--- a/src/HOL/IsaMakefile Fri Oct 23 14:33:07 2009 +0200
+++ b/src/HOL/IsaMakefile Fri Oct 23 13:23:18 2009 +0200
@@ -323,15 +323,14 @@
$(LOG)/HOL-Library.gz: $(OUT)/HOL Library/SetsAndFunctions.thy \
Library/Abstract_Rat.thy Library/BigO.thy Library/ContNotDenum.thy \
- Library/Efficient_Nat.thy Library/Euclidean_Space.thy \
+ Library/Efficient_Nat.thy \
Library/Sum_Of_Squares.thy Library/Sum_Of_Squares/sos_wrapper.ML \
Library/Sum_Of_Squares/sum_of_squares.ML Library/Fset.thy \
- Library/Convex_Euclidean_Space.thy Library/Glbs.thy \
+ Library/Glbs.thy \
Library/normarith.ML Library/Executable_Set.thy \
Library/Infinite_Set.thy Library/FuncSet.thy \
- Library/Permutations.thy Library/Determinants.thy Library/Bit.thy \
- Library/Topology_Euclidean_Space.thy \
- Library/Finite_Cartesian_Product.thy Library/FrechetDeriv.thy \
+ Library/Permutations.thy Library/Bit.thy \
+ Library/FrechetDeriv.thy \
Library/Fraction_Field.thy Library/Fundamental_Theorem_Algebra.thy \
Library/Inner_Product.thy Library/Kleene_Algebra.thy \
Library/Lattice_Syntax.thy \
@@ -1005,6 +1004,19 @@
@cd TLA; $(ISABELLE_TOOL) usedir $(OUT)/TLA Memory
+## HOL-Multivariate_Analysis
+
+HOL-Multivariate_Analysis: HOL $(OUT)/HOL-Multivariate_Analysis
+
+$(OUT)/HOL-Multivariate_Analysis: $(OUT)/HOL Multivariate_Analysis/ROOT.ML \
+ Multivariate_Analysis/Multivariate_Analysis.thy \
+ Multivariate_Analysis/Determinants.thy \
+ Multivariate_Analysis/Finite_Cartesian_Product.thy \
+ Multivariate_Analysis/Euclidean_Space.thy \
+ Multivariate_Analysis/Topology_Euclidean_Space.thy \
+ Multivariate_Analysis/Convex_Euclidean_Space.thy
+ @cd Multivariate_Analysis; $(ISABELLE_TOOL) usedir -b -g true $(OUT)/HOL HOL-Multivariate_Analysis
+
## HOL-Nominal
HOL-Nominal: HOL $(OUT)/HOL-Nominal
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Library/#Topology_Euclidean_Space.thy# Fri Oct 23 13:23:18 2009 +0200
@@ -0,0 +1,6029 @@
+(* Title: Topology
+ Author: Amine Chaieb, University of Cambridge
+ Author: Robert Himmelmann, TU Muenchen
+*)
+
+header {* Elementary topology in Euclidean space. *}
+
+theory Topology_Euclidean_Space
+imports SEQ Euclidean_Space Product_Vector
+begin
+
+declare fstcart_pastecart[simp] sndcart_pastecart[simp]
+
+subsection{* General notion of a topology *}
+
+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)"
+typedef (open) 'a topology = "{L::('a set) set. istopology L}"
+ morphisms "openin" "topology"
+ unfolding istopology_def by blast
+
+lemma istopology_open_in[intro]: "istopology(openin U)"
+ using openin[of U] by blast
+
+lemma topology_inverse': "istopology U \<Longrightarrow> openin (topology U) = U"
+ using topology_inverse[unfolded mem_def Collect_def] .
+
+lemma topology_inverse_iff: "istopology U \<longleftrightarrow> openin (topology U) = U"
+ using topology_inverse[of U] istopology_open_in[of "topology U"] by auto
+
+lemma topology_eq: "T1 = T2 \<longleftrightarrow> (\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S)"
+proof-
+ {assume "T1=T2" hence "\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S" by simp}
+ moreover
+ {assume H: "\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S"
+ hence "openin T1 = openin T2" by (metis mem_def set_ext)
+ hence "topology (openin T1) = topology (openin T2)" by simp
+ hence "T1 = T2" unfolding openin_inverse .}
+ ultimately show ?thesis by blast
+qed
+
+text{* Infer the "universe" from union of all sets in the topology. *}
+
+definition "topspace T = \<Union>{S. openin T S}"
+
+subsection{* Main properties of open sets *}
+
+lemma openin_clauses:
+ fixes U :: "'a topology"
+ shows "openin U {}"
+ "\<And>S T. openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S\<inter>T)"
+ "\<And>K. (\<forall>S \<in> K. openin U S) \<Longrightarrow> openin U (\<Union>K)"
+ using openin[of U] unfolding istopology_def Collect_def mem_def
+ by (metis mem_def subset_eq)+
+
+lemma openin_subset[intro]: "openin U S \<Longrightarrow> S \<subseteq> topspace U"
+ unfolding topspace_def by blast
+lemma openin_empty[simp]: "openin U {}" by (simp add: openin_clauses)
+
+lemma openin_Int[intro]: "openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S \<inter> T)"
+ by (simp add: openin_clauses)
+
+lemma openin_Union[intro]: "(\<forall>S \<in>K. openin U S) \<Longrightarrow> openin U (\<Union> K)" by (simp add: openin_clauses)
+
+lemma openin_Un[intro]: "openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S \<union> T)"
+ using openin_Union[of "{S,T}" U] by auto
+
+lemma openin_topspace[intro, simp]: "openin U (topspace U)" by (simp add: openin_Union topspace_def)
+
+lemma openin_subopen: "openin U S \<longleftrightarrow> (\<forall>x \<in> S. \<exists>T. openin U T \<and> x \<in> T \<and> T \<subseteq> S)" (is "?lhs \<longleftrightarrow> ?rhs")
+proof-
+ {assume ?lhs then have ?rhs by auto }
+ moreover
+ {assume H: ?rhs
+ then obtain t where t: "\<forall>x\<in>S. openin U (t x) \<and> x \<in> t x \<and> t x \<subseteq> S"
+ unfolding Ball_def ex_simps(6)[symmetric] choice_iff by blast
+ from t have th0: "\<forall>x\<in> t`S. openin U x" by auto
+ have "\<Union> t`S = S" using t by auto
+ with openin_Union[OF th0] have "openin U S" by simp }
+ ultimately show ?thesis by blast
+qed
+
+subsection{* Closed sets *}
+
+definition "closedin U S \<longleftrightarrow> S \<subseteq> topspace U \<and> openin U (topspace U - S)"
+
+lemma closedin_subset: "closedin U S \<Longrightarrow> S \<subseteq> topspace U" by (metis closedin_def)
+lemma closedin_empty[simp]: "closedin U {}" by (simp add: closedin_def)
+lemma closedin_topspace[intro,simp]:
+ "closedin U (topspace U)" by (simp add: closedin_def)
+lemma closedin_Un[intro]: "closedin U S \<Longrightarrow> closedin U T \<Longrightarrow> closedin U (S \<union> T)"
+ by (auto simp add: Diff_Un closedin_def)
+
+lemma Diff_Inter[intro]: "A - \<Inter>S = \<Union> {A - s|s. s\<in>S}" by auto
+lemma closedin_Inter[intro]: assumes Ke: "K \<noteq> {}" and Kc: "\<forall>S \<in>K. closedin U S"
+ shows "closedin U (\<Inter> K)" using Ke Kc unfolding closedin_def Diff_Inter by auto
+
+lemma closedin_Int[intro]: "closedin U S \<Longrightarrow> closedin U T \<Longrightarrow> closedin U (S \<inter> T)"
+ using closedin_Inter[of "{S,T}" U] by auto
+
+lemma Diff_Diff_Int: "A - (A - B) = A \<inter> B" by blast
+lemma openin_closedin_eq: "openin U S \<longleftrightarrow> S \<subseteq> topspace U \<and> closedin U (topspace U - S)"
+ apply (auto simp add: closedin_def)
+ apply (metis openin_subset subset_eq)
+ apply (auto simp add: Diff_Diff_Int)
+ apply (subgoal_tac "topspace U \<inter> S = S")
+ by auto
+
+lemma openin_closedin: "S \<subseteq> topspace U \<Longrightarrow> (openin U S \<longleftrightarrow> closedin U (topspace U - S))"
+ by (simp add: openin_closedin_eq)
+
+lemma openin_diff[intro]: assumes oS: "openin U S" and cT: "closedin U T" shows "openin U (S - T)"
+proof-
+ have "S - T = S \<inter> (topspace U - T)" using openin_subset[of U S] oS cT
+ by (auto simp add: topspace_def openin_subset)
+ then show ?thesis using oS cT by (auto simp add: closedin_def)
+qed
+
+lemma closedin_diff[intro]: assumes oS: "closedin U S" and cT: "openin U T" shows "closedin U (S - T)"
+proof-
+ have "S - T = S \<inter> (topspace U - T)" using closedin_subset[of U S] oS cT
+ by (auto simp add: topspace_def )
+ then show ?thesis using oS cT by (auto simp add: openin_closedin_eq)
+qed
+
+subsection{* Subspace topology. *}
+
+definition "subtopology U V = topology {S \<inter> V |S. openin U S}"
+
+lemma istopology_subtopology: "istopology {S \<inter> V |S. openin U S}" (is "istopology ?L")
+proof-
+ have "{} \<in> ?L" by blast
+ {fix A B assume A: "A \<in> ?L" and B: "B \<in> ?L"
+ from A B obtain Sa and Sb where Sa: "openin U Sa" "A = Sa \<inter> V" and Sb: "openin U Sb" "B = Sb \<inter> V" by blast
+ have "A\<inter>B = (Sa \<inter> Sb) \<inter> V" "openin U (Sa \<inter> Sb)" using Sa Sb by blast+
+ then have "A \<inter> B \<in> ?L" by blast}
+ moreover
+ {fix K assume K: "K \<subseteq> ?L"
+ have th0: "?L = (\<lambda>S. S \<inter> V) ` openin U "
+ apply (rule set_ext)
+ apply (simp add: Ball_def image_iff)
+ by (metis mem_def)
+ from K[unfolded th0 subset_image_iff]
+ obtain Sk where Sk: "Sk \<subseteq> openin U" "K = (\<lambda>S. S \<inter> V) ` Sk" by blast
+ have "\<Union>K = (\<Union>Sk) \<inter> V" using Sk by auto
+ moreover have "openin U (\<Union> Sk)" using Sk by (auto simp add: subset_eq mem_def)
+ ultimately have "\<Union>K \<in> ?L" by blast}
+ ultimately show ?thesis unfolding istopology_def by blast
+qed
+
+lemma openin_subtopology:
+ "openin (subtopology U V) S \<longleftrightarrow> (\<exists> T. (openin U T) \<and> (S = T \<inter> V))"
+ unfolding subtopology_def topology_inverse'[OF istopology_subtopology]
+ by (auto simp add: Collect_def)
+
+lemma topspace_subtopology: "topspace(subtopology U V) = topspace U \<inter> V"
+ by (auto simp add: topspace_def openin_subtopology)
+
+lemma closedin_subtopology:
+ "closedin (subtopology U V) S \<longleftrightarrow> (\<exists>T. closedin U T \<and> S = T \<inter> V)"
+ unfolding closedin_def topspace_subtopology
+ apply (simp add: openin_subtopology)
+ apply (rule iffI)
+ apply clarify
+ apply (rule_tac x="topspace U - T" in exI)
+ by auto
+
+lemma openin_subtopology_refl: "openin (subtopology U V) V \<longleftrightarrow> V \<subseteq> topspace U"
+ unfolding openin_subtopology
+ apply (rule iffI, clarify)
+ apply (frule openin_subset[of U]) apply blast
+ apply (rule exI[where x="topspace U"])
+ by auto
+
+lemma subtopology_superset: assumes UV: "topspace U \<subseteq> V"
+ shows "subtopology U V = U"
+proof-
+ {fix S
+ {fix T assume T: "openin U T" "S = T \<inter> V"
+ from T openin_subset[OF T(1)] UV have eq: "S = T" by blast
+ have "openin U S" unfolding eq using T by blast}
+ moreover
+ {assume S: "openin U S"
+ hence "\<exists>T. openin U T \<and> S = T \<inter> V"
+ using openin_subset[OF S] UV by auto}
+ ultimately have "(\<exists>T. openin U T \<and> S = T \<inter> V) \<longleftrightarrow> openin U S" by blast}
+ then show ?thesis unfolding topology_eq openin_subtopology by blast
+qed
+
+
+lemma subtopology_topspace[simp]: "subtopology U (topspace U) = U"
+ by (simp add: subtopology_superset)
+
+lemma subtopology_UNIV[simp]: "subtopology U UNIV = U"
+ by (simp add: subtopology_superset)
+
+subsection{* The universal Euclidean versions are what we use most of the time *}
+
+definition
+ euclidean :: "'a::topological_space topology" where
+ "euclidean = topology open"
+
+lemma open_openin: "open S \<longleftrightarrow> openin euclidean S"
+ unfolding euclidean_def
+ apply (rule cong[where x=S and y=S])
+ apply (rule topology_inverse[symmetric])
+ apply (auto simp add: istopology_def)
+ by (auto simp add: mem_def subset_eq)
+
+lemma topspace_euclidean: "topspace euclidean = UNIV"
+ apply (simp add: topspace_def)
+ apply (rule set_ext)
+ by (auto simp add: open_openin[symmetric])
+
+lemma topspace_euclidean_subtopology[simp]: "topspace (subtopology euclidean S) = S"
+ by (simp add: topspace_euclidean topspace_subtopology)
+
+lemma closed_closedin: "closed S \<longleftrightarrow> closedin euclidean S"
+ by (simp add: closed_def closedin_def topspace_euclidean open_openin Compl_eq_Diff_UNIV)
+
+lemma open_subopen: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> S)"
+ by (simp add: open_openin openin_subopen[symmetric])
+
+subsection{* Open and closed balls. *}
+
+definition
+ ball :: "'a::metric_space \<Rightarrow> real \<Rightarrow> 'a set" where
+ "ball x e = {y. dist x y < e}"
+
+definition
+ cball :: "'a::metric_space \<Rightarrow> real \<Rightarrow> 'a set" where
+ "cball x e = {y. dist x y \<le> e}"
+
+lemma mem_ball[simp]: "y \<in> ball x e \<longleftrightarrow> dist x y < e" by (simp add: ball_def)
+lemma mem_cball[simp]: "y \<in> cball x e \<longleftrightarrow> dist x y \<le> e" by (simp add: cball_def)
+
+lemma mem_ball_0 [simp]:
+ fixes x :: "'a::real_normed_vecto"
+ shows "x \<in> ball 0 e \<longleftrightarrow> norm x < e"
+ by (simp add: dist_norm)
+
+lemma mem_cball_0 [simp]:
+ fixes x :: "'a::real_normed_vector"
+ shows "x \<in> cball 0 e \<longleftrightarrow> norm x \<le> e"
+ by (simp add: dist_norm)
+
+lemma centre_in_cball[simp]: "x \<in> cball x e \<longleftrightarrow> 0\<le> e" by simp
+lemma ball_subset_cball[simp,intro]: "ball x e \<subseteq> cball x e" by (simp add: subset_eq)
+lemma subset_ball[intro]: "d <= e ==> ball x d \<subseteq> ball x e" by (simp add: subset_eq)
+lemma subset_cball[intro]: "d <= e ==> cball x d \<subseteq> cball x e" by (simp add: subset_eq)
+lemma ball_max_Un: "ball a (max r s) = ball a r \<union> ball a s"
+ by (simp add: expand_set_eq) arith
+
+lemma ball_min_Int: "ball a (min r s) = ball a r \<inter> ball a s"
+ by (simp add: expand_set_eq)
+
+subsection{* Topological properties of open balls *}
+
+lemma diff_less_iff: "(a::real) - b > 0 \<longleftrightarrow> a > b"
+ "(a::real) - b < 0 \<longleftrightarrow> a < b"
+ "a - b < c \<longleftrightarrow> a < c +b" "a - b > c \<longleftrightarrow> a > c +b" by arith+
+lemma diff_le_iff: "(a::real) - b \<ge> 0 \<longleftrightarrow> a \<ge> b" "(a::real) - b \<le> 0 \<longleftrightarrow> a \<le> b"
+ "a - b \<le> c \<longleftrightarrow> a \<le> c +b" "a - b \<ge> c \<longleftrightarrow> a \<ge> c +b" by arith+
+
+lemma open_ball[intro, simp]: "open (ball x e)"
+ unfolding open_dist ball_def Collect_def Ball_def mem_def
+ unfolding dist_commute
+ apply clarify
+ apply (rule_tac x="e - dist xa x" in exI)
+ using dist_triangle_alt[where z=x]
+ apply (clarsimp simp add: diff_less_iff)
+ apply atomize
+ apply (erule_tac x="y" in allE)
+ apply (erule_tac x="xa" in allE)
+ by arith
+
+lemma centre_in_ball[simp]: "x \<in> ball x e \<longleftrightarrow> e > 0" by (metis mem_ball dist_self)
+lemma open_contains_ball: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. ball x e \<subseteq> S)"
+ unfolding open_dist subset_eq mem_ball Ball_def dist_commute ..
+
+lemma open_contains_ball_eq: "open S \<Longrightarrow> \<forall>x. x\<in>S \<longleftrightarrow> (\<exists>e>0. ball x e \<subseteq> S)"
+ by (metis open_contains_ball subset_eq centre_in_ball)
+
+lemma ball_eq_empty[simp]: "ball x e = {} \<longleftrightarrow> e \<le> 0"
+ unfolding mem_ball expand_set_eq
+ apply (simp add: not_less)
+ by (metis zero_le_dist order_trans dist_self)
+
+lemma ball_empty[intro]: "e \<le> 0 ==> ball x e = {}" by simp
+
+subsection{* Basic "localization" results are handy for connectedness. *}
+
+lemma openin_open: "openin (subtopology euclidean U) S \<longleftrightarrow> (\<exists>T. open T \<and> (S = U \<inter> T))"
+ by (auto simp add: openin_subtopology open_openin[symmetric])
+
+lemma openin_open_Int[intro]: "open S \<Longrightarrow> openin (subtopology euclidean U) (U \<inter> S)"
+ by (auto simp add: openin_open)
+
+lemma open_openin_trans[trans]:
+ "open S \<Longrightarrow> open T \<Longrightarrow> T \<subseteq> S \<Longrightarrow> openin (subtopology euclidean S) T"
+ by (metis Int_absorb1 openin_open_Int)
+
+lemma open_subset: "S \<subseteq> T \<Longrightarrow> open S \<Longrightarrow> openin (subtopology euclidean T) S"
+ by (auto simp add: openin_open)
+
+lemma closedin_closed: "closedin (subtopology euclidean U) S \<longleftrightarrow> (\<exists>T. closed T \<and> S = U \<inter> T)"
+ by (simp add: closedin_subtopology closed_closedin Int_ac)
+
+lemma closedin_closed_Int: "closed S ==> closedin (subtopology euclidean U) (U \<inter> S)"
+ by (metis closedin_closed)
+
+lemma closed_closedin_trans: "closed S \<Longrightarrow> closed T \<Longrightarrow> T \<subseteq> S \<Longrightarrow> closedin (subtopology euclidean S) T"
+ apply (subgoal_tac "S \<inter> T = T" )
+ apply auto
+ apply (frule closedin_closed_Int[of T S])
+ by simp
+
+lemma closed_subset: "S \<subseteq> T \<Longrightarrow> closed S \<Longrightarrow> closedin (subtopology euclidean T) S"
+ by (auto simp add: closedin_closed)
+
+lemma openin_euclidean_subtopology_iff:
+ fixes S U :: "'a::metric_space set"
+ shows "openin (subtopology euclidean U) S
+ \<longleftrightarrow> S \<subseteq> U \<and> (\<forall>x\<in>S. \<exists>e>0. \<forall>x'\<in>U. dist x' x < e \<longrightarrow> x'\<in> S)" (is "?lhs \<longleftrightarrow> ?rhs")
+proof-
+ {assume ?lhs hence ?rhs unfolding openin_subtopology open_openin[symmetric]
+ by (simp add: open_dist) blast}
+ moreover
+ {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"
+ 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)"
+ by metis
+ let ?T = "\<Union>{B. \<exists>x\<in>S. B = ball x (d x)}"
+ have oT: "open ?T" by auto
+ { fix x assume "x\<in>S"
+ hence "x \<in> \<Union>{B. \<exists>x\<in>S. B = ball x (d x)}"
+ apply simp apply(rule_tac x="ball x(d x)" in exI) apply auto
+ by (rule d [THEN conjunct1])
+ hence "x\<in> ?T \<inter> U" using SU and `x\<in>S` by auto }
+ moreover
+ { fix y assume "y\<in>?T"
+ then obtain B where "y\<in>B" "B\<in>{B. \<exists>x\<in>S. B = ball x (d x)}" by auto
+ then obtain x where "x\<in>S" and x:"y \<in> ball x (d x)" by auto
+ assume "y\<in>U"
+ hence "y\<in>S" using d[OF `x\<in>S`] and x by(auto simp add: dist_commute) }
+ ultimately have "S = ?T \<inter> U" by blast
+ with oT have ?lhs unfolding openin_subtopology open_openin[symmetric] by blast}
+ ultimately show ?thesis by blast
+qed
+
+text{* These "transitivity" results are handy too. *}
+
+lemma openin_trans[trans]: "openin (subtopology euclidean T) S \<Longrightarrow> openin (subtopology euclidean U) T
+ \<Longrightarrow> openin (subtopology euclidean U) S"
+ unfolding open_openin openin_open by blast
+
+lemma openin_open_trans: "openin (subtopology euclidean T) S \<Longrightarrow> open T \<Longrightarrow> open S"
+ by (auto simp add: openin_open intro: openin_trans)
+
+lemma closedin_trans[trans]:
+ "closedin (subtopology euclidean T) S \<Longrightarrow>
+ closedin (subtopology euclidean U) T
+ ==> closedin (subtopology euclidean U) S"
+ by (auto simp add: closedin_closed closed_closedin closed_Inter Int_assoc)
+
+lemma closedin_closed_trans: "closedin (subtopology euclidean T) S \<Longrightarrow> closed T \<Longrightarrow> closed S"
+ by (auto simp add: closedin_closed intro: closedin_trans)
+
+subsection{* Connectedness *}
+
+definition "connected S \<longleftrightarrow>
+ ~(\<exists>e1 e2. open e1 \<and> open e2 \<and> S \<subseteq> (e1 \<union> e2) \<and> (e1 \<inter> e2 \<inter> S = {})
+ \<and> ~(e1 \<inter> S = {}) \<and> ~(e2 \<inter> S = {}))"
+
+lemma connected_local:
+ "connected S \<longleftrightarrow> ~(\<exists>e1 e2.
+ openin (subtopology euclidean S) e1 \<and>
+ openin (subtopology euclidean S) e2 \<and>
+ S \<subseteq> e1 \<union> e2 \<and>
+ e1 \<inter> e2 = {} \<and>
+ ~(e1 = {}) \<and>
+ ~(e2 = {}))"
+unfolding connected_def openin_open by (safe, blast+)
+
+lemma exists_diff: "(\<exists>S. P(UNIV - S)) \<longleftrightarrow> (\<exists>S. P S)" (is "?lhs \<longleftrightarrow> ?rhs")
+proof-
+
+ {assume "?lhs" hence ?rhs by blast }
+ moreover
+ {fix S assume H: "P S"
+ have "S = UNIV - (UNIV - S)" by auto
+ with H have "P (UNIV - (UNIV - S))" by metis }
+ ultimately show ?thesis by metis
+qed
+
+lemma connected_clopen: "connected S \<longleftrightarrow>
+ (\<forall>T. openin (subtopology euclidean S) T \<and>
+ closedin (subtopology euclidean S) T \<longrightarrow> T = {} \<or> T = S)" (is "?lhs \<longleftrightarrow> ?rhs")
+proof-
+ 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> {})"
+ unfolding connected_def openin_open closedin_closed
+ apply (subst exists_diff) by blast
+ 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> {})"
+ (is " _ \<longleftrightarrow> \<not> (\<exists>e2 e1. ?P e2 e1)") apply (simp add: closed_def Compl_eq_Diff_UNIV) by metis
+
+ have th1: "?rhs \<longleftrightarrow> \<not> (\<exists>t' t. closed t'\<and>t = S\<inter>t' \<and> t\<noteq>{} \<and> t\<noteq>S \<and> (\<exists>t'. open t' \<and> t = S \<inter> t'))"
+ (is "_ \<longleftrightarrow> \<not> (\<exists>t' t. ?Q t' t)")
+ unfolding connected_def openin_open closedin_closed by auto
+ {fix e2
+ {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)"
+ by auto}
+ then have "(\<exists>e1. ?P e2 e1) \<longleftrightarrow> (\<exists>t. ?Q e2 t)" by metis}
+ then have "\<forall>e2. (\<exists>e1. ?P e2 e1) \<longleftrightarrow> (\<exists>t. ?Q e2 t)" by blast
+ then show ?thesis unfolding th0 th1 by simp
+qed
+
+lemma connected_empty[simp, intro]: "connected {}"
+ by (simp add: connected_def)
+
+subsection{* Hausdorff and other separation properties *}
+
+class t0_space =
+ assumes t0_space: "x \<noteq> y \<Longrightarrow> \<exists>U. open U \<and> \<not> (x \<in> U \<longleftrightarrow> y \<in> U)"
+
+class t1_space =
+ 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"
+begin
+
+subclass t0_space
+proof
+qed (fast dest: t1_space)
+
+end
+
+text {* T2 spaces are also known as Hausdorff spaces. *}
+
+class t2_space =
+ 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 = {}"
+begin
+
+subclass t1_space
+proof
+qed (fast dest: hausdorff)
+
+end
+
+instance metric_space \<subseteq> t2_space
+proof
+ fix x y :: "'a::metric_space"
+ assume xy: "x \<noteq> y"
+ let ?U = "ball x (dist x y / 2)"
+ let ?V = "ball y (dist x y / 2)"
+ have th0: "\<And>d x y z. (d x z :: real) <= d x y + d y z \<Longrightarrow> d y z = d z y
+ ==> ~(d x y * 2 < d x z \<and> d z y * 2 < d x z)" by arith
+ have "open ?U \<and> open ?V \<and> x \<in> ?U \<and> y \<in> ?V \<and> ?U \<inter> ?V = {}"
+ using dist_pos_lt[OF xy] th0[of dist,OF dist_triangle dist_commute]
+ by (auto simp add: expand_set_eq)
+ then show "\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"
+ by blast
+qed
+
+lemma separation_t2:
+ fixes x y :: "'a::t2_space"
+ 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 = {})"
+ using hausdorff[of x y] by blast
+
+lemma separation_t1:
+ fixes x y :: "'a::t1_space"
+ 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)"
+ using t1_space[of x y] by blast
+
+lemma separation_t0:
+ fixes x y :: "'a::t0_space"
+ shows "x \<noteq> y \<longleftrightarrow> (\<exists>U. open U \<and> ~(x\<in>U \<longleftrightarrow> y\<in>U))"
+ using t0_space[of x y] by blast
+
+subsection{* Limit points *}
+
+definition
+ islimpt:: "'a::topological_space \<Rightarrow> 'a set \<Rightarrow> bool"
+ (infixr "islimpt" 60) where
+ "x islimpt S \<longleftrightarrow> (\<forall>T. x\<in>T \<longrightarrow> open T \<longrightarrow> (\<exists>y\<in>S. y\<in>T \<and> y\<noteq>x))"
+
+lemma islimptI:
+ assumes "\<And>T. x \<in> T \<Longrightarrow> open T \<Longrightarrow> \<exists>y\<in>S. y \<in> T \<and> y \<noteq> x"
+ shows "x islimpt S"
+ using assms unfolding islimpt_def by auto
+
+lemma islimptE:
+ assumes "x islimpt S" and "x \<in> T" and "open T"
+ obtains y where "y \<in> S" and "y \<in> T" and "y \<noteq> x"
+ using assms unfolding islimpt_def by auto
+
+lemma islimpt_subset: "x islimpt S \<Longrightarrow> S \<subseteq> T ==> x islimpt T" by (auto simp add: islimpt_def)
+
+lemma islimpt_approachable:
+ fixes x :: "'a::metric_space"
+ shows "x islimpt S \<longleftrightarrow> (\<forall>e>0. \<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e)"
+ unfolding islimpt_def
+ apply auto
+ apply(erule_tac x="ball x e" in allE)
+ apply auto
+ apply(rule_tac x=y in bexI)
+ apply (auto simp add: dist_commute)
+ apply (simp add: open_dist, drule (1) bspec)
+ apply (clarify, drule spec, drule (1) mp, auto)
+ done
+
+lemma islimpt_approachable_le:
+ fixes x :: "'a::metric_space"
+ shows "x islimpt S \<longleftrightarrow> (\<forall>e>0. \<exists>x'\<in> S. x' \<noteq> x \<and> dist x' x <= e)"
+ unfolding islimpt_approachable
+ using approachable_lt_le[where f="\<lambda>x'. dist x' x" and P="\<lambda>x'. \<not> (x'\<in>S \<and> x'\<noteq>x)"]
+ by metis (* FIXME: VERY slow! *)
+
+class perfect_space =
+ (* FIXME: perfect_space should inherit from topological_space *)
+ assumes islimpt_UNIV [simp, intro]: "(x::'a::metric_space) islimpt UNIV"
+
+lemma perfect_choose_dist:
+ fixes x :: "'a::perfect_space"
+ shows "0 < r \<Longrightarrow> \<exists>a. a \<noteq> x \<and> dist a x < r"
+using islimpt_UNIV [of x]
+by (simp add: islimpt_approachable)
+
+instance real :: perfect_space
+apply default
+apply (rule islimpt_approachable [THEN iffD2])
+apply (clarify, rule_tac x="x + e/2" in bexI)
+apply (auto simp add: dist_norm)
+done
+
+instance "^" :: (perfect_space, finite) perfect_space
+proof
+ fix x :: "'a ^ 'b"
+ {
+ fix e :: real assume "0 < e"
+ def a \<equiv> "x $ arbitrary"
+ have "a islimpt UNIV" by (rule islimpt_UNIV)
+ with `0 < e` obtain b where "b \<noteq> a" and "dist b a < e"
+ unfolding islimpt_approachable by auto
+ def y \<equiv> "Cart_lambda ((Cart_nth x)(arbitrary := b))"
+ from `b \<noteq> a` have "y \<noteq> x"
+ unfolding a_def y_def by (simp add: Cart_eq)
+ from `dist b a < e` have "dist y x < e"
+ unfolding dist_vector_def a_def y_def
+ apply simp
+ apply (rule le_less_trans [OF setL2_le_setsum [OF zero_le_dist]])
+ apply (subst setsum_diff1' [where a=arbitrary], simp, simp, simp)
+ done
+ from `y \<noteq> x` and `dist y x < e`
+ have "\<exists>y\<in>UNIV. y \<noteq> x \<and> dist y x < e" by auto
+ }
+ then show "x islimpt UNIV" unfolding islimpt_approachable by blast
+qed
+
+lemma closed_limpt: "closed S \<longleftrightarrow> (\<forall>x. x islimpt S \<longrightarrow> x \<in> S)"
+ unfolding closed_def
+ apply (subst open_subopen)
+ apply (simp add: islimpt_def subset_eq Compl_eq_Diff_UNIV)
+ by (metis DiffE DiffI UNIV_I insertCI insert_absorb mem_def)
+
+lemma islimpt_EMPTY[simp]: "\<not> x islimpt {}"
+ unfolding islimpt_def by auto
+
+lemma closed_positive_orthant: "closed {x::real^'n::finite. \<forall>i. 0 \<le>x$i}"
+proof-
+ let ?U = "UNIV :: 'n set"
+ let ?O = "{x::real^'n. \<forall>i. x$i\<ge>0}"
+ {fix x:: "real^'n" and i::'n assume H: "\<forall>e>0. \<exists>x'\<in>?O. x' \<noteq> x \<and> dist x' x < e"
+ and xi: "x$i < 0"
+ from xi have th0: "-x$i > 0" by arith
+ from H[rule_format, OF th0] obtain x' where x': "x' \<in>?O" "x' \<noteq> x" "dist x' x < -x $ i" by blast
+ have th:" \<And>b a (x::real). abs x <= b \<Longrightarrow> b <= a ==> ~(a + x < 0)" by arith
+ have th': "\<And>x (y::real). x < 0 \<Longrightarrow> 0 <= y ==> abs x <= abs (y - x)" by arith
+ have th1: "\<bar>x$i\<bar> \<le> \<bar>(x' - x)$i\<bar>" using x'(1) xi
+ apply (simp only: vector_component)
+ by (rule th') auto
+ have th2: "\<bar>dist x x'\<bar> \<ge> \<bar>(x' - x)$i\<bar>" using component_le_norm[of "x'-x" i]
+ apply (simp add: dist_norm) by norm
+ from th[OF th1 th2] x'(3) have False by (simp add: dist_commute) }
+ then show ?thesis unfolding closed_limpt islimpt_approachable
+ unfolding not_le[symmetric] by blast
+qed
+
+lemma finite_set_avoid:
+ fixes a :: "'a::metric_space"
+ assumes fS: "finite S" shows "\<exists>d>0. \<forall>x\<in>S. x \<noteq> a \<longrightarrow> d <= dist a x"
+proof(induct rule: finite_induct[OF fS])
+ case 1 thus ?case apply auto by ferrack
+next
+ case (2 x F)
+ from 2 obtain d where d: "d >0" "\<forall>x\<in>F. x\<noteq>a \<longrightarrow> d \<le> dist a x" by blast
+ {assume "x = a" hence ?case using d by auto }
+ moreover
+ {assume xa: "x\<noteq>a"
+ let ?d = "min d (dist a x)"
+ have dp: "?d > 0" using xa d(1) using dist_nz by auto
+ from d have d': "\<forall>x\<in>F. x\<noteq>a \<longrightarrow> ?d \<le> dist a x" by auto
+ with dp xa have ?case by(auto intro!: exI[where x="?d"]) }
+ ultimately show ?case by blast
+qed
+
+lemma islimpt_finite:
+ fixes S :: "'a::metric_space set"
+ assumes fS: "finite S" shows "\<not> a islimpt S"
+ unfolding islimpt_approachable
+ using finite_set_avoid[OF fS, of a] by (metis dist_commute not_le)
+
+lemma islimpt_Un: "x islimpt (S \<union> T) \<longleftrightarrow> x islimpt S \<or> x islimpt T"
+ apply (rule iffI)
+ defer
+ apply (metis Un_upper1 Un_upper2 islimpt_subset)
+ unfolding islimpt_def
+ apply (rule ccontr, clarsimp, rename_tac A B)
+ apply (drule_tac x="A \<inter> B" in spec)
+ apply (auto simp add: open_Int)
+ done
+
+lemma discrete_imp_closed:
+ fixes S :: "'a::metric_space set"
+ assumes e: "0 < e" and d: "\<forall>x \<in> S. \<forall>y \<in> S. dist y x < e \<longrightarrow> y = x"
+ shows "closed S"
+proof-
+ {fix x assume C: "\<forall>e>0. \<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e"
+ from e have e2: "e/2 > 0" by arith
+ from C[rule_format, OF e2] obtain y where y: "y \<in> S" "y\<noteq>x" "dist y x < e/2" by blast
+ let ?m = "min (e/2) (dist x y) "
+ from e2 y(2) have mp: "?m > 0" by (simp add: dist_nz[THEN sym])
+ from C[rule_format, OF mp] obtain z where z: "z \<in> S" "z\<noteq>x" "dist z x < ?m" by blast
+ have th: "dist z y < e" using z y
+ by (intro dist_triangle_lt [where z=x], simp)
+ from d[rule_format, OF y(1) z(1) th] y z
+ have False by (auto simp add: dist_commute)}
+ then show ?thesis by (metis islimpt_approachable closed_limpt [where 'a='a])
+qed
+
+subsection{* Interior of a Set *}
+definition "interior S = {x. \<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> S}"
+
+lemma interior_eq: "interior S = S \<longleftrightarrow> open S"
+ apply (simp add: expand_set_eq interior_def)
+ apply (subst (2) open_subopen) by (safe, blast+)
+
+lemma interior_open: "open S ==> (interior S = S)" by (metis interior_eq)
+
+lemma interior_empty[simp]: "interior {} = {}" by (simp add: interior_def)
+
+lemma open_interior[simp, intro]: "open(interior S)"
+ apply (simp add: interior_def)
+ apply (subst open_subopen) by blast
+
+lemma interior_interior[simp]: "interior(interior S) = interior S" by (metis interior_eq open_interior)
+lemma interior_subset: "interior S \<subseteq> S" by (auto simp add: interior_def)
+lemma subset_interior: "S \<subseteq> T ==> (interior S) \<subseteq> (interior T)" by (auto simp add: interior_def)
+lemma interior_maximal: "T \<subseteq> S \<Longrightarrow> open T ==> T \<subseteq> (interior S)" by (auto simp add: interior_def)
+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"
+ by (metis equalityI interior_maximal interior_subset open_interior)
+lemma mem_interior: "x \<in> interior S \<longleftrightarrow> (\<exists>e. 0 < e \<and> ball x e \<subseteq> S)"
+ apply (simp add: interior_def)
+ by (metis open_contains_ball centre_in_ball open_ball subset_trans)
+
+lemma open_subset_interior: "open S ==> S \<subseteq> interior T \<longleftrightarrow> S \<subseteq> T"
+ by (metis interior_maximal interior_subset subset_trans)
+
+lemma interior_inter[simp]: "interior(S \<inter> T) = interior S \<inter> interior T"
+ apply (rule equalityI, simp)
+ apply (metis Int_lower1 Int_lower2 subset_interior)
+ by (metis Int_mono interior_subset open_Int open_interior open_subset_interior)
+
+lemma interior_limit_point [intro]:
+ fixes x :: "'a::perfect_space"
+ assumes x: "x \<in> interior S" shows "x islimpt S"
+proof-
+ from x obtain e where e: "e>0" "\<forall>x'. dist x x' < e \<longrightarrow> x' \<in> S"
+ unfolding mem_interior subset_eq Ball_def mem_ball by blast
+ {
+ fix d::real assume d: "d>0"
+ let ?m = "min d e"
+ have mde2: "0 < ?m" using e(1) d(1) by simp
+ from perfect_choose_dist [OF mde2, of x]
+ obtain y where "y \<noteq> x" and "dist y x < ?m" by blast
+ then have "dist y x < e" "dist y x < d" by simp_all
+ from `dist y x < e` e(2) have "y \<in> S" by (simp add: dist_commute)
+ have "\<exists>x'\<in>S. x'\<noteq> x \<and> dist x' x < d"
+ using `y \<in> S` `y \<noteq> x` `dist y x < d` by fast
+ }
+ then show ?thesis unfolding islimpt_approachable by blast
+qed
+
+lemma interior_closed_Un_empty_interior:
+ assumes cS: "closed S" and iT: "interior T = {}"
+ shows "interior(S \<union> T) = interior S"
+proof
+ show "interior S \<subseteq> interior (S\<union>T)"
+ by (rule subset_interior, blast)
+next
+ show "interior (S \<union> T) \<subseteq> interior S"
+ proof
+ fix x assume "x \<in> interior (S \<union> T)"
+ then obtain R where "open R" "x \<in> R" "R \<subseteq> S \<union> T"
+ unfolding interior_def by fast
+ show "x \<in> interior S"
+ proof (rule ccontr)
+ assume "x \<notin> interior S"
+ with `x \<in> R` `open R` obtain y where "y \<in> R - S"
+ unfolding interior_def expand_set_eq by fast
+ from `open R` `closed S` have "open (R - S)" by (rule open_Diff)
+ from `R \<subseteq> S \<union> T` have "R - S \<subseteq> T" by fast
+ from `y \<in> R - S` `open (R - S)` `R - S \<subseteq> T` `interior T = {}`
+ show "False" unfolding interior_def by fast
+ qed
+ qed
+qed
+
+
+subsection{* Closure of a Set *}
+
+definition "closure S = S \<union> {x | x. x islimpt S}"
+
+lemma closure_interior: "closure S = UNIV - interior (UNIV - S)"
+proof-
+ { fix x
+ have "x\<in>UNIV - interior (UNIV - S) \<longleftrightarrow> x \<in> closure S" (is "?lhs = ?rhs")
+ proof
+ let ?exT = "\<lambda> y. (\<exists>T. open T \<and> y \<in> T \<and> T \<subseteq> UNIV - S)"
+ assume "?lhs"
+ hence *:"\<not> ?exT x"
+ unfolding interior_def
+ by simp
+ { assume "\<not> ?rhs"
+ hence False using *
+ unfolding closure_def islimpt_def
+ by blast
+ }
+ thus "?rhs"
+ by blast
+ next
+ assume "?rhs" thus "?lhs"
+ unfolding closure_def interior_def islimpt_def
+ by blast
+ qed
+ }
+ thus ?thesis
+ by blast
+qed
+
+lemma interior_closure: "interior S = UNIV - (closure (UNIV - S))"
+proof-
+ { fix x
+ have "x \<in> interior S \<longleftrightarrow> x \<in> UNIV - (closure (UNIV - S))"
+ unfolding interior_def closure_def islimpt_def
+ by blast (* FIXME: VERY slow! *)
+ }
+ thus ?thesis
+ by blast
+qed
+
+lemma closed_closure[simp, intro]: "closed (closure S)"
+proof-
+ have "closed (UNIV - interior (UNIV -S))" by blast
+ thus ?thesis using closure_interior[of S] by simp
+qed
+
+lemma closure_hull: "closure S = closed hull S"
+proof-
+ have "S \<subseteq> closure S"
+ unfolding closure_def
+ by blast
+ moreover
+ have "closed (closure S)"
+ using closed_closure[of S]
+ by assumption
+ moreover
+ { fix t
+ assume *:"S \<subseteq> t" "closed t"
+ { fix x
+ assume "x islimpt S"
+ hence "x islimpt t" using *(1)
+ using islimpt_subset[of x, of S, of t]
+ by blast
+ }
+ with * have "closure S \<subseteq> t"
+ unfolding closure_def
+ using closed_limpt[of t]
+ by auto
+ }
+ ultimately show ?thesis
+ using hull_unique[of S, of "closure S", of closed]
+ unfolding mem_def
+ by simp
+qed
+
+lemma closure_eq: "closure S = S \<longleftrightarrow> closed S"
+ unfolding closure_hull
+ using hull_eq[of closed, unfolded mem_def, OF closed_Inter, of S]
+ by (metis mem_def subset_eq)
+
+lemma closure_closed[simp]: "closed S \<Longrightarrow> closure S = S"
+ using closure_eq[of S]
+ by simp
+
+lemma closure_closure[simp]: "closure (closure S) = closure S"
+ unfolding closure_hull
+ using hull_hull[of closed S]
+ by assumption
+
+lemma closure_subset: "S \<subseteq> closure S"
+ unfolding closure_hull
+ using hull_subset[of S closed]
+ by assumption
+
+lemma subset_closure: "S \<subseteq> T \<Longrightarrow> closure S \<subseteq> closure T"
+ unfolding closure_hull
+ using hull_mono[of S T closed]
+ by assumption
+
+lemma closure_minimal: "S \<subseteq> T \<Longrightarrow> closed T \<Longrightarrow> closure S \<subseteq> T"
+ using hull_minimal[of S T closed]
+ unfolding closure_hull mem_def
+ by simp
+
+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"
+ using hull_unique[of S T closed]
+ unfolding closure_hull mem_def
+ by simp
+
+lemma closure_empty[simp]: "closure {} = {}"
+ using closed_empty closure_closed[of "{}"]
+ by simp
+
+lemma closure_univ[simp]: "closure UNIV = UNIV"
+ using closure_closed[of UNIV]
+ by simp
+
+lemma closure_eq_empty: "closure S = {} \<longleftrightarrow> S = {}"
+ using closure_empty closure_subset[of S]
+ by blast
+
+lemma closure_subset_eq: "closure S \<subseteq> S \<longleftrightarrow> closed S"
+ using closure_eq[of S] closure_subset[of S]
+ by simp
+
+lemma open_inter_closure_eq_empty:
+ "open S \<Longrightarrow> (S \<inter> closure T) = {} \<longleftrightarrow> S \<inter> T = {}"
+ using open_subset_interior[of S "UNIV - T"]
+ using interior_subset[of "UNIV - T"]
+ unfolding closure_interior
+ by auto
+
+lemma open_inter_closure_subset:
+ "open S \<Longrightarrow> (S \<inter> (closure T)) \<subseteq> closure(S \<inter> T)"
+proof
+ fix x
+ assume as: "open S" "x \<in> S \<inter> closure T"
+ { assume *:"x islimpt T"
+ have "x islimpt (S \<inter> T)"
+ proof (rule islimptI)
+ fix A
+ assume "x \<in> A" "open A"
+ with as have "x \<in> A \<inter> S" "open (A \<inter> S)"
+ by (simp_all add: open_Int)
+ with * obtain y where "y \<in> T" "y \<in> A \<inter> S" "y \<noteq> x"
+ by (rule islimptE)
+ hence "y \<in> S \<inter> T" "y \<in> A \<and> y \<noteq> x"
+ by simp_all
+ thus "\<exists>y\<in>(S \<inter> T). y \<in> A \<and> y \<noteq> x" ..
+ qed
+ }
+ then show "x \<in> closure (S \<inter> T)" using as
+ unfolding closure_def
+ by blast
+qed
+
+lemma closure_complement: "closure(UNIV - S) = UNIV - interior(S)"
+proof-
+ have "S = UNIV - (UNIV - S)"
+ by auto
+ thus ?thesis
+ unfolding closure_interior
+ by auto
+qed
+
+lemma interior_complement: "interior(UNIV - S) = UNIV - closure(S)"
+ unfolding closure_interior
+ by blast
+
+subsection{* Frontier (aka boundary) *}
+
+definition "frontier S = closure S - interior S"
+
+lemma frontier_closed: "closed(frontier S)"
+ by (simp add: frontier_def closed_Diff)
+
+lemma frontier_closures: "frontier S = (closure S) \<inter> (closure(UNIV - S))"
+ by (auto simp add: frontier_def interior_closure)
+
+lemma frontier_straddle:
+ fixes a :: "'a::metric_space"
+ 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")
+proof
+ assume "?lhs"
+ { fix e::real
+ assume "e > 0"
+ let ?rhse = "(\<exists>x\<in>S. dist a x < e) \<and> (\<exists>x. x \<notin> S \<and> dist a x < e)"
+ { assume "a\<in>S"
+ have "\<exists>x\<in>S. dist a x < e" using `e>0` `a\<in>S` by(rule_tac x=a in bexI) auto
+ moreover have "\<exists>x. x \<notin> S \<and> dist a x < e" using `?lhs` `a\<in>S`
+ unfolding frontier_closures closure_def islimpt_def using `e>0`
+ by (auto, erule_tac x="ball a e" in allE, auto)
+ ultimately have ?rhse by auto
+ }
+ moreover
+ { assume "a\<notin>S"
+ hence ?rhse using `?lhs`
+ unfolding frontier_closures closure_def islimpt_def
+ using open_ball[of a e] `e > 0`
+ by (auto, erule_tac x = "ball a e" in allE, auto) (* FIXME: VERY slow! *)
+ }
+ ultimately have ?rhse by auto
+ }
+ thus ?rhs by auto
+next
+ assume ?rhs
+ moreover
+ { fix T assume "a\<notin>S" and
+ 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"
+ from `open T` `a \<in> T` have "\<exists>e>0. ball a e \<subseteq> T" unfolding open_contains_ball[of T] by auto
+ then obtain e where "e>0" "ball a e \<subseteq> T" by auto
+ then obtain y where y:"y\<in>S" "dist a y < e" using as(1) by auto
+ have "\<exists>y\<in>S. y \<in> T \<and> y \<noteq> a"
+ using `dist a y < e` `ball a e \<subseteq> T` unfolding ball_def using `y\<in>S` `a\<notin>S` by auto
+ }
+ hence "a \<in> closure S" unfolding closure_def islimpt_def using `?rhs` by auto
+ moreover
+ { fix T assume "a \<in> T" "open T" "a\<in>S"
+ then obtain e where "e>0" and balle: "ball a e \<subseteq> T" unfolding open_contains_ball using `?rhs` by auto
+ obtain x where "x \<notin> S" "dist a x < e" using `?rhs` using `e>0` by auto
+ 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
+ }
+ hence "a islimpt (UNIV - S) \<or> a\<notin>S" unfolding islimpt_def by auto
+ ultimately show ?lhs unfolding frontier_closures using closure_def[of "UNIV - S"] by auto
+qed
+
+lemma frontier_subset_closed: "closed S \<Longrightarrow> frontier S \<subseteq> S"
+ by (metis frontier_def closure_closed Diff_subset)
+
+lemma frontier_empty: "frontier {} = {}"
+ by (simp add: frontier_def closure_empty)
+
+lemma frontier_subset_eq: "frontier S \<subseteq> S \<longleftrightarrow> closed S"
+proof-
+ { assume "frontier S \<subseteq> S"
+ hence "closure S \<subseteq> S" using interior_subset unfolding frontier_def by auto
+ hence "closed S" using closure_subset_eq by auto
+ }
+ thus ?thesis using frontier_subset_closed[of S] by auto
+qed
+
+lemma frontier_complement: "frontier(UNIV - S) = frontier S"
+ by (auto simp add: frontier_def closure_complement interior_complement)
+
+lemma frontier_disjoint_eq: "frontier S \<inter> S = {} \<longleftrightarrow> open S"
+ using frontier_complement frontier_subset_eq[of "UNIV - S"]
+ unfolding open_closed Compl_eq_Diff_UNIV by auto
+
+subsection{* Common nets and The "within" modifier for nets. *}
+
+definition
+ at_infinity :: "'a::real_normed_vector net" where
+ "at_infinity = Abs_net (range (\<lambda>r. {x. r \<le> norm x}))"
+
+definition
+ indirection :: "'a::real_normed_vector \<Rightarrow> 'a \<Rightarrow> 'a net" (infixr "indirection" 70) where
+ "a indirection v = (at a) within {b. \<exists>c\<ge>0. b - a = scaleR c v}"
+
+text{* Prove That They are all nets. *}
+
+lemma Rep_net_at_infinity:
+ "Rep_net at_infinity = range (\<lambda>r. {x. r \<le> norm x})"
+unfolding at_infinity_def
+apply (rule Abs_net_inverse')
+apply (rule image_nonempty, simp)
+apply (clarsimp, rename_tac r s)
+apply (rule_tac x="max r s" in exI, auto)
+done
+
+lemma within_UNIV: "net within UNIV = net"
+ by (simp add: Rep_net_inject [symmetric] Rep_net_within)
+
+subsection{* Identify Trivial limits, where we can't approach arbitrarily closely. *}
+
+definition
+ trivial_limit :: "'a net \<Rightarrow> bool" where
+ "trivial_limit net \<longleftrightarrow> {} \<in> Rep_net net"
+
+lemma trivial_limit_within:
+ shows "trivial_limit (at a within S) \<longleftrightarrow> \<not> a islimpt S"
+proof
+ assume "trivial_limit (at a within S)"
+ thus "\<not> a islimpt S"
+ unfolding trivial_limit_def
+ unfolding Rep_net_within Rep_net_at
+ unfolding islimpt_def
+ apply (clarsimp simp add: expand_set_eq)
+ apply (rename_tac T, rule_tac x=T in exI)
+ apply (clarsimp, drule_tac x=y in spec, simp)
+ done
+next
+ assume "\<not> a islimpt S"
+ thus "trivial_limit (at a within S)"
+ unfolding trivial_limit_def
+ unfolding Rep_net_within Rep_net_at
+ unfolding islimpt_def
+ apply (clarsimp simp add: image_image)
+ apply (rule_tac x=T in image_eqI)
+ apply (auto simp add: expand_set_eq)
+ done
+qed
+
+lemma trivial_limit_at_iff: "trivial_limit (at a) \<longleftrightarrow> \<not> a islimpt UNIV"
+ using trivial_limit_within [of a UNIV]
+ by (simp add: within_UNIV)
+
+lemma trivial_limit_at:
+ fixes a :: "'a::perfect_space"
+ shows "\<not> trivial_limit (at a)"
+ by (simp add: trivial_limit_at_iff)
+
+lemma trivial_limit_at_infinity:
+ "\<not> trivial_limit (at_infinity :: ('a::{real_normed_vector,zero_neq_one}) net)"
+ (* FIXME: find a more appropriate type class *)
+ unfolding trivial_limit_def Rep_net_at_infinity
+ apply (clarsimp simp add: expand_set_eq)
+ apply (drule_tac x="scaleR r (sgn 1)" in spec)
+ apply (simp add: norm_sgn)
+ done
+
+lemma trivial_limit_sequentially: "\<not> trivial_limit sequentially"
+ by (auto simp add: trivial_limit_def Rep_net_sequentially)
+
+subsection{* Some property holds "sufficiently close" to the limit point. *}
+
+lemma eventually_at: (* FIXME: this replaces Limits.eventually_at *)
+ "eventually P (at a) \<longleftrightarrow> (\<exists>d>0. \<forall>x. 0 < dist x a \<and> dist x a < d \<longrightarrow> P x)"
+unfolding eventually_at dist_nz by auto
+
+lemma eventually_at_infinity:
+ "eventually P at_infinity \<longleftrightarrow> (\<exists>b. \<forall>x. norm x >= b \<longrightarrow> P x)"
+unfolding eventually_def Rep_net_at_infinity by auto
+
+lemma eventually_within: "eventually P (at a within S) \<longleftrightarrow>
+ (\<exists>d>0. \<forall>x\<in>S. 0 < dist x a \<and> dist x a < d \<longrightarrow> P x)"
+unfolding eventually_within eventually_at dist_nz by auto
+
+lemma eventually_within_le: "eventually P (at a within S) \<longleftrightarrow>
+ (\<exists>d>0. \<forall>x\<in>S. 0 < dist x a \<and> dist x a <= d \<longrightarrow> P x)" (is "?lhs = ?rhs")
+unfolding eventually_within
+apply safe
+apply (rule_tac x="d/2" in exI, simp)
+apply (rule_tac x="d" in exI, simp)
+done
+
+lemma eventually_happens: "eventually P net ==> trivial_limit net \<or> (\<exists>x. P x)"
+ unfolding eventually_def trivial_limit_def
+ using Rep_net_nonempty [of net] by auto
+
+lemma always_eventually: "(\<forall>x. P x) ==> eventually P net"
+ unfolding eventually_def trivial_limit_def
+ using Rep_net_nonempty [of net] by auto
+
+lemma trivial_limit_eventually: "trivial_limit net \<Longrightarrow> eventually P net"
+ unfolding trivial_limit_def eventually_def by auto
+
+lemma eventually_False: "eventually (\<lambda>x. False) net \<longleftrightarrow> trivial_limit net"
+ unfolding trivial_limit_def eventually_def by auto
+
+lemma trivial_limit_eq: "trivial_limit net \<longleftrightarrow> (\<forall>P. eventually P net)"
+ apply (safe elim!: trivial_limit_eventually)
+ apply (simp add: eventually_False [symmetric])
+ done
+
+text{* Combining theorems for "eventually" *}
+
+lemma eventually_conjI:
+ "\<lbrakk>eventually (\<lambda>x. P x) net; eventually (\<lambda>x. Q x) net\<rbrakk>
+ \<Longrightarrow> eventually (\<lambda>x. P x \<and> Q x) net"
+by (rule eventually_conj)
+
+lemma eventually_rev_mono:
+ "eventually P net \<Longrightarrow> (\<forall>x. P x \<longrightarrow> Q x) \<Longrightarrow> eventually Q net"
+using eventually_mono [of P Q] by fast
+
+lemma eventually_and: " eventually (\<lambda>x. P x \<and> Q x) net \<longleftrightarrow> eventually P net \<and> eventually Q net"
+ by (auto intro!: eventually_conjI elim: eventually_rev_mono)
+
+lemma eventually_false: "eventually (\<lambda>x. False) net \<longleftrightarrow> trivial_limit net"
+ by (auto simp add: eventually_False)
+
+lemma not_eventually: "(\<forall>x. \<not> P x ) \<Longrightarrow> ~(trivial_limit net) ==> ~(eventually (\<lambda>x. P x) net)"
+ by (simp add: eventually_False)
+
+subsection{* Limits, defined as vacuously true when the limit is trivial. *}
+
+ text{* Notation Lim to avoid collition with lim defined in analysis *}
+definition
+ Lim :: "'a net \<Rightarrow> ('a \<Rightarrow> 'b::t2_space) \<Rightarrow> 'b" where
+ "Lim net f = (THE l. (f ---> l) net)"
+
+lemma Lim:
+ "(f ---> l) net \<longleftrightarrow>
+ trivial_limit net \<or>
+ (\<forall>e>0. eventually (\<lambda>x. dist (f x) l < e) net)"
+ unfolding tendsto_iff trivial_limit_eq by auto
+
+
+text{* Show that they yield usual definitions in the various cases. *}
+
+lemma Lim_within_le: "(f ---> l)(at a within S) \<longleftrightarrow>
+ (\<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)"
+ by (auto simp add: tendsto_iff eventually_within_le)
+
+lemma Lim_within: "(f ---> l) (at a within S) \<longleftrightarrow>
+ (\<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)"
+ by (auto simp add: tendsto_iff eventually_within)
+
+lemma Lim_at: "(f ---> l) (at a) \<longleftrightarrow>
+ (\<forall>e >0. \<exists>d>0. \<forall>x. 0 < dist x a \<and> dist x a < d \<longrightarrow> dist (f x) l < e)"
+ by (auto simp add: tendsto_iff eventually_at)
+
+lemma Lim_at_iff_LIM: "(f ---> l) (at a) \<longleftrightarrow> f -- a --> l"
+ unfolding Lim_at LIM_def by (simp only: zero_less_dist_iff)
+
+lemma Lim_at_infinity:
+ "(f ---> l) at_infinity \<longleftrightarrow> (\<forall>e>0. \<exists>b. \<forall>x. norm x >= b \<longrightarrow> dist (f x) l < e)"
+ by (auto simp add: tendsto_iff eventually_at_infinity)
+
+lemma Lim_sequentially:
+ "(S ---> l) sequentially \<longleftrightarrow>
+ (\<forall>e>0. \<exists>N. \<forall>n\<ge>N. dist (S n) l < e)"
+ by (auto simp add: tendsto_iff eventually_sequentially)
+
+lemma Lim_sequentially_iff_LIMSEQ: "(S ---> l) sequentially \<longleftrightarrow> S ----> l"
+ unfolding Lim_sequentially LIMSEQ_def ..
+
+lemma Lim_eventually: "eventually (\<lambda>x. f x = l) net \<Longrightarrow> (f ---> l) net"
+ by (rule topological_tendstoI, auto elim: eventually_rev_mono)
+
+text{* The expected monotonicity property. *}
+
+lemma Lim_within_empty: "(f ---> l) (net within {})"
+ unfolding tendsto_def Limits.eventually_within by simp
+
+lemma Lim_within_subset: "(f ---> l) (net within S) \<Longrightarrow> T \<subseteq> S \<Longrightarrow> (f ---> l) (net within T)"
+ unfolding tendsto_def Limits.eventually_within
+ by (auto elim!: eventually_elim1)
+
+lemma Lim_Un: assumes "(f ---> l) (net within S)" "(f ---> l) (net within T)"
+ shows "(f ---> l) (net within (S \<union> T))"
+ using assms unfolding tendsto_def Limits.eventually_within
+ apply clarify
+ apply (drule spec, drule (1) mp, drule (1) mp)
+ apply (drule spec, drule (1) mp, drule (1) mp)
+ apply (auto elim: eventually_elim2)
+ done
+
+lemma Lim_Un_univ:
+ "(f ---> l) (net within S) \<Longrightarrow> (f ---> l) (net within T) \<Longrightarrow> S \<union> T = UNIV
+ ==> (f ---> l) net"
+ by (metis Lim_Un within_UNIV)
+
+text{* Interrelations between restricted and unrestricted limits. *}
+
+lemma Lim_at_within: "(f ---> l) net ==> (f ---> l)(net within S)"
+ (* FIXME: rename *)
+ unfolding tendsto_def Limits.eventually_within
+ apply (clarify, drule spec, drule (1) mp, drule (1) mp)
+ by (auto elim!: eventually_elim1)
+
+lemma Lim_within_open:
+ fixes f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
+ assumes"a \<in> S" "open S"
+ shows "(f ---> l)(at a within S) \<longleftrightarrow> (f ---> l)(at a)" (is "?lhs \<longleftrightarrow> ?rhs")
+proof
+ assume ?lhs
+ { fix A assume "open A" "l \<in> A"
+ with `?lhs` have "eventually (\<lambda>x. f x \<in> A) (at a within S)"
+ by (rule topological_tendstoD)
+ hence "eventually (\<lambda>x. x \<in> S \<longrightarrow> f x \<in> A) (at a)"
+ unfolding Limits.eventually_within .
+ 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"
+ unfolding eventually_at_topological by fast
+ hence "open (T \<inter> S)" "a \<in> T \<inter> S" "\<forall>x\<in>(T \<inter> S). x \<noteq> a \<longrightarrow> f x \<in> A"
+ using assms by auto
+ hence "\<exists>T. open T \<and> a \<in> T \<and> (\<forall>x\<in>T. x \<noteq> a \<longrightarrow> f x \<in> A)"
+ by fast
+ hence "eventually (\<lambda>x. f x \<in> A) (at a)"
+ unfolding eventually_at_topological .
+ }
+ thus ?rhs by (rule topological_tendstoI)
+next
+ assume ?rhs
+ thus ?lhs by (rule Lim_at_within)
+qed
+
+text{* Another limit point characterization. *}
+
+lemma islimpt_sequential:
+ fixes x :: "'a::metric_space" (* FIXME: generalize to topological_space *)
+ shows "x islimpt S \<longleftrightarrow> (\<exists>f. (\<forall>n::nat. f n \<in> S -{x}) \<and> (f ---> x) sequentially)"
+ (is "?lhs = ?rhs")
+proof
+ assume ?lhs
+ 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"
+ 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
+ { fix n::nat
+ have "f (inverse (real n + 1)) \<in> S - {x}" using f by auto
+ }
+ moreover
+ { fix e::real assume "e>0"
+ 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
+ then obtain N::nat where "inverse (real (N + 1)) < e" by auto
+ 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)
+ moreover have "\<forall>n\<ge>N. dist (f (inverse (real n + 1))) x < (inverse (real n + 1))" using f `e>0` by auto
+ 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
+ }
+ hence " ((\<lambda>n. f (inverse (real n + 1))) ---> x) sequentially"
+ unfolding Lim_sequentially using f by auto
+ ultimately show ?rhs apply (rule_tac x="(\<lambda>n::nat. f (inverse (real n + 1)))" in exI) by auto
+next
+ assume ?rhs
+ 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
+ { fix e::real assume "e>0"
+ then obtain N where "dist (f N) x < e" using f(2) by auto
+ moreover have "f N\<in>S" "f N \<noteq> x" using f(1) by auto
+ ultimately have "\<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e" by auto
+ }
+ thus ?lhs unfolding islimpt_approachable by auto
+qed
+
+text{* Basic arithmetical combining theorems for limits. *}
+
+lemma Lim_linear:
+ assumes "(f ---> l) net" "bounded_linear h"
+ shows "((\<lambda>x. h (f x)) ---> h l) net"
+using `bounded_linear h` `(f ---> l) net`
+by (rule bounded_linear.tendsto)
+
+lemma Lim_ident_at: "((\<lambda>x. x) ---> a) (at a)"
+ unfolding tendsto_def Limits.eventually_at_topological by fast
+
+lemma Lim_const: "((\<lambda>x. a) ---> a) net"
+ by (rule tendsto_const)
+
+lemma Lim_cmul:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ shows "(f ---> l) net ==> ((\<lambda>x. c *\<^sub>R f x) ---> c *\<^sub>R l) net"
+ by (intro tendsto_intros)
+
+lemma Lim_neg:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ shows "(f ---> l) net ==> ((\<lambda>x. -(f x)) ---> -l) net"
+ by (rule tendsto_minus)
+
+lemma Lim_add: fixes f :: "'a \<Rightarrow> 'b::real_normed_vector" shows
+ "(f ---> l) net \<Longrightarrow> (g ---> m) net \<Longrightarrow> ((\<lambda>x. f(x) + g(x)) ---> l + m) net"
+ by (rule tendsto_add)
+
+lemma Lim_sub:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ shows "(f ---> l) net \<Longrightarrow> (g ---> m) net \<Longrightarrow> ((\<lambda>x. f(x) - g(x)) ---> l - m) net"
+ by (rule tendsto_diff)
+
+lemma Lim_null:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ shows "(f ---> l) net \<longleftrightarrow> ((\<lambda>x. f(x) - l) ---> 0) net" by (simp add: Lim dist_norm)
+
+lemma Lim_null_norm:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ shows "(f ---> 0) net \<longleftrightarrow> ((\<lambda>x. norm(f x)) ---> 0) net"
+ by (simp add: Lim dist_norm)
+
+lemma Lim_null_comparison:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ assumes "eventually (\<lambda>x. norm (f x) \<le> g x) net" "(g ---> 0) net"
+ shows "(f ---> 0) net"
+proof(simp add: tendsto_iff, rule+)
+ fix e::real assume "0<e"
+ { fix x
+ assume "norm (f x) \<le> g x" "dist (g x) 0 < e"
+ hence "dist (f x) 0 < e" by (simp add: dist_norm)
+ }
+ thus "eventually (\<lambda>x. dist (f x) 0 < e) net"
+ using eventually_and[of "\<lambda>x. norm(f x) <= g x" "\<lambda>x. dist (g x) 0 < e" net]
+ 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]
+ using assms `e>0` unfolding tendsto_iff by auto
+qed
+
+lemma Lim_component:
+ fixes f :: "'a \<Rightarrow> 'b::metric_space ^ 'n::finite"
+ shows "(f ---> l) net \<Longrightarrow> ((\<lambda>a. f a $i) ---> l$i) net"
+ unfolding tendsto_iff
+ apply (clarify)
+ apply (drule spec, drule (1) mp)
+ apply (erule eventually_elim1)
+ apply (erule le_less_trans [OF dist_nth_le])
+ done
+
+lemma Lim_transform_bound:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ fixes g :: "'a \<Rightarrow> 'c::real_normed_vector"
+ assumes "eventually (\<lambda>n. norm(f n) <= norm(g n)) net" "(g ---> 0) net"
+ shows "(f ---> 0) net"
+proof (rule tendstoI)
+ fix e::real assume "e>0"
+ { fix x
+ assume "norm (f x) \<le> norm (g x)" "dist (g x) 0 < e"
+ hence "dist (f x) 0 < e" by (simp add: dist_norm)}
+ thus "eventually (\<lambda>x. dist (f x) 0 < e) net"
+ using eventually_and[of "\<lambda>x. norm (f x) \<le> norm (g x)" "\<lambda>x. dist (g x) 0 < e" net]
+ 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]
+ using assms `e>0` unfolding tendsto_iff by blast
+qed
+
+text{* Deducing things about the limit from the elements. *}
+
+lemma Lim_in_closed_set:
+ assumes "closed S" "eventually (\<lambda>x. f(x) \<in> S) net" "\<not>(trivial_limit net)" "(f ---> l) net"
+ shows "l \<in> S"
+proof (rule ccontr)
+ assume "l \<notin> S"
+ with `closed S` have "open (- S)" "l \<in> - S"
+ by (simp_all add: open_Compl)
+ with assms(4) have "eventually (\<lambda>x. f x \<in> - S) net"
+ by (rule topological_tendstoD)
+ with assms(2) have "eventually (\<lambda>x. False) net"
+ by (rule eventually_elim2) simp
+ with assms(3) show "False"
+ by (simp add: eventually_False)
+qed
+
+text{* Need to prove closed(cball(x,e)) before deducing this as a corollary. *}
+
+lemma Lim_dist_ubound:
+ assumes "\<not>(trivial_limit net)" "(f ---> l) net" "eventually (\<lambda>x. dist a (f x) <= e) net"
+ shows "dist a l <= e"
+proof (rule ccontr)
+ assume "\<not> dist a l \<le> e"
+ then have "0 < dist a l - e" by simp
+ with assms(2) have "eventually (\<lambda>x. dist (f x) l < dist a l - e) net"
+ by (rule tendstoD)
+ with assms(3) have "eventually (\<lambda>x. dist a (f x) \<le> e \<and> dist (f x) l < dist a l - e) net"
+ by (rule eventually_conjI)
+ then obtain w where "dist a (f w) \<le> e" "dist (f w) l < dist a l - e"
+ using assms(1) eventually_happens by auto
+ hence "dist a (f w) + dist (f w) l < e + (dist a l - e)"
+ by (rule add_le_less_mono)
+ hence "dist a (f w) + dist (f w) l < dist a l"
+ by simp
+ also have "\<dots> \<le> dist a (f w) + dist (f w) l"
+ by (rule dist_triangle)
+ finally show False by simp
+qed
+
+lemma Lim_norm_ubound:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ assumes "\<not>(trivial_limit net)" "(f ---> l) net" "eventually (\<lambda>x. norm(f x) <= e) net"
+ shows "norm(l) <= e"
+proof (rule ccontr)
+ assume "\<not> norm l \<le> e"
+ then have "0 < norm l - e" by simp
+ with assms(2) have "eventually (\<lambda>x. dist (f x) l < norm l - e) net"
+ by (rule tendstoD)
+ with assms(3) have "eventually (\<lambda>x. norm (f x) \<le> e \<and> dist (f x) l < norm l - e) net"
+ by (rule eventually_conjI)
+ then obtain w where "norm (f w) \<le> e" "dist (f w) l < norm l - e"
+ using assms(1) eventually_happens by auto
+ hence "norm (f w - l) < norm l - e" "norm (f w) \<le> e" by (simp_all add: dist_norm)
+ hence "norm (f w - l) + norm (f w) < norm l" by simp
+ hence "norm (f w - l - f w) < norm l" by (rule le_less_trans [OF norm_triangle_ineq4])
+ thus False using `\<not> norm l \<le> e` by simp
+qed
+
+lemma Lim_norm_lbound:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ assumes "\<not> (trivial_limit net)" "(f ---> l) net" "eventually (\<lambda>x. e <= norm(f x)) net"
+ shows "e \<le> norm l"
+proof (rule ccontr)
+ assume "\<not> e \<le> norm l"
+ then have "0 < e - norm l" by simp
+ with assms(2) have "eventually (\<lambda>x. dist (f x) l < e - norm l) net"
+ by (rule tendstoD)
+ with assms(3) have "eventually (\<lambda>x. e \<le> norm (f x) \<and> dist (f x) l < e - norm l) net"
+ by (rule eventually_conjI)
+ then obtain w where "e \<le> norm (f w)" "dist (f w) l < e - norm l"
+ using assms(1) eventually_happens by auto
+ hence "norm (f w - l) + norm l < e" "e \<le> norm (f w)" by (simp_all add: dist_norm)
+ hence "norm (f w - l) + norm l < norm (f w)" by (rule less_le_trans)
+ hence "norm (f w - l + l) < norm (f w)" by (rule le_less_trans [OF norm_triangle_ineq])
+ thus False by simp
+qed
+
+text{* Uniqueness of the limit, when nontrivial. *}
+
+lemma Lim_unique:
+ fixes f :: "'a \<Rightarrow> 'b::t2_space"
+ assumes "\<not> trivial_limit net" "(f ---> l) net" "(f ---> l') net"
+ shows "l = l'"
+proof (rule ccontr)
+ assume "l \<noteq> l'"
+ obtain U V where "open U" "open V" "l \<in> U" "l' \<in> V" "U \<inter> V = {}"
+ using hausdorff [OF `l \<noteq> l'`] by fast
+ have "eventually (\<lambda>x. f x \<in> U) net"
+ using `(f ---> l) net` `open U` `l \<in> U` by (rule topological_tendstoD)
+ moreover
+ have "eventually (\<lambda>x. f x \<in> V) net"
+ using `(f ---> l') net` `open V` `l' \<in> V` by (rule topological_tendstoD)
+ ultimately
+ have "eventually (\<lambda>x. False) net"
+ proof (rule eventually_elim2)
+ fix x
+ assume "f x \<in> U" "f x \<in> V"
+ hence "f x \<in> U \<inter> V" by simp
+ with `U \<inter> V = {}` show "False" by simp
+ qed
+ with `\<not> trivial_limit net` show "False"
+ by (simp add: eventually_False)
+qed
+
+lemma tendsto_Lim:
+ fixes f :: "'a \<Rightarrow> 'b::t2_space"
+ shows "~(trivial_limit net) \<Longrightarrow> (f ---> l) net ==> Lim net f = l"
+ unfolding Lim_def using Lim_unique[of net f] by auto
+
+text{* Limit under bilinear function *}
+
+lemma Lim_bilinear:
+ assumes "(f ---> l) net" and "(g ---> m) net" and "bounded_bilinear h"
+ shows "((\<lambda>x. h (f x) (g x)) ---> (h l m)) net"
+using `bounded_bilinear h` `(f ---> l) net` `(g ---> m) net`
+by (rule bounded_bilinear.tendsto)
+
+text{* These are special for limits out of the same vector space. *}
+
+lemma Lim_within_id: "(id ---> a) (at a within s)"
+ unfolding tendsto_def Limits.eventually_within eventually_at_topological
+ by auto
+
+lemma Lim_at_id: "(id ---> a) (at a)"
+apply (subst within_UNIV[symmetric]) by (simp add: Lim_within_id)
+
+lemma Lim_at_zero:
+ fixes a :: "'a::real_normed_vector"
+ fixes l :: "'b::topological_space"
+ shows "(f ---> l) (at a) \<longleftrightarrow> ((\<lambda>x. f(a + x)) ---> l) (at 0)" (is "?lhs = ?rhs")
+proof
+ assume "?lhs"
+ { fix S assume "open S" "l \<in> S"
+ with `?lhs` have "eventually (\<lambda>x. f x \<in> S) (at a)"
+ by (rule topological_tendstoD)
+ then obtain d where d: "d>0" "\<forall>x. x \<noteq> a \<and> dist x a < d \<longrightarrow> f x \<in> S"
+ unfolding Limits.eventually_at by fast
+ { fix x::"'a" assume "x \<noteq> 0 \<and> dist x 0 < d"
+ hence "f (a + x) \<in> S" using d
+ apply(erule_tac x="x+a" in allE)
+ by(auto simp add: comm_monoid_add.mult_commute dist_norm dist_commute)
+ }
+ hence "\<exists>d>0. \<forall>x. x \<noteq> 0 \<and> dist x 0 < d \<longrightarrow> f (a + x) \<in> S"
+ using d(1) by auto
+ hence "eventually (\<lambda>x. f (a + x) \<in> S) (at 0)"
+ unfolding Limits.eventually_at .
+ }
+ thus "?rhs" by (rule topological_tendstoI)
+next
+ assume "?rhs"
+ { fix S assume "open S" "l \<in> S"
+ with `?rhs` have "eventually (\<lambda>x. f (a + x) \<in> S) (at 0)"
+ by (rule topological_tendstoD)
+ then obtain d where d: "d>0" "\<forall>x. x \<noteq> 0 \<and> dist x 0 < d \<longrightarrow> f (a + x) \<in> S"
+ unfolding Limits.eventually_at by fast
+ { fix x::"'a" assume "x \<noteq> a \<and> dist x a < d"
+ hence "f x \<in> S" using d apply(erule_tac x="x-a" in allE)
+ by(auto simp add: comm_monoid_add.mult_commute dist_norm dist_commute)
+ }
+ hence "\<exists>d>0. \<forall>x. x \<noteq> a \<and> dist x a < d \<longrightarrow> f x \<in> S" using d(1) by auto
+ hence "eventually (\<lambda>x. f x \<in> S) (at a)" unfolding Limits.eventually_at .
+ }
+ thus "?lhs" by (rule topological_tendstoI)
+qed
+
+text{* It's also sometimes useful to extract the limit point from the net. *}
+
+definition
+ netlimit :: "'a::t2_space net \<Rightarrow> 'a" where
+ "netlimit net = (SOME a. ((\<lambda>x. x) ---> a) net)"
+
+lemma netlimit_within:
+ assumes "\<not> trivial_limit (at a within S)"
+ shows "netlimit (at a within S) = a"
+unfolding netlimit_def
+apply (rule some_equality)
+apply (rule Lim_at_within)
+apply (rule Lim_ident_at)
+apply (erule Lim_unique [OF assms])
+apply (rule Lim_at_within)
+apply (rule Lim_ident_at)
+done
+
+lemma netlimit_at:
+ fixes a :: "'a::perfect_space"
+ shows "netlimit (at a) = a"
+ apply (subst within_UNIV[symmetric])
+ using netlimit_within[of a UNIV]
+ by (simp add: trivial_limit_at within_UNIV)
+
+text{* Transformation of limit. *}
+
+lemma Lim_transform:
+ fixes f g :: "'a::type \<Rightarrow> 'b::real_normed_vector"
+ assumes "((\<lambda>x. f x - g x) ---> 0) net" "(f ---> l) net"
+ shows "(g ---> l) net"
+proof-
+ 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
+ thus "?thesis" using Lim_neg [of "\<lambda> x. - g x" "-l" net] by auto
+qed
+
+lemma Lim_transform_eventually:
+ "eventually (\<lambda>x. f x = g x) net \<Longrightarrow> (f ---> l) net ==> (g ---> l) net"
+ apply (rule topological_tendstoI)
+ apply (drule (2) topological_tendstoD)
+ apply (erule (1) eventually_elim2, simp)
+ done
+
+lemma Lim_transform_within:
+ fixes l :: "'b::metric_space" (* TODO: generalize *)
+ assumes "0 < d" "(\<forall>x'\<in>S. 0 < dist x' x \<and> dist x' x < d \<longrightarrow> f x' = g x')"
+ "(f ---> l) (at x within S)"
+ shows "(g ---> l) (at x within S)"
+ using assms(1,3) unfolding Lim_within
+ apply -
+ apply (clarify, rename_tac e)
+ apply (drule_tac x=e in spec, clarsimp, rename_tac r)
+ apply (rule_tac x="min d r" in exI, clarsimp, rename_tac y)
+ apply (drule_tac x=y in bspec, assumption, clarsimp)
+ apply (simp add: assms(2))
+ done
+
+lemma Lim_transform_at:
+ fixes l :: "'b::metric_space" (* TODO: generalize *)
+ shows "0 < d \<Longrightarrow> (\<forall>x'. 0 < dist x' x \<and> dist x' x < d \<longrightarrow> f x' = g x') \<Longrightarrow>
+ (f ---> l) (at x) ==> (g ---> l) (at x)"
+ apply (subst within_UNIV[symmetric])
+ using Lim_transform_within[of d UNIV x f g l]
+ by (auto simp add: within_UNIV)
+
+text{* Common case assuming being away from some crucial point like 0. *}
+
+lemma Lim_transform_away_within:
+ fixes a b :: "'a::metric_space"
+ fixes l :: "'b::metric_space" (* TODO: generalize *)
+ assumes "a\<noteq>b" "\<forall>x\<in> S. x \<noteq> a \<and> x \<noteq> b \<longrightarrow> f x = g x"
+ and "(f ---> l) (at a within S)"
+ shows "(g ---> l) (at a within S)"
+proof-
+ have "\<forall>x'\<in>S. 0 < dist x' a \<and> dist x' a < dist a b \<longrightarrow> f x' = g x'" using assms(2)
+ apply auto apply(erule_tac x=x' in ballE) by (auto simp add: dist_commute)
+ thus ?thesis using Lim_transform_within[of "dist a b" S a f g l] using assms(1,3) unfolding dist_nz by auto
+qed
+
+lemma Lim_transform_away_at:
+ fixes a b :: "'a::metric_space"
+ fixes l :: "'b::metric_space" (* TODO: generalize *)
+ assumes ab: "a\<noteq>b" and fg: "\<forall>x. x \<noteq> a \<and> x \<noteq> b \<longrightarrow> f x = g x"
+ and fl: "(f ---> l) (at a)"
+ shows "(g ---> l) (at a)"
+ using Lim_transform_away_within[OF ab, of UNIV f g l] fg fl
+ by (auto simp add: within_UNIV)
+
+text{* Alternatively, within an open set. *}
+
+lemma Lim_transform_within_open:
+ fixes a :: "'a::metric_space"
+ fixes l :: "'b::metric_space" (* TODO: generalize *)
+ assumes "open S" "a \<in> S" "\<forall>x\<in>S. x \<noteq> a \<longrightarrow> f x = g x" "(f ---> l) (at a)"
+ shows "(g ---> l) (at a)"
+proof-
+ from assms(1,2) obtain e::real where "e>0" and e:"ball a e \<subseteq> S" unfolding open_contains_ball by auto
+ hence "\<forall>x'. 0 < dist x' a \<and> dist x' a < e \<longrightarrow> f x' = g x'" using assms(3)
+ 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)
+ thus ?thesis using Lim_transform_at[of e a f g l] `e>0` assms(4) by auto
+qed
+
+text{* A congruence rule allowing us to transform limits assuming not at point. *}
+
+(* FIXME: Only one congruence rule for tendsto can be used at a time! *)
+
+lemma Lim_cong_within[cong add]:
+ fixes a :: "'a::metric_space"
+ fixes l :: "'b::metric_space" (* TODO: generalize *)
+ 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))"
+ by (simp add: Lim_within dist_nz[symmetric])
+
+lemma Lim_cong_at[cong add]:
+ fixes a :: "'a::metric_space"
+ fixes l :: "'b::metric_space" (* TODO: generalize *)
+ shows "(\<And>x. x \<noteq> a ==> f x = g x) ==> (((\<lambda>x. f x) ---> l) (at a) \<longleftrightarrow> ((g ---> l) (at a)))"
+ by (simp add: Lim_at dist_nz[symmetric])
+
+text{* Useful lemmas on closure and set of possible sequential limits.*}
+
+lemma closure_sequential:
+ fixes l :: "'a::metric_space" (* TODO: generalize *)
+ shows "l \<in> closure S \<longleftrightarrow> (\<exists>x. (\<forall>n. x n \<in> S) \<and> (x ---> l) sequentially)" (is "?lhs = ?rhs")
+proof
+ assume "?lhs" moreover
+ { assume "l \<in> S"
+ hence "?rhs" using Lim_const[of l sequentially] by auto
+ } moreover
+ { assume "l islimpt S"
+ hence "?rhs" unfolding islimpt_sequential by auto
+ } ultimately
+ show "?rhs" unfolding closure_def by auto
+next
+ assume "?rhs"
+ thus "?lhs" unfolding closure_def unfolding islimpt_sequential by auto
+qed
+
+lemma closed_sequential_limits:
+ fixes S :: "'a::metric_space set"
+ shows "closed S \<longleftrightarrow> (\<forall>x l. (\<forall>n. x n \<in> S) \<and> (x ---> l) sequentially \<longrightarrow> l \<in> S)"
+ unfolding closed_limpt
+ 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]
+ by metis
+
+lemma closure_approachable:
+ fixes S :: "'a::metric_space set"
+ shows "x \<in> closure S \<longleftrightarrow> (\<forall>e>0. \<exists>y\<in>S. dist y x < e)"
+ apply (auto simp add: closure_def islimpt_approachable)
+ by (metis dist_self)
+
+lemma closed_approachable:
+ fixes S :: "'a::metric_space set"
+ shows "closed S ==> (\<forall>e>0. \<exists>y\<in>S. dist y x < e) \<longleftrightarrow> x \<in> S"
+ by (metis closure_closed closure_approachable)
+
+text{* Some other lemmas about sequences. *}
+
+lemma seq_offset:
+ fixes l :: "'a::metric_space" (* TODO: generalize *)
+ shows "(f ---> l) sequentially ==> ((\<lambda>i. f( i + k)) ---> l) sequentially"
+ apply (auto simp add: Lim_sequentially)
+ by (metis trans_le_add1 )
+
+lemma seq_offset_neg:
+ "(f ---> l) sequentially ==> ((\<lambda>i. f(i - k)) ---> l) sequentially"
+ apply (rule topological_tendstoI)
+ apply (drule (2) topological_tendstoD)
+ apply (simp only: eventually_sequentially)
+ apply (subgoal_tac "\<And>N k (n::nat). N + k <= n ==> N <= n - k")
+ apply metis
+ by arith
+
+lemma seq_offset_rev:
+ "((\<lambda>i. f(i + k)) ---> l) sequentially ==> (f ---> l) sequentially"
+ apply (rule topological_tendstoI)
+ apply (drule (2) topological_tendstoD)
+ apply (simp only: eventually_sequentially)
+ apply (subgoal_tac "\<And>N k (n::nat). N + k <= n ==> N <= n - k \<and> (n - k) + k = n")
+ by metis arith
+
+lemma seq_harmonic: "((\<lambda>n. inverse (real n)) ---> 0) sequentially"
+proof-
+ { fix e::real assume "e>0"
+ hence "\<exists>N::nat. \<forall>n::nat\<ge>N. inverse (real n) < e"
+ using real_arch_inv[of e] apply auto apply(rule_tac x=n in exI)
+ by (metis not_le le_imp_inverse_le not_less real_of_nat_gt_zero_cancel_iff real_of_nat_less_iff xt1(7))
+ }
+ thus ?thesis unfolding Lim_sequentially dist_norm by simp
+qed
+
+text{* More properties of closed balls. *}
+
+lemma closed_cball: "closed (cball x e)"
+unfolding cball_def closed_def
+unfolding Collect_neg_eq [symmetric] not_le
+apply (clarsimp simp add: open_dist, rename_tac y)
+apply (rule_tac x="dist x y - e" in exI, clarsimp)
+apply (rename_tac x')
+apply (cut_tac x=x and y=x' and z=y in dist_triangle)
+apply simp
+done
+
+lemma open_contains_cball: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. cball x e \<subseteq> S)"
+proof-
+ { fix x and e::real assume "x\<in>S" "e>0" "ball x e \<subseteq> S"
+ hence "\<exists>d>0. cball x d \<subseteq> S" unfolding subset_eq by (rule_tac x="e/2" in exI, auto)
+ } moreover
+ { fix x and e::real assume "x\<in>S" "e>0" "cball x e \<subseteq> S"
+ hence "\<exists>d>0. ball x d \<subseteq> S" unfolding subset_eq apply(rule_tac x="e/2" in exI) by auto
+ } ultimately
+ show ?thesis unfolding open_contains_ball by auto
+qed
+
+lemma open_contains_cball_eq: "open S ==> (\<forall>x. x \<in> S \<longleftrightarrow> (\<exists>e>0. cball x e \<subseteq> S))"
+ by (metis open_contains_cball subset_eq order_less_imp_le centre_in_cball mem_def)
+
+lemma mem_interior_cball: "x \<in> interior S \<longleftrightarrow> (\<exists>e>0. cball x e \<subseteq> S)"
+ apply (simp add: interior_def, safe)
+ apply (force simp add: open_contains_cball)
+ apply (rule_tac x="ball x e" in exI)
+ apply (simp add: open_ball centre_in_ball subset_trans [OF ball_subset_cball])
+ done
+
+lemma islimpt_ball:
+ fixes x y :: "'a::{real_normed_vector,perfect_space}"
+ shows "y islimpt ball x e \<longleftrightarrow> 0 < e \<and> y \<in> cball x e" (is "?lhs = ?rhs")
+proof
+ assume "?lhs"
+ { assume "e \<le> 0"
+ hence *:"ball x e = {}" using ball_eq_empty[of x e] by auto
+ have False using `?lhs` unfolding * using islimpt_EMPTY[of y] by auto
+ }
+ hence "e > 0" by (metis not_less)
+ moreover
+ 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
+ ultimately show "?rhs" by auto
+next
+ assume "?rhs" hence "e>0" by auto
+ { fix d::real assume "d>0"
+ have "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
+ proof(cases "d \<le> dist x y")
+ case True thus "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
+ proof(cases "x=y")
+ case True hence False using `d \<le> dist x y` `d>0` by auto
+ thus "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d" by auto
+ next
+ case False
+
+ have "dist x (y - (d / (2 * dist y x)) *\<^sub>R (y - x))
+ = norm (x - y + (d / (2 * norm (y - x))) *\<^sub>R (y - x))"
+ unfolding mem_cball mem_ball dist_norm diff_diff_eq2 diff_add_eq[THEN sym] by auto
+ also have "\<dots> = \<bar>- 1 + d / (2 * norm (x - y))\<bar> * norm (x - y)"
+ using scaleR_left_distrib[of "- 1" "d / (2 * norm (y - x))", THEN sym, of "y - x"]
+ unfolding scaleR_minus_left scaleR_one
+ by (auto simp add: norm_minus_commute)
+ also have "\<dots> = \<bar>- norm (x - y) + d / 2\<bar>"
+ unfolding abs_mult_pos[of "norm (x - y)", OF norm_ge_zero[of "x - y"]]
+ unfolding real_add_mult_distrib using `x\<noteq>y`[unfolded dist_nz, unfolded dist_norm] by auto
+ also have "\<dots> \<le> e - d/2" using `d \<le> dist x y` and `d>0` and `?rhs` by(auto simp add: dist_norm)
+ finally have "y - (d / (2 * dist y x)) *\<^sub>R (y - x) \<in> ball x e" using `d>0` by auto
+
+ moreover
+
+ have "(d / (2*dist y x)) *\<^sub>R (y - x) \<noteq> 0"
+ using `x\<noteq>y`[unfolded dist_nz] `d>0` unfolding scaleR_eq_0_iff by (auto simp add: dist_commute)
+ moreover
+ have "dist (y - (d / (2 * dist y x)) *\<^sub>R (y - x)) y < d" unfolding dist_norm apply simp unfolding norm_minus_cancel
+ using `d>0` `x\<noteq>y`[unfolded dist_nz] dist_commute[of x y]
+ unfolding dist_norm by auto
+ 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
+ qed
+ next
+ case False hence "d > dist x y" by auto
+ show "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
+ proof(cases "x=y")
+ case True
+ obtain z where **: "z \<noteq> y" "dist z y < min e d"
+ using perfect_choose_dist[of "min e d" y]
+ using `d > 0` `e>0` by auto
+ show "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
+ unfolding `x = y`
+ using `z \<noteq> y` **
+ by (rule_tac x=z in bexI, auto simp add: dist_commute)
+ next
+ case False thus "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
+ using `d>0` `d > dist x y` `?rhs` by(rule_tac x=x in bexI, auto)
+ qed
+ qed }
+ thus "?lhs" unfolding mem_cball islimpt_approachable mem_ball by auto
+qed
+
+lemma closure_ball_lemma:
+ fixes x y :: "'a::real_normed_vector"
+ assumes "x \<noteq> y" shows "y islimpt ball x (dist x y)"
+proof (rule islimptI)
+ fix T assume "y \<in> T" "open T"
+ then obtain r where "0 < r" "\<forall>z. dist z y < r \<longrightarrow> z \<in> T"
+ unfolding open_dist by fast
+ (* choose point between x and y, within distance r of y. *)
+ def k \<equiv> "min 1 (r / (2 * dist x y))"
+ def z \<equiv> "y + scaleR k (x - y)"
+ have z_def2: "z = x + scaleR (1 - k) (y - x)"
+ unfolding z_def by (simp add: algebra_simps)
+ have "dist z y < r"
+ unfolding z_def k_def using `0 < r`
+ by (simp add: dist_norm min_def)
+ hence "z \<in> T" using `\<forall>z. dist z y < r \<longrightarrow> z \<in> T` by simp
+ have "dist x z < dist x y"
+ unfolding z_def2 dist_norm
+ apply (simp add: norm_minus_commute)
+ apply (simp only: dist_norm [symmetric])
+ apply (subgoal_tac "\<bar>1 - k\<bar> * dist x y < 1 * dist x y", simp)
+ apply (rule mult_strict_right_mono)
+ apply (simp add: k_def divide_pos_pos zero_less_dist_iff `0 < r` `x \<noteq> y`)
+ apply (simp add: zero_less_dist_iff `x \<noteq> y`)
+ done
+ hence "z \<in> ball x (dist x y)" by simp
+ have "z \<noteq> y"
+ unfolding z_def k_def using `x \<noteq> y` `0 < r`
+ by (simp add: min_def)
+ show "\<exists>z\<in>ball x (dist x y). z \<in> T \<and> z \<noteq> y"
+ using `z \<in> ball x (dist x y)` `z \<in> T` `z \<noteq> y`
+ by fast
+qed
+
+lemma closure_ball:
+ fixes x :: "'a::real_normed_vector"
+ shows "0 < e \<Longrightarrow> closure (ball x e) = cball x e"
+apply (rule equalityI)
+apply (rule closure_minimal)
+apply (rule ball_subset_cball)
+apply (rule closed_cball)
+apply (rule subsetI, rename_tac y)
+apply (simp add: le_less [where 'a=real])
+apply (erule disjE)
+apply (rule subsetD [OF closure_subset], simp)
+apply (simp add: closure_def)
+apply clarify
+apply (rule closure_ball_lemma)
+apply (simp add: zero_less_dist_iff)
+done
+
+(* In a trivial vector space, this fails for e = 0. *)
+lemma interior_cball:
+ fixes x :: "'a::{real_normed_vector, perfect_space}"
+ shows "interior (cball x e) = ball x e"
+proof(cases "e\<ge>0")
+ case False note cs = this
+ from cs have "ball x e = {}" using ball_empty[of e x] by auto moreover
+ { fix y assume "y \<in> cball x e"
+ hence False unfolding mem_cball using dist_nz[of x y] cs by auto }
+ hence "cball x e = {}" by auto
+ hence "interior (cball x e) = {}" using interior_empty by auto
+ ultimately show ?thesis by blast
+next
+ case True note cs = this
+ have "ball x e \<subseteq> cball x e" using ball_subset_cball by auto moreover
+ { fix S y assume as: "S \<subseteq> cball x e" "open S" "y\<in>S"
+ then obtain d where "d>0" and d:"\<forall>x'. dist x' y < d \<longrightarrow> x' \<in> S" unfolding open_dist by blast
+
+ then obtain xa where xa_y: "xa \<noteq> y" and xa: "dist xa y < d"
+ using perfect_choose_dist [of d] by auto
+ have "xa\<in>S" using d[THEN spec[where x=xa]] using xa by(auto simp add: dist_commute)
+ hence xa_cball:"xa \<in> cball x e" using as(1) by auto
+
+ hence "y \<in> ball x e" proof(cases "x = y")
+ case True
+ hence "e>0" using xa_y[unfolded dist_nz] xa_cball[unfolded mem_cball] by (auto simp add: dist_commute)
+ thus "y \<in> ball x e" using `x = y ` by simp
+ next
+ case False
+ have "dist (y + (d / 2 / dist y x) *\<^sub>R (y - x)) y < d" unfolding dist_norm
+ using `d>0` norm_ge_zero[of "y - x"] `x \<noteq> y` by auto
+ hence *:"y + (d / 2 / dist y x) *\<^sub>R (y - x) \<in> cball x e" using d as(1)[unfolded subset_eq] by blast
+ have "y - x \<noteq> 0" using `x \<noteq> y` by auto
+ hence **:"d / (2 * norm (y - x)) > 0" unfolding zero_less_norm_iff[THEN sym]
+ using `d>0` divide_pos_pos[of d "2*norm (y - x)"] by auto
+
+ 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)"
+ by (auto simp add: dist_norm algebra_simps)
+ also have "\<dots> = norm ((1 + d / (2 * norm (y - x))) *\<^sub>R (y - x))"
+ by (auto simp add: algebra_simps)
+ also have "\<dots> = \<bar>1 + d / (2 * norm (y - x))\<bar> * norm (y - x)"
+ using ** by auto
+ also have "\<dots> = (dist y x) + d/2"using ** by (auto simp add: left_distrib dist_norm)
+ finally have "e \<ge> dist x y +d/2" using *[unfolded mem_cball] by (auto simp add: dist_commute)
+ thus "y \<in> ball x e" unfolding mem_ball using `d>0` by auto
+ qed }
+ hence "\<forall>S \<subseteq> cball x e. open S \<longrightarrow> S \<subseteq> ball x e" by auto
+ ultimately show ?thesis using interior_unique[of "ball x e" "cball x e"] using open_ball[of x e] by auto
+qed
+
+lemma frontier_ball:
+ fixes a :: "'a::real_normed_vector"
+ shows "0 < e ==> frontier(ball a e) = {x. dist a x = e}"
+ apply (simp add: frontier_def closure_ball interior_open open_ball order_less_imp_le)
+ apply (simp add: expand_set_eq)
+ by arith
+
+lemma frontier_cball:
+ fixes a :: "'a::{real_normed_vector, perfect_space}"
+ shows "frontier(cball a e) = {x. dist a x = e}"
+ apply (simp add: frontier_def interior_cball closed_cball closure_closed order_less_imp_le)
+ apply (simp add: expand_set_eq)
+ by arith
+
+lemma cball_eq_empty: "(cball x e = {}) \<longleftrightarrow> e < 0"
+ apply (simp add: expand_set_eq not_le)
+ by (metis zero_le_dist dist_self order_less_le_trans)
+lemma cball_empty: "e < 0 ==> cball x e = {}" by (simp add: cball_eq_empty)
+
+lemma cball_eq_sing:
+ fixes x :: "'a::perfect_space"
+ shows "(cball x e = {x}) \<longleftrightarrow> e = 0"
+proof (rule linorder_cases)
+ assume e: "0 < e"
+ obtain a where "a \<noteq> x" "dist a x < e"
+ using perfect_choose_dist [OF e] by auto
+ hence "a \<noteq> x" "dist x a \<le> e" by (auto simp add: dist_commute)
+ with e show ?thesis by (auto simp add: expand_set_eq)
+qed auto
+
+lemma cball_sing:
+ fixes x :: "'a::metric_space"
+ shows "e = 0 ==> cball x e = {x}"
+ by (auto simp add: expand_set_eq)
+
+text{* For points in the interior, localization of limits makes no difference. *}
+
+lemma eventually_within_interior:
+ assumes "x \<in> interior S"
+ shows "eventually P (at x within S) \<longleftrightarrow> eventually P (at x)" (is "?lhs = ?rhs")
+proof-
+ from assms obtain T where T: "open T" "x \<in> T" "T \<subseteq> S"
+ unfolding interior_def by fast
+ { assume "?lhs"
+ then obtain A where "open A" "x \<in> A" "\<forall>y\<in>A. y \<noteq> x \<longrightarrow> y \<in> S \<longrightarrow> P y"
+ unfolding Limits.eventually_within Limits.eventually_at_topological
+ by auto
+ with T have "open (A \<inter> T)" "x \<in> A \<inter> T" "\<forall>y\<in>(A \<inter> T). y \<noteq> x \<longrightarrow> P y"
+ by auto
+ then have "?rhs"
+ unfolding Limits.eventually_at_topological by auto
+ } moreover
+ { assume "?rhs" hence "?lhs"
+ unfolding Limits.eventually_within
+ by (auto elim: eventually_elim1)
+ } ultimately
+ show "?thesis" ..
+qed
+
+lemma lim_within_interior:
+ "x \<in> interior S \<Longrightarrow> (f ---> l) (at x within S) \<longleftrightarrow> (f ---> l) (at x)"
+ unfolding tendsto_def by (simp add: eventually_within_interior)
+
+lemma netlimit_within_interior:
+ fixes x :: "'a::{perfect_space, real_normed_vector}"
+ (* FIXME: generalize to perfect_space *)
+ assumes "x \<in> interior S"
+ shows "netlimit(at x within S) = x" (is "?lhs = ?rhs")
+proof-
+ 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
+ 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
+ thus ?thesis using netlimit_within by auto
+qed
+
+subsection{* Boundedness. *}
+
+ (* FIXME: This has to be unified with BSEQ!! *)
+definition
+ bounded :: "'a::metric_space set \<Rightarrow> bool" where
+ "bounded S \<longleftrightarrow> (\<exists>x e. \<forall>y\<in>S. dist x y \<le> e)"
+
+lemma bounded_any_center: "bounded S \<longleftrightarrow> (\<exists>e. \<forall>y\<in>S. dist a y \<le> e)"
+unfolding bounded_def
+apply safe
+apply (rule_tac x="dist a x + e" in exI, clarify)
+apply (drule (1) bspec)
+apply (erule order_trans [OF dist_triangle add_left_mono])
+apply auto
+done
+
+lemma bounded_iff: "bounded S \<longleftrightarrow> (\<exists>a. \<forall>x\<in>S. norm x \<le> a)"
+unfolding bounded_any_center [where a=0]
+by (simp add: dist_norm)
+
+lemma bounded_empty[simp]: "bounded {}" by (simp add: bounded_def)
+lemma bounded_subset: "bounded T \<Longrightarrow> S \<subseteq> T ==> bounded S"
+ by (metis bounded_def subset_eq)
+
+lemma bounded_interior[intro]: "bounded S ==> bounded(interior S)"
+ by (metis bounded_subset interior_subset)
+
+lemma bounded_closure[intro]: assumes "bounded S" shows "bounded(closure S)"
+proof-
+ from assms obtain x and a where a: "\<forall>y\<in>S. dist x y \<le> a" unfolding bounded_def by auto
+ { fix y assume "y \<in> closure S"
+ then obtain f where f: "\<forall>n. f n \<in> S" "(f ---> y) sequentially"
+ unfolding closure_sequential by auto
+ have "\<forall>n. f n \<in> S \<longrightarrow> dist x (f n) \<le> a" using a by simp
+ hence "eventually (\<lambda>n. dist x (f n) \<le> a) sequentially"
+ by (rule eventually_mono, simp add: f(1))
+ have "dist x y \<le> a"
+ apply (rule Lim_dist_ubound [of sequentially f])
+ apply (rule trivial_limit_sequentially)
+ apply (rule f(2))
+ apply fact
+ done
+ }
+ thus ?thesis unfolding bounded_def by auto
+qed
+
+lemma bounded_cball[simp,intro]: "bounded (cball x e)"
+ apply (simp add: bounded_def)
+ apply (rule_tac x=x in exI)
+ apply (rule_tac x=e in exI)
+ apply auto
+ done
+
+lemma bounded_ball[simp,intro]: "bounded(ball x e)"
+ by (metis ball_subset_cball bounded_cball bounded_subset)
+
+lemma finite_imp_bounded[intro]: assumes "finite S" shows "bounded S"
+proof-
+ { fix a F assume as:"bounded F"
+ then obtain x e where "\<forall>y\<in>F. dist x y \<le> e" unfolding bounded_def by auto
+ hence "\<forall>y\<in>(insert a F). dist x y \<le> max e (dist x a)" by auto
+ hence "bounded (insert a F)" unfolding bounded_def by (intro exI)
+ }
+ thus ?thesis using finite_induct[of S bounded] using bounded_empty assms by auto
+qed
+
+lemma bounded_Un[simp]: "bounded (S \<union> T) \<longleftrightarrow> bounded S \<and> bounded T"
+ apply (auto simp add: bounded_def)
+ apply (rename_tac x y r s)
+ apply (rule_tac x=x in exI)
+ apply (rule_tac x="max r (dist x y + s)" in exI)
+ apply (rule ballI, rename_tac z, safe)
+ apply (drule (1) bspec, simp)
+ apply (drule (1) bspec)
+ apply (rule min_max.le_supI2)
+ apply (erule order_trans [OF dist_triangle add_left_mono])
+ done
+
+lemma bounded_Union[intro]: "finite F \<Longrightarrow> (\<forall>S\<in>F. bounded S) \<Longrightarrow> bounded(\<Union>F)"
+ by (induct rule: finite_induct[of F], auto)
+
+lemma bounded_pos: "bounded S \<longleftrightarrow> (\<exists>b>0. \<forall>x\<in> S. norm x <= b)"
+ apply (simp add: bounded_iff)
+ apply (subgoal_tac "\<And>x (y::real). 0 < 1 + abs y \<and> (x <= y \<longrightarrow> x <= 1 + abs y)")
+ by metis arith
+
+lemma bounded_Int[intro]: "bounded S \<or> bounded T \<Longrightarrow> bounded (S \<inter> T)"
+ by (metis Int_lower1 Int_lower2 bounded_subset)
+
+lemma bounded_diff[intro]: "bounded S ==> bounded (S - T)"
+apply (metis Diff_subset bounded_subset)
+done
+
+lemma bounded_insert[intro]:"bounded(insert x S) \<longleftrightarrow> bounded S"
+ by (metis Diff_cancel Un_empty_right Un_insert_right bounded_Un bounded_subset finite.emptyI finite_imp_bounded infinite_remove subset_insertI)
+
+lemma not_bounded_UNIV[simp, intro]:
+ "\<not> bounded (UNIV :: 'a::{real_normed_vector, perfect_space} set)"
+proof(auto simp add: bounded_pos not_le)
+ obtain x :: 'a where "x \<noteq> 0"
+ using perfect_choose_dist [OF zero_less_one] by fast
+ fix b::real assume b: "b >0"
+ have b1: "b +1 \<ge> 0" using b by simp
+ with `x \<noteq> 0` have "b < norm (scaleR (b + 1) (sgn x))"
+ by (simp add: norm_sgn)
+ then show "\<exists>x::'a. b < norm x" ..
+qed
+
+lemma bounded_linear_image:
+ assumes "bounded S" "bounded_linear f"
+ shows "bounded(f ` S)"
+proof-
+ from assms(1) obtain b where b:"b>0" "\<forall>x\<in>S. norm x \<le> b" unfolding bounded_pos by auto
+ 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)
+ { fix x assume "x\<in>S"
+ hence "norm x \<le> b" using b by auto
+ hence "norm (f x) \<le> B * b" using B(2) apply(erule_tac x=x in allE)
+ by (metis B(1) B(2) real_le_trans real_mult_le_cancel_iff2)
+ }
+ thus ?thesis unfolding bounded_pos apply(rule_tac x="b*B" in exI)
+ using b B real_mult_order[of b B] by (auto simp add: real_mult_commute)
+qed
+
+lemma bounded_scaling:
+ fixes S :: "'a::real_normed_vector set"
+ shows "bounded S \<Longrightarrow> bounded ((\<lambda>x. c *\<^sub>R x) ` S)"
+ apply (rule bounded_linear_image, assumption)
+ apply (rule scaleR.bounded_linear_right)
+ done
+
+lemma bounded_translation:
+ fixes S :: "'a::real_normed_vector set"
+ assumes "bounded S" shows "bounded ((\<lambda>x. a + x) ` S)"
+proof-
+ from assms obtain b where b:"b>0" "\<forall>x\<in>S. norm x \<le> b" unfolding bounded_pos by auto
+ { fix x assume "x\<in>S"
+ hence "norm (a + x) \<le> b + norm a" using norm_triangle_ineq[of a x] b by auto
+ }
+ thus ?thesis unfolding bounded_pos using norm_ge_zero[of a] b(1) using add_strict_increasing[of b 0 "norm a"]
+ by (auto intro!: add exI[of _ "b + norm a"])
+qed
+
+
+text{* Some theorems on sups and infs using the notion "bounded". *}
+
+lemma bounded_real:
+ fixes S :: "real set"
+ shows "bounded S \<longleftrightarrow> (\<exists>a. \<forall>x\<in>S. abs x <= a)"
+ by (simp add: bounded_iff)
+
+lemma bounded_has_rsup: assumes "bounded S" "S \<noteq> {}"
+ shows "\<forall>x\<in>S. x <= rsup S" and "\<forall>b. (\<forall>x\<in>S. x <= b) \<longrightarrow> rsup S <= b"
+proof
+ fix x assume "x\<in>S"
+ from assms(1) obtain a where a:"\<forall>x\<in>S. \<bar>x\<bar> \<le> a" unfolding bounded_real by auto
+ hence *:"S *<= a" using setleI[of S a] by (metis abs_le_interval_iff mem_def)
+ 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
+next
+ show "\<forall>b. (\<forall>x\<in>S. x \<le> b) \<longrightarrow> rsup S \<le> b" using assms
+ using rsup[of S, unfolded isLub_def isUb_def leastP_def setle_def setge_def]
+ apply (auto simp add: bounded_real)
+ by (auto simp add: isLub_def isUb_def leastP_def setle_def setge_def)
+qed
+
+lemma rsup_insert: assumes "bounded S"
+ shows "rsup(insert x S) = (if S = {} then x else max x (rsup S))"
+proof(cases "S={}")
+ case True thus ?thesis using rsup_finite_in[of "{x}"] by auto
+next
+ let ?S = "insert x S"
+ case False
+ hence *:"\<forall>x\<in>S. x \<le> rsup S" using bounded_has_rsup(1)[of S] using assms by auto
+ hence "insert x S *<= max x (rsup S)" unfolding setle_def by auto
+ hence "isLub UNIV ?S (rsup ?S)" using rsup[of ?S] by auto
+ moreover
+ have **:"isUb UNIV ?S (max x (rsup S))" unfolding isUb_def setle_def using * by auto
+ { fix y assume as:"isUb UNIV (insert x S) y"
+ hence "max x (rsup S) \<le> y" unfolding isUb_def using rsup_le[OF `S\<noteq>{}`]
+ unfolding setle_def by auto }
+ hence "max x (rsup S) <=* isUb UNIV (insert x S)" unfolding setge_def Ball_def mem_def by auto
+ hence "isLub UNIV ?S (max x (rsup S))" using ** isLubI2[of UNIV ?S "max x (rsup S)"] unfolding Collect_def by auto
+ ultimately show ?thesis using real_isLub_unique[of UNIV ?S] using `S\<noteq>{}` by auto
+qed
+
+lemma sup_insert_finite: "finite S \<Longrightarrow> rsup(insert x S) = (if S = {} then x else max x (rsup S))"
+ apply (rule rsup_insert)
+ apply (rule finite_imp_bounded)
+ by simp
+
+lemma bounded_has_rinf:
+ assumes "bounded S" "S \<noteq> {}"
+ shows "\<forall>x\<in>S. x >= rinf S" and "\<forall>b. (\<forall>x\<in>S. x >= b) \<longrightarrow> rinf S >= b"
+proof
+ fix x assume "x\<in>S"
+ from assms(1) obtain a where a:"\<forall>x\<in>S. \<bar>x\<bar> \<le> a" unfolding bounded_real by auto
+ hence *:"- a <=* S" using setgeI[of S "-a"] unfolding abs_le_interval_iff by auto
+ thus "x \<ge> rinf S" using rinf[OF `S\<noteq>{}`] using isGlbD2[of UNIV S "rinf S" x] using `x\<in>S` by auto
+next
+ show "\<forall>b. (\<forall>x\<in>S. x >= b) \<longrightarrow> rinf S \<ge> b" using assms
+ using rinf[of S, unfolded isGlb_def isLb_def greatestP_def setle_def setge_def]
+ apply (auto simp add: bounded_real)
+ by (auto simp add: isGlb_def isLb_def greatestP_def setle_def setge_def)
+qed
+
+(* TODO: Move this to RComplete.thy -- would need to include Glb into RComplete *)
+lemma real_isGlb_unique: "[| isGlb R S x; isGlb R S y |] ==> x = (y::real)"
+ apply (frule isGlb_isLb)
+ apply (frule_tac x = y in isGlb_isLb)
+ apply (blast intro!: order_antisym dest!: isGlb_le_isLb)
+ done
+
+lemma rinf_insert: assumes "bounded S"
+ shows "rinf(insert x S) = (if S = {} then x else min x (rinf S))" (is "?lhs = ?rhs")
+proof(cases "S={}")
+ case True thus ?thesis using rinf_finite_in[of "{x}"] by auto
+next
+ let ?S = "insert x S"
+ case False
+ hence *:"\<forall>x\<in>S. x \<ge> rinf S" using bounded_has_rinf(1)[of S] using assms by auto
+ hence "min x (rinf S) <=* insert x S" unfolding setge_def by auto
+ hence "isGlb UNIV ?S (rinf ?S)" using rinf[of ?S] by auto
+ moreover
+ have **:"isLb UNIV ?S (min x (rinf S))" unfolding isLb_def setge_def using * by auto
+ { fix y assume as:"isLb UNIV (insert x S) y"
+ hence "min x (rinf S) \<ge> y" unfolding isLb_def using rinf_ge[OF `S\<noteq>{}`]
+ unfolding setge_def by auto }
+ hence "isLb UNIV (insert x S) *<= min x (rinf S)" unfolding setle_def Ball_def mem_def by auto
+ hence "isGlb UNIV ?S (min x (rinf S))" using ** isGlbI2[of UNIV ?S "min x (rinf S)"] unfolding Collect_def by auto
+ ultimately show ?thesis using real_isGlb_unique[of UNIV ?S] using `S\<noteq>{}` by auto
+qed
+
+lemma inf_insert_finite: "finite S ==> rinf(insert x S) = (if S = {} then x else min x (rinf S))"
+ by (rule rinf_insert, rule finite_imp_bounded, simp)
+
+subsection{* Compactness (the definition is the one based on convegent subsequences). *}
+
+definition
+ compact :: "'a::metric_space set \<Rightarrow> bool" where (* TODO: generalize *)
+ "compact S \<longleftrightarrow>
+ (\<forall>f. (\<forall>n. f n \<in> S) \<longrightarrow>
+ (\<exists>l\<in>S. \<exists>r. subseq r \<and> ((f o r) ---> l) sequentially))"
+
+text {*
+ A metric space (or topological vector space) is said to have the
+ Heine-Borel property if every closed and bounded subset is compact.
+*}
+
+class heine_borel =
+ assumes bounded_imp_convergent_subsequence:
+ "bounded s \<Longrightarrow> \<forall>n. f n \<in> s
+ \<Longrightarrow> \<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
+
+lemma bounded_closed_imp_compact:
+ fixes s::"'a::heine_borel set"
+ assumes "bounded s" and "closed s" shows "compact s"
+proof (unfold compact_def, clarify)
+ fix f :: "nat \<Rightarrow> 'a" assume f: "\<forall>n. f n \<in> s"
+ obtain l r where r: "subseq r" and l: "((f \<circ> r) ---> l) sequentially"
+ using bounded_imp_convergent_subsequence [OF `bounded s` `\<forall>n. f n \<in> s`] by auto
+ from f have fr: "\<forall>n. (f \<circ> r) n \<in> s" by simp
+ have "l \<in> s" using `closed s` fr l
+ unfolding closed_sequential_limits by blast
+ show "\<exists>l\<in>s. \<exists>r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
+ using `l \<in> s` r l by blast
+qed
+
+lemma subseq_bigger: assumes "subseq r" shows "n \<le> r n"
+proof(induct n)
+ show "0 \<le> r 0" by auto
+next
+ fix n assume "n \<le> r n"
+ moreover have "r n < r (Suc n)"
+ using assms [unfolded subseq_def] by auto
+ ultimately show "Suc n \<le> r (Suc n)" by auto
+qed
+
+lemma eventually_subseq:
+ assumes r: "subseq r"
+ shows "eventually P sequentially \<Longrightarrow> eventually (\<lambda>n. P (r n)) sequentially"
+unfolding eventually_sequentially
+by (metis subseq_bigger [OF r] le_trans)
+
+lemma lim_subseq:
+ "subseq r \<Longrightarrow> (s ---> l) sequentially \<Longrightarrow> ((s o r) ---> l) sequentially"
+unfolding tendsto_def eventually_sequentially o_def
+by (metis subseq_bigger le_trans)
+
+lemma num_Axiom: "EX! g. g 0 = e \<and> (\<forall>n. g (Suc n) = f n (g n))"
+ unfolding Ex1_def
+ apply (rule_tac x="nat_rec e f" in exI)
+ apply (rule conjI)+
+apply (rule def_nat_rec_0, simp)
+apply (rule allI, rule def_nat_rec_Suc, simp)
+apply (rule allI, rule impI, rule ext)
+apply (erule conjE)
+apply (induct_tac x)
+apply (simp add: nat_rec_0)
+apply (erule_tac x="n" in allE)
+apply (simp)
+done
+
+lemma convergent_bounded_increasing: fixes s ::"nat\<Rightarrow>real"
+ assumes "incseq s" and "\<forall>n. abs(s n) \<le> b"
+ shows "\<exists> l. \<forall>e::real>0. \<exists> N. \<forall>n \<ge> N. abs(s n - l) < e"
+proof-
+ have "isUb UNIV (range s) b" using assms(2) and abs_le_D1 unfolding isUb_def and setle_def by auto
+ then obtain t where t:"isLub UNIV (range s) t" using reals_complete[of "range s" ] by auto
+ { fix e::real assume "e>0" and as:"\<forall>N. \<exists>n\<ge>N. \<not> \<bar>s n - t\<bar> < e"
+ { fix n::nat
+ obtain N where "N\<ge>n" and n:"\<bar>s N - t\<bar> \<ge> e" using as[THEN spec[where x=n]] by auto
+ have "t \<ge> s N" using isLub_isUb[OF t, unfolded isUb_def setle_def] by auto
+ with n have "s N \<le> t - e" using `e>0` by auto
+ 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 }
+ hence "isUb UNIV (range s) (t - e)" unfolding isUb_def and setle_def by auto
+ hence False using isLub_le_isUb[OF t, of "t - e"] and `e>0` by auto }
+ thus ?thesis by blast
+qed
+
+lemma convergent_bounded_monotone: fixes s::"nat \<Rightarrow> real"
+ assumes "\<forall>n. abs(s n) \<le> b" and "monoseq s"
+ shows "\<exists>l. \<forall>e::real>0. \<exists>N. \<forall>n\<ge>N. abs(s n - l) < e"
+ using convergent_bounded_increasing[of s b] assms using convergent_bounded_increasing[of "\<lambda>n. - s n" b]
+ unfolding monoseq_def incseq_def
+ apply auto unfolding minus_add_distrib[THEN sym, unfolded diff_minus[THEN sym]]
+ unfolding abs_minus_cancel by(rule_tac x="-l" in exI)auto
+
+lemma compact_real_lemma:
+ assumes "\<forall>n::nat. abs(s n) \<le> b"
+ shows "\<exists>(l::real) r. subseq r \<and> ((s \<circ> r) ---> l) sequentially"
+proof-
+ obtain r where r:"subseq r" "monoseq (\<lambda>n. s (r n))"
+ using seq_monosub[of s] by auto
+ thus ?thesis using convergent_bounded_monotone[of "\<lambda>n. s (r n)" b] and assms
+ unfolding tendsto_iff dist_norm eventually_sequentially by auto
+qed
+
+instance real :: heine_borel
+proof
+ fix s :: "real set" and f :: "nat \<Rightarrow> real"
+ assume s: "bounded s" and f: "\<forall>n. f n \<in> s"
+ then obtain b where b: "\<forall>n. abs (f n) \<le> b"
+ unfolding bounded_iff by auto
+ obtain l :: real and r :: "nat \<Rightarrow> nat" where
+ r: "subseq r" and l: "((f \<circ> r) ---> l) sequentially"
+ using compact_real_lemma [OF b] by auto
+ thus "\<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
+ by auto
+qed
+
+lemma bounded_component: "bounded s \<Longrightarrow> bounded ((\<lambda>x. x $ i) ` s)"
+unfolding bounded_def
+apply clarify
+apply (rule_tac x="x $ i" in exI)
+apply (rule_tac x="e" in exI)
+apply clarify
+apply (rule order_trans [OF dist_nth_le], simp)
+done
+
+lemma compact_lemma:
+ fixes f :: "nat \<Rightarrow> 'a::heine_borel ^ 'n::finite"
+ assumes "bounded s" and "\<forall>n. f n \<in> s"
+ shows "\<forall>d.
+ \<exists>l r. subseq r \<and>
+ (\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r n) $ i) (l $ i) < e) sequentially)"
+proof
+ fix d::"'n set" have "finite d" by simp
+ thus "\<exists>l::'a ^ 'n. \<exists>r. subseq r \<and>
+ (\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r n) $ i) (l $ i) < e) sequentially)"
+ proof(induct d) case empty thus ?case unfolding subseq_def by auto
+ next case (insert k d)
+ have s': "bounded ((\<lambda>x. x $ k) ` s)" using `bounded s` by (rule bounded_component)
+ 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"
+ using insert(3) by auto
+ have f': "\<forall>n. f (r1 n) $ k \<in> (\<lambda>x. x $ k) ` s" using `\<forall>n. f n \<in> s` by simp
+ obtain l2 r2 where r2:"subseq r2" and lr2:"((\<lambda>i. f (r1 (r2 i)) $ k) ---> l2) sequentially"
+ using bounded_imp_convergent_subsequence[OF s' f'] unfolding o_def by auto
+ def r \<equiv> "r1 \<circ> r2" have r:"subseq r"
+ using r1 and r2 unfolding r_def o_def subseq_def by auto
+ moreover
+ def l \<equiv> "(\<chi> i. if i = k then l2 else l1$i)::'a^'n"
+ { fix e::real assume "e>0"
+ from lr1 `e>0` have N1:"eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r1 n) $ i) (l1 $ i) < e) sequentially" by blast
+ from lr2 `e>0` have N2:"eventually (\<lambda>n. dist (f (r1 (r2 n)) $ k) l2 < e) sequentially" by (rule tendstoD)
+ from r2 N1 have N1': "eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r1 (r2 n)) $ i) (l1 $ i) < e) sequentially"
+ by (rule eventually_subseq)
+ have "eventually (\<lambda>n. \<forall>i\<in>(insert k d). dist (f (r n) $ i) (l $ i) < e) sequentially"
+ using N1' N2 by (rule eventually_elim2, simp add: l_def r_def)
+ }
+ ultimately show ?case by auto
+ qed
+qed
+
+instance "^" :: (heine_borel, finite) heine_borel
+proof
+ fix s :: "('a ^ 'b) set" and f :: "nat \<Rightarrow> 'a ^ 'b"
+ assume s: "bounded s" and f: "\<forall>n. f n \<in> s"
+ then obtain l r where r: "subseq r"
+ and l: "\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>UNIV. dist (f (r n) $ i) (l $ i) < e) sequentially"
+ using compact_lemma [OF s f] by blast
+ let ?d = "UNIV::'b set"
+ { fix e::real assume "e>0"
+ hence "0 < e / (real_of_nat (card ?d))"
+ using zero_less_card_finite using divide_pos_pos[of e, of "real_of_nat (card ?d)"] by auto
+ with l have "eventually (\<lambda>n. \<forall>i. dist (f (r n) $ i) (l $ i) < e / (real_of_nat (card ?d))) sequentially"
+ by simp
+ moreover
+ { fix n assume n: "\<forall>i. dist (f (r n) $ i) (l $ i) < e / (real_of_nat (card ?d))"
+ have "dist (f (r n)) l \<le> (\<Sum>i\<in>?d. dist (f (r n) $ i) (l $ i))"
+ unfolding dist_vector_def using zero_le_dist by (rule setL2_le_setsum)
+ also have "\<dots> < (\<Sum>i\<in>?d. e / (real_of_nat (card ?d)))"
+ by (rule setsum_strict_mono) (simp_all add: n)
+ finally have "dist (f (r n)) l < e" by simp
+ }
+ ultimately have "eventually (\<lambda>n. dist (f (r n)) l < e) sequentially"
+ by (rule eventually_elim1)
+ }
+ hence *:"((f \<circ> r) ---> l) sequentially" unfolding o_def tendsto_iff by simp
+ with r show "\<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially" by auto
+qed
+
+lemma bounded_fst: "bounded s \<Longrightarrow> bounded (fst ` s)"
+unfolding bounded_def
+apply clarify
+apply (rule_tac x="a" in exI)
+apply (rule_tac x="e" in exI)
+apply clarsimp
+apply (drule (1) bspec)
+apply (simp add: dist_Pair_Pair)
+apply (erule order_trans [OF real_sqrt_sum_squares_ge1])
+done
+
+lemma bounded_snd: "bounded s \<Longrightarrow> bounded (snd ` s)"
+unfolding bounded_def
+apply clarify
+apply (rule_tac x="b" in exI)
+apply (rule_tac x="e" in exI)
+apply clarsimp
+apply (drule (1) bspec)
+apply (simp add: dist_Pair_Pair)
+apply (erule order_trans [OF real_sqrt_sum_squares_ge2])
+done
+
+instance "*" :: (heine_borel, heine_borel) heine_borel
+proof
+ fix s :: "('a * 'b) set" and f :: "nat \<Rightarrow> 'a * 'b"
+ assume s: "bounded s" and f: "\<forall>n. f n \<in> s"
+ from s have s1: "bounded (fst ` s)" by (rule bounded_fst)
+ from f have f1: "\<forall>n. fst (f n) \<in> fst ` s" by simp
+ obtain l1 r1 where r1: "subseq r1"
+ and l1: "((\<lambda>n. fst (f (r1 n))) ---> l1) sequentially"
+ using bounded_imp_convergent_subsequence [OF s1 f1]
+ unfolding o_def by fast
+ from s have s2: "bounded (snd ` s)" by (rule bounded_snd)
+ from f have f2: "\<forall>n. snd (f (r1 n)) \<in> snd ` s" by simp
+ obtain l2 r2 where r2: "subseq r2"
+ and l2: "((\<lambda>n. snd (f (r1 (r2 n)))) ---> l2) sequentially"
+ using bounded_imp_convergent_subsequence [OF s2 f2]
+ unfolding o_def by fast
+ have l1': "((\<lambda>n. fst (f (r1 (r2 n)))) ---> l1) sequentially"
+ using lim_subseq [OF r2 l1] unfolding o_def .
+ have l: "((f \<circ> (r1 \<circ> r2)) ---> (l1, l2)) sequentially"
+ using tendsto_Pair [OF l1' l2] unfolding o_def by simp
+ have r: "subseq (r1 \<circ> r2)"
+ using r1 r2 unfolding subseq_def by simp
+ show "\<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
+ using l r by fast
+qed
+
+subsection{* Completeness. *}
+
+lemma cauchy_def:
+ "Cauchy s \<longleftrightarrow> (\<forall>e>0. \<exists>N. \<forall>m n. m \<ge> N \<and> n \<ge> N --> dist(s m)(s n) < e)"
+unfolding Cauchy_def by blast
+
+definition
+ complete :: "'a::metric_space set \<Rightarrow> bool" where
+ "complete s \<longleftrightarrow> (\<forall>f. (\<forall>n. f n \<in> s) \<and> Cauchy f
+ --> (\<exists>l \<in> s. (f ---> l) sequentially))"
+
+lemma cauchy: "Cauchy s \<longleftrightarrow> (\<forall>e>0.\<exists> N::nat. \<forall>n\<ge>N. dist(s n)(s N) < e)" (is "?lhs = ?rhs")
+proof-
+ { assume ?rhs
+ { fix e::real
+ assume "e>0"
+ with `?rhs` obtain N where N:"\<forall>n\<ge>N. dist (s n) (s N) < e/2"
+ by (erule_tac x="e/2" in allE) auto
+ { fix n m
+ assume nm:"N \<le> m \<and> N \<le> n"
+ hence "dist (s m) (s n) < e" using N
+ using dist_triangle_half_l[of "s m" "s N" "e" "s n"]
+ by blast
+ }
+ hence "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (s m) (s n) < e"
+ by blast
+ }
+ hence ?lhs
+ unfolding cauchy_def
+ by blast
+ }
+ thus ?thesis
+ unfolding cauchy_def
+ using dist_triangle_half_l
+ by blast
+qed
+
+lemma convergent_imp_cauchy:
+ "(s ---> l) sequentially ==> Cauchy s"
+proof(simp only: cauchy_def, rule, rule)
+ fix e::real assume "e>0" "(s ---> l) sequentially"
+ 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
+ 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
+qed
+
+lemma cauchy_imp_bounded: assumes "Cauchy s" shows "bounded {y. (\<exists>n::nat. y = s n)}"
+proof-
+ 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
+ hence N:"\<forall>n. N \<le> n \<longrightarrow> dist (s N) (s n) < 1" by auto
+ moreover
+ have "bounded (s ` {0..N})" using finite_imp_bounded[of "s ` {1..N}"] by auto
+ then obtain a where a:"\<forall>x\<in>s ` {0..N}. dist (s N) x \<le> a"
+ unfolding bounded_any_center [where a="s N"] by auto
+ ultimately show "?thesis"
+ unfolding bounded_any_center [where a="s N"]
+ apply(rule_tac x="max a 1" in exI) apply auto
+ apply(erule_tac x=n in allE) apply(erule_tac x=n in ballE) by auto
+qed
+
+lemma compact_imp_complete: assumes "compact s" shows "complete s"
+proof-
+ { fix f assume as: "(\<forall>n::nat. f n \<in> s)" "Cauchy f"
+ 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
+
+ note lr' = subseq_bigger [OF lr(2)]
+
+ { fix e::real assume "e>0"
+ 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
+ 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
+ { fix n::nat assume n:"n \<ge> max N M"
+ have "dist ((f \<circ> r) n) l < e/2" using n M by auto
+ moreover have "r n \<ge> N" using lr'[of n] n by auto
+ hence "dist (f n) ((f \<circ> r) n) < e / 2" using N using n by auto
+ 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) }
+ hence "\<exists>N. \<forall>n\<ge>N. dist (f n) l < e" by blast }
+ hence "\<exists>l\<in>s. (f ---> l) sequentially" using `l\<in>s` unfolding Lim_sequentially by auto }
+ thus ?thesis unfolding complete_def by auto
+qed
+
+instance heine_borel < complete_space
+proof
+ fix f :: "nat \<Rightarrow> 'a" assume "Cauchy f"
+ hence "bounded (range f)" unfolding image_def
+ using cauchy_imp_bounded [of f] by auto
+ hence "compact (closure (range f))"
+ using bounded_closed_imp_compact [of "closure (range f)"] by auto
+ hence "complete (closure (range f))"
+ using compact_imp_complete by auto
+ moreover have "\<forall>n. f n \<in> closure (range f)"
+ using closure_subset [of "range f"] by auto
+ ultimately have "\<exists>l\<in>closure (range f). (f ---> l) sequentially"
+ using `Cauchy f` unfolding complete_def by auto
+ then show "convergent f"
+ unfolding convergent_def LIMSEQ_conv_tendsto [symmetric] by auto
+qed
+
+lemma complete_univ: "complete (UNIV :: 'a::complete_space set)"
+proof(simp add: complete_def, rule, rule)
+ fix f :: "nat \<Rightarrow> 'a" assume "Cauchy f"
+ hence "convergent f" by (rule Cauchy_convergent)
+ hence "\<exists>l. f ----> l" unfolding convergent_def .
+ thus "\<exists>l. (f ---> l) sequentially" unfolding LIMSEQ_conv_tendsto .
+qed
+
+lemma complete_imp_closed: assumes "complete s" shows "closed s"
+proof -
+ { fix x assume "x islimpt s"
+ then obtain f where f: "\<forall>n. f n \<in> s - {x}" "(f ---> x) sequentially"
+ unfolding islimpt_sequential by auto
+ then obtain l where l: "l\<in>s" "(f ---> l) sequentially"
+ using `complete s`[unfolded complete_def] using convergent_imp_cauchy[of f x] by auto
+ hence "x \<in> s" using Lim_unique[of sequentially f l x] trivial_limit_sequentially f(2) by auto
+ }
+ thus "closed s" unfolding closed_limpt by auto
+qed
+
+lemma complete_eq_closed:
+ fixes s :: "'a::complete_space set"
+ shows "complete s \<longleftrightarrow> closed s" (is "?lhs = ?rhs")
+proof
+ assume ?lhs thus ?rhs by (rule complete_imp_closed)
+next
+ assume ?rhs
+ { fix f assume as:"\<forall>n::nat. f n \<in> s" "Cauchy f"
+ then obtain l where "(f ---> l) sequentially" using complete_univ[unfolded complete_def, THEN spec[where x=f]] by auto
+ 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 }
+ thus ?lhs unfolding complete_def by auto
+qed
+
+lemma convergent_eq_cauchy:
+ fixes s :: "nat \<Rightarrow> 'a::complete_space"
+ shows "(\<exists>l. (s ---> l) sequentially) \<longleftrightarrow> Cauchy s" (is "?lhs = ?rhs")
+proof
+ assume ?lhs then obtain l where "(s ---> l) sequentially" by auto
+ thus ?rhs using convergent_imp_cauchy by auto
+next
+ assume ?rhs thus ?lhs using complete_univ[unfolded complete_def, THEN spec[where x=s]] by auto
+qed
+
+lemma convergent_imp_bounded:
+ fixes s :: "nat \<Rightarrow> 'a::metric_space"
+ shows "(s ---> l) sequentially ==> bounded (s ` (UNIV::(nat set)))"
+ using convergent_imp_cauchy[of s]
+ using cauchy_imp_bounded[of s]
+ unfolding image_def
+ by auto
+
+subsection{* Total boundedness. *}
+
+fun helper_1::"('a::metric_space set) \<Rightarrow> real \<Rightarrow> nat \<Rightarrow> 'a" where
+ "helper_1 s e n = (SOME y::'a. y \<in> s \<and> (\<forall>m<n. \<not> (dist (helper_1 s e m) y < e)))"
+declare helper_1.simps[simp del]
+
+lemma compact_imp_totally_bounded:
+ assumes "compact s"
+ shows "\<forall>e>0. \<exists>k. finite k \<and> k \<subseteq> s \<and> s \<subseteq> (\<Union>((\<lambda>x. ball x e) ` k))"
+proof(rule, rule, rule ccontr)
+ 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)"
+ def x \<equiv> "helper_1 s e"
+ { fix n
+ have "x n \<in> s \<and> (\<forall>m<n. \<not> dist (x m) (x n) < e)"
+ proof(induct_tac rule:nat_less_induct)
+ fix n def Q \<equiv> "(\<lambda>y. y \<in> s \<and> (\<forall>m<n. \<not> dist (x m) y < e))"
+ assume as:"\<forall>m<n. x m \<in> s \<and> (\<forall>ma<m. \<not> dist (x ma) (x m) < e)"
+ 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
+ then obtain z where z:"z\<in>s" "z \<notin> (\<Union>x\<in>x ` {0..<n}. ball x e)" unfolding subset_eq by auto
+ have "Q (x n)" unfolding x_def and helper_1.simps[of s e n]
+ apply(rule someI2[where a=z]) unfolding x_def[symmetric] and Q_def using z by auto
+ thus "x n \<in> s \<and> (\<forall>m<n. \<not> dist (x m) (x n) < e)" unfolding Q_def by auto
+ qed }
+ hence "\<forall>n::nat. x n \<in> s" and x:"\<forall>n. \<forall>m < n. \<not> (dist (x m) (x n) < e)" by blast+
+ 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
+ from this(3) have "Cauchy (x \<circ> r)" using convergent_imp_cauchy by auto
+ 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
+ show False
+ using N[THEN spec[where x=N], THEN spec[where x="N+1"]]
+ using r[unfolded subseq_def, THEN spec[where x=N], THEN spec[where x="N+1"]]
+ using x[THEN spec[where x="r (N+1)"], THEN spec[where x="r (N)"]] by auto
+qed
+
+subsection{* Heine-Borel theorem (following Burkill \& Burkill vol. 2) *}
+
+lemma heine_borel_lemma: fixes s::"'a::metric_space set"
+ assumes "compact s" "s \<subseteq> (\<Union> t)" "\<forall>b \<in> t. open b"
+ shows "\<exists>e>0. \<forall>x \<in> s. \<exists>b \<in> t. ball x e \<subseteq> b"
+proof(rule ccontr)
+ assume "\<not> (\<exists>e>0. \<forall>x\<in>s. \<exists>b\<in>t. ball x e \<subseteq> b)"
+ hence cont:"\<forall>e>0. \<exists>x\<in>s. \<forall>xa\<in>t. \<not> (ball x e \<subseteq> xa)" by auto
+ { fix n::nat
+ have "1 / real (n + 1) > 0" by auto
+ 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 }
+ 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
+ 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)"
+ 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
+
+ then obtain l r where l:"l\<in>s" and r:"subseq r" and lr:"((f \<circ> r) ---> l) sequentially"
+ using assms(1)[unfolded compact_def, THEN spec[where x=f]] by auto
+
+ obtain b where "l\<in>b" "b\<in>t" using assms(2) and l by auto
+ then obtain e where "e>0" and e:"\<forall>z. dist z l < e \<longrightarrow> z\<in>b"
+ using assms(3)[THEN bspec[where x=b]] unfolding open_dist by auto
+
+ then obtain N1 where N1:"\<forall>n\<ge>N1. dist ((f \<circ> r) n) l < e / 2"
+ using lr[unfolded Lim_sequentially, THEN spec[where x="e/2"]] by auto
+
+ obtain N2::nat where N2:"N2>0" "inverse (real N2) < e /2" using real_arch_inv[of "e/2"] and `e>0` by auto
+ have N2':"inverse (real (r (N1 + N2) +1 )) < e/2"
+ apply(rule order_less_trans) apply(rule less_imp_inverse_less) using N2
+ using subseq_bigger[OF r, of "N1 + N2"] by auto
+
+ def x \<equiv> "(f (r (N1 + N2)))"
+ have x:"\<not> ball x (inverse (real (r (N1 + N2) + 1))) \<subseteq> b" unfolding x_def
+ using f[THEN spec[where x="r (N1 + N2)"]] using `b\<in>t` by auto
+ have "\<exists>y\<in>ball x (inverse (real (r (N1 + N2) + 1))). y\<notin>b" apply(rule ccontr) using x by auto
+ then obtain y where y:"y \<in> ball x (inverse (real (r (N1 + N2) + 1)))" "y \<notin> b" by auto
+
+ have "dist x l < e/2" using N1 unfolding x_def o_def by auto
+ hence "dist y l < e" using y N2' using dist_triangle[of y l x]by (auto simp add:dist_commute)
+
+ thus False using e and `y\<notin>b` by auto
+qed
+
+lemma compact_imp_heine_borel: "compact s ==> (\<forall>f. (\<forall>t \<in> f. open t) \<and> s \<subseteq> (\<Union> f)
+ \<longrightarrow> (\<exists>f'. f' \<subseteq> f \<and> finite f' \<and> s \<subseteq> (\<Union> f')))"
+proof clarify
+ fix f assume "compact s" " \<forall>t\<in>f. open t" "s \<subseteq> \<Union>f"
+ 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
+ hence "\<forall>x\<in>s. \<exists>b. b\<in>f \<and> ball x e \<subseteq> b" by auto
+ 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
+ then obtain bb where bb:"\<forall>x\<in>s. (bb x) \<in> f \<and> ball x e \<subseteq> (bb x)" by blast
+
+ 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
+ then obtain k where k:"finite k" "k \<subseteq> s" "s \<subseteq> \<Union>(\<lambda>x. ball x e) ` k" by auto
+
+ have "finite (bb ` k)" using k(1) by auto
+ moreover
+ { fix x assume "x\<in>s"
+ hence "x\<in>\<Union>(\<lambda>x. ball x e) ` k" using k(3) unfolding subset_eq by auto
+ hence "\<exists>X\<in>bb ` k. x \<in> X" using bb k(2) by blast
+ hence "x \<in> \<Union>(bb ` k)" using Union_iff[of x "bb ` k"] by auto
+ }
+ 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
+qed
+
+subsection{* Bolzano-Weierstrass property. *}
+
+lemma heine_borel_imp_bolzano_weierstrass:
+ 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'))"
+ "infinite t" "t \<subseteq> s"
+ shows "\<exists>x \<in> s. x islimpt t"
+proof(rule ccontr)
+ assume "\<not> (\<exists>x \<in> s. x islimpt t)"
+ 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
+ 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
+ obtain g where g:"g\<subseteq>{t. \<exists>x. x \<in> s \<and> t = f x}" "finite g" "s \<subseteq> \<Union>g"
+ using assms(1)[THEN spec[where x="{t. \<exists>x. x\<in>s \<and> t = f x}"]] using f by auto
+ from g(1,3) have g':"\<forall>x\<in>g. \<exists>xa \<in> s. x = f xa" by auto
+ { fix x y assume "x\<in>t" "y\<in>t" "f x = f y"
+ 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
+ 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 }
+ hence "infinite (f ` t)" using assms(2) using finite_imageD[unfolded inj_on_def, of f t] by auto
+ moreover
+ { fix x assume "x\<in>t" "f x \<notin> g"
+ from g(3) assms(3) `x\<in>t` obtain h where "h\<in>g" and "x\<in>h" by auto
+ then obtain y where "y\<in>s" "h = f y" using g'[THEN bspec[where x=h]] by auto
+ hence "y = x" using f[THEN bspec[where x=y]] and `x\<in>t` and `x\<in>h`[unfolded `h = f y`] by auto
+ hence False using `f x \<notin> g` `h\<in>g` unfolding `h = f y` by auto }
+ hence "f ` t \<subseteq> g" by auto
+ ultimately show False using g(2) using finite_subset by auto
+qed
+
+subsection{* Complete the chain of compactness variants. *}
+
+primrec helper_2::"(real \<Rightarrow> 'a::metric_space) \<Rightarrow> nat \<Rightarrow> 'a" where
+ "helper_2 beyond 0 = beyond 0" |
+ "helper_2 beyond (Suc n) = beyond (dist arbitrary (helper_2 beyond n) + 1 )"
+
+lemma bolzano_weierstrass_imp_bounded: fixes s::"'a::metric_space set"
+ assumes "\<forall>t. infinite t \<and> t \<subseteq> s --> (\<exists>x \<in> s. x islimpt t)"
+ shows "bounded s"
+proof(rule ccontr)
+ assume "\<not> bounded s"
+ then obtain beyond where "\<forall>a. beyond a \<in>s \<and> \<not> dist arbitrary (beyond a) \<le> a"
+ unfolding bounded_any_center [where a=arbitrary]
+ apply simp using choice[of "\<lambda>a x. x\<in>s \<and> \<not> dist arbitrary x \<le> a"] by auto
+ hence beyond:"\<And>a. beyond a \<in>s" "\<And>a. dist arbitrary (beyond a) > a"
+ unfolding linorder_not_le by auto
+ def x \<equiv> "helper_2 beyond"
+
+ { fix m n ::nat assume "m<n"
+ hence "dist arbitrary (x m) + 1 < dist arbitrary (x n)"
+ proof(induct n)
+ case 0 thus ?case by auto
+ next
+ case (Suc n)
+ have *:"dist arbitrary (x n) + 1 < dist arbitrary (x (Suc n))"
+ unfolding x_def and helper_2.simps
+ using beyond(2)[of "dist arbitrary (helper_2 beyond n) + 1"] by auto
+ thus ?case proof(cases "m < n")
+ case True thus ?thesis using Suc and * by auto
+ next
+ case False hence "m = n" using Suc(2) by auto
+ thus ?thesis using * by auto
+ qed
+ qed } note * = this
+ { fix m n ::nat assume "m\<noteq>n"
+ have "1 < dist (x m) (x n)"
+ proof(cases "m<n")
+ case True
+ hence "1 < dist arbitrary (x n) - dist arbitrary (x m)" using *[of m n] by auto
+ thus ?thesis using dist_triangle [of arbitrary "x n" "x m"] by arith
+ next
+ case False hence "n<m" using `m\<noteq>n` by auto
+ hence "1 < dist arbitrary (x m) - dist arbitrary (x n)" using *[of n m] by auto
+ thus ?thesis using dist_triangle2 [of arbitrary "x m" "x n"] by arith
+ qed } note ** = this
+ { fix a b assume "x a = x b" "a \<noteq> b"
+ hence False using **[of a b] by auto }
+ hence "inj x" unfolding inj_on_def by auto
+ moreover
+ { fix n::nat
+ have "x n \<in> s"
+ proof(cases "n = 0")
+ case True thus ?thesis unfolding x_def using beyond by auto
+ next
+ case False then obtain z where "n = Suc z" using not0_implies_Suc by auto
+ thus ?thesis unfolding x_def using beyond by auto
+ qed }
+ 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
+
+ then obtain l where "l\<in>s" and l:"l islimpt range x" using assms[THEN spec[where x="range x"]] by auto
+ 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
+ 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"]]
+ unfolding dist_nz by auto
+ show False using y and z and dist_triangle_half_l[of "x y" l 1 "x z"] and **[of y z] by auto
+qed
+
+lemma sequence_infinite_lemma:
+ fixes l :: "'a::metric_space" (* TODO: generalize *)
+ assumes "\<forall>n::nat. (f n \<noteq> l)" "(f ---> l) sequentially"
+ shows "infinite {y. (\<exists> n. y = f n)}"
+proof(rule ccontr)
+ let ?A = "(\<lambda>x. dist x l) ` {y. \<exists>n. y = f n}"
+ assume "\<not> infinite {y. \<exists>n. y = f n}"
+ hence **:"finite ?A" "?A \<noteq> {}" by auto
+ obtain k where k:"dist (f k) l = Min ?A" using Min_in[OF **] by auto
+ have "0 < Min ?A" using assms(1) unfolding dist_nz unfolding Min_gr_iff[OF **] by auto
+ then obtain N where "dist (f N) l < Min ?A" using assms(2)[unfolded Lim_sequentially, THEN spec[where x="Min ?A"]] by auto
+ moreover have "dist (f N) l \<in> ?A" by auto
+ ultimately show False using Min_le[OF **(1), of "dist (f N) l"] by auto
+qed
+
+lemma sequence_unique_limpt:
+ fixes l :: "'a::metric_space" (* TODO: generalize *)
+ assumes "\<forall>n::nat. (f n \<noteq> l)" "(f ---> l) sequentially" "l' islimpt {y. (\<exists>n. y = f n)}"
+ shows "l' = l"
+proof(rule ccontr)
+ def e \<equiv> "dist l' l"
+ assume "l' \<noteq> l" hence "e>0" unfolding dist_nz e_def by auto
+ then obtain N::nat where N:"\<forall>n\<ge>N. dist (f n) l < e / 2"
+ using assms(2)[unfolded Lim_sequentially, THEN spec[where x="e/2"]] by auto
+ 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}))"
+ have "d>0" using `e>0` unfolding d_def e_def using zero_le_dist[of _ l', unfolded order_le_less] by auto
+ 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
+ have "k\<ge>N" using k(1)[unfolded dist_nz] using k(2)[unfolded d_def]
+ by force
+ 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
+ thus False unfolding e_def by auto
+qed
+
+lemma bolzano_weierstrass_imp_closed:
+ fixes s :: "'a::metric_space set" (* TODO: can this be generalized? *)
+ assumes "\<forall>t. infinite t \<and> t \<subseteq> s --> (\<exists>x \<in> s. x islimpt t)"
+ shows "closed s"
+proof-
+ { fix x l assume as: "\<forall>n::nat. x n \<in> s" "(x ---> l) sequentially"
+ hence "l \<in> s"
+ proof(cases "\<forall>n. x n \<noteq> l")
+ case False thus "l\<in>s" using as(1) by auto
+ next
+ case True note cas = this
+ with as(2) have "infinite {y. \<exists>n. y = x n}" using sequence_infinite_lemma[of x l] by auto
+ 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
+ thus "l\<in>s" using sequence_unique_limpt[of x l l'] using as cas by auto
+ qed }
+ thus ?thesis unfolding closed_sequential_limits by fast
+qed
+
+text{* Hence express everything as an equivalence. *}
+
+lemma compact_eq_heine_borel:
+ fixes s :: "'a::heine_borel set"
+ shows "compact s \<longleftrightarrow>
+ (\<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')))" (is "?lhs = ?rhs")
+proof
+ assume ?lhs thus ?rhs using compact_imp_heine_borel[of s] by blast
+next
+ assume ?rhs
+ hence "\<forall>t. infinite t \<and> t \<subseteq> s \<longrightarrow> (\<exists>x\<in>s. x islimpt t)"
+ by (blast intro: heine_borel_imp_bolzano_weierstrass[of s])
+ thus ?lhs using bolzano_weierstrass_imp_bounded[of s] bolzano_weierstrass_imp_closed[of s] bounded_closed_imp_compact[of s] by blast
+qed
+
+lemma compact_eq_bolzano_weierstrass:
+ fixes s :: "'a::heine_borel set"
+ shows "compact s \<longleftrightarrow> (\<forall>t. infinite t \<and> t \<subseteq> s --> (\<exists>x \<in> s. x islimpt t))" (is "?lhs = ?rhs")
+proof
+ assume ?lhs thus ?rhs unfolding compact_eq_heine_borel using heine_borel_imp_bolzano_weierstrass[of s] by auto
+next
+ assume ?rhs thus ?lhs using bolzano_weierstrass_imp_bounded bolzano_weierstrass_imp_closed bounded_closed_imp_compact by auto
+qed
+
+lemma compact_eq_bounded_closed:
+ fixes s :: "'a::heine_borel set"
+ shows "compact s \<longleftrightarrow> bounded s \<and> closed s" (is "?lhs = ?rhs")
+proof
+ assume ?lhs thus ?rhs unfolding compact_eq_bolzano_weierstrass using bolzano_weierstrass_imp_bounded bolzano_weierstrass_imp_closed by auto
+next
+ assume ?rhs thus ?lhs using bounded_closed_imp_compact by auto
+qed
+
+lemma compact_imp_bounded:
+ fixes s :: "'a::metric_space set"
+ shows "compact s ==> bounded s"
+proof -
+ assume "compact s"
+ 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')"
+ by (rule compact_imp_heine_borel)
+ hence "\<forall>t. infinite t \<and> t \<subseteq> s \<longrightarrow> (\<exists>x \<in> s. x islimpt t)"
+ using heine_borel_imp_bolzano_weierstrass[of s] by auto
+ thus "bounded s"
+ by (rule bolzano_weierstrass_imp_bounded)
+qed
+
+lemma compact_imp_closed:
+ fixes s :: "'a::metric_space set"
+ shows "compact s ==> closed s"
+proof -
+ assume "compact s"
+ 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')"
+ by (rule compact_imp_heine_borel)
+ hence "\<forall>t. infinite t \<and> t \<subseteq> s \<longrightarrow> (\<exists>x \<in> s. x islimpt t)"
+ using heine_borel_imp_bolzano_weierstrass[of s] by auto
+ thus "closed s"
+ by (rule bolzano_weierstrass_imp_closed)
+qed
+
+text{* In particular, some common special cases. *}
+
+lemma compact_empty[simp]:
+ "compact {}"
+ unfolding compact_def
+ by simp
+
+(* TODO: can any of the next 3 lemmas be generalized to metric spaces? *)
+
+ (* FIXME : Rename *)
+lemma compact_union[intro]:
+ fixes s t :: "'a::heine_borel set"
+ shows "compact s \<Longrightarrow> compact t ==> compact (s \<union> t)"
+ unfolding compact_eq_bounded_closed
+ using bounded_Un[of s t]
+ using closed_Un[of s t]
+ by simp
+
+lemma compact_inter[intro]:
+ fixes s t :: "'a::heine_borel set"
+ shows "compact s \<Longrightarrow> compact t ==> compact (s \<inter> t)"
+ unfolding compact_eq_bounded_closed
+ using bounded_Int[of s t]
+ using closed_Int[of s t]
+ by simp
+
+lemma compact_inter_closed[intro]:
+ fixes s t :: "'a::heine_borel set"
+ shows "compact s \<Longrightarrow> closed t ==> compact (s \<inter> t)"
+ unfolding compact_eq_bounded_closed
+ using closed_Int[of s t]
+ using bounded_subset[of "s \<inter> t" s]
+ by blast
+
+lemma closed_inter_compact[intro]:
+ fixes s t :: "'a::heine_borel set"
+ shows "closed s \<Longrightarrow> compact t ==> compact (s \<inter> t)"
+proof-
+ assume "closed s" "compact t"
+ moreover
+ have "s \<inter> t = t \<inter> s" by auto ultimately
+ show ?thesis
+ using compact_inter_closed[of t s]
+ by auto
+qed
+
+lemma closed_sing [simp]:
+ fixes a :: "'a::metric_space"
+ shows "closed {a}"
+ apply (clarsimp simp add: closed_def open_dist)
+ apply (rule ccontr)
+ apply (drule_tac x="dist x a" in spec)
+ apply (simp add: dist_nz dist_commute)
+ done
+
+lemma finite_imp_closed:
+ fixes s :: "'a::metric_space set"
+ shows "finite s ==> closed s"
+proof (induct set: finite)
+ case empty show "closed {}" by simp
+next
+ case (insert x F)
+ hence "closed ({x} \<union> F)" by (simp only: closed_Un closed_sing)
+ thus "closed (insert x F)" by simp
+qed
+
+lemma finite_imp_compact:
+ fixes s :: "'a::heine_borel set"
+ shows "finite s ==> compact s"
+ unfolding compact_eq_bounded_closed
+ using finite_imp_closed finite_imp_bounded
+ by blast
+
+lemma compact_sing [simp]: "compact {a}"
+ unfolding compact_def o_def subseq_def
+ by (auto simp add: tendsto_const)
+
+lemma compact_cball[simp]:
+ fixes x :: "'a::heine_borel"
+ shows "compact(cball x e)"
+ using compact_eq_bounded_closed bounded_cball closed_cball
+ by blast
+
+lemma compact_frontier_bounded[intro]:
+ fixes s :: "'a::heine_borel set"
+ shows "bounded s ==> compact(frontier s)"
+ unfolding frontier_def
+ using compact_eq_bounded_closed
+ by blast
+
+lemma compact_frontier[intro]:
+ fixes s :: "'a::heine_borel set"
+ shows "compact s ==> compact (frontier s)"
+ using compact_eq_bounded_closed compact_frontier_bounded
+ by blast
+
+lemma frontier_subset_compact:
+ fixes s :: "'a::heine_borel set"
+ shows "compact s ==> frontier s \<subseteq> s"
+ using frontier_subset_closed compact_eq_bounded_closed
+ by blast
+
+lemma open_delete:
+ fixes s :: "'a::metric_space set"
+ shows "open s ==> open(s - {x})"
+ using open_Diff[of s "{x}"] closed_sing
+ by blast
+
+text{* Finite intersection property. I could make it an equivalence in fact. *}
+
+lemma compact_imp_fip:
+ fixes s :: "'a::heine_borel set"
+ assumes "compact s" "\<forall>t \<in> f. closed t"
+ "\<forall>f'. finite f' \<and> f' \<subseteq> f --> (s \<inter> (\<Inter> f') \<noteq> {})"
+ shows "s \<inter> (\<Inter> f) \<noteq> {}"
+proof
+ assume as:"s \<inter> (\<Inter> f) = {}"
+ hence "s \<subseteq> \<Union>op - UNIV ` f" by auto
+ moreover have "Ball (op - UNIV ` f) open" using open_Diff closed_Diff using assms(2) by auto
+ 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
+ hence "finite (op - UNIV ` f') \<and> op - UNIV ` f' \<subseteq> f" by(auto simp add: Diff_Diff_Int)
+ hence "s \<inter> \<Inter>op - UNIV ` f' \<noteq> {}" using assms(3)[THEN spec[where x="op - UNIV ` f'"]] by auto
+ thus False using f'(3) unfolding subset_eq and Union_iff by blast
+qed
+
+subsection{* Bounded closed nest property (proof does not use Heine-Borel). *}
+
+lemma bounded_closed_nest:
+ assumes "\<forall>n. closed(s n)" "\<forall>n. (s n \<noteq> {})"
+ "(\<forall>m n. m \<le> n --> s n \<subseteq> s m)" "bounded(s 0)"
+ shows "\<exists>a::'a::heine_borel. \<forall>n::nat. a \<in> s(n)"
+proof-
+ 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
+ from assms(4,1) have *:"compact (s 0)" using bounded_closed_imp_compact[of "s 0"] by auto
+
+ then obtain l r where lr:"l\<in>s 0" "subseq r" "((x \<circ> r) ---> l) sequentially"
+ unfolding compact_def apply(erule_tac x=x in allE) using x using assms(3) by blast
+
+ { fix n::nat
+ { fix e::real assume "e>0"
+ with lr(3) obtain N where N:"\<forall>m\<ge>N. dist ((x \<circ> r) m) l < e" unfolding Lim_sequentially by auto
+ hence "dist ((x \<circ> r) (max N n)) l < e" by auto
+ moreover
+ have "r (max N n) \<ge> n" using lr(2) using subseq_bigger[of r "max N n"] by auto
+ hence "(x \<circ> r) (max N n) \<in> s n"
+ using x apply(erule_tac x=n in allE)
+ using x apply(erule_tac x="r (max N n)" in allE)
+ using assms(3) apply(erule_tac x=n in allE)apply( erule_tac x="r (max N n)" in allE) by auto
+ ultimately have "\<exists>y\<in>s n. dist y l < e" by auto
+ }
+ hence "l \<in> s n" using closed_approachable[of "s n" l] assms(1) by blast
+ }
+ thus ?thesis by auto
+qed
+
+text{* Decreasing case does not even need compactness, just completeness. *}
+
+lemma decreasing_closed_nest:
+ assumes "\<forall>n. closed(s n)"
+ "\<forall>n. (s n \<noteq> {})"
+ "\<forall>m n. m \<le> n --> s n \<subseteq> s m"
+ "\<forall>e>0. \<exists>n. \<forall>x \<in> (s n). \<forall> y \<in> (s n). dist x y < e"
+ shows "\<exists>a::'a::heine_borel. \<forall>n::nat. a \<in> s n"
+proof-
+ have "\<forall>n. \<exists> x. x\<in>s n" using assms(2) by auto
+ hence "\<exists>t. \<forall>n. t n \<in> s n" using choice[of "\<lambda> n x. x \<in> s n"] by auto
+ then obtain t where t: "\<forall>n. t n \<in> s n" by auto
+ { fix e::real assume "e>0"
+ then obtain N where N:"\<forall>x\<in>s N. \<forall>y\<in>s N. dist x y < e" using assms(4) by auto
+ { fix m n ::nat assume "N \<le> m \<and> N \<le> n"
+ hence "t m \<in> s N" "t n \<in> s N" using assms(3) t unfolding subset_eq t by blast+
+ hence "dist (t m) (t n) < e" using N by auto
+ }
+ hence "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (t m) (t n) < e" by auto
+ }
+ hence "Cauchy t" unfolding cauchy_def by auto
+ then obtain l where l:"(t ---> l) sequentially" using complete_univ unfolding complete_def by auto
+ { fix n::nat
+ { fix e::real assume "e>0"
+ then obtain N::nat where N:"\<forall>n\<ge>N. dist (t n) l < e" using l[unfolded Lim_sequentially] by auto
+ 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
+ hence "\<exists>y\<in>s n. dist y l < e" apply(rule_tac x="t (max n N)" in bexI) using N by auto
+ }
+ hence "l \<in> s n" using closed_approachable[of "s n" l] assms(1) by auto
+ }
+ then show ?thesis by auto
+qed
+
+text{* Strengthen it to the intersection actually being a singleton. *}
+
+lemma decreasing_closed_nest_sing:
+ assumes "\<forall>n. closed(s n)"
+ "\<forall>n. s n \<noteq> {}"
+ "\<forall>m n. m \<le> n --> s n \<subseteq> s m"
+ "\<forall>e>0. \<exists>n. \<forall>x \<in> (s n). \<forall> y\<in>(s n). dist x y < e"
+ shows "\<exists>a::'a::heine_borel. \<Inter> {t. (\<exists>n::nat. t = s n)} = {a}"
+proof-
+ obtain a where a:"\<forall>n. a \<in> s n" using decreasing_closed_nest[of s] using assms by auto
+ { fix b assume b:"b \<in> \<Inter>{t. \<exists>n. t = s n}"
+ { fix e::real assume "e>0"
+ hence "dist a b < e" using assms(4 )using b using a by blast
+ }
+ hence "dist a b = 0" by (metis dist_eq_0_iff dist_nz real_less_def)
+ }
+ with a have "\<Inter>{t. \<exists>n. t = s n} = {a}" by auto
+ thus ?thesis by auto
+qed
+
+text{* Cauchy-type criteria for uniform convergence. *}
+
+lemma uniformly_convergent_eq_cauchy: fixes s::"nat \<Rightarrow> 'b \<Rightarrow> 'a::heine_borel" shows
+ "(\<exists>l. \<forall>e>0. \<exists>N. \<forall>n x. N \<le> n \<and> P x --> dist(s n x)(l x) < e) \<longleftrightarrow>
+ (\<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")
+proof(rule)
+ assume ?lhs
+ 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
+ { fix e::real assume "e>0"
+ 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
+ { fix n m::nat and x::"'b" assume "N \<le> m \<and> N \<le> n \<and> P x"
+ hence "dist (s m x) (s n x) < e"
+ using N[THEN spec[where x=m], THEN spec[where x=x]]
+ using N[THEN spec[where x=n], THEN spec[where x=x]]
+ using dist_triangle_half_l[of "s m x" "l x" e "s n x"] by auto }
+ 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 }
+ thus ?rhs by auto
+next
+ assume ?rhs
+ 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
+ then obtain l where l:"\<forall>x. P x \<longrightarrow> ((\<lambda>n. s n x) ---> l x) sequentially" unfolding convergent_eq_cauchy[THEN sym]
+ using choice[of "\<lambda>x l. P x \<longrightarrow> ((\<lambda>n. s n x) ---> l) sequentially"] by auto
+ { fix e::real assume "e>0"
+ 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"
+ using `?rhs`[THEN spec[where x="e/2"]] by auto
+ { fix x assume "P x"
+ then obtain M where M:"\<forall>n\<ge>M. dist (s n x) (l x) < e/2"
+ using l[THEN spec[where x=x], unfolded Lim_sequentially] using `e>0` by(auto elim!: allE[where x="e/2"])
+ fix n::nat assume "n\<ge>N"
+ 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]]
+ 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) }
+ hence "\<exists>N. \<forall>n x. N \<le> n \<and> P x \<longrightarrow> dist(s n x)(l x) < e" by auto }
+ thus ?lhs by auto
+qed
+
+lemma uniformly_cauchy_imp_uniformly_convergent:
+ fixes s :: "nat \<Rightarrow> 'a \<Rightarrow> 'b::heine_borel"
+ 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"
+ "\<forall>x. P x --> (\<forall>e>0. \<exists>N. \<forall>n. N \<le> n --> dist(s n x)(l x) < e)"
+ shows "\<forall>e>0. \<exists>N. \<forall>n x. N \<le> n \<and> P x --> dist(s n x)(l x) < e"
+proof-
+ 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"
+ using assms(1) unfolding uniformly_convergent_eq_cauchy[THEN sym] by auto
+ moreover
+ { fix x assume "P x"
+ hence "l x = l' x" using Lim_unique[OF trivial_limit_sequentially, of "\<lambda>n. s n x" "l x" "l' x"]
+ using l and assms(2) unfolding Lim_sequentially by blast }
+ ultimately show ?thesis by auto
+qed
+
+subsection{* Define continuity over a net to take in restrictions of the set. *}
+
+definition
+ continuous :: "'a::t2_space net \<Rightarrow> ('a \<Rightarrow> 'b::topological_space) \<Rightarrow> bool" where
+ "continuous net f \<longleftrightarrow> (f ---> f(netlimit net)) net"
+
+lemma continuous_trivial_limit:
+ "trivial_limit net ==> continuous net f"
+ unfolding continuous_def tendsto_def trivial_limit_eq by auto
+
+lemma continuous_within: "continuous (at x within s) f \<longleftrightarrow> (f ---> f(x)) (at x within s)"
+ unfolding continuous_def
+ unfolding tendsto_def
+ using netlimit_within[of x s]
+ by (cases "trivial_limit (at x within s)") (auto simp add: trivial_limit_eventually)
+
+lemma continuous_at: "continuous (at x) f \<longleftrightarrow> (f ---> f(x)) (at x)"
+ using continuous_within [of x UNIV f] by (simp add: within_UNIV)
+
+lemma continuous_at_within:
+ assumes "continuous (at x) f" shows "continuous (at x within s) f"
+ using assms unfolding continuous_at continuous_within
+ by (rule Lim_at_within)
+
+text{* Derive the epsilon-delta forms, which we often use as "definitions" *}
+
+lemma continuous_within_eps_delta:
+ "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)"
+ unfolding continuous_within and Lim_within
+ apply auto unfolding dist_nz[THEN sym] apply(auto elim!:allE) apply(rule_tac x=d in exI) by auto
+
+lemma continuous_at_eps_delta: "continuous (at x) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0.
+ \<forall>x'. dist x' x < d --> dist(f x')(f x) < e)"
+ using continuous_within_eps_delta[of x UNIV f]
+ unfolding within_UNIV by blast
+
+text{* Versions in terms of open balls. *}
+
+lemma continuous_within_ball:
+ "continuous (at x within s) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0.
+ f ` (ball x d \<inter> s) \<subseteq> ball (f x) e)" (is "?lhs = ?rhs")
+proof
+ assume ?lhs
+ { fix e::real assume "e>0"
+ 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 `?lhs`[unfolded continuous_within Lim_within] by auto
+ { fix y assume "y\<in>f ` (ball x d \<inter> s)"
+ hence "y \<in> ball (f x) e" using d(2) unfolding dist_nz[THEN sym]
+ apply (auto simp add: dist_commute mem_ball) apply(erule_tac x=xa in ballE) apply auto using `e>0` by auto
+ }
+ 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) }
+ thus ?rhs by auto
+next
+ assume ?rhs thus ?lhs unfolding continuous_within Lim_within ball_def subset_eq
+ apply (auto simp add: dist_commute) apply(erule_tac x=e in allE) by auto
+qed
+
+lemma continuous_at_ball:
+ "continuous (at x) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0. f ` (ball x d) \<subseteq> ball (f x) e)" (is "?lhs = ?rhs")
+proof
+ assume ?lhs thus ?rhs unfolding continuous_at Lim_at subset_eq Ball_def Bex_def image_iff mem_ball
+ 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)
+ unfolding dist_nz[THEN sym] by auto
+next
+ assume ?rhs thus ?lhs unfolding continuous_at Lim_at subset_eq Ball_def Bex_def image_iff mem_ball
+ 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)
+qed
+
+text{* For setwise continuity, just start from the epsilon-delta definitions. *}
+
+definition
+ continuous_on :: "'a::metric_space set \<Rightarrow> ('a \<Rightarrow> 'b::metric_space) \<Rightarrow> bool" where
+ "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)"
+
+
+definition
+ uniformly_continuous_on ::
+ "'a::metric_space set \<Rightarrow> ('a \<Rightarrow> 'b::metric_space) \<Rightarrow> bool" where
+ "uniformly_continuous_on s f \<longleftrightarrow>
+ (\<forall>e>0. \<exists>d>0. \<forall>x\<in>s. \<forall> x'\<in>s. dist x' x < d
+ --> dist (f x') (f x) < e)"
+
+text{* Some simple consequential lemmas. *}
+
+lemma uniformly_continuous_imp_continuous:
+ " uniformly_continuous_on s f ==> continuous_on s f"
+ unfolding uniformly_continuous_on_def continuous_on_def by blast
+
+lemma continuous_at_imp_continuous_within:
+ "continuous (at x) f ==> continuous (at x within s) f"
+ unfolding continuous_within continuous_at using Lim_at_within by auto
+
+lemma continuous_at_imp_continuous_on: assumes "(\<forall>x \<in> s. continuous (at x) f)"
+ shows "continuous_on s f"
+proof(simp add: continuous_at continuous_on_def, rule, rule, rule)
+ fix x and e::real assume "x\<in>s" "e>0"
+ hence "eventually (\<lambda>xa. dist (f xa) (f x) < e) (at x)" using assms unfolding continuous_at tendsto_iff by auto
+ 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
+ { fix x' assume "\<not> 0 < dist x' x"
+ hence "x=x'"
+ using dist_nz[of x' x] by auto
+ hence "dist (f x') (f x) < e" using `e>0` by auto
+ }
+ thus "\<exists>d>0. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e" using d by auto
+qed
+
+lemma continuous_on_eq_continuous_within:
+ "continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. continuous (at x within s) f)" (is "?lhs = ?rhs")
+proof
+ assume ?rhs
+ { fix x assume "x\<in>s"
+ fix e::real assume "e>0"
+ assume "\<exists>d>0. \<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e"
+ 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
+ { fix x' assume as:"x'\<in>s" "dist x' x < d"
+ 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) }
+ hence "\<exists>d>0. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e" using `d>0` by auto
+ }
+ thus ?lhs using `?rhs` unfolding continuous_on_def continuous_within Lim_within by auto
+next
+ assume ?lhs
+ thus ?rhs unfolding continuous_on_def continuous_within Lim_within by blast
+qed
+
+lemma continuous_on:
+ "continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. (f ---> f(x)) (at x within s))"
+ by (auto simp add: continuous_on_eq_continuous_within continuous_within)
+
+lemma continuous_on_eq_continuous_at:
+ "open s ==> (continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. continuous (at x) f))"
+ by (auto simp add: continuous_on continuous_at Lim_within_open)
+
+lemma continuous_within_subset:
+ "continuous (at x within s) f \<Longrightarrow> t \<subseteq> s
+ ==> continuous (at x within t) f"
+ unfolding continuous_within by(metis Lim_within_subset)
+
+lemma continuous_on_subset:
+ "continuous_on s f \<Longrightarrow> t \<subseteq> s ==> continuous_on t f"
+ unfolding continuous_on by (metis subset_eq Lim_within_subset)
+
+lemma continuous_on_interior:
+ "continuous_on s f \<Longrightarrow> x \<in> interior s ==> continuous (at x) f"
+unfolding interior_def
+apply simp
+by (meson continuous_on_eq_continuous_at continuous_on_subset)
+
+lemma continuous_on_eq:
+ "(\<forall>x \<in> s. f x = g x) \<Longrightarrow> continuous_on s f
+ ==> continuous_on s g"
+ by (simp add: continuous_on_def)
+
+text{* Characterization of various kinds of continuity in terms of sequences. *}
+
+(* \<longrightarrow> could be generalized, but \<longleftarrow> requires metric space *)
+lemma continuous_within_sequentially:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
+ shows "continuous (at a within s) f \<longleftrightarrow>
+ (\<forall>x. (\<forall>n::nat. x n \<in> s) \<and> (x ---> a) sequentially
+ --> ((f o x) ---> f a) sequentially)" (is "?lhs = ?rhs")
+proof
+ assume ?lhs
+ { 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"
+ fix e::real assume "e>0"
+ 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
+ from x(2) `d>0` obtain N where N:"\<forall>n\<ge>N. dist (x n) a < d" by auto
+ hence "\<exists>N. \<forall>n\<ge>N. dist ((f \<circ> x) n) (f a) < e"
+ apply(rule_tac x=N in exI) using N d apply auto using x(1)
+ apply(erule_tac x=n in allE) apply(erule_tac x=n in allE)
+ apply(erule_tac x="x n" in ballE) apply auto unfolding dist_nz[THEN sym] apply auto using `e>0` by auto
+ }
+ thus ?rhs unfolding continuous_within unfolding Lim_sequentially by simp
+next
+ assume ?rhs
+ { fix e::real assume "e>0"
+ 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)"
+ 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
+ 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)"
+ 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
+ { fix d::real assume "d>0"
+ 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
+ then obtain N::nat where N:"inverse (real (N + 1)) < d" by auto
+ { fix n::nat assume n:"n\<ge>N"
+ hence "dist (x (inverse (real (n + 1)))) a < inverse (real (n + 1))" using x[THEN spec[where x="inverse (real (n + 1))"]] by auto
+ 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)
+ ultimately have "dist (x (inverse (real (n + 1)))) a < d" by auto
+ }
+ hence "\<exists>N::nat. \<forall>n\<ge>N. dist (x (inverse (real (n + 1)))) a < d" by auto
+ }
+ 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
+ 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
+ hence "False" apply(erule_tac x=e in allE) using `e>0` using x by auto
+ }
+ thus ?lhs unfolding continuous_within unfolding Lim_within unfolding Lim_sequentially by blast
+qed
+
+lemma continuous_at_sequentially:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
+ shows "continuous (at a) f \<longleftrightarrow> (\<forall>x. (x ---> a) sequentially
+ --> ((f o x) ---> f a) sequentially)"
+ using continuous_within_sequentially[of a UNIV f] unfolding within_UNIV by auto
+
+lemma continuous_on_sequentially:
+ "continuous_on s f \<longleftrightarrow> (\<forall>x. \<forall>a \<in> s. (\<forall>n. x(n) \<in> s) \<and> (x ---> a) sequentially
+ --> ((f o x) ---> f(a)) sequentially)" (is "?lhs = ?rhs")
+proof
+ assume ?rhs thus ?lhs using continuous_within_sequentially[of _ s f] unfolding continuous_on_eq_continuous_within by auto
+next
+ assume ?lhs thus ?rhs unfolding continuous_on_eq_continuous_within using continuous_within_sequentially[of _ s f] by auto
+qed
+
+lemma uniformly_continuous_on_sequentially:
+ fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
+ shows "uniformly_continuous_on s f \<longleftrightarrow> (\<forall>x y. (\<forall>n. x n \<in> s) \<and> (\<forall>n. y n \<in> s) \<and>
+ ((\<lambda>n. x n - y n) ---> 0) sequentially
+ \<longrightarrow> ((\<lambda>n. f(x n) - f(y n)) ---> 0) sequentially)" (is "?lhs = ?rhs")
+proof
+ assume ?lhs
+ { 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"
+ { fix e::real assume "e>0"
+ 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"
+ using `?lhs`[unfolded uniformly_continuous_on_def, THEN spec[where x=e]] by auto
+ 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
+ { fix n assume "n\<ge>N"
+ hence "norm (f (x n) - f (y n) - 0) < e"
+ 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
+ unfolding dist_commute and dist_norm by simp }
+ hence "\<exists>N. \<forall>n\<ge>N. norm (f (x n) - f (y n) - 0) < e" by auto }
+ hence "((\<lambda>n. f(x n) - f(y n)) ---> 0) sequentially" unfolding Lim_sequentially and dist_norm by auto }
+ thus ?rhs by auto
+next
+ assume ?rhs
+ { assume "\<not> ?lhs"
+ 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
+ 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"
+ 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
+ by (auto simp add: dist_commute)
+ def x \<equiv> "\<lambda>n::nat. fst (fa (inverse (real n + 1)))"
+ def y \<equiv> "\<lambda>n::nat. snd (fa (inverse (real n + 1)))"
+ 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"
+ unfolding x_def and y_def using fa by auto
+ have 1:"\<And>(x::'a) y. dist (x - y) 0 = dist x y" unfolding dist_norm by auto
+ have 2:"\<And>(x::'b) y. dist (x - y) 0 = dist x y" unfolding dist_norm by auto
+ { fix e::real assume "e>0"
+ 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
+ { fix n::nat assume "n\<ge>N"
+ hence "inverse (real n + 1) < inverse (real N)" using real_of_nat_ge_zero and `N\<noteq>0` by auto
+ also have "\<dots> < e" using N by auto
+ finally have "inverse (real n + 1) < e" by auto
+ hence "dist (x n - y n) 0 < e" unfolding 1 using xy0[THEN spec[where x=n]] by auto }
+ hence "\<exists>N. \<forall>n\<ge>N. dist (x n - y n) 0 < e" by auto }
+ 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
+ hence False unfolding 2 using fxy and `e>0` by auto }
+ thus ?lhs unfolding uniformly_continuous_on_def by blast
+qed
+
+text{* The usual transformation theorems. *}
+
+lemma continuous_transform_within:
+ fixes f g :: "'a::metric_space \<Rightarrow> 'b::metric_space"
+ assumes "0 < d" "x \<in> s" "\<forall>x' \<in> s. dist x' x < d --> f x' = g x'"
+ "continuous (at x within s) f"
+ shows "continuous (at x within s) g"
+proof-
+ { fix e::real assume "e>0"
+ 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
+ { fix x' assume "x'\<in>s" "0 < dist x' x" "dist x' x < (min d d')"
+ hence "dist (f x') (g x) < e" using assms(2,3) apply(erule_tac x=x in ballE) using d' by auto }
+ 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
+ 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 }
+ hence "(f ---> g x) (at x within s)" unfolding Lim_within using assms(1) by auto
+ thus ?thesis unfolding continuous_within using Lim_transform_within[of d s x f g "g x"] using assms by blast
+qed
+
+lemma continuous_transform_at:
+ fixes f g :: "'a::metric_space \<Rightarrow> 'b::metric_space"
+ assumes "0 < d" "\<forall>x'. dist x' x < d --> f x' = g x'"
+ "continuous (at x) f"
+ shows "continuous (at x) g"
+proof-
+ { fix e::real assume "e>0"
+ 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
+ { fix x' assume "0 < dist x' x" "dist x' x < (min d d')"
+ hence "dist (f x') (g x) < e" using assms(2) apply(erule_tac x=x in allE) using d' by auto
+ }
+ hence "\<forall>xa. 0 < dist xa x \<and> dist xa x < (min d d') \<longrightarrow> dist (f xa) (g x) < e" by blast
+ 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
+ }
+ hence "(f ---> g x) (at x)" unfolding Lim_at using assms(1) by auto
+ thus ?thesis unfolding continuous_at using Lim_transform_at[of d x f g "g x"] using assms by blast
+qed
+
+text{* Combination results for pointwise continuity. *}
+
+lemma continuous_const: "continuous net (\<lambda>x. c)"
+ by (auto simp add: continuous_def Lim_const)
+
+lemma continuous_cmul:
+ fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
+ shows "continuous net f ==> continuous net (\<lambda>x. c *\<^sub>R f x)"
+ by (auto simp add: continuous_def Lim_cmul)
+
+lemma continuous_neg:
+ fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
+ shows "continuous net f ==> continuous net (\<lambda>x. -(f x))"
+ by (auto simp add: continuous_def Lim_neg)
+
+lemma continuous_add:
+ fixes f g :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
+ shows "continuous net f \<Longrightarrow> continuous net g \<Longrightarrow> continuous net (\<lambda>x. f x + g x)"
+ by (auto simp add: continuous_def Lim_add)
+
+lemma continuous_sub:
+ fixes f g :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
+ shows "continuous net f \<Longrightarrow> continuous net g \<Longrightarrow> continuous net (\<lambda>x. f x - g x)"
+ by (auto simp add: continuous_def Lim_sub)
+
+text{* Same thing for setwise continuity. *}
+
+lemma continuous_on_const:
+ "continuous_on s (\<lambda>x. c)"
+ unfolding continuous_on_eq_continuous_within using continuous_const by blast
+
+lemma continuous_on_cmul:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
+ shows "continuous_on s f ==> continuous_on s (\<lambda>x. c *\<^sub>R (f x))"
+ unfolding continuous_on_eq_continuous_within using continuous_cmul by blast
+
+lemma continuous_on_neg:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
+ shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. - f x)"
+ unfolding continuous_on_eq_continuous_within using continuous_neg by blast
+
+lemma continuous_on_add:
+ fixes f g :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
+ shows "continuous_on s f \<Longrightarrow> continuous_on s g
+ \<Longrightarrow> continuous_on s (\<lambda>x. f x + g x)"
+ unfolding continuous_on_eq_continuous_within using continuous_add by blast
+
+lemma continuous_on_sub:
+ fixes f g :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
+ shows "continuous_on s f \<Longrightarrow> continuous_on s g
+ \<Longrightarrow> continuous_on s (\<lambda>x. f x - g x)"
+ unfolding continuous_on_eq_continuous_within using continuous_sub by blast
+
+text{* Same thing for uniform continuity, using sequential formulations. *}
+
+lemma uniformly_continuous_on_const:
+ "uniformly_continuous_on s (\<lambda>x. c)"
+ unfolding uniformly_continuous_on_def by simp
+
+lemma uniformly_continuous_on_cmul:
+ fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
+ (* FIXME: generalize 'a to metric_space *)
+ assumes "uniformly_continuous_on s f"
+ shows "uniformly_continuous_on s (\<lambda>x. c *\<^sub>R f(x))"
+proof-
+ { fix x y assume "((\<lambda>n. f (x n) - f (y n)) ---> 0) sequentially"
+ hence "((\<lambda>n. c *\<^sub>R f (x n) - c *\<^sub>R f (y n)) ---> 0) sequentially"
+ using Lim_cmul[of "(\<lambda>n. f (x n) - f (y n))" 0 sequentially c]
+ unfolding scaleR_zero_right scaleR_right_diff_distrib by auto
+ }
+ thus ?thesis using assms unfolding uniformly_continuous_on_sequentially by auto
+qed
+
+lemma dist_minus:
+ fixes x y :: "'a::real_normed_vector"
+ shows "dist (- x) (- y) = dist x y"
+ unfolding dist_norm minus_diff_minus norm_minus_cancel ..
+
+lemma uniformly_continuous_on_neg:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
+ shows "uniformly_continuous_on s f
+ ==> uniformly_continuous_on s (\<lambda>x. -(f x))"
+ unfolding uniformly_continuous_on_def dist_minus .
+
+lemma uniformly_continuous_on_add:
+ fixes f g :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector" (* FIXME: generalize 'a *)
+ assumes "uniformly_continuous_on s f" "uniformly_continuous_on s g"
+ shows "uniformly_continuous_on s (\<lambda>x. f x + g x)"
+proof-
+ { fix x y assume "((\<lambda>n. f (x n) - f (y n)) ---> 0) sequentially"
+ "((\<lambda>n. g (x n) - g (y n)) ---> 0) sequentially"
+ hence "((\<lambda>xa. f (x xa) - f (y xa) + (g (x xa) - g (y xa))) ---> 0 + 0) sequentially"
+ 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
+ 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 }
+ thus ?thesis using assms unfolding uniformly_continuous_on_sequentially by auto
+qed
+
+lemma uniformly_continuous_on_sub:
+ fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector" (* FIXME: generalize 'a *)
+ shows "uniformly_continuous_on s f \<Longrightarrow> uniformly_continuous_on s g
+ ==> uniformly_continuous_on s (\<lambda>x. f x - g x)"
+ unfolding ab_diff_minus
+ using uniformly_continuous_on_add[of s f "\<lambda>x. - g x"]
+ using uniformly_continuous_on_neg[of s g] by auto
+
+text{* Identity function is continuous in every sense. *}
+
+lemma continuous_within_id:
+ "continuous (at a within s) (\<lambda>x. x)"
+ unfolding continuous_within by (rule Lim_at_within [OF Lim_ident_at])
+
+lemma continuous_at_id:
+ "continuous (at a) (\<lambda>x. x)"
+ unfolding continuous_at by (rule Lim_ident_at)
+
+lemma continuous_on_id:
+ "continuous_on s (\<lambda>x. x)"
+ unfolding continuous_on Lim_within by auto
+
+lemma uniformly_continuous_on_id:
+ "uniformly_continuous_on s (\<lambda>x. x)"
+ unfolding uniformly_continuous_on_def by auto
+
+text{* Continuity of all kinds is preserved under composition. *}
+
+lemma continuous_within_compose:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
+ fixes g :: "'b::metric_space \<Rightarrow> 'c::metric_space"
+ assumes "continuous (at x within s) f" "continuous (at (f x) within f ` s) g"
+ shows "continuous (at x within s) (g o f)"
+proof-
+ { fix e::real assume "e>0"
+ 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
+ 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
+ { fix y assume as:"y\<in>s" "0 < dist y x" "dist y x < d'"
+ hence "dist (f y) (f x) < d" using d'[THEN bspec[where x=y]] by (auto simp add:dist_commute)
+ 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 }
+ 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 }
+ thus ?thesis unfolding continuous_within Lim_within by auto
+qed
+
+lemma continuous_at_compose:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
+ fixes g :: "'b::metric_space \<Rightarrow> 'c::metric_space"
+ assumes "continuous (at x) f" "continuous (at (f x)) g"
+ shows "continuous (at x) (g o f)"
+proof-
+ 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
+ thus ?thesis using assms(1) using continuous_within_compose[of x UNIV f g, unfolded within_UNIV] by auto
+qed
+
+lemma continuous_on_compose:
+ "continuous_on s f \<Longrightarrow> continuous_on (f ` s) g \<Longrightarrow> continuous_on s (g o f)"
+ unfolding continuous_on_eq_continuous_within using continuous_within_compose[of _ s f g] by auto
+
+lemma uniformly_continuous_on_compose:
+ assumes "uniformly_continuous_on s f" "uniformly_continuous_on (f ` s) g"
+ shows "uniformly_continuous_on s (g o f)"
+proof-
+ { fix e::real assume "e>0"
+ 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
+ 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
+ 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 }
+ thus ?thesis using assms unfolding uniformly_continuous_on_def by auto
+qed
+
+text{* Continuity in terms of open preimages. *}
+
+lemma continuous_at_open:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
+ 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")
+proof
+ assume ?lhs
+ { fix t assume as: "open t" "f x \<in> t"
+ then obtain e where "e>0" and e:"ball (f x) e \<subseteq> t" unfolding open_contains_ball by auto
+
+ 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
+
+ have "open (ball x d)" using open_ball by auto
+ moreover have "x \<in> ball x d" unfolding centre_in_ball using `d>0` by simp
+ moreover
+ { fix x' assume "x'\<in>ball x d" hence "f x' \<in> t"
+ using e[unfolded subset_eq Ball_def mem_ball, THEN spec[where x="f x'"]] d[THEN spec[where x=x']]
+ unfolding mem_ball apply (auto simp add: dist_commute)
+ unfolding dist_nz[THEN sym] using as(2) by auto }
+ hence "\<forall>x'\<in>ball x d. f x' \<in> t" by auto
+ ultimately have "\<exists>s. open s \<and> x \<in> s \<and> (\<forall>x'\<in>s. f x' \<in> t)"
+ apply(rule_tac x="ball x d" in exI) by simp }
+ thus ?rhs by auto
+next
+ assume ?rhs
+ { fix e::real assume "e>0"
+ 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"]]
+ unfolding centre_in_ball[of "f x" e, THEN sym] by auto
+ then obtain d where "d>0" and d:"ball x d \<subseteq> s" unfolding open_contains_ball by auto
+ { fix y assume "0 < dist y x \<and> dist y x < d"
+ hence "dist (f y) (f x) < e" using d[unfolded subset_eq Ball_def mem_ball, THEN spec[where x=y]]
+ using s(3)[THEN bspec[where x=y], unfolded mem_ball] by (auto simp add: dist_commute) }
+ 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 }
+ thus ?lhs unfolding continuous_at Lim_at by auto
+qed
+
+lemma continuous_on_open:
+ "continuous_on s f \<longleftrightarrow>
+ (\<forall>t. openin (subtopology euclidean (f ` s)) t
+ --> openin (subtopology euclidean s) {x \<in> s. f x \<in> t})" (is "?lhs = ?rhs")
+proof
+ assume ?lhs
+ { fix t assume as:"openin (subtopology euclidean (f ` s)) t"
+ have "{x \<in> s. f x \<in> t} \<subseteq> s" using as[unfolded openin_euclidean_subtopology_iff] by auto
+ moreover
+ { fix x assume as':"x\<in>{x \<in> s. f x \<in> t}"
+ 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
+ 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
+ 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) }
+ ultimately have "openin (subtopology euclidean s) {x \<in> s. f x \<in> t}" unfolding openin_euclidean_subtopology_iff by auto }
+ thus ?rhs unfolding continuous_on Lim_within using openin by auto
+next
+ assume ?rhs
+ { fix e::real and x assume "x\<in>s" "e>0"
+ { 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)"
+ hence "dist (f x') (f x) < e" using dist_triangle[of "f x'" "f x" "f xa"]
+ by (auto simp add: dist_commute) }
+ 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
+ apply(rule_tac x="e - dist (f xa) (f x)" in exI) using `e>0` by (auto simp add: dist_commute)
+ 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}"
+ using `?rhs`[unfolded openin_euclidean_subtopology_iff, THEN spec[where x="ball (f x) e \<inter> f ` s"]] by auto
+ 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) }
+ thus ?lhs unfolding continuous_on Lim_within by auto
+qed
+
+(* ------------------------------------------------------------------------- *)
+(* Similarly in terms of closed sets. *)
+(* ------------------------------------------------------------------------- *)
+
+lemma continuous_on_closed:
+ "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")
+proof
+ assume ?lhs
+ { fix t
+ have *:"s - {x \<in> s. f x \<in> f ` s - t} = {x \<in> s. f x \<in> t}" by auto
+ have **:"f ` s - (f ` s - (f ` s - t)) = f ` s - t" by auto
+ assume as:"closedin (subtopology euclidean (f ` s)) t"
+ hence "closedin (subtopology euclidean (f ` s)) (f ` s - (f ` s - t))" unfolding closedin_def topspace_euclidean_subtopology unfolding ** by auto
+ 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"]]
+ unfolding openin_closedin_eq topspace_euclidean_subtopology unfolding * by auto }
+ thus ?rhs by auto
+next
+ assume ?rhs
+ { fix t
+ have *:"s - {x \<in> s. f x \<in> f ` s - t} = {x \<in> s. f x \<in> t}" by auto
+ assume as:"openin (subtopology euclidean (f ` s)) t"
+ hence "openin (subtopology euclidean s) {x \<in> s. f x \<in> t}" using `?rhs`[THEN spec[where x="(f ` s) - t"]]
+ unfolding openin_closedin_eq topspace_euclidean_subtopology *[THEN sym] closedin_subtopology by auto }
+ thus ?lhs unfolding continuous_on_open by auto
+qed
+
+text{* Half-global and completely global cases. *}
+
+lemma continuous_open_in_preimage:
+ assumes "continuous_on s f" "open t"
+ shows "openin (subtopology euclidean s) {x \<in> s. f x \<in> t}"
+proof-
+ 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
+ have "openin (subtopology euclidean (f ` s)) (t \<inter> f ` s)"
+ using openin_open_Int[of t "f ` s", OF assms(2)] unfolding openin_open by auto
+ thus ?thesis using assms(1)[unfolded continuous_on_open, THEN spec[where x="t \<inter> f ` s"]] using * by auto
+qed
+
+lemma continuous_closed_in_preimage:
+ assumes "continuous_on s f" "closed t"
+ shows "closedin (subtopology euclidean s) {x \<in> s. f x \<in> t}"
+proof-
+ 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
+ have "closedin (subtopology euclidean (f ` s)) (t \<inter> f ` s)"
+ using closedin_closed_Int[of t "f ` s", OF assms(2)] unfolding Int_commute by auto
+ thus ?thesis
+ using assms(1)[unfolded continuous_on_closed, THEN spec[where x="t \<inter> f ` s"]] using * by auto
+qed
+
+lemma continuous_open_preimage:
+ assumes "continuous_on s f" "open s" "open t"
+ shows "open {x \<in> s. f x \<in> t}"
+proof-
+ obtain T where T: "open T" "{x \<in> s. f x \<in> t} = s \<inter> T"
+ using continuous_open_in_preimage[OF assms(1,3)] unfolding openin_open by auto
+ thus ?thesis using open_Int[of s T, OF assms(2)] by auto
+qed
+
+lemma continuous_closed_preimage:
+ assumes "continuous_on s f" "closed s" "closed t"
+ shows "closed {x \<in> s. f x \<in> t}"
+proof-
+ obtain T where T: "closed T" "{x \<in> s. f x \<in> t} = s \<inter> T"
+ using continuous_closed_in_preimage[OF assms(1,3)] unfolding closedin_closed by auto
+ thus ?thesis using closed_Int[of s T, OF assms(2)] by auto
+qed
+
+lemma continuous_open_preimage_univ:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
+ shows "\<forall>x. continuous (at x) f \<Longrightarrow> open s \<Longrightarrow> open {x. f x \<in> s}"
+ using continuous_open_preimage[of UNIV f s] open_UNIV continuous_at_imp_continuous_on by auto
+
+lemma continuous_closed_preimage_univ:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
+ shows "(\<forall>x. continuous (at x) f) \<Longrightarrow> closed s ==> closed {x. f x \<in> s}"
+ using continuous_closed_preimage[of UNIV f s] closed_UNIV continuous_at_imp_continuous_on by auto
+
+lemma continuous_open_vimage:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
+ shows "\<forall>x. continuous (at x) f \<Longrightarrow> open s \<Longrightarrow> open (f -` s)"
+ unfolding vimage_def by (rule continuous_open_preimage_univ)
+
+lemma continuous_closed_vimage:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
+ shows "\<forall>x. continuous (at x) f \<Longrightarrow> closed s \<Longrightarrow> closed (f -` s)"
+ unfolding vimage_def by (rule continuous_closed_preimage_univ)
+
+text{* Equality of continuous functions on closure and related results. *}
+
+lemma continuous_closed_in_preimage_constant:
+ "continuous_on s f ==> closedin (subtopology euclidean s) {x \<in> s. f x = a}"
+ using continuous_closed_in_preimage[of s f "{a}"] closed_sing by auto
+
+lemma continuous_closed_preimage_constant:
+ "continuous_on s f \<Longrightarrow> closed s ==> closed {x \<in> s. f x = a}"
+ using continuous_closed_preimage[of s f "{a}"] closed_sing by auto
+
+lemma continuous_constant_on_closure:
+ assumes "continuous_on (closure s) f"
+ "\<forall>x \<in> s. f x = a"
+ shows "\<forall>x \<in> (closure s). f x = a"
+ using continuous_closed_preimage_constant[of "closure s" f a]
+ assms closure_minimal[of s "{x \<in> closure s. f x = a}"] closure_subset unfolding subset_eq by auto
+
+lemma image_closure_subset:
+ assumes "continuous_on (closure s) f" "closed t" "(f ` s) \<subseteq> t"
+ shows "f ` (closure s) \<subseteq> t"
+proof-
+ have "s \<subseteq> {x \<in> closure s. f x \<in> t}" using assms(3) closure_subset by auto
+ moreover have "closed {x \<in> closure s. f x \<in> t}"
+ using continuous_closed_preimage[OF assms(1)] and assms(2) by auto
+ ultimately have "closure s = {x \<in> closure s . f x \<in> t}"
+ using closure_minimal[of s "{x \<in> closure s. f x \<in> t}"] by auto
+ thus ?thesis by auto
+qed
+
+lemma continuous_on_closure_norm_le:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
+ assumes "continuous_on (closure s) f" "\<forall>y \<in> s. norm(f y) \<le> b" "x \<in> (closure s)"
+ shows "norm(f x) \<le> b"
+proof-
+ have *:"f ` s \<subseteq> cball 0 b" using assms(2)[unfolded mem_cball_0[THEN sym]] by auto
+ show ?thesis
+ using image_closure_subset[OF assms(1) closed_cball[of 0 b] *] assms(3)
+ unfolding subset_eq apply(erule_tac x="f x" in ballE) by (auto simp add: dist_norm)
+qed
+
+text{* Making a continuous function avoid some value in a neighbourhood. *}
+
+lemma continuous_within_avoid:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
+ assumes "continuous (at x within s) f" "x \<in> s" "f x \<noteq> a"
+ shows "\<exists>e>0. \<forall>y \<in> s. dist x y < e --> f y \<noteq> a"
+proof-
+ 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"
+ using assms(1)[unfolded continuous_within Lim_within, THEN spec[where x="dist (f x) a"]] assms(3)[unfolded dist_nz] by auto
+ { fix y assume " y\<in>s" "dist x y < d"
+ hence "f y \<noteq> a" using d[THEN bspec[where x=y]] assms(3)[unfolded dist_nz]
+ apply auto unfolding dist_nz[THEN sym] by (auto simp add: dist_commute) }
+ thus ?thesis using `d>0` by auto
+qed
+
+lemma continuous_at_avoid:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
+ assumes "continuous (at x) f" "f x \<noteq> a"
+ shows "\<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> f y \<noteq> a"
+using assms using continuous_within_avoid[of x UNIV f a, unfolded within_UNIV] by auto
+
+lemma continuous_on_avoid:
+ assumes "continuous_on s f" "x \<in> s" "f x \<noteq> a"
+ shows "\<exists>e>0. \<forall>y \<in> s. dist x y < e \<longrightarrow> f y \<noteq> a"
+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
+
+lemma continuous_on_open_avoid:
+ assumes "continuous_on s f" "open s" "x \<in> s" "f x \<noteq> a"
+ shows "\<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> f y \<noteq> a"
+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
+
+text{* Proving a function is constant by proving open-ness of level set. *}
+
+lemma continuous_levelset_open_in_cases:
+ "connected s \<Longrightarrow> continuous_on s f \<Longrightarrow>
+ openin (subtopology euclidean s) {x \<in> s. f x = a}
+ ==> (\<forall>x \<in> s. f x \<noteq> a) \<or> (\<forall>x \<in> s. f x = a)"
+unfolding connected_clopen using continuous_closed_in_preimage_constant by auto
+
+lemma continuous_levelset_open_in:
+ "connected s \<Longrightarrow> continuous_on s f \<Longrightarrow>
+ openin (subtopology euclidean s) {x \<in> s. f x = a} \<Longrightarrow>
+ (\<exists>x \<in> s. f x = a) ==> (\<forall>x \<in> s. f x = a)"
+using continuous_levelset_open_in_cases[of s f ]
+by meson
+
+lemma continuous_levelset_open:
+ assumes "connected s" "continuous_on s f" "open {x \<in> s. f x = a}" "\<exists>x \<in> s. f x = a"
+ shows "\<forall>x \<in> s. f x = a"
+using continuous_levelset_open_in[OF assms(1,2), of a, unfolded openin_open] using assms (3,4) by auto
+
+text{* Some arithmetical combinations (more to prove). *}
+
+lemma open_scaling[intro]:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "c \<noteq> 0" "open s"
+ shows "open((\<lambda>x. c *\<^sub>R x) ` s)"
+proof-
+ { fix x assume "x \<in> s"
+ 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
+ have "e * abs c > 0" using assms(1)[unfolded zero_less_abs_iff[THEN sym]] using real_mult_order[OF `e>0`] by auto
+ moreover
+ { fix y assume "dist y (c *\<^sub>R x) < e * \<bar>c\<bar>"
+ hence "norm ((1 / c) *\<^sub>R y - x) < e" unfolding dist_norm
+ using norm_scaleR[of c "(1 / c) *\<^sub>R y - x", unfolded scaleR_right_diff_distrib, unfolded scaleR_scaleR] assms(1)
+ assms(1)[unfolded zero_less_abs_iff[THEN sym]] by (simp del:zero_less_abs_iff)
+ 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 }
+ 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 }
+ thus ?thesis unfolding open_dist by auto
+qed
+
+lemma minus_image_eq_vimage:
+ fixes A :: "'a::ab_group_add set"
+ shows "(\<lambda>x. - x) ` A = (\<lambda>x. - x) -` A"
+ by (auto intro!: image_eqI [where f="\<lambda>x. - x"])
+
+lemma open_negations:
+ fixes s :: "'a::real_normed_vector set"
+ shows "open s ==> open ((\<lambda> x. -x) ` s)"
+ unfolding scaleR_minus1_left [symmetric]
+ by (rule open_scaling, auto)
+
+lemma open_translation:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "open s" shows "open((\<lambda>x. a + x) ` s)"
+proof-
+ { 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 }
+ 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
+ ultimately show ?thesis using continuous_open_preimage_univ[of "\<lambda>x. x - a" s] using assms by auto
+qed
+
+lemma open_affinity:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "open s" "c \<noteq> 0"
+ shows "open ((\<lambda>x. a + c *\<^sub>R x) ` s)"
+proof-
+ have *:"(\<lambda>x. a + c *\<^sub>R x) = (\<lambda>x. a + x) \<circ> (\<lambda>x. c *\<^sub>R x)" unfolding o_def ..
+ have "op + a ` op *\<^sub>R c ` s = (op + a \<circ> op *\<^sub>R c) ` s" by auto
+ thus ?thesis using assms open_translation[of "op *\<^sub>R c ` s" a] unfolding * by auto
+qed
+
+lemma interior_translation:
+ fixes s :: "'a::real_normed_vector set"
+ shows "interior ((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (interior s)"
+proof (rule set_ext, rule)
+ fix x assume "x \<in> interior (op + a ` s)"
+ then obtain e where "e>0" and e:"ball x e \<subseteq> op + a ` s" unfolding mem_interior by auto
+ 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
+ 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
+next
+ fix x assume "x \<in> op + a ` interior s"
+ 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
+ { fix z have *:"a + y - z = y + a - z" by auto
+ assume "z\<in>ball x e"
+ 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
+ hence "z \<in> op + a ` s" unfolding image_iff by(auto intro!: bexI[where x="z - a"]) }
+ hence "ball x e \<subseteq> op + a ` s" unfolding subset_eq by auto
+ thus "x \<in> interior (op + a ` s)" unfolding mem_interior using `e>0` by auto
+qed
+
+subsection {* Preservation of compactness and connectedness under continuous function. *}
+
+lemma compact_continuous_image:
+ assumes "continuous_on s f" "compact s"
+ shows "compact(f ` s)"
+proof-
+ { fix x assume x:"\<forall>n::nat. x n \<in> f ` s"
+ 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
+ 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
+ { fix e::real assume "e>0"
+ 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
+ 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
+ { 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 }
+ hence "\<exists>N. \<forall>n\<ge>N. dist ((x \<circ> r) n) (f l) < e" by auto }
+ 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 }
+ thus ?thesis unfolding compact_def by auto
+qed
+
+lemma connected_continuous_image:
+ assumes "continuous_on s f" "connected s"
+ shows "connected(f ` s)"
+proof-
+ { fix T assume as: "T \<noteq> {}" "T \<noteq> f ` s" "openin (subtopology euclidean (f ` s)) T" "closedin (subtopology euclidean (f ` s)) T"
+ have "{x \<in> s. f x \<in> T} = {} \<or> {x \<in> s. f x \<in> T} = s"
+ using assms(1)[unfolded continuous_on_open, THEN spec[where x=T]]
+ using assms(1)[unfolded continuous_on_closed, THEN spec[where x=T]]
+ using assms(2)[unfolded connected_clopen, THEN spec[where x="{x \<in> s. f x \<in> T}"]] as(3,4) by auto
+ hence False using as(1,2)
+ using as(4)[unfolded closedin_def topspace_euclidean_subtopology] by auto }
+ thus ?thesis unfolding connected_clopen by auto
+qed
+
+text{* Continuity implies uniform continuity on a compact domain. *}
+
+lemma compact_uniformly_continuous:
+ assumes "continuous_on s f" "compact s"
+ shows "uniformly_continuous_on s f"
+proof-
+ { fix x assume x:"x\<in>s"
+ 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
+ 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 }
+ 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
+ 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)"
+ 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
+
+ { fix e::real assume "e>0"
+
+ { 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 }
+ hence "s \<subseteq> \<Union>{ball x (d x (e / 2)) |x. x \<in> s}" unfolding subset_eq by auto
+ moreover
+ { fix b assume "b\<in>{ball x (d x (e / 2)) |x. x \<in> s}" hence "open b" by auto }
+ 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
+
+ { fix x y assume "x\<in>s" "y\<in>s" and as:"dist y x < ea"
+ 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
+ hence "x\<in>ball z (d z (e / 2))" using `ea>0` unfolding subset_eq by auto
+ 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`
+ by (auto simp add: dist_commute)
+ moreover have "y\<in>ball z (d z (e / 2))" using as and `ea>0` and z[unfolded subset_eq]
+ by (auto simp add: dist_commute)
+ 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`
+ by (auto simp add: dist_commute)
+ ultimately have "dist (f y) (f x) < e" using dist_triangle_half_r[of "f z" "f x" e "f y"]
+ by (auto simp add: dist_commute) }
+ 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 }
+ thus ?thesis unfolding uniformly_continuous_on_def by auto
+qed
+
+text{* Continuity of inverse function on compact domain. *}
+
+lemma continuous_on_inverse:
+ fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
+ (* TODO: can this be generalized more? *)
+ assumes "continuous_on s f" "compact s" "\<forall>x \<in> s. g (f x) = x"
+ shows "continuous_on (f ` s) g"
+proof-
+ have *:"g ` f ` s = s" using assms(3) by (auto simp add: image_iff)
+ { fix t assume t:"closedin (subtopology euclidean (g ` f ` s)) t"
+ then obtain T where T: "closed T" "t = s \<inter> T" unfolding closedin_closed unfolding * by auto
+ have "continuous_on (s \<inter> T) f" using continuous_on_subset[OF assms(1), of "s \<inter> t"]
+ unfolding T(2) and Int_left_absorb by auto
+ moreover have "compact (s \<inter> T)"
+ using assms(2) unfolding compact_eq_bounded_closed
+ using bounded_subset[of s "s \<inter> T"] and T(1) by auto
+ ultimately have "closed (f ` t)" using T(1) unfolding T(2)
+ using compact_continuous_image [of "s \<inter> T" f] unfolding compact_eq_bounded_closed by auto
+ moreover have "{x \<in> f ` s. g x \<in> t} = f ` s \<inter> f ` t" using assms(3) unfolding T(2) by auto
+ ultimately have "closedin (subtopology euclidean (f ` s)) {x \<in> f ` s. g x \<in> t}"
+ unfolding closedin_closed by auto }
+ thus ?thesis unfolding continuous_on_closed by auto
+qed
+
+subsection{* A uniformly convergent limit of continuous functions is continuous. *}
+
+lemma norm_triangle_lt:
+ fixes x y :: "'a::real_normed_vector"
+ shows "norm x + norm y < e \<Longrightarrow> norm (x + y) < e"
+by (rule le_less_trans [OF norm_triangle_ineq])
+
+lemma continuous_uniform_limit:
+ fixes f :: "'a \<Rightarrow> 'b::metric_space \<Rightarrow> 'c::real_normed_vector"
+ assumes "\<not> (trivial_limit net)" "eventually (\<lambda>n. continuous_on s (f n)) net"
+ "\<forall>e>0. eventually (\<lambda>n. \<forall>x \<in> s. norm(f n x - g x) < e) net"
+ shows "continuous_on s g"
+proof-
+ { fix x and e::real assume "x\<in>s" "e>0"
+ 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
+ then obtain n where n:"\<forall>xa\<in>s. norm (f n xa - g xa) < e / 3" "continuous_on s (f n)"
+ 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
+ have "e / 3 > 0" using `e>0` by auto
+ 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"
+ using n(2)[unfolded continuous_on_def, THEN bspec[where x=x], OF `x\<in>s`, THEN spec[where x="e/3"]] by blast
+ { fix y assume "y\<in>s" "dist y x < d"
+ hence "dist (f n y) (f n x) < e / 3" using d[THEN bspec[where x=y]] by auto
+ 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"]
+ 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
+ hence "dist (g y) (g x) < e" unfolding dist_norm using n(1)[THEN bspec[where x=y], OF `y\<in>s`]
+ 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) }
+ hence "\<exists>d>0. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (g x') (g x) < e" using `d>0` by auto }
+ thus ?thesis unfolding continuous_on_def by auto
+qed
+
+subsection{* Topological properties of linear functions. *}
+
+lemma linear_lim_0:
+ assumes "bounded_linear f" shows "(f ---> 0) (at (0))"
+proof-
+ interpret f: bounded_linear f by fact
+ have "(f ---> f 0) (at 0)"
+ using tendsto_ident_at by (rule f.tendsto)
+ thus ?thesis unfolding f.zero .
+qed
+
+lemma linear_continuous_at:
+ assumes "bounded_linear f" shows "continuous (at a) f"
+ unfolding continuous_at using assms
+ apply (rule bounded_linear.tendsto)
+ apply (rule tendsto_ident_at)
+ done
+
+lemma linear_continuous_within:
+ shows "bounded_linear f ==> continuous (at x within s) f"
+ using continuous_at_imp_continuous_within[of x f s] using linear_continuous_at[of f] by auto
+
+lemma linear_continuous_on:
+ shows "bounded_linear f ==> continuous_on s f"
+ using continuous_at_imp_continuous_on[of s f] using linear_continuous_at[of f] by auto
+
+text{* Also bilinear functions, in composition form. *}
+
+lemma bilinear_continuous_at_compose:
+ shows "continuous (at x) f \<Longrightarrow> continuous (at x) g \<Longrightarrow> bounded_bilinear h
+ ==> continuous (at x) (\<lambda>x. h (f x) (g x))"
+ unfolding continuous_at using Lim_bilinear[of f "f x" "(at x)" g "g x" h] by auto
+
+lemma bilinear_continuous_within_compose:
+ shows "continuous (at x within s) f \<Longrightarrow> continuous (at x within s) g \<Longrightarrow> bounded_bilinear h
+ ==> continuous (at x within s) (\<lambda>x. h (f x) (g x))"
+ unfolding continuous_within using Lim_bilinear[of f "f x"] by auto
+
+lemma bilinear_continuous_on_compose:
+ shows "continuous_on s f \<Longrightarrow> continuous_on s g \<Longrightarrow> bounded_bilinear h
+ ==> continuous_on s (\<lambda>x. h (f x) (g x))"
+ 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
+ using bilinear_continuous_within_compose[of _ s f g h] by auto
+
+subsection{* Topological stuff lifted from and dropped to R *}
+
+
+lemma open_real:
+ fixes s :: "real set" shows
+ "open s \<longleftrightarrow>
+ (\<forall>x \<in> s. \<exists>e>0. \<forall>x'. abs(x' - x) < e --> x' \<in> s)" (is "?lhs = ?rhs")
+ unfolding open_dist dist_norm by simp
+
+lemma islimpt_approachable_real:
+ fixes s :: "real set"
+ shows "x islimpt s \<longleftrightarrow> (\<forall>e>0. \<exists>x'\<in> s. x' \<noteq> x \<and> abs(x' - x) < e)"
+ unfolding islimpt_approachable dist_norm by simp
+
+lemma closed_real:
+ fixes s :: "real set"
+ shows "closed s \<longleftrightarrow>
+ (\<forall>x. (\<forall>e>0. \<exists>x' \<in> s. x' \<noteq> x \<and> abs(x' - x) < e)
+ --> x \<in> s)"
+ unfolding closed_limpt islimpt_approachable dist_norm by simp
+
+lemma continuous_at_real_range:
+ fixes f :: "'a::real_normed_vector \<Rightarrow> real"
+ shows "continuous (at x) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0.
+ \<forall>x'. norm(x' - x) < d --> abs(f x' - f x) < e)"
+ unfolding continuous_at unfolding Lim_at
+ unfolding dist_nz[THEN sym] unfolding dist_norm apply auto
+ 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
+ apply(erule_tac x=e in allE) by auto
+
+lemma continuous_on_real_range:
+ fixes f :: "'a::real_normed_vector \<Rightarrow> real"
+ 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))"
+ unfolding continuous_on_def dist_norm by simp
+
+lemma continuous_at_norm: "continuous (at x) norm"
+ unfolding continuous_at by (intro tendsto_intros)
+
+lemma continuous_on_norm: "continuous_on s norm"
+unfolding continuous_on by (intro ballI tendsto_intros)
+
+lemma continuous_at_component: "continuous (at a) (\<lambda>x. x $ i)"
+unfolding continuous_at by (intro tendsto_intros)
+
+lemma continuous_on_component: "continuous_on s (\<lambda>x. x $ i)"
+unfolding continuous_on by (intro ballI tendsto_intros)
+
+lemma continuous_at_infnorm: "continuous (at x) infnorm"
+ unfolding continuous_at Lim_at o_def unfolding dist_norm
+ apply auto apply (rule_tac x=e in exI) apply auto
+ using order_trans[OF real_abs_sub_infnorm infnorm_le_norm, of _ x] by (metis xt1(7))
+
+text{* Hence some handy theorems on distance, diameter etc. of/from a set. *}
+
+lemma compact_attains_sup:
+ fixes s :: "real set"
+ assumes "compact s" "s \<noteq> {}"
+ shows "\<exists>x \<in> s. \<forall>y \<in> s. y \<le> x"
+proof-
+ from assms(1) have a:"bounded s" "closed s" unfolding compact_eq_bounded_closed by auto
+ { 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"
+ have "isLub UNIV s (rsup s)" using rsup[OF assms(2)] unfolding setle_def using as(1) by auto
+ moreover have "isUb UNIV s (rsup s - e)" unfolding isUb_def unfolding setle_def using as(4,2) by auto
+ ultimately have False using isLub_le_isUb[of UNIV s "rsup s" "rsup s - e"] using `e>0` by auto }
+ thus ?thesis using bounded_has_rsup(1)[OF a(1) assms(2)] using a(2)[unfolded closed_real, THEN spec[where x="rsup s"]]
+ apply(rule_tac x="rsup s" in bexI) by auto
+qed
+
+lemma compact_attains_inf:
+ fixes s :: "real set"
+ assumes "compact s" "s \<noteq> {}" shows "\<exists>x \<in> s. \<forall>y \<in> s. x \<le> y"
+proof-
+ from assms(1) have a:"bounded s" "closed s" unfolding compact_eq_bounded_closed by auto
+ { fix e::real assume as: "\<forall>x\<in>s. x \<ge> rinf s" "rinf s \<notin> s" "0 < e"
+ "\<forall>x'\<in>s. x' = rinf s \<or> \<not> abs (x' - rinf s) < e"
+ have "isGlb UNIV s (rinf s)" using rinf[OF assms(2)] unfolding setge_def using as(1) by auto
+ moreover
+ { fix x assume "x \<in> s"
+ hence *:"abs (x - rinf s) = x - rinf s" using as(1)[THEN bspec[where x=x]] by auto
+ have "rinf s + e \<le> x" using as(4)[THEN bspec[where x=x]] using as(2) `x\<in>s` unfolding * by auto }
+ hence "isLb UNIV s (rinf s + e)" unfolding isLb_def and setge_def by auto
+ ultimately have False using isGlb_le_isLb[of UNIV s "rinf s" "rinf s + e"] using `e>0` by auto }
+ thus ?thesis using bounded_has_rinf(1)[OF a(1) assms(2)] using a(2)[unfolded closed_real, THEN spec[where x="rinf s"]]
+ apply(rule_tac x="rinf s" in bexI) by auto
+qed
+
+lemma continuous_attains_sup:
+ fixes f :: "'a::metric_space \<Rightarrow> real"
+ shows "compact s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> continuous_on s f
+ ==> (\<exists>x \<in> s. \<forall>y \<in> s. f y \<le> f x)"
+ using compact_attains_sup[of "f ` s"]
+ using compact_continuous_image[of s f] by auto
+
+lemma continuous_attains_inf:
+ fixes f :: "'a::metric_space \<Rightarrow> real"
+ shows "compact s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> continuous_on s f
+ \<Longrightarrow> (\<exists>x \<in> s. \<forall>y \<in> s. f x \<le> f y)"
+ using compact_attains_inf[of "f ` s"]
+ using compact_continuous_image[of s f] by auto
+
+lemma distance_attains_sup:
+ assumes "compact s" "s \<noteq> {}"
+ shows "\<exists>x \<in> s. \<forall>y \<in> s. dist a y \<le> dist a x"
+proof (rule continuous_attains_sup [OF assms])
+ { fix x assume "x\<in>s"
+ have "(dist a ---> dist a x) (at x within s)"
+ by (intro tendsto_dist tendsto_const Lim_at_within Lim_ident_at)
+ }
+ thus "continuous_on s (dist a)"
+ unfolding continuous_on ..
+qed
+
+text{* For *minimal* distance, we only need closure, not compactness. *}
+
+lemma distance_attains_inf:
+ fixes a :: "'a::heine_borel"
+ assumes "closed s" "s \<noteq> {}"
+ shows "\<exists>x \<in> s. \<forall>y \<in> s. dist a x \<le> dist a y"
+proof-
+ from assms(2) obtain b where "b\<in>s" by auto
+ let ?B = "cball a (dist b a) \<inter> s"
+ have "b \<in> ?B" using `b\<in>s` by (simp add: dist_commute)
+ hence "?B \<noteq> {}" by auto
+ moreover
+ { fix x assume "x\<in>?B"
+ fix e::real assume "e>0"
+ { fix x' assume "x'\<in>?B" and as:"dist x' x < e"
+ from as have "\<bar>dist a x' - dist a x\<bar> < e"
+ unfolding abs_less_iff minus_diff_eq
+ using dist_triangle2 [of a x' x]
+ using dist_triangle [of a x x']
+ by arith
+ }
+ hence "\<exists>d>0. \<forall>x'\<in>?B. dist x' x < d \<longrightarrow> \<bar>dist a x' - dist a x\<bar> < e"
+ using `e>0` by auto
+ }
+ hence "continuous_on (cball a (dist b a) \<inter> s) (dist a)"
+ unfolding continuous_on Lim_within dist_norm real_norm_def
+ by fast
+ moreover have "compact ?B"
+ using compact_cball[of a "dist b a"]
+ unfolding compact_eq_bounded_closed
+ using bounded_Int and closed_Int and assms(1) by auto
+ 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"
+ using continuous_attains_inf[of ?B "dist a"] by fastsimp
+ thus ?thesis by fastsimp
+qed
+
+subsection{* We can now extend limit compositions to consider the scalar multiplier. *}
+
+lemma Lim_mul:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ assumes "(c ---> d) net" "(f ---> l) net"
+ shows "((\<lambda>x. c(x) *\<^sub>R f x) ---> (d *\<^sub>R l)) net"
+ using assms by (rule scaleR.tendsto)
+
+lemma Lim_vmul:
+ fixes c :: "'a \<Rightarrow> real" and v :: "'b::real_normed_vector"
+ shows "(c ---> d) net ==> ((\<lambda>x. c(x) *\<^sub>R v) ---> d *\<^sub>R v) net"
+ by (intro tendsto_intros)
+
+lemma continuous_vmul:
+ fixes c :: "'a::metric_space \<Rightarrow> real" and v :: "'b::real_normed_vector"
+ shows "continuous net c ==> continuous net (\<lambda>x. c(x) *\<^sub>R v)"
+ unfolding continuous_def using Lim_vmul[of c] by auto
+
+lemma continuous_mul:
+ fixes c :: "'a::metric_space \<Rightarrow> real"
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
+ shows "continuous net c \<Longrightarrow> continuous net f
+ ==> continuous net (\<lambda>x. c(x) *\<^sub>R f x) "
+ unfolding continuous_def by (intro tendsto_intros)
+
+lemma continuous_on_vmul:
+ fixes c :: "'a::metric_space \<Rightarrow> real" and v :: "'b::real_normed_vector"
+ shows "continuous_on s c ==> continuous_on s (\<lambda>x. c(x) *\<^sub>R v)"
+ unfolding continuous_on_eq_continuous_within using continuous_vmul[of _ c] by auto
+
+lemma continuous_on_mul:
+ fixes c :: "'a::metric_space \<Rightarrow> real"
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
+ shows "continuous_on s c \<Longrightarrow> continuous_on s f
+ ==> continuous_on s (\<lambda>x. c(x) *\<^sub>R f x)"
+ unfolding continuous_on_eq_continuous_within using continuous_mul[of _ c] by auto
+
+text{* And so we have continuity of inverse. *}
+
+lemma Lim_inv:
+ fixes f :: "'a \<Rightarrow> real"
+ assumes "(f ---> l) (net::'a net)" "l \<noteq> 0"
+ shows "((inverse o f) ---> inverse l) net"
+ unfolding o_def using assms by (rule tendsto_inverse)
+
+lemma continuous_inv:
+ fixes f :: "'a::metric_space \<Rightarrow> real"
+ shows "continuous net f \<Longrightarrow> f(netlimit net) \<noteq> 0
+ ==> continuous net (inverse o f)"
+ unfolding continuous_def using Lim_inv by auto
+
+lemma continuous_at_within_inv:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_field"
+ assumes "continuous (at a within s) f" "f a \<noteq> 0"
+ shows "continuous (at a within s) (inverse o f)"
+ using assms unfolding continuous_within o_def
+ by (intro tendsto_intros)
+
+lemma continuous_at_inv:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_field"
+ shows "continuous (at a) f \<Longrightarrow> f a \<noteq> 0
+ ==> continuous (at a) (inverse o f) "
+ using within_UNIV[THEN sym, of "at a"] using continuous_at_within_inv[of a UNIV] by auto
+
+subsection{* Preservation properties for pasted sets. *}
+
+lemma bounded_pastecart:
+ fixes s :: "('a::real_normed_vector ^ _) set" (* FIXME: generalize to metric_space *)
+ assumes "bounded s" "bounded t"
+ shows "bounded { pastecart x y | x y . (x \<in> s \<and> y \<in> t)}"
+proof-
+ 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
+ { fix x y assume "x\<in>s" "y\<in>t"
+ hence "norm x \<le> a" "norm y \<le> b" using ab by auto
+ hence "norm (pastecart x y) \<le> a + b" using norm_pastecart[of x y] by auto }
+ thus ?thesis unfolding bounded_iff by auto
+qed
+
+lemma bounded_Times:
+ assumes "bounded s" "bounded t" shows "bounded (s \<times> t)"
+proof-
+ obtain x y a b where "\<forall>z\<in>s. dist x z \<le> a" "\<forall>z\<in>t. dist y z \<le> b"
+ using assms [unfolded bounded_def] by auto
+ then have "\<forall>z\<in>s \<times> t. dist (x, y) z \<le> sqrt (a\<twosuperior> + b\<twosuperior>)"
+ by (auto simp add: dist_Pair_Pair real_sqrt_le_mono add_mono power_mono)
+ thus ?thesis unfolding bounded_any_center [where a="(x, y)"] by auto
+qed
+
+lemma closed_pastecart:
+ fixes s :: "(real ^ 'a::finite) set" (* FIXME: generalize *)
+ assumes "closed s" "closed t"
+ shows "closed {pastecart x y | x y . x \<in> s \<and> y \<in> t}"
+proof-
+ { 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"
+ { 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
+ moreover
+ { fix e::real assume "e>0"
+ 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
+ { fix n::nat assume "n\<ge>N"
+ hence "dist (fstcart (x n)) (fstcart l) < e" "dist (sndcart (x n)) (sndcart l) < e"
+ using N[THEN spec[where x=n]] dist_fstcart[of "x n" l] dist_sndcart[of "x n" l] by auto }
+ 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 }
+ ultimately have "fstcart l \<in> s" "sndcart l \<in> t"
+ using assms(1)[unfolded closed_sequential_limits, THEN spec[where x="\<lambda>n. fstcart (x n)"], THEN spec[where x="fstcart l"]]
+ using assms(2)[unfolded closed_sequential_limits, THEN spec[where x="\<lambda>n. sndcart (x n)"], THEN spec[where x="sndcart l"]]
+ unfolding Lim_sequentially by auto
+ 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 }
+ thus ?thesis unfolding closed_sequential_limits by auto
+qed
+
+lemma compact_pastecart:
+ fixes s t :: "(real ^ _) set"
+ shows "compact s \<Longrightarrow> compact t ==> compact {pastecart x y | x y . x \<in> s \<and> y \<in> t}"
+ unfolding compact_eq_bounded_closed using bounded_pastecart[of s t] closed_pastecart[of s t] by auto
+
+lemma mem_Times_iff: "x \<in> A \<times> B \<longleftrightarrow> fst x \<in> A \<and> snd x \<in> B"
+by (induct x) simp
+
+lemma compact_Times: "compact s \<Longrightarrow> compact t \<Longrightarrow> compact (s \<times> t)"
+unfolding compact_def
+apply clarify
+apply (drule_tac x="fst \<circ> f" in spec)
+apply (drule mp, simp add: mem_Times_iff)
+apply (clarify, rename_tac l1 r1)
+apply (drule_tac x="snd \<circ> f \<circ> r1" in spec)
+apply (drule mp, simp add: mem_Times_iff)
+apply (clarify, rename_tac l2 r2)
+apply (rule_tac x="(l1, l2)" in rev_bexI, simp)
+apply (rule_tac x="r1 \<circ> r2" in exI)
+apply (rule conjI, simp add: subseq_def)
+apply (drule_tac r=r2 in lim_subseq [COMP swap_prems_rl], assumption)
+apply (drule (1) tendsto_Pair) back
+apply (simp add: o_def)
+done
+
+text{* Hence some useful properties follow quite easily. *}
+
+lemma compact_scaling:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "compact s" shows "compact ((\<lambda>x. c *\<^sub>R x) ` s)"
+proof-
+ let ?f = "\<lambda>x. scaleR c x"
+ have *:"bounded_linear ?f" by (rule scaleR.bounded_linear_right)
+ show ?thesis using compact_continuous_image[of s ?f] continuous_at_imp_continuous_on[of s ?f]
+ using linear_continuous_at[OF *] assms by auto
+qed
+
+lemma compact_negations:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "compact s" shows "compact ((\<lambda>x. -x) ` s)"
+ using compact_scaling [OF assms, of "- 1"] by auto
+
+lemma compact_sums:
+ fixes s t :: "'a::real_normed_vector set"
+ assumes "compact s" "compact t" shows "compact {x + y | x y. x \<in> s \<and> y \<in> t}"
+proof-
+ have *:"{x + y | x y. x \<in> s \<and> y \<in> t} = (\<lambda>z. fst z + snd z) ` (s \<times> t)"
+ apply auto unfolding image_iff apply(rule_tac x="(xa, y)" in bexI) by auto
+ have "continuous_on (s \<times> t) (\<lambda>z. fst z + snd z)"
+ unfolding continuous_on by (rule ballI) (intro tendsto_intros)
+ thus ?thesis unfolding * using compact_continuous_image compact_Times [OF assms] by auto
+qed
+
+lemma compact_differences:
+ fixes s t :: "'a::real_normed_vector set"
+ assumes "compact s" "compact t" shows "compact {x - y | x y. x \<in> s \<and> y \<in> t}"
+proof-
+ have "{x - y | x y. x\<in>s \<and> y \<in> t} = {x + y | x y. x \<in> s \<and> y \<in> (uminus ` t)}"
+ apply auto apply(rule_tac x= xa in exI) apply auto apply(rule_tac x=xa in exI) by auto
+ thus ?thesis using compact_sums[OF assms(1) compact_negations[OF assms(2)]] by auto
+qed
+
+lemma compact_translation:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "compact s" shows "compact ((\<lambda>x. a + x) ` s)"
+proof-
+ have "{x + y |x y. x \<in> s \<and> y \<in> {a}} = (\<lambda>x. a + x) ` s" by auto
+ thus ?thesis using compact_sums[OF assms compact_sing[of a]] by auto
+qed
+
+lemma compact_affinity:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "compact s" shows "compact ((\<lambda>x. a + c *\<^sub>R x) ` s)"
+proof-
+ have "op + a ` op *\<^sub>R c ` s = (\<lambda>x. a + c *\<^sub>R x) ` s" by auto
+ thus ?thesis using compact_translation[OF compact_scaling[OF assms], of a c] by auto
+qed
+
+text{* Hence we get the following. *}
+
+lemma compact_sup_maxdistance:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "compact s" "s \<noteq> {}"
+ shows "\<exists>x\<in>s. \<exists>y\<in>s. \<forall>u\<in>s. \<forall>v\<in>s. norm(u - v) \<le> norm(x - y)"
+proof-
+ have "{x - y | x y . x\<in>s \<and> y\<in>s} \<noteq> {}" using `s \<noteq> {}` by auto
+ 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"
+ using compact_differences[OF assms(1) assms(1)]
+ 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)
+ from x(1) obtain a b where "a\<in>s" "b\<in>s" "x = a - b" by auto
+ thus ?thesis using x(2)[unfolded `x = a - b`] by blast
+qed
+
+text{* We can state this in terms of diameter of a set. *}
+
+definition "diameter s = (if s = {} then 0::real else rsup {norm(x - y) | x y. x \<in> s \<and> y \<in> s})"
+ (* TODO: generalize to class metric_space *)
+
+lemma diameter_bounded:
+ assumes "bounded s"
+ shows "\<forall>x\<in>s. \<forall>y\<in>s. norm(x - y) \<le> diameter s"
+ "\<forall>d>0. d < diameter s --> (\<exists>x\<in>s. \<exists>y\<in>s. norm(x - y) > d)"
+proof-
+ let ?D = "{norm (x - y) |x y. x \<in> s \<and> y \<in> s}"
+ obtain a where a:"\<forall>x\<in>s. norm x \<le> a" using assms[unfolded bounded_iff] by auto
+ { fix x y assume "x \<in> s" "y \<in> s"
+ 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) }
+ note * = this
+ { fix x y assume "x\<in>s" "y\<in>s" hence "s \<noteq> {}" by auto
+ have lub:"isLub UNIV ?D (rsup ?D)" using * rsup[of ?D] using `s\<noteq>{}` unfolding setle_def by auto
+ 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 }
+ moreover
+ { fix d::real assume "d>0" "d < diameter s"
+ hence "s\<noteq>{}" unfolding diameter_def by auto
+ hence lub:"isLub UNIV ?D (rsup ?D)" using * rsup[of ?D] unfolding setle_def by auto
+ have "\<exists>d' \<in> ?D. d' > d"
+ proof(rule ccontr)
+ assume "\<not> (\<exists>d'\<in>{norm (x - y) |x y. x \<in> s \<and> y \<in> s}. d < d')"
+ hence as:"\<forall>d'\<in>?D. d' \<le> d" apply auto apply(erule_tac x="norm (x - y)" in allE) by auto
+ hence "isUb UNIV ?D d" unfolding isUb_def unfolding setle_def by auto
+ thus False using `d < diameter s` `s\<noteq>{}` isLub_le_isUb[OF lub, of d] unfolding diameter_def by auto
+ qed
+ hence "\<exists>x\<in>s. \<exists>y\<in>s. norm(x - y) > d" by auto }
+ ultimately show "\<forall>x\<in>s. \<forall>y\<in>s. norm(x - y) \<le> diameter s"
+ "\<forall>d>0. d < diameter s --> (\<exists>x\<in>s. \<exists>y\<in>s. norm(x - y) > d)" by auto
+qed
+
+lemma diameter_bounded_bound:
+ "bounded s \<Longrightarrow> x \<in> s \<Longrightarrow> y \<in> s ==> norm(x - y) \<le> diameter s"
+ using diameter_bounded by blast
+
+lemma diameter_compact_attained:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "compact s" "s \<noteq> {}"
+ shows "\<exists>x\<in>s. \<exists>y\<in>s. (norm(x - y) = diameter s)"
+proof-
+ have b:"bounded s" using assms(1) by (rule compact_imp_bounded)
+ 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
+ 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)"]
+ unfolding setle_def and diameter_def by auto
+ thus ?thesis using diameter_bounded(1)[OF b, THEN bspec[where x=x], THEN bspec[where x=y], OF xys] and xys by auto
+qed
+
+text{* Related results with closure as the conclusion. *}
+
+lemma closed_scaling:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "closed s" shows "closed ((\<lambda>x. c *\<^sub>R x) ` s)"
+proof(cases "s={}")
+ case True thus ?thesis by auto
+next
+ case False
+ show ?thesis
+ proof(cases "c=0")
+ have *:"(\<lambda>x. 0) ` s = {0}" using `s\<noteq>{}` by auto
+ case True thus ?thesis apply auto unfolding * using closed_sing by auto
+ next
+ case False
+ { fix x l assume as:"\<forall>n::nat. x n \<in> scaleR c ` s" "(x ---> l) sequentially"
+ { fix n::nat have "scaleR (1 / c) (x n) \<in> s"
+ using as(1)[THEN spec[where x=n]]
+ using `c\<noteq>0` by (auto simp add: vector_smult_assoc)
+ }
+ moreover
+ { fix e::real assume "e>0"
+ hence "0 < e *\<bar>c\<bar>" using `c\<noteq>0` mult_pos_pos[of e "abs c"] by auto
+ then obtain N where "\<forall>n\<ge>N. dist (x n) l < e * \<bar>c\<bar>"
+ using as(2)[unfolded Lim_sequentially, THEN spec[where x="e * abs c"]] by auto
+ hence "\<exists>N. \<forall>n\<ge>N. dist (scaleR (1 / c) (x n)) (scaleR (1 / c) l) < e"
+ unfolding dist_norm unfolding scaleR_right_diff_distrib[THEN sym]
+ using mult_imp_div_pos_less[of "abs c" _ e] `c\<noteq>0` by auto }
+ hence "((\<lambda>n. scaleR (1 / c) (x n)) ---> scaleR (1 / c) l) sequentially" unfolding Lim_sequentially by auto
+ ultimately have "l \<in> scaleR c ` s"
+ 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"]]
+ unfolding image_iff using `c\<noteq>0` apply(rule_tac x="scaleR (1 / c) l" in bexI) by auto }
+ thus ?thesis unfolding closed_sequential_limits by fast
+ qed
+qed
+
+lemma closed_negations:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "closed s" shows "closed ((\<lambda>x. -x) ` s)"
+ using closed_scaling[OF assms, of "- 1"] by simp
+
+lemma compact_closed_sums:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "compact s" "closed t" shows "closed {x + y | x y. x \<in> s \<and> y \<in> t}"
+proof-
+ let ?S = "{x + y |x y. x \<in> s \<and> y \<in> t}"
+ { fix x l assume as:"\<forall>n. x n \<in> ?S" "(x ---> l) sequentially"
+ 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"
+ using choice[of "\<lambda>n y. x n = (fst y) + (snd y) \<and> fst y \<in> s \<and> snd y \<in> t"] by auto
+ obtain l' r where "l'\<in>s" and r:"subseq r" and lr:"(((\<lambda>n. fst (f n)) \<circ> r) ---> l') sequentially"
+ using assms(1)[unfolded compact_def, THEN spec[where x="\<lambda> n. fst (f n)"]] using f(2) by auto
+ have "((\<lambda>n. snd (f (r n))) ---> l - l') sequentially"
+ using Lim_sub[OF lim_subseq[OF r as(2)] lr] and f(1) unfolding o_def by auto
+ hence "l - l' \<in> t"
+ using assms(2)[unfolded closed_sequential_limits, THEN spec[where x="\<lambda> n. snd (f (r n))"], THEN spec[where x="l - l'"]]
+ using f(3) by auto
+ 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
+ }
+ thus ?thesis unfolding closed_sequential_limits by fast
+qed
+
+lemma closed_compact_sums:
+ fixes s t :: "'a::real_normed_vector set"
+ assumes "closed s" "compact t"
+ shows "closed {x + y | x y. x \<in> s \<and> y \<in> t}"
+proof-
+ 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
+ apply(rule_tac x=y in exI) apply auto apply(rule_tac x=y in exI) by auto
+ thus ?thesis using compact_closed_sums[OF assms(2,1)] by simp
+qed
+
+lemma compact_closed_differences:
+ fixes s t :: "'a::real_normed_vector set"
+ assumes "compact s" "closed t"
+ shows "closed {x - y | x y. x \<in> s \<and> y \<in> t}"
+proof-
+ have "{x + y |x y. x \<in> s \<and> y \<in> uminus ` t} = {x - y |x y. x \<in> s \<and> y \<in> t}"
+ apply auto apply(rule_tac x=xa in exI) apply auto apply(rule_tac x=xa in exI) by auto
+ thus ?thesis using compact_closed_sums[OF assms(1) closed_negations[OF assms(2)]] by auto
+qed
+
+lemma closed_compact_differences:
+ fixes s t :: "'a::real_normed_vector set"
+ assumes "closed s" "compact t"
+ shows "closed {x - y | x y. x \<in> s \<and> y \<in> t}"
+proof-
+ have "{x + y |x y. x \<in> s \<and> y \<in> uminus ` t} = {x - y |x y. x \<in> s \<and> y \<in> t}"
+ apply auto apply(rule_tac x=xa in exI) apply auto apply(rule_tac x=xa in exI) by auto
+ thus ?thesis using closed_compact_sums[OF assms(1) compact_negations[OF assms(2)]] by simp
+qed
+
+lemma closed_translation:
+ fixes a :: "'a::real_normed_vector"
+ assumes "closed s" shows "closed ((\<lambda>x. a + x) ` s)"
+proof-
+ have "{a + y |y. y \<in> s} = (op + a ` s)" by auto
+ thus ?thesis using compact_closed_sums[OF compact_sing[of a] assms] by auto
+qed
+
+lemma translation_UNIV:
+ fixes a :: "'a::ab_group_add" shows "range (\<lambda>x. a + x) = UNIV"
+ apply (auto simp add: image_iff) apply(rule_tac x="x - a" in exI) by auto
+
+lemma translation_diff:
+ fixes a :: "'a::ab_group_add"
+ shows "(\<lambda>x. a + x) ` (s - t) = ((\<lambda>x. a + x) ` s) - ((\<lambda>x. a + x) ` t)"
+ by auto
+
+lemma closure_translation:
+ fixes a :: "'a::real_normed_vector"
+ shows "closure ((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (closure s)"
+proof-
+ have *:"op + a ` (UNIV - s) = UNIV - op + a ` s"
+ apply auto unfolding image_iff apply(rule_tac x="x - a" in bexI) by auto
+ show ?thesis unfolding closure_interior translation_diff translation_UNIV
+ using interior_translation[of a "UNIV - s"] unfolding * by auto
+qed
+
+lemma frontier_translation:
+ fixes a :: "'a::real_normed_vector"
+ shows "frontier((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (frontier s)"
+ unfolding frontier_def translation_diff interior_translation closure_translation by auto
+
+subsection{* Separation between points and sets. *}
+
+lemma separate_point_closed:
+ fixes s :: "'a::heine_borel set"
+ shows "closed s \<Longrightarrow> a \<notin> s ==> (\<exists>d>0. \<forall>x\<in>s. d \<le> dist a x)"
+proof(cases "s = {}")
+ case True
+ thus ?thesis by(auto intro!: exI[where x=1])
+next
+ case False
+ assume "closed s" "a \<notin> s"
+ 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
+ with `x\<in>s` show ?thesis using dist_pos_lt[of a x] and`a \<notin> s` by blast
+qed
+
+lemma separate_compact_closed:
+ fixes s t :: "'a::{heine_borel, real_normed_vector} set"
+ (* TODO: does this generalize to heine_borel? *)
+ assumes "compact s" and "closed t" and "s \<inter> t = {}"
+ shows "\<exists>d>0. \<forall>x\<in>s. \<forall>y\<in>t. d \<le> dist x y"
+proof-
+ have "0 \<notin> {x - y |x y. x \<in> s \<and> y \<in> t}" using assms(3) by auto
+ 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"
+ using separate_point_closed[OF compact_closed_differences[OF assms(1,2)], of 0] by auto
+ { fix x y assume "x\<in>s" "y\<in>t"
+ hence "x - y \<in> {x - y |x y. x \<in> s \<and> y \<in> t}" by auto
+ hence "d \<le> dist (x - y) 0" using d[THEN bspec[where x="x - y"]] using dist_commute
+ by (auto simp add: dist_commute)
+ hence "d \<le> dist x y" unfolding dist_norm by auto }
+ thus ?thesis using `d>0` by auto
+qed
+
+lemma separate_closed_compact:
+ fixes s t :: "'a::{heine_borel, real_normed_vector} set"
+ assumes "closed s" and "compact t" and "s \<inter> t = {}"
+ shows "\<exists>d>0. \<forall>x\<in>s. \<forall>y\<in>t. d \<le> dist x y"
+proof-
+ have *:"t \<inter> s = {}" using assms(3) by auto
+ show ?thesis using separate_compact_closed[OF assms(2,1) *]
+ apply auto apply(rule_tac x=d in exI) apply auto apply (erule_tac x=y in ballE)
+ by (auto simp add: dist_commute)
+qed
+
+(* A cute way of denoting open and closed intervals using overloading. *)
+
+lemma interval: fixes a :: "'a::ord^'n::finite" shows
+ "{a <..< b} = {x::'a^'n. \<forall>i. a$i < x$i \<and> x$i < b$i}" and
+ "{a .. b} = {x::'a^'n. \<forall>i. a$i \<le> x$i \<and> x$i \<le> b$i}"
+ by (auto simp add: expand_set_eq vector_less_def vector_less_eq_def)
+
+lemma mem_interval: fixes a :: "'a::ord^'n::finite" shows
+ "x \<in> {a<..<b} \<longleftrightarrow> (\<forall>i. a$i < x$i \<and> x$i < b$i)"
+ "x \<in> {a .. b} \<longleftrightarrow> (\<forall>i. a$i \<le> x$i \<and> x$i \<le> b$i)"
+ using interval[of a b] by(auto simp add: expand_set_eq vector_less_def vector_less_eq_def)
+
+lemma mem_interval_1: fixes x :: "real^1" shows
+ "(x \<in> {a .. b} \<longleftrightarrow> dest_vec1 a \<le> dest_vec1 x \<and> dest_vec1 x \<le> dest_vec1 b)"
+ "(x \<in> {a<..<b} \<longleftrightarrow> dest_vec1 a < dest_vec1 x \<and> dest_vec1 x < dest_vec1 b)"
+by(simp_all add: Cart_eq vector_less_def vector_less_eq_def dest_vec1_def forall_1)
+
+lemma interval_eq_empty: fixes a :: "real^'n::finite" shows
+ "({a <..< b} = {} \<longleftrightarrow> (\<exists>i. b$i \<le> a$i))" (is ?th1) and
+ "({a .. b} = {} \<longleftrightarrow> (\<exists>i. b$i < a$i))" (is ?th2)
+proof-
+ { fix i x assume as:"b$i \<le> a$i" and x:"x\<in>{a <..< b}"
+ hence "a $ i < x $ i \<and> x $ i < b $ i" unfolding mem_interval by auto
+ hence "a$i < b$i" by auto
+ hence False using as by auto }
+ moreover
+ { assume as:"\<forall>i. \<not> (b$i \<le> a$i)"
+ let ?x = "(1/2) *\<^sub>R (a + b)"
+ { fix i
+ have "a$i < b$i" using as[THEN spec[where x=i]] by auto
+ hence "a$i < ((1/2) *\<^sub>R (a+b)) $ i" "((1/2) *\<^sub>R (a+b)) $ i < b$i"
+ unfolding vector_smult_component and vector_add_component
+ by (auto simp add: less_divide_eq_number_of1) }
+ hence "{a <..< b} \<noteq> {}" using mem_interval(1)[of "?x" a b] by auto }
+ ultimately show ?th1 by blast
+
+ { fix i x assume as:"b$i < a$i" and x:"x\<in>{a .. b}"
+ hence "a $ i \<le> x $ i \<and> x $ i \<le> b $ i" unfolding mem_interval by auto
+ hence "a$i \<le> b$i" by auto
+ hence False using as by auto }
+ moreover
+ { assume as:"\<forall>i. \<not> (b$i < a$i)"
+ let ?x = "(1/2) *\<^sub>R (a + b)"
+ { fix i
+ have "a$i \<le> b$i" using as[THEN spec[where x=i]] by auto
+ hence "a$i \<le> ((1/2) *\<^sub>R (a+b)) $ i" "((1/2) *\<^sub>R (a+b)) $ i \<le> b$i"
+ unfolding vector_smult_component and vector_add_component
+ by (auto simp add: less_divide_eq_number_of1) }
+ hence "{a .. b} \<noteq> {}" using mem_interval(2)[of "?x" a b] by auto }
+ ultimately show ?th2 by blast
+qed
+
+lemma interval_ne_empty: fixes a :: "real^'n::finite" shows
+ "{a .. b} \<noteq> {} \<longleftrightarrow> (\<forall>i. a$i \<le> b$i)" and
+ "{a <..< b} \<noteq> {} \<longleftrightarrow> (\<forall>i. a$i < b$i)"
+ unfolding interval_eq_empty[of a b] by (auto simp add: not_less not_le) (* BH: Why doesn't just "auto" work here? *)
+
+lemma subset_interval_imp: fixes a :: "real^'n::finite" shows
+ "(\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i) \<Longrightarrow> {c .. d} \<subseteq> {a .. b}" and
+ "(\<forall>i. a$i < c$i \<and> d$i < b$i) \<Longrightarrow> {c .. d} \<subseteq> {a<..<b}" and
+ "(\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i) \<Longrightarrow> {c<..<d} \<subseteq> {a .. b}" and
+ "(\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i) \<Longrightarrow> {c<..<d} \<subseteq> {a<..<b}"
+ unfolding subset_eq[unfolded Ball_def] unfolding mem_interval
+ by (auto intro: order_trans less_le_trans le_less_trans less_imp_le) (* BH: Why doesn't just "auto" work here? *)
+
+lemma interval_sing: fixes a :: "'a::linorder^'n::finite" shows
+ "{a .. a} = {a} \<and> {a<..<a} = {}"
+apply(auto simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
+apply (simp add: order_eq_iff)
+apply (auto simp add: not_less less_imp_le)
+done
+
+lemma interval_open_subset_closed: fixes a :: "'a::preorder^'n::finite" shows
+ "{a<..<b} \<subseteq> {a .. b}"
+proof(simp add: subset_eq, rule)
+ fix x
+ assume x:"x \<in>{a<..<b}"
+ { fix i
+ have "a $ i \<le> x $ i"
+ using x order_less_imp_le[of "a$i" "x$i"]
+ by(simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
+ }
+ moreover
+ { fix i
+ have "x $ i \<le> b $ i"
+ using x order_less_imp_le[of "x$i" "b$i"]
+ by(simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
+ }
+ ultimately
+ show "a \<le> x \<and> x \<le> b"
+ by(simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
+qed
+
+lemma subset_interval: fixes a :: "real^'n::finite" shows
+ "{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
+ "{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
+ "{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
+ "{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)
+proof-
+ show ?th1 unfolding subset_eq and Ball_def and mem_interval by (auto intro: order_trans)
+ 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)
+ { assume as: "{c<..<d} \<subseteq> {a .. b}" "\<forall>i. c$i < d$i"
+ hence "{c<..<d} \<noteq> {}" unfolding interval_eq_empty by (auto, drule_tac x=i in spec, simp) (* BH: Why doesn't just "auto" work? *)
+ fix i
+ (** TODO combine the following two parts as done in the HOL_light version. **)
+ { let ?x = "(\<chi> j. (if j=i then ((min (a$j) (d$j))+c$j)/2 else (c$j+d$j)/2))::real^'n"
+ assume as2: "a$i > c$i"
+ { fix j
+ have "c $ j < ?x $ j \<and> ?x $ j < d $ j" unfolding Cart_lambda_beta
+ apply(cases "j=i") using as(2)[THEN spec[where x=j]]
+ by (auto simp add: less_divide_eq_number_of1 as2) }
+ hence "?x\<in>{c<..<d}" unfolding mem_interval by auto
+ moreover
+ have "?x\<notin>{a .. b}"
+ unfolding mem_interval apply auto apply(rule_tac x=i in exI)
+ using as(2)[THEN spec[where x=i]] and as2
+ by (auto simp add: less_divide_eq_number_of1)
+ ultimately have False using as by auto }
+ hence "a$i \<le> c$i" by(rule ccontr)auto
+ moreover
+ { let ?x = "(\<chi> j. (if j=i then ((max (b$j) (c$j))+d$j)/2 else (c$j+d$j)/2))::real^'n"
+ assume as2: "b$i < d$i"
+ { fix j
+ have "d $ j > ?x $ j \<and> ?x $ j > c $ j" unfolding Cart_lambda_beta
+ apply(cases "j=i") using as(2)[THEN spec[where x=j]]
+ by (auto simp add: less_divide_eq_number_of1 as2) }
+ hence "?x\<in>{c<..<d}" unfolding mem_interval by auto
+ moreover
+ have "?x\<notin>{a .. b}"
+ unfolding mem_interval apply auto apply(rule_tac x=i in exI)
+ using as(2)[THEN spec[where x=i]] and as2
+ by (auto simp add: less_divide_eq_number_of1)
+ ultimately have False using as by auto }
+ hence "b$i \<ge> d$i" by(rule ccontr)auto
+ ultimately
+ have "a$i \<le> c$i \<and> d$i \<le> b$i" by auto
+ } note part1 = this
+ 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)+
+ { assume as:"{c<..<d} \<subseteq> {a<..<b}" "\<forall>i. c$i < d$i"
+ fix i
+ from as(1) have "{c<..<d} \<subseteq> {a..b}" using interval_open_subset_closed[of a b] by auto
+ hence "a$i \<le> c$i \<and> d$i \<le> b$i" using part1 and as(2) by auto } note * = this
+ 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)+
+qed
+
+lemma disjoint_interval: fixes a::"real^'n::finite" shows
+ "{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
+ "{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
+ "{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
+ "{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)
+proof-
+ let ?z = "(\<chi> i. ((max (a$i) (c$i)) + (min (b$i) (d$i))) / 2)::real^'n"
+ show ?th1 ?th2 ?th3 ?th4
+ unfolding expand_set_eq and Int_iff and empty_iff and mem_interval and all_conj_distrib[THEN sym] and eq_False
+ apply (auto elim!: allE[where x="?z"])
+ apply ((rule_tac x=x in exI, force) | (rule_tac x=i in exI, force))+
+ done
+qed
+
+lemma inter_interval: fixes a :: "'a::linorder^'n::finite" shows
+ "{a .. b} \<inter> {c .. d} = {(\<chi> i. max (a$i) (c$i)) .. (\<chi> i. min (b$i) (d$i))}"
+ unfolding expand_set_eq and Int_iff and mem_interval
+ by (auto simp add: less_divide_eq_number_of1 intro!: bexI)
+
+(* Moved interval_open_subset_closed a bit upwards *)
+
+lemma open_interval_lemma: fixes x :: "real" shows
+ "a < x \<Longrightarrow> x < b ==> (\<exists>d>0. \<forall>x'. abs(x' - x) < d --> a < x' \<and> x' < b)"
+ by(rule_tac x="min (x - a) (b - x)" in exI, auto)
+
+lemma open_interval: fixes a :: "real^'n::finite" shows "open {a<..<b}"
+proof-
+ { fix x assume x:"x\<in>{a<..<b}"
+ { fix i
+ have "\<exists>d>0. \<forall>x'. abs (x' - (x$i)) < d \<longrightarrow> a$i < x' \<and> x' < b$i"
+ using x[unfolded mem_interval, THEN spec[where x=i]]
+ using open_interval_lemma[of "a$i" "x$i" "b$i"] by auto }
+
+ hence "\<forall>i. \<exists>d>0. \<forall>x'. abs (x' - (x$i)) < d \<longrightarrow> a$i < x' \<and> x' < b$i" by auto
+ 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)"
+ 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
+
+ let ?d = "Min (range d)"
+ have **:"finite (range d)" "range d \<noteq> {}" by auto
+ have "?d>0" unfolding Min_gr_iff[OF **] using d by auto
+ moreover
+ { fix x' assume as:"dist x' x < ?d"
+ { fix i
+ have "\<bar>x'$i - x $ i\<bar> < d i"
+ using norm_bound_component_lt[OF as[unfolded dist_norm], of i]
+ unfolding vector_minus_component and Min_gr_iff[OF **] by auto
+ hence "a $ i < x' $ i" "x' $ i < b $ i" using d[THEN spec[where x=i]] by auto }
+ hence "a < x' \<and> x' < b" unfolding vector_less_def by auto }
+ 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)
+ }
+ thus ?thesis unfolding open_dist using open_interval_lemma by auto
+qed
+
+lemma closed_interval: fixes a :: "real^'n::finite" shows "closed {a .. b}"
+proof-
+ { 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"*)
+ { assume xa:"a$i > x$i"
+ 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
+ hence False unfolding mem_interval and dist_norm
+ using component_le_norm[of "y-x" i, unfolded vector_minus_component] and xa by(auto elim!: allE[where x=i])
+ } hence "a$i \<le> x$i" by(rule ccontr)auto
+ moreover
+ { assume xb:"b$i < x$i"
+ 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
+ hence False unfolding mem_interval and dist_norm
+ using component_le_norm[of "y-x" i, unfolded vector_minus_component] and xb by(auto elim!: allE[where x=i])
+ } hence "x$i \<le> b$i" by(rule ccontr)auto
+ ultimately
+ have "a $ i \<le> x $ i \<and> x $ i \<le> b $ i" by auto }
+ thus ?thesis unfolding closed_limpt islimpt_approachable mem_interval by auto
+qed
+
+lemma interior_closed_interval: fixes a :: "real^'n::finite" shows
+ "interior {a .. b} = {a<..<b}" (is "?L = ?R")
+proof(rule subset_antisym)
+ show "?R \<subseteq> ?L" using interior_maximal[OF interval_open_subset_closed open_interval] by auto
+next
+ { fix x assume "\<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> {a..b}"
+ then obtain s where s:"open s" "x \<in> s" "s \<subseteq> {a..b}" by auto
+ 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
+ { fix i
+ have "dist (x - (e / 2) *\<^sub>R basis i) x < e"
+ "dist (x + (e / 2) *\<^sub>R basis i) x < e"
+ unfolding dist_norm apply auto
+ unfolding norm_minus_cancel using norm_basis[of i] and `e>0` by auto
+ hence "a $ i \<le> (x - (e / 2) *\<^sub>R basis i) $ i"
+ "(x + (e / 2) *\<^sub>R basis i) $ i \<le> b $ i"
+ using e[THEN spec[where x="x - (e/2) *\<^sub>R basis i"]]
+ and e[THEN spec[where x="x + (e/2) *\<^sub>R basis i"]]
+ unfolding mem_interval by (auto elim!: allE[where x=i])
+ hence "a $ i < x $ i" and "x $ i < b $ i"
+ unfolding vector_minus_component and vector_add_component
+ unfolding vector_smult_component and basis_component using `e>0` by auto }
+ hence "x \<in> {a<..<b}" unfolding mem_interval by auto }
+ thus "?L \<subseteq> ?R" unfolding interior_def and subset_eq by auto
+qed
+
+lemma bounded_closed_interval: fixes a :: "real^'n::finite" shows
+ "bounded {a .. b}"
+proof-
+ let ?b = "\<Sum>i\<in>UNIV. \<bar>a$i\<bar> + \<bar>b$i\<bar>"
+ { fix x::"real^'n" assume x:"\<forall>i. a $ i \<le> x $ i \<and> x $ i \<le> b $ i"
+ { fix i
+ have "\<bar>x$i\<bar> \<le> \<bar>a$i\<bar> + \<bar>b$i\<bar>" using x[THEN spec[where x=i]] by auto }
+ hence "(\<Sum>i\<in>UNIV. \<bar>x $ i\<bar>) \<le> ?b" by(rule setsum_mono)
+ hence "norm x \<le> ?b" using norm_le_l1[of x] by auto }
+ thus ?thesis unfolding interval and bounded_iff by auto
+qed
+
+lemma bounded_interval: fixes a :: "real^'n::finite" shows
+ "bounded {a .. b} \<and> bounded {a<..<b}"
+ using bounded_closed_interval[of a b]
+ using interval_open_subset_closed[of a b]
+ using bounded_subset[of "{a..b}" "{a<..<b}"]
+ by simp
+
+lemma not_interval_univ: fixes a :: "real^'n::finite" shows
+ "({a .. b} \<noteq> UNIV) \<and> ({a<..<b} \<noteq> UNIV)"
+ using bounded_interval[of a b]
+ by auto
+
+lemma compact_interval: fixes a :: "real^'n::finite" shows
+ "compact {a .. b}"
+ using bounded_closed_imp_compact using bounded_interval[of a b] using closed_interval[of a b] by auto
+
+lemma open_interval_midpoint: fixes a :: "real^'n::finite"
+ assumes "{a<..<b} \<noteq> {}" shows "((1/2) *\<^sub>R (a + b)) \<in> {a<..<b}"
+proof-
+ { fix i
+ have "a $ i < ((1 / 2) *\<^sub>R (a + b)) $ i \<and> ((1 / 2) *\<^sub>R (a + b)) $ i < b $ i"
+ using assms[unfolded interval_ne_empty, THEN spec[where x=i]]
+ unfolding vector_smult_component and vector_add_component
+ by(auto simp add: less_divide_eq_number_of1) }
+ thus ?thesis unfolding mem_interval by auto
+qed
+
+lemma open_closed_interval_convex: fixes x :: "real^'n::finite"
+ assumes x:"x \<in> {a<..<b}" and y:"y \<in> {a .. b}" and e:"0 < e" "e \<le> 1"
+ shows "(e *\<^sub>R x + (1 - e) *\<^sub>R y) \<in> {a<..<b}"
+proof-
+ { fix i
+ have "a $ i = e * a$i + (1 - e) * a$i" unfolding left_diff_distrib by simp
+ also have "\<dots> < e * x $ i + (1 - e) * y $ i" apply(rule add_less_le_mono)
+ using e unfolding mult_less_cancel_left and mult_le_cancel_left apply simp_all
+ using x unfolding mem_interval apply simp
+ using y unfolding mem_interval apply simp
+ done
+ finally have "a $ i < (e *\<^sub>R x + (1 - e) *\<^sub>R y) $ i" by auto
+ moreover {
+ have "b $ i = e * b$i + (1 - e) * b$i" unfolding left_diff_distrib by simp
+ also have "\<dots> > e * x $ i + (1 - e) * y $ i" apply(rule add_less_le_mono)
+ using e unfolding mult_less_cancel_left and mult_le_cancel_left apply simp_all
+ using x unfolding mem_interval apply simp
+ using y unfolding mem_interval apply simp
+ done
+ finally have "(e *\<^sub>R x + (1 - e) *\<^sub>R y) $ i < b $ i" by auto
+ } 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 }
+ thus ?thesis unfolding mem_interval by auto
+qed
+
+lemma closure_open_interval: fixes a :: "real^'n::finite"
+ assumes "{a<..<b} \<noteq> {}"
+ shows "closure {a<..<b} = {a .. b}"
+proof-
+ have ab:"a < b" using assms[unfolded interval_ne_empty] unfolding vector_less_def by auto
+ let ?c = "(1 / 2) *\<^sub>R (a + b)"
+ { fix x assume as:"x \<in> {a .. b}"
+ def f == "\<lambda>n::nat. x + (inverse (real n + 1)) *\<^sub>R (?c - x)"
+ { fix n assume fn:"f n < b \<longrightarrow> a < f n \<longrightarrow> f n = x" and xc:"x \<noteq> ?c"
+ have *:"0 < inverse (real n + 1)" "inverse (real n + 1) \<le> 1" unfolding inverse_le_1_iff by auto
+ have "(inverse (real n + 1)) *\<^sub>R ((1 / 2) *\<^sub>R (a + b)) + (1 - inverse (real n + 1)) *\<^sub>R x =
+ x + (inverse (real n + 1)) *\<^sub>R (((1 / 2) *\<^sub>R (a + b)) - x)"
+ by (auto simp add: algebra_simps)
+ 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
+ hence False using fn unfolding f_def using xc by(auto simp add: vector_mul_lcancel vector_ssub_ldistrib) }
+ moreover
+ { assume "\<not> (f ---> x) sequentially"
+ { fix e::real assume "e>0"
+ 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
+ then obtain N::nat where "inverse (real (N + 1)) < e" by auto
+ 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)
+ hence "\<exists>N::nat. \<forall>n\<ge>N. inverse (real n + 1) < e" by auto }
+ hence "((\<lambda>n. inverse (real n + 1)) ---> 0) sequentially"
+ unfolding Lim_sequentially by(auto simp add: dist_norm)
+ hence "(f ---> x) sequentially" unfolding f_def
+ 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]
+ using Lim_vmul[of "\<lambda>n::nat. inverse (real n + 1)" 0 sequentially "((1 / 2) *\<^sub>R (a + b) - x)"] by auto }
+ ultimately have "x \<in> closure {a<..<b}"
+ using as and open_interval_midpoint[OF assms] unfolding closure_def unfolding islimpt_sequential by(cases "x=?c")auto }
+ thus ?thesis using closure_minimal[OF interval_open_subset_closed closed_interval, of a b] by blast
+qed
+
+lemma bounded_subset_open_interval_symmetric: fixes s::"(real^'n::finite) set"
+ assumes "bounded s" shows "\<exists>a. s \<subseteq> {-a<..<a}"
+proof-
+ obtain b where "b>0" and b:"\<forall>x\<in>s. norm x \<le> b" using assms[unfolded bounded_pos] by auto
+ def a \<equiv> "(\<chi> i. b+1)::real^'n"
+ { fix x assume "x\<in>s"
+ fix i
+ 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]
+ unfolding vector_uminus_component and a_def and Cart_lambda_beta by auto
+ }
+ thus ?thesis by(auto intro: exI[where x=a] simp add: vector_less_def)
+qed
+
+lemma bounded_subset_open_interval:
+ fixes s :: "(real ^ 'n::finite) set"
+ shows "bounded s ==> (\<exists>a b. s \<subseteq> {a<..<b})"
+ by (auto dest!: bounded_subset_open_interval_symmetric)
+
+lemma bounded_subset_closed_interval_symmetric:
+ fixes s :: "(real ^ 'n::finite) set"
+ assumes "bounded s" shows "\<exists>a. s \<subseteq> {-a .. a}"
+proof-
+ obtain a where "s \<subseteq> {- a<..<a}" using bounded_subset_open_interval_symmetric[OF assms] by auto
+ thus ?thesis using interval_open_subset_closed[of "-a" a] by auto
+qed
+
+lemma bounded_subset_closed_interval:
+ fixes s :: "(real ^ 'n::finite) set"
+ shows "bounded s ==> (\<exists>a b. s \<subseteq> {a .. b})"
+ using bounded_subset_closed_interval_symmetric[of s] by auto
+
+lemma frontier_closed_interval:
+ fixes a b :: "real ^ _"
+ shows "frontier {a .. b} = {a .. b} - {a<..<b}"
+ unfolding frontier_def unfolding interior_closed_interval and closure_closed[OF closed_interval] ..
+
+lemma frontier_open_interval:
+ fixes a b :: "real ^ _"
+ shows "frontier {a<..<b} = (if {a<..<b} = {} then {} else {a .. b} - {a<..<b})"
+proof(cases "{a<..<b} = {}")
+ case True thus ?thesis using frontier_empty by auto
+next
+ case False thus ?thesis unfolding frontier_def and closure_open_interval[OF False] and interior_open[OF open_interval] by auto
+qed
+
+lemma inter_interval_mixed_eq_empty: fixes a :: "real^'n::finite"
+ assumes "{c<..<d} \<noteq> {}" shows "{a<..<b} \<inter> {c .. d} = {} \<longleftrightarrow> {a<..<b} \<inter> {c<..<d} = {}"
+ unfolding closure_open_interval[OF assms, THEN sym] unfolding open_inter_closure_eq_empty[OF open_interval] ..
+
+
+(* Some special cases for intervals in R^1. *)
+
+lemma all_1: "(\<forall>x::1. P x) \<longleftrightarrow> P 1"
+ by (metis num1_eq_iff)
+
+lemma ex_1: "(\<exists>x::1. P x) \<longleftrightarrow> P 1"
+ by auto (metis num1_eq_iff)
+
+lemma interval_cases_1: fixes x :: "real^1" shows
+ "x \<in> {a .. b} ==> x \<in> {a<..<b} \<or> (x = a) \<or> (x = b)"
+ by(simp add: Cart_eq vector_less_def vector_less_eq_def all_1, auto)
+
+lemma in_interval_1: fixes x :: "real^1" shows
+ "(x \<in> {a .. b} \<longleftrightarrow> dest_vec1 a \<le> dest_vec1 x \<and> dest_vec1 x \<le> dest_vec1 b) \<and>
+ (x \<in> {a<..<b} \<longleftrightarrow> dest_vec1 a < dest_vec1 x \<and> dest_vec1 x < dest_vec1 b)"
+by(simp add: Cart_eq vector_less_def vector_less_eq_def all_1 dest_vec1_def)
+
+lemma interval_eq_empty_1: fixes a :: "real^1" shows
+ "{a .. b} = {} \<longleftrightarrow> dest_vec1 b < dest_vec1 a"
+ "{a<..<b} = {} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a"
+ unfolding interval_eq_empty and ex_1 and dest_vec1_def by auto
+
+lemma subset_interval_1: fixes a :: "real^1" shows
+ "({a .. b} \<subseteq> {c .. d} \<longleftrightarrow> dest_vec1 b < dest_vec1 a \<or>
+ dest_vec1 c \<le> dest_vec1 a \<and> dest_vec1 a \<le> dest_vec1 b \<and> dest_vec1 b \<le> dest_vec1 d)"
+ "({a .. b} \<subseteq> {c<..<d} \<longleftrightarrow> dest_vec1 b < dest_vec1 a \<or>
+ dest_vec1 c < dest_vec1 a \<and> dest_vec1 a \<le> dest_vec1 b \<and> dest_vec1 b < dest_vec1 d)"
+ "({a<..<b} \<subseteq> {c .. d} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a \<or>
+ dest_vec1 c \<le> dest_vec1 a \<and> dest_vec1 a < dest_vec1 b \<and> dest_vec1 b \<le> dest_vec1 d)"
+ "({a<..<b} \<subseteq> {c<..<d} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a \<or>
+ dest_vec1 c \<le> dest_vec1 a \<and> dest_vec1 a < dest_vec1 b \<and> dest_vec1 b \<le> dest_vec1 d)"
+ unfolding subset_interval[of a b c d] unfolding all_1 and dest_vec1_def by auto
+
+lemma eq_interval_1: fixes a :: "real^1" shows
+ "{a .. b} = {c .. d} \<longleftrightarrow>
+ dest_vec1 b < dest_vec1 a \<and> dest_vec1 d < dest_vec1 c \<or>
+ dest_vec1 a = dest_vec1 c \<and> dest_vec1 b = dest_vec1 d"
+using set_eq_subset[of "{a .. b}" "{c .. d}"]
+using subset_interval_1(1)[of a b c d]
+using subset_interval_1(1)[of c d a b]
+by auto (* FIXME: slow *)
+
+lemma disjoint_interval_1: fixes a :: "real^1" shows
+ "{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"
+ "{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"
+ "{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"
+ "{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"
+ unfolding disjoint_interval and dest_vec1_def ex_1 by auto
+
+lemma open_closed_interval_1: fixes a :: "real^1" shows
+ "{a<..<b} = {a .. b} - {a, b}"
+ 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
+
+lemma closed_open_interval_1: "dest_vec1 (a::real^1) \<le> dest_vec1 b ==> {a .. b} = {a<..<b} \<union> {a,b}"
+ 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
+
+(* Some stuff for half-infinite intervals too; FIXME: notation? *)
+
+lemma closed_interval_left: fixes b::"real^'n::finite"
+ shows "closed {x::real^'n. \<forall>i. x$i \<le> b$i}"
+proof-
+ { fix i
+ 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"
+ { assume "x$i > b$i"
+ 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
+ hence False using component_le_norm[of "y - x" i] unfolding dist_norm and vector_minus_component by auto }
+ hence "x$i \<le> b$i" by(rule ccontr)auto }
+ thus ?thesis unfolding closed_limpt unfolding islimpt_approachable by blast
+qed
+
+lemma closed_interval_right: fixes a::"real^'n::finite"
+ shows "closed {x::real^'n. \<forall>i. a$i \<le> x$i}"
+proof-
+ { fix i
+ 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"
+ { assume "a$i > x$i"
+ 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
+ hence False using component_le_norm[of "y - x" i] unfolding dist_norm and vector_minus_component by auto }
+ hence "a$i \<le> x$i" by(rule ccontr)auto }
+ thus ?thesis unfolding closed_limpt unfolding islimpt_approachable by blast
+qed
+
+subsection{* Intervals in general, including infinite and mixtures of open and closed. *}
+
+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)"
+
+lemma is_interval_interval: "is_interval {a .. b::real^'n::finite}" (is ?th1) "is_interval {a<..<b}" (is ?th2) proof -
+ have *:"\<And>x y z::real. x < y \<Longrightarrow> y < z \<Longrightarrow> x < z" by auto
+ show ?th1 ?th2 unfolding is_interval_def mem_interval Ball_def atLeastAtMost_iff
+ by(meson real_le_trans le_less_trans less_le_trans *)+ qed
+
+lemma is_interval_empty:
+ "is_interval {}"
+ unfolding is_interval_def
+ by simp
+
+lemma is_interval_univ:
+ "is_interval UNIV"
+ unfolding is_interval_def
+ by simp
+
+subsection{* Closure of halfspaces and hyperplanes. *}
+
+lemma Lim_inner:
+ assumes "(f ---> l) net" shows "((\<lambda>y. inner a (f y)) ---> inner a l) net"
+ by (intro tendsto_intros assms)
+
+lemma continuous_at_inner: "continuous (at x) (inner a)"
+ unfolding continuous_at by (intro tendsto_intros)
+
+lemma continuous_on_inner:
+ fixes s :: "'a::real_inner set"
+ shows "continuous_on s (inner a)"
+ unfolding continuous_on by (rule ballI) (intro tendsto_intros)
+
+lemma closed_halfspace_le: "closed {x. inner a x \<le> b}"
+proof-
+ have "\<forall>x. continuous (at x) (inner a)"
+ unfolding continuous_at by (rule allI) (intro tendsto_intros)
+ hence "closed (inner a -` {..b})"
+ using closed_real_atMost by (rule continuous_closed_vimage)
+ moreover have "{x. inner a x \<le> b} = inner a -` {..b}" by auto
+ ultimately show ?thesis by simp
+qed
+
+lemma closed_halfspace_ge: "closed {x. inner a x \<ge> b}"
+ using closed_halfspace_le[of "-a" "-b"] unfolding inner_minus_left by auto
+
+lemma closed_hyperplane: "closed {x. inner a x = b}"
+proof-
+ have "{x. inner a x = b} = {x. inner a x \<ge> b} \<inter> {x. inner a x \<le> b}" by auto
+ thus ?thesis using closed_halfspace_le[of a b] and closed_halfspace_ge[of b a] using closed_Int by auto
+qed
+
+lemma closed_halfspace_component_le:
+ shows "closed {x::real^'n::finite. x$i \<le> a}"
+ using closed_halfspace_le[of "(basis i)::real^'n" a] unfolding inner_basis[OF assms] by auto
+
+lemma closed_halfspace_component_ge:
+ shows "closed {x::real^'n::finite. x$i \<ge> a}"
+ using closed_halfspace_ge[of a "(basis i)::real^'n"] unfolding inner_basis[OF assms] by auto
+
+text{* Openness of halfspaces. *}
+
+lemma open_halfspace_lt: "open {x. inner a x < b}"
+proof-
+ have "UNIV - {x. b \<le> inner a x} = {x. inner a x < b}" by auto
+ thus ?thesis using closed_halfspace_ge[unfolded closed_def Compl_eq_Diff_UNIV, of b a] by auto
+qed
+
+lemma open_halfspace_gt: "open {x. inner a x > b}"
+proof-
+ have "UNIV - {x. b \<ge> inner a x} = {x. inner a x > b}" by auto
+ thus ?thesis using closed_halfspace_le[unfolded closed_def Compl_eq_Diff_UNIV, of a b] by auto
+qed
+
+lemma open_halfspace_component_lt:
+ shows "open {x::real^'n::finite. x$i < a}"
+ using open_halfspace_lt[of "(basis i)::real^'n" a] unfolding inner_basis[OF assms] by auto
+
+lemma open_halfspace_component_gt:
+ shows "open {x::real^'n::finite. x$i > a}"
+ using open_halfspace_gt[of a "(basis i)::real^'n"] unfolding inner_basis[OF assms] by auto
+
+text{* This gives a simple derivation of limit component bounds. *}
+
+lemma Lim_component_le: fixes f :: "'a \<Rightarrow> real^'n::finite"
+ assumes "(f ---> l) net" "\<not> (trivial_limit net)" "eventually (\<lambda>x. f(x)$i \<le> b) net"
+ shows "l$i \<le> b"
+proof-
+ { 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
+ show ?thesis using Lim_in_closed_set[of "{x. inner (basis i) x \<le> b}" f net l] unfolding *
+ using closed_halfspace_le[of "(basis i)::real^'n" b] and assms(1,2,3) by auto
+qed
+
+lemma Lim_component_ge: fixes f :: "'a \<Rightarrow> real^'n::finite"
+ assumes "(f ---> l) net" "\<not> (trivial_limit net)" "eventually (\<lambda>x. b \<le> (f x)$i) net"
+ shows "b \<le> l$i"
+proof-
+ { 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
+ show ?thesis using Lim_in_closed_set[of "{x. inner (basis i) x \<ge> b}" f net l] unfolding *
+ using closed_halfspace_ge[of b "(basis i)::real^'n"] and assms(1,2,3) by auto
+qed
+
+lemma Lim_component_eq: fixes f :: "'a \<Rightarrow> real^'n::finite"
+ assumes net:"(f ---> l) net" "~(trivial_limit net)" and ev:"eventually (\<lambda>x. f(x)$i = b) net"
+ shows "l$i = b"
+ 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
+
+lemma Lim_drop_le: fixes f :: "'a \<Rightarrow> real^1" shows
+ "(f ---> l) net \<Longrightarrow> ~(trivial_limit net) \<Longrightarrow> eventually (\<lambda>x. dest_vec1 (f x) \<le> b) net ==> dest_vec1 l \<le> b"
+ using Lim_component_le[of f l net 1 b] unfolding dest_vec1_def by auto
+
+lemma Lim_drop_ge: fixes f :: "'a \<Rightarrow> real^1" shows
+ "(f ---> l) net \<Longrightarrow> ~(trivial_limit net) \<Longrightarrow> eventually (\<lambda>x. b \<le> dest_vec1 (f x)) net ==> b \<le> dest_vec1 l"
+ using Lim_component_ge[of f l net b 1] unfolding dest_vec1_def by auto
+
+text{* Limits relative to a union. *}
+
+lemma eventually_within_Un:
+ "eventually P (net within (s \<union> t)) \<longleftrightarrow>
+ eventually P (net within s) \<and> eventually P (net within t)"
+ unfolding Limits.eventually_within
+ by (auto elim!: eventually_rev_mp)
+
+lemma Lim_within_union:
+ "(f ---> l) (net within (s \<union> t)) \<longleftrightarrow>
+ (f ---> l) (net within s) \<and> (f ---> l) (net within t)"
+ unfolding tendsto_def
+ by (auto simp add: eventually_within_Un)
+
+lemma continuous_on_union:
+ assumes "closed s" "closed t" "continuous_on s f" "continuous_on t f"
+ shows "continuous_on (s \<union> t) f"
+ using assms unfolding continuous_on unfolding Lim_within_union
+ unfolding Lim unfolding trivial_limit_within unfolding closed_limpt by auto
+
+lemma continuous_on_cases:
+ assumes "closed s" "closed t" "continuous_on s f" "continuous_on t g"
+ "\<forall>x. (x\<in>s \<and> \<not> P x) \<or> (x \<in> t \<and> P x) \<longrightarrow> f x = g x"
+ shows "continuous_on (s \<union> t) (\<lambda>x. if P x then f x else g x)"
+proof-
+ let ?h = "(\<lambda>x. if P x then f x else g x)"
+ have "\<forall>x\<in>s. f x = (if P x then f x else g x)" using assms(5) by auto
+ hence "continuous_on s ?h" using continuous_on_eq[of s f ?h] using assms(3) by auto
+ moreover
+ have "\<forall>x\<in>t. g x = (if P x then f x else g x)" using assms(5) by auto
+ hence "continuous_on t ?h" using continuous_on_eq[of t g ?h] using assms(4) by auto
+ ultimately show ?thesis using continuous_on_union[OF assms(1,2), of ?h] by auto
+qed
+
+
+text{* Some more convenient intermediate-value theorem formulations. *}
+
+lemma connected_ivt_hyperplane:
+ assumes "connected s" "x \<in> s" "y \<in> s" "inner a x \<le> b" "b \<le> inner a y"
+ shows "\<exists>z \<in> s. inner a z = b"
+proof(rule ccontr)
+ assume as:"\<not> (\<exists>z\<in>s. inner a z = b)"
+ let ?A = "{x. inner a x < b}"
+ let ?B = "{x. inner a x > b}"
+ have "open ?A" "open ?B" using open_halfspace_lt and open_halfspace_gt by auto
+ moreover have "?A \<inter> ?B = {}" by auto
+ moreover have "s \<subseteq> ?A \<union> ?B" using as by auto
+ ultimately show False using assms(1)[unfolded connected_def not_ex, THEN spec[where x="?A"], THEN spec[where x="?B"]] and assms(2-5) by auto
+qed
+
+lemma connected_ivt_component: fixes x::"real^'n::finite" shows
+ "connected s \<Longrightarrow> x \<in> s \<Longrightarrow> y \<in> s \<Longrightarrow> x$k \<le> a \<Longrightarrow> a \<le> y$k \<Longrightarrow> (\<exists>z\<in>s. z$k = a)"
+ using connected_ivt_hyperplane[of s x y "(basis k)::real^'n" a] by (auto simp add: inner_basis)
+
+text{* Also more convenient formulations of monotone convergence. *}
+
+lemma bounded_increasing_convergent: fixes s::"nat \<Rightarrow> real^1"
+ assumes "bounded {s n| n::nat. True}" "\<forall>n. dest_vec1(s n) \<le> dest_vec1(s(Suc n))"
+ shows "\<exists>l. (s ---> l) sequentially"
+proof-
+ 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
+ { fix m::nat
+ have "\<And> n. n\<ge>m \<longrightarrow> dest_vec1 (s m) \<le> dest_vec1 (s n)"
+ apply(induct_tac n) apply simp using assms(2) apply(erule_tac x="na" in allE) by(auto simp add: not_less_eq_eq) }
+ hence "\<forall>m n. m \<le> n \<longrightarrow> dest_vec1 (s m) \<le> dest_vec1 (s n)" by auto
+ 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
+ thus ?thesis unfolding Lim_sequentially apply(rule_tac x="vec1 l" in exI)
+ unfolding dist_norm unfolding abs_dest_vec1 and dest_vec1_sub by auto
+qed
+
+subsection{* Basic homeomorphism definitions. *}
+
+definition "homeomorphism s t f g \<equiv>
+ (\<forall>x\<in>s. (g(f x) = x)) \<and> (f ` s = t) \<and> continuous_on s f \<and>
+ (\<forall>y\<in>t. (f(g y) = y)) \<and> (g ` t = s) \<and> continuous_on t g"
+
+definition
+ homeomorphic :: "'a::metric_space set \<Rightarrow> 'b::metric_space set \<Rightarrow> bool"
+ (infixr "homeomorphic" 60) where
+ homeomorphic_def: "s homeomorphic t \<equiv> (\<exists>f g. homeomorphism s t f g)"
+
+lemma homeomorphic_refl: "s homeomorphic s"
+ unfolding homeomorphic_def
+ unfolding homeomorphism_def
+ using continuous_on_id
+ apply(rule_tac x = "(\<lambda>x. x)" in exI)
+ apply(rule_tac x = "(\<lambda>x. x)" in exI)
+ by blast
+
+lemma homeomorphic_sym:
+ "s homeomorphic t \<longleftrightarrow> t homeomorphic s"
+unfolding homeomorphic_def
+unfolding homeomorphism_def
+by blast (* FIXME: slow *)
+
+lemma homeomorphic_trans:
+ assumes "s homeomorphic t" "t homeomorphic u" shows "s homeomorphic u"
+proof-
+ 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"
+ using assms(1) unfolding homeomorphic_def homeomorphism_def by auto
+ 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"
+ using assms(2) unfolding homeomorphic_def homeomorphism_def by auto
+
+ { 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 }
+ moreover have "(f2 \<circ> f1) ` s = u" using fg1(2) fg2(2) by auto
+ moreover have "continuous_on s (f2 \<circ> f1)" using continuous_on_compose[OF fg1(3)] and fg2(3) unfolding fg1(2) by auto
+ 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 }
+ moreover have "(g1 \<circ> g2) ` u = s" using fg1(5) fg2(5) by auto
+ moreover have "continuous_on u (g1 \<circ> g2)" using continuous_on_compose[OF fg2(6)] and fg1(6) unfolding fg2(5) by auto
+ 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
+qed
+
+lemma homeomorphic_minimal:
+ "s homeomorphic t \<longleftrightarrow>
+ (\<exists>f g. (\<forall>x\<in>s. f(x) \<in> t \<and> (g(f(x)) = x)) \<and>
+ (\<forall>y\<in>t. g(y) \<in> s \<and> (f(g(y)) = y)) \<and>
+ continuous_on s f \<and> continuous_on t g)"
+unfolding homeomorphic_def homeomorphism_def
+apply auto apply (rule_tac x=f in exI) apply (rule_tac x=g in exI)
+apply auto apply (rule_tac x=f in exI) apply (rule_tac x=g in exI) apply auto
+unfolding image_iff
+apply(erule_tac x="g x" in ballE) apply(erule_tac x="x" in ballE)
+apply auto apply(rule_tac x="g x" in bexI) apply auto
+apply(erule_tac x="f x" in ballE) apply(erule_tac x="x" in ballE)
+apply auto apply(rule_tac x="f x" in bexI) by auto
+
+subsection{* Relatively weak hypotheses if a set is compact. *}
+
+definition "inv_on f s = (\<lambda>x. SOME y. y\<in>s \<and> f y = x)"
+
+lemma assumes "inj_on f s" "x\<in>s"
+ shows "inv_on f s (f x) = x"
+ using assms unfolding inj_on_def inv_on_def by auto
+
+lemma homeomorphism_compact:
+ fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
+ (* class constraint due to continuous_on_inverse *)
+ assumes "compact s" "continuous_on s f" "f ` s = t" "inj_on f s"
+ shows "\<exists>g. homeomorphism s t f g"
+proof-
+ def g \<equiv> "\<lambda>x. SOME y. y\<in>s \<and> f y = x"
+ have g:"\<forall>x\<in>s. g (f x) = x" using assms(3) assms(4)[unfolded inj_on_def] unfolding g_def by auto
+ { fix y assume "y\<in>t"
+ then obtain x where x:"f x = y" "x\<in>s" using assms(3) by auto
+ hence "g (f x) = x" using g by auto
+ hence "f (g y) = y" unfolding x(1)[THEN sym] by auto }
+ hence g':"\<forall>x\<in>t. f (g x) = x" by auto
+ moreover
+ { fix x
+ 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"])
+ moreover
+ { assume "x\<in>g ` t"
+ then obtain y where y:"y\<in>t" "g y = x" by auto
+ then obtain x' where x':"x'\<in>s" "f x' = y" using assms(3) by auto
+ 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 }
+ ultimately have "x\<in>s \<longleftrightarrow> x \<in> g ` t" by auto }
+ hence "g ` t = s" by auto
+ ultimately
+ show ?thesis unfolding homeomorphism_def homeomorphic_def
+ 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
+qed
+
+lemma homeomorphic_compact:
+ fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
+ (* class constraint due to continuous_on_inverse *)
+ shows "compact s \<Longrightarrow> continuous_on s f \<Longrightarrow> (f ` s = t) \<Longrightarrow> inj_on f s
+ \<Longrightarrow> s homeomorphic t"
+ unfolding homeomorphic_def by(metis homeomorphism_compact)
+
+text{* Preservation of topological properties. *}
+
+lemma homeomorphic_compactness:
+ "s homeomorphic t ==> (compact s \<longleftrightarrow> compact t)"
+unfolding homeomorphic_def homeomorphism_def
+by (metis compact_continuous_image)
+
+text{* Results on translation, scaling etc. *}
+
+lemma homeomorphic_scaling:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "c \<noteq> 0" shows "s homeomorphic ((\<lambda>x. c *\<^sub>R x) ` s)"
+ unfolding homeomorphic_minimal
+ apply(rule_tac x="\<lambda>x. c *\<^sub>R x" in exI)
+ apply(rule_tac x="\<lambda>x. (1 / c) *\<^sub>R x" in exI)
+ using assms apply auto
+ using continuous_on_cmul[OF continuous_on_id] by auto
+
+lemma homeomorphic_translation:
+ fixes s :: "'a::real_normed_vector set"
+ shows "s homeomorphic ((\<lambda>x. a + x) ` s)"
+ unfolding homeomorphic_minimal
+ apply(rule_tac x="\<lambda>x. a + x" in exI)
+ apply(rule_tac x="\<lambda>x. -a + x" in exI)
+ using continuous_on_add[OF continuous_on_const continuous_on_id] by auto
+
+lemma homeomorphic_affinity:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "c \<noteq> 0" shows "s homeomorphic ((\<lambda>x. a + c *\<^sub>R x) ` s)"
+proof-
+ have *:"op + a ` op *\<^sub>R c ` s = (\<lambda>x. a + c *\<^sub>R x) ` s" by auto
+ show ?thesis
+ using homeomorphic_trans
+ using homeomorphic_scaling[OF assms, of s]
+ using homeomorphic_translation[of "(\<lambda>x. c *\<^sub>R x) ` s" a] unfolding * by auto
+qed
+
+lemma homeomorphic_balls:
+ fixes a b ::"'a::real_normed_vector" (* FIXME: generalize to metric_space *)
+ assumes "0 < d" "0 < e"
+ shows "(ball a d) homeomorphic (ball b e)" (is ?th)
+ "(cball a d) homeomorphic (cball b e)" (is ?cth)
+proof-
+ have *:"\<bar>e / d\<bar> > 0" "\<bar>d / e\<bar> >0" using assms using divide_pos_pos by auto
+ show ?th unfolding homeomorphic_minimal
+ apply(rule_tac x="\<lambda>x. b + (e/d) *\<^sub>R (x - a)" in exI)
+ apply(rule_tac x="\<lambda>x. a + (d/e) *\<^sub>R (x - b)" in exI)
+ using assms apply (auto simp add: dist_commute)
+ unfolding dist_norm
+ apply (auto simp add: pos_divide_less_eq mult_strict_left_mono)
+ unfolding continuous_on
+ by (intro ballI tendsto_intros, simp, assumption)+
+next
+ have *:"\<bar>e / d\<bar> > 0" "\<bar>d / e\<bar> >0" using assms using divide_pos_pos by auto
+ show ?cth unfolding homeomorphic_minimal
+ apply(rule_tac x="\<lambda>x. b + (e/d) *\<^sub>R (x - a)" in exI)
+ apply(rule_tac x="\<lambda>x. a + (d/e) *\<^sub>R (x - b)" in exI)
+ using assms apply (auto simp add: dist_commute)
+ unfolding dist_norm
+ apply (auto simp add: pos_divide_le_eq)
+ unfolding continuous_on
+ by (intro ballI tendsto_intros, simp, assumption)+
+qed
+
+text{* "Isometry" (up to constant bounds) of injective linear map etc. *}
+
+lemma cauchy_isometric:
+ fixes x :: "nat \<Rightarrow> real ^ 'n::finite"
+ 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)"
+ shows "Cauchy x"
+proof-
+ interpret f: bounded_linear f by fact
+ { fix d::real assume "d>0"
+ then obtain N where N:"\<forall>n\<ge>N. norm (f (x n) - f (x N)) < e * d"
+ 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
+ { fix n assume "n\<ge>N"
+ hence "norm (f (x n - x N)) < e * d" using N[THEN spec[where x=n]] unfolding f.diff[THEN sym] by auto
+ moreover have "e * norm (x n - x N) \<le> norm (f (x n - x N))"
+ using subspace_sub[OF s, of "x n" "x N"] using xs[THEN spec[where x=N]] and xs[THEN spec[where x=n]]
+ using normf[THEN bspec[where x="x n - x N"]] by auto
+ ultimately have "norm (x n - x N) < d" using `e>0`
+ using mult_left_less_imp_less[of e "norm (x n - x N)" d] by auto }
+ hence "\<exists>N. \<forall>n\<ge>N. norm (x n - x N) < d" by auto }
+ thus ?thesis unfolding cauchy and dist_norm by auto
+qed
+
+lemma complete_isometric_image:
+ fixes f :: "real ^ _ \<Rightarrow> real ^ _"
+ 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"
+ shows "complete(f ` s)"
+proof-
+ { fix g assume as:"\<forall>n::nat. g n \<in> f ` s" and cfg:"Cauchy g"
+ then obtain x where "\<forall>n. x n \<in> s \<and> g n = f (x n)" unfolding image_iff and Bex_def
+ using choice[of "\<lambda> n xa. xa \<in> s \<and> g n = f xa"] by auto
+ hence x:"\<forall>n. x n \<in> s" "\<forall>n. g n = f (x n)" by auto
+ hence "f \<circ> x = g" unfolding expand_fun_eq by auto
+ then obtain l where "l\<in>s" and l:"(x ---> l) sequentially"
+ using cs[unfolded complete_def, THEN spec[where x="x"]]
+ using cauchy_isometric[OF `0<e` s f normf] and cfg and x(1) by auto
+ hence "\<exists>l\<in>f ` s. (g ---> l) sequentially"
+ using linear_continuous_at[OF f, unfolded continuous_at_sequentially, THEN spec[where x=x], of l]
+ unfolding `f \<circ> x = g` by auto }
+ thus ?thesis unfolding complete_def by auto
+qed
+
+lemma dist_0_norm:
+ fixes x :: "'a::real_normed_vector"
+ shows "dist 0 x = norm x"
+unfolding dist_norm by simp
+
+lemma injective_imp_isometric: fixes f::"real^'m::finite \<Rightarrow> real^'n::finite"
+ assumes s:"closed s" "subspace s" and f:"bounded_linear f" "\<forall>x\<in>s. (f x = 0) \<longrightarrow> (x = 0)"
+ shows "\<exists>e>0. \<forall>x\<in>s. norm (f x) \<ge> e * norm(x)"
+proof(cases "s \<subseteq> {0::real^'m}")
+ case True
+ { fix x assume "x \<in> s"
+ hence "x = 0" using True by auto
+ hence "norm x \<le> norm (f x)" by auto }
+ thus ?thesis by(auto intro!: exI[where x=1])
+next
+ interpret f: bounded_linear f by fact
+ case False
+ then obtain a where a:"a\<noteq>0" "a\<in>s" by auto
+ from False have "s \<noteq> {}" by auto
+ let ?S = "{f x| x. (x \<in> s \<and> norm x = norm a)}"
+ let ?S' = "{x::real^'m. x\<in>s \<and> norm x = norm a}"
+ let ?S'' = "{x::real^'m. norm x = norm a}"
+
+ have "?S'' = frontier(cball 0 (norm a))" unfolding frontier_cball and dist_norm by (auto simp add: norm_minus_cancel)
+ hence "compact ?S''" using compact_frontier[OF compact_cball, of 0 "norm a"] by auto
+ moreover have "?S' = s \<inter> ?S''" by auto
+ ultimately have "compact ?S'" using closed_inter_compact[of s ?S''] using s(1) by auto
+ moreover have *:"f ` ?S' = ?S" by auto
+ ultimately have "compact ?S" using compact_continuous_image[OF linear_continuous_on[OF f(1)], of ?S'] by auto
+ hence "closed ?S" using compact_imp_closed by auto
+ moreover have "?S \<noteq> {}" using a by auto
+ ultimately obtain b' where "b'\<in>?S" "\<forall>y\<in>?S. norm b' \<le> norm y" using distance_attains_inf[of ?S 0] unfolding dist_0_norm by auto
+ then obtain b where "b\<in>s" and ba:"norm b = norm a" and b:"\<forall>x\<in>{x \<in> s. norm x = norm a}. norm (f b) \<le> norm (f x)" unfolding *[THEN sym] unfolding image_iff by auto
+
+ let ?e = "norm (f b) / norm b"
+ have "norm b > 0" using ba and a and norm_ge_zero by auto
+ moreover have "norm (f b) > 0" using f(2)[THEN bspec[where x=b], OF `b\<in>s`] using `norm b >0` unfolding zero_less_norm_iff by auto
+ ultimately have "0 < norm (f b) / norm b" by(simp only: divide_pos_pos)
+ moreover
+ { fix x assume "x\<in>s"
+ hence "norm (f b) / norm b * norm x \<le> norm (f x)"
+ proof(cases "x=0")
+ case True thus "norm (f b) / norm b * norm x \<le> norm (f x)" by auto
+ next
+ case False
+ hence *:"0 < norm a / norm x" using `a\<noteq>0` unfolding zero_less_norm_iff[THEN sym] by(simp only: divide_pos_pos)
+ have "\<forall>c. \<forall>x\<in>s. c *\<^sub>R x \<in> s" using s[unfolded subspace_def smult_conv_scaleR] by auto
+ 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
+ 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"]]
+ unfolding f.scaleR and ba using `x\<noteq>0` `a\<noteq>0`
+ by (auto simp add: real_mult_commute pos_le_divide_eq pos_divide_le_eq)
+ qed }
+ ultimately
+ show ?thesis by auto
+qed
+
+lemma closed_injective_image_subspace:
+ fixes f :: "real ^ _ \<Rightarrow> real ^ _"
+ assumes "subspace s" "bounded_linear f" "\<forall>x\<in>s. f x = 0 --> x = 0" "closed s"
+ shows "closed(f ` s)"
+proof-
+ obtain e where "e>0" and e:"\<forall>x\<in>s. e * norm x \<le> norm (f x)" using injective_imp_isometric[OF assms(4,1,2,3)] by auto
+ show ?thesis using complete_isometric_image[OF `e>0` assms(1,2) e] and assms(4)
+ unfolding complete_eq_closed[THEN sym] by auto
+qed
+
+subsection{* Some properties of a canonical subspace. *}
+
+lemma subspace_substandard:
+ "subspace {x::real^'n. (\<forall>i. P i \<longrightarrow> x$i = 0)}"
+ unfolding subspace_def by(auto simp add: vector_add_component vector_smult_component elim!: ballE)
+
+lemma closed_substandard:
+ "closed {x::real^'n::finite. \<forall>i. P i --> x$i = 0}" (is "closed ?A")
+proof-
+ let ?D = "{i. P i}"
+ let ?Bs = "{{x::real^'n. inner (basis i) x = 0}| i. i \<in> ?D}"
+ { fix x
+ { assume "x\<in>?A"
+ hence x:"\<forall>i\<in>?D. x $ i = 0" by auto
+ hence "x\<in> \<Inter> ?Bs" by(auto simp add: inner_basis x) }
+ moreover
+ { assume x:"x\<in>\<Inter>?Bs"
+ { fix i assume i:"i \<in> ?D"
+ then obtain B where BB:"B \<in> ?Bs" and B:"B = {x::real^'n. inner (basis i) x = 0}" by auto
+ hence "x $ i = 0" unfolding B using x unfolding inner_basis by auto }
+ hence "x\<in>?A" by auto }
+ ultimately have "x\<in>?A \<longleftrightarrow> x\<in> \<Inter>?Bs" by auto }
+ hence "?A = \<Inter> ?Bs" by auto
+ thus ?thesis by(auto simp add: closed_Inter closed_hyperplane)
+qed
+
+lemma dim_substandard:
+ shows "dim {x::real^'n::finite. \<forall>i. i \<notin> d \<longrightarrow> x$i = 0} = card d" (is "dim ?A = _")
+proof-
+ let ?D = "UNIV::'n set"
+ let ?B = "(basis::'n\<Rightarrow>real^'n) ` d"
+
+ let ?bas = "basis::'n \<Rightarrow> real^'n"
+
+ have "?B \<subseteq> ?A" by auto
+
+ moreover
+ { fix x::"real^'n" assume "x\<in>?A"
+ with finite[of d]
+ have "x\<in> span ?B"
+ proof(induct d arbitrary: x)
+ case empty hence "x=0" unfolding Cart_eq by auto
+ thus ?case using subspace_0[OF subspace_span[of "{}"]] by auto
+ next
+ case (insert k F)
+ hence *:"\<forall>i. i \<notin> insert k F \<longrightarrow> x $ i = 0" by auto
+ have **:"F \<subseteq> insert k F" by auto
+ def y \<equiv> "x - x$k *\<^sub>R basis k"
+ have y:"x = y + (x$k) *\<^sub>R basis k" unfolding y_def by auto
+ { fix i assume i':"i \<notin> F"
+ hence "y $ i = 0" unfolding y_def unfolding vector_minus_component
+ and vector_smult_component and basis_component
+ using *[THEN spec[where x=i]] by auto }
+ hence "y \<in> span (basis ` (insert k F))" using insert(3)
+ using span_mono[of "?bas ` F" "?bas ` (insert k F)"]
+ using image_mono[OF **, of basis] by auto
+ moreover
+ have "basis k \<in> span (?bas ` (insert k F))" by(rule span_superset, auto)
+ hence "x$k *\<^sub>R basis k \<in> span (?bas ` (insert k F))"
+ using span_mul [where 'a=real, unfolded smult_conv_scaleR] by auto
+ ultimately
+ have "y + x$k *\<^sub>R basis k \<in> span (?bas ` (insert k F))"
+ using span_add by auto
+ thus ?case using y by auto
+ qed
+ }
+ hence "?A \<subseteq> span ?B" by auto
+
+ moreover
+ { fix x assume "x \<in> ?B"
+ hence "x\<in>{(basis i)::real^'n |i. i \<in> ?D}" using assms by auto }
+ hence "independent ?B" using independent_mono[OF independent_stdbasis, of ?B] and assms by auto
+
+ moreover
+ have "d \<subseteq> ?D" unfolding subset_eq using assms by auto
+ hence *:"inj_on (basis::'n\<Rightarrow>real^'n) d" using subset_inj_on[OF basis_inj, of "d"] by auto
+ have "?B hassize (card d)" unfolding hassize_def and card_image[OF *] by auto
+
+ ultimately show ?thesis using dim_unique[of "basis ` d" ?A] by auto
+qed
+
+text{* Hence closure and completeness of all subspaces. *}
+
+lemma closed_subspace_lemma: "n \<le> card (UNIV::'n::finite set) \<Longrightarrow> \<exists>A::'n set. card A = n"
+apply (induct n)
+apply (rule_tac x="{}" in exI, simp)
+apply clarsimp
+apply (subgoal_tac "\<exists>x. x \<notin> A")
+apply (erule exE)
+apply (rule_tac x="insert x A" in exI, simp)
+apply (subgoal_tac "A \<noteq> UNIV", auto)
+done
+
+lemma closed_subspace: fixes s::"(real^'n::finite) set"
+ assumes "subspace s" shows "closed s"
+proof-
+ have "dim s \<le> card (UNIV :: 'n set)" using dim_subset_univ by auto
+ then obtain d::"'n set" where t: "card d = dim s"
+ using closed_subspace_lemma by auto
+ let ?t = "{x::real^'n. \<forall>i. i \<notin> d \<longrightarrow> x$i = 0}"
+ obtain f where f:"bounded_linear f" "f ` ?t = s" "inj_on f ?t"
+ using subspace_isomorphism[unfolded linear_conv_bounded_linear, OF subspace_substandard[of "\<lambda>i. i \<notin> d"] assms]
+ using dim_substandard[of d] and t by auto
+ interpret f: bounded_linear f by fact
+ have "\<forall>x\<in>?t. f x = 0 \<longrightarrow> x = 0" using f.zero using f(3)[unfolded inj_on_def]
+ by(erule_tac x=0 in ballE) auto
+ moreover have "closed ?t" using closed_substandard .
+ moreover have "subspace ?t" using subspace_substandard .
+ ultimately show ?thesis using closed_injective_image_subspace[of ?t f]
+ unfolding f(2) using f(1) by auto
+qed
+
+lemma complete_subspace:
+ fixes s :: "(real ^ _) set" shows "subspace s ==> complete s"
+ using complete_eq_closed closed_subspace
+ by auto
+
+lemma dim_closure:
+ fixes s :: "(real ^ _) set"
+ shows "dim(closure s) = dim s" (is "?dc = ?d")
+proof-
+ have "?dc \<le> ?d" using closure_minimal[OF span_inc, of s]
+ using closed_subspace[OF subspace_span, of s]
+ using dim_subset[of "closure s" "span s"] unfolding dim_span by auto
+ thus ?thesis using dim_subset[OF closure_subset, of s] by auto
+qed
+
+text{* Affine transformations of intervals. *}
+
+lemma affinity_inverses:
+ assumes m0: "m \<noteq> (0::'a::field)"
+ shows "(\<lambda>x. m *s x + c) o (\<lambda>x. inverse(m) *s x + (-(inverse(m) *s c))) = id"
+ "(\<lambda>x. inverse(m) *s x + (-(inverse(m) *s c))) o (\<lambda>x. m *s x + c) = id"
+ using m0
+apply (auto simp add: expand_fun_eq vector_add_ldistrib vector_smult_assoc)
+by (simp add: vector_smult_lneg[symmetric] vector_smult_assoc vector_sneg_minus1[symmetric])
+
+lemma real_affinity_le:
+ "0 < (m::'a::ordered_field) ==> (m * x + c \<le> y \<longleftrightarrow> x \<le> inverse(m) * y + -(c / m))"
+ by (simp add: field_simps inverse_eq_divide)
+
+lemma real_le_affinity:
+ "0 < (m::'a::ordered_field) ==> (y \<le> m * x + c \<longleftrightarrow> inverse(m) * y + -(c / m) \<le> x)"
+ by (simp add: field_simps inverse_eq_divide)
+
+lemma real_affinity_lt:
+ "0 < (m::'a::ordered_field) ==> (m * x + c < y \<longleftrightarrow> x < inverse(m) * y + -(c / m))"
+ by (simp add: field_simps inverse_eq_divide)
+
+lemma real_lt_affinity:
+ "0 < (m::'a::ordered_field) ==> (y < m * x + c \<longleftrightarrow> inverse(m) * y + -(c / m) < x)"
+ by (simp add: field_simps inverse_eq_divide)
+
+lemma real_affinity_eq:
+ "(m::'a::ordered_field) \<noteq> 0 ==> (m * x + c = y \<longleftrightarrow> x = inverse(m) * y + -(c / m))"
+ by (simp add: field_simps inverse_eq_divide)
+
+lemma real_eq_affinity:
+ "(m::'a::ordered_field) \<noteq> 0 ==> (y = m * x + c \<longleftrightarrow> inverse(m) * y + -(c / m) = x)"
+ by (simp add: field_simps inverse_eq_divide)
+
+lemma vector_affinity_eq:
+ assumes m0: "(m::'a::field) \<noteq> 0"
+ shows "m *s x + c = y \<longleftrightarrow> x = inverse m *s y + -(inverse m *s c)"
+proof
+ assume h: "m *s x + c = y"
+ hence "m *s x = y - c" by (simp add: ring_simps)
+ hence "inverse m *s (m *s x) = inverse m *s (y - c)" by simp
+ then show "x = inverse m *s y + - (inverse m *s c)"
+ using m0 by (simp add: vector_smult_assoc vector_ssub_ldistrib)
+next
+ assume h: "x = inverse m *s y + - (inverse m *s c)"
+ show "m *s x + c = y" unfolding h diff_minus[symmetric]
+ using m0 by (simp add: vector_smult_assoc vector_ssub_ldistrib)
+qed
+
+lemma vector_eq_affinity:
+ "(m::'a::field) \<noteq> 0 ==> (y = m *s x + c \<longleftrightarrow> inverse(m) *s y + -(inverse(m) *s c) = x)"
+ using vector_affinity_eq[where m=m and x=x and y=y and c=c]
+ by metis
+
+lemma image_affinity_interval: fixes m::real
+ fixes a b c :: "real^'n::finite"
+ shows "(\<lambda>x. m *\<^sub>R x + c) ` {a .. b} =
+ (if {a .. b} = {} then {}
+ else (if 0 \<le> m then {m *\<^sub>R a + c .. m *\<^sub>R b + c}
+ else {m *\<^sub>R b + c .. m *\<^sub>R a + c}))"
+proof(cases "m=0")
+ { fix x assume "x \<le> c" "c \<le> x"
+ hence "x=c" unfolding vector_less_eq_def and Cart_eq by (auto intro: order_antisym) }
+ moreover case True
+ moreover have "c \<in> {m *\<^sub>R a + c..m *\<^sub>R b + c}" unfolding True by(auto simp add: vector_less_eq_def)
+ ultimately show ?thesis by auto
+next
+ case False
+ { fix y assume "a \<le> y" "y \<le> b" "m > 0"
+ hence "m *\<^sub>R a + c \<le> m *\<^sub>R y + c" "m *\<^sub>R y + c \<le> m *\<^sub>R b + c"
+ unfolding vector_less_eq_def by(auto simp add: vector_smult_component vector_add_component)
+ } moreover
+ { fix y assume "a \<le> y" "y \<le> b" "m < 0"
+ hence "m *\<^sub>R b + c \<le> m *\<^sub>R y + c" "m *\<^sub>R y + c \<le> m *\<^sub>R a + c"
+ unfolding vector_less_eq_def by(auto simp add: vector_smult_component vector_add_component mult_left_mono_neg elim!:ballE)
+ } moreover
+ { fix y assume "m > 0" "m *\<^sub>R a + c \<le> y" "y \<le> m *\<^sub>R b + c"
+ hence "y \<in> (\<lambda>x. m *\<^sub>R x + c) ` {a..b}"
+ unfolding image_iff Bex_def mem_interval vector_less_eq_def
+ apply(auto simp add: vector_smult_component vector_add_component vector_minus_component vector_smult_assoc pth_3[symmetric]
+ intro!: exI[where x="(1 / m) *\<^sub>R (y - c)"])
+ by(auto simp add: pos_le_divide_eq pos_divide_le_eq real_mult_commute diff_le_iff)
+ } moreover
+ { fix y assume "m *\<^sub>R b + c \<le> y" "y \<le> m *\<^sub>R a + c" "m < 0"
+ hence "y \<in> (\<lambda>x. m *\<^sub>R x + c) ` {a..b}"
+ unfolding image_iff Bex_def mem_interval vector_less_eq_def
+ apply(auto simp add: vector_smult_component vector_add_component vector_minus_component vector_smult_assoc pth_3[symmetric]
+ intro!: exI[where x="(1 / m) *\<^sub>R (y - c)"])
+ by(auto simp add: neg_le_divide_eq neg_divide_le_eq real_mult_commute diff_le_iff)
+ }
+ ultimately show ?thesis using False by auto
+qed
+
+lemma image_smult_interval:"(\<lambda>x. m *\<^sub>R (x::real^'n::finite)) ` {a..b} =
+ (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})"
+ using image_affinity_interval[of m 0 a b] by auto
+
+subsection{* Banach fixed point theorem (not really topological...) *}
+
+lemma banach_fix:
+ assumes s:"complete s" "s \<noteq> {}" and c:"0 \<le> c" "c < 1" and f:"(f ` s) \<subseteq> s" and
+ lipschitz:"\<forall>x\<in>s. \<forall>y\<in>s. dist (f x) (f y) \<le> c * dist x y"
+ shows "\<exists>! x\<in>s. (f x = x)"
+proof-
+ have "1 - c > 0" using c by auto
+
+ from s(2) obtain z0 where "z0 \<in> s" by auto
+ def z \<equiv> "\<lambda>n. (f ^^ n) z0"
+ { fix n::nat
+ have "z n \<in> s" unfolding z_def
+ proof(induct n) case 0 thus ?case using `z0 \<in>s` by auto
+ next case Suc thus ?case using f by auto qed }
+ note z_in_s = this
+
+ def d \<equiv> "dist (z 0) (z 1)"
+
+ have fzn:"\<And>n. f (z n) = z (Suc n)" unfolding z_def by auto
+ { fix n::nat
+ have "dist (z n) (z (Suc n)) \<le> (c ^ n) * d"
+ proof(induct n)
+ case 0 thus ?case unfolding d_def by auto
+ next
+ case (Suc m)
+ hence "c * dist (z m) (z (Suc m)) \<le> c ^ Suc m * d"
+ using `0 \<le> c` using mult_mono1_class.mult_mono1[of "dist (z m) (z (Suc m))" "c ^ m * d" c] by auto
+ 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]
+ unfolding fzn and mult_le_cancel_left by auto
+ qed
+ } note cf_z = this
+
+ { fix n m::nat
+ have "(1 - c) * dist (z m) (z (m+n)) \<le> (c ^ m) * d * (1 - c ^ n)"
+ proof(induct n)
+ case 0 show ?case by auto
+ next
+ case (Suc k)
+ 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))))"
+ using dist_triangle and c by(auto simp add: dist_triangle)
+ also have "\<dots> \<le> (1 - c) * (dist (z m) (z (m + k)) + c ^ (m + k) * d)"
+ using cf_z[of "m + k"] and c by auto
+ also have "\<dots> \<le> c ^ m * d * (1 - c ^ k) + (1 - c) * c ^ (m + k) * d"
+ using Suc by (auto simp add: ring_simps)
+ also have "\<dots> = (c ^ m) * (d * (1 - c ^ k) + (1 - c) * c ^ k * d)"
+ unfolding power_add by (auto simp add: ring_simps)
+ also have "\<dots> \<le> (c ^ m) * d * (1 - c ^ Suc k)"
+ using c by (auto simp add: ring_simps)
+ finally show ?case by auto
+ qed
+ } note cf_z2 = this
+ { fix e::real assume "e>0"
+ hence "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (z m) (z n) < e"
+ proof(cases "d = 0")
+ case True
+ 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`])
+ thus ?thesis using `e>0` by auto
+ next
+ case False hence "d>0" unfolding d_def using zero_le_dist[of "z 0" "z 1"]
+ by (metis False d_def real_less_def)
+ hence "0 < e * (1 - c) / d" using `e>0` and `1-c>0`
+ using divide_pos_pos[of "e * (1 - c)" d] and mult_pos_pos[of e "1 - c"] by auto
+ 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
+ { fix m n::nat assume "m>n" and as:"m\<ge>N" "n\<ge>N"
+ have *:"c ^ n \<le> c ^ N" using `n\<ge>N` and c using power_decreasing[OF `n\<ge>N`, of c] by auto
+ have "1 - c ^ (m - n) > 0" using c and power_strict_mono[of c 1 "m - n"] using `m>n` by auto
+ hence **:"d * (1 - c ^ (m - n)) / (1 - c) > 0"
+ using real_mult_order[OF `d>0`, of "1 - c ^ (m - n)"]
+ using divide_pos_pos[of "d * (1 - c ^ (m - n))" "1 - c"]
+ using `0 < 1 - c` by auto
+
+ have "dist (z m) (z n) \<le> c ^ n * d * (1 - c ^ (m - n)) / (1 - c)"
+ using cf_z2[of n "m - n"] and `m>n` unfolding pos_le_divide_eq[OF `1-c>0`]
+ by (auto simp add: real_mult_commute dist_commute)
+ also have "\<dots> \<le> c ^ N * d * (1 - c ^ (m - n)) / (1 - c)"
+ using mult_right_mono[OF * order_less_imp_le[OF **]]
+ unfolding real_mult_assoc by auto
+ also have "\<dots> < (e * (1 - c) / d) * d * (1 - c ^ (m - n)) / (1 - c)"
+ using mult_strict_right_mono[OF N **] unfolding real_mult_assoc by auto
+ also have "\<dots> = e * (1 - c ^ (m - n))" using c and `d>0` and `1 - c > 0` by auto
+ 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
+ finally have "dist (z m) (z n) < e" by auto
+ } note * = this
+ { fix m n::nat assume as:"N\<le>m" "N\<le>n"
+ hence "dist (z n) (z m) < e"
+ proof(cases "n = m")
+ case True thus ?thesis using `e>0` by auto
+ next
+ case False thus ?thesis using as and *[of n m] *[of m n] unfolding nat_neq_iff by (auto simp add: dist_commute)
+ qed }
+ thus ?thesis by auto
+ qed
+ }
+ hence "Cauchy z" unfolding cauchy_def by auto
+ 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
+
+ def e \<equiv> "dist (f x) x"
+ have "e = 0" proof(rule ccontr)
+ assume "e \<noteq> 0" hence "e>0" unfolding e_def using zero_le_dist[of "f x" x]
+ by (metis dist_eq_0_iff dist_nz e_def)
+ then obtain N where N:"\<forall>n\<ge>N. dist (z n) x < e / 2"
+ using x[unfolded Lim_sequentially, THEN spec[where x="e/2"]] by auto
+ hence N':"dist (z N) x < e / 2" by auto
+
+ have *:"c * dist (z N) x \<le> dist (z N) x" unfolding mult_le_cancel_right2
+ using zero_le_dist[of "z N" x] and c
+ by (metis dist_eq_0_iff dist_nz order_less_asym real_less_def)
+ 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]]
+ using z_in_s[of N] `x\<in>s` using c by auto
+ also have "\<dots> < e / 2" using N' and c using * by auto
+ finally show False unfolding fzn
+ using N[THEN spec[where x="Suc N"]] and dist_triangle_half_r[of "z (Suc N)" "f x" e x]
+ unfolding e_def by auto
+ qed
+ hence "f x = x" unfolding e_def by auto
+ moreover
+ { fix y assume "f y = y" "y\<in>s"
+ hence "dist x y \<le> c * dist x y" using lipschitz[THEN bspec[where x=x], THEN bspec[where x=y]]
+ using `x\<in>s` and `f x = x` by auto
+ hence "dist x y = 0" unfolding mult_le_cancel_right1
+ using c and zero_le_dist[of x y] by auto
+ hence "y = x" by auto
+ }
+ ultimately show ?thesis unfolding Bex1_def using `x\<in>s` by blast+
+qed
+
+subsection{* Edelstein fixed point theorem. *}
+
+lemma edelstein_fix:
+ fixes s :: "'a::real_normed_vector set"
+ assumes s:"compact s" "s \<noteq> {}" and gs:"(g ` s) \<subseteq> s"
+ and dist:"\<forall>x\<in>s. \<forall>y\<in>s. x \<noteq> y \<longrightarrow> dist (g x) (g y) < dist x y"
+ shows "\<exists>! x\<in>s. g x = x"
+proof(cases "\<exists>x\<in>s. g x \<noteq> x")
+ obtain x where "x\<in>s" using s(2) by auto
+ case False hence g:"\<forall>x\<in>s. g x = x" by auto
+ { fix y assume "y\<in>s"
+ hence "x = y" using `x\<in>s` and dist[THEN bspec[where x=x], THEN bspec[where x=y]]
+ unfolding g[THEN bspec[where x=x], OF `x\<in>s`]
+ unfolding g[THEN bspec[where x=y], OF `y\<in>s`] by auto }
+ thus ?thesis unfolding Bex1_def using `x\<in>s` and g by blast+
+next
+ case True
+ then obtain x where [simp]:"x\<in>s" and "g x \<noteq> x" by auto
+ { fix x y assume "x \<in> s" "y \<in> s"
+ hence "dist (g x) (g y) \<le> dist x y"
+ using dist[THEN bspec[where x=x], THEN bspec[where x=y]] by auto } note dist' = this
+ def y \<equiv> "g x"
+ have [simp]:"y\<in>s" unfolding y_def using gs[unfolded image_subset_iff] and `x\<in>s` by blast
+ def f \<equiv> "\<lambda>n. g ^^ n"
+ have [simp]:"\<And>n z. g (f n z) = f (Suc n) z" unfolding f_def by auto
+ have [simp]:"\<And>z. f 0 z = z" unfolding f_def by auto
+ { fix n::nat and z assume "z\<in>s"
+ have "f n z \<in> s" unfolding f_def
+ proof(induct n)
+ case 0 thus ?case using `z\<in>s` by simp
+ next
+ case (Suc n) thus ?case using gs[unfolded image_subset_iff] by auto
+ qed } note fs = this
+ { fix m n ::nat assume "m\<le>n"
+ fix w z assume "w\<in>s" "z\<in>s"
+ have "dist (f n w) (f n z) \<le> dist (f m w) (f m z)" using `m\<le>n`
+ proof(induct n)
+ case 0 thus ?case by auto
+ next
+ case (Suc n)
+ thus ?case proof(cases "m\<le>n")
+ case True thus ?thesis using Suc(1)
+ using dist'[OF fs fs, OF `w\<in>s` `z\<in>s`, of n n] by auto
+ next
+ case False hence mn:"m = Suc n" using Suc(2) by simp
+ show ?thesis unfolding mn by auto
+ qed
+ qed } note distf = this
+
+ def h \<equiv> "\<lambda>n. (f n x, f n y)"
+ let ?s2 = "s \<times> s"
+ obtain l r where "l\<in>?s2" and r:"subseq r" and lr:"((h \<circ> r) ---> l) sequentially"
+ using compact_Times [OF s(1) s(1), unfolded compact_def, THEN spec[where x=h]] unfolding h_def
+ using fs[OF `x\<in>s`] and fs[OF `y\<in>s`] by blast
+ def a \<equiv> "fst l" def b \<equiv> "snd l"
+ have lab:"l = (a, b)" unfolding a_def b_def by simp
+ have [simp]:"a\<in>s" "b\<in>s" unfolding a_def b_def using `l\<in>?s2` by auto
+
+ have lima:"((fst \<circ> (h \<circ> r)) ---> a) sequentially"
+ and limb:"((snd \<circ> (h \<circ> r)) ---> b) sequentially"
+ using lr
+ unfolding o_def a_def b_def by (simp_all add: tendsto_intros)
+
+ { fix n::nat
+ 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
+ { fix x y :: 'a
+ have "dist (-x) (-y) = dist x y" unfolding dist_norm
+ using norm_minus_cancel[of "x - y"] by (auto simp add: uminus_add_conv_diff) } note ** = this
+
+ { assume as:"dist a b > dist (f n x) (f n y)"
+ 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"
+ and "\<forall>m\<ge>Nb. dist (f (r m) y) b < (dist a b - dist (f n x) (f n y)) / 2"
+ using lima limb unfolding h_def Lim_sequentially by (fastsimp simp del: less_divide_eq_number_of1)
+ 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)"
+ apply(erule_tac x="Na+Nb+n" in allE)
+ apply(erule_tac x="Na+Nb+n" in allE) apply simp
+ using dist_triangle_add_half[of a "f (r (Na + Nb + n)) x" "dist a b - dist (f n x) (f n y)"
+ "-b" "- f (r (Na + Nb + n)) y"]
+ unfolding ** unfolding group_simps(12) by (auto simp add: dist_commute)
+ moreover
+ 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)"
+ using distf[of n "r (Na+Nb+n)", OF _ `x\<in>s` `y\<in>s`]
+ using subseq_bigger[OF r, of "Na+Nb+n"]
+ using *[of "f (r (Na + Nb + n)) x" "f (r (Na + Nb + n)) y" "f n x" "f n y"] by auto
+ ultimately have False by simp
+ }
+ hence "dist a b \<le> dist (f n x) (f n y)" by(rule ccontr)auto }
+ note ab_fn = this
+
+ have [simp]:"a = b" proof(rule ccontr)
+ def e \<equiv> "dist a b - dist (g a) (g b)"
+ assume "a\<noteq>b" hence "e > 0" unfolding e_def using dist by fastsimp
+ hence "\<exists>n. dist (f n x) a < e/2 \<and> dist (f n y) b < e/2"
+ using lima limb unfolding Lim_sequentially
+ apply (auto elim!: allE[where x="e/2"]) apply(rule_tac x="r (max N Na)" in exI) unfolding h_def by fastsimp
+ then obtain n where n:"dist (f n x) a < e/2 \<and> dist (f n y) b < e/2" by auto
+ have "dist (f (Suc n) x) (g a) \<le> dist (f n x) a"
+ using dist[THEN bspec[where x="f n x"], THEN bspec[where x="a"]] and fs by auto
+ moreover have "dist (f (Suc n) y) (g b) \<le> dist (f n y) b"
+ using dist[THEN bspec[where x="f n y"], THEN bspec[where x="b"]] and fs by auto
+ ultimately have "dist (f (Suc n) x) (g a) + dist (f (Suc n) y) (g b) < e" using n by auto
+ thus False unfolding e_def using ab_fn[of "Suc n"] by norm
+ qed
+
+ have [simp]:"\<And>n. f (Suc n) x = f n y" unfolding f_def y_def by(induct_tac n)auto
+ { fix x y assume "x\<in>s" "y\<in>s" moreover
+ fix e::real assume "e>0" ultimately
+ have "dist y x < e \<longrightarrow> dist (g y) (g x) < e" using dist by fastsimp }
+ hence "continuous_on s g" unfolding continuous_on_def by auto
+
+ hence "((snd \<circ> h \<circ> r) ---> g a) sequentially" unfolding continuous_on_sequentially
+ apply (rule allE[where x="\<lambda>n. (fst \<circ> h \<circ> r) n"]) apply (erule ballE[where x=a])
+ using lima unfolding h_def o_def using fs[OF `x\<in>s`] by (auto simp add: y_def)
+ hence "g a = a" using Lim_unique[OF trivial_limit_sequentially limb, of "g a"]
+ unfolding `a=b` and o_assoc by auto
+ moreover
+ { fix x assume "x\<in>s" "g x = x" "x\<noteq>a"
+ hence "False" using dist[THEN bspec[where x=a], THEN bspec[where x=x]]
+ using `g a = a` and `a\<in>s` by auto }
+ ultimately show "\<exists>!x\<in>s. g x = x" unfolding Bex1_def using `a\<in>s` by blast
+qed
+
+end
--- a/src/HOL/Library/Convex_Euclidean_Space.thy Fri Oct 23 14:33:07 2009 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,3371 +0,0 @@
-(* Title: HOL/Library/Convex_Euclidean_Space.thy
- Author: Robert Himmelmann, TU Muenchen
-*)
-
-header {* Convex sets, functions and related things. *}
-
-theory Convex_Euclidean_Space
-imports Topology_Euclidean_Space
-begin
-
-
-(* ------------------------------------------------------------------------- *)
-(* To be moved elsewhere *)
-(* ------------------------------------------------------------------------- *)
-
-declare vector_add_ldistrib[simp] vector_ssub_ldistrib[simp] vector_smult_assoc[simp] vector_smult_rneg[simp]
-declare vector_sadd_rdistrib[simp] vector_sub_rdistrib[simp]
-declare dot_ladd[simp] dot_radd[simp] dot_lsub[simp] dot_rsub[simp]
-declare dot_lmult[simp] dot_rmult[simp] dot_lneg[simp] dot_rneg[simp]
-declare UNIV_1[simp]
-
-term "(x::real^'n \<Rightarrow> real) 0"
-
-lemma dim1in[intro]:"Suc 0 \<in> {1::nat .. CARD(1)}" by auto
-
-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
-
-lemmas continuous_intros = continuous_add continuous_vmul continuous_cmul continuous_const continuous_sub continuous_at_id continuous_within_id
-
-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
- 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
-
-lemma dest_vec1_simps[simp]: fixes a::"real^1"
- 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"*)
- "a \<le> b \<longleftrightarrow> dest_vec1 a \<le> dest_vec1 b" "dest_vec1 (1::real^1) = 1"
- by(auto simp add:vector_component_simps all_1 Cart_eq)
-
-lemma nequals0I:"x\<in>A \<Longrightarrow> A \<noteq> {}" by auto
-
-lemma norm_not_0:"(x::real^'n::finite)\<noteq>0 \<Longrightarrow> norm x \<noteq> 0" by auto
-
-lemma setsum_delta_notmem: assumes "x\<notin>s"
- shows "setsum (\<lambda>y. if (y = x) then P x else Q y) s = setsum Q s"
- "setsum (\<lambda>y. if (x = y) then P x else Q y) s = setsum Q s"
- "setsum (\<lambda>y. if (y = x) then P y else Q y) s = setsum Q s"
- "setsum (\<lambda>y. if (x = y) then P y else Q y) s = setsum Q s"
- apply(rule_tac [!] setsum_cong2) using assms by auto
-
-lemma setsum_delta'':
- fixes s::"'a::real_vector set" assumes "finite s"
- 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)"
-proof-
- 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
- show ?thesis unfolding * using setsum_delta[OF assms, of y "\<lambda>x. f x *\<^sub>R x"] by auto
-qed
-
-lemma not_disjointI:"x\<in>A \<Longrightarrow> x\<in>B \<Longrightarrow> A \<inter> B \<noteq> {}" by blast
-
-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
-
-lemma mem_interval_1: fixes x :: "real^1" shows
- "(x \<in> {a .. b} \<longleftrightarrow> dest_vec1 a \<le> dest_vec1 x \<and> dest_vec1 x \<le> dest_vec1 b)"
- "(x \<in> {a<..<b} \<longleftrightarrow> dest_vec1 a < dest_vec1 x \<and> dest_vec1 x < dest_vec1 b)"
-by(simp_all add: Cart_eq vector_less_def vector_less_eq_def dest_vec1_def all_1)
-
-lemma image_smult_interval:"(\<lambda>x. m *\<^sub>R (x::real^'n::finite)) ` {a..b} =
- (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})"
- using image_affinity_interval[of m 0 a b] by auto
-
-lemma dest_vec1_inverval:
- "dest_vec1 ` {a .. b} = {dest_vec1 a .. dest_vec1 b}"
- "dest_vec1 ` {a<.. b} = {dest_vec1 a<.. dest_vec1 b}"
- "dest_vec1 ` {a ..<b} = {dest_vec1 a ..<dest_vec1 b}"
- "dest_vec1 ` {a<..<b} = {dest_vec1 a<..<dest_vec1 b}"
- apply(rule_tac [!] equalityI)
- unfolding subset_eq Ball_def Bex_def mem_interval_1 image_iff
- apply(rule_tac [!] allI)apply(rule_tac [!] impI)
- apply(rule_tac[2] x="vec1 x" in exI)apply(rule_tac[4] x="vec1 x" in exI)
- apply(rule_tac[6] x="vec1 x" in exI)apply(rule_tac[8] x="vec1 x" in exI)
- by (auto simp add: vector_less_def vector_less_eq_def all_1 dest_vec1_def
- vec1_dest_vec1[unfolded dest_vec1_def One_nat_def])
-
-lemma dest_vec1_setsum: assumes "finite S"
- shows " dest_vec1 (setsum f S) = setsum (\<lambda>x. dest_vec1 (f x)) S"
- using dest_vec1_sum[OF assms] by auto
-
-lemma dist_triangle_eq:
- fixes x y z :: "real ^ _"
- 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)"
-proof- have *:"x - y + (y - z) = x - z" by auto
- show ?thesis unfolding dist_norm norm_triangle_eq[of "x - y" "y - z", unfolded smult_conv_scaleR *]
- by(auto simp add:norm_minus_commute) qed
-
-lemma norm_eqI:"x = y \<Longrightarrow> norm x = norm y" by auto
-lemma norm_minus_eqI:"(x::real^'n::finite) = - y \<Longrightarrow> norm x = norm y" by auto
-
-lemma Min_grI: assumes "finite A" "A \<noteq> {}" "\<forall>a\<in>A. x < a" shows "x < Min A"
- unfolding Min_gr_iff[OF assms(1,2)] using assms(3) by auto
-
-lemma dimindex_ge_1:"CARD(_::finite) \<ge> 1"
- using one_le_card_finite by auto
-
-lemma real_dimindex_ge_1:"real (CARD('n::finite)) \<ge> 1"
- by(metis dimindex_ge_1 linorder_not_less real_eq_of_nat real_le_trans real_of_nat_1 real_of_nat_le_iff)
-
-lemma real_dimindex_gt_0:"real (CARD('n::finite)) > 0" apply(rule less_le_trans[OF _ real_dimindex_ge_1]) by auto
-
-subsection {* Affine set and affine hull.*}
-
-definition
- affine :: "'a::real_vector set \<Rightarrow> bool" where
- "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)"
-
-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)"
-proof- have *:"\<And>u v ::real. u + v = 1 \<longleftrightarrow> v = 1 - u" by auto
- { fix x y assume "x\<in>s" "y\<in>s"
- 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
- apply(erule_tac[!] x="1 - u" in allE) unfolding * by auto }
- thus ?thesis unfolding affine_def by auto qed
-
-lemma affine_empty[intro]: "affine {}"
- unfolding affine_def by auto
-
-lemma affine_sing[intro]: "affine {x}"
- unfolding affine_alt by (auto simp add: scaleR_left_distrib [symmetric])
-
-lemma affine_UNIV[intro]: "affine UNIV"
- unfolding affine_def by auto
-
-lemma affine_Inter: "(\<forall>s\<in>f. affine s) \<Longrightarrow> affine (\<Inter> f)"
- unfolding affine_def by auto
-
-lemma affine_Int: "affine s \<Longrightarrow> affine t \<Longrightarrow> affine (s \<inter> t)"
- unfolding affine_def by auto
-
-lemma affine_affine_hull: "affine(affine hull s)"
- unfolding hull_def using affine_Inter[of "{t \<in> affine. s \<subseteq> t}"]
- unfolding mem_def by auto
-
-lemma affine_hull_eq[simp]: "(affine hull s = s) \<longleftrightarrow> affine s"
-proof-
- { fix f assume "f \<subseteq> affine"
- hence "affine (\<Inter>f)" using affine_Inter[of f] unfolding subset_eq mem_def by auto }
- thus ?thesis using hull_eq[unfolded mem_def, of affine s] by auto
-qed
-
-lemma setsum_restrict_set'': assumes "finite A"
- shows "setsum f {x \<in> A. P x} = (\<Sum>x\<in>A. if P x then f x else 0)"
- unfolding mem_def[of _ P, symmetric] unfolding setsum_restrict_set'[OF assms] ..
-
-subsection {* Some explicit formulations (from Lars Schewe). *}
-
-lemma affine: fixes V::"'a::real_vector set"
- 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)"
-unfolding affine_def apply rule apply(rule, rule, rule) apply(erule conjE)+
-defer apply(rule, rule, rule, rule, rule) proof-
- fix x y u v assume as:"x \<in> V" "y \<in> V" "u + v = (1::real)"
- "\<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"
- thus "u *\<^sub>R x + v *\<^sub>R y \<in> V" apply(cases "x=y")
- 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)
- by(auto simp add: scaleR_left_distrib[THEN sym])
-next
- 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"
- "finite s" "s \<noteq> {}" "s \<subseteq> V" "setsum u s = (1::real)"
- def n \<equiv> "card s"
- have "card s = 0 \<or> card s = 1 \<or> card s = 2 \<or> card s > 2" by auto
- thus "(\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V" proof(auto simp only: disjE)
- assume "card s = 2" hence "card s = Suc (Suc 0)" by auto
- then obtain a b where "s = {a, b}" unfolding card_Suc_eq by auto
- thus ?thesis using as(1)[THEN bspec[where x=a], THEN bspec[where x=b]] using as(4,5)
- by(auto simp add: setsum_clauses(2))
- next assume "card s > 2" thus ?thesis using as and n_def proof(induct n arbitrary: u s)
- case (Suc n) fix s::"'a set" and u::"'a \<Rightarrow> real"
- 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;
- 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
- 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"
- "finite s" "s \<noteq> {}" "s \<subseteq> V" "setsum u s = 1"
- have "\<exists>x\<in>s. u x \<noteq> 1" proof(rule_tac ccontr)
- 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
- thus False using as(7) and `card s > 2` by (metis Numeral1_eq1_nat less_0_number_of less_int_code(15)
- less_nat_number_of not_less_iff_gr_or_eq of_nat_1 of_nat_eq_iff pos2 rel_simps(4)) qed
- then obtain x where x:"x\<in>s" "u x \<noteq> 1" by auto
-
- have c:"card (s - {x}) = card s - 1" apply(rule card_Diff_singleton) using `x\<in>s` as(4) by auto
- have *:"s = insert x (s - {x})" "finite (s - {x})" using `x\<in>s` and as(4) by auto
- have **:"setsum u (s - {x}) = 1 - u x"
- using setsum_clauses(2)[OF *(2), of u x, unfolded *(1)[THEN sym] as(7)] by auto
- have ***:"inverse (1 - u x) * setsum u (s - {x}) = 1" unfolding ** using `u x \<noteq> 1` by auto
- have "(\<Sum>xa\<in>s - {x}. (inverse (1 - u x) * u xa) *\<^sub>R xa) \<in> V" proof(cases "card (s - {x}) > 2")
- case True hence "s - {x} \<noteq> {}" "card (s - {x}) = n" unfolding c and as(1)[symmetric] proof(rule_tac ccontr)
- assume "\<not> s - {x} \<noteq> {}" hence "card (s - {x}) = 0" unfolding card_0_eq[OF *(2)] by simp
- thus False using True by auto qed auto
- thus ?thesis apply(rule_tac IA[of "s - {x}" "\<lambda>y. (inverse (1 - u x) * u y)"])
- unfolding setsum_right_distrib[THEN sym] using as and *** and True by auto
- next case False hence "card (s - {x}) = Suc (Suc 0)" using as(2) and c by auto
- then obtain a b where "(s - {x}) = {a, b}" "a\<noteq>b" unfolding card_Suc_eq by auto
- thus ?thesis using as(3)[THEN bspec[where x=a], THEN bspec[where x=b]]
- using *** *(2) and `s \<subseteq> V` unfolding setsum_right_distrib by(auto simp add: setsum_clauses(2)) qed
- thus "(\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V" unfolding scaleR_scaleR[THEN sym] and scaleR_right.setsum [symmetric]
- apply(subst *) unfolding setsum_clauses(2)[OF *(2)]
- 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)"],
- 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
- qed auto
- next assume "card s = 1" then obtain a where "s={a}" by(auto simp add: card_Suc_eq)
- thus ?thesis using as(4,5) by simp
- qed(insert `s\<noteq>{}` `finite s`, auto)
-qed
-
-lemma affine_hull_explicit:
- "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}"
- apply(rule hull_unique) apply(subst subset_eq) prefer 3 apply rule unfolding mem_Collect_eq and mem_def[of _ affine]
- apply (erule exE)+ apply(erule conjE)+ prefer 2 apply rule proof-
- 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"
- apply(rule_tac x="{x}" in exI, rule_tac x="\<lambda>x. 1" in exI) by auto
-next
- 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"
- thus "x \<in> t" using as(2)[unfolded affine, THEN spec[where x=s], THEN spec[where x=u]] by auto
-next
- 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
- apply(rule,rule,rule,rule,rule) unfolding mem_Collect_eq proof-
- fix u v ::real assume uv:"u + v = 1"
- 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"
- 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
- 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"
- 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
- have xy:"finite (sx \<union> sy)" using x(1) y(1) by auto
- have **:"(sx \<union> sy) \<inter> sx = sx" "(sx \<union> sy) \<inter> sy = sy" by auto
- 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"
- apply(rule_tac x="sx \<union> sy" in exI)
- 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)
- unfolding scaleR_left_distrib setsum_addf if_smult scaleR_zero_left ** setsum_restrict_set[OF xy, THEN sym]
- unfolding scaleR_scaleR[THEN sym] scaleR_right.setsum [symmetric] and setsum_right_distrib[THEN sym]
- unfolding x y using x(1-3) y(1-3) uv by simp qed qed
-
-lemma affine_hull_finite:
- assumes "finite s"
- shows "affine hull s = {y. \<exists>u. setsum u s = 1 \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = y}"
- unfolding affine_hull_explicit and expand_set_eq and mem_Collect_eq apply (rule,rule)
- apply(erule exE)+ apply(erule conjE)+ defer apply(erule exE) apply(erule conjE) proof-
- fix x u assume "setsum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = x"
- 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"
- apply(rule_tac x=s in exI, rule_tac x=u in exI) using assms by auto
-next
- fix x t u assume "t \<subseteq> s" hence *:"s \<inter> t = t" by auto
- 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"
- 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)
- unfolding if_smult scaleR_zero_left and setsum_restrict_set[OF assms, THEN sym] and * by auto qed
-
-subsection {* Stepping theorems and hence small special cases. *}
-
-lemma affine_hull_empty[simp]: "affine hull {} = {}"
- apply(rule hull_unique) unfolding mem_def by auto
-
-lemma affine_hull_finite_step:
- fixes y :: "'a::real_vector"
- shows "(\<exists>u. setsum u {} = w \<and> setsum (\<lambda>x. u x *\<^sub>R x) {} = y) \<longleftrightarrow> w = 0 \<and> y = 0" (is ?th1)
- "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>
- (\<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)")
-proof-
- show ?th1 by simp
- assume ?as
- { assume ?lhs
- 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
- have ?rhs proof(cases "a\<in>s")
- case True hence *:"insert a s = s" by auto
- show ?thesis using u[unfolded *] apply(rule_tac x=0 in exI) by auto
- next
- case False thus ?thesis apply(rule_tac x="u a" in exI) using u and `?as` by auto
- qed } moreover
- { assume ?rhs
- 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
- 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
- have ?lhs proof(cases "a\<in>s")
- case True thus ?thesis
- apply(rule_tac x="\<lambda>x. (if x=a then v else 0) + u x" in exI)
- unfolding setsum_clauses(2)[OF `?as`] apply simp
- unfolding scaleR_left_distrib and setsum_addf
- unfolding vu and * and scaleR_zero_left
- by (auto simp add: setsum_delta[OF `?as`])
- next
- case False
- hence **:"\<And>x. x \<in> s \<Longrightarrow> u x = (if x = a then v else u x)"
- "\<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
- from False show ?thesis
- apply(rule_tac x="\<lambda>x. if x=a then v else u x" in exI)
- unfolding setsum_clauses(2)[OF `?as`] and * using vu
- 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)]
- using setsum_cong2[of s u "\<lambda>x. if x = a then v else u x", OF **(1)] by auto
- qed }
- ultimately show "?lhs = ?rhs" by blast
-qed
-
-lemma affine_hull_2:
- fixes a b :: "'a::real_vector"
- shows "affine hull {a,b} = {u *\<^sub>R a + v *\<^sub>R b| u v. (u + v = 1)}" (is "?lhs = ?rhs")
-proof-
- have *:"\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::real)"
- "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::'a)" by auto
- have "?lhs = {y. \<exists>u. setsum u {a, b} = 1 \<and> (\<Sum>v\<in>{a, b}. u v *\<^sub>R v) = y}"
- using affine_hull_finite[of "{a,b}"] by auto
- also have "\<dots> = {y. \<exists>v u. u b = 1 - v \<and> u b *\<^sub>R b = y - v *\<^sub>R a}"
- by(simp add: affine_hull_finite_step(2)[of "{b}" a])
- also have "\<dots> = ?rhs" unfolding * by auto
- finally show ?thesis by auto
-qed
-
-lemma affine_hull_3:
- fixes a b c :: "'a::real_vector"
- 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")
-proof-
- have *:"\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::real)"
- "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::'a)" by auto
- show ?thesis apply(simp add: affine_hull_finite affine_hull_finite_step)
- unfolding * apply auto
- apply(rule_tac x=v in exI) apply(rule_tac x=va in exI) apply auto
- apply(rule_tac x=u in exI) by(auto intro!: exI)
-qed
-
-subsection {* Some relations between affine hull and subspaces. *}
-
-lemma affine_hull_insert_subset_span:
- fixes a :: "real ^ _"
- shows "affine hull (insert a s) \<subseteq> {a + v| v . v \<in> span {x - a | x . x \<in> s}}"
- unfolding subset_eq Ball_def unfolding affine_hull_explicit span_explicit mem_Collect_eq smult_conv_scaleR
- apply(rule,rule) apply(erule exE)+ apply(erule conjE)+ proof-
- 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"
- have "(\<lambda>x. x - a) ` (t - {a}) \<subseteq> {x - a |x. x \<in> s}" using as(3) by auto
- 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)"
- apply(rule_tac x="x - a" in exI)
- apply (rule conjI, simp)
- apply(rule_tac x="(\<lambda>x. x - a) ` (t - {a})" in exI)
- apply(rule_tac x="\<lambda>x. u (x + a)" in exI)
- apply (rule conjI) using as(1) apply simp
- apply (erule conjI)
- using as(1)
- 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)
- unfolding as by simp qed
-
-lemma affine_hull_insert_span:
- fixes a :: "real ^ _"
- assumes "a \<notin> s"
- shows "affine hull (insert a s) =
- {a + v | v . v \<in> span {x - a | x. x \<in> s}}"
- apply(rule, rule affine_hull_insert_subset_span) unfolding subset_eq Ball_def
- unfolding affine_hull_explicit and mem_Collect_eq proof(rule,rule,erule exE,erule conjE)
- fix y v assume "y = a + v" "v \<in> span {x - a |x. x \<in> s}"
- 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
- def f \<equiv> "(\<lambda>x. x + a) ` t"
- 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
- by(auto simp add: setsum_reindex[unfolded inj_on_def])
- have *:"f \<inter> {a} = {}" "f \<inter> - {a} = f" using f(2) assms by auto
- 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"
- apply(rule_tac x="insert a f" in exI)
- apply(rule_tac x="\<lambda>x. if x=a then 1 - setsum (\<lambda>x. u (x - a)) f else u (x - a)" in exI)
- using assms and f unfolding setsum_clauses(2)[OF f(1)] and if_smult
- unfolding setsum_cases[OF f(1), of "{a}", unfolded singleton_iff] and *
- by (auto simp add: setsum_subtractf scaleR_left.setsum algebra_simps) qed
-
-lemma affine_hull_span:
- fixes a :: "real ^ _"
- assumes "a \<in> s"
- shows "affine hull s = {a + v | v. v \<in> span {x - a | x. x \<in> s - {a}}}"
- using affine_hull_insert_span[of a "s - {a}", unfolded insert_Diff[OF assms]] by auto
-
-subsection {* Convexity. *}
-
-definition
- convex :: "'a::real_vector set \<Rightarrow> bool" where
- "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)"
-
-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)"
-proof- have *:"\<And>u v::real. u + v = 1 \<longleftrightarrow> u = 1 - v" by auto
- show ?thesis unfolding convex_def apply auto
- apply(erule_tac x=x in ballE) apply(erule_tac x=y in ballE) apply(erule_tac x="1 - u" in allE)
- by (auto simp add: *) qed
-
-lemma mem_convex:
- assumes "convex s" "a \<in> s" "b \<in> s" "0 \<le> u" "u \<le> 1"
- shows "((1 - u) *\<^sub>R a + u *\<^sub>R b) \<in> s"
- using assms unfolding convex_alt by auto
-
-lemma convex_empty[intro]: "convex {}"
- unfolding convex_def by simp
-
-lemma convex_singleton[intro]: "convex {a}"
- unfolding convex_def by (auto simp add:scaleR_left_distrib[THEN sym])
-
-lemma convex_UNIV[intro]: "convex UNIV"
- unfolding convex_def by auto
-
-lemma convex_Inter: "(\<forall>s\<in>f. convex s) ==> convex(\<Inter> f)"
- unfolding convex_def by auto
-
-lemma convex_Int: "convex s \<Longrightarrow> convex t \<Longrightarrow> convex (s \<inter> t)"
- unfolding convex_def by auto
-
-lemma convex_halfspace_le: "convex {x. inner a x \<le> b}"
- unfolding convex_def apply auto
- unfolding inner_add inner_scaleR
- by (metis real_convex_bound_le)
-
-lemma convex_halfspace_ge: "convex {x. inner a x \<ge> b}"
-proof- have *:"{x. inner a x \<ge> b} = {x. inner (-a) x \<le> -b}" by auto
- show ?thesis apply(unfold *) using convex_halfspace_le[of "-a" "-b"] by auto qed
-
-lemma convex_hyperplane: "convex {x. inner a x = b}"
-proof-
- have *:"{x. inner a x = b} = {x. inner a x \<le> b} \<inter> {x. inner a x \<ge> b}" by auto
- show ?thesis unfolding * apply(rule convex_Int)
- using convex_halfspace_le convex_halfspace_ge by auto
-qed
-
-lemma convex_halfspace_lt: "convex {x. inner a x < b}"
- unfolding convex_def
- by(auto simp add: real_convex_bound_lt inner_add)
-
-lemma convex_halfspace_gt: "convex {x. inner a x > b}"
- using convex_halfspace_lt[of "-a" "-b"] by auto
-
-lemma convex_positive_orthant: "convex {x::real^'n::finite. (\<forall>i. 0 \<le> x$i)}"
- unfolding convex_def apply auto apply(erule_tac x=i in allE)+
- apply(rule add_nonneg_nonneg) by(auto simp add: mult_nonneg_nonneg)
-
-subsection {* Explicit expressions for convexity in terms of arbitrary sums. *}
-
-lemma convex: "convex s \<longleftrightarrow>
- (\<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> setsum (\<lambda>i. u i *\<^sub>R x i) {1..k} \<in> s)"
- unfolding convex_def apply rule apply(rule allI)+ defer apply(rule ballI)+ apply(rule allI)+ proof(rule,rule,rule,rule)
- 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"
- "x \<in> s" "y \<in> s" "0 \<le> u" "0 \<le> v" "u + v = (1::real)"
- 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-)
- by (auto simp add: setsum_head_Suc)
-next
- 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"
- 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)
- case (Suc k) show ?case proof(cases "u (Suc k) = 1")
- 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-
- fix i assume i:"i \<in> {Suc 0..k}" "u i *\<^sub>R x i \<noteq> 0"
- hence ui:"u i \<noteq> 0" by auto
- 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
- hence "setsum u {1 .. k} \<ge> u i" using i(1) by(auto simp add: setsum_delta)
- 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
- thus False using Suc(3) unfolding setsum_cl_ivl_Suc and True by simp qed
- thus ?thesis unfolding setsum_cl_ivl_Suc using True and Suc(2) by auto
- next
- have *:"setsum u {1..k} = 1 - u (Suc k)" using Suc(3)[unfolded setsum_cl_ivl_Suc] by auto
- 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
- 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)
- case False hence nn:"1 - u (Suc k) \<noteq> 0" by auto
- 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 *
- apply(rule_tac allI) apply(rule,rule) apply(rule divide_nonneg_pos) using nn Suc(2) ** by auto
- 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"
- 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
- thus ?thesis unfolding setsum_cl_ivl_Suc and *** and scaleR_right.setsum [symmetric] using nn by auto qed qed auto qed
-
-
-lemma convex_explicit:
- fixes s :: "'a::real_vector set"
- shows "convex s \<longleftrightarrow>
- (\<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)"
- unfolding convex_def apply(rule,rule,rule) apply(subst imp_conjL,rule) defer apply(rule,rule,rule,rule,rule,rule,rule) proof-
- 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)"
- show "u *\<^sub>R x + v *\<^sub>R y \<in> s" proof(cases "x=y")
- case True show ?thesis unfolding True and scaleR_left_distrib[THEN sym] using as(3,6) by auto next
- 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
-next
- 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)"
- (*"finite t" "t \<subseteq> s" "\<forall>x\<in>t. (0::real) \<le> u x" "setsum u t = 1"*)
- 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)
- prefer 3 apply (rule,rule) apply(erule conjE)+ proof-
- 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"
- 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)"
- show "(\<Sum>x\<in>insert x f. u x *\<^sub>R x) \<in> s" proof(cases "u x = 1")
- 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-
- fix y assume y:"y \<in> f" "u y *\<^sub>R y \<noteq> 0"
- hence uy:"u y \<noteq> 0" by auto
- 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
- hence "setsum u f \<ge> u y" using y(1) and as(1) by(auto simp add: setsum_delta)
- hence "setsum u f > 0" using uy apply(rule_tac less_le_trans[of _ "u y"]) using as(4) and y(1) by auto
- thus False using as(2,5) unfolding setsum_clauses(2)[OF as(1)] and True by auto qed
- thus ?thesis unfolding setsum_clauses(2)[OF as(1)] using as(2,3) unfolding True by auto
- next
- have *:"setsum u f = setsum u (insert x f) - u x" using as(2) unfolding setsum_clauses(2)[OF as(1)] by auto
- have **:"u x \<le> 1" apply(rule ccontr) unfolding not_le using as(5)[unfolded setsum_clauses(2)[OF as(1)]] and as(2)
- using setsum_nonneg[of f u] and as(4) by auto
- 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
- apply(rule_tac ind[THEN spec, THEN mp]) apply rule defer apply rule apply rule apply(rule mult_nonneg_nonneg)
- unfolding setsum_right_distrib[THEN sym] and * using as and ** by auto
- 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"
- 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
- thus ?thesis unfolding setsum_clauses(2)[OF as(1)] using as(2) and False by auto qed
- 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
-qed
-
-lemma convex_finite: assumes "finite s"
- shows "convex s \<longleftrightarrow> (\<forall>u. (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1
- \<longrightarrow> setsum (\<lambda>x. u x *\<^sub>R x) s \<in> s)"
- unfolding convex_explicit apply(rule, rule, rule) defer apply(rule,rule,rule)apply(erule conjE)+ proof-
- 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)"
- have *:"s \<inter> t = t" using as(3) by auto
- 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"]]
- unfolding if_smult and setsum_cases[OF assms] and * using as(2-) by auto
-qed (erule_tac x=s in allE, erule_tac x=u in allE, auto)
-
-subsection {* Cones. *}
-
-definition
- cone :: "'a::real_vector set \<Rightarrow> bool" where
- "cone s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>c\<ge>0. (c *\<^sub>R x) \<in> s)"
-
-lemma cone_empty[intro, simp]: "cone {}"
- unfolding cone_def by auto
-
-lemma cone_univ[intro, simp]: "cone UNIV"
- unfolding cone_def by auto
-
-lemma cone_Inter[intro]: "(\<forall>s\<in>f. cone s) \<Longrightarrow> cone(\<Inter> f)"
- unfolding cone_def by auto
-
-subsection {* Conic hull. *}
-
-lemma cone_cone_hull: "cone (cone hull s)"
- unfolding hull_def using cone_Inter[of "{t \<in> conic. s \<subseteq> t}"]
- by (auto simp add: mem_def)
-
-lemma cone_hull_eq: "(cone hull s = s) \<longleftrightarrow> cone s"
- apply(rule hull_eq[unfolded mem_def])
- using cone_Inter unfolding subset_eq by (auto simp add: mem_def)
-
-subsection {* Affine dependence and consequential theorems (from Lars Schewe). *}
-
-definition
- affine_dependent :: "'a::real_vector set \<Rightarrow> bool" where
- "affine_dependent s \<longleftrightarrow> (\<exists>x\<in>s. x \<in> (affine hull (s - {x})))"
-
-lemma affine_dependent_explicit:
- "affine_dependent p \<longleftrightarrow>
- (\<exists>s u. finite s \<and> s \<subseteq> p \<and> setsum u s = 0 \<and>
- (\<exists>v\<in>s. u v \<noteq> 0) \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = 0)"
- unfolding affine_dependent_def affine_hull_explicit mem_Collect_eq apply(rule)
- apply(erule bexE,erule exE,erule exE) apply(erule conjE)+ defer apply(erule exE,erule exE) apply(erule conjE)+ apply(erule bexE)
-proof-
- 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"
- have "x\<notin>s" using as(1,4) by auto
- 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"
- apply(rule_tac x="insert x s" in exI, rule_tac x="\<lambda>v. if v = x then - 1 else u v" in exI)
- unfolding if_smult and setsum_clauses(2)[OF as(2)] and setsum_delta_notmem[OF `x\<notin>s`] and as using as by auto
-next
- 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"
- have "s \<noteq> {v}" using as(3,6) by auto
- 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"
- 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)
- 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
-qed
-
-lemma affine_dependent_explicit_finite:
- fixes s :: "'a::real_vector set" assumes "finite s"
- 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)"
- (is "?lhs = ?rhs")
-proof
- 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
- assume ?lhs
- 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"
- unfolding affine_dependent_explicit by auto
- thus ?rhs apply(rule_tac x="\<lambda>x. if x\<in>t then u x else 0" in exI)
- apply auto unfolding * and setsum_restrict_set[OF assms, THEN sym]
- unfolding Int_absorb1[OF `t\<subseteq>s`] by auto
-next
- assume ?rhs
- 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
- thus ?lhs unfolding affine_dependent_explicit using assms by auto
-qed
-
-subsection {* A general lemma. *}
-
-lemma convex_connected:
- fixes s :: "'a::real_normed_vector set"
- assumes "convex s" shows "connected s"
-proof-
- { fix e1 e2 assume as:"open e1" "open e2" "e1 \<inter> e2 \<inter> s = {}" "s \<subseteq> e1 \<union> e2"
- assume "e1 \<inter> s \<noteq> {}" "e2 \<inter> s \<noteq> {}"
- then obtain x1 x2 where x1:"x1\<in>e1" "x1\<in>s" and x2:"x2\<in>e2" "x2\<in>s" by auto
- hence n:"norm (x1 - x2) > 0" unfolding zero_less_norm_iff using as(3) by auto
-
- { fix x e::real assume as:"0 \<le> x" "x \<le> 1" "0 < e"
- { 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"
- by (simp add: algebra_simps)
- assume "\<bar>y - x\<bar> < e / norm (x1 - x2)"
- hence "norm ((1 - x) *\<^sub>R x1 + x *\<^sub>R x2 - ((1 - y) *\<^sub>R x1 + y *\<^sub>R x2)) < e"
- unfolding * and scaleR_right_diff_distrib[THEN sym]
- unfolding less_divide_eq using n by auto }
- 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"
- apply(rule_tac x="e / norm (x1 - x2)" in exI) using as
- apply auto unfolding zero_less_divide_iff using n by simp } note * = this
-
- 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"
- apply(rule connected_real_lemma) apply (simp add: `x1\<in>e1` `x2\<in>e2` dist_commute)+
- using * apply(simp add: dist_norm)
- using as(1,2)[unfolded open_dist] apply simp
- using as(1,2)[unfolded open_dist] apply simp
- using assms[unfolded convex_alt, THEN bspec[where x=x1], THEN bspec[where x=x2]] using x1 x2
- using as(3) by auto
- 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
- hence False using as(4)
- using assms[unfolded convex_alt, THEN bspec[where x=x1], THEN bspec[where x=x2]]
- using x1(2) x2(2) by auto }
- thus ?thesis unfolding connected_def by auto
-qed
-
-subsection {* One rather trivial consequence. *}
-
-lemma connected_UNIV: "connected (UNIV :: 'a::real_normed_vector set)"
- by(simp add: convex_connected convex_UNIV)
-
-subsection {* Convex functions into the reals. *}
-
-definition
- convex_on :: "'a::real_vector set \<Rightarrow> ('a \<Rightarrow> real) \<Rightarrow> bool" where
- "convex_on s f \<longleftrightarrow>
- (\<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)"
-
-lemma convex_on_subset: "convex_on t f \<Longrightarrow> s \<subseteq> t \<Longrightarrow> convex_on s f"
- unfolding convex_on_def by auto
-
-lemma convex_add:
- assumes "convex_on s f" "convex_on s g"
- shows "convex_on s (\<lambda>x. f x + g x)"
-proof-
- { fix x y assume "x\<in>s" "y\<in>s" moreover
- fix u v ::real assume "0 \<le> u" "0 \<le> v" "u + v = 1"
- 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)"
- using assms(1)[unfolded convex_on_def, THEN bspec[where x=x], THEN bspec[where x=y], THEN spec[where x=u]]
- using assms(2)[unfolded convex_on_def, THEN bspec[where x=x], THEN bspec[where x=y], THEN spec[where x=u]]
- apply - apply(rule add_mono) by auto
- 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) }
- thus ?thesis unfolding convex_on_def by auto
-qed
-
-lemma convex_cmul:
- assumes "0 \<le> (c::real)" "convex_on s f"
- shows "convex_on s (\<lambda>x. c * f x)"
-proof-
- have *:"\<And>u c fx v fy ::real. u * (c * fx) + v * (c * fy) = c * (u * fx + v * fy)" by (simp add: ring_simps)
- show ?thesis using assms(2) and mult_mono1[OF _ assms(1)] unfolding convex_on_def and * by auto
-qed
-
-lemma convex_lower:
- assumes "convex_on s f" "x\<in>s" "y \<in> s" "0 \<le> u" "0 \<le> v" "u + v = 1"
- shows "f (u *\<^sub>R x + v *\<^sub>R y) \<le> max (f x) (f y)"
-proof-
- let ?m = "max (f x) (f y)"
- have "u * f x + v * f y \<le> u * max (f x) (f y) + v * max (f x) (f y)" apply(rule add_mono)
- using assms(4,5) by(auto simp add: mult_mono1)
- also have "\<dots> = max (f x) (f y)" using assms(6) unfolding distrib[THEN sym] by auto
- 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]]
- using assms(2-6) by auto
-qed
-
-lemma convex_local_global_minimum:
- fixes s :: "'a::real_normed_vector set"
- assumes "0<e" "convex_on s f" "ball x e \<subseteq> s" "\<forall>y\<in>ball x e. f x \<le> f y"
- shows "\<forall>y\<in>s. f x \<le> f y"
-proof(rule ccontr)
- have "x\<in>s" using assms(1,3) by auto
- assume "\<not> (\<forall>y\<in>s. f x \<le> f y)"
- then obtain y where "y\<in>s" and y:"f x > f y" by auto
- hence xy:"0 < dist x y" by (auto simp add: dist_nz[THEN sym])
-
- then obtain u where "0 < u" "u \<le> 1" and u:"u < e / dist x y"
- 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
- 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`
- 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
- moreover
- have *:"x - ((1 - u) *\<^sub>R x + u *\<^sub>R y) = u *\<^sub>R (x - y)" by (simp add: algebra_simps)
- 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]
- using u unfolding pos_less_divide_eq[OF xy] by auto
- hence "f x \<le> f ((1 - u) *\<^sub>R x + u *\<^sub>R y)" using assms(4) by auto
- ultimately show False using mult_strict_left_mono[OF y `u>0`] unfolding left_diff_distrib by auto
-qed
-
-lemma convex_distance:
- fixes s :: "'a::real_normed_vector set"
- shows "convex_on s (\<lambda>x. dist a x)"
-proof(auto simp add: convex_on_def dist_norm)
- fix x y assume "x\<in>s" "y\<in>s"
- fix u v ::real assume "0 \<le> u" "0 \<le> v" "u + v = 1"
- have "a = u *\<^sub>R a + v *\<^sub>R a" unfolding scaleR_left_distrib[THEN sym] and `u+v=1` by simp
- hence *:"a - (u *\<^sub>R x + v *\<^sub>R y) = (u *\<^sub>R (a - x)) + (v *\<^sub>R (a - y))"
- by (auto simp add: algebra_simps)
- show "norm (a - (u *\<^sub>R x + v *\<^sub>R y)) \<le> u * norm (a - x) + v * norm (a - y)"
- unfolding * using norm_triangle_ineq[of "u *\<^sub>R (a - x)" "v *\<^sub>R (a - y)"]
- using `0 \<le> u` `0 \<le> v` by auto
-qed
-
-subsection {* Arithmetic operations on sets preserve convexity. *}
-
-lemma convex_scaling: "convex s \<Longrightarrow> convex ((\<lambda>x. c *\<^sub>R x) ` s)"
- unfolding convex_def and image_iff apply auto
- apply (rule_tac x="u *\<^sub>R x+v *\<^sub>R y" in bexI) by (auto simp add: algebra_simps)
-
-lemma convex_negations: "convex s \<Longrightarrow> convex ((\<lambda>x. -x)` s)"
- unfolding convex_def and image_iff apply auto
- apply (rule_tac x="u *\<^sub>R x+v *\<^sub>R y" in bexI) by auto
-
-lemma convex_sums:
- assumes "convex s" "convex t"
- shows "convex {x + y| x y. x \<in> s \<and> y \<in> t}"
-proof(auto simp add: convex_def image_iff scaleR_right_distrib)
- fix xa xb ya yb assume xy:"xa\<in>s" "xb\<in>s" "ya\<in>t" "yb\<in>t"
- fix u v ::real assume uv:"0 \<le> u" "0 \<le> v" "u + v = 1"
- 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"
- 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)
- using assms(1)[unfolded convex_def, THEN bspec[where x=xa], THEN bspec[where x=xb]]
- using assms(2)[unfolded convex_def, THEN bspec[where x=ya], THEN bspec[where x=yb]]
- using uv xy by auto
-qed
-
-lemma convex_differences:
- assumes "convex s" "convex t"
- shows "convex {x - y| x y. x \<in> s \<and> y \<in> t}"
-proof-
- 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
- apply(rule_tac x=xa in exI) apply(rule_tac x="-y" in exI) apply simp
- apply(rule_tac x=xa in exI) apply(rule_tac x=xb in exI) by simp
- thus ?thesis using convex_sums[OF assms(1) convex_negations[OF assms(2)]] by auto
-qed
-
-lemma convex_translation: assumes "convex s" shows "convex ((\<lambda>x. a + x) ` s)"
-proof- have "{a + y |y. y \<in> s} = (\<lambda>x. a + x) ` s" by auto
- thus ?thesis using convex_sums[OF convex_singleton[of a] assms] by auto qed
-
-lemma convex_affinity: assumes "convex s" shows "convex ((\<lambda>x. a + c *\<^sub>R x) ` s)"
-proof- have "(\<lambda>x. a + c *\<^sub>R x) ` s = op + a ` op *\<^sub>R c ` s" by auto
- thus ?thesis using convex_translation[OF convex_scaling[OF assms], of a c] by auto qed
-
-lemma convex_linear_image:
- assumes c:"convex s" and l:"bounded_linear f"
- shows "convex(f ` s)"
-proof(auto simp add: convex_def)
- interpret f: bounded_linear f by fact
- fix x y assume xy:"x \<in> s" "y \<in> s"
- fix u v ::real assume uv:"0 \<le> u" "0 \<le> v" "u + v = 1"
- show "u *\<^sub>R f x + v *\<^sub>R f y \<in> f ` s" unfolding image_iff
- apply(rule_tac x="u *\<^sub>R x + v *\<^sub>R y" in bexI)
- unfolding f.add f.scaleR
- using c[unfolded convex_def] xy uv by auto
-qed
-
-subsection {* Balls, being convex, are connected. *}
-
-lemma convex_ball:
- fixes x :: "'a::real_normed_vector"
- shows "convex (ball x e)"
-proof(auto simp add: convex_def)
- fix y z assume yz:"dist x y < e" "dist x z < e"
- fix u v ::real assume uv:"0 \<le> u" "0 \<le> v" "u + v = 1"
- have "dist x (u *\<^sub>R y + v *\<^sub>R z) \<le> u * dist x y + v * dist x z" using uv yz
- using convex_distance[of "ball x e" x, unfolded convex_on_def, THEN bspec[where x=y], THEN bspec[where x=z]] by auto
- thus "dist x (u *\<^sub>R y + v *\<^sub>R z) < e" using real_convex_bound_lt[OF yz uv] by auto
-qed
-
-lemma convex_cball:
- fixes x :: "'a::real_normed_vector"
- shows "convex(cball x e)"
-proof(auto simp add: convex_def Ball_def mem_cball)
- fix y z assume yz:"dist x y \<le> e" "dist x z \<le> e"
- fix u v ::real assume uv:" 0 \<le> u" "0 \<le> v" "u + v = 1"
- have "dist x (u *\<^sub>R y + v *\<^sub>R z) \<le> u * dist x y + v * dist x z" using uv yz
- using convex_distance[of "cball x e" x, unfolded convex_on_def, THEN bspec[where x=y], THEN bspec[where x=z]] by auto
- thus "dist x (u *\<^sub>R y + v *\<^sub>R z) \<le> e" using real_convex_bound_le[OF yz uv] by auto
-qed
-
-lemma connected_ball:
- fixes x :: "'a::real_normed_vector"
- shows "connected (ball x e)"
- using convex_connected convex_ball by auto
-
-lemma connected_cball:
- fixes x :: "'a::real_normed_vector"
- shows "connected(cball x e)"
- using convex_connected convex_cball by auto
-
-subsection {* Convex hull. *}
-
-lemma convex_convex_hull: "convex(convex hull s)"
- unfolding hull_def using convex_Inter[of "{t\<in>convex. s\<subseteq>t}"]
- unfolding mem_def by auto
-
-lemma convex_hull_eq: "(convex hull s = s) \<longleftrightarrow> convex s" apply(rule hull_eq[unfolded mem_def])
- using convex_Inter[unfolded Ball_def mem_def] by auto
-
-lemma bounded_convex_hull:
- fixes s :: "'a::real_normed_vector set"
- assumes "bounded s" shows "bounded(convex hull s)"
-proof- from assms obtain B where B:"\<forall>x\<in>s. norm x \<le> B" unfolding bounded_iff by auto
- show ?thesis apply(rule bounded_subset[OF bounded_cball, of _ 0 B])
- unfolding subset_hull[unfolded mem_def, of convex, OF convex_cball]
- unfolding subset_eq mem_cball dist_norm using B by auto qed
-
-lemma finite_imp_bounded_convex_hull:
- fixes s :: "'a::real_normed_vector set"
- shows "finite s \<Longrightarrow> bounded(convex hull s)"
- using bounded_convex_hull finite_imp_bounded by auto
-
-subsection {* Stepping theorems for convex hulls of finite sets. *}
-
-lemma convex_hull_empty[simp]: "convex hull {} = {}"
- apply(rule hull_unique) unfolding mem_def by auto
-
-lemma convex_hull_singleton[simp]: "convex hull {a} = {a}"
- apply(rule hull_unique) unfolding mem_def by auto
-
-lemma convex_hull_insert:
- fixes s :: "'a::real_vector set"
- assumes "s \<noteq> {}"
- shows "convex hull (insert a s) = {x. \<exists>u\<ge>0. \<exists>v\<ge>0. \<exists>b. (u + v = 1) \<and>
- b \<in> (convex hull s) \<and> (x = u *\<^sub>R a + v *\<^sub>R b)}" (is "?xyz = ?hull")
- apply(rule,rule hull_minimal,rule) unfolding mem_def[of _ convex] and insert_iff prefer 3 apply rule proof-
- fix x assume x:"x = a \<or> x \<in> s"
- thus "x\<in>?hull" apply rule unfolding mem_Collect_eq apply(rule_tac x=1 in exI) defer
- apply(rule_tac x=0 in exI) using assms hull_subset[of s convex] by auto
-next
- fix x assume "x\<in>?hull"
- 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
- have "a\<in>convex hull insert a s" "b\<in>convex hull insert a s"
- using hull_mono[of s "insert a s" convex] hull_mono[of "{a}" "insert a s" convex] and obt(4) by auto
- thus "x\<in> convex hull insert a s" unfolding obt(5) using convex_convex_hull[of "insert a s", unfolded convex_def]
- 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
-next
- show "convex ?hull" unfolding convex_def apply(rule,rule,rule,rule,rule,rule,rule) proof-
- fix x y u v assume as:"(0::real) \<le> u" "0 \<le> v" "u + v = 1" "x\<in>?hull" "y\<in>?hull"
- 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
- 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
- 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)
- 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)"
- proof(cases "u * v1 + v * v2 = 0")
- 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)
- case True hence **:"u * v1 = 0" "v * v2 = 0" apply- apply(rule_tac [!] ccontr)
- using mult_nonneg_nonneg[OF `u\<ge>0` `v1\<ge>0`] mult_nonneg_nonneg[OF `v\<ge>0` `v2\<ge>0`] by auto
- hence "u * u1 + v * u2 = 1" using as(3) obt1(3) obt2(3) by auto
- thus ?thesis unfolding obt1(5) obt2(5) * using assms hull_subset[of s convex] by(auto simp add: ** scaleR_right_distrib)
- next
- 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)
- also have "\<dots> = u * (v1 + u1 - u1) + v * (v2 + u2 - u2)" using as(3) obt1(3) obt2(3) by (auto simp add: field_simps)
- also have "\<dots> = u * v1 + v * v2" by simp finally have **:"1 - (u * u1 + v * u2) = u * v1 + v * v2" by auto
- case False have "0 \<le> u * v1 + v * v2" "0 \<le> u * v1" "0 \<le> u * v1 + v * v2" "0 \<le> v * v2" apply -
- apply(rule add_nonneg_nonneg) prefer 4 apply(rule add_nonneg_nonneg) apply(rule_tac [!] mult_nonneg_nonneg)
- using as(1,2) obt1(1,2) obt2(1,2) by auto
- thus ?thesis unfolding obt1(5) obt2(5) unfolding * and ** using False
- 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
- apply(rule convex_convex_hull[of s, unfolded convex_def, rule_format]) using obt1(4) obt2(4)
- unfolding add_divide_distrib[THEN sym] and real_0_le_divide_iff
- by (auto simp add: scaleR_left_distrib scaleR_right_distrib)
- qed note * = this
- have u1:"u1 \<le> 1" apply(rule ccontr) unfolding obt1(3)[THEN sym] and not_le using obt1(2) by auto
- have u2:"u2 \<le> 1" apply(rule ccontr) unfolding obt2(3)[THEN sym] and not_le using obt2(2) by auto
- have "u1 * u + u2 * v \<le> (max u1 u2) * u + (max u1 u2) * v" apply(rule add_mono)
- apply(rule_tac [!] mult_right_mono) using as(1,2) obt1(1,2) obt2(1,2) by auto
- also have "\<dots> \<le> 1" unfolding mult.add_right[THEN sym] and as(3) using u1 u2 by auto
- finally
- 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)
- apply(rule conjI) defer apply(rule_tac x="1 - u * u1 - v * u2" in exI) unfolding Bex_def
- using as(1,2) obt1(1,2) obt2(1,2) * by(auto intro!: mult_nonneg_nonneg add_nonneg_nonneg simp add: algebra_simps)
- qed
-qed
-
-
-subsection {* Explicit expression for convex hull. *}
-
-lemma convex_hull_indexed:
- fixes s :: "'a::real_vector set"
- 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>
- (setsum u {1..k} = 1) \<and>
- (setsum (\<lambda>i. u i *\<^sub>R x i) {1..k} = y)}" (is "?xyz = ?hull")
- apply(rule hull_unique) unfolding mem_def[of _ convex] apply(rule) defer
- apply(subst convex_def) apply(rule,rule,rule,rule,rule,rule,rule)
-proof-
- fix x assume "x\<in>s"
- 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
-next
- fix t assume as:"s \<subseteq> t" "convex t"
- show "?hull \<subseteq> t" apply(rule) unfolding mem_Collect_eq apply(erule exE | erule conjE)+ proof-
- 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"
- show "x\<in>t" unfolding assm(3)[THEN sym] apply(rule as(2)[unfolded convex, rule_format])
- using assm(1,2) as(1) by auto qed
-next
- 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"
- 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
- 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
- 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)"
- "{1..k1 + k2} \<inter> {1..k1} = {1..k1}" "{1..k1 + k2} \<inter> - {1..k1} = (\<lambda>i. i + k1) ` {1..k2}"
- prefer 3 apply(rule,rule) unfolding image_iff apply(rule_tac x="x - k1" in bexI) by(auto simp add: not_le)
- have inj:"inj_on (\<lambda>i. i + k1) {1..k2}" unfolding inj_on_def by auto
- show "u *\<^sub>R x + v *\<^sub>R y \<in> ?hull" apply(rule)
- 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)
- 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)
- unfolding * and setsum_cases[OF finite_atLeastAtMost[of 1 "k1 + k2"]] and setsum_reindex[OF inj] and o_def
- unfolding scaleR_scaleR[THEN sym] scaleR_right.setsum [symmetric] setsum_right_distrib[THEN sym] proof-
- fix i assume i:"i \<in> {1..k1+k2}"
- 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"
- proof(cases "i\<in>{1..k1}")
- case True thus ?thesis using mult_nonneg_nonneg[of u "u1 i"] and uv(1) x(1)[THEN bspec[where x=i]] by auto
- next def j \<equiv> "i - k1"
- case False with i have "j \<in> {1..k2}" unfolding j_def by auto
- thus ?thesis unfolding j_def[symmetric] using False
- using mult_nonneg_nonneg[of v "u2 j"] and uv(2) y(1)[THEN bspec[where x=j]] by auto qed
- qed(auto simp add: not_le x(2,3) y(2,3) uv(3))
-qed
-
-lemma convex_hull_finite:
- fixes s :: "'a::real_vector set"
- assumes "finite s"
- shows "convex hull s = {y. \<exists>u. (\<forall>x\<in>s. 0 \<le> u x) \<and>
- setsum u s = 1 \<and> setsum (\<lambda>x. u x *\<^sub>R x) s = y}" (is "?HULL = ?set")
-proof(rule hull_unique, auto simp add: mem_def[of _ convex] convex_def[of ?set])
- 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"
- apply(rule_tac x="\<lambda>y. if x=y then 1 else 0" in exI) apply auto
- unfolding setsum_delta'[OF assms] and setsum_delta''[OF assms] by auto
-next
- fix u v ::real assume uv:"0 \<le> u" "0 \<le> v" "u + v = 1"
- fix ux assume ux:"\<forall>x\<in>s. 0 \<le> ux x" "setsum ux s = (1::real)"
- fix uy assume uy:"\<forall>x\<in>s. 0 \<le> uy x" "setsum uy s = (1::real)"
- { fix x assume "x\<in>s"
- 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)
- by (auto, metis add_nonneg_nonneg mult_nonneg_nonneg uv(1) uv(2)) }
- moreover have "(\<Sum>x\<in>s. u * ux x + v * uy x) = 1"
- unfolding setsum_addf and setsum_right_distrib[THEN sym] and ux(2) uy(2) using uv(3) by auto
- 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)"
- unfolding scaleR_left_distrib and setsum_addf and scaleR_scaleR[THEN sym] and scaleR_right.setsum [symmetric] by auto
- 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)"
- apply(rule_tac x="\<lambda>x. u * ux x + v * uy x" in exI) by auto
-next
- fix t assume t:"s \<subseteq> t" "convex t"
- fix u assume u:"\<forall>x\<in>s. 0 \<le> u x" "setsum u s = (1::real)"
- 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]]
- using assms and t(1) by auto
-qed
-
-subsection {* Another formulation from Lars Schewe. *}
-
-lemma setsum_constant_scaleR:
- fixes y :: "'a::real_vector"
- shows "(\<Sum>x\<in>A. y) = of_nat (card A) *\<^sub>R y"
-apply (cases "finite A")
-apply (induct set: finite)
-apply (simp_all add: algebra_simps)
-done
-
-lemma convex_hull_explicit:
- fixes p :: "'a::real_vector set"
- shows "convex hull p = {y. \<exists>s u. finite s \<and> s \<subseteq> p \<and>
- (\<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")
-proof-
- { fix x assume "x\<in>?lhs"
- 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"
- unfolding convex_hull_indexed by auto
-
- have fin:"finite {1..k}" by auto
- have fin':"\<And>v. finite {i \<in> {1..k}. y i = v}" by auto
- { fix j assume "j\<in>{1..k}"
- hence "y j \<in> p" "0 \<le> setsum u {i. Suc 0 \<le> i \<and> i \<le> k \<and> y i = y j}"
- using obt(1)[THEN bspec[where x=j]] and obt(2) apply simp
- apply(rule setsum_nonneg) using obt(1) by auto }
- moreover
- have "(\<Sum>v\<in>y ` {1..k}. setsum u {i \<in> {1..k}. y i = v}) = 1"
- unfolding setsum_image_gen[OF fin, THEN sym] using obt(2) by auto
- moreover have "(\<Sum>v\<in>y ` {1..k}. setsum u {i \<in> {1..k}. y i = v} *\<^sub>R v) = x"
- using setsum_image_gen[OF fin, of "\<lambda>i. u i *\<^sub>R y i" y, THEN sym]
- unfolding scaleR_left.setsum using obt(3) by auto
- 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"
- apply(rule_tac x="y ` {1..k}" in exI)
- apply(rule_tac x="\<lambda>v. setsum u {i\<in>{1..k}. y i = v}" in exI) by auto
- hence "x\<in>?rhs" by auto }
- moreover
- { fix y assume "y\<in>?rhs"
- 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
-
- 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
-
- { fix i::nat assume "i\<in>{1..card s}"
- hence "f i \<in> s" apply(subst f(2)[THEN sym]) by auto
- hence "0 \<le> u (f i)" "f i \<in> p" using obt(2,3) by auto }
- moreover have *:"finite {1..card s}" by auto
- { fix y assume "y\<in>s"
- 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
- 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
- hence "card {x. Suc 0 \<le> x \<and> x \<le> card s \<and> f x = y} = 1" by auto
- hence "(\<Sum>x\<in>{x \<in> {1..card s}. f x = y}. u (f x)) = u y"
- "(\<Sum>x\<in>{x \<in> {1..card s}. f x = y}. u (f x) *\<^sub>R f x) = u y *\<^sub>R y"
- by (auto simp add: setsum_constant_scaleR) }
-
- hence "(\<Sum>x = 1..card s. u (f x)) = 1" "(\<Sum>i = 1..card s. u (f i) *\<^sub>R f i) = y"
- 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]
- 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"]
- 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
-
- 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"
- 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
- hence "y \<in> ?lhs" unfolding convex_hull_indexed by auto }
- ultimately show ?thesis unfolding expand_set_eq by blast
-qed
-
-subsection {* A stepping theorem for that expansion. *}
-
-lemma convex_hull_finite_step:
- fixes s :: "'a::real_vector set" assumes "finite s"
- 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)
- \<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")
-proof(rule, case_tac[!] "a\<in>s")
- assume "a\<in>s" hence *:"insert a s = s" by auto
- assume ?lhs thus ?rhs unfolding * apply(rule_tac x=0 in exI) by auto
-next
- 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
- assume "a\<notin>s" thus ?rhs apply(rule_tac x="u a" in exI) using u(1)[THEN bspec[where x=a]] apply simp
- apply(rule_tac x=u in exI) using u[unfolded setsum_clauses(2)[OF assms]] and `a\<notin>s` by auto
-next
- assume "a\<in>s" hence *:"insert a s = s" by auto
- have fin:"finite (insert a s)" using assms by auto
- 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
- 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]
- unfolding setsum_clauses(2)[OF assms] using uv and uv(2)[THEN bspec[where x=a]] and `a\<in>s` by auto
-next
- 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
- 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)"
- apply(rule_tac setsum_cong2) defer apply(rule_tac setsum_cong2) using `a\<notin>s` by auto
- 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
-qed
-
-subsection {* Hence some special cases. *}
-
-lemma convex_hull_2:
- "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}"
-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
-show ?thesis apply(simp add: convex_hull_finite) unfolding convex_hull_finite_step[OF **, of a 1, unfolded * conj_assoc]
- apply auto apply(rule_tac x=v in exI) apply(rule_tac x="1 - v" in exI) apply simp
- apply(rule_tac x=u in exI) apply simp apply(rule_tac x="\<lambda>x. v" in exI) by simp qed
-
-lemma convex_hull_2_alt: "convex hull {a,b} = {a + u *\<^sub>R (b - a) | u. 0 \<le> u \<and> u \<le> 1}"
- unfolding convex_hull_2 unfolding Collect_def
-proof(rule ext) have *:"\<And>x y ::real. x + y = 1 \<longleftrightarrow> x = 1 - y" by auto
- 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)"
- unfolding * apply auto apply(rule_tac[!] x=u in exI) by (auto simp add: algebra_simps) qed
-
-lemma convex_hull_3:
- "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}"
-proof-
- have fin:"finite {a,b,c}" "finite {b,c}" "finite {c}" by auto
- have *:"\<And>x y z ::real. x + y + z = 1 \<longleftrightarrow> x = 1 - y - z"
- "\<And>x y z ::real^'n. x + y + z = 1 \<longleftrightarrow> x = 1 - y - z" by (auto simp add: ring_simps)
- show ?thesis unfolding convex_hull_finite[OF fin(1)] and Collect_def and convex_hull_finite_step[OF fin(2)] and *
- unfolding convex_hull_finite_step[OF fin(3)] apply(rule ext) apply simp apply auto
- apply(rule_tac x=va in exI) apply (rule_tac x="u c" in exI) apply simp
- 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
-
-lemma convex_hull_3_alt:
- "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}"
-proof- have *:"\<And>x y z ::real. x + y + z = 1 \<longleftrightarrow> x = 1 - y - z" by auto
- 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)
- apply(rule_tac x=u in exI) apply(rule_tac x=v in exI) by (simp add: algebra_simps) qed
-
-subsection {* Relations among closure notions and corresponding hulls. *}
-
-text {* TODO: Generalize linear algebra concepts defined in @{text
-Euclidean_Space.thy} so that we can generalize these lemmas. *}
-
-lemma subspace_imp_affine:
- fixes s :: "(real ^ _) set" shows "subspace s \<Longrightarrow> affine s"
- unfolding subspace_def affine_def smult_conv_scaleR by auto
-
-lemma affine_imp_convex: "affine s \<Longrightarrow> convex s"
- unfolding affine_def convex_def by auto
-
-lemma subspace_imp_convex:
- fixes s :: "(real ^ _) set" shows "subspace s \<Longrightarrow> convex s"
- using subspace_imp_affine affine_imp_convex by auto
-
-lemma affine_hull_subset_span:
- fixes s :: "(real ^ _) set" shows "(affine hull s) \<subseteq> (span s)"
- unfolding span_def apply(rule hull_antimono) unfolding subset_eq Ball_def mem_def
- using subspace_imp_affine by auto
-
-lemma convex_hull_subset_span:
- fixes s :: "(real ^ _) set" shows "(convex hull s) \<subseteq> (span s)"
- unfolding span_def apply(rule hull_antimono) unfolding subset_eq Ball_def mem_def
- using subspace_imp_convex by auto
-
-lemma convex_hull_subset_affine_hull: "(convex hull s) \<subseteq> (affine hull s)"
- unfolding span_def apply(rule hull_antimono) unfolding subset_eq Ball_def mem_def
- using affine_imp_convex by auto
-
-lemma affine_dependent_imp_dependent:
- fixes s :: "(real ^ _) set" shows "affine_dependent s \<Longrightarrow> dependent s"
- unfolding affine_dependent_def dependent_def
- using affine_hull_subset_span by auto
-
-lemma dependent_imp_affine_dependent:
- fixes s :: "(real ^ _) set"
- assumes "dependent {x - a| x . x \<in> s}" "a \<notin> s"
- shows "affine_dependent (insert a s)"
-proof-
- from assms(1)[unfolded dependent_explicit smult_conv_scaleR] obtain S u v
- 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
- def t \<equiv> "(\<lambda>x. x + a) ` S"
-
- have inj:"inj_on (\<lambda>x. x + a) S" unfolding inj_on_def by auto
- have "0\<notin>S" using obt(2) assms(2) unfolding subset_eq by auto
- have fin:"finite t" and "t\<subseteq>s" unfolding t_def using obt(1,2) by auto
-
- hence "finite (insert a t)" and "insert a t \<subseteq> insert a s" by auto
- moreover have *:"\<And>P Q. (\<Sum>x\<in>t. (if x = a then P x else Q x)) = (\<Sum>x\<in>t. Q x)"
- apply(rule setsum_cong2) using `a\<notin>s` `t\<subseteq>s` by auto
- have "(\<Sum>x\<in>insert a t. if x = a then - (\<Sum>x\<in>t. u (x - a)) else u (x - a)) = 0"
- unfolding setsum_clauses(2)[OF fin] using `a\<notin>s` `t\<subseteq>s` apply auto unfolding * by auto
- 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"
- apply(rule_tac x="v + a" in bexI) using obt(3,4) and `0\<notin>S` unfolding t_def by auto
- 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)"
- apply(rule setsum_cong2) using `a\<notin>s` `t\<subseteq>s` by auto
- have "(\<Sum>x\<in>t. u (x - a)) *\<^sub>R a = (\<Sum>v\<in>t. u (v - a) *\<^sub>R v)"
- unfolding scaleR_left.setsum unfolding t_def and setsum_reindex[OF inj] and o_def
- using obt(5) by (auto simp add: setsum_addf scaleR_right_distrib)
- 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"
- unfolding setsum_clauses(2)[OF fin] using `a\<notin>s` `t\<subseteq>s` by (auto simp add: * vector_smult_lneg)
- ultimately show ?thesis unfolding affine_dependent_explicit
- apply(rule_tac x="insert a t" in exI) by auto
-qed
-
-lemma convex_cone:
- "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")
-proof-
- { fix x y assume "x\<in>s" "y\<in>s" and ?lhs
- hence "2 *\<^sub>R x \<in>s" "2 *\<^sub>R y \<in> s" unfolding cone_def by auto
- hence "x + y \<in> s" using `?lhs`[unfolded convex_def, THEN conjunct1]
- apply(erule_tac x="2*\<^sub>R x" in ballE) apply(erule_tac x="2*\<^sub>R y" in ballE)
- apply(erule_tac x="1/2" in allE) apply simp apply(erule_tac x="1/2" in allE) by auto }
- thus ?thesis unfolding convex_def cone_def by blast
-qed
-
-lemma affine_dependent_biggerset: fixes s::"(real^'n::finite) set"
- assumes "finite s" "card s \<ge> CARD('n) + 2"
- shows "affine_dependent s"
-proof-
- have "s\<noteq>{}" using assms by auto then obtain a where "a\<in>s" by auto
- have *:"{x - a |x. x \<in> s - {a}} = (\<lambda>x. x - a) ` (s - {a})" by auto
- have "card {x - a |x. x \<in> s - {a}} = card (s - {a})" unfolding *
- apply(rule card_image) unfolding inj_on_def by auto
- also have "\<dots> > CARD('n)" using assms(2)
- unfolding card_Diff_singleton[OF assms(1) `a\<in>s`] by auto
- finally show ?thesis apply(subst insert_Diff[OF `a\<in>s`, THEN sym])
- apply(rule dependent_imp_affine_dependent)
- apply(rule dependent_biggerset) by auto qed
-
-lemma affine_dependent_biggerset_general:
- assumes "finite (s::(real^'n::finite) set)" "card s \<ge> dim s + 2"
- shows "affine_dependent s"
-proof-
- from assms(2) have "s \<noteq> {}" by auto
- then obtain a where "a\<in>s" by auto
- have *:"{x - a |x. x \<in> s - {a}} = (\<lambda>x. x - a) ` (s - {a})" by auto
- have **:"card {x - a |x. x \<in> s - {a}} = card (s - {a})" unfolding *
- apply(rule card_image) unfolding inj_on_def by auto
- have "dim {x - a |x. x \<in> s - {a}} \<le> dim s"
- apply(rule subset_le_dim) unfolding subset_eq
- using `a\<in>s` by (auto simp add:span_superset span_sub)
- also have "\<dots> < dim s + 1" by auto
- also have "\<dots> \<le> card (s - {a})" using assms
- using card_Diff_singleton[OF assms(1) `a\<in>s`] by auto
- finally show ?thesis apply(subst insert_Diff[OF `a\<in>s`, THEN sym])
- apply(rule dependent_imp_affine_dependent) apply(rule dependent_biggerset_general) unfolding ** by auto qed
-
-subsection {* Caratheodory's theorem. *}
-
-lemma convex_hull_caratheodory: fixes p::"(real^'n::finite) set"
- shows "convex hull p = {y. \<exists>s u. finite s \<and> s \<subseteq> p \<and> card s \<le> CARD('n) + 1 \<and>
- (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1 \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = y}"
- unfolding convex_hull_explicit expand_set_eq mem_Collect_eq
-proof(rule,rule)
- 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"
- 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"
- then obtain N where "?P N" by auto
- hence "\<exists>n\<le>N. (\<forall>k<n. \<not> ?P k) \<and> ?P n" apply(rule_tac ex_least_nat_le) by auto
- then obtain n where "?P n" and smallest:"\<forall>k<n. \<not> ?P k" by blast
- 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
-
- have "card s \<le> CARD('n) + 1" proof(rule ccontr, simp only: not_le)
- assume "CARD('n) + 1 < card s"
- hence "affine_dependent s" using affine_dependent_biggerset[OF obt(1)] by auto
- 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"
- using affine_dependent_explicit_finite[OF obt(1)] by auto
- def i \<equiv> "(\<lambda>v. (u v) / (- w v)) ` {v\<in>s. w v < 0}" def t \<equiv> "Min i"
- have "\<exists>x\<in>s. w x < 0" proof(rule ccontr, simp add: not_less)
- assume as:"\<forall>x\<in>s. 0 \<le> w x"
- hence "setsum w (s - {v}) \<ge> 0" apply(rule_tac setsum_nonneg) by auto
- hence "setsum w s > 0" unfolding setsum_diff1'[OF obt(1) `v\<in>s`]
- using as[THEN bspec[where x=v]] and `v\<in>s` using `w v \<noteq> 0` by auto
- thus False using wv(1) by auto
- qed hence "i\<noteq>{}" unfolding i_def by auto
-
- hence "t \<ge> 0" using Min_ge_iff[of i 0 ] and obt(1) unfolding t_def i_def
- using obt(4)[unfolded le_less] apply auto unfolding divide_le_0_iff by auto
- have t:"\<forall>v\<in>s. u v + t * w v \<ge> 0" proof
- fix v assume "v\<in>s" hence v:"0\<le>u v" using obt(4)[THEN bspec[where x=v]] by auto
- show"0 \<le> u v + t * w v" proof(cases "w v < 0")
- case False thus ?thesis apply(rule_tac add_nonneg_nonneg)
- using v apply simp apply(rule mult_nonneg_nonneg) using `t\<ge>0` by auto next
- case True hence "t \<le> u v / (- w v)" using `v\<in>s`
- unfolding t_def i_def apply(rule_tac Min_le) using obt(1) by auto
- thus ?thesis unfolding real_0_le_add_iff
- using pos_le_divide_eq[OF True[unfolded neg_0_less_iff_less[THEN sym]]] by auto
- qed qed
-
- obtain a where "a\<in>s" and "t = (\<lambda>v. (u v) / (- w v)) a" and "w a < 0"
- using Min_in[OF _ `i\<noteq>{}`] and obt(1) unfolding i_def t_def by auto
- hence a:"a\<in>s" "u a + t * w a = 0" by auto
- 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
- have "(\<Sum>v\<in>s. u v + t * w v) = 1"
- unfolding setsum_addf wv(1) setsum_right_distrib[THEN sym] obt(5) by auto
- 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"
- unfolding setsum_addf obt(6) scaleR_scaleR[THEN sym] scaleR_right.setsum [symmetric] wv(4)
- using a(2) [THEN eq_neg_iff_add_eq_0 [THEN iffD2]]
- by (simp add: vector_smult_lneg)
- ultimately have "?P (n - 1)" apply(rule_tac x="(s - {a})" in exI)
- 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)
- thus False using smallest[THEN spec[where x="n - 1"]] by auto qed
- thus "\<exists>s u. finite s \<and> s \<subseteq> p \<and> card s \<le> CARD('n) + 1
- \<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
-qed auto
-
-lemma caratheodory:
- "convex hull p = {x::real^'n::finite. \<exists>s. finite s \<and> s \<subseteq> p \<and>
- card s \<le> CARD('n) + 1 \<and> x \<in> convex hull s}"
- unfolding expand_set_eq apply(rule, rule) unfolding mem_Collect_eq proof-
- fix x assume "x \<in> convex hull p"
- then obtain s u where "finite s" "s \<subseteq> p" "card s \<le> CARD('n) + 1"
- "\<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
- thus "\<exists>s. finite s \<and> s \<subseteq> p \<and> card s \<le> CARD('n) + 1 \<and> x \<in> convex hull s"
- apply(rule_tac x=s in exI) using hull_subset[of s convex]
- using convex_convex_hull[unfolded convex_explicit, of s, THEN spec[where x=s], THEN spec[where x=u]] by auto
-next
- fix x assume "\<exists>s. finite s \<and> s \<subseteq> p \<and> card s \<le> CARD('n) + 1 \<and> x \<in> convex hull s"
- then obtain s where "finite s" "s \<subseteq> p" "card s \<le> CARD('n) + 1" "x \<in> convex hull s" by auto
- thus "x \<in> convex hull p" using hull_mono[OF `s\<subseteq>p`] by auto
-qed
-
-subsection {* Openness and compactness are preserved by convex hull operation. *}
-
-lemma open_convex_hull:
- fixes s :: "'a::real_normed_vector set"
- assumes "open s"
- shows "open(convex hull s)"
- unfolding open_contains_cball convex_hull_explicit unfolding mem_Collect_eq ball_simps(10)
-proof(rule, rule) fix a
- 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"
- 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
-
- from assms[unfolded open_contains_cball] obtain b where b:"\<forall>x\<in>s. 0 < b x \<and> cball x (b x) \<subseteq> s"
- using bchoice[of s "\<lambda>x e. e>0 \<and> cball x e \<subseteq> s"] by auto
- have "b ` t\<noteq>{}" unfolding i_def using obt by auto def i \<equiv> "b ` t"
-
- 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}"
- apply(rule_tac x="Min i" in exI) unfolding subset_eq apply rule defer apply rule unfolding mem_Collect_eq
- proof-
- show "0 < Min i" unfolding i_def and Min_gr_iff[OF finite_imageI[OF obt(1)] `b \` t\<noteq>{}`]
- using b apply simp apply rule apply(erule_tac x=x in ballE) using `t\<subseteq>s` by auto
- next fix y assume "y \<in> cball a (Min i)"
- hence y:"norm (a - y) \<le> Min i" unfolding dist_norm[THEN sym] by auto
- { fix x assume "x\<in>t"
- hence "Min i \<le> b x" unfolding i_def apply(rule_tac Min_le) using obt(1) by auto
- hence "x + (y - a) \<in> cball x (b x)" using y unfolding mem_cball dist_norm by auto
- moreover from `x\<in>t` have "x\<in>s" using obt(2) by auto
- ultimately have "x + (y - a) \<in> s" using y and b[THEN bspec[where x=x]] unfolding subset_eq by auto }
- moreover
- have *:"inj_on (\<lambda>v. v + (y - a)) t" unfolding inj_on_def by auto
- have "(\<Sum>v\<in>(\<lambda>v. v + (y - a)) ` t. u (v - (y - a))) = 1"
- unfolding setsum_reindex[OF *] o_def using obt(4) by auto
- moreover have "(\<Sum>v\<in>(\<lambda>v. v + (y - a)) ` t. u (v - (y - a)) *\<^sub>R v) = y"
- unfolding setsum_reindex[OF *] o_def using obt(4,5)
- by (simp add: setsum_addf setsum_subtractf scaleR_left.setsum[THEN sym] scaleR_right_distrib)
- 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"
- apply(rule_tac x="(\<lambda>v. v + (y - a)) ` t" in exI) apply(rule_tac x="\<lambda>v. u (v - (y - a))" in exI)
- using obt(1, 3) by auto
- qed
-qed
-
-lemma open_dest_vec1_vimage: "open S \<Longrightarrow> open (dest_vec1 -` S)"
-unfolding open_vector_def all_1
-by (auto simp add: dest_vec1_def)
-
-lemma tendsto_dest_vec1 [tendsto_intros]:
- "(f ---> l) net \<Longrightarrow> ((\<lambda>x. dest_vec1 (f x)) ---> dest_vec1 l) net"
- unfolding tendsto_def
- apply clarify
- apply (drule_tac x="dest_vec1 -` S" in spec)
- apply (simp add: open_dest_vec1_vimage)
- done
-
-lemma continuous_dest_vec1: "continuous net f \<Longrightarrow> continuous net (\<lambda>x. dest_vec1 (f x))"
- unfolding continuous_def by (rule tendsto_dest_vec1)
-
-(* TODO: move *)
-lemma compact_real_interval:
- fixes a b :: real shows "compact {a..b}"
-proof -
- have "continuous_on {vec1 a .. vec1 b} dest_vec1"
- unfolding continuous_on
- by (simp add: tendsto_dest_vec1 Lim_at_within Lim_ident_at)
- moreover have "compact {vec1 a .. vec1 b}" by (rule compact_interval)
- ultimately have "compact (dest_vec1 ` {vec1 a .. vec1 b})"
- by (rule compact_continuous_image)
- also have "dest_vec1 ` {vec1 a .. vec1 b} = {a..b}"
- by (auto simp add: image_def Bex_def exists_vec1)
- finally show ?thesis .
-qed
-
-lemma compact_convex_combinations:
- fixes s t :: "'a::real_normed_vector set"
- assumes "compact s" "compact t"
- shows "compact { (1 - u) *\<^sub>R x + u *\<^sub>R y | x y u. 0 \<le> u \<and> u \<le> 1 \<and> x \<in> s \<and> y \<in> t}"
-proof-
- let ?X = "{0..1} \<times> s \<times> t"
- let ?h = "(\<lambda>z. (1 - fst z) *\<^sub>R fst (snd z) + fst z *\<^sub>R snd (snd z))"
- have *:"{ (1 - u) *\<^sub>R x + u *\<^sub>R y | x y u. 0 \<le> u \<and> u \<le> 1 \<and> x \<in> s \<and> y \<in> t} = ?h ` ?X"
- apply(rule set_ext) unfolding image_iff mem_Collect_eq
- apply rule apply auto
- apply (rule_tac x=u in rev_bexI, simp)
- apply (erule rev_bexI, erule rev_bexI, simp)
- by auto
- have "continuous_on ({0..1} \<times> s \<times> t)
- (\<lambda>z. (1 - fst z) *\<^sub>R fst (snd z) + fst z *\<^sub>R snd (snd z))"
- unfolding continuous_on by (rule ballI) (intro tendsto_intros)
- thus ?thesis unfolding *
- apply (rule compact_continuous_image)
- apply (intro compact_Times compact_real_interval assms)
- done
-qed
-
-lemma compact_convex_hull: fixes s::"(real^'n::finite) set"
- assumes "compact s" shows "compact(convex hull s)"
-proof(cases "s={}")
- case True thus ?thesis using compact_empty by simp
-next
- case False then obtain w where "w\<in>s" by auto
- show ?thesis unfolding caratheodory[of s]
- proof(induct "CARD('n) + 1")
- have *:"{x.\<exists>sa. finite sa \<and> sa \<subseteq> s \<and> card sa \<le> 0 \<and> x \<in> convex hull sa} = {}"
- using compact_empty by (auto simp add: convex_hull_empty)
- case 0 thus ?case unfolding * by simp
- next
- case (Suc n)
- show ?case proof(cases "n=0")
- case True have "{x. \<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t} = s"
- unfolding expand_set_eq and mem_Collect_eq proof(rule, rule)
- fix x assume "\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t"
- then obtain t where t:"finite t" "t \<subseteq> s" "card t \<le> Suc n" "x \<in> convex hull t" by auto
- show "x\<in>s" proof(cases "card t = 0")
- case True thus ?thesis using t(4) unfolding card_0_eq[OF t(1)] by(simp add: convex_hull_empty)
- next
- case False hence "card t = Suc 0" using t(3) `n=0` by auto
- then obtain a where "t = {a}" unfolding card_Suc_eq by auto
- thus ?thesis using t(2,4) by (simp add: convex_hull_singleton)
- qed
- next
- fix x assume "x\<in>s"
- thus "\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t"
- apply(rule_tac x="{x}" in exI) unfolding convex_hull_singleton by auto
- qed thus ?thesis using assms by simp
- next
- case False have "{x. \<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t} =
- { (1 - u) *\<^sub>R x + u *\<^sub>R y | x y u.
- 0 \<le> u \<and> u \<le> 1 \<and> x \<in> s \<and> y \<in> {x. \<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> n \<and> x \<in> convex hull t}}"
- unfolding expand_set_eq and mem_Collect_eq proof(rule,rule)
- fix x assume "\<exists>u v c. x = (1 - c) *\<^sub>R u + c *\<^sub>R v \<and>
- 0 \<le> c \<and> c \<le> 1 \<and> u \<in> s \<and> (\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> n \<and> v \<in> convex hull t)"
- then obtain u v c t where obt:"x = (1 - c) *\<^sub>R u + c *\<^sub>R v"
- "0 \<le> c \<and> c \<le> 1" "u \<in> s" "finite t" "t \<subseteq> s" "card t \<le> n" "v \<in> convex hull t" by auto
- moreover have "(1 - c) *\<^sub>R u + c *\<^sub>R v \<in> convex hull insert u t"
- apply(rule mem_convex) using obt(2) and convex_convex_hull and hull_subset[of "insert u t" convex]
- using obt(7) and hull_mono[of t "insert u t"] by auto
- ultimately show "\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t"
- apply(rule_tac x="insert u t" in exI) by (auto simp add: card_insert_if)
- next
- fix x assume "\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t"
- then obtain t where t:"finite t" "t \<subseteq> s" "card t \<le> Suc n" "x \<in> convex hull t" by auto
- let ?P = "\<exists>u v c. x = (1 - c) *\<^sub>R u + c *\<^sub>R v \<and>
- 0 \<le> c \<and> c \<le> 1 \<and> u \<in> s \<and> (\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> n \<and> v \<in> convex hull t)"
- show ?P proof(cases "card t = Suc n")
- case False hence "card t \<le> n" using t(3) by auto
- 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
- by(auto intro!: exI[where x=t])
- next
- case True then obtain a u where au:"t = insert a u" "a\<notin>u" apply(drule_tac card_eq_SucD) by auto
- show ?P proof(cases "u={}")
- case True hence "x=a" using t(4)[unfolded au] by auto
- show ?P unfolding `x=a` apply(rule_tac x=a in exI, rule_tac x=a in exI, rule_tac x=1 in exI)
- using t and `n\<noteq>0` unfolding au by(auto intro!: exI[where x="{a}"] simp add: convex_hull_singleton)
- next
- case False obtain ux vx b where obt:"ux\<ge>0" "vx\<ge>0" "ux + vx = 1" "b \<in> convex hull u" "x = ux *\<^sub>R a + vx *\<^sub>R b"
- using t(4)[unfolded au convex_hull_insert[OF False]] by auto
- have *:"1 - vx = ux" using obt(3) by auto
- show ?P apply(rule_tac x=a in exI, rule_tac x=b in exI, rule_tac x=vx in exI)
- using obt and t(1-3) unfolding au and * using card_insert_disjoint[OF _ au(2)]
- by(auto intro!: exI[where x=u])
- qed
- qed
- qed
- thus ?thesis using compact_convex_combinations[OF assms Suc] by simp
- qed
- qed
-qed
-
-lemma finite_imp_compact_convex_hull:
- fixes s :: "(real ^ _) set"
- shows "finite s \<Longrightarrow> compact(convex hull s)"
- apply(drule finite_imp_compact, drule compact_convex_hull) by assumption
-
-subsection {* Extremal points of a simplex are some vertices. *}
-
-lemma dist_increases_online:
- fixes a b d :: "'a::real_inner"
- assumes "d \<noteq> 0"
- shows "dist a (b + d) > dist a b \<or> dist a (b - d) > dist a b"
-proof(cases "inner a d - inner b d > 0")
- case True hence "0 < inner d d + (inner a d * 2 - inner b d * 2)"
- apply(rule_tac add_pos_pos) using assms by auto
- thus ?thesis apply(rule_tac disjI2) unfolding dist_norm and norm_eq_sqrt_inner and real_sqrt_less_iff
- by (simp add: algebra_simps inner_commute)
-next
- case False hence "0 < inner d d + (inner b d * 2 - inner a d * 2)"
- apply(rule_tac add_pos_nonneg) using assms by auto
- thus ?thesis apply(rule_tac disjI1) unfolding dist_norm and norm_eq_sqrt_inner and real_sqrt_less_iff
- by (simp add: algebra_simps inner_commute)
-qed
-
-lemma norm_increases_online:
- fixes d :: "'a::real_inner"
- shows "d \<noteq> 0 \<Longrightarrow> norm(a + d) > norm a \<or> norm(a - d) > norm a"
- using dist_increases_online[of d a 0] unfolding dist_norm by auto
-
-lemma simplex_furthest_lt:
- fixes s::"'a::real_inner set" assumes "finite s"
- shows "\<forall>x \<in> (convex hull s). x \<notin> s \<longrightarrow> (\<exists>y\<in>(convex hull s). norm(x - a) < norm(y - a))"
-proof(induct_tac rule: finite_induct[of s])
- fix x s assume as:"finite s" "x\<notin>s" "\<forall>x\<in>convex hull s. x \<notin> s \<longrightarrow> (\<exists>y\<in>convex hull s. norm (x - a) < norm (y - a))"
- show "\<forall>xa\<in>convex hull insert x s. xa \<notin> insert x s \<longrightarrow> (\<exists>y\<in>convex hull insert x s. norm (xa - a) < norm (y - a))"
- proof(rule,rule,cases "s = {}")
- case False fix y assume y:"y \<in> convex hull insert x s" "y \<notin> insert x s"
- obtain u v b where obt:"u\<ge>0" "v\<ge>0" "u + v = 1" "b \<in> convex hull s" "y = u *\<^sub>R x + v *\<^sub>R b"
- using y(1)[unfolded convex_hull_insert[OF False]] by auto
- show "\<exists>z\<in>convex hull insert x s. norm (y - a) < norm (z - a)"
- proof(cases "y\<in>convex hull s")
- case True then obtain z where "z\<in>convex hull s" "norm (y - a) < norm (z - a)"
- using as(3)[THEN bspec[where x=y]] and y(2) by auto
- thus ?thesis apply(rule_tac x=z in bexI) unfolding convex_hull_insert[OF False] by auto
- next
- case False show ?thesis using obt(3) proof(cases "u=0", case_tac[!] "v=0")
- assume "u=0" "v\<noteq>0" hence "y = b" using obt by auto
- thus ?thesis using False and obt(4) by auto
- next
- assume "u\<noteq>0" "v=0" hence "y = x" using obt by auto
- thus ?thesis using y(2) by auto
- next
- assume "u\<noteq>0" "v\<noteq>0"
- then obtain w where w:"w>0" "w<u" "w<v" using real_lbound_gt_zero[of u v] and obt(1,2) by auto
- have "x\<noteq>b" proof(rule ccontr)
- assume "\<not> x\<noteq>b" hence "y=b" unfolding obt(5)
- using obt(3) by(auto simp add: scaleR_left_distrib[THEN sym])
- thus False using obt(4) and False by simp qed
- hence *:"w *\<^sub>R (x - b) \<noteq> 0" using w(1) by auto
- show ?thesis using dist_increases_online[OF *, of a y]
- proof(erule_tac disjE)
- assume "dist a y < dist a (y + w *\<^sub>R (x - b))"
- hence "norm (y - a) < norm ((u + w) *\<^sub>R x + (v - w) *\<^sub>R b - a)"
- unfolding dist_commute[of a] unfolding dist_norm obt(5) by (simp add: algebra_simps)
- moreover have "(u + w) *\<^sub>R x + (v - w) *\<^sub>R b \<in> convex hull insert x s"
- unfolding convex_hull_insert[OF `s\<noteq>{}`] and mem_Collect_eq
- apply(rule_tac x="u + w" in exI) apply rule defer
- apply(rule_tac x="v - w" in exI) using `u\<ge>0` and w and obt(3,4) by auto
- ultimately show ?thesis by auto
- next
- assume "dist a y < dist a (y - w *\<^sub>R (x - b))"
- hence "norm (y - a) < norm ((u - w) *\<^sub>R x + (v + w) *\<^sub>R b - a)"
- unfolding dist_commute[of a] unfolding dist_norm obt(5) by (simp add: algebra_simps)
- moreover have "(u - w) *\<^sub>R x + (v + w) *\<^sub>R b \<in> convex hull insert x s"
- unfolding convex_hull_insert[OF `s\<noteq>{}`] and mem_Collect_eq
- apply(rule_tac x="u - w" in exI) apply rule defer
- apply(rule_tac x="v + w" in exI) using `u\<ge>0` and w and obt(3,4) by auto
- ultimately show ?thesis by auto
- qed
- qed auto
- qed
- qed auto
-qed (auto simp add: assms)
-
-lemma simplex_furthest_le:
- fixes s :: "(real ^ _) set"
- assumes "finite s" "s \<noteq> {}"
- shows "\<exists>y\<in>s. \<forall>x\<in>(convex hull s). norm(x - a) \<le> norm(y - a)"
-proof-
- have "convex hull s \<noteq> {}" using hull_subset[of s convex] and assms(2) by auto
- then obtain x where x:"x\<in>convex hull s" "\<forall>y\<in>convex hull s. norm (y - a) \<le> norm (x - a)"
- using distance_attains_sup[OF finite_imp_compact_convex_hull[OF assms(1)], of a]
- unfolding dist_commute[of a] unfolding dist_norm by auto
- thus ?thesis proof(cases "x\<in>s")
- case False then obtain y where "y\<in>convex hull s" "norm (x - a) < norm (y - a)"
- using simplex_furthest_lt[OF assms(1), THEN bspec[where x=x]] and x(1) by auto
- thus ?thesis using x(2)[THEN bspec[where x=y]] by auto
- qed auto
-qed
-
-lemma simplex_furthest_le_exists:
- fixes s :: "(real ^ _) set"
- shows "finite s \<Longrightarrow> (\<forall>x\<in>(convex hull s). \<exists>y\<in>s. norm(x - a) \<le> norm(y - a))"
- using simplex_furthest_le[of s] by (cases "s={}")auto
-
-lemma simplex_extremal_le:
- fixes s :: "(real ^ _) set"
- assumes "finite s" "s \<noteq> {}"
- shows "\<exists>u\<in>s. \<exists>v\<in>s. \<forall>x\<in>convex hull s. \<forall>y \<in> convex hull s. norm(x - y) \<le> norm(u - v)"
-proof-
- have "convex hull s \<noteq> {}" using hull_subset[of s convex] and assms(2) by auto
- then obtain u v where obt:"u\<in>convex hull s" "v\<in>convex hull s"
- "\<forall>x\<in>convex hull s. \<forall>y\<in>convex hull s. norm (x - y) \<le> norm (u - v)"
- using compact_sup_maxdistance[OF finite_imp_compact_convex_hull[OF assms(1)]] by auto
- thus ?thesis proof(cases "u\<notin>s \<or> v\<notin>s", erule_tac disjE)
- assume "u\<notin>s" then obtain y where "y\<in>convex hull s" "norm (u - v) < norm (y - v)"
- using simplex_furthest_lt[OF assms(1), THEN bspec[where x=u]] and obt(1) by auto
- thus ?thesis using obt(3)[THEN bspec[where x=y], THEN bspec[where x=v]] and obt(2) by auto
- next
- assume "v\<notin>s" then obtain y where "y\<in>convex hull s" "norm (v - u) < norm (y - u)"
- using simplex_furthest_lt[OF assms(1), THEN bspec[where x=v]] and obt(2) by auto
- thus ?thesis using obt(3)[THEN bspec[where x=u], THEN bspec[where x=y]] and obt(1)
- by (auto simp add: norm_minus_commute)
- qed auto
-qed
-
-lemma simplex_extremal_le_exists:
- fixes s :: "(real ^ _) set"
- shows "finite s \<Longrightarrow> x \<in> convex hull s \<Longrightarrow> y \<in> convex hull s
- \<Longrightarrow> (\<exists>u\<in>s. \<exists>v\<in>s. norm(x - y) \<le> norm(u - v))"
- using convex_hull_empty simplex_extremal_le[of s] by(cases "s={}")auto
-
-subsection {* Closest point of a convex set is unique, with a continuous projection. *}
-
-definition
- closest_point :: "(real ^ 'n::finite) set \<Rightarrow> real ^ 'n \<Rightarrow> real ^ 'n" where
- "closest_point s a = (SOME x. x \<in> s \<and> (\<forall>y\<in>s. dist a x \<le> dist a y))"
-
-lemma closest_point_exists:
- assumes "closed s" "s \<noteq> {}"
- shows "closest_point s a \<in> s" "\<forall>y\<in>s. dist a (closest_point s a) \<le> dist a y"
- unfolding closest_point_def apply(rule_tac[!] someI2_ex)
- using distance_attains_inf[OF assms(1,2), of a] by auto
-
-lemma closest_point_in_set:
- "closed s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> (closest_point s a) \<in> s"
- by(meson closest_point_exists)
-
-lemma closest_point_le:
- "closed s \<Longrightarrow> x \<in> s \<Longrightarrow> dist a (closest_point s a) \<le> dist a x"
- using closest_point_exists[of s] by auto
-
-lemma closest_point_self:
- assumes "x \<in> s" shows "closest_point s x = x"
- unfolding closest_point_def apply(rule some1_equality, rule ex1I[of _ x])
- using assms by auto
-
-lemma closest_point_refl:
- "closed s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> (closest_point s x = x \<longleftrightarrow> x \<in> s)"
- using closest_point_in_set[of s x] closest_point_self[of x s] by auto
-
-(* TODO: move *)
-lemma norm_lt: "norm x < norm y \<longleftrightarrow> inner x x < inner y y"
- unfolding norm_eq_sqrt_inner by simp
-
-(* TODO: move *)
-lemma norm_le: "norm x \<le> norm y \<longleftrightarrow> inner x x \<le> inner y y"
- unfolding norm_eq_sqrt_inner by simp
-
-lemma closer_points_lemma: fixes y::"real^'n::finite"
- assumes "inner y z > 0"
- shows "\<exists>u>0. \<forall>v>0. v \<le> u \<longrightarrow> norm(v *\<^sub>R z - y) < norm y"
-proof- have z:"inner z z > 0" unfolding inner_gt_zero_iff using assms by auto
- thus ?thesis using assms apply(rule_tac x="inner y z / inner z z" in exI) apply(rule) defer proof(rule+)
- fix v assume "0<v" "v \<le> inner y z / inner z z"
- thus "norm (v *\<^sub>R z - y) < norm y" unfolding norm_lt using z and assms
- by (simp add: field_simps inner_diff inner_commute mult_strict_left_mono[OF _ `0<v`])
- qed(rule divide_pos_pos, auto) qed
-
-lemma closer_point_lemma:
- fixes x y z :: "real ^ 'n::finite"
- assumes "inner (y - x) (z - x) > 0"
- shows "\<exists>u>0. u \<le> 1 \<and> dist (x + u *\<^sub>R (z - x)) y < dist x y"
-proof- obtain u where "u>0" and u:"\<forall>v>0. v \<le> u \<longrightarrow> norm (v *\<^sub>R (z - x) - (y - x)) < norm (y - x)"
- using closer_points_lemma[OF assms] by auto
- show ?thesis apply(rule_tac x="min u 1" in exI) using u[THEN spec[where x="min u 1"]] and `u>0`
- unfolding dist_norm by(auto simp add: norm_minus_commute field_simps) qed
-
-lemma any_closest_point_dot:
- fixes s :: "(real ^ _) set"
- assumes "convex s" "closed s" "x \<in> s" "y \<in> s" "\<forall>z\<in>s. dist a x \<le> dist a z"
- shows "inner (a - x) (y - x) \<le> 0"
-proof(rule ccontr) assume "\<not> inner (a - x) (y - x) \<le> 0"
- then obtain u where u:"u>0" "u\<le>1" "dist (x + u *\<^sub>R (y - x)) a < dist x a" using closer_point_lemma[of a x y] by auto
- let ?z = "(1 - u) *\<^sub>R x + u *\<^sub>R y" have "?z \<in> s" using mem_convex[OF assms(1,3,4), of u] using u by auto
- thus False using assms(5)[THEN bspec[where x="?z"]] and u(3) by (auto simp add: dist_commute algebra_simps) qed
-
-(* TODO: move *)
-lemma norm_le_square: "norm x \<le> a \<longleftrightarrow> 0 \<le> a \<and> inner x x \<le> a\<twosuperior>"
-proof -
- have "norm x \<le> a \<longleftrightarrow> 0 \<le> a \<and> norm x \<le> a"
- using norm_ge_zero [of x] by arith
- also have "\<dots> \<longleftrightarrow> 0 \<le> a \<and> (norm x)\<twosuperior> \<le> a\<twosuperior>"
- by (auto intro: power_mono dest: power2_le_imp_le)
- also have "\<dots> \<longleftrightarrow> 0 \<le> a \<and> inner x x \<le> a\<twosuperior>"
- unfolding power2_norm_eq_inner ..
- finally show ?thesis .
-qed
-
-lemma any_closest_point_unique:
- fixes s :: "(real ^ _) set"
- assumes "convex s" "closed s" "x \<in> s" "y \<in> s"
- "\<forall>z\<in>s. dist a x \<le> dist a z" "\<forall>z\<in>s. dist a y \<le> dist a z"
- shows "x = y" using any_closest_point_dot[OF assms(1-4,5)] and any_closest_point_dot[OF assms(1-2,4,3,6)]
- unfolding norm_pths(1) and norm_le_square
- by (auto simp add: algebra_simps)
-
-lemma closest_point_unique:
- assumes "convex s" "closed s" "x \<in> s" "\<forall>z\<in>s. dist a x \<le> dist a z"
- shows "x = closest_point s a"
- using any_closest_point_unique[OF assms(1-3) _ assms(4), of "closest_point s a"]
- using closest_point_exists[OF assms(2)] and assms(3) by auto
-
-lemma closest_point_dot:
- assumes "convex s" "closed s" "x \<in> s"
- shows "inner (a - closest_point s a) (x - closest_point s a) \<le> 0"
- apply(rule any_closest_point_dot[OF assms(1,2) _ assms(3)])
- using closest_point_exists[OF assms(2)] and assms(3) by auto
-
-lemma closest_point_lt:
- assumes "convex s" "closed s" "x \<in> s" "x \<noteq> closest_point s a"
- shows "dist a (closest_point s a) < dist a x"
- apply(rule ccontr) apply(rule_tac notE[OF assms(4)])
- apply(rule closest_point_unique[OF assms(1-3), of a])
- using closest_point_le[OF assms(2), of _ a] by fastsimp
-
-lemma closest_point_lipschitz:
- assumes "convex s" "closed s" "s \<noteq> {}"
- shows "dist (closest_point s x) (closest_point s y) \<le> dist x y"
-proof-
- have "inner (x - closest_point s x) (closest_point s y - closest_point s x) \<le> 0"
- "inner (y - closest_point s y) (closest_point s x - closest_point s y) \<le> 0"
- apply(rule_tac[!] any_closest_point_dot[OF assms(1-2)])
- using closest_point_exists[OF assms(2-3)] by auto
- thus ?thesis unfolding dist_norm and norm_le
- using inner_ge_zero[of "(x - closest_point s x) - (y - closest_point s y)"]
- by (simp add: inner_add inner_diff inner_commute) qed
-
-lemma continuous_at_closest_point:
- assumes "convex s" "closed s" "s \<noteq> {}"
- shows "continuous (at x) (closest_point s)"
- unfolding continuous_at_eps_delta
- using le_less_trans[OF closest_point_lipschitz[OF assms]] by auto
-
-lemma continuous_on_closest_point:
- assumes "convex s" "closed s" "s \<noteq> {}"
- shows "continuous_on t (closest_point s)"
- apply(rule continuous_at_imp_continuous_on) using continuous_at_closest_point[OF assms] by auto
-
-subsection {* Various point-to-set separating/supporting hyperplane theorems. *}
-
-lemma supporting_hyperplane_closed_point:
- fixes s :: "(real ^ _) set"
- assumes "convex s" "closed s" "s \<noteq> {}" "z \<notin> s"
- shows "\<exists>a b. \<exists>y\<in>s. inner a z < b \<and> (inner a y = b) \<and> (\<forall>x\<in>s. inner a x \<ge> b)"
-proof-
- 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
- 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)
- apply rule defer apply rule defer apply(rule, rule ccontr) using `y\<in>s` proof-
- show "inner (y - z) z < inner (y - z) y" apply(subst diff_less_iff(1)[THEN sym])
- unfolding inner_diff_right[THEN sym] and inner_gt_zero_iff using `y\<in>s` `z\<notin>s` by auto
- next
- 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)"
- using assms(1)[unfolded convex_alt] and y and `x\<in>s` and `y\<in>s` by auto
- assume "\<not> inner (y - z) y \<le> inner (y - z) x" then obtain v where
- "v>0" "v\<le>1" "dist (y + v *\<^sub>R (x - y)) z < dist y z" using closer_point_lemma[of z y x] apply - by (auto simp add: inner_diff)
- thus False using *[THEN spec[where x=v]] by(auto simp add: dist_commute algebra_simps)
- qed auto
-qed
-
-lemma separating_hyperplane_closed_point:
- fixes s :: "(real ^ _) set"
- assumes "convex s" "closed s" "z \<notin> s"
- shows "\<exists>a b. inner a z < b \<and> (\<forall>x\<in>s. inner a x > b)"
-proof(cases "s={}")
- case True thus ?thesis apply(rule_tac x="-z" in exI, rule_tac x=1 in exI)
- using less_le_trans[OF _ inner_ge_zero[of z]] by auto
-next
- case False obtain y where "y\<in>s" and y:"\<forall>x\<in>s. dist z y \<le> dist z x"
- using distance_attains_inf[OF assms(2) False] by auto
- show ?thesis apply(rule_tac x="y - z" in exI, rule_tac x="inner (y - z) z + (norm(y - z))\<twosuperior> / 2" in exI)
- apply rule defer apply rule proof-
- fix x assume "x\<in>s"
- have "\<not> 0 < inner (z - y) (x - y)" apply(rule_tac notI) proof(drule closer_point_lemma)
- assume "\<exists>u>0. u \<le> 1 \<and> dist (y + u *\<^sub>R (x - y)) z < dist y z"
- then obtain u where "u>0" "u\<le>1" "dist (y + u *\<^sub>R (x - y)) z < dist y z" by auto
- thus False using y[THEN bspec[where x="y + u *\<^sub>R (x - y)"]]
- using assms(1)[unfolded convex_alt, THEN bspec[where x=y]]
- using `x\<in>s` `y\<in>s` by (auto simp add: dist_commute algebra_simps) qed
- moreover have "0 < norm (y - z) ^ 2" using `y\<in>s` `z\<notin>s` by auto
- hence "0 < inner (y - z) (y - z)" unfolding power2_norm_eq_inner by simp
- ultimately show "inner (y - z) z + (norm (y - z))\<twosuperior> / 2 < inner (y - z) x"
- unfolding power2_norm_eq_inner and not_less by (auto simp add: field_simps inner_commute inner_diff)
- qed(insert `y\<in>s` `z\<notin>s`, auto)
-qed
-
-lemma separating_hyperplane_closed_0:
- assumes "convex (s::(real^'n::finite) set)" "closed s" "0 \<notin> s"
- shows "\<exists>a b. a \<noteq> 0 \<and> 0 < b \<and> (\<forall>x\<in>s. inner a x > b)"
- proof(cases "s={}") guess a using UNIV_witness[where 'a='n] ..
- case True have "norm ((basis a)::real^'n::finite) = 1"
- using norm_basis and dimindex_ge_1 by auto
- thus ?thesis apply(rule_tac x="basis a" in exI, rule_tac x=1 in exI) using True by auto
-next case False thus ?thesis using False using separating_hyperplane_closed_point[OF assms]
- apply - apply(erule exE)+ unfolding dot_rzero apply(rule_tac x=a in exI, rule_tac x=b in exI) by auto qed
-
-subsection {* Now set-to-set for closed/compact sets. *}
-
-lemma separating_hyperplane_closed_compact:
- assumes "convex (s::(real^'n::finite) set)" "closed s" "convex t" "compact t" "t \<noteq> {}" "s \<inter> t = {}"
- shows "\<exists>a b. (\<forall>x\<in>s. inner a x < b) \<and> (\<forall>x\<in>t. inner a x > b)"
-proof(cases "s={}")
- case True
- obtain b where b:"b>0" "\<forall>x\<in>t. norm x \<le> b" using compact_imp_bounded[OF assms(4)] unfolding bounded_pos by auto
- obtain z::"real^'n" where z:"norm z = b + 1" using vector_choose_size[of "b + 1"] and b(1) by auto
- hence "z\<notin>t" using b(2)[THEN bspec[where x=z]] by auto
- then obtain a b where ab:"inner a z < b" "\<forall>x\<in>t. b < inner a x"
- using separating_hyperplane_closed_point[OF assms(3) compact_imp_closed[OF assms(4)], of z] by auto
- thus ?thesis using True by auto
-next
- case False then obtain y where "y\<in>s" by auto
- obtain a b where "0 < b" "\<forall>x\<in>{x - y |x y. x \<in> s \<and> y \<in> t}. b < inner a x"
- using separating_hyperplane_closed_point[OF convex_differences[OF assms(1,3)], of 0]
- using closed_compact_differences[OF assms(2,4)] using assms(6) by(auto, blast)
- 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)
- def k \<equiv> "rsup ((\<lambda>x. inner a x) ` t)"
- show ?thesis apply(rule_tac x="-a" in exI, rule_tac x="-(k + b / 2)" in exI)
- apply(rule,rule) defer apply(rule) unfolding inner_minus_left and neg_less_iff_less proof-
- from ab have "((\<lambda>x. inner a x) ` t) *<= (inner a y - b)"
- apply(erule_tac x=y in ballE) apply(rule setleI) using `y\<in>s` by auto
- hence k:"isLub UNIV ((\<lambda>x. inner a x) ` t) k" unfolding k_def apply(rule_tac rsup) using assms(5) by auto
- 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
- next
- fix x assume "x\<in>s"
- hence "k \<le> inner a x - b" unfolding k_def apply(rule_tac rsup_le) using assms(5)
- unfolding setle_def
- using ab[THEN bspec[where x=x]] by auto
- thus "k + b / 2 < inner a x" using `0 < b` by auto
- qed
-qed
-
-lemma separating_hyperplane_compact_closed:
- fixes s :: "(real ^ _) set"
- assumes "convex s" "compact s" "s \<noteq> {}" "convex t" "closed t" "s \<inter> t = {}"
- shows "\<exists>a b. (\<forall>x\<in>s. inner a x < b) \<and> (\<forall>x\<in>t. inner a x > b)"
-proof- obtain a b where "(\<forall>x\<in>t. inner a x < b) \<and> (\<forall>x\<in>s. b < inner a x)"
- using separating_hyperplane_closed_compact[OF assms(4-5,1-2,3)] and assms(6) by auto
- thus ?thesis apply(rule_tac x="-a" in exI, rule_tac x="-b" in exI) by auto qed
-
-subsection {* General case without assuming closure and getting non-strict separation. *}
-
-lemma separating_hyperplane_set_0:
- assumes "convex s" "(0::real^'n::finite) \<notin> s"
- shows "\<exists>a. a \<noteq> 0 \<and> (\<forall>x\<in>s. 0 \<le> inner a x)"
-proof- let ?k = "\<lambda>c. {x::real^'n. 0 \<le> inner c x}"
- have "frontier (cball 0 1) \<inter> (\<Inter> (?k ` s)) \<noteq> {}"
- apply(rule compact_imp_fip) apply(rule compact_frontier[OF compact_cball])
- defer apply(rule,rule,erule conjE) proof-
- fix f assume as:"f \<subseteq> ?k ` s" "finite f"
- obtain c where c:"f = ?k ` c" "c\<subseteq>s" "finite c" using finite_subset_image[OF as(2,1)] by auto
- then obtain a b where ab:"a \<noteq> 0" "0 < b" "\<forall>x\<in>convex hull c. b < inner a x"
- using separating_hyperplane_closed_0[OF convex_convex_hull, of c]
- using finite_imp_compact_convex_hull[OF c(3), THEN compact_imp_closed] and assms(2)
- using subset_hull[unfolded mem_def, of convex, OF assms(1), THEN sym, of c] by auto
- 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)
- using hull_subset[of c convex] unfolding subset_eq and inner_scaleR
- apply- apply rule defer apply rule apply(rule mult_nonneg_nonneg)
- by(auto simp add: inner_commute elim!: ballE)
- thus "frontier (cball 0 1) \<inter> \<Inter>f \<noteq> {}" unfolding c(1) frontier_cball dist_norm by auto
- qed(insert closed_halfspace_ge, auto)
- then obtain x where "norm x = 1" "\<forall>y\<in>s. x\<in>?k y" unfolding frontier_cball dist_norm by auto
- thus ?thesis apply(rule_tac x=x in exI) by(auto simp add: inner_commute) qed
-
-lemma separating_hyperplane_sets:
- assumes "convex s" "convex (t::(real^'n::finite) set)" "s \<noteq> {}" "t \<noteq> {}" "s \<inter> t = {}"
- shows "\<exists>a b. a \<noteq> 0 \<and> (\<forall>x\<in>s. inner a x \<le> b) \<and> (\<forall>x\<in>t. inner a x \<ge> b)"
-proof- from separating_hyperplane_set_0[OF convex_differences[OF assms(2,1)]]
- obtain a where "a\<noteq>0" "\<forall>x\<in>{x - y |x y. x \<in> t \<and> y \<in> s}. 0 \<le> inner a x" using assms(3-5) by auto
- 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)
- 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`
- apply(rule) apply(rule,rule) apply(rule rsup[THEN isLubD2]) prefer 4 apply(rule,rule rsup_le) unfolding setle_def
- prefer 4 using assms(3-5) by blast+ qed
-
-subsection {* More convexity generalities. *}
-
-lemma convex_closure:
- fixes s :: "'a::real_normed_vector set"
- assumes "convex s" shows "convex(closure s)"
- unfolding convex_def Ball_def closure_sequential
- apply(rule,rule,rule,rule,rule,rule,rule,rule,rule) apply(erule_tac exE)+
- apply(rule_tac x="\<lambda>n. u *\<^sub>R xb n + v *\<^sub>R xc n" in exI) apply(rule,rule)
- apply(rule assms[unfolded convex_def, rule_format]) prefer 6
- apply(rule Lim_add) apply(rule_tac [1-2] Lim_cmul) by auto
-
-lemma convex_interior:
- fixes s :: "'a::real_normed_vector set"
- assumes "convex s" shows "convex(interior s)"
- unfolding convex_alt Ball_def mem_interior apply(rule,rule,rule,rule,rule,rule) apply(erule exE | erule conjE)+ proof-
- fix x y u assume u:"0 \<le> u" "u \<le> (1::real)"
- fix e d assume ed:"ball x e \<subseteq> s" "ball y d \<subseteq> s" "0<d" "0<e"
- show "\<exists>e>0. ball ((1 - u) *\<^sub>R x + u *\<^sub>R y) e \<subseteq> s" apply(rule_tac x="min d e" in exI)
- apply rule unfolding subset_eq defer apply rule proof-
- fix z assume "z \<in> ball ((1 - u) *\<^sub>R x + u *\<^sub>R y) (min d e)"
- hence "(1- u) *\<^sub>R (z - u *\<^sub>R (y - x)) + u *\<^sub>R (z + (1 - u) *\<^sub>R (y - x)) \<in> s"
- apply(rule_tac assms[unfolded convex_alt, rule_format])
- using ed(1,2) and u unfolding subset_eq mem_ball Ball_def dist_norm by(auto simp add: algebra_simps)
- thus "z \<in> s" using u by (auto simp add: algebra_simps) qed(insert u ed(3-4), auto) qed
-
-lemma convex_hull_eq_empty: "convex hull s = {} \<longleftrightarrow> s = {}"
- using hull_subset[of s convex] convex_hull_empty by auto
-
-subsection {* Moving and scaling convex hulls. *}
-
-lemma convex_hull_translation_lemma:
- "convex hull ((\<lambda>x. a + x) ` s) \<subseteq> (\<lambda>x. a + x) ` (convex hull s)"
- apply(rule hull_minimal, rule image_mono, rule hull_subset) unfolding mem_def
- using convex_translation[OF convex_convex_hull, of a s] by assumption
-
-lemma convex_hull_bilemma: fixes neg
- assumes "(\<forall>s a. (convex hull (up a s)) \<subseteq> up a (convex hull s))"
- 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)
- \<Longrightarrow> \<forall>s. (convex hull (up a s)) = up a (convex hull s)"
- using assms by(metis subset_antisym)
-
-lemma convex_hull_translation:
- "convex hull ((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (convex hull s)"
- apply(rule convex_hull_bilemma[rule_format, of _ _ "\<lambda>a. -a"], rule convex_hull_translation_lemma) unfolding image_image by auto
-
-lemma convex_hull_scaling_lemma:
- "(convex hull ((\<lambda>x. c *\<^sub>R x) ` s)) \<subseteq> (\<lambda>x. c *\<^sub>R x) ` (convex hull s)"
- apply(rule hull_minimal, rule image_mono, rule hull_subset)
- unfolding mem_def by(rule convex_scaling, rule convex_convex_hull)
-
-lemma convex_hull_scaling:
- "convex hull ((\<lambda>x. c *\<^sub>R x) ` s) = (\<lambda>x. c *\<^sub>R x) ` (convex hull s)"
- apply(cases "c=0") defer apply(rule convex_hull_bilemma[rule_format, of _ _ inverse]) apply(rule convex_hull_scaling_lemma)
- unfolding image_image scaleR_scaleR by(auto simp add:image_constant_conv convex_hull_eq_empty)
-
-lemma convex_hull_affinity:
- "convex hull ((\<lambda>x. a + c *\<^sub>R x) ` s) = (\<lambda>x. a + c *\<^sub>R x) ` (convex hull s)"
- unfolding image_image[THEN sym] convex_hull_scaling convex_hull_translation ..
-
-subsection {* Convex set as intersection of halfspaces. *}
-
-lemma convex_halfspace_intersection:
- fixes s :: "(real ^ _) set"
- assumes "closed s" "convex s"
- shows "s = \<Inter> {h. s \<subseteq> h \<and> (\<exists>a b. h = {x. inner a x \<le> b})}"
- apply(rule set_ext, rule) unfolding Inter_iff Ball_def mem_Collect_eq apply(rule,rule,erule conjE) proof-
- fix x assume "\<forall>xa. s \<subseteq> xa \<and> (\<exists>a b. xa = {x. inner a x \<le> b}) \<longrightarrow> x \<in> xa"
- hence "\<forall>a b. s \<subseteq> {x. inner a x \<le> b} \<longrightarrow> x \<in> {x. inner a x \<le> b}" by blast
- thus "x\<in>s" apply(rule_tac ccontr) apply(drule separating_hyperplane_closed_point[OF assms(2,1)])
- apply(erule exE)+ apply(erule_tac x="-a" in allE, erule_tac x="-b" in allE) by auto
-qed auto
-
-subsection {* Radon's theorem (from Lars Schewe). *}
-
-lemma radon_ex_lemma:
- assumes "finite c" "affine_dependent c"
- 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"
-proof- from assms(2)[unfolded affine_dependent_explicit] guess s .. then guess u ..
- 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
- and setsum_restrict_set[OF assms(1), THEN sym] by(auto simp add: Int_absorb1) qed
-
-lemma radon_s_lemma:
- assumes "finite s" "setsum f s = (0::real)"
- shows "setsum f {x\<in>s. 0 < f x} = - setsum f {x\<in>s. f x < 0}"
-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
- show ?thesis unfolding real_add_eq_0_iff[THEN sym] and setsum_restrict_set''[OF assms(1)] and setsum_addf[THEN sym] and *
- using assms(2) by assumption qed
-
-lemma radon_v_lemma:
- assumes "finite s" "setsum f s = 0" "\<forall>x. g x = (0::real) \<longrightarrow> f x = (0::real^'n)"
- shows "(setsum f {x\<in>s. 0 < g x}) = - setsum f {x\<in>s. g x < 0}"
-proof-
- 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
- show ?thesis unfolding eq_neg_iff_add_eq_0 and setsum_restrict_set''[OF assms(1)] and setsum_addf[THEN sym] and *
- using assms(2) by assumption qed
-
-lemma radon_partition:
- assumes "finite c" "affine_dependent c"
- shows "\<exists>m p. m \<inter> p = {} \<and> m \<union> p = c \<and> (convex hull m) \<inter> (convex hull p) \<noteq> {}" proof-
- 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
- have fin:"finite {x \<in> c. 0 < u x}" "finite {x \<in> c. 0 > u x}" using assms(1) by auto
- 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}"
- have "setsum u {x \<in> c. 0 < u x} \<noteq> 0" proof(cases "u v \<ge> 0")
- case False hence "u v < 0" by auto
- thus ?thesis proof(cases "\<exists>w\<in>{x \<in> c. 0 < u x}. u w > 0")
- case True thus ?thesis using setsum_nonneg_eq_0_iff[of _ u, OF fin(1)] by auto
- next
- 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
- thus ?thesis unfolding setsum_delta[OF assms(1)] using uv(2) and `u v < 0` and uv(1) by auto qed
- qed (insert setsum_nonneg_eq_0_iff[of _ u, OF fin(1)] uv(2-3), auto)
-
- hence *:"setsum u {x\<in>c. u x > 0} > 0" unfolding real_less_def apply(rule_tac conjI, rule_tac setsum_nonneg) by auto
- moreover have "setsum u ({x \<in> c. 0 < u x} \<union> {x \<in> c. u x < 0}) = setsum u c"
- "(\<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)"
- using assms(1) apply(rule_tac[!] setsum_mono_zero_left) by auto
- hence "setsum u {x \<in> c. 0 < u x} = - setsum u {x \<in> c. 0 > u x}"
- "(\<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)"
- unfolding eq_neg_iff_add_eq_0 using uv(1,4) by (auto simp add: setsum_Un_zero[OF fin, THEN sym])
- moreover have "\<forall>x\<in>{v \<in> c. u v < 0}. 0 \<le> inverse (setsum u {x \<in> c. 0 < u x}) * - u x"
- apply (rule) apply (rule mult_nonneg_nonneg) using * by auto
-
- ultimately have "z \<in> convex hull {v \<in> c. u v \<le> 0}" unfolding convex_hull_explicit mem_Collect_eq
- 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)
- using assms(1) unfolding scaleR_scaleR[THEN sym] scaleR_right.setsum [symmetric] and z_def
- by(auto simp add: setsum_negf vector_smult_lneg mult_right.setsum[THEN sym])
- moreover have "\<forall>x\<in>{v \<in> c. 0 < u v}. 0 \<le> inverse (setsum u {x \<in> c. 0 < u x}) * u x"
- apply (rule) apply (rule mult_nonneg_nonneg) using * by auto
- hence "z \<in> convex hull {v \<in> c. u v > 0}" unfolding convex_hull_explicit mem_Collect_eq
- 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)
- using assms(1) unfolding scaleR_scaleR[THEN sym] scaleR_right.setsum [symmetric] and z_def using *
- by(auto simp add: setsum_negf vector_smult_lneg mult_right.setsum[THEN sym])
- 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
-qed
-
-lemma radon: assumes "affine_dependent c"
- obtains m p where "m\<subseteq>c" "p\<subseteq>c" "m \<inter> p = {}" "(convex hull m) \<inter> (convex hull p) \<noteq> {}"
-proof- from assms[unfolded affine_dependent_explicit] guess s .. then guess u ..
- hence *:"finite s" "affine_dependent s" and s:"s \<subseteq> c" unfolding affine_dependent_explicit by auto
- from radon_partition[OF *] guess m .. then guess p ..
- thus ?thesis apply(rule_tac that[of p m]) using s by auto qed
-
-subsection {* Helly's theorem. *}
-
-lemma helly_induct: fixes f::"(real^'n::finite) set set"
- assumes "f hassize n" "n \<ge> CARD('n) + 1"
- "\<forall>s\<in>f. convex s" "\<forall>t\<subseteq>f. card t = CARD('n) + 1 \<longrightarrow> \<Inter> t \<noteq> {}"
- shows "\<Inter> f \<noteq> {}"
- using assms unfolding hassize_def apply(erule_tac conjE) proof(induct n arbitrary: f)
-case (Suc n)
-show "\<Inter> f \<noteq> {}" apply(cases "n = CARD('n)") apply(rule Suc(4)[rule_format])
- unfolding card_Diff_singleton_if[OF Suc(5)] and Suc(6) proof-
- 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
- apply(rule, rule Suc(1)[rule_format]) unfolding card_Diff_singleton_if[OF Suc(5)] and Suc(6)
- defer apply(rule Suc(3)[rule_format]) defer apply(rule Suc(4)[rule_format]) using Suc(2,5) by auto
- then obtain X where X:"\<forall>s\<in>f. X s \<in> \<Inter>(f - {s})" by auto
- show ?thesis proof(cases "inj_on X f")
- 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
- hence *:"\<Inter> f = \<Inter> (f - {s}) \<inter> \<Inter> (f - {t})" by auto
- show ?thesis unfolding * unfolding ex_in_conv[THEN sym] apply(rule_tac x="X s" in exI)
- apply(rule, rule X[rule_format]) using X st by auto
- 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> {}"
- using radon_partition[of "X ` f"] and affine_dependent_biggerset[of "X ` f"]
- unfolding card_image[OF True] and Suc(6) using Suc(2,5) and ng by auto
- have "m \<subseteq> X ` f" "p \<subseteq> X ` f" using mp(2) by auto
- then obtain g h where gh:"m = X ` g" "p = X ` h" "g \<subseteq> f" "h \<subseteq> f" unfolding subset_image_iff by auto
- hence "f \<union> (g \<union> h) = f" by auto
- hence f:"f = g \<union> h" using inj_on_Un_image_eq_iff[of X f "g \<union> h"] and True
- unfolding mp(2)[unfolded image_Un[THEN sym] gh] by auto
- have *:"g \<inter> h = {}" using mp(1) unfolding gh using inj_on_image_Int[OF True gh(3,4)] by auto
- have "convex hull (X ` h) \<subseteq> \<Inter> g" "convex hull (X ` g) \<subseteq> \<Inter> h"
- apply(rule_tac [!] hull_minimal) using Suc(3) gh(3-4) unfolding mem_def unfolding subset_eq
- apply(rule_tac [2] convex_Inter, rule_tac [4] convex_Inter) apply rule prefer 3 apply rule proof-
- fix x assume "x\<in>X ` g" then guess y unfolding image_iff ..
- thus "x\<in>\<Inter>h" using X[THEN bspec[where x=y]] using * f by auto next
- fix x assume "x\<in>X ` h" then guess y unfolding image_iff ..
- thus "x\<in>\<Inter>g" using X[THEN bspec[where x=y]] using * f by auto
- qed(auto)
- thus ?thesis unfolding f using mp(3)[unfolded gh] by blast qed
-qed(insert dimindex_ge_1, auto) qed(auto)
-
-lemma helly: fixes f::"(real^'n::finite) set set"
- assumes "finite f" "card f \<ge> CARD('n) + 1" "\<forall>s\<in>f. convex s"
- "\<forall>t\<subseteq>f. card t = CARD('n) + 1 \<longrightarrow> \<Inter> t \<noteq> {}"
- shows "\<Inter> f \<noteq>{}"
- apply(rule helly_induct) unfolding hassize_def using assms by auto
-
-subsection {* Convex hull is "preserved" by a linear function. *}
-
-lemma convex_hull_linear_image:
- assumes "bounded_linear f"
- shows "f ` (convex hull s) = convex hull (f ` s)"
- apply rule unfolding subset_eq ball_simps apply(rule_tac[!] hull_induct, rule hull_inc) prefer 3
- apply(erule imageE)apply(rule_tac x=xa in image_eqI) apply assumption
- apply(rule hull_subset[unfolded subset_eq, rule_format]) apply assumption
-proof-
- interpret f: bounded_linear f by fact
- show "convex {x. f x \<in> convex hull f ` s}"
- unfolding convex_def by(auto simp add: f.scaleR f.add convex_convex_hull[unfolded convex_def, rule_format]) next
- interpret f: bounded_linear f by fact
- show "convex {x. x \<in> f ` (convex hull s)}" using convex_convex_hull[unfolded convex_def, of s]
- unfolding convex_def by (auto simp add: f.scaleR [symmetric] f.add [symmetric])
-qed auto
-
-lemma in_convex_hull_linear_image:
- assumes "bounded_linear f" "x \<in> convex hull s"
- shows "(f x) \<in> convex hull (f ` s)"
-using convex_hull_linear_image[OF assms(1)] assms(2) by auto
-
-subsection {* Homeomorphism of all convex compact sets with nonempty interior. *}
-
-lemma compact_frontier_line_lemma:
- fixes s :: "(real ^ _) set"
- assumes "compact s" "0 \<in> s" "x \<noteq> 0"
- obtains u where "0 \<le> u" "(u *\<^sub>R x) \<in> frontier s" "\<forall>v>u. (v *\<^sub>R x) \<notin> s"
-proof-
- 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
- let ?A = "{y. \<exists>u. 0 \<le> u \<and> u \<le> b / norm(x) \<and> (y = u *\<^sub>R x)}"
- have A:"?A = (\<lambda>u. dest_vec1 u *\<^sub>R x) ` {0 .. vec1 (b / norm x)}"
- unfolding image_image[of "\<lambda>u. u *\<^sub>R x" "\<lambda>x. dest_vec1 x", THEN sym]
- unfolding dest_vec1_inverval vec1_dest_vec1 by auto
- have "compact ?A" unfolding A apply(rule compact_continuous_image, rule continuous_at_imp_continuous_on)
- apply(rule, rule continuous_vmul)
- apply (rule continuous_dest_vec1)
- apply(rule continuous_at_id) by(rule compact_interval)
- 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)])
- unfolding mem_Collect_eq using `b>0` assms(3) by(auto intro!: divide_nonneg_pos)
- ultimately obtain u y where obt: "u\<ge>0" "u \<le> b / norm x" "y = u *\<^sub>R x"
- "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
-
- have "norm x > 0" using assms(3)[unfolded zero_less_norm_iff[THEN sym]] by auto
- { fix v assume as:"v > u" "v *\<^sub>R x \<in> s"
- hence "v \<le> b / norm x" using b(2)[rule_format, OF as(2)]
- using `u\<ge>0` unfolding pos_le_divide_eq[OF `norm x > 0`] by auto
- hence "norm (v *\<^sub>R x) \<le> norm y" apply(rule_tac obt(6)[rule_format, unfolded dist_0_norm]) apply(rule IntI) defer
- apply(rule as(2)) unfolding mem_Collect_eq apply(rule_tac x=v in exI)
- using as(1) `u\<ge>0` by(auto simp add:field_simps)
- hence False unfolding obt(3) using `u\<ge>0` `norm x > 0` `v>u` by(auto simp add:field_simps)
- } note u_max = this
-
- 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]
- prefer 3 apply(rule_tac x="(u + (e / 2) / norm x) *\<^sub>R x" in exI) apply(rule, rule) proof-
- fix e assume "0 < e" and as:"(u + e / 2 / norm x) *\<^sub>R x \<in> s"
- hence "u + e / 2 / norm x > u" using`norm x > 0` by(auto simp del:zero_less_norm_iff intro!: divide_pos_pos)
- thus False using u_max[OF _ as] by auto
- qed(insert `y\<in>s`, auto simp add: dist_norm scaleR_left_distrib obt(3))
- thus ?thesis apply(rule_tac that[of u]) apply(rule obt(1), assumption)
- apply(rule,rule,rule ccontr) apply(rule u_max) by auto qed
-
-lemma starlike_compact_projective:
- assumes "compact s" "cball (0::real^'n::finite) 1 \<subseteq> s "
- "\<forall>x\<in>s. \<forall>u. 0 \<le> u \<and> u < 1 \<longrightarrow> (u *\<^sub>R x) \<in> (s - frontier s )"
- shows "s homeomorphic (cball (0::real^'n::finite) 1)"
-proof-
- have fs:"frontier s \<subseteq> s" apply(rule frontier_subset_closed) using compact_imp_closed[OF assms(1)] by simp
- def pi \<equiv> "\<lambda>x::real^'n. inverse (norm x) *\<^sub>R x"
- have "0 \<notin> frontier s" unfolding frontier_straddle apply(rule ccontr) unfolding not_not apply(erule_tac x=1 in allE)
- using assms(2)[unfolded subset_eq Ball_def mem_cball] by auto
- have injpi:"\<And>x y. pi x = pi y \<and> norm x = norm y \<longleftrightarrow> x = y" unfolding pi_def by auto
-
- have contpi:"continuous_on (UNIV - {0}) pi" apply(rule continuous_at_imp_continuous_on)
- apply rule unfolding pi_def
- apply (rule continuous_mul)
- apply (rule continuous_at_inv[unfolded o_def])
- apply (rule continuous_at_norm)
- apply simp
- apply (rule continuous_at_id)
- done
- def sphere \<equiv> "{x::real^'n. norm x = 1}"
- 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
-
- have "0\<in>s" using assms(2) and centre_in_cball[of 0 1] by auto
- 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)
- fix x u assume x:"x\<in>frontier s" and "(0::real)\<le>u"
- hence "x\<noteq>0" using `0\<notin>frontier s` by auto
- obtain v where v:"0 \<le> v" "v *\<^sub>R x \<in> frontier s" "\<forall>w>v. w *\<^sub>R x \<notin> s"
- using compact_frontier_line_lemma[OF assms(1) `0\<in>s` `x\<noteq>0`] by auto
- have "v=1" apply(rule ccontr) unfolding neq_iff apply(erule disjE) proof-
- assume "v<1" thus False using v(3)[THEN spec[where x=1]] using x and fs by auto next
- assume "v>1" thus False using assms(3)[THEN bspec[where x="v *\<^sub>R x"], THEN spec[where x="inverse v"]]
- using v and x and fs unfolding inverse_less_1_iff by auto qed
- 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-
- assume "u\<le>1" thus "u *\<^sub>R x \<in> s" apply(cases "u=1")
- 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
-
- have "\<exists>surf. homeomorphism (frontier s) sphere pi surf"
- apply(rule homeomorphism_compact) apply(rule compact_frontier[OF assms(1)])
- apply(rule continuous_on_subset[OF contpi]) defer apply(rule set_ext,rule)
- unfolding inj_on_def prefer 3 apply(rule,rule,rule)
- proof- fix x assume "x\<in>pi ` frontier s" then obtain y where "y\<in>frontier s" "x = pi y" by auto
- thus "x \<in> sphere" using pi(1)[of y] and `0 \<notin> frontier s` by auto
- next fix x assume "x\<in>sphere" hence "norm x = 1" "x\<noteq>0" unfolding sphere_def by auto
- then obtain u where "0 \<le> u" "u *\<^sub>R x \<in> frontier s" "\<forall>v>u. v *\<^sub>R x \<notin> s"
- using compact_frontier_line_lemma[OF assms(1) `0\<in>s`, of x] by auto
- 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
- next fix x y assume as:"x \<in> frontier s" "y \<in> frontier s" "pi x = pi y"
- hence xys:"x\<in>s" "y\<in>s" using fs by auto
- from as(1,2) have nor:"norm x \<noteq> 0" "norm y \<noteq> 0" using `0\<notin>frontier s` by auto
- 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
- from nor have y:"y = norm y *\<^sub>R ((inverse (norm x)) *\<^sub>R x)" unfolding as(3)[unfolded pi_def] by auto
- have "0 \<le> norm y * inverse (norm x)" "0 \<le> norm x * inverse (norm y)"
- unfolding divide_inverse[THEN sym] apply(rule_tac[!] divide_nonneg_pos) using nor by auto
- hence "norm x = norm y" apply(rule_tac ccontr) unfolding neq_iff
- using x y and front_smul[THEN bspec, OF as(1), THEN spec[where x="norm y * (inverse (norm x))"]]
- using front_smul[THEN bspec, OF as(2), THEN spec[where x="norm x * (inverse (norm y))"]]
- using xys nor by(auto simp add:field_simps divide_le_eq_1 divide_inverse[THEN sym])
- thus "x = y" apply(subst injpi[THEN sym]) using as(3) by auto
- qed(insert `0 \<notin> frontier s`, auto)
- then obtain surf where surf:"\<forall>x\<in>frontier s. surf (pi x) = x" "pi ` frontier s = sphere" "continuous_on (frontier s) pi"
- "\<forall>y\<in>sphere. pi (surf y) = y" "surf ` sphere = frontier s" "continuous_on sphere surf" unfolding homeomorphism_def by auto
-
- have cont_surfpi:"continuous_on (UNIV - {0}) (surf \<circ> pi)" apply(rule continuous_on_compose, rule contpi)
- apply(rule continuous_on_subset[of sphere], rule surf(6)) using pi(1) by auto
-
- { fix x assume as:"x \<in> cball (0::real^'n) 1"
- have "norm x *\<^sub>R surf (pi x) \<in> s" proof(cases "x=0 \<or> norm x = 1")
- case False hence "pi x \<in> sphere" "norm x < 1" using pi(1)[of x] as by(auto simp add: dist_norm)
- thus ?thesis apply(rule_tac assms(3)[rule_format, THEN DiffD1])
- apply(rule_tac fs[unfolded subset_eq, rule_format])
- unfolding surf(5)[THEN sym] by auto
- next case True thus ?thesis apply rule defer unfolding pi_def apply(rule fs[unfolded subset_eq, rule_format])
- unfolding surf(5)[unfolded sphere_def, THEN sym] using `0\<in>s` by auto qed } note hom = this
-
- { fix x assume "x\<in>s"
- hence "x \<in> (\<lambda>x. norm x *\<^sub>R surf (pi x)) ` cball 0 1" proof(cases "x=0")
- case True show ?thesis unfolding image_iff True apply(rule_tac x=0 in bexI) by auto
- next let ?a = "inverse (norm (surf (pi x)))"
- case False hence invn:"inverse (norm x) \<noteq> 0" by auto
- from False have pix:"pi x\<in>sphere" using pi(1) by auto
- hence "pi (surf (pi x)) = pi x" apply(rule_tac surf(4)[rule_format]) by assumption
- 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
- hence *:"?a * norm x > 0" and"?a > 0" "?a \<noteq> 0" using surf(5) `0\<notin>frontier s` apply -
- apply(rule_tac mult_pos_pos) using False[unfolded zero_less_norm_iff[THEN sym]] by auto
- have "norm (surf (pi x)) \<noteq> 0" using ** False by auto
- hence "norm x = norm ((?a * norm x) *\<^sub>R surf (pi x))"
- unfolding norm_scaleR abs_mult abs_norm_cancel abs_of_pos[OF `?a > 0`] by auto
- moreover have "pi x = pi ((inverse (norm (surf (pi x))) * norm x) *\<^sub>R surf (pi x))"
- unfolding pi(2)[OF *] surf(4)[rule_format, OF pix] ..
- moreover have "surf (pi x) \<in> frontier s" using surf(5) pix by auto
- hence "dist 0 (inverse (norm (surf (pi x))) *\<^sub>R x) \<le> 1" unfolding dist_norm
- using ** and * using front_smul[THEN bspec[where x="surf (pi x)"], THEN spec[where x="norm x * ?a"]]
- using False `x\<in>s` by(auto simp add:field_simps)
- ultimately show ?thesis unfolding image_iff apply(rule_tac x="inverse (norm (surf(pi x))) *\<^sub>R x" in bexI)
- apply(subst injpi[THEN sym]) unfolding abs_mult abs_norm_cancel abs_of_pos[OF `?a > 0`]
- unfolding pi(2)[OF `?a > 0`] by auto
- qed } note hom2 = this
-
- show ?thesis apply(subst homeomorphic_sym) apply(rule homeomorphic_compact[where f="\<lambda>x. norm x *\<^sub>R surf (pi x)"])
- apply(rule compact_cball) defer apply(rule set_ext, rule, erule imageE, drule hom)
- prefer 4 apply(rule continuous_at_imp_continuous_on, rule) apply(rule_tac [3] hom2) proof-
- fix x::"real^'n" assume as:"x \<in> cball 0 1"
- thus "continuous (at x) (\<lambda>x. norm x *\<^sub>R surf (pi x))" proof(cases "x=0")
- case False thus ?thesis apply(rule_tac continuous_mul, rule_tac continuous_at_norm)
- using cont_surfpi unfolding continuous_on_eq_continuous_at[OF open_delete[OF open_UNIV]] o_def by auto
- next guess a using UNIV_witness[where 'a = 'n] ..
- obtain B where B:"\<forall>x\<in>s. norm x \<le> B" using compact_imp_bounded[OF assms(1)] unfolding bounded_iff by auto
- 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)
- unfolding Ball_def mem_cball dist_norm by (auto simp add: norm_basis[unfolded One_nat_def])
- case True show ?thesis unfolding True continuous_at Lim_at apply(rule,rule) apply(rule_tac x="e / B" in exI)
- apply(rule) apply(rule divide_pos_pos) prefer 3 apply(rule,rule,erule conjE)
- unfolding norm_0 scaleR_zero_left dist_norm diff_0_right norm_scaleR abs_norm_cancel proof-
- fix e and x::"real^'n" assume as:"norm x < e / B" "0 < norm x" "0<e"
- hence "surf (pi x) \<in> frontier s" using pi(1)[of x] unfolding surf(5)[THEN sym] by auto
- hence "norm (surf (pi x)) \<le> B" using B fs by auto
- hence "norm x * norm (surf (pi x)) \<le> norm x * B" using as(2) by auto
- also have "\<dots> < e / B * B" apply(rule mult_strict_right_mono) using as(1) `B>0` by auto
- also have "\<dots> = e" using `B>0` by auto
- finally show "norm x * norm (surf (pi x)) < e" by assumption
- qed(insert `B>0`, auto) qed
- next { fix x assume as:"surf (pi x) = 0"
- have "x = 0" proof(rule ccontr)
- assume "x\<noteq>0" hence "pi x \<in> sphere" using pi(1) by auto
- hence "surf (pi x) \<in> frontier s" using surf(5) by auto
- thus False using `0\<notin>frontier s` unfolding as by simp qed
- } note surf_0 = this
- show "inj_on (\<lambda>x. norm x *\<^sub>R surf (pi x)) (cball 0 1)" unfolding inj_on_def proof(rule,rule,rule)
- 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)"
- thus "x=y" proof(cases "x=0 \<or> y=0")
- case True thus ?thesis using as by(auto elim: surf_0) next
- case False
- hence "pi (surf (pi x)) = pi (surf (pi y))" using as(3)
- using pi(2)[of "norm x" "surf (pi x)"] pi(2)[of "norm y" "surf (pi y)"] by auto
- moreover have "pi x \<in> sphere" "pi y \<in> sphere" using pi(1) False by auto
- 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
- moreover have "norm x = norm y" using as(3)[unfolded *] using False by(auto dest:surf_0)
- ultimately show ?thesis using injpi by auto qed qed
- qed auto qed
-
-lemma homeomorphic_convex_compact_lemma: fixes s::"(real^'n::finite) set"
- assumes "convex s" "compact s" "cball 0 1 \<subseteq> s"
- shows "s homeomorphic (cball (0::real^'n) 1)"
- apply(rule starlike_compact_projective[OF assms(2-3)]) proof(rule,rule,rule,erule conjE)
- fix x u assume as:"x \<in> s" "0 \<le> u" "u < (1::real)"
- hence "u *\<^sub>R x \<in> interior s" unfolding interior_def mem_Collect_eq
- apply(rule_tac x="ball (u *\<^sub>R x) (1 - u)" in exI) apply(rule, rule open_ball)
- unfolding centre_in_ball apply rule defer apply(rule) unfolding mem_ball proof-
- fix y assume "dist (u *\<^sub>R x) y < 1 - u"
- hence "inverse (1 - u) *\<^sub>R (y - u *\<^sub>R x) \<in> s"
- using assms(3) apply(erule_tac subsetD) unfolding mem_cball dist_commute dist_norm
- unfolding group_add_class.diff_0 group_add_class.diff_0_right norm_minus_cancel norm_scaleR
- apply (rule mult_left_le_imp_le[of "1 - u"])
- unfolding class_semiring.mul_a using `u<1` by auto
- 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]
- using as unfolding scaleR_scaleR by auto qed auto
- thus "u *\<^sub>R x \<in> s - frontier s" using frontier_def and interior_subset by auto qed
-
-lemma homeomorphic_convex_compact_cball: fixes e::real and s::"(real^'n::finite) set"
- assumes "convex s" "compact s" "interior s \<noteq> {}" "0 < e"
- shows "s homeomorphic (cball (b::real^'n::finite) e)"
-proof- obtain a where "a\<in>interior s" using assms(3) by auto
- then obtain d where "d>0" and d:"cball a d \<subseteq> s" unfolding mem_interior_cball by auto
- let ?d = "inverse d" and ?n = "0::real^'n"
- have "cball ?n 1 \<subseteq> (\<lambda>x. inverse d *\<^sub>R (x - a)) ` s"
- apply(rule, rule_tac x="d *\<^sub>R x + a" in image_eqI) defer
- apply(rule d[unfolded subset_eq, rule_format]) using `d>0` unfolding mem_cball dist_norm
- by(auto simp add: mult_right_le_one_le)
- hence "(\<lambda>x. inverse d *\<^sub>R (x - a)) ` s homeomorphic cball ?n 1"
- using homeomorphic_convex_compact_lemma[of "(\<lambda>x. ?d *\<^sub>R -a + ?d *\<^sub>R x) ` s", OF convex_affinity compact_affinity]
- using assms(1,2) by(auto simp add: uminus_add_conv_diff scaleR_right_diff_distrib)
- thus ?thesis apply(rule_tac homeomorphic_trans[OF _ homeomorphic_balls(2)[of 1 _ ?n]])
- apply(rule homeomorphic_trans[OF homeomorphic_affinity[of "?d" s "?d *\<^sub>R -a"]])
- using `d>0` `e>0` by(auto simp add: uminus_add_conv_diff scaleR_right_diff_distrib) qed
-
-lemma homeomorphic_convex_compact: fixes s::"(real^'n::finite) set" and t::"(real^'n) set"
- assumes "convex s" "compact s" "interior s \<noteq> {}"
- "convex t" "compact t" "interior t \<noteq> {}"
- shows "s homeomorphic t"
- using assms by(meson zero_less_one homeomorphic_trans homeomorphic_convex_compact_cball homeomorphic_sym)
-
-subsection {* Epigraphs of convex functions. *}
-
-definition "epigraph s (f::real^'n \<Rightarrow> real) = {xy. fstcart xy \<in> s \<and> f(fstcart xy) \<le> dest_vec1 (sndcart xy)}"
-
-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
-
-lemma convex_epigraph:
- "convex(epigraph s f) \<longleftrightarrow> convex_on s f \<and> convex s"
- unfolding convex_def convex_on_def unfolding Ball_def forall_pastecart epigraph_def
- 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]
- unfolding Ball_def[symmetric] unfolding dest_vec1_add dest_vec1_cmul [where 'a=real, unfolded smult_conv_scaleR]
- apply(subst forall_dest_vec1[THEN sym])+ by(meson real_le_refl real_le_trans add_mono mult_left_mono)
-
-lemma convex_epigraphI: assumes "convex_on s f" "convex s"
- shows "convex(epigraph s f)" using assms unfolding convex_epigraph by auto
-
-lemma convex_epigraph_convex: "convex s \<Longrightarrow> (convex_on s f \<longleftrightarrow> convex(epigraph s f))"
- using convex_epigraph by auto
-
-subsection {* Use this to derive general bound property of convex function. *}
-
-lemma forall_of_pastecart:
- "(\<forall>p. P (\<lambda>x. fstcart (p x)) (\<lambda>x. sndcart (p x))) \<longleftrightarrow> (\<forall>x y. P x y)" apply meson
- apply(erule_tac x="\<lambda>a. pastecart (x a) (y a)" in allE) unfolding o_def by auto
-
-lemma forall_of_pastecart':
- "(\<forall>p. P (fstcart p) (sndcart p)) \<longleftrightarrow> (\<forall>x y. P x y)" apply meson
- apply(erule_tac x="pastecart x y" in allE) unfolding o_def by auto
-
-lemma forall_of_dest_vec1: "(\<forall>v. P (\<lambda>x. dest_vec1 (v x))) \<longleftrightarrow> (\<forall>x. P x)"
- apply rule apply rule apply(erule_tac x="(vec1 \<circ> x)" in allE) unfolding o_def vec1_dest_vec1 by auto
-
-lemma forall_of_dest_vec1': "(\<forall>v. P (dest_vec1 v)) \<longleftrightarrow> (\<forall>x. P x)"
- apply rule apply rule apply(erule_tac x="(vec1 x)" in allE) defer apply rule
- apply(erule_tac x="dest_vec1 v" in allE) unfolding o_def vec1_dest_vec1 by auto
-
-lemma convex_on:
- fixes s :: "(real ^ _) set"
- assumes "convex s"
- 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>
- f (setsum (\<lambda>i. u i *\<^sub>R x i) {1..k} ) \<le> setsum (\<lambda>i. u i * f(x i)) {1..k} ) "
- unfolding convex_epigraph_convex[OF assms] convex epigraph_def Ball_def mem_Collect_eq
- unfolding sndcart_setsum[OF finite_atLeastAtMost] fstcart_setsum[OF finite_atLeastAtMost] dest_vec1_setsum[OF finite_atLeastAtMost]
- 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]
- 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
- using assms[unfolded convex] apply simp apply(rule,rule,rule)
- 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
- apply(rule_tac j="\<Sum>i = 1..k. u i * f (x i)" in real_le_trans)
- defer apply(rule setsum_mono) apply(erule conjE)+ apply(erule_tac x=i in allE)apply(rule mult_left_mono)
- using assms[unfolded convex] by auto
-
-subsection {* Convexity of general and special intervals. *}
-
-lemma is_interval_convex:
- fixes s :: "(real ^ _) set"
- assumes "is_interval s" shows "convex s"
- unfolding convex_def apply(rule,rule,rule,rule,rule,rule,rule) proof-
- fix x y u v assume as:"x \<in> s" "y \<in> s" "0 \<le> u" "0 \<le> v" "u + v = (1::real)"
- hence *:"u = 1 - v" "1 - v \<ge> 0" and **:"v = 1 - u" "1 - u \<ge> 0" by auto
- { fix a b assume "\<not> b \<le> u * a + v * b"
- hence "u * a < (1 - v) * b" unfolding not_le using as(4) by(auto simp add: field_simps)
- 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)
- hence "a \<le> u * a + v * b" unfolding * using as(4) by (auto simp add: field_simps intro!:mult_right_mono)
- } moreover
- { fix a b assume "\<not> u * a + v * b \<le> a"
- hence "v * b > (1 - u) * a" unfolding not_le using as(4) by(auto simp add: field_simps)
- hence "a < b" unfolding * using as(4) apply(rule_tac mult_left_less_imp_less) by(auto simp add: ring_simps)
- hence "u * a + v * b \<le> b" unfolding ** using **(2) as(3) by(auto simp add: field_simps intro!:mult_right_mono) }
- ultimately show "u *\<^sub>R x + v *\<^sub>R y \<in> s" apply- apply(rule assms[unfolded is_interval_def, rule_format, OF as(1,2)])
- using as(3-) dimindex_ge_1 apply- by(auto simp add: vector_component) qed
-
-lemma is_interval_connected:
- fixes s :: "(real ^ _) set"
- shows "is_interval s \<Longrightarrow> connected s"
- using is_interval_convex convex_connected by auto
-
-lemma convex_interval: "convex {a .. b}" "convex {a<..<b::real^'n::finite}"
- apply(rule_tac[!] is_interval_convex) using is_interval_interval by auto
-
-subsection {* On @{text "real^1"}, @{text "is_interval"}, @{text "convex"} and @{text "connected"} are all equivalent. *}
-
-lemma is_interval_1:
- "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)"
- unfolding is_interval_def dest_vec1_def forall_1 by auto
-
-lemma is_interval_connected_1: "is_interval s \<longleftrightarrow> connected (s::(real^1) set)"
- apply(rule, rule is_interval_connected, assumption) unfolding is_interval_1
- apply(rule,rule,rule,rule,erule conjE,rule ccontr) proof-
- 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"
- hence *:"dest_vec1 a < dest_vec1 x" "dest_vec1 x < dest_vec1 b" apply(rule_tac [!] ccontr) unfolding not_less by auto
- let ?halfl = "{z. inner (basis 1) z < dest_vec1 x} " and ?halfr = "{z. inner (basis 1) z > dest_vec1 x} "
- { fix y assume "y \<in> s" have "y \<in> ?halfr \<union> ?halfl" apply(rule ccontr)
- using as(6) `y\<in>s` by (auto simp add: inner_vector_def dest_vec1_eq [unfolded dest_vec1_def] dest_vec1_def) }
- moreover have "a\<in>?halfl" "b\<in>?halfr" using * by (auto simp add: inner_vector_def dest_vec1_def)
- hence "?halfl \<inter> s \<noteq> {}" "?halfr \<inter> s \<noteq> {}" using as(2-3) by auto
- ultimately show False apply(rule_tac notE[OF as(1)[unfolded connected_def]])
- apply(rule_tac x="?halfl" in exI, rule_tac x="?halfr" in exI)
- apply(rule, rule open_halfspace_lt, rule, rule open_halfspace_gt) apply(rule, rule, rule ccontr)
- by(auto simp add: basis_component field_simps) qed
-
-lemma is_interval_convex_1:
- "is_interval s \<longleftrightarrow> convex (s::(real^1) set)"
- using is_interval_convex convex_connected is_interval_connected_1 by auto
-
-lemma convex_connected_1:
- "connected s \<longleftrightarrow> convex (s::(real^1) set)"
- using is_interval_convex convex_connected is_interval_connected_1 by auto
-
-subsection {* Another intermediate value theorem formulation. *}
-
-lemma ivt_increasing_component_on_1: fixes f::"real^1 \<Rightarrow> real^'n::finite"
- assumes "dest_vec1 a \<le> dest_vec1 b" "continuous_on {a .. b} f" "(f a)$k \<le> y" "y \<le> (f b)$k"
- shows "\<exists>x\<in>{a..b}. (f x)$k = y"
-proof- have "f a \<in> f ` {a..b}" "f b \<in> f ` {a..b}" apply(rule_tac[!] imageI)
- using assms(1) by(auto simp add: vector_less_eq_def dest_vec1_def)
- thus ?thesis using connected_ivt_component[of "f ` {a..b}" "f a" "f b" k y]
- using connected_continuous_image[OF assms(2) convex_connected[OF convex_interval(1)]]
- using assms by(auto intro!: imageI) qed
-
-lemma ivt_increasing_component_1: fixes f::"real^1 \<Rightarrow> real^'n::finite"
- assumes "dest_vec1 a \<le> dest_vec1 b"
- "\<forall>x\<in>{a .. b}. continuous (at x) f" "f a$k \<le> y" "y \<le> f b$k"
- shows "\<exists>x\<in>{a..b}. (f x)$k = y"
- apply(rule ivt_increasing_component_on_1) using assms using continuous_at_imp_continuous_on by auto
-
-lemma ivt_decreasing_component_on_1: fixes f::"real^1 \<Rightarrow> real^'n::finite"
- assumes "dest_vec1 a \<le> dest_vec1 b" "continuous_on {a .. b} f" "(f b)$k \<le> y" "y \<le> (f a)$k"
- shows "\<exists>x\<in>{a..b}. (f x)$k = y"
- apply(subst neg_equal_iff_equal[THEN sym]) unfolding vector_uminus_component[THEN sym]
- apply(rule ivt_increasing_component_on_1) using assms using continuous_on_neg
- by(auto simp add:vector_uminus_component)
-
-lemma ivt_decreasing_component_1: fixes f::"real^1 \<Rightarrow> real^'n::finite"
- 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"
- shows "\<exists>x\<in>{a..b}. (f x)$k = y"
- apply(rule ivt_decreasing_component_on_1) using assms using continuous_at_imp_continuous_on by auto
-
-subsection {* A bound within a convex hull, and so an interval. *}
-
-lemma convex_on_convex_hull_bound:
- fixes s :: "(real ^ _) set"
- assumes "convex_on (convex hull s) f" "\<forall>x\<in>s. f x \<le> b"
- shows "\<forall>x\<in> convex hull s. f x \<le> b" proof
- fix x assume "x\<in>convex hull s"
- 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"
- unfolding convex_hull_indexed mem_Collect_eq by auto
- 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"]
- unfolding setsum_left_distrib[THEN sym] obt(2) mult_1 apply(drule_tac meta_mp) apply(rule mult_left_mono)
- using assms(2) obt(1) by auto
- thus "f x \<le> b" using assms(1)[unfolded convex_on[OF convex_convex_hull], rule_format, of k u v]
- unfolding obt(2-3) using obt(1) and hull_subset[unfolded subset_eq, rule_format, of _ s] by auto qed
-
-lemma unit_interval_convex_hull:
- "{0::real^'n::finite .. 1} = convex hull {x. \<forall>i. (x$i = 0) \<or> (x$i = 1)}" (is "?int = convex hull ?points")
-proof- have 01:"{0,1} \<subseteq> convex hull ?points" apply rule apply(rule_tac hull_subset[unfolded subset_eq, rule_format]) by auto
- { fix n x assume "x\<in>{0::real^'n .. 1}" "n \<le> CARD('n)" "card {i. x$i \<noteq> 0} \<le> n"
- hence "x\<in>convex hull ?points" proof(induct n arbitrary: x)
- case 0 hence "x = 0" apply(subst Cart_eq) apply rule by auto
- thus "x\<in>convex hull ?points" using 01 by auto
- next
- case (Suc n) show "x\<in>convex hull ?points" proof(cases "{i. x$i \<noteq> 0} = {}")
- case True hence "x = 0" unfolding Cart_eq by auto
- thus "x\<in>convex hull ?points" using 01 by auto
- next
- case False def xi \<equiv> "Min ((\<lambda>i. x$i) ` {i. x$i \<noteq> 0})"
- have "xi \<in> (\<lambda>i. x$i) ` {i. x$i \<noteq> 0}" unfolding xi_def apply(rule Min_in) using False by auto
- then obtain i where i':"x$i = xi" "x$i \<noteq> 0" by auto
- have i:"\<And>j. x$j > 0 \<Longrightarrow> x$i \<le> x$j"
- unfolding i'(1) xi_def apply(rule_tac Min_le) unfolding image_iff
- defer apply(rule_tac x=j in bexI) using i' by auto
- 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`
- by(auto simp add: Cart_lambda_beta)
- show ?thesis proof(cases "x$i=1")
- case True have "\<forall>j\<in>{i. x$i \<noteq> 0}. x$j = 1" apply(rule, rule ccontr) unfolding mem_Collect_eq proof-
- fix j assume "x $ j \<noteq> 0" "x $ j \<noteq> 1"
- hence j:"x$j \<in> {0<..<1}" using Suc(2) by(auto simp add: vector_less_eq_def elim!:allE[where x=j])
- hence "x$j \<in> op $ x ` {i. x $ i \<noteq> 0}" by auto
- hence "x$j \<ge> x$i" unfolding i'(1) xi_def apply(rule_tac Min_le) by auto
- thus False using True Suc(2) j by(auto simp add: vector_less_eq_def elim!:ballE[where x=j]) qed
- thus "x\<in>convex hull ?points" apply(rule_tac hull_subset[unfolded subset_eq, rule_format])
- by(auto simp add: Cart_lambda_beta)
- next let ?y = "\<lambda>j. if x$j = 0 then 0 else (x$j - x$i) / (1 - x$i)"
- 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
- by(auto simp add: Cart_lambda_beta vector_add_component vector_smult_component vector_minus_component field_simps)
- { 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"
- apply(rule_tac divide_nonneg_pos) using i(1)[of j] using False i01
- using Suc(2)[unfolded mem_interval, rule_format, of j] by(auto simp add:field_simps Cart_lambda_beta)
- hence "0 \<le> ?y j \<and> ?y j \<le> 1" by auto }
- 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)
- hence "{j. x$j \<noteq> 0} \<noteq> {j. ((\<chi> j. ?y j)::real^'n::finite) $ j \<noteq> 0}" by auto
- 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)
- 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
- ultimately show ?thesis apply(subst *) apply(rule convex_convex_hull[unfolded convex_def, rule_format])
- apply(rule_tac hull_subset[unfolded subset_eq, rule_format]) defer apply(rule Suc(1))
- unfolding mem_interval using i01 Suc(3) by (auto simp add: Cart_lambda_beta)
- qed qed qed } note * = this
- show ?thesis apply rule defer apply(rule hull_minimal) unfolding subset_eq prefer 3 apply rule
- apply(rule_tac n2="CARD('n)" in *) prefer 3 apply(rule card_mono) using 01 and convex_interval(1) prefer 5 apply - apply rule
- unfolding mem_interval apply rule unfolding mem_Collect_eq apply(erule_tac x=i in allE)
- by(auto simp add: vector_less_eq_def mem_def[of _ convex]) qed
-
-subsection {* And this is a finite set of vertices. *}
-
-lemma unit_cube_convex_hull: obtains s where "finite s" "{0 .. 1::real^'n::finite} = convex hull s"
- apply(rule that[of "{x::real^'n::finite. \<forall>i. x$i=0 \<or> x$i=1}"])
- apply(rule finite_subset[of _ "(\<lambda>s. (\<chi> i. if i\<in>s then 1::real else 0)::real^'n::finite) ` UNIV"])
- prefer 3 apply(rule unit_interval_convex_hull) apply rule unfolding mem_Collect_eq proof-
- fix x::"real^'n" assume as:"\<forall>i. x $ i = 0 \<or> x $ i = 1"
- 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}"])
- unfolding Cart_eq using as by(auto simp add:Cart_lambda_beta) qed auto
-
-subsection {* Hence any cube (could do any nonempty interval). *}
-
-lemma cube_convex_hull:
- assumes "0 < d" obtains s::"(real^'n::finite) set" where "finite s" "{x - (\<chi> i. d) .. x + (\<chi> i. d)} = convex hull s" proof-
- let ?d = "(\<chi> i. d)::real^'n"
- have *:"{x - ?d .. x + ?d} = (\<lambda>y. x - ?d + (2 * d) *\<^sub>R y) ` {0 .. 1}" apply(rule set_ext, rule)
- unfolding image_iff defer apply(erule bexE) proof-
- fix y assume as:"y\<in>{x - ?d .. x + ?d}"
- { 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]]
- by(auto simp add: vector_component)
- hence "1 \<ge> inverse d * (x $ i - y $ i)" "1 \<ge> inverse d * (y $ i - x $ i)"
- apply(rule_tac[!] mult_left_le_imp_le[OF _ assms]) unfolding mult_assoc[THEN sym]
- using assms by(auto simp add: field_simps right_inverse)
- hence "inverse d * (x $ i * 2) \<le> 2 + inverse d * (y $ i * 2)"
- "inverse d * (y $ i * 2) \<le> 2 + inverse d * (x $ i * 2)" by(auto simp add:field_simps) }
- hence "inverse (2 * d) *\<^sub>R (y - (x - ?d)) \<in> {0..1}" unfolding mem_interval using assms
- by(auto simp add: Cart_eq vector_component_simps field_simps)
- 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)
- using assms by(auto simp add: Cart_eq vector_less_eq_def Cart_lambda_beta)
- next
- fix y z assume as:"z\<in>{0..1}" "y = x - ?d + (2*d) *\<^sub>R z"
- 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)
- apply rule apply(rule mult_nonneg_nonneg) prefer 3 apply(rule mult_right_le_one_le)
- using assms by(auto simp add: vector_component_simps Cart_eq)
- thus "y \<in> {x - ?d..x + ?d}" unfolding as(2) mem_interval apply- apply rule using as(1)[unfolded mem_interval]
- apply(erule_tac x=i in allE) using assms by(auto simp add: vector_component_simps Cart_eq) qed
- obtain s where "finite s" "{0..1::real^'n} = convex hull s" using unit_cube_convex_hull by auto
- 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
-
-subsection {* Bounded convex function on open set is continuous. *}
-
-lemma convex_on_bounded_continuous:
- fixes s :: "(real ^ _) set"
- assumes "open s" "convex_on s f" "\<forall>x\<in>s. abs(f x) \<le> b"
- shows "continuous_on s f"
- apply(rule continuous_at_imp_continuous_on) unfolding continuous_at_real_range proof(rule,rule,rule)
- fix x e assume "x\<in>s" "(0::real) < e"
- def B \<equiv> "abs b + 1"
- have B:"0 < B" "\<And>x. x\<in>s \<Longrightarrow> abs (f x) \<le> B"
- unfolding B_def defer apply(drule assms(3)[rule_format]) by auto
- 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
- show "\<exists>d>0. \<forall>x'. norm (x' - x) < d \<longrightarrow> \<bar>f x' - f x\<bar> < e"
- apply(rule_tac x="min (k / 2) (e / (2 * B) * k)" in exI) apply rule defer proof(rule,rule)
- fix y assume as:"norm (y - x) < min (k / 2) (e / (2 * B) * k)"
- show "\<bar>f y - f x\<bar> < e" proof(cases "y=x")
- case False def t \<equiv> "k / norm (y - x)"
- have "2 < t" "0<t" unfolding t_def using as False and `k>0` by(auto simp add:field_simps)
- have "y\<in>s" apply(rule k[unfolded subset_eq,rule_format]) unfolding mem_cball dist_norm
- apply(rule order_trans[of _ "2 * norm (x - y)"]) using as by(auto simp add: field_simps norm_minus_commute)
- { def w \<equiv> "x + t *\<^sub>R (y - x)"
- have "w\<in>s" unfolding w_def apply(rule k[unfolded subset_eq,rule_format]) unfolding mem_cball dist_norm
- unfolding t_def using `k>0` by auto
- 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)
- also have "\<dots> = 0" using `t>0` by(auto simp add:field_simps)
- 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)
- 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)
- hence "(f w - f x) / t < e"
- using B(2)[OF `w\<in>s`] and B(2)[OF `x\<in>s`] using `t>0` by(auto simp add:field_simps)
- hence th1:"f y - f x < e" apply- apply(rule le_less_trans) defer apply assumption
- using assms(2)[unfolded convex_on_def,rule_format,of w x "1/t" "(t - 1)/t", unfolded w]
- using `0<t` `2<t` and `x\<in>s` `w\<in>s` by(auto simp add:field_simps) }
- moreover
- { def w \<equiv> "x - t *\<^sub>R (y - x)"
- have "w\<in>s" unfolding w_def apply(rule k[unfolded subset_eq,rule_format]) unfolding mem_cball dist_norm
- unfolding t_def using `k>0` by auto
- 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)
- also have "\<dots>=x" using `t>0` by (auto simp add:field_simps)
- 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)
- 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)
- 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)
- have "f x \<le> 1 / (1 + t) * f w + (t / (1 + t)) * f y"
- using assms(2)[unfolded convex_on_def,rule_format,of w y "1/(1+t)" "t / (1+t)",unfolded w]
- using `0<t` `2<t` and `y\<in>s` `w\<in>s` by (auto simp add:field_simps)
- also have "\<dots> = (f w + t * f y) / (1 + t)" using `t>0` unfolding real_divide_def by (auto simp add:field_simps)
- also have "\<dots> < e + f y" using `t>0` * `e>0` by(auto simp add:field_simps)
- finally have "f x - f y < e" by auto }
- ultimately show ?thesis by auto
- qed(insert `0<e`, auto)
- qed(insert `0<e` `0<k` `0<B`, auto simp add:field_simps intro!:mult_pos_pos) qed
-
-subsection {* Upper bound on a ball implies upper and lower bounds. *}
-
-lemma convex_bounds_lemma:
- fixes x :: "real ^ _"
- assumes "convex_on (cball x e) f" "\<forall>y \<in> cball x e. f y \<le> b"
- shows "\<forall>y \<in> cball x e. abs(f y) \<le> b + 2 * abs(f x)"
- apply(rule) proof(cases "0 \<le> e") case True
- fix y assume y:"y\<in>cball x e" def z \<equiv> "2 *\<^sub>R x - y"
- have *:"x - (2 *\<^sub>R x - y) = y - x" by vector
- have z:"z\<in>cball x e" using y unfolding z_def mem_cball dist_norm * by(auto simp add: norm_minus_commute)
- have "(1 / 2) *\<^sub>R y + (1 / 2) *\<^sub>R z = x" unfolding z_def by (auto simp add: algebra_simps)
- 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"]
- using assms(2)[rule_format,OF y] assms(2)[rule_format,OF z] by(auto simp add:field_simps)
-next case False fix y assume "y\<in>cball x e"
- hence "dist x y < 0" using False unfolding mem_cball not_le by (auto simp del: dist_not_less_zero)
- thus "\<bar>f y\<bar> \<le> b + 2 * \<bar>f x\<bar>" using zero_le_dist[of x y] by auto qed
-
-subsection {* Hence a convex function on an open set is continuous. *}
-
-lemma convex_on_continuous:
- assumes "open (s::(real^'n::finite) set)" "convex_on s f"
- shows "continuous_on s f"
- unfolding continuous_on_eq_continuous_at[OF assms(1)] proof
- note dimge1 = dimindex_ge_1[where 'a='n]
- fix x assume "x\<in>s"
- then obtain e where e:"cball x e \<subseteq> s" "e>0" using assms(1) unfolding open_contains_cball by auto
- def d \<equiv> "e / real CARD('n)"
- have "0 < d" unfolding d_def using `e>0` dimge1 by(rule_tac divide_pos_pos, auto)
- let ?d = "(\<chi> i. d)::real^'n"
- obtain c where c:"finite c" "{x - ?d..x + ?d} = convex hull c" using cube_convex_hull[OF `d>0`, of x] by auto
- have "x\<in>{x - ?d..x + ?d}" using `d>0` unfolding mem_interval by(auto simp add:vector_component_simps)
- hence "c\<noteq>{}" apply(rule_tac ccontr) using c by(auto simp add:convex_hull_empty)
- def k \<equiv> "Max (f ` c)"
- have "convex_on {x - ?d..x + ?d} f" apply(rule convex_on_subset[OF assms(2)])
- apply(rule subset_trans[OF _ e(1)]) unfolding subset_eq mem_cball proof
- fix z assume z:"z\<in>{x - ?d..x + ?d}"
- have e:"e = setsum (\<lambda>i. d) (UNIV::'n set)" unfolding setsum_constant d_def using dimge1
- by (metis card_enum field_simps d_def not_one_le_zero of_nat_le_iff real_eq_of_nat real_of_nat_1)
- show "dist x z \<le> e" unfolding dist_norm e apply(rule_tac order_trans[OF norm_le_l1], rule setsum_mono)
- using z[unfolded mem_interval] apply(erule_tac x=i in allE) by(auto simp add:field_simps vector_component_simps) qed
- 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
- unfolding k_def apply(rule, rule Max_ge) using c(1) by auto
- 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
- hence dsube:"cball x d \<subseteq> cball x e" unfolding subset_eq Ball_def mem_cball by auto
- 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
- 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
- fix y assume y:"y\<in>cball x d"
- { fix i::'n have "x $ i - d \<le> y $ i" "y $ i \<le> x $ i + d"
- using order_trans[OF component_le_norm y[unfolded mem_cball dist_norm], of i] by(auto simp add: vector_component) }
- thus "f y \<le> k" apply(rule_tac k[rule_format]) unfolding mem_cball mem_interval dist_norm
- by(auto simp add: vector_component_simps) qed
- hence "continuous_on (ball x d) f" apply(rule_tac convex_on_bounded_continuous)
- apply(rule open_ball, rule convex_on_subset[OF conv], rule ball_subset_cball) by auto
- thus "continuous (at x) f" unfolding continuous_on_eq_continuous_at[OF open_ball] using `d>0` by auto qed
-
-subsection {* Line segments, starlike sets etc. *)
-(* Use the same overloading tricks as for intervals, so that *)
-(* segment[a,b] is closed and segment(a,b) is open relative to affine hull. *}
-
-definition
- midpoint :: "real ^ 'n::finite \<Rightarrow> real ^ 'n \<Rightarrow> real ^ 'n" where
- "midpoint a b = (inverse (2::real)) *\<^sub>R (a + b)"
-
-definition
- open_segment :: "real ^ 'n::finite \<Rightarrow> real ^ 'n \<Rightarrow> (real ^ 'n) set" where
- "open_segment a b = {(1 - u) *\<^sub>R a + u *\<^sub>R b | u::real. 0 < u \<and> u < 1}"
-
-definition
- closed_segment :: "real ^ 'n::finite \<Rightarrow> real ^ 'n \<Rightarrow> (real ^ 'n) set" where
- "closed_segment a b = {(1 - u) *\<^sub>R a + u *\<^sub>R b | u::real. 0 \<le> u \<and> u \<le> 1}"
-
-definition "between = (\<lambda> (a,b). closed_segment a b)"
-
-lemmas segment = open_segment_def closed_segment_def
-
-definition "starlike s \<longleftrightarrow> (\<exists>a\<in>s. \<forall>x\<in>s. closed_segment a x \<subseteq> s)"
-
-lemma midpoint_refl: "midpoint x x = x"
- unfolding midpoint_def unfolding scaleR_right_distrib unfolding scaleR_left_distrib[THEN sym] by auto
-
-lemma midpoint_sym: "midpoint a b = midpoint b a" unfolding midpoint_def by (auto simp add: scaleR_right_distrib)
-
-lemma dist_midpoint:
- "dist a (midpoint a b) = (dist a b) / 2" (is ?t1)
- "dist b (midpoint a b) = (dist a b) / 2" (is ?t2)
- "dist (midpoint a b) a = (dist a b) / 2" (is ?t3)
- "dist (midpoint a b) b = (dist a b) / 2" (is ?t4)
-proof-
- have *: "\<And>x y::real^'n::finite. 2 *\<^sub>R x = - y \<Longrightarrow> norm x = (norm y) / 2" unfolding equation_minus_iff by auto
- have **:"\<And>x y::real^'n::finite. 2 *\<^sub>R x = y \<Longrightarrow> norm x = (norm y) / 2" by auto
- note scaleR_right_distrib [simp]
- show ?t1 unfolding midpoint_def dist_norm apply (rule **) by(auto,vector)
- show ?t2 unfolding midpoint_def dist_norm apply (rule *) by(auto,vector)
- show ?t3 unfolding midpoint_def dist_norm apply (rule *) by(auto,vector)
- show ?t4 unfolding midpoint_def dist_norm apply (rule **) by(auto,vector) qed
-
-lemma midpoint_eq_endpoint:
- "midpoint a b = a \<longleftrightarrow> a = (b::real^'n::finite)"
- "midpoint a b = b \<longleftrightarrow> a = b"
- unfolding dist_eq_0_iff[where 'a="real^'n", THEN sym] dist_midpoint by auto
-
-lemma convex_contains_segment:
- "convex s \<longleftrightarrow> (\<forall>a\<in>s. \<forall>b\<in>s. closed_segment a b \<subseteq> s)"
- unfolding convex_alt closed_segment_def by auto
-
-lemma convex_imp_starlike:
- "convex s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> starlike s"
- unfolding convex_contains_segment starlike_def by auto
-
-lemma segment_convex_hull:
- "closed_segment a b = convex hull {a,b}" proof-
- have *:"\<And>x. {x} \<noteq> {}" by auto
- have **:"\<And>u v. u + v = 1 \<longleftrightarrow> u = 1 - (v::real)" by auto
- show ?thesis unfolding segment convex_hull_insert[OF *] convex_hull_singleton apply(rule set_ext)
- unfolding mem_Collect_eq apply(rule,erule exE)
- apply(rule_tac x="1 - u" in exI) apply rule defer apply(rule_tac x=u in exI) defer
- apply(erule exE, (erule conjE)?)+ apply(rule_tac x="1 - u" in exI) unfolding ** by auto qed
-
-lemma convex_segment: "convex (closed_segment a b)"
- unfolding segment_convex_hull by(rule convex_convex_hull)
-
-lemma ends_in_segment: "a \<in> closed_segment a b" "b \<in> closed_segment a b"
- unfolding segment_convex_hull apply(rule_tac[!] hull_subset[unfolded subset_eq, rule_format]) by auto
-
-lemma segment_furthest_le:
- assumes "x \<in> closed_segment a b" shows "norm(y - x) \<le> norm(y - a) \<or> norm(y - x) \<le> norm(y - b)" proof-
- obtain z where "z\<in>{a, b}" "norm (x - y) \<le> norm (z - y)" using simplex_furthest_le[of "{a, b}" y]
- using assms[unfolded segment_convex_hull] by auto
- thus ?thesis by(auto simp add:norm_minus_commute) qed
-
-lemma segment_bound:
- assumes "x \<in> closed_segment a b"
- shows "norm(x - a) \<le> norm(b - a)" "norm(x - b) \<le> norm(b - a)"
- using segment_furthest_le[OF assms, of a]
- using segment_furthest_le[OF assms, of b]
- by (auto simp add:norm_minus_commute)
-
-lemma segment_refl:"closed_segment a a = {a}" unfolding segment by (auto simp add: algebra_simps)
-
-lemma between_mem_segment: "between (a,b) x \<longleftrightarrow> x \<in> closed_segment a b"
- unfolding between_def mem_def by auto
-
-lemma between:"between (a,b) (x::real^'n::finite) \<longleftrightarrow> dist a b = (dist a x) + (dist x b)"
-proof(cases "a = b")
- case True thus ?thesis unfolding between_def split_conv mem_def[of x, symmetric]
- by(auto simp add:segment_refl dist_commute) next
- case False hence Fal:"norm (a - b) \<noteq> 0" and Fal2: "norm (a - b) > 0" by auto
- have *:"\<And>u. a - ((1 - u) *\<^sub>R a + u *\<^sub>R b) = u *\<^sub>R (a - b)" by (auto simp add: algebra_simps)
- show ?thesis unfolding between_def split_conv mem_def[of x, symmetric] closed_segment_def mem_Collect_eq
- apply rule apply(erule exE, (erule conjE)+) apply(subst dist_triangle_eq) proof-
- fix u assume as:"x = (1 - u) *\<^sub>R a + u *\<^sub>R b" "0 \<le> u" "u \<le> 1"
- hence *:"a - x = u *\<^sub>R (a - b)" "x - b = (1 - u) *\<^sub>R (a - b)"
- unfolding as(1) by(auto simp add:algebra_simps)
- show "norm (a - x) *\<^sub>R (x - b) = norm (x - b) *\<^sub>R (a - x)"
- unfolding norm_minus_commute[of x a] * Cart_eq using as(2,3)
- by(auto simp add: vector_component_simps field_simps)
- next assume as:"dist a b = dist a x + dist x b"
- 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
- 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)
- unfolding dist_norm Cart_eq apply- apply rule defer apply(rule, rule divide_nonneg_pos) prefer 4 proof rule
- fix i::'n have "((1 - norm (a - x) / norm (a - b)) *\<^sub>R a + (norm (a - x) / norm (a - b)) *\<^sub>R b) $ i =
- ((norm (a - b) - norm (a - x)) * (a $ i) + norm (a - x) * (b $ i)) / norm (a - b)"
- using Fal by(auto simp add:vector_component_simps field_simps)
- also have "\<dots> = x$i" apply(rule divide_eq_imp[OF Fal])
- unfolding as[unfolded dist_norm] using as[unfolded dist_triangle_eq Cart_eq,rule_format, of i]
- by(auto simp add:field_simps vector_component_simps)
- 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
- qed(insert Fal2, auto) qed qed
-
-lemma between_midpoint: fixes a::"real^'n::finite" shows
- "between (a,b) (midpoint a b)" (is ?t1)
- "between (b,a) (midpoint a b)" (is ?t2)
-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
- show ?t1 ?t2 unfolding between midpoint_def dist_norm apply(rule_tac[!] *)
- by(auto simp add:field_simps Cart_eq vector_component_simps) qed
-
-lemma between_mem_convex_hull:
- "between (a,b) x \<longleftrightarrow> x \<in> convex hull {a,b}"
- unfolding between_mem_segment segment_convex_hull ..
-
-subsection {* Shrinking towards the interior of a convex set. *}
-
-lemma mem_interior_convex_shrink:
- fixes s :: "(real ^ _) set"
- assumes "convex s" "c \<in> interior s" "x \<in> s" "0 < e" "e \<le> 1"
- shows "x - e *\<^sub>R (x - c) \<in> interior s"
-proof- obtain d where "d>0" and d:"ball c d \<subseteq> s" using assms(2) unfolding mem_interior by auto
- show ?thesis unfolding mem_interior apply(rule_tac x="e*d" in exI)
- apply(rule) defer unfolding subset_eq Ball_def mem_ball proof(rule,rule)
- fix y assume as:"dist (x - e *\<^sub>R (x - c)) y < e * d"
- 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)
- 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)"
- unfolding dist_norm unfolding norm_scaleR[THEN sym] apply(rule norm_eqI) using `e>0`
- by(auto simp add:vector_component_simps Cart_eq field_simps)
- also have "\<dots> = abs(1/e) * norm (x - e *\<^sub>R (x - c) - y)" by(auto intro!:norm_eqI simp add: algebra_simps)
- also have "\<dots> < d" using as[unfolded dist_norm] and `e>0`
- by(auto simp add:pos_divide_less_eq[OF `e>0`] real_mult_commute)
- finally show "y \<in> s" apply(subst *) apply(rule assms(1)[unfolded convex_alt,rule_format])
- apply(rule d[unfolded subset_eq,rule_format]) unfolding mem_ball using assms(3-5) by auto
- qed(rule mult_pos_pos, insert `e>0` `d>0`, auto) qed
-
-lemma mem_interior_closure_convex_shrink:
- fixes s :: "(real ^ _) set"
- assumes "convex s" "c \<in> interior s" "x \<in> closure s" "0 < e" "e \<le> 1"
- shows "x - e *\<^sub>R (x - c) \<in> interior s"
-proof- obtain d where "d>0" and d:"ball c d \<subseteq> s" using assms(2) unfolding mem_interior by auto
- have "\<exists>y\<in>s. norm (y - x) * (1 - e) < e * d" proof(cases "x\<in>s")
- case True thus ?thesis using `e>0` `d>0` by(rule_tac bexI[where x=x], auto intro!: mult_pos_pos) next
- case False hence x:"x islimpt s" using assms(3)[unfolded closure_def] by auto
- show ?thesis proof(cases "e=1")
- case True obtain y where "y\<in>s" "y \<noteq> x" "dist y x < 1"
- using x[unfolded islimpt_approachable,THEN spec[where x=1]] by auto
- thus ?thesis apply(rule_tac x=y in bexI) unfolding True using `d>0` by auto next
- case False hence "0 < e * d / (1 - e)" and *:"1 - e > 0"
- using `e\<le>1` `e>0` `d>0` by(auto intro!:mult_pos_pos divide_pos_pos)
- then obtain y where "y\<in>s" "y \<noteq> x" "dist y x < e * d / (1 - e)"
- using x[unfolded islimpt_approachable,THEN spec[where x="e*d / (1 - e)"]] by auto
- thus ?thesis apply(rule_tac x=y in bexI) unfolding dist_norm using pos_less_divide_eq[OF *] by auto qed qed
- then obtain y where "y\<in>s" and y:"norm (y - x) * (1 - e) < e * d" by auto
- def z \<equiv> "c + ((1 - e) / e) *\<^sub>R (x - y)"
- have *:"x - e *\<^sub>R (x - c) = y - e *\<^sub>R (y - z)" unfolding z_def using `e>0` by (auto simp add: scaleR_right_diff_distrib scaleR_right_distrib scaleR_left_diff_distrib)
- have "z\<in>interior s" apply(rule subset_interior[OF d,unfolded subset_eq,rule_format])
- unfolding interior_open[OF open_ball] mem_ball z_def dist_norm using y and assms(4,5)
- by(auto simp add:field_simps norm_minus_commute)
- thus ?thesis unfolding * apply - apply(rule mem_interior_convex_shrink)
- using assms(1,4-5) `y\<in>s` by auto qed
-
-subsection {* Some obvious but surprisingly hard simplex lemmas. *}
-
-lemma simplex:
- assumes "finite s" "0 \<notin> s"
- 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)}"
- unfolding convex_hull_finite[OF finite.insertI[OF assms(1)]] apply(rule set_ext, rule) unfolding mem_Collect_eq
- apply(erule_tac[!] exE) apply(erule_tac[!] conjE)+ unfolding setsum_clauses(2)[OF assms(1)]
- 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)
- unfolding if_smult and setsum_delta_notmem[OF assms(2)] by auto
-
-lemma std_simplex:
- "convex hull (insert 0 { basis i | i. i\<in>UNIV}) =
- {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")
-proof- let ?D = "UNIV::'n set"
- have "0\<notin>?p" by(auto simp add: basis_nonzero)
- have "{(basis i)::real^'n |i. i \<in> ?D} = basis ` ?D" by auto
- note sumbas = this setsum_reindex[OF basis_inj, unfolded o_def]
- show ?thesis unfolding simplex[OF finite_stdbasis `0\<notin>?p`] apply(rule set_ext) unfolding mem_Collect_eq apply rule
- apply(erule exE, (erule conjE)+) apply(erule_tac[2] conjE)+ proof-
- 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"
- 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
- hence **:"setsum u {basis i |i. i \<in> ?D} = setsum (op $ x) ?D" unfolding sumbas by(rule_tac setsum_cong, auto)
- show " (\<forall>i. 0 \<le> x $ i) \<and> setsum (op $ x) ?D \<le> 1" apply - proof(rule,rule)
- fix i::'n show "0 \<le> x$i" unfolding *[rule_format,of i,THEN sym] apply(rule_tac as(1)[rule_format]) by auto
- qed(insert as(2)[unfolded **], auto)
- next fix x::"real^'n" assume as:"\<forall>i. 0 \<le> x $ i" "setsum (op $ x) ?D \<le> 1"
- 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"
- 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)
- unfolding sumbas using as(2) and basis_expansion_unique [where 'a=real, unfolded smult_conv_scaleR] by(auto simp add:inner_basis) qed qed
-
-lemma interior_std_simplex:
- "interior (convex hull (insert 0 { basis i| i. i\<in>UNIV})) =
- {x::real^'n::finite. (\<forall>i. 0 < x$i) \<and> setsum (\<lambda>i. x$i) UNIV < 1 }"
- apply(rule set_ext) unfolding mem_interior std_simplex unfolding subset_eq mem_Collect_eq Ball_def mem_ball
- unfolding Ball_def[symmetric] apply rule apply(erule exE, (erule conjE)+) defer apply(erule conjE) proof-
- 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"
- show "(\<forall>xa. 0 < x $ xa) \<and> setsum (op $ x) UNIV < 1" apply(rule,rule) proof-
- fix i::'n show "0 < x $ i" using as[THEN spec[where x="x - (e / 2) *\<^sub>R basis i"]] and `e>0`
- unfolding dist_norm by(auto simp add: norm_basis vector_component_simps basis_component elim:allE[where x=i])
- next guess a using UNIV_witness[where 'a='n] ..
- have **:"dist x (x + (e / 2) *\<^sub>R basis a) < e" using `e>0` and norm_basis[of a]
- unfolding dist_norm by(auto simp add: vector_component_simps basis_component intro!: mult_strict_left_mono_comm)
- 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)
- 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)
- have "setsum (op $ x) UNIV < setsum (op $ (x + (e / 2) *\<^sub>R basis a)) UNIV" unfolding * setsum_addf
- using `0<e` dimindex_ge_1 by(auto simp add: setsum_delta')
- also have "\<dots> \<le> 1" using ** apply(drule_tac as[rule_format]) by auto
- finally show "setsum (op $ x) UNIV < 1" by auto qed
-next
- fix x::"real^'n::finite" assume as:"\<forall>i. 0 < x $ i" "setsum (op $ x) UNIV < 1"
- guess a using UNIV_witness[where 'a='b] ..
- let ?d = "(1 - setsum (op $ x) UNIV) / real (CARD('n))"
- have "Min ((op $ x) ` UNIV) > 0" apply(rule Min_grI) using as(1) dimindex_ge_1 by auto
- moreover have"?d > 0" apply(rule divide_pos_pos) using as(2) using dimindex_ge_1 by(auto simp add: Suc_le_eq)
- 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"
- apply(rule_tac x="min (Min ((op $ x) ` UNIV)) ?D" in exI) apply rule defer apply(rule,rule) proof-
- fix y assume y:"dist x y < min (Min (op $ x ` UNIV)) ?d"
- have "setsum (op $ y) UNIV \<le> setsum (\<lambda>i. x$i + ?d) UNIV" proof(rule setsum_mono)
- fix i::'n have "abs (y$i - x$i) < ?d" apply(rule le_less_trans) using component_le_norm[of "y - x" i]
- using y[unfolded min_less_iff_conj dist_norm, THEN conjunct2] by(auto simp add:vector_component_simps norm_minus_commute)
- thus "y $ i \<le> x $ i + ?d" by auto qed
- 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)
- finally show "(\<forall>i. 0 \<le> y $ i) \<and> setsum (op $ y) UNIV \<le> 1" apply- proof(rule,rule)
- fix i::'n have "norm (x - y) < x$i" using y[unfolded min_less_iff_conj dist_norm, THEN conjunct1]
- using Min_gr_iff[of "op $ x ` dimset x"] dimindex_ge_1 by auto
- 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)
- qed auto qed auto qed
-
-lemma interior_std_simplex_nonempty: obtains a::"real^'n::finite" where
- "a \<in> interior(convex hull (insert 0 {basis i | i . i \<in> UNIV}))" proof-
- 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}"
- have *:"{basis i :: real ^ 'n | i. i \<in> ?D} = basis ` ?D" by auto
- { fix i have "?a $ i = inverse (2 * real CARD('n))"
- unfolding setsum_component vector_smult_component and * and setsum_reindex[OF basis_inj] and o_def
- apply(rule trans[of _ "setsum (\<lambda>j. if i = j then inverse (2 * real CARD('n)) else 0) ?D"]) apply(rule setsum_cong2)
- 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]) }
- note ** = this
- show ?thesis apply(rule that[of ?a]) unfolding interior_std_simplex mem_Collect_eq proof(rule,rule)
- fix i::'n show "0 < ?a $ i" unfolding ** using dimindex_ge_1 by(auto simp add: Suc_le_eq) next
- have "setsum (op $ ?a) ?D = setsum (\<lambda>i. inverse (2 * real CARD('n))) ?D" by(rule setsum_cong2, rule **)
- also have "\<dots> < 1" unfolding setsum_constant card_enum real_eq_of_nat real_divide_def[THEN sym] by (auto simp add:field_simps)
- finally show "setsum (op $ ?a) ?D < 1" by auto qed qed
-
-subsection {* Paths. *}
-
-definition "path (g::real^1 \<Rightarrow> real^'n::finite) \<longleftrightarrow> continuous_on {0 .. 1} g"
-
-definition "pathstart (g::real^1 \<Rightarrow> real^'n) = g 0"
-
-definition "pathfinish (g::real^1 \<Rightarrow> real^'n) = g 1"
-
-definition "path_image (g::real^1 \<Rightarrow> real^'n) = g ` {0 .. 1}"
-
-definition "reversepath (g::real^1 \<Rightarrow> real^'n) = (\<lambda>x. g(1 - x))"
-
-definition joinpaths:: "(real^1 \<Rightarrow> real^'n) \<Rightarrow> (real^1 \<Rightarrow> real^'n) \<Rightarrow> (real^1 \<Rightarrow> real^'n)" (infixr "+++" 75)
- 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))"
-definition "simple_path (g::real^1 \<Rightarrow> real^'n) \<longleftrightarrow>
- (\<forall>x\<in>{0..1}. \<forall>y\<in>{0..1}. g x = g y \<longrightarrow> x = y \<or> x = 0 \<and> y = 1 \<or> x = 1 \<and> y = 0)"
-
-definition "injective_path (g::real^1 \<Rightarrow> real^'n) \<longleftrightarrow>
- (\<forall>x\<in>{0..1}. \<forall>y\<in>{0..1}. g x = g y \<longrightarrow> x = y)"
-
-subsection {* Some lemmas about these concepts. *}
-
-lemma injective_imp_simple_path:
- "injective_path g \<Longrightarrow> simple_path g"
- unfolding injective_path_def simple_path_def by auto
-
-lemma path_image_nonempty: "path_image g \<noteq> {}"
- unfolding path_image_def image_is_empty interval_eq_empty by auto
-
-lemma pathstart_in_path_image[intro]: "(pathstart g) \<in> path_image g"
- unfolding pathstart_def path_image_def apply(rule imageI)
- unfolding mem_interval_1 vec_1[THEN sym] dest_vec1_vec by auto
-
-lemma pathfinish_in_path_image[intro]: "(pathfinish g) \<in> path_image g"
- unfolding pathfinish_def path_image_def apply(rule imageI)
- unfolding mem_interval_1 vec_1[THEN sym] dest_vec1_vec by auto
-
-lemma connected_path_image[intro]: "path g \<Longrightarrow> connected(path_image g)"
- unfolding path_def path_image_def apply(rule connected_continuous_image, assumption)
- by(rule convex_connected, rule convex_interval)
-
-lemma compact_path_image[intro]: "path g \<Longrightarrow> compact(path_image g)"
- unfolding path_def path_image_def apply(rule compact_continuous_image, assumption)
- by(rule compact_interval)
-
-lemma reversepath_reversepath[simp]: "reversepath(reversepath g) = g"
- unfolding reversepath_def by auto
-
-lemma pathstart_reversepath[simp]: "pathstart(reversepath g) = pathfinish g"
- unfolding pathstart_def reversepath_def pathfinish_def by auto
-
-lemma pathfinish_reversepath[simp]: "pathfinish(reversepath g) = pathstart g"
- unfolding pathstart_def reversepath_def pathfinish_def by auto
-
-lemma pathstart_join[simp]: "pathstart(g1 +++ g2) = pathstart g1"
- unfolding pathstart_def joinpaths_def pathfinish_def by auto
-
-lemma pathfinish_join[simp]:"pathfinish(g1 +++ g2) = pathfinish g2" proof-
- have "2 *\<^sub>R 1 - 1 = (1::real^1)" unfolding Cart_eq by(auto simp add:vector_component_simps)
- thus ?thesis unfolding pathstart_def joinpaths_def pathfinish_def
- unfolding vec_1[THEN sym] dest_vec1_vec by auto qed
-
-lemma path_image_reversepath[simp]: "path_image(reversepath g) = path_image g" proof-
- have *:"\<And>g. path_image(reversepath g) \<subseteq> path_image g"
- unfolding path_image_def subset_eq reversepath_def Ball_def image_iff apply(rule,rule,erule bexE)
- apply(rule_tac x="1 - xa" in bexI) by(auto simp add:vector_less_eq_def vector_component_simps elim!:ballE)
- show ?thesis using *[of g] *[of "reversepath g"] unfolding reversepath_reversepath by auto qed
-
-lemma path_reversepath[simp]: "path(reversepath g) \<longleftrightarrow> path g" proof-
- have *:"\<And>g. path g \<Longrightarrow> path(reversepath g)" unfolding path_def reversepath_def
- apply(rule continuous_on_compose[unfolded o_def, of _ "\<lambda>x. 1 - x"])
- apply(rule continuous_on_sub, rule continuous_on_const, rule continuous_on_id)
- apply(rule continuous_on_subset[of "{0..1}"], assumption)
- by (auto, auto simp add:vector_less_eq_def vector_component_simps elim!:ballE)
- show ?thesis using *[of g] *[of "reversepath g"] unfolding reversepath_reversepath by auto qed
-
-lemmas reversepath_simps = path_reversepath path_image_reversepath pathstart_reversepath pathfinish_reversepath
-
-lemma path_join[simp]: assumes "pathfinish g1 = pathstart g2" shows "path (g1 +++ g2) \<longleftrightarrow> path g1 \<and> path g2"
- unfolding path_def pathfinish_def pathstart_def apply rule defer apply(erule conjE) proof-
- assume as:"continuous_on {0..1} (g1 +++ g2)"
- have *:"g1 = (\<lambda>x. g1 (2 *\<^sub>R x)) \<circ> (\<lambda>x. (1/2) *\<^sub>R x)"
- "g2 = (\<lambda>x. g2 (2 *\<^sub>R x - 1)) \<circ> (\<lambda>x. (1/2) *\<^sub>R (x + 1))" unfolding o_def by auto
- 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}"
- unfolding image_smult_interval by (auto, auto simp add:vector_less_eq_def vector_component_simps elim!:ballE)
- thus "continuous_on {0..1} g1 \<and> continuous_on {0..1} g2" apply -apply rule
- apply(subst *) defer apply(subst *) apply (rule_tac[!] continuous_on_compose)
- apply (rule continuous_on_cmul, rule continuous_on_add, rule continuous_on_id, rule continuous_on_const) defer
- apply (rule continuous_on_cmul, rule continuous_on_id) apply(rule_tac[!] continuous_on_eq[of _ "g1 +++ g2"]) defer prefer 3
- apply(rule_tac[1-2] continuous_on_subset[of "{0 .. 1}"]) apply(rule as, assumption, rule as, assumption)
- apply(rule) defer apply rule proof-
- fix x assume "x \<in> op *\<^sub>R (1 / 2) ` {0::real^1..1}"
- hence "dest_vec1 x \<le> 1 / 2" unfolding image_iff by(auto simp add: vector_component_simps)
- thus "(g1 +++ g2) x = g1 (2 *\<^sub>R x)" unfolding joinpaths_def by auto next
- fix x assume "x \<in> (\<lambda>x. (1 / 2) *\<^sub>R (x + 1)) ` {0::real^1..1}"
- hence "dest_vec1 x \<ge> 1 / 2" unfolding image_iff by(auto simp add: vector_component_simps)
- thus "(g1 +++ g2) x = g2 (2 *\<^sub>R x - 1)" proof(cases "dest_vec1 x = 1 / 2")
- case True hence "x = (1/2) *\<^sub>R 1" unfolding Cart_eq by(auto simp add: forall_1 vector_component_simps)
- thus ?thesis unfolding joinpaths_def using assms[unfolded pathstart_def pathfinish_def] by auto
- qed (auto simp add:le_less joinpaths_def) qed
-next assume as:"continuous_on {0..1} g1" "continuous_on {0..1} g2"
- 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)
- have **:"op *\<^sub>R 2 ` {0..(1 / 2) *\<^sub>R 1} = {0..1::real^1}" apply(rule set_ext, rule) unfolding image_iff
- defer apply(rule_tac x="(1/2)*\<^sub>R x" in bexI) by(auto simp add: vector_component_simps)
- have ***:"(\<lambda>x. 2 *\<^sub>R x - 1) ` {(1 / 2) *\<^sub>R 1..1} = {0..1::real^1}"
- unfolding image_affinity_interval[of _ "- 1", unfolded diff_def[symmetric]] and interval_eq_empty_1
- by(auto simp add: vector_component_simps)
- 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)
- show "continuous_on {0..1} (g1 +++ g2)" unfolding * apply(rule continuous_on_union) apply(rule closed_interval)+ proof-
- 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
- unfolding o_def[THEN sym] apply(rule continuous_on_compose) apply(rule continuous_on_cmul, rule continuous_on_id)
- unfolding ** apply(rule as(1)) unfolding joinpaths_def by(auto simp add: vector_component_simps) next
- 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
- apply(rule continuous_on_compose) apply(rule continuous_on_sub, rule continuous_on_cmul, rule continuous_on_id, rule continuous_on_const)
- unfolding *** o_def joinpaths_def apply(rule as(2)) using assms[unfolded pathstart_def pathfinish_def]
- by(auto simp add: vector_component_simps ****) qed qed
-
-lemma path_image_join_subset: "path_image(g1 +++ g2) \<subseteq> (path_image g1 \<union> path_image g2)" proof
- fix x assume "x \<in> path_image (g1 +++ g2)"
- 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))"
- unfolding path_image_def image_iff joinpaths_def by auto
- thus "x \<in> path_image g1 \<union> path_image g2" apply(cases "dest_vec1 y \<le> 1/2")
- apply(rule_tac UnI1) defer apply(rule_tac UnI2) unfolding y(2) path_image_def using y(1)
- by(auto intro!: imageI simp add: vector_component_simps) qed
-
-lemma subset_path_image_join:
- assumes "path_image g1 \<subseteq> s" "path_image g2 \<subseteq> s" shows "path_image(g1 +++ g2) \<subseteq> s"
- using path_image_join_subset[of g1 g2] and assms by auto
-
-lemma path_image_join:
- assumes "path g1" "path g2" "pathfinish g1 = pathstart g2"
- shows "path_image(g1 +++ g2) = (path_image g1) \<union> (path_image g2)"
-apply(rule, rule path_image_join_subset, rule) unfolding Un_iff proof(erule disjE)
- fix x assume "x \<in> path_image g1"
- then obtain y where y:"y\<in>{0..1}" "x = g1 y" unfolding path_image_def image_iff by auto
- thus "x \<in> path_image (g1 +++ g2)" unfolding joinpaths_def path_image_def image_iff
- apply(rule_tac x="(1/2) *\<^sub>R y" in bexI) by(auto simp add: vector_component_simps) next
- fix x assume "x \<in> path_image g2"
- then obtain y where y:"y\<in>{0..1}" "x = g2 y" unfolding path_image_def image_iff by auto
- moreover have *:"y $ 1 = 0 \<Longrightarrow> y = 0" unfolding Cart_eq by auto
- ultimately show "x \<in> path_image (g1 +++ g2)" unfolding joinpaths_def path_image_def image_iff
- apply(rule_tac x="(1/2) *\<^sub>R (y + 1)" in bexI) using assms(3)[unfolded pathfinish_def pathstart_def]
- by(auto simp add: vector_component_simps) qed
-
-lemma not_in_path_image_join:
- assumes "x \<notin> path_image g1" "x \<notin> path_image g2" shows "x \<notin> path_image(g1 +++ g2)"
- using assms and path_image_join_subset[of g1 g2] by auto
-
-lemma simple_path_reversepath: assumes "simple_path g" shows "simple_path (reversepath g)"
- using assms unfolding simple_path_def reversepath_def apply- apply(rule ballI)+
- apply(erule_tac x="1-x" in ballE, erule_tac x="1-y" in ballE)
- unfolding mem_interval_1 by(auto simp add:vector_component_simps)
-
-lemma dest_vec1_scaleR [simp]:
- "dest_vec1 (scaleR a x) = scaleR a (dest_vec1 x)"
-unfolding dest_vec1_def by simp
-
-lemma simple_path_join_loop:
- assumes "injective_path g1" "injective_path g2" "pathfinish g2 = pathstart g1"
- "(path_image g1 \<inter> path_image g2) \<subseteq> {pathstart g1,pathstart g2}"
- shows "simple_path(g1 +++ g2)"
-unfolding simple_path_def proof((rule ballI)+, rule impI) let ?g = "g1 +++ g2"
- note inj = assms(1,2)[unfolded injective_path_def, rule_format]
- fix x y::"real^1" assume xy:"x \<in> {0..1}" "y \<in> {0..1}" "?g x = ?g y"
- 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)
- assume as:"x $ 1 \<le> 1 / 2" "y $ 1 \<le> 1 / 2"
- hence "g1 (2 *\<^sub>R x) = g1 (2 *\<^sub>R y)" using xy(3) unfolding joinpaths_def dest_vec1_def by auto
- moreover have "2 *\<^sub>R x \<in> {0..1}" "2 *\<^sub>R y \<in> {0..1}" using xy(1,2) as
- unfolding mem_interval_1 dest_vec1_def by(auto simp add:vector_component_simps)
- ultimately show ?thesis using inj(1)[of "2*\<^sub>R x" "2*\<^sub>R y"] by auto
- next assume as:"x $ 1 > 1 / 2" "y $ 1 > 1 / 2"
- hence "g2 (2 *\<^sub>R x - 1) = g2 (2 *\<^sub>R y - 1)" using xy(3) unfolding joinpaths_def dest_vec1_def by auto
- moreover have "2 *\<^sub>R x - 1 \<in> {0..1}" "2 *\<^sub>R y - 1 \<in> {0..1}" using xy(1,2) as
- unfolding mem_interval_1 dest_vec1_def by(auto simp add:vector_component_simps)
- ultimately show ?thesis using inj(2)[of "2*\<^sub>R x - 1" "2*\<^sub>R y - 1"] by auto
- next assume as:"x $ 1 \<le> 1 / 2" "y $ 1 > 1 / 2"
- hence "?g x \<in> path_image g1" "?g y \<in> path_image g2" unfolding path_image_def joinpaths_def
- using xy(1,2)[unfolded mem_interval_1] by(auto simp add:vector_component_simps intro!: imageI)
- moreover have "?g y \<noteq> pathstart g2" using as(2) unfolding pathstart_def joinpaths_def
- using inj(2)[of "2 *\<^sub>R y - 1" 0] and xy(2)[unfolded mem_interval_1]
- apply(rule_tac ccontr) by(auto simp add:vector_component_simps field_simps Cart_eq)
- ultimately have *:"?g x = pathstart g1" using assms(4) unfolding xy(3) by auto
- hence "x = 0" unfolding pathstart_def joinpaths_def using as(1) and xy(1)[unfolded mem_interval_1]
- using inj(1)[of "2 *\<^sub>R x" 0] by(auto simp add:vector_component_simps)
- moreover have "y = 1" using * unfolding xy(3) assms(3)[THEN sym]
- unfolding joinpaths_def pathfinish_def using as(2) and xy(2)[unfolded mem_interval_1]
- using inj(2)[of "2 *\<^sub>R y - 1" 1] by (auto simp add:vector_component_simps Cart_eq)
- ultimately show ?thesis by auto
- next assume as:"x $ 1 > 1 / 2" "y $ 1 \<le> 1 / 2"
- hence "?g x \<in> path_image g2" "?g y \<in> path_image g1" unfolding path_image_def joinpaths_def
- using xy(1,2)[unfolded mem_interval_1] by(auto simp add:vector_component_simps intro!: imageI)
- moreover have "?g x \<noteq> pathstart g2" using as(1) unfolding pathstart_def joinpaths_def
- using inj(2)[of "2 *\<^sub>R x - 1" 0] and xy(1)[unfolded mem_interval_1]
- apply(rule_tac ccontr) by(auto simp add:vector_component_simps field_simps Cart_eq)
- ultimately have *:"?g y = pathstart g1" using assms(4) unfolding xy(3) by auto
- hence "y = 0" unfolding pathstart_def joinpaths_def using as(2) and xy(2)[unfolded mem_interval_1]
- using inj(1)[of "2 *\<^sub>R y" 0] by(auto simp add:vector_component_simps)
- moreover have "x = 1" using * unfolding xy(3)[THEN sym] assms(3)[THEN sym]
- unfolding joinpaths_def pathfinish_def using as(1) and xy(1)[unfolded mem_interval_1]
- using inj(2)[of "2 *\<^sub>R x - 1" 1] by(auto simp add:vector_component_simps Cart_eq)
- ultimately show ?thesis by auto qed qed
-
-lemma injective_path_join:
- assumes "injective_path g1" "injective_path g2" "pathfinish g1 = pathstart g2"
- "(path_image g1 \<inter> path_image g2) \<subseteq> {pathstart g2}"
- shows "injective_path(g1 +++ g2)"
- unfolding injective_path_def proof(rule,rule,rule) let ?g = "g1 +++ g2"
- note inj = assms(1,2)[unfolded injective_path_def, rule_format]
- fix x y assume xy:"x \<in> {0..1}" "y \<in> {0..1}" "(g1 +++ g2) x = (g1 +++ g2) y"
- show "x = y" proof(cases "x$1 \<le> 1/2", case_tac[!] "y$1 \<le> 1/2", unfold not_le)
- 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
- unfolding mem_interval_1 joinpaths_def by(auto simp add:vector_component_simps)
- 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
- unfolding mem_interval_1 joinpaths_def by(auto simp add:vector_component_simps)
- next assume as:"x $ 1 \<le> 1 / 2" "y $ 1 > 1 / 2"
- hence "?g x \<in> path_image g1" "?g y \<in> path_image g2" unfolding path_image_def joinpaths_def
- using xy(1,2)[unfolded mem_interval_1] by(auto simp add:vector_component_simps intro!: imageI)
- hence "?g x = pathfinish g1" "?g y = pathstart g2" using assms(4) unfolding assms(3) xy(3) by auto
- 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)
- unfolding pathstart_def pathfinish_def joinpaths_def mem_interval_1
- by(auto simp add:vector_component_simps Cart_eq forall_1)
- next assume as:"x $ 1 > 1 / 2" "y $ 1 \<le> 1 / 2"
- hence "?g x \<in> path_image g2" "?g y \<in> path_image g1" unfolding path_image_def joinpaths_def
- using xy(1,2)[unfolded mem_interval_1] by(auto simp add:vector_component_simps intro!: imageI)
- hence "?g x = pathstart g2" "?g y = pathfinish g1" using assms(4) unfolding assms(3) xy(3) by auto
- 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)
- unfolding pathstart_def pathfinish_def joinpaths_def mem_interval_1
- by(auto simp add:vector_component_simps forall_1 Cart_eq) qed qed
-
-lemmas join_paths_simps = path_join path_image_join pathstart_join pathfinish_join
-
-subsection {* Reparametrizing a closed curve to start at some chosen point. *}
-
-definition "shiftpath a (f::real^1 \<Rightarrow> real^'n) =
- (\<lambda>x. if dest_vec1 (a + x) \<le> 1 then f(a + x) else f(a + x - 1))"
-
-lemma pathstart_shiftpath: "a \<le> 1 \<Longrightarrow> pathstart(shiftpath a g) = g a"
- unfolding pathstart_def shiftpath_def by auto
-
-(** move this **)
-declare forall_1[simp] ex_1[simp]
-
-lemma pathfinish_shiftpath: assumes "0 \<le> a" "pathfinish g = pathstart g"
- shows "pathfinish(shiftpath a g) = g a"
- using assms unfolding pathstart_def pathfinish_def shiftpath_def
- by(auto simp add: vector_component_simps)
-
-lemma endpoints_shiftpath:
- assumes "pathfinish g = pathstart g" "a \<in> {0 .. 1}"
- shows "pathfinish(shiftpath a g) = g a" "pathstart(shiftpath a g) = g a"
- using assms by(auto intro!:pathfinish_shiftpath pathstart_shiftpath)
-
-lemma closed_shiftpath:
- assumes "pathfinish g = pathstart g" "a \<in> {0..1}"
- shows "pathfinish(shiftpath a g) = pathstart(shiftpath a g)"
- using endpoints_shiftpath[OF assms] by auto
-
-lemma path_shiftpath:
- assumes "path g" "pathfinish g = pathstart g" "a \<in> {0..1}"
- shows "path(shiftpath a g)" proof-
- have *:"{0 .. 1} = {0 .. 1-a} \<union> {1-a .. 1}" using assms(3) by(auto simp add: vector_component_simps)
- have **:"\<And>x. x + a = 1 \<Longrightarrow> g (x + a - 1) = g (x + a)"
- using assms(2)[unfolded pathfinish_def pathstart_def] by auto
- show ?thesis unfolding path_def shiftpath_def * apply(rule continuous_on_union)
- apply(rule closed_interval)+ apply(rule continuous_on_eq[of _ "g \<circ> (\<lambda>x. a + x)"]) prefer 3
- apply(rule continuous_on_eq[of _ "g \<circ> (\<lambda>x. a - 1 + x)"]) defer prefer 3
- apply(rule continuous_on_intros)+ prefer 2 apply(rule continuous_on_intros)+
- apply(rule_tac[1-2] continuous_on_subset[OF assms(1)[unfolded path_def]])
- using assms(3) and ** by(auto simp add:vector_component_simps field_simps Cart_eq) qed
-
-lemma shiftpath_shiftpath: assumes "pathfinish g = pathstart g" "a \<in> {0..1}" "x \<in> {0..1}"
- shows "shiftpath (1 - a) (shiftpath a g) x = g x"
- using assms unfolding pathfinish_def pathstart_def shiftpath_def
- by(auto simp add: vector_component_simps)
-
-lemma path_image_shiftpath:
- assumes "a \<in> {0..1}" "pathfinish g = pathstart g"
- shows "path_image(shiftpath a g) = path_image g" proof-
- { 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)"
- hence "\<exists>y\<in>{0..1} \<inter> {x. a $ 1 + x $ 1 \<le> 1}. g x = g (a + y)" proof(cases "a \<le> x")
- case False thus ?thesis apply(rule_tac x="1 + x - a" in bexI)
- using as(1,2) and as(3)[THEN bspec[where x="1 + x - a"]] and assms(1)
- by(auto simp add:vector_component_simps field_simps atomize_not) next
- case True thus ?thesis using as(1-2) and assms(1) apply(rule_tac x="x - a" in bexI)
- by(auto simp add:vector_component_simps field_simps) qed }
- thus ?thesis using assms unfolding shiftpath_def path_image_def pathfinish_def pathstart_def
- by(auto simp add:vector_component_simps image_iff) qed
-
-subsection {* Special case of straight-line paths. *}
-
-definition
- linepath :: "real ^ 'n::finite \<Rightarrow> real ^ 'n \<Rightarrow> real ^ 1 \<Rightarrow> real ^ 'n" where
- "linepath a b = (\<lambda>x. (1 - dest_vec1 x) *\<^sub>R a + dest_vec1 x *\<^sub>R b)"
-
-lemma pathstart_linepath[simp]: "pathstart(linepath a b) = a"
- unfolding pathstart_def linepath_def by auto
-
-lemma pathfinish_linepath[simp]: "pathfinish(linepath a b) = b"
- unfolding pathfinish_def linepath_def by auto
-
-lemma continuous_linepath_at[intro]: "continuous (at x) (linepath a b)"
- unfolding linepath_def
- by (intro continuous_intros continuous_dest_vec1)
-
-lemma continuous_on_linepath[intro]: "continuous_on s (linepath a b)"
- using continuous_linepath_at by(auto intro!: continuous_at_imp_continuous_on)
-
-lemma path_linepath[intro]: "path(linepath a b)"
- unfolding path_def by(rule continuous_on_linepath)
-
-lemma path_image_linepath[simp]: "path_image(linepath a b) = (closed_segment a b)"
- unfolding path_image_def segment linepath_def apply (rule set_ext, rule) defer
- unfolding mem_Collect_eq image_iff apply(erule exE) apply(rule_tac x="u *\<^sub>R 1" in bexI)
- by(auto simp add:vector_component_simps)
-
-lemma reversepath_linepath[simp]: "reversepath(linepath a b) = linepath b a"
- unfolding reversepath_def linepath_def by(rule ext, auto simp add:vector_component_simps)
-
-lemma injective_path_linepath: assumes "a \<noteq> b" shows "injective_path(linepath a b)" proof-
- { obtain i where i:"a$i \<noteq> b$i" using assms[unfolded Cart_eq] by auto
- 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"
- 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)
- hence "x = y" unfolding mult_cancel_right Cart_eq using i(1) by(auto simp add:field_simps) }
- thus ?thesis unfolding injective_path_def linepath_def by(auto simp add:vector_component_simps algebra_simps) qed
-
-lemma simple_path_linepath[intro]: "a \<noteq> b \<Longrightarrow> simple_path(linepath a b)" by(auto intro!: injective_imp_simple_path injective_path_linepath)
-
-subsection {* Bounding a point away from a path. *}
-
-lemma not_on_path_ball: assumes "path g" "z \<notin> path_image g"
- shows "\<exists>e>0. ball z e \<inter> (path_image g) = {}" proof-
- obtain a where "a\<in>path_image g" "\<forall>y\<in>path_image g. dist z a \<le> dist z y"
- using distance_attains_inf[OF _ path_image_nonempty, of g z]
- using compact_path_image[THEN compact_imp_closed, OF assms(1)] by auto
- thus ?thesis apply(rule_tac x="dist z a" in exI) using assms(2) by(auto intro!: dist_pos_lt) qed
-
-lemma not_on_path_cball: assumes "path g" "z \<notin> path_image g"
- shows "\<exists>e>0. cball z e \<inter> (path_image g) = {}" proof-
- obtain e where "ball z e \<inter> path_image g = {}" "e>0" using not_on_path_ball[OF assms] by auto
- moreover have "cball z (e/2) \<subseteq> ball z e" using `e>0` by auto
- ultimately show ?thesis apply(rule_tac x="e/2" in exI) by auto qed
-
-subsection {* Path component, considered as a "joinability" relation (from Tom Hales). *}
-
-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)"
-
-lemmas path_defs = path_def pathstart_def pathfinish_def path_image_def path_component_def
-
-lemma path_component_mem: assumes "path_component s x y" shows "x \<in> s" "y \<in> s"
- using assms unfolding path_defs by auto
-
-lemma path_component_refl: assumes "x \<in> s" shows "path_component s x x"
- unfolding path_defs apply(rule_tac x="\<lambda>u. x" in exI) using assms
- by(auto intro!:continuous_on_intros)
-
-lemma path_component_refl_eq: "path_component s x x \<longleftrightarrow> x \<in> s"
- by(auto intro!: path_component_mem path_component_refl)
-
-lemma path_component_sym: "path_component s x y \<Longrightarrow> path_component s y x"
- using assms unfolding path_component_def apply(erule exE) apply(rule_tac x="reversepath g" in exI)
- by(auto simp add: reversepath_simps)
-
-lemma path_component_trans: assumes "path_component s x y" "path_component s y z" shows "path_component s x z"
- 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)
-
-lemma path_component_of_subset: "s \<subseteq> t \<Longrightarrow> path_component s x y \<Longrightarrow> path_component t x y"
- unfolding path_component_def by auto
-
-subsection {* Can also consider it as a set, as the name suggests. *}
-
-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 )}"
- apply(rule set_ext) unfolding mem_Collect_eq unfolding mem_def path_component_def by auto
-
-lemma mem_path_component_set:"x \<in> path_component s y \<longleftrightarrow> path_component s y x" unfolding mem_def by auto
-
-lemma path_component_subset: "(path_component s x) \<subseteq> s"
- apply(rule, rule path_component_mem(2)) by(auto simp add:mem_def)
-
-lemma path_component_eq_empty: "path_component s x = {} \<longleftrightarrow> x \<notin> s"
- apply rule apply(drule equals0D[of _ x]) defer apply(rule equals0I) unfolding mem_path_component_set
- apply(drule path_component_mem(1)) using path_component_refl by auto
-
-subsection {* Path connectedness of a space. *}
-
-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)"
-
-lemma path_connected_component: "path_connected s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. path_component s x y)"
- unfolding path_connected_def path_component_def by auto
-
-lemma path_connected_component_set: "path_connected s \<longleftrightarrow> (\<forall>x\<in>s. path_component s x = s)"
- unfolding path_connected_component apply(rule, rule, rule, rule path_component_subset)
- unfolding subset_eq mem_path_component_set Ball_def mem_def by auto
-
-subsection {* Some useful lemmas about path-connectedness. *}
-
-lemma convex_imp_path_connected: assumes "convex s" shows "path_connected s"
- unfolding path_connected_def apply(rule,rule,rule_tac x="linepath x y" in exI)
- unfolding path_image_linepath using assms[unfolded convex_contains_segment] by auto
-
-lemma path_connected_imp_connected: assumes "path_connected s" shows "connected s"
- unfolding connected_def not_ex apply(rule,rule,rule ccontr) unfolding not_not apply(erule conjE)+ proof-
- fix e1 e2 assume as:"open e1" "open e2" "s \<subseteq> e1 \<union> e2" "e1 \<inter> e2 \<inter> s = {}" "e1 \<inter> s \<noteq> {}" "e2 \<inter> s \<noteq> {}"
- then obtain x1 x2 where obt:"x1\<in>e1\<inter>s" "x2\<in>e2\<inter>s" by auto
- then obtain g where g:"path g" "path_image g \<subseteq> s" "pathstart g = x1" "pathfinish g = x2"
- using assms[unfolded path_connected_def,rule_format,of x1 x2] by auto
- have *:"connected {0..1::real^1}" by(auto intro!: convex_connected convex_interval)
- have "{0..1} \<subseteq> {x \<in> {0..1}. g x \<in> e1} \<union> {x \<in> {0..1}. g x \<in> e2}" using as(3) g(2)[unfolded path_defs] by blast
- moreover have "{x \<in> {0..1}. g x \<in> e1} \<inter> {x \<in> {0..1}. g x \<in> e2} = {}" using as(4) g(2)[unfolded path_defs] unfolding subset_eq by auto
- moreover have "{x \<in> {0..1}. g x \<in> e1} \<noteq> {} \<and> {x \<in> {0..1}. g x \<in> e2} \<noteq> {}" using g(3,4)[unfolded path_defs] using obt by(auto intro!: exI)
- 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}"]
- using continuous_open_in_preimage[OF g(1)[unfolded path_def] as(1)]
- using continuous_open_in_preimage[OF g(1)[unfolded path_def] as(2)] by auto qed
-
-lemma open_path_component: assumes "open s" shows "open(path_component s x)"
- unfolding open_contains_ball proof
- fix y assume as:"y \<in> path_component s x"
- hence "y\<in>s" apply- apply(rule path_component_mem(2)) unfolding mem_def by auto
- then obtain e where e:"e>0" "ball y e \<subseteq> s" using assms[unfolded open_contains_ball] by auto
- 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-
- fix z assume "dist y z < e" thus "path_component s x z" apply(rule_tac path_component_trans[of _ _ y]) defer
- 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`
- using as[unfolded mem_def] by auto qed qed
-
-lemma open_non_path_component: assumes "open s" shows "open(s - path_component s x)" unfolding open_contains_ball proof
- fix y assume as:"y\<in>s - path_component s x"
- then obtain e where e:"e>0" "ball y e \<subseteq> s" using assms[unfolded open_contains_ball] by auto
- 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)
- fix z assume "z\<in>ball y e" "\<not> z \<notin> path_component s x"
- hence "y \<in> path_component s x" unfolding not_not mem_path_component_set using `e>0`
- apply- apply(rule path_component_trans,assumption) apply(rule path_component_of_subset[OF e(2)])
- apply(rule convex_imp_path_connected[OF convex_ball, unfolded path_connected_component, rule_format]) by auto
- thus False using as by auto qed(insert e(2), auto) qed
-
-lemma connected_open_path_connected: assumes "open s" "connected s" shows "path_connected s"
- unfolding path_connected_component_set proof(rule,rule,rule path_component_subset, rule)
- fix x y assume "x \<in> s" "y \<in> s" show "y \<in> path_component s x" proof(rule ccontr)
- assume "y \<notin> path_component s x" moreover
- have "path_component s x \<inter> s \<noteq> {}" using `x\<in>s` path_component_eq_empty path_component_subset[of s x] by auto
- ultimately show False using `y\<in>s` open_non_path_component[OF assms(1)] open_path_component[OF assms(1)]
- using assms(2)[unfolded connected_def not_ex, rule_format, of"path_component s x" "s - path_component s x"] by auto
-qed qed
-
-lemma path_connected_continuous_image:
- assumes "continuous_on s f" "path_connected s" shows "path_connected (f ` s)"
- unfolding path_connected_def proof(rule,rule)
- fix x' y' assume "x' \<in> f ` s" "y' \<in> f ` s"
- then obtain x y where xy:"x\<in>s" "y\<in>s" "x' = f x" "y' = f y" by auto
- guess g using assms(2)[unfolded path_connected_def,rule_format,OF xy(1,2)] ..
- thus "\<exists>g. path g \<and> path_image g \<subseteq> f ` s \<and> pathstart g = x' \<and> pathfinish g = y'"
- unfolding xy apply(rule_tac x="f \<circ> g" in exI) unfolding path_defs
- using assms(1) by(auto intro!: continuous_on_compose continuous_on_subset[of _ _ "g ` {0..1}"]) qed
-
-lemma homeomorphic_path_connectedness:
- "s homeomorphic t \<Longrightarrow> (path_connected s \<longleftrightarrow> path_connected t)"
- unfolding homeomorphic_def homeomorphism_def apply(erule exE|erule conjE)+ apply rule
- apply(drule_tac f=f in path_connected_continuous_image) prefer 3
- apply(drule_tac f=g in path_connected_continuous_image) by auto
-
-lemma path_connected_empty: "path_connected {}"
- unfolding path_connected_def by auto
-
-lemma path_connected_singleton: "path_connected {a}"
- unfolding path_connected_def apply(rule,rule)
- apply(rule_tac x="linepath a a" in exI) by(auto simp add:segment scaleR_left_diff_distrib)
-
-lemma path_connected_Un: assumes "path_connected s" "path_connected t" "s \<inter> t \<noteq> {}"
- shows "path_connected (s \<union> t)" unfolding path_connected_component proof(rule,rule)
- fix x y assume as:"x \<in> s \<union> t" "y \<in> s \<union> t"
- from assms(3) obtain z where "z \<in> s \<inter> t" by auto
- thus "path_component (s \<union> t) x y" using as using assms(1-2)[unfolded path_connected_component] apply-
- apply(erule_tac[!] UnE)+ apply(rule_tac[2-3] path_component_trans[of _ _ z])
- by(auto simp add:path_component_of_subset [OF Un_upper1] path_component_of_subset[OF Un_upper2]) qed
-
-subsection {* sphere is path-connected. *}
-
-lemma path_connected_punctured_universe:
- assumes "2 \<le> CARD('n::finite)" shows "path_connected((UNIV::(real^'n::finite) set) - {a})" proof-
- 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
- let ?U = "UNIV::(real^'n) set" let ?u = "?U - {0}"
- let ?basis = "\<lambda>k. basis (\<psi> k)"
- let ?A = "\<lambda>k. {x::real^'n. \<exists>i\<in>{1..k}. inner (basis (\<psi> i)) x \<noteq> 0}"
- have "\<forall>k\<in>{2..CARD('n)}. path_connected (?A k)" proof
- 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
- apply(erule UnE)+ unfolding mem_Collect_eq apply(rule_tac[1-2] x="Suc k" in bexI)
- by(auto elim!: ballE simp add: not_less le_Suc_eq)
- fix k assume "k \<in> {2..CARD('n)}" thus "path_connected (?A k)" proof(induct k)
- case (Suc k) show ?case proof(cases "k = 1")
- case False from Suc have d:"k \<in> {1..CARD('n)}" "Suc k \<in> {1..CARD('n)}" by auto
- 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
- hence **:"?basis k + ?basis (Suc k) \<in> {x. 0 < inner (?basis (Suc k)) x} \<inter> (?A k)"
- "?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
- by(auto simp add: inner_basis vector_component_simps intro!:bexI[where x=k])
- show ?thesis unfolding * Un_assoc apply(rule path_connected_Un) defer apply(rule path_connected_Un)
- prefer 5 apply(rule_tac[1-2] convex_imp_path_connected, rule convex_halfspace_lt, rule convex_halfspace_gt)
- apply(rule Suc(1)) apply(rule_tac[2-3] ccontr) using d ** False by auto
- next case True hence d:"1\<in>{1..CARD('n)}" "2\<in>{1..CARD('n)}" using Suc(2) by auto
- have ***:"Suc 1 = 2" by auto
- 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
- 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
- thus ?thesis unfolding * True unfolding ** neq_iff bex_disj_distrib apply -
- apply(rule path_connected_Un, rule_tac[1-2] path_connected_Un) defer 3 apply(rule_tac[1-4] convex_imp_path_connected)
- apply(rule_tac[5] x=" ?basis 1 + ?basis 2" in nequals0I)
- apply(rule_tac[6] x="-?basis 1 + ?basis 2" in nequals0I)
- apply(rule_tac[7] x="-?basis 1 - ?basis 2" in nequals0I)
- using d unfolding *** by(auto intro!: convex_halfspace_gt convex_halfspace_lt, auto simp add:vector_component_simps inner_basis)
- qed qed auto qed note lem = this
-
- 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)"
- apply rule apply(erule bexE) apply(rule_tac x="\<psi> i" in exI) defer apply(erule exE) proof-
- fix x::"real^'n" and i assume as:"inner (basis i) x \<noteq> 0"
- have "i\<in>\<psi> ` {1..CARD('n)}" using \<psi>[unfolded bij_betw_def, THEN conjunct2] by auto
- then obtain j where "j\<in>{1..CARD('n)}" "\<psi> j = i" by auto
- 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
- have *:"?U - {a} = (\<lambda>x. x + a) ` {x. x \<noteq> 0}" apply(rule set_ext) unfolding image_iff
- apply rule apply(rule_tac x="x - a" in bexI) by auto
- 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)
- show ?thesis unfolding * apply(rule path_connected_continuous_image) apply(rule continuous_on_intros)+
- unfolding ** apply(rule lem[THEN bspec[where x="CARD('n)"], unfolded ***]) using assms by auto qed
-
-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")
- case True thus ?thesis proof(cases "r=0")
- case False hence "{x::real^'n. norm(x - a) = r} = {}" using True by auto
- thus ?thesis using path_connected_empty by auto
- qed(auto intro!:path_connected_singleton) next
- 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)
- 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)
- have **:"{x::real^'n. norm x = 1} = (\<lambda>x. (1/norm x) *\<^sub>R x) ` (UNIV - {0})" apply(rule set_ext,rule)
- unfolding image_iff apply(rule_tac x=x in bexI) unfolding mem_Collect_eq by(auto split:split_if_asm)
- have "continuous_on (UNIV - {0}) (\<lambda>x::real^'n. 1 / norm x)" unfolding o_def continuous_on_eq_continuous_within
- apply(rule, rule continuous_at_within_inv[unfolded o_def inverse_eq_divide]) apply(rule continuous_at_within)
- apply(rule continuous_at_norm[unfolded o_def]) by auto
- thus ?thesis unfolding * ** using path_connected_punctured_universe[OF assms]
- by(auto intro!: path_connected_continuous_image continuous_on_intros continuous_on_mul) qed
-
-lemma connected_sphere: "2 \<le> CARD('n) \<Longrightarrow> connected {x::real^'n::finite. norm(x - a) = r}"
- using path_connected_sphere path_connected_imp_connected by auto
-
-(** In continuous_at_vec1_norm : Use \<And> instead of \<forall>. **)
-
-end
--- a/src/HOL/Library/Determinants.thy Fri Oct 23 14:33:07 2009 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1087 +0,0 @@
-(* Title: Determinants
- Author: Amine Chaieb, University of Cambridge
-*)
-
-header {* Traces, Determinant of square matrices and some properties *}
-
-theory Determinants
-imports Euclidean_Space Permutations
-begin
-
-subsection{* First some facts about products*}
-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)"
-apply clarsimp
-by(subgoal_tac "insert a A = A", auto)
-
-lemma setprod_add_split:
- assumes mn: "(m::nat) <= n + 1"
- shows "setprod f {m.. n+p} = setprod f {m .. n} * setprod f {n+1..n+p}"
-proof-
- let ?A = "{m .. n+p}"
- let ?B = "{m .. n}"
- let ?C = "{n+1..n+p}"
- from mn have un: "?B \<union> ?C = ?A" by auto
- from mn have dj: "?B \<inter> ?C = {}" by auto
- have f: "finite ?B" "finite ?C" by simp_all
- from setprod_Un_disjoint[OF f dj, of f, unfolded un] show ?thesis .
-qed
-
-
-lemma setprod_offset: "setprod f {(m::nat) + p .. n + p} = setprod (\<lambda>i. f (i + p)) {m..n}"
-apply (rule setprod_reindex_cong[where f="op + p"])
-apply (auto simp add: image_iff Bex_def inj_on_def)
-apply arith
-apply (rule ext)
-apply (simp add: add_commute)
-done
-
-lemma setprod_singleton: "setprod f {x} = f x" by simp
-
-lemma setprod_singleton_nat_seg: "setprod f {n..n} = f (n::'a::order)" by simp
-
-lemma setprod_numseg: "setprod f {m..0} = (if m=0 then f 0 else 1)"
- "setprod f {m .. Suc n} = (if m \<le> Suc n then f (Suc n) * setprod f {m..n}
- else setprod f {m..n})"
- by (auto simp add: atLeastAtMostSuc_conv)
-
-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)"
- shows "setprod f S \<le> setprod g S"
-using fS fg
-apply(induct S)
-apply simp
-apply auto
-apply (rule mult_mono)
-apply (auto intro: setprod_nonneg)
-done
-
- (* FIXME: In Finite_Set there is a useless further assumption *)
-lemma setprod_inversef: "finite A ==> setprod (inverse \<circ> f) A = (inverse (setprod f A) :: 'a:: {division_by_zero, field})"
- apply (erule finite_induct)
- apply (simp)
- apply simp
- done
-
-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)"
- shows "setprod f S \<le> 1"
-using setprod_le[OF fS f] unfolding setprod_1 .
-
-subsection{* Trace *}
-
-definition trace :: "'a::semiring_1^'n^'n \<Rightarrow> 'a" where
- "trace A = setsum (\<lambda>i. ((A$i)$i)) (UNIV::'n set)"
-
-lemma trace_0: "trace(mat 0) = 0"
- by (simp add: trace_def mat_def)
-
-lemma trace_I: "trace(mat 1 :: 'a::semiring_1^'n^'n) = of_nat(CARD('n))"
- by (simp add: trace_def mat_def)
-
-lemma trace_add: "trace ((A::'a::comm_semiring_1^'n^'n) + B) = trace A + trace B"
- by (simp add: trace_def setsum_addf)
-
-lemma trace_sub: "trace ((A::'a::comm_ring_1^'n^'n) - B) = trace A - trace B"
- by (simp add: trace_def setsum_subtractf)
-
-lemma trace_mul_sym:"trace ((A::'a::comm_semiring_1^'n^'n) ** B) = trace (B**A)"
- apply (simp add: trace_def matrix_matrix_mult_def)
- apply (subst setsum_commute)
- by (simp add: mult_commute)
-
-(* ------------------------------------------------------------------------- *)
-(* Definition of determinant. *)
-(* ------------------------------------------------------------------------- *)
-
-definition det:: "'a::comm_ring_1^'n^'n \<Rightarrow> 'a" where
- "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)}"
-
-(* ------------------------------------------------------------------------- *)
-(* A few general lemmas we need below. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma setprod_permute:
- assumes p: "p permutes S"
- shows "setprod f S = setprod (f o p) S"
-proof-
- {assume "\<not> finite S" hence ?thesis by simp}
- moreover
- {assume fS: "finite S"
- then have ?thesis
- apply (simp add: setprod_def cong del:strong_setprod_cong)
- apply (rule ab_semigroup_mult.fold_image_permute)
- apply (auto simp add: p)
- apply unfold_locales
- done}
- ultimately show ?thesis by blast
-qed
-
-lemma setproduct_permute_nat_interval: "p permutes {m::nat .. n} ==> setprod f {m..n} = setprod (f o p) {m..n}"
- by (blast intro!: setprod_permute)
-
-(* ------------------------------------------------------------------------- *)
-(* Basic determinant properties. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma det_transp: "det (transp A) = det (A::'a::comm_ring_1 ^'n^'n::finite)"
-proof-
- let ?di = "\<lambda>A i j. A$i$j"
- let ?U = "(UNIV :: 'n set)"
- have fU: "finite ?U" by simp
- {fix p assume p: "p \<in> {p. p permutes ?U}"
- from p have pU: "p permutes ?U" by blast
- have sth: "sign (inv p) = sign p"
- by (metis sign_inverse fU p mem_def Collect_def permutation_permutes)
- from permutes_inj[OF pU]
- have pi: "inj_on p ?U" by (blast intro: subset_inj_on)
- from permutes_image[OF pU]
- 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
- also have "\<dots> = setprod ((\<lambda>i. ?di (transp A) i (inv p i)) o p) ?U"
- unfolding setprod_reindex[OF pi] ..
- also have "\<dots> = setprod (\<lambda>i. ?di A i (p i)) ?U"
- proof-
- {fix i assume i: "i \<in> ?U"
- from i permutes_inv_o[OF pU] permutes_in_image[OF pU]
- have "((\<lambda>i. ?di (transp A) i (inv p i)) o p) i = ?di A i (p i)"
- unfolding transp_def by (simp add: expand_fun_eq)}
- 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)
- qed
- 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
- by simp}
- then show ?thesis unfolding det_def apply (subst setsum_permutations_inverse)
- apply (rule setsum_cong2) by blast
-qed
-
-lemma det_lowerdiagonal:
- fixes A :: "'a::comm_ring_1^'n^'n::{finite,wellorder}"
- assumes ld: "\<And>i j. i < j \<Longrightarrow> A$i$j = 0"
- shows "det A = setprod (\<lambda>i. A$i$i) (UNIV:: 'n set)"
-proof-
- let ?U = "UNIV:: 'n set"
- let ?PU = "{p. p permutes ?U}"
- let ?pp = "\<lambda>p. of_int (sign p) * setprod (\<lambda>i. A$i$p i) (UNIV :: 'n set)"
- have fU: "finite ?U" by simp
- from finite_permutations[OF fU] have fPU: "finite ?PU" .
- have id0: "{id} \<subseteq> ?PU" by (auto simp add: permutes_id)
- {fix p assume p: "p \<in> ?PU -{id}"
- from p have pU: "p permutes ?U" and pid: "p \<noteq> id" by blast+
- from permutes_natset_le[OF pU] pid obtain i where
- i: "p i > i" by (metis not_le)
- from ld[OF i] have ex:"\<exists>i \<in> ?U. A$i$p i = 0" by blast
- from setprod_zero[OF fU ex] have "?pp p = 0" by simp}
- then have p0: "\<forall>p \<in> ?PU -{id}. ?pp p = 0" by blast
- from setsum_mono_zero_cong_left[OF fPU id0 p0] show ?thesis
- unfolding det_def by (simp add: sign_id)
-qed
-
-lemma det_upperdiagonal:
- fixes A :: "'a::comm_ring_1^'n^'n::{finite,wellorder}"
- assumes ld: "\<And>i j. i > j \<Longrightarrow> A$i$j = 0"
- shows "det A = setprod (\<lambda>i. A$i$i) (UNIV:: 'n set)"
-proof-
- let ?U = "UNIV:: 'n set"
- let ?PU = "{p. p permutes ?U}"
- let ?pp = "(\<lambda>p. of_int (sign p) * setprod (\<lambda>i. A$i$p i) (UNIV :: 'n set))"
- have fU: "finite ?U" by simp
- from finite_permutations[OF fU] have fPU: "finite ?PU" .
- have id0: "{id} \<subseteq> ?PU" by (auto simp add: permutes_id)
- {fix p assume p: "p \<in> ?PU -{id}"
- from p have pU: "p permutes ?U" and pid: "p \<noteq> id" by blast+
- from permutes_natset_ge[OF pU] pid obtain i where
- i: "p i < i" by (metis not_le)
- from ld[OF i] have ex:"\<exists>i \<in> ?U. A$i$p i = 0" by blast
- from setprod_zero[OF fU ex] have "?pp p = 0" by simp}
- then have p0: "\<forall>p \<in> ?PU -{id}. ?pp p = 0" by blast
- from setsum_mono_zero_cong_left[OF fPU id0 p0] show ?thesis
- unfolding det_def by (simp add: sign_id)
-qed
-
-lemma det_diagonal:
- fixes A :: "'a::comm_ring_1^'n^'n::finite"
- assumes ld: "\<And>i j. i \<noteq> j \<Longrightarrow> A$i$j = 0"
- shows "det A = setprod (\<lambda>i. A$i$i) (UNIV::'n set)"
-proof-
- let ?U = "UNIV:: 'n set"
- let ?PU = "{p. p permutes ?U}"
- let ?pp = "\<lambda>p. of_int (sign p) * setprod (\<lambda>i. A$i$p i) (UNIV :: 'n set)"
- have fU: "finite ?U" by simp
- from finite_permutations[OF fU] have fPU: "finite ?PU" .
- have id0: "{id} \<subseteq> ?PU" by (auto simp add: permutes_id)
- {fix p assume p: "p \<in> ?PU - {id}"
- then have "p \<noteq> id" by simp
- then obtain i where i: "p i \<noteq> i" unfolding expand_fun_eq by auto
- from ld [OF i [symmetric]] have ex:"\<exists>i \<in> ?U. A$i$p i = 0" by blast
- from setprod_zero [OF fU ex] have "?pp p = 0" by simp}
- then have p0: "\<forall>p \<in> ?PU - {id}. ?pp p = 0" by blast
- from setsum_mono_zero_cong_left[OF fPU id0 p0] show ?thesis
- unfolding det_def by (simp add: sign_id)
-qed
-
-lemma det_I: "det (mat 1 :: 'a::comm_ring_1^'n^'n::finite) = 1"
-proof-
- let ?A = "mat 1 :: 'a::comm_ring_1^'n^'n"
- let ?U = "UNIV :: 'n set"
- let ?f = "\<lambda>i j. ?A$i$j"
- {fix i assume i: "i \<in> ?U"
- have "?f i i = 1" using i by (vector mat_def)}
- hence th: "setprod (\<lambda>i. ?f i i) ?U = setprod (\<lambda>x. 1) ?U"
- by (auto intro: setprod_cong)
- {fix i j assume i: "i \<in> ?U" and j: "j \<in> ?U" and ij: "i \<noteq> j"
- have "?f i j = 0" using i j ij by (vector mat_def) }
- then have "det ?A = setprod (\<lambda>i. ?f i i) ?U" using det_diagonal
- by blast
- also have "\<dots> = 1" unfolding th setprod_1 ..
- finally show ?thesis .
-qed
-
-lemma det_0: "det (mat 0 :: 'a::comm_ring_1^'n^'n::finite) = 0"
- by (simp add: det_def setprod_zero)
-
-lemma det_permute_rows:
- fixes A :: "'a::comm_ring_1^'n^'n::finite"
- assumes p: "p permutes (UNIV :: 'n::finite set)"
- shows "det(\<chi> i. A$p i :: 'a^'n^'n) = of_int (sign p) * det A"
- apply (simp add: det_def setsum_right_distrib mult_assoc[symmetric])
- apply (subst sum_permutations_compose_right[OF p])
-proof(rule setsum_cong2)
- let ?U = "UNIV :: 'n set"
- let ?PU = "{p. p permutes ?U}"
- fix q assume qPU: "q \<in> ?PU"
- have fU: "finite ?U" by simp
- from qPU have q: "q permutes ?U" by blast
- from p q have pp: "permutation p" and qp: "permutation q"
- by (metis fU permutation_permutes)+
- from permutes_inv[OF p] have ip: "inv p permutes ?U" .
- 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"
- by (simp only: setprod_permute[OF ip, symmetric])
- also have "\<dots> = setprod (\<lambda>i. A $ (p o inv p) i $ (q o (p o inv p)) i) ?U"
- by (simp only: o_def)
- also have "\<dots> = setprod (\<lambda>i. A$i$q i) ?U" by (simp only: o_def permutes_inverses[OF p])
- finally have thp: "setprod (\<lambda>i. A$p i$ (q o p) i) ?U = setprod (\<lambda>i. A$i$q i) ?U"
- by blast
- 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"
- by (simp only: thp sign_compose[OF qp pp] mult_commute of_int_mult)
-qed
-
-lemma det_permute_columns:
- fixes A :: "'a::comm_ring_1^'n^'n::finite"
- assumes p: "p permutes (UNIV :: 'n set)"
- shows "det(\<chi> i j. A$i$ p j :: 'a^'n^'n) = of_int (sign p) * det A"
-proof-
- let ?Ap = "\<chi> i j. A$i$ p j :: 'a^'n^'n"
- let ?At = "transp A"
- have "of_int (sign p) * det A = det (transp (\<chi> i. transp A $ p i))"
- unfolding det_permute_rows[OF p, of ?At] det_transp ..
- moreover
- have "?Ap = transp (\<chi> i. transp A $ p i)"
- by (simp add: transp_def Cart_eq)
- ultimately show ?thesis by simp
-qed
-
-lemma det_identical_rows:
- fixes A :: "'a::ordered_idom^'n^'n::finite"
- assumes ij: "i \<noteq> j"
- and r: "row i A = row j A"
- shows "det A = 0"
-proof-
- have tha: "\<And>(a::'a) b. a = b ==> b = - a ==> a = 0"
- by simp
- have th1: "of_int (-1) = - 1" by (metis of_int_1 of_int_minus number_of_Min)
- let ?p = "Fun.swap i j id"
- let ?A = "\<chi> i. A $ ?p i"
- from r have "A = ?A" by (simp add: Cart_eq row_def swap_def)
- hence "det A = det ?A" by simp
- moreover have "det A = - det ?A"
- by (simp add: det_permute_rows[OF permutes_swap_id] sign_swap_id ij th1)
- ultimately show "det A = 0" by (metis tha)
-qed
-
-lemma det_identical_columns:
- fixes A :: "'a::ordered_idom^'n^'n::finite"
- assumes ij: "i \<noteq> j"
- and r: "column i A = column j A"
- shows "det A = 0"
-apply (subst det_transp[symmetric])
-apply (rule det_identical_rows[OF ij])
-by (metis row_transp r)
-
-lemma det_zero_row:
- fixes A :: "'a::{idom, ring_char_0}^'n^'n::finite"
- assumes r: "row i A = 0"
- shows "det A = 0"
-using r
-apply (simp add: row_def det_def Cart_eq)
-apply (rule setsum_0')
-apply (auto simp: sign_nz)
-done
-
-lemma det_zero_column:
- fixes A :: "'a::{idom,ring_char_0}^'n^'n::finite"
- assumes r: "column i A = 0"
- shows "det A = 0"
- apply (subst det_transp[symmetric])
- apply (rule det_zero_row [of i])
- by (metis row_transp r)
-
-lemma det_row_add:
- fixes a b c :: "'n::finite \<Rightarrow> _ ^ 'n"
- shows "det((\<chi> i. if i = k then a i + b i else c i)::'a::comm_ring_1^'n^'n) =
- det((\<chi> i. if i = k then a i else c i)::'a::comm_ring_1^'n^'n) +
- det((\<chi> i. if i = k then b i else c i)::'a::comm_ring_1^'n^'n)"
-unfolding det_def Cart_lambda_beta setsum_addf[symmetric]
-proof (rule setsum_cong2)
- let ?U = "UNIV :: 'n set"
- let ?pU = "{p. p permutes ?U}"
- let ?f = "(\<lambda>i. if i = k then a i + b i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
- let ?g = "(\<lambda> i. if i = k then a i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
- let ?h = "(\<lambda> i. if i = k then b i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
- fix p assume p: "p \<in> ?pU"
- let ?Uk = "?U - {k}"
- from p have pU: "p permutes ?U" by blast
- have kU: "?U = insert k ?Uk" by blast
- {fix j assume j: "j \<in> ?Uk"
- from j have "?f j $ p j = ?g j $ p j" and "?f j $ p j= ?h j $ p j"
- by simp_all}
- then have th1: "setprod (\<lambda>i. ?f i $ p i) ?Uk = setprod (\<lambda>i. ?g i $ p i) ?Uk"
- and th2: "setprod (\<lambda>i. ?f i $ p i) ?Uk = setprod (\<lambda>i. ?h i $ p i) ?Uk"
- apply -
- apply (rule setprod_cong, simp_all)+
- done
- have th3: "finite ?Uk" "k \<notin> ?Uk" by auto
- have "setprod (\<lambda>i. ?f i $ p i) ?U = setprod (\<lambda>i. ?f i $ p i) (insert k ?Uk)"
- unfolding kU[symmetric] ..
- also have "\<dots> = ?f k $ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk"
- apply (rule setprod_insert)
- apply simp
- by blast
- 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)
- 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)
- also have "\<dots> = setprod (\<lambda>i. ?g i $ p i) (insert k ?Uk) + setprod (\<lambda>i. ?h i $ p i) (insert k ?Uk)"
- unfolding setprod_insert[OF th3] by simp
- 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] .
- 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"
- by (simp add: ring_simps)
-qed
-
-lemma det_row_mul:
- fixes a b :: "'n::finite \<Rightarrow> _ ^ 'n"
- shows "det((\<chi> i. if i = k then c *s a i else b i)::'a::comm_ring_1^'n^'n) =
- c* det((\<chi> i. if i = k then a i else b i)::'a::comm_ring_1^'n^'n)"
-
-unfolding det_def Cart_lambda_beta setsum_right_distrib
-proof (rule setsum_cong2)
- let ?U = "UNIV :: 'n set"
- let ?pU = "{p. p permutes ?U}"
- let ?f = "(\<lambda>i. if i = k then c*s a i else b i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
- let ?g = "(\<lambda> i. if i = k then a i else b i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
- fix p assume p: "p \<in> ?pU"
- let ?Uk = "?U - {k}"
- from p have pU: "p permutes ?U" by blast
- have kU: "?U = insert k ?Uk" by blast
- {fix j assume j: "j \<in> ?Uk"
- from j have "?f j $ p j = ?g j $ p j" by simp}
- then have th1: "setprod (\<lambda>i. ?f i $ p i) ?Uk = setprod (\<lambda>i. ?g i $ p i) ?Uk"
- apply -
- apply (rule setprod_cong, simp_all)
- done
- have th3: "finite ?Uk" "k \<notin> ?Uk" by auto
- have "setprod (\<lambda>i. ?f i $ p i) ?U = setprod (\<lambda>i. ?f i $ p i) (insert k ?Uk)"
- unfolding kU[symmetric] ..
- also have "\<dots> = ?f k $ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk"
- apply (rule setprod_insert)
- apply simp
- by blast
- also have "\<dots> = (c*s a k) $ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk" by (simp add: ring_simps)
- also have "\<dots> = c* (a k $ p k * setprod (\<lambda>i. ?g i $ p i) ?Uk)"
- unfolding th1 by (simp add: mult_ac)
- also have "\<dots> = c* (setprod (\<lambda>i. ?g i $ p i) (insert k ?Uk))"
- unfolding setprod_insert[OF th3] by simp
- finally have "setprod (\<lambda>i. ?f i $ p i) ?U = c* (setprod (\<lambda>i. ?g i $ p i) ?U)" unfolding kU[symmetric] .
- 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)"
- by (simp add: ring_simps)
-qed
-
-lemma det_row_0:
- fixes b :: "'n::finite \<Rightarrow> _ ^ 'n"
- shows "det((\<chi> i. if i = k then 0 else b i)::'a::comm_ring_1^'n^'n) = 0"
-using det_row_mul[of k 0 "\<lambda>i. 1" b]
-apply (simp)
- unfolding vector_smult_lzero .
-
-lemma det_row_operation:
- fixes A :: "'a::ordered_idom^'n^'n::finite"
- assumes ij: "i \<noteq> j"
- shows "det (\<chi> k. if k = i then row i A + c *s row j A else row k A) = det A"
-proof-
- let ?Z = "(\<chi> k. if k = i then row j A else row k A) :: 'a ^'n^'n"
- have th: "row i ?Z = row j ?Z" by (vector row_def)
- have th2: "((\<chi> k. if k = i then row i A else row k A) :: 'a^'n^'n) = A"
- by (vector row_def)
- show ?thesis
- unfolding det_row_add [of i] det_row_mul[of i] det_identical_rows[OF ij th] th2
- by simp
-qed
-
-lemma det_row_span:
- fixes A :: "'a:: ordered_idom^'n^'n::finite"
- assumes x: "x \<in> span {row j A |j. j \<noteq> i}"
- shows "det (\<chi> k. if k = i then row i A + x else row k A) = det A"
-proof-
- let ?U = "UNIV :: 'n set"
- let ?S = "{row j A |j. j \<noteq> i}"
- let ?d = "\<lambda>x. det (\<chi> k. if k = i then x else row k A)"
- let ?P = "\<lambda>x. ?d (row i A + x) = det A"
- {fix k
-
- have "(if k = i then row i A + 0 else row k A) = row k A" by simp}
- then have P0: "?P 0"
- apply -
- apply (rule cong[of det, OF refl])
- by (vector row_def)
- moreover
- {fix c z y assume zS: "z \<in> ?S" and Py: "?P y"
- from zS obtain j where j: "z = row j A" "i \<noteq> j" by blast
- let ?w = "row i A + y"
- have th0: "row i A + (c*s z + y) = ?w + c*s z" by vector
- have thz: "?d z = 0"
- apply (rule det_identical_rows[OF j(2)])
- using j by (vector row_def)
- have "?d (row i A + (c*s z + y)) = ?d (?w + c*s z)" unfolding th0 ..
- then have "?P (c*s z + y)" unfolding thz Py det_row_mul[of i] det_row_add[of i]
- by simp }
-
- ultimately show ?thesis
- apply -
- apply (rule span_induct_alt[of ?P ?S, OF P0])
- apply blast
- apply (rule x)
- done
-qed
-
-(* ------------------------------------------------------------------------- *)
-(* May as well do this, though it's a bit unsatisfactory since it ignores *)
-(* exact duplicates by considering the rows/columns as a set. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma det_dependent_rows:
- fixes A:: "'a::ordered_idom^'n^'n::finite"
- assumes d: "dependent (rows A)"
- shows "det A = 0"
-proof-
- let ?U = "UNIV :: 'n set"
- from d obtain i where i: "row i A \<in> span (rows A - {row i A})"
- unfolding dependent_def rows_def by blast
- {fix j k assume jk: "j \<noteq> k"
- and c: "row j A = row k A"
- from det_identical_rows[OF jk c] have ?thesis .}
- moreover
- {assume H: "\<And> i j. i \<noteq> j \<Longrightarrow> row i A \<noteq> row j A"
- have th0: "- row i A \<in> span {row j A|j. j \<noteq> i}"
- apply (rule span_neg)
- apply (rule set_rev_mp)
- apply (rule i)
- apply (rule span_mono)
- using H i by (auto simp add: rows_def)
- from det_row_span[OF th0]
- have "det A = det (\<chi> k. if k = i then 0 *s 1 else row k A)"
- unfolding right_minus vector_smult_lzero ..
- with det_row_mul[of i "0::'a" "\<lambda>i. 1"]
- have "det A = 0" by simp}
- ultimately show ?thesis by blast
-qed
-
-lemma det_dependent_columns: assumes d: "dependent(columns (A::'a::ordered_idom^'n^'n::finite))" shows "det A = 0"
-by (metis d det_dependent_rows rows_transp det_transp)
-
-(* ------------------------------------------------------------------------- *)
-(* Multilinearity and the multiplication formula. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma Cart_lambda_cong: "(\<And>x. f x = g x) \<Longrightarrow> (Cart_lambda f::'a^'n) = (Cart_lambda g :: 'a^'n)"
- apply (rule iffD1[OF Cart_lambda_unique]) by vector
-
-lemma det_linear_row_setsum:
- assumes fS: "finite S"
- 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"
-proof(induct rule: finite_induct[OF fS])
- case 1 thus ?case apply simp unfolding setsum_empty det_row_0[of k] ..
-next
- case (2 x F)
- then show ?case by (simp add: det_row_add cong del: if_weak_cong)
-qed
-
-lemma finite_bounded_functions:
- assumes fS: "finite S"
- shows "finite {f. (\<forall>i \<in> {1.. (k::nat)}. f i \<in> S) \<and> (\<forall>i. i \<notin> {1 .. k} \<longrightarrow> f i = i)}"
-proof(induct k)
- case 0
- have th: "{f. \<forall>i. f i = i} = {id}" by (auto intro: ext)
- show ?case by (auto simp add: th)
-next
- case (Suc k)
- let ?f = "\<lambda>(y::nat,g) i. if i = Suc k then y else g i"
- 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)})"
- 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)}"
- apply (auto simp add: image_iff)
- apply (rule_tac x="x (Suc k)" in bexI)
- apply (rule_tac x = "\<lambda>i. if i = Suc k then i else x i" in exI)
- apply (auto intro: ext)
- done
- with finite_imageI[OF finite_cartesian_product[OF fS Suc.hyps(1)], of ?f]
- show ?case by metis
-qed
-
-
-lemma eq_id_iff[simp]: "(\<forall>x. f x = x) = (f = id)" by (auto intro: ext)
-
-lemma det_linear_rows_setsum_lemma:
- assumes fS: "finite S" and fT: "finite T"
- shows "det((\<chi> i. if i \<in> T then setsum (a i) S else c i):: 'a::comm_ring_1^'n^'n::finite) =
- setsum (\<lambda>f. det((\<chi> i. if i \<in> T then a i (f i) else c i)::'a^'n^'n))
- {f. (\<forall>i \<in> T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = i)}"
-using fT
-proof(induct T arbitrary: a c set: finite)
- case empty
- have th0: "\<And>x y. (\<chi> i. if i \<in> {} then x i else y i) = (\<chi> i. y i)" by vector
- from "empty.prems" show ?case unfolding th0 by simp
-next
- case (insert z T a c)
- let ?F = "\<lambda>T. {f. (\<forall>i \<in> T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = i)}"
- let ?h = "\<lambda>(y,g) i. if i = z then y else g i"
- let ?k = "\<lambda>h. (h(z),(\<lambda>i. if i = z then i else h i))"
- 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)"
- let ?c = "\<lambda>i. if i = z then a i j else c i"
- 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
- have thif2: "\<And>a b c d e. (if a then b else if c then d else e) =
- (if c then (if a then b else d) else (if a then b else e))" by simp
- from `z \<notin> T` have nz: "\<And>i. i \<in> T \<Longrightarrow> i = z \<longleftrightarrow> False" by auto
- have "det (\<chi> i. if i \<in> insert z T then setsum (a i) S else c i) =
- det (\<chi> i. if i = z then setsum (a i) S
- else if i \<in> T then setsum (a i) S else c i)"
- unfolding insert_iff thif ..
- also have "\<dots> = (\<Sum>j\<in>S. det (\<chi> i. if i \<in> T then setsum (a i) S
- else if i = z then a i j else c i))"
- unfolding det_linear_row_setsum[OF fS]
- apply (subst thif2)
- using nz by (simp cong del: if_weak_cong cong add: if_cong)
- finally have tha:
- "det (\<chi> i. if i \<in> insert z T then setsum (a i) S else c i) =
- (\<Sum>(j, f)\<in>S \<times> ?F T. det (\<chi> i. if i \<in> T then a i (f i)
- else if i = z then a i j
- else c i))"
- unfolding insert.hyps unfolding setsum_cartesian_product by blast
- show ?case unfolding tha
- apply(rule setsum_eq_general_reverses[where h= "?h" and k= "?k"],
- blast intro: finite_cartesian_product fS finite,
- blast intro: finite_cartesian_product fS finite)
- using `z \<notin> T`
- apply (auto intro: ext)
- apply (rule cong[OF refl[of det]])
- by vector
-qed
-
-lemma det_linear_rows_setsum:
- assumes fS: "finite (S::'n::finite set)"
- 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}"
-proof-
- 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
-
- from det_linear_rows_setsum_lemma[OF fS, of "UNIV :: 'n set" a, unfolded th0, OF finite] show ?thesis by simp
-qed
-
-lemma matrix_mul_setsum_alt:
- fixes A B :: "'a::comm_ring_1^'n^'n::finite"
- shows "A ** B = (\<chi> i. setsum (\<lambda>k. A$i$k *s B $ k) (UNIV :: 'n set))"
- by (vector matrix_matrix_mult_def setsum_component)
-
-lemma det_rows_mul:
- "det((\<chi> i. c i *s a i)::'a::comm_ring_1^'n^'n::finite) =
- setprod (\<lambda>i. c i) (UNIV:: 'n set) * det((\<chi> i. a i)::'a^'n^'n)"
-proof (simp add: det_def setsum_right_distrib cong add: setprod_cong, rule setsum_cong2)
- let ?U = "UNIV :: 'n set"
- let ?PU = "{p. p permutes ?U}"
- fix p assume pU: "p \<in> ?PU"
- let ?s = "of_int (sign p)"
- from pU have p: "p permutes ?U" by blast
- have "setprod (\<lambda>i. c i * a i $ p i) ?U = setprod c ?U * setprod (\<lambda>i. a i $ p i) ?U"
- unfolding setprod_timesf ..
- then show "?s * (\<Prod>xa\<in>?U. c xa * a xa $ p xa) =
- setprod c ?U * (?s* (\<Prod>xa\<in>?U. a xa $ p xa))" by (simp add: ring_simps)
-qed
-
-lemma det_mul:
- fixes A B :: "'a::ordered_idom^'n^'n::finite"
- shows "det (A ** B) = det A * det B"
-proof-
- let ?U = "UNIV :: 'n set"
- let ?F = "{f. (\<forall>i\<in> ?U. f i \<in> ?U) \<and> (\<forall>i. i \<notin> ?U \<longrightarrow> f i = i)}"
- let ?PU = "{p. p permutes ?U}"
- have fU: "finite ?U" by simp
- have fF: "finite ?F" by (rule finite)
- {fix p assume p: "p permutes ?U"
-
- have "p \<in> ?F" unfolding mem_Collect_eq permutes_in_image[OF p]
- using p[unfolded permutes_def] by simp}
- then have PUF: "?PU \<subseteq> ?F" by blast
- {fix f assume fPU: "f \<in> ?F - ?PU"
- have fUU: "f ` ?U \<subseteq> ?U" using fPU by auto
- from fPU have f: "\<forall>i \<in> ?U. f i \<in> ?U"
- "\<forall>i. i \<notin> ?U \<longrightarrow> f i = i" "\<not>(\<forall>y. \<exists>!x. f x = y)" unfolding permutes_def
- by auto
-
- let ?A = "(\<chi> i. A$i$f i *s B$f i) :: 'a^'n^'n"
- let ?B = "(\<chi> i. B$f i) :: 'a^'n^'n"
- {assume fni: "\<not> inj_on f ?U"
- then obtain i j where ij: "f i = f j" "i \<noteq> j"
- unfolding inj_on_def by blast
- from ij
- have rth: "row i ?B = row j ?B" by (vector row_def)
- from det_identical_rows[OF ij(2) rth]
- have "det (\<chi> i. A$i$f i *s B$f i) = 0"
- unfolding det_rows_mul by simp}
- moreover
- {assume fi: "inj_on f ?U"
- from f fi have fith: "\<And>i j. f i = f j \<Longrightarrow> i = j"
- unfolding inj_on_def by metis
- note fs = fi[unfolded surjective_iff_injective_gen[OF fU fU refl fUU, symmetric]]
-
- {fix y
- from fs f have "\<exists>x. f x = y" by blast
- then obtain x where x: "f x = y" by blast
- {fix z assume z: "f z = y" from fith x z have "z = x" by metis}
- with x have "\<exists>!x. f x = y" by blast}
- with f(3) have "det (\<chi> i. A$i$f i *s B$f i) = 0" by blast}
- ultimately have "det (\<chi> i. A$i$f i *s B$f i) = 0" by blast}
- hence zth: "\<forall> f\<in> ?F - ?PU. det (\<chi> i. A$i$f i *s B$f i) = 0" by simp
- {fix p assume pU: "p \<in> ?PU"
- from pU have p: "p permutes ?U" by blast
- let ?s = "\<lambda>p. of_int (sign p)"
- let ?f = "\<lambda>q. ?s p * (\<Prod>i\<in> ?U. A $ i $ p i) *
- (?s q * (\<Prod>i\<in> ?U. B $ i $ q i))"
- have "(setsum (\<lambda>q. ?s q *
- (\<Prod>i\<in> ?U. (\<chi> i. A $ i $ p i *s B $ p i :: 'a^'n^'n) $ i $ q i)) ?PU) =
- (setsum (\<lambda>q. ?s p * (\<Prod>i\<in> ?U. A $ i $ p i) *
- (?s q * (\<Prod>i\<in> ?U. B $ i $ q i))) ?PU)"
- unfolding sum_permutations_compose_right[OF permutes_inv[OF p], of ?f]
- proof(rule setsum_cong2)
- fix q assume qU: "q \<in> ?PU"
- hence q: "q permutes ?U" by blast
- from p q have pp: "permutation p" and pq: "permutation q"
- unfolding permutation_permutes by auto
- have th00: "of_int (sign p) * of_int (sign p) = (1::'a)"
- "\<And>a. of_int (sign p) * (of_int (sign p) * a) = a"
- unfolding mult_assoc[symmetric] unfolding of_int_mult[symmetric]
- by (simp_all add: sign_idempotent)
- have ths: "?s q = ?s p * ?s (q o inv p)"
- using pp pq permutation_inverse[OF pp] sign_inverse[OF pp]
- by (simp add: th00 mult_ac sign_idempotent sign_compose)
- have th001: "setprod (\<lambda>i. B$i$ q (inv p i)) ?U = setprod ((\<lambda>i. B$i$ q (inv p i)) o p) ?U"
- by (rule setprod_permute[OF p])
- 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"
- unfolding th001 setprod_timesf[symmetric] o_def permutes_inverses[OF p]
- apply (rule setprod_cong[OF refl])
- using permutes_in_image[OF q] by vector
- 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)"
- using ths thp pp pq permutation_inverse[OF pp] sign_inverse[OF pp]
- by (simp add: sign_nz th00 ring_simps sign_idempotent sign_compose)
- qed
- }
- then have th2: "setsum (\<lambda>f. det (\<chi> i. A$i$f i *s B$f i)) ?PU = det A * det B"
- unfolding det_def setsum_product
- by (rule setsum_cong2)
- have "det (A**B) = setsum (\<lambda>f. det (\<chi> i. A $ i $ f i *s B $ f i)) ?F"
- unfolding matrix_mul_setsum_alt det_linear_rows_setsum[OF fU] by simp
- also have "\<dots> = setsum (\<lambda>f. det (\<chi> i. A$i$f i *s B$f i)) ?PU"
- using setsum_mono_zero_cong_left[OF fF PUF zth, symmetric]
- unfolding det_rows_mul by auto
- finally show ?thesis unfolding th2 .
-qed
-
-(* ------------------------------------------------------------------------- *)
-(* Relation to invertibility. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma invertible_left_inverse:
- fixes A :: "real^'n^'n::finite"
- shows "invertible A \<longleftrightarrow> (\<exists>(B::real^'n^'n). B** A = mat 1)"
- by (metis invertible_def matrix_left_right_inverse)
-
-lemma invertible_righ_inverse:
- fixes A :: "real^'n^'n::finite"
- shows "invertible A \<longleftrightarrow> (\<exists>(B::real^'n^'n). A** B = mat 1)"
- by (metis invertible_def matrix_left_right_inverse)
-
-lemma invertible_det_nz:
- fixes A::"real ^'n^'n::finite"
- shows "invertible A \<longleftrightarrow> det A \<noteq> 0"
-proof-
- {assume "invertible A"
- then obtain B :: "real ^'n^'n" where B: "A ** B = mat 1"
- unfolding invertible_righ_inverse by blast
- hence "det (A ** B) = det (mat 1 :: real ^'n^'n)" by simp
- hence "det A \<noteq> 0"
- apply (simp add: det_mul det_I) by algebra }
- moreover
- {assume H: "\<not> invertible A"
- let ?U = "UNIV :: 'n set"
- have fU: "finite ?U" by simp
- from H obtain c i where c: "setsum (\<lambda>i. c i *s row i A) ?U = 0"
- and iU: "i \<in> ?U" and ci: "c i \<noteq> 0"
- unfolding invertible_righ_inverse
- unfolding matrix_right_invertible_independent_rows by blast
- have stupid: "\<And>(a::real^'n) b. a + b = 0 \<Longrightarrow> -a = b"
- apply (drule_tac f="op + (- a)" in cong[OF refl])
- apply (simp only: ab_left_minus add_assoc[symmetric])
- apply simp
- done
- from c ci
- have thr0: "- row i A = setsum (\<lambda>j. (1/ c i) *s (c j *s row j A)) (?U - {i})"
- unfolding setsum_diff1'[OF fU iU] setsum_cmul
- apply -
- apply (rule vector_mul_lcancel_imp[OF ci])
- apply (auto simp add: vector_smult_assoc vector_smult_rneg field_simps)
- unfolding stupid ..
- have thr: "- row i A \<in> span {row j A| j. j \<noteq> i}"
- unfolding thr0
- apply (rule span_setsum)
- apply simp
- apply (rule ballI)
- apply (rule span_mul)+
- apply (rule span_superset)
- apply auto
- done
- let ?B = "(\<chi> k. if k = i then 0 else row k A) :: real ^'n^'n"
- have thrb: "row i ?B = 0" using iU by (vector row_def)
- have "det A = 0"
- unfolding det_row_span[OF thr, symmetric] right_minus
- unfolding det_zero_row[OF thrb] ..}
- ultimately show ?thesis by blast
-qed
-
-(* ------------------------------------------------------------------------- *)
-(* Cramer's rule. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma cramer_lemma_transp:
- fixes A:: "'a::ordered_idom^'n^'n::finite" and x :: "'a ^'n::finite"
- shows "det ((\<chi> i. if i = k then setsum (\<lambda>i. x$i *s row i A) (UNIV::'n set)
- else row i A)::'a^'n^'n) = x$k * det A"
- (is "?lhs = ?rhs")
-proof-
- let ?U = "UNIV :: 'n set"
- let ?Uk = "?U - {k}"
- have U: "?U = insert k ?Uk" by blast
- have fUk: "finite ?Uk" by simp
- have kUk: "k \<notin> ?Uk" by simp
- have th00: "\<And>k s. x$k *s row k A + s = (x$k - 1) *s row k A + row k A + s"
- by (vector ring_simps)
- have th001: "\<And>f k . (\<lambda>x. if x = k then f k else f x) = f" by (auto intro: ext)
- have "(\<chi> i. row i A) = A" by (vector row_def)
- then have thd1: "det (\<chi> i. row i A) = det A" by simp
- 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"
- apply (rule det_row_span)
- apply (rule span_setsum[OF fUk])
- apply (rule ballI)
- apply (rule span_mul)
- apply (rule span_superset)
- apply auto
- done
- show "?lhs = x$k * det A"
- apply (subst U)
- unfolding setsum_insert[OF fUk kUk]
- apply (subst th00)
- unfolding add_assoc
- apply (subst det_row_add)
- unfolding thd0
- unfolding det_row_mul
- unfolding th001[of k "\<lambda>i. row i A"]
- unfolding thd1 by (simp add: ring_simps)
-qed
-
-lemma cramer_lemma:
- fixes A :: "'a::ordered_idom ^'n^'n::finite"
- shows "det((\<chi> i j. if j = k then (A *v x)$i else A$i$j):: 'a^'n^'n) = x$k * det A"
-proof-
- let ?U = "UNIV :: 'n set"
- 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"
- by (auto simp add: row_transp intro: setsum_cong2)
- show ?thesis unfolding matrix_mult_vsum
- unfolding cramer_lemma_transp[of k x "transp A", unfolded det_transp, symmetric]
- unfolding stupid[of "\<lambda>i. x$i"]
- apply (subst det_transp[symmetric])
- apply (rule cong[OF refl[of det]]) by (vector transp_def column_def row_def)
-qed
-
-lemma cramer:
- fixes A ::"real^'n^'n::finite"
- assumes d0: "det A \<noteq> 0"
- 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)"
-proof-
- from d0 obtain B where B: "A ** B = mat 1" "B ** A = mat 1"
- unfolding invertible_det_nz[symmetric] invertible_def by blast
- have "(A ** B) *v b = b" by (simp add: B matrix_vector_mul_lid)
- hence "A *v (B *v b) = b" by (simp add: matrix_vector_mul_assoc)
- then have xe: "\<exists>x. A*v x = b" by blast
- {fix x assume x: "A *v x = b"
- have "x = (\<chi> k. det(\<chi> i j. if j=k then b$i else A$i$j :: real^'n^'n) / det A)"
- unfolding x[symmetric]
- using d0 by (simp add: Cart_eq cramer_lemma field_simps)}
- with xe show ?thesis by auto
-qed
-
-(* ------------------------------------------------------------------------- *)
-(* Orthogonality of a transformation and matrix. *)
-(* ------------------------------------------------------------------------- *)
-
-definition "orthogonal_transformation f \<longleftrightarrow> linear f \<and> (\<forall>v w. f v \<bullet> f w = v \<bullet> w)"
-
-lemma orthogonal_transformation: "orthogonal_transformation f \<longleftrightarrow> linear f \<and> (\<forall>(v::real ^_). norm (f v) = norm v)"
- unfolding orthogonal_transformation_def
- apply auto
- apply (erule_tac x=v in allE)+
- apply (simp add: real_vector_norm_def)
- by (simp add: dot_norm linear_add[symmetric])
-
-definition "orthogonal_matrix (Q::'a::semiring_1^'n^'n) \<longleftrightarrow> transp Q ** Q = mat 1 \<and> Q ** transp Q = mat 1"
-
-lemma orthogonal_matrix: "orthogonal_matrix (Q:: real ^'n^'n::finite) \<longleftrightarrow> transp Q ** Q = mat 1"
- by (metis matrix_left_right_inverse orthogonal_matrix_def)
-
-lemma orthogonal_matrix_id: "orthogonal_matrix (mat 1 :: _^'n^'n::finite)"
- by (simp add: orthogonal_matrix_def transp_mat matrix_mul_lid)
-
-lemma orthogonal_matrix_mul:
- fixes A :: "real ^'n^'n::finite"
- assumes oA : "orthogonal_matrix A"
- and oB: "orthogonal_matrix B"
- shows "orthogonal_matrix(A ** B)"
- using oA oB
- unfolding orthogonal_matrix matrix_transp_mul
- apply (subst matrix_mul_assoc)
- apply (subst matrix_mul_assoc[symmetric])
- by (simp add: matrix_mul_rid)
-
-lemma orthogonal_transformation_matrix:
- fixes f:: "real^'n \<Rightarrow> real^'n::finite"
- shows "orthogonal_transformation f \<longleftrightarrow> linear f \<and> orthogonal_matrix(matrix f)"
- (is "?lhs \<longleftrightarrow> ?rhs")
-proof-
- let ?mf = "matrix f"
- let ?ot = "orthogonal_transformation f"
- let ?U = "UNIV :: 'n set"
- have fU: "finite ?U" by simp
- let ?m1 = "mat 1 :: real ^'n^'n"
- {assume ot: ?ot
- from ot have lf: "linear f" and fd: "\<forall>v w. f v \<bullet> f w = v \<bullet> w"
- unfolding orthogonal_transformation_def orthogonal_matrix by blast+
- {fix i j
- let ?A = "transp ?mf ** ?mf"
- have th0: "\<And>b (x::'a::comm_ring_1). (if b then 1 else 0)*x = (if b then x else 0)"
- "\<And>b (x::'a::comm_ring_1). x*(if b then 1 else 0) = (if b then x else 0)"
- by simp_all
- from fd[rule_format, of "basis i" "basis j", unfolded matrix_works[OF lf, symmetric] dot_matrix_vector_mul]
- have "?A$i$j = ?m1 $ i $ j"
- by (simp add: dot_def matrix_matrix_mult_def columnvector_def rowvector_def basis_def th0 setsum_delta[OF fU] mat_def)}
- hence "orthogonal_matrix ?mf" unfolding orthogonal_matrix by vector
- with lf have ?rhs by blast}
- moreover
- {assume lf: "linear f" and om: "orthogonal_matrix ?mf"
- from lf om have ?lhs
- unfolding orthogonal_matrix_def norm_eq orthogonal_transformation
- unfolding matrix_works[OF lf, symmetric]
- apply (subst dot_matrix_vector_mul)
- by (simp add: dot_matrix_product matrix_mul_lid)}
- ultimately show ?thesis by blast
-qed
-
-lemma det_orthogonal_matrix:
- fixes Q:: "'a::ordered_idom^'n^'n::finite"
- assumes oQ: "orthogonal_matrix Q"
- shows "det Q = 1 \<or> det Q = - 1"
-proof-
-
- have th: "\<And>x::'a. x = 1 \<or> x = - 1 \<longleftrightarrow> x*x = 1" (is "\<And>x::'a. ?ths x")
- proof-
- fix x:: 'a
- have th0: "x*x - 1 = (x - 1)*(x + 1)" by (simp add: ring_simps)
- have th1: "\<And>(x::'a) y. x = - y \<longleftrightarrow> x + y = 0"
- apply (subst eq_iff_diff_eq_0) by simp
- have "x*x = 1 \<longleftrightarrow> x*x - 1 = 0" by simp
- also have "\<dots> \<longleftrightarrow> x = 1 \<or> x = - 1" unfolding th0 th1 by simp
- finally show "?ths x" ..
- qed
- from oQ have "Q ** transp Q = mat 1" by (metis orthogonal_matrix_def)
- hence "det (Q ** transp Q) = det (mat 1:: 'a^'n^'n)" by simp
- hence "det Q * det Q = 1" by (simp add: det_mul det_I det_transp)
- then show ?thesis unfolding th .
-qed
-
-(* ------------------------------------------------------------------------- *)
-(* Linearity of scaling, and hence isometry, that preserves origin. *)
-(* ------------------------------------------------------------------------- *)
-lemma scaling_linear:
- fixes f :: "real ^'n \<Rightarrow> real ^'n::finite"
- assumes f0: "f 0 = 0" and fd: "\<forall>x y. dist (f x) (f y) = c * dist x y"
- shows "linear f"
-proof-
- {fix v w
- {fix x note fd[rule_format, of x 0, unfolded dist_norm f0 diff_0_right] }
- note th0 = this
- have "f v \<bullet> f w = c^2 * (v \<bullet> w)"
- unfolding dot_norm_neg dist_norm[symmetric]
- unfolding th0 fd[rule_format] by (simp add: power2_eq_square field_simps)}
- note fc = this
- show ?thesis unfolding linear_def vector_eq
- by (simp add: dot_lmult dot_ladd dot_rmult dot_radd fc ring_simps)
-qed
-
-lemma isometry_linear:
- "f (0:: real^'n) = (0:: real^'n::finite) \<Longrightarrow> \<forall>x y. dist(f x) (f y) = dist x y
- \<Longrightarrow> linear f"
-by (rule scaling_linear[where c=1]) simp_all
-
-(* ------------------------------------------------------------------------- *)
-(* Hence another formulation of orthogonal transformation. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma orthogonal_transformation_isometry:
- "orthogonal_transformation f \<longleftrightarrow> f(0::real^'n) = (0::real^'n::finite) \<and> (\<forall>x y. dist(f x) (f y) = dist x y)"
- unfolding orthogonal_transformation
- apply (rule iffI)
- apply clarify
- apply (clarsimp simp add: linear_0 linear_sub[symmetric] dist_norm)
- apply (rule conjI)
- apply (rule isometry_linear)
- apply simp
- apply simp
- apply clarify
- apply (erule_tac x=v in allE)
- apply (erule_tac x=0 in allE)
- by (simp add: dist_norm)
-
-(* ------------------------------------------------------------------------- *)
-(* Can extend an isometry from unit sphere. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma isometry_sphere_extend:
- fixes f:: "real ^'n \<Rightarrow> real ^'n::finite"
- assumes f1: "\<forall>x. norm x = 1 \<longrightarrow> norm (f x) = 1"
- and fd1: "\<forall> x y. norm x = 1 \<longrightarrow> norm y = 1 \<longrightarrow> dist (f x) (f y) = dist x y"
- shows "\<exists>g. orthogonal_transformation g \<and> (\<forall>x. norm x = 1 \<longrightarrow> g x = f x)"
-proof-
- {fix x y x' y' x0 y0 x0' y0' :: "real ^'n"
- assume H: "x = norm x *s x0" "y = norm y *s y0"
- "x' = norm x *s x0'" "y' = norm y *s y0'"
- "norm x0 = 1" "norm x0' = 1" "norm y0 = 1" "norm y0' = 1"
- "norm(x0' - y0') = norm(x0 - y0)"
-
- have "norm(x' - y') = norm(x - y)"
- apply (subst H(1))
- apply (subst H(2))
- apply (subst H(3))
- apply (subst H(4))
- using H(5-9)
- apply (simp add: norm_eq norm_eq_1)
- apply (simp add: dot_lsub dot_rsub dot_lmult dot_rmult)
- apply (simp add: ring_simps)
- by (simp only: right_distrib[symmetric])}
- note th0 = this
- let ?g = "\<lambda>x. if x = 0 then 0 else norm x *s f (inverse (norm x) *s x)"
- {fix x:: "real ^'n" assume nx: "norm x = 1"
- have "?g x = f x" using nx by auto}
- hence thfg: "\<forall>x. norm x = 1 \<longrightarrow> ?g x = f x" by blast
- have g0: "?g 0 = 0" by simp
- {fix x y :: "real ^'n"
- {assume "x = 0" "y = 0"
- then have "dist (?g x) (?g y) = dist x y" by simp }
- moreover
- {assume "x = 0" "y \<noteq> 0"
- then have "dist (?g x) (?g y) = dist x y"
- apply (simp add: dist_norm norm_mul)
- apply (rule f1[rule_format])
- by(simp add: norm_mul field_simps)}
- moreover
- {assume "x \<noteq> 0" "y = 0"
- then have "dist (?g x) (?g y) = dist x y"
- apply (simp add: dist_norm norm_mul)
- apply (rule f1[rule_format])
- by(simp add: norm_mul field_simps)}
- moreover
- {assume z: "x \<noteq> 0" "y \<noteq> 0"
- 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)"
- "norm y *s f (inverse (norm y) *s y) = norm y *s f (inverse (norm y) *s y)"
- "norm (inverse (norm x) *s x) = 1"
- "norm (f (inverse (norm x) *s x)) = 1"
- "norm (inverse (norm y) *s y) = 1"
- "norm (f (inverse (norm y) *s y)) = 1"
- "norm (f (inverse (norm x) *s x) - f (inverse (norm y) *s y)) =
- norm (inverse (norm x) *s x - inverse (norm y) *s y)"
- using z
- by (auto simp add: vector_smult_assoc field_simps norm_mul intro: f1[rule_format] fd1[rule_format, unfolded dist_norm])
- from z th0[OF th00] have "dist (?g x) (?g y) = dist x y"
- by (simp add: dist_norm)}
- ultimately have "dist (?g x) (?g y) = dist x y" by blast}
- note thd = this
- show ?thesis
- apply (rule exI[where x= ?g])
- unfolding orthogonal_transformation_isometry
- using g0 thfg thd by metis
-qed
-
-(* ------------------------------------------------------------------------- *)
-(* Rotation, reflection, rotoinversion. *)
-(* ------------------------------------------------------------------------- *)
-
-definition "rotation_matrix Q \<longleftrightarrow> orthogonal_matrix Q \<and> det Q = 1"
-definition "rotoinversion_matrix Q \<longleftrightarrow> orthogonal_matrix Q \<and> det Q = - 1"
-
-lemma orthogonal_rotation_or_rotoinversion:
- fixes Q :: "'a::ordered_idom^'n^'n::finite"
- shows " orthogonal_matrix Q \<longleftrightarrow> rotation_matrix Q \<or> rotoinversion_matrix Q"
- by (metis rotoinversion_matrix_def rotation_matrix_def det_orthogonal_matrix)
-(* ------------------------------------------------------------------------- *)
-(* Explicit formulas for low dimensions. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma setprod_1: "setprod f {(1::nat)..1} = f 1" by simp
-
-lemma setprod_2: "setprod f {(1::nat)..2} = f 1 * f 2"
- by (simp add: nat_number setprod_numseg mult_commute)
-lemma setprod_3: "setprod f {(1::nat)..3} = f 1 * f 2 * f 3"
- by (simp add: nat_number setprod_numseg mult_commute)
-
-lemma det_1: "det (A::'a::comm_ring_1^1^1) = A$1$1"
- by (simp add: det_def permutes_sing sign_id UNIV_1)
-
-lemma det_2: "det (A::'a::comm_ring_1^2^2) = A$1$1 * A$2$2 - A$1$2 * A$2$1"
-proof-
- have f12: "finite {2::2}" "1 \<notin> {2::2}" by auto
- show ?thesis
- unfolding det_def UNIV_2
- unfolding setsum_over_permutations_insert[OF f12]
- unfolding permutes_sing
- apply (simp add: sign_swap_id sign_id swap_id_eq)
- by (simp add: arith_simps(31)[symmetric] of_int_minus of_int_1 del: arith_simps(31))
-qed
-
-lemma det_3: "det (A::'a::comm_ring_1^3^3) =
- A$1$1 * A$2$2 * A$3$3 +
- A$1$2 * A$2$3 * A$3$1 +
- A$1$3 * A$2$1 * A$3$2 -
- A$1$1 * A$2$3 * A$3$2 -
- A$1$2 * A$2$1 * A$3$3 -
- A$1$3 * A$2$2 * A$3$1"
-proof-
- have f123: "finite {2::3, 3}" "1 \<notin> {2::3, 3}" by auto
- have f23: "finite {3::3}" "2 \<notin> {3::3}" by auto
-
- show ?thesis
- unfolding det_def UNIV_3
- unfolding setsum_over_permutations_insert[OF f123]
- unfolding setsum_over_permutations_insert[OF f23]
-
- unfolding permutes_sing
- apply (simp add: sign_swap_id permutation_swap_id sign_compose sign_id swap_id_eq)
- apply (simp add: arith_simps(31)[symmetric] of_int_minus of_int_1 del: arith_simps(31))
- by (simp add: ring_simps)
-qed
-
-end
--- a/src/HOL/Library/Euclidean_Space.thy Fri Oct 23 14:33:07 2009 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,5372 +0,0 @@
-(* Title: Library/Euclidean_Space
- Author: Amine Chaieb, University of Cambridge
-*)
-
-header {* (Real) Vectors in Euclidean space, and elementary linear algebra.*}
-
-theory Euclidean_Space
-imports
- Complex_Main "~~/src/HOL/Decision_Procs/Dense_Linear_Order"
- Finite_Cartesian_Product Glbs Infinite_Set Numeral_Type
- Inner_Product
-uses "positivstellensatz.ML" ("normarith.ML")
-begin
-
-text{* Some common special cases.*}
-
-lemma forall_1: "(\<forall>i::1. P i) \<longleftrightarrow> P 1"
- by (metis num1_eq_iff)
-
-lemma exhaust_2:
- fixes x :: 2 shows "x = 1 \<or> x = 2"
-proof (induct x)
- case (of_int z)
- then have "0 <= z" and "z < 2" by simp_all
- then have "z = 0 | z = 1" by arith
- then show ?case by auto
-qed
-
-lemma forall_2: "(\<forall>i::2. P i) \<longleftrightarrow> P 1 \<and> P 2"
- by (metis exhaust_2)
-
-lemma exhaust_3:
- fixes x :: 3 shows "x = 1 \<or> x = 2 \<or> x = 3"
-proof (induct x)
- case (of_int z)
- then have "0 <= z" and "z < 3" by simp_all
- then have "z = 0 \<or> z = 1 \<or> z = 2" by arith
- then show ?case by auto
-qed
-
-lemma forall_3: "(\<forall>i::3. P i) \<longleftrightarrow> P 1 \<and> P 2 \<and> P 3"
- by (metis exhaust_3)
-
-lemma UNIV_1: "UNIV = {1::1}"
- by (auto simp add: num1_eq_iff)
-
-lemma UNIV_2: "UNIV = {1::2, 2::2}"
- using exhaust_2 by auto
-
-lemma UNIV_3: "UNIV = {1::3, 2::3, 3::3}"
- using exhaust_3 by auto
-
-lemma setsum_1: "setsum f (UNIV::1 set) = f 1"
- unfolding UNIV_1 by simp
-
-lemma setsum_2: "setsum f (UNIV::2 set) = f 1 + f 2"
- unfolding UNIV_2 by simp
-
-lemma setsum_3: "setsum f (UNIV::3 set) = f 1 + f 2 + f 3"
- unfolding UNIV_3 by (simp add: add_ac)
-
-subsection{* Basic componentwise operations on vectors. *}
-
-instantiation "^" :: (plus,type) plus
-begin
-definition vector_add_def : "op + \<equiv> (\<lambda> x y. (\<chi> i. (x$i) + (y$i)))"
-instance ..
-end
-
-instantiation "^" :: (times,type) times
-begin
- definition vector_mult_def : "op * \<equiv> (\<lambda> x y. (\<chi> i. (x$i) * (y$i)))"
- instance ..
-end
-
-instantiation "^" :: (minus,type) minus begin
- definition vector_minus_def : "op - \<equiv> (\<lambda> x y. (\<chi> i. (x$i) - (y$i)))"
-instance ..
-end
-
-instantiation "^" :: (uminus,type) uminus begin
- definition vector_uminus_def : "uminus \<equiv> (\<lambda> x. (\<chi> i. - (x$i)))"
-instance ..
-end
-instantiation "^" :: (zero,type) zero begin
- definition vector_zero_def : "0 \<equiv> (\<chi> i. 0)"
-instance ..
-end
-
-instantiation "^" :: (one,type) one begin
- definition vector_one_def : "1 \<equiv> (\<chi> i. 1)"
-instance ..
-end
-
-instantiation "^" :: (ord,type) ord
- begin
-definition vector_less_eq_def:
- "less_eq (x :: 'a ^'b) y = (ALL i. x$i <= y$i)"
-definition vector_less_def: "less (x :: 'a ^'b) y = (ALL i. x$i < y$i)"
-
-instance by (intro_classes)
-end
-
-instantiation "^" :: (scaleR, type) scaleR
-begin
-definition vector_scaleR_def: "scaleR = (\<lambda> r x. (\<chi> i. scaleR r (x$i)))"
-instance ..
-end
-
-text{* Also the scalar-vector multiplication. *}
-
-definition vector_scalar_mult:: "'a::times \<Rightarrow> 'a ^'n \<Rightarrow> 'a ^ 'n" (infixl "*s" 70)
- where "c *s x = (\<chi> i. c * (x$i))"
-
-text{* Constant Vectors *}
-
-definition "vec x = (\<chi> i. x)"
-
-text{* Dot products. *}
-
-definition dot :: "'a::{comm_monoid_add, times} ^ 'n \<Rightarrow> 'a ^ 'n \<Rightarrow> 'a" (infix "\<bullet>" 70) where
- "x \<bullet> y = setsum (\<lambda>i. x$i * y$i) UNIV"
-
-lemma dot_1[simp]: "(x::'a::{comm_monoid_add, times}^1) \<bullet> y = (x$1) * (y$1)"
- by (simp add: dot_def setsum_1)
-
-lemma dot_2[simp]: "(x::'a::{comm_monoid_add, times}^2) \<bullet> y = (x$1) * (y$1) + (x$2) * (y$2)"
- by (simp add: dot_def setsum_2)
-
-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)"
- by (simp add: dot_def setsum_3)
-
-subsection {* A naive proof procedure to lift really trivial arithmetic stuff from the basis of the vector space. *}
-
-method_setup vector = {*
-let
- val ss1 = HOL_basic_ss addsimps [@{thm dot_def}, @{thm setsum_addf} RS sym,
- @{thm setsum_subtractf} RS sym, @{thm setsum_right_distrib},
- @{thm setsum_left_distrib}, @{thm setsum_negf} RS sym]
- val ss2 = @{simpset} addsimps
- [@{thm vector_add_def}, @{thm vector_mult_def},
- @{thm vector_minus_def}, @{thm vector_uminus_def},
- @{thm vector_one_def}, @{thm vector_zero_def}, @{thm vec_def},
- @{thm vector_scaleR_def},
- @{thm Cart_lambda_beta}, @{thm vector_scalar_mult_def}]
- fun vector_arith_tac ths =
- simp_tac ss1
- THEN' (fn i => rtac @{thm setsum_cong2} i
- ORELSE rtac @{thm setsum_0'} i
- ORELSE simp_tac (HOL_basic_ss addsimps [@{thm "Cart_eq"}]) i)
- (* THEN' TRY o clarify_tac HOL_cs THEN' (TRY o rtac @{thm iffI}) *)
- THEN' asm_full_simp_tac (ss2 addsimps ths)
- in
- Attrib.thms >> (fn ths => K (SIMPLE_METHOD' (vector_arith_tac ths)))
- end
-*} "Lifts trivial vector statements to real arith statements"
-
-lemma vec_0[simp]: "vec 0 = 0" by (vector vector_zero_def)
-lemma vec_1[simp]: "vec 1 = 1" by (vector vector_one_def)
-
-
-
-text{* Obvious "component-pushing". *}
-
-lemma vec_component [simp]: "(vec x :: 'a ^ 'n)$i = x"
- by (vector vec_def)
-
-lemma vector_add_component [simp]:
- fixes x y :: "'a::{plus} ^ 'n"
- shows "(x + y)$i = x$i + y$i"
- by vector
-
-lemma vector_minus_component [simp]:
- fixes x y :: "'a::{minus} ^ 'n"
- shows "(x - y)$i = x$i - y$i"
- by vector
-
-lemma vector_mult_component [simp]:
- fixes x y :: "'a::{times} ^ 'n"
- shows "(x * y)$i = x$i * y$i"
- by vector
-
-lemma vector_smult_component [simp]:
- fixes y :: "'a::{times} ^ 'n"
- shows "(c *s y)$i = c * (y$i)"
- by vector
-
-lemma vector_uminus_component [simp]:
- fixes x :: "'a::{uminus} ^ 'n"
- shows "(- x)$i = - (x$i)"
- by vector
-
-lemma vector_scaleR_component [simp]:
- fixes x :: "'a::scaleR ^ 'n"
- shows "(scaleR r x)$i = scaleR r (x$i)"
- by vector
-
-lemma cond_component: "(if b then x else y)$i = (if b then x$i else y$i)" by vector
-
-lemmas vector_component =
- vec_component vector_add_component vector_mult_component
- vector_smult_component vector_minus_component vector_uminus_component
- vector_scaleR_component cond_component
-
-subsection {* Some frequently useful arithmetic lemmas over vectors. *}
-
-instance "^" :: (semigroup_add,type) semigroup_add
- apply (intro_classes) by (vector add_assoc)
-
-
-instance "^" :: (monoid_add,type) monoid_add
- apply (intro_classes) by vector+
-
-instance "^" :: (group_add,type) group_add
- apply (intro_classes) by (vector algebra_simps)+
-
-instance "^" :: (ab_semigroup_add,type) ab_semigroup_add
- apply (intro_classes) by (vector add_commute)
-
-instance "^" :: (comm_monoid_add,type) comm_monoid_add
- apply (intro_classes) by vector
-
-instance "^" :: (ab_group_add,type) ab_group_add
- apply (intro_classes) by vector+
-
-instance "^" :: (cancel_semigroup_add,type) cancel_semigroup_add
- apply (intro_classes)
- by (vector Cart_eq)+
-
-instance "^" :: (cancel_ab_semigroup_add,type) cancel_ab_semigroup_add
- apply (intro_classes)
- by (vector Cart_eq)
-
-instance "^" :: (real_vector, type) real_vector
- by default (vector scaleR_left_distrib scaleR_right_distrib)+
-
-instance "^" :: (semigroup_mult,type) semigroup_mult
- apply (intro_classes) by (vector mult_assoc)
-
-instance "^" :: (monoid_mult,type) monoid_mult
- apply (intro_classes) by vector+
-
-instance "^" :: (ab_semigroup_mult,type) ab_semigroup_mult
- apply (intro_classes) by (vector mult_commute)
-
-instance "^" :: (ab_semigroup_idem_mult,type) ab_semigroup_idem_mult
- apply (intro_classes) by (vector mult_idem)
-
-instance "^" :: (comm_monoid_mult,type) comm_monoid_mult
- apply (intro_classes) by vector
-
-fun vector_power :: "('a::{one,times} ^'n) \<Rightarrow> nat \<Rightarrow> 'a^'n" where
- "vector_power x 0 = 1"
- | "vector_power x (Suc n) = x * vector_power x n"
-
-instance "^" :: (semiring,type) semiring
- apply (intro_classes) by (vector ring_simps)+
-
-instance "^" :: (semiring_0,type) semiring_0
- apply (intro_classes) by (vector ring_simps)+
-instance "^" :: (semiring_1,type) semiring_1
- apply (intro_classes) by vector
-instance "^" :: (comm_semiring,type) comm_semiring
- apply (intro_classes) by (vector ring_simps)+
-
-instance "^" :: (comm_semiring_0,type) comm_semiring_0 by (intro_classes)
-instance "^" :: (cancel_comm_monoid_add, type) cancel_comm_monoid_add ..
-instance "^" :: (semiring_0_cancel,type) semiring_0_cancel by (intro_classes)
-instance "^" :: (comm_semiring_0_cancel,type) comm_semiring_0_cancel by (intro_classes)
-instance "^" :: (ring,type) ring by (intro_classes)
-instance "^" :: (semiring_1_cancel,type) semiring_1_cancel by (intro_classes)
-instance "^" :: (comm_semiring_1,type) comm_semiring_1 by (intro_classes)
-
-instance "^" :: (ring_1,type) ring_1 ..
-
-instance "^" :: (real_algebra,type) real_algebra
- apply intro_classes
- apply (simp_all add: vector_scaleR_def ring_simps)
- apply vector
- apply vector
- done
-
-instance "^" :: (real_algebra_1,type) real_algebra_1 ..
-
-lemma of_nat_index:
- "(of_nat n :: 'a::semiring_1 ^'n)$i = of_nat n"
- apply (induct n)
- apply vector
- apply vector
- done
-lemma zero_index[simp]:
- "(0 :: 'a::zero ^'n)$i = 0" by vector
-
-lemma one_index[simp]:
- "(1 :: 'a::one ^'n)$i = 1" by vector
-
-lemma one_plus_of_nat_neq_0: "(1::'a::semiring_char_0) + of_nat n \<noteq> 0"
-proof-
- have "(1::'a) + of_nat n = 0 \<longleftrightarrow> of_nat 1 + of_nat n = (of_nat 0 :: 'a)" by simp
- also have "\<dots> \<longleftrightarrow> 1 + n = 0" by (simp only: of_nat_add[symmetric] of_nat_eq_iff)
- finally show ?thesis by simp
-qed
-
-instance "^" :: (semiring_char_0,type) semiring_char_0
-proof (intro_classes)
- fix m n ::nat
- show "(of_nat m :: 'a^'b) = of_nat n \<longleftrightarrow> m = n"
- by (simp add: Cart_eq of_nat_index)
-qed
-
-instance "^" :: (comm_ring_1,type) comm_ring_1 by intro_classes
-instance "^" :: (ring_char_0,type) ring_char_0 by intro_classes
-
-lemma vector_smult_assoc: "a *s (b *s x) = ((a::'a::semigroup_mult) * b) *s x"
- by (vector mult_assoc)
-lemma vector_sadd_rdistrib: "((a::'a::semiring) + b) *s x = a *s x + b *s x"
- by (vector ring_simps)
-lemma vector_add_ldistrib: "(c::'a::semiring) *s (x + y) = c *s x + c *s y"
- by (vector ring_simps)
-lemma vector_smult_lzero[simp]: "(0::'a::mult_zero) *s x = 0" by vector
-lemma vector_smult_lid[simp]: "(1::'a::monoid_mult) *s x = x" by vector
-lemma vector_ssub_ldistrib: "(c::'a::ring) *s (x - y) = c *s x - c *s y"
- by (vector ring_simps)
-lemma vector_smult_rneg: "(c::'a::ring) *s -x = -(c *s x)" by vector
-lemma vector_smult_lneg: "- (c::'a::ring) *s x = -(c *s x)" by vector
-lemma vector_sneg_minus1: "-x = (- (1::'a::ring_1)) *s x" by vector
-lemma vector_smult_rzero[simp]: "c *s 0 = (0::'a::mult_zero ^ 'n)" by vector
-lemma vector_sub_rdistrib: "((a::'a::ring) - b) *s x = a *s x - b *s x"
- by (vector ring_simps)
-
-lemma vec_eq[simp]: "(vec m = vec n) \<longleftrightarrow> (m = n)"
- by (simp add: Cart_eq)
-
-subsection {* Topological space *}
-
-instantiation "^" :: (topological_space, finite) topological_space
-begin
-
-definition open_vector_def:
- "open (S :: ('a ^ 'b) set) \<longleftrightarrow>
- (\<forall>x\<in>S. \<exists>A. (\<forall>i. open (A i) \<and> x$i \<in> A i) \<and>
- (\<forall>y. (\<forall>i. y$i \<in> A i) \<longrightarrow> y \<in> S))"
-
-instance proof
- show "open (UNIV :: ('a ^ 'b) set)"
- unfolding open_vector_def by auto
-next
- fix S T :: "('a ^ 'b) set"
- assume "open S" "open T" thus "open (S \<inter> T)"
- unfolding open_vector_def
- apply clarify
- apply (drule (1) bspec)+
- apply (clarify, rename_tac Sa Ta)
- apply (rule_tac x="\<lambda>i. Sa i \<inter> Ta i" in exI)
- apply (simp add: open_Int)
- done
-next
- fix K :: "('a ^ 'b) set set"
- assume "\<forall>S\<in>K. open S" thus "open (\<Union>K)"
- unfolding open_vector_def
- apply clarify
- apply (drule (1) bspec)
- apply (drule (1) bspec)
- apply clarify
- apply (rule_tac x=A in exI)
- apply fast
- done
-qed
-
-end
-
-lemma open_vector_box: "\<forall>i. open (S i) \<Longrightarrow> open {x. \<forall>i. x $ i \<in> S i}"
-unfolding open_vector_def by auto
-
-lemma open_vimage_Cart_nth: "open S \<Longrightarrow> open ((\<lambda>x. x $ i) -` S)"
-unfolding open_vector_def
-apply clarify
-apply (rule_tac x="\<lambda>k. if k = i then S else UNIV" in exI, simp)
-done
-
-lemma closed_vimage_Cart_nth: "closed S \<Longrightarrow> closed ((\<lambda>x. x $ i) -` S)"
-unfolding closed_open vimage_Compl [symmetric]
-by (rule open_vimage_Cart_nth)
-
-lemma closed_vector_box: "\<forall>i. closed (S i) \<Longrightarrow> closed {x. \<forall>i. x $ i \<in> S i}"
-proof -
- have "{x. \<forall>i. x $ i \<in> S i} = (\<Inter>i. (\<lambda>x. x $ i) -` S i)" by auto
- thus "\<forall>i. closed (S i) \<Longrightarrow> closed {x. \<forall>i. x $ i \<in> S i}"
- by (simp add: closed_INT closed_vimage_Cart_nth)
-qed
-
-lemma tendsto_Cart_nth [tendsto_intros]:
- assumes "((\<lambda>x. f x) ---> a) net"
- shows "((\<lambda>x. f x $ i) ---> a $ i) net"
-proof (rule topological_tendstoI)
- fix S assume "open S" "a $ i \<in> S"
- then have "open ((\<lambda>y. y $ i) -` S)" "a \<in> ((\<lambda>y. y $ i) -` S)"
- by (simp_all add: open_vimage_Cart_nth)
- with assms have "eventually (\<lambda>x. f x \<in> (\<lambda>y. y $ i) -` S) net"
- by (rule topological_tendstoD)
- then show "eventually (\<lambda>x. f x $ i \<in> S) net"
- by simp
-qed
-
-subsection {* Square root of sum of squares *}
-
-definition
- "setL2 f A = sqrt (\<Sum>i\<in>A. (f i)\<twosuperior>)"
-
-lemma setL2_cong:
- "\<lbrakk>A = B; \<And>x. x \<in> B \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> setL2 f A = setL2 g B"
- unfolding setL2_def by simp
-
-lemma strong_setL2_cong:
- "\<lbrakk>A = B; \<And>x. x \<in> B =simp=> f x = g x\<rbrakk> \<Longrightarrow> setL2 f A = setL2 g B"
- unfolding setL2_def simp_implies_def by simp
-
-lemma setL2_infinite [simp]: "\<not> finite A \<Longrightarrow> setL2 f A = 0"
- unfolding setL2_def by simp
-
-lemma setL2_empty [simp]: "setL2 f {} = 0"
- unfolding setL2_def by simp
-
-lemma setL2_insert [simp]:
- "\<lbrakk>finite F; a \<notin> F\<rbrakk> \<Longrightarrow>
- setL2 f (insert a F) = sqrt ((f a)\<twosuperior> + (setL2 f F)\<twosuperior>)"
- unfolding setL2_def by (simp add: setsum_nonneg)
-
-lemma setL2_nonneg [simp]: "0 \<le> setL2 f A"
- unfolding setL2_def by (simp add: setsum_nonneg)
-
-lemma setL2_0': "\<forall>a\<in>A. f a = 0 \<Longrightarrow> setL2 f A = 0"
- unfolding setL2_def by simp
-
-lemma setL2_constant: "setL2 (\<lambda>x. y) A = sqrt (of_nat (card A)) * \<bar>y\<bar>"
- unfolding setL2_def by (simp add: real_sqrt_mult)
-
-lemma setL2_mono:
- assumes "\<And>i. i \<in> K \<Longrightarrow> f i \<le> g i"
- assumes "\<And>i. i \<in> K \<Longrightarrow> 0 \<le> f i"
- shows "setL2 f K \<le> setL2 g K"
- unfolding setL2_def
- by (simp add: setsum_nonneg setsum_mono power_mono prems)
-
-lemma setL2_strict_mono:
- assumes "finite K" and "K \<noteq> {}"
- assumes "\<And>i. i \<in> K \<Longrightarrow> f i < g i"
- assumes "\<And>i. i \<in> K \<Longrightarrow> 0 \<le> f i"
- shows "setL2 f K < setL2 g K"
- unfolding setL2_def
- by (simp add: setsum_strict_mono power_strict_mono assms)
-
-lemma setL2_right_distrib:
- "0 \<le> r \<Longrightarrow> r * setL2 f A = setL2 (\<lambda>x. r * f x) A"
- unfolding setL2_def
- apply (simp add: power_mult_distrib)
- apply (simp add: setsum_right_distrib [symmetric])
- apply (simp add: real_sqrt_mult setsum_nonneg)
- done
-
-lemma setL2_left_distrib:
- "0 \<le> r \<Longrightarrow> setL2 f A * r = setL2 (\<lambda>x. f x * r) A"
- unfolding setL2_def
- apply (simp add: power_mult_distrib)
- apply (simp add: setsum_left_distrib [symmetric])
- apply (simp add: real_sqrt_mult setsum_nonneg)
- done
-
-lemma setsum_nonneg_eq_0_iff:
- fixes f :: "'a \<Rightarrow> 'b::pordered_ab_group_add"
- 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)"
- apply (induct set: finite, simp)
- apply (simp add: add_nonneg_eq_0_iff setsum_nonneg)
- done
-
-lemma setL2_eq_0_iff: "finite A \<Longrightarrow> setL2 f A = 0 \<longleftrightarrow> (\<forall>x\<in>A. f x = 0)"
- unfolding setL2_def
- by (simp add: setsum_nonneg setsum_nonneg_eq_0_iff)
-
-lemma setL2_triangle_ineq:
- shows "setL2 (\<lambda>i. f i + g i) A \<le> setL2 f A + setL2 g A"
-proof (cases "finite A")
- case False
- thus ?thesis by simp
-next
- case True
- thus ?thesis
- proof (induct set: finite)
- case empty
- show ?case by simp
- next
- case (insert x F)
- hence "sqrt ((f x + g x)\<twosuperior> + (setL2 (\<lambda>i. f i + g i) F)\<twosuperior>) \<le>
- sqrt ((f x + g x)\<twosuperior> + (setL2 f F + setL2 g F)\<twosuperior>)"
- by (intro real_sqrt_le_mono add_left_mono power_mono insert
- setL2_nonneg add_increasing zero_le_power2)
- also have
- "\<dots> \<le> sqrt ((f x)\<twosuperior> + (setL2 f F)\<twosuperior>) + sqrt ((g x)\<twosuperior> + (setL2 g F)\<twosuperior>)"
- by (rule real_sqrt_sum_squares_triangle_ineq)
- finally show ?case
- using insert by simp
- qed
-qed
-
-lemma sqrt_sum_squares_le_sum:
- "\<lbrakk>0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> sqrt (x\<twosuperior> + y\<twosuperior>) \<le> x + y"
- apply (rule power2_le_imp_le)
- apply (simp add: power2_sum)
- apply (simp add: mult_nonneg_nonneg)
- apply (simp add: add_nonneg_nonneg)
- done
-
-lemma setL2_le_setsum [rule_format]:
- "(\<forall>i\<in>A. 0 \<le> f i) \<longrightarrow> setL2 f A \<le> setsum f A"
- apply (cases "finite A")
- apply (induct set: finite)
- apply simp
- apply clarsimp
- apply (erule order_trans [OF sqrt_sum_squares_le_sum])
- apply simp
- apply simp
- apply simp
- done
-
-lemma sqrt_sum_squares_le_sum_abs: "sqrt (x\<twosuperior> + y\<twosuperior>) \<le> \<bar>x\<bar> + \<bar>y\<bar>"
- apply (rule power2_le_imp_le)
- apply (simp add: power2_sum)
- apply (simp add: mult_nonneg_nonneg)
- apply (simp add: add_nonneg_nonneg)
- done
-
-lemma setL2_le_setsum_abs: "setL2 f A \<le> (\<Sum>i\<in>A. \<bar>f i\<bar>)"
- apply (cases "finite A")
- apply (induct set: finite)
- apply simp
- apply simp
- apply (rule order_trans [OF sqrt_sum_squares_le_sum_abs])
- apply simp
- apply simp
- done
-
-lemma setL2_mult_ineq_lemma:
- fixes a b c d :: real
- shows "2 * (a * c) * (b * d) \<le> a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior>"
-proof -
- have "0 \<le> (a * d - b * c)\<twosuperior>" by simp
- also have "\<dots> = a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior> - 2 * (a * d) * (b * c)"
- by (simp only: power2_diff power_mult_distrib)
- also have "\<dots> = a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior> - 2 * (a * c) * (b * d)"
- by simp
- finally show "2 * (a * c) * (b * d) \<le> a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior>"
- by simp
-qed
-
-lemma setL2_mult_ineq: "(\<Sum>i\<in>A. \<bar>f i\<bar> * \<bar>g i\<bar>) \<le> setL2 f A * setL2 g A"
- apply (cases "finite A")
- apply (induct set: finite)
- apply simp
- apply (rule power2_le_imp_le, simp)
- apply (rule order_trans)
- apply (rule power_mono)
- apply (erule add_left_mono)
- apply (simp add: add_nonneg_nonneg mult_nonneg_nonneg setsum_nonneg)
- apply (simp add: power2_sum)
- apply (simp add: power_mult_distrib)
- apply (simp add: right_distrib left_distrib)
- apply (rule ord_le_eq_trans)
- apply (rule setL2_mult_ineq_lemma)
- apply simp
- apply (intro mult_nonneg_nonneg setL2_nonneg)
- apply simp
- done
-
-lemma member_le_setL2: "\<lbrakk>finite A; i \<in> A\<rbrakk> \<Longrightarrow> f i \<le> setL2 f A"
- apply (rule_tac s="insert i (A - {i})" and t="A" in subst)
- apply fast
- apply (subst setL2_insert)
- apply simp
- apply simp
- apply simp
- done
-
-subsection {* Metric *}
-
-(* TODO: move somewhere else *)
-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)"
-apply (induct set: finite, simp_all)
-apply (clarify, rename_tac y)
-apply (rule_tac x="f(x:=y)" in exI, simp)
-done
-
-instantiation "^" :: (metric_space, finite) metric_space
-begin
-
-definition dist_vector_def:
- "dist (x::'a^'b) (y::'a^'b) = setL2 (\<lambda>i. dist (x$i) (y$i)) UNIV"
-
-lemma dist_nth_le: "dist (x $ i) (y $ i) \<le> dist x y"
-unfolding dist_vector_def
-by (rule member_le_setL2) simp_all
-
-instance proof
- fix x y :: "'a ^ 'b"
- show "dist x y = 0 \<longleftrightarrow> x = y"
- unfolding dist_vector_def
- by (simp add: setL2_eq_0_iff Cart_eq)
-next
- fix x y z :: "'a ^ 'b"
- show "dist x y \<le> dist x z + dist y z"
- unfolding dist_vector_def
- apply (rule order_trans [OF _ setL2_triangle_ineq])
- apply (simp add: setL2_mono dist_triangle2)
- done
-next
- (* FIXME: long proof! *)
- fix S :: "('a ^ 'b) set"
- show "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> S)"
- unfolding open_vector_def open_dist
- apply safe
- apply (drule (1) bspec)
- apply clarify
- apply (subgoal_tac "\<exists>e>0. \<forall>i y. dist y (x$i) < e \<longrightarrow> y \<in> A i")
- apply clarify
- apply (rule_tac x=e in exI, clarify)
- apply (drule spec, erule mp, clarify)
- apply (drule spec, drule spec, erule mp)
- apply (erule le_less_trans [OF dist_nth_le])
- apply (subgoal_tac "\<forall>i\<in>UNIV. \<exists>e>0. \<forall>y. dist y (x$i) < e \<longrightarrow> y \<in> A i")
- apply (drule finite_choice [OF finite], clarify)
- apply (rule_tac x="Min (range f)" in exI, simp)
- apply clarify
- apply (drule_tac x=i in spec, clarify)
- apply (erule (1) bspec)
- apply (drule (1) bspec, clarify)
- apply (subgoal_tac "\<exists>r. (\<forall>i::'b. 0 < r i) \<and> e = setL2 r UNIV")
- apply clarify
- apply (rule_tac x="\<lambda>i. {y. dist y (x$i) < r i}" in exI)
- apply (rule conjI)
- apply clarify
- apply (rule conjI)
- apply (clarify, rename_tac y)
- apply (rule_tac x="r i - dist y (x$i)" in exI, rule conjI, simp)
- apply clarify
- apply (simp only: less_diff_eq)
- apply (erule le_less_trans [OF dist_triangle])
- apply simp
- apply clarify
- apply (drule spec, erule mp)
- apply (simp add: dist_vector_def setL2_strict_mono)
- apply (rule_tac x="\<lambda>i. e / sqrt (of_nat CARD('b))" in exI)
- apply (simp add: divide_pos_pos setL2_constant)
- done
-qed
-
-end
-
-lemma LIMSEQ_Cart_nth:
- "(X ----> a) \<Longrightarrow> (\<lambda>n. X n $ i) ----> a $ i"
-unfolding LIMSEQ_conv_tendsto by (rule tendsto_Cart_nth)
-
-lemma LIM_Cart_nth:
- "(f -- x --> y) \<Longrightarrow> (\<lambda>x. f x $ i) -- x --> y $ i"
-unfolding LIM_conv_tendsto by (rule tendsto_Cart_nth)
-
-lemma Cauchy_Cart_nth:
- "Cauchy (\<lambda>n. X n) \<Longrightarrow> Cauchy (\<lambda>n. X n $ i)"
-unfolding Cauchy_def by (fast intro: le_less_trans [OF dist_nth_le])
-
-lemma LIMSEQ_vector:
- fixes X :: "nat \<Rightarrow> 'a::metric_space ^ 'n::finite"
- assumes X: "\<And>i. (\<lambda>n. X n $ i) ----> (a $ i)"
- shows "X ----> a"
-proof (rule metric_LIMSEQ_I)
- fix r :: real assume "0 < r"
- then have "0 < r / of_nat CARD('n)" (is "0 < ?s")
- by (simp add: divide_pos_pos)
- def N \<equiv> "\<lambda>i. LEAST N. \<forall>n\<ge>N. dist (X n $ i) (a $ i) < ?s"
- def M \<equiv> "Max (range N)"
- have "\<And>i. \<exists>N. \<forall>n\<ge>N. dist (X n $ i) (a $ i) < ?s"
- using X `0 < ?s` by (rule metric_LIMSEQ_D)
- hence "\<And>i. \<forall>n\<ge>N i. dist (X n $ i) (a $ i) < ?s"
- unfolding N_def by (rule LeastI_ex)
- hence M: "\<And>i. \<forall>n\<ge>M. dist (X n $ i) (a $ i) < ?s"
- unfolding M_def by simp
- {
- fix n :: nat assume "M \<le> n"
- have "dist (X n) a = setL2 (\<lambda>i. dist (X n $ i) (a $ i)) UNIV"
- unfolding dist_vector_def ..
- also have "\<dots> \<le> setsum (\<lambda>i. dist (X n $ i) (a $ i)) UNIV"
- by (rule setL2_le_setsum [OF zero_le_dist])
- also have "\<dots> < setsum (\<lambda>i::'n. ?s) UNIV"
- by (rule setsum_strict_mono, simp_all add: M `M \<le> n`)
- also have "\<dots> = r"
- by simp
- finally have "dist (X n) a < r" .
- }
- hence "\<forall>n\<ge>M. dist (X n) a < r"
- by simp
- then show "\<exists>M. \<forall>n\<ge>M. dist (X n) a < r" ..
-qed
-
-lemma Cauchy_vector:
- fixes X :: "nat \<Rightarrow> 'a::metric_space ^ 'n::finite"
- assumes X: "\<And>i. Cauchy (\<lambda>n. X n $ i)"
- shows "Cauchy (\<lambda>n. X n)"
-proof (rule metric_CauchyI)
- fix r :: real assume "0 < r"
- then have "0 < r / of_nat CARD('n)" (is "0 < ?s")
- by (simp add: divide_pos_pos)
- def N \<equiv> "\<lambda>i. LEAST N. \<forall>m\<ge>N. \<forall>n\<ge>N. dist (X m $ i) (X n $ i) < ?s"
- def M \<equiv> "Max (range N)"
- have "\<And>i. \<exists>N. \<forall>m\<ge>N. \<forall>n\<ge>N. dist (X m $ i) (X n $ i) < ?s"
- using X `0 < ?s` by (rule metric_CauchyD)
- hence "\<And>i. \<forall>m\<ge>N i. \<forall>n\<ge>N i. dist (X m $ i) (X n $ i) < ?s"
- unfolding N_def by (rule LeastI_ex)
- hence M: "\<And>i. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m $ i) (X n $ i) < ?s"
- unfolding M_def by simp
- {
- fix m n :: nat
- assume "M \<le> m" "M \<le> n"
- have "dist (X m) (X n) = setL2 (\<lambda>i. dist (X m $ i) (X n $ i)) UNIV"
- unfolding dist_vector_def ..
- also have "\<dots> \<le> setsum (\<lambda>i. dist (X m $ i) (X n $ i)) UNIV"
- by (rule setL2_le_setsum [OF zero_le_dist])
- also have "\<dots> < setsum (\<lambda>i::'n. ?s) UNIV"
- by (rule setsum_strict_mono, simp_all add: M `M \<le> m` `M \<le> n`)
- also have "\<dots> = r"
- by simp
- finally have "dist (X m) (X n) < r" .
- }
- hence "\<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < r"
- by simp
- then show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < r" ..
-qed
-
-instance "^" :: (complete_space, finite) complete_space
-proof
- fix X :: "nat \<Rightarrow> 'a ^ 'b" assume "Cauchy X"
- have "\<And>i. (\<lambda>n. X n $ i) ----> lim (\<lambda>n. X n $ i)"
- using Cauchy_Cart_nth [OF `Cauchy X`]
- by (simp add: Cauchy_convergent_iff convergent_LIMSEQ_iff)
- hence "X ----> Cart_lambda (\<lambda>i. lim (\<lambda>n. X n $ i))"
- by (simp add: LIMSEQ_vector)
- then show "convergent X"
- by (rule convergentI)
-qed
-
-subsection {* Norms *}
-
-instantiation "^" :: (real_normed_vector, finite) real_normed_vector
-begin
-
-definition norm_vector_def:
- "norm (x::'a^'b) = setL2 (\<lambda>i. norm (x$i)) UNIV"
-
-definition vector_sgn_def:
- "sgn (x::'a^'b) = scaleR (inverse (norm x)) x"
-
-instance proof
- fix a :: real and x y :: "'a ^ 'b"
- show "0 \<le> norm x"
- unfolding norm_vector_def
- by (rule setL2_nonneg)
- show "norm x = 0 \<longleftrightarrow> x = 0"
- unfolding norm_vector_def
- by (simp add: setL2_eq_0_iff Cart_eq)
- show "norm (x + y) \<le> norm x + norm y"
- unfolding norm_vector_def
- apply (rule order_trans [OF _ setL2_triangle_ineq])
- apply (simp add: setL2_mono norm_triangle_ineq)
- done
- show "norm (scaleR a x) = \<bar>a\<bar> * norm x"
- unfolding norm_vector_def
- by (simp add: setL2_right_distrib)
- show "sgn x = scaleR (inverse (norm x)) x"
- by (rule vector_sgn_def)
- show "dist x y = norm (x - y)"
- unfolding dist_vector_def norm_vector_def
- by (simp add: dist_norm)
-qed
-
-end
-
-lemma norm_nth_le: "norm (x $ i) \<le> norm x"
-unfolding norm_vector_def
-by (rule member_le_setL2) simp_all
-
-interpretation Cart_nth: bounded_linear "\<lambda>x. x $ i"
-apply default
-apply (rule vector_add_component)
-apply (rule vector_scaleR_component)
-apply (rule_tac x="1" in exI, simp add: norm_nth_le)
-done
-
-instance "^" :: (banach, finite) banach ..
-
-subsection {* Inner products *}
-
-instantiation "^" :: (real_inner, finite) real_inner
-begin
-
-definition inner_vector_def:
- "inner x y = setsum (\<lambda>i. inner (x$i) (y$i)) UNIV"
-
-instance proof
- fix r :: real and x y z :: "'a ^ 'b"
- show "inner x y = inner y x"
- unfolding inner_vector_def
- by (simp add: inner_commute)
- show "inner (x + y) z = inner x z + inner y z"
- unfolding inner_vector_def
- by (simp add: inner_add_left setsum_addf)
- show "inner (scaleR r x) y = r * inner x y"
- unfolding inner_vector_def
- by (simp add: setsum_right_distrib)
- show "0 \<le> inner x x"
- unfolding inner_vector_def
- by (simp add: setsum_nonneg)
- show "inner x x = 0 \<longleftrightarrow> x = 0"
- unfolding inner_vector_def
- by (simp add: Cart_eq setsum_nonneg_eq_0_iff)
- show "norm x = sqrt (inner x x)"
- unfolding inner_vector_def norm_vector_def setL2_def
- by (simp add: power2_norm_eq_inner)
-qed
-
-end
-
-subsection{* Properties of the dot product. *}
-
-lemma dot_sym: "(x::'a:: {comm_monoid_add, ab_semigroup_mult} ^ 'n) \<bullet> y = y \<bullet> x"
- by (vector mult_commute)
-lemma dot_ladd: "((x::'a::ring ^ 'n) + y) \<bullet> z = (x \<bullet> z) + (y \<bullet> z)"
- by (vector ring_simps)
-lemma dot_radd: "x \<bullet> (y + (z::'a::ring ^ 'n)) = (x \<bullet> y) + (x \<bullet> z)"
- by (vector ring_simps)
-lemma dot_lsub: "((x::'a::ring ^ 'n) - y) \<bullet> z = (x \<bullet> z) - (y \<bullet> z)"
- by (vector ring_simps)
-lemma dot_rsub: "(x::'a::ring ^ 'n) \<bullet> (y - z) = (x \<bullet> y) - (x \<bullet> z)"
- by (vector ring_simps)
-lemma dot_lmult: "(c *s x) \<bullet> y = (c::'a::ring) * (x \<bullet> y)" by (vector ring_simps)
-lemma dot_rmult: "x \<bullet> (c *s y) = (c::'a::comm_ring) * (x \<bullet> y)" by (vector ring_simps)
-lemma dot_lneg: "(-x) \<bullet> (y::'a::ring ^ 'n) = -(x \<bullet> y)" by vector
-lemma dot_rneg: "(x::'a::ring ^ 'n) \<bullet> (-y) = -(x \<bullet> y)" by vector
-lemma dot_lzero[simp]: "0 \<bullet> x = (0::'a::{comm_monoid_add, mult_zero})" by vector
-lemma dot_rzero[simp]: "x \<bullet> 0 = (0::'a::{comm_monoid_add, mult_zero})" by vector
-lemma dot_pos_le[simp]: "(0::'a\<Colon>ordered_ring_strict) <= x \<bullet> x"
- by (simp add: dot_def setsum_nonneg)
-
-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)"
-using fS fp setsum_nonneg[OF fp]
-proof (induct set: finite)
- case empty thus ?case by simp
-next
- case (insert x F)
- from insert.prems have Fx: "f x \<ge> 0" and Fp: "\<forall> a \<in> F. f a \<ge> 0" by simp_all
- from insert.hyps Fp setsum_nonneg[OF Fp]
- have h: "setsum f F = 0 \<longleftrightarrow> (\<forall>a \<in>F. f a = 0)" by metis
- from add_nonneg_eq_0_iff[OF Fx setsum_nonneg[OF Fp]] insert.hyps(1,2)
- show ?case by (simp add: h)
-qed
-
-lemma dot_eq_0: "x \<bullet> x = 0 \<longleftrightarrow> (x::'a::{ordered_ring_strict,ring_no_zero_divisors} ^ 'n::finite) = 0"
- by (simp add: dot_def setsum_squares_eq_0_iff Cart_eq)
-
-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]
- by (auto simp add: le_less)
-
-subsection{* The collapse of the general concepts to dimension one. *}
-
-lemma vector_one: "(x::'a ^1) = (\<chi> i. (x$1))"
- by (simp add: Cart_eq forall_1)
-
-lemma forall_one: "(\<forall>(x::'a ^1). P x) \<longleftrightarrow> (\<forall>x. P(\<chi> i. x))"
- apply auto
- apply (erule_tac x= "x$1" in allE)
- apply (simp only: vector_one[symmetric])
- done
-
-lemma norm_vector_1: "norm (x :: _^1) = norm (x$1)"
- by (simp add: norm_vector_def UNIV_1)
-
-lemma norm_real: "norm(x::real ^ 1) = abs(x$1)"
- by (simp add: norm_vector_1)
-
-lemma dist_real: "dist(x::real ^ 1) y = abs((x$1) - (y$1))"
- by (auto simp add: norm_real dist_norm)
-
-subsection {* A connectedness or intermediate value lemma with several applications. *}
-
-lemma connected_real_lemma:
- fixes f :: "real \<Rightarrow> 'a::metric_space"
- assumes ab: "a \<le> b" and fa: "f a \<in> e1" and fb: "f b \<in> e2"
- 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"
- and e1: "\<forall>y \<in> e1. \<exists>e > 0. \<forall>y'. dist y' y < e \<longrightarrow> y' \<in> e1"
- and e2: "\<forall>y \<in> e2. \<exists>e > 0. \<forall>y'. dist y' y < e \<longrightarrow> y' \<in> e2"
- and e12: "~(\<exists>x \<ge> a. x <= b \<and> f x \<in> e1 \<and> f x \<in> e2)"
- shows "\<exists>x \<ge> a. x <= b \<and> f x \<notin> e1 \<and> f x \<notin> e2" (is "\<exists> x. ?P x")
-proof-
- let ?S = "{c. \<forall>x \<ge> a. x <= c \<longrightarrow> f x \<in> e1}"
- have Se: " \<exists>x. x \<in> ?S" apply (rule exI[where x=a]) by (auto simp add: fa)
- have Sub: "\<exists>y. isUb UNIV ?S y"
- apply (rule exI[where x= b])
- using ab fb e12 by (auto simp add: isUb_def setle_def)
- from reals_complete[OF Se Sub] obtain l where
- l: "isLub UNIV ?S l"by blast
- have alb: "a \<le> l" "l \<le> b" using l ab fa fb e12
- apply (auto simp add: isLub_def leastP_def isUb_def setle_def setge_def)
- by (metis linorder_linear)
- have ale1: "\<forall>z \<ge> a. z < l \<longrightarrow> f z \<in> e1" using l
- apply (auto simp add: isLub_def leastP_def isUb_def setle_def setge_def)
- by (metis linorder_linear not_le)
- have th1: "\<And>z x e d :: real. z <= x + e \<Longrightarrow> e < d ==> z < x \<or> abs(z - x) < d" by arith
- have th2: "\<And>e x:: real. 0 < e ==> ~(x + e <= x)" by arith
- have th3: "\<And>d::real. d > 0 \<Longrightarrow> \<exists>e > 0. e < d" by dlo
- {assume le2: "f l \<in> e2"
- from le2 fa fb e12 alb have la: "l \<noteq> a" by metis
- hence lap: "l - a > 0" using alb by arith
- from e2[rule_format, OF le2] obtain e where
- e: "e > 0" "\<forall>y. dist y (f l) < e \<longrightarrow> y \<in> e2" by metis
- from dst[OF alb e(1)] obtain d where
- d: "d > 0" "\<forall>y. \<bar>y - l\<bar> < d \<longrightarrow> dist (f y) (f l) < e" by metis
- have "\<exists>d'. d' < d \<and> d' >0 \<and> l - d' > a" using lap d(1)
- apply ferrack by arith
- then obtain d' where d': "d' > 0" "d' < d" "l - d' > a" by metis
- from d e have th0: "\<forall>y. \<bar>y - l\<bar> < d \<longrightarrow> f y \<in> e2" by metis
- from th0[rule_format, of "l - d'"] d' have "f (l - d') \<in> e2" by auto
- moreover
- have "f (l - d') \<in> e1" using ale1[rule_format, of "l -d'"] d' by auto
- ultimately have False using e12 alb d' by auto}
- moreover
- {assume le1: "f l \<in> e1"
- from le1 fa fb e12 alb have lb: "l \<noteq> b" by metis
- hence blp: "b - l > 0" using alb by arith
- from e1[rule_format, OF le1] obtain e where
- e: "e > 0" "\<forall>y. dist y (f l) < e \<longrightarrow> y \<in> e1" by metis
- from dst[OF alb e(1)] obtain d where
- d: "d > 0" "\<forall>y. \<bar>y - l\<bar> < d \<longrightarrow> dist (f y) (f l) < e" by metis
- have "\<exists>d'. d' < d \<and> d' >0" using d(1) by dlo
- then obtain d' where d': "d' > 0" "d' < d" by metis
- from d e have th0: "\<forall>y. \<bar>y - l\<bar> < d \<longrightarrow> f y \<in> e1" by auto
- hence "\<forall>y. l \<le> y \<and> y \<le> l + d' \<longrightarrow> f y \<in> e1" using d' by auto
- with ale1 have "\<forall>y. a \<le> y \<and> y \<le> l + d' \<longrightarrow> f y \<in> e1" by auto
- with l d' have False
- by (auto simp add: isLub_def isUb_def setle_def setge_def leastP_def) }
- ultimately show ?thesis using alb by metis
-qed
-
-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"} *}
-
-lemma square_bound_lemma: "(x::real) < (1 + x) * (1 + x)"
-proof-
- have "(x + 1/2)^2 + 3/4 > 0" using zero_le_power2[of "x+1/2"] by arith
- thus ?thesis by (simp add: ring_simps power2_eq_square)
-qed
-
-lemma square_continuous: "0 < (e::real) ==> \<exists>d. 0 < d \<and> (\<forall>y. abs(y - x) < d \<longrightarrow> abs(y * y - x * x) < e)"
- 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)
- apply (rule_tac x="s" in exI)
- apply auto
- apply (erule_tac x=y in allE)
- apply auto
- done
-
-lemma real_le_lsqrt: "0 <= x \<Longrightarrow> 0 <= y \<Longrightarrow> x <= y^2 ==> sqrt x <= y"
- using real_sqrt_le_iff[of x "y^2"] by simp
-
-lemma real_le_rsqrt: "x^2 \<le> y \<Longrightarrow> x \<le> sqrt y"
- using real_sqrt_le_mono[of "x^2" y] by simp
-
-lemma real_less_rsqrt: "x^2 < y \<Longrightarrow> x < sqrt y"
- using real_sqrt_less_mono[of "x^2" y] by simp
-
-lemma sqrt_even_pow2: assumes n: "even n"
- shows "sqrt(2 ^ n) = 2 ^ (n div 2)"
-proof-
- from n obtain m where m: "n = 2*m" unfolding even_nat_equiv_def2
- by (auto simp add: nat_number)
- from m have "sqrt(2 ^ n) = sqrt ((2 ^ m) ^ 2)"
- by (simp only: power_mult[symmetric] mult_commute)
- then show ?thesis using m by simp
-qed
-
-lemma real_div_sqrt: "0 <= x ==> x / sqrt(x) = sqrt(x)"
- apply (cases "x = 0", simp_all)
- using sqrt_divide_self_eq[of x]
- apply (simp add: inverse_eq_divide real_sqrt_ge_0_iff field_simps)
- done
-
-text{* Hence derive more interesting properties of the norm. *}
-
-text {*
- This type-specific version is only here
- to make @{text normarith.ML} happy.
-*}
-lemma norm_0: "norm (0::real ^ _) = 0"
- by (rule norm_zero)
-
-lemma norm_mul[simp]: "norm(a *s x) = abs(a) * norm x"
- by (simp add: norm_vector_def vector_component setL2_right_distrib
- abs_mult cong: strong_setL2_cong)
-lemma norm_eq_0_dot: "(norm x = 0) \<longleftrightarrow> (x \<bullet> x = (0::real))"
- by (simp add: norm_vector_def dot_def setL2_def power2_eq_square)
-lemma real_vector_norm_def: "norm x = sqrt (x \<bullet> x)"
- by (simp add: norm_vector_def setL2_def dot_def power2_eq_square)
-lemma norm_pow_2: "norm x ^ 2 = x \<bullet> x"
- by (simp add: real_vector_norm_def)
-lemma norm_eq_0_imp: "norm x = 0 ==> x = (0::real ^'n::finite)" by (metis norm_eq_zero)
-lemma vector_mul_eq_0[simp]: "(a *s x = 0) \<longleftrightarrow> a = (0::'a::idom) \<or> x = 0"
- by vector
-lemma vector_mul_lcancel[simp]: "a *s x = a *s y \<longleftrightarrow> a = (0::real) \<or> x = y"
- by (metis eq_iff_diff_eq_0 vector_mul_eq_0 vector_ssub_ldistrib)
-lemma vector_mul_rcancel[simp]: "a *s x = b *s x \<longleftrightarrow> (a::real) = b \<or> x = 0"
- by (metis eq_iff_diff_eq_0 vector_mul_eq_0 vector_sub_rdistrib)
-lemma vector_mul_lcancel_imp: "a \<noteq> (0::real) ==> a *s x = a *s y ==> (x = y)"
- by (metis vector_mul_lcancel)
-lemma vector_mul_rcancel_imp: "x \<noteq> 0 \<Longrightarrow> (a::real) *s x = b *s x ==> a = b"
- by (metis vector_mul_rcancel)
-lemma norm_cauchy_schwarz:
- fixes x y :: "real ^ 'n::finite"
- shows "x \<bullet> y <= norm x * norm y"
-proof-
- {assume "norm x = 0"
- hence ?thesis by (simp add: dot_lzero dot_rzero)}
- moreover
- {assume "norm y = 0"
- hence ?thesis by (simp add: dot_lzero dot_rzero)}
- moreover
- {assume h: "norm x \<noteq> 0" "norm y \<noteq> 0"
- let ?z = "norm y *s x - norm x *s y"
- from h have p: "norm x * norm y > 0" by (metis norm_ge_zero le_less zero_compare_simps)
- from dot_pos_le[of ?z]
- have "(norm x * norm y) * (x \<bullet> y) \<le> norm x ^2 * norm y ^2"
- apply (simp add: dot_rsub dot_lsub dot_lmult dot_rmult ring_simps)
- by (simp add: norm_pow_2[symmetric] power2_eq_square dot_sym)
- hence "x\<bullet>y \<le> (norm x ^2 * norm y ^2) / (norm x * norm y)" using p
- by (simp add: field_simps)
- hence ?thesis using h by (simp add: power2_eq_square)}
- ultimately show ?thesis by metis
-qed
-
-lemma norm_cauchy_schwarz_abs:
- fixes x y :: "real ^ 'n::finite"
- shows "\<bar>x \<bullet> y\<bar> \<le> norm x * norm y"
- using norm_cauchy_schwarz[of x y] norm_cauchy_schwarz[of x "-y"]
- by (simp add: real_abs_def dot_rneg)
-
-lemma norm_triangle_sub:
- fixes x y :: "'a::real_normed_vector"
- shows "norm x \<le> norm y + norm (x - y)"
- using norm_triangle_ineq[of "y" "x - y"] by (simp add: ring_simps)
-
-lemma norm_triangle_le: "norm(x::real ^'n::finite) + norm y <= e ==> norm(x + y) <= e"
- by (metis order_trans norm_triangle_ineq)
-lemma norm_triangle_lt: "norm(x::real ^'n::finite) + norm(y) < e ==> norm(x + y) < e"
- by (metis basic_trans_rules(21) norm_triangle_ineq)
-
-lemma component_le_norm: "\<bar>x$i\<bar> <= norm (x::real ^ 'n::finite)"
- apply (simp add: norm_vector_def)
- apply (rule member_le_setL2, simp_all)
- done
-
-lemma norm_bound_component_le: "norm(x::real ^ 'n::finite) <= e
- ==> \<bar>x$i\<bar> <= e"
- by (metis component_le_norm order_trans)
-
-lemma norm_bound_component_lt: "norm(x::real ^ 'n::finite) < e
- ==> \<bar>x$i\<bar> < e"
- by (metis component_le_norm basic_trans_rules(21))
-
-lemma norm_le_l1: "norm (x:: real ^'n::finite) <= setsum(\<lambda>i. \<bar>x$i\<bar>) UNIV"
- by (simp add: norm_vector_def setL2_le_setsum)
-
-lemma real_abs_norm: "\<bar>norm x\<bar> = norm (x :: real ^ _)"
- by (rule abs_norm_cancel)
-lemma real_abs_sub_norm: "\<bar>norm(x::real ^'n::finite) - norm y\<bar> <= norm(x - y)"
- by (rule norm_triangle_ineq3)
-lemma norm_le: "norm(x::real ^ _) <= norm(y) \<longleftrightarrow> x \<bullet> x <= y \<bullet> y"
- by (simp add: real_vector_norm_def)
-lemma norm_lt: "norm(x::real ^ _) < norm(y) \<longleftrightarrow> x \<bullet> x < y \<bullet> y"
- by (simp add: real_vector_norm_def)
-lemma norm_eq: "norm (x::real ^ _) = norm y \<longleftrightarrow> x \<bullet> x = y \<bullet> y"
- by (simp add: order_eq_iff norm_le)
-lemma norm_eq_1: "norm(x::real ^ _) = 1 \<longleftrightarrow> x \<bullet> x = 1"
- by (simp add: real_vector_norm_def)
-
-text{* Squaring equations and inequalities involving norms. *}
-
-lemma dot_square_norm: "x \<bullet> x = norm(x)^2"
- by (simp add: real_vector_norm_def)
-
-lemma norm_eq_square: "norm(x) = a \<longleftrightarrow> 0 <= a \<and> x \<bullet> x = a^2"
- by (auto simp add: real_vector_norm_def)
-
-lemma real_abs_le_square_iff: "\<bar>x\<bar> \<le> \<bar>y\<bar> \<longleftrightarrow> (x::real)^2 \<le> y^2"
-proof-
- have "x^2 \<le> y^2 \<longleftrightarrow> (x -y) * (y + x) \<le> 0" by (simp add: ring_simps power2_eq_square)
- also have "\<dots> \<longleftrightarrow> \<bar>x\<bar> \<le> \<bar>y\<bar>" apply (simp add: zero_compare_simps real_abs_def not_less) by arith
-finally show ?thesis ..
-qed
-
-lemma norm_le_square: "norm(x) <= a \<longleftrightarrow> 0 <= a \<and> x \<bullet> x <= a^2"
- apply (simp add: dot_square_norm real_abs_le_square_iff[symmetric])
- using norm_ge_zero[of x]
- apply arith
- done
-
-lemma norm_ge_square: "norm(x) >= a \<longleftrightarrow> a <= 0 \<or> x \<bullet> x >= a ^ 2"
- apply (simp add: dot_square_norm real_abs_le_square_iff[symmetric])
- using norm_ge_zero[of x]
- apply arith
- done
-
-lemma norm_lt_square: "norm(x) < a \<longleftrightarrow> 0 < a \<and> x \<bullet> x < a^2"
- by (metis not_le norm_ge_square)
-lemma norm_gt_square: "norm(x) > a \<longleftrightarrow> a < 0 \<or> x \<bullet> x > a^2"
- by (metis norm_le_square not_less)
-
-text{* Dot product in terms of the norm rather than conversely. *}
-
-lemma dot_norm: "x \<bullet> y = (norm(x + y) ^2 - norm x ^ 2 - norm y ^ 2) / 2"
- by (simp add: norm_pow_2 dot_ladd dot_radd dot_sym)
-
-lemma dot_norm_neg: "x \<bullet> y = ((norm x ^ 2 + norm y ^ 2) - norm(x - y) ^ 2) / 2"
- by (simp add: norm_pow_2 dot_ladd dot_radd dot_lsub dot_rsub dot_sym)
-
-
-text{* Equality of vectors in terms of @{term "op \<bullet>"} products. *}
-
-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")
-proof
- assume "?lhs" then show ?rhs by simp
-next
- assume ?rhs
- then have "x \<bullet> x - x \<bullet> y = 0 \<and> x \<bullet> y - y\<bullet> y = 0" by simp
- hence "x \<bullet> (x - y) = 0 \<and> y \<bullet> (x - y) = 0"
- by (simp add: dot_rsub dot_lsub dot_sym)
- then have "(x - y) \<bullet> (x - y) = 0" by (simp add: ring_simps dot_lsub dot_rsub)
- then show "x = y" by (simp add: dot_eq_0)
-qed
-
-
-subsection{* General linear decision procedure for normed spaces. *}
-
-lemma norm_cmul_rule_thm:
- fixes x :: "'a::real_normed_vector"
- shows "b >= norm(x) ==> \<bar>c\<bar> * b >= norm(scaleR c x)"
- unfolding norm_scaleR
- apply (erule mult_mono1)
- apply simp
- done
-
- (* FIXME: Move all these theorems into the ML code using lemma antiquotation *)
-lemma norm_add_rule_thm:
- fixes x1 x2 :: "'a::real_normed_vector"
- shows "norm x1 \<le> b1 \<Longrightarrow> norm x2 \<le> b2 \<Longrightarrow> norm (x1 + x2) \<le> b1 + b2"
- by (rule order_trans [OF norm_triangle_ineq add_mono])
-
-lemma ge_iff_diff_ge_0: "(a::'a::ordered_ring) \<ge> b == a - b \<ge> 0"
- by (simp add: ring_simps)
-
-lemma pth_1:
- fixes x :: "'a::real_normed_vector"
- shows "x == scaleR 1 x" by simp
-
-lemma pth_2:
- fixes x :: "'a::real_normed_vector"
- shows "x - y == x + -y" by (atomize (full)) simp
-
-lemma pth_3:
- fixes x :: "'a::real_normed_vector"
- shows "- x == scaleR (-1) x" by simp
-
-lemma pth_4:
- fixes x :: "'a::real_normed_vector"
- shows "scaleR 0 x == 0" and "scaleR c 0 = (0::'a)" by simp_all
-
-lemma pth_5:
- fixes x :: "'a::real_normed_vector"
- shows "scaleR c (scaleR d x) == scaleR (c * d) x" by simp
-
-lemma pth_6:
- fixes x :: "'a::real_normed_vector"
- shows "scaleR c (x + y) == scaleR c x + scaleR c y"
- by (simp add: scaleR_right_distrib)
-
-lemma pth_7:
- fixes x :: "'a::real_normed_vector"
- shows "0 + x == x" and "x + 0 == x" by simp_all
-
-lemma pth_8:
- fixes x :: "'a::real_normed_vector"
- shows "scaleR c x + scaleR d x == scaleR (c + d) x"
- by (simp add: scaleR_left_distrib)
-
-lemma pth_9:
- fixes x :: "'a::real_normed_vector" shows
- "(scaleR c x + z) + scaleR d x == scaleR (c + d) x + z"
- "scaleR c x + (scaleR d x + z) == scaleR (c + d) x + z"
- "(scaleR c x + w) + (scaleR d x + z) == scaleR (c + d) x + (w + z)"
- by (simp_all add: algebra_simps)
-
-lemma pth_a:
- fixes x :: "'a::real_normed_vector"
- shows "scaleR 0 x + y == y" by simp
-
-lemma pth_b:
- fixes x :: "'a::real_normed_vector" shows
- "scaleR c x + scaleR d y == scaleR c x + scaleR d y"
- "(scaleR c x + z) + scaleR d y == scaleR c x + (z + scaleR d y)"
- "scaleR c x + (scaleR d y + z) == scaleR c x + (scaleR d y + z)"
- "(scaleR c x + w) + (scaleR d y + z) == scaleR c x + (w + (scaleR d y + z))"
- by (simp_all add: algebra_simps)
-
-lemma pth_c:
- fixes x :: "'a::real_normed_vector" shows
- "scaleR c x + scaleR d y == scaleR d y + scaleR c x"
- "(scaleR c x + z) + scaleR d y == scaleR d y + (scaleR c x + z)"
- "scaleR c x + (scaleR d y + z) == scaleR d y + (scaleR c x + z)"
- "(scaleR c x + w) + (scaleR d y + z) == scaleR d y + ((scaleR c x + w) + z)"
- by (simp_all add: algebra_simps)
-
-lemma pth_d:
- fixes x :: "'a::real_normed_vector"
- shows "x + 0 == x" by simp
-
-lemma norm_imp_pos_and_ge:
- fixes x :: "'a::real_normed_vector"
- shows "norm x == n \<Longrightarrow> norm x \<ge> 0 \<and> n \<ge> norm x"
- by atomize auto
-
-lemma real_eq_0_iff_le_ge_0: "(x::real) = 0 == x \<ge> 0 \<and> -x \<ge> 0" by arith
-
-lemma norm_pths:
- fixes x :: "'a::real_normed_vector" shows
- "x = y \<longleftrightarrow> norm (x - y) \<le> 0"
- "x \<noteq> y \<longleftrightarrow> \<not> (norm (x - y) \<le> 0)"
- using norm_ge_zero[of "x - y"] by auto
-
-lemma vector_dist_norm:
- fixes x :: "'a::real_normed_vector"
- shows "dist x y = norm (x - y)"
- by (rule dist_norm)
-
-use "normarith.ML"
-
-method_setup norm = {* Scan.succeed (SIMPLE_METHOD' o NormArith.norm_arith_tac)
-*} "Proves simple linear statements about vector norms"
-
-
-text{* Hence more metric properties. *}
-
-lemma dist_triangle_alt:
- fixes x y z :: "'a::metric_space"
- shows "dist y z <= dist x y + dist x z"
-using dist_triangle [of y z x] by (simp add: dist_commute)
-
-lemma dist_pos_lt:
- fixes x y :: "'a::metric_space"
- shows "x \<noteq> y ==> 0 < dist x y"
-by (simp add: zero_less_dist_iff)
-
-lemma dist_nz:
- fixes x y :: "'a::metric_space"
- shows "x \<noteq> y \<longleftrightarrow> 0 < dist x y"
-by (simp add: zero_less_dist_iff)
-
-lemma dist_triangle_le:
- fixes x y z :: "'a::metric_space"
- shows "dist x z + dist y z <= e \<Longrightarrow> dist x y <= e"
-by (rule order_trans [OF dist_triangle2])
-
-lemma dist_triangle_lt:
- fixes x y z :: "'a::metric_space"
- shows "dist x z + dist y z < e ==> dist x y < e"
-by (rule le_less_trans [OF dist_triangle2])
-
-lemma dist_triangle_half_l:
- fixes x1 x2 y :: "'a::metric_space"
- shows "dist x1 y < e / 2 \<Longrightarrow> dist x2 y < e / 2 \<Longrightarrow> dist x1 x2 < e"
-by (rule dist_triangle_lt [where z=y], simp)
-
-lemma dist_triangle_half_r:
- fixes x1 x2 y :: "'a::metric_space"
- shows "dist y x1 < e / 2 \<Longrightarrow> dist y x2 < e / 2 \<Longrightarrow> dist x1 x2 < e"
-by (rule dist_triangle_half_l, simp_all add: dist_commute)
-
-lemma dist_triangle_add:
- fixes x y x' y' :: "'a::real_normed_vector"
- shows "dist (x + y) (x' + y') <= dist x x' + dist y y'"
- by norm
-
-lemma dist_mul[simp]: "dist (c *s x) (c *s y) = \<bar>c\<bar> * dist x y"
- unfolding dist_norm vector_ssub_ldistrib[symmetric] norm_mul ..
-
-lemma dist_triangle_add_half:
- fixes x x' y y' :: "'a::real_normed_vector"
- shows "dist x x' < e / 2 \<Longrightarrow> dist y y' < e / 2 \<Longrightarrow> dist(x + y) (x' + y') < e"
- by norm
-
-lemma setsum_component [simp]:
- fixes f:: " 'a \<Rightarrow> ('b::comm_monoid_add) ^'n"
- shows "(setsum f S)$i = setsum (\<lambda>x. (f x)$i) S"
- by (cases "finite S", induct S set: finite, simp_all)
-
-lemma setsum_eq: "setsum f S = (\<chi> i. setsum (\<lambda>x. (f x)$i ) S)"
- by (simp add: Cart_eq)
-
-lemma setsum_clauses:
- shows "setsum f {} = 0"
- and "finite S \<Longrightarrow> setsum f (insert x S) =
- (if x \<in> S then setsum f S else f x + setsum f S)"
- by (auto simp add: insert_absorb)
-
-lemma setsum_cmul:
- fixes f:: "'c \<Rightarrow> ('a::semiring_1)^'n"
- shows "setsum (\<lambda>x. c *s f x) S = c *s setsum f S"
- by (simp add: Cart_eq setsum_right_distrib)
-
-lemma setsum_norm:
- fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
- assumes fS: "finite S"
- shows "norm (setsum f S) <= setsum (\<lambda>x. norm(f x)) S"
-proof(induct rule: finite_induct[OF fS])
- case 1 thus ?case by simp
-next
- case (2 x S)
- from "2.hyps" have "norm (setsum f (insert x S)) \<le> norm (f x) + norm (setsum f S)" by (simp add: norm_triangle_ineq)
- also have "\<dots> \<le> norm (f x) + setsum (\<lambda>x. norm(f x)) S"
- using "2.hyps" by simp
- finally show ?case using "2.hyps" by simp
-qed
-
-lemma real_setsum_norm:
- fixes f :: "'a \<Rightarrow> real ^'n::finite"
- assumes fS: "finite S"
- shows "norm (setsum f S) <= setsum (\<lambda>x. norm(f x)) S"
-proof(induct rule: finite_induct[OF fS])
- case 1 thus ?case by simp
-next
- case (2 x S)
- from "2.hyps" have "norm (setsum f (insert x S)) \<le> norm (f x) + norm (setsum f S)" by (simp add: norm_triangle_ineq)
- also have "\<dots> \<le> norm (f x) + setsum (\<lambda>x. norm(f x)) S"
- using "2.hyps" by simp
- finally show ?case using "2.hyps" by simp
-qed
-
-lemma setsum_norm_le:
- fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
- assumes fS: "finite S"
- and fg: "\<forall>x \<in> S. norm (f x) \<le> g x"
- shows "norm (setsum f S) \<le> setsum g S"
-proof-
- from fg have "setsum (\<lambda>x. norm(f x)) S <= setsum g S"
- by - (rule setsum_mono, simp)
- then show ?thesis using setsum_norm[OF fS, of f] fg
- by arith
-qed
-
-lemma real_setsum_norm_le:
- fixes f :: "'a \<Rightarrow> real ^ 'n::finite"
- assumes fS: "finite S"
- and fg: "\<forall>x \<in> S. norm (f x) \<le> g x"
- shows "norm (setsum f S) \<le> setsum g S"
-proof-
- from fg have "setsum (\<lambda>x. norm(f x)) S <= setsum g S"
- by - (rule setsum_mono, simp)
- then show ?thesis using real_setsum_norm[OF fS, of f] fg
- by arith
-qed
-
-lemma setsum_norm_bound:
- fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
- assumes fS: "finite S"
- and K: "\<forall>x \<in> S. norm (f x) \<le> K"
- shows "norm (setsum f S) \<le> of_nat (card S) * K"
- using setsum_norm_le[OF fS K] setsum_constant[symmetric]
- by simp
-
-lemma real_setsum_norm_bound:
- fixes f :: "'a \<Rightarrow> real ^ 'n::finite"
- assumes fS: "finite S"
- and K: "\<forall>x \<in> S. norm (f x) \<le> K"
- shows "norm (setsum f S) \<le> of_nat (card S) * K"
- using real_setsum_norm_le[OF fS K] setsum_constant[symmetric]
- by simp
-
-lemma setsum_vmul:
- fixes f :: "'a \<Rightarrow> 'b::{real_normed_vector,semiring, mult_zero}"
- assumes fS: "finite S"
- shows "setsum f S *s v = setsum (\<lambda>x. f x *s v) S"
-proof(induct rule: finite_induct[OF fS])
- case 1 then show ?case by (simp add: vector_smult_lzero)
-next
- case (2 x F)
- from "2.hyps" have "setsum f (insert x F) *s v = (f x + setsum f F) *s v"
- by simp
- also have "\<dots> = f x *s v + setsum f F *s v"
- by (simp add: vector_sadd_rdistrib)
- also have "\<dots> = setsum (\<lambda>x. f x *s v) (insert x F)" using "2.hyps" by simp
- finally show ?case .
-qed
-
-(* FIXME : Problem thm setsum_vmul[of _ "f:: 'a \<Rightarrow> real ^'n"] ---
- Get rid of *s and use real_vector instead! Also prove that ^ creates a real_vector !! *)
-
- (* FIXME: Here too need stupid finiteness assumption on T!!! *)
-lemma setsum_group:
- assumes fS: "finite S" and fT: "finite T" and fST: "f ` S \<subseteq> T"
- shows "setsum (\<lambda>y. setsum g {x. x\<in> S \<and> f x = y}) T = setsum g S"
-
-apply (subst setsum_image_gen[OF fS, of g f])
-apply (rule setsum_mono_zero_right[OF fT fST])
-by (auto intro: setsum_0')
-
-lemma vsum_norm_allsubsets_bound:
- fixes f:: "'a \<Rightarrow> real ^'n::finite"
- assumes fP: "finite P" and fPs: "\<And>Q. Q \<subseteq> P \<Longrightarrow> norm (setsum f Q) \<le> e"
- shows "setsum (\<lambda>x. norm (f x)) P \<le> 2 * real CARD('n) * e"
-proof-
- let ?d = "real CARD('n)"
- let ?nf = "\<lambda>x. norm (f x)"
- let ?U = "UNIV :: 'n set"
- 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"
- by (rule setsum_commute)
- have th1: "2 * ?d * e = of_nat (card ?U) * (2 * e)" by (simp add: real_of_nat_def)
- have "setsum ?nf P \<le> setsum (\<lambda>x. setsum (\<lambda>i. \<bar>f x $ i\<bar>) ?U) P"
- apply (rule setsum_mono)
- by (rule norm_le_l1)
- also have "\<dots> \<le> 2 * ?d * e"
- unfolding th0 th1
- proof(rule setsum_bounded)
- fix i assume i: "i \<in> ?U"
- let ?Pp = "{x. x\<in> P \<and> f x $ i \<ge> 0}"
- let ?Pn = "{x. x \<in> P \<and> f x $ i < 0}"
- have thp: "P = ?Pp \<union> ?Pn" by auto
- have thp0: "?Pp \<inter> ?Pn ={}" by auto
- have PpP: "?Pp \<subseteq> P" and PnP: "?Pn \<subseteq> P" by blast+
- have Ppe:"setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pp \<le> e"
- using component_le_norm[of "setsum (\<lambda>x. f x) ?Pp" i] fPs[OF PpP]
- by (auto intro: abs_le_D1)
- have Pne: "setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pn \<le> e"
- using component_le_norm[of "setsum (\<lambda>x. - f x) ?Pn" i] fPs[OF PnP]
- by (auto simp add: setsum_negf intro: abs_le_D1)
- 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"
- apply (subst thp)
- apply (rule setsum_Un_zero)
- using fP thp0 by auto
- also have "\<dots> \<le> 2*e" using Pne Ppe by arith
- finally show "setsum (\<lambda>x. \<bar>f x $ i\<bar>) P \<le> 2*e" .
- qed
- finally show ?thesis .
-qed
-
-lemma dot_lsum: "finite S \<Longrightarrow> setsum f S \<bullet> (y::'a::{comm_ring}^'n) = setsum (\<lambda>x. f x \<bullet> y) S "
- by (induct rule: finite_induct, auto simp add: dot_lzero dot_ladd dot_radd)
-
-lemma dot_rsum: "finite S \<Longrightarrow> (y::'a::{comm_ring}^'n) \<bullet> setsum f S = setsum (\<lambda>x. y \<bullet> f x) S "
- by (induct rule: finite_induct, auto simp add: dot_rzero dot_radd)
-
-subsection{* Basis vectors in coordinate directions. *}
-
-
-definition "basis k = (\<chi> i. if i = k then 1 else 0)"
-
-lemma basis_component [simp]: "basis k $ i = (if k=i then 1 else 0)"
- unfolding basis_def by simp
-
-lemma delta_mult_idempotent:
- "(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)
-
-lemma norm_basis:
- shows "norm (basis k :: real ^'n::finite) = 1"
- apply (simp add: basis_def real_vector_norm_def dot_def)
- apply (vector delta_mult_idempotent)
- using setsum_delta[of "UNIV :: 'n set" "k" "\<lambda>k. 1::real"]
- apply auto
- done
-
-lemma norm_basis_1: "norm(basis 1 :: real ^'n::{finite,one}) = 1"
- by (rule norm_basis)
-
-lemma vector_choose_size: "0 <= c ==> \<exists>(x::real^'n::finite). norm x = c"
- apply (rule exI[where x="c *s basis arbitrary"])
- by (simp only: norm_mul norm_basis)
-
-lemma vector_choose_dist: assumes e: "0 <= e"
- shows "\<exists>(y::real^'n::finite). dist x y = e"
-proof-
- from vector_choose_size[OF e] obtain c:: "real ^'n" where "norm c = e"
- by blast
- then have "dist x (x - c) = e" by (simp add: dist_norm)
- then show ?thesis by blast
-qed
-
-lemma basis_inj: "inj (basis :: 'n \<Rightarrow> real ^'n::finite)"
- by (simp add: inj_on_def Cart_eq)
-
-lemma cond_value_iff: "f (if b then x else y) = (if b then f x else f y)"
- by auto
-
-lemma basis_expansion:
- "setsum (\<lambda>i. (x$i) *s basis i) UNIV = (x::('a::ring_1) ^'n::finite)" (is "?lhs = ?rhs" is "setsum ?f ?S = _")
- by (auto simp add: Cart_eq cond_value_iff setsum_delta[of "?S", where ?'b = "'a", simplified] cong del: if_weak_cong)
-
-lemma basis_expansion_unique:
- "setsum (\<lambda>i. f i *s basis i) UNIV = (x::('a::comm_ring_1) ^'n::finite) \<longleftrightarrow> (\<forall>i. f i = x$i)"
- by (simp add: Cart_eq setsum_delta cond_value_iff cong del: if_weak_cong)
-
-lemma cond_application_beta: "(if b then f else g) x = (if b then f x else g x)"
- by auto
-
-lemma dot_basis:
- shows "basis i \<bullet> x = x$i" "x \<bullet> (basis i :: 'a^'n::finite) = (x$i :: 'a::semiring_1)"
- by (auto simp add: dot_def basis_def cond_application_beta cond_value_iff setsum_delta cong del: if_weak_cong)
-
-lemma inner_basis:
- fixes x :: "'a::{real_inner, real_algebra_1} ^ 'n::finite"
- shows "inner (basis i) x = inner 1 (x $ i)"
- and "inner x (basis i) = inner (x $ i) 1"
- unfolding inner_vector_def basis_def
- by (auto simp add: cond_application_beta cond_value_iff setsum_delta cong del: if_weak_cong)
-
-lemma basis_eq_0: "basis i = (0::'a::semiring_1^'n) \<longleftrightarrow> False"
- by (auto simp add: Cart_eq)
-
-lemma basis_nonzero:
- shows "basis k \<noteq> (0:: 'a::semiring_1 ^'n)"
- by (simp add: basis_eq_0)
-
-lemma vector_eq_ldot: "(\<forall>x. x \<bullet> y = x \<bullet> z) \<longleftrightarrow> y = (z::'a::semiring_1^'n::finite)"
- apply (auto simp add: Cart_eq dot_basis)
- apply (erule_tac x="basis i" in allE)
- apply (simp add: dot_basis)
- apply (subgoal_tac "y = z")
- apply simp
- apply (simp add: Cart_eq)
- done
-
-lemma vector_eq_rdot: "(\<forall>z. x \<bullet> z = y \<bullet> z) \<longleftrightarrow> x = (y::'a::semiring_1^'n::finite)"
- apply (auto simp add: Cart_eq dot_basis)
- apply (erule_tac x="basis i" in allE)
- apply (simp add: dot_basis)
- apply (subgoal_tac "x = y")
- apply simp
- apply (simp add: Cart_eq)
- done
-
-subsection{* Orthogonality. *}
-
-definition "orthogonal x y \<longleftrightarrow> (x \<bullet> y = 0)"
-
-lemma orthogonal_basis:
- shows "orthogonal (basis i :: 'a^'n::finite) x \<longleftrightarrow> x$i = (0::'a::ring_1)"
- by (auto simp add: orthogonal_def dot_def basis_def cond_value_iff cond_application_beta setsum_delta cong del: if_weak_cong)
-
-lemma orthogonal_basis_basis:
- shows "orthogonal (basis i :: 'a::ring_1^'n::finite) (basis j) \<longleftrightarrow> i \<noteq> j"
- unfolding orthogonal_basis[of i] basis_component[of j] by simp
-
- (* FIXME : Maybe some of these require less than comm_ring, but not all*)
-lemma orthogonal_clauses:
- "orthogonal a (0::'a::comm_ring ^'n)"
- "orthogonal a x ==> orthogonal a (c *s x)"
- "orthogonal a x ==> orthogonal a (-x)"
- "orthogonal a x \<Longrightarrow> orthogonal a y ==> orthogonal a (x + y)"
- "orthogonal a x \<Longrightarrow> orthogonal a y ==> orthogonal a (x - y)"
- "orthogonal 0 a"
- "orthogonal x a ==> orthogonal (c *s x) a"
- "orthogonal x a ==> orthogonal (-x) a"
- "orthogonal x a \<Longrightarrow> orthogonal y a ==> orthogonal (x + y) a"
- "orthogonal x a \<Longrightarrow> orthogonal y a ==> orthogonal (x - y) a"
- unfolding orthogonal_def dot_rneg dot_rmult dot_radd dot_rsub
- dot_lzero dot_rzero dot_lneg dot_lmult dot_ladd dot_lsub
- by simp_all
-
-lemma orthogonal_commute: "orthogonal (x::'a::{ab_semigroup_mult,comm_monoid_add} ^'n)y \<longleftrightarrow> orthogonal y x"
- by (simp add: orthogonal_def dot_sym)
-
-subsection{* Explicit vector construction from lists. *}
-
-primrec from_nat :: "nat \<Rightarrow> 'a::{monoid_add,one}"
-where "from_nat 0 = 0" | "from_nat (Suc n) = 1 + from_nat n"
-
-lemma from_nat [simp]: "from_nat = of_nat"
-by (rule ext, induct_tac x, simp_all)
-
-primrec
- list_fun :: "nat \<Rightarrow> _ list \<Rightarrow> _ \<Rightarrow> _"
-where
- "list_fun n [] = (\<lambda>x. 0)"
-| "list_fun n (x # xs) = fun_upd (list_fun (Suc n) xs) (from_nat n) x"
-
-definition "vector l = (\<chi> i. list_fun 1 l i)"
-(*definition "vector l = (\<chi> i. if i <= length l then l ! (i - 1) else 0)"*)
-
-lemma vector_1: "(vector[x]) $1 = x"
- unfolding vector_def by simp
-
-lemma vector_2:
- "(vector[x,y]) $1 = x"
- "(vector[x,y] :: 'a^2)$2 = (y::'a::zero)"
- unfolding vector_def by simp_all
-
-lemma vector_3:
- "(vector [x,y,z] ::('a::zero)^3)$1 = x"
- "(vector [x,y,z] ::('a::zero)^3)$2 = y"
- "(vector [x,y,z] ::('a::zero)^3)$3 = z"
- unfolding vector_def by simp_all
-
-lemma forall_vector_1: "(\<forall>v::'a::zero^1. P v) \<longleftrightarrow> (\<forall>x. P(vector[x]))"
- apply auto
- apply (erule_tac x="v$1" in allE)
- apply (subgoal_tac "vector [v$1] = v")
- apply simp
- apply (vector vector_def)
- apply (simp add: forall_1)
- done
-
-lemma forall_vector_2: "(\<forall>v::'a::zero^2. P v) \<longleftrightarrow> (\<forall>x y. P(vector[x, y]))"
- apply auto
- apply (erule_tac x="v$1" in allE)
- apply (erule_tac x="v$2" in allE)
- apply (subgoal_tac "vector [v$1, v$2] = v")
- apply simp
- apply (vector vector_def)
- apply (simp add: forall_2)
- done
-
-lemma forall_vector_3: "(\<forall>v::'a::zero^3. P v) \<longleftrightarrow> (\<forall>x y z. P(vector[x, y, z]))"
- apply auto
- apply (erule_tac x="v$1" in allE)
- apply (erule_tac x="v$2" in allE)
- apply (erule_tac x="v$3" in allE)
- apply (subgoal_tac "vector [v$1, v$2, v$3] = v")
- apply simp
- apply (vector vector_def)
- apply (simp add: forall_3)
- done
-
-subsection{* Linear functions. *}
-
-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)"
-
-lemma linear_compose_cmul: "linear f ==> linear (\<lambda>x. (c::'a::comm_semiring) *s f x)"
- by (vector linear_def Cart_eq ring_simps)
-
-lemma linear_compose_neg: "linear (f :: 'a ^'n \<Rightarrow> 'a::comm_ring ^'m) ==> linear (\<lambda>x. -(f(x)))" by (vector linear_def Cart_eq)
-
-lemma linear_compose_add: "linear (f :: 'a ^'n \<Rightarrow> 'a::semiring_1 ^'m) \<Longrightarrow> linear g ==> linear (\<lambda>x. f(x) + g(x))"
- by (vector linear_def Cart_eq ring_simps)
-
-lemma linear_compose_sub: "linear (f :: 'a ^'n \<Rightarrow> 'a::ring_1 ^'m) \<Longrightarrow> linear g ==> linear (\<lambda>x. f x - g x)"
- by (vector linear_def Cart_eq ring_simps)
-
-lemma linear_compose: "linear f \<Longrightarrow> linear g ==> linear (g o f)"
- by (simp add: linear_def)
-
-lemma linear_id: "linear id" by (simp add: linear_def id_def)
-
-lemma linear_zero: "linear (\<lambda>x. 0::'a::semiring_1 ^ 'n)" by (simp add: linear_def)
-
-lemma linear_compose_setsum:
- assumes fS: "finite S" and lS: "\<forall>a \<in> S. linear (f a :: 'a::semiring_1 ^ 'n \<Rightarrow> 'a ^ 'm)"
- shows "linear(\<lambda>x. setsum (\<lambda>a. f a x :: 'a::semiring_1 ^'m) S)"
- using lS
- apply (induct rule: finite_induct[OF fS])
- by (auto simp add: linear_zero intro: linear_compose_add)
-
-lemma linear_vmul_component:
- fixes f:: "'a::semiring_1^'m \<Rightarrow> 'a^'n"
- assumes lf: "linear f"
- shows "linear (\<lambda>x. f x $ k *s v)"
- using lf
- apply (auto simp add: linear_def )
- by (vector ring_simps)+
-
-lemma linear_0: "linear f ==> f 0 = (0::'a::semiring_1 ^'n)"
- unfolding linear_def
- apply clarsimp
- apply (erule allE[where x="0::'a"])
- apply simp
- done
-
-lemma linear_cmul: "linear f ==> f(c*s x) = c *s f x" by (simp add: linear_def)
-
-lemma linear_neg: "linear (f :: 'a::ring_1 ^'n \<Rightarrow> _) ==> f (-x) = - f x"
- unfolding vector_sneg_minus1
- using linear_cmul[of f] by auto
-
-lemma linear_add: "linear f ==> f(x + y) = f x + f y" by (metis linear_def)
-
-lemma linear_sub: "linear (f::'a::ring_1 ^'n \<Rightarrow> _) ==> f(x - y) = f x - f y"
- by (simp add: diff_def linear_add linear_neg)
-
-lemma linear_setsum:
- fixes f:: "'a::semiring_1^'n \<Rightarrow> _"
- assumes lf: "linear f" and fS: "finite S"
- shows "f (setsum g S) = setsum (f o g) S"
-proof (induct rule: finite_induct[OF fS])
- case 1 thus ?case by (simp add: linear_0[OF lf])
-next
- case (2 x F)
- have "f (setsum g (insert x F)) = f (g x + setsum g F)" using "2.hyps"
- by simp
- also have "\<dots> = f (g x) + f (setsum g F)" using linear_add[OF lf] by simp
- also have "\<dots> = setsum (f o g) (insert x F)" using "2.hyps" by simp
- finally show ?case .
-qed
-
-lemma linear_setsum_mul:
- fixes f:: "'a ^'n \<Rightarrow> 'a::semiring_1^'m"
- assumes lf: "linear f" and fS: "finite S"
- shows "f (setsum (\<lambda>i. c i *s v i) S) = setsum (\<lambda>i. c i *s f (v i)) S"
- using linear_setsum[OF lf fS, of "\<lambda>i. c i *s v i" , unfolded o_def]
- linear_cmul[OF lf] by simp
-
-lemma linear_injective_0:
- assumes lf: "linear (f:: 'a::ring_1 ^ 'n \<Rightarrow> _)"
- shows "inj f \<longleftrightarrow> (\<forall>x. f x = 0 \<longrightarrow> x = 0)"
-proof-
- have "inj f \<longleftrightarrow> (\<forall> x y. f x = f y \<longrightarrow> x = y)" by (simp add: inj_on_def)
- also have "\<dots> \<longleftrightarrow> (\<forall> x y. f x - f y = 0 \<longrightarrow> x - y = 0)" by simp
- also have "\<dots> \<longleftrightarrow> (\<forall> x y. f (x - y) = 0 \<longrightarrow> x - y = 0)"
- by (simp add: linear_sub[OF lf])
- also have "\<dots> \<longleftrightarrow> (\<forall> x. f x = 0 \<longrightarrow> x = 0)" by auto
- finally show ?thesis .
-qed
-
-lemma linear_bounded:
- fixes f:: "real ^'m::finite \<Rightarrow> real ^'n::finite"
- assumes lf: "linear f"
- shows "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
-proof-
- let ?S = "UNIV:: 'm set"
- let ?B = "setsum (\<lambda>i. norm(f(basis i))) ?S"
- have fS: "finite ?S" by simp
- {fix x:: "real ^ 'm"
- let ?g = "(\<lambda>i. (x$i) *s (basis i) :: real ^ 'm)"
- have "norm (f x) = norm (f (setsum (\<lambda>i. (x$i) *s (basis i)) ?S))"
- by (simp only: basis_expansion)
- also have "\<dots> = norm (setsum (\<lambda>i. (x$i) *s f (basis i))?S)"
- using linear_setsum[OF lf fS, of ?g, unfolded o_def] linear_cmul[OF lf]
- by auto
- finally have th0: "norm (f x) = norm (setsum (\<lambda>i. (x$i) *s f (basis i))?S)" .
- {fix i assume i: "i \<in> ?S"
- from component_le_norm[of x i]
- have "norm ((x$i) *s f (basis i :: real ^'m)) \<le> norm (f (basis i)) * norm x"
- unfolding norm_mul
- apply (simp only: mult_commute)
- apply (rule mult_mono)
- by (auto simp add: ring_simps norm_ge_zero) }
- 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
- from real_setsum_norm_le[OF fS, of "\<lambda>i. (x$i) *s (f (basis i))", OF th]
- have "norm (f x) \<le> ?B * norm x" unfolding th0 setsum_left_distrib by metis}
- then show ?thesis by blast
-qed
-
-lemma linear_bounded_pos:
- fixes f:: "real ^'n::finite \<Rightarrow> real ^ 'm::finite"
- assumes lf: "linear f"
- shows "\<exists>B > 0. \<forall>x. norm (f x) \<le> B * norm x"
-proof-
- from linear_bounded[OF lf] obtain B where
- B: "\<forall>x. norm (f x) \<le> B * norm x" by blast
- let ?K = "\<bar>B\<bar> + 1"
- have Kp: "?K > 0" by arith
- {assume C: "B < 0"
- have "norm (1::real ^ 'n) > 0" by (simp add: zero_less_norm_iff)
- with C have "B * norm (1:: real ^ 'n) < 0"
- by (simp add: zero_compare_simps)
- with B[rule_format, of 1] norm_ge_zero[of "f 1"] have False by simp
- }
- then have Bp: "B \<ge> 0" by ferrack
- {fix x::"real ^ 'n"
- have "norm (f x) \<le> ?K * norm x"
- using B[rule_format, of x] norm_ge_zero[of x] norm_ge_zero[of "f x"] Bp
- apply (auto simp add: ring_simps split add: abs_split)
- apply (erule order_trans, simp)
- done
- }
- then show ?thesis using Kp by blast
-qed
-
-lemma smult_conv_scaleR: "c *s x = scaleR c x"
- unfolding vector_scalar_mult_def vector_scaleR_def by simp
-
-lemma linear_conv_bounded_linear:
- fixes f :: "real ^ _ \<Rightarrow> real ^ _"
- shows "linear f \<longleftrightarrow> bounded_linear f"
-proof
- assume "linear f"
- show "bounded_linear f"
- proof
- fix x y show "f (x + y) = f x + f y"
- using `linear f` unfolding linear_def by simp
- next
- fix r x show "f (scaleR r x) = scaleR r (f x)"
- using `linear f` unfolding linear_def
- by (simp add: smult_conv_scaleR)
- next
- have "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
- using `linear f` by (rule linear_bounded)
- thus "\<exists>K. \<forall>x. norm (f x) \<le> norm x * K"
- by (simp add: mult_commute)
- qed
-next
- assume "bounded_linear f"
- then interpret f: bounded_linear f .
- show "linear f"
- unfolding linear_def smult_conv_scaleR
- by (simp add: f.add f.scaleR)
-qed
-
-subsection{* Bilinear functions. *}
-
-definition "bilinear f \<longleftrightarrow> (\<forall>x. linear(\<lambda>y. f x y)) \<and> (\<forall>y. linear(\<lambda>x. f x y))"
-
-lemma bilinear_ladd: "bilinear h ==> h (x + y) z = (h x z) + (h y z)"
- by (simp add: bilinear_def linear_def)
-lemma bilinear_radd: "bilinear h ==> h x (y + z) = (h x y) + (h x z)"
- by (simp add: bilinear_def linear_def)
-
-lemma bilinear_lmul: "bilinear h ==> h (c *s x) y = c *s (h x y)"
- by (simp add: bilinear_def linear_def)
-
-lemma bilinear_rmul: "bilinear h ==> h x (c *s y) = c *s (h x y)"
- by (simp add: bilinear_def linear_def)
-
-lemma bilinear_lneg: "bilinear h ==> h (- (x:: 'a::ring_1 ^ 'n)) y = -(h x y)"
- by (simp only: vector_sneg_minus1 bilinear_lmul)
-
-lemma bilinear_rneg: "bilinear h ==> h x (- (y:: 'a::ring_1 ^ 'n)) = - h x y"
- by (simp only: vector_sneg_minus1 bilinear_rmul)
-
-lemma (in ab_group_add) eq_add_iff: "x = x + y \<longleftrightarrow> y = 0"
- using add_imp_eq[of x y 0] by auto
-
-lemma bilinear_lzero:
- fixes h :: "'a::ring^'n \<Rightarrow> _" assumes bh: "bilinear h" shows "h 0 x = 0"
- using bilinear_ladd[OF bh, of 0 0 x]
- by (simp add: eq_add_iff ring_simps)
-
-lemma bilinear_rzero:
- fixes h :: "'a::ring^'n \<Rightarrow> _" assumes bh: "bilinear h" shows "h x 0 = 0"
- using bilinear_radd[OF bh, of x 0 0 ]
- by (simp add: eq_add_iff ring_simps)
-
-lemma bilinear_lsub: "bilinear h ==> h (x - (y:: 'a::ring_1 ^ 'n)) z = h x z - h y z"
- by (simp add: diff_def bilinear_ladd bilinear_lneg)
-
-lemma bilinear_rsub: "bilinear h ==> h z (x - (y:: 'a::ring_1 ^ 'n)) = h z x - h z y"
- by (simp add: diff_def bilinear_radd bilinear_rneg)
-
-lemma bilinear_setsum:
- fixes h:: "'a ^'n \<Rightarrow> 'a::semiring_1^'m \<Rightarrow> 'a ^ 'k"
- assumes bh: "bilinear h" and fS: "finite S" and fT: "finite T"
- shows "h (setsum f S) (setsum g T) = setsum (\<lambda>(i,j). h (f i) (g j)) (S \<times> T) "
-proof-
- have "h (setsum f S) (setsum g T) = setsum (\<lambda>x. h (f x) (setsum g T)) S"
- apply (rule linear_setsum[unfolded o_def])
- using bh fS by (auto simp add: bilinear_def)
- also have "\<dots> = setsum (\<lambda>x. setsum (\<lambda>y. h (f x) (g y)) T) S"
- apply (rule setsum_cong, simp)
- apply (rule linear_setsum[unfolded o_def])
- using bh fT by (auto simp add: bilinear_def)
- finally show ?thesis unfolding setsum_cartesian_product .
-qed
-
-lemma bilinear_bounded:
- fixes h:: "real ^'m::finite \<Rightarrow> real^'n::finite \<Rightarrow> real ^ 'k::finite"
- assumes bh: "bilinear h"
- shows "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
-proof-
- let ?M = "UNIV :: 'm set"
- let ?N = "UNIV :: 'n set"
- let ?B = "setsum (\<lambda>(i,j). norm (h (basis i) (basis j))) (?M \<times> ?N)"
- have fM: "finite ?M" and fN: "finite ?N" by simp_all
- {fix x:: "real ^ 'm" and y :: "real^'n"
- 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 ..
- 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] ..
- finally have th: "norm (h x y) = \<dots>" .
- have "norm (h x y) \<le> ?B * norm x * norm y"
- apply (simp add: setsum_left_distrib th)
- apply (rule real_setsum_norm_le)
- using fN fM
- apply simp
- apply (auto simp add: bilinear_rmul[OF bh] bilinear_lmul[OF bh] norm_mul ring_simps)
- apply (rule mult_mono)
- apply (auto simp add: norm_ge_zero zero_le_mult_iff component_le_norm)
- apply (rule mult_mono)
- apply (auto simp add: norm_ge_zero zero_le_mult_iff component_le_norm)
- done}
- then show ?thesis by metis
-qed
-
-lemma bilinear_bounded_pos:
- fixes h:: "real ^'m::finite \<Rightarrow> real^'n::finite \<Rightarrow> real ^ 'k::finite"
- assumes bh: "bilinear h"
- shows "\<exists>B > 0. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
-proof-
- from bilinear_bounded[OF bh] obtain B where
- B: "\<forall>x y. norm (h x y) \<le> B * norm x * norm y" by blast
- let ?K = "\<bar>B\<bar> + 1"
- have Kp: "?K > 0" by arith
- have KB: "B < ?K" by arith
- {fix x::"real ^'m" and y :: "real ^'n"
- from KB Kp
- have "B * norm x * norm y \<le> ?K * norm x * norm y"
- apply -
- apply (rule mult_right_mono, rule mult_right_mono)
- by (auto simp add: norm_ge_zero)
- then have "norm (h x y) \<le> ?K * norm x * norm y"
- using B[rule_format, of x y] by simp}
- with Kp show ?thesis by blast
-qed
-
-lemma bilinear_conv_bounded_bilinear:
- fixes h :: "real ^ _ \<Rightarrow> real ^ _ \<Rightarrow> real ^ _"
- shows "bilinear h \<longleftrightarrow> bounded_bilinear h"
-proof
- assume "bilinear h"
- show "bounded_bilinear h"
- proof
- fix x y z show "h (x + y) z = h x z + h y z"
- using `bilinear h` unfolding bilinear_def linear_def by simp
- next
- fix x y z show "h x (y + z) = h x y + h x z"
- using `bilinear h` unfolding bilinear_def linear_def by simp
- next
- fix r x y show "h (scaleR r x) y = scaleR r (h x y)"
- using `bilinear h` unfolding bilinear_def linear_def
- by (simp add: smult_conv_scaleR)
- next
- fix r x y show "h x (scaleR r y) = scaleR r (h x y)"
- using `bilinear h` unfolding bilinear_def linear_def
- by (simp add: smult_conv_scaleR)
- next
- have "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
- using `bilinear h` by (rule bilinear_bounded)
- thus "\<exists>K. \<forall>x y. norm (h x y) \<le> norm x * norm y * K"
- by (simp add: mult_ac)
- qed
-next
- assume "bounded_bilinear h"
- then interpret h: bounded_bilinear h .
- show "bilinear h"
- unfolding bilinear_def linear_conv_bounded_linear
- using h.bounded_linear_left h.bounded_linear_right
- by simp
-qed
-
-subsection{* Adjoints. *}
-
-definition "adjoint f = (SOME f'. \<forall>x y. f x \<bullet> y = x \<bullet> f' y)"
-
-lemma choice_iff: "(\<forall>x. \<exists>y. P x y) \<longleftrightarrow> (\<exists>f. \<forall>x. P x (f x))" by metis
-
-lemma adjoint_works_lemma:
- fixes f:: "'a::ring_1 ^'n::finite \<Rightarrow> 'a ^ 'm::finite"
- assumes lf: "linear f"
- shows "\<forall>x y. f x \<bullet> y = x \<bullet> adjoint f y"
-proof-
- let ?N = "UNIV :: 'n set"
- let ?M = "UNIV :: 'm set"
- have fN: "finite ?N" by simp
- have fM: "finite ?M" by simp
- {fix y:: "'a ^ 'm"
- let ?w = "(\<chi> i. (f (basis i) \<bullet> y)) :: 'a ^ 'n"
- {fix x
- have "f x \<bullet> y = f (setsum (\<lambda>i. (x$i) *s basis i) ?N) \<bullet> y"
- by (simp only: basis_expansion)
- also have "\<dots> = (setsum (\<lambda>i. (x$i) *s f (basis i)) ?N) \<bullet> y"
- unfolding linear_setsum[OF lf fN]
- by (simp add: linear_cmul[OF lf])
- finally have "f x \<bullet> y = x \<bullet> ?w"
- apply (simp only: )
- apply (simp add: dot_def setsum_left_distrib setsum_right_distrib setsum_commute[of _ ?M ?N] ring_simps)
- done}
- }
- then show ?thesis unfolding adjoint_def
- some_eq_ex[of "\<lambda>f'. \<forall>x y. f x \<bullet> y = x \<bullet> f' y"]
- using choice_iff[of "\<lambda>a b. \<forall>x. f x \<bullet> a = x \<bullet> b "]
- by metis
-qed
-
-lemma adjoint_works:
- fixes f:: "'a::ring_1 ^'n::finite \<Rightarrow> 'a ^ 'm::finite"
- assumes lf: "linear f"
- shows "x \<bullet> adjoint f y = f x \<bullet> y"
- using adjoint_works_lemma[OF lf] by metis
-
-
-lemma adjoint_linear:
- fixes f :: "'a::comm_ring_1 ^'n::finite \<Rightarrow> 'a ^ 'm::finite"
- assumes lf: "linear f"
- shows "linear (adjoint f)"
- by (simp add: linear_def vector_eq_ldot[symmetric] dot_radd dot_rmult adjoint_works[OF lf])
-
-lemma adjoint_clauses:
- fixes f:: "'a::comm_ring_1 ^'n::finite \<Rightarrow> 'a ^ 'm::finite"
- assumes lf: "linear f"
- shows "x \<bullet> adjoint f y = f x \<bullet> y"
- and "adjoint f y \<bullet> x = y \<bullet> f x"
- by (simp_all add: adjoint_works[OF lf] dot_sym )
-
-lemma adjoint_adjoint:
- fixes f:: "'a::comm_ring_1 ^ 'n::finite \<Rightarrow> 'a ^ 'm::finite"
- assumes lf: "linear f"
- shows "adjoint (adjoint f) = f"
- apply (rule ext)
- by (simp add: vector_eq_ldot[symmetric] adjoint_clauses[OF adjoint_linear[OF lf]] adjoint_clauses[OF lf])
-
-lemma adjoint_unique:
- fixes f:: "'a::comm_ring_1 ^ 'n::finite \<Rightarrow> 'a ^ 'm::finite"
- assumes lf: "linear f" and u: "\<forall>x y. f' x \<bullet> y = x \<bullet> f y"
- shows "f' = adjoint f"
- apply (rule ext)
- using u
- by (simp add: vector_eq_rdot[symmetric] adjoint_clauses[OF lf])
-
-text{* Matrix notation. NB: an MxN matrix is of type @{typ "'a^'n^'m"}, not @{typ "'a^'m^'n"} *}
-
-consts generic_mult :: "'a \<Rightarrow> 'b \<Rightarrow> 'c" (infixr "\<star>" 75)
-
-defs (overloaded)
-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"
-
-abbreviation
- matrix_matrix_mult' :: "('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'p^'n \<Rightarrow> 'a ^ 'p ^'m" (infixl "**" 70)
- where "m ** m' == m\<star> m'"
-
-defs (overloaded)
- 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"
-
-abbreviation
- matrix_vector_mult' :: "('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'n \<Rightarrow> 'a ^ 'm" (infixl "*v" 70)
- where
- "m *v v == m \<star> v"
-
-defs (overloaded)
- 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"
-
-abbreviation
- vactor_matrix_mult' :: "'a ^ 'm \<Rightarrow> ('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'n " (infixl "v*" 70)
- where
- "v v* m == v \<star> m"
-
-definition "(mat::'a::zero => 'a ^'n^'n) k = (\<chi> i j. if i = j then k else 0)"
-definition "(transp::'a^'n^'m \<Rightarrow> 'a^'m^'n) A = (\<chi> i j. ((A$j)$i))"
-definition "(row::'m => 'a ^'n^'m \<Rightarrow> 'a ^'n) i A = (\<chi> j. ((A$i)$j))"
-definition "(column::'n =>'a^'n^'m =>'a^'m) j A = (\<chi> i. ((A$i)$j))"
-definition "rows(A::'a^'n^'m) = { row i A | i. i \<in> (UNIV :: 'm set)}"
-definition "columns(A::'a^'n^'m) = { column i A | i. i \<in> (UNIV :: 'n set)}"
-
-lemma mat_0[simp]: "mat 0 = 0" by (vector mat_def)
-lemma matrix_add_ldistrib: "(A ** (B + C)) = (A \<star> B) + (A \<star> C)"
- by (vector matrix_matrix_mult_def setsum_addf[symmetric] ring_simps)
-
-lemma matrix_mul_lid:
- fixes A :: "'a::semiring_1 ^ 'm ^ 'n::finite"
- shows "mat 1 ** A = A"
- apply (simp add: matrix_matrix_mult_def mat_def)
- apply vector
- by (auto simp only: cond_value_iff cond_application_beta setsum_delta'[OF finite] mult_1_left mult_zero_left if_True UNIV_I)
-
-
-lemma matrix_mul_rid:
- fixes A :: "'a::semiring_1 ^ 'm::finite ^ 'n"
- shows "A ** mat 1 = A"
- apply (simp add: matrix_matrix_mult_def mat_def)
- apply vector
- 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)
-
-lemma matrix_mul_assoc: "A ** (B ** C) = (A ** B) ** C"
- apply (vector matrix_matrix_mult_def setsum_right_distrib setsum_left_distrib mult_assoc)
- apply (subst setsum_commute)
- apply simp
- done
-
-lemma matrix_vector_mul_assoc: "A *v (B *v x) = (A ** B) *v x"
- apply (vector matrix_matrix_mult_def matrix_vector_mult_def setsum_right_distrib setsum_left_distrib mult_assoc)
- apply (subst setsum_commute)
- apply simp
- done
-
-lemma matrix_vector_mul_lid: "mat 1 *v x = (x::'a::semiring_1 ^ 'n::finite)"
- apply (vector matrix_vector_mult_def mat_def)
- by (simp add: cond_value_iff cond_application_beta
- setsum_delta' cong del: if_weak_cong)
-
-lemma matrix_transp_mul: "transp(A ** B) = transp B ** transp (A::'a::comm_semiring_1^'m^'n)"
- by (simp add: matrix_matrix_mult_def transp_def Cart_eq mult_commute)
-
-lemma matrix_eq:
- fixes A B :: "'a::semiring_1 ^ 'n::finite ^ 'm"
- shows "A = B \<longleftrightarrow> (\<forall>x. A *v x = B *v x)" (is "?lhs \<longleftrightarrow> ?rhs")
- apply auto
- apply (subst Cart_eq)
- apply clarify
- apply (clarsimp simp add: matrix_vector_mult_def basis_def cond_value_iff cond_application_beta Cart_eq cong del: if_weak_cong)
- apply (erule_tac x="basis ia" in allE)
- apply (erule_tac x="i" in allE)
- by (auto simp add: basis_def cond_value_iff cond_application_beta setsum_delta[OF finite] cong del: if_weak_cong)
-
-lemma matrix_vector_mul_component:
- shows "((A::'a::semiring_1^'n'^'m) *v x)$k = (A$k) \<bullet> x"
- by (simp add: matrix_vector_mult_def dot_def)
-
-lemma dot_lmul_matrix: "((x::'a::comm_semiring_1 ^'n) v* A) \<bullet> y = x \<bullet> (A *v y)"
- apply (simp add: dot_def matrix_vector_mult_def vector_matrix_mult_def setsum_left_distrib setsum_right_distrib mult_ac)
- apply (subst setsum_commute)
- by simp
-
-lemma transp_mat: "transp (mat n) = mat n"
- by (vector transp_def mat_def)
-
-lemma transp_transp: "transp(transp A) = A"
- by (vector transp_def)
-
-lemma row_transp:
- fixes A:: "'a::semiring_1^'n^'m"
- shows "row i (transp A) = column i A"
- by (simp add: row_def column_def transp_def Cart_eq)
-
-lemma column_transp:
- fixes A:: "'a::semiring_1^'n^'m"
- shows "column i (transp A) = row i A"
- by (simp add: row_def column_def transp_def Cart_eq)
-
-lemma rows_transp: "rows(transp (A::'a::semiring_1^'n^'m)) = columns A"
-by (auto simp add: rows_def columns_def row_transp intro: set_ext)
-
-lemma columns_transp: "columns(transp (A::'a::semiring_1^'n^'m)) = rows A" by (metis transp_transp rows_transp)
-
-text{* Two sometimes fruitful ways of looking at matrix-vector multiplication. *}
-
-lemma matrix_mult_dot: "A *v x = (\<chi> i. A$i \<bullet> x)"
- by (simp add: matrix_vector_mult_def dot_def)
-
-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)"
- by (simp add: matrix_vector_mult_def Cart_eq column_def mult_commute)
-
-lemma vector_componentwise:
- "(x::'a::ring_1^'n::finite) = (\<chi> j. setsum (\<lambda>i. (x$i) * (basis i :: 'a^'n)$j) (UNIV :: 'n set))"
- apply (subst basis_expansion[symmetric])
- by (vector Cart_eq setsum_component)
-
-lemma linear_componentwise:
- fixes f:: "'a::ring_1 ^ 'm::finite \<Rightarrow> 'a ^ 'n"
- assumes lf: "linear f"
- shows "(f x)$j = setsum (\<lambda>i. (x$i) * (f (basis i)$j)) (UNIV :: 'm set)" (is "?lhs = ?rhs")
-proof-
- let ?M = "(UNIV :: 'm set)"
- let ?N = "(UNIV :: 'n set)"
- have fM: "finite ?M" by simp
- have "?rhs = (setsum (\<lambda>i.(x$i) *s f (basis i) ) ?M)$j"
- unfolding vector_smult_component[symmetric]
- unfolding setsum_component[of "(\<lambda>i.(x$i) *s f (basis i :: 'a^'m))" ?M]
- ..
- then show ?thesis unfolding linear_setsum_mul[OF lf fM, symmetric] basis_expansion ..
-qed
-
-text{* Inverse matrices (not necessarily square) *}
-
-definition "invertible(A::'a::semiring_1^'n^'m) \<longleftrightarrow> (\<exists>A'::'a^'m^'n. A ** A' = mat 1 \<and> A' ** A = mat 1)"
-
-definition "matrix_inv(A:: 'a::semiring_1^'n^'m) =
- (SOME A'::'a^'m^'n. A ** A' = mat 1 \<and> A' ** A = mat 1)"
-
-text{* Correspondence between matrices and linear operators. *}
-
-definition matrix:: "('a::{plus,times, one, zero}^'m \<Rightarrow> 'a ^ 'n) \<Rightarrow> 'a^'m^'n"
-where "matrix f = (\<chi> i j. (f(basis j))$i)"
-
-lemma matrix_vector_mul_linear: "linear(\<lambda>x. A *v (x::'a::comm_semiring_1 ^ 'n))"
- by (simp add: linear_def matrix_vector_mult_def Cart_eq ring_simps setsum_right_distrib setsum_addf)
-
-lemma matrix_works: assumes lf: "linear f" shows "matrix f *v x = f (x::'a::comm_ring_1 ^ 'n::finite)"
-apply (simp add: matrix_def matrix_vector_mult_def Cart_eq mult_commute)
-apply clarify
-apply (rule linear_componentwise[OF lf, symmetric])
-done
-
-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)
-
-lemma matrix_of_matrix_vector_mul: "matrix(\<lambda>x. A *v (x :: 'a:: comm_ring_1 ^ 'n::finite)) = A"
- by (simp add: matrix_eq matrix_vector_mul_linear matrix_works)
-
-lemma matrix_compose:
- assumes lf: "linear (f::'a::comm_ring_1^'n::finite \<Rightarrow> 'a^'m::finite)"
- and lg: "linear (g::'a::comm_ring_1^'m::finite \<Rightarrow> 'a^'k)"
- shows "matrix (g o f) = matrix g ** matrix f"
- using lf lg linear_compose[OF lf lg] matrix_works[OF linear_compose[OF lf lg]]
- by (simp add: matrix_eq matrix_works matrix_vector_mul_assoc[symmetric] o_def)
-
-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)"
- by (simp add: matrix_vector_mult_def transp_def Cart_eq mult_commute)
-
-lemma adjoint_matrix: "adjoint(\<lambda>x. (A::'a::comm_ring_1^'n::finite^'m::finite) *v x) = (\<lambda>x. transp A *v x)"
- apply (rule adjoint_unique[symmetric])
- apply (rule matrix_vector_mul_linear)
- apply (simp add: transp_def dot_def matrix_vector_mult_def setsum_left_distrib setsum_right_distrib)
- apply (subst setsum_commute)
- apply (auto simp add: mult_ac)
- done
-
-lemma matrix_adjoint: assumes lf: "linear (f :: 'a::comm_ring_1^'n::finite \<Rightarrow> 'a ^ 'm::finite)"
- shows "matrix(adjoint f) = transp(matrix f)"
- apply (subst matrix_vector_mul[OF lf])
- unfolding adjoint_matrix matrix_of_matrix_vector_mul ..
-
-subsection{* Interlude: Some properties of real sets *}
-
-lemma seq_mono_lemma: assumes "\<forall>(n::nat) \<ge> m. (d n :: real) < e n" and "\<forall>n \<ge> m. e n <= e m"
- shows "\<forall>n \<ge> m. d n < e m"
- using prems apply auto
- apply (erule_tac x="n" in allE)
- apply (erule_tac x="n" in allE)
- apply auto
- done
-
-
-lemma real_convex_bound_lt:
- assumes xa: "(x::real) < a" and ya: "y < a" and u: "0 <= u" and v: "0 <= v"
- and uv: "u + v = 1"
- shows "u * x + v * y < a"
-proof-
- have uv': "u = 0 \<longrightarrow> v \<noteq> 0" using u v uv by arith
- have "a = a * (u + v)" unfolding uv by simp
- hence th: "u * a + v * a = a" by (simp add: ring_simps)
- from xa u have "u \<noteq> 0 \<Longrightarrow> u*x < u*a" by (simp add: mult_compare_simps)
- from ya v have "v \<noteq> 0 \<Longrightarrow> v * y < v * a" by (simp add: mult_compare_simps)
- from xa ya u v have "u * x + v * y < u * a + v * a"
- apply (cases "u = 0", simp_all add: uv')
- apply(rule mult_strict_left_mono)
- using uv' apply simp_all
-
- apply (rule add_less_le_mono)
- apply(rule mult_strict_left_mono)
- apply simp_all
- apply (rule mult_left_mono)
- apply simp_all
- done
- thus ?thesis unfolding th .
-qed
-
-lemma real_convex_bound_le:
- assumes xa: "(x::real) \<le> a" and ya: "y \<le> a" and u: "0 <= u" and v: "0 <= v"
- and uv: "u + v = 1"
- shows "u * x + v * y \<le> a"
-proof-
- from xa ya u v have "u * x + v * y \<le> u * a + v * a" by (simp add: add_mono mult_left_mono)
- also have "\<dots> \<le> (u + v) * a" by (simp add: ring_simps)
- finally show ?thesis unfolding uv by simp
-qed
-
-lemma infinite_enumerate: assumes fS: "infinite S"
- shows "\<exists>r. subseq r \<and> (\<forall>n. r n \<in> S)"
-unfolding subseq_def
-using enumerate_in_set[OF fS] enumerate_mono[of _ _ S] fS by auto
-
-lemma approachable_lt_le: "(\<exists>(d::real)>0. \<forall>x. f x < d \<longrightarrow> P x) \<longleftrightarrow> (\<exists>d>0. \<forall>x. f x \<le> d \<longrightarrow> P x)"
-apply auto
-apply (rule_tac x="d/2" in exI)
-apply auto
-done
-
-
-lemma triangle_lemma:
- assumes x: "0 <= (x::real)" and y:"0 <= y" and z: "0 <= z" and xy: "x^2 <= y^2 + z^2"
- shows "x <= y + z"
-proof-
- have "y^2 + z^2 \<le> y^2 + 2*y*z + z^2" using z y by (simp add: zero_compare_simps)
- with xy have th: "x ^2 \<le> (y+z)^2" by (simp add: power2_eq_square ring_simps)
- from y z have yz: "y + z \<ge> 0" by arith
- from power2_le_imp_le[OF th yz] show ?thesis .
-qed
-
-
-lemma lambda_skolem: "(\<forall>i. \<exists>x. P i x) \<longleftrightarrow>
- (\<exists>x::'a ^ 'n. \<forall>i. P i (x$i))" (is "?lhs \<longleftrightarrow> ?rhs")
-proof-
- let ?S = "(UNIV :: 'n set)"
- {assume H: "?rhs"
- then have ?lhs by auto}
- moreover
- {assume H: "?lhs"
- then obtain f where f:"\<forall>i. P i (f i)" unfolding choice_iff by metis
- let ?x = "(\<chi> i. (f i)) :: 'a ^ 'n"
- {fix i
- from f have "P i (f i)" by metis
- then have "P i (?x$i)" by auto
- }
- hence "\<forall>i. P i (?x$i)" by metis
- hence ?rhs by metis }
- ultimately show ?thesis by metis
-qed
-
-(* Supremum and infimum of real sets *)
-
-
-definition rsup:: "real set \<Rightarrow> real" where
- "rsup S = (SOME a. isLub UNIV S a)"
-
-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)
-
-lemma rsup: assumes Se: "S \<noteq> {}" and b: "\<exists>b. S *<= b"
- shows "isLub UNIV S (rsup S)"
-using Se b
-unfolding rsup_def
-apply clarify
-apply (rule someI_ex)
-apply (rule reals_complete)
-by (auto simp add: isUb_def setle_def)
-
-lemma rsup_le: assumes Se: "S \<noteq> {}" and Sb: "S *<= b" shows "rsup S \<le> b"
-proof-
- from Sb have bu: "isUb UNIV S b" by (simp add: isUb_def setle_def)
- from rsup[OF Se] Sb have "isLub UNIV S (rsup S)" by blast
- then show ?thesis using bu by (auto simp add: isLub_def leastP_def setle_def setge_def)
-qed
-
-lemma rsup_finite_Max: assumes fS: "finite S" and Se: "S \<noteq> {}"
- shows "rsup S = Max S"
-using fS Se
-proof-
- let ?m = "Max S"
- from Max_ge[OF fS] have Sm: "\<forall> x\<in> S. x \<le> ?m" by metis
- with rsup[OF Se] have lub: "isLub UNIV S (rsup S)" by (metis setle_def)
- from Max_in[OF fS Se] lub have mrS: "?m \<le> rsup S"
- by (auto simp add: isLub_def leastP_def setle_def setge_def isUb_def)
- moreover
- have "rsup S \<le> ?m" using Sm lub
- by (auto simp add: isLub_def leastP_def isUb_def setle_def setge_def)
- ultimately show ?thesis by arith
-qed
-
-lemma rsup_finite_in: assumes fS: "finite S" and Se: "S \<noteq> {}"
- shows "rsup S \<in> S"
- using rsup_finite_Max[OF fS Se] Max_in[OF fS Se] by metis
-
-lemma rsup_finite_Ub: assumes fS: "finite S" and Se: "S \<noteq> {}"
- shows "isUb S S (rsup S)"
- using rsup_finite_Max[OF fS Se] rsup_finite_in[OF fS Se] Max_ge[OF fS]
- unfolding isUb_def setle_def by metis
-
-lemma rsup_finite_ge_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
- shows "a \<le> rsup S \<longleftrightarrow> (\<exists> x \<in> S. a \<le> x)"
-using rsup_finite_Ub[OF fS Se] by (auto simp add: isUb_def setle_def)
-
-lemma rsup_finite_le_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
- shows "a \<ge> rsup S \<longleftrightarrow> (\<forall> x \<in> S. a \<ge> x)"
-using rsup_finite_Ub[OF fS Se] by (auto simp add: isUb_def setle_def)
-
-lemma rsup_finite_gt_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
- shows "a < rsup S \<longleftrightarrow> (\<exists> x \<in> S. a < x)"
-using rsup_finite_Ub[OF fS Se] by (auto simp add: isUb_def setle_def)
-
-lemma rsup_finite_lt_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
- shows "a > rsup S \<longleftrightarrow> (\<forall> x \<in> S. a > x)"
-using rsup_finite_Ub[OF fS Se] by (auto simp add: isUb_def setle_def)
-
-lemma rsup_unique: assumes b: "S *<= b" and S: "\<forall>b' < b. \<exists>x \<in> S. b' < x"
- shows "rsup S = b"
-using b S
-unfolding setle_def rsup_alt
-apply -
-apply (rule some_equality)
-apply (metis linorder_not_le order_eq_iff[symmetric])+
-done
-
-lemma rsup_le_subset: "S\<noteq>{} \<Longrightarrow> S \<subseteq> T \<Longrightarrow> (\<exists>b. T *<= b) \<Longrightarrow> rsup S \<le> rsup T"
- apply (rule rsup_le)
- apply simp
- using rsup[of T] by (auto simp add: isLub_def leastP_def setge_def setle_def isUb_def)
-
-lemma isUb_def': "isUb R S = (\<lambda>x. S *<= x \<and> x \<in> R)"
- apply (rule ext)
- by (metis isUb_def)
-
-lemma UNIV_trivial: "UNIV x" using UNIV_I[of x] by (metis mem_def)
-lemma rsup_bounds: assumes Se: "S \<noteq> {}" and l: "a <=* S" and u: "S *<= b"
- shows "a \<le> rsup S \<and> rsup S \<le> b"
-proof-
- from rsup[OF Se] u have lub: "isLub UNIV S (rsup S)" by blast
- hence b: "rsup S \<le> b" using u by (auto simp add: isLub_def leastP_def setle_def setge_def isUb_def')
- from Se obtain y where y: "y \<in> S" by blast
- from lub l have "a \<le> rsup S" apply (auto simp add: isLub_def leastP_def setle_def setge_def isUb_def')
- apply (erule ballE[where x=y])
- apply (erule ballE[where x=y])
- apply arith
- using y apply auto
- done
- with b show ?thesis by blast
-qed
-
-lemma rsup_abs_le: "S \<noteq> {} \<Longrightarrow> (\<forall>x\<in>S. \<bar>x\<bar> \<le> a) \<Longrightarrow> \<bar>rsup S\<bar> \<le> a"
- unfolding abs_le_interval_iff using rsup_bounds[of S "-a" a]
- by (auto simp add: setge_def setle_def)
-
-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"
-proof-
- 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
- show ?thesis using S b rsup_bounds[of S "l - e" "l+e"] unfolding th
- by (auto simp add: setge_def setle_def)
-qed
-
-definition rinf:: "real set \<Rightarrow> real" where
- "rinf S = (SOME a. isGlb UNIV S a)"
-
-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)
-
-lemma reals_complete_Glb: assumes Se: "\<exists>x. x \<in> S" and lb: "\<exists> y. isLb UNIV S y"
- shows "\<exists>(t::real). isGlb UNIV S t"
-proof-
- let ?M = "uminus ` S"
- from lb have th: "\<exists>y. isUb UNIV ?M y" apply (auto simp add: isUb_def isLb_def setle_def setge_def)
- by (rule_tac x="-y" in exI, auto)
- from Se have Me: "\<exists>x. x \<in> ?M" by blast
- from reals_complete[OF Me th] obtain t where t: "isLub UNIV ?M t" by blast
- have "isGlb UNIV S (- t)" using t
- apply (auto simp add: isLub_def isGlb_def leastP_def greatestP_def setle_def setge_def isUb_def isLb_def)
- apply (erule_tac x="-y" in allE)
- apply auto
- done
- then show ?thesis by metis
-qed
-
-lemma rinf: assumes Se: "S \<noteq> {}" and b: "\<exists>b. b <=* S"
- shows "isGlb UNIV S (rinf S)"
-using Se b
-unfolding rinf_def
-apply clarify
-apply (rule someI_ex)
-apply (rule reals_complete_Glb)
-apply (auto simp add: isLb_def setle_def setge_def)
-done
-
-lemma rinf_ge: assumes Se: "S \<noteq> {}" and Sb: "b <=* S" shows "rinf S \<ge> b"
-proof-
- from Sb have bu: "isLb UNIV S b" by (simp add: isLb_def setge_def)
- from rinf[OF Se] Sb have "isGlb UNIV S (rinf S)" by blast
- then show ?thesis using bu by (auto simp add: isGlb_def greatestP_def setle_def setge_def)
-qed
-
-lemma rinf_finite_Min: assumes fS: "finite S" and Se: "S \<noteq> {}"
- shows "rinf S = Min S"
-using fS Se
-proof-
- let ?m = "Min S"
- from Min_le[OF fS] have Sm: "\<forall> x\<in> S. x \<ge> ?m" by metis
- with rinf[OF Se] have glb: "isGlb UNIV S (rinf S)" by (metis setge_def)
- from Min_in[OF fS Se] glb have mrS: "?m \<ge> rinf S"
- by (auto simp add: isGlb_def greatestP_def setle_def setge_def isLb_def)
- moreover
- have "rinf S \<ge> ?m" using Sm glb
- by (auto simp add: isGlb_def greatestP_def isLb_def setle_def setge_def)
- ultimately show ?thesis by arith
-qed
-
-lemma rinf_finite_in: assumes fS: "finite S" and Se: "S \<noteq> {}"
- shows "rinf S \<in> S"
- using rinf_finite_Min[OF fS Se] Min_in[OF fS Se] by metis
-
-lemma rinf_finite_Lb: assumes fS: "finite S" and Se: "S \<noteq> {}"
- shows "isLb S S (rinf S)"
- using rinf_finite_Min[OF fS Se] rinf_finite_in[OF fS Se] Min_le[OF fS]
- unfolding isLb_def setge_def by metis
-
-lemma rinf_finite_ge_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
- shows "a \<le> rinf S \<longleftrightarrow> (\<forall> x \<in> S. a \<le> x)"
-using rinf_finite_Lb[OF fS Se] by (auto simp add: isLb_def setge_def)
-
-lemma rinf_finite_le_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
- shows "a \<ge> rinf S \<longleftrightarrow> (\<exists> x \<in> S. a \<ge> x)"
-using rinf_finite_Lb[OF fS Se] by (auto simp add: isLb_def setge_def)
-
-lemma rinf_finite_gt_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
- shows "a < rinf S \<longleftrightarrow> (\<forall> x \<in> S. a < x)"
-using rinf_finite_Lb[OF fS Se] by (auto simp add: isLb_def setge_def)
-
-lemma rinf_finite_lt_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
- shows "a > rinf S \<longleftrightarrow> (\<exists> x \<in> S. a > x)"
-using rinf_finite_Lb[OF fS Se] by (auto simp add: isLb_def setge_def)
-
-lemma rinf_unique: assumes b: "b <=* S" and S: "\<forall>b' > b. \<exists>x \<in> S. b' > x"
- shows "rinf S = b"
-using b S
-unfolding setge_def rinf_alt
-apply -
-apply (rule some_equality)
-apply (metis linorder_not_le order_eq_iff[symmetric])+
-done
-
-lemma rinf_ge_subset: "S\<noteq>{} \<Longrightarrow> S \<subseteq> T \<Longrightarrow> (\<exists>b. b <=* T) \<Longrightarrow> rinf S >= rinf T"
- apply (rule rinf_ge)
- apply simp
- using rinf[of T] by (auto simp add: isGlb_def greatestP_def setge_def setle_def isLb_def)
-
-lemma isLb_def': "isLb R S = (\<lambda>x. x <=* S \<and> x \<in> R)"
- apply (rule ext)
- by (metis isLb_def)
-
-lemma rinf_bounds: assumes Se: "S \<noteq> {}" and l: "a <=* S" and u: "S *<= b"
- shows "a \<le> rinf S \<and> rinf S \<le> b"
-proof-
- from rinf[OF Se] l have lub: "isGlb UNIV S (rinf S)" by blast
- hence b: "a \<le> rinf S" using l by (auto simp add: isGlb_def greatestP_def setle_def setge_def isLb_def')
- from Se obtain y where y: "y \<in> S" by blast
- from lub u have "b \<ge> rinf S" apply (auto simp add: isGlb_def greatestP_def setle_def setge_def isLb_def')
- apply (erule ballE[where x=y])
- apply (erule ballE[where x=y])
- apply arith
- using y apply auto
- done
- with b show ?thesis by blast
-qed
-
-lemma rinf_abs_ge: "S \<noteq> {} \<Longrightarrow> (\<forall>x\<in>S. \<bar>x\<bar> \<le> a) \<Longrightarrow> \<bar>rinf S\<bar> \<le> a"
- unfolding abs_le_interval_iff using rinf_bounds[of S "-a" a]
- by (auto simp add: setge_def setle_def)
-
-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"
-proof-
- 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
- show ?thesis using S b rinf_bounds[of S "l - e" "l+e"] unfolding th
- by (auto simp add: setge_def setle_def)
-qed
-
-
-
-subsection{* Operator norm. *}
-
-definition "onorm f = rsup {norm (f x)| x. norm x = 1}"
-
-lemma norm_bound_generalize:
- fixes f:: "real ^'n::finite \<Rightarrow> real^'m::finite"
- assumes lf: "linear f"
- 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")
-proof-
- {assume H: ?rhs
- {fix x :: "real^'n" assume x: "norm x = 1"
- from H[rule_format, of x] x have "norm (f x) \<le> b" by simp}
- then have ?lhs by blast }
-
- moreover
- {assume H: ?lhs
- from H[rule_format, of "basis arbitrary"]
- have bp: "b \<ge> 0" using norm_ge_zero[of "f (basis arbitrary)"]
- by (auto simp add: norm_basis elim: order_trans [OF norm_ge_zero])
- {fix x :: "real ^'n"
- {assume "x = 0"
- then have "norm (f x) \<le> b * norm x" by (simp add: linear_0[OF lf] bp)}
- moreover
- {assume x0: "x \<noteq> 0"
- hence n0: "norm x \<noteq> 0" by (metis norm_eq_zero)
- let ?c = "1/ norm x"
- have "norm (?c*s x) = 1" using x0 by (simp add: n0 norm_mul)
- with H have "norm (f(?c*s x)) \<le> b" by blast
- hence "?c * norm (f x) \<le> b"
- by (simp add: linear_cmul[OF lf] norm_mul)
- hence "norm (f x) \<le> b * norm x"
- using n0 norm_ge_zero[of x] by (auto simp add: field_simps)}
- ultimately have "norm (f x) \<le> b * norm x" by blast}
- then have ?rhs by blast}
- ultimately show ?thesis by blast
-qed
-
-lemma onorm:
- fixes f:: "real ^'n::finite \<Rightarrow> real ^'m::finite"
- assumes lf: "linear f"
- shows "norm (f x) <= onorm f * norm x"
- and "\<forall>x. norm (f x) <= b * norm x \<Longrightarrow> onorm f <= b"
-proof-
- {
- let ?S = "{norm (f x) |x. norm x = 1}"
- have Se: "?S \<noteq> {}" using norm_basis by auto
- from linear_bounded[OF lf] have b: "\<exists> b. ?S *<= b"
- unfolding norm_bound_generalize[OF lf, symmetric] by (auto simp add: setle_def)
- {from rsup[OF Se b, unfolded onorm_def[symmetric]]
- show "norm (f x) <= onorm f * norm x"
- apply -
- apply (rule spec[where x = x])
- unfolding norm_bound_generalize[OF lf, symmetric]
- by (auto simp add: isLub_def isUb_def leastP_def setge_def setle_def)}
- {
- show "\<forall>x. norm (f x) <= b * norm x \<Longrightarrow> onorm f <= b"
- using rsup[OF Se b, unfolded onorm_def[symmetric]]
- unfolding norm_bound_generalize[OF lf, symmetric]
- by (auto simp add: isLub_def isUb_def leastP_def setge_def setle_def)}
- }
-qed
-
-lemma onorm_pos_le: assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)" shows "0 <= onorm f"
- using order_trans[OF norm_ge_zero onorm(1)[OF lf, of "basis arbitrary"], unfolded norm_basis] by simp
-
-lemma onorm_eq_0: assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)"
- shows "onorm f = 0 \<longleftrightarrow> (\<forall>x. f x = 0)"
- using onorm[OF lf]
- apply (auto simp add: onorm_pos_le)
- apply atomize
- apply (erule allE[where x="0::real"])
- using onorm_pos_le[OF lf]
- apply arith
- done
-
-lemma onorm_const: "onorm(\<lambda>x::real^'n::finite. (y::real ^ 'm::finite)) = norm y"
-proof-
- let ?f = "\<lambda>x::real^'n. (y::real ^ 'm)"
- have th: "{norm (?f x)| x. norm x = 1} = {norm y}"
- by(auto intro: vector_choose_size set_ext)
- show ?thesis
- unfolding onorm_def th
- apply (rule rsup_unique) by (simp_all add: setle_def)
-qed
-
-lemma onorm_pos_lt: assumes lf: "linear (f::real ^ 'n::finite \<Rightarrow> real ^'m::finite)"
- shows "0 < onorm f \<longleftrightarrow> ~(\<forall>x. f x = 0)"
- unfolding onorm_eq_0[OF lf, symmetric]
- using onorm_pos_le[OF lf] by arith
-
-lemma onorm_compose:
- assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)"
- and lg: "linear (g::real^'k::finite \<Rightarrow> real^'n::finite)"
- shows "onorm (f o g) <= onorm f * onorm g"
- apply (rule onorm(2)[OF linear_compose[OF lg lf], rule_format])
- unfolding o_def
- apply (subst mult_assoc)
- apply (rule order_trans)
- apply (rule onorm(1)[OF lf])
- apply (rule mult_mono1)
- apply (rule onorm(1)[OF lg])
- apply (rule onorm_pos_le[OF lf])
- done
-
-lemma onorm_neg_lemma: assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real^'m::finite)"
- shows "onorm (\<lambda>x. - f x) \<le> onorm f"
- using onorm[OF linear_compose_neg[OF lf]] onorm[OF lf]
- unfolding norm_minus_cancel by metis
-
-lemma onorm_neg: assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real^'m::finite)"
- shows "onorm (\<lambda>x. - f x) = onorm f"
- using onorm_neg_lemma[OF lf] onorm_neg_lemma[OF linear_compose_neg[OF lf]]
- by simp
-
-lemma onorm_triangle:
- assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)" and lg: "linear g"
- shows "onorm (\<lambda>x. f x + g x) <= onorm f + onorm g"
- apply(rule onorm(2)[OF linear_compose_add[OF lf lg], rule_format])
- apply (rule order_trans)
- apply (rule norm_triangle_ineq)
- apply (simp add: distrib)
- apply (rule add_mono)
- apply (rule onorm(1)[OF lf])
- apply (rule onorm(1)[OF lg])
- done
-
-lemma onorm_triangle_le: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite) \<Longrightarrow> linear g \<Longrightarrow> onorm(f) + onorm(g) <= e
- \<Longrightarrow> onorm(\<lambda>x. f x + g x) <= e"
- apply (rule order_trans)
- apply (rule onorm_triangle)
- apply assumption+
- done
-
-lemma onorm_triangle_lt: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite) \<Longrightarrow> linear g \<Longrightarrow> onorm(f) + onorm(g) < e
- ==> onorm(\<lambda>x. f x + g x) < e"
- apply (rule order_le_less_trans)
- apply (rule onorm_triangle)
- by assumption+
-
-(* "lift" from 'a to 'a^1 and "drop" from 'a^1 to 'a -- FIXME: potential use of transfer *)
-
-definition vec1:: "'a \<Rightarrow> 'a ^ 1" where "vec1 x = (\<chi> i. x)"
-
-definition dest_vec1:: "'a ^1 \<Rightarrow> 'a"
- where "dest_vec1 x = (x$1)"
-
-lemma vec1_component[simp]: "(vec1 x)$1 = x"
- by (simp add: vec1_def)
-
-lemma vec1_dest_vec1[simp]: "vec1(dest_vec1 x) = x" "dest_vec1(vec1 y) = y"
- by (simp_all add: vec1_def dest_vec1_def Cart_eq forall_1)
-
-lemma forall_vec1: "(\<forall>x. P x) \<longleftrightarrow> (\<forall>x. P (vec1 x))" by (metis vec1_dest_vec1)
-
-lemma exists_vec1: "(\<exists>x. P x) \<longleftrightarrow> (\<exists>x. P(vec1 x))" by (metis vec1_dest_vec1)
-
-lemma forall_dest_vec1: "(\<forall>x. P x) \<longleftrightarrow> (\<forall>x. P(dest_vec1 x))" by (metis vec1_dest_vec1)
-
-lemma exists_dest_vec1: "(\<exists>x. P x) \<longleftrightarrow> (\<exists>x. P(dest_vec1 x))"by (metis vec1_dest_vec1)
-
-lemma vec1_eq[simp]: "vec1 x = vec1 y \<longleftrightarrow> x = y" by (metis vec1_dest_vec1)
-
-lemma dest_vec1_eq[simp]: "dest_vec1 x = dest_vec1 y \<longleftrightarrow> x = y" by (metis vec1_dest_vec1)
-
-lemma vec1_in_image_vec1: "vec1 x \<in> (vec1 ` S) \<longleftrightarrow> x \<in> S" by auto
-
-lemma vec1_vec: "vec1 x = vec x" by (vector vec1_def)
-
-lemma vec1_add: "vec1(x + y) = vec1 x + vec1 y" by (vector vec1_def)
-lemma vec1_sub: "vec1(x - y) = vec1 x - vec1 y" by (vector vec1_def)
-lemma vec1_cmul: "vec1(c* x) = c *s vec1 x " by (vector vec1_def)
-lemma vec1_neg: "vec1(- x) = - vec1 x " by (vector vec1_def)
-
-lemma vec1_setsum: assumes fS: "finite S"
- shows "vec1(setsum f S) = setsum (vec1 o f) S"
- apply (induct rule: finite_induct[OF fS])
- apply (simp add: vec1_vec)
- apply (auto simp add: vec1_add)
- done
-
-lemma dest_vec1_lambda: "dest_vec1(\<chi> i. x i) = x 1"
- by (simp add: dest_vec1_def)
-
-lemma dest_vec1_vec: "dest_vec1(vec x) = x"
- by (simp add: vec1_vec[symmetric])
-
-lemma dest_vec1_add: "dest_vec1(x + y) = dest_vec1 x + dest_vec1 y"
- by (metis vec1_dest_vec1 vec1_add)
-
-lemma dest_vec1_sub: "dest_vec1(x - y) = dest_vec1 x - dest_vec1 y"
- by (metis vec1_dest_vec1 vec1_sub)
-
-lemma dest_vec1_cmul: "dest_vec1(c*sx) = c * dest_vec1 x"
- by (metis vec1_dest_vec1 vec1_cmul)
-
-lemma dest_vec1_neg: "dest_vec1(- x) = - dest_vec1 x"
- by (metis vec1_dest_vec1 vec1_neg)
-
-lemma dest_vec1_0[simp]: "dest_vec1 0 = 0" by (metis vec_0 dest_vec1_vec)
-
-lemma dest_vec1_sum: assumes fS: "finite S"
- shows "dest_vec1(setsum f S) = setsum (dest_vec1 o f) S"
- apply (induct rule: finite_induct[OF fS])
- apply (simp add: dest_vec1_vec)
- apply (auto simp add: dest_vec1_add)
- done
-
-lemma norm_vec1: "norm(vec1 x) = abs(x)"
- by (simp add: vec1_def norm_real)
-
-lemma dist_vec1: "dist(vec1 x) (vec1 y) = abs(x - y)"
- by (simp only: dist_real vec1_component)
-lemma abs_dest_vec1: "norm x = \<bar>dest_vec1 x\<bar>"
- by (metis vec1_dest_vec1 norm_vec1)
-
-lemma linear_vmul_dest_vec1:
- fixes f:: "'a::semiring_1^'n \<Rightarrow> 'a^1"
- shows "linear f \<Longrightarrow> linear (\<lambda>x. dest_vec1(f x) *s v)"
- unfolding dest_vec1_def
- apply (rule linear_vmul_component)
- by auto
-
-lemma linear_from_scalars:
- assumes lf: "linear (f::'a::comm_ring_1 ^1 \<Rightarrow> 'a^'n)"
- shows "f = (\<lambda>x. dest_vec1 x *s column 1 (matrix f))"
- apply (rule ext)
- apply (subst matrix_works[OF lf, symmetric])
- apply (auto simp add: Cart_eq matrix_vector_mult_def dest_vec1_def column_def mult_commute UNIV_1)
- done
-
-lemma linear_to_scalars: assumes lf: "linear (f::'a::comm_ring_1 ^'n::finite \<Rightarrow> 'a^1)"
- shows "f = (\<lambda>x. vec1(row 1 (matrix f) \<bullet> x))"
- apply (rule ext)
- apply (subst matrix_works[OF lf, symmetric])
- apply (simp add: Cart_eq matrix_vector_mult_def vec1_def row_def dot_def mult_commute forall_1)
- done
-
-lemma dest_vec1_eq_0: "dest_vec1 x = 0 \<longleftrightarrow> x = 0"
- by (simp add: dest_vec1_eq[symmetric])
-
-lemma setsum_scalars: assumes fS: "finite S"
- shows "setsum f S = vec1 (setsum (dest_vec1 o f) S)"
- unfolding vec1_setsum[OF fS] by simp
-
-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"
- apply (cases "dest_vec1 x \<le> dest_vec1 y")
- apply simp
- apply (subgoal_tac "dest_vec1 y \<le> dest_vec1 x")
- apply (auto)
- done
-
-text{* Pasting vectors. *}
-
-lemma linear_fstcart: "linear fstcart"
- by (auto simp add: linear_def Cart_eq)
-
-lemma linear_sndcart: "linear sndcart"
- by (auto simp add: linear_def Cart_eq)
-
-lemma fstcart_vec[simp]: "fstcart(vec x) = vec x"
- by (simp add: Cart_eq)
-
-lemma fstcart_add[simp]:"fstcart(x + y) = fstcart (x::'a::{plus,times}^('b + 'c)) + fstcart y"
- by (simp add: Cart_eq)
-
-lemma fstcart_cmul[simp]:"fstcart(c*s x) = c*s fstcart (x::'a::{plus,times}^('b + 'c))"
- by (simp add: Cart_eq)
-
-lemma fstcart_neg[simp]:"fstcart(- x) = - fstcart (x::'a::ring_1^('b + 'c))"
- by (simp add: Cart_eq)
-
-lemma fstcart_sub[simp]:"fstcart(x - y) = fstcart (x::'a::ring_1^('b + 'c)) - fstcart y"
- by (simp add: Cart_eq)
-
-lemma fstcart_setsum:
- fixes f:: "'d \<Rightarrow> 'a::semiring_1^_"
- assumes fS: "finite S"
- shows "fstcart (setsum f S) = setsum (\<lambda>i. fstcart (f i)) S"
- by (induct rule: finite_induct[OF fS], simp_all add: vec_0[symmetric] del: vec_0)
-
-lemma sndcart_vec[simp]: "sndcart(vec x) = vec x"
- by (simp add: Cart_eq)
-
-lemma sndcart_add[simp]:"sndcart(x + y) = sndcart (x::'a::{plus,times}^('b + 'c)) + sndcart y"
- by (simp add: Cart_eq)
-
-lemma sndcart_cmul[simp]:"sndcart(c*s x) = c*s sndcart (x::'a::{plus,times}^('b + 'c))"
- by (simp add: Cart_eq)
-
-lemma sndcart_neg[simp]:"sndcart(- x) = - sndcart (x::'a::ring_1^('b + 'c))"
- by (simp add: Cart_eq)
-
-lemma sndcart_sub[simp]:"sndcart(x - y) = sndcart (x::'a::ring_1^('b + 'c)) - sndcart y"
- by (simp add: Cart_eq)
-
-lemma sndcart_setsum:
- fixes f:: "'d \<Rightarrow> 'a::semiring_1^_"
- assumes fS: "finite S"
- shows "sndcart (setsum f S) = setsum (\<lambda>i. sndcart (f i)) S"
- by (induct rule: finite_induct[OF fS], simp_all add: vec_0[symmetric] del: vec_0)
-
-lemma pastecart_vec[simp]: "pastecart (vec x) (vec x) = vec x"
- by (simp add: pastecart_eq fstcart_pastecart sndcart_pastecart)
-
-lemma pastecart_add[simp]:"pastecart (x1::'a::{plus,times}^_) y1 + pastecart x2 y2 = pastecart (x1 + x2) (y1 + y2)"
- by (simp add: pastecart_eq fstcart_pastecart sndcart_pastecart)
-
-lemma pastecart_cmul[simp]: "pastecart (c *s (x1::'a::{plus,times}^_)) (c *s y1) = c *s pastecart x1 y1"
- by (simp add: pastecart_eq fstcart_pastecart sndcart_pastecart)
-
-lemma pastecart_neg[simp]: "pastecart (- (x::'a::ring_1^_)) (- y) = - pastecart x y"
- unfolding vector_sneg_minus1 pastecart_cmul ..
-
-lemma pastecart_sub: "pastecart (x1::'a::ring_1^_) y1 - pastecart x2 y2 = pastecart (x1 - x2) (y1 - y2)"
- by (simp add: diff_def pastecart_neg[symmetric] del: pastecart_neg)
-
-lemma pastecart_setsum:
- fixes f:: "'d \<Rightarrow> 'a::semiring_1^_"
- assumes fS: "finite S"
- shows "pastecart (setsum f S) (setsum g S) = setsum (\<lambda>i. pastecart (f i) (g i)) S"
- by (simp add: pastecart_eq fstcart_setsum[OF fS] sndcart_setsum[OF fS] fstcart_pastecart sndcart_pastecart)
-
-lemma setsum_Plus:
- "\<lbrakk>finite A; finite B\<rbrakk> \<Longrightarrow>
- (\<Sum>x\<in>A <+> B. g x) = (\<Sum>x\<in>A. g (Inl x)) + (\<Sum>x\<in>B. g (Inr x))"
- unfolding Plus_def
- by (subst setsum_Un_disjoint, auto simp add: setsum_reindex)
-
-lemma setsum_UNIV_sum:
- fixes g :: "'a::finite + 'b::finite \<Rightarrow> _"
- shows "(\<Sum>x\<in>UNIV. g x) = (\<Sum>x\<in>UNIV. g (Inl x)) + (\<Sum>x\<in>UNIV. g (Inr x))"
- apply (subst UNIV_Plus_UNIV [symmetric])
- apply (rule setsum_Plus [OF finite finite])
- done
-
-lemma norm_fstcart: "norm(fstcart x) <= norm (x::real ^('n::finite + 'm::finite))"
-proof-
- have th0: "norm x = norm (pastecart (fstcart x) (sndcart x))"
- by (simp add: pastecart_fst_snd)
- have th1: "fstcart x \<bullet> fstcart x \<le> pastecart (fstcart x) (sndcart x) \<bullet> pastecart (fstcart x) (sndcart x)"
- by (simp add: dot_def setsum_UNIV_sum pastecart_def setsum_nonneg)
- then show ?thesis
- unfolding th0
- unfolding real_vector_norm_def real_sqrt_le_iff id_def
- by (simp add: dot_def)
-qed
-
-lemma dist_fstcart: "dist(fstcart (x::real^_)) (fstcart y) <= dist x y"
- unfolding dist_norm by (metis fstcart_sub[symmetric] norm_fstcart)
-
-lemma norm_sndcart: "norm(sndcart x) <= norm (x::real ^('n::finite + 'm::finite))"
-proof-
- have th0: "norm x = norm (pastecart (fstcart x) (sndcart x))"
- by (simp add: pastecart_fst_snd)
- have th1: "sndcart x \<bullet> sndcart x \<le> pastecart (fstcart x) (sndcart x) \<bullet> pastecart (fstcart x) (sndcart x)"
- by (simp add: dot_def setsum_UNIV_sum pastecart_def setsum_nonneg)
- then show ?thesis
- unfolding th0
- unfolding real_vector_norm_def real_sqrt_le_iff id_def
- by (simp add: dot_def)
-qed
-
-lemma dist_sndcart: "dist(sndcart (x::real^_)) (sndcart y) <= dist x y"
- unfolding dist_norm by (metis sndcart_sub[symmetric] norm_sndcart)
-
-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"
- by (simp add: dot_def setsum_UNIV_sum pastecart_def)
-
-text {* TODO: move to NthRoot *}
-lemma sqrt_add_le_add_sqrt:
- assumes x: "0 \<le> x" and y: "0 \<le> y"
- shows "sqrt (x + y) \<le> sqrt x + sqrt y"
-apply (rule power2_le_imp_le)
-apply (simp add: real_sum_squared_expand add_nonneg_nonneg x y)
-apply (simp add: mult_nonneg_nonneg x y)
-apply (simp add: add_nonneg_nonneg x y)
-done
-
-lemma norm_pastecart: "norm (pastecart x y) <= norm x + norm y"
- unfolding norm_vector_def setL2_def setsum_UNIV_sum
- by (simp add: sqrt_add_le_add_sqrt setsum_nonneg)
-
-subsection {* A generic notion of "hull" (convex, affine, conic hull and closure). *}
-
-definition hull :: "'a set set \<Rightarrow> 'a set \<Rightarrow> 'a set" (infixl "hull" 75) where
- "S hull s = Inter {t. t \<in> S \<and> s \<subseteq> t}"
-
-lemma hull_same: "s \<in> S \<Longrightarrow> S hull s = s"
- unfolding hull_def by auto
-
-lemma hull_in: "(\<And>T. T \<subseteq> S ==> Inter T \<in> S) ==> (S hull s) \<in> S"
-unfolding hull_def subset_iff by auto
-
-lemma hull_eq: "(\<And>T. T \<subseteq> S ==> Inter T \<in> S) ==> (S hull s) = s \<longleftrightarrow> s \<in> S"
-using hull_same[of s S] hull_in[of S s] by metis
-
-
-lemma hull_hull: "S hull (S hull s) = S hull s"
- unfolding hull_def by blast
-
-lemma hull_subset: "s \<subseteq> (S hull s)"
- unfolding hull_def by blast
-
-lemma hull_mono: " s \<subseteq> t ==> (S hull s) \<subseteq> (S hull t)"
- unfolding hull_def by blast
-
-lemma hull_antimono: "S \<subseteq> T ==> (T hull s) \<subseteq> (S hull s)"
- unfolding hull_def by blast
-
-lemma hull_minimal: "s \<subseteq> t \<Longrightarrow> t \<in> S ==> (S hull s) \<subseteq> t"
- unfolding hull_def by blast
-
-lemma subset_hull: "t \<in> S ==> S hull s \<subseteq> t \<longleftrightarrow> s \<subseteq> t"
- unfolding hull_def by blast
-
-lemma hull_unique: "s \<subseteq> t \<Longrightarrow> t \<in> S \<Longrightarrow> (\<And>t'. s \<subseteq> t' \<Longrightarrow> t' \<in> S ==> t \<subseteq> t')
- ==> (S hull s = t)"
-unfolding hull_def by auto
-
-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"
- using hull_minimal[of S "{x. P x}" Q]
- by (auto simp add: subset_eq Collect_def mem_def)
-
-lemma hull_inc: "x \<in> S \<Longrightarrow> x \<in> P hull S" by (metis hull_subset subset_eq)
-
-lemma hull_union_subset: "(S hull s) \<union> (S hull t) \<subseteq> (S hull (s \<union> t))"
-unfolding Un_subset_iff by (metis hull_mono Un_upper1 Un_upper2)
-
-lemma hull_union: assumes T: "\<And>T. T \<subseteq> S ==> Inter T \<in> S"
- shows "S hull (s \<union> t) = S hull (S hull s \<union> S hull t)"
-apply rule
-apply (rule hull_mono)
-unfolding Un_subset_iff
-apply (metis hull_subset Un_upper1 Un_upper2 subset_trans)
-apply (rule hull_minimal)
-apply (metis hull_union_subset)
-apply (metis hull_in T)
-done
-
-lemma hull_redundant_eq: "a \<in> (S hull s) \<longleftrightarrow> (S hull (insert a s) = S hull s)"
- unfolding hull_def by blast
-
-lemma hull_redundant: "a \<in> (S hull s) ==> (S hull (insert a s) = S hull s)"
-by (metis hull_redundant_eq)
-
-text{* Archimedian properties and useful consequences. *}
-
-lemma real_arch_simple: "\<exists>n. x <= real (n::nat)"
- using reals_Archimedean2[of x] apply auto by (rule_tac x="Suc n" in exI, auto)
-lemmas real_arch_lt = reals_Archimedean2
-
-lemmas real_arch = reals_Archimedean3
-
-lemma real_arch_inv: "0 < e \<longleftrightarrow> (\<exists>n::nat. n \<noteq> 0 \<and> 0 < inverse (real n) \<and> inverse (real n) < e)"
- using reals_Archimedean
- apply (auto simp add: field_simps inverse_positive_iff_positive)
- apply (subgoal_tac "inverse (real n) > 0")
- apply arith
- apply simp
- done
-
-lemma real_pow_lbound: "0 <= x ==> 1 + real n * x <= (1 + x) ^ n"
-proof(induct n)
- case 0 thus ?case by simp
-next
- case (Suc n)
- hence h: "1 + real n * x \<le> (1 + x) ^ n" by simp
- from h have p: "1 \<le> (1 + x) ^ n" using Suc.prems by simp
- from h have "1 + real n * x + x \<le> (1 + x) ^ n + x" by simp
- also have "\<dots> \<le> (1 + x) ^ Suc n" apply (subst diff_le_0_iff_le[symmetric])
- apply (simp add: ring_simps)
- using mult_left_mono[OF p Suc.prems] by simp
- finally show ?case by (simp add: real_of_nat_Suc ring_simps)
-qed
-
-lemma real_arch_pow: assumes x: "1 < (x::real)" shows "\<exists>n. y < x^n"
-proof-
- from x have x0: "x - 1 > 0" by arith
- from real_arch[OF x0, rule_format, of y]
- obtain n::nat where n:"y < real n * (x - 1)" by metis
- from x0 have x00: "x- 1 \<ge> 0" by arith
- from real_pow_lbound[OF x00, of n] n
- have "y < x^n" by auto
- then show ?thesis by metis
-qed
-
-lemma real_arch_pow2: "\<exists>n. (x::real) < 2^ n"
- using real_arch_pow[of 2 x] by simp
-
-lemma real_arch_pow_inv: assumes y: "(y::real) > 0" and x1: "x < 1"
- shows "\<exists>n. x^n < y"
-proof-
- {assume x0: "x > 0"
- from x0 x1 have ix: "1 < 1/x" by (simp add: field_simps)
- from real_arch_pow[OF ix, of "1/y"]
- obtain n where n: "1/y < (1/x)^n" by blast
- then
- have ?thesis using y x0 by (auto simp add: field_simps power_divide) }
- moreover
- {assume "\<not> x > 0" with y x1 have ?thesis apply auto by (rule exI[where x=1], auto)}
- ultimately show ?thesis by metis
-qed
-
-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)"
- by (metis real_arch_inv)
-
-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"
- apply (rule forall_pos_mono)
- apply auto
- apply (atomize)
- apply (erule_tac x="n - 1" in allE)
- apply auto
- done
-
-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"
- shows "x = 0"
-proof-
- {assume "x \<noteq> 0" with x0 have xp: "x > 0" by arith
- from real_arch[OF xp, rule_format, of c] obtain n::nat where n: "c < real n * x" by blast
- with xc[rule_format, of n] have "n = 0" by arith
- with n c have False by simp}
- then show ?thesis by blast
-qed
-
-(* ------------------------------------------------------------------------- *)
-(* Relate max and min to sup and inf. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma real_max_rsup: "max x y = rsup {x,y}"
-proof-
- have f: "finite {x, y}" "{x,y} \<noteq> {}" by simp_all
- from rsup_finite_le_iff[OF f, of "max x y"] have "rsup {x,y} \<le> max x y" by simp
- moreover
- have "max x y \<le> rsup {x,y}" using rsup_finite_ge_iff[OF f, of "max x y"]
- by (simp add: linorder_linear)
- ultimately show ?thesis by arith
-qed
-
-lemma real_min_rinf: "min x y = rinf {x,y}"
-proof-
- have f: "finite {x, y}" "{x,y} \<noteq> {}" by simp_all
- from rinf_finite_le_iff[OF f, of "min x y"] have "rinf {x,y} \<le> min x y"
- by (simp add: linorder_linear)
- moreover
- have "min x y \<le> rinf {x,y}" using rinf_finite_ge_iff[OF f, of "min x y"]
- by simp
- ultimately show ?thesis by arith
-qed
-
-(* ------------------------------------------------------------------------- *)
-(* Geometric progression. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma sum_gp_basic: "((1::'a::{field}) - x) * setsum (\<lambda>i. x^i) {0 .. n} = (1 - x^(Suc n))"
- (is "?lhs = ?rhs")
-proof-
- {assume x1: "x = 1" hence ?thesis by simp}
- moreover
- {assume x1: "x\<noteq>1"
- hence x1': "x - 1 \<noteq> 0" "1 - x \<noteq> 0" "x - 1 = - (1 - x)" "- (1 - x) \<noteq> 0" by auto
- from geometric_sum[OF x1, of "Suc n", unfolded x1']
- have "(- (1 - x)) * setsum (\<lambda>i. x^i) {0 .. n} = - (1 - x^(Suc n))"
- unfolding atLeastLessThanSuc_atLeastAtMost
- using x1' apply (auto simp only: field_simps)
- apply (simp add: ring_simps)
- done
- then have ?thesis by (simp add: ring_simps) }
- ultimately show ?thesis by metis
-qed
-
-lemma sum_gp_multiplied: assumes mn: "m <= n"
- shows "((1::'a::{field}) - x) * setsum (op ^ x) {m..n} = x^m - x^ Suc n"
- (is "?lhs = ?rhs")
-proof-
- let ?S = "{0..(n - m)}"
- from mn have mn': "n - m \<ge> 0" by arith
- let ?f = "op + m"
- have i: "inj_on ?f ?S" unfolding inj_on_def by auto
- have f: "?f ` ?S = {m..n}"
- using mn apply (auto simp add: image_iff Bex_def) by arith
- have th: "op ^ x o op + m = (\<lambda>i. x^m * x^i)"
- by (rule ext, simp add: power_add power_mult)
- from setsum_reindex[OF i, of "op ^ x", unfolded f th setsum_right_distrib[symmetric]]
- have "?lhs = x^m * ((1 - x) * setsum (op ^ x) {0..n - m})" by simp
- then show ?thesis unfolding sum_gp_basic using mn
- by (simp add: ring_simps power_add[symmetric])
-qed
-
-lemma sum_gp: "setsum (op ^ (x::'a::{field})) {m .. n} =
- (if n < m then 0 else if x = 1 then of_nat ((n + 1) - m)
- else (x^ m - x^ (Suc n)) / (1 - x))"
-proof-
- {assume nm: "n < m" hence ?thesis by simp}
- moreover
- {assume "\<not> n < m" hence nm: "m \<le> n" by arith
- {assume x: "x = 1" hence ?thesis by simp}
- moreover
- {assume x: "x \<noteq> 1" hence nz: "1 - x \<noteq> 0" by simp
- from sum_gp_multiplied[OF nm, of x] nz have ?thesis by (simp add: field_simps)}
- ultimately have ?thesis by metis
- }
- ultimately show ?thesis by metis
-qed
-
-lemma sum_gp_offset: "setsum (op ^ (x::'a::{field})) {m .. m+n} =
- (if x = 1 then of_nat n + 1 else x^m * (1 - x^Suc n) / (1 - x))"
- unfolding sum_gp[of x m "m + n"] power_Suc
- by (simp add: ring_simps power_add)
-
-
-subsection{* A bit of linear algebra. *}
-
-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 )"
-definition "span S = (subspace hull S)"
-definition "dependent S \<longleftrightarrow> (\<exists>a \<in> S. a \<in> span(S - {a}))"
-abbreviation "independent s == ~(dependent s)"
-
-(* Closure properties of subspaces. *)
-
-lemma subspace_UNIV[simp]: "subspace(UNIV)" by (simp add: subspace_def)
-
-lemma subspace_0: "subspace S ==> 0 \<in> S" by (metis subspace_def)
-
-lemma subspace_add: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> y \<in> S ==> x + y \<in> S"
- by (metis subspace_def)
-
-lemma subspace_mul: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> c *s x \<in> S"
- by (metis subspace_def)
-
-lemma subspace_neg: "subspace S \<Longrightarrow> (x::'a::ring_1^'n) \<in> S \<Longrightarrow> - x \<in> S"
- by (metis vector_sneg_minus1 subspace_mul)
-
-lemma subspace_sub: "subspace S \<Longrightarrow> (x::'a::ring_1^'n) \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x - y \<in> S"
- by (metis diff_def subspace_add subspace_neg)
-
-lemma subspace_setsum:
- assumes sA: "subspace A" and fB: "finite B"
- and f: "\<forall>x\<in> B. f x \<in> A"
- shows "setsum f B \<in> A"
- using fB f sA
- apply(induct rule: finite_induct[OF fB])
- by (simp add: subspace_def sA, auto simp add: sA subspace_add)
-
-lemma subspace_linear_image:
- assumes lf: "linear (f::'a::semiring_1^'n \<Rightarrow> _)" and sS: "subspace S"
- shows "subspace(f ` S)"
- using lf sS linear_0[OF lf]
- unfolding linear_def subspace_def
- apply (auto simp add: image_iff)
- apply (rule_tac x="x + y" in bexI, auto)
- apply (rule_tac x="c*s x" in bexI, auto)
- done
-
-lemma subspace_linear_preimage: "linear (f::'a::semiring_1^'n \<Rightarrow> _) ==> subspace S ==> subspace {x. f x \<in> S}"
- by (auto simp add: subspace_def linear_def linear_0[of f])
-
-lemma subspace_trivial: "subspace {0::'a::semiring_1 ^_}"
- by (simp add: subspace_def)
-
-lemma subspace_inter: "subspace A \<Longrightarrow> subspace B ==> subspace (A \<inter> B)"
- by (simp add: subspace_def)
-
-
-lemma span_mono: "A \<subseteq> B ==> span A \<subseteq> span B"
- by (metis span_def hull_mono)
-
-lemma subspace_span: "subspace(span S)"
- unfolding span_def
- apply (rule hull_in[unfolded mem_def])
- apply (simp only: subspace_def Inter_iff Int_iff subset_eq)
- apply auto
- apply (erule_tac x="X" in ballE)
- apply (simp add: mem_def)
- apply blast
- apply (erule_tac x="X" in ballE)
- apply (erule_tac x="X" in ballE)
- apply (erule_tac x="X" in ballE)
- apply (clarsimp simp add: mem_def)
- apply simp
- apply simp
- apply simp
- apply (erule_tac x="X" in ballE)
- apply (erule_tac x="X" in ballE)
- apply (simp add: mem_def)
- apply simp
- apply simp
- done
-
-lemma span_clauses:
- "a \<in> S ==> a \<in> span S"
- "0 \<in> span S"
- "x\<in> span S \<Longrightarrow> y \<in> span S ==> x + y \<in> span S"
- "x \<in> span S \<Longrightarrow> c *s x \<in> span S"
- by (metis span_def hull_subset subset_eq subspace_span subspace_def)+
-
-lemma span_induct: assumes SP: "\<And>x. x \<in> S ==> P x"
- and P: "subspace P" and x: "x \<in> span S" shows "P x"
-proof-
- from SP have SP': "S \<subseteq> P" by (simp add: mem_def subset_eq)
- from P have P': "P \<in> subspace" by (simp add: mem_def)
- from x hull_minimal[OF SP' P', unfolded span_def[symmetric]]
- show "P x" by (metis mem_def subset_eq)
-qed
-
-lemma span_empty: "span {} = {(0::'a::semiring_0 ^ 'n)}"
- apply (simp add: span_def)
- apply (rule hull_unique)
- apply (auto simp add: mem_def subspace_def)
- unfolding mem_def[of "0::'a^'n", symmetric]
- apply simp
- done
-
-lemma independent_empty: "independent {}"
- by (simp add: dependent_def)
-
-lemma independent_mono: "independent A \<Longrightarrow> B \<subseteq> A ==> independent B"
- apply (clarsimp simp add: dependent_def span_mono)
- apply (subgoal_tac "span (B - {a}) \<le> span (A - {a})")
- apply force
- apply (rule span_mono)
- apply auto
- done
-
-lemma span_subspace: "A \<subseteq> B \<Longrightarrow> B \<le> span A \<Longrightarrow> subspace B \<Longrightarrow> span A = B"
- by (metis order_antisym span_def hull_minimal mem_def)
-
-lemma span_induct': assumes SP: "\<forall>x \<in> S. P x"
- and P: "subspace P" shows "\<forall>x \<in> span S. P x"
- using span_induct SP P by blast
-
-inductive span_induct_alt_help for S:: "'a::semiring_1^'n \<Rightarrow> bool"
- where
- span_induct_alt_help_0: "span_induct_alt_help S 0"
- | 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)"
-
-lemma span_induct_alt':
- 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"
-proof-
- {fix x:: "'a^'n" assume x: "span_induct_alt_help S x"
- have "h x"
- apply (rule span_induct_alt_help.induct[OF x])
- apply (rule h0)
- apply (rule hS, assumption, assumption)
- done}
- note th0 = this
- {fix x assume x: "x \<in> span S"
-
- have "span_induct_alt_help S x"
- proof(rule span_induct[where x=x and S=S])
- show "x \<in> span S" using x .
- next
- fix x assume xS : "x \<in> S"
- from span_induct_alt_help_S[OF xS span_induct_alt_help_0, of 1]
- show "span_induct_alt_help S x" by simp
- next
- have "span_induct_alt_help S 0" by (rule span_induct_alt_help_0)
- moreover
- {fix x y assume h: "span_induct_alt_help S x" "span_induct_alt_help S y"
- from h
- have "span_induct_alt_help S (x + y)"
- apply (induct rule: span_induct_alt_help.induct)
- apply simp
- unfolding add_assoc
- apply (rule span_induct_alt_help_S)
- apply assumption
- apply simp
- done}
- moreover
- {fix c x assume xt: "span_induct_alt_help S x"
- then have "span_induct_alt_help S (c*s x)"
- apply (induct rule: span_induct_alt_help.induct)
- apply (simp add: span_induct_alt_help_0)
- apply (simp add: vector_smult_assoc vector_add_ldistrib)
- apply (rule span_induct_alt_help_S)
- apply assumption
- apply simp
- done
- }
- ultimately show "subspace (span_induct_alt_help S)"
- unfolding subspace_def mem_def Ball_def by blast
- qed}
- with th0 show ?thesis by blast
-qed
-
-lemma span_induct_alt:
- 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"
- shows "h x"
-using span_induct_alt'[of h S] h0 hS x by blast
-
-(* Individual closure properties. *)
-
-lemma span_superset: "x \<in> S ==> x \<in> span S" by (metis span_clauses)
-
-lemma span_0: "0 \<in> span S" by (metis subspace_span subspace_0)
-
-lemma span_add: "x \<in> span S \<Longrightarrow> y \<in> span S ==> x + y \<in> span S"
- by (metis subspace_add subspace_span)
-
-lemma span_mul: "x \<in> span S ==> (c *s x) \<in> span S"
- by (metis subspace_span subspace_mul)
-
-lemma span_neg: "x \<in> span S ==> - (x::'a::ring_1^'n) \<in> span S"
- by (metis subspace_neg subspace_span)
-
-lemma span_sub: "(x::'a::ring_1^'n) \<in> span S \<Longrightarrow> y \<in> span S ==> x - y \<in> span S"
- by (metis subspace_span subspace_sub)
-
-lemma span_setsum: "finite A \<Longrightarrow> \<forall>x \<in> A. f x \<in> span S ==> setsum f A \<in> span S"
- apply (rule subspace_setsum)
- by (metis subspace_span subspace_setsum)+
-
-lemma span_add_eq: "(x::'a::ring_1^'n) \<in> span S \<Longrightarrow> x + y \<in> span S \<longleftrightarrow> y \<in> span S"
- apply (auto simp only: span_add span_sub)
- apply (subgoal_tac "(x + y) - x \<in> span S", simp)
- by (simp only: span_add span_sub)
-
-(* Mapping under linear image. *)
-
-lemma span_linear_image: assumes lf: "linear (f::'a::semiring_1 ^ 'n => _)"
- shows "span (f ` S) = f ` (span S)"
-proof-
- {fix x
- assume x: "x \<in> span (f ` S)"
- have "x \<in> f ` span S"
- apply (rule span_induct[where x=x and S = "f ` S"])
- apply (clarsimp simp add: image_iff)
- apply (frule span_superset)
- apply blast
- apply (simp only: mem_def)
- apply (rule subspace_linear_image[OF lf])
- apply (rule subspace_span)
- apply (rule x)
- done}
- moreover
- {fix x assume x: "x \<in> span S"
- have th0:"(\<lambda>a. f a \<in> span (f ` S)) = {x. f x \<in> span (f ` S)}" apply (rule set_ext)
- unfolding mem_def Collect_def ..
- have "f x \<in> span (f ` S)"
- apply (rule span_induct[where S=S])
- apply (rule span_superset)
- apply simp
- apply (subst th0)
- apply (rule subspace_linear_preimage[OF lf subspace_span, of "f ` S"])
- apply (rule x)
- done}
- ultimately show ?thesis by blast
-qed
-
-(* The key breakdown property. *)
-
-lemma span_breakdown:
- assumes bS: "(b::'a::ring_1 ^ 'n) \<in> S" and aS: "a \<in> span S"
- shows "\<exists>k. a - k*s b \<in> span (S - {b})" (is "?P a")
-proof-
- {fix x assume xS: "x \<in> S"
- {assume ab: "x = b"
- then have "?P x"
- apply simp
- apply (rule exI[where x="1"], simp)
- by (rule span_0)}
- moreover
- {assume ab: "x \<noteq> b"
- then have "?P x" using xS
- apply -
- apply (rule exI[where x=0])
- apply (rule span_superset)
- by simp}
- ultimately have "?P x" by blast}
- moreover have "subspace ?P"
- unfolding subspace_def
- apply auto
- apply (simp add: mem_def)
- apply (rule exI[where x=0])
- using span_0[of "S - {b}"]
- apply (simp add: mem_def)
- apply (clarsimp simp add: mem_def)
- apply (rule_tac x="k + ka" in exI)
- apply (subgoal_tac "x + y - (k + ka) *s b = (x - k*s b) + (y - ka *s b)")
- apply (simp only: )
- apply (rule span_add[unfolded mem_def])
- apply assumption+
- apply (vector ring_simps)
- apply (clarsimp simp add: mem_def)
- apply (rule_tac x= "c*k" in exI)
- apply (subgoal_tac "c *s x - (c * k) *s b = c*s (x - k*s b)")
- apply (simp only: )
- apply (rule span_mul[unfolded mem_def])
- apply assumption
- by (vector ring_simps)
- ultimately show "?P a" using aS span_induct[where S=S and P= "?P"] by metis
-qed
-
-lemma span_breakdown_eq:
- "(x::'a::ring_1^'n) \<in> span (insert a S) \<longleftrightarrow> (\<exists>k. (x - k *s a) \<in> span S)" (is "?lhs \<longleftrightarrow> ?rhs")
-proof-
- {assume x: "x \<in> span (insert a S)"
- from x span_breakdown[of "a" "insert a S" "x"]
- have ?rhs apply clarsimp
- apply (rule_tac x= "k" in exI)
- apply (rule set_rev_mp[of _ "span (S - {a})" _])
- apply assumption
- apply (rule span_mono)
- apply blast
- done}
- moreover
- { fix k assume k: "x - k *s a \<in> span S"
- have eq: "x = (x - k *s a) + k *s a" by vector
- have "(x - k *s a) + k *s a \<in> span (insert a S)"
- apply (rule span_add)
- apply (rule set_rev_mp[of _ "span S" _])
- apply (rule k)
- apply (rule span_mono)
- apply blast
- apply (rule span_mul)
- apply (rule span_superset)
- apply blast
- done
- then have ?lhs using eq by metis}
- ultimately show ?thesis by blast
-qed
-
-(* Hence some "reversal" results.*)
-
-lemma in_span_insert:
- assumes a: "(a::'a::field^'n) \<in> span (insert b S)" and na: "a \<notin> span S"
- shows "b \<in> span (insert a S)"
-proof-
- from span_breakdown[of b "insert b S" a, OF insertI1 a]
- obtain k where k: "a - k*s b \<in> span (S - {b})" by auto
- {assume k0: "k = 0"
- with k have "a \<in> span S"
- apply (simp)
- apply (rule set_rev_mp)
- apply assumption
- apply (rule span_mono)
- apply blast
- done
- with na have ?thesis by blast}
- moreover
- {assume k0: "k \<noteq> 0"
- have eq: "b = (1/k) *s a - ((1/k) *s a - b)" by vector
- from k0 have eq': "(1/k) *s (a - k*s b) = (1/k) *s a - b"
- by (vector field_simps)
- from k have "(1/k) *s (a - k*s b) \<in> span (S - {b})"
- by (rule span_mul)
- hence th: "(1/k) *s a - b \<in> span (S - {b})"
- unfolding eq' .
-
- from k
- have ?thesis
- apply (subst eq)
- apply (rule span_sub)
- apply (rule span_mul)
- apply (rule span_superset)
- apply blast
- apply (rule set_rev_mp)
- apply (rule th)
- apply (rule span_mono)
- using na by blast}
- ultimately show ?thesis by blast
-qed
-
-lemma in_span_delete:
- assumes a: "(a::'a::field^'n) \<in> span S"
- and na: "a \<notin> span (S-{b})"
- shows "b \<in> span (insert a (S - {b}))"
- apply (rule in_span_insert)
- apply (rule set_rev_mp)
- apply (rule a)
- apply (rule span_mono)
- apply blast
- apply (rule na)
- done
-
-(* Transitivity property. *)
-
-lemma span_trans:
- assumes x: "(x::'a::ring_1^'n) \<in> span S" and y: "y \<in> span (insert x S)"
- shows "y \<in> span S"
-proof-
- from span_breakdown[of x "insert x S" y, OF insertI1 y]
- obtain k where k: "y -k*s x \<in> span (S - {x})" by auto
- have eq: "y = (y - k *s x) + k *s x" by vector
- show ?thesis
- apply (subst eq)
- apply (rule span_add)
- apply (rule set_rev_mp)
- apply (rule k)
- apply (rule span_mono)
- apply blast
- apply (rule span_mul)
- by (rule x)
-qed
-
-(* ------------------------------------------------------------------------- *)
-(* An explicit expansion is sometimes needed. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma span_explicit:
- "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}"
- (is "_ = ?E" is "_ = {y. ?h y}" is "_ = {y. \<exists>S u. ?Q S u y}")
-proof-
- {fix x assume x: "x \<in> ?E"
- then obtain S u where fS: "finite S" and SP: "S\<subseteq>P" and u: "setsum (\<lambda>v. u v *s v) S = x"
- by blast
- have "x \<in> span P"
- unfolding u[symmetric]
- apply (rule span_setsum[OF fS])
- using span_mono[OF SP]
- by (auto intro: span_superset span_mul)}
- moreover
- have "\<forall>x \<in> span P. x \<in> ?E"
- unfolding mem_def Collect_def
- proof(rule span_induct_alt')
- show "?h 0"
- apply (rule exI[where x="{}"]) by simp
- next
- fix c x y
- assume x: "x \<in> P" and hy: "?h y"
- from hy obtain S u where fS: "finite S" and SP: "S\<subseteq>P"
- and u: "setsum (\<lambda>v. u v *s v) S = y" by blast
- let ?S = "insert x S"
- let ?u = "\<lambda>y. if y = x then (if x \<in> S then u y + c else c)
- else u y"
- from fS SP x have th0: "finite (insert x S)" "insert x S \<subseteq> P" by blast+
- {assume xS: "x \<in> S"
- have S1: "S = (S - {x}) \<union> {x}"
- and Sss:"finite (S - {x})" "finite {x}" "(S -{x}) \<inter> {x} = {}" using xS fS by auto
- have "setsum (\<lambda>v. ?u v *s v) ?S =(\<Sum>v\<in>S - {x}. u v *s v) + (u x + c) *s x"
- using xS
- by (simp add: setsum_Un_disjoint[OF Sss, unfolded S1[symmetric]]
- setsum_clauses(2)[OF fS] cong del: if_weak_cong)
- also have "\<dots> = (\<Sum>v\<in>S. u v *s v) + c *s x"
- apply (simp add: setsum_Un_disjoint[OF Sss, unfolded S1[symmetric]])
- by (vector ring_simps)
- also have "\<dots> = c*s x + y"
- by (simp add: add_commute u)
- finally have "setsum (\<lambda>v. ?u v *s v) ?S = c*s x + y" .
- then have "?Q ?S ?u (c*s x + y)" using th0 by blast}
- moreover
- {assume xS: "x \<notin> S"
- have th00: "(\<Sum>v\<in>S. (if v = x then c else u v) *s v) = y"
- unfolding u[symmetric]
- apply (rule setsum_cong2)
- using xS by auto
- have "?Q ?S ?u (c*s x + y)" using fS xS th0
- by (simp add: th00 setsum_clauses add_commute cong del: if_weak_cong)}
- ultimately have "?Q ?S ?u (c*s x + y)"
- by (cases "x \<in> S", simp, simp)
- then show "?h (c*s x + y)"
- apply -
- apply (rule exI[where x="?S"])
- apply (rule exI[where x="?u"]) by metis
- qed
- ultimately show ?thesis by blast
-qed
-
-lemma dependent_explicit:
- "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")
-proof-
- {assume dP: "dependent P"
- then obtain a S u where aP: "a \<in> P" and fS: "finite S"
- and SP: "S \<subseteq> P - {a}" and ua: "setsum (\<lambda>v. u v *s v) S = a"
- unfolding dependent_def span_explicit by blast
- let ?S = "insert a S"
- let ?u = "\<lambda>y. if y = a then - 1 else u y"
- let ?v = a
- from aP SP have aS: "a \<notin> S" by blast
- from fS SP aP have th0: "finite ?S" "?S \<subseteq> P" "?v \<in> ?S" "?u ?v \<noteq> 0" by auto
- have s0: "setsum (\<lambda>v. ?u v *s v) ?S = 0"
- using fS aS
- apply (simp add: vector_smult_lneg vector_smult_lid setsum_clauses ring_simps )
- apply (subst (2) ua[symmetric])
- apply (rule setsum_cong2)
- by auto
- with th0 have ?rhs
- apply -
- apply (rule exI[where x= "?S"])
- apply (rule exI[where x= "?u"])
- by clarsimp}
- moreover
- {fix S u v assume fS: "finite S"
- and SP: "S \<subseteq> P" and vS: "v \<in> S" and uv: "u v \<noteq> 0"
- and u: "setsum (\<lambda>v. u v *s v) S = 0"
- let ?a = v
- let ?S = "S - {v}"
- let ?u = "\<lambda>i. (- u i) / u v"
- have th0: "?a \<in> P" "finite ?S" "?S \<subseteq> P" using fS SP vS by auto
- 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"
- using fS vS uv
- by (simp add: setsum_diff1 vector_smult_lneg divide_inverse
- vector_smult_assoc field_simps)
- also have "\<dots> = ?a"
- unfolding setsum_cmul u
- using uv by (simp add: vector_smult_lneg)
- finally have "setsum (\<lambda>v. ?u v *s v) ?S = ?a" .
- with th0 have ?lhs
- unfolding dependent_def span_explicit
- apply -
- apply (rule bexI[where x= "?a"])
- apply simp_all
- apply (rule exI[where x= "?S"])
- by auto}
- ultimately show ?thesis by blast
-qed
-
-
-lemma span_finite:
- assumes fS: "finite S"
- shows "span S = {(y::'a::semiring_1^'n). \<exists>u. setsum (\<lambda>v. u v *s v) S = y}"
- (is "_ = ?rhs")
-proof-
- {fix y assume y: "y \<in> span S"
- from y obtain S' u where fS': "finite S'" and SS': "S' \<subseteq> S" and
- u: "setsum (\<lambda>v. u v *s v) S' = y" unfolding span_explicit by blast
- let ?u = "\<lambda>x. if x \<in> S' then u x else 0"
- from setsum_restrict_set[OF fS, of "\<lambda>v. u v *s v" S', symmetric] SS'
- have "setsum (\<lambda>v. ?u v *s v) S = setsum (\<lambda>v. u v *s v) S'"
- unfolding cond_value_iff cond_application_beta
- by (simp add: cond_value_iff inf_absorb2 cong del: if_weak_cong)
- hence "setsum (\<lambda>v. ?u v *s v) S = y" by (metis u)
- hence "y \<in> ?rhs" by auto}
- moreover
- {fix y u assume u: "setsum (\<lambda>v. u v *s v) S = y"
- then have "y \<in> span S" using fS unfolding span_explicit by auto}
- ultimately show ?thesis by blast
-qed
-
-
-(* Standard bases are a spanning set, and obviously finite. *)
-
-lemma span_stdbasis:"span {basis i :: 'a::ring_1^'n::finite | i. i \<in> (UNIV :: 'n set)} = UNIV"
-apply (rule set_ext)
-apply auto
-apply (subst basis_expansion[symmetric])
-apply (rule span_setsum)
-apply simp
-apply auto
-apply (rule span_mul)
-apply (rule span_superset)
-apply (auto simp add: Collect_def mem_def)
-done
-
-lemma has_size_stdbasis: "{basis i ::real ^'n::finite | i. i \<in> (UNIV :: 'n set)} hassize CARD('n)" (is "?S hassize ?n")
-proof-
- have eq: "?S = basis ` UNIV" by blast
- show ?thesis unfolding eq
- apply (rule hassize_image_inj[OF basis_inj])
- by (simp add: hassize_def)
-qed
-
-lemma finite_stdbasis: "finite {basis i ::real^'n::finite |i. i\<in> (UNIV:: 'n set)}"
- using has_size_stdbasis[unfolded hassize_def]
- ..
-
-lemma card_stdbasis: "card {basis i ::real^'n::finite |i. i\<in> (UNIV :: 'n set)} = CARD('n)"
- using has_size_stdbasis[unfolded hassize_def]
- ..
-
-lemma independent_stdbasis_lemma:
- assumes x: "(x::'a::semiring_1 ^ 'n) \<in> span (basis ` S)"
- and iS: "i \<notin> S"
- shows "(x$i) = 0"
-proof-
- let ?U = "UNIV :: 'n set"
- let ?B = "basis ` S"
- let ?P = "\<lambda>(x::'a^'n). \<forall>i\<in> ?U. i \<notin> S \<longrightarrow> x$i =0"
- {fix x::"'a^'n" assume xS: "x\<in> ?B"
- from xS have "?P x" by auto}
- moreover
- have "subspace ?P"
- by (auto simp add: subspace_def Collect_def mem_def)
- ultimately show ?thesis
- using x span_induct[of ?B ?P x] iS by blast
-qed
-
-lemma independent_stdbasis: "independent {basis i ::real^'n::finite |i. i\<in> (UNIV :: 'n set)}"
-proof-
- let ?I = "UNIV :: 'n set"
- let ?b = "basis :: _ \<Rightarrow> real ^'n"
- let ?B = "?b ` ?I"
- have eq: "{?b i|i. i \<in> ?I} = ?B"
- by auto
- {assume d: "dependent ?B"
- then obtain k where k: "k \<in> ?I" "?b k \<in> span (?B - {?b k})"
- unfolding dependent_def by auto
- have eq1: "?B - {?b k} = ?B - ?b ` {k}" by simp
- have eq2: "?B - {?b k} = ?b ` (?I - {k})"
- unfolding eq1
- apply (rule inj_on_image_set_diff[symmetric])
- apply (rule basis_inj) using k(1) by auto
- from k(2) have th0: "?b k \<in> span (?b ` (?I - {k}))" unfolding eq2 .
- from independent_stdbasis_lemma[OF th0, of k, simplified]
- have False by simp}
- then show ?thesis unfolding eq dependent_def ..
-qed
-
-(* This is useful for building a basis step-by-step. *)
-
-lemma independent_insert:
- "independent(insert (a::'a::field ^'n) S) \<longleftrightarrow>
- (if a \<in> S then independent S
- else independent S \<and> a \<notin> span S)" (is "?lhs \<longleftrightarrow> ?rhs")
-proof-
- {assume aS: "a \<in> S"
- hence ?thesis using insert_absorb[OF aS] by simp}
- moreover
- {assume aS: "a \<notin> S"
- {assume i: ?lhs
- then have ?rhs using aS
- apply simp
- apply (rule conjI)
- apply (rule independent_mono)
- apply assumption
- apply blast
- by (simp add: dependent_def)}
- moreover
- {assume i: ?rhs
- have ?lhs using i aS
- apply simp
- apply (auto simp add: dependent_def)
- apply (case_tac "aa = a", auto)
- apply (subgoal_tac "insert a S - {aa} = insert a (S - {aa})")
- apply simp
- apply (subgoal_tac "a \<in> span (insert aa (S - {aa}))")
- apply (subgoal_tac "insert aa (S - {aa}) = S")
- apply simp
- apply blast
- apply (rule in_span_insert)
- apply assumption
- apply blast
- apply blast
- done}
- ultimately have ?thesis by blast}
- ultimately show ?thesis by blast
-qed
-
-(* The degenerate case of the Exchange Lemma. *)
-
-lemma mem_delete: "x \<in> (A - {a}) \<longleftrightarrow> x \<noteq> a \<and> x \<in> A"
- by blast
-
-lemma span_span: "span (span A) = span A"
- unfolding span_def hull_hull ..
-
-lemma span_inc: "S \<subseteq> span S"
- by (metis subset_eq span_superset)
-
-lemma spanning_subset_independent:
- assumes BA: "B \<subseteq> A" and iA: "independent (A::('a::field ^'n) set)"
- and AsB: "A \<subseteq> span B"
- shows "A = B"
-proof
- from BA show "B \<subseteq> A" .
-next
- from span_mono[OF BA] span_mono[OF AsB]
- have sAB: "span A = span B" unfolding span_span by blast
-
- {fix x assume x: "x \<in> A"
- from iA have th0: "x \<notin> span (A - {x})"
- unfolding dependent_def using x by blast
- from x have xsA: "x \<in> span A" by (blast intro: span_superset)
- have "A - {x} \<subseteq> A" by blast
- hence th1:"span (A - {x}) \<subseteq> span A" by (metis span_mono)
- {assume xB: "x \<notin> B"
- from xB BA have "B \<subseteq> A -{x}" by blast
- hence "span B \<subseteq> span (A - {x})" by (metis span_mono)
- with th1 th0 sAB have "x \<notin> span A" by blast
- with x have False by (metis span_superset)}
- then have "x \<in> B" by blast}
- then show "A \<subseteq> B" by blast
-qed
-
-(* The general case of the Exchange Lemma, the key to what follows. *)
-
-lemma exchange_lemma:
- assumes f:"finite (t:: ('a::field^'n) set)" and i: "independent s"
- and sp:"s \<subseteq> span t"
- shows "\<exists>t'. (t' hassize card t) \<and> s \<subseteq> t' \<and> t' \<subseteq> s \<union> t \<and> s \<subseteq> span t'"
-using f i sp
-proof(induct c\<equiv>"card(t - s)" arbitrary: s t rule: nat_less_induct)
- fix n:: nat and s t :: "('a ^'n) set"
- assume H: " \<forall>m<n. \<forall>(x:: ('a ^'n) set) xa.
- finite xa \<longrightarrow>
- independent x \<longrightarrow>
- x \<subseteq> span xa \<longrightarrow>
- m = card (xa - x) \<longrightarrow>
- (\<exists>t'. (t' hassize card xa) \<and>
- x \<subseteq> t' \<and> t' \<subseteq> x \<union> xa \<and> x \<subseteq> span t')"
- and ft: "finite t" and s: "independent s" and sp: "s \<subseteq> span t"
- and n: "n = card (t - s)"
- let ?P = "\<lambda>t'. (t' hassize card t) \<and> s \<subseteq> t' \<and> t' \<subseteq> s \<union> t \<and> s \<subseteq> span t'"
- let ?ths = "\<exists>t'. ?P t'"
- {assume st: "s \<subseteq> t"
- from st ft span_mono[OF st] have ?ths apply - apply (rule exI[where x=t])
- by (auto simp add: hassize_def intro: span_superset)}
- moreover
- {assume st: "t \<subseteq> s"
-
- from spanning_subset_independent[OF st s sp]
- st ft span_mono[OF st] have ?ths apply - apply (rule exI[where x=t])
- by (auto simp add: hassize_def intro: span_superset)}
- moreover
- {assume st: "\<not> s \<subseteq> t" "\<not> t \<subseteq> s"
- from st(2) obtain b where b: "b \<in> t" "b \<notin> s" by blast
- from b have "t - {b} - s \<subset> t - s" by blast
- then have cardlt: "card (t - {b} - s) < n" using n ft
- by (auto intro: psubset_card_mono)
- from b ft have ct0: "card t \<noteq> 0" by auto
- {assume stb: "s \<subseteq> span(t -{b})"
- from ft have ftb: "finite (t -{b})" by auto
- from H[rule_format, OF cardlt ftb s stb]
- obtain u where u: "u hassize card (t-{b})" "s \<subseteq> u" "u \<subseteq> s \<union> (t - {b})" "s \<subseteq> span u" by blast
- let ?w = "insert b u"
- have th0: "s \<subseteq> insert b u" using u by blast
- from u(3) b have "u \<subseteq> s \<union> t" by blast
- then have th1: "insert b u \<subseteq> s \<union> t" using u b by blast
- have bu: "b \<notin> u" using b u by blast
- from u(1) have fu: "finite u" by (simp add: hassize_def)
- from u(1) ft b have "u hassize (card t - 1)" by auto
- then
- have th2: "insert b u hassize card t"
- using card_insert_disjoint[OF fu bu] ct0 by (auto simp add: hassize_def)
- from u(4) have "s \<subseteq> span u" .
- also have "\<dots> \<subseteq> span (insert b u)" apply (rule span_mono) by blast
- finally have th3: "s \<subseteq> span (insert b u)" . from th0 th1 th2 th3 have th: "?P ?w" by blast
- from th have ?ths by blast}
- moreover
- {assume stb: "\<not> s \<subseteq> span(t -{b})"
- from stb obtain a where a: "a \<in> s" "a \<notin> span (t - {b})" by blast
- have ab: "a \<noteq> b" using a b by blast
- have at: "a \<notin> t" using a ab span_superset[of a "t- {b}"] by auto
- have mlt: "card ((insert a (t - {b})) - s) < n"
- using cardlt ft n a b by auto
- have ft': "finite (insert a (t - {b}))" using ft by auto
- {fix x assume xs: "x \<in> s"
- have t: "t \<subseteq> (insert b (insert a (t -{b})))" using b by auto
- from b(1) have "b \<in> span t" by (simp add: span_superset)
- have bs: "b \<in> span (insert a (t - {b}))"
- by (metis in_span_delete a sp mem_def subset_eq)
- from xs sp have "x \<in> span t" by blast
- with span_mono[OF t]
- have x: "x \<in> span (insert b (insert a (t - {b})))" ..
- from span_trans[OF bs x] have "x \<in> span (insert a (t - {b}))" .}
- then have sp': "s \<subseteq> span (insert a (t - {b}))" by blast
-
- from H[rule_format, OF mlt ft' s sp' refl] obtain u where
- u: "u hassize card (insert a (t -{b}))" "s \<subseteq> u" "u \<subseteq> s \<union> insert a (t -{b})"
- "s \<subseteq> span u" by blast
- from u a b ft at ct0 have "?P u" by (auto simp add: hassize_def)
- then have ?ths by blast }
- ultimately have ?ths by blast
- }
- ultimately
- show ?ths by blast
-qed
-
-(* This implies corresponding size bounds. *)
-
-lemma independent_span_bound:
- assumes f: "finite t" and i: "independent (s::('a::field^'n) set)" and sp:"s \<subseteq> span t"
- shows "finite s \<and> card s \<le> card t"
- by (metis exchange_lemma[OF f i sp] hassize_def finite_subset card_mono)
-
-
-lemma finite_Atleast_Atmost_nat[simp]: "finite {f x |x. x\<in> (UNIV::'a::finite set)}"
-proof-
- have eq: "{f x |x. x\<in> UNIV} = f ` UNIV" by auto
- show ?thesis unfolding eq
- apply (rule finite_imageI)
- apply (rule finite)
- done
-qed
-
-
-lemma independent_bound:
- fixes S:: "(real^'n::finite) set"
- shows "independent S \<Longrightarrow> finite S \<and> card S <= CARD('n)"
- apply (subst card_stdbasis[symmetric])
- apply (rule independent_span_bound)
- apply (rule finite_Atleast_Atmost_nat)
- apply assumption
- unfolding span_stdbasis
- apply (rule subset_UNIV)
- done
-
-lemma dependent_biggerset: "(finite (S::(real ^'n::finite) set) ==> card S > CARD('n)) ==> dependent S"
- by (metis independent_bound not_less)
-
-(* Hence we can create a maximal independent subset. *)
-
-lemma maximal_independent_subset_extend:
- assumes sv: "(S::(real^'n::finite) set) \<subseteq> V" and iS: "independent S"
- shows "\<exists>B. S \<subseteq> B \<and> B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B"
- using sv iS
-proof(induct d\<equiv> "CARD('n) - card S" arbitrary: S rule: nat_less_induct)
- fix n and S:: "(real^'n) set"
- assume H: "\<forall>m<n. \<forall>S \<subseteq> V. independent S \<longrightarrow> m = CARD('n) - card S \<longrightarrow>
- (\<exists>B. S \<subseteq> B \<and> B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B)"
- and sv: "S \<subseteq> V" and i: "independent S" and n: "n = CARD('n) - card S"
- let ?P = "\<lambda>B. S \<subseteq> B \<and> B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B"
- let ?ths = "\<exists>x. ?P x"
- let ?d = "CARD('n)"
- {assume "V \<subseteq> span S"
- then have ?ths using sv i by blast }
- moreover
- {assume VS: "\<not> V \<subseteq> span S"
- from VS obtain a where a: "a \<in> V" "a \<notin> span S" by blast
- from a have aS: "a \<notin> S" by (auto simp add: span_superset)
- have th0: "insert a S \<subseteq> V" using a sv by blast
- from independent_insert[of a S] i a
- have th1: "independent (insert a S)" by auto
- have mlt: "?d - card (insert a S) < n"
- using aS a n independent_bound[OF th1]
- by auto
-
- from H[rule_format, OF mlt th0 th1 refl]
- obtain B where B: "insert a S \<subseteq> B" "B \<subseteq> V" "independent B" " V \<subseteq> span B"
- by blast
- from B have "?P B" by auto
- then have ?ths by blast}
- ultimately show ?ths by blast
-qed
-
-lemma maximal_independent_subset:
- "\<exists>(B:: (real ^'n::finite) set). B\<subseteq> V \<and> independent B \<and> V \<subseteq> span B"
- by (metis maximal_independent_subset_extend[of "{}:: (real ^'n) set"] empty_subsetI independent_empty)
-
-(* Notion of dimension. *)
-
-definition "dim V = (SOME n. \<exists>B. B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> (B hassize n))"
-
-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)"
-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)"]
-unfolding hassize_def
-using maximal_independent_subset[of V] independent_bound
-by auto
-
-(* Consequences of independence or spanning for cardinality. *)
-
-lemma independent_card_le_dim: "(B::(real ^'n::finite) set) \<subseteq> V \<Longrightarrow> independent B \<Longrightarrow> finite B \<and> card B \<le> dim V"
-by (metis basis_exists[of V] independent_span_bound[where ?'a=real] hassize_def subset_trans)
-
-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"
- by (metis basis_exists[of V] independent_span_bound hassize_def subset_trans)
-
-lemma basis_card_eq_dim:
- "B \<subseteq> (V:: (real ^'n::finite) set) \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> independent B \<Longrightarrow> finite B \<and> card B = dim V"
- by (metis order_eq_iff independent_card_le_dim span_card_ge_dim independent_mono)
-
-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"
- by (metis basis_card_eq_dim hassize_def)
-
-(* More lemmas about dimension. *)
-
-lemma dim_univ: "dim (UNIV :: (real^'n::finite) set) = CARD('n)"
- apply (rule dim_unique[of "{basis i |i. i\<in> (UNIV :: 'n set)}"])
- by (auto simp only: span_stdbasis has_size_stdbasis independent_stdbasis)
-
-lemma dim_subset:
- "(S:: (real ^'n::finite) set) \<subseteq> T \<Longrightarrow> dim S \<le> dim T"
- using basis_exists[of T] basis_exists[of S]
- by (metis independent_span_bound[where ?'a = real and ?'n = 'n] subset_eq hassize_def)
-
-lemma dim_subset_univ: "dim (S:: (real^'n::finite) set) \<le> CARD('n)"
- by (metis dim_subset subset_UNIV dim_univ)
-
-(* Converses to those. *)
-
-lemma card_ge_dim_independent:
- assumes BV:"(B::(real ^'n::finite) set) \<subseteq> V" and iB:"independent B" and dVB:"dim V \<le> card B"
- shows "V \<subseteq> span B"
-proof-
- {fix a assume aV: "a \<in> V"
- {assume aB: "a \<notin> span B"
- then have iaB: "independent (insert a B)" using iB aV BV by (simp add: independent_insert)
- from aV BV have th0: "insert a B \<subseteq> V" by blast
- from aB have "a \<notin>B" by (auto simp add: span_superset)
- with independent_card_le_dim[OF th0 iaB] dVB have False by auto}
- then have "a \<in> span B" by blast}
- then show ?thesis by blast
-qed
-
-lemma card_le_dim_spanning:
- assumes BV: "(B:: (real ^'n::finite) set) \<subseteq> V" and VB: "V \<subseteq> span B"
- and fB: "finite B" and dVB: "dim V \<ge> card B"
- shows "independent B"
-proof-
- {fix a assume a: "a \<in> B" "a \<in> span (B -{a})"
- from a fB have c0: "card B \<noteq> 0" by auto
- from a fB have cb: "card (B -{a}) = card B - 1" by auto
- from BV a have th0: "B -{a} \<subseteq> V" by blast
- {fix x assume x: "x \<in> V"
- from a have eq: "insert a (B -{a}) = B" by blast
- from x VB have x': "x \<in> span B" by blast
- from span_trans[OF a(2), unfolded eq, OF x']
- have "x \<in> span (B -{a})" . }
- then have th1: "V \<subseteq> span (B -{a})" by blast
- have th2: "finite (B -{a})" using fB by auto
- from span_card_ge_dim[OF th0 th1 th2]
- have c: "dim V \<le> card (B -{a})" .
- from c c0 dVB cb have False by simp}
- then show ?thesis unfolding dependent_def by blast
-qed
-
-lemma card_eq_dim: "(B:: (real ^'n::finite) set) \<subseteq> V \<Longrightarrow> B hassize dim V \<Longrightarrow> independent B \<longleftrightarrow> V \<subseteq> span B"
- by (metis hassize_def order_eq_iff card_le_dim_spanning
- card_ge_dim_independent)
-
-(* ------------------------------------------------------------------------- *)
-(* More general size bound lemmas. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma independent_bound_general:
- "independent (S:: (real^'n::finite) set) \<Longrightarrow> finite S \<and> card S \<le> dim S"
- by (metis independent_card_le_dim independent_bound subset_refl)
-
-lemma dependent_biggerset_general: "(finite (S:: (real^'n::finite) set) \<Longrightarrow> card S > dim S) \<Longrightarrow> dependent S"
- using independent_bound_general[of S] by (metis linorder_not_le)
-
-lemma dim_span: "dim (span (S:: (real ^'n::finite) set)) = dim S"
-proof-
- have th0: "dim S \<le> dim (span S)"
- by (auto simp add: subset_eq intro: dim_subset span_superset)
- from basis_exists[of S]
- obtain B where B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "B hassize dim S" by blast
- from B have fB: "finite B" "card B = dim S" unfolding hassize_def by blast+
- have bSS: "B \<subseteq> span S" using B(1) by (metis subset_eq span_inc)
- have sssB: "span S \<subseteq> span B" using span_mono[OF B(3)] by (simp add: span_span)
- from span_card_ge_dim[OF bSS sssB fB(1)] th0 show ?thesis
- using fB(2) by arith
-qed
-
-lemma subset_le_dim: "(S:: (real ^'n::finite) set) \<subseteq> span T \<Longrightarrow> dim S \<le> dim T"
- by (metis dim_span dim_subset)
-
-lemma span_eq_dim: "span (S:: (real ^'n::finite) set) = span T ==> dim S = dim T"
- by (metis dim_span)
-
-lemma spans_image:
- assumes lf: "linear (f::'a::semiring_1^'n \<Rightarrow> _)" and VB: "V \<subseteq> span B"
- shows "f ` V \<subseteq> span (f ` B)"
- unfolding span_linear_image[OF lf]
- by (metis VB image_mono)
-
-lemma dim_image_le:
- fixes f :: "real^'n::finite \<Rightarrow> real^'m::finite"
- assumes lf: "linear f" shows "dim (f ` S) \<le> dim (S:: (real ^'n::finite) set)"
-proof-
- from basis_exists[of S] obtain B where
- B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "B hassize dim S" by blast
- from B have fB: "finite B" "card B = dim S" unfolding hassize_def by blast+
- have "dim (f ` S) \<le> card (f ` B)"
- apply (rule span_card_ge_dim)
- using lf B fB by (auto simp add: span_linear_image spans_image subset_image_iff)
- also have "\<dots> \<le> dim S" using card_image_le[OF fB(1)] fB by simp
- finally show ?thesis .
-qed
-
-(* Relation between bases and injectivity/surjectivity of map. *)
-
-lemma spanning_surjective_image:
- assumes us: "UNIV \<subseteq> span (S:: ('a::semiring_1 ^'n) set)"
- and lf: "linear f" and sf: "surj f"
- shows "UNIV \<subseteq> span (f ` S)"
-proof-
- have "UNIV \<subseteq> f ` UNIV" using sf by (auto simp add: surj_def)
- also have " \<dots> \<subseteq> span (f ` S)" using spans_image[OF lf us] .
-finally show ?thesis .
-qed
-
-lemma independent_injective_image:
- assumes iS: "independent (S::('a::semiring_1^'n) set)" and lf: "linear f" and fi: "inj f"
- shows "independent (f ` S)"
-proof-
- {fix a assume a: "a \<in> S" "f a \<in> span (f ` S - {f a})"
- have eq: "f ` S - {f a} = f ` (S - {a})" using fi
- by (auto simp add: inj_on_def)
- from a have "f a \<in> f ` span (S -{a})"
- unfolding eq span_linear_image[OF lf, of "S - {a}"] by blast
- hence "a \<in> span (S -{a})" using fi by (auto simp add: inj_on_def)
- with a(1) iS have False by (simp add: dependent_def) }
- then show ?thesis unfolding dependent_def by blast
-qed
-
-(* ------------------------------------------------------------------------- *)
-(* Picking an orthogonal replacement for a spanning set. *)
-(* ------------------------------------------------------------------------- *)
- (* FIXME : Move to some general theory ?*)
-definition "pairwise R S \<longleftrightarrow> (\<forall>x \<in> S. \<forall>y\<in> S. x\<noteq>y \<longrightarrow> R x y)"
-
-lemma vector_sub_project_orthogonal: "(b::'a::ordered_field^'n::finite) \<bullet> (x - ((b \<bullet> x) / (b\<bullet>b)) *s b) = 0"
- apply (cases "b = 0", simp)
- apply (simp add: dot_rsub dot_rmult)
- unfolding times_divide_eq_right[symmetric]
- by (simp add: field_simps dot_eq_0)
-
-lemma basis_orthogonal:
- fixes B :: "(real ^'n::finite) set"
- assumes fB: "finite B"
- shows "\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C"
- (is " \<exists>C. ?P B C")
-proof(induct rule: finite_induct[OF fB])
- case 1 thus ?case apply (rule exI[where x="{}"]) by (auto simp add: pairwise_def)
-next
- case (2 a B)
- note fB = `finite B` and aB = `a \<notin> B`
- from `\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C`
- obtain C where C: "finite C" "card C \<le> card B"
- "span C = span B" "pairwise orthogonal C" by blast
- let ?a = "a - setsum (\<lambda>x. (x\<bullet>a / (x\<bullet>x)) *s x) C"
- let ?C = "insert ?a C"
- from C(1) have fC: "finite ?C" by simp
- from fB aB C(1,2) have cC: "card ?C \<le> card (insert a B)" by (simp add: card_insert_if)
- {fix x k
- have th0: "\<And>(a::'b::comm_ring) b c. a - (b - c) = c + (a - b)" by (simp add: ring_simps)
- 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"
- apply (simp only: vector_ssub_ldistrib th0)
- apply (rule span_add_eq)
- apply (rule span_mul)
- apply (rule span_setsum[OF C(1)])
- apply clarify
- apply (rule span_mul)
- by (rule span_superset)}
- then have SC: "span ?C = span (insert a B)"
- unfolding expand_set_eq span_breakdown_eq C(3)[symmetric] by auto
- thm pairwise_def
- {fix x y assume xC: "x \<in> ?C" and yC: "y \<in> ?C" and xy: "x \<noteq> y"
- {assume xa: "x = ?a" and ya: "y = ?a"
- have "orthogonal x y" using xa ya xy by blast}
- moreover
- {assume xa: "x = ?a" and ya: "y \<noteq> ?a" "y \<in> C"
- from ya have Cy: "C = insert y (C - {y})" by blast
- have fth: "finite (C - {y})" using C by simp
- have "orthogonal x y"
- using xa ya
- unfolding orthogonal_def xa dot_lsub dot_rsub diff_eq_0_iff_eq
- apply simp
- apply (subst Cy)
- using C(1) fth
- apply (simp only: setsum_clauses)
- thm dot_ladd
- apply (auto simp add: dot_ladd dot_radd dot_lmult dot_rmult dot_eq_0 dot_sym[of y a] dot_lsum[OF fth])
- apply (rule setsum_0')
- apply clarsimp
- apply (rule C(4)[unfolded pairwise_def orthogonal_def, rule_format])
- by auto}
- moreover
- {assume xa: "x \<noteq> ?a" "x \<in> C" and ya: "y = ?a"
- from xa have Cx: "C = insert x (C - {x})" by blast
- have fth: "finite (C - {x})" using C by simp
- have "orthogonal x y"
- using xa ya
- unfolding orthogonal_def ya dot_rsub dot_lsub diff_eq_0_iff_eq
- apply simp
- apply (subst Cx)
- using C(1) fth
- apply (simp only: setsum_clauses)
- apply (subst dot_sym[of x])
- apply (auto simp add: dot_radd dot_rmult dot_eq_0 dot_sym[of x a] dot_rsum[OF fth])
- apply (rule setsum_0')
- apply clarsimp
- apply (rule C(4)[unfolded pairwise_def orthogonal_def, rule_format])
- by auto}
- moreover
- {assume xa: "x \<in> C" and ya: "y \<in> C"
- have "orthogonal x y" using xa ya xy C(4) unfolding pairwise_def by blast}
- ultimately have "orthogonal x y" using xC yC by blast}
- then have CPO: "pairwise orthogonal ?C" unfolding pairwise_def by blast
- from fC cC SC CPO have "?P (insert a B) ?C" by blast
- then show ?case by blast
-qed
-
-lemma orthogonal_basis_exists:
- fixes V :: "(real ^'n::finite) set"
- shows "\<exists>B. independent B \<and> B \<subseteq> span V \<and> V \<subseteq> span B \<and> (B hassize dim V) \<and> pairwise orthogonal B"
-proof-
- from basis_exists[of V] obtain B where B: "B \<subseteq> V" "independent B" "V \<subseteq> span B" "B hassize dim V" by blast
- from B have fB: "finite B" "card B = dim V" by (simp_all add: hassize_def)
- from basis_orthogonal[OF fB(1)] obtain C where
- C: "finite C" "card C \<le> card B" "span C = span B" "pairwise orthogonal C" by blast
- from C B
- have CSV: "C \<subseteq> span V" by (metis span_inc span_mono subset_trans)
- from span_mono[OF B(3)] C have SVC: "span V \<subseteq> span C" by (simp add: span_span)
- from card_le_dim_spanning[OF CSV SVC C(1)] C(2,3) fB
- have iC: "independent C" by (simp add: dim_span)
- from C fB have "card C \<le> dim V" by simp
- moreover have "dim V \<le> card C" using span_card_ge_dim[OF CSV SVC C(1)]
- by (simp add: dim_span)
- ultimately have CdV: "C hassize dim V" unfolding hassize_def using C(1) by simp
- from C B CSV CdV iC show ?thesis by auto
-qed
-
-lemma span_eq: "span S = span T \<longleftrightarrow> S \<subseteq> span T \<and> T \<subseteq> span S"
- by (metis set_eq_subset span_mono span_span span_inc) (* FIXME: slow *)
-
-(* ------------------------------------------------------------------------- *)
-(* Low-dimensional subset is in a hyperplane (weak orthogonal complement). *)
-(* ------------------------------------------------------------------------- *)
-
-lemma span_not_univ_orthogonal:
- assumes sU: "span S \<noteq> UNIV"
- shows "\<exists>(a:: real ^'n::finite). a \<noteq>0 \<and> (\<forall>x \<in> span S. a \<bullet> x = 0)"
-proof-
- from sU obtain a where a: "a \<notin> span S" by blast
- from orthogonal_basis_exists obtain B where
- B: "independent B" "B \<subseteq> span S" "S \<subseteq> span B" "B hassize dim S" "pairwise orthogonal B"
- by blast
- from B have fB: "finite B" "card B = dim S" by (simp_all add: hassize_def)
- from span_mono[OF B(2)] span_mono[OF B(3)]
- have sSB: "span S = span B" by (simp add: span_span)
- let ?a = "a - setsum (\<lambda>b. (a\<bullet>b / (b\<bullet>b)) *s b) B"
- have "setsum (\<lambda>b. (a\<bullet>b / (b\<bullet>b)) *s b) B \<in> span S"
- unfolding sSB
- apply (rule span_setsum[OF fB(1)])
- apply clarsimp
- apply (rule span_mul)
- by (rule span_superset)
- with a have a0:"?a \<noteq> 0" by auto
- have "\<forall>x\<in>span B. ?a \<bullet> x = 0"
- proof(rule span_induct')
- show "subspace (\<lambda>x. ?a \<bullet> x = 0)"
- by (auto simp add: subspace_def mem_def dot_radd dot_rmult)
- next
- {fix x assume x: "x \<in> B"
- from x have B': "B = insert x (B - {x})" by blast
- have fth: "finite (B - {x})" using fB by simp
- have "?a \<bullet> x = 0"
- apply (subst B') using fB fth
- unfolding setsum_clauses(2)[OF fth]
- apply simp
- apply (clarsimp simp add: dot_lsub dot_ladd dot_lmult dot_lsum dot_eq_0)
- apply (rule setsum_0', rule ballI)
- unfolding dot_sym
- by (auto simp add: x field_simps dot_eq_0 intro: B(5)[unfolded pairwise_def orthogonal_def, rule_format])}
- then show "\<forall>x \<in> B. ?a \<bullet> x = 0" by blast
- qed
- with a0 show ?thesis unfolding sSB by (auto intro: exI[where x="?a"])
-qed
-
-lemma span_not_univ_subset_hyperplane:
- assumes SU: "span S \<noteq> (UNIV ::(real^'n::finite) set)"
- shows "\<exists> a. a \<noteq>0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
- using span_not_univ_orthogonal[OF SU] by auto
-
-lemma lowdim_subset_hyperplane:
- assumes d: "dim S < CARD('n::finite)"
- shows "\<exists>(a::real ^'n::finite). a \<noteq> 0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
-proof-
- {assume "span S = UNIV"
- hence "dim (span S) = dim (UNIV :: (real ^'n) set)" by simp
- hence "dim S = CARD('n)" by (simp add: dim_span dim_univ)
- with d have False by arith}
- hence th: "span S \<noteq> UNIV" by blast
- from span_not_univ_subset_hyperplane[OF th] show ?thesis .
-qed
-
-(* We can extend a linear basis-basis injection to the whole set. *)
-
-lemma linear_indep_image_lemma:
- assumes lf: "linear f" and fB: "finite B"
- and ifB: "independent (f ` B)"
- and fi: "inj_on f B" and xsB: "x \<in> span B"
- and fx: "f (x::'a::field^'n) = 0"
- shows "x = 0"
- using fB ifB fi xsB fx
-proof(induct arbitrary: x rule: finite_induct[OF fB])
- case 1 thus ?case by (auto simp add: span_empty)
-next
- case (2 a b x)
- have fb: "finite b" using "2.prems" by simp
- have th0: "f ` b \<subseteq> f ` (insert a b)"
- apply (rule image_mono) by blast
- from independent_mono[ OF "2.prems"(2) th0]
- have ifb: "independent (f ` b)" .
- have fib: "inj_on f b"
- apply (rule subset_inj_on [OF "2.prems"(3)])
- by blast
- from span_breakdown[of a "insert a b", simplified, OF "2.prems"(4)]
- obtain k where k: "x - k*s a \<in> span (b -{a})" by blast
- have "f (x - k*s a) \<in> span (f ` b)"
- unfolding span_linear_image[OF lf]
- apply (rule imageI)
- using k span_mono[of "b-{a}" b] by blast
- hence "f x - k*s f a \<in> span (f ` b)"
- by (simp add: linear_sub[OF lf] linear_cmul[OF lf])
- hence th: "-k *s f a \<in> span (f ` b)"
- using "2.prems"(5) by (simp add: vector_smult_lneg)
- {assume k0: "k = 0"
- from k0 k have "x \<in> span (b -{a})" by simp
- then have "x \<in> span b" using span_mono[of "b-{a}" b]
- by blast}
- moreover
- {assume k0: "k \<noteq> 0"
- from span_mul[OF th, of "- 1/ k"] k0
- have th1: "f a \<in> span (f ` b)"
- by (auto simp add: vector_smult_assoc)
- from inj_on_image_set_diff[OF "2.prems"(3), of "insert a b " "{a}", symmetric]
- have tha: "f ` insert a b - f ` {a} = f ` (insert a b - {a})" by blast
- from "2.prems"(2)[unfolded dependent_def bex_simps(10), rule_format, of "f a"]
- have "f a \<notin> span (f ` b)" using tha
- using "2.hyps"(2)
- "2.prems"(3) by auto
- with th1 have False by blast
- then have "x \<in> span b" by blast}
- ultimately have xsb: "x \<in> span b" by blast
- from "2.hyps"(3)[OF fb ifb fib xsb "2.prems"(5)]
- show "x = 0" .
-qed
-
-(* We can extend a linear mapping from basis. *)
-
-lemma linear_independent_extend_lemma:
- assumes fi: "finite B" and ib: "independent B"
- shows "\<exists>g. (\<forall>x\<in> span B. \<forall>y\<in> span B. g ((x::'a::field^'n) + y) = g x + g y)
- \<and> (\<forall>x\<in> span B. \<forall>c. g (c*s x) = c *s g x)
- \<and> (\<forall>x\<in> B. g x = f x)"
-using ib fi
-proof(induct rule: finite_induct[OF fi])
- case 1 thus ?case by (auto simp add: span_empty)
-next
- case (2 a b)
- from "2.prems" "2.hyps" have ibf: "independent b" "finite b"
- by (simp_all add: independent_insert)
- from "2.hyps"(3)[OF ibf] obtain g where
- g: "\<forall>x\<in>span b. \<forall>y\<in>span b. g (x + y) = g x + g y"
- "\<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
- let ?h = "\<lambda>z. SOME k. (z - k *s a) \<in> span b"
- {fix z assume z: "z \<in> span (insert a b)"
- have th0: "z - ?h z *s a \<in> span b"
- apply (rule someI_ex)
- unfolding span_breakdown_eq[symmetric]
- using z .
- {fix k assume k: "z - k *s a \<in> span b"
- have eq: "z - ?h z *s a - (z - k*s a) = (k - ?h z) *s a"
- by (simp add: ring_simps vector_sadd_rdistrib[symmetric])
- from span_sub[OF th0 k]
- have khz: "(k - ?h z) *s a \<in> span b" by (simp add: eq)
- {assume "k \<noteq> ?h z" hence k0: "k - ?h z \<noteq> 0" by simp
- from k0 span_mul[OF khz, of "1 /(k - ?h z)"]
- have "a \<in> span b" by (simp add: vector_smult_assoc)
- with "2.prems"(1) "2.hyps"(2) have False
- by (auto simp add: dependent_def)}
- then have "k = ?h z" by blast}
- 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}
- note h = this
- let ?g = "\<lambda>z. ?h z *s f a + g (z - ?h z *s a)"
- {fix x y assume x: "x \<in> span (insert a b)" and y: "y \<in> span (insert a b)"
- have tha: "\<And>(x::'a^'n) y a k l. (x + y) - (k + l) *s a = (x - k *s a) + (y - l *s a)"
- by (vector ring_simps)
- have addh: "?h (x + y) = ?h x + ?h y"
- apply (rule conjunct2[OF h, rule_format, symmetric])
- apply (rule span_add[OF x y])
- unfolding tha
- by (metis span_add x y conjunct1[OF h, rule_format])
- have "?g (x + y) = ?g x + ?g y"
- unfolding addh tha
- g(1)[rule_format,OF conjunct1[OF h, OF x] conjunct1[OF h, OF y]]
- by (simp add: vector_sadd_rdistrib)}
- moreover
- {fix x:: "'a^'n" and c:: 'a assume x: "x \<in> span (insert a b)"
- have tha: "\<And>(x::'a^'n) c k a. c *s x - (c * k) *s a = c *s (x - k *s a)"
- by (vector ring_simps)
- have hc: "?h (c *s x) = c * ?h x"
- apply (rule conjunct2[OF h, rule_format, symmetric])
- apply (metis span_mul x)
- by (metis tha span_mul x conjunct1[OF h])
- have "?g (c *s x) = c*s ?g x"
- unfolding hc tha g(2)[rule_format, OF conjunct1[OF h, OF x]]
- by (vector ring_simps)}
- moreover
- {fix x assume x: "x \<in> (insert a b)"
- {assume xa: "x = a"
- have ha1: "1 = ?h a"
- apply (rule conjunct2[OF h, rule_format])
- apply (metis span_superset insertI1)
- using conjunct1[OF h, OF span_superset, OF insertI1]
- by (auto simp add: span_0)
-
- from xa ha1[symmetric] have "?g x = f x"
- apply simp
- using g(2)[rule_format, OF span_0, of 0]
- by simp}
- moreover
- {assume xb: "x \<in> b"
- have h0: "0 = ?h x"
- apply (rule conjunct2[OF h, rule_format])
- apply (metis span_superset insertI1 xb x)
- apply simp
- apply (metis span_superset xb)
- done
- have "?g x = f x"
- by (simp add: h0[symmetric] g(3)[rule_format, OF xb])}
- ultimately have "?g x = f x" using x by blast }
- ultimately show ?case apply - apply (rule exI[where x="?g"]) by blast
-qed
-
-lemma linear_independent_extend:
- assumes iB: "independent (B:: (real ^'n::finite) set)"
- shows "\<exists>g. linear g \<and> (\<forall>x\<in>B. g x = f x)"
-proof-
- from maximal_independent_subset_extend[of B UNIV] iB
- obtain C where C: "B \<subseteq> C" "independent C" "\<And>x. x \<in> span C" by auto
-
- from C(2) independent_bound[of C] linear_independent_extend_lemma[of C f]
- obtain g where g: "(\<forall>x\<in> span C. \<forall>y\<in> span C. g (x + y) = g x + g y)
- \<and> (\<forall>x\<in> span C. \<forall>c. g (c*s x) = c *s g x)
- \<and> (\<forall>x\<in> C. g x = f x)" by blast
- from g show ?thesis unfolding linear_def using C
- apply clarsimp by blast
-qed
-
-(* Can construct an isomorphism between spaces of same dimension. *)
-
-lemma card_le_inj: assumes fA: "finite A" and fB: "finite B"
- and c: "card A \<le> card B" shows "(\<exists>f. f ` A \<subseteq> B \<and> inj_on f A)"
-using fB c
-proof(induct arbitrary: B rule: finite_induct[OF fA])
- case 1 thus ?case by simp
-next
- case (2 x s t)
- thus ?case
- proof(induct rule: finite_induct[OF "2.prems"(1)])
- case 1 then show ?case by simp
- next
- case (2 y t)
- from "2.prems"(1,2,5) "2.hyps"(1,2) have cst:"card s \<le> card t" by simp
- from "2.prems"(3) [OF "2.hyps"(1) cst] obtain f where
- f: "f ` s \<subseteq> t \<and> inj_on f s" by blast
- from f "2.prems"(2) "2.hyps"(2) show ?case
- apply -
- apply (rule exI[where x = "\<lambda>z. if z = x then y else f z"])
- by (auto simp add: inj_on_def)
- qed
-qed
-
-lemma card_subset_eq: assumes fB: "finite B" and AB: "A \<subseteq> B" and
- c: "card A = card B"
- shows "A = B"
-proof-
- from fB AB have fA: "finite A" by (auto intro: finite_subset)
- from fA fB have fBA: "finite (B - A)" by auto
- have e: "A \<inter> (B - A) = {}" by blast
- have eq: "A \<union> (B - A) = B" using AB by blast
- from card_Un_disjoint[OF fA fBA e, unfolded eq c]
- have "card (B - A) = 0" by arith
- hence "B - A = {}" unfolding card_eq_0_iff using fA fB by simp
- with AB show "A = B" by blast
-qed
-
-lemma subspace_isomorphism:
- assumes s: "subspace (S:: (real ^'n::finite) set)"
- and t: "subspace (T :: (real ^ 'm::finite) set)"
- and d: "dim S = dim T"
- shows "\<exists>f. linear f \<and> f ` S = T \<and> inj_on f S"
-proof-
- from basis_exists[of S] obtain B where
- B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "B hassize dim S" by blast
- from basis_exists[of T] obtain C where
- C: "C \<subseteq> T" "independent C" "T \<subseteq> span C" "C hassize dim T" by blast
- from B(4) C(4) card_le_inj[of B C] d obtain f where
- f: "f ` B \<subseteq> C" "inj_on f B" unfolding hassize_def by auto
- from linear_independent_extend[OF B(2)] obtain g where
- g: "linear g" "\<forall>x\<in> B. g x = f x" by blast
- from B(4) have fB: "finite B" by (simp add: hassize_def)
- from C(4) have fC: "finite C" by (simp add: hassize_def)
- from inj_on_iff_eq_card[OF fB, of f] f(2)
- have "card (f ` B) = card B" by simp
- with B(4) C(4) have ceq: "card (f ` B) = card C" using d
- by (simp add: hassize_def)
- have "g ` B = f ` B" using g(2)
- by (auto simp add: image_iff)
- also have "\<dots> = C" using card_subset_eq[OF fC f(1) ceq] .
- finally have gBC: "g ` B = C" .
- have gi: "inj_on g B" using f(2) g(2)
- by (auto simp add: inj_on_def)
- note g0 = linear_indep_image_lemma[OF g(1) fB, unfolded gBC, OF C(2) gi]
- {fix x y assume x: "x \<in> S" and y: "y \<in> S" and gxy:"g x = g y"
- from B(3) x y have x': "x \<in> span B" and y': "y \<in> span B" by blast+
- from gxy have th0: "g (x - y) = 0" by (simp add: linear_sub[OF g(1)])
- have th1: "x - y \<in> span B" using x' y' by (metis span_sub)
- have "x=y" using g0[OF th1 th0] by simp }
- then have giS: "inj_on g S"
- unfolding inj_on_def by blast
- from span_subspace[OF B(1,3) s]
- have "g ` S = span (g ` B)" by (simp add: span_linear_image[OF g(1)])
- also have "\<dots> = span C" unfolding gBC ..
- also have "\<dots> = T" using span_subspace[OF C(1,3) t] .
- finally have gS: "g ` S = T" .
- from g(1) gS giS show ?thesis by blast
-qed
-
-(* linear functions are equal on a subspace if they are on a spanning set. *)
-
-lemma subspace_kernel:
- assumes lf: "linear (f::'a::semiring_1 ^'n \<Rightarrow> _)"
- shows "subspace {x. f x = 0}"
-apply (simp add: subspace_def)
-by (simp add: linear_add[OF lf] linear_cmul[OF lf] linear_0[OF lf])
-
-lemma linear_eq_0_span:
- assumes lf: "linear f" and f0: "\<forall>x\<in>B. f x = 0"
- shows "\<forall>x \<in> span B. f x = (0::'a::semiring_1 ^'n)"
-proof
- fix x assume x: "x \<in> span B"
- let ?P = "\<lambda>x. f x = 0"
- from subspace_kernel[OF lf] have "subspace ?P" unfolding Collect_def .
- with x f0 span_induct[of B "?P" x] show "f x = 0" by blast
-qed
-
-lemma linear_eq_0:
- assumes lf: "linear f" and SB: "S \<subseteq> span B" and f0: "\<forall>x\<in>B. f x = 0"
- shows "\<forall>x \<in> S. f x = (0::'a::semiring_1^'n)"
- by (metis linear_eq_0_span[OF lf] subset_eq SB f0)
-
-lemma linear_eq:
- assumes lf: "linear (f::'a::ring_1^'n \<Rightarrow> _)" and lg: "linear g" and S: "S \<subseteq> span B"
- and fg: "\<forall> x\<in> B. f x = g x"
- shows "\<forall>x\<in> S. f x = g x"
-proof-
- let ?h = "\<lambda>x. f x - g x"
- from fg have fg': "\<forall>x\<in> B. ?h x = 0" by simp
- from linear_eq_0[OF linear_compose_sub[OF lf lg] S fg']
- show ?thesis by simp
-qed
-
-lemma linear_eq_stdbasis:
- assumes lf: "linear (f::'a::ring_1^'m::finite \<Rightarrow> 'a^'n::finite)" and lg: "linear g"
- and fg: "\<forall>i. f (basis i) = g(basis i)"
- shows "f = g"
-proof-
- let ?U = "UNIV :: 'm set"
- let ?I = "{basis i:: 'a^'m|i. i \<in> ?U}"
- {fix x assume x: "x \<in> (UNIV :: ('a^'m) set)"
- from equalityD2[OF span_stdbasis]
- have IU: " (UNIV :: ('a^'m) set) \<subseteq> span ?I" by blast
- from linear_eq[OF lf lg IU] fg x
- have "f x = g x" unfolding Collect_def Ball_def mem_def by metis}
- then show ?thesis by (auto intro: ext)
-qed
-
-(* Similar results for bilinear functions. *)
-
-lemma bilinear_eq:
- assumes bf: "bilinear (f:: 'a::ring^'m \<Rightarrow> 'a^'n \<Rightarrow> 'a^'p)"
- and bg: "bilinear g"
- and SB: "S \<subseteq> span B" and TC: "T \<subseteq> span C"
- and fg: "\<forall>x\<in> B. \<forall>y\<in> C. f x y = g x y"
- shows "\<forall>x\<in>S. \<forall>y\<in>T. f x y = g x y "
-proof-
- let ?P = "\<lambda>x. \<forall>y\<in> span C. f x y = g x y"
- from bf bg have sp: "subspace ?P"
- unfolding bilinear_def linear_def subspace_def bf bg
- 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])
-
- have "\<forall>x \<in> span B. \<forall>y\<in> span C. f x y = g x y"
- apply -
- apply (rule ballI)
- apply (rule span_induct[of B ?P])
- defer
- apply (rule sp)
- apply assumption
- apply (clarsimp simp add: Ball_def)
- apply (rule_tac P="\<lambda>y. f xa y = g xa y" and S=C in span_induct)
- using fg
- apply (auto simp add: subspace_def)
- using bf bg unfolding bilinear_def linear_def
- 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])
- then show ?thesis using SB TC by (auto intro: ext)
-qed
-
-lemma bilinear_eq_stdbasis:
- assumes bf: "bilinear (f:: 'a::ring_1^'m::finite \<Rightarrow> 'a^'n::finite \<Rightarrow> 'a^'p)"
- and bg: "bilinear g"
- and fg: "\<forall>i j. f (basis i) (basis j) = g (basis i) (basis j)"
- shows "f = g"
-proof-
- 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
- from bilinear_eq[OF bf bg equalityD2[OF span_stdbasis] equalityD2[OF span_stdbasis] th] show ?thesis by (blast intro: ext)
-qed
-
-(* Detailed theorems about left and right invertibility in general case. *)
-
-lemma left_invertible_transp:
- "(\<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)"
- by (metis matrix_transp_mul transp_mat transp_transp)
-
-lemma right_invertible_transp:
- "(\<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)"
- by (metis matrix_transp_mul transp_mat transp_transp)
-
-lemma linear_injective_left_inverse:
- assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)" and fi: "inj f"
- shows "\<exists>g. linear g \<and> g o f = id"
-proof-
- from linear_independent_extend[OF independent_injective_image, OF independent_stdbasis, OF lf fi]
- 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
- from h(2)
- have th: "\<forall>i. (h \<circ> f) (basis i) = id (basis i)"
- using inv_o_cancel[OF fi, unfolded stupid_ext[symmetric] id_def o_def]
- by auto
-
- from linear_eq_stdbasis[OF linear_compose[OF lf h(1)] linear_id th]
- have "h o f = id" .
- then show ?thesis using h(1) by blast
-qed
-
-lemma linear_surjective_right_inverse:
- assumes lf: "linear (f:: real ^'m::finite \<Rightarrow> real ^'n::finite)" and sf: "surj f"
- shows "\<exists>g. linear g \<and> f o g = id"
-proof-
- from linear_independent_extend[OF independent_stdbasis]
- obtain h:: "real ^'n \<Rightarrow> real ^'m" where
- h: "linear h" "\<forall> x\<in> {basis i| i. i\<in> (UNIV :: 'n set)}. h x = inv f x" by blast
- from h(2)
- have th: "\<forall>i. (f o h) (basis i) = id (basis i)"
- using sf
- apply (auto simp add: surj_iff o_def stupid_ext[symmetric])
- apply (erule_tac x="basis i" in allE)
- by auto
-
- from linear_eq_stdbasis[OF linear_compose[OF h(1) lf] linear_id th]
- have "f o h = id" .
- then show ?thesis using h(1) by blast
-qed
-
-lemma matrix_left_invertible_injective:
-"(\<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)"
-proof-
- {fix B:: "real^'m^'n" and x y assume B: "B ** A = mat 1" and xy: "A *v x = A*v y"
- from xy have "B*v (A *v x) = B *v (A*v y)" by simp
- hence "x = y"
- unfolding matrix_vector_mul_assoc B matrix_vector_mul_lid .}
- moreover
- {assume A: "\<forall>x y. A *v x = A *v y \<longrightarrow> x = y"
- hence i: "inj (op *v A)" unfolding inj_on_def by auto
- from linear_injective_left_inverse[OF matrix_vector_mul_linear i]
- obtain g where g: "linear g" "g o op *v A = id" by blast
- have "matrix g ** A = mat 1"
- unfolding matrix_eq matrix_vector_mul_lid matrix_vector_mul_assoc[symmetric] matrix_works[OF g(1)]
- using g(2) by (simp add: o_def id_def stupid_ext)
- then have "\<exists>B. (B::real ^'m^'n) ** A = mat 1" by blast}
- ultimately show ?thesis by blast
-qed
-
-lemma matrix_left_invertible_ker:
- "(\<exists>B. (B::real ^'m::finite^'n::finite) ** (A::real^'n^'m) = mat 1) \<longleftrightarrow> (\<forall>x. A *v x = 0 \<longrightarrow> x = 0)"
- unfolding matrix_left_invertible_injective
- using linear_injective_0[OF matrix_vector_mul_linear, of A]
- by (simp add: inj_on_def)
-
-lemma matrix_right_invertible_surjective:
-"(\<exists>B. (A::real^'n::finite^'m::finite) ** (B::real^'m^'n) = mat 1) \<longleftrightarrow> surj (\<lambda>x. A *v x)"
-proof-
- {fix B :: "real ^'m^'n" assume AB: "A ** B = mat 1"
- {fix x :: "real ^ 'm"
- have "A *v (B *v x) = x"
- by (simp add: matrix_vector_mul_lid matrix_vector_mul_assoc AB)}
- hence "surj (op *v A)" unfolding surj_def by metis }
- moreover
- {assume sf: "surj (op *v A)"
- from linear_surjective_right_inverse[OF matrix_vector_mul_linear sf]
- obtain g:: "real ^'m \<Rightarrow> real ^'n" where g: "linear g" "op *v A o g = id"
- by blast
-
- have "A ** (matrix g) = mat 1"
- unfolding matrix_eq matrix_vector_mul_lid
- matrix_vector_mul_assoc[symmetric] matrix_works[OF g(1)]
- using g(2) unfolding o_def stupid_ext[symmetric] id_def
- .
- hence "\<exists>B. A ** (B::real^'m^'n) = mat 1" by blast
- }
- ultimately show ?thesis unfolding surj_def by blast
-qed
-
-lemma matrix_left_invertible_independent_columns:
- fixes A :: "real^'n::finite^'m::finite"
- 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))"
- (is "?lhs \<longleftrightarrow> ?rhs")
-proof-
- let ?U = "UNIV :: 'n set"
- {assume k: "\<forall>x. A *v x = 0 \<longrightarrow> x = 0"
- {fix c i assume c: "setsum (\<lambda>i. c i *s column i A) ?U = 0"
- and i: "i \<in> ?U"
- let ?x = "\<chi> i. c i"
- have th0:"A *v ?x = 0"
- using c
- unfolding matrix_mult_vsum Cart_eq
- by auto
- from k[rule_format, OF th0] i
- have "c i = 0" by (vector Cart_eq)}
- hence ?rhs by blast}
- moreover
- {assume H: ?rhs
- {fix x assume x: "A *v x = 0"
- let ?c = "\<lambda>i. ((x$i ):: real)"
- from H[rule_format, of ?c, unfolded matrix_mult_vsum[symmetric], OF x]
- have "x = 0" by vector}}
- ultimately show ?thesis unfolding matrix_left_invertible_ker by blast
-qed
-
-lemma matrix_right_invertible_independent_rows:
- fixes A :: "real^'n::finite^'m::finite"
- 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))"
- unfolding left_invertible_transp[symmetric]
- matrix_left_invertible_independent_columns
- by (simp add: column_transp)
-
-lemma matrix_right_invertible_span_columns:
- "(\<exists>(B::real ^'n::finite^'m::finite). (A::real ^'m^'n) ** B = mat 1) \<longleftrightarrow> span (columns A) = UNIV" (is "?lhs = ?rhs")
-proof-
- let ?U = "UNIV :: 'm set"
- have fU: "finite ?U" by simp
- have lhseq: "?lhs \<longleftrightarrow> (\<forall>y. \<exists>(x::real^'m). setsum (\<lambda>i. (x$i) *s column i A) ?U = y)"
- unfolding matrix_right_invertible_surjective matrix_mult_vsum surj_def
- apply (subst eq_commute) ..
- have rhseq: "?rhs \<longleftrightarrow> (\<forall>x. x \<in> span (columns A))" by blast
- {assume h: ?lhs
- {fix x:: "real ^'n"
- from h[unfolded lhseq, rule_format, of x] obtain y:: "real ^'m"
- where y: "setsum (\<lambda>i. (y$i) *s column i A) ?U = x" by blast
- have "x \<in> span (columns A)"
- unfolding y[symmetric]
- apply (rule span_setsum[OF fU])
- apply clarify
- apply (rule span_mul)
- apply (rule span_superset)
- unfolding columns_def
- by blast}
- then have ?rhs unfolding rhseq by blast}
- moreover
- {assume h:?rhs
- let ?P = "\<lambda>(y::real ^'n). \<exists>(x::real^'m). setsum (\<lambda>i. (x$i) *s column i A) ?U = y"
- {fix y have "?P y"
- proof(rule span_induct_alt[of ?P "columns A"])
- show "\<exists>x\<Colon>real ^ 'm. setsum (\<lambda>i. (x$i) *s column i A) ?U = 0"
- apply (rule exI[where x=0])
- by (simp add: zero_index vector_smult_lzero)
- next
- fix c y1 y2 assume y1: "y1 \<in> columns A" and y2: "?P y2"
- from y1 obtain i where i: "i \<in> ?U" "y1 = column i A"
- unfolding columns_def by blast
- from y2 obtain x:: "real ^'m" where
- x: "setsum (\<lambda>i. (x$i) *s column i A) ?U = y2" by blast
- let ?x = "(\<chi> j. if j = i then c + (x$i) else (x$j))::real^'m"
- show "?P (c*s y1 + y2)"
- 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)
- fix j
- have th: "\<forall>xa \<in> ?U. (if xa = i then (c + (x$i)) * ((column xa A)$j)
- 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)
- by (simp add: ring_simps)
- have "setsum (\<lambda>xa. if xa = i then (c + (x$i)) * ((column xa A)$j)
- 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"
- apply (rule setsum_cong[OF refl])
- using th by blast
- 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"
- by (simp add: setsum_addf)
- also have "\<dots> = c * ((column i A)$j) + setsum (\<lambda>xa. ((x$xa) * ((column xa A)$j))) ?U"
- unfolding setsum_delta[OF fU]
- using i(1) by simp
- finally show "setsum (\<lambda>xa. if xa = i then (c + (x$i)) * ((column xa A)$j)
- else (x$xa) * ((column xa A$j))) ?U = c * ((column i A)$j) + setsum (\<lambda>xa. ((x$xa) * ((column xa A)$j))) ?U" .
- qed
- next
- show "y \<in> span (columns A)" unfolding h by blast
- qed}
- then have ?lhs unfolding lhseq ..}
- ultimately show ?thesis by blast
-qed
-
-lemma matrix_left_invertible_span_rows:
- "(\<exists>(B::real^'m::finite^'n::finite). B ** (A::real^'n^'m) = mat 1) \<longleftrightarrow> span (rows A) = UNIV"
- unfolding right_invertible_transp[symmetric]
- unfolding columns_transp[symmetric]
- unfolding matrix_right_invertible_span_columns
- ..
-
-(* An injective map real^'n->real^'n is also surjective. *)
-
-lemma linear_injective_imp_surjective:
- assumes lf: "linear (f:: real ^'n::finite \<Rightarrow> real ^'n)" and fi: "inj f"
- shows "surj f"
-proof-
- let ?U = "UNIV :: (real ^'n) set"
- from basis_exists[of ?U] obtain B
- where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" "B hassize dim ?U"
- by blast
- from B(4) have d: "dim ?U = card B" by (simp add: hassize_def)
- have th: "?U \<subseteq> span (f ` B)"
- apply (rule card_ge_dim_independent)
- apply blast
- apply (rule independent_injective_image[OF B(2) lf fi])
- apply (rule order_eq_refl)
- apply (rule sym)
- unfolding d
- apply (rule card_image)
- apply (rule subset_inj_on[OF fi])
- by blast
- from th show ?thesis
- unfolding span_linear_image[OF lf] surj_def
- using B(3) by blast
-qed
-
-(* And vice versa. *)
-
-lemma surjective_iff_injective_gen:
- assumes fS: "finite S" and fT: "finite T" and c: "card S = card T"
- and ST: "f ` S \<subseteq> T"
- shows "(\<forall>y \<in> T. \<exists>x \<in> S. f x = y) \<longleftrightarrow> inj_on f S" (is "?lhs \<longleftrightarrow> ?rhs")
-proof-
- {assume h: "?lhs"
- {fix x y assume x: "x \<in> S" and y: "y \<in> S" and f: "f x = f y"
- from x fS have S0: "card S \<noteq> 0" by auto
- {assume xy: "x \<noteq> y"
- have th: "card S \<le> card (f ` (S - {y}))"
- unfolding c
- apply (rule card_mono)
- apply (rule finite_imageI)
- using fS apply simp
- using h xy x y f unfolding subset_eq image_iff
- apply auto
- apply (case_tac "xa = f x")
- apply (rule bexI[where x=x])
- apply auto
- done
- also have " \<dots> \<le> card (S -{y})"
- apply (rule card_image_le)
- using fS by simp
- also have "\<dots> \<le> card S - 1" using y fS by simp
- finally have False using S0 by arith }
- then have "x = y" by blast}
- then have ?rhs unfolding inj_on_def by blast}
- moreover
- {assume h: ?rhs
- have "f ` S = T"
- apply (rule card_subset_eq[OF fT ST])
- unfolding card_image[OF h] using c .
- then have ?lhs by blast}
- ultimately show ?thesis by blast
-qed
-
-lemma linear_surjective_imp_injective:
- assumes lf: "linear (f::real ^'n::finite => real ^'n)" and sf: "surj f"
- shows "inj f"
-proof-
- let ?U = "UNIV :: (real ^'n) set"
- from basis_exists[of ?U] obtain B
- where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" "B hassize dim ?U"
- by blast
- {fix x assume x: "x \<in> span B" and fx: "f x = 0"
- from B(4) have fB: "finite B" by (simp add: hassize_def)
- from B(4) have d: "dim ?U = card B" by (simp add: hassize_def)
- have fBi: "independent (f ` B)"
- apply (rule card_le_dim_spanning[of "f ` B" ?U])
- apply blast
- using sf B(3)
- unfolding span_linear_image[OF lf] surj_def subset_eq image_iff
- apply blast
- using fB apply (blast intro: finite_imageI)
- unfolding d
- apply (rule card_image_le)
- apply (rule fB)
- done
- have th0: "dim ?U \<le> card (f ` B)"
- apply (rule span_card_ge_dim)
- apply blast
- unfolding span_linear_image[OF lf]
- apply (rule subset_trans[where B = "f ` UNIV"])
- using sf unfolding surj_def apply blast
- apply (rule image_mono)
- apply (rule B(3))
- apply (metis finite_imageI fB)
- done
-
- moreover have "card (f ` B) \<le> card B"
- by (rule card_image_le, rule fB)
- ultimately have th1: "card B = card (f ` B)" unfolding d by arith
- have fiB: "inj_on f B"
- unfolding surjective_iff_injective_gen[OF fB finite_imageI[OF fB] th1 subset_refl, symmetric] by blast
- from linear_indep_image_lemma[OF lf fB fBi fiB x] fx
- have "x = 0" by blast}
- note th = this
- from th show ?thesis unfolding linear_injective_0[OF lf]
- using B(3) by blast
-qed
-
-(* Hence either is enough for isomorphism. *)
-
-lemma left_right_inverse_eq:
- assumes fg: "f o g = id" and gh: "g o h = id"
- shows "f = h"
-proof-
- have "f = f o (g o h)" unfolding gh by simp
- also have "\<dots> = (f o g) o h" by (simp add: o_assoc)
- finally show "f = h" unfolding fg by simp
-qed
-
-lemma isomorphism_expand:
- "f o g = id \<and> g o f = id \<longleftrightarrow> (\<forall>x. f(g x) = x) \<and> (\<forall>x. g(f x) = x)"
- by (simp add: expand_fun_eq o_def id_def)
-
-lemma linear_injective_isomorphism:
- assumes lf: "linear (f :: real^'n::finite \<Rightarrow> real ^'n)" and fi: "inj f"
- shows "\<exists>f'. linear f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)"
-unfolding isomorphism_expand[symmetric]
-using linear_surjective_right_inverse[OF lf linear_injective_imp_surjective[OF lf fi]] linear_injective_left_inverse[OF lf fi]
-by (metis left_right_inverse_eq)
-
-lemma linear_surjective_isomorphism:
- assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'n)" and sf: "surj f"
- shows "\<exists>f'. linear f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)"
-unfolding isomorphism_expand[symmetric]
-using linear_surjective_right_inverse[OF lf sf] linear_injective_left_inverse[OF lf linear_surjective_imp_injective[OF lf sf]]
-by (metis left_right_inverse_eq)
-
-(* Left and right inverses are the same for R^N->R^N. *)
-
-lemma linear_inverse_left:
- assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'n)" and lf': "linear f'"
- shows "f o f' = id \<longleftrightarrow> f' o f = id"
-proof-
- {fix f f':: "real ^'n \<Rightarrow> real ^'n"
- assume lf: "linear f" "linear f'" and f: "f o f' = id"
- from f have sf: "surj f"
-
- apply (auto simp add: o_def stupid_ext[symmetric] id_def surj_def)
- by metis
- from linear_surjective_isomorphism[OF lf(1) sf] lf f
- have "f' o f = id" unfolding stupid_ext[symmetric] o_def id_def
- by metis}
- then show ?thesis using lf lf' by metis
-qed
-
-(* Moreover, a one-sided inverse is automatically linear. *)
-
-lemma left_inverse_linear:
- assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'n)" and gf: "g o f = id"
- shows "linear g"
-proof-
- from gf have fi: "inj f" apply (auto simp add: inj_on_def o_def id_def stupid_ext[symmetric])
- by metis
- from linear_injective_isomorphism[OF lf fi]
- obtain h:: "real ^'n \<Rightarrow> real ^'n" where
- h: "linear h" "\<forall>x. h (f x) = x" "\<forall>x. f (h x) = x" by blast
- have "h = g" apply (rule ext) using gf h(2,3)
- apply (simp add: o_def id_def stupid_ext[symmetric])
- by metis
- with h(1) show ?thesis by blast
-qed
-
-lemma right_inverse_linear:
- assumes lf: "linear (f:: real ^'n::finite \<Rightarrow> real ^'n)" and gf: "f o g = id"
- shows "linear g"
-proof-
- from gf have fi: "surj f" apply (auto simp add: surj_def o_def id_def stupid_ext[symmetric])
- by metis
- from linear_surjective_isomorphism[OF lf fi]
- obtain h:: "real ^'n \<Rightarrow> real ^'n" where
- h: "linear h" "\<forall>x. h (f x) = x" "\<forall>x. f (h x) = x" by blast
- have "h = g" apply (rule ext) using gf h(2,3)
- apply (simp add: o_def id_def stupid_ext[symmetric])
- by metis
- with h(1) show ?thesis by blast
-qed
-
-(* The same result in terms of square matrices. *)
-
-lemma matrix_left_right_inverse:
- fixes A A' :: "real ^'n::finite^'n"
- shows "A ** A' = mat 1 \<longleftrightarrow> A' ** A = mat 1"
-proof-
- {fix A A' :: "real ^'n^'n" assume AA': "A ** A' = mat 1"
- have sA: "surj (op *v A)"
- unfolding surj_def
- apply clarify
- apply (rule_tac x="(A' *v y)" in exI)
- by (simp add: matrix_vector_mul_assoc AA' matrix_vector_mul_lid)
- from linear_surjective_isomorphism[OF matrix_vector_mul_linear sA]
- obtain f' :: "real ^'n \<Rightarrow> real ^'n"
- where f': "linear f'" "\<forall>x. f' (A *v x) = x" "\<forall>x. A *v f' x = x" by blast
- have th: "matrix f' ** A = mat 1"
- by (simp add: matrix_eq matrix_works[OF f'(1)] matrix_vector_mul_assoc[symmetric] matrix_vector_mul_lid f'(2)[rule_format])
- hence "(matrix f' ** A) ** A' = mat 1 ** A'" by simp
- hence "matrix f' = A'" by (simp add: matrix_mul_assoc[symmetric] AA' matrix_mul_rid matrix_mul_lid)
- hence "matrix f' ** A = A' ** A" by simp
- hence "A' ** A = mat 1" by (simp add: th)}
- then show ?thesis by blast
-qed
-
-(* Considering an n-element vector as an n-by-1 or 1-by-n matrix. *)
-
-definition "rowvector v = (\<chi> i j. (v$j))"
-
-definition "columnvector v = (\<chi> i j. (v$i))"
-
-lemma transp_columnvector:
- "transp(columnvector v) = rowvector v"
- by (simp add: transp_def rowvector_def columnvector_def Cart_eq)
-
-lemma transp_rowvector: "transp(rowvector v) = columnvector v"
- by (simp add: transp_def columnvector_def rowvector_def Cart_eq)
-
-lemma dot_rowvector_columnvector:
- "columnvector (A *v v) = A ** columnvector v"
- by (vector columnvector_def matrix_matrix_mult_def matrix_vector_mult_def)
-
-lemma dot_matrix_product: "(x::'a::semiring_1^'n::finite) \<bullet> y = (((rowvector x ::'a^'n^1) ** (columnvector y :: 'a^1^'n))$1)$1"
- by (vector matrix_matrix_mult_def rowvector_def columnvector_def dot_def)
-
-lemma dot_matrix_vector_mul:
- fixes A B :: "real ^'n::finite ^'n" and x y :: "real ^'n"
- shows "(A *v x) \<bullet> (B *v y) =
- (((rowvector x :: real^'n^1) ** ((transp A ** B) ** (columnvector y :: real ^1^'n)))$1)$1"
-unfolding dot_matrix_product transp_columnvector[symmetric]
- dot_rowvector_columnvector matrix_transp_mul matrix_mul_assoc ..
-
-(* Infinity norm. *)
-
-definition "infnorm (x::real^'n::finite) = rsup {abs(x$i) |i. i\<in> (UNIV :: 'n set)}"
-
-lemma numseg_dimindex_nonempty: "\<exists>i. i \<in> (UNIV :: 'n set)"
- by auto
-
-lemma infnorm_set_image:
- "{abs(x$i) |i. i\<in> (UNIV :: 'n set)} =
- (\<lambda>i. abs(x$i)) ` (UNIV :: 'n set)" by blast
-
-lemma infnorm_set_lemma:
- shows "finite {abs((x::'a::abs ^'n::finite)$i) |i. i\<in> (UNIV :: 'n set)}"
- and "{abs(x$i) |i. i\<in> (UNIV :: 'n::finite set)} \<noteq> {}"
- unfolding infnorm_set_image
- by (auto intro: finite_imageI)
-
-lemma infnorm_pos_le: "0 \<le> infnorm (x::real^'n::finite)"
- unfolding infnorm_def
- unfolding rsup_finite_ge_iff[ OF infnorm_set_lemma]
- unfolding infnorm_set_image
- by auto
-
-lemma infnorm_triangle: "infnorm ((x::real^'n::finite) + y) \<le> infnorm x + infnorm y"
-proof-
- have th: "\<And>x y (z::real). x - y <= z \<longleftrightarrow> x - z <= y" by arith
- have th1: "\<And>S f. f ` S = { f i| i. i \<in> S}" by blast
- have th2: "\<And>x (y::real). abs(x + y) - abs(x) <= abs(y)" by arith
- show ?thesis
- unfolding infnorm_def
- unfolding rsup_finite_le_iff[ OF infnorm_set_lemma]
- apply (subst diff_le_eq[symmetric])
- unfolding rsup_finite_ge_iff[ OF infnorm_set_lemma]
- unfolding infnorm_set_image bex_simps
- apply (subst th)
- unfolding th1
- unfolding rsup_finite_ge_iff[ OF infnorm_set_lemma]
-
- unfolding infnorm_set_image ball_simps bex_simps
- apply simp
- apply (metis th2)
- done
-qed
-
-lemma infnorm_eq_0: "infnorm x = 0 \<longleftrightarrow> (x::real ^'n::finite) = 0"
-proof-
- have "infnorm x <= 0 \<longleftrightarrow> x = 0"
- unfolding infnorm_def
- unfolding rsup_finite_le_iff[OF infnorm_set_lemma]
- unfolding infnorm_set_image ball_simps
- by vector
- then show ?thesis using infnorm_pos_le[of x] by simp
-qed
-
-lemma infnorm_0: "infnorm 0 = 0"
- by (simp add: infnorm_eq_0)
-
-lemma infnorm_neg: "infnorm (- x) = infnorm x"
- unfolding infnorm_def
- apply (rule cong[of "rsup" "rsup"])
- apply blast
- apply (rule set_ext)
- apply auto
- done
-
-lemma infnorm_sub: "infnorm (x - y) = infnorm (y - x)"
-proof-
- have "y - x = - (x - y)" by simp
- then show ?thesis by (metis infnorm_neg)
-qed
-
-lemma real_abs_sub_infnorm: "\<bar> infnorm x - infnorm y\<bar> \<le> infnorm (x - y)"
-proof-
- have th: "\<And>(nx::real) n ny. nx <= n + ny \<Longrightarrow> ny <= n + nx ==> \<bar>nx - ny\<bar> <= n"
- by arith
- from infnorm_triangle[of "x - y" " y"] infnorm_triangle[of "x - y" "-x"]
- have ths: "infnorm x \<le> infnorm (x - y) + infnorm y"
- "infnorm y \<le> infnorm (x - y) + infnorm x"
- by (simp_all add: ring_simps infnorm_neg diff_def[symmetric])
- from th[OF ths] show ?thesis .
-qed
-
-lemma real_abs_infnorm: " \<bar>infnorm x\<bar> = infnorm x"
- using infnorm_pos_le[of x] by arith
-
-lemma component_le_infnorm:
- shows "\<bar>x$i\<bar> \<le> infnorm (x::real^'n::finite)"
-proof-
- let ?U = "UNIV :: 'n set"
- let ?S = "{\<bar>x$i\<bar> |i. i\<in> ?U}"
- have fS: "finite ?S" unfolding image_Collect[symmetric]
- apply (rule finite_imageI) unfolding Collect_def mem_def by simp
- have S0: "?S \<noteq> {}" by blast
- have th1: "\<And>S f. f ` S = { f i| i. i \<in> S}" by blast
- from rsup_finite_in[OF fS S0] rsup_finite_Ub[OF fS S0]
- show ?thesis unfolding infnorm_def isUb_def setle_def
- unfolding infnorm_set_image ball_simps by auto
-qed
-
-lemma infnorm_mul_lemma: "infnorm(a *s x) <= \<bar>a\<bar> * infnorm x"
- apply (subst infnorm_def)
- unfolding rsup_finite_le_iff[OF infnorm_set_lemma]
- unfolding infnorm_set_image ball_simps
- apply (simp add: abs_mult)
- apply (rule allI)
- apply (cut_tac component_le_infnorm[of x])
- apply (rule mult_mono)
- apply auto
- done
-
-lemma infnorm_mul: "infnorm(a *s x) = abs a * infnorm x"
-proof-
- {assume a0: "a = 0" hence ?thesis by (simp add: infnorm_0) }
- moreover
- {assume a0: "a \<noteq> 0"
- from a0 have th: "(1/a) *s (a *s x) = x"
- by (simp add: vector_smult_assoc)
- from a0 have ap: "\<bar>a\<bar> > 0" by arith
- from infnorm_mul_lemma[of "1/a" "a *s x"]
- have "infnorm x \<le> 1/\<bar>a\<bar> * infnorm (a*s x)"
- unfolding th by simp
- 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)
- then have "\<bar>a\<bar> * infnorm x \<le> infnorm (a*s x)"
- using ap by (simp add: field_simps)
- with infnorm_mul_lemma[of a x] have ?thesis by arith }
- ultimately show ?thesis by blast
-qed
-
-lemma infnorm_pos_lt: "infnorm x > 0 \<longleftrightarrow> x \<noteq> 0"
- using infnorm_pos_le[of x] infnorm_eq_0[of x] by arith
-
-(* Prove that it differs only up to a bound from Euclidean norm. *)
-
-lemma infnorm_le_norm: "infnorm x \<le> norm x"
- unfolding infnorm_def rsup_finite_le_iff[OF infnorm_set_lemma]
- unfolding infnorm_set_image ball_simps
- by (metis component_le_norm)
-lemma card_enum: "card {1 .. n} = n" by auto
-lemma norm_le_infnorm: "norm(x) <= sqrt(real CARD('n)) * infnorm(x::real ^'n::finite)"
-proof-
- let ?d = "CARD('n)"
- have "real ?d \<ge> 0" by simp
- hence d2: "(sqrt (real ?d))^2 = real ?d"
- by (auto intro: real_sqrt_pow2)
- have th: "sqrt (real ?d) * infnorm x \<ge> 0"
- by (simp add: zero_le_mult_iff real_sqrt_ge_0_iff infnorm_pos_le)
- have th1: "x\<bullet>x \<le> (sqrt (real ?d) * infnorm x)^2"
- unfolding power_mult_distrib d2
- apply (subst power2_abs[symmetric])
- unfolding real_of_nat_def dot_def power2_eq_square[symmetric]
- apply (subst power2_abs[symmetric])
- apply (rule setsum_bounded)
- apply (rule power_mono)
- unfolding abs_of_nonneg[OF infnorm_pos_le]
- unfolding infnorm_def rsup_finite_ge_iff[OF infnorm_set_lemma]
- unfolding infnorm_set_image bex_simps
- apply blast
- by (rule abs_ge_zero)
- from real_le_lsqrt[OF dot_pos_le th th1]
- show ?thesis unfolding real_vector_norm_def id_def .
-qed
-
-(* Equality in Cauchy-Schwarz and triangle inequalities. *)
-
-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")
-proof-
- {assume h: "x = 0"
- hence ?thesis by simp}
- moreover
- {assume h: "y = 0"
- hence ?thesis by simp}
- moreover
- {assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
- from dot_eq_0[of "norm y *s x - norm x *s y"]
- 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)"
- using x y
- unfolding dot_rsub dot_lsub dot_lmult dot_rmult
- unfolding norm_pow_2[symmetric] power2_eq_square diff_eq_0_iff_eq apply (simp add: dot_sym)
- apply (simp add: ring_simps)
- apply metis
- done
- also have "\<dots> \<longleftrightarrow> (2 * norm x * norm y * (norm x * norm y - x \<bullet> y) = 0)" using x y
- by (simp add: ring_simps dot_sym)
- also have "\<dots> \<longleftrightarrow> ?lhs" using x y
- apply simp
- by metis
- finally have ?thesis by blast}
- ultimately show ?thesis by blast
-qed
-
-lemma norm_cauchy_schwarz_abs_eq:
- fixes x y :: "real ^ 'n::finite"
- shows "abs(x \<bullet> y) = norm x * norm y \<longleftrightarrow>
- norm x *s y = norm y *s x \<or> norm(x) *s y = - norm y *s x" (is "?lhs \<longleftrightarrow> ?rhs")
-proof-
- have th: "\<And>(x::real) a. a \<ge> 0 \<Longrightarrow> abs x = a \<longleftrightarrow> x = a \<or> x = - a" by arith
- have "?rhs \<longleftrightarrow> norm x *s y = norm y *s x \<or> norm (- x) *s y = norm y *s (- x)"
- apply simp by vector
- also have "\<dots> \<longleftrightarrow>(x \<bullet> y = norm x * norm y \<or>
- (-x) \<bullet> y = norm x * norm y)"
- unfolding norm_cauchy_schwarz_eq[symmetric]
- unfolding norm_minus_cancel
- norm_mul by blast
- also have "\<dots> \<longleftrightarrow> ?lhs"
- unfolding th[OF mult_nonneg_nonneg, OF norm_ge_zero[of x] norm_ge_zero[of y]] dot_lneg
- by arith
- finally show ?thesis ..
-qed
-
-lemma norm_triangle_eq:
- fixes x y :: "real ^ 'n::finite"
- shows "norm(x + y) = norm x + norm y \<longleftrightarrow> norm x *s y = norm y *s x"
-proof-
- {assume x: "x =0 \<or> y =0"
- hence ?thesis by (cases "x=0", simp_all)}
- moreover
- {assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
- hence "norm x \<noteq> 0" "norm y \<noteq> 0"
- by simp_all
- hence n: "norm x > 0" "norm y > 0"
- using norm_ge_zero[of x] norm_ge_zero[of y]
- by arith+
- have th: "\<And>(a::real) b c. a + b + c \<noteq> 0 ==> (a = b + c \<longleftrightarrow> a^2 = (b + c)^2)" by algebra
- have "norm(x + y) = norm x + norm y \<longleftrightarrow> norm(x + y)^ 2 = (norm x + norm y) ^2"
- apply (rule th) using n norm_ge_zero[of "x + y"]
- by arith
- also have "\<dots> \<longleftrightarrow> norm x *s y = norm y *s x"
- unfolding norm_cauchy_schwarz_eq[symmetric]
- unfolding norm_pow_2 dot_ladd dot_radd
- by (simp add: norm_pow_2[symmetric] power2_eq_square dot_sym ring_simps)
- finally have ?thesis .}
- ultimately show ?thesis by blast
-qed
-
-(* Collinearity.*)
-
-definition "collinear S \<longleftrightarrow> (\<exists>u. \<forall>x \<in> S. \<forall> y \<in> S. \<exists>c. x - y = c *s u)"
-
-lemma collinear_empty: "collinear {}" by (simp add: collinear_def)
-
-lemma collinear_sing: "collinear {(x::'a::ring_1^'n)}"
- apply (simp add: collinear_def)
- apply (rule exI[where x=0])
- by simp
-
-lemma collinear_2: "collinear {(x::'a::ring_1^'n),y}"
- apply (simp add: collinear_def)
- apply (rule exI[where x="x - y"])
- apply auto
- apply (rule exI[where x=0], simp)
- apply (rule exI[where x=1], simp)
- apply (rule exI[where x="- 1"], simp add: vector_sneg_minus1[symmetric])
- apply (rule exI[where x=0], simp)
- done
-
-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")
-proof-
- {assume "x=0 \<or> y = 0" hence ?thesis
- by (cases "x = 0", simp_all add: collinear_2 insert_commute)}
- moreover
- {assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
- {assume h: "?lhs"
- 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
- from u[rule_format, of x 0] u[rule_format, of y 0]
- obtain cx and cy where
- cx: "x = cx*s u" and cy: "y = cy*s u"
- by auto
- from cx x have cx0: "cx \<noteq> 0" by auto
- from cy y have cy0: "cy \<noteq> 0" by auto
- let ?d = "cy / cx"
- from cx cy cx0 have "y = ?d *s x"
- by (simp add: vector_smult_assoc)
- hence ?rhs using x y by blast}
- moreover
- {assume h: "?rhs"
- then obtain c where c: "y = c*s x" using x y by blast
- have ?lhs unfolding collinear_def c
- apply (rule exI[where x=x])
- apply auto
- apply (rule exI[where x="- 1"], simp only: vector_smult_lneg vector_smult_lid)
- apply (rule exI[where x= "-c"], simp only: vector_smult_lneg)
- apply (rule exI[where x=1], simp)
- apply (rule exI[where x="1 - c"], simp add: vector_smult_lneg vector_sub_rdistrib)
- apply (rule exI[where x="c - 1"], simp add: vector_smult_lneg vector_sub_rdistrib)
- done}
- ultimately have ?thesis by blast}
- ultimately show ?thesis by blast
-qed
-
-lemma norm_cauchy_schwarz_equal:
- fixes x y :: "real ^ 'n::finite"
- shows "abs(x \<bullet> y) = norm x * norm y \<longleftrightarrow> collinear {(0::real^'n),x,y}"
-unfolding norm_cauchy_schwarz_abs_eq
-apply (cases "x=0", simp_all add: collinear_2)
-apply (cases "y=0", simp_all add: collinear_2 insert_commute)
-unfolding collinear_lemma
-apply simp
-apply (subgoal_tac "norm x \<noteq> 0")
-apply (subgoal_tac "norm y \<noteq> 0")
-apply (rule iffI)
-apply (cases "norm x *s y = norm y *s x")
-apply (rule exI[where x="(1/norm x) * norm y"])
-apply (drule sym)
-unfolding vector_smult_assoc[symmetric]
-apply (simp add: vector_smult_assoc field_simps)
-apply (rule exI[where x="(1/norm x) * - norm y"])
-apply clarify
-apply (drule sym)
-unfolding vector_smult_assoc[symmetric]
-apply (simp add: vector_smult_assoc field_simps)
-apply (erule exE)
-apply (erule ssubst)
-unfolding vector_smult_assoc
-unfolding norm_mul
-apply (subgoal_tac "norm x * c = \<bar>c\<bar> * norm x \<or> norm x * c = - \<bar>c\<bar> * norm x")
-apply (case_tac "c <= 0", simp add: ring_simps)
-apply (simp add: ring_simps)
-apply (case_tac "c <= 0", simp add: ring_simps)
-apply (simp add: ring_simps)
-apply simp
-apply simp
-done
-
-end
--- a/src/HOL/Library/Finite_Cartesian_Product.thy Fri Oct 23 14:33:07 2009 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,95 +0,0 @@
-(* Title: HOL/Library/Finite_Cartesian_Product
- Author: Amine Chaieb, University of Cambridge
-*)
-
-header {* Definition of finite Cartesian product types. *}
-
-theory Finite_Cartesian_Product
-imports Main (*FIXME: ATP_Linkup is only needed for metis at a few places. We could dispense of that by changing the proofs.*)
-begin
-
-definition hassize (infixr "hassize" 12) where
- "(S hassize n) = (finite S \<and> card S = n)"
-
-lemma hassize_image_inj: assumes f: "inj_on f S" and S: "S hassize n"
- shows "f ` S hassize n"
- using f S card_image[OF f]
- by (simp add: hassize_def inj_on_def)
-
-
-subsection {* Finite Cartesian products, with indexing and lambdas. *}
-
-typedef (open Cart)
- ('a, 'b) "^" (infixl "^" 15)
- = "UNIV :: ('b \<Rightarrow> 'a) set"
- morphisms Cart_nth Cart_lambda ..
-
-notation Cart_nth (infixl "$" 90)
-
-notation (xsymbols) Cart_lambda (binder "\<chi>" 10)
-
-lemma stupid_ext: "(\<forall>x. f x = g x) \<longleftrightarrow> (f = g)"
- apply auto
- apply (rule ext)
- apply auto
- done
-
-lemma Cart_eq: "((x:: 'a ^ 'b) = y) \<longleftrightarrow> (\<forall>i. x$i = y$i)"
- by (simp add: Cart_nth_inject [symmetric] expand_fun_eq)
-
-lemma Cart_lambda_beta [simp]: "Cart_lambda g $ i = g i"
- by (simp add: Cart_lambda_inverse)
-
-lemma Cart_lambda_unique:
- fixes f :: "'a ^ 'b"
- shows "(\<forall>i. f$i = g i) \<longleftrightarrow> Cart_lambda g = f"
- by (auto simp add: Cart_eq)
-
-lemma Cart_lambda_eta: "(\<chi> i. (g$i)) = g"
- by (simp add: Cart_eq)
-
-text{* A non-standard sum to "paste" Cartesian products. *}
-
-definition pastecart :: "'a ^ 'm \<Rightarrow> 'a ^ 'n \<Rightarrow> 'a ^ ('m + 'n)" where
- "pastecart f g = (\<chi> i. case i of Inl a \<Rightarrow> f$a | Inr b \<Rightarrow> g$b)"
-
-definition fstcart:: "'a ^('m + 'n) \<Rightarrow> 'a ^ 'm" where
- "fstcart f = (\<chi> i. (f$(Inl i)))"
-
-definition sndcart:: "'a ^('m + 'n) \<Rightarrow> 'a ^ 'n" where
- "sndcart f = (\<chi> i. (f$(Inr i)))"
-
-lemma nth_pastecart_Inl [simp]: "pastecart f g $ Inl a = f$a"
- unfolding pastecart_def by simp
-
-lemma nth_pastecart_Inr [simp]: "pastecart f g $ Inr b = g$b"
- unfolding pastecart_def by simp
-
-lemma nth_fstcart [simp]: "fstcart f $ i = f $ Inl i"
- unfolding fstcart_def by simp
-
-lemma nth_sndtcart [simp]: "sndcart f $ i = f $ Inr i"
- unfolding sndcart_def by simp
-
-lemma finite_sum_image: "(UNIV::('a + 'b) set) = range Inl \<union> range Inr"
-by (auto, case_tac x, auto)
-
-lemma fstcart_pastecart: "fstcart (pastecart (x::'a ^'m ) (y:: 'a ^ 'n)) = x"
- by (simp add: Cart_eq)
-
-lemma sndcart_pastecart: "sndcart (pastecart (x::'a ^'m ) (y:: 'a ^ 'n)) = y"
- by (simp add: Cart_eq)
-
-lemma pastecart_fst_snd: "pastecart (fstcart z) (sndcart z) = z"
- by (simp add: Cart_eq pastecart_def fstcart_def sndcart_def split: sum.split)
-
-lemma pastecart_eq: "(x = y) \<longleftrightarrow> (fstcart x = fstcart y) \<and> (sndcart x = sndcart y)"
- using pastecart_fst_snd[of x] pastecart_fst_snd[of y] by metis
-
-lemma forall_pastecart: "(\<forall>p. P p) \<longleftrightarrow> (\<forall>x y. P (pastecart x y))"
- by (metis pastecart_fst_snd fstcart_pastecart sndcart_pastecart)
-
-lemma exists_pastecart: "(\<exists>p. P p) \<longleftrightarrow> (\<exists>x y. P (pastecart x y))"
- by (metis pastecart_fst_snd fstcart_pastecart sndcart_pastecart)
-
-end
--- a/src/HOL/Library/Library.thy Fri Oct 23 14:33:07 2009 +0200
+++ b/src/HOL/Library/Library.thy Fri Oct 23 13:23:18 2009 +0200
@@ -14,9 +14,7 @@
Commutative_Ring
Continuity
ContNotDenum
- Convex_Euclidean_Space
Countable
- Determinants
Diagonalize
Efficient_Nat
Enum
@@ -54,7 +52,6 @@
RBT
State_Monad
Sum_Of_Squares
- Topology_Euclidean_Space
Univ_Poly
While_Combinator
Word
--- a/src/HOL/Library/Topology_Euclidean_Space.thy Fri Oct 23 14:33:07 2009 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,6027 +0,0 @@
-(* Title: HOL/Library/Topology_Euclidian_Space.thy
- Author: Amine Chaieb, University of Cambridge
- Author: Robert Himmelmann, TU Muenchen
-*)
-
-header {* Elementary topology in Euclidean space. *}
-
-theory Topology_Euclidean_Space
-imports SEQ Euclidean_Space Product_Vector
-begin
-
-declare fstcart_pastecart[simp] sndcart_pastecart[simp]
-
-subsection{* General notion of a topology *}
-
-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)"
-typedef (open) 'a topology = "{L::('a set) set. istopology L}"
- morphisms "openin" "topology"
- unfolding istopology_def by blast
-
-lemma istopology_open_in[intro]: "istopology(openin U)"
- using openin[of U] by blast
-
-lemma topology_inverse': "istopology U \<Longrightarrow> openin (topology U) = U"
- using topology_inverse[unfolded mem_def Collect_def] .
-
-lemma topology_inverse_iff: "istopology U \<longleftrightarrow> openin (topology U) = U"
- using topology_inverse[of U] istopology_open_in[of "topology U"] by auto
-
-lemma topology_eq: "T1 = T2 \<longleftrightarrow> (\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S)"
-proof-
- {assume "T1=T2" hence "\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S" by simp}
- moreover
- {assume H: "\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S"
- hence "openin T1 = openin T2" by (metis mem_def set_ext)
- hence "topology (openin T1) = topology (openin T2)" by simp
- hence "T1 = T2" unfolding openin_inverse .}
- ultimately show ?thesis by blast
-qed
-
-text{* Infer the "universe" from union of all sets in the topology. *}
-
-definition "topspace T = \<Union>{S. openin T S}"
-
-subsection{* Main properties of open sets *}
-
-lemma openin_clauses:
- fixes U :: "'a topology"
- shows "openin U {}"
- "\<And>S T. openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S\<inter>T)"
- "\<And>K. (\<forall>S \<in> K. openin U S) \<Longrightarrow> openin U (\<Union>K)"
- using openin[of U] unfolding istopology_def Collect_def mem_def
- by (metis mem_def subset_eq)+
-
-lemma openin_subset[intro]: "openin U S \<Longrightarrow> S \<subseteq> topspace U"
- unfolding topspace_def by blast
-lemma openin_empty[simp]: "openin U {}" by (simp add: openin_clauses)
-
-lemma openin_Int[intro]: "openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S \<inter> T)"
- by (simp add: openin_clauses)
-
-lemma openin_Union[intro]: "(\<forall>S \<in>K. openin U S) \<Longrightarrow> openin U (\<Union> K)" by (simp add: openin_clauses)
-
-lemma openin_Un[intro]: "openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S \<union> T)"
- using openin_Union[of "{S,T}" U] by auto
-
-lemma openin_topspace[intro, simp]: "openin U (topspace U)" by (simp add: openin_Union topspace_def)
-
-lemma openin_subopen: "openin U S \<longleftrightarrow> (\<forall>x \<in> S. \<exists>T. openin U T \<and> x \<in> T \<and> T \<subseteq> S)" (is "?lhs \<longleftrightarrow> ?rhs")
-proof-
- {assume ?lhs then have ?rhs by auto }
- moreover
- {assume H: ?rhs
- then obtain t where t: "\<forall>x\<in>S. openin U (t x) \<and> x \<in> t x \<and> t x \<subseteq> S"
- unfolding Ball_def ex_simps(6)[symmetric] choice_iff by blast
- from t have th0: "\<forall>x\<in> t`S. openin U x" by auto
- have "\<Union> t`S = S" using t by auto
- with openin_Union[OF th0] have "openin U S" by simp }
- ultimately show ?thesis by blast
-qed
-
-subsection{* Closed sets *}
-
-definition "closedin U S \<longleftrightarrow> S \<subseteq> topspace U \<and> openin U (topspace U - S)"
-
-lemma closedin_subset: "closedin U S \<Longrightarrow> S \<subseteq> topspace U" by (metis closedin_def)
-lemma closedin_empty[simp]: "closedin U {}" by (simp add: closedin_def)
-lemma closedin_topspace[intro,simp]:
- "closedin U (topspace U)" by (simp add: closedin_def)
-lemma closedin_Un[intro]: "closedin U S \<Longrightarrow> closedin U T \<Longrightarrow> closedin U (S \<union> T)"
- by (auto simp add: Diff_Un closedin_def)
-
-lemma Diff_Inter[intro]: "A - \<Inter>S = \<Union> {A - s|s. s\<in>S}" by auto
-lemma closedin_Inter[intro]: assumes Ke: "K \<noteq> {}" and Kc: "\<forall>S \<in>K. closedin U S"
- shows "closedin U (\<Inter> K)" using Ke Kc unfolding closedin_def Diff_Inter by auto
-
-lemma closedin_Int[intro]: "closedin U S \<Longrightarrow> closedin U T \<Longrightarrow> closedin U (S \<inter> T)"
- using closedin_Inter[of "{S,T}" U] by auto
-
-lemma Diff_Diff_Int: "A - (A - B) = A \<inter> B" by blast
-lemma openin_closedin_eq: "openin U S \<longleftrightarrow> S \<subseteq> topspace U \<and> closedin U (topspace U - S)"
- apply (auto simp add: closedin_def Diff_Diff_Int inf_absorb2)
- apply (metis openin_subset subset_eq)
- done
-
-lemma openin_closedin: "S \<subseteq> topspace U \<Longrightarrow> (openin U S \<longleftrightarrow> closedin U (topspace U - S))"
- by (simp add: openin_closedin_eq)
-
-lemma openin_diff[intro]: assumes oS: "openin U S" and cT: "closedin U T" shows "openin U (S - T)"
-proof-
- have "S - T = S \<inter> (topspace U - T)" using openin_subset[of U S] oS cT
- by (auto simp add: topspace_def openin_subset)
- then show ?thesis using oS cT by (auto simp add: closedin_def)
-qed
-
-lemma closedin_diff[intro]: assumes oS: "closedin U S" and cT: "openin U T" shows "closedin U (S - T)"
-proof-
- have "S - T = S \<inter> (topspace U - T)" using closedin_subset[of U S] oS cT
- by (auto simp add: topspace_def )
- then show ?thesis using oS cT by (auto simp add: openin_closedin_eq)
-qed
-
-subsection{* Subspace topology. *}
-
-definition "subtopology U V = topology {S \<inter> V |S. openin U S}"
-
-lemma istopology_subtopology: "istopology {S \<inter> V |S. openin U S}" (is "istopology ?L")
-proof-
- have "{} \<in> ?L" by blast
- {fix A B assume A: "A \<in> ?L" and B: "B \<in> ?L"
- from A B obtain Sa and Sb where Sa: "openin U Sa" "A = Sa \<inter> V" and Sb: "openin U Sb" "B = Sb \<inter> V" by blast
- have "A\<inter>B = (Sa \<inter> Sb) \<inter> V" "openin U (Sa \<inter> Sb)" using Sa Sb by blast+
- then have "A \<inter> B \<in> ?L" by blast}
- moreover
- {fix K assume K: "K \<subseteq> ?L"
- have th0: "?L = (\<lambda>S. S \<inter> V) ` openin U "
- apply (rule set_ext)
- apply (simp add: Ball_def image_iff)
- by (metis mem_def)
- from K[unfolded th0 subset_image_iff]
- obtain Sk where Sk: "Sk \<subseteq> openin U" "K = (\<lambda>S. S \<inter> V) ` Sk" by blast
- have "\<Union>K = (\<Union>Sk) \<inter> V" using Sk by auto
- moreover have "openin U (\<Union> Sk)" using Sk by (auto simp add: subset_eq mem_def)
- ultimately have "\<Union>K \<in> ?L" by blast}
- ultimately show ?thesis unfolding istopology_def by blast
-qed
-
-lemma openin_subtopology:
- "openin (subtopology U V) S \<longleftrightarrow> (\<exists> T. (openin U T) \<and> (S = T \<inter> V))"
- unfolding subtopology_def topology_inverse'[OF istopology_subtopology]
- by (auto simp add: Collect_def)
-
-lemma topspace_subtopology: "topspace(subtopology U V) = topspace U \<inter> V"
- by (auto simp add: topspace_def openin_subtopology)
-
-lemma closedin_subtopology:
- "closedin (subtopology U V) S \<longleftrightarrow> (\<exists>T. closedin U T \<and> S = T \<inter> V)"
- unfolding closedin_def topspace_subtopology
- apply (simp add: openin_subtopology)
- apply (rule iffI)
- apply clarify
- apply (rule_tac x="topspace U - T" in exI)
- by auto
-
-lemma openin_subtopology_refl: "openin (subtopology U V) V \<longleftrightarrow> V \<subseteq> topspace U"
- unfolding openin_subtopology
- apply (rule iffI, clarify)
- apply (frule openin_subset[of U]) apply blast
- apply (rule exI[where x="topspace U"])
- by auto
-
-lemma subtopology_superset: assumes UV: "topspace U \<subseteq> V"
- shows "subtopology U V = U"
-proof-
- {fix S
- {fix T assume T: "openin U T" "S = T \<inter> V"
- from T openin_subset[OF T(1)] UV have eq: "S = T" by blast
- have "openin U S" unfolding eq using T by blast}
- moreover
- {assume S: "openin U S"
- hence "\<exists>T. openin U T \<and> S = T \<inter> V"
- using openin_subset[OF S] UV by auto}
- ultimately have "(\<exists>T. openin U T \<and> S = T \<inter> V) \<longleftrightarrow> openin U S" by blast}
- then show ?thesis unfolding topology_eq openin_subtopology by blast
-qed
-
-
-lemma subtopology_topspace[simp]: "subtopology U (topspace U) = U"
- by (simp add: subtopology_superset)
-
-lemma subtopology_UNIV[simp]: "subtopology U UNIV = U"
- by (simp add: subtopology_superset)
-
-subsection{* The universal Euclidean versions are what we use most of the time *}
-
-definition
- euclidean :: "'a::topological_space topology" where
- "euclidean = topology open"
-
-lemma open_openin: "open S \<longleftrightarrow> openin euclidean S"
- unfolding euclidean_def
- apply (rule cong[where x=S and y=S])
- apply (rule topology_inverse[symmetric])
- apply (auto simp add: istopology_def)
- by (auto simp add: mem_def subset_eq)
-
-lemma topspace_euclidean: "topspace euclidean = UNIV"
- apply (simp add: topspace_def)
- apply (rule set_ext)
- by (auto simp add: open_openin[symmetric])
-
-lemma topspace_euclidean_subtopology[simp]: "topspace (subtopology euclidean S) = S"
- by (simp add: topspace_euclidean topspace_subtopology)
-
-lemma closed_closedin: "closed S \<longleftrightarrow> closedin euclidean S"
- by (simp add: closed_def closedin_def topspace_euclidean open_openin Compl_eq_Diff_UNIV)
-
-lemma open_subopen: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> S)"
- by (simp add: open_openin openin_subopen[symmetric])
-
-subsection{* Open and closed balls. *}
-
-definition
- ball :: "'a::metric_space \<Rightarrow> real \<Rightarrow> 'a set" where
- "ball x e = {y. dist x y < e}"
-
-definition
- cball :: "'a::metric_space \<Rightarrow> real \<Rightarrow> 'a set" where
- "cball x e = {y. dist x y \<le> e}"
-
-lemma mem_ball[simp]: "y \<in> ball x e \<longleftrightarrow> dist x y < e" by (simp add: ball_def)
-lemma mem_cball[simp]: "y \<in> cball x e \<longleftrightarrow> dist x y \<le> e" by (simp add: cball_def)
-
-lemma mem_ball_0 [simp]:
- fixes x :: "'a::real_normed_vector"
- shows "x \<in> ball 0 e \<longleftrightarrow> norm x < e"
- by (simp add: dist_norm)
-
-lemma mem_cball_0 [simp]:
- fixes x :: "'a::real_normed_vector"
- shows "x \<in> cball 0 e \<longleftrightarrow> norm x \<le> e"
- by (simp add: dist_norm)
-
-lemma centre_in_cball[simp]: "x \<in> cball x e \<longleftrightarrow> 0\<le> e" by simp
-lemma ball_subset_cball[simp,intro]: "ball x e \<subseteq> cball x e" by (simp add: subset_eq)
-lemma subset_ball[intro]: "d <= e ==> ball x d \<subseteq> ball x e" by (simp add: subset_eq)
-lemma subset_cball[intro]: "d <= e ==> cball x d \<subseteq> cball x e" by (simp add: subset_eq)
-lemma ball_max_Un: "ball a (max r s) = ball a r \<union> ball a s"
- by (simp add: expand_set_eq) arith
-
-lemma ball_min_Int: "ball a (min r s) = ball a r \<inter> ball a s"
- by (simp add: expand_set_eq)
-
-subsection{* Topological properties of open balls *}
-
-lemma diff_less_iff: "(a::real) - b > 0 \<longleftrightarrow> a > b"
- "(a::real) - b < 0 \<longleftrightarrow> a < b"
- "a - b < c \<longleftrightarrow> a < c +b" "a - b > c \<longleftrightarrow> a > c +b" by arith+
-lemma diff_le_iff: "(a::real) - b \<ge> 0 \<longleftrightarrow> a \<ge> b" "(a::real) - b \<le> 0 \<longleftrightarrow> a \<le> b"
- "a - b \<le> c \<longleftrightarrow> a \<le> c +b" "a - b \<ge> c \<longleftrightarrow> a \<ge> c +b" by arith+
-
-lemma open_ball[intro, simp]: "open (ball x e)"
- unfolding open_dist ball_def Collect_def Ball_def mem_def
- unfolding dist_commute
- apply clarify
- apply (rule_tac x="e - dist xa x" in exI)
- using dist_triangle_alt[where z=x]
- apply (clarsimp simp add: diff_less_iff)
- apply atomize
- apply (erule_tac x="y" in allE)
- apply (erule_tac x="xa" in allE)
- by arith
-
-lemma centre_in_ball[simp]: "x \<in> ball x e \<longleftrightarrow> e > 0" by (metis mem_ball dist_self)
-lemma open_contains_ball: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. ball x e \<subseteq> S)"
- unfolding open_dist subset_eq mem_ball Ball_def dist_commute ..
-
-lemma open_contains_ball_eq: "open S \<Longrightarrow> \<forall>x. x\<in>S \<longleftrightarrow> (\<exists>e>0. ball x e \<subseteq> S)"
- by (metis open_contains_ball subset_eq centre_in_ball)
-
-lemma ball_eq_empty[simp]: "ball x e = {} \<longleftrightarrow> e \<le> 0"
- unfolding mem_ball expand_set_eq
- apply (simp add: not_less)
- by (metis zero_le_dist order_trans dist_self)
-
-lemma ball_empty[intro]: "e \<le> 0 ==> ball x e = {}" by simp
-
-subsection{* Basic "localization" results are handy for connectedness. *}
-
-lemma openin_open: "openin (subtopology euclidean U) S \<longleftrightarrow> (\<exists>T. open T \<and> (S = U \<inter> T))"
- by (auto simp add: openin_subtopology open_openin[symmetric])
-
-lemma openin_open_Int[intro]: "open S \<Longrightarrow> openin (subtopology euclidean U) (U \<inter> S)"
- by (auto simp add: openin_open)
-
-lemma open_openin_trans[trans]:
- "open S \<Longrightarrow> open T \<Longrightarrow> T \<subseteq> S \<Longrightarrow> openin (subtopology euclidean S) T"
- by (metis Int_absorb1 openin_open_Int)
-
-lemma open_subset: "S \<subseteq> T \<Longrightarrow> open S \<Longrightarrow> openin (subtopology euclidean T) S"
- by (auto simp add: openin_open)
-
-lemma closedin_closed: "closedin (subtopology euclidean U) S \<longleftrightarrow> (\<exists>T. closed T \<and> S = U \<inter> T)"
- by (simp add: closedin_subtopology closed_closedin Int_ac)
-
-lemma closedin_closed_Int: "closed S ==> closedin (subtopology euclidean U) (U \<inter> S)"
- by (metis closedin_closed)
-
-lemma closed_closedin_trans: "closed S \<Longrightarrow> closed T \<Longrightarrow> T \<subseteq> S \<Longrightarrow> closedin (subtopology euclidean S) T"
- apply (subgoal_tac "S \<inter> T = T" )
- apply auto
- apply (frule closedin_closed_Int[of T S])
- by simp
-
-lemma closed_subset: "S \<subseteq> T \<Longrightarrow> closed S \<Longrightarrow> closedin (subtopology euclidean T) S"
- by (auto simp add: closedin_closed)
-
-lemma openin_euclidean_subtopology_iff:
- fixes S U :: "'a::metric_space set"
- shows "openin (subtopology euclidean U) S
- \<longleftrightarrow> S \<subseteq> U \<and> (\<forall>x\<in>S. \<exists>e>0. \<forall>x'\<in>U. dist x' x < e \<longrightarrow> x'\<in> S)" (is "?lhs \<longleftrightarrow> ?rhs")
-proof-
- {assume ?lhs hence ?rhs unfolding openin_subtopology open_openin[symmetric]
- by (simp add: open_dist) blast}
- moreover
- {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"
- 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)"
- by metis
- let ?T = "\<Union>{B. \<exists>x\<in>S. B = ball x (d x)}"
- have oT: "open ?T" by auto
- { fix x assume "x\<in>S"
- hence "x \<in> \<Union>{B. \<exists>x\<in>S. B = ball x (d x)}"
- apply simp apply(rule_tac x="ball x(d x)" in exI) apply auto
- by (rule d [THEN conjunct1])
- hence "x\<in> ?T \<inter> U" using SU and `x\<in>S` by auto }
- moreover
- { fix y assume "y\<in>?T"
- then obtain B where "y\<in>B" "B\<in>{B. \<exists>x\<in>S. B = ball x (d x)}" by auto
- then obtain x where "x\<in>S" and x:"y \<in> ball x (d x)" by auto
- assume "y\<in>U"
- hence "y\<in>S" using d[OF `x\<in>S`] and x by(auto simp add: dist_commute) }
- ultimately have "S = ?T \<inter> U" by blast
- with oT have ?lhs unfolding openin_subtopology open_openin[symmetric] by blast}
- ultimately show ?thesis by blast
-qed
-
-text{* These "transitivity" results are handy too. *}
-
-lemma openin_trans[trans]: "openin (subtopology euclidean T) S \<Longrightarrow> openin (subtopology euclidean U) T
- \<Longrightarrow> openin (subtopology euclidean U) S"
- unfolding open_openin openin_open by blast
-
-lemma openin_open_trans: "openin (subtopology euclidean T) S \<Longrightarrow> open T \<Longrightarrow> open S"
- by (auto simp add: openin_open intro: openin_trans)
-
-lemma closedin_trans[trans]:
- "closedin (subtopology euclidean T) S \<Longrightarrow>
- closedin (subtopology euclidean U) T
- ==> closedin (subtopology euclidean U) S"
- by (auto simp add: closedin_closed closed_closedin closed_Inter Int_assoc)
-
-lemma closedin_closed_trans: "closedin (subtopology euclidean T) S \<Longrightarrow> closed T \<Longrightarrow> closed S"
- by (auto simp add: closedin_closed intro: closedin_trans)
-
-subsection{* Connectedness *}
-
-definition "connected S \<longleftrightarrow>
- ~(\<exists>e1 e2. open e1 \<and> open e2 \<and> S \<subseteq> (e1 \<union> e2) \<and> (e1 \<inter> e2 \<inter> S = {})
- \<and> ~(e1 \<inter> S = {}) \<and> ~(e2 \<inter> S = {}))"
-
-lemma connected_local:
- "connected S \<longleftrightarrow> ~(\<exists>e1 e2.
- openin (subtopology euclidean S) e1 \<and>
- openin (subtopology euclidean S) e2 \<and>
- S \<subseteq> e1 \<union> e2 \<and>
- e1 \<inter> e2 = {} \<and>
- ~(e1 = {}) \<and>
- ~(e2 = {}))"
-unfolding connected_def openin_open by (safe, blast+)
-
-lemma exists_diff: "(\<exists>S. P(UNIV - S)) \<longleftrightarrow> (\<exists>S. P S)" (is "?lhs \<longleftrightarrow> ?rhs")
-proof-
-
- {assume "?lhs" hence ?rhs by blast }
- moreover
- {fix S assume H: "P S"
- have "S = UNIV - (UNIV - S)" by auto
- with H have "P (UNIV - (UNIV - S))" by metis }
- ultimately show ?thesis by metis
-qed
-
-lemma connected_clopen: "connected S \<longleftrightarrow>
- (\<forall>T. openin (subtopology euclidean S) T \<and>
- closedin (subtopology euclidean S) T \<longrightarrow> T = {} \<or> T = S)" (is "?lhs \<longleftrightarrow> ?rhs")
-proof-
- 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> {})"
- unfolding connected_def openin_open closedin_closed
- apply (subst exists_diff) by blast
- 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> {})"
- (is " _ \<longleftrightarrow> \<not> (\<exists>e2 e1. ?P e2 e1)") apply (simp add: closed_def Compl_eq_Diff_UNIV) by metis
-
- have th1: "?rhs \<longleftrightarrow> \<not> (\<exists>t' t. closed t'\<and>t = S\<inter>t' \<and> t\<noteq>{} \<and> t\<noteq>S \<and> (\<exists>t'. open t' \<and> t = S \<inter> t'))"
- (is "_ \<longleftrightarrow> \<not> (\<exists>t' t. ?Q t' t)")
- unfolding connected_def openin_open closedin_closed by auto
- {fix e2
- {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)"
- by auto}
- then have "(\<exists>e1. ?P e2 e1) \<longleftrightarrow> (\<exists>t. ?Q e2 t)" by metis}
- then have "\<forall>e2. (\<exists>e1. ?P e2 e1) \<longleftrightarrow> (\<exists>t. ?Q e2 t)" by blast
- then show ?thesis unfolding th0 th1 by simp
-qed
-
-lemma connected_empty[simp, intro]: "connected {}"
- by (simp add: connected_def)
-
-subsection{* Hausdorff and other separation properties *}
-
-class t0_space =
- assumes t0_space: "x \<noteq> y \<Longrightarrow> \<exists>U. open U \<and> \<not> (x \<in> U \<longleftrightarrow> y \<in> U)"
-
-class t1_space =
- 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"
-begin
-
-subclass t0_space
-proof
-qed (fast dest: t1_space)
-
-end
-
-text {* T2 spaces are also known as Hausdorff spaces. *}
-
-class t2_space =
- 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 = {}"
-begin
-
-subclass t1_space
-proof
-qed (fast dest: hausdorff)
-
-end
-
-instance metric_space \<subseteq> t2_space
-proof
- fix x y :: "'a::metric_space"
- assume xy: "x \<noteq> y"
- let ?U = "ball x (dist x y / 2)"
- let ?V = "ball y (dist x y / 2)"
- have th0: "\<And>d x y z. (d x z :: real) <= d x y + d y z \<Longrightarrow> d y z = d z y
- ==> ~(d x y * 2 < d x z \<and> d z y * 2 < d x z)" by arith
- have "open ?U \<and> open ?V \<and> x \<in> ?U \<and> y \<in> ?V \<and> ?U \<inter> ?V = {}"
- using dist_pos_lt[OF xy] th0[of dist,OF dist_triangle dist_commute]
- by (auto simp add: expand_set_eq)
- then show "\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"
- by blast
-qed
-
-lemma separation_t2:
- fixes x y :: "'a::t2_space"
- 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 = {})"
- using hausdorff[of x y] by blast
-
-lemma separation_t1:
- fixes x y :: "'a::t1_space"
- 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)"
- using t1_space[of x y] by blast
-
-lemma separation_t0:
- fixes x y :: "'a::t0_space"
- shows "x \<noteq> y \<longleftrightarrow> (\<exists>U. open U \<and> ~(x\<in>U \<longleftrightarrow> y\<in>U))"
- using t0_space[of x y] by blast
-
-subsection{* Limit points *}
-
-definition
- islimpt:: "'a::topological_space \<Rightarrow> 'a set \<Rightarrow> bool"
- (infixr "islimpt" 60) where
- "x islimpt S \<longleftrightarrow> (\<forall>T. x\<in>T \<longrightarrow> open T \<longrightarrow> (\<exists>y\<in>S. y\<in>T \<and> y\<noteq>x))"
-
-lemma islimptI:
- assumes "\<And>T. x \<in> T \<Longrightarrow> open T \<Longrightarrow> \<exists>y\<in>S. y \<in> T \<and> y \<noteq> x"
- shows "x islimpt S"
- using assms unfolding islimpt_def by auto
-
-lemma islimptE:
- assumes "x islimpt S" and "x \<in> T" and "open T"
- obtains y where "y \<in> S" and "y \<in> T" and "y \<noteq> x"
- using assms unfolding islimpt_def by auto
-
-lemma islimpt_subset: "x islimpt S \<Longrightarrow> S \<subseteq> T ==> x islimpt T" by (auto simp add: islimpt_def)
-
-lemma islimpt_approachable:
- fixes x :: "'a::metric_space"
- shows "x islimpt S \<longleftrightarrow> (\<forall>e>0. \<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e)"
- unfolding islimpt_def
- apply auto
- apply(erule_tac x="ball x e" in allE)
- apply auto
- apply(rule_tac x=y in bexI)
- apply (auto simp add: dist_commute)
- apply (simp add: open_dist, drule (1) bspec)
- apply (clarify, drule spec, drule (1) mp, auto)
- done
-
-lemma islimpt_approachable_le:
- fixes x :: "'a::metric_space"
- shows "x islimpt S \<longleftrightarrow> (\<forall>e>0. \<exists>x'\<in> S. x' \<noteq> x \<and> dist x' x <= e)"
- unfolding islimpt_approachable
- using approachable_lt_le[where f="\<lambda>x'. dist x' x" and P="\<lambda>x'. \<not> (x'\<in>S \<and> x'\<noteq>x)"]
- by metis (* FIXME: VERY slow! *)
-
-class perfect_space =
- (* FIXME: perfect_space should inherit from topological_space *)
- assumes islimpt_UNIV [simp, intro]: "(x::'a::metric_space) islimpt UNIV"
-
-lemma perfect_choose_dist:
- fixes x :: "'a::perfect_space"
- shows "0 < r \<Longrightarrow> \<exists>a. a \<noteq> x \<and> dist a x < r"
-using islimpt_UNIV [of x]
-by (simp add: islimpt_approachable)
-
-instance real :: perfect_space
-apply default
-apply (rule islimpt_approachable [THEN iffD2])
-apply (clarify, rule_tac x="x + e/2" in bexI)
-apply (auto simp add: dist_norm)
-done
-
-instance "^" :: (perfect_space, finite) perfect_space
-proof
- fix x :: "'a ^ 'b"
- {
- fix e :: real assume "0 < e"
- def a \<equiv> "x $ undefined"
- have "a islimpt UNIV" by (rule islimpt_UNIV)
- with `0 < e` obtain b where "b \<noteq> a" and "dist b a < e"
- unfolding islimpt_approachable by auto
- def y \<equiv> "Cart_lambda ((Cart_nth x)(undefined := b))"
- from `b \<noteq> a` have "y \<noteq> x"
- unfolding a_def y_def by (simp add: Cart_eq)
- from `dist b a < e` have "dist y x < e"
- unfolding dist_vector_def a_def y_def
- apply simp
- apply (rule le_less_trans [OF setL2_le_setsum [OF zero_le_dist]])
- apply (subst setsum_diff1' [where a=undefined], simp, simp, simp)
- done
- from `y \<noteq> x` and `dist y x < e`
- have "\<exists>y\<in>UNIV. y \<noteq> x \<and> dist y x < e" by auto
- }
- then show "x islimpt UNIV" unfolding islimpt_approachable by blast
-qed
-
-lemma closed_limpt: "closed S \<longleftrightarrow> (\<forall>x. x islimpt S \<longrightarrow> x \<in> S)"
- unfolding closed_def
- apply (subst open_subopen)
- apply (simp add: islimpt_def subset_eq Compl_eq_Diff_UNIV)
- by (metis DiffE DiffI UNIV_I insertCI insert_absorb mem_def)
-
-lemma islimpt_EMPTY[simp]: "\<not> x islimpt {}"
- unfolding islimpt_def by auto
-
-lemma closed_positive_orthant: "closed {x::real^'n::finite. \<forall>i. 0 \<le>x$i}"
-proof-
- let ?U = "UNIV :: 'n set"
- let ?O = "{x::real^'n. \<forall>i. x$i\<ge>0}"
- {fix x:: "real^'n" and i::'n assume H: "\<forall>e>0. \<exists>x'\<in>?O. x' \<noteq> x \<and> dist x' x < e"
- and xi: "x$i < 0"
- from xi have th0: "-x$i > 0" by arith
- from H[rule_format, OF th0] obtain x' where x': "x' \<in>?O" "x' \<noteq> x" "dist x' x < -x $ i" by blast
- have th:" \<And>b a (x::real). abs x <= b \<Longrightarrow> b <= a ==> ~(a + x < 0)" by arith
- have th': "\<And>x (y::real). x < 0 \<Longrightarrow> 0 <= y ==> abs x <= abs (y - x)" by arith
- have th1: "\<bar>x$i\<bar> \<le> \<bar>(x' - x)$i\<bar>" using x'(1) xi
- apply (simp only: vector_component)
- by (rule th') auto
- have th2: "\<bar>dist x x'\<bar> \<ge> \<bar>(x' - x)$i\<bar>" using component_le_norm[of "x'-x" i]
- apply (simp add: dist_norm) by norm
- from th[OF th1 th2] x'(3) have False by (simp add: dist_commute) }
- then show ?thesis unfolding closed_limpt islimpt_approachable
- unfolding not_le[symmetric] by blast
-qed
-
-lemma finite_set_avoid:
- fixes a :: "'a::metric_space"
- assumes fS: "finite S" shows "\<exists>d>0. \<forall>x\<in>S. x \<noteq> a \<longrightarrow> d <= dist a x"
-proof(induct rule: finite_induct[OF fS])
- case 1 thus ?case apply auto by ferrack
-next
- case (2 x F)
- from 2 obtain d where d: "d >0" "\<forall>x\<in>F. x\<noteq>a \<longrightarrow> d \<le> dist a x" by blast
- {assume "x = a" hence ?case using d by auto }
- moreover
- {assume xa: "x\<noteq>a"
- let ?d = "min d (dist a x)"
- have dp: "?d > 0" using xa d(1) using dist_nz by auto
- from d have d': "\<forall>x\<in>F. x\<noteq>a \<longrightarrow> ?d \<le> dist a x" by auto
- with dp xa have ?case by(auto intro!: exI[where x="?d"]) }
- ultimately show ?case by blast
-qed
-
-lemma islimpt_finite:
- fixes S :: "'a::metric_space set"
- assumes fS: "finite S" shows "\<not> a islimpt S"
- unfolding islimpt_approachable
- using finite_set_avoid[OF fS, of a] by (metis dist_commute not_le)
-
-lemma islimpt_Un: "x islimpt (S \<union> T) \<longleftrightarrow> x islimpt S \<or> x islimpt T"
- apply (rule iffI)
- defer
- apply (metis Un_upper1 Un_upper2 islimpt_subset)
- unfolding islimpt_def
- apply (rule ccontr, clarsimp, rename_tac A B)
- apply (drule_tac x="A \<inter> B" in spec)
- apply (auto simp add: open_Int)
- done
-
-lemma discrete_imp_closed:
- fixes S :: "'a::metric_space set"
- assumes e: "0 < e" and d: "\<forall>x \<in> S. \<forall>y \<in> S. dist y x < e \<longrightarrow> y = x"
- shows "closed S"
-proof-
- {fix x assume C: "\<forall>e>0. \<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e"
- from e have e2: "e/2 > 0" by arith
- from C[rule_format, OF e2] obtain y where y: "y \<in> S" "y\<noteq>x" "dist y x < e/2" by blast
- let ?m = "min (e/2) (dist x y) "
- from e2 y(2) have mp: "?m > 0" by (simp add: dist_nz[THEN sym])
- from C[rule_format, OF mp] obtain z where z: "z \<in> S" "z\<noteq>x" "dist z x < ?m" by blast
- have th: "dist z y < e" using z y
- by (intro dist_triangle_lt [where z=x], simp)
- from d[rule_format, OF y(1) z(1) th] y z
- have False by (auto simp add: dist_commute)}
- then show ?thesis by (metis islimpt_approachable closed_limpt [where 'a='a])
-qed
-
-subsection{* Interior of a Set *}
-definition "interior S = {x. \<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> S}"
-
-lemma interior_eq: "interior S = S \<longleftrightarrow> open S"
- apply (simp add: expand_set_eq interior_def)
- apply (subst (2) open_subopen) by (safe, blast+)
-
-lemma interior_open: "open S ==> (interior S = S)" by (metis interior_eq)
-
-lemma interior_empty[simp]: "interior {} = {}" by (simp add: interior_def)
-
-lemma open_interior[simp, intro]: "open(interior S)"
- apply (simp add: interior_def)
- apply (subst open_subopen) by blast
-
-lemma interior_interior[simp]: "interior(interior S) = interior S" by (metis interior_eq open_interior)
-lemma interior_subset: "interior S \<subseteq> S" by (auto simp add: interior_def)
-lemma subset_interior: "S \<subseteq> T ==> (interior S) \<subseteq> (interior T)" by (auto simp add: interior_def)
-lemma interior_maximal: "T \<subseteq> S \<Longrightarrow> open T ==> T \<subseteq> (interior S)" by (auto simp add: interior_def)
-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"
- by (metis equalityI interior_maximal interior_subset open_interior)
-lemma mem_interior: "x \<in> interior S \<longleftrightarrow> (\<exists>e. 0 < e \<and> ball x e \<subseteq> S)"
- apply (simp add: interior_def)
- by (metis open_contains_ball centre_in_ball open_ball subset_trans)
-
-lemma open_subset_interior: "open S ==> S \<subseteq> interior T \<longleftrightarrow> S \<subseteq> T"
- by (metis interior_maximal interior_subset subset_trans)
-
-lemma interior_inter[simp]: "interior(S \<inter> T) = interior S \<inter> interior T"
- apply (rule equalityI, simp)
- apply (metis Int_lower1 Int_lower2 subset_interior)
- by (metis Int_mono interior_subset open_Int open_interior open_subset_interior)
-
-lemma interior_limit_point [intro]:
- fixes x :: "'a::perfect_space"
- assumes x: "x \<in> interior S" shows "x islimpt S"
-proof-
- from x obtain e where e: "e>0" "\<forall>x'. dist x x' < e \<longrightarrow> x' \<in> S"
- unfolding mem_interior subset_eq Ball_def mem_ball by blast
- {
- fix d::real assume d: "d>0"
- let ?m = "min d e"
- have mde2: "0 < ?m" using e(1) d(1) by simp
- from perfect_choose_dist [OF mde2, of x]
- obtain y where "y \<noteq> x" and "dist y x < ?m" by blast
- then have "dist y x < e" "dist y x < d" by simp_all
- from `dist y x < e` e(2) have "y \<in> S" by (simp add: dist_commute)
- have "\<exists>x'\<in>S. x'\<noteq> x \<and> dist x' x < d"
- using `y \<in> S` `y \<noteq> x` `dist y x < d` by fast
- }
- then show ?thesis unfolding islimpt_approachable by blast
-qed
-
-lemma interior_closed_Un_empty_interior:
- assumes cS: "closed S" and iT: "interior T = {}"
- shows "interior(S \<union> T) = interior S"
-proof
- show "interior S \<subseteq> interior (S\<union>T)"
- by (rule subset_interior, blast)
-next
- show "interior (S \<union> T) \<subseteq> interior S"
- proof
- fix x assume "x \<in> interior (S \<union> T)"
- then obtain R where "open R" "x \<in> R" "R \<subseteq> S \<union> T"
- unfolding interior_def by fast
- show "x \<in> interior S"
- proof (rule ccontr)
- assume "x \<notin> interior S"
- with `x \<in> R` `open R` obtain y where "y \<in> R - S"
- unfolding interior_def expand_set_eq by fast
- from `open R` `closed S` have "open (R - S)" by (rule open_Diff)
- from `R \<subseteq> S \<union> T` have "R - S \<subseteq> T" by fast
- from `y \<in> R - S` `open (R - S)` `R - S \<subseteq> T` `interior T = {}`
- show "False" unfolding interior_def by fast
- qed
- qed
-qed
-
-
-subsection{* Closure of a Set *}
-
-definition "closure S = S \<union> {x | x. x islimpt S}"
-
-lemma closure_interior: "closure S = UNIV - interior (UNIV - S)"
-proof-
- { fix x
- have "x\<in>UNIV - interior (UNIV - S) \<longleftrightarrow> x \<in> closure S" (is "?lhs = ?rhs")
- proof
- let ?exT = "\<lambda> y. (\<exists>T. open T \<and> y \<in> T \<and> T \<subseteq> UNIV - S)"
- assume "?lhs"
- hence *:"\<not> ?exT x"
- unfolding interior_def
- by simp
- { assume "\<not> ?rhs"
- hence False using *
- unfolding closure_def islimpt_def
- by blast
- }
- thus "?rhs"
- by blast
- next
- assume "?rhs" thus "?lhs"
- unfolding closure_def interior_def islimpt_def
- by blast
- qed
- }
- thus ?thesis
- by blast
-qed
-
-lemma interior_closure: "interior S = UNIV - (closure (UNIV - S))"
-proof-
- { fix x
- have "x \<in> interior S \<longleftrightarrow> x \<in> UNIV - (closure (UNIV - S))"
- unfolding interior_def closure_def islimpt_def
- by blast (* FIXME: VERY slow! *)
- }
- thus ?thesis
- by blast
-qed
-
-lemma closed_closure[simp, intro]: "closed (closure S)"
-proof-
- have "closed (UNIV - interior (UNIV -S))" by blast
- thus ?thesis using closure_interior[of S] by simp
-qed
-
-lemma closure_hull: "closure S = closed hull S"
-proof-
- have "S \<subseteq> closure S"
- unfolding closure_def
- by blast
- moreover
- have "closed (closure S)"
- using closed_closure[of S]
- by assumption
- moreover
- { fix t
- assume *:"S \<subseteq> t" "closed t"
- { fix x
- assume "x islimpt S"
- hence "x islimpt t" using *(1)
- using islimpt_subset[of x, of S, of t]
- by blast
- }
- with * have "closure S \<subseteq> t"
- unfolding closure_def
- using closed_limpt[of t]
- by auto
- }
- ultimately show ?thesis
- using hull_unique[of S, of "closure S", of closed]
- unfolding mem_def
- by simp
-qed
-
-lemma closure_eq: "closure S = S \<longleftrightarrow> closed S"
- unfolding closure_hull
- using hull_eq[of closed, unfolded mem_def, OF closed_Inter, of S]
- by (metis mem_def subset_eq)
-
-lemma closure_closed[simp]: "closed S \<Longrightarrow> closure S = S"
- using closure_eq[of S]
- by simp
-
-lemma closure_closure[simp]: "closure (closure S) = closure S"
- unfolding closure_hull
- using hull_hull[of closed S]
- by assumption
-
-lemma closure_subset: "S \<subseteq> closure S"
- unfolding closure_hull
- using hull_subset[of S closed]
- by assumption
-
-lemma subset_closure: "S \<subseteq> T \<Longrightarrow> closure S \<subseteq> closure T"
- unfolding closure_hull
- using hull_mono[of S T closed]
- by assumption
-
-lemma closure_minimal: "S \<subseteq> T \<Longrightarrow> closed T \<Longrightarrow> closure S \<subseteq> T"
- using hull_minimal[of S T closed]
- unfolding closure_hull mem_def
- by simp
-
-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"
- using hull_unique[of S T closed]
- unfolding closure_hull mem_def
- by simp
-
-lemma closure_empty[simp]: "closure {} = {}"
- using closed_empty closure_closed[of "{}"]
- by simp
-
-lemma closure_univ[simp]: "closure UNIV = UNIV"
- using closure_closed[of UNIV]
- by simp
-
-lemma closure_eq_empty: "closure S = {} \<longleftrightarrow> S = {}"
- using closure_empty closure_subset[of S]
- by blast
-
-lemma closure_subset_eq: "closure S \<subseteq> S \<longleftrightarrow> closed S"
- using closure_eq[of S] closure_subset[of S]
- by simp
-
-lemma open_inter_closure_eq_empty:
- "open S \<Longrightarrow> (S \<inter> closure T) = {} \<longleftrightarrow> S \<inter> T = {}"
- using open_subset_interior[of S "UNIV - T"]
- using interior_subset[of "UNIV - T"]
- unfolding closure_interior
- by auto
-
-lemma open_inter_closure_subset:
- "open S \<Longrightarrow> (S \<inter> (closure T)) \<subseteq> closure(S \<inter> T)"
-proof
- fix x
- assume as: "open S" "x \<in> S \<inter> closure T"
- { assume *:"x islimpt T"
- have "x islimpt (S \<inter> T)"
- proof (rule islimptI)
- fix A
- assume "x \<in> A" "open A"
- with as have "x \<in> A \<inter> S" "open (A \<inter> S)"
- by (simp_all add: open_Int)
- with * obtain y where "y \<in> T" "y \<in> A \<inter> S" "y \<noteq> x"
- by (rule islimptE)
- hence "y \<in> S \<inter> T" "y \<in> A \<and> y \<noteq> x"
- by simp_all
- thus "\<exists>y\<in>(S \<inter> T). y \<in> A \<and> y \<noteq> x" ..
- qed
- }
- then show "x \<in> closure (S \<inter> T)" using as
- unfolding closure_def
- by blast
-qed
-
-lemma closure_complement: "closure(UNIV - S) = UNIV - interior(S)"
-proof-
- have "S = UNIV - (UNIV - S)"
- by auto
- thus ?thesis
- unfolding closure_interior
- by auto
-qed
-
-lemma interior_complement: "interior(UNIV - S) = UNIV - closure(S)"
- unfolding closure_interior
- by blast
-
-subsection{* Frontier (aka boundary) *}
-
-definition "frontier S = closure S - interior S"
-
-lemma frontier_closed: "closed(frontier S)"
- by (simp add: frontier_def closed_Diff)
-
-lemma frontier_closures: "frontier S = (closure S) \<inter> (closure(UNIV - S))"
- by (auto simp add: frontier_def interior_closure)
-
-lemma frontier_straddle:
- fixes a :: "'a::metric_space"
- 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")
-proof
- assume "?lhs"
- { fix e::real
- assume "e > 0"
- let ?rhse = "(\<exists>x\<in>S. dist a x < e) \<and> (\<exists>x. x \<notin> S \<and> dist a x < e)"
- { assume "a\<in>S"
- have "\<exists>x\<in>S. dist a x < e" using `e>0` `a\<in>S` by(rule_tac x=a in bexI) auto
- moreover have "\<exists>x. x \<notin> S \<and> dist a x < e" using `?lhs` `a\<in>S`
- unfolding frontier_closures closure_def islimpt_def using `e>0`
- by (auto, erule_tac x="ball a e" in allE, auto)
- ultimately have ?rhse by auto
- }
- moreover
- { assume "a\<notin>S"
- hence ?rhse using `?lhs`
- unfolding frontier_closures closure_def islimpt_def
- using open_ball[of a e] `e > 0`
- by (auto, erule_tac x = "ball a e" in allE, auto) (* FIXME: VERY slow! *)
- }
- ultimately have ?rhse by auto
- }
- thus ?rhs by auto
-next
- assume ?rhs
- moreover
- { fix T assume "a\<notin>S" and
- 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"
- from `open T` `a \<in> T` have "\<exists>e>0. ball a e \<subseteq> T" unfolding open_contains_ball[of T] by auto
- then obtain e where "e>0" "ball a e \<subseteq> T" by auto
- then obtain y where y:"y\<in>S" "dist a y < e" using as(1) by auto
- have "\<exists>y\<in>S. y \<in> T \<and> y \<noteq> a"
- using `dist a y < e` `ball a e \<subseteq> T` unfolding ball_def using `y\<in>S` `a\<notin>S` by auto
- }
- hence "a \<in> closure S" unfolding closure_def islimpt_def using `?rhs` by auto
- moreover
- { fix T assume "a \<in> T" "open T" "a\<in>S"
- then obtain e where "e>0" and balle: "ball a e \<subseteq> T" unfolding open_contains_ball using `?rhs` by auto
- obtain x where "x \<notin> S" "dist a x < e" using `?rhs` using `e>0` by auto
- 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
- }
- hence "a islimpt (UNIV - S) \<or> a\<notin>S" unfolding islimpt_def by auto
- ultimately show ?lhs unfolding frontier_closures using closure_def[of "UNIV - S"] by auto
-qed
-
-lemma frontier_subset_closed: "closed S \<Longrightarrow> frontier S \<subseteq> S"
- by (metis frontier_def closure_closed Diff_subset)
-
-lemma frontier_empty: "frontier {} = {}"
- by (simp add: frontier_def closure_empty)
-
-lemma frontier_subset_eq: "frontier S \<subseteq> S \<longleftrightarrow> closed S"
-proof-
- { assume "frontier S \<subseteq> S"
- hence "closure S \<subseteq> S" using interior_subset unfolding frontier_def by auto
- hence "closed S" using closure_subset_eq by auto
- }
- thus ?thesis using frontier_subset_closed[of S] by auto
-qed
-
-lemma frontier_complement: "frontier(UNIV - S) = frontier S"
- by (auto simp add: frontier_def closure_complement interior_complement)
-
-lemma frontier_disjoint_eq: "frontier S \<inter> S = {} \<longleftrightarrow> open S"
- using frontier_complement frontier_subset_eq[of "UNIV - S"]
- unfolding open_closed Compl_eq_Diff_UNIV by auto
-
-subsection{* Common nets and The "within" modifier for nets. *}
-
-definition
- at_infinity :: "'a::real_normed_vector net" where
- "at_infinity = Abs_net (range (\<lambda>r. {x. r \<le> norm x}))"
-
-definition
- indirection :: "'a::real_normed_vector \<Rightarrow> 'a \<Rightarrow> 'a net" (infixr "indirection" 70) where
- "a indirection v = (at a) within {b. \<exists>c\<ge>0. b - a = scaleR c v}"
-
-text{* Prove That They are all nets. *}
-
-lemma Rep_net_at_infinity:
- "Rep_net at_infinity = range (\<lambda>r. {x. r \<le> norm x})"
-unfolding at_infinity_def
-apply (rule Abs_net_inverse')
-apply (rule image_nonempty, simp)
-apply (clarsimp, rename_tac r s)
-apply (rule_tac x="max r s" in exI, auto)
-done
-
-lemma within_UNIV: "net within UNIV = net"
- by (simp add: Rep_net_inject [symmetric] Rep_net_within)
-
-subsection{* Identify Trivial limits, where we can't approach arbitrarily closely. *}
-
-definition
- trivial_limit :: "'a net \<Rightarrow> bool" where
- "trivial_limit net \<longleftrightarrow> {} \<in> Rep_net net"
-
-lemma trivial_limit_within:
- shows "trivial_limit (at a within S) \<longleftrightarrow> \<not> a islimpt S"
-proof
- assume "trivial_limit (at a within S)"
- thus "\<not> a islimpt S"
- unfolding trivial_limit_def
- unfolding Rep_net_within Rep_net_at
- unfolding islimpt_def
- apply (clarsimp simp add: expand_set_eq)
- apply (rename_tac T, rule_tac x=T in exI)
- apply (clarsimp, drule_tac x=y in spec, simp)
- done
-next
- assume "\<not> a islimpt S"
- thus "trivial_limit (at a within S)"
- unfolding trivial_limit_def
- unfolding Rep_net_within Rep_net_at
- unfolding islimpt_def
- apply (clarsimp simp add: image_image)
- apply (rule_tac x=T in image_eqI)
- apply (auto simp add: expand_set_eq)
- done
-qed
-
-lemma trivial_limit_at_iff: "trivial_limit (at a) \<longleftrightarrow> \<not> a islimpt UNIV"
- using trivial_limit_within [of a UNIV]
- by (simp add: within_UNIV)
-
-lemma trivial_limit_at:
- fixes a :: "'a::perfect_space"
- shows "\<not> trivial_limit (at a)"
- by (simp add: trivial_limit_at_iff)
-
-lemma trivial_limit_at_infinity:
- "\<not> trivial_limit (at_infinity :: ('a::{real_normed_vector,zero_neq_one}) net)"
- (* FIXME: find a more appropriate type class *)
- unfolding trivial_limit_def Rep_net_at_infinity
- apply (clarsimp simp add: expand_set_eq)
- apply (drule_tac x="scaleR r (sgn 1)" in spec)
- apply (simp add: norm_sgn)
- done
-
-lemma trivial_limit_sequentially: "\<not> trivial_limit sequentially"
- by (auto simp add: trivial_limit_def Rep_net_sequentially)
-
-subsection{* Some property holds "sufficiently close" to the limit point. *}
-
-lemma eventually_at: (* FIXME: this replaces Limits.eventually_at *)
- "eventually P (at a) \<longleftrightarrow> (\<exists>d>0. \<forall>x. 0 < dist x a \<and> dist x a < d \<longrightarrow> P x)"
-unfolding eventually_at dist_nz by auto
-
-lemma eventually_at_infinity:
- "eventually P at_infinity \<longleftrightarrow> (\<exists>b. \<forall>x. norm x >= b \<longrightarrow> P x)"
-unfolding eventually_def Rep_net_at_infinity by auto
-
-lemma eventually_within: "eventually P (at a within S) \<longleftrightarrow>
- (\<exists>d>0. \<forall>x\<in>S. 0 < dist x a \<and> dist x a < d \<longrightarrow> P x)"
-unfolding eventually_within eventually_at dist_nz by auto
-
-lemma eventually_within_le: "eventually P (at a within S) \<longleftrightarrow>
- (\<exists>d>0. \<forall>x\<in>S. 0 < dist x a \<and> dist x a <= d \<longrightarrow> P x)" (is "?lhs = ?rhs")
-unfolding eventually_within
-apply safe
-apply (rule_tac x="d/2" in exI, simp)
-apply (rule_tac x="d" in exI, simp)
-done
-
-lemma eventually_happens: "eventually P net ==> trivial_limit net \<or> (\<exists>x. P x)"
- unfolding eventually_def trivial_limit_def
- using Rep_net_nonempty [of net] by auto
-
-lemma always_eventually: "(\<forall>x. P x) ==> eventually P net"
- unfolding eventually_def trivial_limit_def
- using Rep_net_nonempty [of net] by auto
-
-lemma trivial_limit_eventually: "trivial_limit net \<Longrightarrow> eventually P net"
- unfolding trivial_limit_def eventually_def by auto
-
-lemma eventually_False: "eventually (\<lambda>x. False) net \<longleftrightarrow> trivial_limit net"
- unfolding trivial_limit_def eventually_def by auto
-
-lemma trivial_limit_eq: "trivial_limit net \<longleftrightarrow> (\<forall>P. eventually P net)"
- apply (safe elim!: trivial_limit_eventually)
- apply (simp add: eventually_False [symmetric])
- done
-
-text{* Combining theorems for "eventually" *}
-
-lemma eventually_conjI:
- "\<lbrakk>eventually (\<lambda>x. P x) net; eventually (\<lambda>x. Q x) net\<rbrakk>
- \<Longrightarrow> eventually (\<lambda>x. P x \<and> Q x) net"
-by (rule eventually_conj)
-
-lemma eventually_rev_mono:
- "eventually P net \<Longrightarrow> (\<forall>x. P x \<longrightarrow> Q x) \<Longrightarrow> eventually Q net"
-using eventually_mono [of P Q] by fast
-
-lemma eventually_and: " eventually (\<lambda>x. P x \<and> Q x) net \<longleftrightarrow> eventually P net \<and> eventually Q net"
- by (auto intro!: eventually_conjI elim: eventually_rev_mono)
-
-lemma eventually_false: "eventually (\<lambda>x. False) net \<longleftrightarrow> trivial_limit net"
- by (auto simp add: eventually_False)
-
-lemma not_eventually: "(\<forall>x. \<not> P x ) \<Longrightarrow> ~(trivial_limit net) ==> ~(eventually (\<lambda>x. P x) net)"
- by (simp add: eventually_False)
-
-subsection{* Limits, defined as vacuously true when the limit is trivial. *}
-
- text{* Notation Lim to avoid collition with lim defined in analysis *}
-definition
- Lim :: "'a net \<Rightarrow> ('a \<Rightarrow> 'b::t2_space) \<Rightarrow> 'b" where
- "Lim net f = (THE l. (f ---> l) net)"
-
-lemma Lim:
- "(f ---> l) net \<longleftrightarrow>
- trivial_limit net \<or>
- (\<forall>e>0. eventually (\<lambda>x. dist (f x) l < e) net)"
- unfolding tendsto_iff trivial_limit_eq by auto
-
-
-text{* Show that they yield usual definitions in the various cases. *}
-
-lemma Lim_within_le: "(f ---> l)(at a within S) \<longleftrightarrow>
- (\<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)"
- by (auto simp add: tendsto_iff eventually_within_le)
-
-lemma Lim_within: "(f ---> l) (at a within S) \<longleftrightarrow>
- (\<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)"
- by (auto simp add: tendsto_iff eventually_within)
-
-lemma Lim_at: "(f ---> l) (at a) \<longleftrightarrow>
- (\<forall>e >0. \<exists>d>0. \<forall>x. 0 < dist x a \<and> dist x a < d \<longrightarrow> dist (f x) l < e)"
- by (auto simp add: tendsto_iff eventually_at)
-
-lemma Lim_at_iff_LIM: "(f ---> l) (at a) \<longleftrightarrow> f -- a --> l"
- unfolding Lim_at LIM_def by (simp only: zero_less_dist_iff)
-
-lemma Lim_at_infinity:
- "(f ---> l) at_infinity \<longleftrightarrow> (\<forall>e>0. \<exists>b. \<forall>x. norm x >= b \<longrightarrow> dist (f x) l < e)"
- by (auto simp add: tendsto_iff eventually_at_infinity)
-
-lemma Lim_sequentially:
- "(S ---> l) sequentially \<longleftrightarrow>
- (\<forall>e>0. \<exists>N. \<forall>n\<ge>N. dist (S n) l < e)"
- by (auto simp add: tendsto_iff eventually_sequentially)
-
-lemma Lim_sequentially_iff_LIMSEQ: "(S ---> l) sequentially \<longleftrightarrow> S ----> l"
- unfolding Lim_sequentially LIMSEQ_def ..
-
-lemma Lim_eventually: "eventually (\<lambda>x. f x = l) net \<Longrightarrow> (f ---> l) net"
- by (rule topological_tendstoI, auto elim: eventually_rev_mono)
-
-text{* The expected monotonicity property. *}
-
-lemma Lim_within_empty: "(f ---> l) (net within {})"
- unfolding tendsto_def Limits.eventually_within by simp
-
-lemma Lim_within_subset: "(f ---> l) (net within S) \<Longrightarrow> T \<subseteq> S \<Longrightarrow> (f ---> l) (net within T)"
- unfolding tendsto_def Limits.eventually_within
- by (auto elim!: eventually_elim1)
-
-lemma Lim_Un: assumes "(f ---> l) (net within S)" "(f ---> l) (net within T)"
- shows "(f ---> l) (net within (S \<union> T))"
- using assms unfolding tendsto_def Limits.eventually_within
- apply clarify
- apply (drule spec, drule (1) mp, drule (1) mp)
- apply (drule spec, drule (1) mp, drule (1) mp)
- apply (auto elim: eventually_elim2)
- done
-
-lemma Lim_Un_univ:
- "(f ---> l) (net within S) \<Longrightarrow> (f ---> l) (net within T) \<Longrightarrow> S \<union> T = UNIV
- ==> (f ---> l) net"
- by (metis Lim_Un within_UNIV)
-
-text{* Interrelations between restricted and unrestricted limits. *}
-
-lemma Lim_at_within: "(f ---> l) net ==> (f ---> l)(net within S)"
- (* FIXME: rename *)
- unfolding tendsto_def Limits.eventually_within
- apply (clarify, drule spec, drule (1) mp, drule (1) mp)
- by (auto elim!: eventually_elim1)
-
-lemma Lim_within_open:
- fixes f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
- assumes"a \<in> S" "open S"
- shows "(f ---> l)(at a within S) \<longleftrightarrow> (f ---> l)(at a)" (is "?lhs \<longleftrightarrow> ?rhs")
-proof
- assume ?lhs
- { fix A assume "open A" "l \<in> A"
- with `?lhs` have "eventually (\<lambda>x. f x \<in> A) (at a within S)"
- by (rule topological_tendstoD)
- hence "eventually (\<lambda>x. x \<in> S \<longrightarrow> f x \<in> A) (at a)"
- unfolding Limits.eventually_within .
- 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"
- unfolding eventually_at_topological by fast
- hence "open (T \<inter> S)" "a \<in> T \<inter> S" "\<forall>x\<in>(T \<inter> S). x \<noteq> a \<longrightarrow> f x \<in> A"
- using assms by auto
- hence "\<exists>T. open T \<and> a \<in> T \<and> (\<forall>x\<in>T. x \<noteq> a \<longrightarrow> f x \<in> A)"
- by fast
- hence "eventually (\<lambda>x. f x \<in> A) (at a)"
- unfolding eventually_at_topological .
- }
- thus ?rhs by (rule topological_tendstoI)
-next
- assume ?rhs
- thus ?lhs by (rule Lim_at_within)
-qed
-
-text{* Another limit point characterization. *}
-
-lemma islimpt_sequential:
- fixes x :: "'a::metric_space" (* FIXME: generalize to topological_space *)
- shows "x islimpt S \<longleftrightarrow> (\<exists>f. (\<forall>n::nat. f n \<in> S -{x}) \<and> (f ---> x) sequentially)"
- (is "?lhs = ?rhs")
-proof
- assume ?lhs
- 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"
- 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
- { fix n::nat
- have "f (inverse (real n + 1)) \<in> S - {x}" using f by auto
- }
- moreover
- { fix e::real assume "e>0"
- 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
- then obtain N::nat where "inverse (real (N + 1)) < e" by auto
- 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)
- moreover have "\<forall>n\<ge>N. dist (f (inverse (real n + 1))) x < (inverse (real n + 1))" using f `e>0` by auto
- 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
- }
- hence " ((\<lambda>n. f (inverse (real n + 1))) ---> x) sequentially"
- unfolding Lim_sequentially using f by auto
- ultimately show ?rhs apply (rule_tac x="(\<lambda>n::nat. f (inverse (real n + 1)))" in exI) by auto
-next
- assume ?rhs
- 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
- { fix e::real assume "e>0"
- then obtain N where "dist (f N) x < e" using f(2) by auto
- moreover have "f N\<in>S" "f N \<noteq> x" using f(1) by auto
- ultimately have "\<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e" by auto
- }
- thus ?lhs unfolding islimpt_approachable by auto
-qed
-
-text{* Basic arithmetical combining theorems for limits. *}
-
-lemma Lim_linear:
- assumes "(f ---> l) net" "bounded_linear h"
- shows "((\<lambda>x. h (f x)) ---> h l) net"
-using `bounded_linear h` `(f ---> l) net`
-by (rule bounded_linear.tendsto)
-
-lemma Lim_ident_at: "((\<lambda>x. x) ---> a) (at a)"
- unfolding tendsto_def Limits.eventually_at_topological by fast
-
-lemma Lim_const: "((\<lambda>x. a) ---> a) net"
- by (rule tendsto_const)
-
-lemma Lim_cmul:
- fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
- shows "(f ---> l) net ==> ((\<lambda>x. c *\<^sub>R f x) ---> c *\<^sub>R l) net"
- by (intro tendsto_intros)
-
-lemma Lim_neg:
- fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
- shows "(f ---> l) net ==> ((\<lambda>x. -(f x)) ---> -l) net"
- by (rule tendsto_minus)
-
-lemma Lim_add: fixes f :: "'a \<Rightarrow> 'b::real_normed_vector" shows
- "(f ---> l) net \<Longrightarrow> (g ---> m) net \<Longrightarrow> ((\<lambda>x. f(x) + g(x)) ---> l + m) net"
- by (rule tendsto_add)
-
-lemma Lim_sub:
- fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
- shows "(f ---> l) net \<Longrightarrow> (g ---> m) net \<Longrightarrow> ((\<lambda>x. f(x) - g(x)) ---> l - m) net"
- by (rule tendsto_diff)
-
-lemma Lim_null:
- fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
- shows "(f ---> l) net \<longleftrightarrow> ((\<lambda>x. f(x) - l) ---> 0) net" by (simp add: Lim dist_norm)
-
-lemma Lim_null_norm:
- fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
- shows "(f ---> 0) net \<longleftrightarrow> ((\<lambda>x. norm(f x)) ---> 0) net"
- by (simp add: Lim dist_norm)
-
-lemma Lim_null_comparison:
- fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
- assumes "eventually (\<lambda>x. norm (f x) \<le> g x) net" "(g ---> 0) net"
- shows "(f ---> 0) net"
-proof(simp add: tendsto_iff, rule+)
- fix e::real assume "0<e"
- { fix x
- assume "norm (f x) \<le> g x" "dist (g x) 0 < e"
- hence "dist (f x) 0 < e" by (simp add: dist_norm)
- }
- thus "eventually (\<lambda>x. dist (f x) 0 < e) net"
- using eventually_and[of "\<lambda>x. norm(f x) <= g x" "\<lambda>x. dist (g x) 0 < e" net]
- 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]
- using assms `e>0` unfolding tendsto_iff by auto
-qed
-
-lemma Lim_component:
- fixes f :: "'a \<Rightarrow> 'b::metric_space ^ 'n::finite"
- shows "(f ---> l) net \<Longrightarrow> ((\<lambda>a. f a $i) ---> l$i) net"
- unfolding tendsto_iff
- apply (clarify)
- apply (drule spec, drule (1) mp)
- apply (erule eventually_elim1)
- apply (erule le_less_trans [OF dist_nth_le])
- done
-
-lemma Lim_transform_bound:
- fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
- fixes g :: "'a \<Rightarrow> 'c::real_normed_vector"
- assumes "eventually (\<lambda>n. norm(f n) <= norm(g n)) net" "(g ---> 0) net"
- shows "(f ---> 0) net"
-proof (rule tendstoI)
- fix e::real assume "e>0"
- { fix x
- assume "norm (f x) \<le> norm (g x)" "dist (g x) 0 < e"
- hence "dist (f x) 0 < e" by (simp add: dist_norm)}
- thus "eventually (\<lambda>x. dist (f x) 0 < e) net"
- using eventually_and[of "\<lambda>x. norm (f x) \<le> norm (g x)" "\<lambda>x. dist (g x) 0 < e" net]
- 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]
- using assms `e>0` unfolding tendsto_iff by blast
-qed
-
-text{* Deducing things about the limit from the elements. *}
-
-lemma Lim_in_closed_set:
- assumes "closed S" "eventually (\<lambda>x. f(x) \<in> S) net" "\<not>(trivial_limit net)" "(f ---> l) net"
- shows "l \<in> S"
-proof (rule ccontr)
- assume "l \<notin> S"
- with `closed S` have "open (- S)" "l \<in> - S"
- by (simp_all add: open_Compl)
- with assms(4) have "eventually (\<lambda>x. f x \<in> - S) net"
- by (rule topological_tendstoD)
- with assms(2) have "eventually (\<lambda>x. False) net"
- by (rule eventually_elim2) simp
- with assms(3) show "False"
- by (simp add: eventually_False)
-qed
-
-text{* Need to prove closed(cball(x,e)) before deducing this as a corollary. *}
-
-lemma Lim_dist_ubound:
- assumes "\<not>(trivial_limit net)" "(f ---> l) net" "eventually (\<lambda>x. dist a (f x) <= e) net"
- shows "dist a l <= e"
-proof (rule ccontr)
- assume "\<not> dist a l \<le> e"
- then have "0 < dist a l - e" by simp
- with assms(2) have "eventually (\<lambda>x. dist (f x) l < dist a l - e) net"
- by (rule tendstoD)
- with assms(3) have "eventually (\<lambda>x. dist a (f x) \<le> e \<and> dist (f x) l < dist a l - e) net"
- by (rule eventually_conjI)
- then obtain w where "dist a (f w) \<le> e" "dist (f w) l < dist a l - e"
- using assms(1) eventually_happens by auto
- hence "dist a (f w) + dist (f w) l < e + (dist a l - e)"
- by (rule add_le_less_mono)
- hence "dist a (f w) + dist (f w) l < dist a l"
- by simp
- also have "\<dots> \<le> dist a (f w) + dist (f w) l"
- by (rule dist_triangle)
- finally show False by simp
-qed
-
-lemma Lim_norm_ubound:
- fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
- assumes "\<not>(trivial_limit net)" "(f ---> l) net" "eventually (\<lambda>x. norm(f x) <= e) net"
- shows "norm(l) <= e"
-proof (rule ccontr)
- assume "\<not> norm l \<le> e"
- then have "0 < norm l - e" by simp
- with assms(2) have "eventually (\<lambda>x. dist (f x) l < norm l - e) net"
- by (rule tendstoD)
- with assms(3) have "eventually (\<lambda>x. norm (f x) \<le> e \<and> dist (f x) l < norm l - e) net"
- by (rule eventually_conjI)
- then obtain w where "norm (f w) \<le> e" "dist (f w) l < norm l - e"
- using assms(1) eventually_happens by auto
- hence "norm (f w - l) < norm l - e" "norm (f w) \<le> e" by (simp_all add: dist_norm)
- hence "norm (f w - l) + norm (f w) < norm l" by simp
- hence "norm (f w - l - f w) < norm l" by (rule le_less_trans [OF norm_triangle_ineq4])
- thus False using `\<not> norm l \<le> e` by simp
-qed
-
-lemma Lim_norm_lbound:
- fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
- assumes "\<not> (trivial_limit net)" "(f ---> l) net" "eventually (\<lambda>x. e <= norm(f x)) net"
- shows "e \<le> norm l"
-proof (rule ccontr)
- assume "\<not> e \<le> norm l"
- then have "0 < e - norm l" by simp
- with assms(2) have "eventually (\<lambda>x. dist (f x) l < e - norm l) net"
- by (rule tendstoD)
- with assms(3) have "eventually (\<lambda>x. e \<le> norm (f x) \<and> dist (f x) l < e - norm l) net"
- by (rule eventually_conjI)
- then obtain w where "e \<le> norm (f w)" "dist (f w) l < e - norm l"
- using assms(1) eventually_happens by auto
- hence "norm (f w - l) + norm l < e" "e \<le> norm (f w)" by (simp_all add: dist_norm)
- hence "norm (f w - l) + norm l < norm (f w)" by (rule less_le_trans)
- hence "norm (f w - l + l) < norm (f w)" by (rule le_less_trans [OF norm_triangle_ineq])
- thus False by simp
-qed
-
-text{* Uniqueness of the limit, when nontrivial. *}
-
-lemma Lim_unique:
- fixes f :: "'a \<Rightarrow> 'b::t2_space"
- assumes "\<not> trivial_limit net" "(f ---> l) net" "(f ---> l') net"
- shows "l = l'"
-proof (rule ccontr)
- assume "l \<noteq> l'"
- obtain U V where "open U" "open V" "l \<in> U" "l' \<in> V" "U \<inter> V = {}"
- using hausdorff [OF `l \<noteq> l'`] by fast
- have "eventually (\<lambda>x. f x \<in> U) net"
- using `(f ---> l) net` `open U` `l \<in> U` by (rule topological_tendstoD)
- moreover
- have "eventually (\<lambda>x. f x \<in> V) net"
- using `(f ---> l') net` `open V` `l' \<in> V` by (rule topological_tendstoD)
- ultimately
- have "eventually (\<lambda>x. False) net"
- proof (rule eventually_elim2)
- fix x
- assume "f x \<in> U" "f x \<in> V"
- hence "f x \<in> U \<inter> V" by simp
- with `U \<inter> V = {}` show "False" by simp
- qed
- with `\<not> trivial_limit net` show "False"
- by (simp add: eventually_False)
-qed
-
-lemma tendsto_Lim:
- fixes f :: "'a \<Rightarrow> 'b::t2_space"
- shows "~(trivial_limit net) \<Longrightarrow> (f ---> l) net ==> Lim net f = l"
- unfolding Lim_def using Lim_unique[of net f] by auto
-
-text{* Limit under bilinear function *}
-
-lemma Lim_bilinear:
- assumes "(f ---> l) net" and "(g ---> m) net" and "bounded_bilinear h"
- shows "((\<lambda>x. h (f x) (g x)) ---> (h l m)) net"
-using `bounded_bilinear h` `(f ---> l) net` `(g ---> m) net`
-by (rule bounded_bilinear.tendsto)
-
-text{* These are special for limits out of the same vector space. *}
-
-lemma Lim_within_id: "(id ---> a) (at a within s)"
- unfolding tendsto_def Limits.eventually_within eventually_at_topological
- by auto
-
-lemma Lim_at_id: "(id ---> a) (at a)"
-apply (subst within_UNIV[symmetric]) by (simp add: Lim_within_id)
-
-lemma Lim_at_zero:
- fixes a :: "'a::real_normed_vector"
- fixes l :: "'b::topological_space"
- shows "(f ---> l) (at a) \<longleftrightarrow> ((\<lambda>x. f(a + x)) ---> l) (at 0)" (is "?lhs = ?rhs")
-proof
- assume "?lhs"
- { fix S assume "open S" "l \<in> S"
- with `?lhs` have "eventually (\<lambda>x. f x \<in> S) (at a)"
- by (rule topological_tendstoD)
- then obtain d where d: "d>0" "\<forall>x. x \<noteq> a \<and> dist x a < d \<longrightarrow> f x \<in> S"
- unfolding Limits.eventually_at by fast
- { fix x::"'a" assume "x \<noteq> 0 \<and> dist x 0 < d"
- hence "f (a + x) \<in> S" using d
- apply(erule_tac x="x+a" in allE)
- by(auto simp add: comm_monoid_add.mult_commute dist_norm dist_commute)
- }
- hence "\<exists>d>0. \<forall>x. x \<noteq> 0 \<and> dist x 0 < d \<longrightarrow> f (a + x) \<in> S"
- using d(1) by auto
- hence "eventually (\<lambda>x. f (a + x) \<in> S) (at 0)"
- unfolding Limits.eventually_at .
- }
- thus "?rhs" by (rule topological_tendstoI)
-next
- assume "?rhs"
- { fix S assume "open S" "l \<in> S"
- with `?rhs` have "eventually (\<lambda>x. f (a + x) \<in> S) (at 0)"
- by (rule topological_tendstoD)
- then obtain d where d: "d>0" "\<forall>x. x \<noteq> 0 \<and> dist x 0 < d \<longrightarrow> f (a + x) \<in> S"
- unfolding Limits.eventually_at by fast
- { fix x::"'a" assume "x \<noteq> a \<and> dist x a < d"
- hence "f x \<in> S" using d apply(erule_tac x="x-a" in allE)
- by(auto simp add: comm_monoid_add.mult_commute dist_norm dist_commute)
- }
- hence "\<exists>d>0. \<forall>x. x \<noteq> a \<and> dist x a < d \<longrightarrow> f x \<in> S" using d(1) by auto
- hence "eventually (\<lambda>x. f x \<in> S) (at a)" unfolding Limits.eventually_at .
- }
- thus "?lhs" by (rule topological_tendstoI)
-qed
-
-text{* It's also sometimes useful to extract the limit point from the net. *}
-
-definition
- netlimit :: "'a::t2_space net \<Rightarrow> 'a" where
- "netlimit net = (SOME a. ((\<lambda>x. x) ---> a) net)"
-
-lemma netlimit_within:
- assumes "\<not> trivial_limit (at a within S)"
- shows "netlimit (at a within S) = a"
-unfolding netlimit_def
-apply (rule some_equality)
-apply (rule Lim_at_within)
-apply (rule Lim_ident_at)
-apply (erule Lim_unique [OF assms])
-apply (rule Lim_at_within)
-apply (rule Lim_ident_at)
-done
-
-lemma netlimit_at:
- fixes a :: "'a::perfect_space"
- shows "netlimit (at a) = a"
- apply (subst within_UNIV[symmetric])
- using netlimit_within[of a UNIV]
- by (simp add: trivial_limit_at within_UNIV)
-
-text{* Transformation of limit. *}
-
-lemma Lim_transform:
- fixes f g :: "'a::type \<Rightarrow> 'b::real_normed_vector"
- assumes "((\<lambda>x. f x - g x) ---> 0) net" "(f ---> l) net"
- shows "(g ---> l) net"
-proof-
- 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
- thus "?thesis" using Lim_neg [of "\<lambda> x. - g x" "-l" net] by auto
-qed
-
-lemma Lim_transform_eventually:
- "eventually (\<lambda>x. f x = g x) net \<Longrightarrow> (f ---> l) net ==> (g ---> l) net"
- apply (rule topological_tendstoI)
- apply (drule (2) topological_tendstoD)
- apply (erule (1) eventually_elim2, simp)
- done
-
-lemma Lim_transform_within:
- fixes l :: "'b::metric_space" (* TODO: generalize *)
- assumes "0 < d" "(\<forall>x'\<in>S. 0 < dist x' x \<and> dist x' x < d \<longrightarrow> f x' = g x')"
- "(f ---> l) (at x within S)"
- shows "(g ---> l) (at x within S)"
- using assms(1,3) unfolding Lim_within
- apply -
- apply (clarify, rename_tac e)
- apply (drule_tac x=e in spec, clarsimp, rename_tac r)
- apply (rule_tac x="min d r" in exI, clarsimp, rename_tac y)
- apply (drule_tac x=y in bspec, assumption, clarsimp)
- apply (simp add: assms(2))
- done
-
-lemma Lim_transform_at:
- fixes l :: "'b::metric_space" (* TODO: generalize *)
- shows "0 < d \<Longrightarrow> (\<forall>x'. 0 < dist x' x \<and> dist x' x < d \<longrightarrow> f x' = g x') \<Longrightarrow>
- (f ---> l) (at x) ==> (g ---> l) (at x)"
- apply (subst within_UNIV[symmetric])
- using Lim_transform_within[of d UNIV x f g l]
- by (auto simp add: within_UNIV)
-
-text{* Common case assuming being away from some crucial point like 0. *}
-
-lemma Lim_transform_away_within:
- fixes a b :: "'a::metric_space"
- fixes l :: "'b::metric_space" (* TODO: generalize *)
- assumes "a\<noteq>b" "\<forall>x\<in> S. x \<noteq> a \<and> x \<noteq> b \<longrightarrow> f x = g x"
- and "(f ---> l) (at a within S)"
- shows "(g ---> l) (at a within S)"
-proof-
- have "\<forall>x'\<in>S. 0 < dist x' a \<and> dist x' a < dist a b \<longrightarrow> f x' = g x'" using assms(2)
- apply auto apply(erule_tac x=x' in ballE) by (auto simp add: dist_commute)
- thus ?thesis using Lim_transform_within[of "dist a b" S a f g l] using assms(1,3) unfolding dist_nz by auto
-qed
-
-lemma Lim_transform_away_at:
- fixes a b :: "'a::metric_space"
- fixes l :: "'b::metric_space" (* TODO: generalize *)
- assumes ab: "a\<noteq>b" and fg: "\<forall>x. x \<noteq> a \<and> x \<noteq> b \<longrightarrow> f x = g x"
- and fl: "(f ---> l) (at a)"
- shows "(g ---> l) (at a)"
- using Lim_transform_away_within[OF ab, of UNIV f g l] fg fl
- by (auto simp add: within_UNIV)
-
-text{* Alternatively, within an open set. *}
-
-lemma Lim_transform_within_open:
- fixes a :: "'a::metric_space"
- fixes l :: "'b::metric_space" (* TODO: generalize *)
- assumes "open S" "a \<in> S" "\<forall>x\<in>S. x \<noteq> a \<longrightarrow> f x = g x" "(f ---> l) (at a)"
- shows "(g ---> l) (at a)"
-proof-
- from assms(1,2) obtain e::real where "e>0" and e:"ball a e \<subseteq> S" unfolding open_contains_ball by auto
- hence "\<forall>x'. 0 < dist x' a \<and> dist x' a < e \<longrightarrow> f x' = g x'" using assms(3)
- 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)
- thus ?thesis using Lim_transform_at[of e a f g l] `e>0` assms(4) by auto
-qed
-
-text{* A congruence rule allowing us to transform limits assuming not at point. *}
-
-(* FIXME: Only one congruence rule for tendsto can be used at a time! *)
-
-lemma Lim_cong_within[cong add]:
- fixes a :: "'a::metric_space"
- fixes l :: "'b::metric_space" (* TODO: generalize *)
- 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))"
- by (simp add: Lim_within dist_nz[symmetric])
-
-lemma Lim_cong_at[cong add]:
- fixes a :: "'a::metric_space"
- fixes l :: "'b::metric_space" (* TODO: generalize *)
- shows "(\<And>x. x \<noteq> a ==> f x = g x) ==> (((\<lambda>x. f x) ---> l) (at a) \<longleftrightarrow> ((g ---> l) (at a)))"
- by (simp add: Lim_at dist_nz[symmetric])
-
-text{* Useful lemmas on closure and set of possible sequential limits.*}
-
-lemma closure_sequential:
- fixes l :: "'a::metric_space" (* TODO: generalize *)
- shows "l \<in> closure S \<longleftrightarrow> (\<exists>x. (\<forall>n. x n \<in> S) \<and> (x ---> l) sequentially)" (is "?lhs = ?rhs")
-proof
- assume "?lhs" moreover
- { assume "l \<in> S"
- hence "?rhs" using Lim_const[of l sequentially] by auto
- } moreover
- { assume "l islimpt S"
- hence "?rhs" unfolding islimpt_sequential by auto
- } ultimately
- show "?rhs" unfolding closure_def by auto
-next
- assume "?rhs"
- thus "?lhs" unfolding closure_def unfolding islimpt_sequential by auto
-qed
-
-lemma closed_sequential_limits:
- fixes S :: "'a::metric_space set"
- shows "closed S \<longleftrightarrow> (\<forall>x l. (\<forall>n. x n \<in> S) \<and> (x ---> l) sequentially \<longrightarrow> l \<in> S)"
- unfolding closed_limpt
- 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]
- by metis
-
-lemma closure_approachable:
- fixes S :: "'a::metric_space set"
- shows "x \<in> closure S \<longleftrightarrow> (\<forall>e>0. \<exists>y\<in>S. dist y x < e)"
- apply (auto simp add: closure_def islimpt_approachable)
- by (metis dist_self)
-
-lemma closed_approachable:
- fixes S :: "'a::metric_space set"
- shows "closed S ==> (\<forall>e>0. \<exists>y\<in>S. dist y x < e) \<longleftrightarrow> x \<in> S"
- by (metis closure_closed closure_approachable)
-
-text{* Some other lemmas about sequences. *}
-
-lemma seq_offset:
- fixes l :: "'a::metric_space" (* TODO: generalize *)
- shows "(f ---> l) sequentially ==> ((\<lambda>i. f( i + k)) ---> l) sequentially"
- apply (auto simp add: Lim_sequentially)
- by (metis trans_le_add1 )
-
-lemma seq_offset_neg:
- "(f ---> l) sequentially ==> ((\<lambda>i. f(i - k)) ---> l) sequentially"
- apply (rule topological_tendstoI)
- apply (drule (2) topological_tendstoD)
- apply (simp only: eventually_sequentially)
- apply (subgoal_tac "\<And>N k (n::nat). N + k <= n ==> N <= n - k")
- apply metis
- by arith
-
-lemma seq_offset_rev:
- "((\<lambda>i. f(i + k)) ---> l) sequentially ==> (f ---> l) sequentially"
- apply (rule topological_tendstoI)
- apply (drule (2) topological_tendstoD)
- apply (simp only: eventually_sequentially)
- apply (subgoal_tac "\<And>N k (n::nat). N + k <= n ==> N <= n - k \<and> (n - k) + k = n")
- by metis arith
-
-lemma seq_harmonic: "((\<lambda>n. inverse (real n)) ---> 0) sequentially"
-proof-
- { fix e::real assume "e>0"
- hence "\<exists>N::nat. \<forall>n::nat\<ge>N. inverse (real n) < e"
- using real_arch_inv[of e] apply auto apply(rule_tac x=n in exI)
- by (metis not_le le_imp_inverse_le not_less real_of_nat_gt_zero_cancel_iff real_of_nat_less_iff xt1(7))
- }
- thus ?thesis unfolding Lim_sequentially dist_norm by simp
-qed
-
-text{* More properties of closed balls. *}
-
-lemma closed_cball: "closed (cball x e)"
-unfolding cball_def closed_def
-unfolding Collect_neg_eq [symmetric] not_le
-apply (clarsimp simp add: open_dist, rename_tac y)
-apply (rule_tac x="dist x y - e" in exI, clarsimp)
-apply (rename_tac x')
-apply (cut_tac x=x and y=x' and z=y in dist_triangle)
-apply simp
-done
-
-lemma open_contains_cball: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. cball x e \<subseteq> S)"
-proof-
- { fix x and e::real assume "x\<in>S" "e>0" "ball x e \<subseteq> S"
- hence "\<exists>d>0. cball x d \<subseteq> S" unfolding subset_eq by (rule_tac x="e/2" in exI, auto)
- } moreover
- { fix x and e::real assume "x\<in>S" "e>0" "cball x e \<subseteq> S"
- hence "\<exists>d>0. ball x d \<subseteq> S" unfolding subset_eq apply(rule_tac x="e/2" in exI) by auto
- } ultimately
- show ?thesis unfolding open_contains_ball by auto
-qed
-
-lemma open_contains_cball_eq: "open S ==> (\<forall>x. x \<in> S \<longleftrightarrow> (\<exists>e>0. cball x e \<subseteq> S))"
- by (metis open_contains_cball subset_eq order_less_imp_le centre_in_cball mem_def)
-
-lemma mem_interior_cball: "x \<in> interior S \<longleftrightarrow> (\<exists>e>0. cball x e \<subseteq> S)"
- apply (simp add: interior_def, safe)
- apply (force simp add: open_contains_cball)
- apply (rule_tac x="ball x e" in exI)
- apply (simp add: open_ball centre_in_ball subset_trans [OF ball_subset_cball])
- done
-
-lemma islimpt_ball:
- fixes x y :: "'a::{real_normed_vector,perfect_space}"
- shows "y islimpt ball x e \<longleftrightarrow> 0 < e \<and> y \<in> cball x e" (is "?lhs = ?rhs")
-proof
- assume "?lhs"
- { assume "e \<le> 0"
- hence *:"ball x e = {}" using ball_eq_empty[of x e] by auto
- have False using `?lhs` unfolding * using islimpt_EMPTY[of y] by auto
- }
- hence "e > 0" by (metis not_less)
- moreover
- 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
- ultimately show "?rhs" by auto
-next
- assume "?rhs" hence "e>0" by auto
- { fix d::real assume "d>0"
- have "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
- proof(cases "d \<le> dist x y")
- case True thus "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
- proof(cases "x=y")
- case True hence False using `d \<le> dist x y` `d>0` by auto
- thus "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d" by auto
- next
- case False
-
- have "dist x (y - (d / (2 * dist y x)) *\<^sub>R (y - x))
- = norm (x - y + (d / (2 * norm (y - x))) *\<^sub>R (y - x))"
- unfolding mem_cball mem_ball dist_norm diff_diff_eq2 diff_add_eq[THEN sym] by auto
- also have "\<dots> = \<bar>- 1 + d / (2 * norm (x - y))\<bar> * norm (x - y)"
- using scaleR_left_distrib[of "- 1" "d / (2 * norm (y - x))", THEN sym, of "y - x"]
- unfolding scaleR_minus_left scaleR_one
- by (auto simp add: norm_minus_commute)
- also have "\<dots> = \<bar>- norm (x - y) + d / 2\<bar>"
- unfolding abs_mult_pos[of "norm (x - y)", OF norm_ge_zero[of "x - y"]]
- unfolding real_add_mult_distrib using `x\<noteq>y`[unfolded dist_nz, unfolded dist_norm] by auto
- also have "\<dots> \<le> e - d/2" using `d \<le> dist x y` and `d>0` and `?rhs` by(auto simp add: dist_norm)
- finally have "y - (d / (2 * dist y x)) *\<^sub>R (y - x) \<in> ball x e" using `d>0` by auto
-
- moreover
-
- have "(d / (2*dist y x)) *\<^sub>R (y - x) \<noteq> 0"
- using `x\<noteq>y`[unfolded dist_nz] `d>0` unfolding scaleR_eq_0_iff by (auto simp add: dist_commute)
- moreover
- have "dist (y - (d / (2 * dist y x)) *\<^sub>R (y - x)) y < d" unfolding dist_norm apply simp unfolding norm_minus_cancel
- using `d>0` `x\<noteq>y`[unfolded dist_nz] dist_commute[of x y]
- unfolding dist_norm by auto
- 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
- qed
- next
- case False hence "d > dist x y" by auto
- show "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
- proof(cases "x=y")
- case True
- obtain z where **: "z \<noteq> y" "dist z y < min e d"
- using perfect_choose_dist[of "min e d" y]
- using `d > 0` `e>0` by auto
- show "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
- unfolding `x = y`
- using `z \<noteq> y` **
- by (rule_tac x=z in bexI, auto simp add: dist_commute)
- next
- case False thus "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
- using `d>0` `d > dist x y` `?rhs` by(rule_tac x=x in bexI, auto)
- qed
- qed }
- thus "?lhs" unfolding mem_cball islimpt_approachable mem_ball by auto
-qed
-
-lemma closure_ball_lemma:
- fixes x y :: "'a::real_normed_vector"
- assumes "x \<noteq> y" shows "y islimpt ball x (dist x y)"
-proof (rule islimptI)
- fix T assume "y \<in> T" "open T"
- then obtain r where "0 < r" "\<forall>z. dist z y < r \<longrightarrow> z \<in> T"
- unfolding open_dist by fast
- (* choose point between x and y, within distance r of y. *)
- def k \<equiv> "min 1 (r / (2 * dist x y))"
- def z \<equiv> "y + scaleR k (x - y)"
- have z_def2: "z = x + scaleR (1 - k) (y - x)"
- unfolding z_def by (simp add: algebra_simps)
- have "dist z y < r"
- unfolding z_def k_def using `0 < r`
- by (simp add: dist_norm min_def)
- hence "z \<in> T" using `\<forall>z. dist z y < r \<longrightarrow> z \<in> T` by simp
- have "dist x z < dist x y"
- unfolding z_def2 dist_norm
- apply (simp add: norm_minus_commute)
- apply (simp only: dist_norm [symmetric])
- apply (subgoal_tac "\<bar>1 - k\<bar> * dist x y < 1 * dist x y", simp)
- apply (rule mult_strict_right_mono)
- apply (simp add: k_def divide_pos_pos zero_less_dist_iff `0 < r` `x \<noteq> y`)
- apply (simp add: zero_less_dist_iff `x \<noteq> y`)
- done
- hence "z \<in> ball x (dist x y)" by simp
- have "z \<noteq> y"
- unfolding z_def k_def using `x \<noteq> y` `0 < r`
- by (simp add: min_def)
- show "\<exists>z\<in>ball x (dist x y). z \<in> T \<and> z \<noteq> y"
- using `z \<in> ball x (dist x y)` `z \<in> T` `z \<noteq> y`
- by fast
-qed
-
-lemma closure_ball:
- fixes x :: "'a::real_normed_vector"
- shows "0 < e \<Longrightarrow> closure (ball x e) = cball x e"
-apply (rule equalityI)
-apply (rule closure_minimal)
-apply (rule ball_subset_cball)
-apply (rule closed_cball)
-apply (rule subsetI, rename_tac y)
-apply (simp add: le_less [where 'a=real])
-apply (erule disjE)
-apply (rule subsetD [OF closure_subset], simp)
-apply (simp add: closure_def)
-apply clarify
-apply (rule closure_ball_lemma)
-apply (simp add: zero_less_dist_iff)
-done
-
-(* In a trivial vector space, this fails for e = 0. *)
-lemma interior_cball:
- fixes x :: "'a::{real_normed_vector, perfect_space}"
- shows "interior (cball x e) = ball x e"
-proof(cases "e\<ge>0")
- case False note cs = this
- from cs have "ball x e = {}" using ball_empty[of e x] by auto moreover
- { fix y assume "y \<in> cball x e"
- hence False unfolding mem_cball using dist_nz[of x y] cs by auto }
- hence "cball x e = {}" by auto
- hence "interior (cball x e) = {}" using interior_empty by auto
- ultimately show ?thesis by blast
-next
- case True note cs = this
- have "ball x e \<subseteq> cball x e" using ball_subset_cball by auto moreover
- { fix S y assume as: "S \<subseteq> cball x e" "open S" "y\<in>S"
- then obtain d where "d>0" and d:"\<forall>x'. dist x' y < d \<longrightarrow> x' \<in> S" unfolding open_dist by blast
-
- then obtain xa where xa_y: "xa \<noteq> y" and xa: "dist xa y < d"
- using perfect_choose_dist [of d] by auto
- have "xa\<in>S" using d[THEN spec[where x=xa]] using xa by(auto simp add: dist_commute)
- hence xa_cball:"xa \<in> cball x e" using as(1) by auto
-
- hence "y \<in> ball x e" proof(cases "x = y")
- case True
- hence "e>0" using xa_y[unfolded dist_nz] xa_cball[unfolded mem_cball] by (auto simp add: dist_commute)
- thus "y \<in> ball x e" using `x = y ` by simp
- next
- case False
- have "dist (y + (d / 2 / dist y x) *\<^sub>R (y - x)) y < d" unfolding dist_norm
- using `d>0` norm_ge_zero[of "y - x"] `x \<noteq> y` by auto
- hence *:"y + (d / 2 / dist y x) *\<^sub>R (y - x) \<in> cball x e" using d as(1)[unfolded subset_eq] by blast
- have "y - x \<noteq> 0" using `x \<noteq> y` by auto
- hence **:"d / (2 * norm (y - x)) > 0" unfolding zero_less_norm_iff[THEN sym]
- using `d>0` divide_pos_pos[of d "2*norm (y - x)"] by auto
-
- 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)"
- by (auto simp add: dist_norm algebra_simps)
- also have "\<dots> = norm ((1 + d / (2 * norm (y - x))) *\<^sub>R (y - x))"
- by (auto simp add: algebra_simps)
- also have "\<dots> = \<bar>1 + d / (2 * norm (y - x))\<bar> * norm (y - x)"
- using ** by auto
- also have "\<dots> = (dist y x) + d/2"using ** by (auto simp add: left_distrib dist_norm)
- finally have "e \<ge> dist x y +d/2" using *[unfolded mem_cball] by (auto simp add: dist_commute)
- thus "y \<in> ball x e" unfolding mem_ball using `d>0` by auto
- qed }
- hence "\<forall>S \<subseteq> cball x e. open S \<longrightarrow> S \<subseteq> ball x e" by auto
- ultimately show ?thesis using interior_unique[of "ball x e" "cball x e"] using open_ball[of x e] by auto
-qed
-
-lemma frontier_ball:
- fixes a :: "'a::real_normed_vector"
- shows "0 < e ==> frontier(ball a e) = {x. dist a x = e}"
- apply (simp add: frontier_def closure_ball interior_open open_ball order_less_imp_le)
- apply (simp add: expand_set_eq)
- by arith
-
-lemma frontier_cball:
- fixes a :: "'a::{real_normed_vector, perfect_space}"
- shows "frontier(cball a e) = {x. dist a x = e}"
- apply (simp add: frontier_def interior_cball closed_cball closure_closed order_less_imp_le)
- apply (simp add: expand_set_eq)
- by arith
-
-lemma cball_eq_empty: "(cball x e = {}) \<longleftrightarrow> e < 0"
- apply (simp add: expand_set_eq not_le)
- by (metis zero_le_dist dist_self order_less_le_trans)
-lemma cball_empty: "e < 0 ==> cball x e = {}" by (simp add: cball_eq_empty)
-
-lemma cball_eq_sing:
- fixes x :: "'a::perfect_space"
- shows "(cball x e = {x}) \<longleftrightarrow> e = 0"
-proof (rule linorder_cases)
- assume e: "0 < e"
- obtain a where "a \<noteq> x" "dist a x < e"
- using perfect_choose_dist [OF e] by auto
- hence "a \<noteq> x" "dist x a \<le> e" by (auto simp add: dist_commute)
- with e show ?thesis by (auto simp add: expand_set_eq)
-qed auto
-
-lemma cball_sing:
- fixes x :: "'a::metric_space"
- shows "e = 0 ==> cball x e = {x}"
- by (auto simp add: expand_set_eq)
-
-text{* For points in the interior, localization of limits makes no difference. *}
-
-lemma eventually_within_interior:
- assumes "x \<in> interior S"
- shows "eventually P (at x within S) \<longleftrightarrow> eventually P (at x)" (is "?lhs = ?rhs")
-proof-
- from assms obtain T where T: "open T" "x \<in> T" "T \<subseteq> S"
- unfolding interior_def by fast
- { assume "?lhs"
- then obtain A where "open A" "x \<in> A" "\<forall>y\<in>A. y \<noteq> x \<longrightarrow> y \<in> S \<longrightarrow> P y"
- unfolding Limits.eventually_within Limits.eventually_at_topological
- by auto
- with T have "open (A \<inter> T)" "x \<in> A \<inter> T" "\<forall>y\<in>(A \<inter> T). y \<noteq> x \<longrightarrow> P y"
- by auto
- then have "?rhs"
- unfolding Limits.eventually_at_topological by auto
- } moreover
- { assume "?rhs" hence "?lhs"
- unfolding Limits.eventually_within
- by (auto elim: eventually_elim1)
- } ultimately
- show "?thesis" ..
-qed
-
-lemma lim_within_interior:
- "x \<in> interior S \<Longrightarrow> (f ---> l) (at x within S) \<longleftrightarrow> (f ---> l) (at x)"
- unfolding tendsto_def by (simp add: eventually_within_interior)
-
-lemma netlimit_within_interior:
- fixes x :: "'a::{perfect_space, real_normed_vector}"
- (* FIXME: generalize to perfect_space *)
- assumes "x \<in> interior S"
- shows "netlimit(at x within S) = x" (is "?lhs = ?rhs")
-proof-
- 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
- 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
- thus ?thesis using netlimit_within by auto
-qed
-
-subsection{* Boundedness. *}
-
- (* FIXME: This has to be unified with BSEQ!! *)
-definition
- bounded :: "'a::metric_space set \<Rightarrow> bool" where
- "bounded S \<longleftrightarrow> (\<exists>x e. \<forall>y\<in>S. dist x y \<le> e)"
-
-lemma bounded_any_center: "bounded S \<longleftrightarrow> (\<exists>e. \<forall>y\<in>S. dist a y \<le> e)"
-unfolding bounded_def
-apply safe
-apply (rule_tac x="dist a x + e" in exI, clarify)
-apply (drule (1) bspec)
-apply (erule order_trans [OF dist_triangle add_left_mono])
-apply auto
-done
-
-lemma bounded_iff: "bounded S \<longleftrightarrow> (\<exists>a. \<forall>x\<in>S. norm x \<le> a)"
-unfolding bounded_any_center [where a=0]
-by (simp add: dist_norm)
-
-lemma bounded_empty[simp]: "bounded {}" by (simp add: bounded_def)
-lemma bounded_subset: "bounded T \<Longrightarrow> S \<subseteq> T ==> bounded S"
- by (metis bounded_def subset_eq)
-
-lemma bounded_interior[intro]: "bounded S ==> bounded(interior S)"
- by (metis bounded_subset interior_subset)
-
-lemma bounded_closure[intro]: assumes "bounded S" shows "bounded(closure S)"
-proof-
- from assms obtain x and a where a: "\<forall>y\<in>S. dist x y \<le> a" unfolding bounded_def by auto
- { fix y assume "y \<in> closure S"
- then obtain f where f: "\<forall>n. f n \<in> S" "(f ---> y) sequentially"
- unfolding closure_sequential by auto
- have "\<forall>n. f n \<in> S \<longrightarrow> dist x (f n) \<le> a" using a by simp
- hence "eventually (\<lambda>n. dist x (f n) \<le> a) sequentially"
- by (rule eventually_mono, simp add: f(1))
- have "dist x y \<le> a"
- apply (rule Lim_dist_ubound [of sequentially f])
- apply (rule trivial_limit_sequentially)
- apply (rule f(2))
- apply fact
- done
- }
- thus ?thesis unfolding bounded_def by auto
-qed
-
-lemma bounded_cball[simp,intro]: "bounded (cball x e)"
- apply (simp add: bounded_def)
- apply (rule_tac x=x in exI)
- apply (rule_tac x=e in exI)
- apply auto
- done
-
-lemma bounded_ball[simp,intro]: "bounded(ball x e)"
- by (metis ball_subset_cball bounded_cball bounded_subset)
-
-lemma finite_imp_bounded[intro]: assumes "finite S" shows "bounded S"
-proof-
- { fix a F assume as:"bounded F"
- then obtain x e where "\<forall>y\<in>F. dist x y \<le> e" unfolding bounded_def by auto
- hence "\<forall>y\<in>(insert a F). dist x y \<le> max e (dist x a)" by auto
- hence "bounded (insert a F)" unfolding bounded_def by (intro exI)
- }
- thus ?thesis using finite_induct[of S bounded] using bounded_empty assms by auto
-qed
-
-lemma bounded_Un[simp]: "bounded (S \<union> T) \<longleftrightarrow> bounded S \<and> bounded T"
- apply (auto simp add: bounded_def)
- apply (rename_tac x y r s)
- apply (rule_tac x=x in exI)
- apply (rule_tac x="max r (dist x y + s)" in exI)
- apply (rule ballI, rename_tac z, safe)
- apply (drule (1) bspec, simp)
- apply (drule (1) bspec)
- apply (rule min_max.le_supI2)
- apply (erule order_trans [OF dist_triangle add_left_mono])
- done
-
-lemma bounded_Union[intro]: "finite F \<Longrightarrow> (\<forall>S\<in>F. bounded S) \<Longrightarrow> bounded(\<Union>F)"
- by (induct rule: finite_induct[of F], auto)
-
-lemma bounded_pos: "bounded S \<longleftrightarrow> (\<exists>b>0. \<forall>x\<in> S. norm x <= b)"
- apply (simp add: bounded_iff)
- apply (subgoal_tac "\<And>x (y::real). 0 < 1 + abs y \<and> (x <= y \<longrightarrow> x <= 1 + abs y)")
- by metis arith
-
-lemma bounded_Int[intro]: "bounded S \<or> bounded T \<Longrightarrow> bounded (S \<inter> T)"
- by (metis Int_lower1 Int_lower2 bounded_subset)
-
-lemma bounded_diff[intro]: "bounded S ==> bounded (S - T)"
-apply (metis Diff_subset bounded_subset)
-done
-
-lemma bounded_insert[intro]:"bounded(insert x S) \<longleftrightarrow> bounded S"
- by (metis Diff_cancel Un_empty_right Un_insert_right bounded_Un bounded_subset finite.emptyI finite_imp_bounded infinite_remove subset_insertI)
-
-lemma not_bounded_UNIV[simp, intro]:
- "\<not> bounded (UNIV :: 'a::{real_normed_vector, perfect_space} set)"
-proof(auto simp add: bounded_pos not_le)
- obtain x :: 'a where "x \<noteq> 0"
- using perfect_choose_dist [OF zero_less_one] by fast
- fix b::real assume b: "b >0"
- have b1: "b +1 \<ge> 0" using b by simp
- with `x \<noteq> 0` have "b < norm (scaleR (b + 1) (sgn x))"
- by (simp add: norm_sgn)
- then show "\<exists>x::'a. b < norm x" ..
-qed
-
-lemma bounded_linear_image:
- assumes "bounded S" "bounded_linear f"
- shows "bounded(f ` S)"
-proof-
- from assms(1) obtain b where b:"b>0" "\<forall>x\<in>S. norm x \<le> b" unfolding bounded_pos by auto
- 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)
- { fix x assume "x\<in>S"
- hence "norm x \<le> b" using b by auto
- hence "norm (f x) \<le> B * b" using B(2) apply(erule_tac x=x in allE)
- by (metis B(1) B(2) real_le_trans real_mult_le_cancel_iff2)
- }
- thus ?thesis unfolding bounded_pos apply(rule_tac x="b*B" in exI)
- using b B real_mult_order[of b B] by (auto simp add: real_mult_commute)
-qed
-
-lemma bounded_scaling:
- fixes S :: "'a::real_normed_vector set"
- shows "bounded S \<Longrightarrow> bounded ((\<lambda>x. c *\<^sub>R x) ` S)"
- apply (rule bounded_linear_image, assumption)
- apply (rule scaleR.bounded_linear_right)
- done
-
-lemma bounded_translation:
- fixes S :: "'a::real_normed_vector set"
- assumes "bounded S" shows "bounded ((\<lambda>x. a + x) ` S)"
-proof-
- from assms obtain b where b:"b>0" "\<forall>x\<in>S. norm x \<le> b" unfolding bounded_pos by auto
- { fix x assume "x\<in>S"
- hence "norm (a + x) \<le> b + norm a" using norm_triangle_ineq[of a x] b by auto
- }
- thus ?thesis unfolding bounded_pos using norm_ge_zero[of a] b(1) using add_strict_increasing[of b 0 "norm a"]
- by (auto intro!: add exI[of _ "b + norm a"])
-qed
-
-
-text{* Some theorems on sups and infs using the notion "bounded". *}
-
-lemma bounded_real:
- fixes S :: "real set"
- shows "bounded S \<longleftrightarrow> (\<exists>a. \<forall>x\<in>S. abs x <= a)"
- by (simp add: bounded_iff)
-
-lemma bounded_has_rsup: assumes "bounded S" "S \<noteq> {}"
- shows "\<forall>x\<in>S. x <= rsup S" and "\<forall>b. (\<forall>x\<in>S. x <= b) \<longrightarrow> rsup S <= b"
-proof
- fix x assume "x\<in>S"
- from assms(1) obtain a where a:"\<forall>x\<in>S. \<bar>x\<bar> \<le> a" unfolding bounded_real by auto
- hence *:"S *<= a" using setleI[of S a] by (metis abs_le_interval_iff mem_def)
- 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
-next
- show "\<forall>b. (\<forall>x\<in>S. x \<le> b) \<longrightarrow> rsup S \<le> b" using assms
- using rsup[of S, unfolded isLub_def isUb_def leastP_def setle_def setge_def]
- apply (auto simp add: bounded_real)
- by (auto simp add: isLub_def isUb_def leastP_def setle_def setge_def)
-qed
-
-lemma rsup_insert: assumes "bounded S"
- shows "rsup(insert x S) = (if S = {} then x else max x (rsup S))"
-proof(cases "S={}")
- case True thus ?thesis using rsup_finite_in[of "{x}"] by auto
-next
- let ?S = "insert x S"
- case False
- hence *:"\<forall>x\<in>S. x \<le> rsup S" using bounded_has_rsup(1)[of S] using assms by auto
- hence "insert x S *<= max x (rsup S)" unfolding setle_def by auto
- hence "isLub UNIV ?S (rsup ?S)" using rsup[of ?S] by auto
- moreover
- have **:"isUb UNIV ?S (max x (rsup S))" unfolding isUb_def setle_def using * by auto
- { fix y assume as:"isUb UNIV (insert x S) y"
- hence "max x (rsup S) \<le> y" unfolding isUb_def using rsup_le[OF `S\<noteq>{}`]
- unfolding setle_def by auto }
- hence "max x (rsup S) <=* isUb UNIV (insert x S)" unfolding setge_def Ball_def mem_def by auto
- hence "isLub UNIV ?S (max x (rsup S))" using ** isLubI2[of UNIV ?S "max x (rsup S)"] unfolding Collect_def by auto
- ultimately show ?thesis using real_isLub_unique[of UNIV ?S] using `S\<noteq>{}` by auto
-qed
-
-lemma sup_insert_finite: "finite S \<Longrightarrow> rsup(insert x S) = (if S = {} then x else max x (rsup S))"
- apply (rule rsup_insert)
- apply (rule finite_imp_bounded)
- by simp
-
-lemma bounded_has_rinf:
- assumes "bounded S" "S \<noteq> {}"
- shows "\<forall>x\<in>S. x >= rinf S" and "\<forall>b. (\<forall>x\<in>S. x >= b) \<longrightarrow> rinf S >= b"
-proof
- fix x assume "x\<in>S"
- from assms(1) obtain a where a:"\<forall>x\<in>S. \<bar>x\<bar> \<le> a" unfolding bounded_real by auto
- hence *:"- a <=* S" using setgeI[of S "-a"] unfolding abs_le_interval_iff by auto
- thus "x \<ge> rinf S" using rinf[OF `S\<noteq>{}`] using isGlbD2[of UNIV S "rinf S" x] using `x\<in>S` by auto
-next
- show "\<forall>b. (\<forall>x\<in>S. x >= b) \<longrightarrow> rinf S \<ge> b" using assms
- using rinf[of S, unfolded isGlb_def isLb_def greatestP_def setle_def setge_def]
- apply (auto simp add: bounded_real)
- by (auto simp add: isGlb_def isLb_def greatestP_def setle_def setge_def)
-qed
-
-(* TODO: Move this to RComplete.thy -- would need to include Glb into RComplete *)
-lemma real_isGlb_unique: "[| isGlb R S x; isGlb R S y |] ==> x = (y::real)"
- apply (frule isGlb_isLb)
- apply (frule_tac x = y in isGlb_isLb)
- apply (blast intro!: order_antisym dest!: isGlb_le_isLb)
- done
-
-lemma rinf_insert: assumes "bounded S"
- shows "rinf(insert x S) = (if S = {} then x else min x (rinf S))" (is "?lhs = ?rhs")
-proof(cases "S={}")
- case True thus ?thesis using rinf_finite_in[of "{x}"] by auto
-next
- let ?S = "insert x S"
- case False
- hence *:"\<forall>x\<in>S. x \<ge> rinf S" using bounded_has_rinf(1)[of S] using assms by auto
- hence "min x (rinf S) <=* insert x S" unfolding setge_def by auto
- hence "isGlb UNIV ?S (rinf ?S)" using rinf[of ?S] by auto
- moreover
- have **:"isLb UNIV ?S (min x (rinf S))" unfolding isLb_def setge_def using * by auto
- { fix y assume as:"isLb UNIV (insert x S) y"
- hence "min x (rinf S) \<ge> y" unfolding isLb_def using rinf_ge[OF `S\<noteq>{}`]
- unfolding setge_def by auto }
- hence "isLb UNIV (insert x S) *<= min x (rinf S)" unfolding setle_def Ball_def mem_def by auto
- hence "isGlb UNIV ?S (min x (rinf S))" using ** isGlbI2[of UNIV ?S "min x (rinf S)"] unfolding Collect_def by auto
- ultimately show ?thesis using real_isGlb_unique[of UNIV ?S] using `S\<noteq>{}` by auto
-qed
-
-lemma inf_insert_finite: "finite S ==> rinf(insert x S) = (if S = {} then x else min x (rinf S))"
- by (rule rinf_insert, rule finite_imp_bounded, simp)
-
-subsection{* Compactness (the definition is the one based on convegent subsequences). *}
-
-definition
- compact :: "'a::metric_space set \<Rightarrow> bool" where (* TODO: generalize *)
- "compact S \<longleftrightarrow>
- (\<forall>f. (\<forall>n. f n \<in> S) \<longrightarrow>
- (\<exists>l\<in>S. \<exists>r. subseq r \<and> ((f o r) ---> l) sequentially))"
-
-text {*
- A metric space (or topological vector space) is said to have the
- Heine-Borel property if every closed and bounded subset is compact.
-*}
-
-class heine_borel =
- assumes bounded_imp_convergent_subsequence:
- "bounded s \<Longrightarrow> \<forall>n. f n \<in> s
- \<Longrightarrow> \<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
-
-lemma bounded_closed_imp_compact:
- fixes s::"'a::heine_borel set"
- assumes "bounded s" and "closed s" shows "compact s"
-proof (unfold compact_def, clarify)
- fix f :: "nat \<Rightarrow> 'a" assume f: "\<forall>n. f n \<in> s"
- obtain l r where r: "subseq r" and l: "((f \<circ> r) ---> l) sequentially"
- using bounded_imp_convergent_subsequence [OF `bounded s` `\<forall>n. f n \<in> s`] by auto
- from f have fr: "\<forall>n. (f \<circ> r) n \<in> s" by simp
- have "l \<in> s" using `closed s` fr l
- unfolding closed_sequential_limits by blast
- show "\<exists>l\<in>s. \<exists>r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
- using `l \<in> s` r l by blast
-qed
-
-lemma subseq_bigger: assumes "subseq r" shows "n \<le> r n"
-proof(induct n)
- show "0 \<le> r 0" by auto
-next
- fix n assume "n \<le> r n"
- moreover have "r n < r (Suc n)"
- using assms [unfolded subseq_def] by auto
- ultimately show "Suc n \<le> r (Suc n)" by auto
-qed
-
-lemma eventually_subseq:
- assumes r: "subseq r"
- shows "eventually P sequentially \<Longrightarrow> eventually (\<lambda>n. P (r n)) sequentially"
-unfolding eventually_sequentially
-by (metis subseq_bigger [OF r] le_trans)
-
-lemma lim_subseq:
- "subseq r \<Longrightarrow> (s ---> l) sequentially \<Longrightarrow> ((s o r) ---> l) sequentially"
-unfolding tendsto_def eventually_sequentially o_def
-by (metis subseq_bigger le_trans)
-
-lemma num_Axiom: "EX! g. g 0 = e \<and> (\<forall>n. g (Suc n) = f n (g n))"
- unfolding Ex1_def
- apply (rule_tac x="nat_rec e f" in exI)
- apply (rule conjI)+
-apply (rule def_nat_rec_0, simp)
-apply (rule allI, rule def_nat_rec_Suc, simp)
-apply (rule allI, rule impI, rule ext)
-apply (erule conjE)
-apply (induct_tac x)
-apply (simp add: nat_rec_0)
-apply (erule_tac x="n" in allE)
-apply (simp)
-done
-
-lemma convergent_bounded_increasing: fixes s ::"nat\<Rightarrow>real"
- assumes "incseq s" and "\<forall>n. abs(s n) \<le> b"
- shows "\<exists> l. \<forall>e::real>0. \<exists> N. \<forall>n \<ge> N. abs(s n - l) < e"
-proof-
- have "isUb UNIV (range s) b" using assms(2) and abs_le_D1 unfolding isUb_def and setle_def by auto
- then obtain t where t:"isLub UNIV (range s) t" using reals_complete[of "range s" ] by auto
- { fix e::real assume "e>0" and as:"\<forall>N. \<exists>n\<ge>N. \<not> \<bar>s n - t\<bar> < e"
- { fix n::nat
- obtain N where "N\<ge>n" and n:"\<bar>s N - t\<bar> \<ge> e" using as[THEN spec[where x=n]] by auto
- have "t \<ge> s N" using isLub_isUb[OF t, unfolded isUb_def setle_def] by auto
- with n have "s N \<le> t - e" using `e>0` by auto
- 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 }
- hence "isUb UNIV (range s) (t - e)" unfolding isUb_def and setle_def by auto
- hence False using isLub_le_isUb[OF t, of "t - e"] and `e>0` by auto }
- thus ?thesis by blast
-qed
-
-lemma convergent_bounded_monotone: fixes s::"nat \<Rightarrow> real"
- assumes "\<forall>n. abs(s n) \<le> b" and "monoseq s"
- shows "\<exists>l. \<forall>e::real>0. \<exists>N. \<forall>n\<ge>N. abs(s n - l) < e"
- using convergent_bounded_increasing[of s b] assms using convergent_bounded_increasing[of "\<lambda>n. - s n" b]
- unfolding monoseq_def incseq_def
- apply auto unfolding minus_add_distrib[THEN sym, unfolded diff_minus[THEN sym]]
- unfolding abs_minus_cancel by(rule_tac x="-l" in exI)auto
-
-lemma compact_real_lemma:
- assumes "\<forall>n::nat. abs(s n) \<le> b"
- shows "\<exists>(l::real) r. subseq r \<and> ((s \<circ> r) ---> l) sequentially"
-proof-
- obtain r where r:"subseq r" "monoseq (\<lambda>n. s (r n))"
- using seq_monosub[of s] by auto
- thus ?thesis using convergent_bounded_monotone[of "\<lambda>n. s (r n)" b] and assms
- unfolding tendsto_iff dist_norm eventually_sequentially by auto
-qed
-
-instance real :: heine_borel
-proof
- fix s :: "real set" and f :: "nat \<Rightarrow> real"
- assume s: "bounded s" and f: "\<forall>n. f n \<in> s"
- then obtain b where b: "\<forall>n. abs (f n) \<le> b"
- unfolding bounded_iff by auto
- obtain l :: real and r :: "nat \<Rightarrow> nat" where
- r: "subseq r" and l: "((f \<circ> r) ---> l) sequentially"
- using compact_real_lemma [OF b] by auto
- thus "\<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
- by auto
-qed
-
-lemma bounded_component: "bounded s \<Longrightarrow> bounded ((\<lambda>x. x $ i) ` s)"
-unfolding bounded_def
-apply clarify
-apply (rule_tac x="x $ i" in exI)
-apply (rule_tac x="e" in exI)
-apply clarify
-apply (rule order_trans [OF dist_nth_le], simp)
-done
-
-lemma compact_lemma:
- fixes f :: "nat \<Rightarrow> 'a::heine_borel ^ 'n::finite"
- assumes "bounded s" and "\<forall>n. f n \<in> s"
- shows "\<forall>d.
- \<exists>l r. subseq r \<and>
- (\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r n) $ i) (l $ i) < e) sequentially)"
-proof
- fix d::"'n set" have "finite d" by simp
- thus "\<exists>l::'a ^ 'n. \<exists>r. subseq r \<and>
- (\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r n) $ i) (l $ i) < e) sequentially)"
- proof(induct d) case empty thus ?case unfolding subseq_def by auto
- next case (insert k d)
- have s': "bounded ((\<lambda>x. x $ k) ` s)" using `bounded s` by (rule bounded_component)
- 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"
- using insert(3) by auto
- have f': "\<forall>n. f (r1 n) $ k \<in> (\<lambda>x. x $ k) ` s" using `\<forall>n. f n \<in> s` by simp
- obtain l2 r2 where r2:"subseq r2" and lr2:"((\<lambda>i. f (r1 (r2 i)) $ k) ---> l2) sequentially"
- using bounded_imp_convergent_subsequence[OF s' f'] unfolding o_def by auto
- def r \<equiv> "r1 \<circ> r2" have r:"subseq r"
- using r1 and r2 unfolding r_def o_def subseq_def by auto
- moreover
- def l \<equiv> "(\<chi> i. if i = k then l2 else l1$i)::'a^'n"
- { fix e::real assume "e>0"
- from lr1 `e>0` have N1:"eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r1 n) $ i) (l1 $ i) < e) sequentially" by blast
- from lr2 `e>0` have N2:"eventually (\<lambda>n. dist (f (r1 (r2 n)) $ k) l2 < e) sequentially" by (rule tendstoD)
- from r2 N1 have N1': "eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r1 (r2 n)) $ i) (l1 $ i) < e) sequentially"
- by (rule eventually_subseq)
- have "eventually (\<lambda>n. \<forall>i\<in>(insert k d). dist (f (r n) $ i) (l $ i) < e) sequentially"
- using N1' N2 by (rule eventually_elim2, simp add: l_def r_def)
- }
- ultimately show ?case by auto
- qed
-qed
-
-instance "^" :: (heine_borel, finite) heine_borel
-proof
- fix s :: "('a ^ 'b) set" and f :: "nat \<Rightarrow> 'a ^ 'b"
- assume s: "bounded s" and f: "\<forall>n. f n \<in> s"
- then obtain l r where r: "subseq r"
- and l: "\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>UNIV. dist (f (r n) $ i) (l $ i) < e) sequentially"
- using compact_lemma [OF s f] by blast
- let ?d = "UNIV::'b set"
- { fix e::real assume "e>0"
- hence "0 < e / (real_of_nat (card ?d))"
- using zero_less_card_finite using divide_pos_pos[of e, of "real_of_nat (card ?d)"] by auto
- with l have "eventually (\<lambda>n. \<forall>i. dist (f (r n) $ i) (l $ i) < e / (real_of_nat (card ?d))) sequentially"
- by simp
- moreover
- { fix n assume n: "\<forall>i. dist (f (r n) $ i) (l $ i) < e / (real_of_nat (card ?d))"
- have "dist (f (r n)) l \<le> (\<Sum>i\<in>?d. dist (f (r n) $ i) (l $ i))"
- unfolding dist_vector_def using zero_le_dist by (rule setL2_le_setsum)
- also have "\<dots> < (\<Sum>i\<in>?d. e / (real_of_nat (card ?d)))"
- by (rule setsum_strict_mono) (simp_all add: n)
- finally have "dist (f (r n)) l < e" by simp
- }
- ultimately have "eventually (\<lambda>n. dist (f (r n)) l < e) sequentially"
- by (rule eventually_elim1)
- }
- hence *:"((f \<circ> r) ---> l) sequentially" unfolding o_def tendsto_iff by simp
- with r show "\<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially" by auto
-qed
-
-lemma bounded_fst: "bounded s \<Longrightarrow> bounded (fst ` s)"
-unfolding bounded_def
-apply clarify
-apply (rule_tac x="a" in exI)
-apply (rule_tac x="e" in exI)
-apply clarsimp
-apply (drule (1) bspec)
-apply (simp add: dist_Pair_Pair)
-apply (erule order_trans [OF real_sqrt_sum_squares_ge1])
-done
-
-lemma bounded_snd: "bounded s \<Longrightarrow> bounded (snd ` s)"
-unfolding bounded_def
-apply clarify
-apply (rule_tac x="b" in exI)
-apply (rule_tac x="e" in exI)
-apply clarsimp
-apply (drule (1) bspec)
-apply (simp add: dist_Pair_Pair)
-apply (erule order_trans [OF real_sqrt_sum_squares_ge2])
-done
-
-instance "*" :: (heine_borel, heine_borel) heine_borel
-proof
- fix s :: "('a * 'b) set" and f :: "nat \<Rightarrow> 'a * 'b"
- assume s: "bounded s" and f: "\<forall>n. f n \<in> s"
- from s have s1: "bounded (fst ` s)" by (rule bounded_fst)
- from f have f1: "\<forall>n. fst (f n) \<in> fst ` s" by simp
- obtain l1 r1 where r1: "subseq r1"
- and l1: "((\<lambda>n. fst (f (r1 n))) ---> l1) sequentially"
- using bounded_imp_convergent_subsequence [OF s1 f1]
- unfolding o_def by fast
- from s have s2: "bounded (snd ` s)" by (rule bounded_snd)
- from f have f2: "\<forall>n. snd (f (r1 n)) \<in> snd ` s" by simp
- obtain l2 r2 where r2: "subseq r2"
- and l2: "((\<lambda>n. snd (f (r1 (r2 n)))) ---> l2) sequentially"
- using bounded_imp_convergent_subsequence [OF s2 f2]
- unfolding o_def by fast
- have l1': "((\<lambda>n. fst (f (r1 (r2 n)))) ---> l1) sequentially"
- using lim_subseq [OF r2 l1] unfolding o_def .
- have l: "((f \<circ> (r1 \<circ> r2)) ---> (l1, l2)) sequentially"
- using tendsto_Pair [OF l1' l2] unfolding o_def by simp
- have r: "subseq (r1 \<circ> r2)"
- using r1 r2 unfolding subseq_def by simp
- show "\<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
- using l r by fast
-qed
-
-subsection{* Completeness. *}
-
-lemma cauchy_def:
- "Cauchy s \<longleftrightarrow> (\<forall>e>0. \<exists>N. \<forall>m n. m \<ge> N \<and> n \<ge> N --> dist(s m)(s n) < e)"
-unfolding Cauchy_def by blast
-
-definition
- complete :: "'a::metric_space set \<Rightarrow> bool" where
- "complete s \<longleftrightarrow> (\<forall>f. (\<forall>n. f n \<in> s) \<and> Cauchy f
- --> (\<exists>l \<in> s. (f ---> l) sequentially))"
-
-lemma cauchy: "Cauchy s \<longleftrightarrow> (\<forall>e>0.\<exists> N::nat. \<forall>n\<ge>N. dist(s n)(s N) < e)" (is "?lhs = ?rhs")
-proof-
- { assume ?rhs
- { fix e::real
- assume "e>0"
- with `?rhs` obtain N where N:"\<forall>n\<ge>N. dist (s n) (s N) < e/2"
- by (erule_tac x="e/2" in allE) auto
- { fix n m
- assume nm:"N \<le> m \<and> N \<le> n"
- hence "dist (s m) (s n) < e" using N
- using dist_triangle_half_l[of "s m" "s N" "e" "s n"]
- by blast
- }
- hence "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (s m) (s n) < e"
- by blast
- }
- hence ?lhs
- unfolding cauchy_def
- by blast
- }
- thus ?thesis
- unfolding cauchy_def
- using dist_triangle_half_l
- by blast
-qed
-
-lemma convergent_imp_cauchy:
- "(s ---> l) sequentially ==> Cauchy s"
-proof(simp only: cauchy_def, rule, rule)
- fix e::real assume "e>0" "(s ---> l) sequentially"
- 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
- 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
-qed
-
-lemma cauchy_imp_bounded: assumes "Cauchy s" shows "bounded {y. (\<exists>n::nat. y = s n)}"
-proof-
- 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
- hence N:"\<forall>n. N \<le> n \<longrightarrow> dist (s N) (s n) < 1" by auto
- moreover
- have "bounded (s ` {0..N})" using finite_imp_bounded[of "s ` {1..N}"] by auto
- then obtain a where a:"\<forall>x\<in>s ` {0..N}. dist (s N) x \<le> a"
- unfolding bounded_any_center [where a="s N"] by auto
- ultimately show "?thesis"
- unfolding bounded_any_center [where a="s N"]
- apply(rule_tac x="max a 1" in exI) apply auto
- apply(erule_tac x=n in allE) apply(erule_tac x=n in ballE) by auto
-qed
-
-lemma compact_imp_complete: assumes "compact s" shows "complete s"
-proof-
- { fix f assume as: "(\<forall>n::nat. f n \<in> s)" "Cauchy f"
- 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
-
- note lr' = subseq_bigger [OF lr(2)]
-
- { fix e::real assume "e>0"
- 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
- 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
- { fix n::nat assume n:"n \<ge> max N M"
- have "dist ((f \<circ> r) n) l < e/2" using n M by auto
- moreover have "r n \<ge> N" using lr'[of n] n by auto
- hence "dist (f n) ((f \<circ> r) n) < e / 2" using N using n by auto
- 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) }
- hence "\<exists>N. \<forall>n\<ge>N. dist (f n) l < e" by blast }
- hence "\<exists>l\<in>s. (f ---> l) sequentially" using `l\<in>s` unfolding Lim_sequentially by auto }
- thus ?thesis unfolding complete_def by auto
-qed
-
-instance heine_borel < complete_space
-proof
- fix f :: "nat \<Rightarrow> 'a" assume "Cauchy f"
- hence "bounded (range f)" unfolding image_def
- using cauchy_imp_bounded [of f] by auto
- hence "compact (closure (range f))"
- using bounded_closed_imp_compact [of "closure (range f)"] by auto
- hence "complete (closure (range f))"
- using compact_imp_complete by auto
- moreover have "\<forall>n. f n \<in> closure (range f)"
- using closure_subset [of "range f"] by auto
- ultimately have "\<exists>l\<in>closure (range f). (f ---> l) sequentially"
- using `Cauchy f` unfolding complete_def by auto
- then show "convergent f"
- unfolding convergent_def LIMSEQ_conv_tendsto [symmetric] by auto
-qed
-
-lemma complete_univ: "complete (UNIV :: 'a::complete_space set)"
-proof(simp add: complete_def, rule, rule)
- fix f :: "nat \<Rightarrow> 'a" assume "Cauchy f"
- hence "convergent f" by (rule Cauchy_convergent)
- hence "\<exists>l. f ----> l" unfolding convergent_def .
- thus "\<exists>l. (f ---> l) sequentially" unfolding LIMSEQ_conv_tendsto .
-qed
-
-lemma complete_imp_closed: assumes "complete s" shows "closed s"
-proof -
- { fix x assume "x islimpt s"
- then obtain f where f: "\<forall>n. f n \<in> s - {x}" "(f ---> x) sequentially"
- unfolding islimpt_sequential by auto
- then obtain l where l: "l\<in>s" "(f ---> l) sequentially"
- using `complete s`[unfolded complete_def] using convergent_imp_cauchy[of f x] by auto
- hence "x \<in> s" using Lim_unique[of sequentially f l x] trivial_limit_sequentially f(2) by auto
- }
- thus "closed s" unfolding closed_limpt by auto
-qed
-
-lemma complete_eq_closed:
- fixes s :: "'a::complete_space set"
- shows "complete s \<longleftrightarrow> closed s" (is "?lhs = ?rhs")
-proof
- assume ?lhs thus ?rhs by (rule complete_imp_closed)
-next
- assume ?rhs
- { fix f assume as:"\<forall>n::nat. f n \<in> s" "Cauchy f"
- then obtain l where "(f ---> l) sequentially" using complete_univ[unfolded complete_def, THEN spec[where x=f]] by auto
- 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 }
- thus ?lhs unfolding complete_def by auto
-qed
-
-lemma convergent_eq_cauchy:
- fixes s :: "nat \<Rightarrow> 'a::complete_space"
- shows "(\<exists>l. (s ---> l) sequentially) \<longleftrightarrow> Cauchy s" (is "?lhs = ?rhs")
-proof
- assume ?lhs then obtain l where "(s ---> l) sequentially" by auto
- thus ?rhs using convergent_imp_cauchy by auto
-next
- assume ?rhs thus ?lhs using complete_univ[unfolded complete_def, THEN spec[where x=s]] by auto
-qed
-
-lemma convergent_imp_bounded:
- fixes s :: "nat \<Rightarrow> 'a::metric_space"
- shows "(s ---> l) sequentially ==> bounded (s ` (UNIV::(nat set)))"
- using convergent_imp_cauchy[of s]
- using cauchy_imp_bounded[of s]
- unfolding image_def
- by auto
-
-subsection{* Total boundedness. *}
-
-fun helper_1::"('a::metric_space set) \<Rightarrow> real \<Rightarrow> nat \<Rightarrow> 'a" where
- "helper_1 s e n = (SOME y::'a. y \<in> s \<and> (\<forall>m<n. \<not> (dist (helper_1 s e m) y < e)))"
-declare helper_1.simps[simp del]
-
-lemma compact_imp_totally_bounded:
- assumes "compact s"
- shows "\<forall>e>0. \<exists>k. finite k \<and> k \<subseteq> s \<and> s \<subseteq> (\<Union>((\<lambda>x. ball x e) ` k))"
-proof(rule, rule, rule ccontr)
- 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)"
- def x \<equiv> "helper_1 s e"
- { fix n
- have "x n \<in> s \<and> (\<forall>m<n. \<not> dist (x m) (x n) < e)"
- proof(induct_tac rule:nat_less_induct)
- fix n def Q \<equiv> "(\<lambda>y. y \<in> s \<and> (\<forall>m<n. \<not> dist (x m) y < e))"
- assume as:"\<forall>m<n. x m \<in> s \<and> (\<forall>ma<m. \<not> dist (x ma) (x m) < e)"
- 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
- then obtain z where z:"z\<in>s" "z \<notin> (\<Union>x\<in>x ` {0..<n}. ball x e)" unfolding subset_eq by auto
- have "Q (x n)" unfolding x_def and helper_1.simps[of s e n]
- apply(rule someI2[where a=z]) unfolding x_def[symmetric] and Q_def using z by auto
- thus "x n \<in> s \<and> (\<forall>m<n. \<not> dist (x m) (x n) < e)" unfolding Q_def by auto
- qed }
- hence "\<forall>n::nat. x n \<in> s" and x:"\<forall>n. \<forall>m < n. \<not> (dist (x m) (x n) < e)" by blast+
- 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
- from this(3) have "Cauchy (x \<circ> r)" using convergent_imp_cauchy by auto
- 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
- show False
- using N[THEN spec[where x=N], THEN spec[where x="N+1"]]
- using r[unfolded subseq_def, THEN spec[where x=N], THEN spec[where x="N+1"]]
- using x[THEN spec[where x="r (N+1)"], THEN spec[where x="r (N)"]] by auto
-qed
-
-subsection{* Heine-Borel theorem (following Burkill \& Burkill vol. 2) *}
-
-lemma heine_borel_lemma: fixes s::"'a::metric_space set"
- assumes "compact s" "s \<subseteq> (\<Union> t)" "\<forall>b \<in> t. open b"
- shows "\<exists>e>0. \<forall>x \<in> s. \<exists>b \<in> t. ball x e \<subseteq> b"
-proof(rule ccontr)
- assume "\<not> (\<exists>e>0. \<forall>x\<in>s. \<exists>b\<in>t. ball x e \<subseteq> b)"
- hence cont:"\<forall>e>0. \<exists>x\<in>s. \<forall>xa\<in>t. \<not> (ball x e \<subseteq> xa)" by auto
- { fix n::nat
- have "1 / real (n + 1) > 0" by auto
- 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 }
- 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
- 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)"
- 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
-
- then obtain l r where l:"l\<in>s" and r:"subseq r" and lr:"((f \<circ> r) ---> l) sequentially"
- using assms(1)[unfolded compact_def, THEN spec[where x=f]] by auto
-
- obtain b where "l\<in>b" "b\<in>t" using assms(2) and l by auto
- then obtain e where "e>0" and e:"\<forall>z. dist z l < e \<longrightarrow> z\<in>b"
- using assms(3)[THEN bspec[where x=b]] unfolding open_dist by auto
-
- then obtain N1 where N1:"\<forall>n\<ge>N1. dist ((f \<circ> r) n) l < e / 2"
- using lr[unfolded Lim_sequentially, THEN spec[where x="e/2"]] by auto
-
- obtain N2::nat where N2:"N2>0" "inverse (real N2) < e /2" using real_arch_inv[of "e/2"] and `e>0` by auto
- have N2':"inverse (real (r (N1 + N2) +1 )) < e/2"
- apply(rule order_less_trans) apply(rule less_imp_inverse_less) using N2
- using subseq_bigger[OF r, of "N1 + N2"] by auto
-
- def x \<equiv> "(f (r (N1 + N2)))"
- have x:"\<not> ball x (inverse (real (r (N1 + N2) + 1))) \<subseteq> b" unfolding x_def
- using f[THEN spec[where x="r (N1 + N2)"]] using `b\<in>t` by auto
- have "\<exists>y\<in>ball x (inverse (real (r (N1 + N2) + 1))). y\<notin>b" apply(rule ccontr) using x by auto
- then obtain y where y:"y \<in> ball x (inverse (real (r (N1 + N2) + 1)))" "y \<notin> b" by auto
-
- have "dist x l < e/2" using N1 unfolding x_def o_def by auto
- hence "dist y l < e" using y N2' using dist_triangle[of y l x]by (auto simp add:dist_commute)
-
- thus False using e and `y\<notin>b` by auto
-qed
-
-lemma compact_imp_heine_borel: "compact s ==> (\<forall>f. (\<forall>t \<in> f. open t) \<and> s \<subseteq> (\<Union> f)
- \<longrightarrow> (\<exists>f'. f' \<subseteq> f \<and> finite f' \<and> s \<subseteq> (\<Union> f')))"
-proof clarify
- fix f assume "compact s" " \<forall>t\<in>f. open t" "s \<subseteq> \<Union>f"
- 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
- hence "\<forall>x\<in>s. \<exists>b. b\<in>f \<and> ball x e \<subseteq> b" by auto
- 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
- then obtain bb where bb:"\<forall>x\<in>s. (bb x) \<in> f \<and> ball x e \<subseteq> (bb x)" by blast
-
- 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
- then obtain k where k:"finite k" "k \<subseteq> s" "s \<subseteq> \<Union>(\<lambda>x. ball x e) ` k" by auto
-
- have "finite (bb ` k)" using k(1) by auto
- moreover
- { fix x assume "x\<in>s"
- hence "x\<in>\<Union>(\<lambda>x. ball x e) ` k" using k(3) unfolding subset_eq by auto
- hence "\<exists>X\<in>bb ` k. x \<in> X" using bb k(2) by blast
- hence "x \<in> \<Union>(bb ` k)" using Union_iff[of x "bb ` k"] by auto
- }
- 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
-qed
-
-subsection{* Bolzano-Weierstrass property. *}
-
-lemma heine_borel_imp_bolzano_weierstrass:
- 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'))"
- "infinite t" "t \<subseteq> s"
- shows "\<exists>x \<in> s. x islimpt t"
-proof(rule ccontr)
- assume "\<not> (\<exists>x \<in> s. x islimpt t)"
- 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
- 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
- obtain g where g:"g\<subseteq>{t. \<exists>x. x \<in> s \<and> t = f x}" "finite g" "s \<subseteq> \<Union>g"
- using assms(1)[THEN spec[where x="{t. \<exists>x. x\<in>s \<and> t = f x}"]] using f by auto
- from g(1,3) have g':"\<forall>x\<in>g. \<exists>xa \<in> s. x = f xa" by auto
- { fix x y assume "x\<in>t" "y\<in>t" "f x = f y"
- 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
- 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 }
- hence "infinite (f ` t)" using assms(2) using finite_imageD[unfolded inj_on_def, of f t] by auto
- moreover
- { fix x assume "x\<in>t" "f x \<notin> g"
- from g(3) assms(3) `x\<in>t` obtain h where "h\<in>g" and "x\<in>h" by auto
- then obtain y where "y\<in>s" "h = f y" using g'[THEN bspec[where x=h]] by auto
- hence "y = x" using f[THEN bspec[where x=y]] and `x\<in>t` and `x\<in>h`[unfolded `h = f y`] by auto
- hence False using `f x \<notin> g` `h\<in>g` unfolding `h = f y` by auto }
- hence "f ` t \<subseteq> g" by auto
- ultimately show False using g(2) using finite_subset by auto
-qed
-
-subsection{* Complete the chain of compactness variants. *}
-
-primrec helper_2::"(real \<Rightarrow> 'a::metric_space) \<Rightarrow> nat \<Rightarrow> 'a" where
- "helper_2 beyond 0 = beyond 0" |
- "helper_2 beyond (Suc n) = beyond (dist undefined (helper_2 beyond n) + 1 )"
-
-lemma bolzano_weierstrass_imp_bounded: fixes s::"'a::metric_space set"
- assumes "\<forall>t. infinite t \<and> t \<subseteq> s --> (\<exists>x \<in> s. x islimpt t)"
- shows "bounded s"
-proof(rule ccontr)
- assume "\<not> bounded s"
- then obtain beyond where "\<forall>a. beyond a \<in>s \<and> \<not> dist undefined (beyond a) \<le> a"
- unfolding bounded_any_center [where a=undefined]
- apply simp using choice[of "\<lambda>a x. x\<in>s \<and> \<not> dist undefined x \<le> a"] by auto
- hence beyond:"\<And>a. beyond a \<in>s" "\<And>a. dist undefined (beyond a) > a"
- unfolding linorder_not_le by auto
- def x \<equiv> "helper_2 beyond"
-
- { fix m n ::nat assume "m<n"
- hence "dist undefined (x m) + 1 < dist undefined (x n)"
- proof(induct n)
- case 0 thus ?case by auto
- next
- case (Suc n)
- have *:"dist undefined (x n) + 1 < dist undefined (x (Suc n))"
- unfolding x_def and helper_2.simps
- using beyond(2)[of "dist undefined (helper_2 beyond n) + 1"] by auto
- thus ?case proof(cases "m < n")
- case True thus ?thesis using Suc and * by auto
- next
- case False hence "m = n" using Suc(2) by auto
- thus ?thesis using * by auto
- qed
- qed } note * = this
- { fix m n ::nat assume "m\<noteq>n"
- have "1 < dist (x m) (x n)"
- proof(cases "m<n")
- case True
- hence "1 < dist undefined (x n) - dist undefined (x m)" using *[of m n] by auto
- thus ?thesis using dist_triangle [of undefined "x n" "x m"] by arith
- next
- case False hence "n<m" using `m\<noteq>n` by auto
- hence "1 < dist undefined (x m) - dist undefined (x n)" using *[of n m] by auto
- thus ?thesis using dist_triangle2 [of undefined "x m" "x n"] by arith
- qed } note ** = this
- { fix a b assume "x a = x b" "a \<noteq> b"
- hence False using **[of a b] by auto }
- hence "inj x" unfolding inj_on_def by auto
- moreover
- { fix n::nat
- have "x n \<in> s"
- proof(cases "n = 0")
- case True thus ?thesis unfolding x_def using beyond by auto
- next
- case False then obtain z where "n = Suc z" using not0_implies_Suc by auto
- thus ?thesis unfolding x_def using beyond by auto
- qed }
- 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
-
- then obtain l where "l\<in>s" and l:"l islimpt range x" using assms[THEN spec[where x="range x"]] by auto
- 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
- 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"]]
- unfolding dist_nz by auto
- show False using y and z and dist_triangle_half_l[of "x y" l 1 "x z"] and **[of y z] by auto
-qed
-
-lemma sequence_infinite_lemma:
- fixes l :: "'a::metric_space" (* TODO: generalize *)
- assumes "\<forall>n::nat. (f n \<noteq> l)" "(f ---> l) sequentially"
- shows "infinite {y. (\<exists> n. y = f n)}"
-proof(rule ccontr)
- let ?A = "(\<lambda>x. dist x l) ` {y. \<exists>n. y = f n}"
- assume "\<not> infinite {y. \<exists>n. y = f n}"
- hence **:"finite ?A" "?A \<noteq> {}" by auto
- obtain k where k:"dist (f k) l = Min ?A" using Min_in[OF **] by auto
- have "0 < Min ?A" using assms(1) unfolding dist_nz unfolding Min_gr_iff[OF **] by auto
- then obtain N where "dist (f N) l < Min ?A" using assms(2)[unfolded Lim_sequentially, THEN spec[where x="Min ?A"]] by auto
- moreover have "dist (f N) l \<in> ?A" by auto
- ultimately show False using Min_le[OF **(1), of "dist (f N) l"] by auto
-qed
-
-lemma sequence_unique_limpt:
- fixes l :: "'a::metric_space" (* TODO: generalize *)
- assumes "\<forall>n::nat. (f n \<noteq> l)" "(f ---> l) sequentially" "l' islimpt {y. (\<exists>n. y = f n)}"
- shows "l' = l"
-proof(rule ccontr)
- def e \<equiv> "dist l' l"
- assume "l' \<noteq> l" hence "e>0" unfolding dist_nz e_def by auto
- then obtain N::nat where N:"\<forall>n\<ge>N. dist (f n) l < e / 2"
- using assms(2)[unfolded Lim_sequentially, THEN spec[where x="e/2"]] by auto
- 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}))"
- have "d>0" using `e>0` unfolding d_def e_def using zero_le_dist[of _ l', unfolded order_le_less] by auto
- 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
- have "k\<ge>N" using k(1)[unfolded dist_nz] using k(2)[unfolded d_def]
- by force
- 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
- thus False unfolding e_def by auto
-qed
-
-lemma bolzano_weierstrass_imp_closed:
- fixes s :: "'a::metric_space set" (* TODO: can this be generalized? *)
- assumes "\<forall>t. infinite t \<and> t \<subseteq> s --> (\<exists>x \<in> s. x islimpt t)"
- shows "closed s"
-proof-
- { fix x l assume as: "\<forall>n::nat. x n \<in> s" "(x ---> l) sequentially"
- hence "l \<in> s"
- proof(cases "\<forall>n. x n \<noteq> l")
- case False thus "l\<in>s" using as(1) by auto
- next
- case True note cas = this
- with as(2) have "infinite {y. \<exists>n. y = x n}" using sequence_infinite_lemma[of x l] by auto
- 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
- thus "l\<in>s" using sequence_unique_limpt[of x l l'] using as cas by auto
- qed }
- thus ?thesis unfolding closed_sequential_limits by fast
-qed
-
-text{* Hence express everything as an equivalence. *}
-
-lemma compact_eq_heine_borel:
- fixes s :: "'a::heine_borel set"
- shows "compact s \<longleftrightarrow>
- (\<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')))" (is "?lhs = ?rhs")
-proof
- assume ?lhs thus ?rhs using compact_imp_heine_borel[of s] by blast
-next
- assume ?rhs
- hence "\<forall>t. infinite t \<and> t \<subseteq> s \<longrightarrow> (\<exists>x\<in>s. x islimpt t)"
- by (blast intro: heine_borel_imp_bolzano_weierstrass[of s])
- thus ?lhs using bolzano_weierstrass_imp_bounded[of s] bolzano_weierstrass_imp_closed[of s] bounded_closed_imp_compact[of s] by blast
-qed
-
-lemma compact_eq_bolzano_weierstrass:
- fixes s :: "'a::heine_borel set"
- shows "compact s \<longleftrightarrow> (\<forall>t. infinite t \<and> t \<subseteq> s --> (\<exists>x \<in> s. x islimpt t))" (is "?lhs = ?rhs")
-proof
- assume ?lhs thus ?rhs unfolding compact_eq_heine_borel using heine_borel_imp_bolzano_weierstrass[of s] by auto
-next
- assume ?rhs thus ?lhs using bolzano_weierstrass_imp_bounded bolzano_weierstrass_imp_closed bounded_closed_imp_compact by auto
-qed
-
-lemma compact_eq_bounded_closed:
- fixes s :: "'a::heine_borel set"
- shows "compact s \<longleftrightarrow> bounded s \<and> closed s" (is "?lhs = ?rhs")
-proof
- assume ?lhs thus ?rhs unfolding compact_eq_bolzano_weierstrass using bolzano_weierstrass_imp_bounded bolzano_weierstrass_imp_closed by auto
-next
- assume ?rhs thus ?lhs using bounded_closed_imp_compact by auto
-qed
-
-lemma compact_imp_bounded:
- fixes s :: "'a::metric_space set"
- shows "compact s ==> bounded s"
-proof -
- assume "compact s"
- 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')"
- by (rule compact_imp_heine_borel)
- hence "\<forall>t. infinite t \<and> t \<subseteq> s \<longrightarrow> (\<exists>x \<in> s. x islimpt t)"
- using heine_borel_imp_bolzano_weierstrass[of s] by auto
- thus "bounded s"
- by (rule bolzano_weierstrass_imp_bounded)
-qed
-
-lemma compact_imp_closed:
- fixes s :: "'a::metric_space set"
- shows "compact s ==> closed s"
-proof -
- assume "compact s"
- 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')"
- by (rule compact_imp_heine_borel)
- hence "\<forall>t. infinite t \<and> t \<subseteq> s \<longrightarrow> (\<exists>x \<in> s. x islimpt t)"
- using heine_borel_imp_bolzano_weierstrass[of s] by auto
- thus "closed s"
- by (rule bolzano_weierstrass_imp_closed)
-qed
-
-text{* In particular, some common special cases. *}
-
-lemma compact_empty[simp]:
- "compact {}"
- unfolding compact_def
- by simp
-
-(* TODO: can any of the next 3 lemmas be generalized to metric spaces? *)
-
- (* FIXME : Rename *)
-lemma compact_union[intro]:
- fixes s t :: "'a::heine_borel set"
- shows "compact s \<Longrightarrow> compact t ==> compact (s \<union> t)"
- unfolding compact_eq_bounded_closed
- using bounded_Un[of s t]
- using closed_Un[of s t]
- by simp
-
-lemma compact_inter[intro]:
- fixes s t :: "'a::heine_borel set"
- shows "compact s \<Longrightarrow> compact t ==> compact (s \<inter> t)"
- unfolding compact_eq_bounded_closed
- using bounded_Int[of s t]
- using closed_Int[of s t]
- by simp
-
-lemma compact_inter_closed[intro]:
- fixes s t :: "'a::heine_borel set"
- shows "compact s \<Longrightarrow> closed t ==> compact (s \<inter> t)"
- unfolding compact_eq_bounded_closed
- using closed_Int[of s t]
- using bounded_subset[of "s \<inter> t" s]
- by blast
-
-lemma closed_inter_compact[intro]:
- fixes s t :: "'a::heine_borel set"
- shows "closed s \<Longrightarrow> compact t ==> compact (s \<inter> t)"
-proof-
- assume "closed s" "compact t"
- moreover
- have "s \<inter> t = t \<inter> s" by auto ultimately
- show ?thesis
- using compact_inter_closed[of t s]
- by auto
-qed
-
-lemma closed_sing [simp]:
- fixes a :: "'a::metric_space"
- shows "closed {a}"
- apply (clarsimp simp add: closed_def open_dist)
- apply (rule ccontr)
- apply (drule_tac x="dist x a" in spec)
- apply (simp add: dist_nz dist_commute)
- done
-
-lemma finite_imp_closed:
- fixes s :: "'a::metric_space set"
- shows "finite s ==> closed s"
-proof (induct set: finite)
- case empty show "closed {}" by simp
-next
- case (insert x F)
- hence "closed ({x} \<union> F)" by (simp only: closed_Un closed_sing)
- thus "closed (insert x F)" by simp
-qed
-
-lemma finite_imp_compact:
- fixes s :: "'a::heine_borel set"
- shows "finite s ==> compact s"
- unfolding compact_eq_bounded_closed
- using finite_imp_closed finite_imp_bounded
- by blast
-
-lemma compact_sing [simp]: "compact {a}"
- unfolding compact_def o_def subseq_def
- by (auto simp add: tendsto_const)
-
-lemma compact_cball[simp]:
- fixes x :: "'a::heine_borel"
- shows "compact(cball x e)"
- using compact_eq_bounded_closed bounded_cball closed_cball
- by blast
-
-lemma compact_frontier_bounded[intro]:
- fixes s :: "'a::heine_borel set"
- shows "bounded s ==> compact(frontier s)"
- unfolding frontier_def
- using compact_eq_bounded_closed
- by blast
-
-lemma compact_frontier[intro]:
- fixes s :: "'a::heine_borel set"
- shows "compact s ==> compact (frontier s)"
- using compact_eq_bounded_closed compact_frontier_bounded
- by blast
-
-lemma frontier_subset_compact:
- fixes s :: "'a::heine_borel set"
- shows "compact s ==> frontier s \<subseteq> s"
- using frontier_subset_closed compact_eq_bounded_closed
- by blast
-
-lemma open_delete:
- fixes s :: "'a::metric_space set"
- shows "open s ==> open(s - {x})"
- using open_Diff[of s "{x}"] closed_sing
- by blast
-
-text{* Finite intersection property. I could make it an equivalence in fact. *}
-
-lemma compact_imp_fip:
- fixes s :: "'a::heine_borel set"
- assumes "compact s" "\<forall>t \<in> f. closed t"
- "\<forall>f'. finite f' \<and> f' \<subseteq> f --> (s \<inter> (\<Inter> f') \<noteq> {})"
- shows "s \<inter> (\<Inter> f) \<noteq> {}"
-proof
- assume as:"s \<inter> (\<Inter> f) = {}"
- hence "s \<subseteq> \<Union>op - UNIV ` f" by auto
- moreover have "Ball (op - UNIV ` f) open" using open_Diff closed_Diff using assms(2) by auto
- 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
- hence "finite (op - UNIV ` f') \<and> op - UNIV ` f' \<subseteq> f" by(auto simp add: Diff_Diff_Int)
- hence "s \<inter> \<Inter>op - UNIV ` f' \<noteq> {}" using assms(3)[THEN spec[where x="op - UNIV ` f'"]] by auto
- thus False using f'(3) unfolding subset_eq and Union_iff by blast
-qed
-
-subsection{* Bounded closed nest property (proof does not use Heine-Borel). *}
-
-lemma bounded_closed_nest:
- assumes "\<forall>n. closed(s n)" "\<forall>n. (s n \<noteq> {})"
- "(\<forall>m n. m \<le> n --> s n \<subseteq> s m)" "bounded(s 0)"
- shows "\<exists>a::'a::heine_borel. \<forall>n::nat. a \<in> s(n)"
-proof-
- 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
- from assms(4,1) have *:"compact (s 0)" using bounded_closed_imp_compact[of "s 0"] by auto
-
- then obtain l r where lr:"l\<in>s 0" "subseq r" "((x \<circ> r) ---> l) sequentially"
- unfolding compact_def apply(erule_tac x=x in allE) using x using assms(3) by blast
-
- { fix n::nat
- { fix e::real assume "e>0"
- with lr(3) obtain N where N:"\<forall>m\<ge>N. dist ((x \<circ> r) m) l < e" unfolding Lim_sequentially by auto
- hence "dist ((x \<circ> r) (max N n)) l < e" by auto
- moreover
- have "r (max N n) \<ge> n" using lr(2) using subseq_bigger[of r "max N n"] by auto
- hence "(x \<circ> r) (max N n) \<in> s n"
- using x apply(erule_tac x=n in allE)
- using x apply(erule_tac x="r (max N n)" in allE)
- using assms(3) apply(erule_tac x=n in allE)apply( erule_tac x="r (max N n)" in allE) by auto
- ultimately have "\<exists>y\<in>s n. dist y l < e" by auto
- }
- hence "l \<in> s n" using closed_approachable[of "s n" l] assms(1) by blast
- }
- thus ?thesis by auto
-qed
-
-text{* Decreasing case does not even need compactness, just completeness. *}
-
-lemma decreasing_closed_nest:
- assumes "\<forall>n. closed(s n)"
- "\<forall>n. (s n \<noteq> {})"
- "\<forall>m n. m \<le> n --> s n \<subseteq> s m"
- "\<forall>e>0. \<exists>n. \<forall>x \<in> (s n). \<forall> y \<in> (s n). dist x y < e"
- shows "\<exists>a::'a::heine_borel. \<forall>n::nat. a \<in> s n"
-proof-
- have "\<forall>n. \<exists> x. x\<in>s n" using assms(2) by auto
- hence "\<exists>t. \<forall>n. t n \<in> s n" using choice[of "\<lambda> n x. x \<in> s n"] by auto
- then obtain t where t: "\<forall>n. t n \<in> s n" by auto
- { fix e::real assume "e>0"
- then obtain N where N:"\<forall>x\<in>s N. \<forall>y\<in>s N. dist x y < e" using assms(4) by auto
- { fix m n ::nat assume "N \<le> m \<and> N \<le> n"
- hence "t m \<in> s N" "t n \<in> s N" using assms(3) t unfolding subset_eq t by blast+
- hence "dist (t m) (t n) < e" using N by auto
- }
- hence "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (t m) (t n) < e" by auto
- }
- hence "Cauchy t" unfolding cauchy_def by auto
- then obtain l where l:"(t ---> l) sequentially" using complete_univ unfolding complete_def by auto
- { fix n::nat
- { fix e::real assume "e>0"
- then obtain N::nat where N:"\<forall>n\<ge>N. dist (t n) l < e" using l[unfolded Lim_sequentially] by auto
- 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
- hence "\<exists>y\<in>s n. dist y l < e" apply(rule_tac x="t (max n N)" in bexI) using N by auto
- }
- hence "l \<in> s n" using closed_approachable[of "s n" l] assms(1) by auto
- }
- then show ?thesis by auto
-qed
-
-text{* Strengthen it to the intersection actually being a singleton. *}
-
-lemma decreasing_closed_nest_sing:
- assumes "\<forall>n. closed(s n)"
- "\<forall>n. s n \<noteq> {}"
- "\<forall>m n. m \<le> n --> s n \<subseteq> s m"
- "\<forall>e>0. \<exists>n. \<forall>x \<in> (s n). \<forall> y\<in>(s n). dist x y < e"
- shows "\<exists>a::'a::heine_borel. \<Inter> {t. (\<exists>n::nat. t = s n)} = {a}"
-proof-
- obtain a where a:"\<forall>n. a \<in> s n" using decreasing_closed_nest[of s] using assms by auto
- { fix b assume b:"b \<in> \<Inter>{t. \<exists>n. t = s n}"
- { fix e::real assume "e>0"
- hence "dist a b < e" using assms(4 )using b using a by blast
- }
- hence "dist a b = 0" by (metis dist_eq_0_iff dist_nz real_less_def)
- }
- with a have "\<Inter>{t. \<exists>n. t = s n} = {a}" by auto
- thus ?thesis by auto
-qed
-
-text{* Cauchy-type criteria for uniform convergence. *}
-
-lemma uniformly_convergent_eq_cauchy: fixes s::"nat \<Rightarrow> 'b \<Rightarrow> 'a::heine_borel" shows
- "(\<exists>l. \<forall>e>0. \<exists>N. \<forall>n x. N \<le> n \<and> P x --> dist(s n x)(l x) < e) \<longleftrightarrow>
- (\<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")
-proof(rule)
- assume ?lhs
- 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
- { fix e::real assume "e>0"
- 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
- { fix n m::nat and x::"'b" assume "N \<le> m \<and> N \<le> n \<and> P x"
- hence "dist (s m x) (s n x) < e"
- using N[THEN spec[where x=m], THEN spec[where x=x]]
- using N[THEN spec[where x=n], THEN spec[where x=x]]
- using dist_triangle_half_l[of "s m x" "l x" e "s n x"] by auto }
- 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 }
- thus ?rhs by auto
-next
- assume ?rhs
- 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
- then obtain l where l:"\<forall>x. P x \<longrightarrow> ((\<lambda>n. s n x) ---> l x) sequentially" unfolding convergent_eq_cauchy[THEN sym]
- using choice[of "\<lambda>x l. P x \<longrightarrow> ((\<lambda>n. s n x) ---> l) sequentially"] by auto
- { fix e::real assume "e>0"
- 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"
- using `?rhs`[THEN spec[where x="e/2"]] by auto
- { fix x assume "P x"
- then obtain M where M:"\<forall>n\<ge>M. dist (s n x) (l x) < e/2"
- using l[THEN spec[where x=x], unfolded Lim_sequentially] using `e>0` by(auto elim!: allE[where x="e/2"])
- fix n::nat assume "n\<ge>N"
- 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]]
- 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) }
- hence "\<exists>N. \<forall>n x. N \<le> n \<and> P x \<longrightarrow> dist(s n x)(l x) < e" by auto }
- thus ?lhs by auto
-qed
-
-lemma uniformly_cauchy_imp_uniformly_convergent:
- fixes s :: "nat \<Rightarrow> 'a \<Rightarrow> 'b::heine_borel"
- 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"
- "\<forall>x. P x --> (\<forall>e>0. \<exists>N. \<forall>n. N \<le> n --> dist(s n x)(l x) < e)"
- shows "\<forall>e>0. \<exists>N. \<forall>n x. N \<le> n \<and> P x --> dist(s n x)(l x) < e"
-proof-
- 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"
- using assms(1) unfolding uniformly_convergent_eq_cauchy[THEN sym] by auto
- moreover
- { fix x assume "P x"
- hence "l x = l' x" using Lim_unique[OF trivial_limit_sequentially, of "\<lambda>n. s n x" "l x" "l' x"]
- using l and assms(2) unfolding Lim_sequentially by blast }
- ultimately show ?thesis by auto
-qed
-
-subsection{* Define continuity over a net to take in restrictions of the set. *}
-
-definition
- continuous :: "'a::t2_space net \<Rightarrow> ('a \<Rightarrow> 'b::topological_space) \<Rightarrow> bool" where
- "continuous net f \<longleftrightarrow> (f ---> f(netlimit net)) net"
-
-lemma continuous_trivial_limit:
- "trivial_limit net ==> continuous net f"
- unfolding continuous_def tendsto_def trivial_limit_eq by auto
-
-lemma continuous_within: "continuous (at x within s) f \<longleftrightarrow> (f ---> f(x)) (at x within s)"
- unfolding continuous_def
- unfolding tendsto_def
- using netlimit_within[of x s]
- by (cases "trivial_limit (at x within s)") (auto simp add: trivial_limit_eventually)
-
-lemma continuous_at: "continuous (at x) f \<longleftrightarrow> (f ---> f(x)) (at x)"
- using continuous_within [of x UNIV f] by (simp add: within_UNIV)
-
-lemma continuous_at_within:
- assumes "continuous (at x) f" shows "continuous (at x within s) f"
- using assms unfolding continuous_at continuous_within
- by (rule Lim_at_within)
-
-text{* Derive the epsilon-delta forms, which we often use as "definitions" *}
-
-lemma continuous_within_eps_delta:
- "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)"
- unfolding continuous_within and Lim_within
- apply auto unfolding dist_nz[THEN sym] apply(auto elim!:allE) apply(rule_tac x=d in exI) by auto
-
-lemma continuous_at_eps_delta: "continuous (at x) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0.
- \<forall>x'. dist x' x < d --> dist(f x')(f x) < e)"
- using continuous_within_eps_delta[of x UNIV f]
- unfolding within_UNIV by blast
-
-text{* Versions in terms of open balls. *}
-
-lemma continuous_within_ball:
- "continuous (at x within s) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0.
- f ` (ball x d \<inter> s) \<subseteq> ball (f x) e)" (is "?lhs = ?rhs")
-proof
- assume ?lhs
- { fix e::real assume "e>0"
- 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 `?lhs`[unfolded continuous_within Lim_within] by auto
- { fix y assume "y\<in>f ` (ball x d \<inter> s)"
- hence "y \<in> ball (f x) e" using d(2) unfolding dist_nz[THEN sym]
- apply (auto simp add: dist_commute mem_ball) apply(erule_tac x=xa in ballE) apply auto using `e>0` by auto
- }
- 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) }
- thus ?rhs by auto
-next
- assume ?rhs thus ?lhs unfolding continuous_within Lim_within ball_def subset_eq
- apply (auto simp add: dist_commute) apply(erule_tac x=e in allE) by auto
-qed
-
-lemma continuous_at_ball:
- "continuous (at x) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0. f ` (ball x d) \<subseteq> ball (f x) e)" (is "?lhs = ?rhs")
-proof
- assume ?lhs thus ?rhs unfolding continuous_at Lim_at subset_eq Ball_def Bex_def image_iff mem_ball
- 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)
- unfolding dist_nz[THEN sym] by auto
-next
- assume ?rhs thus ?lhs unfolding continuous_at Lim_at subset_eq Ball_def Bex_def image_iff mem_ball
- 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)
-qed
-
-text{* For setwise continuity, just start from the epsilon-delta definitions. *}
-
-definition
- continuous_on :: "'a::metric_space set \<Rightarrow> ('a \<Rightarrow> 'b::metric_space) \<Rightarrow> bool" where
- "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)"
-
-
-definition
- uniformly_continuous_on ::
- "'a::metric_space set \<Rightarrow> ('a \<Rightarrow> 'b::metric_space) \<Rightarrow> bool" where
- "uniformly_continuous_on s f \<longleftrightarrow>
- (\<forall>e>0. \<exists>d>0. \<forall>x\<in>s. \<forall> x'\<in>s. dist x' x < d
- --> dist (f x') (f x) < e)"
-
-text{* Some simple consequential lemmas. *}
-
-lemma uniformly_continuous_imp_continuous:
- " uniformly_continuous_on s f ==> continuous_on s f"
- unfolding uniformly_continuous_on_def continuous_on_def by blast
-
-lemma continuous_at_imp_continuous_within:
- "continuous (at x) f ==> continuous (at x within s) f"
- unfolding continuous_within continuous_at using Lim_at_within by auto
-
-lemma continuous_at_imp_continuous_on: assumes "(\<forall>x \<in> s. continuous (at x) f)"
- shows "continuous_on s f"
-proof(simp add: continuous_at continuous_on_def, rule, rule, rule)
- fix x and e::real assume "x\<in>s" "e>0"
- hence "eventually (\<lambda>xa. dist (f xa) (f x) < e) (at x)" using assms unfolding continuous_at tendsto_iff by auto
- 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
- { fix x' assume "\<not> 0 < dist x' x"
- hence "x=x'"
- using dist_nz[of x' x] by auto
- hence "dist (f x') (f x) < e" using `e>0` by auto
- }
- thus "\<exists>d>0. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e" using d by auto
-qed
-
-lemma continuous_on_eq_continuous_within:
- "continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. continuous (at x within s) f)" (is "?lhs = ?rhs")
-proof
- assume ?rhs
- { fix x assume "x\<in>s"
- fix e::real assume "e>0"
- assume "\<exists>d>0. \<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e"
- 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
- { fix x' assume as:"x'\<in>s" "dist x' x < d"
- 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) }
- hence "\<exists>d>0. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e" using `d>0` by auto
- }
- thus ?lhs using `?rhs` unfolding continuous_on_def continuous_within Lim_within by auto
-next
- assume ?lhs
- thus ?rhs unfolding continuous_on_def continuous_within Lim_within by blast
-qed
-
-lemma continuous_on:
- "continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. (f ---> f(x)) (at x within s))"
- by (auto simp add: continuous_on_eq_continuous_within continuous_within)
-
-lemma continuous_on_eq_continuous_at:
- "open s ==> (continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. continuous (at x) f))"
- by (auto simp add: continuous_on continuous_at Lim_within_open)
-
-lemma continuous_within_subset:
- "continuous (at x within s) f \<Longrightarrow> t \<subseteq> s
- ==> continuous (at x within t) f"
- unfolding continuous_within by(metis Lim_within_subset)
-
-lemma continuous_on_subset:
- "continuous_on s f \<Longrightarrow> t \<subseteq> s ==> continuous_on t f"
- unfolding continuous_on by (metis subset_eq Lim_within_subset)
-
-lemma continuous_on_interior:
- "continuous_on s f \<Longrightarrow> x \<in> interior s ==> continuous (at x) f"
-unfolding interior_def
-apply simp
-by (meson continuous_on_eq_continuous_at continuous_on_subset)
-
-lemma continuous_on_eq:
- "(\<forall>x \<in> s. f x = g x) \<Longrightarrow> continuous_on s f
- ==> continuous_on s g"
- by (simp add: continuous_on_def)
-
-text{* Characterization of various kinds of continuity in terms of sequences. *}
-
-(* \<longrightarrow> could be generalized, but \<longleftarrow> requires metric space *)
-lemma continuous_within_sequentially:
- fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
- shows "continuous (at a within s) f \<longleftrightarrow>
- (\<forall>x. (\<forall>n::nat. x n \<in> s) \<and> (x ---> a) sequentially
- --> ((f o x) ---> f a) sequentially)" (is "?lhs = ?rhs")
-proof
- assume ?lhs
- { 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"
- fix e::real assume "e>0"
- 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
- from x(2) `d>0` obtain N where N:"\<forall>n\<ge>N. dist (x n) a < d" by auto
- hence "\<exists>N. \<forall>n\<ge>N. dist ((f \<circ> x) n) (f a) < e"
- apply(rule_tac x=N in exI) using N d apply auto using x(1)
- apply(erule_tac x=n in allE) apply(erule_tac x=n in allE)
- apply(erule_tac x="x n" in ballE) apply auto unfolding dist_nz[THEN sym] apply auto using `e>0` by auto
- }
- thus ?rhs unfolding continuous_within unfolding Lim_sequentially by simp
-next
- assume ?rhs
- { fix e::real assume "e>0"
- 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)"
- 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
- 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)"
- 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
- { fix d::real assume "d>0"
- 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
- then obtain N::nat where N:"inverse (real (N + 1)) < d" by auto
- { fix n::nat assume n:"n\<ge>N"
- hence "dist (x (inverse (real (n + 1)))) a < inverse (real (n + 1))" using x[THEN spec[where x="inverse (real (n + 1))"]] by auto
- 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)
- ultimately have "dist (x (inverse (real (n + 1)))) a < d" by auto
- }
- hence "\<exists>N::nat. \<forall>n\<ge>N. dist (x (inverse (real (n + 1)))) a < d" by auto
- }
- 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
- 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
- hence "False" apply(erule_tac x=e in allE) using `e>0` using x by auto
- }
- thus ?lhs unfolding continuous_within unfolding Lim_within unfolding Lim_sequentially by blast
-qed
-
-lemma continuous_at_sequentially:
- fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
- shows "continuous (at a) f \<longleftrightarrow> (\<forall>x. (x ---> a) sequentially
- --> ((f o x) ---> f a) sequentially)"
- using continuous_within_sequentially[of a UNIV f] unfolding within_UNIV by auto
-
-lemma continuous_on_sequentially:
- "continuous_on s f \<longleftrightarrow> (\<forall>x. \<forall>a \<in> s. (\<forall>n. x(n) \<in> s) \<and> (x ---> a) sequentially
- --> ((f o x) ---> f(a)) sequentially)" (is "?lhs = ?rhs")
-proof
- assume ?rhs thus ?lhs using continuous_within_sequentially[of _ s f] unfolding continuous_on_eq_continuous_within by auto
-next
- assume ?lhs thus ?rhs unfolding continuous_on_eq_continuous_within using continuous_within_sequentially[of _ s f] by auto
-qed
-
-lemma uniformly_continuous_on_sequentially:
- fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
- shows "uniformly_continuous_on s f \<longleftrightarrow> (\<forall>x y. (\<forall>n. x n \<in> s) \<and> (\<forall>n. y n \<in> s) \<and>
- ((\<lambda>n. x n - y n) ---> 0) sequentially
- \<longrightarrow> ((\<lambda>n. f(x n) - f(y n)) ---> 0) sequentially)" (is "?lhs = ?rhs")
-proof
- assume ?lhs
- { 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"
- { fix e::real assume "e>0"
- 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"
- using `?lhs`[unfolded uniformly_continuous_on_def, THEN spec[where x=e]] by auto
- 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
- { fix n assume "n\<ge>N"
- hence "norm (f (x n) - f (y n) - 0) < e"
- 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
- unfolding dist_commute and dist_norm by simp }
- hence "\<exists>N. \<forall>n\<ge>N. norm (f (x n) - f (y n) - 0) < e" by auto }
- hence "((\<lambda>n. f(x n) - f(y n)) ---> 0) sequentially" unfolding Lim_sequentially and dist_norm by auto }
- thus ?rhs by auto
-next
- assume ?rhs
- { assume "\<not> ?lhs"
- 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
- 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"
- 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
- by (auto simp add: dist_commute)
- def x \<equiv> "\<lambda>n::nat. fst (fa (inverse (real n + 1)))"
- def y \<equiv> "\<lambda>n::nat. snd (fa (inverse (real n + 1)))"
- 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"
- unfolding x_def and y_def using fa by auto
- have 1:"\<And>(x::'a) y. dist (x - y) 0 = dist x y" unfolding dist_norm by auto
- have 2:"\<And>(x::'b) y. dist (x - y) 0 = dist x y" unfolding dist_norm by auto
- { fix e::real assume "e>0"
- 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
- { fix n::nat assume "n\<ge>N"
- hence "inverse (real n + 1) < inverse (real N)" using real_of_nat_ge_zero and `N\<noteq>0` by auto
- also have "\<dots> < e" using N by auto
- finally have "inverse (real n + 1) < e" by auto
- hence "dist (x n - y n) 0 < e" unfolding 1 using xy0[THEN spec[where x=n]] by auto }
- hence "\<exists>N. \<forall>n\<ge>N. dist (x n - y n) 0 < e" by auto }
- 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
- hence False unfolding 2 using fxy and `e>0` by auto }
- thus ?lhs unfolding uniformly_continuous_on_def by blast
-qed
-
-text{* The usual transformation theorems. *}
-
-lemma continuous_transform_within:
- fixes f g :: "'a::metric_space \<Rightarrow> 'b::metric_space"
- assumes "0 < d" "x \<in> s" "\<forall>x' \<in> s. dist x' x < d --> f x' = g x'"
- "continuous (at x within s) f"
- shows "continuous (at x within s) g"
-proof-
- { fix e::real assume "e>0"
- 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
- { fix x' assume "x'\<in>s" "0 < dist x' x" "dist x' x < (min d d')"
- hence "dist (f x') (g x) < e" using assms(2,3) apply(erule_tac x=x in ballE) using d' by auto }
- 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
- 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 }
- hence "(f ---> g x) (at x within s)" unfolding Lim_within using assms(1) by auto
- thus ?thesis unfolding continuous_within using Lim_transform_within[of d s x f g "g x"] using assms by blast
-qed
-
-lemma continuous_transform_at:
- fixes f g :: "'a::metric_space \<Rightarrow> 'b::metric_space"
- assumes "0 < d" "\<forall>x'. dist x' x < d --> f x' = g x'"
- "continuous (at x) f"
- shows "continuous (at x) g"
-proof-
- { fix e::real assume "e>0"
- 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
- { fix x' assume "0 < dist x' x" "dist x' x < (min d d')"
- hence "dist (f x') (g x) < e" using assms(2) apply(erule_tac x=x in allE) using d' by auto
- }
- hence "\<forall>xa. 0 < dist xa x \<and> dist xa x < (min d d') \<longrightarrow> dist (f xa) (g x) < e" by blast
- 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
- }
- hence "(f ---> g x) (at x)" unfolding Lim_at using assms(1) by auto
- thus ?thesis unfolding continuous_at using Lim_transform_at[of d x f g "g x"] using assms by blast
-qed
-
-text{* Combination results for pointwise continuity. *}
-
-lemma continuous_const: "continuous net (\<lambda>x. c)"
- by (auto simp add: continuous_def Lim_const)
-
-lemma continuous_cmul:
- fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
- shows "continuous net f ==> continuous net (\<lambda>x. c *\<^sub>R f x)"
- by (auto simp add: continuous_def Lim_cmul)
-
-lemma continuous_neg:
- fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
- shows "continuous net f ==> continuous net (\<lambda>x. -(f x))"
- by (auto simp add: continuous_def Lim_neg)
-
-lemma continuous_add:
- fixes f g :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
- shows "continuous net f \<Longrightarrow> continuous net g \<Longrightarrow> continuous net (\<lambda>x. f x + g x)"
- by (auto simp add: continuous_def Lim_add)
-
-lemma continuous_sub:
- fixes f g :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
- shows "continuous net f \<Longrightarrow> continuous net g \<Longrightarrow> continuous net (\<lambda>x. f x - g x)"
- by (auto simp add: continuous_def Lim_sub)
-
-text{* Same thing for setwise continuity. *}
-
-lemma continuous_on_const:
- "continuous_on s (\<lambda>x. c)"
- unfolding continuous_on_eq_continuous_within using continuous_const by blast
-
-lemma continuous_on_cmul:
- fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
- shows "continuous_on s f ==> continuous_on s (\<lambda>x. c *\<^sub>R (f x))"
- unfolding continuous_on_eq_continuous_within using continuous_cmul by blast
-
-lemma continuous_on_neg:
- fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
- shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. - f x)"
- unfolding continuous_on_eq_continuous_within using continuous_neg by blast
-
-lemma continuous_on_add:
- fixes f g :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
- shows "continuous_on s f \<Longrightarrow> continuous_on s g
- \<Longrightarrow> continuous_on s (\<lambda>x. f x + g x)"
- unfolding continuous_on_eq_continuous_within using continuous_add by blast
-
-lemma continuous_on_sub:
- fixes f g :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
- shows "continuous_on s f \<Longrightarrow> continuous_on s g
- \<Longrightarrow> continuous_on s (\<lambda>x. f x - g x)"
- unfolding continuous_on_eq_continuous_within using continuous_sub by blast
-
-text{* Same thing for uniform continuity, using sequential formulations. *}
-
-lemma uniformly_continuous_on_const:
- "uniformly_continuous_on s (\<lambda>x. c)"
- unfolding uniformly_continuous_on_def by simp
-
-lemma uniformly_continuous_on_cmul:
- fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
- (* FIXME: generalize 'a to metric_space *)
- assumes "uniformly_continuous_on s f"
- shows "uniformly_continuous_on s (\<lambda>x. c *\<^sub>R f(x))"
-proof-
- { fix x y assume "((\<lambda>n. f (x n) - f (y n)) ---> 0) sequentially"
- hence "((\<lambda>n. c *\<^sub>R f (x n) - c *\<^sub>R f (y n)) ---> 0) sequentially"
- using Lim_cmul[of "(\<lambda>n. f (x n) - f (y n))" 0 sequentially c]
- unfolding scaleR_zero_right scaleR_right_diff_distrib by auto
- }
- thus ?thesis using assms unfolding uniformly_continuous_on_sequentially by auto
-qed
-
-lemma dist_minus:
- fixes x y :: "'a::real_normed_vector"
- shows "dist (- x) (- y) = dist x y"
- unfolding dist_norm minus_diff_minus norm_minus_cancel ..
-
-lemma uniformly_continuous_on_neg:
- fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
- shows "uniformly_continuous_on s f
- ==> uniformly_continuous_on s (\<lambda>x. -(f x))"
- unfolding uniformly_continuous_on_def dist_minus .
-
-lemma uniformly_continuous_on_add:
- fixes f g :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector" (* FIXME: generalize 'a *)
- assumes "uniformly_continuous_on s f" "uniformly_continuous_on s g"
- shows "uniformly_continuous_on s (\<lambda>x. f x + g x)"
-proof-
- { fix x y assume "((\<lambda>n. f (x n) - f (y n)) ---> 0) sequentially"
- "((\<lambda>n. g (x n) - g (y n)) ---> 0) sequentially"
- hence "((\<lambda>xa. f (x xa) - f (y xa) + (g (x xa) - g (y xa))) ---> 0 + 0) sequentially"
- 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
- 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 }
- thus ?thesis using assms unfolding uniformly_continuous_on_sequentially by auto
-qed
-
-lemma uniformly_continuous_on_sub:
- fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector" (* FIXME: generalize 'a *)
- shows "uniformly_continuous_on s f \<Longrightarrow> uniformly_continuous_on s g
- ==> uniformly_continuous_on s (\<lambda>x. f x - g x)"
- unfolding ab_diff_minus
- using uniformly_continuous_on_add[of s f "\<lambda>x. - g x"]
- using uniformly_continuous_on_neg[of s g] by auto
-
-text{* Identity function is continuous in every sense. *}
-
-lemma continuous_within_id:
- "continuous (at a within s) (\<lambda>x. x)"
- unfolding continuous_within by (rule Lim_at_within [OF Lim_ident_at])
-
-lemma continuous_at_id:
- "continuous (at a) (\<lambda>x. x)"
- unfolding continuous_at by (rule Lim_ident_at)
-
-lemma continuous_on_id:
- "continuous_on s (\<lambda>x. x)"
- unfolding continuous_on Lim_within by auto
-
-lemma uniformly_continuous_on_id:
- "uniformly_continuous_on s (\<lambda>x. x)"
- unfolding uniformly_continuous_on_def by auto
-
-text{* Continuity of all kinds is preserved under composition. *}
-
-lemma continuous_within_compose:
- fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
- fixes g :: "'b::metric_space \<Rightarrow> 'c::metric_space"
- assumes "continuous (at x within s) f" "continuous (at (f x) within f ` s) g"
- shows "continuous (at x within s) (g o f)"
-proof-
- { fix e::real assume "e>0"
- 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
- 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
- { fix y assume as:"y\<in>s" "0 < dist y x" "dist y x < d'"
- hence "dist (f y) (f x) < d" using d'[THEN bspec[where x=y]] by (auto simp add:dist_commute)
- 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 }
- 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 }
- thus ?thesis unfolding continuous_within Lim_within by auto
-qed
-
-lemma continuous_at_compose:
- fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
- fixes g :: "'b::metric_space \<Rightarrow> 'c::metric_space"
- assumes "continuous (at x) f" "continuous (at (f x)) g"
- shows "continuous (at x) (g o f)"
-proof-
- 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
- thus ?thesis using assms(1) using continuous_within_compose[of x UNIV f g, unfolded within_UNIV] by auto
-qed
-
-lemma continuous_on_compose:
- "continuous_on s f \<Longrightarrow> continuous_on (f ` s) g \<Longrightarrow> continuous_on s (g o f)"
- unfolding continuous_on_eq_continuous_within using continuous_within_compose[of _ s f g] by auto
-
-lemma uniformly_continuous_on_compose:
- assumes "uniformly_continuous_on s f" "uniformly_continuous_on (f ` s) g"
- shows "uniformly_continuous_on s (g o f)"
-proof-
- { fix e::real assume "e>0"
- 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
- 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
- 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 }
- thus ?thesis using assms unfolding uniformly_continuous_on_def by auto
-qed
-
-text{* Continuity in terms of open preimages. *}
-
-lemma continuous_at_open:
- fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
- 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")
-proof
- assume ?lhs
- { fix t assume as: "open t" "f x \<in> t"
- then obtain e where "e>0" and e:"ball (f x) e \<subseteq> t" unfolding open_contains_ball by auto
-
- 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
-
- have "open (ball x d)" using open_ball by auto
- moreover have "x \<in> ball x d" unfolding centre_in_ball using `d>0` by simp
- moreover
- { fix x' assume "x'\<in>ball x d" hence "f x' \<in> t"
- using e[unfolded subset_eq Ball_def mem_ball, THEN spec[where x="f x'"]] d[THEN spec[where x=x']]
- unfolding mem_ball apply (auto simp add: dist_commute)
- unfolding dist_nz[THEN sym] using as(2) by auto }
- hence "\<forall>x'\<in>ball x d. f x' \<in> t" by auto
- ultimately have "\<exists>s. open s \<and> x \<in> s \<and> (\<forall>x'\<in>s. f x' \<in> t)"
- apply(rule_tac x="ball x d" in exI) by simp }
- thus ?rhs by auto
-next
- assume ?rhs
- { fix e::real assume "e>0"
- 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"]]
- unfolding centre_in_ball[of "f x" e, THEN sym] by auto
- then obtain d where "d>0" and d:"ball x d \<subseteq> s" unfolding open_contains_ball by auto
- { fix y assume "0 < dist y x \<and> dist y x < d"
- hence "dist (f y) (f x) < e" using d[unfolded subset_eq Ball_def mem_ball, THEN spec[where x=y]]
- using s(3)[THEN bspec[where x=y], unfolded mem_ball] by (auto simp add: dist_commute) }
- 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 }
- thus ?lhs unfolding continuous_at Lim_at by auto
-qed
-
-lemma continuous_on_open:
- "continuous_on s f \<longleftrightarrow>
- (\<forall>t. openin (subtopology euclidean (f ` s)) t
- --> openin (subtopology euclidean s) {x \<in> s. f x \<in> t})" (is "?lhs = ?rhs")
-proof
- assume ?lhs
- { fix t assume as:"openin (subtopology euclidean (f ` s)) t"
- have "{x \<in> s. f x \<in> t} \<subseteq> s" using as[unfolded openin_euclidean_subtopology_iff] by auto
- moreover
- { fix x assume as':"x\<in>{x \<in> s. f x \<in> t}"
- 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
- 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
- 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) }
- ultimately have "openin (subtopology euclidean s) {x \<in> s. f x \<in> t}" unfolding openin_euclidean_subtopology_iff by auto }
- thus ?rhs unfolding continuous_on Lim_within using openin by auto
-next
- assume ?rhs
- { fix e::real and x assume "x\<in>s" "e>0"
- { 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)"
- hence "dist (f x') (f x) < e" using dist_triangle[of "f x'" "f x" "f xa"]
- by (auto simp add: dist_commute) }
- 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
- apply(rule_tac x="e - dist (f xa) (f x)" in exI) using `e>0` by (auto simp add: dist_commute)
- 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}"
- using `?rhs`[unfolded openin_euclidean_subtopology_iff, THEN spec[where x="ball (f x) e \<inter> f ` s"]] by auto
- 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) }
- thus ?lhs unfolding continuous_on Lim_within by auto
-qed
-
-(* ------------------------------------------------------------------------- *)
-(* Similarly in terms of closed sets. *)
-(* ------------------------------------------------------------------------- *)
-
-lemma continuous_on_closed:
- "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")
-proof
- assume ?lhs
- { fix t
- have *:"s - {x \<in> s. f x \<in> f ` s - t} = {x \<in> s. f x \<in> t}" by auto
- have **:"f ` s - (f ` s - (f ` s - t)) = f ` s - t" by auto
- assume as:"closedin (subtopology euclidean (f ` s)) t"
- hence "closedin (subtopology euclidean (f ` s)) (f ` s - (f ` s - t))" unfolding closedin_def topspace_euclidean_subtopology unfolding ** by auto
- 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"]]
- unfolding openin_closedin_eq topspace_euclidean_subtopology unfolding * by auto }
- thus ?rhs by auto
-next
- assume ?rhs
- { fix t
- have *:"s - {x \<in> s. f x \<in> f ` s - t} = {x \<in> s. f x \<in> t}" by auto
- assume as:"openin (subtopology euclidean (f ` s)) t"
- hence "openin (subtopology euclidean s) {x \<in> s. f x \<in> t}" using `?rhs`[THEN spec[where x="(f ` s) - t"]]
- unfolding openin_closedin_eq topspace_euclidean_subtopology *[THEN sym] closedin_subtopology by auto }
- thus ?lhs unfolding continuous_on_open by auto
-qed
-
-text{* Half-global and completely global cases. *}
-
-lemma continuous_open_in_preimage:
- assumes "continuous_on s f" "open t"
- shows "openin (subtopology euclidean s) {x \<in> s. f x \<in> t}"
-proof-
- 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
- have "openin (subtopology euclidean (f ` s)) (t \<inter> f ` s)"
- using openin_open_Int[of t "f ` s", OF assms(2)] unfolding openin_open by auto
- thus ?thesis using assms(1)[unfolded continuous_on_open, THEN spec[where x="t \<inter> f ` s"]] using * by auto
-qed
-
-lemma continuous_closed_in_preimage:
- assumes "continuous_on s f" "closed t"
- shows "closedin (subtopology euclidean s) {x \<in> s. f x \<in> t}"
-proof-
- 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
- have "closedin (subtopology euclidean (f ` s)) (t \<inter> f ` s)"
- using closedin_closed_Int[of t "f ` s", OF assms(2)] unfolding Int_commute by auto
- thus ?thesis
- using assms(1)[unfolded continuous_on_closed, THEN spec[where x="t \<inter> f ` s"]] using * by auto
-qed
-
-lemma continuous_open_preimage:
- assumes "continuous_on s f" "open s" "open t"
- shows "open {x \<in> s. f x \<in> t}"
-proof-
- obtain T where T: "open T" "{x \<in> s. f x \<in> t} = s \<inter> T"
- using continuous_open_in_preimage[OF assms(1,3)] unfolding openin_open by auto
- thus ?thesis using open_Int[of s T, OF assms(2)] by auto
-qed
-
-lemma continuous_closed_preimage:
- assumes "continuous_on s f" "closed s" "closed t"
- shows "closed {x \<in> s. f x \<in> t}"
-proof-
- obtain T where T: "closed T" "{x \<in> s. f x \<in> t} = s \<inter> T"
- using continuous_closed_in_preimage[OF assms(1,3)] unfolding closedin_closed by auto
- thus ?thesis using closed_Int[of s T, OF assms(2)] by auto
-qed
-
-lemma continuous_open_preimage_univ:
- fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
- shows "\<forall>x. continuous (at x) f \<Longrightarrow> open s \<Longrightarrow> open {x. f x \<in> s}"
- using continuous_open_preimage[of UNIV f s] open_UNIV continuous_at_imp_continuous_on by auto
-
-lemma continuous_closed_preimage_univ:
- fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
- shows "(\<forall>x. continuous (at x) f) \<Longrightarrow> closed s ==> closed {x. f x \<in> s}"
- using continuous_closed_preimage[of UNIV f s] closed_UNIV continuous_at_imp_continuous_on by auto
-
-lemma continuous_open_vimage:
- fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
- shows "\<forall>x. continuous (at x) f \<Longrightarrow> open s \<Longrightarrow> open (f -` s)"
- unfolding vimage_def by (rule continuous_open_preimage_univ)
-
-lemma continuous_closed_vimage:
- fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
- shows "\<forall>x. continuous (at x) f \<Longrightarrow> closed s \<Longrightarrow> closed (f -` s)"
- unfolding vimage_def by (rule continuous_closed_preimage_univ)
-
-text{* Equality of continuous functions on closure and related results. *}
-
-lemma continuous_closed_in_preimage_constant:
- "continuous_on s f ==> closedin (subtopology euclidean s) {x \<in> s. f x = a}"
- using continuous_closed_in_preimage[of s f "{a}"] closed_sing by auto
-
-lemma continuous_closed_preimage_constant:
- "continuous_on s f \<Longrightarrow> closed s ==> closed {x \<in> s. f x = a}"
- using continuous_closed_preimage[of s f "{a}"] closed_sing by auto
-
-lemma continuous_constant_on_closure:
- assumes "continuous_on (closure s) f"
- "\<forall>x \<in> s. f x = a"
- shows "\<forall>x \<in> (closure s). f x = a"
- using continuous_closed_preimage_constant[of "closure s" f a]
- assms closure_minimal[of s "{x \<in> closure s. f x = a}"] closure_subset unfolding subset_eq by auto
-
-lemma image_closure_subset:
- assumes "continuous_on (closure s) f" "closed t" "(f ` s) \<subseteq> t"
- shows "f ` (closure s) \<subseteq> t"
-proof-
- have "s \<subseteq> {x \<in> closure s. f x \<in> t}" using assms(3) closure_subset by auto
- moreover have "closed {x \<in> closure s. f x \<in> t}"
- using continuous_closed_preimage[OF assms(1)] and assms(2) by auto
- ultimately have "closure s = {x \<in> closure s . f x \<in> t}"
- using closure_minimal[of s "{x \<in> closure s. f x \<in> t}"] by auto
- thus ?thesis by auto
-qed
-
-lemma continuous_on_closure_norm_le:
- fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
- assumes "continuous_on (closure s) f" "\<forall>y \<in> s. norm(f y) \<le> b" "x \<in> (closure s)"
- shows "norm(f x) \<le> b"
-proof-
- have *:"f ` s \<subseteq> cball 0 b" using assms(2)[unfolded mem_cball_0[THEN sym]] by auto
- show ?thesis
- using image_closure_subset[OF assms(1) closed_cball[of 0 b] *] assms(3)
- unfolding subset_eq apply(erule_tac x="f x" in ballE) by (auto simp add: dist_norm)
-qed
-
-text{* Making a continuous function avoid some value in a neighbourhood. *}
-
-lemma continuous_within_avoid:
- fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
- assumes "continuous (at x within s) f" "x \<in> s" "f x \<noteq> a"
- shows "\<exists>e>0. \<forall>y \<in> s. dist x y < e --> f y \<noteq> a"
-proof-
- 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"
- using assms(1)[unfolded continuous_within Lim_within, THEN spec[where x="dist (f x) a"]] assms(3)[unfolded dist_nz] by auto
- { fix y assume " y\<in>s" "dist x y < d"
- hence "f y \<noteq> a" using d[THEN bspec[where x=y]] assms(3)[unfolded dist_nz]
- apply auto unfolding dist_nz[THEN sym] by (auto simp add: dist_commute) }
- thus ?thesis using `d>0` by auto
-qed
-
-lemma continuous_at_avoid:
- fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
- assumes "continuous (at x) f" "f x \<noteq> a"
- shows "\<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> f y \<noteq> a"
-using assms using continuous_within_avoid[of x UNIV f a, unfolded within_UNIV] by auto
-
-lemma continuous_on_avoid:
- assumes "continuous_on s f" "x \<in> s" "f x \<noteq> a"
- shows "\<exists>e>0. \<forall>y \<in> s. dist x y < e \<longrightarrow> f y \<noteq> a"
-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
-
-lemma continuous_on_open_avoid:
- assumes "continuous_on s f" "open s" "x \<in> s" "f x \<noteq> a"
- shows "\<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> f y \<noteq> a"
-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
-
-text{* Proving a function is constant by proving open-ness of level set. *}
-
-lemma continuous_levelset_open_in_cases:
- "connected s \<Longrightarrow> continuous_on s f \<Longrightarrow>
- openin (subtopology euclidean s) {x \<in> s. f x = a}
- ==> (\<forall>x \<in> s. f x \<noteq> a) \<or> (\<forall>x \<in> s. f x = a)"
-unfolding connected_clopen using continuous_closed_in_preimage_constant by auto
-
-lemma continuous_levelset_open_in:
- "connected s \<Longrightarrow> continuous_on s f \<Longrightarrow>
- openin (subtopology euclidean s) {x \<in> s. f x = a} \<Longrightarrow>
- (\<exists>x \<in> s. f x = a) ==> (\<forall>x \<in> s. f x = a)"
-using continuous_levelset_open_in_cases[of s f ]
-by meson
-
-lemma continuous_levelset_open:
- assumes "connected s" "continuous_on s f" "open {x \<in> s. f x = a}" "\<exists>x \<in> s. f x = a"
- shows "\<forall>x \<in> s. f x = a"
-using continuous_levelset_open_in[OF assms(1,2), of a, unfolded openin_open] using assms (3,4) by auto
-
-text{* Some arithmetical combinations (more to prove). *}
-
-lemma open_scaling[intro]:
- fixes s :: "'a::real_normed_vector set"
- assumes "c \<noteq> 0" "open s"
- shows "open((\<lambda>x. c *\<^sub>R x) ` s)"
-proof-
- { fix x assume "x \<in> s"
- 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
- have "e * abs c > 0" using assms(1)[unfolded zero_less_abs_iff[THEN sym]] using real_mult_order[OF `e>0`] by auto
- moreover
- { fix y assume "dist y (c *\<^sub>R x) < e * \<bar>c\<bar>"
- hence "norm ((1 / c) *\<^sub>R y - x) < e" unfolding dist_norm
- using norm_scaleR[of c "(1 / c) *\<^sub>R y - x", unfolded scaleR_right_diff_distrib, unfolded scaleR_scaleR] assms(1)
- assms(1)[unfolded zero_less_abs_iff[THEN sym]] by (simp del:zero_less_abs_iff)
- 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 }
- 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 }
- thus ?thesis unfolding open_dist by auto
-qed
-
-lemma minus_image_eq_vimage:
- fixes A :: "'a::ab_group_add set"
- shows "(\<lambda>x. - x) ` A = (\<lambda>x. - x) -` A"
- by (auto intro!: image_eqI [where f="\<lambda>x. - x"])
-
-lemma open_negations:
- fixes s :: "'a::real_normed_vector set"
- shows "open s ==> open ((\<lambda> x. -x) ` s)"
- unfolding scaleR_minus1_left [symmetric]
- by (rule open_scaling, auto)
-
-lemma open_translation:
- fixes s :: "'a::real_normed_vector set"
- assumes "open s" shows "open((\<lambda>x. a + x) ` s)"
-proof-
- { 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 }
- 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
- ultimately show ?thesis using continuous_open_preimage_univ[of "\<lambda>x. x - a" s] using assms by auto
-qed
-
-lemma open_affinity:
- fixes s :: "'a::real_normed_vector set"
- assumes "open s" "c \<noteq> 0"
- shows "open ((\<lambda>x. a + c *\<^sub>R x) ` s)"
-proof-
- have *:"(\<lambda>x. a + c *\<^sub>R x) = (\<lambda>x. a + x) \<circ> (\<lambda>x. c *\<^sub>R x)" unfolding o_def ..
- have "op + a ` op *\<^sub>R c ` s = (op + a \<circ> op *\<^sub>R c) ` s" by auto
- thus ?thesis using assms open_translation[of "op *\<^sub>R c ` s" a] unfolding * by auto
-qed
-
-lemma interior_translation:
- fixes s :: "'a::real_normed_vector set"
- shows "interior ((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (interior s)"
-proof (rule set_ext, rule)
- fix x assume "x \<in> interior (op + a ` s)"
- then obtain e where "e>0" and e:"ball x e \<subseteq> op + a ` s" unfolding mem_interior by auto
- 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
- 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
-next
- fix x assume "x \<in> op + a ` interior s"
- 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
- { fix z have *:"a + y - z = y + a - z" by auto
- assume "z\<in>ball x e"
- 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
- hence "z \<in> op + a ` s" unfolding image_iff by(auto intro!: bexI[where x="z - a"]) }
- hence "ball x e \<subseteq> op + a ` s" unfolding subset_eq by auto
- thus "x \<in> interior (op + a ` s)" unfolding mem_interior using `e>0` by auto
-qed
-
-subsection {* Preservation of compactness and connectedness under continuous function. *}
-
-lemma compact_continuous_image:
- assumes "continuous_on s f" "compact s"
- shows "compact(f ` s)"
-proof-
- { fix x assume x:"\<forall>n::nat. x n \<in> f ` s"
- 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
- 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
- { fix e::real assume "e>0"
- 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
- 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
- { 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 }
- hence "\<exists>N. \<forall>n\<ge>N. dist ((x \<circ> r) n) (f l) < e" by auto }
- 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 }
- thus ?thesis unfolding compact_def by auto
-qed
-
-lemma connected_continuous_image:
- assumes "continuous_on s f" "connected s"
- shows "connected(f ` s)"
-proof-
- { fix T assume as: "T \<noteq> {}" "T \<noteq> f ` s" "openin (subtopology euclidean (f ` s)) T" "closedin (subtopology euclidean (f ` s)) T"
- have "{x \<in> s. f x \<in> T} = {} \<or> {x \<in> s. f x \<in> T} = s"
- using assms(1)[unfolded continuous_on_open, THEN spec[where x=T]]
- using assms(1)[unfolded continuous_on_closed, THEN spec[where x=T]]
- using assms(2)[unfolded connected_clopen, THEN spec[where x="{x \<in> s. f x \<in> T}"]] as(3,4) by auto
- hence False using as(1,2)
- using as(4)[unfolded closedin_def topspace_euclidean_subtopology] by auto }
- thus ?thesis unfolding connected_clopen by auto
-qed
-
-text{* Continuity implies uniform continuity on a compact domain. *}
-
-lemma compact_uniformly_continuous:
- assumes "continuous_on s f" "compact s"
- shows "uniformly_continuous_on s f"
-proof-
- { fix x assume x:"x\<in>s"
- 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
- 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 }
- 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
- 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)"
- 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
-
- { fix e::real assume "e>0"
-
- { 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 }
- hence "s \<subseteq> \<Union>{ball x (d x (e / 2)) |x. x \<in> s}" unfolding subset_eq by auto
- moreover
- { fix b assume "b\<in>{ball x (d x (e / 2)) |x. x \<in> s}" hence "open b" by auto }
- 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
-
- { fix x y assume "x\<in>s" "y\<in>s" and as:"dist y x < ea"
- 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
- hence "x\<in>ball z (d z (e / 2))" using `ea>0` unfolding subset_eq by auto
- 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`
- by (auto simp add: dist_commute)
- moreover have "y\<in>ball z (d z (e / 2))" using as and `ea>0` and z[unfolded subset_eq]
- by (auto simp add: dist_commute)
- 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`
- by (auto simp add: dist_commute)
- ultimately have "dist (f y) (f x) < e" using dist_triangle_half_r[of "f z" "f x" e "f y"]
- by (auto simp add: dist_commute) }
- 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 }
- thus ?thesis unfolding uniformly_continuous_on_def by auto
-qed
-
-text{* Continuity of inverse function on compact domain. *}
-
-lemma continuous_on_inverse:
- fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
- (* TODO: can this be generalized more? *)
- assumes "continuous_on s f" "compact s" "\<forall>x \<in> s. g (f x) = x"
- shows "continuous_on (f ` s) g"
-proof-
- have *:"g ` f ` s = s" using assms(3) by (auto simp add: image_iff)
- { fix t assume t:"closedin (subtopology euclidean (g ` f ` s)) t"
- then obtain T where T: "closed T" "t = s \<inter> T" unfolding closedin_closed unfolding * by auto
- have "continuous_on (s \<inter> T) f" using continuous_on_subset[OF assms(1), of "s \<inter> t"]
- unfolding T(2) and Int_left_absorb by auto
- moreover have "compact (s \<inter> T)"
- using assms(2) unfolding compact_eq_bounded_closed
- using bounded_subset[of s "s \<inter> T"] and T(1) by auto
- ultimately have "closed (f ` t)" using T(1) unfolding T(2)
- using compact_continuous_image [of "s \<inter> T" f] unfolding compact_eq_bounded_closed by auto
- moreover have "{x \<in> f ` s. g x \<in> t} = f ` s \<inter> f ` t" using assms(3) unfolding T(2) by auto
- ultimately have "closedin (subtopology euclidean (f ` s)) {x \<in> f ` s. g x \<in> t}"
- unfolding closedin_closed by auto }
- thus ?thesis unfolding continuous_on_closed by auto
-qed
-
-subsection{* A uniformly convergent limit of continuous functions is continuous. *}
-
-lemma norm_triangle_lt:
- fixes x y :: "'a::real_normed_vector"
- shows "norm x + norm y < e \<Longrightarrow> norm (x + y) < e"
-by (rule le_less_trans [OF norm_triangle_ineq])
-
-lemma continuous_uniform_limit:
- fixes f :: "'a \<Rightarrow> 'b::metric_space \<Rightarrow> 'c::real_normed_vector"
- assumes "\<not> (trivial_limit net)" "eventually (\<lambda>n. continuous_on s (f n)) net"
- "\<forall>e>0. eventually (\<lambda>n. \<forall>x \<in> s. norm(f n x - g x) < e) net"
- shows "continuous_on s g"
-proof-
- { fix x and e::real assume "x\<in>s" "e>0"
- 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
- then obtain n where n:"\<forall>xa\<in>s. norm (f n xa - g xa) < e / 3" "continuous_on s (f n)"
- 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
- have "e / 3 > 0" using `e>0` by auto
- 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"
- using n(2)[unfolded continuous_on_def, THEN bspec[where x=x], OF `x\<in>s`, THEN spec[where x="e/3"]] by blast
- { fix y assume "y\<in>s" "dist y x < d"
- hence "dist (f n y) (f n x) < e / 3" using d[THEN bspec[where x=y]] by auto
- 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"]
- 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
- hence "dist (g y) (g x) < e" unfolding dist_norm using n(1)[THEN bspec[where x=y], OF `y\<in>s`]
- 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) }
- hence "\<exists>d>0. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (g x') (g x) < e" using `d>0` by auto }
- thus ?thesis unfolding continuous_on_def by auto
-qed
-
-subsection{* Topological properties of linear functions. *}
-
-lemma linear_lim_0:
- assumes "bounded_linear f" shows "(f ---> 0) (at (0))"
-proof-
- interpret f: bounded_linear f by fact
- have "(f ---> f 0) (at 0)"
- using tendsto_ident_at by (rule f.tendsto)
- thus ?thesis unfolding f.zero .
-qed
-
-lemma linear_continuous_at:
- assumes "bounded_linear f" shows "continuous (at a) f"
- unfolding continuous_at using assms
- apply (rule bounded_linear.tendsto)
- apply (rule tendsto_ident_at)
- done
-
-lemma linear_continuous_within:
- shows "bounded_linear f ==> continuous (at x within s) f"
- using continuous_at_imp_continuous_within[of x f s] using linear_continuous_at[of f] by auto
-
-lemma linear_continuous_on:
- shows "bounded_linear f ==> continuous_on s f"
- using continuous_at_imp_continuous_on[of s f] using linear_continuous_at[of f] by auto
-
-text{* Also bilinear functions, in composition form. *}
-
-lemma bilinear_continuous_at_compose:
- shows "continuous (at x) f \<Longrightarrow> continuous (at x) g \<Longrightarrow> bounded_bilinear h
- ==> continuous (at x) (\<lambda>x. h (f x) (g x))"
- unfolding continuous_at using Lim_bilinear[of f "f x" "(at x)" g "g x" h] by auto
-
-lemma bilinear_continuous_within_compose:
- shows "continuous (at x within s) f \<Longrightarrow> continuous (at x within s) g \<Longrightarrow> bounded_bilinear h
- ==> continuous (at x within s) (\<lambda>x. h (f x) (g x))"
- unfolding continuous_within using Lim_bilinear[of f "f x"] by auto
-
-lemma bilinear_continuous_on_compose:
- shows "continuous_on s f \<Longrightarrow> continuous_on s g \<Longrightarrow> bounded_bilinear h
- ==> continuous_on s (\<lambda>x. h (f x) (g x))"
- 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
- using bilinear_continuous_within_compose[of _ s f g h] by auto
-
-subsection{* Topological stuff lifted from and dropped to R *}
-
-
-lemma open_real:
- fixes s :: "real set" shows
- "open s \<longleftrightarrow>
- (\<forall>x \<in> s. \<exists>e>0. \<forall>x'. abs(x' - x) < e --> x' \<in> s)" (is "?lhs = ?rhs")
- unfolding open_dist dist_norm by simp
-
-lemma islimpt_approachable_real:
- fixes s :: "real set"
- shows "x islimpt s \<longleftrightarrow> (\<forall>e>0. \<exists>x'\<in> s. x' \<noteq> x \<and> abs(x' - x) < e)"
- unfolding islimpt_approachable dist_norm by simp
-
-lemma closed_real:
- fixes s :: "real set"
- shows "closed s \<longleftrightarrow>
- (\<forall>x. (\<forall>e>0. \<exists>x' \<in> s. x' \<noteq> x \<and> abs(x' - x) < e)
- --> x \<in> s)"
- unfolding closed_limpt islimpt_approachable dist_norm by simp
-
-lemma continuous_at_real_range:
- fixes f :: "'a::real_normed_vector \<Rightarrow> real"
- shows "continuous (at x) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0.
- \<forall>x'. norm(x' - x) < d --> abs(f x' - f x) < e)"
- unfolding continuous_at unfolding Lim_at
- unfolding dist_nz[THEN sym] unfolding dist_norm apply auto
- 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
- apply(erule_tac x=e in allE) by auto
-
-lemma continuous_on_real_range:
- fixes f :: "'a::real_normed_vector \<Rightarrow> real"
- 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))"
- unfolding continuous_on_def dist_norm by simp
-
-lemma continuous_at_norm: "continuous (at x) norm"
- unfolding continuous_at by (intro tendsto_intros)
-
-lemma continuous_on_norm: "continuous_on s norm"
-unfolding continuous_on by (intro ballI tendsto_intros)
-
-lemma continuous_at_component: "continuous (at a) (\<lambda>x. x $ i)"
-unfolding continuous_at by (intro tendsto_intros)
-
-lemma continuous_on_component: "continuous_on s (\<lambda>x. x $ i)"
-unfolding continuous_on by (intro ballI tendsto_intros)
-
-lemma continuous_at_infnorm: "continuous (at x) infnorm"
- unfolding continuous_at Lim_at o_def unfolding dist_norm
- apply auto apply (rule_tac x=e in exI) apply auto
- using order_trans[OF real_abs_sub_infnorm infnorm_le_norm, of _ x] by (metis xt1(7))
-
-text{* Hence some handy theorems on distance, diameter etc. of/from a set. *}
-
-lemma compact_attains_sup:
- fixes s :: "real set"
- assumes "compact s" "s \<noteq> {}"
- shows "\<exists>x \<in> s. \<forall>y \<in> s. y \<le> x"
-proof-
- from assms(1) have a:"bounded s" "closed s" unfolding compact_eq_bounded_closed by auto
- { 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"
- have "isLub UNIV s (rsup s)" using rsup[OF assms(2)] unfolding setle_def using as(1) by auto
- moreover have "isUb UNIV s (rsup s - e)" unfolding isUb_def unfolding setle_def using as(4,2) by auto
- ultimately have False using isLub_le_isUb[of UNIV s "rsup s" "rsup s - e"] using `e>0` by auto }
- thus ?thesis using bounded_has_rsup(1)[OF a(1) assms(2)] using a(2)[unfolded closed_real, THEN spec[where x="rsup s"]]
- apply(rule_tac x="rsup s" in bexI) by auto
-qed
-
-lemma compact_attains_inf:
- fixes s :: "real set"
- assumes "compact s" "s \<noteq> {}" shows "\<exists>x \<in> s. \<forall>y \<in> s. x \<le> y"
-proof-
- from assms(1) have a:"bounded s" "closed s" unfolding compact_eq_bounded_closed by auto
- { fix e::real assume as: "\<forall>x\<in>s. x \<ge> rinf s" "rinf s \<notin> s" "0 < e"
- "\<forall>x'\<in>s. x' = rinf s \<or> \<not> abs (x' - rinf s) < e"
- have "isGlb UNIV s (rinf s)" using rinf[OF assms(2)] unfolding setge_def using as(1) by auto
- moreover
- { fix x assume "x \<in> s"
- hence *:"abs (x - rinf s) = x - rinf s" using as(1)[THEN bspec[where x=x]] by auto
- have "rinf s + e \<le> x" using as(4)[THEN bspec[where x=x]] using as(2) `x\<in>s` unfolding * by auto }
- hence "isLb UNIV s (rinf s + e)" unfolding isLb_def and setge_def by auto
- ultimately have False using isGlb_le_isLb[of UNIV s "rinf s" "rinf s + e"] using `e>0` by auto }
- thus ?thesis using bounded_has_rinf(1)[OF a(1) assms(2)] using a(2)[unfolded closed_real, THEN spec[where x="rinf s"]]
- apply(rule_tac x="rinf s" in bexI) by auto
-qed
-
-lemma continuous_attains_sup:
- fixes f :: "'a::metric_space \<Rightarrow> real"
- shows "compact s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> continuous_on s f
- ==> (\<exists>x \<in> s. \<forall>y \<in> s. f y \<le> f x)"
- using compact_attains_sup[of "f ` s"]
- using compact_continuous_image[of s f] by auto
-
-lemma continuous_attains_inf:
- fixes f :: "'a::metric_space \<Rightarrow> real"
- shows "compact s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> continuous_on s f
- \<Longrightarrow> (\<exists>x \<in> s. \<forall>y \<in> s. f x \<le> f y)"
- using compact_attains_inf[of "f ` s"]
- using compact_continuous_image[of s f] by auto
-
-lemma distance_attains_sup:
- assumes "compact s" "s \<noteq> {}"
- shows "\<exists>x \<in> s. \<forall>y \<in> s. dist a y \<le> dist a x"
-proof (rule continuous_attains_sup [OF assms])
- { fix x assume "x\<in>s"
- have "(dist a ---> dist a x) (at x within s)"
- by (intro tendsto_dist tendsto_const Lim_at_within Lim_ident_at)
- }
- thus "continuous_on s (dist a)"
- unfolding continuous_on ..
-qed
-
-text{* For *minimal* distance, we only need closure, not compactness. *}
-
-lemma distance_attains_inf:
- fixes a :: "'a::heine_borel"
- assumes "closed s" "s \<noteq> {}"
- shows "\<exists>x \<in> s. \<forall>y \<in> s. dist a x \<le> dist a y"
-proof-
- from assms(2) obtain b where "b\<in>s" by auto
- let ?B = "cball a (dist b a) \<inter> s"
- have "b \<in> ?B" using `b\<in>s` by (simp add: dist_commute)
- hence "?B \<noteq> {}" by auto
- moreover
- { fix x assume "x\<in>?B"
- fix e::real assume "e>0"
- { fix x' assume "x'\<in>?B" and as:"dist x' x < e"
- from as have "\<bar>dist a x' - dist a x\<bar> < e"
- unfolding abs_less_iff minus_diff_eq
- using dist_triangle2 [of a x' x]
- using dist_triangle [of a x x']
- by arith
- }
- hence "\<exists>d>0. \<forall>x'\<in>?B. dist x' x < d \<longrightarrow> \<bar>dist a x' - dist a x\<bar> < e"
- using `e>0` by auto
- }
- hence "continuous_on (cball a (dist b a) \<inter> s) (dist a)"
- unfolding continuous_on Lim_within dist_norm real_norm_def
- by fast
- moreover have "compact ?B"
- using compact_cball[of a "dist b a"]
- unfolding compact_eq_bounded_closed
- using bounded_Int and closed_Int and assms(1) by auto
- 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"
- using continuous_attains_inf[of ?B "dist a"] by fastsimp
- thus ?thesis by fastsimp
-qed
-
-subsection{* We can now extend limit compositions to consider the scalar multiplier. *}
-
-lemma Lim_mul:
- fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
- assumes "(c ---> d) net" "(f ---> l) net"
- shows "((\<lambda>x. c(x) *\<^sub>R f x) ---> (d *\<^sub>R l)) net"
- using assms by (rule scaleR.tendsto)
-
-lemma Lim_vmul:
- fixes c :: "'a \<Rightarrow> real" and v :: "'b::real_normed_vector"
- shows "(c ---> d) net ==> ((\<lambda>x. c(x) *\<^sub>R v) ---> d *\<^sub>R v) net"
- by (intro tendsto_intros)
-
-lemma continuous_vmul:
- fixes c :: "'a::metric_space \<Rightarrow> real" and v :: "'b::real_normed_vector"
- shows "continuous net c ==> continuous net (\<lambda>x. c(x) *\<^sub>R v)"
- unfolding continuous_def using Lim_vmul[of c] by auto
-
-lemma continuous_mul:
- fixes c :: "'a::metric_space \<Rightarrow> real"
- fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
- shows "continuous net c \<Longrightarrow> continuous net f
- ==> continuous net (\<lambda>x. c(x) *\<^sub>R f x) "
- unfolding continuous_def by (intro tendsto_intros)
-
-lemma continuous_on_vmul:
- fixes c :: "'a::metric_space \<Rightarrow> real" and v :: "'b::real_normed_vector"
- shows "continuous_on s c ==> continuous_on s (\<lambda>x. c(x) *\<^sub>R v)"
- unfolding continuous_on_eq_continuous_within using continuous_vmul[of _ c] by auto
-
-lemma continuous_on_mul:
- fixes c :: "'a::metric_space \<Rightarrow> real"
- fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
- shows "continuous_on s c \<Longrightarrow> continuous_on s f
- ==> continuous_on s (\<lambda>x. c(x) *\<^sub>R f x)"
- unfolding continuous_on_eq_continuous_within using continuous_mul[of _ c] by auto
-
-text{* And so we have continuity of inverse. *}
-
-lemma Lim_inv:
- fixes f :: "'a \<Rightarrow> real"
- assumes "(f ---> l) (net::'a net)" "l \<noteq> 0"
- shows "((inverse o f) ---> inverse l) net"
- unfolding o_def using assms by (rule tendsto_inverse)
-
-lemma continuous_inv:
- fixes f :: "'a::metric_space \<Rightarrow> real"
- shows "continuous net f \<Longrightarrow> f(netlimit net) \<noteq> 0
- ==> continuous net (inverse o f)"
- unfolding continuous_def using Lim_inv by auto
-
-lemma continuous_at_within_inv:
- fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_field"
- assumes "continuous (at a within s) f" "f a \<noteq> 0"
- shows "continuous (at a within s) (inverse o f)"
- using assms unfolding continuous_within o_def
- by (intro tendsto_intros)
-
-lemma continuous_at_inv:
- fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_field"
- shows "continuous (at a) f \<Longrightarrow> f a \<noteq> 0
- ==> continuous (at a) (inverse o f) "
- using within_UNIV[THEN sym, of "at a"] using continuous_at_within_inv[of a UNIV] by auto
-
-subsection{* Preservation properties for pasted sets. *}
-
-lemma bounded_pastecart:
- fixes s :: "('a::real_normed_vector ^ _) set" (* FIXME: generalize to metric_space *)
- assumes "bounded s" "bounded t"
- shows "bounded { pastecart x y | x y . (x \<in> s \<and> y \<in> t)}"
-proof-
- 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
- { fix x y assume "x\<in>s" "y\<in>t"
- hence "norm x \<le> a" "norm y \<le> b" using ab by auto
- hence "norm (pastecart x y) \<le> a + b" using norm_pastecart[of x y] by auto }
- thus ?thesis unfolding bounded_iff by auto
-qed
-
-lemma bounded_Times:
- assumes "bounded s" "bounded t" shows "bounded (s \<times> t)"
-proof-
- obtain x y a b where "\<forall>z\<in>s. dist x z \<le> a" "\<forall>z\<in>t. dist y z \<le> b"
- using assms [unfolded bounded_def] by auto
- then have "\<forall>z\<in>s \<times> t. dist (x, y) z \<le> sqrt (a\<twosuperior> + b\<twosuperior>)"
- by (auto simp add: dist_Pair_Pair real_sqrt_le_mono add_mono power_mono)
- thus ?thesis unfolding bounded_any_center [where a="(x, y)"] by auto
-qed
-
-lemma closed_pastecart:
- fixes s :: "(real ^ 'a::finite) set" (* FIXME: generalize *)
- assumes "closed s" "closed t"
- shows "closed {pastecart x y | x y . x \<in> s \<and> y \<in> t}"
-proof-
- { 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"
- { 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
- moreover
- { fix e::real assume "e>0"
- 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
- { fix n::nat assume "n\<ge>N"
- hence "dist (fstcart (x n)) (fstcart l) < e" "dist (sndcart (x n)) (sndcart l) < e"
- using N[THEN spec[where x=n]] dist_fstcart[of "x n" l] dist_sndcart[of "x n" l] by auto }
- 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 }
- ultimately have "fstcart l \<in> s" "sndcart l \<in> t"
- using assms(1)[unfolded closed_sequential_limits, THEN spec[where x="\<lambda>n. fstcart (x n)"], THEN spec[where x="fstcart l"]]
- using assms(2)[unfolded closed_sequential_limits, THEN spec[where x="\<lambda>n. sndcart (x n)"], THEN spec[where x="sndcart l"]]
- unfolding Lim_sequentially by auto
- 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 }
- thus ?thesis unfolding closed_sequential_limits by auto
-qed
-
-lemma compact_pastecart:
- fixes s t :: "(real ^ _) set"
- shows "compact s \<Longrightarrow> compact t ==> compact {pastecart x y | x y . x \<in> s \<and> y \<in> t}"
- unfolding compact_eq_bounded_closed using bounded_pastecart[of s t] closed_pastecart[of s t] by auto
-
-lemma mem_Times_iff: "x \<in> A \<times> B \<longleftrightarrow> fst x \<in> A \<and> snd x \<in> B"
-by (induct x) simp
-
-lemma compact_Times: "compact s \<Longrightarrow> compact t \<Longrightarrow> compact (s \<times> t)"
-unfolding compact_def
-apply clarify
-apply (drule_tac x="fst \<circ> f" in spec)
-apply (drule mp, simp add: mem_Times_iff)
-apply (clarify, rename_tac l1 r1)
-apply (drule_tac x="snd \<circ> f \<circ> r1" in spec)
-apply (drule mp, simp add: mem_Times_iff)
-apply (clarify, rename_tac l2 r2)
-apply (rule_tac x="(l1, l2)" in rev_bexI, simp)
-apply (rule_tac x="r1 \<circ> r2" in exI)
-apply (rule conjI, simp add: subseq_def)
-apply (drule_tac r=r2 in lim_subseq [COMP swap_prems_rl], assumption)
-apply (drule (1) tendsto_Pair) back
-apply (simp add: o_def)
-done
-
-text{* Hence some useful properties follow quite easily. *}
-
-lemma compact_scaling:
- fixes s :: "'a::real_normed_vector set"
- assumes "compact s" shows "compact ((\<lambda>x. c *\<^sub>R x) ` s)"
-proof-
- let ?f = "\<lambda>x. scaleR c x"
- have *:"bounded_linear ?f" by (rule scaleR.bounded_linear_right)
- show ?thesis using compact_continuous_image[of s ?f] continuous_at_imp_continuous_on[of s ?f]
- using linear_continuous_at[OF *] assms by auto
-qed
-
-lemma compact_negations:
- fixes s :: "'a::real_normed_vector set"
- assumes "compact s" shows "compact ((\<lambda>x. -x) ` s)"
- using compact_scaling [OF assms, of "- 1"] by auto
-
-lemma compact_sums:
- fixes s t :: "'a::real_normed_vector set"
- assumes "compact s" "compact t" shows "compact {x + y | x y. x \<in> s \<and> y \<in> t}"
-proof-
- have *:"{x + y | x y. x \<in> s \<and> y \<in> t} = (\<lambda>z. fst z + snd z) ` (s \<times> t)"
- apply auto unfolding image_iff apply(rule_tac x="(xa, y)" in bexI) by auto
- have "continuous_on (s \<times> t) (\<lambda>z. fst z + snd z)"
- unfolding continuous_on by (rule ballI) (intro tendsto_intros)
- thus ?thesis unfolding * using compact_continuous_image compact_Times [OF assms] by auto
-qed
-
-lemma compact_differences:
- fixes s t :: "'a::real_normed_vector set"
- assumes "compact s" "compact t" shows "compact {x - y | x y. x \<in> s \<and> y \<in> t}"
-proof-
- have "{x - y | x y. x\<in>s \<and> y \<in> t} = {x + y | x y. x \<in> s \<and> y \<in> (uminus ` t)}"
- apply auto apply(rule_tac x= xa in exI) apply auto apply(rule_tac x=xa in exI) by auto
- thus ?thesis using compact_sums[OF assms(1) compact_negations[OF assms(2)]] by auto
-qed
-
-lemma compact_translation:
- fixes s :: "'a::real_normed_vector set"
- assumes "compact s" shows "compact ((\<lambda>x. a + x) ` s)"
-proof-
- have "{x + y |x y. x \<in> s \<and> y \<in> {a}} = (\<lambda>x. a + x) ` s" by auto
- thus ?thesis using compact_sums[OF assms compact_sing[of a]] by auto
-qed
-
-lemma compact_affinity:
- fixes s :: "'a::real_normed_vector set"
- assumes "compact s" shows "compact ((\<lambda>x. a + c *\<^sub>R x) ` s)"
-proof-
- have "op + a ` op *\<^sub>R c ` s = (\<lambda>x. a + c *\<^sub>R x) ` s" by auto
- thus ?thesis using compact_translation[OF compact_scaling[OF assms], of a c] by auto
-qed
-
-text{* Hence we get the following. *}
-
-lemma compact_sup_maxdistance:
- fixes s :: "'a::real_normed_vector set"
- assumes "compact s" "s \<noteq> {}"
- shows "\<exists>x\<in>s. \<exists>y\<in>s. \<forall>u\<in>s. \<forall>v\<in>s. norm(u - v) \<le> norm(x - y)"
-proof-
- have "{x - y | x y . x\<in>s \<and> y\<in>s} \<noteq> {}" using `s \<noteq> {}` by auto
- 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"
- using compact_differences[OF assms(1) assms(1)]
- 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)
- from x(1) obtain a b where "a\<in>s" "b\<in>s" "x = a - b" by auto
- thus ?thesis using x(2)[unfolded `x = a - b`] by blast
-qed
-
-text{* We can state this in terms of diameter of a set. *}
-
-definition "diameter s = (if s = {} then 0::real else rsup {norm(x - y) | x y. x \<in> s \<and> y \<in> s})"
- (* TODO: generalize to class metric_space *)
-
-lemma diameter_bounded:
- assumes "bounded s"
- shows "\<forall>x\<in>s. \<forall>y\<in>s. norm(x - y) \<le> diameter s"
- "\<forall>d>0. d < diameter s --> (\<exists>x\<in>s. \<exists>y\<in>s. norm(x - y) > d)"
-proof-
- let ?D = "{norm (x - y) |x y. x \<in> s \<and> y \<in> s}"
- obtain a where a:"\<forall>x\<in>s. norm x \<le> a" using assms[unfolded bounded_iff] by auto
- { fix x y assume "x \<in> s" "y \<in> s"
- 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) }
- note * = this
- { fix x y assume "x\<in>s" "y\<in>s" hence "s \<noteq> {}" by auto
- have lub:"isLub UNIV ?D (rsup ?D)" using * rsup[of ?D] using `s\<noteq>{}` unfolding setle_def by auto
- 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 }
- moreover
- { fix d::real assume "d>0" "d < diameter s"
- hence "s\<noteq>{}" unfolding diameter_def by auto
- hence lub:"isLub UNIV ?D (rsup ?D)" using * rsup[of ?D] unfolding setle_def by auto
- have "\<exists>d' \<in> ?D. d' > d"
- proof(rule ccontr)
- assume "\<not> (\<exists>d'\<in>{norm (x - y) |x y. x \<in> s \<and> y \<in> s}. d < d')"
- hence as:"\<forall>d'\<in>?D. d' \<le> d" apply auto apply(erule_tac x="norm (x - y)" in allE) by auto
- hence "isUb UNIV ?D d" unfolding isUb_def unfolding setle_def by auto
- thus False using `d < diameter s` `s\<noteq>{}` isLub_le_isUb[OF lub, of d] unfolding diameter_def by auto
- qed
- hence "\<exists>x\<in>s. \<exists>y\<in>s. norm(x - y) > d" by auto }
- ultimately show "\<forall>x\<in>s. \<forall>y\<in>s. norm(x - y) \<le> diameter s"
- "\<forall>d>0. d < diameter s --> (\<exists>x\<in>s. \<exists>y\<in>s. norm(x - y) > d)" by auto
-qed
-
-lemma diameter_bounded_bound:
- "bounded s \<Longrightarrow> x \<in> s \<Longrightarrow> y \<in> s ==> norm(x - y) \<le> diameter s"
- using diameter_bounded by blast
-
-lemma diameter_compact_attained:
- fixes s :: "'a::real_normed_vector set"
- assumes "compact s" "s \<noteq> {}"
- shows "\<exists>x\<in>s. \<exists>y\<in>s. (norm(x - y) = diameter s)"
-proof-
- have b:"bounded s" using assms(1) by (rule compact_imp_bounded)
- 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
- 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)"]
- unfolding setle_def and diameter_def by auto
- thus ?thesis using diameter_bounded(1)[OF b, THEN bspec[where x=x], THEN bspec[where x=y], OF xys] and xys by auto
-qed
-
-text{* Related results with closure as the conclusion. *}
-
-lemma closed_scaling:
- fixes s :: "'a::real_normed_vector set"
- assumes "closed s" shows "closed ((\<lambda>x. c *\<^sub>R x) ` s)"
-proof(cases "s={}")
- case True thus ?thesis by auto
-next
- case False
- show ?thesis
- proof(cases "c=0")
- have *:"(\<lambda>x. 0) ` s = {0}" using `s\<noteq>{}` by auto
- case True thus ?thesis apply auto unfolding * using closed_sing by auto
- next
- case False
- { fix x l assume as:"\<forall>n::nat. x n \<in> scaleR c ` s" "(x ---> l) sequentially"
- { fix n::nat have "scaleR (1 / c) (x n) \<in> s"
- using as(1)[THEN spec[where x=n]]
- using `c\<noteq>0` by (auto simp add: vector_smult_assoc)
- }
- moreover
- { fix e::real assume "e>0"
- hence "0 < e *\<bar>c\<bar>" using `c\<noteq>0` mult_pos_pos[of e "abs c"] by auto
- then obtain N where "\<forall>n\<ge>N. dist (x n) l < e * \<bar>c\<bar>"
- using as(2)[unfolded Lim_sequentially, THEN spec[where x="e * abs c"]] by auto
- hence "\<exists>N. \<forall>n\<ge>N. dist (scaleR (1 / c) (x n)) (scaleR (1 / c) l) < e"
- unfolding dist_norm unfolding scaleR_right_diff_distrib[THEN sym]
- using mult_imp_div_pos_less[of "abs c" _ e] `c\<noteq>0` by auto }
- hence "((\<lambda>n. scaleR (1 / c) (x n)) ---> scaleR (1 / c) l) sequentially" unfolding Lim_sequentially by auto
- ultimately have "l \<in> scaleR c ` s"
- 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"]]
- unfolding image_iff using `c\<noteq>0` apply(rule_tac x="scaleR (1 / c) l" in bexI) by auto }
- thus ?thesis unfolding closed_sequential_limits by fast
- qed
-qed
-
-lemma closed_negations:
- fixes s :: "'a::real_normed_vector set"
- assumes "closed s" shows "closed ((\<lambda>x. -x) ` s)"
- using closed_scaling[OF assms, of "- 1"] by simp
-
-lemma compact_closed_sums:
- fixes s :: "'a::real_normed_vector set"
- assumes "compact s" "closed t" shows "closed {x + y | x y. x \<in> s \<and> y \<in> t}"
-proof-
- let ?S = "{x + y |x y. x \<in> s \<and> y \<in> t}"
- { fix x l assume as:"\<forall>n. x n \<in> ?S" "(x ---> l) sequentially"
- 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"
- using choice[of "\<lambda>n y. x n = (fst y) + (snd y) \<and> fst y \<in> s \<and> snd y \<in> t"] by auto
- obtain l' r where "l'\<in>s" and r:"subseq r" and lr:"(((\<lambda>n. fst (f n)) \<circ> r) ---> l') sequentially"
- using assms(1)[unfolded compact_def, THEN spec[where x="\<lambda> n. fst (f n)"]] using f(2) by auto
- have "((\<lambda>n. snd (f (r n))) ---> l - l') sequentially"
- using Lim_sub[OF lim_subseq[OF r as(2)] lr] and f(1) unfolding o_def by auto
- hence "l - l' \<in> t"
- using assms(2)[unfolded closed_sequential_limits, THEN spec[where x="\<lambda> n. snd (f (r n))"], THEN spec[where x="l - l'"]]
- using f(3) by auto
- 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
- }
- thus ?thesis unfolding closed_sequential_limits by fast
-qed
-
-lemma closed_compact_sums:
- fixes s t :: "'a::real_normed_vector set"
- assumes "closed s" "compact t"
- shows "closed {x + y | x y. x \<in> s \<and> y \<in> t}"
-proof-
- 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
- apply(rule_tac x=y in exI) apply auto apply(rule_tac x=y in exI) by auto
- thus ?thesis using compact_closed_sums[OF assms(2,1)] by simp
-qed
-
-lemma compact_closed_differences:
- fixes s t :: "'a::real_normed_vector set"
- assumes "compact s" "closed t"
- shows "closed {x - y | x y. x \<in> s \<and> y \<in> t}"
-proof-
- have "{x + y |x y. x \<in> s \<and> y \<in> uminus ` t} = {x - y |x y. x \<in> s \<and> y \<in> t}"
- apply auto apply(rule_tac x=xa in exI) apply auto apply(rule_tac x=xa in exI) by auto
- thus ?thesis using compact_closed_sums[OF assms(1) closed_negations[OF assms(2)]] by auto
-qed
-
-lemma closed_compact_differences:
- fixes s t :: "'a::real_normed_vector set"
- assumes "closed s" "compact t"
- shows "closed {x - y | x y. x \<in> s \<and> y \<in> t}"
-proof-
- have "{x + y |x y. x \<in> s \<and> y \<in> uminus ` t} = {x - y |x y. x \<in> s \<and> y \<in> t}"
- apply auto apply(rule_tac x=xa in exI) apply auto apply(rule_tac x=xa in exI) by auto
- thus ?thesis using closed_compact_sums[OF assms(1) compact_negations[OF assms(2)]] by simp
-qed
-
-lemma closed_translation:
- fixes a :: "'a::real_normed_vector"
- assumes "closed s" shows "closed ((\<lambda>x. a + x) ` s)"
-proof-
- have "{a + y |y. y \<in> s} = (op + a ` s)" by auto
- thus ?thesis using compact_closed_sums[OF compact_sing[of a] assms] by auto
-qed
-
-lemma translation_UNIV:
- fixes a :: "'a::ab_group_add" shows "range (\<lambda>x. a + x) = UNIV"
- apply (auto simp add: image_iff) apply(rule_tac x="x - a" in exI) by auto
-
-lemma translation_diff:
- fixes a :: "'a::ab_group_add"
- shows "(\<lambda>x. a + x) ` (s - t) = ((\<lambda>x. a + x) ` s) - ((\<lambda>x. a + x) ` t)"
- by auto
-
-lemma closure_translation:
- fixes a :: "'a::real_normed_vector"
- shows "closure ((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (closure s)"
-proof-
- have *:"op + a ` (UNIV - s) = UNIV - op + a ` s"
- apply auto unfolding image_iff apply(rule_tac x="x - a" in bexI) by auto
- show ?thesis unfolding closure_interior translation_diff translation_UNIV
- using interior_translation[of a "UNIV - s"] unfolding * by auto
-qed
-
-lemma frontier_translation:
- fixes a :: "'a::real_normed_vector"
- shows "frontier((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (frontier s)"
- unfolding frontier_def translation_diff interior_translation closure_translation by auto
-
-subsection{* Separation between points and sets. *}
-
-lemma separate_point_closed:
- fixes s :: "'a::heine_borel set"
- shows "closed s \<Longrightarrow> a \<notin> s ==> (\<exists>d>0. \<forall>x\<in>s. d \<le> dist a x)"
-proof(cases "s = {}")
- case True
- thus ?thesis by(auto intro!: exI[where x=1])
-next
- case False
- assume "closed s" "a \<notin> s"
- 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
- with `x\<in>s` show ?thesis using dist_pos_lt[of a x] and`a \<notin> s` by blast
-qed
-
-lemma separate_compact_closed:
- fixes s t :: "'a::{heine_borel, real_normed_vector} set"
- (* TODO: does this generalize to heine_borel? *)
- assumes "compact s" and "closed t" and "s \<inter> t = {}"
- shows "\<exists>d>0. \<forall>x\<in>s. \<forall>y\<in>t. d \<le> dist x y"
-proof-
- have "0 \<notin> {x - y |x y. x \<in> s \<and> y \<in> t}" using assms(3) by auto
- 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"
- using separate_point_closed[OF compact_closed_differences[OF assms(1,2)], of 0] by auto
- { fix x y assume "x\<in>s" "y\<in>t"
- hence "x - y \<in> {x - y |x y. x \<in> s \<and> y \<in> t}" by auto
- hence "d \<le> dist (x - y) 0" using d[THEN bspec[where x="x - y"]] using dist_commute
- by (auto simp add: dist_commute)
- hence "d \<le> dist x y" unfolding dist_norm by auto }
- thus ?thesis using `d>0` by auto
-qed
-
-lemma separate_closed_compact:
- fixes s t :: "'a::{heine_borel, real_normed_vector} set"
- assumes "closed s" and "compact t" and "s \<inter> t = {}"
- shows "\<exists>d>0. \<forall>x\<in>s. \<forall>y\<in>t. d \<le> dist x y"
-proof-
- have *:"t \<inter> s = {}" using assms(3) by auto
- show ?thesis using separate_compact_closed[OF assms(2,1) *]
- apply auto apply(rule_tac x=d in exI) apply auto apply (erule_tac x=y in ballE)
- by (auto simp add: dist_commute)
-qed
-
-(* A cute way of denoting open and closed intervals using overloading. *)
-
-lemma interval: fixes a :: "'a::ord^'n::finite" shows
- "{a <..< b} = {x::'a^'n. \<forall>i. a$i < x$i \<and> x$i < b$i}" and
- "{a .. b} = {x::'a^'n. \<forall>i. a$i \<le> x$i \<and> x$i \<le> b$i}"
- by (auto simp add: expand_set_eq vector_less_def vector_less_eq_def)
-
-lemma mem_interval: fixes a :: "'a::ord^'n::finite" shows
- "x \<in> {a<..<b} \<longleftrightarrow> (\<forall>i. a$i < x$i \<and> x$i < b$i)"
- "x \<in> {a .. b} \<longleftrightarrow> (\<forall>i. a$i \<le> x$i \<and> x$i \<le> b$i)"
- using interval[of a b] by(auto simp add: expand_set_eq vector_less_def vector_less_eq_def)
-
-lemma mem_interval_1: fixes x :: "real^1" shows
- "(x \<in> {a .. b} \<longleftrightarrow> dest_vec1 a \<le> dest_vec1 x \<and> dest_vec1 x \<le> dest_vec1 b)"
- "(x \<in> {a<..<b} \<longleftrightarrow> dest_vec1 a < dest_vec1 x \<and> dest_vec1 x < dest_vec1 b)"
-by(simp_all add: Cart_eq vector_less_def vector_less_eq_def dest_vec1_def forall_1)
-
-lemma interval_eq_empty: fixes a :: "real^'n::finite" shows
- "({a <..< b} = {} \<longleftrightarrow> (\<exists>i. b$i \<le> a$i))" (is ?th1) and
- "({a .. b} = {} \<longleftrightarrow> (\<exists>i. b$i < a$i))" (is ?th2)
-proof-
- { fix i x assume as:"b$i \<le> a$i" and x:"x\<in>{a <..< b}"
- hence "a $ i < x $ i \<and> x $ i < b $ i" unfolding mem_interval by auto
- hence "a$i < b$i" by auto
- hence False using as by auto }
- moreover
- { assume as:"\<forall>i. \<not> (b$i \<le> a$i)"
- let ?x = "(1/2) *\<^sub>R (a + b)"
- { fix i
- have "a$i < b$i" using as[THEN spec[where x=i]] by auto
- hence "a$i < ((1/2) *\<^sub>R (a+b)) $ i" "((1/2) *\<^sub>R (a+b)) $ i < b$i"
- unfolding vector_smult_component and vector_add_component
- by (auto simp add: less_divide_eq_number_of1) }
- hence "{a <..< b} \<noteq> {}" using mem_interval(1)[of "?x" a b] by auto }
- ultimately show ?th1 by blast
-
- { fix i x assume as:"b$i < a$i" and x:"x\<in>{a .. b}"
- hence "a $ i \<le> x $ i \<and> x $ i \<le> b $ i" unfolding mem_interval by auto
- hence "a$i \<le> b$i" by auto
- hence False using as by auto }
- moreover
- { assume as:"\<forall>i. \<not> (b$i < a$i)"
- let ?x = "(1/2) *\<^sub>R (a + b)"
- { fix i
- have "a$i \<le> b$i" using as[THEN spec[where x=i]] by auto
- hence "a$i \<le> ((1/2) *\<^sub>R (a+b)) $ i" "((1/2) *\<^sub>R (a+b)) $ i \<le> b$i"
- unfolding vector_smult_component and vector_add_component
- by (auto simp add: less_divide_eq_number_of1) }
- hence "{a .. b} \<noteq> {}" using mem_interval(2)[of "?x" a b] by auto }
- ultimately show ?th2 by blast
-qed
-
-lemma interval_ne_empty: fixes a :: "real^'n::finite" shows
- "{a .. b} \<noteq> {} \<longleftrightarrow> (\<forall>i. a$i \<le> b$i)" and
- "{a <..< b} \<noteq> {} \<longleftrightarrow> (\<forall>i. a$i < b$i)"
- unfolding interval_eq_empty[of a b] by (auto simp add: not_less not_le) (* BH: Why doesn't just "auto" work here? *)
-
-lemma subset_interval_imp: fixes a :: "real^'n::finite" shows
- "(\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i) \<Longrightarrow> {c .. d} \<subseteq> {a .. b}" and
- "(\<forall>i. a$i < c$i \<and> d$i < b$i) \<Longrightarrow> {c .. d} \<subseteq> {a<..<b}" and
- "(\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i) \<Longrightarrow> {c<..<d} \<subseteq> {a .. b}" and
- "(\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i) \<Longrightarrow> {c<..<d} \<subseteq> {a<..<b}"
- unfolding subset_eq[unfolded Ball_def] unfolding mem_interval
- by (auto intro: order_trans less_le_trans le_less_trans less_imp_le) (* BH: Why doesn't just "auto" work here? *)
-
-lemma interval_sing: fixes a :: "'a::linorder^'n::finite" shows
- "{a .. a} = {a} \<and> {a<..<a} = {}"
-apply(auto simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
-apply (simp add: order_eq_iff)
-apply (auto simp add: not_less less_imp_le)
-done
-
-lemma interval_open_subset_closed: fixes a :: "'a::preorder^'n::finite" shows
- "{a<..<b} \<subseteq> {a .. b}"
-proof(simp add: subset_eq, rule)
- fix x
- assume x:"x \<in>{a<..<b}"
- { fix i
- have "a $ i \<le> x $ i"
- using x order_less_imp_le[of "a$i" "x$i"]
- by(simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
- }
- moreover
- { fix i
- have "x $ i \<le> b $ i"
- using x order_less_imp_le[of "x$i" "b$i"]
- by(simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
- }
- ultimately
- show "a \<le> x \<and> x \<le> b"
- by(simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
-qed
-
-lemma subset_interval: fixes a :: "real^'n::finite" shows
- "{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
- "{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
- "{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
- "{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)
-proof-
- show ?th1 unfolding subset_eq and Ball_def and mem_interval by (auto intro: order_trans)
- 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)
- { assume as: "{c<..<d} \<subseteq> {a .. b}" "\<forall>i. c$i < d$i"
- hence "{c<..<d} \<noteq> {}" unfolding interval_eq_empty by (auto, drule_tac x=i in spec, simp) (* BH: Why doesn't just "auto" work? *)
- fix i
- (** TODO combine the following two parts as done in the HOL_light version. **)
- { let ?x = "(\<chi> j. (if j=i then ((min (a$j) (d$j))+c$j)/2 else (c$j+d$j)/2))::real^'n"
- assume as2: "a$i > c$i"
- { fix j
- have "c $ j < ?x $ j \<and> ?x $ j < d $ j" unfolding Cart_lambda_beta
- apply(cases "j=i") using as(2)[THEN spec[where x=j]]
- by (auto simp add: less_divide_eq_number_of1 as2) }
- hence "?x\<in>{c<..<d}" unfolding mem_interval by auto
- moreover
- have "?x\<notin>{a .. b}"
- unfolding mem_interval apply auto apply(rule_tac x=i in exI)
- using as(2)[THEN spec[where x=i]] and as2
- by (auto simp add: less_divide_eq_number_of1)
- ultimately have False using as by auto }
- hence "a$i \<le> c$i" by(rule ccontr)auto
- moreover
- { let ?x = "(\<chi> j. (if j=i then ((max (b$j) (c$j))+d$j)/2 else (c$j+d$j)/2))::real^'n"
- assume as2: "b$i < d$i"
- { fix j
- have "d $ j > ?x $ j \<and> ?x $ j > c $ j" unfolding Cart_lambda_beta
- apply(cases "j=i") using as(2)[THEN spec[where x=j]]
- by (auto simp add: less_divide_eq_number_of1 as2) }
- hence "?x\<in>{c<..<d}" unfolding mem_interval by auto
- moreover
- have "?x\<notin>{a .. b}"
- unfolding mem_interval apply auto apply(rule_tac x=i in exI)
- using as(2)[THEN spec[where x=i]] and as2
- by (auto simp add: less_divide_eq_number_of1)
- ultimately have False using as by auto }
- hence "b$i \<ge> d$i" by(rule ccontr)auto
- ultimately
- have "a$i \<le> c$i \<and> d$i \<le> b$i" by auto
- } note part1 = this
- 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)+
- { assume as:"{c<..<d} \<subseteq> {a<..<b}" "\<forall>i. c$i < d$i"
- fix i
- from as(1) have "{c<..<d} \<subseteq> {a..b}" using interval_open_subset_closed[of a b] by auto
- hence "a$i \<le> c$i \<and> d$i \<le> b$i" using part1 and as(2) by auto } note * = this
- 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)+
-qed
-
-lemma disjoint_interval: fixes a::"real^'n::finite" shows
- "{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
- "{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
- "{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
- "{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)
-proof-
- let ?z = "(\<chi> i. ((max (a$i) (c$i)) + (min (b$i) (d$i))) / 2)::real^'n"
- show ?th1 ?th2 ?th3 ?th4
- unfolding expand_set_eq and Int_iff and empty_iff and mem_interval and all_conj_distrib[THEN sym] and eq_False
- apply (auto elim!: allE[where x="?z"])
- apply ((rule_tac x=x in exI, force) | (rule_tac x=i in exI, force))+
- done
-qed
-
-lemma inter_interval: fixes a :: "'a::linorder^'n::finite" shows
- "{a .. b} \<inter> {c .. d} = {(\<chi> i. max (a$i) (c$i)) .. (\<chi> i. min (b$i) (d$i))}"
- unfolding expand_set_eq and Int_iff and mem_interval
- by (auto simp add: less_divide_eq_number_of1 intro!: bexI)
-
-(* Moved interval_open_subset_closed a bit upwards *)
-
-lemma open_interval_lemma: fixes x :: "real" shows
- "a < x \<Longrightarrow> x < b ==> (\<exists>d>0. \<forall>x'. abs(x' - x) < d --> a < x' \<and> x' < b)"
- by(rule_tac x="min (x - a) (b - x)" in exI, auto)
-
-lemma open_interval: fixes a :: "real^'n::finite" shows "open {a<..<b}"
-proof-
- { fix x assume x:"x\<in>{a<..<b}"
- { fix i
- have "\<exists>d>0. \<forall>x'. abs (x' - (x$i)) < d \<longrightarrow> a$i < x' \<and> x' < b$i"
- using x[unfolded mem_interval, THEN spec[where x=i]]
- using open_interval_lemma[of "a$i" "x$i" "b$i"] by auto }
-
- hence "\<forall>i. \<exists>d>0. \<forall>x'. abs (x' - (x$i)) < d \<longrightarrow> a$i < x' \<and> x' < b$i" by auto
- 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)"
- 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
-
- let ?d = "Min (range d)"
- have **:"finite (range d)" "range d \<noteq> {}" by auto
- have "?d>0" unfolding Min_gr_iff[OF **] using d by auto
- moreover
- { fix x' assume as:"dist x' x < ?d"
- { fix i
- have "\<bar>x'$i - x $ i\<bar> < d i"
- using norm_bound_component_lt[OF as[unfolded dist_norm], of i]
- unfolding vector_minus_component and Min_gr_iff[OF **] by auto
- hence "a $ i < x' $ i" "x' $ i < b $ i" using d[THEN spec[where x=i]] by auto }
- hence "a < x' \<and> x' < b" unfolding vector_less_def by auto }
- 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)
- }
- thus ?thesis unfolding open_dist using open_interval_lemma by auto
-qed
-
-lemma closed_interval: fixes a :: "real^'n::finite" shows "closed {a .. b}"
-proof-
- { 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"*)
- { assume xa:"a$i > x$i"
- 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
- hence False unfolding mem_interval and dist_norm
- using component_le_norm[of "y-x" i, unfolded vector_minus_component] and xa by(auto elim!: allE[where x=i])
- } hence "a$i \<le> x$i" by(rule ccontr)auto
- moreover
- { assume xb:"b$i < x$i"
- 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
- hence False unfolding mem_interval and dist_norm
- using component_le_norm[of "y-x" i, unfolded vector_minus_component] and xb by(auto elim!: allE[where x=i])
- } hence "x$i \<le> b$i" by(rule ccontr)auto
- ultimately
- have "a $ i \<le> x $ i \<and> x $ i \<le> b $ i" by auto }
- thus ?thesis unfolding closed_limpt islimpt_approachable mem_interval by auto
-qed
-
-lemma interior_closed_interval: fixes a :: "real^'n::finite" shows
- "interior {a .. b} = {a<..<b}" (is "?L = ?R")
-proof(rule subset_antisym)
- show "?R \<subseteq> ?L" using interior_maximal[OF interval_open_subset_closed open_interval] by auto
-next
- { fix x assume "\<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> {a..b}"
- then obtain s where s:"open s" "x \<in> s" "s \<subseteq> {a..b}" by auto
- 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
- { fix i
- have "dist (x - (e / 2) *\<^sub>R basis i) x < e"
- "dist (x + (e / 2) *\<^sub>R basis i) x < e"
- unfolding dist_norm apply auto
- unfolding norm_minus_cancel using norm_basis[of i] and `e>0` by auto
- hence "a $ i \<le> (x - (e / 2) *\<^sub>R basis i) $ i"
- "(x + (e / 2) *\<^sub>R basis i) $ i \<le> b $ i"
- using e[THEN spec[where x="x - (e/2) *\<^sub>R basis i"]]
- and e[THEN spec[where x="x + (e/2) *\<^sub>R basis i"]]
- unfolding mem_interval by (auto elim!: allE[where x=i])
- hence "a $ i < x $ i" and "x $ i < b $ i"
- unfolding vector_minus_component and vector_add_component
- unfolding vector_smult_component and basis_component using `e>0` by auto }
- hence "x \<in> {a<..<b}" unfolding mem_interval by auto }
- thus "?L \<subseteq> ?R" unfolding interior_def and subset_eq by auto
-qed
-
-lemma bounded_closed_interval: fixes a :: "real^'n::finite" shows
- "bounded {a .. b}"
-proof-
- let ?b = "\<Sum>i\<in>UNIV. \<bar>a$i\<bar> + \<bar>b$i\<bar>"
- { fix x::"real^'n" assume x:"\<forall>i. a $ i \<le> x $ i \<and> x $ i \<le> b $ i"
- { fix i
- have "\<bar>x$i\<bar> \<le> \<bar>a$i\<bar> + \<bar>b$i\<bar>" using x[THEN spec[where x=i]] by auto }
- hence "(\<Sum>i\<in>UNIV. \<bar>x $ i\<bar>) \<le> ?b" by(rule setsum_mono)
- hence "norm x \<le> ?b" using norm_le_l1[of x] by auto }
- thus ?thesis unfolding interval and bounded_iff by auto
-qed
-
-lemma bounded_interval: fixes a :: "real^'n::finite" shows
- "bounded {a .. b} \<and> bounded {a<..<b}"
- using bounded_closed_interval[of a b]
- using interval_open_subset_closed[of a b]
- using bounded_subset[of "{a..b}" "{a<..<b}"]
- by simp
-
-lemma not_interval_univ: fixes a :: "real^'n::finite" shows
- "({a .. b} \<noteq> UNIV) \<and> ({a<..<b} \<noteq> UNIV)"
- using bounded_interval[of a b]
- by auto
-
-lemma compact_interval: fixes a :: "real^'n::finite" shows
- "compact {a .. b}"
- using bounded_closed_imp_compact using bounded_interval[of a b] using closed_interval[of a b] by auto
-
-lemma open_interval_midpoint: fixes a :: "real^'n::finite"
- assumes "{a<..<b} \<noteq> {}" shows "((1/2) *\<^sub>R (a + b)) \<in> {a<..<b}"
-proof-
- { fix i
- have "a $ i < ((1 / 2) *\<^sub>R (a + b)) $ i \<and> ((1 / 2) *\<^sub>R (a + b)) $ i < b $ i"
- using assms[unfolded interval_ne_empty, THEN spec[where x=i]]
- unfolding vector_smult_component and vector_add_component
- by(auto simp add: less_divide_eq_number_of1) }
- thus ?thesis unfolding mem_interval by auto
-qed
-
-lemma open_closed_interval_convex: fixes x :: "real^'n::finite"
- assumes x:"x \<in> {a<..<b}" and y:"y \<in> {a .. b}" and e:"0 < e" "e \<le> 1"
- shows "(e *\<^sub>R x + (1 - e) *\<^sub>R y) \<in> {a<..<b}"
-proof-
- { fix i
- have "a $ i = e * a$i + (1 - e) * a$i" unfolding left_diff_distrib by simp
- also have "\<dots> < e * x $ i + (1 - e) * y $ i" apply(rule add_less_le_mono)
- using e unfolding mult_less_cancel_left and mult_le_cancel_left apply simp_all
- using x unfolding mem_interval apply simp
- using y unfolding mem_interval apply simp
- done
- finally have "a $ i < (e *\<^sub>R x + (1 - e) *\<^sub>R y) $ i" by auto
- moreover {
- have "b $ i = e * b$i + (1 - e) * b$i" unfolding left_diff_distrib by simp
- also have "\<dots> > e * x $ i + (1 - e) * y $ i" apply(rule add_less_le_mono)
- using e unfolding mult_less_cancel_left and mult_le_cancel_left apply simp_all
- using x unfolding mem_interval apply simp
- using y unfolding mem_interval apply simp
- done
- finally have "(e *\<^sub>R x + (1 - e) *\<^sub>R y) $ i < b $ i" by auto
- } 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 }
- thus ?thesis unfolding mem_interval by auto
-qed
-
-lemma closure_open_interval: fixes a :: "real^'n::finite"
- assumes "{a<..<b} \<noteq> {}"
- shows "closure {a<..<b} = {a .. b}"
-proof-
- have ab:"a < b" using assms[unfolded interval_ne_empty] unfolding vector_less_def by auto
- let ?c = "(1 / 2) *\<^sub>R (a + b)"
- { fix x assume as:"x \<in> {a .. b}"
- def f == "\<lambda>n::nat. x + (inverse (real n + 1)) *\<^sub>R (?c - x)"
- { fix n assume fn:"f n < b \<longrightarrow> a < f n \<longrightarrow> f n = x" and xc:"x \<noteq> ?c"
- have *:"0 < inverse (real n + 1)" "inverse (real n + 1) \<le> 1" unfolding inverse_le_1_iff by auto
- have "(inverse (real n + 1)) *\<^sub>R ((1 / 2) *\<^sub>R (a + b)) + (1 - inverse (real n + 1)) *\<^sub>R x =
- x + (inverse (real n + 1)) *\<^sub>R (((1 / 2) *\<^sub>R (a + b)) - x)"
- by (auto simp add: algebra_simps)
- 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
- hence False using fn unfolding f_def using xc by(auto simp add: vector_mul_lcancel vector_ssub_ldistrib) }
- moreover
- { assume "\<not> (f ---> x) sequentially"
- { fix e::real assume "e>0"
- 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
- then obtain N::nat where "inverse (real (N + 1)) < e" by auto
- 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)
- hence "\<exists>N::nat. \<forall>n\<ge>N. inverse (real n + 1) < e" by auto }
- hence "((\<lambda>n. inverse (real n + 1)) ---> 0) sequentially"
- unfolding Lim_sequentially by(auto simp add: dist_norm)
- hence "(f ---> x) sequentially" unfolding f_def
- 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]
- using Lim_vmul[of "\<lambda>n::nat. inverse (real n + 1)" 0 sequentially "((1 / 2) *\<^sub>R (a + b) - x)"] by auto }
- ultimately have "x \<in> closure {a<..<b}"
- using as and open_interval_midpoint[OF assms] unfolding closure_def unfolding islimpt_sequential by(cases "x=?c")auto }
- thus ?thesis using closure_minimal[OF interval_open_subset_closed closed_interval, of a b] by blast
-qed
-
-lemma bounded_subset_open_interval_symmetric: fixes s::"(real^'n::finite) set"
- assumes "bounded s" shows "\<exists>a. s \<subseteq> {-a<..<a}"
-proof-
- obtain b where "b>0" and b:"\<forall>x\<in>s. norm x \<le> b" using assms[unfolded bounded_pos] by auto
- def a \<equiv> "(\<chi> i. b+1)::real^'n"
- { fix x assume "x\<in>s"
- fix i
- 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]
- unfolding vector_uminus_component and a_def and Cart_lambda_beta by auto
- }
- thus ?thesis by(auto intro: exI[where x=a] simp add: vector_less_def)
-qed
-
-lemma bounded_subset_open_interval:
- fixes s :: "(real ^ 'n::finite) set"
- shows "bounded s ==> (\<exists>a b. s \<subseteq> {a<..<b})"
- by (auto dest!: bounded_subset_open_interval_symmetric)
-
-lemma bounded_subset_closed_interval_symmetric:
- fixes s :: "(real ^ 'n::finite) set"
- assumes "bounded s" shows "\<exists>a. s \<subseteq> {-a .. a}"
-proof-
- obtain a where "s \<subseteq> {- a<..<a}" using bounded_subset_open_interval_symmetric[OF assms] by auto
- thus ?thesis using interval_open_subset_closed[of "-a" a] by auto
-qed
-
-lemma bounded_subset_closed_interval:
- fixes s :: "(real ^ 'n::finite) set"
- shows "bounded s ==> (\<exists>a b. s \<subseteq> {a .. b})"
- using bounded_subset_closed_interval_symmetric[of s] by auto
-
-lemma frontier_closed_interval:
- fixes a b :: "real ^ _"
- shows "frontier {a .. b} = {a .. b} - {a<..<b}"
- unfolding frontier_def unfolding interior_closed_interval and closure_closed[OF closed_interval] ..
-
-lemma frontier_open_interval:
- fixes a b :: "real ^ _"
- shows "frontier {a<..<b} = (if {a<..<b} = {} then {} else {a .. b} - {a<..<b})"
-proof(cases "{a<..<b} = {}")
- case True thus ?thesis using frontier_empty by auto
-next
- case False thus ?thesis unfolding frontier_def and closure_open_interval[OF False] and interior_open[OF open_interval] by auto
-qed
-
-lemma inter_interval_mixed_eq_empty: fixes a :: "real^'n::finite"
- assumes "{c<..<d} \<noteq> {}" shows "{a<..<b} \<inter> {c .. d} = {} \<longleftrightarrow> {a<..<b} \<inter> {c<..<d} = {}"
- unfolding closure_open_interval[OF assms, THEN sym] unfolding open_inter_closure_eq_empty[OF open_interval] ..
-
-
-(* Some special cases for intervals in R^1. *)
-
-lemma all_1: "(\<forall>x::1. P x) \<longleftrightarrow> P 1"
- by (metis num1_eq_iff)
-
-lemma ex_1: "(\<exists>x::1. P x) \<longleftrightarrow> P 1"
- by auto (metis num1_eq_iff)
-
-lemma interval_cases_1: fixes x :: "real^1" shows
- "x \<in> {a .. b} ==> x \<in> {a<..<b} \<or> (x = a) \<or> (x = b)"
- by(simp add: Cart_eq vector_less_def vector_less_eq_def all_1, auto)
-
-lemma in_interval_1: fixes x :: "real^1" shows
- "(x \<in> {a .. b} \<longleftrightarrow> dest_vec1 a \<le> dest_vec1 x \<and> dest_vec1 x \<le> dest_vec1 b) \<and>
- (x \<in> {a<..<b} \<longleftrightarrow> dest_vec1 a < dest_vec1 x \<and> dest_vec1 x < dest_vec1 b)"
-by(simp add: Cart_eq vector_less_def vector_less_eq_def all_1 dest_vec1_def)
-
-lemma interval_eq_empty_1: fixes a :: "real^1" shows
- "{a .. b} = {} \<longleftrightarrow> dest_vec1 b < dest_vec1 a"
- "{a<..<b} = {} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a"
- unfolding interval_eq_empty and ex_1 and dest_vec1_def by auto
-
-lemma subset_interval_1: fixes a :: "real^1" shows
- "({a .. b} \<subseteq> {c .. d} \<longleftrightarrow> dest_vec1 b < dest_vec1 a \<or>
- dest_vec1 c \<le> dest_vec1 a \<and> dest_vec1 a \<le> dest_vec1 b \<and> dest_vec1 b \<le> dest_vec1 d)"
- "({a .. b} \<subseteq> {c<..<d} \<longleftrightarrow> dest_vec1 b < dest_vec1 a \<or>
- dest_vec1 c < dest_vec1 a \<and> dest_vec1 a \<le> dest_vec1 b \<and> dest_vec1 b < dest_vec1 d)"
- "({a<..<b} \<subseteq> {c .. d} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a \<or>
- dest_vec1 c \<le> dest_vec1 a \<and> dest_vec1 a < dest_vec1 b \<and> dest_vec1 b \<le> dest_vec1 d)"
- "({a<..<b} \<subseteq> {c<..<d} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a \<or>
- dest_vec1 c \<le> dest_vec1 a \<and> dest_vec1 a < dest_vec1 b \<and> dest_vec1 b \<le> dest_vec1 d)"
- unfolding subset_interval[of a b c d] unfolding all_1 and dest_vec1_def by auto
-
-lemma eq_interval_1: fixes a :: "real^1" shows
- "{a .. b} = {c .. d} \<longleftrightarrow>
- dest_vec1 b < dest_vec1 a \<and> dest_vec1 d < dest_vec1 c \<or>
- dest_vec1 a = dest_vec1 c \<and> dest_vec1 b = dest_vec1 d"
-using set_eq_subset[of "{a .. b}" "{c .. d}"]
-using subset_interval_1(1)[of a b c d]
-using subset_interval_1(1)[of c d a b]
-by auto (* FIXME: slow *)
-
-lemma disjoint_interval_1: fixes a :: "real^1" shows
- "{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"
- "{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"
- "{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"
- "{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"
- unfolding disjoint_interval and dest_vec1_def ex_1 by auto
-
-lemma open_closed_interval_1: fixes a :: "real^1" shows
- "{a<..<b} = {a .. b} - {a, b}"
- 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
-
-lemma closed_open_interval_1: "dest_vec1 (a::real^1) \<le> dest_vec1 b ==> {a .. b} = {a<..<b} \<union> {a,b}"
- 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
-
-(* Some stuff for half-infinite intervals too; FIXME: notation? *)
-
-lemma closed_interval_left: fixes b::"real^'n::finite"
- shows "closed {x::real^'n. \<forall>i. x$i \<le> b$i}"
-proof-
- { fix i
- 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"
- { assume "x$i > b$i"
- 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
- hence False using component_le_norm[of "y - x" i] unfolding dist_norm and vector_minus_component by auto }
- hence "x$i \<le> b$i" by(rule ccontr)auto }
- thus ?thesis unfolding closed_limpt unfolding islimpt_approachable by blast
-qed
-
-lemma closed_interval_right: fixes a::"real^'n::finite"
- shows "closed {x::real^'n. \<forall>i. a$i \<le> x$i}"
-proof-
- { fix i
- 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"
- { assume "a$i > x$i"
- 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
- hence False using component_le_norm[of "y - x" i] unfolding dist_norm and vector_minus_component by auto }
- hence "a$i \<le> x$i" by(rule ccontr)auto }
- thus ?thesis unfolding closed_limpt unfolding islimpt_approachable by blast
-qed
-
-subsection{* Intervals in general, including infinite and mixtures of open and closed. *}
-
-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)"
-
-lemma is_interval_interval: "is_interval {a .. b::real^'n::finite}" (is ?th1) "is_interval {a<..<b}" (is ?th2) proof -
- have *:"\<And>x y z::real. x < y \<Longrightarrow> y < z \<Longrightarrow> x < z" by auto
- show ?th1 ?th2 unfolding is_interval_def mem_interval Ball_def atLeastAtMost_iff
- by(meson real_le_trans le_less_trans less_le_trans *)+ qed
-
-lemma is_interval_empty:
- "is_interval {}"
- unfolding is_interval_def
- by simp
-
-lemma is_interval_univ:
- "is_interval UNIV"
- unfolding is_interval_def
- by simp
-
-subsection{* Closure of halfspaces and hyperplanes. *}
-
-lemma Lim_inner:
- assumes "(f ---> l) net" shows "((\<lambda>y. inner a (f y)) ---> inner a l) net"
- by (intro tendsto_intros assms)
-
-lemma continuous_at_inner: "continuous (at x) (inner a)"
- unfolding continuous_at by (intro tendsto_intros)
-
-lemma continuous_on_inner:
- fixes s :: "'a::real_inner set"
- shows "continuous_on s (inner a)"
- unfolding continuous_on by (rule ballI) (intro tendsto_intros)
-
-lemma closed_halfspace_le: "closed {x. inner a x \<le> b}"
-proof-
- have "\<forall>x. continuous (at x) (inner a)"
- unfolding continuous_at by (rule allI) (intro tendsto_intros)
- hence "closed (inner a -` {..b})"
- using closed_real_atMost by (rule continuous_closed_vimage)
- moreover have "{x. inner a x \<le> b} = inner a -` {..b}" by auto
- ultimately show ?thesis by simp
-qed
-
-lemma closed_halfspace_ge: "closed {x. inner a x \<ge> b}"
- using closed_halfspace_le[of "-a" "-b"] unfolding inner_minus_left by auto
-
-lemma closed_hyperplane: "closed {x. inner a x = b}"
-proof-
- have "{x. inner a x = b} = {x. inner a x \<ge> b} \<inter> {x. inner a x \<le> b}" by auto
- thus ?thesis using closed_halfspace_le[of a b] and closed_halfspace_ge[of b a] using closed_Int by auto
-qed
-
-lemma closed_halfspace_component_le:
- shows "closed {x::real^'n::finite. x$i \<le> a}"
- using closed_halfspace_le[of "(basis i)::real^'n" a] unfolding inner_basis[OF assms] by auto
-
-lemma closed_halfspace_component_ge:
- shows "closed {x::real^'n::finite. x$i \<ge> a}"
- using closed_halfspace_ge[of a "(basis i)::real^'n"] unfolding inner_basis[OF assms] by auto
-
-text{* Openness of halfspaces. *}
-
-lemma open_halfspace_lt: "open {x. inner a x < b}"
-proof-
- have "UNIV - {x. b \<le> inner a x} = {x. inner a x < b}" by auto
- thus ?thesis using closed_halfspace_ge[unfolded closed_def Compl_eq_Diff_UNIV, of b a] by auto
-qed
-
-lemma open_halfspace_gt: "open {x. inner a x > b}"
-proof-
- have "UNIV - {x. b \<ge> inner a x} = {x. inner a x > b}" by auto
- thus ?thesis using closed_halfspace_le[unfolded closed_def Compl_eq_Diff_UNIV, of a b] by auto
-qed
-
-lemma open_halfspace_component_lt:
- shows "open {x::real^'n::finite. x$i < a}"
- using open_halfspace_lt[of "(basis i)::real^'n" a] unfolding inner_basis[OF assms] by auto
-
-lemma open_halfspace_component_gt:
- shows "open {x::real^'n::finite. x$i > a}"
- using open_halfspace_gt[of a "(basis i)::real^'n"] unfolding inner_basis[OF assms] by auto
-
-text{* This gives a simple derivation of limit component bounds. *}
-
-lemma Lim_component_le: fixes f :: "'a \<Rightarrow> real^'n::finite"
- assumes "(f ---> l) net" "\<not> (trivial_limit net)" "eventually (\<lambda>x. f(x)$i \<le> b) net"
- shows "l$i \<le> b"
-proof-
- { 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
- show ?thesis using Lim_in_closed_set[of "{x. inner (basis i) x \<le> b}" f net l] unfolding *
- using closed_halfspace_le[of "(basis i)::real^'n" b] and assms(1,2,3) by auto
-qed
-
-lemma Lim_component_ge: fixes f :: "'a \<Rightarrow> real^'n::finite"
- assumes "(f ---> l) net" "\<not> (trivial_limit net)" "eventually (\<lambda>x. b \<le> (f x)$i) net"
- shows "b \<le> l$i"
-proof-
- { 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
- show ?thesis using Lim_in_closed_set[of "{x. inner (basis i) x \<ge> b}" f net l] unfolding *
- using closed_halfspace_ge[of b "(basis i)::real^'n"] and assms(1,2,3) by auto
-qed
-
-lemma Lim_component_eq: fixes f :: "'a \<Rightarrow> real^'n::finite"
- assumes net:"(f ---> l) net" "~(trivial_limit net)" and ev:"eventually (\<lambda>x. f(x)$i = b) net"
- shows "l$i = b"
- 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
-
-lemma Lim_drop_le: fixes f :: "'a \<Rightarrow> real^1" shows
- "(f ---> l) net \<Longrightarrow> ~(trivial_limit net) \<Longrightarrow> eventually (\<lambda>x. dest_vec1 (f x) \<le> b) net ==> dest_vec1 l \<le> b"
- using Lim_component_le[of f l net 1 b] unfolding dest_vec1_def by auto
-
-lemma Lim_drop_ge: fixes f :: "'a \<Rightarrow> real^1" shows
- "(f ---> l) net \<Longrightarrow> ~(trivial_limit net) \<Longrightarrow> eventually (\<lambda>x. b \<le> dest_vec1 (f x)) net ==> b \<le> dest_vec1 l"
- using Lim_component_ge[of f l net b 1] unfolding dest_vec1_def by auto
-
-text{* Limits relative to a union. *}
-
-lemma eventually_within_Un:
- "eventually P (net within (s \<union> t)) \<longleftrightarrow>
- eventually P (net within s) \<and> eventually P (net within t)"
- unfolding Limits.eventually_within
- by (auto elim!: eventually_rev_mp)
-
-lemma Lim_within_union:
- "(f ---> l) (net within (s \<union> t)) \<longleftrightarrow>
- (f ---> l) (net within s) \<and> (f ---> l) (net within t)"
- unfolding tendsto_def
- by (auto simp add: eventually_within_Un)
-
-lemma continuous_on_union:
- assumes "closed s" "closed t" "continuous_on s f" "continuous_on t f"
- shows "continuous_on (s \<union> t) f"
- using assms unfolding continuous_on unfolding Lim_within_union
- unfolding Lim unfolding trivial_limit_within unfolding closed_limpt by auto
-
-lemma continuous_on_cases:
- assumes "closed s" "closed t" "continuous_on s f" "continuous_on t g"
- "\<forall>x. (x\<in>s \<and> \<not> P x) \<or> (x \<in> t \<and> P x) \<longrightarrow> f x = g x"
- shows "continuous_on (s \<union> t) (\<lambda>x. if P x then f x else g x)"
-proof-
- let ?h = "(\<lambda>x. if P x then f x else g x)"
- have "\<forall>x\<in>s. f x = (if P x then f x else g x)" using assms(5) by auto
- hence "continuous_on s ?h" using continuous_on_eq[of s f ?h] using assms(3) by auto
- moreover
- have "\<forall>x\<in>t. g x = (if P x then f x else g x)" using assms(5) by auto
- hence "continuous_on t ?h" using continuous_on_eq[of t g ?h] using assms(4) by auto
- ultimately show ?thesis using continuous_on_union[OF assms(1,2), of ?h] by auto
-qed
-
-
-text{* Some more convenient intermediate-value theorem formulations. *}
-
-lemma connected_ivt_hyperplane:
- assumes "connected s" "x \<in> s" "y \<in> s" "inner a x \<le> b" "b \<le> inner a y"
- shows "\<exists>z \<in> s. inner a z = b"
-proof(rule ccontr)
- assume as:"\<not> (\<exists>z\<in>s. inner a z = b)"
- let ?A = "{x. inner a x < b}"
- let ?B = "{x. inner a x > b}"
- have "open ?A" "open ?B" using open_halfspace_lt and open_halfspace_gt by auto
- moreover have "?A \<inter> ?B = {}" by auto
- moreover have "s \<subseteq> ?A \<union> ?B" using as by auto
- ultimately show False using assms(1)[unfolded connected_def not_ex, THEN spec[where x="?A"], THEN spec[where x="?B"]] and assms(2-5) by auto
-qed
-
-lemma connected_ivt_component: fixes x::"real^'n::finite" shows
- "connected s \<Longrightarrow> x \<in> s \<Longrightarrow> y \<in> s \<Longrightarrow> x$k \<le> a \<Longrightarrow> a \<le> y$k \<Longrightarrow> (\<exists>z\<in>s. z$k = a)"
- using connected_ivt_hyperplane[of s x y "(basis k)::real^'n" a] by (auto simp add: inner_basis)
-
-text{* Also more convenient formulations of monotone convergence. *}
-
-lemma bounded_increasing_convergent: fixes s::"nat \<Rightarrow> real^1"
- assumes "bounded {s n| n::nat. True}" "\<forall>n. dest_vec1(s n) \<le> dest_vec1(s(Suc n))"
- shows "\<exists>l. (s ---> l) sequentially"
-proof-
- 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
- { fix m::nat
- have "\<And> n. n\<ge>m \<longrightarrow> dest_vec1 (s m) \<le> dest_vec1 (s n)"
- apply(induct_tac n) apply simp using assms(2) apply(erule_tac x="na" in allE) by(auto simp add: not_less_eq_eq) }
- hence "\<forall>m n. m \<le> n \<longrightarrow> dest_vec1 (s m) \<le> dest_vec1 (s n)" by auto
- 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
- thus ?thesis unfolding Lim_sequentially apply(rule_tac x="vec1 l" in exI)
- unfolding dist_norm unfolding abs_dest_vec1 and dest_vec1_sub by auto
-qed
-
-subsection{* Basic homeomorphism definitions. *}
-
-definition "homeomorphism s t f g \<equiv>
- (\<forall>x\<in>s. (g(f x) = x)) \<and> (f ` s = t) \<and> continuous_on s f \<and>
- (\<forall>y\<in>t. (f(g y) = y)) \<and> (g ` t = s) \<and> continuous_on t g"
-
-definition
- homeomorphic :: "'a::metric_space set \<Rightarrow> 'b::metric_space set \<Rightarrow> bool"
- (infixr "homeomorphic" 60) where
- homeomorphic_def: "s homeomorphic t \<equiv> (\<exists>f g. homeomorphism s t f g)"
-
-lemma homeomorphic_refl: "s homeomorphic s"
- unfolding homeomorphic_def
- unfolding homeomorphism_def
- using continuous_on_id
- apply(rule_tac x = "(\<lambda>x. x)" in exI)
- apply(rule_tac x = "(\<lambda>x. x)" in exI)
- by blast
-
-lemma homeomorphic_sym:
- "s homeomorphic t \<longleftrightarrow> t homeomorphic s"
-unfolding homeomorphic_def
-unfolding homeomorphism_def
-by blast (* FIXME: slow *)
-
-lemma homeomorphic_trans:
- assumes "s homeomorphic t" "t homeomorphic u" shows "s homeomorphic u"
-proof-
- 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"
- using assms(1) unfolding homeomorphic_def homeomorphism_def by auto
- 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"
- using assms(2) unfolding homeomorphic_def homeomorphism_def by auto
-
- { 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 }
- moreover have "(f2 \<circ> f1) ` s = u" using fg1(2) fg2(2) by auto
- moreover have "continuous_on s (f2 \<circ> f1)" using continuous_on_compose[OF fg1(3)] and fg2(3) unfolding fg1(2) by auto
- 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 }
- moreover have "(g1 \<circ> g2) ` u = s" using fg1(5) fg2(5) by auto
- moreover have "continuous_on u (g1 \<circ> g2)" using continuous_on_compose[OF fg2(6)] and fg1(6) unfolding fg2(5) by auto
- 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
-qed
-
-lemma homeomorphic_minimal:
- "s homeomorphic t \<longleftrightarrow>
- (\<exists>f g. (\<forall>x\<in>s. f(x) \<in> t \<and> (g(f(x)) = x)) \<and>
- (\<forall>y\<in>t. g(y) \<in> s \<and> (f(g(y)) = y)) \<and>
- continuous_on s f \<and> continuous_on t g)"
-unfolding homeomorphic_def homeomorphism_def
-apply auto apply (rule_tac x=f in exI) apply (rule_tac x=g in exI)
-apply auto apply (rule_tac x=f in exI) apply (rule_tac x=g in exI) apply auto
-unfolding image_iff
-apply(erule_tac x="g x" in ballE) apply(erule_tac x="x" in ballE)
-apply auto apply(rule_tac x="g x" in bexI) apply auto
-apply(erule_tac x="f x" in ballE) apply(erule_tac x="x" in ballE)
-apply auto apply(rule_tac x="f x" in bexI) by auto
-
-subsection{* Relatively weak hypotheses if a set is compact. *}
-
-definition "inv_on f s = (\<lambda>x. SOME y. y\<in>s \<and> f y = x)"
-
-lemma assumes "inj_on f s" "x\<in>s"
- shows "inv_on f s (f x) = x"
- using assms unfolding inj_on_def inv_on_def by auto
-
-lemma homeomorphism_compact:
- fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
- (* class constraint due to continuous_on_inverse *)
- assumes "compact s" "continuous_on s f" "f ` s = t" "inj_on f s"
- shows "\<exists>g. homeomorphism s t f g"
-proof-
- def g \<equiv> "\<lambda>x. SOME y. y\<in>s \<and> f y = x"
- have g:"\<forall>x\<in>s. g (f x) = x" using assms(3) assms(4)[unfolded inj_on_def] unfolding g_def by auto
- { fix y assume "y\<in>t"
- then obtain x where x:"f x = y" "x\<in>s" using assms(3) by auto
- hence "g (f x) = x" using g by auto
- hence "f (g y) = y" unfolding x(1)[THEN sym] by auto }
- hence g':"\<forall>x\<in>t. f (g x) = x" by auto
- moreover
- { fix x
- 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"])
- moreover
- { assume "x\<in>g ` t"
- then obtain y where y:"y\<in>t" "g y = x" by auto
- then obtain x' where x':"x'\<in>s" "f x' = y" using assms(3) by auto
- 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 }
- ultimately have "x\<in>s \<longleftrightarrow> x \<in> g ` t" by auto }
- hence "g ` t = s" by auto
- ultimately
- show ?thesis unfolding homeomorphism_def homeomorphic_def
- 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
-qed
-
-lemma homeomorphic_compact:
- fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
- (* class constraint due to continuous_on_inverse *)
- shows "compact s \<Longrightarrow> continuous_on s f \<Longrightarrow> (f ` s = t) \<Longrightarrow> inj_on f s
- \<Longrightarrow> s homeomorphic t"
- unfolding homeomorphic_def by(metis homeomorphism_compact)
-
-text{* Preservation of topological properties. *}
-
-lemma homeomorphic_compactness:
- "s homeomorphic t ==> (compact s \<longleftrightarrow> compact t)"
-unfolding homeomorphic_def homeomorphism_def
-by (metis compact_continuous_image)
-
-text{* Results on translation, scaling etc. *}
-
-lemma homeomorphic_scaling:
- fixes s :: "'a::real_normed_vector set"
- assumes "c \<noteq> 0" shows "s homeomorphic ((\<lambda>x. c *\<^sub>R x) ` s)"
- unfolding homeomorphic_minimal
- apply(rule_tac x="\<lambda>x. c *\<^sub>R x" in exI)
- apply(rule_tac x="\<lambda>x. (1 / c) *\<^sub>R x" in exI)
- using assms apply auto
- using continuous_on_cmul[OF continuous_on_id] by auto
-
-lemma homeomorphic_translation:
- fixes s :: "'a::real_normed_vector set"
- shows "s homeomorphic ((\<lambda>x. a + x) ` s)"
- unfolding homeomorphic_minimal
- apply(rule_tac x="\<lambda>x. a + x" in exI)
- apply(rule_tac x="\<lambda>x. -a + x" in exI)
- using continuous_on_add[OF continuous_on_const continuous_on_id] by auto
-
-lemma homeomorphic_affinity:
- fixes s :: "'a::real_normed_vector set"
- assumes "c \<noteq> 0" shows "s homeomorphic ((\<lambda>x. a + c *\<^sub>R x) ` s)"
-proof-
- have *:"op + a ` op *\<^sub>R c ` s = (\<lambda>x. a + c *\<^sub>R x) ` s" by auto
- show ?thesis
- using homeomorphic_trans
- using homeomorphic_scaling[OF assms, of s]
- using homeomorphic_translation[of "(\<lambda>x. c *\<^sub>R x) ` s" a] unfolding * by auto
-qed
-
-lemma homeomorphic_balls:
- fixes a b ::"'a::real_normed_vector" (* FIXME: generalize to metric_space *)
- assumes "0 < d" "0 < e"
- shows "(ball a d) homeomorphic (ball b e)" (is ?th)
- "(cball a d) homeomorphic (cball b e)" (is ?cth)
-proof-
- have *:"\<bar>e / d\<bar> > 0" "\<bar>d / e\<bar> >0" using assms using divide_pos_pos by auto
- show ?th unfolding homeomorphic_minimal
- apply(rule_tac x="\<lambda>x. b + (e/d) *\<^sub>R (x - a)" in exI)
- apply(rule_tac x="\<lambda>x. a + (d/e) *\<^sub>R (x - b)" in exI)
- using assms apply (auto simp add: dist_commute)
- unfolding dist_norm
- apply (auto simp add: pos_divide_less_eq mult_strict_left_mono)
- unfolding continuous_on
- by (intro ballI tendsto_intros, simp, assumption)+
-next
- have *:"\<bar>e / d\<bar> > 0" "\<bar>d / e\<bar> >0" using assms using divide_pos_pos by auto
- show ?cth unfolding homeomorphic_minimal
- apply(rule_tac x="\<lambda>x. b + (e/d) *\<^sub>R (x - a)" in exI)
- apply(rule_tac x="\<lambda>x. a + (d/e) *\<^sub>R (x - b)" in exI)
- using assms apply (auto simp add: dist_commute)
- unfolding dist_norm
- apply (auto simp add: pos_divide_le_eq)
- unfolding continuous_on
- by (intro ballI tendsto_intros, simp, assumption)+
-qed
-
-text{* "Isometry" (up to constant bounds) of injective linear map etc. *}
-
-lemma cauchy_isometric:
- fixes x :: "nat \<Rightarrow> real ^ 'n::finite"
- 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)"
- shows "Cauchy x"
-proof-
- interpret f: bounded_linear f by fact
- { fix d::real assume "d>0"
- then obtain N where N:"\<forall>n\<ge>N. norm (f (x n) - f (x N)) < e * d"
- 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
- { fix n assume "n\<ge>N"
- hence "norm (f (x n - x N)) < e * d" using N[THEN spec[where x=n]] unfolding f.diff[THEN sym] by auto
- moreover have "e * norm (x n - x N) \<le> norm (f (x n - x N))"
- using subspace_sub[OF s, of "x n" "x N"] using xs[THEN spec[where x=N]] and xs[THEN spec[where x=n]]
- using normf[THEN bspec[where x="x n - x N"]] by auto
- ultimately have "norm (x n - x N) < d" using `e>0`
- using mult_left_less_imp_less[of e "norm (x n - x N)" d] by auto }
- hence "\<exists>N. \<forall>n\<ge>N. norm (x n - x N) < d" by auto }
- thus ?thesis unfolding cauchy and dist_norm by auto
-qed
-
-lemma complete_isometric_image:
- fixes f :: "real ^ _ \<Rightarrow> real ^ _"
- 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"
- shows "complete(f ` s)"
-proof-
- { fix g assume as:"\<forall>n::nat. g n \<in> f ` s" and cfg:"Cauchy g"
- then obtain x where "\<forall>n. x n \<in> s \<and> g n = f (x n)" unfolding image_iff and Bex_def
- using choice[of "\<lambda> n xa. xa \<in> s \<and> g n = f xa"] by auto
- hence x:"\<forall>n. x n \<in> s" "\<forall>n. g n = f (x n)" by auto
- hence "f \<circ> x = g" unfolding expand_fun_eq by auto
- then obtain l where "l\<in>s" and l:"(x ---> l) sequentially"
- using cs[unfolded complete_def, THEN spec[where x="x"]]
- using cauchy_isometric[OF `0<e` s f normf] and cfg and x(1) by auto
- hence "\<exists>l\<in>f ` s. (g ---> l) sequentially"
- using linear_continuous_at[OF f, unfolded continuous_at_sequentially, THEN spec[where x=x], of l]
- unfolding `f \<circ> x = g` by auto }
- thus ?thesis unfolding complete_def by auto
-qed
-
-lemma dist_0_norm:
- fixes x :: "'a::real_normed_vector"
- shows "dist 0 x = norm x"
-unfolding dist_norm by simp
-
-lemma injective_imp_isometric: fixes f::"real^'m::finite \<Rightarrow> real^'n::finite"
- assumes s:"closed s" "subspace s" and f:"bounded_linear f" "\<forall>x\<in>s. (f x = 0) \<longrightarrow> (x = 0)"
- shows "\<exists>e>0. \<forall>x\<in>s. norm (f x) \<ge> e * norm(x)"
-proof(cases "s \<subseteq> {0::real^'m}")
- case True
- { fix x assume "x \<in> s"
- hence "x = 0" using True by auto
- hence "norm x \<le> norm (f x)" by auto }
- thus ?thesis by(auto intro!: exI[where x=1])
-next
- interpret f: bounded_linear f by fact
- case False
- then obtain a where a:"a\<noteq>0" "a\<in>s" by auto
- from False have "s \<noteq> {}" by auto
- let ?S = "{f x| x. (x \<in> s \<and> norm x = norm a)}"
- let ?S' = "{x::real^'m. x\<in>s \<and> norm x = norm a}"
- let ?S'' = "{x::real^'m. norm x = norm a}"
-
- have "?S'' = frontier(cball 0 (norm a))" unfolding frontier_cball and dist_norm by (auto simp add: norm_minus_cancel)
- hence "compact ?S''" using compact_frontier[OF compact_cball, of 0 "norm a"] by auto
- moreover have "?S' = s \<inter> ?S''" by auto
- ultimately have "compact ?S'" using closed_inter_compact[of s ?S''] using s(1) by auto
- moreover have *:"f ` ?S' = ?S" by auto
- ultimately have "compact ?S" using compact_continuous_image[OF linear_continuous_on[OF f(1)], of ?S'] by auto
- hence "closed ?S" using compact_imp_closed by auto
- moreover have "?S \<noteq> {}" using a by auto
- ultimately obtain b' where "b'\<in>?S" "\<forall>y\<in>?S. norm b' \<le> norm y" using distance_attains_inf[of ?S 0] unfolding dist_0_norm by auto
- then obtain b where "b\<in>s" and ba:"norm b = norm a" and b:"\<forall>x\<in>{x \<in> s. norm x = norm a}. norm (f b) \<le> norm (f x)" unfolding *[THEN sym] unfolding image_iff by auto
-
- let ?e = "norm (f b) / norm b"
- have "norm b > 0" using ba and a and norm_ge_zero by auto
- moreover have "norm (f b) > 0" using f(2)[THEN bspec[where x=b], OF `b\<in>s`] using `norm b >0` unfolding zero_less_norm_iff by auto
- ultimately have "0 < norm (f b) / norm b" by(simp only: divide_pos_pos)
- moreover
- { fix x assume "x\<in>s"
- hence "norm (f b) / norm b * norm x \<le> norm (f x)"
- proof(cases "x=0")
- case True thus "norm (f b) / norm b * norm x \<le> norm (f x)" by auto
- next
- case False
- hence *:"0 < norm a / norm x" using `a\<noteq>0` unfolding zero_less_norm_iff[THEN sym] by(simp only: divide_pos_pos)
- have "\<forall>c. \<forall>x\<in>s. c *\<^sub>R x \<in> s" using s[unfolded subspace_def smult_conv_scaleR] by auto
- 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
- 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"]]
- unfolding f.scaleR and ba using `x\<noteq>0` `a\<noteq>0`
- by (auto simp add: real_mult_commute pos_le_divide_eq pos_divide_le_eq)
- qed }
- ultimately
- show ?thesis by auto
-qed
-
-lemma closed_injective_image_subspace:
- fixes f :: "real ^ _ \<Rightarrow> real ^ _"
- assumes "subspace s" "bounded_linear f" "\<forall>x\<in>s. f x = 0 --> x = 0" "closed s"
- shows "closed(f ` s)"
-proof-
- obtain e where "e>0" and e:"\<forall>x\<in>s. e * norm x \<le> norm (f x)" using injective_imp_isometric[OF assms(4,1,2,3)] by auto
- show ?thesis using complete_isometric_image[OF `e>0` assms(1,2) e] and assms(4)
- unfolding complete_eq_closed[THEN sym] by auto
-qed
-
-subsection{* Some properties of a canonical subspace. *}
-
-lemma subspace_substandard:
- "subspace {x::real^'n. (\<forall>i. P i \<longrightarrow> x$i = 0)}"
- unfolding subspace_def by(auto simp add: vector_add_component vector_smult_component elim!: ballE)
-
-lemma closed_substandard:
- "closed {x::real^'n::finite. \<forall>i. P i --> x$i = 0}" (is "closed ?A")
-proof-
- let ?D = "{i. P i}"
- let ?Bs = "{{x::real^'n. inner (basis i) x = 0}| i. i \<in> ?D}"
- { fix x
- { assume "x\<in>?A"
- hence x:"\<forall>i\<in>?D. x $ i = 0" by auto
- hence "x\<in> \<Inter> ?Bs" by(auto simp add: inner_basis x) }
- moreover
- { assume x:"x\<in>\<Inter>?Bs"
- { fix i assume i:"i \<in> ?D"
- then obtain B where BB:"B \<in> ?Bs" and B:"B = {x::real^'n. inner (basis i) x = 0}" by auto
- hence "x $ i = 0" unfolding B using x unfolding inner_basis by auto }
- hence "x\<in>?A" by auto }
- ultimately have "x\<in>?A \<longleftrightarrow> x\<in> \<Inter>?Bs" by auto }
- hence "?A = \<Inter> ?Bs" by auto
- thus ?thesis by(auto simp add: closed_Inter closed_hyperplane)
-qed
-
-lemma dim_substandard:
- shows "dim {x::real^'n::finite. \<forall>i. i \<notin> d \<longrightarrow> x$i = 0} = card d" (is "dim ?A = _")
-proof-
- let ?D = "UNIV::'n set"
- let ?B = "(basis::'n\<Rightarrow>real^'n) ` d"
-
- let ?bas = "basis::'n \<Rightarrow> real^'n"
-
- have "?B \<subseteq> ?A" by auto
-
- moreover
- { fix x::"real^'n" assume "x\<in>?A"
- with finite[of d]
- have "x\<in> span ?B"
- proof(induct d arbitrary: x)
- case empty hence "x=0" unfolding Cart_eq by auto
- thus ?case using subspace_0[OF subspace_span[of "{}"]] by auto
- next
- case (insert k F)
- hence *:"\<forall>i. i \<notin> insert k F \<longrightarrow> x $ i = 0" by auto
- have **:"F \<subseteq> insert k F" by auto
- def y \<equiv> "x - x$k *\<^sub>R basis k"
- have y:"x = y + (x$k) *\<^sub>R basis k" unfolding y_def by auto
- { fix i assume i':"i \<notin> F"
- hence "y $ i = 0" unfolding y_def unfolding vector_minus_component
- and vector_smult_component and basis_component
- using *[THEN spec[where x=i]] by auto }
- hence "y \<in> span (basis ` (insert k F))" using insert(3)
- using span_mono[of "?bas ` F" "?bas ` (insert k F)"]
- using image_mono[OF **, of basis] by auto
- moreover
- have "basis k \<in> span (?bas ` (insert k F))" by(rule span_superset, auto)
- hence "x$k *\<^sub>R basis k \<in> span (?bas ` (insert k F))"
- using span_mul [where 'a=real, unfolded smult_conv_scaleR] by auto
- ultimately
- have "y + x$k *\<^sub>R basis k \<in> span (?bas ` (insert k F))"
- using span_add by auto
- thus ?case using y by auto
- qed
- }
- hence "?A \<subseteq> span ?B" by auto
-
- moreover
- { fix x assume "x \<in> ?B"
- hence "x\<in>{(basis i)::real^'n |i. i \<in> ?D}" using assms by auto }
- hence "independent ?B" using independent_mono[OF independent_stdbasis, of ?B] and assms by auto
-
- moreover
- have "d \<subseteq> ?D" unfolding subset_eq using assms by auto
- hence *:"inj_on (basis::'n\<Rightarrow>real^'n) d" using subset_inj_on[OF basis_inj, of "d"] by auto
- have "?B hassize (card d)" unfolding hassize_def and card_image[OF *] by auto
-
- ultimately show ?thesis using dim_unique[of "basis ` d" ?A] by auto
-qed
-
-text{* Hence closure and completeness of all subspaces. *}
-
-lemma closed_subspace_lemma: "n \<le> card (UNIV::'n::finite set) \<Longrightarrow> \<exists>A::'n set. card A = n"
-apply (induct n)
-apply (rule_tac x="{}" in exI, simp)
-apply clarsimp
-apply (subgoal_tac "\<exists>x. x \<notin> A")
-apply (erule exE)
-apply (rule_tac x="insert x A" in exI, simp)
-apply (subgoal_tac "A \<noteq> UNIV", auto)
-done
-
-lemma closed_subspace: fixes s::"(real^'n::finite) set"
- assumes "subspace s" shows "closed s"
-proof-
- have "dim s \<le> card (UNIV :: 'n set)" using dim_subset_univ by auto
- then obtain d::"'n set" where t: "card d = dim s"
- using closed_subspace_lemma by auto
- let ?t = "{x::real^'n. \<forall>i. i \<notin> d \<longrightarrow> x$i = 0}"
- obtain f where f:"bounded_linear f" "f ` ?t = s" "inj_on f ?t"
- using subspace_isomorphism[unfolded linear_conv_bounded_linear, OF subspace_substandard[of "\<lambda>i. i \<notin> d"] assms]
- using dim_substandard[of d] and t by auto
- interpret f: bounded_linear f by fact
- have "\<forall>x\<in>?t. f x = 0 \<longrightarrow> x = 0" using f.zero using f(3)[unfolded inj_on_def]
- by(erule_tac x=0 in ballE) auto
- moreover have "closed ?t" using closed_substandard .
- moreover have "subspace ?t" using subspace_substandard .
- ultimately show ?thesis using closed_injective_image_subspace[of ?t f]
- unfolding f(2) using f(1) by auto
-qed
-
-lemma complete_subspace:
- fixes s :: "(real ^ _) set" shows "subspace s ==> complete s"
- using complete_eq_closed closed_subspace
- by auto
-
-lemma dim_closure:
- fixes s :: "(real ^ _) set"
- shows "dim(closure s) = dim s" (is "?dc = ?d")
-proof-
- have "?dc \<le> ?d" using closure_minimal[OF span_inc, of s]
- using closed_subspace[OF subspace_span, of s]
- using dim_subset[of "closure s" "span s"] unfolding dim_span by auto
- thus ?thesis using dim_subset[OF closure_subset, of s] by auto
-qed
-
-text{* Affine transformations of intervals. *}
-
-lemma affinity_inverses:
- assumes m0: "m \<noteq> (0::'a::field)"
- shows "(\<lambda>x. m *s x + c) o (\<lambda>x. inverse(m) *s x + (-(inverse(m) *s c))) = id"
- "(\<lambda>x. inverse(m) *s x + (-(inverse(m) *s c))) o (\<lambda>x. m *s x + c) = id"
- using m0
-apply (auto simp add: expand_fun_eq vector_add_ldistrib vector_smult_assoc)
-by (simp add: vector_smult_lneg[symmetric] vector_smult_assoc vector_sneg_minus1[symmetric])
-
-lemma real_affinity_le:
- "0 < (m::'a::ordered_field) ==> (m * x + c \<le> y \<longleftrightarrow> x \<le> inverse(m) * y + -(c / m))"
- by (simp add: field_simps inverse_eq_divide)
-
-lemma real_le_affinity:
- "0 < (m::'a::ordered_field) ==> (y \<le> m * x + c \<longleftrightarrow> inverse(m) * y + -(c / m) \<le> x)"
- by (simp add: field_simps inverse_eq_divide)
-
-lemma real_affinity_lt:
- "0 < (m::'a::ordered_field) ==> (m * x + c < y \<longleftrightarrow> x < inverse(m) * y + -(c / m))"
- by (simp add: field_simps inverse_eq_divide)
-
-lemma real_lt_affinity:
- "0 < (m::'a::ordered_field) ==> (y < m * x + c \<longleftrightarrow> inverse(m) * y + -(c / m) < x)"
- by (simp add: field_simps inverse_eq_divide)
-
-lemma real_affinity_eq:
- "(m::'a::ordered_field) \<noteq> 0 ==> (m * x + c = y \<longleftrightarrow> x = inverse(m) * y + -(c / m))"
- by (simp add: field_simps inverse_eq_divide)
-
-lemma real_eq_affinity:
- "(m::'a::ordered_field) \<noteq> 0 ==> (y = m * x + c \<longleftrightarrow> inverse(m) * y + -(c / m) = x)"
- by (simp add: field_simps inverse_eq_divide)
-
-lemma vector_affinity_eq:
- assumes m0: "(m::'a::field) \<noteq> 0"
- shows "m *s x + c = y \<longleftrightarrow> x = inverse m *s y + -(inverse m *s c)"
-proof
- assume h: "m *s x + c = y"
- hence "m *s x = y - c" by (simp add: ring_simps)
- hence "inverse m *s (m *s x) = inverse m *s (y - c)" by simp
- then show "x = inverse m *s y + - (inverse m *s c)"
- using m0 by (simp add: vector_smult_assoc vector_ssub_ldistrib)
-next
- assume h: "x = inverse m *s y + - (inverse m *s c)"
- show "m *s x + c = y" unfolding h diff_minus[symmetric]
- using m0 by (simp add: vector_smult_assoc vector_ssub_ldistrib)
-qed
-
-lemma vector_eq_affinity:
- "(m::'a::field) \<noteq> 0 ==> (y = m *s x + c \<longleftrightarrow> inverse(m) *s y + -(inverse(m) *s c) = x)"
- using vector_affinity_eq[where m=m and x=x and y=y and c=c]
- by metis
-
-lemma image_affinity_interval: fixes m::real
- fixes a b c :: "real^'n::finite"
- shows "(\<lambda>x. m *\<^sub>R x + c) ` {a .. b} =
- (if {a .. b} = {} then {}
- else (if 0 \<le> m then {m *\<^sub>R a + c .. m *\<^sub>R b + c}
- else {m *\<^sub>R b + c .. m *\<^sub>R a + c}))"
-proof(cases "m=0")
- { fix x assume "x \<le> c" "c \<le> x"
- hence "x=c" unfolding vector_less_eq_def and Cart_eq by (auto intro: order_antisym) }
- moreover case True
- moreover have "c \<in> {m *\<^sub>R a + c..m *\<^sub>R b + c}" unfolding True by(auto simp add: vector_less_eq_def)
- ultimately show ?thesis by auto
-next
- case False
- { fix y assume "a \<le> y" "y \<le> b" "m > 0"
- hence "m *\<^sub>R a + c \<le> m *\<^sub>R y + c" "m *\<^sub>R y + c \<le> m *\<^sub>R b + c"
- unfolding vector_less_eq_def by(auto simp add: vector_smult_component vector_add_component)
- } moreover
- { fix y assume "a \<le> y" "y \<le> b" "m < 0"
- hence "m *\<^sub>R b + c \<le> m *\<^sub>R y + c" "m *\<^sub>R y + c \<le> m *\<^sub>R a + c"
- unfolding vector_less_eq_def by(auto simp add: vector_smult_component vector_add_component mult_left_mono_neg elim!:ballE)
- } moreover
- { fix y assume "m > 0" "m *\<^sub>R a + c \<le> y" "y \<le> m *\<^sub>R b + c"
- hence "y \<in> (\<lambda>x. m *\<^sub>R x + c) ` {a..b}"
- unfolding image_iff Bex_def mem_interval vector_less_eq_def
- apply(auto simp add: vector_smult_component vector_add_component vector_minus_component vector_smult_assoc pth_3[symmetric]
- intro!: exI[where x="(1 / m) *\<^sub>R (y - c)"])
- by(auto simp add: pos_le_divide_eq pos_divide_le_eq real_mult_commute diff_le_iff)
- } moreover
- { fix y assume "m *\<^sub>R b + c \<le> y" "y \<le> m *\<^sub>R a + c" "m < 0"
- hence "y \<in> (\<lambda>x. m *\<^sub>R x + c) ` {a..b}"
- unfolding image_iff Bex_def mem_interval vector_less_eq_def
- apply(auto simp add: vector_smult_component vector_add_component vector_minus_component vector_smult_assoc pth_3[symmetric]
- intro!: exI[where x="(1 / m) *\<^sub>R (y - c)"])
- by(auto simp add: neg_le_divide_eq neg_divide_le_eq real_mult_commute diff_le_iff)
- }
- ultimately show ?thesis using False by auto
-qed
-
-lemma image_smult_interval:"(\<lambda>x. m *\<^sub>R (x::real^'n::finite)) ` {a..b} =
- (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})"
- using image_affinity_interval[of m 0 a b] by auto
-
-subsection{* Banach fixed point theorem (not really topological...) *}
-
-lemma banach_fix:
- assumes s:"complete s" "s \<noteq> {}" and c:"0 \<le> c" "c < 1" and f:"(f ` s) \<subseteq> s" and
- lipschitz:"\<forall>x\<in>s. \<forall>y\<in>s. dist (f x) (f y) \<le> c * dist x y"
- shows "\<exists>! x\<in>s. (f x = x)"
-proof-
- have "1 - c > 0" using c by auto
-
- from s(2) obtain z0 where "z0 \<in> s" by auto
- def z \<equiv> "\<lambda>n. (f ^^ n) z0"
- { fix n::nat
- have "z n \<in> s" unfolding z_def
- proof(induct n) case 0 thus ?case using `z0 \<in>s` by auto
- next case Suc thus ?case using f by auto qed }
- note z_in_s = this
-
- def d \<equiv> "dist (z 0) (z 1)"
-
- have fzn:"\<And>n. f (z n) = z (Suc n)" unfolding z_def by auto
- { fix n::nat
- have "dist (z n) (z (Suc n)) \<le> (c ^ n) * d"
- proof(induct n)
- case 0 thus ?case unfolding d_def by auto
- next
- case (Suc m)
- hence "c * dist (z m) (z (Suc m)) \<le> c ^ Suc m * d"
- using `0 \<le> c` using mult_mono1_class.mult_mono1[of "dist (z m) (z (Suc m))" "c ^ m * d" c] by auto
- 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]
- unfolding fzn and mult_le_cancel_left by auto
- qed
- } note cf_z = this
-
- { fix n m::nat
- have "(1 - c) * dist (z m) (z (m+n)) \<le> (c ^ m) * d * (1 - c ^ n)"
- proof(induct n)
- case 0 show ?case by auto
- next
- case (Suc k)
- 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))))"
- using dist_triangle and c by(auto simp add: dist_triangle)
- also have "\<dots> \<le> (1 - c) * (dist (z m) (z (m + k)) + c ^ (m + k) * d)"
- using cf_z[of "m + k"] and c by auto
- also have "\<dots> \<le> c ^ m * d * (1 - c ^ k) + (1 - c) * c ^ (m + k) * d"
- using Suc by (auto simp add: ring_simps)
- also have "\<dots> = (c ^ m) * (d * (1 - c ^ k) + (1 - c) * c ^ k * d)"
- unfolding power_add by (auto simp add: ring_simps)
- also have "\<dots> \<le> (c ^ m) * d * (1 - c ^ Suc k)"
- using c by (auto simp add: ring_simps)
- finally show ?case by auto
- qed
- } note cf_z2 = this
- { fix e::real assume "e>0"
- hence "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (z m) (z n) < e"
- proof(cases "d = 0")
- case True
- 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`])
- thus ?thesis using `e>0` by auto
- next
- case False hence "d>0" unfolding d_def using zero_le_dist[of "z 0" "z 1"]
- by (metis False d_def real_less_def)
- hence "0 < e * (1 - c) / d" using `e>0` and `1-c>0`
- using divide_pos_pos[of "e * (1 - c)" d] and mult_pos_pos[of e "1 - c"] by auto
- 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
- { fix m n::nat assume "m>n" and as:"m\<ge>N" "n\<ge>N"
- have *:"c ^ n \<le> c ^ N" using `n\<ge>N` and c using power_decreasing[OF `n\<ge>N`, of c] by auto
- have "1 - c ^ (m - n) > 0" using c and power_strict_mono[of c 1 "m - n"] using `m>n` by auto
- hence **:"d * (1 - c ^ (m - n)) / (1 - c) > 0"
- using real_mult_order[OF `d>0`, of "1 - c ^ (m - n)"]
- using divide_pos_pos[of "d * (1 - c ^ (m - n))" "1 - c"]
- using `0 < 1 - c` by auto
-
- have "dist (z m) (z n) \<le> c ^ n * d * (1 - c ^ (m - n)) / (1 - c)"
- using cf_z2[of n "m - n"] and `m>n` unfolding pos_le_divide_eq[OF `1-c>0`]
- by (auto simp add: real_mult_commute dist_commute)
- also have "\<dots> \<le> c ^ N * d * (1 - c ^ (m - n)) / (1 - c)"
- using mult_right_mono[OF * order_less_imp_le[OF **]]
- unfolding real_mult_assoc by auto
- also have "\<dots> < (e * (1 - c) / d) * d * (1 - c ^ (m - n)) / (1 - c)"
- using mult_strict_right_mono[OF N **] unfolding real_mult_assoc by auto
- also have "\<dots> = e * (1 - c ^ (m - n))" using c and `d>0` and `1 - c > 0` by auto
- 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
- finally have "dist (z m) (z n) < e" by auto
- } note * = this
- { fix m n::nat assume as:"N\<le>m" "N\<le>n"
- hence "dist (z n) (z m) < e"
- proof(cases "n = m")
- case True thus ?thesis using `e>0` by auto
- next
- case False thus ?thesis using as and *[of n m] *[of m n] unfolding nat_neq_iff by (auto simp add: dist_commute)
- qed }
- thus ?thesis by auto
- qed
- }
- hence "Cauchy z" unfolding cauchy_def by auto
- 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
-
- def e \<equiv> "dist (f x) x"
- have "e = 0" proof(rule ccontr)
- assume "e \<noteq> 0" hence "e>0" unfolding e_def using zero_le_dist[of "f x" x]
- by (metis dist_eq_0_iff dist_nz e_def)
- then obtain N where N:"\<forall>n\<ge>N. dist (z n) x < e / 2"
- using x[unfolded Lim_sequentially, THEN spec[where x="e/2"]] by auto
- hence N':"dist (z N) x < e / 2" by auto
-
- have *:"c * dist (z N) x \<le> dist (z N) x" unfolding mult_le_cancel_right2
- using zero_le_dist[of "z N" x] and c
- by (metis dist_eq_0_iff dist_nz order_less_asym real_less_def)
- 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]]
- using z_in_s[of N] `x\<in>s` using c by auto
- also have "\<dots> < e / 2" using N' and c using * by auto
- finally show False unfolding fzn
- using N[THEN spec[where x="Suc N"]] and dist_triangle_half_r[of "z (Suc N)" "f x" e x]
- unfolding e_def by auto
- qed
- hence "f x = x" unfolding e_def by auto
- moreover
- { fix y assume "f y = y" "y\<in>s"
- hence "dist x y \<le> c * dist x y" using lipschitz[THEN bspec[where x=x], THEN bspec[where x=y]]
- using `x\<in>s` and `f x = x` by auto
- hence "dist x y = 0" unfolding mult_le_cancel_right1
- using c and zero_le_dist[of x y] by auto
- hence "y = x" by auto
- }
- ultimately show ?thesis unfolding Bex1_def using `x\<in>s` by blast+
-qed
-
-subsection{* Edelstein fixed point theorem. *}
-
-lemma edelstein_fix:
- fixes s :: "'a::real_normed_vector set"
- assumes s:"compact s" "s \<noteq> {}" and gs:"(g ` s) \<subseteq> s"
- and dist:"\<forall>x\<in>s. \<forall>y\<in>s. x \<noteq> y \<longrightarrow> dist (g x) (g y) < dist x y"
- shows "\<exists>! x\<in>s. g x = x"
-proof(cases "\<exists>x\<in>s. g x \<noteq> x")
- obtain x where "x\<in>s" using s(2) by auto
- case False hence g:"\<forall>x\<in>s. g x = x" by auto
- { fix y assume "y\<in>s"
- hence "x = y" using `x\<in>s` and dist[THEN bspec[where x=x], THEN bspec[where x=y]]
- unfolding g[THEN bspec[where x=x], OF `x\<in>s`]
- unfolding g[THEN bspec[where x=y], OF `y\<in>s`] by auto }
- thus ?thesis unfolding Bex1_def using `x\<in>s` and g by blast+
-next
- case True
- then obtain x where [simp]:"x\<in>s" and "g x \<noteq> x" by auto
- { fix x y assume "x \<in> s" "y \<in> s"
- hence "dist (g x) (g y) \<le> dist x y"
- using dist[THEN bspec[where x=x], THEN bspec[where x=y]] by auto } note dist' = this
- def y \<equiv> "g x"
- have [simp]:"y\<in>s" unfolding y_def using gs[unfolded image_subset_iff] and `x\<in>s` by blast
- def f \<equiv> "\<lambda>n. g ^^ n"
- have [simp]:"\<And>n z. g (f n z) = f (Suc n) z" unfolding f_def by auto
- have [simp]:"\<And>z. f 0 z = z" unfolding f_def by auto
- { fix n::nat and z assume "z\<in>s"
- have "f n z \<in> s" unfolding f_def
- proof(induct n)
- case 0 thus ?case using `z\<in>s` by simp
- next
- case (Suc n) thus ?case using gs[unfolded image_subset_iff] by auto
- qed } note fs = this
- { fix m n ::nat assume "m\<le>n"
- fix w z assume "w\<in>s" "z\<in>s"
- have "dist (f n w) (f n z) \<le> dist (f m w) (f m z)" using `m\<le>n`
- proof(induct n)
- case 0 thus ?case by auto
- next
- case (Suc n)
- thus ?case proof(cases "m\<le>n")
- case True thus ?thesis using Suc(1)
- using dist'[OF fs fs, OF `w\<in>s` `z\<in>s`, of n n] by auto
- next
- case False hence mn:"m = Suc n" using Suc(2) by simp
- show ?thesis unfolding mn by auto
- qed
- qed } note distf = this
-
- def h \<equiv> "\<lambda>n. (f n x, f n y)"
- let ?s2 = "s \<times> s"
- obtain l r where "l\<in>?s2" and r:"subseq r" and lr:"((h \<circ> r) ---> l) sequentially"
- using compact_Times [OF s(1) s(1), unfolded compact_def, THEN spec[where x=h]] unfolding h_def
- using fs[OF `x\<in>s`] and fs[OF `y\<in>s`] by blast
- def a \<equiv> "fst l" def b \<equiv> "snd l"
- have lab:"l = (a, b)" unfolding a_def b_def by simp
- have [simp]:"a\<in>s" "b\<in>s" unfolding a_def b_def using `l\<in>?s2` by auto
-
- have lima:"((fst \<circ> (h \<circ> r)) ---> a) sequentially"
- and limb:"((snd \<circ> (h \<circ> r)) ---> b) sequentially"
- using lr
- unfolding o_def a_def b_def by (simp_all add: tendsto_intros)
-
- { fix n::nat
- 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
- { fix x y :: 'a
- have "dist (-x) (-y) = dist x y" unfolding dist_norm
- using norm_minus_cancel[of "x - y"] by (auto simp add: uminus_add_conv_diff) } note ** = this
-
- { assume as:"dist a b > dist (f n x) (f n y)"
- 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"
- and "\<forall>m\<ge>Nb. dist (f (r m) y) b < (dist a b - dist (f n x) (f n y)) / 2"
- using lima limb unfolding h_def Lim_sequentially by (fastsimp simp del: less_divide_eq_number_of1)
- 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)"
- apply(erule_tac x="Na+Nb+n" in allE)
- apply(erule_tac x="Na+Nb+n" in allE) apply simp
- using dist_triangle_add_half[of a "f (r (Na + Nb + n)) x" "dist a b - dist (f n x) (f n y)"
- "-b" "- f (r (Na + Nb + n)) y"]
- unfolding ** unfolding group_simps(12) by (auto simp add: dist_commute)
- moreover
- 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)"
- using distf[of n "r (Na+Nb+n)", OF _ `x\<in>s` `y\<in>s`]
- using subseq_bigger[OF r, of "Na+Nb+n"]
- using *[of "f (r (Na + Nb + n)) x" "f (r (Na + Nb + n)) y" "f n x" "f n y"] by auto
- ultimately have False by simp
- }
- hence "dist a b \<le> dist (f n x) (f n y)" by(rule ccontr)auto }
- note ab_fn = this
-
- have [simp]:"a = b" proof(rule ccontr)
- def e \<equiv> "dist a b - dist (g a) (g b)"
- assume "a\<noteq>b" hence "e > 0" unfolding e_def using dist by fastsimp
- hence "\<exists>n. dist (f n x) a < e/2 \<and> dist (f n y) b < e/2"
- using lima limb unfolding Lim_sequentially
- apply (auto elim!: allE[where x="e/2"]) apply(rule_tac x="r (max N Na)" in exI) unfolding h_def by fastsimp
- then obtain n where n:"dist (f n x) a < e/2 \<and> dist (f n y) b < e/2" by auto
- have "dist (f (Suc n) x) (g a) \<le> dist (f n x) a"
- using dist[THEN bspec[where x="f n x"], THEN bspec[where x="a"]] and fs by auto
- moreover have "dist (f (Suc n) y) (g b) \<le> dist (f n y) b"
- using dist[THEN bspec[where x="f n y"], THEN bspec[where x="b"]] and fs by auto
- ultimately have "dist (f (Suc n) x) (g a) + dist (f (Suc n) y) (g b) < e" using n by auto
- thus False unfolding e_def using ab_fn[of "Suc n"] by norm
- qed
-
- have [simp]:"\<And>n. f (Suc n) x = f n y" unfolding f_def y_def by(induct_tac n)auto
- { fix x y assume "x\<in>s" "y\<in>s" moreover
- fix e::real assume "e>0" ultimately
- have "dist y x < e \<longrightarrow> dist (g y) (g x) < e" using dist by fastsimp }
- hence "continuous_on s g" unfolding continuous_on_def by auto
-
- hence "((snd \<circ> h \<circ> r) ---> g a) sequentially" unfolding continuous_on_sequentially
- apply (rule allE[where x="\<lambda>n. (fst \<circ> h \<circ> r) n"]) apply (erule ballE[where x=a])
- using lima unfolding h_def o_def using fs[OF `x\<in>s`] by (auto simp add: y_def)
- hence "g a = a" using Lim_unique[OF trivial_limit_sequentially limb, of "g a"]
- unfolding `a=b` and o_assoc by auto
- moreover
- { fix x assume "x\<in>s" "g x = x" "x\<noteq>a"
- hence "False" using dist[THEN bspec[where x=a], THEN bspec[where x=x]]
- using `g a = a` and `a\<in>s` by auto }
- ultimately show "\<exists>!x\<in>s. g x = x" unfolding Bex1_def using `a\<in>s` by blast
-qed
-
-end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy Fri Oct 23 13:23:18 2009 +0200
@@ -0,0 +1,3371 @@
+(* Title: HOL/Library/Convex_Euclidean_Space.thy
+ Author: Robert Himmelmann, TU Muenchen
+*)
+
+header {* Convex sets, functions and related things. *}
+
+theory Convex_Euclidean_Space
+imports Topology_Euclidean_Space
+begin
+
+
+(* ------------------------------------------------------------------------- *)
+(* To be moved elsewhere *)
+(* ------------------------------------------------------------------------- *)
+
+declare vector_add_ldistrib[simp] vector_ssub_ldistrib[simp] vector_smult_assoc[simp] vector_smult_rneg[simp]
+declare vector_sadd_rdistrib[simp] vector_sub_rdistrib[simp]
+declare dot_ladd[simp] dot_radd[simp] dot_lsub[simp] dot_rsub[simp]
+declare dot_lmult[simp] dot_rmult[simp] dot_lneg[simp] dot_rneg[simp]
+declare UNIV_1[simp]
+
+term "(x::real^'n \<Rightarrow> real) 0"
+
+lemma dim1in[intro]:"Suc 0 \<in> {1::nat .. CARD(1)}" by auto
+
+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
+
+lemmas continuous_intros = continuous_add continuous_vmul continuous_cmul continuous_const continuous_sub continuous_at_id continuous_within_id
+
+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
+ 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
+
+lemma dest_vec1_simps[simp]: fixes a::"real^1"
+ 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"*)
+ "a \<le> b \<longleftrightarrow> dest_vec1 a \<le> dest_vec1 b" "dest_vec1 (1::real^1) = 1"
+ by(auto simp add:vector_component_simps all_1 Cart_eq)
+
+lemma nequals0I:"x\<in>A \<Longrightarrow> A \<noteq> {}" by auto
+
+lemma norm_not_0:"(x::real^'n::finite)\<noteq>0 \<Longrightarrow> norm x \<noteq> 0" by auto
+
+lemma setsum_delta_notmem: assumes "x\<notin>s"
+ shows "setsum (\<lambda>y. if (y = x) then P x else Q y) s = setsum Q s"
+ "setsum (\<lambda>y. if (x = y) then P x else Q y) s = setsum Q s"
+ "setsum (\<lambda>y. if (y = x) then P y else Q y) s = setsum Q s"
+ "setsum (\<lambda>y. if (x = y) then P y else Q y) s = setsum Q s"
+ apply(rule_tac [!] setsum_cong2) using assms by auto
+
+lemma setsum_delta'':
+ fixes s::"'a::real_vector set" assumes "finite s"
+ 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)"
+proof-
+ 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
+ show ?thesis unfolding * using setsum_delta[OF assms, of y "\<lambda>x. f x *\<^sub>R x"] by auto
+qed
+
+lemma not_disjointI:"x\<in>A \<Longrightarrow> x\<in>B \<Longrightarrow> A \<inter> B \<noteq> {}" by blast
+
+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
+
+lemma mem_interval_1: fixes x :: "real^1" shows
+ "(x \<in> {a .. b} \<longleftrightarrow> dest_vec1 a \<le> dest_vec1 x \<and> dest_vec1 x \<le> dest_vec1 b)"
+ "(x \<in> {a<..<b} \<longleftrightarrow> dest_vec1 a < dest_vec1 x \<and> dest_vec1 x < dest_vec1 b)"
+by(simp_all add: Cart_eq vector_less_def vector_less_eq_def dest_vec1_def all_1)
+
+lemma image_smult_interval:"(\<lambda>x. m *\<^sub>R (x::real^'n::finite)) ` {a..b} =
+ (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})"
+ using image_affinity_interval[of m 0 a b] by auto
+
+lemma dest_vec1_inverval:
+ "dest_vec1 ` {a .. b} = {dest_vec1 a .. dest_vec1 b}"
+ "dest_vec1 ` {a<.. b} = {dest_vec1 a<.. dest_vec1 b}"
+ "dest_vec1 ` {a ..<b} = {dest_vec1 a ..<dest_vec1 b}"
+ "dest_vec1 ` {a<..<b} = {dest_vec1 a<..<dest_vec1 b}"
+ apply(rule_tac [!] equalityI)
+ unfolding subset_eq Ball_def Bex_def mem_interval_1 image_iff
+ apply(rule_tac [!] allI)apply(rule_tac [!] impI)
+ apply(rule_tac[2] x="vec1 x" in exI)apply(rule_tac[4] x="vec1 x" in exI)
+ apply(rule_tac[6] x="vec1 x" in exI)apply(rule_tac[8] x="vec1 x" in exI)
+ by (auto simp add: vector_less_def vector_less_eq_def all_1 dest_vec1_def
+ vec1_dest_vec1[unfolded dest_vec1_def One_nat_def])
+
+lemma dest_vec1_setsum: assumes "finite S"
+ shows " dest_vec1 (setsum f S) = setsum (\<lambda>x. dest_vec1 (f x)) S"
+ using dest_vec1_sum[OF assms] by auto
+
+lemma dist_triangle_eq:
+ fixes x y z :: "real ^ _"
+ 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)"
+proof- have *:"x - y + (y - z) = x - z" by auto
+ show ?thesis unfolding dist_norm norm_triangle_eq[of "x - y" "y - z", unfolded smult_conv_scaleR *]
+ by(auto simp add:norm_minus_commute) qed
+
+lemma norm_eqI:"x = y \<Longrightarrow> norm x = norm y" by auto
+lemma norm_minus_eqI:"(x::real^'n::finite) = - y \<Longrightarrow> norm x = norm y" by auto
+
+lemma Min_grI: assumes "finite A" "A \<noteq> {}" "\<forall>a\<in>A. x < a" shows "x < Min A"
+ unfolding Min_gr_iff[OF assms(1,2)] using assms(3) by auto
+
+lemma dimindex_ge_1:"CARD(_::finite) \<ge> 1"
+ using one_le_card_finite by auto
+
+lemma real_dimindex_ge_1:"real (CARD('n::finite)) \<ge> 1"
+ by(metis dimindex_ge_1 linorder_not_less real_eq_of_nat real_le_trans real_of_nat_1 real_of_nat_le_iff)
+
+lemma real_dimindex_gt_0:"real (CARD('n::finite)) > 0" apply(rule less_le_trans[OF _ real_dimindex_ge_1]) by auto
+
+subsection {* Affine set and affine hull.*}
+
+definition
+ affine :: "'a::real_vector set \<Rightarrow> bool" where
+ "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)"
+
+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)"
+proof- have *:"\<And>u v ::real. u + v = 1 \<longleftrightarrow> v = 1 - u" by auto
+ { fix x y assume "x\<in>s" "y\<in>s"
+ 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
+ apply(erule_tac[!] x="1 - u" in allE) unfolding * by auto }
+ thus ?thesis unfolding affine_def by auto qed
+
+lemma affine_empty[intro]: "affine {}"
+ unfolding affine_def by auto
+
+lemma affine_sing[intro]: "affine {x}"
+ unfolding affine_alt by (auto simp add: scaleR_left_distrib [symmetric])
+
+lemma affine_UNIV[intro]: "affine UNIV"
+ unfolding affine_def by auto
+
+lemma affine_Inter: "(\<forall>s\<in>f. affine s) \<Longrightarrow> affine (\<Inter> f)"
+ unfolding affine_def by auto
+
+lemma affine_Int: "affine s \<Longrightarrow> affine t \<Longrightarrow> affine (s \<inter> t)"
+ unfolding affine_def by auto
+
+lemma affine_affine_hull: "affine(affine hull s)"
+ unfolding hull_def using affine_Inter[of "{t \<in> affine. s \<subseteq> t}"]
+ unfolding mem_def by auto
+
+lemma affine_hull_eq[simp]: "(affine hull s = s) \<longleftrightarrow> affine s"
+proof-
+ { fix f assume "f \<subseteq> affine"
+ hence "affine (\<Inter>f)" using affine_Inter[of f] unfolding subset_eq mem_def by auto }
+ thus ?thesis using hull_eq[unfolded mem_def, of affine s] by auto
+qed
+
+lemma setsum_restrict_set'': assumes "finite A"
+ shows "setsum f {x \<in> A. P x} = (\<Sum>x\<in>A. if P x then f x else 0)"
+ unfolding mem_def[of _ P, symmetric] unfolding setsum_restrict_set'[OF assms] ..
+
+subsection {* Some explicit formulations (from Lars Schewe). *}
+
+lemma affine: fixes V::"'a::real_vector set"
+ 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)"
+unfolding affine_def apply rule apply(rule, rule, rule) apply(erule conjE)+
+defer apply(rule, rule, rule, rule, rule) proof-
+ fix x y u v assume as:"x \<in> V" "y \<in> V" "u + v = (1::real)"
+ "\<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"
+ thus "u *\<^sub>R x + v *\<^sub>R y \<in> V" apply(cases "x=y")
+ 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)
+ by(auto simp add: scaleR_left_distrib[THEN sym])
+next
+ 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"
+ "finite s" "s \<noteq> {}" "s \<subseteq> V" "setsum u s = (1::real)"
+ def n \<equiv> "card s"
+ have "card s = 0 \<or> card s = 1 \<or> card s = 2 \<or> card s > 2" by auto
+ thus "(\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V" proof(auto simp only: disjE)
+ assume "card s = 2" hence "card s = Suc (Suc 0)" by auto
+ then obtain a b where "s = {a, b}" unfolding card_Suc_eq by auto
+ thus ?thesis using as(1)[THEN bspec[where x=a], THEN bspec[where x=b]] using as(4,5)
+ by(auto simp add: setsum_clauses(2))
+ next assume "card s > 2" thus ?thesis using as and n_def proof(induct n arbitrary: u s)
+ case (Suc n) fix s::"'a set" and u::"'a \<Rightarrow> real"
+ 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;
+ 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
+ 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"
+ "finite s" "s \<noteq> {}" "s \<subseteq> V" "setsum u s = 1"
+ have "\<exists>x\<in>s. u x \<noteq> 1" proof(rule_tac ccontr)
+ 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
+ thus False using as(7) and `card s > 2` by (metis Numeral1_eq1_nat less_0_number_of less_int_code(15)
+ less_nat_number_of not_less_iff_gr_or_eq of_nat_1 of_nat_eq_iff pos2 rel_simps(4)) qed
+ then obtain x where x:"x\<in>s" "u x \<noteq> 1" by auto
+
+ have c:"card (s - {x}) = card s - 1" apply(rule card_Diff_singleton) using `x\<in>s` as(4) by auto
+ have *:"s = insert x (s - {x})" "finite (s - {x})" using `x\<in>s` and as(4) by auto
+ have **:"setsum u (s - {x}) = 1 - u x"
+ using setsum_clauses(2)[OF *(2), of u x, unfolded *(1)[THEN sym] as(7)] by auto
+ have ***:"inverse (1 - u x) * setsum u (s - {x}) = 1" unfolding ** using `u x \<noteq> 1` by auto
+ have "(\<Sum>xa\<in>s - {x}. (inverse (1 - u x) * u xa) *\<^sub>R xa) \<in> V" proof(cases "card (s - {x}) > 2")
+ case True hence "s - {x} \<noteq> {}" "card (s - {x}) = n" unfolding c and as(1)[symmetric] proof(rule_tac ccontr)
+ assume "\<not> s - {x} \<noteq> {}" hence "card (s - {x}) = 0" unfolding card_0_eq[OF *(2)] by simp
+ thus False using True by auto qed auto
+ thus ?thesis apply(rule_tac IA[of "s - {x}" "\<lambda>y. (inverse (1 - u x) * u y)"])
+ unfolding setsum_right_distrib[THEN sym] using as and *** and True by auto
+ next case False hence "card (s - {x}) = Suc (Suc 0)" using as(2) and c by auto
+ then obtain a b where "(s - {x}) = {a, b}" "a\<noteq>b" unfolding card_Suc_eq by auto
+ thus ?thesis using as(3)[THEN bspec[where x=a], THEN bspec[where x=b]]
+ using *** *(2) and `s \<subseteq> V` unfolding setsum_right_distrib by(auto simp add: setsum_clauses(2)) qed
+ thus "(\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V" unfolding scaleR_scaleR[THEN sym] and scaleR_right.setsum [symmetric]
+ apply(subst *) unfolding setsum_clauses(2)[OF *(2)]
+ 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)"],
+ 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
+ qed auto
+ next assume "card s = 1" then obtain a where "s={a}" by(auto simp add: card_Suc_eq)
+ thus ?thesis using as(4,5) by simp
+ qed(insert `s\<noteq>{}` `finite s`, auto)
+qed
+
+lemma affine_hull_explicit:
+ "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}"
+ apply(rule hull_unique) apply(subst subset_eq) prefer 3 apply rule unfolding mem_Collect_eq and mem_def[of _ affine]
+ apply (erule exE)+ apply(erule conjE)+ prefer 2 apply rule proof-
+ 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"
+ apply(rule_tac x="{x}" in exI, rule_tac x="\<lambda>x. 1" in exI) by auto
+next
+ 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"
+ thus "x \<in> t" using as(2)[unfolded affine, THEN spec[where x=s], THEN spec[where x=u]] by auto
+next
+ 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
+ apply(rule,rule,rule,rule,rule) unfolding mem_Collect_eq proof-
+ fix u v ::real assume uv:"u + v = 1"
+ 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"
+ 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
+ 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"
+ 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
+ have xy:"finite (sx \<union> sy)" using x(1) y(1) by auto
+ have **:"(sx \<union> sy) \<inter> sx = sx" "(sx \<union> sy) \<inter> sy = sy" by auto
+ 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"
+ apply(rule_tac x="sx \<union> sy" in exI)
+ 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)
+ unfolding scaleR_left_distrib setsum_addf if_smult scaleR_zero_left ** setsum_restrict_set[OF xy, THEN sym]
+ unfolding scaleR_scaleR[THEN sym] scaleR_right.setsum [symmetric] and setsum_right_distrib[THEN sym]
+ unfolding x y using x(1-3) y(1-3) uv by simp qed qed
+
+lemma affine_hull_finite:
+ assumes "finite s"
+ shows "affine hull s = {y. \<exists>u. setsum u s = 1 \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = y}"
+ unfolding affine_hull_explicit and expand_set_eq and mem_Collect_eq apply (rule,rule)
+ apply(erule exE)+ apply(erule conjE)+ defer apply(erule exE) apply(erule conjE) proof-
+ fix x u assume "setsum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = x"
+ 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"
+ apply(rule_tac x=s in exI, rule_tac x=u in exI) using assms by auto
+next
+ fix x t u assume "t \<subseteq> s" hence *:"s \<inter> t = t" by auto
+ 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"
+ 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)
+ unfolding if_smult scaleR_zero_left and setsum_restrict_set[OF assms, THEN sym] and * by auto qed
+
+subsection {* Stepping theorems and hence small special cases. *}
+
+lemma affine_hull_empty[simp]: "affine hull {} = {}"
+ apply(rule hull_unique) unfolding mem_def by auto
+
+lemma affine_hull_finite_step:
+ fixes y :: "'a::real_vector"
+ shows "(\<exists>u. setsum u {} = w \<and> setsum (\<lambda>x. u x *\<^sub>R x) {} = y) \<longleftrightarrow> w = 0 \<and> y = 0" (is ?th1)
+ "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>
+ (\<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)")
+proof-
+ show ?th1 by simp
+ assume ?as
+ { assume ?lhs
+ 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
+ have ?rhs proof(cases "a\<in>s")
+ case True hence *:"insert a s = s" by auto
+ show ?thesis using u[unfolded *] apply(rule_tac x=0 in exI) by auto
+ next
+ case False thus ?thesis apply(rule_tac x="u a" in exI) using u and `?as` by auto
+ qed } moreover
+ { assume ?rhs
+ 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
+ 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
+ have ?lhs proof(cases "a\<in>s")
+ case True thus ?thesis
+ apply(rule_tac x="\<lambda>x. (if x=a then v else 0) + u x" in exI)
+ unfolding setsum_clauses(2)[OF `?as`] apply simp
+ unfolding scaleR_left_distrib and setsum_addf
+ unfolding vu and * and scaleR_zero_left
+ by (auto simp add: setsum_delta[OF `?as`])
+ next
+ case False
+ hence **:"\<And>x. x \<in> s \<Longrightarrow> u x = (if x = a then v else u x)"
+ "\<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
+ from False show ?thesis
+ apply(rule_tac x="\<lambda>x. if x=a then v else u x" in exI)
+ unfolding setsum_clauses(2)[OF `?as`] and * using vu
+ 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)]
+ using setsum_cong2[of s u "\<lambda>x. if x = a then v else u x", OF **(1)] by auto
+ qed }
+ ultimately show "?lhs = ?rhs" by blast
+qed
+
+lemma affine_hull_2:
+ fixes a b :: "'a::real_vector"
+ shows "affine hull {a,b} = {u *\<^sub>R a + v *\<^sub>R b| u v. (u + v = 1)}" (is "?lhs = ?rhs")
+proof-
+ have *:"\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::real)"
+ "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::'a)" by auto
+ have "?lhs = {y. \<exists>u. setsum u {a, b} = 1 \<and> (\<Sum>v\<in>{a, b}. u v *\<^sub>R v) = y}"
+ using affine_hull_finite[of "{a,b}"] by auto
+ also have "\<dots> = {y. \<exists>v u. u b = 1 - v \<and> u b *\<^sub>R b = y - v *\<^sub>R a}"
+ by(simp add: affine_hull_finite_step(2)[of "{b}" a])
+ also have "\<dots> = ?rhs" unfolding * by auto
+ finally show ?thesis by auto
+qed
+
+lemma affine_hull_3:
+ fixes a b c :: "'a::real_vector"
+ 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")
+proof-
+ have *:"\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::real)"
+ "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::'a)" by auto
+ show ?thesis apply(simp add: affine_hull_finite affine_hull_finite_step)
+ unfolding * apply auto
+ apply(rule_tac x=v in exI) apply(rule_tac x=va in exI) apply auto
+ apply(rule_tac x=u in exI) by(auto intro!: exI)
+qed
+
+subsection {* Some relations between affine hull and subspaces. *}
+
+lemma affine_hull_insert_subset_span:
+ fixes a :: "real ^ _"
+ shows "affine hull (insert a s) \<subseteq> {a + v| v . v \<in> span {x - a | x . x \<in> s}}"
+ unfolding subset_eq Ball_def unfolding affine_hull_explicit span_explicit mem_Collect_eq smult_conv_scaleR
+ apply(rule,rule) apply(erule exE)+ apply(erule conjE)+ proof-
+ 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"
+ have "(\<lambda>x. x - a) ` (t - {a}) \<subseteq> {x - a |x. x \<in> s}" using as(3) by auto
+ 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)"
+ apply(rule_tac x="x - a" in exI)
+ apply (rule conjI, simp)
+ apply(rule_tac x="(\<lambda>x. x - a) ` (t - {a})" in exI)
+ apply(rule_tac x="\<lambda>x. u (x + a)" in exI)
+ apply (rule conjI) using as(1) apply simp
+ apply (erule conjI)
+ using as(1)
+ 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)
+ unfolding as by simp qed
+
+lemma affine_hull_insert_span:
+ fixes a :: "real ^ _"
+ assumes "a \<notin> s"
+ shows "affine hull (insert a s) =
+ {a + v | v . v \<in> span {x - a | x. x \<in> s}}"
+ apply(rule, rule affine_hull_insert_subset_span) unfolding subset_eq Ball_def
+ unfolding affine_hull_explicit and mem_Collect_eq proof(rule,rule,erule exE,erule conjE)
+ fix y v assume "y = a + v" "v \<in> span {x - a |x. x \<in> s}"
+ 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
+ def f \<equiv> "(\<lambda>x. x + a) ` t"
+ 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
+ by(auto simp add: setsum_reindex[unfolded inj_on_def])
+ have *:"f \<inter> {a} = {}" "f \<inter> - {a} = f" using f(2) assms by auto
+ 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"
+ apply(rule_tac x="insert a f" in exI)
+ apply(rule_tac x="\<lambda>x. if x=a then 1 - setsum (\<lambda>x. u (x - a)) f else u (x - a)" in exI)
+ using assms and f unfolding setsum_clauses(2)[OF f(1)] and if_smult
+ unfolding setsum_cases[OF f(1), of "{a}", unfolded singleton_iff] and *
+ by (auto simp add: setsum_subtractf scaleR_left.setsum algebra_simps) qed
+
+lemma affine_hull_span:
+ fixes a :: "real ^ _"
+ assumes "a \<in> s"
+ shows "affine hull s = {a + v | v. v \<in> span {x - a | x. x \<in> s - {a}}}"
+ using affine_hull_insert_span[of a "s - {a}", unfolded insert_Diff[OF assms]] by auto
+
+subsection {* Convexity. *}
+
+definition
+ convex :: "'a::real_vector set \<Rightarrow> bool" where
+ "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)"
+
+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)"
+proof- have *:"\<And>u v::real. u + v = 1 \<longleftrightarrow> u = 1 - v" by auto
+ show ?thesis unfolding convex_def apply auto
+ apply(erule_tac x=x in ballE) apply(erule_tac x=y in ballE) apply(erule_tac x="1 - u" in allE)
+ by (auto simp add: *) qed
+
+lemma mem_convex:
+ assumes "convex s" "a \<in> s" "b \<in> s" "0 \<le> u" "u \<le> 1"
+ shows "((1 - u) *\<^sub>R a + u *\<^sub>R b) \<in> s"
+ using assms unfolding convex_alt by auto
+
+lemma convex_empty[intro]: "convex {}"
+ unfolding convex_def by simp
+
+lemma convex_singleton[intro]: "convex {a}"
+ unfolding convex_def by (auto simp add:scaleR_left_distrib[THEN sym])
+
+lemma convex_UNIV[intro]: "convex UNIV"
+ unfolding convex_def by auto
+
+lemma convex_Inter: "(\<forall>s\<in>f. convex s) ==> convex(\<Inter> f)"
+ unfolding convex_def by auto
+
+lemma convex_Int: "convex s \<Longrightarrow> convex t \<Longrightarrow> convex (s \<inter> t)"
+ unfolding convex_def by auto
+
+lemma convex_halfspace_le: "convex {x. inner a x \<le> b}"
+ unfolding convex_def apply auto
+ unfolding inner_add inner_scaleR
+ by (metis real_convex_bound_le)
+
+lemma convex_halfspace_ge: "convex {x. inner a x \<ge> b}"
+proof- have *:"{x. inner a x \<ge> b} = {x. inner (-a) x \<le> -b}" by auto
+ show ?thesis apply(unfold *) using convex_halfspace_le[of "-a" "-b"] by auto qed
+
+lemma convex_hyperplane: "convex {x. inner a x = b}"
+proof-
+ have *:"{x. inner a x = b} = {x. inner a x \<le> b} \<inter> {x. inner a x \<ge> b}" by auto
+ show ?thesis unfolding * apply(rule convex_Int)
+ using convex_halfspace_le convex_halfspace_ge by auto
+qed
+
+lemma convex_halfspace_lt: "convex {x. inner a x < b}"
+ unfolding convex_def
+ by(auto simp add: real_convex_bound_lt inner_add)
+
+lemma convex_halfspace_gt: "convex {x. inner a x > b}"
+ using convex_halfspace_lt[of "-a" "-b"] by auto
+
+lemma convex_positive_orthant: "convex {x::real^'n::finite. (\<forall>i. 0 \<le> x$i)}"
+ unfolding convex_def apply auto apply(erule_tac x=i in allE)+
+ apply(rule add_nonneg_nonneg) by(auto simp add: mult_nonneg_nonneg)
+
+subsection {* Explicit expressions for convexity in terms of arbitrary sums. *}
+
+lemma convex: "convex s \<longleftrightarrow>
+ (\<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> setsum (\<lambda>i. u i *\<^sub>R x i) {1..k} \<in> s)"
+ unfolding convex_def apply rule apply(rule allI)+ defer apply(rule ballI)+ apply(rule allI)+ proof(rule,rule,rule,rule)
+ 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"
+ "x \<in> s" "y \<in> s" "0 \<le> u" "0 \<le> v" "u + v = (1::real)"
+ 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-)
+ by (auto simp add: setsum_head_Suc)
+next
+ 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"
+ 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)
+ case (Suc k) show ?case proof(cases "u (Suc k) = 1")
+ 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-
+ fix i assume i:"i \<in> {Suc 0..k}" "u i *\<^sub>R x i \<noteq> 0"
+ hence ui:"u i \<noteq> 0" by auto
+ 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
+ hence "setsum u {1 .. k} \<ge> u i" using i(1) by(auto simp add: setsum_delta)
+ 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
+ thus False using Suc(3) unfolding setsum_cl_ivl_Suc and True by simp qed
+ thus ?thesis unfolding setsum_cl_ivl_Suc using True and Suc(2) by auto
+ next
+ have *:"setsum u {1..k} = 1 - u (Suc k)" using Suc(3)[unfolded setsum_cl_ivl_Suc] by auto
+ 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
+ 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)
+ case False hence nn:"1 - u (Suc k) \<noteq> 0" by auto
+ 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 *
+ apply(rule_tac allI) apply(rule,rule) apply(rule divide_nonneg_pos) using nn Suc(2) ** by auto
+ 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"
+ 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
+ thus ?thesis unfolding setsum_cl_ivl_Suc and *** and scaleR_right.setsum [symmetric] using nn by auto qed qed auto qed
+
+
+lemma convex_explicit:
+ fixes s :: "'a::real_vector set"
+ shows "convex s \<longleftrightarrow>
+ (\<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)"
+ unfolding convex_def apply(rule,rule,rule) apply(subst imp_conjL,rule) defer apply(rule,rule,rule,rule,rule,rule,rule) proof-
+ 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)"
+ show "u *\<^sub>R x + v *\<^sub>R y \<in> s" proof(cases "x=y")
+ case True show ?thesis unfolding True and scaleR_left_distrib[THEN sym] using as(3,6) by auto next
+ 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
+next
+ 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)"
+ (*"finite t" "t \<subseteq> s" "\<forall>x\<in>t. (0::real) \<le> u x" "setsum u t = 1"*)
+ 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)
+ prefer 3 apply (rule,rule) apply(erule conjE)+ proof-
+ 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"
+ 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)"
+ show "(\<Sum>x\<in>insert x f. u x *\<^sub>R x) \<in> s" proof(cases "u x = 1")
+ 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-
+ fix y assume y:"y \<in> f" "u y *\<^sub>R y \<noteq> 0"
+ hence uy:"u y \<noteq> 0" by auto
+ 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
+ hence "setsum u f \<ge> u y" using y(1) and as(1) by(auto simp add: setsum_delta)
+ hence "setsum u f > 0" using uy apply(rule_tac less_le_trans[of _ "u y"]) using as(4) and y(1) by auto
+ thus False using as(2,5) unfolding setsum_clauses(2)[OF as(1)] and True by auto qed
+ thus ?thesis unfolding setsum_clauses(2)[OF as(1)] using as(2,3) unfolding True by auto
+ next
+ have *:"setsum u f = setsum u (insert x f) - u x" using as(2) unfolding setsum_clauses(2)[OF as(1)] by auto
+ have **:"u x \<le> 1" apply(rule ccontr) unfolding not_le using as(5)[unfolded setsum_clauses(2)[OF as(1)]] and as(2)
+ using setsum_nonneg[of f u] and as(4) by auto
+ 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
+ apply(rule_tac ind[THEN spec, THEN mp]) apply rule defer apply rule apply rule apply(rule mult_nonneg_nonneg)
+ unfolding setsum_right_distrib[THEN sym] and * using as and ** by auto
+ 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"
+ 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
+ thus ?thesis unfolding setsum_clauses(2)[OF as(1)] using as(2) and False by auto qed
+ 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
+qed
+
+lemma convex_finite: assumes "finite s"
+ shows "convex s \<longleftrightarrow> (\<forall>u. (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1
+ \<longrightarrow> setsum (\<lambda>x. u x *\<^sub>R x) s \<in> s)"
+ unfolding convex_explicit apply(rule, rule, rule) defer apply(rule,rule,rule)apply(erule conjE)+ proof-
+ 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)"
+ have *:"s \<inter> t = t" using as(3) by auto
+ 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"]]
+ unfolding if_smult and setsum_cases[OF assms] and * using as(2-) by auto
+qed (erule_tac x=s in allE, erule_tac x=u in allE, auto)
+
+subsection {* Cones. *}
+
+definition
+ cone :: "'a::real_vector set \<Rightarrow> bool" where
+ "cone s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>c\<ge>0. (c *\<^sub>R x) \<in> s)"
+
+lemma cone_empty[intro, simp]: "cone {}"
+ unfolding cone_def by auto
+
+lemma cone_univ[intro, simp]: "cone UNIV"
+ unfolding cone_def by auto
+
+lemma cone_Inter[intro]: "(\<forall>s\<in>f. cone s) \<Longrightarrow> cone(\<Inter> f)"
+ unfolding cone_def by auto
+
+subsection {* Conic hull. *}
+
+lemma cone_cone_hull: "cone (cone hull s)"
+ unfolding hull_def using cone_Inter[of "{t \<in> conic. s \<subseteq> t}"]
+ by (auto simp add: mem_def)
+
+lemma cone_hull_eq: "(cone hull s = s) \<longleftrightarrow> cone s"
+ apply(rule hull_eq[unfolded mem_def])
+ using cone_Inter unfolding subset_eq by (auto simp add: mem_def)
+
+subsection {* Affine dependence and consequential theorems (from Lars Schewe). *}
+
+definition
+ affine_dependent :: "'a::real_vector set \<Rightarrow> bool" where
+ "affine_dependent s \<longleftrightarrow> (\<exists>x\<in>s. x \<in> (affine hull (s - {x})))"
+
+lemma affine_dependent_explicit:
+ "affine_dependent p \<longleftrightarrow>
+ (\<exists>s u. finite s \<and> s \<subseteq> p \<and> setsum u s = 0 \<and>
+ (\<exists>v\<in>s. u v \<noteq> 0) \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = 0)"
+ unfolding affine_dependent_def affine_hull_explicit mem_Collect_eq apply(rule)
+ apply(erule bexE,erule exE,erule exE) apply(erule conjE)+ defer apply(erule exE,erule exE) apply(erule conjE)+ apply(erule bexE)
+proof-
+ 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"
+ have "x\<notin>s" using as(1,4) by auto
+ 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"
+ apply(rule_tac x="insert x s" in exI, rule_tac x="\<lambda>v. if v = x then - 1 else u v" in exI)
+ unfolding if_smult and setsum_clauses(2)[OF as(2)] and setsum_delta_notmem[OF `x\<notin>s`] and as using as by auto
+next
+ 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"
+ have "s \<noteq> {v}" using as(3,6) by auto
+ 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"
+ 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)
+ 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
+qed
+
+lemma affine_dependent_explicit_finite:
+ fixes s :: "'a::real_vector set" assumes "finite s"
+ 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)"
+ (is "?lhs = ?rhs")
+proof
+ 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
+ assume ?lhs
+ 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"
+ unfolding affine_dependent_explicit by auto
+ thus ?rhs apply(rule_tac x="\<lambda>x. if x\<in>t then u x else 0" in exI)
+ apply auto unfolding * and setsum_restrict_set[OF assms, THEN sym]
+ unfolding Int_absorb1[OF `t\<subseteq>s`] by auto
+next
+ assume ?rhs
+ 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
+ thus ?lhs unfolding affine_dependent_explicit using assms by auto
+qed
+
+subsection {* A general lemma. *}
+
+lemma convex_connected:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "convex s" shows "connected s"
+proof-
+ { fix e1 e2 assume as:"open e1" "open e2" "e1 \<inter> e2 \<inter> s = {}" "s \<subseteq> e1 \<union> e2"
+ assume "e1 \<inter> s \<noteq> {}" "e2 \<inter> s \<noteq> {}"
+ then obtain x1 x2 where x1:"x1\<in>e1" "x1\<in>s" and x2:"x2\<in>e2" "x2\<in>s" by auto
+ hence n:"norm (x1 - x2) > 0" unfolding zero_less_norm_iff using as(3) by auto
+
+ { fix x e::real assume as:"0 \<le> x" "x \<le> 1" "0 < e"
+ { 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"
+ by (simp add: algebra_simps)
+ assume "\<bar>y - x\<bar> < e / norm (x1 - x2)"
+ hence "norm ((1 - x) *\<^sub>R x1 + x *\<^sub>R x2 - ((1 - y) *\<^sub>R x1 + y *\<^sub>R x2)) < e"
+ unfolding * and scaleR_right_diff_distrib[THEN sym]
+ unfolding less_divide_eq using n by auto }
+ 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"
+ apply(rule_tac x="e / norm (x1 - x2)" in exI) using as
+ apply auto unfolding zero_less_divide_iff using n by simp } note * = this
+
+ 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"
+ apply(rule connected_real_lemma) apply (simp add: `x1\<in>e1` `x2\<in>e2` dist_commute)+
+ using * apply(simp add: dist_norm)
+ using as(1,2)[unfolded open_dist] apply simp
+ using as(1,2)[unfolded open_dist] apply simp
+ using assms[unfolded convex_alt, THEN bspec[where x=x1], THEN bspec[where x=x2]] using x1 x2
+ using as(3) by auto
+ 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
+ hence False using as(4)
+ using assms[unfolded convex_alt, THEN bspec[where x=x1], THEN bspec[where x=x2]]
+ using x1(2) x2(2) by auto }
+ thus ?thesis unfolding connected_def by auto
+qed
+
+subsection {* One rather trivial consequence. *}
+
+lemma connected_UNIV: "connected (UNIV :: 'a::real_normed_vector set)"
+ by(simp add: convex_connected convex_UNIV)
+
+subsection {* Convex functions into the reals. *}
+
+definition
+ convex_on :: "'a::real_vector set \<Rightarrow> ('a \<Rightarrow> real) \<Rightarrow> bool" where
+ "convex_on s f \<longleftrightarrow>
+ (\<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)"
+
+lemma convex_on_subset: "convex_on t f \<Longrightarrow> s \<subseteq> t \<Longrightarrow> convex_on s f"
+ unfolding convex_on_def by auto
+
+lemma convex_add:
+ assumes "convex_on s f" "convex_on s g"
+ shows "convex_on s (\<lambda>x. f x + g x)"
+proof-
+ { fix x y assume "x\<in>s" "y\<in>s" moreover
+ fix u v ::real assume "0 \<le> u" "0 \<le> v" "u + v = 1"
+ 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)"
+ using assms(1)[unfolded convex_on_def, THEN bspec[where x=x], THEN bspec[where x=y], THEN spec[where x=u]]
+ using assms(2)[unfolded convex_on_def, THEN bspec[where x=x], THEN bspec[where x=y], THEN spec[where x=u]]
+ apply - apply(rule add_mono) by auto
+ 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) }
+ thus ?thesis unfolding convex_on_def by auto
+qed
+
+lemma convex_cmul:
+ assumes "0 \<le> (c::real)" "convex_on s f"
+ shows "convex_on s (\<lambda>x. c * f x)"
+proof-
+ have *:"\<And>u c fx v fy ::real. u * (c * fx) + v * (c * fy) = c * (u * fx + v * fy)" by (simp add: ring_simps)
+ show ?thesis using assms(2) and mult_mono1[OF _ assms(1)] unfolding convex_on_def and * by auto
+qed
+
+lemma convex_lower:
+ assumes "convex_on s f" "x\<in>s" "y \<in> s" "0 \<le> u" "0 \<le> v" "u + v = 1"
+ shows "f (u *\<^sub>R x + v *\<^sub>R y) \<le> max (f x) (f y)"
+proof-
+ let ?m = "max (f x) (f y)"
+ have "u * f x + v * f y \<le> u * max (f x) (f y) + v * max (f x) (f y)" apply(rule add_mono)
+ using assms(4,5) by(auto simp add: mult_mono1)
+ also have "\<dots> = max (f x) (f y)" using assms(6) unfolding distrib[THEN sym] by auto
+ 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]]
+ using assms(2-6) by auto
+qed
+
+lemma convex_local_global_minimum:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "0<e" "convex_on s f" "ball x e \<subseteq> s" "\<forall>y\<in>ball x e. f x \<le> f y"
+ shows "\<forall>y\<in>s. f x \<le> f y"
+proof(rule ccontr)
+ have "x\<in>s" using assms(1,3) by auto
+ assume "\<not> (\<forall>y\<in>s. f x \<le> f y)"
+ then obtain y where "y\<in>s" and y:"f x > f y" by auto
+ hence xy:"0 < dist x y" by (auto simp add: dist_nz[THEN sym])
+
+ then obtain u where "0 < u" "u \<le> 1" and u:"u < e / dist x y"
+ 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
+ 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`
+ 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
+ moreover
+ have *:"x - ((1 - u) *\<^sub>R x + u *\<^sub>R y) = u *\<^sub>R (x - y)" by (simp add: algebra_simps)
+ 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]
+ using u unfolding pos_less_divide_eq[OF xy] by auto
+ hence "f x \<le> f ((1 - u) *\<^sub>R x + u *\<^sub>R y)" using assms(4) by auto
+ ultimately show False using mult_strict_left_mono[OF y `u>0`] unfolding left_diff_distrib by auto
+qed
+
+lemma convex_distance:
+ fixes s :: "'a::real_normed_vector set"
+ shows "convex_on s (\<lambda>x. dist a x)"
+proof(auto simp add: convex_on_def dist_norm)
+ fix x y assume "x\<in>s" "y\<in>s"
+ fix u v ::real assume "0 \<le> u" "0 \<le> v" "u + v = 1"
+ have "a = u *\<^sub>R a + v *\<^sub>R a" unfolding scaleR_left_distrib[THEN sym] and `u+v=1` by simp
+ hence *:"a - (u *\<^sub>R x + v *\<^sub>R y) = (u *\<^sub>R (a - x)) + (v *\<^sub>R (a - y))"
+ by (auto simp add: algebra_simps)
+ show "norm (a - (u *\<^sub>R x + v *\<^sub>R y)) \<le> u * norm (a - x) + v * norm (a - y)"
+ unfolding * using norm_triangle_ineq[of "u *\<^sub>R (a - x)" "v *\<^sub>R (a - y)"]
+ using `0 \<le> u` `0 \<le> v` by auto
+qed
+
+subsection {* Arithmetic operations on sets preserve convexity. *}
+
+lemma convex_scaling: "convex s \<Longrightarrow> convex ((\<lambda>x. c *\<^sub>R x) ` s)"
+ unfolding convex_def and image_iff apply auto
+ apply (rule_tac x="u *\<^sub>R x+v *\<^sub>R y" in bexI) by (auto simp add: algebra_simps)
+
+lemma convex_negations: "convex s \<Longrightarrow> convex ((\<lambda>x. -x)` s)"
+ unfolding convex_def and image_iff apply auto
+ apply (rule_tac x="u *\<^sub>R x+v *\<^sub>R y" in bexI) by auto
+
+lemma convex_sums:
+ assumes "convex s" "convex t"
+ shows "convex {x + y| x y. x \<in> s \<and> y \<in> t}"
+proof(auto simp add: convex_def image_iff scaleR_right_distrib)
+ fix xa xb ya yb assume xy:"xa\<in>s" "xb\<in>s" "ya\<in>t" "yb\<in>t"
+ fix u v ::real assume uv:"0 \<le> u" "0 \<le> v" "u + v = 1"
+ 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"
+ 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)
+ using assms(1)[unfolded convex_def, THEN bspec[where x=xa], THEN bspec[where x=xb]]
+ using assms(2)[unfolded convex_def, THEN bspec[where x=ya], THEN bspec[where x=yb]]
+ using uv xy by auto
+qed
+
+lemma convex_differences:
+ assumes "convex s" "convex t"
+ shows "convex {x - y| x y. x \<in> s \<and> y \<in> t}"
+proof-
+ 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
+ apply(rule_tac x=xa in exI) apply(rule_tac x="-y" in exI) apply simp
+ apply(rule_tac x=xa in exI) apply(rule_tac x=xb in exI) by simp
+ thus ?thesis using convex_sums[OF assms(1) convex_negations[OF assms(2)]] by auto
+qed
+
+lemma convex_translation: assumes "convex s" shows "convex ((\<lambda>x. a + x) ` s)"
+proof- have "{a + y |y. y \<in> s} = (\<lambda>x. a + x) ` s" by auto
+ thus ?thesis using convex_sums[OF convex_singleton[of a] assms] by auto qed
+
+lemma convex_affinity: assumes "convex s" shows "convex ((\<lambda>x. a + c *\<^sub>R x) ` s)"
+proof- have "(\<lambda>x. a + c *\<^sub>R x) ` s = op + a ` op *\<^sub>R c ` s" by auto
+ thus ?thesis using convex_translation[OF convex_scaling[OF assms], of a c] by auto qed
+
+lemma convex_linear_image:
+ assumes c:"convex s" and l:"bounded_linear f"
+ shows "convex(f ` s)"
+proof(auto simp add: convex_def)
+ interpret f: bounded_linear f by fact
+ fix x y assume xy:"x \<in> s" "y \<in> s"
+ fix u v ::real assume uv:"0 \<le> u" "0 \<le> v" "u + v = 1"
+ show "u *\<^sub>R f x + v *\<^sub>R f y \<in> f ` s" unfolding image_iff
+ apply(rule_tac x="u *\<^sub>R x + v *\<^sub>R y" in bexI)
+ unfolding f.add f.scaleR
+ using c[unfolded convex_def] xy uv by auto
+qed
+
+subsection {* Balls, being convex, are connected. *}
+
+lemma convex_ball:
+ fixes x :: "'a::real_normed_vector"
+ shows "convex (ball x e)"
+proof(auto simp add: convex_def)
+ fix y z assume yz:"dist x y < e" "dist x z < e"
+ fix u v ::real assume uv:"0 \<le> u" "0 \<le> v" "u + v = 1"
+ have "dist x (u *\<^sub>R y + v *\<^sub>R z) \<le> u * dist x y + v * dist x z" using uv yz
+ using convex_distance[of "ball x e" x, unfolded convex_on_def, THEN bspec[where x=y], THEN bspec[where x=z]] by auto
+ thus "dist x (u *\<^sub>R y + v *\<^sub>R z) < e" using real_convex_bound_lt[OF yz uv] by auto
+qed
+
+lemma convex_cball:
+ fixes x :: "'a::real_normed_vector"
+ shows "convex(cball x e)"
+proof(auto simp add: convex_def Ball_def mem_cball)
+ fix y z assume yz:"dist x y \<le> e" "dist x z \<le> e"
+ fix u v ::real assume uv:" 0 \<le> u" "0 \<le> v" "u + v = 1"
+ have "dist x (u *\<^sub>R y + v *\<^sub>R z) \<le> u * dist x y + v * dist x z" using uv yz
+ using convex_distance[of "cball x e" x, unfolded convex_on_def, THEN bspec[where x=y], THEN bspec[where x=z]] by auto
+ thus "dist x (u *\<^sub>R y + v *\<^sub>R z) \<le> e" using real_convex_bound_le[OF yz uv] by auto
+qed
+
+lemma connected_ball:
+ fixes x :: "'a::real_normed_vector"
+ shows "connected (ball x e)"
+ using convex_connected convex_ball by auto
+
+lemma connected_cball:
+ fixes x :: "'a::real_normed_vector"
+ shows "connected(cball x e)"
+ using convex_connected convex_cball by auto
+
+subsection {* Convex hull. *}
+
+lemma convex_convex_hull: "convex(convex hull s)"
+ unfolding hull_def using convex_Inter[of "{t\<in>convex. s\<subseteq>t}"]
+ unfolding mem_def by auto
+
+lemma convex_hull_eq: "(convex hull s = s) \<longleftrightarrow> convex s" apply(rule hull_eq[unfolded mem_def])
+ using convex_Inter[unfolded Ball_def mem_def] by auto
+
+lemma bounded_convex_hull:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "bounded s" shows "bounded(convex hull s)"
+proof- from assms obtain B where B:"\<forall>x\<in>s. norm x \<le> B" unfolding bounded_iff by auto
+ show ?thesis apply(rule bounded_subset[OF bounded_cball, of _ 0 B])
+ unfolding subset_hull[unfolded mem_def, of convex, OF convex_cball]
+ unfolding subset_eq mem_cball dist_norm using B by auto qed
+
+lemma finite_imp_bounded_convex_hull:
+ fixes s :: "'a::real_normed_vector set"
+ shows "finite s \<Longrightarrow> bounded(convex hull s)"
+ using bounded_convex_hull finite_imp_bounded by auto
+
+subsection {* Stepping theorems for convex hulls of finite sets. *}
+
+lemma convex_hull_empty[simp]: "convex hull {} = {}"
+ apply(rule hull_unique) unfolding mem_def by auto
+
+lemma convex_hull_singleton[simp]: "convex hull {a} = {a}"
+ apply(rule hull_unique) unfolding mem_def by auto
+
+lemma convex_hull_insert:
+ fixes s :: "'a::real_vector set"
+ assumes "s \<noteq> {}"
+ shows "convex hull (insert a s) = {x. \<exists>u\<ge>0. \<exists>v\<ge>0. \<exists>b. (u + v = 1) \<and>
+ b \<in> (convex hull s) \<and> (x = u *\<^sub>R a + v *\<^sub>R b)}" (is "?xyz = ?hull")
+ apply(rule,rule hull_minimal,rule) unfolding mem_def[of _ convex] and insert_iff prefer 3 apply rule proof-
+ fix x assume x:"x = a \<or> x \<in> s"
+ thus "x\<in>?hull" apply rule unfolding mem_Collect_eq apply(rule_tac x=1 in exI) defer
+ apply(rule_tac x=0 in exI) using assms hull_subset[of s convex] by auto
+next
+ fix x assume "x\<in>?hull"
+ 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
+ have "a\<in>convex hull insert a s" "b\<in>convex hull insert a s"
+ using hull_mono[of s "insert a s" convex] hull_mono[of "{a}" "insert a s" convex] and obt(4) by auto
+ thus "x\<in> convex hull insert a s" unfolding obt(5) using convex_convex_hull[of "insert a s", unfolded convex_def]
+ 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
+next
+ show "convex ?hull" unfolding convex_def apply(rule,rule,rule,rule,rule,rule,rule) proof-
+ fix x y u v assume as:"(0::real) \<le> u" "0 \<le> v" "u + v = 1" "x\<in>?hull" "y\<in>?hull"
+ 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
+ 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
+ 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)
+ 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)"
+ proof(cases "u * v1 + v * v2 = 0")
+ 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)
+ case True hence **:"u * v1 = 0" "v * v2 = 0" apply- apply(rule_tac [!] ccontr)
+ using mult_nonneg_nonneg[OF `u\<ge>0` `v1\<ge>0`] mult_nonneg_nonneg[OF `v\<ge>0` `v2\<ge>0`] by auto
+ hence "u * u1 + v * u2 = 1" using as(3) obt1(3) obt2(3) by auto
+ thus ?thesis unfolding obt1(5) obt2(5) * using assms hull_subset[of s convex] by(auto simp add: ** scaleR_right_distrib)
+ next
+ 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)
+ also have "\<dots> = u * (v1 + u1 - u1) + v * (v2 + u2 - u2)" using as(3) obt1(3) obt2(3) by (auto simp add: field_simps)
+ also have "\<dots> = u * v1 + v * v2" by simp finally have **:"1 - (u * u1 + v * u2) = u * v1 + v * v2" by auto
+ case False have "0 \<le> u * v1 + v * v2" "0 \<le> u * v1" "0 \<le> u * v1 + v * v2" "0 \<le> v * v2" apply -
+ apply(rule add_nonneg_nonneg) prefer 4 apply(rule add_nonneg_nonneg) apply(rule_tac [!] mult_nonneg_nonneg)
+ using as(1,2) obt1(1,2) obt2(1,2) by auto
+ thus ?thesis unfolding obt1(5) obt2(5) unfolding * and ** using False
+ 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
+ apply(rule convex_convex_hull[of s, unfolded convex_def, rule_format]) using obt1(4) obt2(4)
+ unfolding add_divide_distrib[THEN sym] and real_0_le_divide_iff
+ by (auto simp add: scaleR_left_distrib scaleR_right_distrib)
+ qed note * = this
+ have u1:"u1 \<le> 1" apply(rule ccontr) unfolding obt1(3)[THEN sym] and not_le using obt1(2) by auto
+ have u2:"u2 \<le> 1" apply(rule ccontr) unfolding obt2(3)[THEN sym] and not_le using obt2(2) by auto
+ have "u1 * u + u2 * v \<le> (max u1 u2) * u + (max u1 u2) * v" apply(rule add_mono)
+ apply(rule_tac [!] mult_right_mono) using as(1,2) obt1(1,2) obt2(1,2) by auto
+ also have "\<dots> \<le> 1" unfolding mult.add_right[THEN sym] and as(3) using u1 u2 by auto
+ finally
+ 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)
+ apply(rule conjI) defer apply(rule_tac x="1 - u * u1 - v * u2" in exI) unfolding Bex_def
+ using as(1,2) obt1(1,2) obt2(1,2) * by(auto intro!: mult_nonneg_nonneg add_nonneg_nonneg simp add: algebra_simps)
+ qed
+qed
+
+
+subsection {* Explicit expression for convex hull. *}
+
+lemma convex_hull_indexed:
+ fixes s :: "'a::real_vector set"
+ 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>
+ (setsum u {1..k} = 1) \<and>
+ (setsum (\<lambda>i. u i *\<^sub>R x i) {1..k} = y)}" (is "?xyz = ?hull")
+ apply(rule hull_unique) unfolding mem_def[of _ convex] apply(rule) defer
+ apply(subst convex_def) apply(rule,rule,rule,rule,rule,rule,rule)
+proof-
+ fix x assume "x\<in>s"
+ 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
+next
+ fix t assume as:"s \<subseteq> t" "convex t"
+ show "?hull \<subseteq> t" apply(rule) unfolding mem_Collect_eq apply(erule exE | erule conjE)+ proof-
+ 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"
+ show "x\<in>t" unfolding assm(3)[THEN sym] apply(rule as(2)[unfolded convex, rule_format])
+ using assm(1,2) as(1) by auto qed
+next
+ 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"
+ 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
+ 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
+ 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)"
+ "{1..k1 + k2} \<inter> {1..k1} = {1..k1}" "{1..k1 + k2} \<inter> - {1..k1} = (\<lambda>i. i + k1) ` {1..k2}"
+ prefer 3 apply(rule,rule) unfolding image_iff apply(rule_tac x="x - k1" in bexI) by(auto simp add: not_le)
+ have inj:"inj_on (\<lambda>i. i + k1) {1..k2}" unfolding inj_on_def by auto
+ show "u *\<^sub>R x + v *\<^sub>R y \<in> ?hull" apply(rule)
+ 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)
+ 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)
+ unfolding * and setsum_cases[OF finite_atLeastAtMost[of 1 "k1 + k2"]] and setsum_reindex[OF inj] and o_def
+ unfolding scaleR_scaleR[THEN sym] scaleR_right.setsum [symmetric] setsum_right_distrib[THEN sym] proof-
+ fix i assume i:"i \<in> {1..k1+k2}"
+ 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"
+ proof(cases "i\<in>{1..k1}")
+ case True thus ?thesis using mult_nonneg_nonneg[of u "u1 i"] and uv(1) x(1)[THEN bspec[where x=i]] by auto
+ next def j \<equiv> "i - k1"
+ case False with i have "j \<in> {1..k2}" unfolding j_def by auto
+ thus ?thesis unfolding j_def[symmetric] using False
+ using mult_nonneg_nonneg[of v "u2 j"] and uv(2) y(1)[THEN bspec[where x=j]] by auto qed
+ qed(auto simp add: not_le x(2,3) y(2,3) uv(3))
+qed
+
+lemma convex_hull_finite:
+ fixes s :: "'a::real_vector set"
+ assumes "finite s"
+ shows "convex hull s = {y. \<exists>u. (\<forall>x\<in>s. 0 \<le> u x) \<and>
+ setsum u s = 1 \<and> setsum (\<lambda>x. u x *\<^sub>R x) s = y}" (is "?HULL = ?set")
+proof(rule hull_unique, auto simp add: mem_def[of _ convex] convex_def[of ?set])
+ 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"
+ apply(rule_tac x="\<lambda>y. if x=y then 1 else 0" in exI) apply auto
+ unfolding setsum_delta'[OF assms] and setsum_delta''[OF assms] by auto
+next
+ fix u v ::real assume uv:"0 \<le> u" "0 \<le> v" "u + v = 1"
+ fix ux assume ux:"\<forall>x\<in>s. 0 \<le> ux x" "setsum ux s = (1::real)"
+ fix uy assume uy:"\<forall>x\<in>s. 0 \<le> uy x" "setsum uy s = (1::real)"
+ { fix x assume "x\<in>s"
+ 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)
+ by (auto, metis add_nonneg_nonneg mult_nonneg_nonneg uv(1) uv(2)) }
+ moreover have "(\<Sum>x\<in>s. u * ux x + v * uy x) = 1"
+ unfolding setsum_addf and setsum_right_distrib[THEN sym] and ux(2) uy(2) using uv(3) by auto
+ 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)"
+ unfolding scaleR_left_distrib and setsum_addf and scaleR_scaleR[THEN sym] and scaleR_right.setsum [symmetric] by auto
+ 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)"
+ apply(rule_tac x="\<lambda>x. u * ux x + v * uy x" in exI) by auto
+next
+ fix t assume t:"s \<subseteq> t" "convex t"
+ fix u assume u:"\<forall>x\<in>s. 0 \<le> u x" "setsum u s = (1::real)"
+ 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]]
+ using assms and t(1) by auto
+qed
+
+subsection {* Another formulation from Lars Schewe. *}
+
+lemma setsum_constant_scaleR:
+ fixes y :: "'a::real_vector"
+ shows "(\<Sum>x\<in>A. y) = of_nat (card A) *\<^sub>R y"
+apply (cases "finite A")
+apply (induct set: finite)
+apply (simp_all add: algebra_simps)
+done
+
+lemma convex_hull_explicit:
+ fixes p :: "'a::real_vector set"
+ shows "convex hull p = {y. \<exists>s u. finite s \<and> s \<subseteq> p \<and>
+ (\<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")
+proof-
+ { fix x assume "x\<in>?lhs"
+ 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"
+ unfolding convex_hull_indexed by auto
+
+ have fin:"finite {1..k}" by auto
+ have fin':"\<And>v. finite {i \<in> {1..k}. y i = v}" by auto
+ { fix j assume "j\<in>{1..k}"
+ hence "y j \<in> p" "0 \<le> setsum u {i. Suc 0 \<le> i \<and> i \<le> k \<and> y i = y j}"
+ using obt(1)[THEN bspec[where x=j]] and obt(2) apply simp
+ apply(rule setsum_nonneg) using obt(1) by auto }
+ moreover
+ have "(\<Sum>v\<in>y ` {1..k}. setsum u {i \<in> {1..k}. y i = v}) = 1"
+ unfolding setsum_image_gen[OF fin, THEN sym] using obt(2) by auto
+ moreover have "(\<Sum>v\<in>y ` {1..k}. setsum u {i \<in> {1..k}. y i = v} *\<^sub>R v) = x"
+ using setsum_image_gen[OF fin, of "\<lambda>i. u i *\<^sub>R y i" y, THEN sym]
+ unfolding scaleR_left.setsum using obt(3) by auto
+ 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"
+ apply(rule_tac x="y ` {1..k}" in exI)
+ apply(rule_tac x="\<lambda>v. setsum u {i\<in>{1..k}. y i = v}" in exI) by auto
+ hence "x\<in>?rhs" by auto }
+ moreover
+ { fix y assume "y\<in>?rhs"
+ 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
+
+ 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
+
+ { fix i::nat assume "i\<in>{1..card s}"
+ hence "f i \<in> s" apply(subst f(2)[THEN sym]) by auto
+ hence "0 \<le> u (f i)" "f i \<in> p" using obt(2,3) by auto }
+ moreover have *:"finite {1..card s}" by auto
+ { fix y assume "y\<in>s"
+ 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
+ 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
+ hence "card {x. Suc 0 \<le> x \<and> x \<le> card s \<and> f x = y} = 1" by auto
+ hence "(\<Sum>x\<in>{x \<in> {1..card s}. f x = y}. u (f x)) = u y"
+ "(\<Sum>x\<in>{x \<in> {1..card s}. f x = y}. u (f x) *\<^sub>R f x) = u y *\<^sub>R y"
+ by (auto simp add: setsum_constant_scaleR) }
+
+ hence "(\<Sum>x = 1..card s. u (f x)) = 1" "(\<Sum>i = 1..card s. u (f i) *\<^sub>R f i) = y"
+ 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]
+ 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"]
+ 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
+
+ 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"
+ 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
+ hence "y \<in> ?lhs" unfolding convex_hull_indexed by auto }
+ ultimately show ?thesis unfolding expand_set_eq by blast
+qed
+
+subsection {* A stepping theorem for that expansion. *}
+
+lemma convex_hull_finite_step:
+ fixes s :: "'a::real_vector set" assumes "finite s"
+ 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)
+ \<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")
+proof(rule, case_tac[!] "a\<in>s")
+ assume "a\<in>s" hence *:"insert a s = s" by auto
+ assume ?lhs thus ?rhs unfolding * apply(rule_tac x=0 in exI) by auto
+next
+ 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
+ assume "a\<notin>s" thus ?rhs apply(rule_tac x="u a" in exI) using u(1)[THEN bspec[where x=a]] apply simp
+ apply(rule_tac x=u in exI) using u[unfolded setsum_clauses(2)[OF assms]] and `a\<notin>s` by auto
+next
+ assume "a\<in>s" hence *:"insert a s = s" by auto
+ have fin:"finite (insert a s)" using assms by auto
+ 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
+ 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]
+ unfolding setsum_clauses(2)[OF assms] using uv and uv(2)[THEN bspec[where x=a]] and `a\<in>s` by auto
+next
+ 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
+ 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)"
+ apply(rule_tac setsum_cong2) defer apply(rule_tac setsum_cong2) using `a\<notin>s` by auto
+ 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
+qed
+
+subsection {* Hence some special cases. *}
+
+lemma convex_hull_2:
+ "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}"
+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
+show ?thesis apply(simp add: convex_hull_finite) unfolding convex_hull_finite_step[OF **, of a 1, unfolded * conj_assoc]
+ apply auto apply(rule_tac x=v in exI) apply(rule_tac x="1 - v" in exI) apply simp
+ apply(rule_tac x=u in exI) apply simp apply(rule_tac x="\<lambda>x. v" in exI) by simp qed
+
+lemma convex_hull_2_alt: "convex hull {a,b} = {a + u *\<^sub>R (b - a) | u. 0 \<le> u \<and> u \<le> 1}"
+ unfolding convex_hull_2 unfolding Collect_def
+proof(rule ext) have *:"\<And>x y ::real. x + y = 1 \<longleftrightarrow> x = 1 - y" by auto
+ 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)"
+ unfolding * apply auto apply(rule_tac[!] x=u in exI) by (auto simp add: algebra_simps) qed
+
+lemma convex_hull_3:
+ "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}"
+proof-
+ have fin:"finite {a,b,c}" "finite {b,c}" "finite {c}" by auto
+ have *:"\<And>x y z ::real. x + y + z = 1 \<longleftrightarrow> x = 1 - y - z"
+ "\<And>x y z ::real^'n. x + y + z = 1 \<longleftrightarrow> x = 1 - y - z" by (auto simp add: ring_simps)
+ show ?thesis unfolding convex_hull_finite[OF fin(1)] and Collect_def and convex_hull_finite_step[OF fin(2)] and *
+ unfolding convex_hull_finite_step[OF fin(3)] apply(rule ext) apply simp apply auto
+ apply(rule_tac x=va in exI) apply (rule_tac x="u c" in exI) apply simp
+ 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
+
+lemma convex_hull_3_alt:
+ "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}"
+proof- have *:"\<And>x y z ::real. x + y + z = 1 \<longleftrightarrow> x = 1 - y - z" by auto
+ 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)
+ apply(rule_tac x=u in exI) apply(rule_tac x=v in exI) by (simp add: algebra_simps) qed
+
+subsection {* Relations among closure notions and corresponding hulls. *}
+
+text {* TODO: Generalize linear algebra concepts defined in @{text
+Euclidean_Space.thy} so that we can generalize these lemmas. *}
+
+lemma subspace_imp_affine:
+ fixes s :: "(real ^ _) set" shows "subspace s \<Longrightarrow> affine s"
+ unfolding subspace_def affine_def smult_conv_scaleR by auto
+
+lemma affine_imp_convex: "affine s \<Longrightarrow> convex s"
+ unfolding affine_def convex_def by auto
+
+lemma subspace_imp_convex:
+ fixes s :: "(real ^ _) set" shows "subspace s \<Longrightarrow> convex s"
+ using subspace_imp_affine affine_imp_convex by auto
+
+lemma affine_hull_subset_span:
+ fixes s :: "(real ^ _) set" shows "(affine hull s) \<subseteq> (span s)"
+ unfolding span_def apply(rule hull_antimono) unfolding subset_eq Ball_def mem_def
+ using subspace_imp_affine by auto
+
+lemma convex_hull_subset_span:
+ fixes s :: "(real ^ _) set" shows "(convex hull s) \<subseteq> (span s)"
+ unfolding span_def apply(rule hull_antimono) unfolding subset_eq Ball_def mem_def
+ using subspace_imp_convex by auto
+
+lemma convex_hull_subset_affine_hull: "(convex hull s) \<subseteq> (affine hull s)"
+ unfolding span_def apply(rule hull_antimono) unfolding subset_eq Ball_def mem_def
+ using affine_imp_convex by auto
+
+lemma affine_dependent_imp_dependent:
+ fixes s :: "(real ^ _) set" shows "affine_dependent s \<Longrightarrow> dependent s"
+ unfolding affine_dependent_def dependent_def
+ using affine_hull_subset_span by auto
+
+lemma dependent_imp_affine_dependent:
+ fixes s :: "(real ^ _) set"
+ assumes "dependent {x - a| x . x \<in> s}" "a \<notin> s"
+ shows "affine_dependent (insert a s)"
+proof-
+ from assms(1)[unfolded dependent_explicit smult_conv_scaleR] obtain S u v
+ 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
+ def t \<equiv> "(\<lambda>x. x + a) ` S"
+
+ have inj:"inj_on (\<lambda>x. x + a) S" unfolding inj_on_def by auto
+ have "0\<notin>S" using obt(2) assms(2) unfolding subset_eq by auto
+ have fin:"finite t" and "t\<subseteq>s" unfolding t_def using obt(1,2) by auto
+
+ hence "finite (insert a t)" and "insert a t \<subseteq> insert a s" by auto
+ moreover have *:"\<And>P Q. (\<Sum>x\<in>t. (if x = a then P x else Q x)) = (\<Sum>x\<in>t. Q x)"
+ apply(rule setsum_cong2) using `a\<notin>s` `t\<subseteq>s` by auto
+ have "(\<Sum>x\<in>insert a t. if x = a then - (\<Sum>x\<in>t. u (x - a)) else u (x - a)) = 0"
+ unfolding setsum_clauses(2)[OF fin] using `a\<notin>s` `t\<subseteq>s` apply auto unfolding * by auto
+ 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"
+ apply(rule_tac x="v + a" in bexI) using obt(3,4) and `0\<notin>S` unfolding t_def by auto
+ 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)"
+ apply(rule setsum_cong2) using `a\<notin>s` `t\<subseteq>s` by auto
+ have "(\<Sum>x\<in>t. u (x - a)) *\<^sub>R a = (\<Sum>v\<in>t. u (v - a) *\<^sub>R v)"
+ unfolding scaleR_left.setsum unfolding t_def and setsum_reindex[OF inj] and o_def
+ using obt(5) by (auto simp add: setsum_addf scaleR_right_distrib)
+ 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"
+ unfolding setsum_clauses(2)[OF fin] using `a\<notin>s` `t\<subseteq>s` by (auto simp add: * vector_smult_lneg)
+ ultimately show ?thesis unfolding affine_dependent_explicit
+ apply(rule_tac x="insert a t" in exI) by auto
+qed
+
+lemma convex_cone:
+ "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")
+proof-
+ { fix x y assume "x\<in>s" "y\<in>s" and ?lhs
+ hence "2 *\<^sub>R x \<in>s" "2 *\<^sub>R y \<in> s" unfolding cone_def by auto
+ hence "x + y \<in> s" using `?lhs`[unfolded convex_def, THEN conjunct1]
+ apply(erule_tac x="2*\<^sub>R x" in ballE) apply(erule_tac x="2*\<^sub>R y" in ballE)
+ apply(erule_tac x="1/2" in allE) apply simp apply(erule_tac x="1/2" in allE) by auto }
+ thus ?thesis unfolding convex_def cone_def by blast
+qed
+
+lemma affine_dependent_biggerset: fixes s::"(real^'n::finite) set"
+ assumes "finite s" "card s \<ge> CARD('n) + 2"
+ shows "affine_dependent s"
+proof-
+ have "s\<noteq>{}" using assms by auto then obtain a where "a\<in>s" by auto
+ have *:"{x - a |x. x \<in> s - {a}} = (\<lambda>x. x - a) ` (s - {a})" by auto
+ have "card {x - a |x. x \<in> s - {a}} = card (s - {a})" unfolding *
+ apply(rule card_image) unfolding inj_on_def by auto
+ also have "\<dots> > CARD('n)" using assms(2)
+ unfolding card_Diff_singleton[OF assms(1) `a\<in>s`] by auto
+ finally show ?thesis apply(subst insert_Diff[OF `a\<in>s`, THEN sym])
+ apply(rule dependent_imp_affine_dependent)
+ apply(rule dependent_biggerset) by auto qed
+
+lemma affine_dependent_biggerset_general:
+ assumes "finite (s::(real^'n::finite) set)" "card s \<ge> dim s + 2"
+ shows "affine_dependent s"
+proof-
+ from assms(2) have "s \<noteq> {}" by auto
+ then obtain a where "a\<in>s" by auto
+ have *:"{x - a |x. x \<in> s - {a}} = (\<lambda>x. x - a) ` (s - {a})" by auto
+ have **:"card {x - a |x. x \<in> s - {a}} = card (s - {a})" unfolding *
+ apply(rule card_image) unfolding inj_on_def by auto
+ have "dim {x - a |x. x \<in> s - {a}} \<le> dim s"
+ apply(rule subset_le_dim) unfolding subset_eq
+ using `a\<in>s` by (auto simp add:span_superset span_sub)
+ also have "\<dots> < dim s + 1" by auto
+ also have "\<dots> \<le> card (s - {a})" using assms
+ using card_Diff_singleton[OF assms(1) `a\<in>s`] by auto
+ finally show ?thesis apply(subst insert_Diff[OF `a\<in>s`, THEN sym])
+ apply(rule dependent_imp_affine_dependent) apply(rule dependent_biggerset_general) unfolding ** by auto qed
+
+subsection {* Caratheodory's theorem. *}
+
+lemma convex_hull_caratheodory: fixes p::"(real^'n::finite) set"
+ shows "convex hull p = {y. \<exists>s u. finite s \<and> s \<subseteq> p \<and> card s \<le> CARD('n) + 1 \<and>
+ (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1 \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = y}"
+ unfolding convex_hull_explicit expand_set_eq mem_Collect_eq
+proof(rule,rule)
+ 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"
+ 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"
+ then obtain N where "?P N" by auto
+ hence "\<exists>n\<le>N. (\<forall>k<n. \<not> ?P k) \<and> ?P n" apply(rule_tac ex_least_nat_le) by auto
+ then obtain n where "?P n" and smallest:"\<forall>k<n. \<not> ?P k" by blast
+ 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
+
+ have "card s \<le> CARD('n) + 1" proof(rule ccontr, simp only: not_le)
+ assume "CARD('n) + 1 < card s"
+ hence "affine_dependent s" using affine_dependent_biggerset[OF obt(1)] by auto
+ 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"
+ using affine_dependent_explicit_finite[OF obt(1)] by auto
+ def i \<equiv> "(\<lambda>v. (u v) / (- w v)) ` {v\<in>s. w v < 0}" def t \<equiv> "Min i"
+ have "\<exists>x\<in>s. w x < 0" proof(rule ccontr, simp add: not_less)
+ assume as:"\<forall>x\<in>s. 0 \<le> w x"
+ hence "setsum w (s - {v}) \<ge> 0" apply(rule_tac setsum_nonneg) by auto
+ hence "setsum w s > 0" unfolding setsum_diff1'[OF obt(1) `v\<in>s`]
+ using as[THEN bspec[where x=v]] and `v\<in>s` using `w v \<noteq> 0` by auto
+ thus False using wv(1) by auto
+ qed hence "i\<noteq>{}" unfolding i_def by auto
+
+ hence "t \<ge> 0" using Min_ge_iff[of i 0 ] and obt(1) unfolding t_def i_def
+ using obt(4)[unfolded le_less] apply auto unfolding divide_le_0_iff by auto
+ have t:"\<forall>v\<in>s. u v + t * w v \<ge> 0" proof
+ fix v assume "v\<in>s" hence v:"0\<le>u v" using obt(4)[THEN bspec[where x=v]] by auto
+ show"0 \<le> u v + t * w v" proof(cases "w v < 0")
+ case False thus ?thesis apply(rule_tac add_nonneg_nonneg)
+ using v apply simp apply(rule mult_nonneg_nonneg) using `t\<ge>0` by auto next
+ case True hence "t \<le> u v / (- w v)" using `v\<in>s`
+ unfolding t_def i_def apply(rule_tac Min_le) using obt(1) by auto
+ thus ?thesis unfolding real_0_le_add_iff
+ using pos_le_divide_eq[OF True[unfolded neg_0_less_iff_less[THEN sym]]] by auto
+ qed qed
+
+ obtain a where "a\<in>s" and "t = (\<lambda>v. (u v) / (- w v)) a" and "w a < 0"
+ using Min_in[OF _ `i\<noteq>{}`] and obt(1) unfolding i_def t_def by auto
+ hence a:"a\<in>s" "u a + t * w a = 0" by auto
+ 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
+ have "(\<Sum>v\<in>s. u v + t * w v) = 1"
+ unfolding setsum_addf wv(1) setsum_right_distrib[THEN sym] obt(5) by auto
+ 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"
+ unfolding setsum_addf obt(6) scaleR_scaleR[THEN sym] scaleR_right.setsum [symmetric] wv(4)
+ using a(2) [THEN eq_neg_iff_add_eq_0 [THEN iffD2]]
+ by (simp add: vector_smult_lneg)
+ ultimately have "?P (n - 1)" apply(rule_tac x="(s - {a})" in exI)
+ 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)
+ thus False using smallest[THEN spec[where x="n - 1"]] by auto qed
+ thus "\<exists>s u. finite s \<and> s \<subseteq> p \<and> card s \<le> CARD('n) + 1
+ \<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
+qed auto
+
+lemma caratheodory:
+ "convex hull p = {x::real^'n::finite. \<exists>s. finite s \<and> s \<subseteq> p \<and>
+ card s \<le> CARD('n) + 1 \<and> x \<in> convex hull s}"
+ unfolding expand_set_eq apply(rule, rule) unfolding mem_Collect_eq proof-
+ fix x assume "x \<in> convex hull p"
+ then obtain s u where "finite s" "s \<subseteq> p" "card s \<le> CARD('n) + 1"
+ "\<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
+ thus "\<exists>s. finite s \<and> s \<subseteq> p \<and> card s \<le> CARD('n) + 1 \<and> x \<in> convex hull s"
+ apply(rule_tac x=s in exI) using hull_subset[of s convex]
+ using convex_convex_hull[unfolded convex_explicit, of s, THEN spec[where x=s], THEN spec[where x=u]] by auto
+next
+ fix x assume "\<exists>s. finite s \<and> s \<subseteq> p \<and> card s \<le> CARD('n) + 1 \<and> x \<in> convex hull s"
+ then obtain s where "finite s" "s \<subseteq> p" "card s \<le> CARD('n) + 1" "x \<in> convex hull s" by auto
+ thus "x \<in> convex hull p" using hull_mono[OF `s\<subseteq>p`] by auto
+qed
+
+subsection {* Openness and compactness are preserved by convex hull operation. *}
+
+lemma open_convex_hull:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "open s"
+ shows "open(convex hull s)"
+ unfolding open_contains_cball convex_hull_explicit unfolding mem_Collect_eq ball_simps(10)
+proof(rule, rule) fix a
+ 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"
+ 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
+
+ from assms[unfolded open_contains_cball] obtain b where b:"\<forall>x\<in>s. 0 < b x \<and> cball x (b x) \<subseteq> s"
+ using bchoice[of s "\<lambda>x e. e>0 \<and> cball x e \<subseteq> s"] by auto
+ have "b ` t\<noteq>{}" unfolding i_def using obt by auto def i \<equiv> "b ` t"
+
+ 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}"
+ apply(rule_tac x="Min i" in exI) unfolding subset_eq apply rule defer apply rule unfolding mem_Collect_eq
+ proof-
+ show "0 < Min i" unfolding i_def and Min_gr_iff[OF finite_imageI[OF obt(1)] `b \` t\<noteq>{}`]
+ using b apply simp apply rule apply(erule_tac x=x in ballE) using `t\<subseteq>s` by auto
+ next fix y assume "y \<in> cball a (Min i)"
+ hence y:"norm (a - y) \<le> Min i" unfolding dist_norm[THEN sym] by auto
+ { fix x assume "x\<in>t"
+ hence "Min i \<le> b x" unfolding i_def apply(rule_tac Min_le) using obt(1) by auto
+ hence "x + (y - a) \<in> cball x (b x)" using y unfolding mem_cball dist_norm by auto
+ moreover from `x\<in>t` have "x\<in>s" using obt(2) by auto
+ ultimately have "x + (y - a) \<in> s" using y and b[THEN bspec[where x=x]] unfolding subset_eq by auto }
+ moreover
+ have *:"inj_on (\<lambda>v. v + (y - a)) t" unfolding inj_on_def by auto
+ have "(\<Sum>v\<in>(\<lambda>v. v + (y - a)) ` t. u (v - (y - a))) = 1"
+ unfolding setsum_reindex[OF *] o_def using obt(4) by auto
+ moreover have "(\<Sum>v\<in>(\<lambda>v. v + (y - a)) ` t. u (v - (y - a)) *\<^sub>R v) = y"
+ unfolding setsum_reindex[OF *] o_def using obt(4,5)
+ by (simp add: setsum_addf setsum_subtractf scaleR_left.setsum[THEN sym] scaleR_right_distrib)
+ 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"
+ apply(rule_tac x="(\<lambda>v. v + (y - a)) ` t" in exI) apply(rule_tac x="\<lambda>v. u (v - (y - a))" in exI)
+ using obt(1, 3) by auto
+ qed
+qed
+
+lemma open_dest_vec1_vimage: "open S \<Longrightarrow> open (dest_vec1 -` S)"
+unfolding open_vector_def all_1
+by (auto simp add: dest_vec1_def)
+
+lemma tendsto_dest_vec1 [tendsto_intros]:
+ "(f ---> l) net \<Longrightarrow> ((\<lambda>x. dest_vec1 (f x)) ---> dest_vec1 l) net"
+ unfolding tendsto_def
+ apply clarify
+ apply (drule_tac x="dest_vec1 -` S" in spec)
+ apply (simp add: open_dest_vec1_vimage)
+ done
+
+lemma continuous_dest_vec1: "continuous net f \<Longrightarrow> continuous net (\<lambda>x. dest_vec1 (f x))"
+ unfolding continuous_def by (rule tendsto_dest_vec1)
+
+(* TODO: move *)
+lemma compact_real_interval:
+ fixes a b :: real shows "compact {a..b}"
+proof -
+ have "continuous_on {vec1 a .. vec1 b} dest_vec1"
+ unfolding continuous_on
+ by (simp add: tendsto_dest_vec1 Lim_at_within Lim_ident_at)
+ moreover have "compact {vec1 a .. vec1 b}" by (rule compact_interval)
+ ultimately have "compact (dest_vec1 ` {vec1 a .. vec1 b})"
+ by (rule compact_continuous_image)
+ also have "dest_vec1 ` {vec1 a .. vec1 b} = {a..b}"
+ by (auto simp add: image_def Bex_def exists_vec1)
+ finally show ?thesis .
+qed
+
+lemma compact_convex_combinations:
+ fixes s t :: "'a::real_normed_vector set"
+ assumes "compact s" "compact t"
+ shows "compact { (1 - u) *\<^sub>R x + u *\<^sub>R y | x y u. 0 \<le> u \<and> u \<le> 1 \<and> x \<in> s \<and> y \<in> t}"
+proof-
+ let ?X = "{0..1} \<times> s \<times> t"
+ let ?h = "(\<lambda>z. (1 - fst z) *\<^sub>R fst (snd z) + fst z *\<^sub>R snd (snd z))"
+ have *:"{ (1 - u) *\<^sub>R x + u *\<^sub>R y | x y u. 0 \<le> u \<and> u \<le> 1 \<and> x \<in> s \<and> y \<in> t} = ?h ` ?X"
+ apply(rule set_ext) unfolding image_iff mem_Collect_eq
+ apply rule apply auto
+ apply (rule_tac x=u in rev_bexI, simp)
+ apply (erule rev_bexI, erule rev_bexI, simp)
+ by auto
+ have "continuous_on ({0..1} \<times> s \<times> t)
+ (\<lambda>z. (1 - fst z) *\<^sub>R fst (snd z) + fst z *\<^sub>R snd (snd z))"
+ unfolding continuous_on by (rule ballI) (intro tendsto_intros)
+ thus ?thesis unfolding *
+ apply (rule compact_continuous_image)
+ apply (intro compact_Times compact_real_interval assms)
+ done
+qed
+
+lemma compact_convex_hull: fixes s::"(real^'n::finite) set"
+ assumes "compact s" shows "compact(convex hull s)"
+proof(cases "s={}")
+ case True thus ?thesis using compact_empty by simp
+next
+ case False then obtain w where "w\<in>s" by auto
+ show ?thesis unfolding caratheodory[of s]
+ proof(induct "CARD('n) + 1")
+ have *:"{x.\<exists>sa. finite sa \<and> sa \<subseteq> s \<and> card sa \<le> 0 \<and> x \<in> convex hull sa} = {}"
+ using compact_empty by (auto simp add: convex_hull_empty)
+ case 0 thus ?case unfolding * by simp
+ next
+ case (Suc n)
+ show ?case proof(cases "n=0")
+ case True have "{x. \<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t} = s"
+ unfolding expand_set_eq and mem_Collect_eq proof(rule, rule)
+ fix x assume "\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t"
+ then obtain t where t:"finite t" "t \<subseteq> s" "card t \<le> Suc n" "x \<in> convex hull t" by auto
+ show "x\<in>s" proof(cases "card t = 0")
+ case True thus ?thesis using t(4) unfolding card_0_eq[OF t(1)] by(simp add: convex_hull_empty)
+ next
+ case False hence "card t = Suc 0" using t(3) `n=0` by auto
+ then obtain a where "t = {a}" unfolding card_Suc_eq by auto
+ thus ?thesis using t(2,4) by (simp add: convex_hull_singleton)
+ qed
+ next
+ fix x assume "x\<in>s"
+ thus "\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t"
+ apply(rule_tac x="{x}" in exI) unfolding convex_hull_singleton by auto
+ qed thus ?thesis using assms by simp
+ next
+ case False have "{x. \<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t} =
+ { (1 - u) *\<^sub>R x + u *\<^sub>R y | x y u.
+ 0 \<le> u \<and> u \<le> 1 \<and> x \<in> s \<and> y \<in> {x. \<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> n \<and> x \<in> convex hull t}}"
+ unfolding expand_set_eq and mem_Collect_eq proof(rule,rule)
+ fix x assume "\<exists>u v c. x = (1 - c) *\<^sub>R u + c *\<^sub>R v \<and>
+ 0 \<le> c \<and> c \<le> 1 \<and> u \<in> s \<and> (\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> n \<and> v \<in> convex hull t)"
+ then obtain u v c t where obt:"x = (1 - c) *\<^sub>R u + c *\<^sub>R v"
+ "0 \<le> c \<and> c \<le> 1" "u \<in> s" "finite t" "t \<subseteq> s" "card t \<le> n" "v \<in> convex hull t" by auto
+ moreover have "(1 - c) *\<^sub>R u + c *\<^sub>R v \<in> convex hull insert u t"
+ apply(rule mem_convex) using obt(2) and convex_convex_hull and hull_subset[of "insert u t" convex]
+ using obt(7) and hull_mono[of t "insert u t"] by auto
+ ultimately show "\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t"
+ apply(rule_tac x="insert u t" in exI) by (auto simp add: card_insert_if)
+ next
+ fix x assume "\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t"
+ then obtain t where t:"finite t" "t \<subseteq> s" "card t \<le> Suc n" "x \<in> convex hull t" by auto
+ let ?P = "\<exists>u v c. x = (1 - c) *\<^sub>R u + c *\<^sub>R v \<and>
+ 0 \<le> c \<and> c \<le> 1 \<and> u \<in> s \<and> (\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> n \<and> v \<in> convex hull t)"
+ show ?P proof(cases "card t = Suc n")
+ case False hence "card t \<le> n" using t(3) by auto
+ 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
+ by(auto intro!: exI[where x=t])
+ next
+ case True then obtain a u where au:"t = insert a u" "a\<notin>u" apply(drule_tac card_eq_SucD) by auto
+ show ?P proof(cases "u={}")
+ case True hence "x=a" using t(4)[unfolded au] by auto
+ show ?P unfolding `x=a` apply(rule_tac x=a in exI, rule_tac x=a in exI, rule_tac x=1 in exI)
+ using t and `n\<noteq>0` unfolding au by(auto intro!: exI[where x="{a}"] simp add: convex_hull_singleton)
+ next
+ case False obtain ux vx b where obt:"ux\<ge>0" "vx\<ge>0" "ux + vx = 1" "b \<in> convex hull u" "x = ux *\<^sub>R a + vx *\<^sub>R b"
+ using t(4)[unfolded au convex_hull_insert[OF False]] by auto
+ have *:"1 - vx = ux" using obt(3) by auto
+ show ?P apply(rule_tac x=a in exI, rule_tac x=b in exI, rule_tac x=vx in exI)
+ using obt and t(1-3) unfolding au and * using card_insert_disjoint[OF _ au(2)]
+ by(auto intro!: exI[where x=u])
+ qed
+ qed
+ qed
+ thus ?thesis using compact_convex_combinations[OF assms Suc] by simp
+ qed
+ qed
+qed
+
+lemma finite_imp_compact_convex_hull:
+ fixes s :: "(real ^ _) set"
+ shows "finite s \<Longrightarrow> compact(convex hull s)"
+ apply(drule finite_imp_compact, drule compact_convex_hull) by assumption
+
+subsection {* Extremal points of a simplex are some vertices. *}
+
+lemma dist_increases_online:
+ fixes a b d :: "'a::real_inner"
+ assumes "d \<noteq> 0"
+ shows "dist a (b + d) > dist a b \<or> dist a (b - d) > dist a b"
+proof(cases "inner a d - inner b d > 0")
+ case True hence "0 < inner d d + (inner a d * 2 - inner b d * 2)"
+ apply(rule_tac add_pos_pos) using assms by auto
+ thus ?thesis apply(rule_tac disjI2) unfolding dist_norm and norm_eq_sqrt_inner and real_sqrt_less_iff
+ by (simp add: algebra_simps inner_commute)
+next
+ case False hence "0 < inner d d + (inner b d * 2 - inner a d * 2)"
+ apply(rule_tac add_pos_nonneg) using assms by auto
+ thus ?thesis apply(rule_tac disjI1) unfolding dist_norm and norm_eq_sqrt_inner and real_sqrt_less_iff
+ by (simp add: algebra_simps inner_commute)
+qed
+
+lemma norm_increases_online:
+ fixes d :: "'a::real_inner"
+ shows "d \<noteq> 0 \<Longrightarrow> norm(a + d) > norm a \<or> norm(a - d) > norm a"
+ using dist_increases_online[of d a 0] unfolding dist_norm by auto
+
+lemma simplex_furthest_lt:
+ fixes s::"'a::real_inner set" assumes "finite s"
+ shows "\<forall>x \<in> (convex hull s). x \<notin> s \<longrightarrow> (\<exists>y\<in>(convex hull s). norm(x - a) < norm(y - a))"
+proof(induct_tac rule: finite_induct[of s])
+ fix x s assume as:"finite s" "x\<notin>s" "\<forall>x\<in>convex hull s. x \<notin> s \<longrightarrow> (\<exists>y\<in>convex hull s. norm (x - a) < norm (y - a))"
+ show "\<forall>xa\<in>convex hull insert x s. xa \<notin> insert x s \<longrightarrow> (\<exists>y\<in>convex hull insert x s. norm (xa - a) < norm (y - a))"
+ proof(rule,rule,cases "s = {}")
+ case False fix y assume y:"y \<in> convex hull insert x s" "y \<notin> insert x s"
+ obtain u v b where obt:"u\<ge>0" "v\<ge>0" "u + v = 1" "b \<in> convex hull s" "y = u *\<^sub>R x + v *\<^sub>R b"
+ using y(1)[unfolded convex_hull_insert[OF False]] by auto
+ show "\<exists>z\<in>convex hull insert x s. norm (y - a) < norm (z - a)"
+ proof(cases "y\<in>convex hull s")
+ case True then obtain z where "z\<in>convex hull s" "norm (y - a) < norm (z - a)"
+ using as(3)[THEN bspec[where x=y]] and y(2) by auto
+ thus ?thesis apply(rule_tac x=z in bexI) unfolding convex_hull_insert[OF False] by auto
+ next
+ case False show ?thesis using obt(3) proof(cases "u=0", case_tac[!] "v=0")
+ assume "u=0" "v\<noteq>0" hence "y = b" using obt by auto
+ thus ?thesis using False and obt(4) by auto
+ next
+ assume "u\<noteq>0" "v=0" hence "y = x" using obt by auto
+ thus ?thesis using y(2) by auto
+ next
+ assume "u\<noteq>0" "v\<noteq>0"
+ then obtain w where w:"w>0" "w<u" "w<v" using real_lbound_gt_zero[of u v] and obt(1,2) by auto
+ have "x\<noteq>b" proof(rule ccontr)
+ assume "\<not> x\<noteq>b" hence "y=b" unfolding obt(5)
+ using obt(3) by(auto simp add: scaleR_left_distrib[THEN sym])
+ thus False using obt(4) and False by simp qed
+ hence *:"w *\<^sub>R (x - b) \<noteq> 0" using w(1) by auto
+ show ?thesis using dist_increases_online[OF *, of a y]
+ proof(erule_tac disjE)
+ assume "dist a y < dist a (y + w *\<^sub>R (x - b))"
+ hence "norm (y - a) < norm ((u + w) *\<^sub>R x + (v - w) *\<^sub>R b - a)"
+ unfolding dist_commute[of a] unfolding dist_norm obt(5) by (simp add: algebra_simps)
+ moreover have "(u + w) *\<^sub>R x + (v - w) *\<^sub>R b \<in> convex hull insert x s"
+ unfolding convex_hull_insert[OF `s\<noteq>{}`] and mem_Collect_eq
+ apply(rule_tac x="u + w" in exI) apply rule defer
+ apply(rule_tac x="v - w" in exI) using `u\<ge>0` and w and obt(3,4) by auto
+ ultimately show ?thesis by auto
+ next
+ assume "dist a y < dist a (y - w *\<^sub>R (x - b))"
+ hence "norm (y - a) < norm ((u - w) *\<^sub>R x + (v + w) *\<^sub>R b - a)"
+ unfolding dist_commute[of a] unfolding dist_norm obt(5) by (simp add: algebra_simps)
+ moreover have "(u - w) *\<^sub>R x + (v + w) *\<^sub>R b \<in> convex hull insert x s"
+ unfolding convex_hull_insert[OF `s\<noteq>{}`] and mem_Collect_eq
+ apply(rule_tac x="u - w" in exI) apply rule defer
+ apply(rule_tac x="v + w" in exI) using `u\<ge>0` and w and obt(3,4) by auto
+ ultimately show ?thesis by auto
+ qed
+ qed auto
+ qed
+ qed auto
+qed (auto simp add: assms)
+
+lemma simplex_furthest_le:
+ fixes s :: "(real ^ _) set"
+ assumes "finite s" "s \<noteq> {}"
+ shows "\<exists>y\<in>s. \<forall>x\<in>(convex hull s). norm(x - a) \<le> norm(y - a)"
+proof-
+ have "convex hull s \<noteq> {}" using hull_subset[of s convex] and assms(2) by auto
+ then obtain x where x:"x\<in>convex hull s" "\<forall>y\<in>convex hull s. norm (y - a) \<le> norm (x - a)"
+ using distance_attains_sup[OF finite_imp_compact_convex_hull[OF assms(1)], of a]
+ unfolding dist_commute[of a] unfolding dist_norm by auto
+ thus ?thesis proof(cases "x\<in>s")
+ case False then obtain y where "y\<in>convex hull s" "norm (x - a) < norm (y - a)"
+ using simplex_furthest_lt[OF assms(1), THEN bspec[where x=x]] and x(1) by auto
+ thus ?thesis using x(2)[THEN bspec[where x=y]] by auto
+ qed auto
+qed
+
+lemma simplex_furthest_le_exists:
+ fixes s :: "(real ^ _) set"
+ shows "finite s \<Longrightarrow> (\<forall>x\<in>(convex hull s). \<exists>y\<in>s. norm(x - a) \<le> norm(y - a))"
+ using simplex_furthest_le[of s] by (cases "s={}")auto
+
+lemma simplex_extremal_le:
+ fixes s :: "(real ^ _) set"
+ assumes "finite s" "s \<noteq> {}"
+ shows "\<exists>u\<in>s. \<exists>v\<in>s. \<forall>x\<in>convex hull s. \<forall>y \<in> convex hull s. norm(x - y) \<le> norm(u - v)"
+proof-
+ have "convex hull s \<noteq> {}" using hull_subset[of s convex] and assms(2) by auto
+ then obtain u v where obt:"u\<in>convex hull s" "v\<in>convex hull s"
+ "\<forall>x\<in>convex hull s. \<forall>y\<in>convex hull s. norm (x - y) \<le> norm (u - v)"
+ using compact_sup_maxdistance[OF finite_imp_compact_convex_hull[OF assms(1)]] by auto
+ thus ?thesis proof(cases "u\<notin>s \<or> v\<notin>s", erule_tac disjE)
+ assume "u\<notin>s" then obtain y where "y\<in>convex hull s" "norm (u - v) < norm (y - v)"
+ using simplex_furthest_lt[OF assms(1), THEN bspec[where x=u]] and obt(1) by auto
+ thus ?thesis using obt(3)[THEN bspec[where x=y], THEN bspec[where x=v]] and obt(2) by auto
+ next
+ assume "v\<notin>s" then obtain y where "y\<in>convex hull s" "norm (v - u) < norm (y - u)"
+ using simplex_furthest_lt[OF assms(1), THEN bspec[where x=v]] and obt(2) by auto
+ thus ?thesis using obt(3)[THEN bspec[where x=u], THEN bspec[where x=y]] and obt(1)
+ by (auto simp add: norm_minus_commute)
+ qed auto
+qed
+
+lemma simplex_extremal_le_exists:
+ fixes s :: "(real ^ _) set"
+ shows "finite s \<Longrightarrow> x \<in> convex hull s \<Longrightarrow> y \<in> convex hull s
+ \<Longrightarrow> (\<exists>u\<in>s. \<exists>v\<in>s. norm(x - y) \<le> norm(u - v))"
+ using convex_hull_empty simplex_extremal_le[of s] by(cases "s={}")auto
+
+subsection {* Closest point of a convex set is unique, with a continuous projection. *}
+
+definition
+ closest_point :: "(real ^ 'n::finite) set \<Rightarrow> real ^ 'n \<Rightarrow> real ^ 'n" where
+ "closest_point s a = (SOME x. x \<in> s \<and> (\<forall>y\<in>s. dist a x \<le> dist a y))"
+
+lemma closest_point_exists:
+ assumes "closed s" "s \<noteq> {}"
+ shows "closest_point s a \<in> s" "\<forall>y\<in>s. dist a (closest_point s a) \<le> dist a y"
+ unfolding closest_point_def apply(rule_tac[!] someI2_ex)
+ using distance_attains_inf[OF assms(1,2), of a] by auto
+
+lemma closest_point_in_set:
+ "closed s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> (closest_point s a) \<in> s"
+ by(meson closest_point_exists)
+
+lemma closest_point_le:
+ "closed s \<Longrightarrow> x \<in> s \<Longrightarrow> dist a (closest_point s a) \<le> dist a x"
+ using closest_point_exists[of s] by auto
+
+lemma closest_point_self:
+ assumes "x \<in> s" shows "closest_point s x = x"
+ unfolding closest_point_def apply(rule some1_equality, rule ex1I[of _ x])
+ using assms by auto
+
+lemma closest_point_refl:
+ "closed s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> (closest_point s x = x \<longleftrightarrow> x \<in> s)"
+ using closest_point_in_set[of s x] closest_point_self[of x s] by auto
+
+(* TODO: move *)
+lemma norm_lt: "norm x < norm y \<longleftrightarrow> inner x x < inner y y"
+ unfolding norm_eq_sqrt_inner by simp
+
+(* TODO: move *)
+lemma norm_le: "norm x \<le> norm y \<longleftrightarrow> inner x x \<le> inner y y"
+ unfolding norm_eq_sqrt_inner by simp
+
+lemma closer_points_lemma: fixes y::"real^'n::finite"
+ assumes "inner y z > 0"
+ shows "\<exists>u>0. \<forall>v>0. v \<le> u \<longrightarrow> norm(v *\<^sub>R z - y) < norm y"
+proof- have z:"inner z z > 0" unfolding inner_gt_zero_iff using assms by auto
+ thus ?thesis using assms apply(rule_tac x="inner y z / inner z z" in exI) apply(rule) defer proof(rule+)
+ fix v assume "0<v" "v \<le> inner y z / inner z z"
+ thus "norm (v *\<^sub>R z - y) < norm y" unfolding norm_lt using z and assms
+ by (simp add: field_simps inner_diff inner_commute mult_strict_left_mono[OF _ `0<v`])
+ qed(rule divide_pos_pos, auto) qed
+
+lemma closer_point_lemma:
+ fixes x y z :: "real ^ 'n::finite"
+ assumes "inner (y - x) (z - x) > 0"
+ shows "\<exists>u>0. u \<le> 1 \<and> dist (x + u *\<^sub>R (z - x)) y < dist x y"
+proof- obtain u where "u>0" and u:"\<forall>v>0. v \<le> u \<longrightarrow> norm (v *\<^sub>R (z - x) - (y - x)) < norm (y - x)"
+ using closer_points_lemma[OF assms] by auto
+ show ?thesis apply(rule_tac x="min u 1" in exI) using u[THEN spec[where x="min u 1"]] and `u>0`
+ unfolding dist_norm by(auto simp add: norm_minus_commute field_simps) qed
+
+lemma any_closest_point_dot:
+ fixes s :: "(real ^ _) set"
+ assumes "convex s" "closed s" "x \<in> s" "y \<in> s" "\<forall>z\<in>s. dist a x \<le> dist a z"
+ shows "inner (a - x) (y - x) \<le> 0"
+proof(rule ccontr) assume "\<not> inner (a - x) (y - x) \<le> 0"
+ then obtain u where u:"u>0" "u\<le>1" "dist (x + u *\<^sub>R (y - x)) a < dist x a" using closer_point_lemma[of a x y] by auto
+ let ?z = "(1 - u) *\<^sub>R x + u *\<^sub>R y" have "?z \<in> s" using mem_convex[OF assms(1,3,4), of u] using u by auto
+ thus False using assms(5)[THEN bspec[where x="?z"]] and u(3) by (auto simp add: dist_commute algebra_simps) qed
+
+(* TODO: move *)
+lemma norm_le_square: "norm x \<le> a \<longleftrightarrow> 0 \<le> a \<and> inner x x \<le> a\<twosuperior>"
+proof -
+ have "norm x \<le> a \<longleftrightarrow> 0 \<le> a \<and> norm x \<le> a"
+ using norm_ge_zero [of x] by arith
+ also have "\<dots> \<longleftrightarrow> 0 \<le> a \<and> (norm x)\<twosuperior> \<le> a\<twosuperior>"
+ by (auto intro: power_mono dest: power2_le_imp_le)
+ also have "\<dots> \<longleftrightarrow> 0 \<le> a \<and> inner x x \<le> a\<twosuperior>"
+ unfolding power2_norm_eq_inner ..
+ finally show ?thesis .
+qed
+
+lemma any_closest_point_unique:
+ fixes s :: "(real ^ _) set"
+ assumes "convex s" "closed s" "x \<in> s" "y \<in> s"
+ "\<forall>z\<in>s. dist a x \<le> dist a z" "\<forall>z\<in>s. dist a y \<le> dist a z"
+ shows "x = y" using any_closest_point_dot[OF assms(1-4,5)] and any_closest_point_dot[OF assms(1-2,4,3,6)]
+ unfolding norm_pths(1) and norm_le_square
+ by (auto simp add: algebra_simps)
+
+lemma closest_point_unique:
+ assumes "convex s" "closed s" "x \<in> s" "\<forall>z\<in>s. dist a x \<le> dist a z"
+ shows "x = closest_point s a"
+ using any_closest_point_unique[OF assms(1-3) _ assms(4), of "closest_point s a"]
+ using closest_point_exists[OF assms(2)] and assms(3) by auto
+
+lemma closest_point_dot:
+ assumes "convex s" "closed s" "x \<in> s"
+ shows "inner (a - closest_point s a) (x - closest_point s a) \<le> 0"
+ apply(rule any_closest_point_dot[OF assms(1,2) _ assms(3)])
+ using closest_point_exists[OF assms(2)] and assms(3) by auto
+
+lemma closest_point_lt:
+ assumes "convex s" "closed s" "x \<in> s" "x \<noteq> closest_point s a"
+ shows "dist a (closest_point s a) < dist a x"
+ apply(rule ccontr) apply(rule_tac notE[OF assms(4)])
+ apply(rule closest_point_unique[OF assms(1-3), of a])
+ using closest_point_le[OF assms(2), of _ a] by fastsimp
+
+lemma closest_point_lipschitz:
+ assumes "convex s" "closed s" "s \<noteq> {}"
+ shows "dist (closest_point s x) (closest_point s y) \<le> dist x y"
+proof-
+ have "inner (x - closest_point s x) (closest_point s y - closest_point s x) \<le> 0"
+ "inner (y - closest_point s y) (closest_point s x - closest_point s y) \<le> 0"
+ apply(rule_tac[!] any_closest_point_dot[OF assms(1-2)])
+ using closest_point_exists[OF assms(2-3)] by auto
+ thus ?thesis unfolding dist_norm and norm_le
+ using inner_ge_zero[of "(x - closest_point s x) - (y - closest_point s y)"]
+ by (simp add: inner_add inner_diff inner_commute) qed
+
+lemma continuous_at_closest_point:
+ assumes "convex s" "closed s" "s \<noteq> {}"
+ shows "continuous (at x) (closest_point s)"
+ unfolding continuous_at_eps_delta
+ using le_less_trans[OF closest_point_lipschitz[OF assms]] by auto
+
+lemma continuous_on_closest_point:
+ assumes "convex s" "closed s" "s \<noteq> {}"
+ shows "continuous_on t (closest_point s)"
+ apply(rule continuous_at_imp_continuous_on) using continuous_at_closest_point[OF assms] by auto
+
+subsection {* Various point-to-set separating/supporting hyperplane theorems. *}
+
+lemma supporting_hyperplane_closed_point:
+ fixes s :: "(real ^ _) set"
+ assumes "convex s" "closed s" "s \<noteq> {}" "z \<notin> s"
+ shows "\<exists>a b. \<exists>y\<in>s. inner a z < b \<and> (inner a y = b) \<and> (\<forall>x\<in>s. inner a x \<ge> b)"
+proof-
+ 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
+ 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)
+ apply rule defer apply rule defer apply(rule, rule ccontr) using `y\<in>s` proof-
+ show "inner (y - z) z < inner (y - z) y" apply(subst diff_less_iff(1)[THEN sym])
+ unfolding inner_diff_right[THEN sym] and inner_gt_zero_iff using `y\<in>s` `z\<notin>s` by auto
+ next
+ 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)"
+ using assms(1)[unfolded convex_alt] and y and `x\<in>s` and `y\<in>s` by auto
+ assume "\<not> inner (y - z) y \<le> inner (y - z) x" then obtain v where
+ "v>0" "v\<le>1" "dist (y + v *\<^sub>R (x - y)) z < dist y z" using closer_point_lemma[of z y x] apply - by (auto simp add: inner_diff)
+ thus False using *[THEN spec[where x=v]] by(auto simp add: dist_commute algebra_simps)
+ qed auto
+qed
+
+lemma separating_hyperplane_closed_point:
+ fixes s :: "(real ^ _) set"
+ assumes "convex s" "closed s" "z \<notin> s"
+ shows "\<exists>a b. inner a z < b \<and> (\<forall>x\<in>s. inner a x > b)"
+proof(cases "s={}")
+ case True thus ?thesis apply(rule_tac x="-z" in exI, rule_tac x=1 in exI)
+ using less_le_trans[OF _ inner_ge_zero[of z]] by auto
+next
+ case False obtain y where "y\<in>s" and y:"\<forall>x\<in>s. dist z y \<le> dist z x"
+ using distance_attains_inf[OF assms(2) False] by auto
+ show ?thesis apply(rule_tac x="y - z" in exI, rule_tac x="inner (y - z) z + (norm(y - z))\<twosuperior> / 2" in exI)
+ apply rule defer apply rule proof-
+ fix x assume "x\<in>s"
+ have "\<not> 0 < inner (z - y) (x - y)" apply(rule_tac notI) proof(drule closer_point_lemma)
+ assume "\<exists>u>0. u \<le> 1 \<and> dist (y + u *\<^sub>R (x - y)) z < dist y z"
+ then obtain u where "u>0" "u\<le>1" "dist (y + u *\<^sub>R (x - y)) z < dist y z" by auto
+ thus False using y[THEN bspec[where x="y + u *\<^sub>R (x - y)"]]
+ using assms(1)[unfolded convex_alt, THEN bspec[where x=y]]
+ using `x\<in>s` `y\<in>s` by (auto simp add: dist_commute algebra_simps) qed
+ moreover have "0 < norm (y - z) ^ 2" using `y\<in>s` `z\<notin>s` by auto
+ hence "0 < inner (y - z) (y - z)" unfolding power2_norm_eq_inner by simp
+ ultimately show "inner (y - z) z + (norm (y - z))\<twosuperior> / 2 < inner (y - z) x"
+ unfolding power2_norm_eq_inner and not_less by (auto simp add: field_simps inner_commute inner_diff)
+ qed(insert `y\<in>s` `z\<notin>s`, auto)
+qed
+
+lemma separating_hyperplane_closed_0:
+ assumes "convex (s::(real^'n::finite) set)" "closed s" "0 \<notin> s"
+ shows "\<exists>a b. a \<noteq> 0 \<and> 0 < b \<and> (\<forall>x\<in>s. inner a x > b)"
+ proof(cases "s={}") guess a using UNIV_witness[where 'a='n] ..
+ case True have "norm ((basis a)::real^'n::finite) = 1"
+ using norm_basis and dimindex_ge_1 by auto
+ thus ?thesis apply(rule_tac x="basis a" in exI, rule_tac x=1 in exI) using True by auto
+next case False thus ?thesis using False using separating_hyperplane_closed_point[OF assms]
+ apply - apply(erule exE)+ unfolding dot_rzero apply(rule_tac x=a in exI, rule_tac x=b in exI) by auto qed
+
+subsection {* Now set-to-set for closed/compact sets. *}
+
+lemma separating_hyperplane_closed_compact:
+ assumes "convex (s::(real^'n::finite) set)" "closed s" "convex t" "compact t" "t \<noteq> {}" "s \<inter> t = {}"
+ shows "\<exists>a b. (\<forall>x\<in>s. inner a x < b) \<and> (\<forall>x\<in>t. inner a x > b)"
+proof(cases "s={}")
+ case True
+ obtain b where b:"b>0" "\<forall>x\<in>t. norm x \<le> b" using compact_imp_bounded[OF assms(4)] unfolding bounded_pos by auto
+ obtain z::"real^'n" where z:"norm z = b + 1" using vector_choose_size[of "b + 1"] and b(1) by auto
+ hence "z\<notin>t" using b(2)[THEN bspec[where x=z]] by auto
+ then obtain a b where ab:"inner a z < b" "\<forall>x\<in>t. b < inner a x"
+ using separating_hyperplane_closed_point[OF assms(3) compact_imp_closed[OF assms(4)], of z] by auto
+ thus ?thesis using True by auto
+next
+ case False then obtain y where "y\<in>s" by auto
+ obtain a b where "0 < b" "\<forall>x\<in>{x - y |x y. x \<in> s \<and> y \<in> t}. b < inner a x"
+ using separating_hyperplane_closed_point[OF convex_differences[OF assms(1,3)], of 0]
+ using closed_compact_differences[OF assms(2,4)] using assms(6) by(auto, blast)
+ 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)
+ def k \<equiv> "rsup ((\<lambda>x. inner a x) ` t)"
+ show ?thesis apply(rule_tac x="-a" in exI, rule_tac x="-(k + b / 2)" in exI)
+ apply(rule,rule) defer apply(rule) unfolding inner_minus_left and neg_less_iff_less proof-
+ from ab have "((\<lambda>x. inner a x) ` t) *<= (inner a y - b)"
+ apply(erule_tac x=y in ballE) apply(rule setleI) using `y\<in>s` by auto
+ hence k:"isLub UNIV ((\<lambda>x. inner a x) ` t) k" unfolding k_def apply(rule_tac rsup) using assms(5) by auto
+ 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
+ next
+ fix x assume "x\<in>s"
+ hence "k \<le> inner a x - b" unfolding k_def apply(rule_tac rsup_le) using assms(5)
+ unfolding setle_def
+ using ab[THEN bspec[where x=x]] by auto
+ thus "k + b / 2 < inner a x" using `0 < b` by auto
+ qed
+qed
+
+lemma separating_hyperplane_compact_closed:
+ fixes s :: "(real ^ _) set"
+ assumes "convex s" "compact s" "s \<noteq> {}" "convex t" "closed t" "s \<inter> t = {}"
+ shows "\<exists>a b. (\<forall>x\<in>s. inner a x < b) \<and> (\<forall>x\<in>t. inner a x > b)"
+proof- obtain a b where "(\<forall>x\<in>t. inner a x < b) \<and> (\<forall>x\<in>s. b < inner a x)"
+ using separating_hyperplane_closed_compact[OF assms(4-5,1-2,3)] and assms(6) by auto
+ thus ?thesis apply(rule_tac x="-a" in exI, rule_tac x="-b" in exI) by auto qed
+
+subsection {* General case without assuming closure and getting non-strict separation. *}
+
+lemma separating_hyperplane_set_0:
+ assumes "convex s" "(0::real^'n::finite) \<notin> s"
+ shows "\<exists>a. a \<noteq> 0 \<and> (\<forall>x\<in>s. 0 \<le> inner a x)"
+proof- let ?k = "\<lambda>c. {x::real^'n. 0 \<le> inner c x}"
+ have "frontier (cball 0 1) \<inter> (\<Inter> (?k ` s)) \<noteq> {}"
+ apply(rule compact_imp_fip) apply(rule compact_frontier[OF compact_cball])
+ defer apply(rule,rule,erule conjE) proof-
+ fix f assume as:"f \<subseteq> ?k ` s" "finite f"
+ obtain c where c:"f = ?k ` c" "c\<subseteq>s" "finite c" using finite_subset_image[OF as(2,1)] by auto
+ then obtain a b where ab:"a \<noteq> 0" "0 < b" "\<forall>x\<in>convex hull c. b < inner a x"
+ using separating_hyperplane_closed_0[OF convex_convex_hull, of c]
+ using finite_imp_compact_convex_hull[OF c(3), THEN compact_imp_closed] and assms(2)
+ using subset_hull[unfolded mem_def, of convex, OF assms(1), THEN sym, of c] by auto
+ 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)
+ using hull_subset[of c convex] unfolding subset_eq and inner_scaleR
+ apply- apply rule defer apply rule apply(rule mult_nonneg_nonneg)
+ by(auto simp add: inner_commute elim!: ballE)
+ thus "frontier (cball 0 1) \<inter> \<Inter>f \<noteq> {}" unfolding c(1) frontier_cball dist_norm by auto
+ qed(insert closed_halfspace_ge, auto)
+ then obtain x where "norm x = 1" "\<forall>y\<in>s. x\<in>?k y" unfolding frontier_cball dist_norm by auto
+ thus ?thesis apply(rule_tac x=x in exI) by(auto simp add: inner_commute) qed
+
+lemma separating_hyperplane_sets:
+ assumes "convex s" "convex (t::(real^'n::finite) set)" "s \<noteq> {}" "t \<noteq> {}" "s \<inter> t = {}"
+ shows "\<exists>a b. a \<noteq> 0 \<and> (\<forall>x\<in>s. inner a x \<le> b) \<and> (\<forall>x\<in>t. inner a x \<ge> b)"
+proof- from separating_hyperplane_set_0[OF convex_differences[OF assms(2,1)]]
+ obtain a where "a\<noteq>0" "\<forall>x\<in>{x - y |x y. x \<in> t \<and> y \<in> s}. 0 \<le> inner a x" using assms(3-5) by auto
+ 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)
+ 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`
+ apply(rule) apply(rule,rule) apply(rule rsup[THEN isLubD2]) prefer 4 apply(rule,rule rsup_le) unfolding setle_def
+ prefer 4 using assms(3-5) by blast+ qed
+
+subsection {* More convexity generalities. *}
+
+lemma convex_closure:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "convex s" shows "convex(closure s)"
+ unfolding convex_def Ball_def closure_sequential
+ apply(rule,rule,rule,rule,rule,rule,rule,rule,rule) apply(erule_tac exE)+
+ apply(rule_tac x="\<lambda>n. u *\<^sub>R xb n + v *\<^sub>R xc n" in exI) apply(rule,rule)
+ apply(rule assms[unfolded convex_def, rule_format]) prefer 6
+ apply(rule Lim_add) apply(rule_tac [1-2] Lim_cmul) by auto
+
+lemma convex_interior:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "convex s" shows "convex(interior s)"
+ unfolding convex_alt Ball_def mem_interior apply(rule,rule,rule,rule,rule,rule) apply(erule exE | erule conjE)+ proof-
+ fix x y u assume u:"0 \<le> u" "u \<le> (1::real)"
+ fix e d assume ed:"ball x e \<subseteq> s" "ball y d \<subseteq> s" "0<d" "0<e"
+ show "\<exists>e>0. ball ((1 - u) *\<^sub>R x + u *\<^sub>R y) e \<subseteq> s" apply(rule_tac x="min d e" in exI)
+ apply rule unfolding subset_eq defer apply rule proof-
+ fix z assume "z \<in> ball ((1 - u) *\<^sub>R x + u *\<^sub>R y) (min d e)"
+ hence "(1- u) *\<^sub>R (z - u *\<^sub>R (y - x)) + u *\<^sub>R (z + (1 - u) *\<^sub>R (y - x)) \<in> s"
+ apply(rule_tac assms[unfolded convex_alt, rule_format])
+ using ed(1,2) and u unfolding subset_eq mem_ball Ball_def dist_norm by(auto simp add: algebra_simps)
+ thus "z \<in> s" using u by (auto simp add: algebra_simps) qed(insert u ed(3-4), auto) qed
+
+lemma convex_hull_eq_empty: "convex hull s = {} \<longleftrightarrow> s = {}"
+ using hull_subset[of s convex] convex_hull_empty by auto
+
+subsection {* Moving and scaling convex hulls. *}
+
+lemma convex_hull_translation_lemma:
+ "convex hull ((\<lambda>x. a + x) ` s) \<subseteq> (\<lambda>x. a + x) ` (convex hull s)"
+ apply(rule hull_minimal, rule image_mono, rule hull_subset) unfolding mem_def
+ using convex_translation[OF convex_convex_hull, of a s] by assumption
+
+lemma convex_hull_bilemma: fixes neg
+ assumes "(\<forall>s a. (convex hull (up a s)) \<subseteq> up a (convex hull s))"
+ 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)
+ \<Longrightarrow> \<forall>s. (convex hull (up a s)) = up a (convex hull s)"
+ using assms by(metis subset_antisym)
+
+lemma convex_hull_translation:
+ "convex hull ((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (convex hull s)"
+ apply(rule convex_hull_bilemma[rule_format, of _ _ "\<lambda>a. -a"], rule convex_hull_translation_lemma) unfolding image_image by auto
+
+lemma convex_hull_scaling_lemma:
+ "(convex hull ((\<lambda>x. c *\<^sub>R x) ` s)) \<subseteq> (\<lambda>x. c *\<^sub>R x) ` (convex hull s)"
+ apply(rule hull_minimal, rule image_mono, rule hull_subset)
+ unfolding mem_def by(rule convex_scaling, rule convex_convex_hull)
+
+lemma convex_hull_scaling:
+ "convex hull ((\<lambda>x. c *\<^sub>R x) ` s) = (\<lambda>x. c *\<^sub>R x) ` (convex hull s)"
+ apply(cases "c=0") defer apply(rule convex_hull_bilemma[rule_format, of _ _ inverse]) apply(rule convex_hull_scaling_lemma)
+ unfolding image_image scaleR_scaleR by(auto simp add:image_constant_conv convex_hull_eq_empty)
+
+lemma convex_hull_affinity:
+ "convex hull ((\<lambda>x. a + c *\<^sub>R x) ` s) = (\<lambda>x. a + c *\<^sub>R x) ` (convex hull s)"
+ unfolding image_image[THEN sym] convex_hull_scaling convex_hull_translation ..
+
+subsection {* Convex set as intersection of halfspaces. *}
+
+lemma convex_halfspace_intersection:
+ fixes s :: "(real ^ _) set"
+ assumes "closed s" "convex s"
+ shows "s = \<Inter> {h. s \<subseteq> h \<and> (\<exists>a b. h = {x. inner a x \<le> b})}"
+ apply(rule set_ext, rule) unfolding Inter_iff Ball_def mem_Collect_eq apply(rule,rule,erule conjE) proof-
+ fix x assume "\<forall>xa. s \<subseteq> xa \<and> (\<exists>a b. xa = {x. inner a x \<le> b}) \<longrightarrow> x \<in> xa"
+ hence "\<forall>a b. s \<subseteq> {x. inner a x \<le> b} \<longrightarrow> x \<in> {x. inner a x \<le> b}" by blast
+ thus "x\<in>s" apply(rule_tac ccontr) apply(drule separating_hyperplane_closed_point[OF assms(2,1)])
+ apply(erule exE)+ apply(erule_tac x="-a" in allE, erule_tac x="-b" in allE) by auto
+qed auto
+
+subsection {* Radon's theorem (from Lars Schewe). *}
+
+lemma radon_ex_lemma:
+ assumes "finite c" "affine_dependent c"
+ 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"
+proof- from assms(2)[unfolded affine_dependent_explicit] guess s .. then guess u ..
+ 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
+ and setsum_restrict_set[OF assms(1), THEN sym] by(auto simp add: Int_absorb1) qed
+
+lemma radon_s_lemma:
+ assumes "finite s" "setsum f s = (0::real)"
+ shows "setsum f {x\<in>s. 0 < f x} = - setsum f {x\<in>s. f x < 0}"
+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
+ show ?thesis unfolding real_add_eq_0_iff[THEN sym] and setsum_restrict_set''[OF assms(1)] and setsum_addf[THEN sym] and *
+ using assms(2) by assumption qed
+
+lemma radon_v_lemma:
+ assumes "finite s" "setsum f s = 0" "\<forall>x. g x = (0::real) \<longrightarrow> f x = (0::real^'n)"
+ shows "(setsum f {x\<in>s. 0 < g x}) = - setsum f {x\<in>s. g x < 0}"
+proof-
+ 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
+ show ?thesis unfolding eq_neg_iff_add_eq_0 and setsum_restrict_set''[OF assms(1)] and setsum_addf[THEN sym] and *
+ using assms(2) by assumption qed
+
+lemma radon_partition:
+ assumes "finite c" "affine_dependent c"
+ shows "\<exists>m p. m \<inter> p = {} \<and> m \<union> p = c \<and> (convex hull m) \<inter> (convex hull p) \<noteq> {}" proof-
+ 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
+ have fin:"finite {x \<in> c. 0 < u x}" "finite {x \<in> c. 0 > u x}" using assms(1) by auto
+ 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}"
+ have "setsum u {x \<in> c. 0 < u x} \<noteq> 0" proof(cases "u v \<ge> 0")
+ case False hence "u v < 0" by auto
+ thus ?thesis proof(cases "\<exists>w\<in>{x \<in> c. 0 < u x}. u w > 0")
+ case True thus ?thesis using setsum_nonneg_eq_0_iff[of _ u, OF fin(1)] by auto
+ next
+ 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
+ thus ?thesis unfolding setsum_delta[OF assms(1)] using uv(2) and `u v < 0` and uv(1) by auto qed
+ qed (insert setsum_nonneg_eq_0_iff[of _ u, OF fin(1)] uv(2-3), auto)
+
+ hence *:"setsum u {x\<in>c. u x > 0} > 0" unfolding real_less_def apply(rule_tac conjI, rule_tac setsum_nonneg) by auto
+ moreover have "setsum u ({x \<in> c. 0 < u x} \<union> {x \<in> c. u x < 0}) = setsum u c"
+ "(\<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)"
+ using assms(1) apply(rule_tac[!] setsum_mono_zero_left) by auto
+ hence "setsum u {x \<in> c. 0 < u x} = - setsum u {x \<in> c. 0 > u x}"
+ "(\<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)"
+ unfolding eq_neg_iff_add_eq_0 using uv(1,4) by (auto simp add: setsum_Un_zero[OF fin, THEN sym])
+ moreover have "\<forall>x\<in>{v \<in> c. u v < 0}. 0 \<le> inverse (setsum u {x \<in> c. 0 < u x}) * - u x"
+ apply (rule) apply (rule mult_nonneg_nonneg) using * by auto
+
+ ultimately have "z \<in> convex hull {v \<in> c. u v \<le> 0}" unfolding convex_hull_explicit mem_Collect_eq
+ 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)
+ using assms(1) unfolding scaleR_scaleR[THEN sym] scaleR_right.setsum [symmetric] and z_def
+ by(auto simp add: setsum_negf vector_smult_lneg mult_right.setsum[THEN sym])
+ moreover have "\<forall>x\<in>{v \<in> c. 0 < u v}. 0 \<le> inverse (setsum u {x \<in> c. 0 < u x}) * u x"
+ apply (rule) apply (rule mult_nonneg_nonneg) using * by auto
+ hence "z \<in> convex hull {v \<in> c. u v > 0}" unfolding convex_hull_explicit mem_Collect_eq
+ 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)
+ using assms(1) unfolding scaleR_scaleR[THEN sym] scaleR_right.setsum [symmetric] and z_def using *
+ by(auto simp add: setsum_negf vector_smult_lneg mult_right.setsum[THEN sym])
+ 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
+qed
+
+lemma radon: assumes "affine_dependent c"
+ obtains m p where "m\<subseteq>c" "p\<subseteq>c" "m \<inter> p = {}" "(convex hull m) \<inter> (convex hull p) \<noteq> {}"
+proof- from assms[unfolded affine_dependent_explicit] guess s .. then guess u ..
+ hence *:"finite s" "affine_dependent s" and s:"s \<subseteq> c" unfolding affine_dependent_explicit by auto
+ from radon_partition[OF *] guess m .. then guess p ..
+ thus ?thesis apply(rule_tac that[of p m]) using s by auto qed
+
+subsection {* Helly's theorem. *}
+
+lemma helly_induct: fixes f::"(real^'n::finite) set set"
+ assumes "f hassize n" "n \<ge> CARD('n) + 1"
+ "\<forall>s\<in>f. convex s" "\<forall>t\<subseteq>f. card t = CARD('n) + 1 \<longrightarrow> \<Inter> t \<noteq> {}"
+ shows "\<Inter> f \<noteq> {}"
+ using assms unfolding hassize_def apply(erule_tac conjE) proof(induct n arbitrary: f)
+case (Suc n)
+show "\<Inter> f \<noteq> {}" apply(cases "n = CARD('n)") apply(rule Suc(4)[rule_format])
+ unfolding card_Diff_singleton_if[OF Suc(5)] and Suc(6) proof-
+ 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
+ apply(rule, rule Suc(1)[rule_format]) unfolding card_Diff_singleton_if[OF Suc(5)] and Suc(6)
+ defer apply(rule Suc(3)[rule_format]) defer apply(rule Suc(4)[rule_format]) using Suc(2,5) by auto
+ then obtain X where X:"\<forall>s\<in>f. X s \<in> \<Inter>(f - {s})" by auto
+ show ?thesis proof(cases "inj_on X f")
+ 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
+ hence *:"\<Inter> f = \<Inter> (f - {s}) \<inter> \<Inter> (f - {t})" by auto
+ show ?thesis unfolding * unfolding ex_in_conv[THEN sym] apply(rule_tac x="X s" in exI)
+ apply(rule, rule X[rule_format]) using X st by auto
+ 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> {}"
+ using radon_partition[of "X ` f"] and affine_dependent_biggerset[of "X ` f"]
+ unfolding card_image[OF True] and Suc(6) using Suc(2,5) and ng by auto
+ have "m \<subseteq> X ` f" "p \<subseteq> X ` f" using mp(2) by auto
+ then obtain g h where gh:"m = X ` g" "p = X ` h" "g \<subseteq> f" "h \<subseteq> f" unfolding subset_image_iff by auto
+ hence "f \<union> (g \<union> h) = f" by auto
+ hence f:"f = g \<union> h" using inj_on_Un_image_eq_iff[of X f "g \<union> h"] and True
+ unfolding mp(2)[unfolded image_Un[THEN sym] gh] by auto
+ have *:"g \<inter> h = {}" using mp(1) unfolding gh using inj_on_image_Int[OF True gh(3,4)] by auto
+ have "convex hull (X ` h) \<subseteq> \<Inter> g" "convex hull (X ` g) \<subseteq> \<Inter> h"
+ apply(rule_tac [!] hull_minimal) using Suc(3) gh(3-4) unfolding mem_def unfolding subset_eq
+ apply(rule_tac [2] convex_Inter, rule_tac [4] convex_Inter) apply rule prefer 3 apply rule proof-
+ fix x assume "x\<in>X ` g" then guess y unfolding image_iff ..
+ thus "x\<in>\<Inter>h" using X[THEN bspec[where x=y]] using * f by auto next
+ fix x assume "x\<in>X ` h" then guess y unfolding image_iff ..
+ thus "x\<in>\<Inter>g" using X[THEN bspec[where x=y]] using * f by auto
+ qed(auto)
+ thus ?thesis unfolding f using mp(3)[unfolded gh] by blast qed
+qed(insert dimindex_ge_1, auto) qed(auto)
+
+lemma helly: fixes f::"(real^'n::finite) set set"
+ assumes "finite f" "card f \<ge> CARD('n) + 1" "\<forall>s\<in>f. convex s"
+ "\<forall>t\<subseteq>f. card t = CARD('n) + 1 \<longrightarrow> \<Inter> t \<noteq> {}"
+ shows "\<Inter> f \<noteq>{}"
+ apply(rule helly_induct) unfolding hassize_def using assms by auto
+
+subsection {* Convex hull is "preserved" by a linear function. *}
+
+lemma convex_hull_linear_image:
+ assumes "bounded_linear f"
+ shows "f ` (convex hull s) = convex hull (f ` s)"
+ apply rule unfolding subset_eq ball_simps apply(rule_tac[!] hull_induct, rule hull_inc) prefer 3
+ apply(erule imageE)apply(rule_tac x=xa in image_eqI) apply assumption
+ apply(rule hull_subset[unfolded subset_eq, rule_format]) apply assumption
+proof-
+ interpret f: bounded_linear f by fact
+ show "convex {x. f x \<in> convex hull f ` s}"
+ unfolding convex_def by(auto simp add: f.scaleR f.add convex_convex_hull[unfolded convex_def, rule_format]) next
+ interpret f: bounded_linear f by fact
+ show "convex {x. x \<in> f ` (convex hull s)}" using convex_convex_hull[unfolded convex_def, of s]
+ unfolding convex_def by (auto simp add: f.scaleR [symmetric] f.add [symmetric])
+qed auto
+
+lemma in_convex_hull_linear_image:
+ assumes "bounded_linear f" "x \<in> convex hull s"
+ shows "(f x) \<in> convex hull (f ` s)"
+using convex_hull_linear_image[OF assms(1)] assms(2) by auto
+
+subsection {* Homeomorphism of all convex compact sets with nonempty interior. *}
+
+lemma compact_frontier_line_lemma:
+ fixes s :: "(real ^ _) set"
+ assumes "compact s" "0 \<in> s" "x \<noteq> 0"
+ obtains u where "0 \<le> u" "(u *\<^sub>R x) \<in> frontier s" "\<forall>v>u. (v *\<^sub>R x) \<notin> s"
+proof-
+ 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
+ let ?A = "{y. \<exists>u. 0 \<le> u \<and> u \<le> b / norm(x) \<and> (y = u *\<^sub>R x)}"
+ have A:"?A = (\<lambda>u. dest_vec1 u *\<^sub>R x) ` {0 .. vec1 (b / norm x)}"
+ unfolding image_image[of "\<lambda>u. u *\<^sub>R x" "\<lambda>x. dest_vec1 x", THEN sym]
+ unfolding dest_vec1_inverval vec1_dest_vec1 by auto
+ have "compact ?A" unfolding A apply(rule compact_continuous_image, rule continuous_at_imp_continuous_on)
+ apply(rule, rule continuous_vmul)
+ apply (rule continuous_dest_vec1)
+ apply(rule continuous_at_id) by(rule compact_interval)
+ 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)])
+ unfolding mem_Collect_eq using `b>0` assms(3) by(auto intro!: divide_nonneg_pos)
+ ultimately obtain u y where obt: "u\<ge>0" "u \<le> b / norm x" "y = u *\<^sub>R x"
+ "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
+
+ have "norm x > 0" using assms(3)[unfolded zero_less_norm_iff[THEN sym]] by auto
+ { fix v assume as:"v > u" "v *\<^sub>R x \<in> s"
+ hence "v \<le> b / norm x" using b(2)[rule_format, OF as(2)]
+ using `u\<ge>0` unfolding pos_le_divide_eq[OF `norm x > 0`] by auto
+ hence "norm (v *\<^sub>R x) \<le> norm y" apply(rule_tac obt(6)[rule_format, unfolded dist_0_norm]) apply(rule IntI) defer
+ apply(rule as(2)) unfolding mem_Collect_eq apply(rule_tac x=v in exI)
+ using as(1) `u\<ge>0` by(auto simp add:field_simps)
+ hence False unfolding obt(3) using `u\<ge>0` `norm x > 0` `v>u` by(auto simp add:field_simps)
+ } note u_max = this
+
+ 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]
+ prefer 3 apply(rule_tac x="(u + (e / 2) / norm x) *\<^sub>R x" in exI) apply(rule, rule) proof-
+ fix e assume "0 < e" and as:"(u + e / 2 / norm x) *\<^sub>R x \<in> s"
+ hence "u + e / 2 / norm x > u" using`norm x > 0` by(auto simp del:zero_less_norm_iff intro!: divide_pos_pos)
+ thus False using u_max[OF _ as] by auto
+ qed(insert `y\<in>s`, auto simp add: dist_norm scaleR_left_distrib obt(3))
+ thus ?thesis apply(rule_tac that[of u]) apply(rule obt(1), assumption)
+ apply(rule,rule,rule ccontr) apply(rule u_max) by auto qed
+
+lemma starlike_compact_projective:
+ assumes "compact s" "cball (0::real^'n::finite) 1 \<subseteq> s "
+ "\<forall>x\<in>s. \<forall>u. 0 \<le> u \<and> u < 1 \<longrightarrow> (u *\<^sub>R x) \<in> (s - frontier s )"
+ shows "s homeomorphic (cball (0::real^'n::finite) 1)"
+proof-
+ have fs:"frontier s \<subseteq> s" apply(rule frontier_subset_closed) using compact_imp_closed[OF assms(1)] by simp
+ def pi \<equiv> "\<lambda>x::real^'n. inverse (norm x) *\<^sub>R x"
+ have "0 \<notin> frontier s" unfolding frontier_straddle apply(rule ccontr) unfolding not_not apply(erule_tac x=1 in allE)
+ using assms(2)[unfolded subset_eq Ball_def mem_cball] by auto
+ have injpi:"\<And>x y. pi x = pi y \<and> norm x = norm y \<longleftrightarrow> x = y" unfolding pi_def by auto
+
+ have contpi:"continuous_on (UNIV - {0}) pi" apply(rule continuous_at_imp_continuous_on)
+ apply rule unfolding pi_def
+ apply (rule continuous_mul)
+ apply (rule continuous_at_inv[unfolded o_def])
+ apply (rule continuous_at_norm)
+ apply simp
+ apply (rule continuous_at_id)
+ done
+ def sphere \<equiv> "{x::real^'n. norm x = 1}"
+ 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
+
+ have "0\<in>s" using assms(2) and centre_in_cball[of 0 1] by auto
+ 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)
+ fix x u assume x:"x\<in>frontier s" and "(0::real)\<le>u"
+ hence "x\<noteq>0" using `0\<notin>frontier s` by auto
+ obtain v where v:"0 \<le> v" "v *\<^sub>R x \<in> frontier s" "\<forall>w>v. w *\<^sub>R x \<notin> s"
+ using compact_frontier_line_lemma[OF assms(1) `0\<in>s` `x\<noteq>0`] by auto
+ have "v=1" apply(rule ccontr) unfolding neq_iff apply(erule disjE) proof-
+ assume "v<1" thus False using v(3)[THEN spec[where x=1]] using x and fs by auto next
+ assume "v>1" thus False using assms(3)[THEN bspec[where x="v *\<^sub>R x"], THEN spec[where x="inverse v"]]
+ using v and x and fs unfolding inverse_less_1_iff by auto qed
+ 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-
+ assume "u\<le>1" thus "u *\<^sub>R x \<in> s" apply(cases "u=1")
+ 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
+
+ have "\<exists>surf. homeomorphism (frontier s) sphere pi surf"
+ apply(rule homeomorphism_compact) apply(rule compact_frontier[OF assms(1)])
+ apply(rule continuous_on_subset[OF contpi]) defer apply(rule set_ext,rule)
+ unfolding inj_on_def prefer 3 apply(rule,rule,rule)
+ proof- fix x assume "x\<in>pi ` frontier s" then obtain y where "y\<in>frontier s" "x = pi y" by auto
+ thus "x \<in> sphere" using pi(1)[of y] and `0 \<notin> frontier s` by auto
+ next fix x assume "x\<in>sphere" hence "norm x = 1" "x\<noteq>0" unfolding sphere_def by auto
+ then obtain u where "0 \<le> u" "u *\<^sub>R x \<in> frontier s" "\<forall>v>u. v *\<^sub>R x \<notin> s"
+ using compact_frontier_line_lemma[OF assms(1) `0\<in>s`, of x] by auto
+ 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
+ next fix x y assume as:"x \<in> frontier s" "y \<in> frontier s" "pi x = pi y"
+ hence xys:"x\<in>s" "y\<in>s" using fs by auto
+ from as(1,2) have nor:"norm x \<noteq> 0" "norm y \<noteq> 0" using `0\<notin>frontier s` by auto
+ 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
+ from nor have y:"y = norm y *\<^sub>R ((inverse (norm x)) *\<^sub>R x)" unfolding as(3)[unfolded pi_def] by auto
+ have "0 \<le> norm y * inverse (norm x)" "0 \<le> norm x * inverse (norm y)"
+ unfolding divide_inverse[THEN sym] apply(rule_tac[!] divide_nonneg_pos) using nor by auto
+ hence "norm x = norm y" apply(rule_tac ccontr) unfolding neq_iff
+ using x y and front_smul[THEN bspec, OF as(1), THEN spec[where x="norm y * (inverse (norm x))"]]
+ using front_smul[THEN bspec, OF as(2), THEN spec[where x="norm x * (inverse (norm y))"]]
+ using xys nor by(auto simp add:field_simps divide_le_eq_1 divide_inverse[THEN sym])
+ thus "x = y" apply(subst injpi[THEN sym]) using as(3) by auto
+ qed(insert `0 \<notin> frontier s`, auto)
+ then obtain surf where surf:"\<forall>x\<in>frontier s. surf (pi x) = x" "pi ` frontier s = sphere" "continuous_on (frontier s) pi"
+ "\<forall>y\<in>sphere. pi (surf y) = y" "surf ` sphere = frontier s" "continuous_on sphere surf" unfolding homeomorphism_def by auto
+
+ have cont_surfpi:"continuous_on (UNIV - {0}) (surf \<circ> pi)" apply(rule continuous_on_compose, rule contpi)
+ apply(rule continuous_on_subset[of sphere], rule surf(6)) using pi(1) by auto
+
+ { fix x assume as:"x \<in> cball (0::real^'n) 1"
+ have "norm x *\<^sub>R surf (pi x) \<in> s" proof(cases "x=0 \<or> norm x = 1")
+ case False hence "pi x \<in> sphere" "norm x < 1" using pi(1)[of x] as by(auto simp add: dist_norm)
+ thus ?thesis apply(rule_tac assms(3)[rule_format, THEN DiffD1])
+ apply(rule_tac fs[unfolded subset_eq, rule_format])
+ unfolding surf(5)[THEN sym] by auto
+ next case True thus ?thesis apply rule defer unfolding pi_def apply(rule fs[unfolded subset_eq, rule_format])
+ unfolding surf(5)[unfolded sphere_def, THEN sym] using `0\<in>s` by auto qed } note hom = this
+
+ { fix x assume "x\<in>s"
+ hence "x \<in> (\<lambda>x. norm x *\<^sub>R surf (pi x)) ` cball 0 1" proof(cases "x=0")
+ case True show ?thesis unfolding image_iff True apply(rule_tac x=0 in bexI) by auto
+ next let ?a = "inverse (norm (surf (pi x)))"
+ case False hence invn:"inverse (norm x) \<noteq> 0" by auto
+ from False have pix:"pi x\<in>sphere" using pi(1) by auto
+ hence "pi (surf (pi x)) = pi x" apply(rule_tac surf(4)[rule_format]) by assumption
+ 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
+ hence *:"?a * norm x > 0" and"?a > 0" "?a \<noteq> 0" using surf(5) `0\<notin>frontier s` apply -
+ apply(rule_tac mult_pos_pos) using False[unfolded zero_less_norm_iff[THEN sym]] by auto
+ have "norm (surf (pi x)) \<noteq> 0" using ** False by auto
+ hence "norm x = norm ((?a * norm x) *\<^sub>R surf (pi x))"
+ unfolding norm_scaleR abs_mult abs_norm_cancel abs_of_pos[OF `?a > 0`] by auto
+ moreover have "pi x = pi ((inverse (norm (surf (pi x))) * norm x) *\<^sub>R surf (pi x))"
+ unfolding pi(2)[OF *] surf(4)[rule_format, OF pix] ..
+ moreover have "surf (pi x) \<in> frontier s" using surf(5) pix by auto
+ hence "dist 0 (inverse (norm (surf (pi x))) *\<^sub>R x) \<le> 1" unfolding dist_norm
+ using ** and * using front_smul[THEN bspec[where x="surf (pi x)"], THEN spec[where x="norm x * ?a"]]
+ using False `x\<in>s` by(auto simp add:field_simps)
+ ultimately show ?thesis unfolding image_iff apply(rule_tac x="inverse (norm (surf(pi x))) *\<^sub>R x" in bexI)
+ apply(subst injpi[THEN sym]) unfolding abs_mult abs_norm_cancel abs_of_pos[OF `?a > 0`]
+ unfolding pi(2)[OF `?a > 0`] by auto
+ qed } note hom2 = this
+
+ show ?thesis apply(subst homeomorphic_sym) apply(rule homeomorphic_compact[where f="\<lambda>x. norm x *\<^sub>R surf (pi x)"])
+ apply(rule compact_cball) defer apply(rule set_ext, rule, erule imageE, drule hom)
+ prefer 4 apply(rule continuous_at_imp_continuous_on, rule) apply(rule_tac [3] hom2) proof-
+ fix x::"real^'n" assume as:"x \<in> cball 0 1"
+ thus "continuous (at x) (\<lambda>x. norm x *\<^sub>R surf (pi x))" proof(cases "x=0")
+ case False thus ?thesis apply(rule_tac continuous_mul, rule_tac continuous_at_norm)
+ using cont_surfpi unfolding continuous_on_eq_continuous_at[OF open_delete[OF open_UNIV]] o_def by auto
+ next guess a using UNIV_witness[where 'a = 'n] ..
+ obtain B where B:"\<forall>x\<in>s. norm x \<le> B" using compact_imp_bounded[OF assms(1)] unfolding bounded_iff by auto
+ 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)
+ unfolding Ball_def mem_cball dist_norm by (auto simp add: norm_basis[unfolded One_nat_def])
+ case True show ?thesis unfolding True continuous_at Lim_at apply(rule,rule) apply(rule_tac x="e / B" in exI)
+ apply(rule) apply(rule divide_pos_pos) prefer 3 apply(rule,rule,erule conjE)
+ unfolding norm_0 scaleR_zero_left dist_norm diff_0_right norm_scaleR abs_norm_cancel proof-
+ fix e and x::"real^'n" assume as:"norm x < e / B" "0 < norm x" "0<e"
+ hence "surf (pi x) \<in> frontier s" using pi(1)[of x] unfolding surf(5)[THEN sym] by auto
+ hence "norm (surf (pi x)) \<le> B" using B fs by auto
+ hence "norm x * norm (surf (pi x)) \<le> norm x * B" using as(2) by auto
+ also have "\<dots> < e / B * B" apply(rule mult_strict_right_mono) using as(1) `B>0` by auto
+ also have "\<dots> = e" using `B>0` by auto
+ finally show "norm x * norm (surf (pi x)) < e" by assumption
+ qed(insert `B>0`, auto) qed
+ next { fix x assume as:"surf (pi x) = 0"
+ have "x = 0" proof(rule ccontr)
+ assume "x\<noteq>0" hence "pi x \<in> sphere" using pi(1) by auto
+ hence "surf (pi x) \<in> frontier s" using surf(5) by auto
+ thus False using `0\<notin>frontier s` unfolding as by simp qed
+ } note surf_0 = this
+ show "inj_on (\<lambda>x. norm x *\<^sub>R surf (pi x)) (cball 0 1)" unfolding inj_on_def proof(rule,rule,rule)
+ 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)"
+ thus "x=y" proof(cases "x=0 \<or> y=0")
+ case True thus ?thesis using as by(auto elim: surf_0) next
+ case False
+ hence "pi (surf (pi x)) = pi (surf (pi y))" using as(3)
+ using pi(2)[of "norm x" "surf (pi x)"] pi(2)[of "norm y" "surf (pi y)"] by auto
+ moreover have "pi x \<in> sphere" "pi y \<in> sphere" using pi(1) False by auto
+ 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
+ moreover have "norm x = norm y" using as(3)[unfolded *] using False by(auto dest:surf_0)
+ ultimately show ?thesis using injpi by auto qed qed
+ qed auto qed
+
+lemma homeomorphic_convex_compact_lemma: fixes s::"(real^'n::finite) set"
+ assumes "convex s" "compact s" "cball 0 1 \<subseteq> s"
+ shows "s homeomorphic (cball (0::real^'n) 1)"
+ apply(rule starlike_compact_projective[OF assms(2-3)]) proof(rule,rule,rule,erule conjE)
+ fix x u assume as:"x \<in> s" "0 \<le> u" "u < (1::real)"
+ hence "u *\<^sub>R x \<in> interior s" unfolding interior_def mem_Collect_eq
+ apply(rule_tac x="ball (u *\<^sub>R x) (1 - u)" in exI) apply(rule, rule open_ball)
+ unfolding centre_in_ball apply rule defer apply(rule) unfolding mem_ball proof-
+ fix y assume "dist (u *\<^sub>R x) y < 1 - u"
+ hence "inverse (1 - u) *\<^sub>R (y - u *\<^sub>R x) \<in> s"
+ using assms(3) apply(erule_tac subsetD) unfolding mem_cball dist_commute dist_norm
+ unfolding group_add_class.diff_0 group_add_class.diff_0_right norm_minus_cancel norm_scaleR
+ apply (rule mult_left_le_imp_le[of "1 - u"])
+ unfolding class_semiring.mul_a using `u<1` by auto
+ 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]
+ using as unfolding scaleR_scaleR by auto qed auto
+ thus "u *\<^sub>R x \<in> s - frontier s" using frontier_def and interior_subset by auto qed
+
+lemma homeomorphic_convex_compact_cball: fixes e::real and s::"(real^'n::finite) set"
+ assumes "convex s" "compact s" "interior s \<noteq> {}" "0 < e"
+ shows "s homeomorphic (cball (b::real^'n::finite) e)"
+proof- obtain a where "a\<in>interior s" using assms(3) by auto
+ then obtain d where "d>0" and d:"cball a d \<subseteq> s" unfolding mem_interior_cball by auto
+ let ?d = "inverse d" and ?n = "0::real^'n"
+ have "cball ?n 1 \<subseteq> (\<lambda>x. inverse d *\<^sub>R (x - a)) ` s"
+ apply(rule, rule_tac x="d *\<^sub>R x + a" in image_eqI) defer
+ apply(rule d[unfolded subset_eq, rule_format]) using `d>0` unfolding mem_cball dist_norm
+ by(auto simp add: mult_right_le_one_le)
+ hence "(\<lambda>x. inverse d *\<^sub>R (x - a)) ` s homeomorphic cball ?n 1"
+ using homeomorphic_convex_compact_lemma[of "(\<lambda>x. ?d *\<^sub>R -a + ?d *\<^sub>R x) ` s", OF convex_affinity compact_affinity]
+ using assms(1,2) by(auto simp add: uminus_add_conv_diff scaleR_right_diff_distrib)
+ thus ?thesis apply(rule_tac homeomorphic_trans[OF _ homeomorphic_balls(2)[of 1 _ ?n]])
+ apply(rule homeomorphic_trans[OF homeomorphic_affinity[of "?d" s "?d *\<^sub>R -a"]])
+ using `d>0` `e>0` by(auto simp add: uminus_add_conv_diff scaleR_right_diff_distrib) qed
+
+lemma homeomorphic_convex_compact: fixes s::"(real^'n::finite) set" and t::"(real^'n) set"
+ assumes "convex s" "compact s" "interior s \<noteq> {}"
+ "convex t" "compact t" "interior t \<noteq> {}"
+ shows "s homeomorphic t"
+ using assms by(meson zero_less_one homeomorphic_trans homeomorphic_convex_compact_cball homeomorphic_sym)
+
+subsection {* Epigraphs of convex functions. *}
+
+definition "epigraph s (f::real^'n \<Rightarrow> real) = {xy. fstcart xy \<in> s \<and> f(fstcart xy) \<le> dest_vec1 (sndcart xy)}"
+
+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
+
+lemma convex_epigraph:
+ "convex(epigraph s f) \<longleftrightarrow> convex_on s f \<and> convex s"
+ unfolding convex_def convex_on_def unfolding Ball_def forall_pastecart epigraph_def
+ 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]
+ unfolding Ball_def[symmetric] unfolding dest_vec1_add dest_vec1_cmul [where 'a=real, unfolded smult_conv_scaleR]
+ apply(subst forall_dest_vec1[THEN sym])+ by(meson real_le_refl real_le_trans add_mono mult_left_mono)
+
+lemma convex_epigraphI: assumes "convex_on s f" "convex s"
+ shows "convex(epigraph s f)" using assms unfolding convex_epigraph by auto
+
+lemma convex_epigraph_convex: "convex s \<Longrightarrow> (convex_on s f \<longleftrightarrow> convex(epigraph s f))"
+ using convex_epigraph by auto
+
+subsection {* Use this to derive general bound property of convex function. *}
+
+lemma forall_of_pastecart:
+ "(\<forall>p. P (\<lambda>x. fstcart (p x)) (\<lambda>x. sndcart (p x))) \<longleftrightarrow> (\<forall>x y. P x y)" apply meson
+ apply(erule_tac x="\<lambda>a. pastecart (x a) (y a)" in allE) unfolding o_def by auto
+
+lemma forall_of_pastecart':
+ "(\<forall>p. P (fstcart p) (sndcart p)) \<longleftrightarrow> (\<forall>x y. P x y)" apply meson
+ apply(erule_tac x="pastecart x y" in allE) unfolding o_def by auto
+
+lemma forall_of_dest_vec1: "(\<forall>v. P (\<lambda>x. dest_vec1 (v x))) \<longleftrightarrow> (\<forall>x. P x)"
+ apply rule apply rule apply(erule_tac x="(vec1 \<circ> x)" in allE) unfolding o_def vec1_dest_vec1 by auto
+
+lemma forall_of_dest_vec1': "(\<forall>v. P (dest_vec1 v)) \<longleftrightarrow> (\<forall>x. P x)"
+ apply rule apply rule apply(erule_tac x="(vec1 x)" in allE) defer apply rule
+ apply(erule_tac x="dest_vec1 v" in allE) unfolding o_def vec1_dest_vec1 by auto
+
+lemma convex_on:
+ fixes s :: "(real ^ _) set"
+ assumes "convex s"
+ 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>
+ f (setsum (\<lambda>i. u i *\<^sub>R x i) {1..k} ) \<le> setsum (\<lambda>i. u i * f(x i)) {1..k} ) "
+ unfolding convex_epigraph_convex[OF assms] convex epigraph_def Ball_def mem_Collect_eq
+ unfolding sndcart_setsum[OF finite_atLeastAtMost] fstcart_setsum[OF finite_atLeastAtMost] dest_vec1_setsum[OF finite_atLeastAtMost]
+ 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]
+ 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
+ using assms[unfolded convex] apply simp apply(rule,rule,rule)
+ 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
+ apply(rule_tac j="\<Sum>i = 1..k. u i * f (x i)" in real_le_trans)
+ defer apply(rule setsum_mono) apply(erule conjE)+ apply(erule_tac x=i in allE)apply(rule mult_left_mono)
+ using assms[unfolded convex] by auto
+
+subsection {* Convexity of general and special intervals. *}
+
+lemma is_interval_convex:
+ fixes s :: "(real ^ _) set"
+ assumes "is_interval s" shows "convex s"
+ unfolding convex_def apply(rule,rule,rule,rule,rule,rule,rule) proof-
+ fix x y u v assume as:"x \<in> s" "y \<in> s" "0 \<le> u" "0 \<le> v" "u + v = (1::real)"
+ hence *:"u = 1 - v" "1 - v \<ge> 0" and **:"v = 1 - u" "1 - u \<ge> 0" by auto
+ { fix a b assume "\<not> b \<le> u * a + v * b"
+ hence "u * a < (1 - v) * b" unfolding not_le using as(4) by(auto simp add: field_simps)
+ 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)
+ hence "a \<le> u * a + v * b" unfolding * using as(4) by (auto simp add: field_simps intro!:mult_right_mono)
+ } moreover
+ { fix a b assume "\<not> u * a + v * b \<le> a"
+ hence "v * b > (1 - u) * a" unfolding not_le using as(4) by(auto simp add: field_simps)
+ hence "a < b" unfolding * using as(4) apply(rule_tac mult_left_less_imp_less) by(auto simp add: ring_simps)
+ hence "u * a + v * b \<le> b" unfolding ** using **(2) as(3) by(auto simp add: field_simps intro!:mult_right_mono) }
+ ultimately show "u *\<^sub>R x + v *\<^sub>R y \<in> s" apply- apply(rule assms[unfolded is_interval_def, rule_format, OF as(1,2)])
+ using as(3-) dimindex_ge_1 apply- by(auto simp add: vector_component) qed
+
+lemma is_interval_connected:
+ fixes s :: "(real ^ _) set"
+ shows "is_interval s \<Longrightarrow> connected s"
+ using is_interval_convex convex_connected by auto
+
+lemma convex_interval: "convex {a .. b}" "convex {a<..<b::real^'n::finite}"
+ apply(rule_tac[!] is_interval_convex) using is_interval_interval by auto
+
+subsection {* On @{text "real^1"}, @{text "is_interval"}, @{text "convex"} and @{text "connected"} are all equivalent. *}
+
+lemma is_interval_1:
+ "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)"
+ unfolding is_interval_def dest_vec1_def forall_1 by auto
+
+lemma is_interval_connected_1: "is_interval s \<longleftrightarrow> connected (s::(real^1) set)"
+ apply(rule, rule is_interval_connected, assumption) unfolding is_interval_1
+ apply(rule,rule,rule,rule,erule conjE,rule ccontr) proof-
+ 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"
+ hence *:"dest_vec1 a < dest_vec1 x" "dest_vec1 x < dest_vec1 b" apply(rule_tac [!] ccontr) unfolding not_less by auto
+ let ?halfl = "{z. inner (basis 1) z < dest_vec1 x} " and ?halfr = "{z. inner (basis 1) z > dest_vec1 x} "
+ { fix y assume "y \<in> s" have "y \<in> ?halfr \<union> ?halfl" apply(rule ccontr)
+ using as(6) `y\<in>s` by (auto simp add: inner_vector_def dest_vec1_eq [unfolded dest_vec1_def] dest_vec1_def) }
+ moreover have "a\<in>?halfl" "b\<in>?halfr" using * by (auto simp add: inner_vector_def dest_vec1_def)
+ hence "?halfl \<inter> s \<noteq> {}" "?halfr \<inter> s \<noteq> {}" using as(2-3) by auto
+ ultimately show False apply(rule_tac notE[OF as(1)[unfolded connected_def]])
+ apply(rule_tac x="?halfl" in exI, rule_tac x="?halfr" in exI)
+ apply(rule, rule open_halfspace_lt, rule, rule open_halfspace_gt) apply(rule, rule, rule ccontr)
+ by(auto simp add: basis_component field_simps) qed
+
+lemma is_interval_convex_1:
+ "is_interval s \<longleftrightarrow> convex (s::(real^1) set)"
+ using is_interval_convex convex_connected is_interval_connected_1 by auto
+
+lemma convex_connected_1:
+ "connected s \<longleftrightarrow> convex (s::(real^1) set)"
+ using is_interval_convex convex_connected is_interval_connected_1 by auto
+
+subsection {* Another intermediate value theorem formulation. *}
+
+lemma ivt_increasing_component_on_1: fixes f::"real^1 \<Rightarrow> real^'n::finite"
+ assumes "dest_vec1 a \<le> dest_vec1 b" "continuous_on {a .. b} f" "(f a)$k \<le> y" "y \<le> (f b)$k"
+ shows "\<exists>x\<in>{a..b}. (f x)$k = y"
+proof- have "f a \<in> f ` {a..b}" "f b \<in> f ` {a..b}" apply(rule_tac[!] imageI)
+ using assms(1) by(auto simp add: vector_less_eq_def dest_vec1_def)
+ thus ?thesis using connected_ivt_component[of "f ` {a..b}" "f a" "f b" k y]
+ using connected_continuous_image[OF assms(2) convex_connected[OF convex_interval(1)]]
+ using assms by(auto intro!: imageI) qed
+
+lemma ivt_increasing_component_1: fixes f::"real^1 \<Rightarrow> real^'n::finite"
+ assumes "dest_vec1 a \<le> dest_vec1 b"
+ "\<forall>x\<in>{a .. b}. continuous (at x) f" "f a$k \<le> y" "y \<le> f b$k"
+ shows "\<exists>x\<in>{a..b}. (f x)$k = y"
+ apply(rule ivt_increasing_component_on_1) using assms using continuous_at_imp_continuous_on by auto
+
+lemma ivt_decreasing_component_on_1: fixes f::"real^1 \<Rightarrow> real^'n::finite"
+ assumes "dest_vec1 a \<le> dest_vec1 b" "continuous_on {a .. b} f" "(f b)$k \<le> y" "y \<le> (f a)$k"
+ shows "\<exists>x\<in>{a..b}. (f x)$k = y"
+ apply(subst neg_equal_iff_equal[THEN sym]) unfolding vector_uminus_component[THEN sym]
+ apply(rule ivt_increasing_component_on_1) using assms using continuous_on_neg
+ by(auto simp add:vector_uminus_component)
+
+lemma ivt_decreasing_component_1: fixes f::"real^1 \<Rightarrow> real^'n::finite"
+ 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"
+ shows "\<exists>x\<in>{a..b}. (f x)$k = y"
+ apply(rule ivt_decreasing_component_on_1) using assms using continuous_at_imp_continuous_on by auto
+
+subsection {* A bound within a convex hull, and so an interval. *}
+
+lemma convex_on_convex_hull_bound:
+ fixes s :: "(real ^ _) set"
+ assumes "convex_on (convex hull s) f" "\<forall>x\<in>s. f x \<le> b"
+ shows "\<forall>x\<in> convex hull s. f x \<le> b" proof
+ fix x assume "x\<in>convex hull s"
+ 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"
+ unfolding convex_hull_indexed mem_Collect_eq by auto
+ 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"]
+ unfolding setsum_left_distrib[THEN sym] obt(2) mult_1 apply(drule_tac meta_mp) apply(rule mult_left_mono)
+ using assms(2) obt(1) by auto
+ thus "f x \<le> b" using assms(1)[unfolded convex_on[OF convex_convex_hull], rule_format, of k u v]
+ unfolding obt(2-3) using obt(1) and hull_subset[unfolded subset_eq, rule_format, of _ s] by auto qed
+
+lemma unit_interval_convex_hull:
+ "{0::real^'n::finite .. 1} = convex hull {x. \<forall>i. (x$i = 0) \<or> (x$i = 1)}" (is "?int = convex hull ?points")
+proof- have 01:"{0,1} \<subseteq> convex hull ?points" apply rule apply(rule_tac hull_subset[unfolded subset_eq, rule_format]) by auto
+ { fix n x assume "x\<in>{0::real^'n .. 1}" "n \<le> CARD('n)" "card {i. x$i \<noteq> 0} \<le> n"
+ hence "x\<in>convex hull ?points" proof(induct n arbitrary: x)
+ case 0 hence "x = 0" apply(subst Cart_eq) apply rule by auto
+ thus "x\<in>convex hull ?points" using 01 by auto
+ next
+ case (Suc n) show "x\<in>convex hull ?points" proof(cases "{i. x$i \<noteq> 0} = {}")
+ case True hence "x = 0" unfolding Cart_eq by auto
+ thus "x\<in>convex hull ?points" using 01 by auto
+ next
+ case False def xi \<equiv> "Min ((\<lambda>i. x$i) ` {i. x$i \<noteq> 0})"
+ have "xi \<in> (\<lambda>i. x$i) ` {i. x$i \<noteq> 0}" unfolding xi_def apply(rule Min_in) using False by auto
+ then obtain i where i':"x$i = xi" "x$i \<noteq> 0" by auto
+ have i:"\<And>j. x$j > 0 \<Longrightarrow> x$i \<le> x$j"
+ unfolding i'(1) xi_def apply(rule_tac Min_le) unfolding image_iff
+ defer apply(rule_tac x=j in bexI) using i' by auto
+ 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`
+ by(auto simp add: Cart_lambda_beta)
+ show ?thesis proof(cases "x$i=1")
+ case True have "\<forall>j\<in>{i. x$i \<noteq> 0}. x$j = 1" apply(rule, rule ccontr) unfolding mem_Collect_eq proof-
+ fix j assume "x $ j \<noteq> 0" "x $ j \<noteq> 1"
+ hence j:"x$j \<in> {0<..<1}" using Suc(2) by(auto simp add: vector_less_eq_def elim!:allE[where x=j])
+ hence "x$j \<in> op $ x ` {i. x $ i \<noteq> 0}" by auto
+ hence "x$j \<ge> x$i" unfolding i'(1) xi_def apply(rule_tac Min_le) by auto
+ thus False using True Suc(2) j by(auto simp add: vector_less_eq_def elim!:ballE[where x=j]) qed
+ thus "x\<in>convex hull ?points" apply(rule_tac hull_subset[unfolded subset_eq, rule_format])
+ by(auto simp add: Cart_lambda_beta)
+ next let ?y = "\<lambda>j. if x$j = 0 then 0 else (x$j - x$i) / (1 - x$i)"
+ 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
+ by(auto simp add: Cart_lambda_beta vector_add_component vector_smult_component vector_minus_component field_simps)
+ { 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"
+ apply(rule_tac divide_nonneg_pos) using i(1)[of j] using False i01
+ using Suc(2)[unfolded mem_interval, rule_format, of j] by(auto simp add:field_simps Cart_lambda_beta)
+ hence "0 \<le> ?y j \<and> ?y j \<le> 1" by auto }
+ 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)
+ hence "{j. x$j \<noteq> 0} \<noteq> {j. ((\<chi> j. ?y j)::real^'n::finite) $ j \<noteq> 0}" by auto
+ 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)
+ 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
+ ultimately show ?thesis apply(subst *) apply(rule convex_convex_hull[unfolded convex_def, rule_format])
+ apply(rule_tac hull_subset[unfolded subset_eq, rule_format]) defer apply(rule Suc(1))
+ unfolding mem_interval using i01 Suc(3) by (auto simp add: Cart_lambda_beta)
+ qed qed qed } note * = this
+ show ?thesis apply rule defer apply(rule hull_minimal) unfolding subset_eq prefer 3 apply rule
+ apply(rule_tac n2="CARD('n)" in *) prefer 3 apply(rule card_mono) using 01 and convex_interval(1) prefer 5 apply - apply rule
+ unfolding mem_interval apply rule unfolding mem_Collect_eq apply(erule_tac x=i in allE)
+ by(auto simp add: vector_less_eq_def mem_def[of _ convex]) qed
+
+subsection {* And this is a finite set of vertices. *}
+
+lemma unit_cube_convex_hull: obtains s where "finite s" "{0 .. 1::real^'n::finite} = convex hull s"
+ apply(rule that[of "{x::real^'n::finite. \<forall>i. x$i=0 \<or> x$i=1}"])
+ apply(rule finite_subset[of _ "(\<lambda>s. (\<chi> i. if i\<in>s then 1::real else 0)::real^'n::finite) ` UNIV"])
+ prefer 3 apply(rule unit_interval_convex_hull) apply rule unfolding mem_Collect_eq proof-
+ fix x::"real^'n" assume as:"\<forall>i. x $ i = 0 \<or> x $ i = 1"
+ 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}"])
+ unfolding Cart_eq using as by(auto simp add:Cart_lambda_beta) qed auto
+
+subsection {* Hence any cube (could do any nonempty interval). *}
+
+lemma cube_convex_hull:
+ assumes "0 < d" obtains s::"(real^'n::finite) set" where "finite s" "{x - (\<chi> i. d) .. x + (\<chi> i. d)} = convex hull s" proof-
+ let ?d = "(\<chi> i. d)::real^'n"
+ have *:"{x - ?d .. x + ?d} = (\<lambda>y. x - ?d + (2 * d) *\<^sub>R y) ` {0 .. 1}" apply(rule set_ext, rule)
+ unfolding image_iff defer apply(erule bexE) proof-
+ fix y assume as:"y\<in>{x - ?d .. x + ?d}"
+ { 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]]
+ by(auto simp add: vector_component)
+ hence "1 \<ge> inverse d * (x $ i - y $ i)" "1 \<ge> inverse d * (y $ i - x $ i)"
+ apply(rule_tac[!] mult_left_le_imp_le[OF _ assms]) unfolding mult_assoc[THEN sym]
+ using assms by(auto simp add: field_simps right_inverse)
+ hence "inverse d * (x $ i * 2) \<le> 2 + inverse d * (y $ i * 2)"
+ "inverse d * (y $ i * 2) \<le> 2 + inverse d * (x $ i * 2)" by(auto simp add:field_simps) }
+ hence "inverse (2 * d) *\<^sub>R (y - (x - ?d)) \<in> {0..1}" unfolding mem_interval using assms
+ by(auto simp add: Cart_eq vector_component_simps field_simps)
+ 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)
+ using assms by(auto simp add: Cart_eq vector_less_eq_def Cart_lambda_beta)
+ next
+ fix y z assume as:"z\<in>{0..1}" "y = x - ?d + (2*d) *\<^sub>R z"
+ 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)
+ apply rule apply(rule mult_nonneg_nonneg) prefer 3 apply(rule mult_right_le_one_le)
+ using assms by(auto simp add: vector_component_simps Cart_eq)
+ thus "y \<in> {x - ?d..x + ?d}" unfolding as(2) mem_interval apply- apply rule using as(1)[unfolded mem_interval]
+ apply(erule_tac x=i in allE) using assms by(auto simp add: vector_component_simps Cart_eq) qed
+ obtain s where "finite s" "{0..1::real^'n} = convex hull s" using unit_cube_convex_hull by auto
+ 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
+
+subsection {* Bounded convex function on open set is continuous. *}
+
+lemma convex_on_bounded_continuous:
+ fixes s :: "(real ^ _) set"
+ assumes "open s" "convex_on s f" "\<forall>x\<in>s. abs(f x) \<le> b"
+ shows "continuous_on s f"
+ apply(rule continuous_at_imp_continuous_on) unfolding continuous_at_real_range proof(rule,rule,rule)
+ fix x e assume "x\<in>s" "(0::real) < e"
+ def B \<equiv> "abs b + 1"
+ have B:"0 < B" "\<And>x. x\<in>s \<Longrightarrow> abs (f x) \<le> B"
+ unfolding B_def defer apply(drule assms(3)[rule_format]) by auto
+ 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
+ show "\<exists>d>0. \<forall>x'. norm (x' - x) < d \<longrightarrow> \<bar>f x' - f x\<bar> < e"
+ apply(rule_tac x="min (k / 2) (e / (2 * B) * k)" in exI) apply rule defer proof(rule,rule)
+ fix y assume as:"norm (y - x) < min (k / 2) (e / (2 * B) * k)"
+ show "\<bar>f y - f x\<bar> < e" proof(cases "y=x")
+ case False def t \<equiv> "k / norm (y - x)"
+ have "2 < t" "0<t" unfolding t_def using as False and `k>0` by(auto simp add:field_simps)
+ have "y\<in>s" apply(rule k[unfolded subset_eq,rule_format]) unfolding mem_cball dist_norm
+ apply(rule order_trans[of _ "2 * norm (x - y)"]) using as by(auto simp add: field_simps norm_minus_commute)
+ { def w \<equiv> "x + t *\<^sub>R (y - x)"
+ have "w\<in>s" unfolding w_def apply(rule k[unfolded subset_eq,rule_format]) unfolding mem_cball dist_norm
+ unfolding t_def using `k>0` by auto
+ 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)
+ also have "\<dots> = 0" using `t>0` by(auto simp add:field_simps)
+ 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)
+ 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)
+ hence "(f w - f x) / t < e"
+ using B(2)[OF `w\<in>s`] and B(2)[OF `x\<in>s`] using `t>0` by(auto simp add:field_simps)
+ hence th1:"f y - f x < e" apply- apply(rule le_less_trans) defer apply assumption
+ using assms(2)[unfolded convex_on_def,rule_format,of w x "1/t" "(t - 1)/t", unfolded w]
+ using `0<t` `2<t` and `x\<in>s` `w\<in>s` by(auto simp add:field_simps) }
+ moreover
+ { def w \<equiv> "x - t *\<^sub>R (y - x)"
+ have "w\<in>s" unfolding w_def apply(rule k[unfolded subset_eq,rule_format]) unfolding mem_cball dist_norm
+ unfolding t_def using `k>0` by auto
+ 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)
+ also have "\<dots>=x" using `t>0` by (auto simp add:field_simps)
+ 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)
+ 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)
+ 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)
+ have "f x \<le> 1 / (1 + t) * f w + (t / (1 + t)) * f y"
+ using assms(2)[unfolded convex_on_def,rule_format,of w y "1/(1+t)" "t / (1+t)",unfolded w]
+ using `0<t` `2<t` and `y\<in>s` `w\<in>s` by (auto simp add:field_simps)
+ also have "\<dots> = (f w + t * f y) / (1 + t)" using `t>0` unfolding real_divide_def by (auto simp add:field_simps)
+ also have "\<dots> < e + f y" using `t>0` * `e>0` by(auto simp add:field_simps)
+ finally have "f x - f y < e" by auto }
+ ultimately show ?thesis by auto
+ qed(insert `0<e`, auto)
+ qed(insert `0<e` `0<k` `0<B`, auto simp add:field_simps intro!:mult_pos_pos) qed
+
+subsection {* Upper bound on a ball implies upper and lower bounds. *}
+
+lemma convex_bounds_lemma:
+ fixes x :: "real ^ _"
+ assumes "convex_on (cball x e) f" "\<forall>y \<in> cball x e. f y \<le> b"
+ shows "\<forall>y \<in> cball x e. abs(f y) \<le> b + 2 * abs(f x)"
+ apply(rule) proof(cases "0 \<le> e") case True
+ fix y assume y:"y\<in>cball x e" def z \<equiv> "2 *\<^sub>R x - y"
+ have *:"x - (2 *\<^sub>R x - y) = y - x" by vector
+ have z:"z\<in>cball x e" using y unfolding z_def mem_cball dist_norm * by(auto simp add: norm_minus_commute)
+ have "(1 / 2) *\<^sub>R y + (1 / 2) *\<^sub>R z = x" unfolding z_def by (auto simp add: algebra_simps)
+ 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"]
+ using assms(2)[rule_format,OF y] assms(2)[rule_format,OF z] by(auto simp add:field_simps)
+next case False fix y assume "y\<in>cball x e"
+ hence "dist x y < 0" using False unfolding mem_cball not_le by (auto simp del: dist_not_less_zero)
+ thus "\<bar>f y\<bar> \<le> b + 2 * \<bar>f x\<bar>" using zero_le_dist[of x y] by auto qed
+
+subsection {* Hence a convex function on an open set is continuous. *}
+
+lemma convex_on_continuous:
+ assumes "open (s::(real^'n::finite) set)" "convex_on s f"
+ shows "continuous_on s f"
+ unfolding continuous_on_eq_continuous_at[OF assms(1)] proof
+ note dimge1 = dimindex_ge_1[where 'a='n]
+ fix x assume "x\<in>s"
+ then obtain e where e:"cball x e \<subseteq> s" "e>0" using assms(1) unfolding open_contains_cball by auto
+ def d \<equiv> "e / real CARD('n)"
+ have "0 < d" unfolding d_def using `e>0` dimge1 by(rule_tac divide_pos_pos, auto)
+ let ?d = "(\<chi> i. d)::real^'n"
+ obtain c where c:"finite c" "{x - ?d..x + ?d} = convex hull c" using cube_convex_hull[OF `d>0`, of x] by auto
+ have "x\<in>{x - ?d..x + ?d}" using `d>0` unfolding mem_interval by(auto simp add:vector_component_simps)
+ hence "c\<noteq>{}" apply(rule_tac ccontr) using c by(auto simp add:convex_hull_empty)
+ def k \<equiv> "Max (f ` c)"
+ have "convex_on {x - ?d..x + ?d} f" apply(rule convex_on_subset[OF assms(2)])
+ apply(rule subset_trans[OF _ e(1)]) unfolding subset_eq mem_cball proof
+ fix z assume z:"z\<in>{x - ?d..x + ?d}"
+ have e:"e = setsum (\<lambda>i. d) (UNIV::'n set)" unfolding setsum_constant d_def using dimge1
+ by (metis card_enum field_simps d_def not_one_le_zero of_nat_le_iff real_eq_of_nat real_of_nat_1)
+ show "dist x z \<le> e" unfolding dist_norm e apply(rule_tac order_trans[OF norm_le_l1], rule setsum_mono)
+ using z[unfolded mem_interval] apply(erule_tac x=i in allE) by(auto simp add:field_simps vector_component_simps) qed
+ 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
+ unfolding k_def apply(rule, rule Max_ge) using c(1) by auto
+ 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
+ hence dsube:"cball x d \<subseteq> cball x e" unfolding subset_eq Ball_def mem_cball by auto
+ 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
+ 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
+ fix y assume y:"y\<in>cball x d"
+ { fix i::'n have "x $ i - d \<le> y $ i" "y $ i \<le> x $ i + d"
+ using order_trans[OF component_le_norm y[unfolded mem_cball dist_norm], of i] by(auto simp add: vector_component) }
+ thus "f y \<le> k" apply(rule_tac k[rule_format]) unfolding mem_cball mem_interval dist_norm
+ by(auto simp add: vector_component_simps) qed
+ hence "continuous_on (ball x d) f" apply(rule_tac convex_on_bounded_continuous)
+ apply(rule open_ball, rule convex_on_subset[OF conv], rule ball_subset_cball) by auto
+ thus "continuous (at x) f" unfolding continuous_on_eq_continuous_at[OF open_ball] using `d>0` by auto qed
+
+subsection {* Line segments, starlike sets etc. *)
+(* Use the same overloading tricks as for intervals, so that *)
+(* segment[a,b] is closed and segment(a,b) is open relative to affine hull. *}
+
+definition
+ midpoint :: "real ^ 'n::finite \<Rightarrow> real ^ 'n \<Rightarrow> real ^ 'n" where
+ "midpoint a b = (inverse (2::real)) *\<^sub>R (a + b)"
+
+definition
+ open_segment :: "real ^ 'n::finite \<Rightarrow> real ^ 'n \<Rightarrow> (real ^ 'n) set" where
+ "open_segment a b = {(1 - u) *\<^sub>R a + u *\<^sub>R b | u::real. 0 < u \<and> u < 1}"
+
+definition
+ closed_segment :: "real ^ 'n::finite \<Rightarrow> real ^ 'n \<Rightarrow> (real ^ 'n) set" where
+ "closed_segment a b = {(1 - u) *\<^sub>R a + u *\<^sub>R b | u::real. 0 \<le> u \<and> u \<le> 1}"
+
+definition "between = (\<lambda> (a,b). closed_segment a b)"
+
+lemmas segment = open_segment_def closed_segment_def
+
+definition "starlike s \<longleftrightarrow> (\<exists>a\<in>s. \<forall>x\<in>s. closed_segment a x \<subseteq> s)"
+
+lemma midpoint_refl: "midpoint x x = x"
+ unfolding midpoint_def unfolding scaleR_right_distrib unfolding scaleR_left_distrib[THEN sym] by auto
+
+lemma midpoint_sym: "midpoint a b = midpoint b a" unfolding midpoint_def by (auto simp add: scaleR_right_distrib)
+
+lemma dist_midpoint:
+ "dist a (midpoint a b) = (dist a b) / 2" (is ?t1)
+ "dist b (midpoint a b) = (dist a b) / 2" (is ?t2)
+ "dist (midpoint a b) a = (dist a b) / 2" (is ?t3)
+ "dist (midpoint a b) b = (dist a b) / 2" (is ?t4)
+proof-
+ have *: "\<And>x y::real^'n::finite. 2 *\<^sub>R x = - y \<Longrightarrow> norm x = (norm y) / 2" unfolding equation_minus_iff by auto
+ have **:"\<And>x y::real^'n::finite. 2 *\<^sub>R x = y \<Longrightarrow> norm x = (norm y) / 2" by auto
+ note scaleR_right_distrib [simp]
+ show ?t1 unfolding midpoint_def dist_norm apply (rule **) by(auto,vector)
+ show ?t2 unfolding midpoint_def dist_norm apply (rule *) by(auto,vector)
+ show ?t3 unfolding midpoint_def dist_norm apply (rule *) by(auto,vector)
+ show ?t4 unfolding midpoint_def dist_norm apply (rule **) by(auto,vector) qed
+
+lemma midpoint_eq_endpoint:
+ "midpoint a b = a \<longleftrightarrow> a = (b::real^'n::finite)"
+ "midpoint a b = b \<longleftrightarrow> a = b"
+ unfolding dist_eq_0_iff[where 'a="real^'n", THEN sym] dist_midpoint by auto
+
+lemma convex_contains_segment:
+ "convex s \<longleftrightarrow> (\<forall>a\<in>s. \<forall>b\<in>s. closed_segment a b \<subseteq> s)"
+ unfolding convex_alt closed_segment_def by auto
+
+lemma convex_imp_starlike:
+ "convex s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> starlike s"
+ unfolding convex_contains_segment starlike_def by auto
+
+lemma segment_convex_hull:
+ "closed_segment a b = convex hull {a,b}" proof-
+ have *:"\<And>x. {x} \<noteq> {}" by auto
+ have **:"\<And>u v. u + v = 1 \<longleftrightarrow> u = 1 - (v::real)" by auto
+ show ?thesis unfolding segment convex_hull_insert[OF *] convex_hull_singleton apply(rule set_ext)
+ unfolding mem_Collect_eq apply(rule,erule exE)
+ apply(rule_tac x="1 - u" in exI) apply rule defer apply(rule_tac x=u in exI) defer
+ apply(erule exE, (erule conjE)?)+ apply(rule_tac x="1 - u" in exI) unfolding ** by auto qed
+
+lemma convex_segment: "convex (closed_segment a b)"
+ unfolding segment_convex_hull by(rule convex_convex_hull)
+
+lemma ends_in_segment: "a \<in> closed_segment a b" "b \<in> closed_segment a b"
+ unfolding segment_convex_hull apply(rule_tac[!] hull_subset[unfolded subset_eq, rule_format]) by auto
+
+lemma segment_furthest_le:
+ assumes "x \<in> closed_segment a b" shows "norm(y - x) \<le> norm(y - a) \<or> norm(y - x) \<le> norm(y - b)" proof-
+ obtain z where "z\<in>{a, b}" "norm (x - y) \<le> norm (z - y)" using simplex_furthest_le[of "{a, b}" y]
+ using assms[unfolded segment_convex_hull] by auto
+ thus ?thesis by(auto simp add:norm_minus_commute) qed
+
+lemma segment_bound:
+ assumes "x \<in> closed_segment a b"
+ shows "norm(x - a) \<le> norm(b - a)" "norm(x - b) \<le> norm(b - a)"
+ using segment_furthest_le[OF assms, of a]
+ using segment_furthest_le[OF assms, of b]
+ by (auto simp add:norm_minus_commute)
+
+lemma segment_refl:"closed_segment a a = {a}" unfolding segment by (auto simp add: algebra_simps)
+
+lemma between_mem_segment: "between (a,b) x \<longleftrightarrow> x \<in> closed_segment a b"
+ unfolding between_def mem_def by auto
+
+lemma between:"between (a,b) (x::real^'n::finite) \<longleftrightarrow> dist a b = (dist a x) + (dist x b)"
+proof(cases "a = b")
+ case True thus ?thesis unfolding between_def split_conv mem_def[of x, symmetric]
+ by(auto simp add:segment_refl dist_commute) next
+ case False hence Fal:"norm (a - b) \<noteq> 0" and Fal2: "norm (a - b) > 0" by auto
+ have *:"\<And>u. a - ((1 - u) *\<^sub>R a + u *\<^sub>R b) = u *\<^sub>R (a - b)" by (auto simp add: algebra_simps)
+ show ?thesis unfolding between_def split_conv mem_def[of x, symmetric] closed_segment_def mem_Collect_eq
+ apply rule apply(erule exE, (erule conjE)+) apply(subst dist_triangle_eq) proof-
+ fix u assume as:"x = (1 - u) *\<^sub>R a + u *\<^sub>R b" "0 \<le> u" "u \<le> 1"
+ hence *:"a - x = u *\<^sub>R (a - b)" "x - b = (1 - u) *\<^sub>R (a - b)"
+ unfolding as(1) by(auto simp add:algebra_simps)
+ show "norm (a - x) *\<^sub>R (x - b) = norm (x - b) *\<^sub>R (a - x)"
+ unfolding norm_minus_commute[of x a] * Cart_eq using as(2,3)
+ by(auto simp add: vector_component_simps field_simps)
+ next assume as:"dist a b = dist a x + dist x b"
+ 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
+ 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)
+ unfolding dist_norm Cart_eq apply- apply rule defer apply(rule, rule divide_nonneg_pos) prefer 4 proof rule
+ fix i::'n have "((1 - norm (a - x) / norm (a - b)) *\<^sub>R a + (norm (a - x) / norm (a - b)) *\<^sub>R b) $ i =
+ ((norm (a - b) - norm (a - x)) * (a $ i) + norm (a - x) * (b $ i)) / norm (a - b)"
+ using Fal by(auto simp add:vector_component_simps field_simps)
+ also have "\<dots> = x$i" apply(rule divide_eq_imp[OF Fal])
+ unfolding as[unfolded dist_norm] using as[unfolded dist_triangle_eq Cart_eq,rule_format, of i]
+ by(auto simp add:field_simps vector_component_simps)
+ 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
+ qed(insert Fal2, auto) qed qed
+
+lemma between_midpoint: fixes a::"real^'n::finite" shows
+ "between (a,b) (midpoint a b)" (is ?t1)
+ "between (b,a) (midpoint a b)" (is ?t2)
+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
+ show ?t1 ?t2 unfolding between midpoint_def dist_norm apply(rule_tac[!] *)
+ by(auto simp add:field_simps Cart_eq vector_component_simps) qed
+
+lemma between_mem_convex_hull:
+ "between (a,b) x \<longleftrightarrow> x \<in> convex hull {a,b}"
+ unfolding between_mem_segment segment_convex_hull ..
+
+subsection {* Shrinking towards the interior of a convex set. *}
+
+lemma mem_interior_convex_shrink:
+ fixes s :: "(real ^ _) set"
+ assumes "convex s" "c \<in> interior s" "x \<in> s" "0 < e" "e \<le> 1"
+ shows "x - e *\<^sub>R (x - c) \<in> interior s"
+proof- obtain d where "d>0" and d:"ball c d \<subseteq> s" using assms(2) unfolding mem_interior by auto
+ show ?thesis unfolding mem_interior apply(rule_tac x="e*d" in exI)
+ apply(rule) defer unfolding subset_eq Ball_def mem_ball proof(rule,rule)
+ fix y assume as:"dist (x - e *\<^sub>R (x - c)) y < e * d"
+ 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)
+ 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)"
+ unfolding dist_norm unfolding norm_scaleR[THEN sym] apply(rule norm_eqI) using `e>0`
+ by(auto simp add:vector_component_simps Cart_eq field_simps)
+ also have "\<dots> = abs(1/e) * norm (x - e *\<^sub>R (x - c) - y)" by(auto intro!:norm_eqI simp add: algebra_simps)
+ also have "\<dots> < d" using as[unfolded dist_norm] and `e>0`
+ by(auto simp add:pos_divide_less_eq[OF `e>0`] real_mult_commute)
+ finally show "y \<in> s" apply(subst *) apply(rule assms(1)[unfolded convex_alt,rule_format])
+ apply(rule d[unfolded subset_eq,rule_format]) unfolding mem_ball using assms(3-5) by auto
+ qed(rule mult_pos_pos, insert `e>0` `d>0`, auto) qed
+
+lemma mem_interior_closure_convex_shrink:
+ fixes s :: "(real ^ _) set"
+ assumes "convex s" "c \<in> interior s" "x \<in> closure s" "0 < e" "e \<le> 1"
+ shows "x - e *\<^sub>R (x - c) \<in> interior s"
+proof- obtain d where "d>0" and d:"ball c d \<subseteq> s" using assms(2) unfolding mem_interior by auto
+ have "\<exists>y\<in>s. norm (y - x) * (1 - e) < e * d" proof(cases "x\<in>s")
+ case True thus ?thesis using `e>0` `d>0` by(rule_tac bexI[where x=x], auto intro!: mult_pos_pos) next
+ case False hence x:"x islimpt s" using assms(3)[unfolded closure_def] by auto
+ show ?thesis proof(cases "e=1")
+ case True obtain y where "y\<in>s" "y \<noteq> x" "dist y x < 1"
+ using x[unfolded islimpt_approachable,THEN spec[where x=1]] by auto
+ thus ?thesis apply(rule_tac x=y in bexI) unfolding True using `d>0` by auto next
+ case False hence "0 < e * d / (1 - e)" and *:"1 - e > 0"
+ using `e\<le>1` `e>0` `d>0` by(auto intro!:mult_pos_pos divide_pos_pos)
+ then obtain y where "y\<in>s" "y \<noteq> x" "dist y x < e * d / (1 - e)"
+ using x[unfolded islimpt_approachable,THEN spec[where x="e*d / (1 - e)"]] by auto
+ thus ?thesis apply(rule_tac x=y in bexI) unfolding dist_norm using pos_less_divide_eq[OF *] by auto qed qed
+ then obtain y where "y\<in>s" and y:"norm (y - x) * (1 - e) < e * d" by auto
+ def z \<equiv> "c + ((1 - e) / e) *\<^sub>R (x - y)"
+ have *:"x - e *\<^sub>R (x - c) = y - e *\<^sub>R (y - z)" unfolding z_def using `e>0` by (auto simp add: scaleR_right_diff_distrib scaleR_right_distrib scaleR_left_diff_distrib)
+ have "z\<in>interior s" apply(rule subset_interior[OF d,unfolded subset_eq,rule_format])
+ unfolding interior_open[OF open_ball] mem_ball z_def dist_norm using y and assms(4,5)
+ by(auto simp add:field_simps norm_minus_commute)
+ thus ?thesis unfolding * apply - apply(rule mem_interior_convex_shrink)
+ using assms(1,4-5) `y\<in>s` by auto qed
+
+subsection {* Some obvious but surprisingly hard simplex lemmas. *}
+
+lemma simplex:
+ assumes "finite s" "0 \<notin> s"
+ 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)}"
+ unfolding convex_hull_finite[OF finite.insertI[OF assms(1)]] apply(rule set_ext, rule) unfolding mem_Collect_eq
+ apply(erule_tac[!] exE) apply(erule_tac[!] conjE)+ unfolding setsum_clauses(2)[OF assms(1)]
+ 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)
+ unfolding if_smult and setsum_delta_notmem[OF assms(2)] by auto
+
+lemma std_simplex:
+ "convex hull (insert 0 { basis i | i. i\<in>UNIV}) =
+ {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")
+proof- let ?D = "UNIV::'n set"
+ have "0\<notin>?p" by(auto simp add: basis_nonzero)
+ have "{(basis i)::real^'n |i. i \<in> ?D} = basis ` ?D" by auto
+ note sumbas = this setsum_reindex[OF basis_inj, unfolded o_def]
+ show ?thesis unfolding simplex[OF finite_stdbasis `0\<notin>?p`] apply(rule set_ext) unfolding mem_Collect_eq apply rule
+ apply(erule exE, (erule conjE)+) apply(erule_tac[2] conjE)+ proof-
+ 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"
+ 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
+ hence **:"setsum u {basis i |i. i \<in> ?D} = setsum (op $ x) ?D" unfolding sumbas by(rule_tac setsum_cong, auto)
+ show " (\<forall>i. 0 \<le> x $ i) \<and> setsum (op $ x) ?D \<le> 1" apply - proof(rule,rule)
+ fix i::'n show "0 \<le> x$i" unfolding *[rule_format,of i,THEN sym] apply(rule_tac as(1)[rule_format]) by auto
+ qed(insert as(2)[unfolded **], auto)
+ next fix x::"real^'n" assume as:"\<forall>i. 0 \<le> x $ i" "setsum (op $ x) ?D \<le> 1"
+ 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"
+ 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)
+ unfolding sumbas using as(2) and basis_expansion_unique [where 'a=real, unfolded smult_conv_scaleR] by(auto simp add:inner_basis) qed qed
+
+lemma interior_std_simplex:
+ "interior (convex hull (insert 0 { basis i| i. i\<in>UNIV})) =
+ {x::real^'n::finite. (\<forall>i. 0 < x$i) \<and> setsum (\<lambda>i. x$i) UNIV < 1 }"
+ apply(rule set_ext) unfolding mem_interior std_simplex unfolding subset_eq mem_Collect_eq Ball_def mem_ball
+ unfolding Ball_def[symmetric] apply rule apply(erule exE, (erule conjE)+) defer apply(erule conjE) proof-
+ 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"
+ show "(\<forall>xa. 0 < x $ xa) \<and> setsum (op $ x) UNIV < 1" apply(rule,rule) proof-
+ fix i::'n show "0 < x $ i" using as[THEN spec[where x="x - (e / 2) *\<^sub>R basis i"]] and `e>0`
+ unfolding dist_norm by(auto simp add: norm_basis vector_component_simps basis_component elim:allE[where x=i])
+ next guess a using UNIV_witness[where 'a='n] ..
+ have **:"dist x (x + (e / 2) *\<^sub>R basis a) < e" using `e>0` and norm_basis[of a]
+ unfolding dist_norm by(auto simp add: vector_component_simps basis_component intro!: mult_strict_left_mono_comm)
+ 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)
+ 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)
+ have "setsum (op $ x) UNIV < setsum (op $ (x + (e / 2) *\<^sub>R basis a)) UNIV" unfolding * setsum_addf
+ using `0<e` dimindex_ge_1 by(auto simp add: setsum_delta')
+ also have "\<dots> \<le> 1" using ** apply(drule_tac as[rule_format]) by auto
+ finally show "setsum (op $ x) UNIV < 1" by auto qed
+next
+ fix x::"real^'n::finite" assume as:"\<forall>i. 0 < x $ i" "setsum (op $ x) UNIV < 1"
+ guess a using UNIV_witness[where 'a='b] ..
+ let ?d = "(1 - setsum (op $ x) UNIV) / real (CARD('n))"
+ have "Min ((op $ x) ` UNIV) > 0" apply(rule Min_grI) using as(1) dimindex_ge_1 by auto
+ moreover have"?d > 0" apply(rule divide_pos_pos) using as(2) using dimindex_ge_1 by(auto simp add: Suc_le_eq)
+ 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"
+ apply(rule_tac x="min (Min ((op $ x) ` UNIV)) ?D" in exI) apply rule defer apply(rule,rule) proof-
+ fix y assume y:"dist x y < min (Min (op $ x ` UNIV)) ?d"
+ have "setsum (op $ y) UNIV \<le> setsum (\<lambda>i. x$i + ?d) UNIV" proof(rule setsum_mono)
+ fix i::'n have "abs (y$i - x$i) < ?d" apply(rule le_less_trans) using component_le_norm[of "y - x" i]
+ using y[unfolded min_less_iff_conj dist_norm, THEN conjunct2] by(auto simp add:vector_component_simps norm_minus_commute)
+ thus "y $ i \<le> x $ i + ?d" by auto qed
+ 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)
+ finally show "(\<forall>i. 0 \<le> y $ i) \<and> setsum (op $ y) UNIV \<le> 1" apply- proof(rule,rule)
+ fix i::'n have "norm (x - y) < x$i" using y[unfolded min_less_iff_conj dist_norm, THEN conjunct1]
+ using Min_gr_iff[of "op $ x ` dimset x"] dimindex_ge_1 by auto
+ 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)
+ qed auto qed auto qed
+
+lemma interior_std_simplex_nonempty: obtains a::"real^'n::finite" where
+ "a \<in> interior(convex hull (insert 0 {basis i | i . i \<in> UNIV}))" proof-
+ 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}"
+ have *:"{basis i :: real ^ 'n | i. i \<in> ?D} = basis ` ?D" by auto
+ { fix i have "?a $ i = inverse (2 * real CARD('n))"
+ unfolding setsum_component vector_smult_component and * and setsum_reindex[OF basis_inj] and o_def
+ apply(rule trans[of _ "setsum (\<lambda>j. if i = j then inverse (2 * real CARD('n)) else 0) ?D"]) apply(rule setsum_cong2)
+ 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]) }
+ note ** = this
+ show ?thesis apply(rule that[of ?a]) unfolding interior_std_simplex mem_Collect_eq proof(rule,rule)
+ fix i::'n show "0 < ?a $ i" unfolding ** using dimindex_ge_1 by(auto simp add: Suc_le_eq) next
+ have "setsum (op $ ?a) ?D = setsum (\<lambda>i. inverse (2 * real CARD('n))) ?D" by(rule setsum_cong2, rule **)
+ also have "\<dots> < 1" unfolding setsum_constant card_enum real_eq_of_nat real_divide_def[THEN sym] by (auto simp add:field_simps)
+ finally show "setsum (op $ ?a) ?D < 1" by auto qed qed
+
+subsection {* Paths. *}
+
+definition "path (g::real^1 \<Rightarrow> real^'n::finite) \<longleftrightarrow> continuous_on {0 .. 1} g"
+
+definition "pathstart (g::real^1 \<Rightarrow> real^'n) = g 0"
+
+definition "pathfinish (g::real^1 \<Rightarrow> real^'n) = g 1"
+
+definition "path_image (g::real^1 \<Rightarrow> real^'n) = g ` {0 .. 1}"
+
+definition "reversepath (g::real^1 \<Rightarrow> real^'n) = (\<lambda>x. g(1 - x))"
+
+definition joinpaths:: "(real^1 \<Rightarrow> real^'n) \<Rightarrow> (real^1 \<Rightarrow> real^'n) \<Rightarrow> (real^1 \<Rightarrow> real^'n)" (infixr "+++" 75)
+ 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))"
+definition "simple_path (g::real^1 \<Rightarrow> real^'n) \<longleftrightarrow>
+ (\<forall>x\<in>{0..1}. \<forall>y\<in>{0..1}. g x = g y \<longrightarrow> x = y \<or> x = 0 \<and> y = 1 \<or> x = 1 \<and> y = 0)"
+
+definition "injective_path (g::real^1 \<Rightarrow> real^'n) \<longleftrightarrow>
+ (\<forall>x\<in>{0..1}. \<forall>y\<in>{0..1}. g x = g y \<longrightarrow> x = y)"
+
+subsection {* Some lemmas about these concepts. *}
+
+lemma injective_imp_simple_path:
+ "injective_path g \<Longrightarrow> simple_path g"
+ unfolding injective_path_def simple_path_def by auto
+
+lemma path_image_nonempty: "path_image g \<noteq> {}"
+ unfolding path_image_def image_is_empty interval_eq_empty by auto
+
+lemma pathstart_in_path_image[intro]: "(pathstart g) \<in> path_image g"
+ unfolding pathstart_def path_image_def apply(rule imageI)
+ unfolding mem_interval_1 vec_1[THEN sym] dest_vec1_vec by auto
+
+lemma pathfinish_in_path_image[intro]: "(pathfinish g) \<in> path_image g"
+ unfolding pathfinish_def path_image_def apply(rule imageI)
+ unfolding mem_interval_1 vec_1[THEN sym] dest_vec1_vec by auto
+
+lemma connected_path_image[intro]: "path g \<Longrightarrow> connected(path_image g)"
+ unfolding path_def path_image_def apply(rule connected_continuous_image, assumption)
+ by(rule convex_connected, rule convex_interval)
+
+lemma compact_path_image[intro]: "path g \<Longrightarrow> compact(path_image g)"
+ unfolding path_def path_image_def apply(rule compact_continuous_image, assumption)
+ by(rule compact_interval)
+
+lemma reversepath_reversepath[simp]: "reversepath(reversepath g) = g"
+ unfolding reversepath_def by auto
+
+lemma pathstart_reversepath[simp]: "pathstart(reversepath g) = pathfinish g"
+ unfolding pathstart_def reversepath_def pathfinish_def by auto
+
+lemma pathfinish_reversepath[simp]: "pathfinish(reversepath g) = pathstart g"
+ unfolding pathstart_def reversepath_def pathfinish_def by auto
+
+lemma pathstart_join[simp]: "pathstart(g1 +++ g2) = pathstart g1"
+ unfolding pathstart_def joinpaths_def pathfinish_def by auto
+
+lemma pathfinish_join[simp]:"pathfinish(g1 +++ g2) = pathfinish g2" proof-
+ have "2 *\<^sub>R 1 - 1 = (1::real^1)" unfolding Cart_eq by(auto simp add:vector_component_simps)
+ thus ?thesis unfolding pathstart_def joinpaths_def pathfinish_def
+ unfolding vec_1[THEN sym] dest_vec1_vec by auto qed
+
+lemma path_image_reversepath[simp]: "path_image(reversepath g) = path_image g" proof-
+ have *:"\<And>g. path_image(reversepath g) \<subseteq> path_image g"
+ unfolding path_image_def subset_eq reversepath_def Ball_def image_iff apply(rule,rule,erule bexE)
+ apply(rule_tac x="1 - xa" in bexI) by(auto simp add:vector_less_eq_def vector_component_simps elim!:ballE)
+ show ?thesis using *[of g] *[of "reversepath g"] unfolding reversepath_reversepath by auto qed
+
+lemma path_reversepath[simp]: "path(reversepath g) \<longleftrightarrow> path g" proof-
+ have *:"\<And>g. path g \<Longrightarrow> path(reversepath g)" unfolding path_def reversepath_def
+ apply(rule continuous_on_compose[unfolded o_def, of _ "\<lambda>x. 1 - x"])
+ apply(rule continuous_on_sub, rule continuous_on_const, rule continuous_on_id)
+ apply(rule continuous_on_subset[of "{0..1}"], assumption)
+ by (auto, auto simp add:vector_less_eq_def vector_component_simps elim!:ballE)
+ show ?thesis using *[of g] *[of "reversepath g"] unfolding reversepath_reversepath by auto qed
+
+lemmas reversepath_simps = path_reversepath path_image_reversepath pathstart_reversepath pathfinish_reversepath
+
+lemma path_join[simp]: assumes "pathfinish g1 = pathstart g2" shows "path (g1 +++ g2) \<longleftrightarrow> path g1 \<and> path g2"
+ unfolding path_def pathfinish_def pathstart_def apply rule defer apply(erule conjE) proof-
+ assume as:"continuous_on {0..1} (g1 +++ g2)"
+ have *:"g1 = (\<lambda>x. g1 (2 *\<^sub>R x)) \<circ> (\<lambda>x. (1/2) *\<^sub>R x)"
+ "g2 = (\<lambda>x. g2 (2 *\<^sub>R x - 1)) \<circ> (\<lambda>x. (1/2) *\<^sub>R (x + 1))" unfolding o_def by auto
+ 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}"
+ unfolding image_smult_interval by (auto, auto simp add:vector_less_eq_def vector_component_simps elim!:ballE)
+ thus "continuous_on {0..1} g1 \<and> continuous_on {0..1} g2" apply -apply rule
+ apply(subst *) defer apply(subst *) apply (rule_tac[!] continuous_on_compose)
+ apply (rule continuous_on_cmul, rule continuous_on_add, rule continuous_on_id, rule continuous_on_const) defer
+ apply (rule continuous_on_cmul, rule continuous_on_id) apply(rule_tac[!] continuous_on_eq[of _ "g1 +++ g2"]) defer prefer 3
+ apply(rule_tac[1-2] continuous_on_subset[of "{0 .. 1}"]) apply(rule as, assumption, rule as, assumption)
+ apply(rule) defer apply rule proof-
+ fix x assume "x \<in> op *\<^sub>R (1 / 2) ` {0::real^1..1}"
+ hence "dest_vec1 x \<le> 1 / 2" unfolding image_iff by(auto simp add: vector_component_simps)
+ thus "(g1 +++ g2) x = g1 (2 *\<^sub>R x)" unfolding joinpaths_def by auto next
+ fix x assume "x \<in> (\<lambda>x. (1 / 2) *\<^sub>R (x + 1)) ` {0::real^1..1}"
+ hence "dest_vec1 x \<ge> 1 / 2" unfolding image_iff by(auto simp add: vector_component_simps)
+ thus "(g1 +++ g2) x = g2 (2 *\<^sub>R x - 1)" proof(cases "dest_vec1 x = 1 / 2")
+ case True hence "x = (1/2) *\<^sub>R 1" unfolding Cart_eq by(auto simp add: forall_1 vector_component_simps)
+ thus ?thesis unfolding joinpaths_def using assms[unfolded pathstart_def pathfinish_def] by auto
+ qed (auto simp add:le_less joinpaths_def) qed
+next assume as:"continuous_on {0..1} g1" "continuous_on {0..1} g2"
+ 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)
+ have **:"op *\<^sub>R 2 ` {0..(1 / 2) *\<^sub>R 1} = {0..1::real^1}" apply(rule set_ext, rule) unfolding image_iff
+ defer apply(rule_tac x="(1/2)*\<^sub>R x" in bexI) by(auto simp add: vector_component_simps)
+ have ***:"(\<lambda>x. 2 *\<^sub>R x - 1) ` {(1 / 2) *\<^sub>R 1..1} = {0..1::real^1}"
+ unfolding image_affinity_interval[of _ "- 1", unfolded diff_def[symmetric]] and interval_eq_empty_1
+ by(auto simp add: vector_component_simps)
+ 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)
+ show "continuous_on {0..1} (g1 +++ g2)" unfolding * apply(rule continuous_on_union) apply(rule closed_interval)+ proof-
+ 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
+ unfolding o_def[THEN sym] apply(rule continuous_on_compose) apply(rule continuous_on_cmul, rule continuous_on_id)
+ unfolding ** apply(rule as(1)) unfolding joinpaths_def by(auto simp add: vector_component_simps) next
+ 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
+ apply(rule continuous_on_compose) apply(rule continuous_on_sub, rule continuous_on_cmul, rule continuous_on_id, rule continuous_on_const)
+ unfolding *** o_def joinpaths_def apply(rule as(2)) using assms[unfolded pathstart_def pathfinish_def]
+ by(auto simp add: vector_component_simps ****) qed qed
+
+lemma path_image_join_subset: "path_image(g1 +++ g2) \<subseteq> (path_image g1 \<union> path_image g2)" proof
+ fix x assume "x \<in> path_image (g1 +++ g2)"
+ 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))"
+ unfolding path_image_def image_iff joinpaths_def by auto
+ thus "x \<in> path_image g1 \<union> path_image g2" apply(cases "dest_vec1 y \<le> 1/2")
+ apply(rule_tac UnI1) defer apply(rule_tac UnI2) unfolding y(2) path_image_def using y(1)
+ by(auto intro!: imageI simp add: vector_component_simps) qed
+
+lemma subset_path_image_join:
+ assumes "path_image g1 \<subseteq> s" "path_image g2 \<subseteq> s" shows "path_image(g1 +++ g2) \<subseteq> s"
+ using path_image_join_subset[of g1 g2] and assms by auto
+
+lemma path_image_join:
+ assumes "path g1" "path g2" "pathfinish g1 = pathstart g2"
+ shows "path_image(g1 +++ g2) = (path_image g1) \<union> (path_image g2)"
+apply(rule, rule path_image_join_subset, rule) unfolding Un_iff proof(erule disjE)
+ fix x assume "x \<in> path_image g1"
+ then obtain y where y:"y\<in>{0..1}" "x = g1 y" unfolding path_image_def image_iff by auto
+ thus "x \<in> path_image (g1 +++ g2)" unfolding joinpaths_def path_image_def image_iff
+ apply(rule_tac x="(1/2) *\<^sub>R y" in bexI) by(auto simp add: vector_component_simps) next
+ fix x assume "x \<in> path_image g2"
+ then obtain y where y:"y\<in>{0..1}" "x = g2 y" unfolding path_image_def image_iff by auto
+ moreover have *:"y $ 1 = 0 \<Longrightarrow> y = 0" unfolding Cart_eq by auto
+ ultimately show "x \<in> path_image (g1 +++ g2)" unfolding joinpaths_def path_image_def image_iff
+ apply(rule_tac x="(1/2) *\<^sub>R (y + 1)" in bexI) using assms(3)[unfolded pathfinish_def pathstart_def]
+ by(auto simp add: vector_component_simps) qed
+
+lemma not_in_path_image_join:
+ assumes "x \<notin> path_image g1" "x \<notin> path_image g2" shows "x \<notin> path_image(g1 +++ g2)"
+ using assms and path_image_join_subset[of g1 g2] by auto
+
+lemma simple_path_reversepath: assumes "simple_path g" shows "simple_path (reversepath g)"
+ using assms unfolding simple_path_def reversepath_def apply- apply(rule ballI)+
+ apply(erule_tac x="1-x" in ballE, erule_tac x="1-y" in ballE)
+ unfolding mem_interval_1 by(auto simp add:vector_component_simps)
+
+lemma dest_vec1_scaleR [simp]:
+ "dest_vec1 (scaleR a x) = scaleR a (dest_vec1 x)"
+unfolding dest_vec1_def by simp
+
+lemma simple_path_join_loop:
+ assumes "injective_path g1" "injective_path g2" "pathfinish g2 = pathstart g1"
+ "(path_image g1 \<inter> path_image g2) \<subseteq> {pathstart g1,pathstart g2}"
+ shows "simple_path(g1 +++ g2)"
+unfolding simple_path_def proof((rule ballI)+, rule impI) let ?g = "g1 +++ g2"
+ note inj = assms(1,2)[unfolded injective_path_def, rule_format]
+ fix x y::"real^1" assume xy:"x \<in> {0..1}" "y \<in> {0..1}" "?g x = ?g y"
+ 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)
+ assume as:"x $ 1 \<le> 1 / 2" "y $ 1 \<le> 1 / 2"
+ hence "g1 (2 *\<^sub>R x) = g1 (2 *\<^sub>R y)" using xy(3) unfolding joinpaths_def dest_vec1_def by auto
+ moreover have "2 *\<^sub>R x \<in> {0..1}" "2 *\<^sub>R y \<in> {0..1}" using xy(1,2) as
+ unfolding mem_interval_1 dest_vec1_def by(auto simp add:vector_component_simps)
+ ultimately show ?thesis using inj(1)[of "2*\<^sub>R x" "2*\<^sub>R y"] by auto
+ next assume as:"x $ 1 > 1 / 2" "y $ 1 > 1 / 2"
+ hence "g2 (2 *\<^sub>R x - 1) = g2 (2 *\<^sub>R y - 1)" using xy(3) unfolding joinpaths_def dest_vec1_def by auto
+ moreover have "2 *\<^sub>R x - 1 \<in> {0..1}" "2 *\<^sub>R y - 1 \<in> {0..1}" using xy(1,2) as
+ unfolding mem_interval_1 dest_vec1_def by(auto simp add:vector_component_simps)
+ ultimately show ?thesis using inj(2)[of "2*\<^sub>R x - 1" "2*\<^sub>R y - 1"] by auto
+ next assume as:"x $ 1 \<le> 1 / 2" "y $ 1 > 1 / 2"
+ hence "?g x \<in> path_image g1" "?g y \<in> path_image g2" unfolding path_image_def joinpaths_def
+ using xy(1,2)[unfolded mem_interval_1] by(auto simp add:vector_component_simps intro!: imageI)
+ moreover have "?g y \<noteq> pathstart g2" using as(2) unfolding pathstart_def joinpaths_def
+ using inj(2)[of "2 *\<^sub>R y - 1" 0] and xy(2)[unfolded mem_interval_1]
+ apply(rule_tac ccontr) by(auto simp add:vector_component_simps field_simps Cart_eq)
+ ultimately have *:"?g x = pathstart g1" using assms(4) unfolding xy(3) by auto
+ hence "x = 0" unfolding pathstart_def joinpaths_def using as(1) and xy(1)[unfolded mem_interval_1]
+ using inj(1)[of "2 *\<^sub>R x" 0] by(auto simp add:vector_component_simps)
+ moreover have "y = 1" using * unfolding xy(3) assms(3)[THEN sym]
+ unfolding joinpaths_def pathfinish_def using as(2) and xy(2)[unfolded mem_interval_1]
+ using inj(2)[of "2 *\<^sub>R y - 1" 1] by (auto simp add:vector_component_simps Cart_eq)
+ ultimately show ?thesis by auto
+ next assume as:"x $ 1 > 1 / 2" "y $ 1 \<le> 1 / 2"
+ hence "?g x \<in> path_image g2" "?g y \<in> path_image g1" unfolding path_image_def joinpaths_def
+ using xy(1,2)[unfolded mem_interval_1] by(auto simp add:vector_component_simps intro!: imageI)
+ moreover have "?g x \<noteq> pathstart g2" using as(1) unfolding pathstart_def joinpaths_def
+ using inj(2)[of "2 *\<^sub>R x - 1" 0] and xy(1)[unfolded mem_interval_1]
+ apply(rule_tac ccontr) by(auto simp add:vector_component_simps field_simps Cart_eq)
+ ultimately have *:"?g y = pathstart g1" using assms(4) unfolding xy(3) by auto
+ hence "y = 0" unfolding pathstart_def joinpaths_def using as(2) and xy(2)[unfolded mem_interval_1]
+ using inj(1)[of "2 *\<^sub>R y" 0] by(auto simp add:vector_component_simps)
+ moreover have "x = 1" using * unfolding xy(3)[THEN sym] assms(3)[THEN sym]
+ unfolding joinpaths_def pathfinish_def using as(1) and xy(1)[unfolded mem_interval_1]
+ using inj(2)[of "2 *\<^sub>R x - 1" 1] by(auto simp add:vector_component_simps Cart_eq)
+ ultimately show ?thesis by auto qed qed
+
+lemma injective_path_join:
+ assumes "injective_path g1" "injective_path g2" "pathfinish g1 = pathstart g2"
+ "(path_image g1 \<inter> path_image g2) \<subseteq> {pathstart g2}"
+ shows "injective_path(g1 +++ g2)"
+ unfolding injective_path_def proof(rule,rule,rule) let ?g = "g1 +++ g2"
+ note inj = assms(1,2)[unfolded injective_path_def, rule_format]
+ fix x y assume xy:"x \<in> {0..1}" "y \<in> {0..1}" "(g1 +++ g2) x = (g1 +++ g2) y"
+ show "x = y" proof(cases "x$1 \<le> 1/2", case_tac[!] "y$1 \<le> 1/2", unfold not_le)
+ 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
+ unfolding mem_interval_1 joinpaths_def by(auto simp add:vector_component_simps)
+ 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
+ unfolding mem_interval_1 joinpaths_def by(auto simp add:vector_component_simps)
+ next assume as:"x $ 1 \<le> 1 / 2" "y $ 1 > 1 / 2"
+ hence "?g x \<in> path_image g1" "?g y \<in> path_image g2" unfolding path_image_def joinpaths_def
+ using xy(1,2)[unfolded mem_interval_1] by(auto simp add:vector_component_simps intro!: imageI)
+ hence "?g x = pathfinish g1" "?g y = pathstart g2" using assms(4) unfolding assms(3) xy(3) by auto
+ 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)
+ unfolding pathstart_def pathfinish_def joinpaths_def mem_interval_1
+ by(auto simp add:vector_component_simps Cart_eq forall_1)
+ next assume as:"x $ 1 > 1 / 2" "y $ 1 \<le> 1 / 2"
+ hence "?g x \<in> path_image g2" "?g y \<in> path_image g1" unfolding path_image_def joinpaths_def
+ using xy(1,2)[unfolded mem_interval_1] by(auto simp add:vector_component_simps intro!: imageI)
+ hence "?g x = pathstart g2" "?g y = pathfinish g1" using assms(4) unfolding assms(3) xy(3) by auto
+ 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)
+ unfolding pathstart_def pathfinish_def joinpaths_def mem_interval_1
+ by(auto simp add:vector_component_simps forall_1 Cart_eq) qed qed
+
+lemmas join_paths_simps = path_join path_image_join pathstart_join pathfinish_join
+
+subsection {* Reparametrizing a closed curve to start at some chosen point. *}
+
+definition "shiftpath a (f::real^1 \<Rightarrow> real^'n) =
+ (\<lambda>x. if dest_vec1 (a + x) \<le> 1 then f(a + x) else f(a + x - 1))"
+
+lemma pathstart_shiftpath: "a \<le> 1 \<Longrightarrow> pathstart(shiftpath a g) = g a"
+ unfolding pathstart_def shiftpath_def by auto
+
+(** move this **)
+declare forall_1[simp] ex_1[simp]
+
+lemma pathfinish_shiftpath: assumes "0 \<le> a" "pathfinish g = pathstart g"
+ shows "pathfinish(shiftpath a g) = g a"
+ using assms unfolding pathstart_def pathfinish_def shiftpath_def
+ by(auto simp add: vector_component_simps)
+
+lemma endpoints_shiftpath:
+ assumes "pathfinish g = pathstart g" "a \<in> {0 .. 1}"
+ shows "pathfinish(shiftpath a g) = g a" "pathstart(shiftpath a g) = g a"
+ using assms by(auto intro!:pathfinish_shiftpath pathstart_shiftpath)
+
+lemma closed_shiftpath:
+ assumes "pathfinish g = pathstart g" "a \<in> {0..1}"
+ shows "pathfinish(shiftpath a g) = pathstart(shiftpath a g)"
+ using endpoints_shiftpath[OF assms] by auto
+
+lemma path_shiftpath:
+ assumes "path g" "pathfinish g = pathstart g" "a \<in> {0..1}"
+ shows "path(shiftpath a g)" proof-
+ have *:"{0 .. 1} = {0 .. 1-a} \<union> {1-a .. 1}" using assms(3) by(auto simp add: vector_component_simps)
+ have **:"\<And>x. x + a = 1 \<Longrightarrow> g (x + a - 1) = g (x + a)"
+ using assms(2)[unfolded pathfinish_def pathstart_def] by auto
+ show ?thesis unfolding path_def shiftpath_def * apply(rule continuous_on_union)
+ apply(rule closed_interval)+ apply(rule continuous_on_eq[of _ "g \<circ> (\<lambda>x. a + x)"]) prefer 3
+ apply(rule continuous_on_eq[of _ "g \<circ> (\<lambda>x. a - 1 + x)"]) defer prefer 3
+ apply(rule continuous_on_intros)+ prefer 2 apply(rule continuous_on_intros)+
+ apply(rule_tac[1-2] continuous_on_subset[OF assms(1)[unfolded path_def]])
+ using assms(3) and ** by(auto simp add:vector_component_simps field_simps Cart_eq) qed
+
+lemma shiftpath_shiftpath: assumes "pathfinish g = pathstart g" "a \<in> {0..1}" "x \<in> {0..1}"
+ shows "shiftpath (1 - a) (shiftpath a g) x = g x"
+ using assms unfolding pathfinish_def pathstart_def shiftpath_def
+ by(auto simp add: vector_component_simps)
+
+lemma path_image_shiftpath:
+ assumes "a \<in> {0..1}" "pathfinish g = pathstart g"
+ shows "path_image(shiftpath a g) = path_image g" proof-
+ { 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)"
+ hence "\<exists>y\<in>{0..1} \<inter> {x. a $ 1 + x $ 1 \<le> 1}. g x = g (a + y)" proof(cases "a \<le> x")
+ case False thus ?thesis apply(rule_tac x="1 + x - a" in bexI)
+ using as(1,2) and as(3)[THEN bspec[where x="1 + x - a"]] and assms(1)
+ by(auto simp add:vector_component_simps field_simps atomize_not) next
+ case True thus ?thesis using as(1-2) and assms(1) apply(rule_tac x="x - a" in bexI)
+ by(auto simp add:vector_component_simps field_simps) qed }
+ thus ?thesis using assms unfolding shiftpath_def path_image_def pathfinish_def pathstart_def
+ by(auto simp add:vector_component_simps image_iff) qed
+
+subsection {* Special case of straight-line paths. *}
+
+definition
+ linepath :: "real ^ 'n::finite \<Rightarrow> real ^ 'n \<Rightarrow> real ^ 1 \<Rightarrow> real ^ 'n" where
+ "linepath a b = (\<lambda>x. (1 - dest_vec1 x) *\<^sub>R a + dest_vec1 x *\<^sub>R b)"
+
+lemma pathstart_linepath[simp]: "pathstart(linepath a b) = a"
+ unfolding pathstart_def linepath_def by auto
+
+lemma pathfinish_linepath[simp]: "pathfinish(linepath a b) = b"
+ unfolding pathfinish_def linepath_def by auto
+
+lemma continuous_linepath_at[intro]: "continuous (at x) (linepath a b)"
+ unfolding linepath_def
+ by (intro continuous_intros continuous_dest_vec1)
+
+lemma continuous_on_linepath[intro]: "continuous_on s (linepath a b)"
+ using continuous_linepath_at by(auto intro!: continuous_at_imp_continuous_on)
+
+lemma path_linepath[intro]: "path(linepath a b)"
+ unfolding path_def by(rule continuous_on_linepath)
+
+lemma path_image_linepath[simp]: "path_image(linepath a b) = (closed_segment a b)"
+ unfolding path_image_def segment linepath_def apply (rule set_ext, rule) defer
+ unfolding mem_Collect_eq image_iff apply(erule exE) apply(rule_tac x="u *\<^sub>R 1" in bexI)
+ by(auto simp add:vector_component_simps)
+
+lemma reversepath_linepath[simp]: "reversepath(linepath a b) = linepath b a"
+ unfolding reversepath_def linepath_def by(rule ext, auto simp add:vector_component_simps)
+
+lemma injective_path_linepath: assumes "a \<noteq> b" shows "injective_path(linepath a b)" proof-
+ { obtain i where i:"a$i \<noteq> b$i" using assms[unfolded Cart_eq] by auto
+ 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"
+ 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)
+ hence "x = y" unfolding mult_cancel_right Cart_eq using i(1) by(auto simp add:field_simps) }
+ thus ?thesis unfolding injective_path_def linepath_def by(auto simp add:vector_component_simps algebra_simps) qed
+
+lemma simple_path_linepath[intro]: "a \<noteq> b \<Longrightarrow> simple_path(linepath a b)" by(auto intro!: injective_imp_simple_path injective_path_linepath)
+
+subsection {* Bounding a point away from a path. *}
+
+lemma not_on_path_ball: assumes "path g" "z \<notin> path_image g"
+ shows "\<exists>e>0. ball z e \<inter> (path_image g) = {}" proof-
+ obtain a where "a\<in>path_image g" "\<forall>y\<in>path_image g. dist z a \<le> dist z y"
+ using distance_attains_inf[OF _ path_image_nonempty, of g z]
+ using compact_path_image[THEN compact_imp_closed, OF assms(1)] by auto
+ thus ?thesis apply(rule_tac x="dist z a" in exI) using assms(2) by(auto intro!: dist_pos_lt) qed
+
+lemma not_on_path_cball: assumes "path g" "z \<notin> path_image g"
+ shows "\<exists>e>0. cball z e \<inter> (path_image g) = {}" proof-
+ obtain e where "ball z e \<inter> path_image g = {}" "e>0" using not_on_path_ball[OF assms] by auto
+ moreover have "cball z (e/2) \<subseteq> ball z e" using `e>0` by auto
+ ultimately show ?thesis apply(rule_tac x="e/2" in exI) by auto qed
+
+subsection {* Path component, considered as a "joinability" relation (from Tom Hales). *}
+
+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)"
+
+lemmas path_defs = path_def pathstart_def pathfinish_def path_image_def path_component_def
+
+lemma path_component_mem: assumes "path_component s x y" shows "x \<in> s" "y \<in> s"
+ using assms unfolding path_defs by auto
+
+lemma path_component_refl: assumes "x \<in> s" shows "path_component s x x"
+ unfolding path_defs apply(rule_tac x="\<lambda>u. x" in exI) using assms
+ by(auto intro!:continuous_on_intros)
+
+lemma path_component_refl_eq: "path_component s x x \<longleftrightarrow> x \<in> s"
+ by(auto intro!: path_component_mem path_component_refl)
+
+lemma path_component_sym: "path_component s x y \<Longrightarrow> path_component s y x"
+ using assms unfolding path_component_def apply(erule exE) apply(rule_tac x="reversepath g" in exI)
+ by(auto simp add: reversepath_simps)
+
+lemma path_component_trans: assumes "path_component s x y" "path_component s y z" shows "path_component s x z"
+ 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)
+
+lemma path_component_of_subset: "s \<subseteq> t \<Longrightarrow> path_component s x y \<Longrightarrow> path_component t x y"
+ unfolding path_component_def by auto
+
+subsection {* Can also consider it as a set, as the name suggests. *}
+
+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 )}"
+ apply(rule set_ext) unfolding mem_Collect_eq unfolding mem_def path_component_def by auto
+
+lemma mem_path_component_set:"x \<in> path_component s y \<longleftrightarrow> path_component s y x" unfolding mem_def by auto
+
+lemma path_component_subset: "(path_component s x) \<subseteq> s"
+ apply(rule, rule path_component_mem(2)) by(auto simp add:mem_def)
+
+lemma path_component_eq_empty: "path_component s x = {} \<longleftrightarrow> x \<notin> s"
+ apply rule apply(drule equals0D[of _ x]) defer apply(rule equals0I) unfolding mem_path_component_set
+ apply(drule path_component_mem(1)) using path_component_refl by auto
+
+subsection {* Path connectedness of a space. *}
+
+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)"
+
+lemma path_connected_component: "path_connected s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. path_component s x y)"
+ unfolding path_connected_def path_component_def by auto
+
+lemma path_connected_component_set: "path_connected s \<longleftrightarrow> (\<forall>x\<in>s. path_component s x = s)"
+ unfolding path_connected_component apply(rule, rule, rule, rule path_component_subset)
+ unfolding subset_eq mem_path_component_set Ball_def mem_def by auto
+
+subsection {* Some useful lemmas about path-connectedness. *}
+
+lemma convex_imp_path_connected: assumes "convex s" shows "path_connected s"
+ unfolding path_connected_def apply(rule,rule,rule_tac x="linepath x y" in exI)
+ unfolding path_image_linepath using assms[unfolded convex_contains_segment] by auto
+
+lemma path_connected_imp_connected: assumes "path_connected s" shows "connected s"
+ unfolding connected_def not_ex apply(rule,rule,rule ccontr) unfolding not_not apply(erule conjE)+ proof-
+ fix e1 e2 assume as:"open e1" "open e2" "s \<subseteq> e1 \<union> e2" "e1 \<inter> e2 \<inter> s = {}" "e1 \<inter> s \<noteq> {}" "e2 \<inter> s \<noteq> {}"
+ then obtain x1 x2 where obt:"x1\<in>e1\<inter>s" "x2\<in>e2\<inter>s" by auto
+ then obtain g where g:"path g" "path_image g \<subseteq> s" "pathstart g = x1" "pathfinish g = x2"
+ using assms[unfolded path_connected_def,rule_format,of x1 x2] by auto
+ have *:"connected {0..1::real^1}" by(auto intro!: convex_connected convex_interval)
+ have "{0..1} \<subseteq> {x \<in> {0..1}. g x \<in> e1} \<union> {x \<in> {0..1}. g x \<in> e2}" using as(3) g(2)[unfolded path_defs] by blast
+ moreover have "{x \<in> {0..1}. g x \<in> e1} \<inter> {x \<in> {0..1}. g x \<in> e2} = {}" using as(4) g(2)[unfolded path_defs] unfolding subset_eq by auto
+ moreover have "{x \<in> {0..1}. g x \<in> e1} \<noteq> {} \<and> {x \<in> {0..1}. g x \<in> e2} \<noteq> {}" using g(3,4)[unfolded path_defs] using obt by(auto intro!: exI)
+ 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}"]
+ using continuous_open_in_preimage[OF g(1)[unfolded path_def] as(1)]
+ using continuous_open_in_preimage[OF g(1)[unfolded path_def] as(2)] by auto qed
+
+lemma open_path_component: assumes "open s" shows "open(path_component s x)"
+ unfolding open_contains_ball proof
+ fix y assume as:"y \<in> path_component s x"
+ hence "y\<in>s" apply- apply(rule path_component_mem(2)) unfolding mem_def by auto
+ then obtain e where e:"e>0" "ball y e \<subseteq> s" using assms[unfolded open_contains_ball] by auto
+ 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-
+ fix z assume "dist y z < e" thus "path_component s x z" apply(rule_tac path_component_trans[of _ _ y]) defer
+ 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`
+ using as[unfolded mem_def] by auto qed qed
+
+lemma open_non_path_component: assumes "open s" shows "open(s - path_component s x)" unfolding open_contains_ball proof
+ fix y assume as:"y\<in>s - path_component s x"
+ then obtain e where e:"e>0" "ball y e \<subseteq> s" using assms[unfolded open_contains_ball] by auto
+ 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)
+ fix z assume "z\<in>ball y e" "\<not> z \<notin> path_component s x"
+ hence "y \<in> path_component s x" unfolding not_not mem_path_component_set using `e>0`
+ apply- apply(rule path_component_trans,assumption) apply(rule path_component_of_subset[OF e(2)])
+ apply(rule convex_imp_path_connected[OF convex_ball, unfolded path_connected_component, rule_format]) by auto
+ thus False using as by auto qed(insert e(2), auto) qed
+
+lemma connected_open_path_connected: assumes "open s" "connected s" shows "path_connected s"
+ unfolding path_connected_component_set proof(rule,rule,rule path_component_subset, rule)
+ fix x y assume "x \<in> s" "y \<in> s" show "y \<in> path_component s x" proof(rule ccontr)
+ assume "y \<notin> path_component s x" moreover
+ have "path_component s x \<inter> s \<noteq> {}" using `x\<in>s` path_component_eq_empty path_component_subset[of s x] by auto
+ ultimately show False using `y\<in>s` open_non_path_component[OF assms(1)] open_path_component[OF assms(1)]
+ using assms(2)[unfolded connected_def not_ex, rule_format, of"path_component s x" "s - path_component s x"] by auto
+qed qed
+
+lemma path_connected_continuous_image:
+ assumes "continuous_on s f" "path_connected s" shows "path_connected (f ` s)"
+ unfolding path_connected_def proof(rule,rule)
+ fix x' y' assume "x' \<in> f ` s" "y' \<in> f ` s"
+ then obtain x y where xy:"x\<in>s" "y\<in>s" "x' = f x" "y' = f y" by auto
+ guess g using assms(2)[unfolded path_connected_def,rule_format,OF xy(1,2)] ..
+ thus "\<exists>g. path g \<and> path_image g \<subseteq> f ` s \<and> pathstart g = x' \<and> pathfinish g = y'"
+ unfolding xy apply(rule_tac x="f \<circ> g" in exI) unfolding path_defs
+ using assms(1) by(auto intro!: continuous_on_compose continuous_on_subset[of _ _ "g ` {0..1}"]) qed
+
+lemma homeomorphic_path_connectedness:
+ "s homeomorphic t \<Longrightarrow> (path_connected s \<longleftrightarrow> path_connected t)"
+ unfolding homeomorphic_def homeomorphism_def apply(erule exE|erule conjE)+ apply rule
+ apply(drule_tac f=f in path_connected_continuous_image) prefer 3
+ apply(drule_tac f=g in path_connected_continuous_image) by auto
+
+lemma path_connected_empty: "path_connected {}"
+ unfolding path_connected_def by auto
+
+lemma path_connected_singleton: "path_connected {a}"
+ unfolding path_connected_def apply(rule,rule)
+ apply(rule_tac x="linepath a a" in exI) by(auto simp add:segment scaleR_left_diff_distrib)
+
+lemma path_connected_Un: assumes "path_connected s" "path_connected t" "s \<inter> t \<noteq> {}"
+ shows "path_connected (s \<union> t)" unfolding path_connected_component proof(rule,rule)
+ fix x y assume as:"x \<in> s \<union> t" "y \<in> s \<union> t"
+ from assms(3) obtain z where "z \<in> s \<inter> t" by auto
+ thus "path_component (s \<union> t) x y" using as using assms(1-2)[unfolded path_connected_component] apply-
+ apply(erule_tac[!] UnE)+ apply(rule_tac[2-3] path_component_trans[of _ _ z])
+ by(auto simp add:path_component_of_subset [OF Un_upper1] path_component_of_subset[OF Un_upper2]) qed
+
+subsection {* sphere is path-connected. *}
+
+lemma path_connected_punctured_universe:
+ assumes "2 \<le> CARD('n::finite)" shows "path_connected((UNIV::(real^'n::finite) set) - {a})" proof-
+ 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
+ let ?U = "UNIV::(real^'n) set" let ?u = "?U - {0}"
+ let ?basis = "\<lambda>k. basis (\<psi> k)"
+ let ?A = "\<lambda>k. {x::real^'n. \<exists>i\<in>{1..k}. inner (basis (\<psi> i)) x \<noteq> 0}"
+ have "\<forall>k\<in>{2..CARD('n)}. path_connected (?A k)" proof
+ 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
+ apply(erule UnE)+ unfolding mem_Collect_eq apply(rule_tac[1-2] x="Suc k" in bexI)
+ by(auto elim!: ballE simp add: not_less le_Suc_eq)
+ fix k assume "k \<in> {2..CARD('n)}" thus "path_connected (?A k)" proof(induct k)
+ case (Suc k) show ?case proof(cases "k = 1")
+ case False from Suc have d:"k \<in> {1..CARD('n)}" "Suc k \<in> {1..CARD('n)}" by auto
+ 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
+ hence **:"?basis k + ?basis (Suc k) \<in> {x. 0 < inner (?basis (Suc k)) x} \<inter> (?A k)"
+ "?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
+ by(auto simp add: inner_basis vector_component_simps intro!:bexI[where x=k])
+ show ?thesis unfolding * Un_assoc apply(rule path_connected_Un) defer apply(rule path_connected_Un)
+ prefer 5 apply(rule_tac[1-2] convex_imp_path_connected, rule convex_halfspace_lt, rule convex_halfspace_gt)
+ apply(rule Suc(1)) apply(rule_tac[2-3] ccontr) using d ** False by auto
+ next case True hence d:"1\<in>{1..CARD('n)}" "2\<in>{1..CARD('n)}" using Suc(2) by auto
+ have ***:"Suc 1 = 2" by auto
+ 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
+ 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
+ thus ?thesis unfolding * True unfolding ** neq_iff bex_disj_distrib apply -
+ apply(rule path_connected_Un, rule_tac[1-2] path_connected_Un) defer 3 apply(rule_tac[1-4] convex_imp_path_connected)
+ apply(rule_tac[5] x=" ?basis 1 + ?basis 2" in nequals0I)
+ apply(rule_tac[6] x="-?basis 1 + ?basis 2" in nequals0I)
+ apply(rule_tac[7] x="-?basis 1 - ?basis 2" in nequals0I)
+ using d unfolding *** by(auto intro!: convex_halfspace_gt convex_halfspace_lt, auto simp add:vector_component_simps inner_basis)
+ qed qed auto qed note lem = this
+
+ 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)"
+ apply rule apply(erule bexE) apply(rule_tac x="\<psi> i" in exI) defer apply(erule exE) proof-
+ fix x::"real^'n" and i assume as:"inner (basis i) x \<noteq> 0"
+ have "i\<in>\<psi> ` {1..CARD('n)}" using \<psi>[unfolded bij_betw_def, THEN conjunct2] by auto
+ then obtain j where "j\<in>{1..CARD('n)}" "\<psi> j = i" by auto
+ 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
+ have *:"?U - {a} = (\<lambda>x. x + a) ` {x. x \<noteq> 0}" apply(rule set_ext) unfolding image_iff
+ apply rule apply(rule_tac x="x - a" in bexI) by auto
+ 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)
+ show ?thesis unfolding * apply(rule path_connected_continuous_image) apply(rule continuous_on_intros)+
+ unfolding ** apply(rule lem[THEN bspec[where x="CARD('n)"], unfolded ***]) using assms by auto qed
+
+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")
+ case True thus ?thesis proof(cases "r=0")
+ case False hence "{x::real^'n. norm(x - a) = r} = {}" using True by auto
+ thus ?thesis using path_connected_empty by auto
+ qed(auto intro!:path_connected_singleton) next
+ 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)
+ 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)
+ have **:"{x::real^'n. norm x = 1} = (\<lambda>x. (1/norm x) *\<^sub>R x) ` (UNIV - {0})" apply(rule set_ext,rule)
+ unfolding image_iff apply(rule_tac x=x in bexI) unfolding mem_Collect_eq by(auto split:split_if_asm)
+ have "continuous_on (UNIV - {0}) (\<lambda>x::real^'n. 1 / norm x)" unfolding o_def continuous_on_eq_continuous_within
+ apply(rule, rule continuous_at_within_inv[unfolded o_def inverse_eq_divide]) apply(rule continuous_at_within)
+ apply(rule continuous_at_norm[unfolded o_def]) by auto
+ thus ?thesis unfolding * ** using path_connected_punctured_universe[OF assms]
+ by(auto intro!: path_connected_continuous_image continuous_on_intros continuous_on_mul) qed
+
+lemma connected_sphere: "2 \<le> CARD('n) \<Longrightarrow> connected {x::real^'n::finite. norm(x - a) = r}"
+ using path_connected_sphere path_connected_imp_connected by auto
+
+(** In continuous_at_vec1_norm : Use \<And> instead of \<forall>. **)
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Multivariate_Analysis/Determinants.thy Fri Oct 23 13:23:18 2009 +0200
@@ -0,0 +1,1087 @@
+(* Title: Determinants
+ Author: Amine Chaieb, University of Cambridge
+*)
+
+header {* Traces, Determinant of square matrices and some properties *}
+
+theory Determinants
+imports Euclidean_Space Permutations
+begin
+
+subsection{* First some facts about products*}
+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)"
+apply clarsimp
+by(subgoal_tac "insert a A = A", auto)
+
+lemma setprod_add_split:
+ assumes mn: "(m::nat) <= n + 1"
+ shows "setprod f {m.. n+p} = setprod f {m .. n} * setprod f {n+1..n+p}"
+proof-
+ let ?A = "{m .. n+p}"
+ let ?B = "{m .. n}"
+ let ?C = "{n+1..n+p}"
+ from mn have un: "?B \<union> ?C = ?A" by auto
+ from mn have dj: "?B \<inter> ?C = {}" by auto
+ have f: "finite ?B" "finite ?C" by simp_all
+ from setprod_Un_disjoint[OF f dj, of f, unfolded un] show ?thesis .
+qed
+
+
+lemma setprod_offset: "setprod f {(m::nat) + p .. n + p} = setprod (\<lambda>i. f (i + p)) {m..n}"
+apply (rule setprod_reindex_cong[where f="op + p"])
+apply (auto simp add: image_iff Bex_def inj_on_def)
+apply arith
+apply (rule ext)
+apply (simp add: add_commute)
+done
+
+lemma setprod_singleton: "setprod f {x} = f x" by simp
+
+lemma setprod_singleton_nat_seg: "setprod f {n..n} = f (n::'a::order)" by simp
+
+lemma setprod_numseg: "setprod f {m..0} = (if m=0 then f 0 else 1)"
+ "setprod f {m .. Suc n} = (if m \<le> Suc n then f (Suc n) * setprod f {m..n}
+ else setprod f {m..n})"
+ by (auto simp add: atLeastAtMostSuc_conv)
+
+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)"
+ shows "setprod f S \<le> setprod g S"
+using fS fg
+apply(induct S)
+apply simp
+apply auto
+apply (rule mult_mono)
+apply (auto intro: setprod_nonneg)
+done
+
+ (* FIXME: In Finite_Set there is a useless further assumption *)
+lemma setprod_inversef: "finite A ==> setprod (inverse \<circ> f) A = (inverse (setprod f A) :: 'a:: {division_by_zero, field})"
+ apply (erule finite_induct)
+ apply (simp)
+ apply simp
+ done
+
+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)"
+ shows "setprod f S \<le> 1"
+using setprod_le[OF fS f] unfolding setprod_1 .
+
+subsection{* Trace *}
+
+definition trace :: "'a::semiring_1^'n^'n \<Rightarrow> 'a" where
+ "trace A = setsum (\<lambda>i. ((A$i)$i)) (UNIV::'n set)"
+
+lemma trace_0: "trace(mat 0) = 0"
+ by (simp add: trace_def mat_def)
+
+lemma trace_I: "trace(mat 1 :: 'a::semiring_1^'n^'n) = of_nat(CARD('n))"
+ by (simp add: trace_def mat_def)
+
+lemma trace_add: "trace ((A::'a::comm_semiring_1^'n^'n) + B) = trace A + trace B"
+ by (simp add: trace_def setsum_addf)
+
+lemma trace_sub: "trace ((A::'a::comm_ring_1^'n^'n) - B) = trace A - trace B"
+ by (simp add: trace_def setsum_subtractf)
+
+lemma trace_mul_sym:"trace ((A::'a::comm_semiring_1^'n^'n) ** B) = trace (B**A)"
+ apply (simp add: trace_def matrix_matrix_mult_def)
+ apply (subst setsum_commute)
+ by (simp add: mult_commute)
+
+(* ------------------------------------------------------------------------- *)
+(* Definition of determinant. *)
+(* ------------------------------------------------------------------------- *)
+
+definition det:: "'a::comm_ring_1^'n^'n \<Rightarrow> 'a" where
+ "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)}"
+
+(* ------------------------------------------------------------------------- *)
+(* A few general lemmas we need below. *)
+(* ------------------------------------------------------------------------- *)
+
+lemma setprod_permute:
+ assumes p: "p permutes S"
+ shows "setprod f S = setprod (f o p) S"
+proof-
+ {assume "\<not> finite S" hence ?thesis by simp}
+ moreover
+ {assume fS: "finite S"
+ then have ?thesis
+ apply (simp add: setprod_def cong del:strong_setprod_cong)
+ apply (rule ab_semigroup_mult.fold_image_permute)
+ apply (auto simp add: p)
+ apply unfold_locales
+ done}
+ ultimately show ?thesis by blast
+qed
+
+lemma setproduct_permute_nat_interval: "p permutes {m::nat .. n} ==> setprod f {m..n} = setprod (f o p) {m..n}"
+ by (blast intro!: setprod_permute)
+
+(* ------------------------------------------------------------------------- *)
+(* Basic determinant properties. *)
+(* ------------------------------------------------------------------------- *)
+
+lemma det_transp: "det (transp A) = det (A::'a::comm_ring_1 ^'n^'n::finite)"
+proof-
+ let ?di = "\<lambda>A i j. A$i$j"
+ let ?U = "(UNIV :: 'n set)"
+ have fU: "finite ?U" by simp
+ {fix p assume p: "p \<in> {p. p permutes ?U}"
+ from p have pU: "p permutes ?U" by blast
+ have sth: "sign (inv p) = sign p"
+ by (metis sign_inverse fU p mem_def Collect_def permutation_permutes)
+ from permutes_inj[OF pU]
+ have pi: "inj_on p ?U" by (blast intro: subset_inj_on)
+ from permutes_image[OF pU]
+ 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
+ also have "\<dots> = setprod ((\<lambda>i. ?di (transp A) i (inv p i)) o p) ?U"
+ unfolding setprod_reindex[OF pi] ..
+ also have "\<dots> = setprod (\<lambda>i. ?di A i (p i)) ?U"
+ proof-
+ {fix i assume i: "i \<in> ?U"
+ from i permutes_inv_o[OF pU] permutes_in_image[OF pU]
+ have "((\<lambda>i. ?di (transp A) i (inv p i)) o p) i = ?di A i (p i)"
+ unfolding transp_def by (simp add: expand_fun_eq)}
+ 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)
+ qed
+ 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
+ by simp}
+ then show ?thesis unfolding det_def apply (subst setsum_permutations_inverse)
+ apply (rule setsum_cong2) by blast
+qed
+
+lemma det_lowerdiagonal:
+ fixes A :: "'a::comm_ring_1^'n^'n::{finite,wellorder}"
+ assumes ld: "\<And>i j. i < j \<Longrightarrow> A$i$j = 0"
+ shows "det A = setprod (\<lambda>i. A$i$i) (UNIV:: 'n set)"
+proof-
+ let ?U = "UNIV:: 'n set"
+ let ?PU = "{p. p permutes ?U}"
+ let ?pp = "\<lambda>p. of_int (sign p) * setprod (\<lambda>i. A$i$p i) (UNIV :: 'n set)"
+ have fU: "finite ?U" by simp
+ from finite_permutations[OF fU] have fPU: "finite ?PU" .
+ have id0: "{id} \<subseteq> ?PU" by (auto simp add: permutes_id)
+ {fix p assume p: "p \<in> ?PU -{id}"
+ from p have pU: "p permutes ?U" and pid: "p \<noteq> id" by blast+
+ from permutes_natset_le[OF pU] pid obtain i where
+ i: "p i > i" by (metis not_le)
+ from ld[OF i] have ex:"\<exists>i \<in> ?U. A$i$p i = 0" by blast
+ from setprod_zero[OF fU ex] have "?pp p = 0" by simp}
+ then have p0: "\<forall>p \<in> ?PU -{id}. ?pp p = 0" by blast
+ from setsum_mono_zero_cong_left[OF fPU id0 p0] show ?thesis
+ unfolding det_def by (simp add: sign_id)
+qed
+
+lemma det_upperdiagonal:
+ fixes A :: "'a::comm_ring_1^'n^'n::{finite,wellorder}"
+ assumes ld: "\<And>i j. i > j \<Longrightarrow> A$i$j = 0"
+ shows "det A = setprod (\<lambda>i. A$i$i) (UNIV:: 'n set)"
+proof-
+ let ?U = "UNIV:: 'n set"
+ let ?PU = "{p. p permutes ?U}"
+ let ?pp = "(\<lambda>p. of_int (sign p) * setprod (\<lambda>i. A$i$p i) (UNIV :: 'n set))"
+ have fU: "finite ?U" by simp
+ from finite_permutations[OF fU] have fPU: "finite ?PU" .
+ have id0: "{id} \<subseteq> ?PU" by (auto simp add: permutes_id)
+ {fix p assume p: "p \<in> ?PU -{id}"
+ from p have pU: "p permutes ?U" and pid: "p \<noteq> id" by blast+
+ from permutes_natset_ge[OF pU] pid obtain i where
+ i: "p i < i" by (metis not_le)
+ from ld[OF i] have ex:"\<exists>i \<in> ?U. A$i$p i = 0" by blast
+ from setprod_zero[OF fU ex] have "?pp p = 0" by simp}
+ then have p0: "\<forall>p \<in> ?PU -{id}. ?pp p = 0" by blast
+ from setsum_mono_zero_cong_left[OF fPU id0 p0] show ?thesis
+ unfolding det_def by (simp add: sign_id)
+qed
+
+lemma det_diagonal:
+ fixes A :: "'a::comm_ring_1^'n^'n::finite"
+ assumes ld: "\<And>i j. i \<noteq> j \<Longrightarrow> A$i$j = 0"
+ shows "det A = setprod (\<lambda>i. A$i$i) (UNIV::'n set)"
+proof-
+ let ?U = "UNIV:: 'n set"
+ let ?PU = "{p. p permutes ?U}"
+ let ?pp = "\<lambda>p. of_int (sign p) * setprod (\<lambda>i. A$i$p i) (UNIV :: 'n set)"
+ have fU: "finite ?U" by simp
+ from finite_permutations[OF fU] have fPU: "finite ?PU" .
+ have id0: "{id} \<subseteq> ?PU" by (auto simp add: permutes_id)
+ {fix p assume p: "p \<in> ?PU - {id}"
+ then have "p \<noteq> id" by simp
+ then obtain i where i: "p i \<noteq> i" unfolding expand_fun_eq by auto
+ from ld [OF i [symmetric]] have ex:"\<exists>i \<in> ?U. A$i$p i = 0" by blast
+ from setprod_zero [OF fU ex] have "?pp p = 0" by simp}
+ then have p0: "\<forall>p \<in> ?PU - {id}. ?pp p = 0" by blast
+ from setsum_mono_zero_cong_left[OF fPU id0 p0] show ?thesis
+ unfolding det_def by (simp add: sign_id)
+qed
+
+lemma det_I: "det (mat 1 :: 'a::comm_ring_1^'n^'n::finite) = 1"
+proof-
+ let ?A = "mat 1 :: 'a::comm_ring_1^'n^'n"
+ let ?U = "UNIV :: 'n set"
+ let ?f = "\<lambda>i j. ?A$i$j"
+ {fix i assume i: "i \<in> ?U"
+ have "?f i i = 1" using i by (vector mat_def)}
+ hence th: "setprod (\<lambda>i. ?f i i) ?U = setprod (\<lambda>x. 1) ?U"
+ by (auto intro: setprod_cong)
+ {fix i j assume i: "i \<in> ?U" and j: "j \<in> ?U" and ij: "i \<noteq> j"
+ have "?f i j = 0" using i j ij by (vector mat_def) }
+ then have "det ?A = setprod (\<lambda>i. ?f i i) ?U" using det_diagonal
+ by blast
+ also have "\<dots> = 1" unfolding th setprod_1 ..
+ finally show ?thesis .
+qed
+
+lemma det_0: "det (mat 0 :: 'a::comm_ring_1^'n^'n::finite) = 0"
+ by (simp add: det_def setprod_zero)
+
+lemma det_permute_rows:
+ fixes A :: "'a::comm_ring_1^'n^'n::finite"
+ assumes p: "p permutes (UNIV :: 'n::finite set)"
+ shows "det(\<chi> i. A$p i :: 'a^'n^'n) = of_int (sign p) * det A"
+ apply (simp add: det_def setsum_right_distrib mult_assoc[symmetric])
+ apply (subst sum_permutations_compose_right[OF p])
+proof(rule setsum_cong2)
+ let ?U = "UNIV :: 'n set"
+ let ?PU = "{p. p permutes ?U}"
+ fix q assume qPU: "q \<in> ?PU"
+ have fU: "finite ?U" by simp
+ from qPU have q: "q permutes ?U" by blast
+ from p q have pp: "permutation p" and qp: "permutation q"
+ by (metis fU permutation_permutes)+
+ from permutes_inv[OF p] have ip: "inv p permutes ?U" .
+ 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"
+ by (simp only: setprod_permute[OF ip, symmetric])
+ also have "\<dots> = setprod (\<lambda>i. A $ (p o inv p) i $ (q o (p o inv p)) i) ?U"
+ by (simp only: o_def)
+ also have "\<dots> = setprod (\<lambda>i. A$i$q i) ?U" by (simp only: o_def permutes_inverses[OF p])
+ finally have thp: "setprod (\<lambda>i. A$p i$ (q o p) i) ?U = setprod (\<lambda>i. A$i$q i) ?U"
+ by blast
+ 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"
+ by (simp only: thp sign_compose[OF qp pp] mult_commute of_int_mult)
+qed
+
+lemma det_permute_columns:
+ fixes A :: "'a::comm_ring_1^'n^'n::finite"
+ assumes p: "p permutes (UNIV :: 'n set)"
+ shows "det(\<chi> i j. A$i$ p j :: 'a^'n^'n) = of_int (sign p) * det A"
+proof-
+ let ?Ap = "\<chi> i j. A$i$ p j :: 'a^'n^'n"
+ let ?At = "transp A"
+ have "of_int (sign p) * det A = det (transp (\<chi> i. transp A $ p i))"
+ unfolding det_permute_rows[OF p, of ?At] det_transp ..
+ moreover
+ have "?Ap = transp (\<chi> i. transp A $ p i)"
+ by (simp add: transp_def Cart_eq)
+ ultimately show ?thesis by simp
+qed
+
+lemma det_identical_rows:
+ fixes A :: "'a::ordered_idom^'n^'n::finite"
+ assumes ij: "i \<noteq> j"
+ and r: "row i A = row j A"
+ shows "det A = 0"
+proof-
+ have tha: "\<And>(a::'a) b. a = b ==> b = - a ==> a = 0"
+ by simp
+ have th1: "of_int (-1) = - 1" by (metis of_int_1 of_int_minus number_of_Min)
+ let ?p = "Fun.swap i j id"
+ let ?A = "\<chi> i. A $ ?p i"
+ from r have "A = ?A" by (simp add: Cart_eq row_def swap_def)
+ hence "det A = det ?A" by simp
+ moreover have "det A = - det ?A"
+ by (simp add: det_permute_rows[OF permutes_swap_id] sign_swap_id ij th1)
+ ultimately show "det A = 0" by (metis tha)
+qed
+
+lemma det_identical_columns:
+ fixes A :: "'a::ordered_idom^'n^'n::finite"
+ assumes ij: "i \<noteq> j"
+ and r: "column i A = column j A"
+ shows "det A = 0"
+apply (subst det_transp[symmetric])
+apply (rule det_identical_rows[OF ij])
+by (metis row_transp r)
+
+lemma det_zero_row:
+ fixes A :: "'a::{idom, ring_char_0}^'n^'n::finite"
+ assumes r: "row i A = 0"
+ shows "det A = 0"
+using r
+apply (simp add: row_def det_def Cart_eq)
+apply (rule setsum_0')
+apply (auto simp: sign_nz)
+done
+
+lemma det_zero_column:
+ fixes A :: "'a::{idom,ring_char_0}^'n^'n::finite"
+ assumes r: "column i A = 0"
+ shows "det A = 0"
+ apply (subst det_transp[symmetric])
+ apply (rule det_zero_row [of i])
+ by (metis row_transp r)
+
+lemma det_row_add:
+ fixes a b c :: "'n::finite \<Rightarrow> _ ^ 'n"
+ shows "det((\<chi> i. if i = k then a i + b i else c i)::'a::comm_ring_1^'n^'n) =
+ det((\<chi> i. if i = k then a i else c i)::'a::comm_ring_1^'n^'n) +
+ det((\<chi> i. if i = k then b i else c i)::'a::comm_ring_1^'n^'n)"
+unfolding det_def Cart_lambda_beta setsum_addf[symmetric]
+proof (rule setsum_cong2)
+ let ?U = "UNIV :: 'n set"
+ let ?pU = "{p. p permutes ?U}"
+ let ?f = "(\<lambda>i. if i = k then a i + b i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
+ let ?g = "(\<lambda> i. if i = k then a i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
+ let ?h = "(\<lambda> i. if i = k then b i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
+ fix p assume p: "p \<in> ?pU"
+ let ?Uk = "?U - {k}"
+ from p have pU: "p permutes ?U" by blast
+ have kU: "?U = insert k ?Uk" by blast
+ {fix j assume j: "j \<in> ?Uk"
+ from j have "?f j $ p j = ?g j $ p j" and "?f j $ p j= ?h j $ p j"
+ by simp_all}
+ then have th1: "setprod (\<lambda>i. ?f i $ p i) ?Uk = setprod (\<lambda>i. ?g i $ p i) ?Uk"
+ and th2: "setprod (\<lambda>i. ?f i $ p i) ?Uk = setprod (\<lambda>i. ?h i $ p i) ?Uk"
+ apply -
+ apply (rule setprod_cong, simp_all)+
+ done
+ have th3: "finite ?Uk" "k \<notin> ?Uk" by auto
+ have "setprod (\<lambda>i. ?f i $ p i) ?U = setprod (\<lambda>i. ?f i $ p i) (insert k ?Uk)"
+ unfolding kU[symmetric] ..
+ also have "\<dots> = ?f k $ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk"
+ apply (rule setprod_insert)
+ apply simp
+ by blast
+ 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)
+ 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)
+ also have "\<dots> = setprod (\<lambda>i. ?g i $ p i) (insert k ?Uk) + setprod (\<lambda>i. ?h i $ p i) (insert k ?Uk)"
+ unfolding setprod_insert[OF th3] by simp
+ 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] .
+ 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"
+ by (simp add: ring_simps)
+qed
+
+lemma det_row_mul:
+ fixes a b :: "'n::finite \<Rightarrow> _ ^ 'n"
+ shows "det((\<chi> i. if i = k then c *s a i else b i)::'a::comm_ring_1^'n^'n) =
+ c* det((\<chi> i. if i = k then a i else b i)::'a::comm_ring_1^'n^'n)"
+
+unfolding det_def Cart_lambda_beta setsum_right_distrib
+proof (rule setsum_cong2)
+ let ?U = "UNIV :: 'n set"
+ let ?pU = "{p. p permutes ?U}"
+ let ?f = "(\<lambda>i. if i = k then c*s a i else b i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
+ let ?g = "(\<lambda> i. if i = k then a i else b i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
+ fix p assume p: "p \<in> ?pU"
+ let ?Uk = "?U - {k}"
+ from p have pU: "p permutes ?U" by blast
+ have kU: "?U = insert k ?Uk" by blast
+ {fix j assume j: "j \<in> ?Uk"
+ from j have "?f j $ p j = ?g j $ p j" by simp}
+ then have th1: "setprod (\<lambda>i. ?f i $ p i) ?Uk = setprod (\<lambda>i. ?g i $ p i) ?Uk"
+ apply -
+ apply (rule setprod_cong, simp_all)
+ done
+ have th3: "finite ?Uk" "k \<notin> ?Uk" by auto
+ have "setprod (\<lambda>i. ?f i $ p i) ?U = setprod (\<lambda>i. ?f i $ p i) (insert k ?Uk)"
+ unfolding kU[symmetric] ..
+ also have "\<dots> = ?f k $ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk"
+ apply (rule setprod_insert)
+ apply simp
+ by blast
+ also have "\<dots> = (c*s a k) $ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk" by (simp add: ring_simps)
+ also have "\<dots> = c* (a k $ p k * setprod (\<lambda>i. ?g i $ p i) ?Uk)"
+ unfolding th1 by (simp add: mult_ac)
+ also have "\<dots> = c* (setprod (\<lambda>i. ?g i $ p i) (insert k ?Uk))"
+ unfolding setprod_insert[OF th3] by simp
+ finally have "setprod (\<lambda>i. ?f i $ p i) ?U = c* (setprod (\<lambda>i. ?g i $ p i) ?U)" unfolding kU[symmetric] .
+ 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)"
+ by (simp add: ring_simps)
+qed
+
+lemma det_row_0:
+ fixes b :: "'n::finite \<Rightarrow> _ ^ 'n"
+ shows "det((\<chi> i. if i = k then 0 else b i)::'a::comm_ring_1^'n^'n) = 0"
+using det_row_mul[of k 0 "\<lambda>i. 1" b]
+apply (simp)
+ unfolding vector_smult_lzero .
+
+lemma det_row_operation:
+ fixes A :: "'a::ordered_idom^'n^'n::finite"
+ assumes ij: "i \<noteq> j"
+ shows "det (\<chi> k. if k = i then row i A + c *s row j A else row k A) = det A"
+proof-
+ let ?Z = "(\<chi> k. if k = i then row j A else row k A) :: 'a ^'n^'n"
+ have th: "row i ?Z = row j ?Z" by (vector row_def)
+ have th2: "((\<chi> k. if k = i then row i A else row k A) :: 'a^'n^'n) = A"
+ by (vector row_def)
+ show ?thesis
+ unfolding det_row_add [of i] det_row_mul[of i] det_identical_rows[OF ij th] th2
+ by simp
+qed
+
+lemma det_row_span:
+ fixes A :: "'a:: ordered_idom^'n^'n::finite"
+ assumes x: "x \<in> span {row j A |j. j \<noteq> i}"
+ shows "det (\<chi> k. if k = i then row i A + x else row k A) = det A"
+proof-
+ let ?U = "UNIV :: 'n set"
+ let ?S = "{row j A |j. j \<noteq> i}"
+ let ?d = "\<lambda>x. det (\<chi> k. if k = i then x else row k A)"
+ let ?P = "\<lambda>x. ?d (row i A + x) = det A"
+ {fix k
+
+ have "(if k = i then row i A + 0 else row k A) = row k A" by simp}
+ then have P0: "?P 0"
+ apply -
+ apply (rule cong[of det, OF refl])
+ by (vector row_def)
+ moreover
+ {fix c z y assume zS: "z \<in> ?S" and Py: "?P y"
+ from zS obtain j where j: "z = row j A" "i \<noteq> j" by blast
+ let ?w = "row i A + y"
+ have th0: "row i A + (c*s z + y) = ?w + c*s z" by vector
+ have thz: "?d z = 0"
+ apply (rule det_identical_rows[OF j(2)])
+ using j by (vector row_def)
+ have "?d (row i A + (c*s z + y)) = ?d (?w + c*s z)" unfolding th0 ..
+ then have "?P (c*s z + y)" unfolding thz Py det_row_mul[of i] det_row_add[of i]
+ by simp }
+
+ ultimately show ?thesis
+ apply -
+ apply (rule span_induct_alt[of ?P ?S, OF P0])
+ apply blast
+ apply (rule x)
+ done
+qed
+
+(* ------------------------------------------------------------------------- *)
+(* May as well do this, though it's a bit unsatisfactory since it ignores *)
+(* exact duplicates by considering the rows/columns as a set. *)
+(* ------------------------------------------------------------------------- *)
+
+lemma det_dependent_rows:
+ fixes A:: "'a::ordered_idom^'n^'n::finite"
+ assumes d: "dependent (rows A)"
+ shows "det A = 0"
+proof-
+ let ?U = "UNIV :: 'n set"
+ from d obtain i where i: "row i A \<in> span (rows A - {row i A})"
+ unfolding dependent_def rows_def by blast
+ {fix j k assume jk: "j \<noteq> k"
+ and c: "row j A = row k A"
+ from det_identical_rows[OF jk c] have ?thesis .}
+ moreover
+ {assume H: "\<And> i j. i \<noteq> j \<Longrightarrow> row i A \<noteq> row j A"
+ have th0: "- row i A \<in> span {row j A|j. j \<noteq> i}"
+ apply (rule span_neg)
+ apply (rule set_rev_mp)
+ apply (rule i)
+ apply (rule span_mono)
+ using H i by (auto simp add: rows_def)
+ from det_row_span[OF th0]
+ have "det A = det (\<chi> k. if k = i then 0 *s 1 else row k A)"
+ unfolding right_minus vector_smult_lzero ..
+ with det_row_mul[of i "0::'a" "\<lambda>i. 1"]
+ have "det A = 0" by simp}
+ ultimately show ?thesis by blast
+qed
+
+lemma det_dependent_columns: assumes d: "dependent(columns (A::'a::ordered_idom^'n^'n::finite))" shows "det A = 0"
+by (metis d det_dependent_rows rows_transp det_transp)
+
+(* ------------------------------------------------------------------------- *)
+(* Multilinearity and the multiplication formula. *)
+(* ------------------------------------------------------------------------- *)
+
+lemma Cart_lambda_cong: "(\<And>x. f x = g x) \<Longrightarrow> (Cart_lambda f::'a^'n) = (Cart_lambda g :: 'a^'n)"
+ apply (rule iffD1[OF Cart_lambda_unique]) by vector
+
+lemma det_linear_row_setsum:
+ assumes fS: "finite S"
+ 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"
+proof(induct rule: finite_induct[OF fS])
+ case 1 thus ?case apply simp unfolding setsum_empty det_row_0[of k] ..
+next
+ case (2 x F)
+ then show ?case by (simp add: det_row_add cong del: if_weak_cong)
+qed
+
+lemma finite_bounded_functions:
+ assumes fS: "finite S"
+ shows "finite {f. (\<forall>i \<in> {1.. (k::nat)}. f i \<in> S) \<and> (\<forall>i. i \<notin> {1 .. k} \<longrightarrow> f i = i)}"
+proof(induct k)
+ case 0
+ have th: "{f. \<forall>i. f i = i} = {id}" by (auto intro: ext)
+ show ?case by (auto simp add: th)
+next
+ case (Suc k)
+ let ?f = "\<lambda>(y::nat,g) i. if i = Suc k then y else g i"
+ 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)})"
+ 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)}"
+ apply (auto simp add: image_iff)
+ apply (rule_tac x="x (Suc k)" in bexI)
+ apply (rule_tac x = "\<lambda>i. if i = Suc k then i else x i" in exI)
+ apply (auto intro: ext)
+ done
+ with finite_imageI[OF finite_cartesian_product[OF fS Suc.hyps(1)], of ?f]
+ show ?case by metis
+qed
+
+
+lemma eq_id_iff[simp]: "(\<forall>x. f x = x) = (f = id)" by (auto intro: ext)
+
+lemma det_linear_rows_setsum_lemma:
+ assumes fS: "finite S" and fT: "finite T"
+ shows "det((\<chi> i. if i \<in> T then setsum (a i) S else c i):: 'a::comm_ring_1^'n^'n::finite) =
+ setsum (\<lambda>f. det((\<chi> i. if i \<in> T then a i (f i) else c i)::'a^'n^'n))
+ {f. (\<forall>i \<in> T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = i)}"
+using fT
+proof(induct T arbitrary: a c set: finite)
+ case empty
+ have th0: "\<And>x y. (\<chi> i. if i \<in> {} then x i else y i) = (\<chi> i. y i)" by vector
+ from "empty.prems" show ?case unfolding th0 by simp
+next
+ case (insert z T a c)
+ let ?F = "\<lambda>T. {f. (\<forall>i \<in> T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = i)}"
+ let ?h = "\<lambda>(y,g) i. if i = z then y else g i"
+ let ?k = "\<lambda>h. (h(z),(\<lambda>i. if i = z then i else h i))"
+ 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)"
+ let ?c = "\<lambda>i. if i = z then a i j else c i"
+ 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
+ have thif2: "\<And>a b c d e. (if a then b else if c then d else e) =
+ (if c then (if a then b else d) else (if a then b else e))" by simp
+ from `z \<notin> T` have nz: "\<And>i. i \<in> T \<Longrightarrow> i = z \<longleftrightarrow> False" by auto
+ have "det (\<chi> i. if i \<in> insert z T then setsum (a i) S else c i) =
+ det (\<chi> i. if i = z then setsum (a i) S
+ else if i \<in> T then setsum (a i) S else c i)"
+ unfolding insert_iff thif ..
+ also have "\<dots> = (\<Sum>j\<in>S. det (\<chi> i. if i \<in> T then setsum (a i) S
+ else if i = z then a i j else c i))"
+ unfolding det_linear_row_setsum[OF fS]
+ apply (subst thif2)
+ using nz by (simp cong del: if_weak_cong cong add: if_cong)
+ finally have tha:
+ "det (\<chi> i. if i \<in> insert z T then setsum (a i) S else c i) =
+ (\<Sum>(j, f)\<in>S \<times> ?F T. det (\<chi> i. if i \<in> T then a i (f i)
+ else if i = z then a i j
+ else c i))"
+ unfolding insert.hyps unfolding setsum_cartesian_product by blast
+ show ?case unfolding tha
+ apply(rule setsum_eq_general_reverses[where h= "?h" and k= "?k"],
+ blast intro: finite_cartesian_product fS finite,
+ blast intro: finite_cartesian_product fS finite)
+ using `z \<notin> T`
+ apply (auto intro: ext)
+ apply (rule cong[OF refl[of det]])
+ by vector
+qed
+
+lemma det_linear_rows_setsum:
+ assumes fS: "finite (S::'n::finite set)"
+ 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}"
+proof-
+ 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
+
+ from det_linear_rows_setsum_lemma[OF fS, of "UNIV :: 'n set" a, unfolded th0, OF finite] show ?thesis by simp
+qed
+
+lemma matrix_mul_setsum_alt:
+ fixes A B :: "'a::comm_ring_1^'n^'n::finite"
+ shows "A ** B = (\<chi> i. setsum (\<lambda>k. A$i$k *s B $ k) (UNIV :: 'n set))"
+ by (vector matrix_matrix_mult_def setsum_component)
+
+lemma det_rows_mul:
+ "det((\<chi> i. c i *s a i)::'a::comm_ring_1^'n^'n::finite) =
+ setprod (\<lambda>i. c i) (UNIV:: 'n set) * det((\<chi> i. a i)::'a^'n^'n)"
+proof (simp add: det_def setsum_right_distrib cong add: setprod_cong, rule setsum_cong2)
+ let ?U = "UNIV :: 'n set"
+ let ?PU = "{p. p permutes ?U}"
+ fix p assume pU: "p \<in> ?PU"
+ let ?s = "of_int (sign p)"
+ from pU have p: "p permutes ?U" by blast
+ have "setprod (\<lambda>i. c i * a i $ p i) ?U = setprod c ?U * setprod (\<lambda>i. a i $ p i) ?U"
+ unfolding setprod_timesf ..
+ then show "?s * (\<Prod>xa\<in>?U. c xa * a xa $ p xa) =
+ setprod c ?U * (?s* (\<Prod>xa\<in>?U. a xa $ p xa))" by (simp add: ring_simps)
+qed
+
+lemma det_mul:
+ fixes A B :: "'a::ordered_idom^'n^'n::finite"
+ shows "det (A ** B) = det A * det B"
+proof-
+ let ?U = "UNIV :: 'n set"
+ let ?F = "{f. (\<forall>i\<in> ?U. f i \<in> ?U) \<and> (\<forall>i. i \<notin> ?U \<longrightarrow> f i = i)}"
+ let ?PU = "{p. p permutes ?U}"
+ have fU: "finite ?U" by simp
+ have fF: "finite ?F" by (rule finite)
+ {fix p assume p: "p permutes ?U"
+
+ have "p \<in> ?F" unfolding mem_Collect_eq permutes_in_image[OF p]
+ using p[unfolded permutes_def] by simp}
+ then have PUF: "?PU \<subseteq> ?F" by blast
+ {fix f assume fPU: "f \<in> ?F - ?PU"
+ have fUU: "f ` ?U \<subseteq> ?U" using fPU by auto
+ from fPU have f: "\<forall>i \<in> ?U. f i \<in> ?U"
+ "\<forall>i. i \<notin> ?U \<longrightarrow> f i = i" "\<not>(\<forall>y. \<exists>!x. f x = y)" unfolding permutes_def
+ by auto
+
+ let ?A = "(\<chi> i. A$i$f i *s B$f i) :: 'a^'n^'n"
+ let ?B = "(\<chi> i. B$f i) :: 'a^'n^'n"
+ {assume fni: "\<not> inj_on f ?U"
+ then obtain i j where ij: "f i = f j" "i \<noteq> j"
+ unfolding inj_on_def by blast
+ from ij
+ have rth: "row i ?B = row j ?B" by (vector row_def)
+ from det_identical_rows[OF ij(2) rth]
+ have "det (\<chi> i. A$i$f i *s B$f i) = 0"
+ unfolding det_rows_mul by simp}
+ moreover
+ {assume fi: "inj_on f ?U"
+ from f fi have fith: "\<And>i j. f i = f j \<Longrightarrow> i = j"
+ unfolding inj_on_def by metis
+ note fs = fi[unfolded surjective_iff_injective_gen[OF fU fU refl fUU, symmetric]]
+
+ {fix y
+ from fs f have "\<exists>x. f x = y" by blast
+ then obtain x where x: "f x = y" by blast
+ {fix z assume z: "f z = y" from fith x z have "z = x" by metis}
+ with x have "\<exists>!x. f x = y" by blast}
+ with f(3) have "det (\<chi> i. A$i$f i *s B$f i) = 0" by blast}
+ ultimately have "det (\<chi> i. A$i$f i *s B$f i) = 0" by blast}
+ hence zth: "\<forall> f\<in> ?F - ?PU. det (\<chi> i. A$i$f i *s B$f i) = 0" by simp
+ {fix p assume pU: "p \<in> ?PU"
+ from pU have p: "p permutes ?U" by blast
+ let ?s = "\<lambda>p. of_int (sign p)"
+ let ?f = "\<lambda>q. ?s p * (\<Prod>i\<in> ?U. A $ i $ p i) *
+ (?s q * (\<Prod>i\<in> ?U. B $ i $ q i))"
+ have "(setsum (\<lambda>q. ?s q *
+ (\<Prod>i\<in> ?U. (\<chi> i. A $ i $ p i *s B $ p i :: 'a^'n^'n) $ i $ q i)) ?PU) =
+ (setsum (\<lambda>q. ?s p * (\<Prod>i\<in> ?U. A $ i $ p i) *
+ (?s q * (\<Prod>i\<in> ?U. B $ i $ q i))) ?PU)"
+ unfolding sum_permutations_compose_right[OF permutes_inv[OF p], of ?f]
+ proof(rule setsum_cong2)
+ fix q assume qU: "q \<in> ?PU"
+ hence q: "q permutes ?U" by blast
+ from p q have pp: "permutation p" and pq: "permutation q"
+ unfolding permutation_permutes by auto
+ have th00: "of_int (sign p) * of_int (sign p) = (1::'a)"
+ "\<And>a. of_int (sign p) * (of_int (sign p) * a) = a"
+ unfolding mult_assoc[symmetric] unfolding of_int_mult[symmetric]
+ by (simp_all add: sign_idempotent)
+ have ths: "?s q = ?s p * ?s (q o inv p)"
+ using pp pq permutation_inverse[OF pp] sign_inverse[OF pp]
+ by (simp add: th00 mult_ac sign_idempotent sign_compose)
+ have th001: "setprod (\<lambda>i. B$i$ q (inv p i)) ?U = setprod ((\<lambda>i. B$i$ q (inv p i)) o p) ?U"
+ by (rule setprod_permute[OF p])
+ 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"
+ unfolding th001 setprod_timesf[symmetric] o_def permutes_inverses[OF p]
+ apply (rule setprod_cong[OF refl])
+ using permutes_in_image[OF q] by vector
+ 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)"
+ using ths thp pp pq permutation_inverse[OF pp] sign_inverse[OF pp]
+ by (simp add: sign_nz th00 ring_simps sign_idempotent sign_compose)
+ qed
+ }
+ then have th2: "setsum (\<lambda>f. det (\<chi> i. A$i$f i *s B$f i)) ?PU = det A * det B"
+ unfolding det_def setsum_product
+ by (rule setsum_cong2)
+ have "det (A**B) = setsum (\<lambda>f. det (\<chi> i. A $ i $ f i *s B $ f i)) ?F"
+ unfolding matrix_mul_setsum_alt det_linear_rows_setsum[OF fU] by simp
+ also have "\<dots> = setsum (\<lambda>f. det (\<chi> i. A$i$f i *s B$f i)) ?PU"
+ using setsum_mono_zero_cong_left[OF fF PUF zth, symmetric]
+ unfolding det_rows_mul by auto
+ finally show ?thesis unfolding th2 .
+qed
+
+(* ------------------------------------------------------------------------- *)
+(* Relation to invertibility. *)
+(* ------------------------------------------------------------------------- *)
+
+lemma invertible_left_inverse:
+ fixes A :: "real^'n^'n::finite"
+ shows "invertible A \<longleftrightarrow> (\<exists>(B::real^'n^'n). B** A = mat 1)"
+ by (metis invertible_def matrix_left_right_inverse)
+
+lemma invertible_righ_inverse:
+ fixes A :: "real^'n^'n::finite"
+ shows "invertible A \<longleftrightarrow> (\<exists>(B::real^'n^'n). A** B = mat 1)"
+ by (metis invertible_def matrix_left_right_inverse)
+
+lemma invertible_det_nz:
+ fixes A::"real ^'n^'n::finite"
+ shows "invertible A \<longleftrightarrow> det A \<noteq> 0"
+proof-
+ {assume "invertible A"
+ then obtain B :: "real ^'n^'n" where B: "A ** B = mat 1"
+ unfolding invertible_righ_inverse by blast
+ hence "det (A ** B) = det (mat 1 :: real ^'n^'n)" by simp
+ hence "det A \<noteq> 0"
+ apply (simp add: det_mul det_I) by algebra }
+ moreover
+ {assume H: "\<not> invertible A"
+ let ?U = "UNIV :: 'n set"
+ have fU: "finite ?U" by simp
+ from H obtain c i where c: "setsum (\<lambda>i. c i *s row i A) ?U = 0"
+ and iU: "i \<in> ?U" and ci: "c i \<noteq> 0"
+ unfolding invertible_righ_inverse
+ unfolding matrix_right_invertible_independent_rows by blast
+ have stupid: "\<And>(a::real^'n) b. a + b = 0 \<Longrightarrow> -a = b"
+ apply (drule_tac f="op + (- a)" in cong[OF refl])
+ apply (simp only: ab_left_minus add_assoc[symmetric])
+ apply simp
+ done
+ from c ci
+ have thr0: "- row i A = setsum (\<lambda>j. (1/ c i) *s (c j *s row j A)) (?U - {i})"
+ unfolding setsum_diff1'[OF fU iU] setsum_cmul
+ apply -
+ apply (rule vector_mul_lcancel_imp[OF ci])
+ apply (auto simp add: vector_smult_assoc vector_smult_rneg field_simps)
+ unfolding stupid ..
+ have thr: "- row i A \<in> span {row j A| j. j \<noteq> i}"
+ unfolding thr0
+ apply (rule span_setsum)
+ apply simp
+ apply (rule ballI)
+ apply (rule span_mul)+
+ apply (rule span_superset)
+ apply auto
+ done
+ let ?B = "(\<chi> k. if k = i then 0 else row k A) :: real ^'n^'n"
+ have thrb: "row i ?B = 0" using iU by (vector row_def)
+ have "det A = 0"
+ unfolding det_row_span[OF thr, symmetric] right_minus
+ unfolding det_zero_row[OF thrb] ..}
+ ultimately show ?thesis by blast
+qed
+
+(* ------------------------------------------------------------------------- *)
+(* Cramer's rule. *)
+(* ------------------------------------------------------------------------- *)
+
+lemma cramer_lemma_transp:
+ fixes A:: "'a::ordered_idom^'n^'n::finite" and x :: "'a ^'n::finite"
+ shows "det ((\<chi> i. if i = k then setsum (\<lambda>i. x$i *s row i A) (UNIV::'n set)
+ else row i A)::'a^'n^'n) = x$k * det A"
+ (is "?lhs = ?rhs")
+proof-
+ let ?U = "UNIV :: 'n set"
+ let ?Uk = "?U - {k}"
+ have U: "?U = insert k ?Uk" by blast
+ have fUk: "finite ?Uk" by simp
+ have kUk: "k \<notin> ?Uk" by simp
+ have th00: "\<And>k s. x$k *s row k A + s = (x$k - 1) *s row k A + row k A + s"
+ by (vector ring_simps)
+ have th001: "\<And>f k . (\<lambda>x. if x = k then f k else f x) = f" by (auto intro: ext)
+ have "(\<chi> i. row i A) = A" by (vector row_def)
+ then have thd1: "det (\<chi> i. row i A) = det A" by simp
+ 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"
+ apply (rule det_row_span)
+ apply (rule span_setsum[OF fUk])
+ apply (rule ballI)
+ apply (rule span_mul)
+ apply (rule span_superset)
+ apply auto
+ done
+ show "?lhs = x$k * det A"
+ apply (subst U)
+ unfolding setsum_insert[OF fUk kUk]
+ apply (subst th00)
+ unfolding add_assoc
+ apply (subst det_row_add)
+ unfolding thd0
+ unfolding det_row_mul
+ unfolding th001[of k "\<lambda>i. row i A"]
+ unfolding thd1 by (simp add: ring_simps)
+qed
+
+lemma cramer_lemma:
+ fixes A :: "'a::ordered_idom ^'n^'n::finite"
+ shows "det((\<chi> i j. if j = k then (A *v x)$i else A$i$j):: 'a^'n^'n) = x$k * det A"
+proof-
+ let ?U = "UNIV :: 'n set"
+ 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"
+ by (auto simp add: row_transp intro: setsum_cong2)
+ show ?thesis unfolding matrix_mult_vsum
+ unfolding cramer_lemma_transp[of k x "transp A", unfolded det_transp, symmetric]
+ unfolding stupid[of "\<lambda>i. x$i"]
+ apply (subst det_transp[symmetric])
+ apply (rule cong[OF refl[of det]]) by (vector transp_def column_def row_def)
+qed
+
+lemma cramer:
+ fixes A ::"real^'n^'n::finite"
+ assumes d0: "det A \<noteq> 0"
+ 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)"
+proof-
+ from d0 obtain B where B: "A ** B = mat 1" "B ** A = mat 1"
+ unfolding invertible_det_nz[symmetric] invertible_def by blast
+ have "(A ** B) *v b = b" by (simp add: B matrix_vector_mul_lid)
+ hence "A *v (B *v b) = b" by (simp add: matrix_vector_mul_assoc)
+ then have xe: "\<exists>x. A*v x = b" by blast
+ {fix x assume x: "A *v x = b"
+ have "x = (\<chi> k. det(\<chi> i j. if j=k then b$i else A$i$j :: real^'n^'n) / det A)"
+ unfolding x[symmetric]
+ using d0 by (simp add: Cart_eq cramer_lemma field_simps)}
+ with xe show ?thesis by auto
+qed
+
+(* ------------------------------------------------------------------------- *)
+(* Orthogonality of a transformation and matrix. *)
+(* ------------------------------------------------------------------------- *)
+
+definition "orthogonal_transformation f \<longleftrightarrow> linear f \<and> (\<forall>v w. f v \<bullet> f w = v \<bullet> w)"
+
+lemma orthogonal_transformation: "orthogonal_transformation f \<longleftrightarrow> linear f \<and> (\<forall>(v::real ^_). norm (f v) = norm v)"
+ unfolding orthogonal_transformation_def
+ apply auto
+ apply (erule_tac x=v in allE)+
+ apply (simp add: real_vector_norm_def)
+ by (simp add: dot_norm linear_add[symmetric])
+
+definition "orthogonal_matrix (Q::'a::semiring_1^'n^'n) \<longleftrightarrow> transp Q ** Q = mat 1 \<and> Q ** transp Q = mat 1"
+
+lemma orthogonal_matrix: "orthogonal_matrix (Q:: real ^'n^'n::finite) \<longleftrightarrow> transp Q ** Q = mat 1"
+ by (metis matrix_left_right_inverse orthogonal_matrix_def)
+
+lemma orthogonal_matrix_id: "orthogonal_matrix (mat 1 :: _^'n^'n::finite)"
+ by (simp add: orthogonal_matrix_def transp_mat matrix_mul_lid)
+
+lemma orthogonal_matrix_mul:
+ fixes A :: "real ^'n^'n::finite"
+ assumes oA : "orthogonal_matrix A"
+ and oB: "orthogonal_matrix B"
+ shows "orthogonal_matrix(A ** B)"
+ using oA oB
+ unfolding orthogonal_matrix matrix_transp_mul
+ apply (subst matrix_mul_assoc)
+ apply (subst matrix_mul_assoc[symmetric])
+ by (simp add: matrix_mul_rid)
+
+lemma orthogonal_transformation_matrix:
+ fixes f:: "real^'n \<Rightarrow> real^'n::finite"
+ shows "orthogonal_transformation f \<longleftrightarrow> linear f \<and> orthogonal_matrix(matrix f)"
+ (is "?lhs \<longleftrightarrow> ?rhs")
+proof-
+ let ?mf = "matrix f"
+ let ?ot = "orthogonal_transformation f"
+ let ?U = "UNIV :: 'n set"
+ have fU: "finite ?U" by simp
+ let ?m1 = "mat 1 :: real ^'n^'n"
+ {assume ot: ?ot
+ from ot have lf: "linear f" and fd: "\<forall>v w. f v \<bullet> f w = v \<bullet> w"
+ unfolding orthogonal_transformation_def orthogonal_matrix by blast+
+ {fix i j
+ let ?A = "transp ?mf ** ?mf"
+ have th0: "\<And>b (x::'a::comm_ring_1). (if b then 1 else 0)*x = (if b then x else 0)"
+ "\<And>b (x::'a::comm_ring_1). x*(if b then 1 else 0) = (if b then x else 0)"
+ by simp_all
+ from fd[rule_format, of "basis i" "basis j", unfolded matrix_works[OF lf, symmetric] dot_matrix_vector_mul]
+ have "?A$i$j = ?m1 $ i $ j"
+ by (simp add: dot_def matrix_matrix_mult_def columnvector_def rowvector_def basis_def th0 setsum_delta[OF fU] mat_def)}
+ hence "orthogonal_matrix ?mf" unfolding orthogonal_matrix by vector
+ with lf have ?rhs by blast}
+ moreover
+ {assume lf: "linear f" and om: "orthogonal_matrix ?mf"
+ from lf om have ?lhs
+ unfolding orthogonal_matrix_def norm_eq orthogonal_transformation
+ unfolding matrix_works[OF lf, symmetric]
+ apply (subst dot_matrix_vector_mul)
+ by (simp add: dot_matrix_product matrix_mul_lid)}
+ ultimately show ?thesis by blast
+qed
+
+lemma det_orthogonal_matrix:
+ fixes Q:: "'a::ordered_idom^'n^'n::finite"
+ assumes oQ: "orthogonal_matrix Q"
+ shows "det Q = 1 \<or> det Q = - 1"
+proof-
+
+ have th: "\<And>x::'a. x = 1 \<or> x = - 1 \<longleftrightarrow> x*x = 1" (is "\<And>x::'a. ?ths x")
+ proof-
+ fix x:: 'a
+ have th0: "x*x - 1 = (x - 1)*(x + 1)" by (simp add: ring_simps)
+ have th1: "\<And>(x::'a) y. x = - y \<longleftrightarrow> x + y = 0"
+ apply (subst eq_iff_diff_eq_0) by simp
+ have "x*x = 1 \<longleftrightarrow> x*x - 1 = 0" by simp
+ also have "\<dots> \<longleftrightarrow> x = 1 \<or> x = - 1" unfolding th0 th1 by simp
+ finally show "?ths x" ..
+ qed
+ from oQ have "Q ** transp Q = mat 1" by (metis orthogonal_matrix_def)
+ hence "det (Q ** transp Q) = det (mat 1:: 'a^'n^'n)" by simp
+ hence "det Q * det Q = 1" by (simp add: det_mul det_I det_transp)
+ then show ?thesis unfolding th .
+qed
+
+(* ------------------------------------------------------------------------- *)
+(* Linearity of scaling, and hence isometry, that preserves origin. *)
+(* ------------------------------------------------------------------------- *)
+lemma scaling_linear:
+ fixes f :: "real ^'n \<Rightarrow> real ^'n::finite"
+ assumes f0: "f 0 = 0" and fd: "\<forall>x y. dist (f x) (f y) = c * dist x y"
+ shows "linear f"
+proof-
+ {fix v w
+ {fix x note fd[rule_format, of x 0, unfolded dist_norm f0 diff_0_right] }
+ note th0 = this
+ have "f v \<bullet> f w = c^2 * (v \<bullet> w)"
+ unfolding dot_norm_neg dist_norm[symmetric]
+ unfolding th0 fd[rule_format] by (simp add: power2_eq_square field_simps)}
+ note fc = this
+ show ?thesis unfolding linear_def vector_eq
+ by (simp add: dot_lmult dot_ladd dot_rmult dot_radd fc ring_simps)
+qed
+
+lemma isometry_linear:
+ "f (0:: real^'n) = (0:: real^'n::finite) \<Longrightarrow> \<forall>x y. dist(f x) (f y) = dist x y
+ \<Longrightarrow> linear f"
+by (rule scaling_linear[where c=1]) simp_all
+
+(* ------------------------------------------------------------------------- *)
+(* Hence another formulation of orthogonal transformation. *)
+(* ------------------------------------------------------------------------- *)
+
+lemma orthogonal_transformation_isometry:
+ "orthogonal_transformation f \<longleftrightarrow> f(0::real^'n) = (0::real^'n::finite) \<and> (\<forall>x y. dist(f x) (f y) = dist x y)"
+ unfolding orthogonal_transformation
+ apply (rule iffI)
+ apply clarify
+ apply (clarsimp simp add: linear_0 linear_sub[symmetric] dist_norm)
+ apply (rule conjI)
+ apply (rule isometry_linear)
+ apply simp
+ apply simp
+ apply clarify
+ apply (erule_tac x=v in allE)
+ apply (erule_tac x=0 in allE)
+ by (simp add: dist_norm)
+
+(* ------------------------------------------------------------------------- *)
+(* Can extend an isometry from unit sphere. *)
+(* ------------------------------------------------------------------------- *)
+
+lemma isometry_sphere_extend:
+ fixes f:: "real ^'n \<Rightarrow> real ^'n::finite"
+ assumes f1: "\<forall>x. norm x = 1 \<longrightarrow> norm (f x) = 1"
+ and fd1: "\<forall> x y. norm x = 1 \<longrightarrow> norm y = 1 \<longrightarrow> dist (f x) (f y) = dist x y"
+ shows "\<exists>g. orthogonal_transformation g \<and> (\<forall>x. norm x = 1 \<longrightarrow> g x = f x)"
+proof-
+ {fix x y x' y' x0 y0 x0' y0' :: "real ^'n"
+ assume H: "x = norm x *s x0" "y = norm y *s y0"
+ "x' = norm x *s x0'" "y' = norm y *s y0'"
+ "norm x0 = 1" "norm x0' = 1" "norm y0 = 1" "norm y0' = 1"
+ "norm(x0' - y0') = norm(x0 - y0)"
+
+ have "norm(x' - y') = norm(x - y)"
+ apply (subst H(1))
+ apply (subst H(2))
+ apply (subst H(3))
+ apply (subst H(4))
+ using H(5-9)
+ apply (simp add: norm_eq norm_eq_1)
+ apply (simp add: dot_lsub dot_rsub dot_lmult dot_rmult)
+ apply (simp add: ring_simps)
+ by (simp only: right_distrib[symmetric])}
+ note th0 = this
+ let ?g = "\<lambda>x. if x = 0 then 0 else norm x *s f (inverse (norm x) *s x)"
+ {fix x:: "real ^'n" assume nx: "norm x = 1"
+ have "?g x = f x" using nx by auto}
+ hence thfg: "\<forall>x. norm x = 1 \<longrightarrow> ?g x = f x" by blast
+ have g0: "?g 0 = 0" by simp
+ {fix x y :: "real ^'n"
+ {assume "x = 0" "y = 0"
+ then have "dist (?g x) (?g y) = dist x y" by simp }
+ moreover
+ {assume "x = 0" "y \<noteq> 0"
+ then have "dist (?g x) (?g y) = dist x y"
+ apply (simp add: dist_norm norm_mul)
+ apply (rule f1[rule_format])
+ by(simp add: norm_mul field_simps)}
+ moreover
+ {assume "x \<noteq> 0" "y = 0"
+ then have "dist (?g x) (?g y) = dist x y"
+ apply (simp add: dist_norm norm_mul)
+ apply (rule f1[rule_format])
+ by(simp add: norm_mul field_simps)}
+ moreover
+ {assume z: "x \<noteq> 0" "y \<noteq> 0"
+ 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)"
+ "norm y *s f (inverse (norm y) *s y) = norm y *s f (inverse (norm y) *s y)"
+ "norm (inverse (norm x) *s x) = 1"
+ "norm (f (inverse (norm x) *s x)) = 1"
+ "norm (inverse (norm y) *s y) = 1"
+ "norm (f (inverse (norm y) *s y)) = 1"
+ "norm (f (inverse (norm x) *s x) - f (inverse (norm y) *s y)) =
+ norm (inverse (norm x) *s x - inverse (norm y) *s y)"
+ using z
+ by (auto simp add: vector_smult_assoc field_simps norm_mul intro: f1[rule_format] fd1[rule_format, unfolded dist_norm])
+ from z th0[OF th00] have "dist (?g x) (?g y) = dist x y"
+ by (simp add: dist_norm)}
+ ultimately have "dist (?g x) (?g y) = dist x y" by blast}
+ note thd = this
+ show ?thesis
+ apply (rule exI[where x= ?g])
+ unfolding orthogonal_transformation_isometry
+ using g0 thfg thd by metis
+qed
+
+(* ------------------------------------------------------------------------- *)
+(* Rotation, reflection, rotoinversion. *)
+(* ------------------------------------------------------------------------- *)
+
+definition "rotation_matrix Q \<longleftrightarrow> orthogonal_matrix Q \<and> det Q = 1"
+definition "rotoinversion_matrix Q \<longleftrightarrow> orthogonal_matrix Q \<and> det Q = - 1"
+
+lemma orthogonal_rotation_or_rotoinversion:
+ fixes Q :: "'a::ordered_idom^'n^'n::finite"
+ shows " orthogonal_matrix Q \<longleftrightarrow> rotation_matrix Q \<or> rotoinversion_matrix Q"
+ by (metis rotoinversion_matrix_def rotation_matrix_def det_orthogonal_matrix)
+(* ------------------------------------------------------------------------- *)
+(* Explicit formulas for low dimensions. *)
+(* ------------------------------------------------------------------------- *)
+
+lemma setprod_1: "setprod f {(1::nat)..1} = f 1" by simp
+
+lemma setprod_2: "setprod f {(1::nat)..2} = f 1 * f 2"
+ by (simp add: nat_number setprod_numseg mult_commute)
+lemma setprod_3: "setprod f {(1::nat)..3} = f 1 * f 2 * f 3"
+ by (simp add: nat_number setprod_numseg mult_commute)
+
+lemma det_1: "det (A::'a::comm_ring_1^1^1) = A$1$1"
+ by (simp add: det_def permutes_sing sign_id UNIV_1)
+
+lemma det_2: "det (A::'a::comm_ring_1^2^2) = A$1$1 * A$2$2 - A$1$2 * A$2$1"
+proof-
+ have f12: "finite {2::2}" "1 \<notin> {2::2}" by auto
+ show ?thesis
+ unfolding det_def UNIV_2
+ unfolding setsum_over_permutations_insert[OF f12]
+ unfolding permutes_sing
+ apply (simp add: sign_swap_id sign_id swap_id_eq)
+ by (simp add: arith_simps(31)[symmetric] of_int_minus of_int_1 del: arith_simps(31))
+qed
+
+lemma det_3: "det (A::'a::comm_ring_1^3^3) =
+ A$1$1 * A$2$2 * A$3$3 +
+ A$1$2 * A$2$3 * A$3$1 +
+ A$1$3 * A$2$1 * A$3$2 -
+ A$1$1 * A$2$3 * A$3$2 -
+ A$1$2 * A$2$1 * A$3$3 -
+ A$1$3 * A$2$2 * A$3$1"
+proof-
+ have f123: "finite {2::3, 3}" "1 \<notin> {2::3, 3}" by auto
+ have f23: "finite {3::3}" "2 \<notin> {3::3}" by auto
+
+ show ?thesis
+ unfolding det_def UNIV_3
+ unfolding setsum_over_permutations_insert[OF f123]
+ unfolding setsum_over_permutations_insert[OF f23]
+
+ unfolding permutes_sing
+ apply (simp add: sign_swap_id permutation_swap_id sign_compose sign_id swap_id_eq)
+ apply (simp add: arith_simps(31)[symmetric] of_int_minus of_int_1 del: arith_simps(31))
+ by (simp add: ring_simps)
+qed
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Multivariate_Analysis/Euclidean_Space.thy Fri Oct 23 13:23:18 2009 +0200
@@ -0,0 +1,5372 @@
+(* Title: Library/Euclidean_Space
+ Author: Amine Chaieb, University of Cambridge
+*)
+
+header {* (Real) Vectors in Euclidean space, and elementary linear algebra.*}
+
+theory Euclidean_Space
+imports
+ Complex_Main "~~/src/HOL/Decision_Procs/Dense_Linear_Order"
+ Finite_Cartesian_Product Glbs Infinite_Set Numeral_Type
+ Inner_Product
+uses "positivstellensatz.ML" ("normarith.ML")
+begin
+
+text{* Some common special cases.*}
+
+lemma forall_1: "(\<forall>i::1. P i) \<longleftrightarrow> P 1"
+ by (metis num1_eq_iff)
+
+lemma exhaust_2:
+ fixes x :: 2 shows "x = 1 \<or> x = 2"
+proof (induct x)
+ case (of_int z)
+ then have "0 <= z" and "z < 2" by simp_all
+ then have "z = 0 | z = 1" by arith
+ then show ?case by auto
+qed
+
+lemma forall_2: "(\<forall>i::2. P i) \<longleftrightarrow> P 1 \<and> P 2"
+ by (metis exhaust_2)
+
+lemma exhaust_3:
+ fixes x :: 3 shows "x = 1 \<or> x = 2 \<or> x = 3"
+proof (induct x)
+ case (of_int z)
+ then have "0 <= z" and "z < 3" by simp_all
+ then have "z = 0 \<or> z = 1 \<or> z = 2" by arith
+ then show ?case by auto
+qed
+
+lemma forall_3: "(\<forall>i::3. P i) \<longleftrightarrow> P 1 \<and> P 2 \<and> P 3"
+ by (metis exhaust_3)
+
+lemma UNIV_1: "UNIV = {1::1}"
+ by (auto simp add: num1_eq_iff)
+
+lemma UNIV_2: "UNIV = {1::2, 2::2}"
+ using exhaust_2 by auto
+
+lemma UNIV_3: "UNIV = {1::3, 2::3, 3::3}"
+ using exhaust_3 by auto
+
+lemma setsum_1: "setsum f (UNIV::1 set) = f 1"
+ unfolding UNIV_1 by simp
+
+lemma setsum_2: "setsum f (UNIV::2 set) = f 1 + f 2"
+ unfolding UNIV_2 by simp
+
+lemma setsum_3: "setsum f (UNIV::3 set) = f 1 + f 2 + f 3"
+ unfolding UNIV_3 by (simp add: add_ac)
+
+subsection{* Basic componentwise operations on vectors. *}
+
+instantiation "^" :: (plus,type) plus
+begin
+definition vector_add_def : "op + \<equiv> (\<lambda> x y. (\<chi> i. (x$i) + (y$i)))"
+instance ..
+end
+
+instantiation "^" :: (times,type) times
+begin
+ definition vector_mult_def : "op * \<equiv> (\<lambda> x y. (\<chi> i. (x$i) * (y$i)))"
+ instance ..
+end
+
+instantiation "^" :: (minus,type) minus begin
+ definition vector_minus_def : "op - \<equiv> (\<lambda> x y. (\<chi> i. (x$i) - (y$i)))"
+instance ..
+end
+
+instantiation "^" :: (uminus,type) uminus begin
+ definition vector_uminus_def : "uminus \<equiv> (\<lambda> x. (\<chi> i. - (x$i)))"
+instance ..
+end
+instantiation "^" :: (zero,type) zero begin
+ definition vector_zero_def : "0 \<equiv> (\<chi> i. 0)"
+instance ..
+end
+
+instantiation "^" :: (one,type) one begin
+ definition vector_one_def : "1 \<equiv> (\<chi> i. 1)"
+instance ..
+end
+
+instantiation "^" :: (ord,type) ord
+ begin
+definition vector_less_eq_def:
+ "less_eq (x :: 'a ^'b) y = (ALL i. x$i <= y$i)"
+definition vector_less_def: "less (x :: 'a ^'b) y = (ALL i. x$i < y$i)"
+
+instance by (intro_classes)
+end
+
+instantiation "^" :: (scaleR, type) scaleR
+begin
+definition vector_scaleR_def: "scaleR = (\<lambda> r x. (\<chi> i. scaleR r (x$i)))"
+instance ..
+end
+
+text{* Also the scalar-vector multiplication. *}
+
+definition vector_scalar_mult:: "'a::times \<Rightarrow> 'a ^'n \<Rightarrow> 'a ^ 'n" (infixl "*s" 70)
+ where "c *s x = (\<chi> i. c * (x$i))"
+
+text{* Constant Vectors *}
+
+definition "vec x = (\<chi> i. x)"
+
+text{* Dot products. *}
+
+definition dot :: "'a::{comm_monoid_add, times} ^ 'n \<Rightarrow> 'a ^ 'n \<Rightarrow> 'a" (infix "\<bullet>" 70) where
+ "x \<bullet> y = setsum (\<lambda>i. x$i * y$i) UNIV"
+
+lemma dot_1[simp]: "(x::'a::{comm_monoid_add, times}^1) \<bullet> y = (x$1) * (y$1)"
+ by (simp add: dot_def setsum_1)
+
+lemma dot_2[simp]: "(x::'a::{comm_monoid_add, times}^2) \<bullet> y = (x$1) * (y$1) + (x$2) * (y$2)"
+ by (simp add: dot_def setsum_2)
+
+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)"
+ by (simp add: dot_def setsum_3)
+
+subsection {* A naive proof procedure to lift really trivial arithmetic stuff from the basis of the vector space. *}
+
+method_setup vector = {*
+let
+ val ss1 = HOL_basic_ss addsimps [@{thm dot_def}, @{thm setsum_addf} RS sym,
+ @{thm setsum_subtractf} RS sym, @{thm setsum_right_distrib},
+ @{thm setsum_left_distrib}, @{thm setsum_negf} RS sym]
+ val ss2 = @{simpset} addsimps
+ [@{thm vector_add_def}, @{thm vector_mult_def},
+ @{thm vector_minus_def}, @{thm vector_uminus_def},
+ @{thm vector_one_def}, @{thm vector_zero_def}, @{thm vec_def},
+ @{thm vector_scaleR_def},
+ @{thm Cart_lambda_beta}, @{thm vector_scalar_mult_def}]
+ fun vector_arith_tac ths =
+ simp_tac ss1
+ THEN' (fn i => rtac @{thm setsum_cong2} i
+ ORELSE rtac @{thm setsum_0'} i
+ ORELSE simp_tac (HOL_basic_ss addsimps [@{thm "Cart_eq"}]) i)
+ (* THEN' TRY o clarify_tac HOL_cs THEN' (TRY o rtac @{thm iffI}) *)
+ THEN' asm_full_simp_tac (ss2 addsimps ths)
+ in
+ Attrib.thms >> (fn ths => K (SIMPLE_METHOD' (vector_arith_tac ths)))
+ end
+*} "Lifts trivial vector statements to real arith statements"
+
+lemma vec_0[simp]: "vec 0 = 0" by (vector vector_zero_def)
+lemma vec_1[simp]: "vec 1 = 1" by (vector vector_one_def)
+
+
+
+text{* Obvious "component-pushing". *}
+
+lemma vec_component [simp]: "(vec x :: 'a ^ 'n)$i = x"
+ by (vector vec_def)
+
+lemma vector_add_component [simp]:
+ fixes x y :: "'a::{plus} ^ 'n"
+ shows "(x + y)$i = x$i + y$i"
+ by vector
+
+lemma vector_minus_component [simp]:
+ fixes x y :: "'a::{minus} ^ 'n"
+ shows "(x - y)$i = x$i - y$i"
+ by vector
+
+lemma vector_mult_component [simp]:
+ fixes x y :: "'a::{times} ^ 'n"
+ shows "(x * y)$i = x$i * y$i"
+ by vector
+
+lemma vector_smult_component [simp]:
+ fixes y :: "'a::{times} ^ 'n"
+ shows "(c *s y)$i = c * (y$i)"
+ by vector
+
+lemma vector_uminus_component [simp]:
+ fixes x :: "'a::{uminus} ^ 'n"
+ shows "(- x)$i = - (x$i)"
+ by vector
+
+lemma vector_scaleR_component [simp]:
+ fixes x :: "'a::scaleR ^ 'n"
+ shows "(scaleR r x)$i = scaleR r (x$i)"
+ by vector
+
+lemma cond_component: "(if b then x else y)$i = (if b then x$i else y$i)" by vector
+
+lemmas vector_component =
+ vec_component vector_add_component vector_mult_component
+ vector_smult_component vector_minus_component vector_uminus_component
+ vector_scaleR_component cond_component
+
+subsection {* Some frequently useful arithmetic lemmas over vectors. *}
+
+instance "^" :: (semigroup_add,type) semigroup_add
+ apply (intro_classes) by (vector add_assoc)
+
+
+instance "^" :: (monoid_add,type) monoid_add
+ apply (intro_classes) by vector+
+
+instance "^" :: (group_add,type) group_add
+ apply (intro_classes) by (vector algebra_simps)+
+
+instance "^" :: (ab_semigroup_add,type) ab_semigroup_add
+ apply (intro_classes) by (vector add_commute)
+
+instance "^" :: (comm_monoid_add,type) comm_monoid_add
+ apply (intro_classes) by vector
+
+instance "^" :: (ab_group_add,type) ab_group_add
+ apply (intro_classes) by vector+
+
+instance "^" :: (cancel_semigroup_add,type) cancel_semigroup_add
+ apply (intro_classes)
+ by (vector Cart_eq)+
+
+instance "^" :: (cancel_ab_semigroup_add,type) cancel_ab_semigroup_add
+ apply (intro_classes)
+ by (vector Cart_eq)
+
+instance "^" :: (real_vector, type) real_vector
+ by default (vector scaleR_left_distrib scaleR_right_distrib)+
+
+instance "^" :: (semigroup_mult,type) semigroup_mult
+ apply (intro_classes) by (vector mult_assoc)
+
+instance "^" :: (monoid_mult,type) monoid_mult
+ apply (intro_classes) by vector+
+
+instance "^" :: (ab_semigroup_mult,type) ab_semigroup_mult
+ apply (intro_classes) by (vector mult_commute)
+
+instance "^" :: (ab_semigroup_idem_mult,type) ab_semigroup_idem_mult
+ apply (intro_classes) by (vector mult_idem)
+
+instance "^" :: (comm_monoid_mult,type) comm_monoid_mult
+ apply (intro_classes) by vector
+
+fun vector_power :: "('a::{one,times} ^'n) \<Rightarrow> nat \<Rightarrow> 'a^'n" where
+ "vector_power x 0 = 1"
+ | "vector_power x (Suc n) = x * vector_power x n"
+
+instance "^" :: (semiring,type) semiring
+ apply (intro_classes) by (vector ring_simps)+
+
+instance "^" :: (semiring_0,type) semiring_0
+ apply (intro_classes) by (vector ring_simps)+
+instance "^" :: (semiring_1,type) semiring_1
+ apply (intro_classes) by vector
+instance "^" :: (comm_semiring,type) comm_semiring
+ apply (intro_classes) by (vector ring_simps)+
+
+instance "^" :: (comm_semiring_0,type) comm_semiring_0 by (intro_classes)
+instance "^" :: (cancel_comm_monoid_add, type) cancel_comm_monoid_add ..
+instance "^" :: (semiring_0_cancel,type) semiring_0_cancel by (intro_classes)
+instance "^" :: (comm_semiring_0_cancel,type) comm_semiring_0_cancel by (intro_classes)
+instance "^" :: (ring,type) ring by (intro_classes)
+instance "^" :: (semiring_1_cancel,type) semiring_1_cancel by (intro_classes)
+instance "^" :: (comm_semiring_1,type) comm_semiring_1 by (intro_classes)
+
+instance "^" :: (ring_1,type) ring_1 ..
+
+instance "^" :: (real_algebra,type) real_algebra
+ apply intro_classes
+ apply (simp_all add: vector_scaleR_def ring_simps)
+ apply vector
+ apply vector
+ done
+
+instance "^" :: (real_algebra_1,type) real_algebra_1 ..
+
+lemma of_nat_index:
+ "(of_nat n :: 'a::semiring_1 ^'n)$i = of_nat n"
+ apply (induct n)
+ apply vector
+ apply vector
+ done
+lemma zero_index[simp]:
+ "(0 :: 'a::zero ^'n)$i = 0" by vector
+
+lemma one_index[simp]:
+ "(1 :: 'a::one ^'n)$i = 1" by vector
+
+lemma one_plus_of_nat_neq_0: "(1::'a::semiring_char_0) + of_nat n \<noteq> 0"
+proof-
+ have "(1::'a) + of_nat n = 0 \<longleftrightarrow> of_nat 1 + of_nat n = (of_nat 0 :: 'a)" by simp
+ also have "\<dots> \<longleftrightarrow> 1 + n = 0" by (simp only: of_nat_add[symmetric] of_nat_eq_iff)
+ finally show ?thesis by simp
+qed
+
+instance "^" :: (semiring_char_0,type) semiring_char_0
+proof (intro_classes)
+ fix m n ::nat
+ show "(of_nat m :: 'a^'b) = of_nat n \<longleftrightarrow> m = n"
+ by (simp add: Cart_eq of_nat_index)
+qed
+
+instance "^" :: (comm_ring_1,type) comm_ring_1 by intro_classes
+instance "^" :: (ring_char_0,type) ring_char_0 by intro_classes
+
+lemma vector_smult_assoc: "a *s (b *s x) = ((a::'a::semigroup_mult) * b) *s x"
+ by (vector mult_assoc)
+lemma vector_sadd_rdistrib: "((a::'a::semiring) + b) *s x = a *s x + b *s x"
+ by (vector ring_simps)
+lemma vector_add_ldistrib: "(c::'a::semiring) *s (x + y) = c *s x + c *s y"
+ by (vector ring_simps)
+lemma vector_smult_lzero[simp]: "(0::'a::mult_zero) *s x = 0" by vector
+lemma vector_smult_lid[simp]: "(1::'a::monoid_mult) *s x = x" by vector
+lemma vector_ssub_ldistrib: "(c::'a::ring) *s (x - y) = c *s x - c *s y"
+ by (vector ring_simps)
+lemma vector_smult_rneg: "(c::'a::ring) *s -x = -(c *s x)" by vector
+lemma vector_smult_lneg: "- (c::'a::ring) *s x = -(c *s x)" by vector
+lemma vector_sneg_minus1: "-x = (- (1::'a::ring_1)) *s x" by vector
+lemma vector_smult_rzero[simp]: "c *s 0 = (0::'a::mult_zero ^ 'n)" by vector
+lemma vector_sub_rdistrib: "((a::'a::ring) - b) *s x = a *s x - b *s x"
+ by (vector ring_simps)
+
+lemma vec_eq[simp]: "(vec m = vec n) \<longleftrightarrow> (m = n)"
+ by (simp add: Cart_eq)
+
+subsection {* Topological space *}
+
+instantiation "^" :: (topological_space, finite) topological_space
+begin
+
+definition open_vector_def:
+ "open (S :: ('a ^ 'b) set) \<longleftrightarrow>
+ (\<forall>x\<in>S. \<exists>A. (\<forall>i. open (A i) \<and> x$i \<in> A i) \<and>
+ (\<forall>y. (\<forall>i. y$i \<in> A i) \<longrightarrow> y \<in> S))"
+
+instance proof
+ show "open (UNIV :: ('a ^ 'b) set)"
+ unfolding open_vector_def by auto
+next
+ fix S T :: "('a ^ 'b) set"
+ assume "open S" "open T" thus "open (S \<inter> T)"
+ unfolding open_vector_def
+ apply clarify
+ apply (drule (1) bspec)+
+ apply (clarify, rename_tac Sa Ta)
+ apply (rule_tac x="\<lambda>i. Sa i \<inter> Ta i" in exI)
+ apply (simp add: open_Int)
+ done
+next
+ fix K :: "('a ^ 'b) set set"
+ assume "\<forall>S\<in>K. open S" thus "open (\<Union>K)"
+ unfolding open_vector_def
+ apply clarify
+ apply (drule (1) bspec)
+ apply (drule (1) bspec)
+ apply clarify
+ apply (rule_tac x=A in exI)
+ apply fast
+ done
+qed
+
+end
+
+lemma open_vector_box: "\<forall>i. open (S i) \<Longrightarrow> open {x. \<forall>i. x $ i \<in> S i}"
+unfolding open_vector_def by auto
+
+lemma open_vimage_Cart_nth: "open S \<Longrightarrow> open ((\<lambda>x. x $ i) -` S)"
+unfolding open_vector_def
+apply clarify
+apply (rule_tac x="\<lambda>k. if k = i then S else UNIV" in exI, simp)
+done
+
+lemma closed_vimage_Cart_nth: "closed S \<Longrightarrow> closed ((\<lambda>x. x $ i) -` S)"
+unfolding closed_open vimage_Compl [symmetric]
+by (rule open_vimage_Cart_nth)
+
+lemma closed_vector_box: "\<forall>i. closed (S i) \<Longrightarrow> closed {x. \<forall>i. x $ i \<in> S i}"
+proof -
+ have "{x. \<forall>i. x $ i \<in> S i} = (\<Inter>i. (\<lambda>x. x $ i) -` S i)" by auto
+ thus "\<forall>i. closed (S i) \<Longrightarrow> closed {x. \<forall>i. x $ i \<in> S i}"
+ by (simp add: closed_INT closed_vimage_Cart_nth)
+qed
+
+lemma tendsto_Cart_nth [tendsto_intros]:
+ assumes "((\<lambda>x. f x) ---> a) net"
+ shows "((\<lambda>x. f x $ i) ---> a $ i) net"
+proof (rule topological_tendstoI)
+ fix S assume "open S" "a $ i \<in> S"
+ then have "open ((\<lambda>y. y $ i) -` S)" "a \<in> ((\<lambda>y. y $ i) -` S)"
+ by (simp_all add: open_vimage_Cart_nth)
+ with assms have "eventually (\<lambda>x. f x \<in> (\<lambda>y. y $ i) -` S) net"
+ by (rule topological_tendstoD)
+ then show "eventually (\<lambda>x. f x $ i \<in> S) net"
+ by simp
+qed
+
+subsection {* Square root of sum of squares *}
+
+definition
+ "setL2 f A = sqrt (\<Sum>i\<in>A. (f i)\<twosuperior>)"
+
+lemma setL2_cong:
+ "\<lbrakk>A = B; \<And>x. x \<in> B \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> setL2 f A = setL2 g B"
+ unfolding setL2_def by simp
+
+lemma strong_setL2_cong:
+ "\<lbrakk>A = B; \<And>x. x \<in> B =simp=> f x = g x\<rbrakk> \<Longrightarrow> setL2 f A = setL2 g B"
+ unfolding setL2_def simp_implies_def by simp
+
+lemma setL2_infinite [simp]: "\<not> finite A \<Longrightarrow> setL2 f A = 0"
+ unfolding setL2_def by simp
+
+lemma setL2_empty [simp]: "setL2 f {} = 0"
+ unfolding setL2_def by simp
+
+lemma setL2_insert [simp]:
+ "\<lbrakk>finite F; a \<notin> F\<rbrakk> \<Longrightarrow>
+ setL2 f (insert a F) = sqrt ((f a)\<twosuperior> + (setL2 f F)\<twosuperior>)"
+ unfolding setL2_def by (simp add: setsum_nonneg)
+
+lemma setL2_nonneg [simp]: "0 \<le> setL2 f A"
+ unfolding setL2_def by (simp add: setsum_nonneg)
+
+lemma setL2_0': "\<forall>a\<in>A. f a = 0 \<Longrightarrow> setL2 f A = 0"
+ unfolding setL2_def by simp
+
+lemma setL2_constant: "setL2 (\<lambda>x. y) A = sqrt (of_nat (card A)) * \<bar>y\<bar>"
+ unfolding setL2_def by (simp add: real_sqrt_mult)
+
+lemma setL2_mono:
+ assumes "\<And>i. i \<in> K \<Longrightarrow> f i \<le> g i"
+ assumes "\<And>i. i \<in> K \<Longrightarrow> 0 \<le> f i"
+ shows "setL2 f K \<le> setL2 g K"
+ unfolding setL2_def
+ by (simp add: setsum_nonneg setsum_mono power_mono prems)
+
+lemma setL2_strict_mono:
+ assumes "finite K" and "K \<noteq> {}"
+ assumes "\<And>i. i \<in> K \<Longrightarrow> f i < g i"
+ assumes "\<And>i. i \<in> K \<Longrightarrow> 0 \<le> f i"
+ shows "setL2 f K < setL2 g K"
+ unfolding setL2_def
+ by (simp add: setsum_strict_mono power_strict_mono assms)
+
+lemma setL2_right_distrib:
+ "0 \<le> r \<Longrightarrow> r * setL2 f A = setL2 (\<lambda>x. r * f x) A"
+ unfolding setL2_def
+ apply (simp add: power_mult_distrib)
+ apply (simp add: setsum_right_distrib [symmetric])
+ apply (simp add: real_sqrt_mult setsum_nonneg)
+ done
+
+lemma setL2_left_distrib:
+ "0 \<le> r \<Longrightarrow> setL2 f A * r = setL2 (\<lambda>x. f x * r) A"
+ unfolding setL2_def
+ apply (simp add: power_mult_distrib)
+ apply (simp add: setsum_left_distrib [symmetric])
+ apply (simp add: real_sqrt_mult setsum_nonneg)
+ done
+
+lemma setsum_nonneg_eq_0_iff:
+ fixes f :: "'a \<Rightarrow> 'b::pordered_ab_group_add"
+ 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)"
+ apply (induct set: finite, simp)
+ apply (simp add: add_nonneg_eq_0_iff setsum_nonneg)
+ done
+
+lemma setL2_eq_0_iff: "finite A \<Longrightarrow> setL2 f A = 0 \<longleftrightarrow> (\<forall>x\<in>A. f x = 0)"
+ unfolding setL2_def
+ by (simp add: setsum_nonneg setsum_nonneg_eq_0_iff)
+
+lemma setL2_triangle_ineq:
+ shows "setL2 (\<lambda>i. f i + g i) A \<le> setL2 f A + setL2 g A"
+proof (cases "finite A")
+ case False
+ thus ?thesis by simp
+next
+ case True
+ thus ?thesis
+ proof (induct set: finite)
+ case empty
+ show ?case by simp
+ next
+ case (insert x F)
+ hence "sqrt ((f x + g x)\<twosuperior> + (setL2 (\<lambda>i. f i + g i) F)\<twosuperior>) \<le>
+ sqrt ((f x + g x)\<twosuperior> + (setL2 f F + setL2 g F)\<twosuperior>)"
+ by (intro real_sqrt_le_mono add_left_mono power_mono insert
+ setL2_nonneg add_increasing zero_le_power2)
+ also have
+ "\<dots> \<le> sqrt ((f x)\<twosuperior> + (setL2 f F)\<twosuperior>) + sqrt ((g x)\<twosuperior> + (setL2 g F)\<twosuperior>)"
+ by (rule real_sqrt_sum_squares_triangle_ineq)
+ finally show ?case
+ using insert by simp
+ qed
+qed
+
+lemma sqrt_sum_squares_le_sum:
+ "\<lbrakk>0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> sqrt (x\<twosuperior> + y\<twosuperior>) \<le> x + y"
+ apply (rule power2_le_imp_le)
+ apply (simp add: power2_sum)
+ apply (simp add: mult_nonneg_nonneg)
+ apply (simp add: add_nonneg_nonneg)
+ done
+
+lemma setL2_le_setsum [rule_format]:
+ "(\<forall>i\<in>A. 0 \<le> f i) \<longrightarrow> setL2 f A \<le> setsum f A"
+ apply (cases "finite A")
+ apply (induct set: finite)
+ apply simp
+ apply clarsimp
+ apply (erule order_trans [OF sqrt_sum_squares_le_sum])
+ apply simp
+ apply simp
+ apply simp
+ done
+
+lemma sqrt_sum_squares_le_sum_abs: "sqrt (x\<twosuperior> + y\<twosuperior>) \<le> \<bar>x\<bar> + \<bar>y\<bar>"
+ apply (rule power2_le_imp_le)
+ apply (simp add: power2_sum)
+ apply (simp add: mult_nonneg_nonneg)
+ apply (simp add: add_nonneg_nonneg)
+ done
+
+lemma setL2_le_setsum_abs: "setL2 f A \<le> (\<Sum>i\<in>A. \<bar>f i\<bar>)"
+ apply (cases "finite A")
+ apply (induct set: finite)
+ apply simp
+ apply simp
+ apply (rule order_trans [OF sqrt_sum_squares_le_sum_abs])
+ apply simp
+ apply simp
+ done
+
+lemma setL2_mult_ineq_lemma:
+ fixes a b c d :: real
+ shows "2 * (a * c) * (b * d) \<le> a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior>"
+proof -
+ have "0 \<le> (a * d - b * c)\<twosuperior>" by simp
+ also have "\<dots> = a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior> - 2 * (a * d) * (b * c)"
+ by (simp only: power2_diff power_mult_distrib)
+ also have "\<dots> = a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior> - 2 * (a * c) * (b * d)"
+ by simp
+ finally show "2 * (a * c) * (b * d) \<le> a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior>"
+ by simp
+qed
+
+lemma setL2_mult_ineq: "(\<Sum>i\<in>A. \<bar>f i\<bar> * \<bar>g i\<bar>) \<le> setL2 f A * setL2 g A"
+ apply (cases "finite A")
+ apply (induct set: finite)
+ apply simp
+ apply (rule power2_le_imp_le, simp)
+ apply (rule order_trans)
+ apply (rule power_mono)
+ apply (erule add_left_mono)
+ apply (simp add: add_nonneg_nonneg mult_nonneg_nonneg setsum_nonneg)
+ apply (simp add: power2_sum)
+ apply (simp add: power_mult_distrib)
+ apply (simp add: right_distrib left_distrib)
+ apply (rule ord_le_eq_trans)
+ apply (rule setL2_mult_ineq_lemma)
+ apply simp
+ apply (intro mult_nonneg_nonneg setL2_nonneg)
+ apply simp
+ done
+
+lemma member_le_setL2: "\<lbrakk>finite A; i \<in> A\<rbrakk> \<Longrightarrow> f i \<le> setL2 f A"
+ apply (rule_tac s="insert i (A - {i})" and t="A" in subst)
+ apply fast
+ apply (subst setL2_insert)
+ apply simp
+ apply simp
+ apply simp
+ done
+
+subsection {* Metric *}
+
+(* TODO: move somewhere else *)
+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)"
+apply (induct set: finite, simp_all)
+apply (clarify, rename_tac y)
+apply (rule_tac x="f(x:=y)" in exI, simp)
+done
+
+instantiation "^" :: (metric_space, finite) metric_space
+begin
+
+definition dist_vector_def:
+ "dist (x::'a^'b) (y::'a^'b) = setL2 (\<lambda>i. dist (x$i) (y$i)) UNIV"
+
+lemma dist_nth_le: "dist (x $ i) (y $ i) \<le> dist x y"
+unfolding dist_vector_def
+by (rule member_le_setL2) simp_all
+
+instance proof
+ fix x y :: "'a ^ 'b"
+ show "dist x y = 0 \<longleftrightarrow> x = y"
+ unfolding dist_vector_def
+ by (simp add: setL2_eq_0_iff Cart_eq)
+next
+ fix x y z :: "'a ^ 'b"
+ show "dist x y \<le> dist x z + dist y z"
+ unfolding dist_vector_def
+ apply (rule order_trans [OF _ setL2_triangle_ineq])
+ apply (simp add: setL2_mono dist_triangle2)
+ done
+next
+ (* FIXME: long proof! *)
+ fix S :: "('a ^ 'b) set"
+ show "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> S)"
+ unfolding open_vector_def open_dist
+ apply safe
+ apply (drule (1) bspec)
+ apply clarify
+ apply (subgoal_tac "\<exists>e>0. \<forall>i y. dist y (x$i) < e \<longrightarrow> y \<in> A i")
+ apply clarify
+ apply (rule_tac x=e in exI, clarify)
+ apply (drule spec, erule mp, clarify)
+ apply (drule spec, drule spec, erule mp)
+ apply (erule le_less_trans [OF dist_nth_le])
+ apply (subgoal_tac "\<forall>i\<in>UNIV. \<exists>e>0. \<forall>y. dist y (x$i) < e \<longrightarrow> y \<in> A i")
+ apply (drule finite_choice [OF finite], clarify)
+ apply (rule_tac x="Min (range f)" in exI, simp)
+ apply clarify
+ apply (drule_tac x=i in spec, clarify)
+ apply (erule (1) bspec)
+ apply (drule (1) bspec, clarify)
+ apply (subgoal_tac "\<exists>r. (\<forall>i::'b. 0 < r i) \<and> e = setL2 r UNIV")
+ apply clarify
+ apply (rule_tac x="\<lambda>i. {y. dist y (x$i) < r i}" in exI)
+ apply (rule conjI)
+ apply clarify
+ apply (rule conjI)
+ apply (clarify, rename_tac y)
+ apply (rule_tac x="r i - dist y (x$i)" in exI, rule conjI, simp)
+ apply clarify
+ apply (simp only: less_diff_eq)
+ apply (erule le_less_trans [OF dist_triangle])
+ apply simp
+ apply clarify
+ apply (drule spec, erule mp)
+ apply (simp add: dist_vector_def setL2_strict_mono)
+ apply (rule_tac x="\<lambda>i. e / sqrt (of_nat CARD('b))" in exI)
+ apply (simp add: divide_pos_pos setL2_constant)
+ done
+qed
+
+end
+
+lemma LIMSEQ_Cart_nth:
+ "(X ----> a) \<Longrightarrow> (\<lambda>n. X n $ i) ----> a $ i"
+unfolding LIMSEQ_conv_tendsto by (rule tendsto_Cart_nth)
+
+lemma LIM_Cart_nth:
+ "(f -- x --> y) \<Longrightarrow> (\<lambda>x. f x $ i) -- x --> y $ i"
+unfolding LIM_conv_tendsto by (rule tendsto_Cart_nth)
+
+lemma Cauchy_Cart_nth:
+ "Cauchy (\<lambda>n. X n) \<Longrightarrow> Cauchy (\<lambda>n. X n $ i)"
+unfolding Cauchy_def by (fast intro: le_less_trans [OF dist_nth_le])
+
+lemma LIMSEQ_vector:
+ fixes X :: "nat \<Rightarrow> 'a::metric_space ^ 'n::finite"
+ assumes X: "\<And>i. (\<lambda>n. X n $ i) ----> (a $ i)"
+ shows "X ----> a"
+proof (rule metric_LIMSEQ_I)
+ fix r :: real assume "0 < r"
+ then have "0 < r / of_nat CARD('n)" (is "0 < ?s")
+ by (simp add: divide_pos_pos)
+ def N \<equiv> "\<lambda>i. LEAST N. \<forall>n\<ge>N. dist (X n $ i) (a $ i) < ?s"
+ def M \<equiv> "Max (range N)"
+ have "\<And>i. \<exists>N. \<forall>n\<ge>N. dist (X n $ i) (a $ i) < ?s"
+ using X `0 < ?s` by (rule metric_LIMSEQ_D)
+ hence "\<And>i. \<forall>n\<ge>N i. dist (X n $ i) (a $ i) < ?s"
+ unfolding N_def by (rule LeastI_ex)
+ hence M: "\<And>i. \<forall>n\<ge>M. dist (X n $ i) (a $ i) < ?s"
+ unfolding M_def by simp
+ {
+ fix n :: nat assume "M \<le> n"
+ have "dist (X n) a = setL2 (\<lambda>i. dist (X n $ i) (a $ i)) UNIV"
+ unfolding dist_vector_def ..
+ also have "\<dots> \<le> setsum (\<lambda>i. dist (X n $ i) (a $ i)) UNIV"
+ by (rule setL2_le_setsum [OF zero_le_dist])
+ also have "\<dots> < setsum (\<lambda>i::'n. ?s) UNIV"
+ by (rule setsum_strict_mono, simp_all add: M `M \<le> n`)
+ also have "\<dots> = r"
+ by simp
+ finally have "dist (X n) a < r" .
+ }
+ hence "\<forall>n\<ge>M. dist (X n) a < r"
+ by simp
+ then show "\<exists>M. \<forall>n\<ge>M. dist (X n) a < r" ..
+qed
+
+lemma Cauchy_vector:
+ fixes X :: "nat \<Rightarrow> 'a::metric_space ^ 'n::finite"
+ assumes X: "\<And>i. Cauchy (\<lambda>n. X n $ i)"
+ shows "Cauchy (\<lambda>n. X n)"
+proof (rule metric_CauchyI)
+ fix r :: real assume "0 < r"
+ then have "0 < r / of_nat CARD('n)" (is "0 < ?s")
+ by (simp add: divide_pos_pos)
+ def N \<equiv> "\<lambda>i. LEAST N. \<forall>m\<ge>N. \<forall>n\<ge>N. dist (X m $ i) (X n $ i) < ?s"
+ def M \<equiv> "Max (range N)"
+ have "\<And>i. \<exists>N. \<forall>m\<ge>N. \<forall>n\<ge>N. dist (X m $ i) (X n $ i) < ?s"
+ using X `0 < ?s` by (rule metric_CauchyD)
+ hence "\<And>i. \<forall>m\<ge>N i. \<forall>n\<ge>N i. dist (X m $ i) (X n $ i) < ?s"
+ unfolding N_def by (rule LeastI_ex)
+ hence M: "\<And>i. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m $ i) (X n $ i) < ?s"
+ unfolding M_def by simp
+ {
+ fix m n :: nat
+ assume "M \<le> m" "M \<le> n"
+ have "dist (X m) (X n) = setL2 (\<lambda>i. dist (X m $ i) (X n $ i)) UNIV"
+ unfolding dist_vector_def ..
+ also have "\<dots> \<le> setsum (\<lambda>i. dist (X m $ i) (X n $ i)) UNIV"
+ by (rule setL2_le_setsum [OF zero_le_dist])
+ also have "\<dots> < setsum (\<lambda>i::'n. ?s) UNIV"
+ by (rule setsum_strict_mono, simp_all add: M `M \<le> m` `M \<le> n`)
+ also have "\<dots> = r"
+ by simp
+ finally have "dist (X m) (X n) < r" .
+ }
+ hence "\<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < r"
+ by simp
+ then show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < r" ..
+qed
+
+instance "^" :: (complete_space, finite) complete_space
+proof
+ fix X :: "nat \<Rightarrow> 'a ^ 'b" assume "Cauchy X"
+ have "\<And>i. (\<lambda>n. X n $ i) ----> lim (\<lambda>n. X n $ i)"
+ using Cauchy_Cart_nth [OF `Cauchy X`]
+ by (simp add: Cauchy_convergent_iff convergent_LIMSEQ_iff)
+ hence "X ----> Cart_lambda (\<lambda>i. lim (\<lambda>n. X n $ i))"
+ by (simp add: LIMSEQ_vector)
+ then show "convergent X"
+ by (rule convergentI)
+qed
+
+subsection {* Norms *}
+
+instantiation "^" :: (real_normed_vector, finite) real_normed_vector
+begin
+
+definition norm_vector_def:
+ "norm (x::'a^'b) = setL2 (\<lambda>i. norm (x$i)) UNIV"
+
+definition vector_sgn_def:
+ "sgn (x::'a^'b) = scaleR (inverse (norm x)) x"
+
+instance proof
+ fix a :: real and x y :: "'a ^ 'b"
+ show "0 \<le> norm x"
+ unfolding norm_vector_def
+ by (rule setL2_nonneg)
+ show "norm x = 0 \<longleftrightarrow> x = 0"
+ unfolding norm_vector_def
+ by (simp add: setL2_eq_0_iff Cart_eq)
+ show "norm (x + y) \<le> norm x + norm y"
+ unfolding norm_vector_def
+ apply (rule order_trans [OF _ setL2_triangle_ineq])
+ apply (simp add: setL2_mono norm_triangle_ineq)
+ done
+ show "norm (scaleR a x) = \<bar>a\<bar> * norm x"
+ unfolding norm_vector_def
+ by (simp add: setL2_right_distrib)
+ show "sgn x = scaleR (inverse (norm x)) x"
+ by (rule vector_sgn_def)
+ show "dist x y = norm (x - y)"
+ unfolding dist_vector_def norm_vector_def
+ by (simp add: dist_norm)
+qed
+
+end
+
+lemma norm_nth_le: "norm (x $ i) \<le> norm x"
+unfolding norm_vector_def
+by (rule member_le_setL2) simp_all
+
+interpretation Cart_nth: bounded_linear "\<lambda>x. x $ i"
+apply default
+apply (rule vector_add_component)
+apply (rule vector_scaleR_component)
+apply (rule_tac x="1" in exI, simp add: norm_nth_le)
+done
+
+instance "^" :: (banach, finite) banach ..
+
+subsection {* Inner products *}
+
+instantiation "^" :: (real_inner, finite) real_inner
+begin
+
+definition inner_vector_def:
+ "inner x y = setsum (\<lambda>i. inner (x$i) (y$i)) UNIV"
+
+instance proof
+ fix r :: real and x y z :: "'a ^ 'b"
+ show "inner x y = inner y x"
+ unfolding inner_vector_def
+ by (simp add: inner_commute)
+ show "inner (x + y) z = inner x z + inner y z"
+ unfolding inner_vector_def
+ by (simp add: inner_add_left setsum_addf)
+ show "inner (scaleR r x) y = r * inner x y"
+ unfolding inner_vector_def
+ by (simp add: setsum_right_distrib)
+ show "0 \<le> inner x x"
+ unfolding inner_vector_def
+ by (simp add: setsum_nonneg)
+ show "inner x x = 0 \<longleftrightarrow> x = 0"
+ unfolding inner_vector_def
+ by (simp add: Cart_eq setsum_nonneg_eq_0_iff)
+ show "norm x = sqrt (inner x x)"
+ unfolding inner_vector_def norm_vector_def setL2_def
+ by (simp add: power2_norm_eq_inner)
+qed
+
+end
+
+subsection{* Properties of the dot product. *}
+
+lemma dot_sym: "(x::'a:: {comm_monoid_add, ab_semigroup_mult} ^ 'n) \<bullet> y = y \<bullet> x"
+ by (vector mult_commute)
+lemma dot_ladd: "((x::'a::ring ^ 'n) + y) \<bullet> z = (x \<bullet> z) + (y \<bullet> z)"
+ by (vector ring_simps)
+lemma dot_radd: "x \<bullet> (y + (z::'a::ring ^ 'n)) = (x \<bullet> y) + (x \<bullet> z)"
+ by (vector ring_simps)
+lemma dot_lsub: "((x::'a::ring ^ 'n) - y) \<bullet> z = (x \<bullet> z) - (y \<bullet> z)"
+ by (vector ring_simps)
+lemma dot_rsub: "(x::'a::ring ^ 'n) \<bullet> (y - z) = (x \<bullet> y) - (x \<bullet> z)"
+ by (vector ring_simps)
+lemma dot_lmult: "(c *s x) \<bullet> y = (c::'a::ring) * (x \<bullet> y)" by (vector ring_simps)
+lemma dot_rmult: "x \<bullet> (c *s y) = (c::'a::comm_ring) * (x \<bullet> y)" by (vector ring_simps)
+lemma dot_lneg: "(-x) \<bullet> (y::'a::ring ^ 'n) = -(x \<bullet> y)" by vector
+lemma dot_rneg: "(x::'a::ring ^ 'n) \<bullet> (-y) = -(x \<bullet> y)" by vector
+lemma dot_lzero[simp]: "0 \<bullet> x = (0::'a::{comm_monoid_add, mult_zero})" by vector
+lemma dot_rzero[simp]: "x \<bullet> 0 = (0::'a::{comm_monoid_add, mult_zero})" by vector
+lemma dot_pos_le[simp]: "(0::'a\<Colon>ordered_ring_strict) <= x \<bullet> x"
+ by (simp add: dot_def setsum_nonneg)
+
+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)"
+using fS fp setsum_nonneg[OF fp]
+proof (induct set: finite)
+ case empty thus ?case by simp
+next
+ case (insert x F)
+ from insert.prems have Fx: "f x \<ge> 0" and Fp: "\<forall> a \<in> F. f a \<ge> 0" by simp_all
+ from insert.hyps Fp setsum_nonneg[OF Fp]
+ have h: "setsum f F = 0 \<longleftrightarrow> (\<forall>a \<in>F. f a = 0)" by metis
+ from add_nonneg_eq_0_iff[OF Fx setsum_nonneg[OF Fp]] insert.hyps(1,2)
+ show ?case by (simp add: h)
+qed
+
+lemma dot_eq_0: "x \<bullet> x = 0 \<longleftrightarrow> (x::'a::{ordered_ring_strict,ring_no_zero_divisors} ^ 'n::finite) = 0"
+ by (simp add: dot_def setsum_squares_eq_0_iff Cart_eq)
+
+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]
+ by (auto simp add: le_less)
+
+subsection{* The collapse of the general concepts to dimension one. *}
+
+lemma vector_one: "(x::'a ^1) = (\<chi> i. (x$1))"
+ by (simp add: Cart_eq forall_1)
+
+lemma forall_one: "(\<forall>(x::'a ^1). P x) \<longleftrightarrow> (\<forall>x. P(\<chi> i. x))"
+ apply auto
+ apply (erule_tac x= "x$1" in allE)
+ apply (simp only: vector_one[symmetric])
+ done
+
+lemma norm_vector_1: "norm (x :: _^1) = norm (x$1)"
+ by (simp add: norm_vector_def UNIV_1)
+
+lemma norm_real: "norm(x::real ^ 1) = abs(x$1)"
+ by (simp add: norm_vector_1)
+
+lemma dist_real: "dist(x::real ^ 1) y = abs((x$1) - (y$1))"
+ by (auto simp add: norm_real dist_norm)
+
+subsection {* A connectedness or intermediate value lemma with several applications. *}
+
+lemma connected_real_lemma:
+ fixes f :: "real \<Rightarrow> 'a::metric_space"
+ assumes ab: "a \<le> b" and fa: "f a \<in> e1" and fb: "f b \<in> e2"
+ 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"
+ and e1: "\<forall>y \<in> e1. \<exists>e > 0. \<forall>y'. dist y' y < e \<longrightarrow> y' \<in> e1"
+ and e2: "\<forall>y \<in> e2. \<exists>e > 0. \<forall>y'. dist y' y < e \<longrightarrow> y' \<in> e2"
+ and e12: "~(\<exists>x \<ge> a. x <= b \<and> f x \<in> e1 \<and> f x \<in> e2)"
+ shows "\<exists>x \<ge> a. x <= b \<and> f x \<notin> e1 \<and> f x \<notin> e2" (is "\<exists> x. ?P x")
+proof-
+ let ?S = "{c. \<forall>x \<ge> a. x <= c \<longrightarrow> f x \<in> e1}"
+ have Se: " \<exists>x. x \<in> ?S" apply (rule exI[where x=a]) by (auto simp add: fa)
+ have Sub: "\<exists>y. isUb UNIV ?S y"
+ apply (rule exI[where x= b])
+ using ab fb e12 by (auto simp add: isUb_def setle_def)
+ from reals_complete[OF Se Sub] obtain l where
+ l: "isLub UNIV ?S l"by blast
+ have alb: "a \<le> l" "l \<le> b" using l ab fa fb e12
+ apply (auto simp add: isLub_def leastP_def isUb_def setle_def setge_def)
+ by (metis linorder_linear)
+ have ale1: "\<forall>z \<ge> a. z < l \<longrightarrow> f z \<in> e1" using l
+ apply (auto simp add: isLub_def leastP_def isUb_def setle_def setge_def)
+ by (metis linorder_linear not_le)
+ have th1: "\<And>z x e d :: real. z <= x + e \<Longrightarrow> e < d ==> z < x \<or> abs(z - x) < d" by arith
+ have th2: "\<And>e x:: real. 0 < e ==> ~(x + e <= x)" by arith
+ have th3: "\<And>d::real. d > 0 \<Longrightarrow> \<exists>e > 0. e < d" by dlo
+ {assume le2: "f l \<in> e2"
+ from le2 fa fb e12 alb have la: "l \<noteq> a" by metis
+ hence lap: "l - a > 0" using alb by arith
+ from e2[rule_format, OF le2] obtain e where
+ e: "e > 0" "\<forall>y. dist y (f l) < e \<longrightarrow> y \<in> e2" by metis
+ from dst[OF alb e(1)] obtain d where
+ d: "d > 0" "\<forall>y. \<bar>y - l\<bar> < d \<longrightarrow> dist (f y) (f l) < e" by metis
+ have "\<exists>d'. d' < d \<and> d' >0 \<and> l - d' > a" using lap d(1)
+ apply ferrack by arith
+ then obtain d' where d': "d' > 0" "d' < d" "l - d' > a" by metis
+ from d e have th0: "\<forall>y. \<bar>y - l\<bar> < d \<longrightarrow> f y \<in> e2" by metis
+ from th0[rule_format, of "l - d'"] d' have "f (l - d') \<in> e2" by auto
+ moreover
+ have "f (l - d') \<in> e1" using ale1[rule_format, of "l -d'"] d' by auto
+ ultimately have False using e12 alb d' by auto}
+ moreover
+ {assume le1: "f l \<in> e1"
+ from le1 fa fb e12 alb have lb: "l \<noteq> b" by metis
+ hence blp: "b - l > 0" using alb by arith
+ from e1[rule_format, OF le1] obtain e where
+ e: "e > 0" "\<forall>y. dist y (f l) < e \<longrightarrow> y \<in> e1" by metis
+ from dst[OF alb e(1)] obtain d where
+ d: "d > 0" "\<forall>y. \<bar>y - l\<bar> < d \<longrightarrow> dist (f y) (f l) < e" by metis
+ have "\<exists>d'. d' < d \<and> d' >0" using d(1) by dlo
+ then obtain d' where d': "d' > 0" "d' < d" by metis
+ from d e have th0: "\<forall>y. \<bar>y - l\<bar> < d \<longrightarrow> f y \<in> e1" by auto
+ hence "\<forall>y. l \<le> y \<and> y \<le> l + d' \<longrightarrow> f y \<in> e1" using d' by auto
+ with ale1 have "\<forall>y. a \<le> y \<and> y \<le> l + d' \<longrightarrow> f y \<in> e1" by auto
+ with l d' have False
+ by (auto simp add: isLub_def isUb_def setle_def setge_def leastP_def) }
+ ultimately show ?thesis using alb by metis
+qed
+
+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"} *}
+
+lemma square_bound_lemma: "(x::real) < (1 + x) * (1 + x)"
+proof-
+ have "(x + 1/2)^2 + 3/4 > 0" using zero_le_power2[of "x+1/2"] by arith
+ thus ?thesis by (simp add: ring_simps power2_eq_square)
+qed
+
+lemma square_continuous: "0 < (e::real) ==> \<exists>d. 0 < d \<and> (\<forall>y. abs(y - x) < d \<longrightarrow> abs(y * y - x * x) < e)"
+ 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)
+ apply (rule_tac x="s" in exI)
+ apply auto
+ apply (erule_tac x=y in allE)
+ apply auto
+ done
+
+lemma real_le_lsqrt: "0 <= x \<Longrightarrow> 0 <= y \<Longrightarrow> x <= y^2 ==> sqrt x <= y"
+ using real_sqrt_le_iff[of x "y^2"] by simp
+
+lemma real_le_rsqrt: "x^2 \<le> y \<Longrightarrow> x \<le> sqrt y"
+ using real_sqrt_le_mono[of "x^2" y] by simp
+
+lemma real_less_rsqrt: "x^2 < y \<Longrightarrow> x < sqrt y"
+ using real_sqrt_less_mono[of "x^2" y] by simp
+
+lemma sqrt_even_pow2: assumes n: "even n"
+ shows "sqrt(2 ^ n) = 2 ^ (n div 2)"
+proof-
+ from n obtain m where m: "n = 2*m" unfolding even_nat_equiv_def2
+ by (auto simp add: nat_number)
+ from m have "sqrt(2 ^ n) = sqrt ((2 ^ m) ^ 2)"
+ by (simp only: power_mult[symmetric] mult_commute)
+ then show ?thesis using m by simp
+qed
+
+lemma real_div_sqrt: "0 <= x ==> x / sqrt(x) = sqrt(x)"
+ apply (cases "x = 0", simp_all)
+ using sqrt_divide_self_eq[of x]
+ apply (simp add: inverse_eq_divide real_sqrt_ge_0_iff field_simps)
+ done
+
+text{* Hence derive more interesting properties of the norm. *}
+
+text {*
+ This type-specific version is only here
+ to make @{text normarith.ML} happy.
+*}
+lemma norm_0: "norm (0::real ^ _) = 0"
+ by (rule norm_zero)
+
+lemma norm_mul[simp]: "norm(a *s x) = abs(a) * norm x"
+ by (simp add: norm_vector_def vector_component setL2_right_distrib
+ abs_mult cong: strong_setL2_cong)
+lemma norm_eq_0_dot: "(norm x = 0) \<longleftrightarrow> (x \<bullet> x = (0::real))"
+ by (simp add: norm_vector_def dot_def setL2_def power2_eq_square)
+lemma real_vector_norm_def: "norm x = sqrt (x \<bullet> x)"
+ by (simp add: norm_vector_def setL2_def dot_def power2_eq_square)
+lemma norm_pow_2: "norm x ^ 2 = x \<bullet> x"
+ by (simp add: real_vector_norm_def)
+lemma norm_eq_0_imp: "norm x = 0 ==> x = (0::real ^'n::finite)" by (metis norm_eq_zero)
+lemma vector_mul_eq_0[simp]: "(a *s x = 0) \<longleftrightarrow> a = (0::'a::idom) \<or> x = 0"
+ by vector
+lemma vector_mul_lcancel[simp]: "a *s x = a *s y \<longleftrightarrow> a = (0::real) \<or> x = y"
+ by (metis eq_iff_diff_eq_0 vector_mul_eq_0 vector_ssub_ldistrib)
+lemma vector_mul_rcancel[simp]: "a *s x = b *s x \<longleftrightarrow> (a::real) = b \<or> x = 0"
+ by (metis eq_iff_diff_eq_0 vector_mul_eq_0 vector_sub_rdistrib)
+lemma vector_mul_lcancel_imp: "a \<noteq> (0::real) ==> a *s x = a *s y ==> (x = y)"
+ by (metis vector_mul_lcancel)
+lemma vector_mul_rcancel_imp: "x \<noteq> 0 \<Longrightarrow> (a::real) *s x = b *s x ==> a = b"
+ by (metis vector_mul_rcancel)
+lemma norm_cauchy_schwarz:
+ fixes x y :: "real ^ 'n::finite"
+ shows "x \<bullet> y <= norm x * norm y"
+proof-
+ {assume "norm x = 0"
+ hence ?thesis by (simp add: dot_lzero dot_rzero)}
+ moreover
+ {assume "norm y = 0"
+ hence ?thesis by (simp add: dot_lzero dot_rzero)}
+ moreover
+ {assume h: "norm x \<noteq> 0" "norm y \<noteq> 0"
+ let ?z = "norm y *s x - norm x *s y"
+ from h have p: "norm x * norm y > 0" by (metis norm_ge_zero le_less zero_compare_simps)
+ from dot_pos_le[of ?z]
+ have "(norm x * norm y) * (x \<bullet> y) \<le> norm x ^2 * norm y ^2"
+ apply (simp add: dot_rsub dot_lsub dot_lmult dot_rmult ring_simps)
+ by (simp add: norm_pow_2[symmetric] power2_eq_square dot_sym)
+ hence "x\<bullet>y \<le> (norm x ^2 * norm y ^2) / (norm x * norm y)" using p
+ by (simp add: field_simps)
+ hence ?thesis using h by (simp add: power2_eq_square)}
+ ultimately show ?thesis by metis
+qed
+
+lemma norm_cauchy_schwarz_abs:
+ fixes x y :: "real ^ 'n::finite"
+ shows "\<bar>x \<bullet> y\<bar> \<le> norm x * norm y"
+ using norm_cauchy_schwarz[of x y] norm_cauchy_schwarz[of x "-y"]
+ by (simp add: real_abs_def dot_rneg)
+
+lemma norm_triangle_sub:
+ fixes x y :: "'a::real_normed_vector"
+ shows "norm x \<le> norm y + norm (x - y)"
+ using norm_triangle_ineq[of "y" "x - y"] by (simp add: ring_simps)
+
+lemma norm_triangle_le: "norm(x::real ^'n::finite) + norm y <= e ==> norm(x + y) <= e"
+ by (metis order_trans norm_triangle_ineq)
+lemma norm_triangle_lt: "norm(x::real ^'n::finite) + norm(y) < e ==> norm(x + y) < e"
+ by (metis basic_trans_rules(21) norm_triangle_ineq)
+
+lemma component_le_norm: "\<bar>x$i\<bar> <= norm (x::real ^ 'n::finite)"
+ apply (simp add: norm_vector_def)
+ apply (rule member_le_setL2, simp_all)
+ done
+
+lemma norm_bound_component_le: "norm(x::real ^ 'n::finite) <= e
+ ==> \<bar>x$i\<bar> <= e"
+ by (metis component_le_norm order_trans)
+
+lemma norm_bound_component_lt: "norm(x::real ^ 'n::finite) < e
+ ==> \<bar>x$i\<bar> < e"
+ by (metis component_le_norm basic_trans_rules(21))
+
+lemma norm_le_l1: "norm (x:: real ^'n::finite) <= setsum(\<lambda>i. \<bar>x$i\<bar>) UNIV"
+ by (simp add: norm_vector_def setL2_le_setsum)
+
+lemma real_abs_norm: "\<bar>norm x\<bar> = norm (x :: real ^ _)"
+ by (rule abs_norm_cancel)
+lemma real_abs_sub_norm: "\<bar>norm(x::real ^'n::finite) - norm y\<bar> <= norm(x - y)"
+ by (rule norm_triangle_ineq3)
+lemma norm_le: "norm(x::real ^ _) <= norm(y) \<longleftrightarrow> x \<bullet> x <= y \<bullet> y"
+ by (simp add: real_vector_norm_def)
+lemma norm_lt: "norm(x::real ^ _) < norm(y) \<longleftrightarrow> x \<bullet> x < y \<bullet> y"
+ by (simp add: real_vector_norm_def)
+lemma norm_eq: "norm (x::real ^ _) = norm y \<longleftrightarrow> x \<bullet> x = y \<bullet> y"
+ by (simp add: order_eq_iff norm_le)
+lemma norm_eq_1: "norm(x::real ^ _) = 1 \<longleftrightarrow> x \<bullet> x = 1"
+ by (simp add: real_vector_norm_def)
+
+text{* Squaring equations and inequalities involving norms. *}
+
+lemma dot_square_norm: "x \<bullet> x = norm(x)^2"
+ by (simp add: real_vector_norm_def)
+
+lemma norm_eq_square: "norm(x) = a \<longleftrightarrow> 0 <= a \<and> x \<bullet> x = a^2"
+ by (auto simp add: real_vector_norm_def)
+
+lemma real_abs_le_square_iff: "\<bar>x\<bar> \<le> \<bar>y\<bar> \<longleftrightarrow> (x::real)^2 \<le> y^2"
+proof-
+ have "x^2 \<le> y^2 \<longleftrightarrow> (x -y) * (y + x) \<le> 0" by (simp add: ring_simps power2_eq_square)
+ also have "\<dots> \<longleftrightarrow> \<bar>x\<bar> \<le> \<bar>y\<bar>" apply (simp add: zero_compare_simps real_abs_def not_less) by arith
+finally show ?thesis ..
+qed
+
+lemma norm_le_square: "norm(x) <= a \<longleftrightarrow> 0 <= a \<and> x \<bullet> x <= a^2"
+ apply (simp add: dot_square_norm real_abs_le_square_iff[symmetric])
+ using norm_ge_zero[of x]
+ apply arith
+ done
+
+lemma norm_ge_square: "norm(x) >= a \<longleftrightarrow> a <= 0 \<or> x \<bullet> x >= a ^ 2"
+ apply (simp add: dot_square_norm real_abs_le_square_iff[symmetric])
+ using norm_ge_zero[of x]
+ apply arith
+ done
+
+lemma norm_lt_square: "norm(x) < a \<longleftrightarrow> 0 < a \<and> x \<bullet> x < a^2"
+ by (metis not_le norm_ge_square)
+lemma norm_gt_square: "norm(x) > a \<longleftrightarrow> a < 0 \<or> x \<bullet> x > a^2"
+ by (metis norm_le_square not_less)
+
+text{* Dot product in terms of the norm rather than conversely. *}
+
+lemma dot_norm: "x \<bullet> y = (norm(x + y) ^2 - norm x ^ 2 - norm y ^ 2) / 2"
+ by (simp add: norm_pow_2 dot_ladd dot_radd dot_sym)
+
+lemma dot_norm_neg: "x \<bullet> y = ((norm x ^ 2 + norm y ^ 2) - norm(x - y) ^ 2) / 2"
+ by (simp add: norm_pow_2 dot_ladd dot_radd dot_lsub dot_rsub dot_sym)
+
+
+text{* Equality of vectors in terms of @{term "op \<bullet>"} products. *}
+
+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")
+proof
+ assume "?lhs" then show ?rhs by simp
+next
+ assume ?rhs
+ then have "x \<bullet> x - x \<bullet> y = 0 \<and> x \<bullet> y - y\<bullet> y = 0" by simp
+ hence "x \<bullet> (x - y) = 0 \<and> y \<bullet> (x - y) = 0"
+ by (simp add: dot_rsub dot_lsub dot_sym)
+ then have "(x - y) \<bullet> (x - y) = 0" by (simp add: ring_simps dot_lsub dot_rsub)
+ then show "x = y" by (simp add: dot_eq_0)
+qed
+
+
+subsection{* General linear decision procedure for normed spaces. *}
+
+lemma norm_cmul_rule_thm:
+ fixes x :: "'a::real_normed_vector"
+ shows "b >= norm(x) ==> \<bar>c\<bar> * b >= norm(scaleR c x)"
+ unfolding norm_scaleR
+ apply (erule mult_mono1)
+ apply simp
+ done
+
+ (* FIXME: Move all these theorems into the ML code using lemma antiquotation *)
+lemma norm_add_rule_thm:
+ fixes x1 x2 :: "'a::real_normed_vector"
+ shows "norm x1 \<le> b1 \<Longrightarrow> norm x2 \<le> b2 \<Longrightarrow> norm (x1 + x2) \<le> b1 + b2"
+ by (rule order_trans [OF norm_triangle_ineq add_mono])
+
+lemma ge_iff_diff_ge_0: "(a::'a::ordered_ring) \<ge> b == a - b \<ge> 0"
+ by (simp add: ring_simps)
+
+lemma pth_1:
+ fixes x :: "'a::real_normed_vector"
+ shows "x == scaleR 1 x" by simp
+
+lemma pth_2:
+ fixes x :: "'a::real_normed_vector"
+ shows "x - y == x + -y" by (atomize (full)) simp
+
+lemma pth_3:
+ fixes x :: "'a::real_normed_vector"
+ shows "- x == scaleR (-1) x" by simp
+
+lemma pth_4:
+ fixes x :: "'a::real_normed_vector"
+ shows "scaleR 0 x == 0" and "scaleR c 0 = (0::'a)" by simp_all
+
+lemma pth_5:
+ fixes x :: "'a::real_normed_vector"
+ shows "scaleR c (scaleR d x) == scaleR (c * d) x" by simp
+
+lemma pth_6:
+ fixes x :: "'a::real_normed_vector"
+ shows "scaleR c (x + y) == scaleR c x + scaleR c y"
+ by (simp add: scaleR_right_distrib)
+
+lemma pth_7:
+ fixes x :: "'a::real_normed_vector"
+ shows "0 + x == x" and "x + 0 == x" by simp_all
+
+lemma pth_8:
+ fixes x :: "'a::real_normed_vector"
+ shows "scaleR c x + scaleR d x == scaleR (c + d) x"
+ by (simp add: scaleR_left_distrib)
+
+lemma pth_9:
+ fixes x :: "'a::real_normed_vector" shows
+ "(scaleR c x + z) + scaleR d x == scaleR (c + d) x + z"
+ "scaleR c x + (scaleR d x + z) == scaleR (c + d) x + z"
+ "(scaleR c x + w) + (scaleR d x + z) == scaleR (c + d) x + (w + z)"
+ by (simp_all add: algebra_simps)
+
+lemma pth_a:
+ fixes x :: "'a::real_normed_vector"
+ shows "scaleR 0 x + y == y" by simp
+
+lemma pth_b:
+ fixes x :: "'a::real_normed_vector" shows
+ "scaleR c x + scaleR d y == scaleR c x + scaleR d y"
+ "(scaleR c x + z) + scaleR d y == scaleR c x + (z + scaleR d y)"
+ "scaleR c x + (scaleR d y + z) == scaleR c x + (scaleR d y + z)"
+ "(scaleR c x + w) + (scaleR d y + z) == scaleR c x + (w + (scaleR d y + z))"
+ by (simp_all add: algebra_simps)
+
+lemma pth_c:
+ fixes x :: "'a::real_normed_vector" shows
+ "scaleR c x + scaleR d y == scaleR d y + scaleR c x"
+ "(scaleR c x + z) + scaleR d y == scaleR d y + (scaleR c x + z)"
+ "scaleR c x + (scaleR d y + z) == scaleR d y + (scaleR c x + z)"
+ "(scaleR c x + w) + (scaleR d y + z) == scaleR d y + ((scaleR c x + w) + z)"
+ by (simp_all add: algebra_simps)
+
+lemma pth_d:
+ fixes x :: "'a::real_normed_vector"
+ shows "x + 0 == x" by simp
+
+lemma norm_imp_pos_and_ge:
+ fixes x :: "'a::real_normed_vector"
+ shows "norm x == n \<Longrightarrow> norm x \<ge> 0 \<and> n \<ge> norm x"
+ by atomize auto
+
+lemma real_eq_0_iff_le_ge_0: "(x::real) = 0 == x \<ge> 0 \<and> -x \<ge> 0" by arith
+
+lemma norm_pths:
+ fixes x :: "'a::real_normed_vector" shows
+ "x = y \<longleftrightarrow> norm (x - y) \<le> 0"
+ "x \<noteq> y \<longleftrightarrow> \<not> (norm (x - y) \<le> 0)"
+ using norm_ge_zero[of "x - y"] by auto
+
+lemma vector_dist_norm:
+ fixes x :: "'a::real_normed_vector"
+ shows "dist x y = norm (x - y)"
+ by (rule dist_norm)
+
+use "normarith.ML"
+
+method_setup norm = {* Scan.succeed (SIMPLE_METHOD' o NormArith.norm_arith_tac)
+*} "Proves simple linear statements about vector norms"
+
+
+text{* Hence more metric properties. *}
+
+lemma dist_triangle_alt:
+ fixes x y z :: "'a::metric_space"
+ shows "dist y z <= dist x y + dist x z"
+using dist_triangle [of y z x] by (simp add: dist_commute)
+
+lemma dist_pos_lt:
+ fixes x y :: "'a::metric_space"
+ shows "x \<noteq> y ==> 0 < dist x y"
+by (simp add: zero_less_dist_iff)
+
+lemma dist_nz:
+ fixes x y :: "'a::metric_space"
+ shows "x \<noteq> y \<longleftrightarrow> 0 < dist x y"
+by (simp add: zero_less_dist_iff)
+
+lemma dist_triangle_le:
+ fixes x y z :: "'a::metric_space"
+ shows "dist x z + dist y z <= e \<Longrightarrow> dist x y <= e"
+by (rule order_trans [OF dist_triangle2])
+
+lemma dist_triangle_lt:
+ fixes x y z :: "'a::metric_space"
+ shows "dist x z + dist y z < e ==> dist x y < e"
+by (rule le_less_trans [OF dist_triangle2])
+
+lemma dist_triangle_half_l:
+ fixes x1 x2 y :: "'a::metric_space"
+ shows "dist x1 y < e / 2 \<Longrightarrow> dist x2 y < e / 2 \<Longrightarrow> dist x1 x2 < e"
+by (rule dist_triangle_lt [where z=y], simp)
+
+lemma dist_triangle_half_r:
+ fixes x1 x2 y :: "'a::metric_space"
+ shows "dist y x1 < e / 2 \<Longrightarrow> dist y x2 < e / 2 \<Longrightarrow> dist x1 x2 < e"
+by (rule dist_triangle_half_l, simp_all add: dist_commute)
+
+lemma dist_triangle_add:
+ fixes x y x' y' :: "'a::real_normed_vector"
+ shows "dist (x + y) (x' + y') <= dist x x' + dist y y'"
+ by norm
+
+lemma dist_mul[simp]: "dist (c *s x) (c *s y) = \<bar>c\<bar> * dist x y"
+ unfolding dist_norm vector_ssub_ldistrib[symmetric] norm_mul ..
+
+lemma dist_triangle_add_half:
+ fixes x x' y y' :: "'a::real_normed_vector"
+ shows "dist x x' < e / 2 \<Longrightarrow> dist y y' < e / 2 \<Longrightarrow> dist(x + y) (x' + y') < e"
+ by norm
+
+lemma setsum_component [simp]:
+ fixes f:: " 'a \<Rightarrow> ('b::comm_monoid_add) ^'n"
+ shows "(setsum f S)$i = setsum (\<lambda>x. (f x)$i) S"
+ by (cases "finite S", induct S set: finite, simp_all)
+
+lemma setsum_eq: "setsum f S = (\<chi> i. setsum (\<lambda>x. (f x)$i ) S)"
+ by (simp add: Cart_eq)
+
+lemma setsum_clauses:
+ shows "setsum f {} = 0"
+ and "finite S \<Longrightarrow> setsum f (insert x S) =
+ (if x \<in> S then setsum f S else f x + setsum f S)"
+ by (auto simp add: insert_absorb)
+
+lemma setsum_cmul:
+ fixes f:: "'c \<Rightarrow> ('a::semiring_1)^'n"
+ shows "setsum (\<lambda>x. c *s f x) S = c *s setsum f S"
+ by (simp add: Cart_eq setsum_right_distrib)
+
+lemma setsum_norm:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ assumes fS: "finite S"
+ shows "norm (setsum f S) <= setsum (\<lambda>x. norm(f x)) S"
+proof(induct rule: finite_induct[OF fS])
+ case 1 thus ?case by simp
+next
+ case (2 x S)
+ from "2.hyps" have "norm (setsum f (insert x S)) \<le> norm (f x) + norm (setsum f S)" by (simp add: norm_triangle_ineq)
+ also have "\<dots> \<le> norm (f x) + setsum (\<lambda>x. norm(f x)) S"
+ using "2.hyps" by simp
+ finally show ?case using "2.hyps" by simp
+qed
+
+lemma real_setsum_norm:
+ fixes f :: "'a \<Rightarrow> real ^'n::finite"
+ assumes fS: "finite S"
+ shows "norm (setsum f S) <= setsum (\<lambda>x. norm(f x)) S"
+proof(induct rule: finite_induct[OF fS])
+ case 1 thus ?case by simp
+next
+ case (2 x S)
+ from "2.hyps" have "norm (setsum f (insert x S)) \<le> norm (f x) + norm (setsum f S)" by (simp add: norm_triangle_ineq)
+ also have "\<dots> \<le> norm (f x) + setsum (\<lambda>x. norm(f x)) S"
+ using "2.hyps" by simp
+ finally show ?case using "2.hyps" by simp
+qed
+
+lemma setsum_norm_le:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ assumes fS: "finite S"
+ and fg: "\<forall>x \<in> S. norm (f x) \<le> g x"
+ shows "norm (setsum f S) \<le> setsum g S"
+proof-
+ from fg have "setsum (\<lambda>x. norm(f x)) S <= setsum g S"
+ by - (rule setsum_mono, simp)
+ then show ?thesis using setsum_norm[OF fS, of f] fg
+ by arith
+qed
+
+lemma real_setsum_norm_le:
+ fixes f :: "'a \<Rightarrow> real ^ 'n::finite"
+ assumes fS: "finite S"
+ and fg: "\<forall>x \<in> S. norm (f x) \<le> g x"
+ shows "norm (setsum f S) \<le> setsum g S"
+proof-
+ from fg have "setsum (\<lambda>x. norm(f x)) S <= setsum g S"
+ by - (rule setsum_mono, simp)
+ then show ?thesis using real_setsum_norm[OF fS, of f] fg
+ by arith
+qed
+
+lemma setsum_norm_bound:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ assumes fS: "finite S"
+ and K: "\<forall>x \<in> S. norm (f x) \<le> K"
+ shows "norm (setsum f S) \<le> of_nat (card S) * K"
+ using setsum_norm_le[OF fS K] setsum_constant[symmetric]
+ by simp
+
+lemma real_setsum_norm_bound:
+ fixes f :: "'a \<Rightarrow> real ^ 'n::finite"
+ assumes fS: "finite S"
+ and K: "\<forall>x \<in> S. norm (f x) \<le> K"
+ shows "norm (setsum f S) \<le> of_nat (card S) * K"
+ using real_setsum_norm_le[OF fS K] setsum_constant[symmetric]
+ by simp
+
+lemma setsum_vmul:
+ fixes f :: "'a \<Rightarrow> 'b::{real_normed_vector,semiring, mult_zero}"
+ assumes fS: "finite S"
+ shows "setsum f S *s v = setsum (\<lambda>x. f x *s v) S"
+proof(induct rule: finite_induct[OF fS])
+ case 1 then show ?case by (simp add: vector_smult_lzero)
+next
+ case (2 x F)
+ from "2.hyps" have "setsum f (insert x F) *s v = (f x + setsum f F) *s v"
+ by simp
+ also have "\<dots> = f x *s v + setsum f F *s v"
+ by (simp add: vector_sadd_rdistrib)
+ also have "\<dots> = setsum (\<lambda>x. f x *s v) (insert x F)" using "2.hyps" by simp
+ finally show ?case .
+qed
+
+(* FIXME : Problem thm setsum_vmul[of _ "f:: 'a \<Rightarrow> real ^'n"] ---
+ Get rid of *s and use real_vector instead! Also prove that ^ creates a real_vector !! *)
+
+ (* FIXME: Here too need stupid finiteness assumption on T!!! *)
+lemma setsum_group:
+ assumes fS: "finite S" and fT: "finite T" and fST: "f ` S \<subseteq> T"
+ shows "setsum (\<lambda>y. setsum g {x. x\<in> S \<and> f x = y}) T = setsum g S"
+
+apply (subst setsum_image_gen[OF fS, of g f])
+apply (rule setsum_mono_zero_right[OF fT fST])
+by (auto intro: setsum_0')
+
+lemma vsum_norm_allsubsets_bound:
+ fixes f:: "'a \<Rightarrow> real ^'n::finite"
+ assumes fP: "finite P" and fPs: "\<And>Q. Q \<subseteq> P \<Longrightarrow> norm (setsum f Q) \<le> e"
+ shows "setsum (\<lambda>x. norm (f x)) P \<le> 2 * real CARD('n) * e"
+proof-
+ let ?d = "real CARD('n)"
+ let ?nf = "\<lambda>x. norm (f x)"
+ let ?U = "UNIV :: 'n set"
+ 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"
+ by (rule setsum_commute)
+ have th1: "2 * ?d * e = of_nat (card ?U) * (2 * e)" by (simp add: real_of_nat_def)
+ have "setsum ?nf P \<le> setsum (\<lambda>x. setsum (\<lambda>i. \<bar>f x $ i\<bar>) ?U) P"
+ apply (rule setsum_mono)
+ by (rule norm_le_l1)
+ also have "\<dots> \<le> 2 * ?d * e"
+ unfolding th0 th1
+ proof(rule setsum_bounded)
+ fix i assume i: "i \<in> ?U"
+ let ?Pp = "{x. x\<in> P \<and> f x $ i \<ge> 0}"
+ let ?Pn = "{x. x \<in> P \<and> f x $ i < 0}"
+ have thp: "P = ?Pp \<union> ?Pn" by auto
+ have thp0: "?Pp \<inter> ?Pn ={}" by auto
+ have PpP: "?Pp \<subseteq> P" and PnP: "?Pn \<subseteq> P" by blast+
+ have Ppe:"setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pp \<le> e"
+ using component_le_norm[of "setsum (\<lambda>x. f x) ?Pp" i] fPs[OF PpP]
+ by (auto intro: abs_le_D1)
+ have Pne: "setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pn \<le> e"
+ using component_le_norm[of "setsum (\<lambda>x. - f x) ?Pn" i] fPs[OF PnP]
+ by (auto simp add: setsum_negf intro: abs_le_D1)
+ 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"
+ apply (subst thp)
+ apply (rule setsum_Un_zero)
+ using fP thp0 by auto
+ also have "\<dots> \<le> 2*e" using Pne Ppe by arith
+ finally show "setsum (\<lambda>x. \<bar>f x $ i\<bar>) P \<le> 2*e" .
+ qed
+ finally show ?thesis .
+qed
+
+lemma dot_lsum: "finite S \<Longrightarrow> setsum f S \<bullet> (y::'a::{comm_ring}^'n) = setsum (\<lambda>x. f x \<bullet> y) S "
+ by (induct rule: finite_induct, auto simp add: dot_lzero dot_ladd dot_radd)
+
+lemma dot_rsum: "finite S \<Longrightarrow> (y::'a::{comm_ring}^'n) \<bullet> setsum f S = setsum (\<lambda>x. y \<bullet> f x) S "
+ by (induct rule: finite_induct, auto simp add: dot_rzero dot_radd)
+
+subsection{* Basis vectors in coordinate directions. *}
+
+
+definition "basis k = (\<chi> i. if i = k then 1 else 0)"
+
+lemma basis_component [simp]: "basis k $ i = (if k=i then 1 else 0)"
+ unfolding basis_def by simp
+
+lemma delta_mult_idempotent:
+ "(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)
+
+lemma norm_basis:
+ shows "norm (basis k :: real ^'n::finite) = 1"
+ apply (simp add: basis_def real_vector_norm_def dot_def)
+ apply (vector delta_mult_idempotent)
+ using setsum_delta[of "UNIV :: 'n set" "k" "\<lambda>k. 1::real"]
+ apply auto
+ done
+
+lemma norm_basis_1: "norm(basis 1 :: real ^'n::{finite,one}) = 1"
+ by (rule norm_basis)
+
+lemma vector_choose_size: "0 <= c ==> \<exists>(x::real^'n::finite). norm x = c"
+ apply (rule exI[where x="c *s basis arbitrary"])
+ by (simp only: norm_mul norm_basis)
+
+lemma vector_choose_dist: assumes e: "0 <= e"
+ shows "\<exists>(y::real^'n::finite). dist x y = e"
+proof-
+ from vector_choose_size[OF e] obtain c:: "real ^'n" where "norm c = e"
+ by blast
+ then have "dist x (x - c) = e" by (simp add: dist_norm)
+ then show ?thesis by blast
+qed
+
+lemma basis_inj: "inj (basis :: 'n \<Rightarrow> real ^'n::finite)"
+ by (simp add: inj_on_def Cart_eq)
+
+lemma cond_value_iff: "f (if b then x else y) = (if b then f x else f y)"
+ by auto
+
+lemma basis_expansion:
+ "setsum (\<lambda>i. (x$i) *s basis i) UNIV = (x::('a::ring_1) ^'n::finite)" (is "?lhs = ?rhs" is "setsum ?f ?S = _")
+ by (auto simp add: Cart_eq cond_value_iff setsum_delta[of "?S", where ?'b = "'a", simplified] cong del: if_weak_cong)
+
+lemma basis_expansion_unique:
+ "setsum (\<lambda>i. f i *s basis i) UNIV = (x::('a::comm_ring_1) ^'n::finite) \<longleftrightarrow> (\<forall>i. f i = x$i)"
+ by (simp add: Cart_eq setsum_delta cond_value_iff cong del: if_weak_cong)
+
+lemma cond_application_beta: "(if b then f else g) x = (if b then f x else g x)"
+ by auto
+
+lemma dot_basis:
+ shows "basis i \<bullet> x = x$i" "x \<bullet> (basis i :: 'a^'n::finite) = (x$i :: 'a::semiring_1)"
+ by (auto simp add: dot_def basis_def cond_application_beta cond_value_iff setsum_delta cong del: if_weak_cong)
+
+lemma inner_basis:
+ fixes x :: "'a::{real_inner, real_algebra_1} ^ 'n::finite"
+ shows "inner (basis i) x = inner 1 (x $ i)"
+ and "inner x (basis i) = inner (x $ i) 1"
+ unfolding inner_vector_def basis_def
+ by (auto simp add: cond_application_beta cond_value_iff setsum_delta cong del: if_weak_cong)
+
+lemma basis_eq_0: "basis i = (0::'a::semiring_1^'n) \<longleftrightarrow> False"
+ by (auto simp add: Cart_eq)
+
+lemma basis_nonzero:
+ shows "basis k \<noteq> (0:: 'a::semiring_1 ^'n)"
+ by (simp add: basis_eq_0)
+
+lemma vector_eq_ldot: "(\<forall>x. x \<bullet> y = x \<bullet> z) \<longleftrightarrow> y = (z::'a::semiring_1^'n::finite)"
+ apply (auto simp add: Cart_eq dot_basis)
+ apply (erule_tac x="basis i" in allE)
+ apply (simp add: dot_basis)
+ apply (subgoal_tac "y = z")
+ apply simp
+ apply (simp add: Cart_eq)
+ done
+
+lemma vector_eq_rdot: "(\<forall>z. x \<bullet> z = y \<bullet> z) \<longleftrightarrow> x = (y::'a::semiring_1^'n::finite)"
+ apply (auto simp add: Cart_eq dot_basis)
+ apply (erule_tac x="basis i" in allE)
+ apply (simp add: dot_basis)
+ apply (subgoal_tac "x = y")
+ apply simp
+ apply (simp add: Cart_eq)
+ done
+
+subsection{* Orthogonality. *}
+
+definition "orthogonal x y \<longleftrightarrow> (x \<bullet> y = 0)"
+
+lemma orthogonal_basis:
+ shows "orthogonal (basis i :: 'a^'n::finite) x \<longleftrightarrow> x$i = (0::'a::ring_1)"
+ by (auto simp add: orthogonal_def dot_def basis_def cond_value_iff cond_application_beta setsum_delta cong del: if_weak_cong)
+
+lemma orthogonal_basis_basis:
+ shows "orthogonal (basis i :: 'a::ring_1^'n::finite) (basis j) \<longleftrightarrow> i \<noteq> j"
+ unfolding orthogonal_basis[of i] basis_component[of j] by simp
+
+ (* FIXME : Maybe some of these require less than comm_ring, but not all*)
+lemma orthogonal_clauses:
+ "orthogonal a (0::'a::comm_ring ^'n)"
+ "orthogonal a x ==> orthogonal a (c *s x)"
+ "orthogonal a x ==> orthogonal a (-x)"
+ "orthogonal a x \<Longrightarrow> orthogonal a y ==> orthogonal a (x + y)"
+ "orthogonal a x \<Longrightarrow> orthogonal a y ==> orthogonal a (x - y)"
+ "orthogonal 0 a"
+ "orthogonal x a ==> orthogonal (c *s x) a"
+ "orthogonal x a ==> orthogonal (-x) a"
+ "orthogonal x a \<Longrightarrow> orthogonal y a ==> orthogonal (x + y) a"
+ "orthogonal x a \<Longrightarrow> orthogonal y a ==> orthogonal (x - y) a"
+ unfolding orthogonal_def dot_rneg dot_rmult dot_radd dot_rsub
+ dot_lzero dot_rzero dot_lneg dot_lmult dot_ladd dot_lsub
+ by simp_all
+
+lemma orthogonal_commute: "orthogonal (x::'a::{ab_semigroup_mult,comm_monoid_add} ^'n)y \<longleftrightarrow> orthogonal y x"
+ by (simp add: orthogonal_def dot_sym)
+
+subsection{* Explicit vector construction from lists. *}
+
+primrec from_nat :: "nat \<Rightarrow> 'a::{monoid_add,one}"
+where "from_nat 0 = 0" | "from_nat (Suc n) = 1 + from_nat n"
+
+lemma from_nat [simp]: "from_nat = of_nat"
+by (rule ext, induct_tac x, simp_all)
+
+primrec
+ list_fun :: "nat \<Rightarrow> _ list \<Rightarrow> _ \<Rightarrow> _"
+where
+ "list_fun n [] = (\<lambda>x. 0)"
+| "list_fun n (x # xs) = fun_upd (list_fun (Suc n) xs) (from_nat n) x"
+
+definition "vector l = (\<chi> i. list_fun 1 l i)"
+(*definition "vector l = (\<chi> i. if i <= length l then l ! (i - 1) else 0)"*)
+
+lemma vector_1: "(vector[x]) $1 = x"
+ unfolding vector_def by simp
+
+lemma vector_2:
+ "(vector[x,y]) $1 = x"
+ "(vector[x,y] :: 'a^2)$2 = (y::'a::zero)"
+ unfolding vector_def by simp_all
+
+lemma vector_3:
+ "(vector [x,y,z] ::('a::zero)^3)$1 = x"
+ "(vector [x,y,z] ::('a::zero)^3)$2 = y"
+ "(vector [x,y,z] ::('a::zero)^3)$3 = z"
+ unfolding vector_def by simp_all
+
+lemma forall_vector_1: "(\<forall>v::'a::zero^1. P v) \<longleftrightarrow> (\<forall>x. P(vector[x]))"
+ apply auto
+ apply (erule_tac x="v$1" in allE)
+ apply (subgoal_tac "vector [v$1] = v")
+ apply simp
+ apply (vector vector_def)
+ apply (simp add: forall_1)
+ done
+
+lemma forall_vector_2: "(\<forall>v::'a::zero^2. P v) \<longleftrightarrow> (\<forall>x y. P(vector[x, y]))"
+ apply auto
+ apply (erule_tac x="v$1" in allE)
+ apply (erule_tac x="v$2" in allE)
+ apply (subgoal_tac "vector [v$1, v$2] = v")
+ apply simp
+ apply (vector vector_def)
+ apply (simp add: forall_2)
+ done
+
+lemma forall_vector_3: "(\<forall>v::'a::zero^3. P v) \<longleftrightarrow> (\<forall>x y z. P(vector[x, y, z]))"
+ apply auto
+ apply (erule_tac x="v$1" in allE)
+ apply (erule_tac x="v$2" in allE)
+ apply (erule_tac x="v$3" in allE)
+ apply (subgoal_tac "vector [v$1, v$2, v$3] = v")
+ apply simp
+ apply (vector vector_def)
+ apply (simp add: forall_3)
+ done
+
+subsection{* Linear functions. *}
+
+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)"
+
+lemma linear_compose_cmul: "linear f ==> linear (\<lambda>x. (c::'a::comm_semiring) *s f x)"
+ by (vector linear_def Cart_eq ring_simps)
+
+lemma linear_compose_neg: "linear (f :: 'a ^'n \<Rightarrow> 'a::comm_ring ^'m) ==> linear (\<lambda>x. -(f(x)))" by (vector linear_def Cart_eq)
+
+lemma linear_compose_add: "linear (f :: 'a ^'n \<Rightarrow> 'a::semiring_1 ^'m) \<Longrightarrow> linear g ==> linear (\<lambda>x. f(x) + g(x))"
+ by (vector linear_def Cart_eq ring_simps)
+
+lemma linear_compose_sub: "linear (f :: 'a ^'n \<Rightarrow> 'a::ring_1 ^'m) \<Longrightarrow> linear g ==> linear (\<lambda>x. f x - g x)"
+ by (vector linear_def Cart_eq ring_simps)
+
+lemma linear_compose: "linear f \<Longrightarrow> linear g ==> linear (g o f)"
+ by (simp add: linear_def)
+
+lemma linear_id: "linear id" by (simp add: linear_def id_def)
+
+lemma linear_zero: "linear (\<lambda>x. 0::'a::semiring_1 ^ 'n)" by (simp add: linear_def)
+
+lemma linear_compose_setsum:
+ assumes fS: "finite S" and lS: "\<forall>a \<in> S. linear (f a :: 'a::semiring_1 ^ 'n \<Rightarrow> 'a ^ 'm)"
+ shows "linear(\<lambda>x. setsum (\<lambda>a. f a x :: 'a::semiring_1 ^'m) S)"
+ using lS
+ apply (induct rule: finite_induct[OF fS])
+ by (auto simp add: linear_zero intro: linear_compose_add)
+
+lemma linear_vmul_component:
+ fixes f:: "'a::semiring_1^'m \<Rightarrow> 'a^'n"
+ assumes lf: "linear f"
+ shows "linear (\<lambda>x. f x $ k *s v)"
+ using lf
+ apply (auto simp add: linear_def )
+ by (vector ring_simps)+
+
+lemma linear_0: "linear f ==> f 0 = (0::'a::semiring_1 ^'n)"
+ unfolding linear_def
+ apply clarsimp
+ apply (erule allE[where x="0::'a"])
+ apply simp
+ done
+
+lemma linear_cmul: "linear f ==> f(c*s x) = c *s f x" by (simp add: linear_def)
+
+lemma linear_neg: "linear (f :: 'a::ring_1 ^'n \<Rightarrow> _) ==> f (-x) = - f x"
+ unfolding vector_sneg_minus1
+ using linear_cmul[of f] by auto
+
+lemma linear_add: "linear f ==> f(x + y) = f x + f y" by (metis linear_def)
+
+lemma linear_sub: "linear (f::'a::ring_1 ^'n \<Rightarrow> _) ==> f(x - y) = f x - f y"
+ by (simp add: diff_def linear_add linear_neg)
+
+lemma linear_setsum:
+ fixes f:: "'a::semiring_1^'n \<Rightarrow> _"
+ assumes lf: "linear f" and fS: "finite S"
+ shows "f (setsum g S) = setsum (f o g) S"
+proof (induct rule: finite_induct[OF fS])
+ case 1 thus ?case by (simp add: linear_0[OF lf])
+next
+ case (2 x F)
+ have "f (setsum g (insert x F)) = f (g x + setsum g F)" using "2.hyps"
+ by simp
+ also have "\<dots> = f (g x) + f (setsum g F)" using linear_add[OF lf] by simp
+ also have "\<dots> = setsum (f o g) (insert x F)" using "2.hyps" by simp
+ finally show ?case .
+qed
+
+lemma linear_setsum_mul:
+ fixes f:: "'a ^'n \<Rightarrow> 'a::semiring_1^'m"
+ assumes lf: "linear f" and fS: "finite S"
+ shows "f (setsum (\<lambda>i. c i *s v i) S) = setsum (\<lambda>i. c i *s f (v i)) S"
+ using linear_setsum[OF lf fS, of "\<lambda>i. c i *s v i" , unfolded o_def]
+ linear_cmul[OF lf] by simp
+
+lemma linear_injective_0:
+ assumes lf: "linear (f:: 'a::ring_1 ^ 'n \<Rightarrow> _)"
+ shows "inj f \<longleftrightarrow> (\<forall>x. f x = 0 \<longrightarrow> x = 0)"
+proof-
+ have "inj f \<longleftrightarrow> (\<forall> x y. f x = f y \<longrightarrow> x = y)" by (simp add: inj_on_def)
+ also have "\<dots> \<longleftrightarrow> (\<forall> x y. f x - f y = 0 \<longrightarrow> x - y = 0)" by simp
+ also have "\<dots> \<longleftrightarrow> (\<forall> x y. f (x - y) = 0 \<longrightarrow> x - y = 0)"
+ by (simp add: linear_sub[OF lf])
+ also have "\<dots> \<longleftrightarrow> (\<forall> x. f x = 0 \<longrightarrow> x = 0)" by auto
+ finally show ?thesis .
+qed
+
+lemma linear_bounded:
+ fixes f:: "real ^'m::finite \<Rightarrow> real ^'n::finite"
+ assumes lf: "linear f"
+ shows "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
+proof-
+ let ?S = "UNIV:: 'm set"
+ let ?B = "setsum (\<lambda>i. norm(f(basis i))) ?S"
+ have fS: "finite ?S" by simp
+ {fix x:: "real ^ 'm"
+ let ?g = "(\<lambda>i. (x$i) *s (basis i) :: real ^ 'm)"
+ have "norm (f x) = norm (f (setsum (\<lambda>i. (x$i) *s (basis i)) ?S))"
+ by (simp only: basis_expansion)
+ also have "\<dots> = norm (setsum (\<lambda>i. (x$i) *s f (basis i))?S)"
+ using linear_setsum[OF lf fS, of ?g, unfolded o_def] linear_cmul[OF lf]
+ by auto
+ finally have th0: "norm (f x) = norm (setsum (\<lambda>i. (x$i) *s f (basis i))?S)" .
+ {fix i assume i: "i \<in> ?S"
+ from component_le_norm[of x i]
+ have "norm ((x$i) *s f (basis i :: real ^'m)) \<le> norm (f (basis i)) * norm x"
+ unfolding norm_mul
+ apply (simp only: mult_commute)
+ apply (rule mult_mono)
+ by (auto simp add: ring_simps norm_ge_zero) }
+ 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
+ from real_setsum_norm_le[OF fS, of "\<lambda>i. (x$i) *s (f (basis i))", OF th]
+ have "norm (f x) \<le> ?B * norm x" unfolding th0 setsum_left_distrib by metis}
+ then show ?thesis by blast
+qed
+
+lemma linear_bounded_pos:
+ fixes f:: "real ^'n::finite \<Rightarrow> real ^ 'm::finite"
+ assumes lf: "linear f"
+ shows "\<exists>B > 0. \<forall>x. norm (f x) \<le> B * norm x"
+proof-
+ from linear_bounded[OF lf] obtain B where
+ B: "\<forall>x. norm (f x) \<le> B * norm x" by blast
+ let ?K = "\<bar>B\<bar> + 1"
+ have Kp: "?K > 0" by arith
+ {assume C: "B < 0"
+ have "norm (1::real ^ 'n) > 0" by (simp add: zero_less_norm_iff)
+ with C have "B * norm (1:: real ^ 'n) < 0"
+ by (simp add: zero_compare_simps)
+ with B[rule_format, of 1] norm_ge_zero[of "f 1"] have False by simp
+ }
+ then have Bp: "B \<ge> 0" by ferrack
+ {fix x::"real ^ 'n"
+ have "norm (f x) \<le> ?K * norm x"
+ using B[rule_format, of x] norm_ge_zero[of x] norm_ge_zero[of "f x"] Bp
+ apply (auto simp add: ring_simps split add: abs_split)
+ apply (erule order_trans, simp)
+ done
+ }
+ then show ?thesis using Kp by blast
+qed
+
+lemma smult_conv_scaleR: "c *s x = scaleR c x"
+ unfolding vector_scalar_mult_def vector_scaleR_def by simp
+
+lemma linear_conv_bounded_linear:
+ fixes f :: "real ^ _ \<Rightarrow> real ^ _"
+ shows "linear f \<longleftrightarrow> bounded_linear f"
+proof
+ assume "linear f"
+ show "bounded_linear f"
+ proof
+ fix x y show "f (x + y) = f x + f y"
+ using `linear f` unfolding linear_def by simp
+ next
+ fix r x show "f (scaleR r x) = scaleR r (f x)"
+ using `linear f` unfolding linear_def
+ by (simp add: smult_conv_scaleR)
+ next
+ have "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
+ using `linear f` by (rule linear_bounded)
+ thus "\<exists>K. \<forall>x. norm (f x) \<le> norm x * K"
+ by (simp add: mult_commute)
+ qed
+next
+ assume "bounded_linear f"
+ then interpret f: bounded_linear f .
+ show "linear f"
+ unfolding linear_def smult_conv_scaleR
+ by (simp add: f.add f.scaleR)
+qed
+
+subsection{* Bilinear functions. *}
+
+definition "bilinear f \<longleftrightarrow> (\<forall>x. linear(\<lambda>y. f x y)) \<and> (\<forall>y. linear(\<lambda>x. f x y))"
+
+lemma bilinear_ladd: "bilinear h ==> h (x + y) z = (h x z) + (h y z)"
+ by (simp add: bilinear_def linear_def)
+lemma bilinear_radd: "bilinear h ==> h x (y + z) = (h x y) + (h x z)"
+ by (simp add: bilinear_def linear_def)
+
+lemma bilinear_lmul: "bilinear h ==> h (c *s x) y = c *s (h x y)"
+ by (simp add: bilinear_def linear_def)
+
+lemma bilinear_rmul: "bilinear h ==> h x (c *s y) = c *s (h x y)"
+ by (simp add: bilinear_def linear_def)
+
+lemma bilinear_lneg: "bilinear h ==> h (- (x:: 'a::ring_1 ^ 'n)) y = -(h x y)"
+ by (simp only: vector_sneg_minus1 bilinear_lmul)
+
+lemma bilinear_rneg: "bilinear h ==> h x (- (y:: 'a::ring_1 ^ 'n)) = - h x y"
+ by (simp only: vector_sneg_minus1 bilinear_rmul)
+
+lemma (in ab_group_add) eq_add_iff: "x = x + y \<longleftrightarrow> y = 0"
+ using add_imp_eq[of x y 0] by auto
+
+lemma bilinear_lzero:
+ fixes h :: "'a::ring^'n \<Rightarrow> _" assumes bh: "bilinear h" shows "h 0 x = 0"
+ using bilinear_ladd[OF bh, of 0 0 x]
+ by (simp add: eq_add_iff ring_simps)
+
+lemma bilinear_rzero:
+ fixes h :: "'a::ring^'n \<Rightarrow> _" assumes bh: "bilinear h" shows "h x 0 = 0"
+ using bilinear_radd[OF bh, of x 0 0 ]
+ by (simp add: eq_add_iff ring_simps)
+
+lemma bilinear_lsub: "bilinear h ==> h (x - (y:: 'a::ring_1 ^ 'n)) z = h x z - h y z"
+ by (simp add: diff_def bilinear_ladd bilinear_lneg)
+
+lemma bilinear_rsub: "bilinear h ==> h z (x - (y:: 'a::ring_1 ^ 'n)) = h z x - h z y"
+ by (simp add: diff_def bilinear_radd bilinear_rneg)
+
+lemma bilinear_setsum:
+ fixes h:: "'a ^'n \<Rightarrow> 'a::semiring_1^'m \<Rightarrow> 'a ^ 'k"
+ assumes bh: "bilinear h" and fS: "finite S" and fT: "finite T"
+ shows "h (setsum f S) (setsum g T) = setsum (\<lambda>(i,j). h (f i) (g j)) (S \<times> T) "
+proof-
+ have "h (setsum f S) (setsum g T) = setsum (\<lambda>x. h (f x) (setsum g T)) S"
+ apply (rule linear_setsum[unfolded o_def])
+ using bh fS by (auto simp add: bilinear_def)
+ also have "\<dots> = setsum (\<lambda>x. setsum (\<lambda>y. h (f x) (g y)) T) S"
+ apply (rule setsum_cong, simp)
+ apply (rule linear_setsum[unfolded o_def])
+ using bh fT by (auto simp add: bilinear_def)
+ finally show ?thesis unfolding setsum_cartesian_product .
+qed
+
+lemma bilinear_bounded:
+ fixes h:: "real ^'m::finite \<Rightarrow> real^'n::finite \<Rightarrow> real ^ 'k::finite"
+ assumes bh: "bilinear h"
+ shows "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
+proof-
+ let ?M = "UNIV :: 'm set"
+ let ?N = "UNIV :: 'n set"
+ let ?B = "setsum (\<lambda>(i,j). norm (h (basis i) (basis j))) (?M \<times> ?N)"
+ have fM: "finite ?M" and fN: "finite ?N" by simp_all
+ {fix x:: "real ^ 'm" and y :: "real^'n"
+ 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 ..
+ 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] ..
+ finally have th: "norm (h x y) = \<dots>" .
+ have "norm (h x y) \<le> ?B * norm x * norm y"
+ apply (simp add: setsum_left_distrib th)
+ apply (rule real_setsum_norm_le)
+ using fN fM
+ apply simp
+ apply (auto simp add: bilinear_rmul[OF bh] bilinear_lmul[OF bh] norm_mul ring_simps)
+ apply (rule mult_mono)
+ apply (auto simp add: norm_ge_zero zero_le_mult_iff component_le_norm)
+ apply (rule mult_mono)
+ apply (auto simp add: norm_ge_zero zero_le_mult_iff component_le_norm)
+ done}
+ then show ?thesis by metis
+qed
+
+lemma bilinear_bounded_pos:
+ fixes h:: "real ^'m::finite \<Rightarrow> real^'n::finite \<Rightarrow> real ^ 'k::finite"
+ assumes bh: "bilinear h"
+ shows "\<exists>B > 0. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
+proof-
+ from bilinear_bounded[OF bh] obtain B where
+ B: "\<forall>x y. norm (h x y) \<le> B * norm x * norm y" by blast
+ let ?K = "\<bar>B\<bar> + 1"
+ have Kp: "?K > 0" by arith
+ have KB: "B < ?K" by arith
+ {fix x::"real ^'m" and y :: "real ^'n"
+ from KB Kp
+ have "B * norm x * norm y \<le> ?K * norm x * norm y"
+ apply -
+ apply (rule mult_right_mono, rule mult_right_mono)
+ by (auto simp add: norm_ge_zero)
+ then have "norm (h x y) \<le> ?K * norm x * norm y"
+ using B[rule_format, of x y] by simp}
+ with Kp show ?thesis by blast
+qed
+
+lemma bilinear_conv_bounded_bilinear:
+ fixes h :: "real ^ _ \<Rightarrow> real ^ _ \<Rightarrow> real ^ _"
+ shows "bilinear h \<longleftrightarrow> bounded_bilinear h"
+proof
+ assume "bilinear h"
+ show "bounded_bilinear h"
+ proof
+ fix x y z show "h (x + y) z = h x z + h y z"
+ using `bilinear h` unfolding bilinear_def linear_def by simp
+ next
+ fix x y z show "h x (y + z) = h x y + h x z"
+ using `bilinear h` unfolding bilinear_def linear_def by simp
+ next
+ fix r x y show "h (scaleR r x) y = scaleR r (h x y)"
+ using `bilinear h` unfolding bilinear_def linear_def
+ by (simp add: smult_conv_scaleR)
+ next
+ fix r x y show "h x (scaleR r y) = scaleR r (h x y)"
+ using `bilinear h` unfolding bilinear_def linear_def
+ by (simp add: smult_conv_scaleR)
+ next
+ have "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
+ using `bilinear h` by (rule bilinear_bounded)
+ thus "\<exists>K. \<forall>x y. norm (h x y) \<le> norm x * norm y * K"
+ by (simp add: mult_ac)
+ qed
+next
+ assume "bounded_bilinear h"
+ then interpret h: bounded_bilinear h .
+ show "bilinear h"
+ unfolding bilinear_def linear_conv_bounded_linear
+ using h.bounded_linear_left h.bounded_linear_right
+ by simp
+qed
+
+subsection{* Adjoints. *}
+
+definition "adjoint f = (SOME f'. \<forall>x y. f x \<bullet> y = x \<bullet> f' y)"
+
+lemma choice_iff: "(\<forall>x. \<exists>y. P x y) \<longleftrightarrow> (\<exists>f. \<forall>x. P x (f x))" by metis
+
+lemma adjoint_works_lemma:
+ fixes f:: "'a::ring_1 ^'n::finite \<Rightarrow> 'a ^ 'm::finite"
+ assumes lf: "linear f"
+ shows "\<forall>x y. f x \<bullet> y = x \<bullet> adjoint f y"
+proof-
+ let ?N = "UNIV :: 'n set"
+ let ?M = "UNIV :: 'm set"
+ have fN: "finite ?N" by simp
+ have fM: "finite ?M" by simp
+ {fix y:: "'a ^ 'm"
+ let ?w = "(\<chi> i. (f (basis i) \<bullet> y)) :: 'a ^ 'n"
+ {fix x
+ have "f x \<bullet> y = f (setsum (\<lambda>i. (x$i) *s basis i) ?N) \<bullet> y"
+ by (simp only: basis_expansion)
+ also have "\<dots> = (setsum (\<lambda>i. (x$i) *s f (basis i)) ?N) \<bullet> y"
+ unfolding linear_setsum[OF lf fN]
+ by (simp add: linear_cmul[OF lf])
+ finally have "f x \<bullet> y = x \<bullet> ?w"
+ apply (simp only: )
+ apply (simp add: dot_def setsum_left_distrib setsum_right_distrib setsum_commute[of _ ?M ?N] ring_simps)
+ done}
+ }
+ then show ?thesis unfolding adjoint_def
+ some_eq_ex[of "\<lambda>f'. \<forall>x y. f x \<bullet> y = x \<bullet> f' y"]
+ using choice_iff[of "\<lambda>a b. \<forall>x. f x \<bullet> a = x \<bullet> b "]
+ by metis
+qed
+
+lemma adjoint_works:
+ fixes f:: "'a::ring_1 ^'n::finite \<Rightarrow> 'a ^ 'm::finite"
+ assumes lf: "linear f"
+ shows "x \<bullet> adjoint f y = f x \<bullet> y"
+ using adjoint_works_lemma[OF lf] by metis
+
+
+lemma adjoint_linear:
+ fixes f :: "'a::comm_ring_1 ^'n::finite \<Rightarrow> 'a ^ 'm::finite"
+ assumes lf: "linear f"
+ shows "linear (adjoint f)"
+ by (simp add: linear_def vector_eq_ldot[symmetric] dot_radd dot_rmult adjoint_works[OF lf])
+
+lemma adjoint_clauses:
+ fixes f:: "'a::comm_ring_1 ^'n::finite \<Rightarrow> 'a ^ 'm::finite"
+ assumes lf: "linear f"
+ shows "x \<bullet> adjoint f y = f x \<bullet> y"
+ and "adjoint f y \<bullet> x = y \<bullet> f x"
+ by (simp_all add: adjoint_works[OF lf] dot_sym )
+
+lemma adjoint_adjoint:
+ fixes f:: "'a::comm_ring_1 ^ 'n::finite \<Rightarrow> 'a ^ 'm::finite"
+ assumes lf: "linear f"
+ shows "adjoint (adjoint f) = f"
+ apply (rule ext)
+ by (simp add: vector_eq_ldot[symmetric] adjoint_clauses[OF adjoint_linear[OF lf]] adjoint_clauses[OF lf])
+
+lemma adjoint_unique:
+ fixes f:: "'a::comm_ring_1 ^ 'n::finite \<Rightarrow> 'a ^ 'm::finite"
+ assumes lf: "linear f" and u: "\<forall>x y. f' x \<bullet> y = x \<bullet> f y"
+ shows "f' = adjoint f"
+ apply (rule ext)
+ using u
+ by (simp add: vector_eq_rdot[symmetric] adjoint_clauses[OF lf])
+
+text{* Matrix notation. NB: an MxN matrix is of type @{typ "'a^'n^'m"}, not @{typ "'a^'m^'n"} *}
+
+consts generic_mult :: "'a \<Rightarrow> 'b \<Rightarrow> 'c" (infixr "\<star>" 75)
+
+defs (overloaded)
+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"
+
+abbreviation
+ matrix_matrix_mult' :: "('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'p^'n \<Rightarrow> 'a ^ 'p ^'m" (infixl "**" 70)
+ where "m ** m' == m\<star> m'"
+
+defs (overloaded)
+ 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"
+
+abbreviation
+ matrix_vector_mult' :: "('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'n \<Rightarrow> 'a ^ 'm" (infixl "*v" 70)
+ where
+ "m *v v == m \<star> v"
+
+defs (overloaded)
+ 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"
+
+abbreviation
+ vactor_matrix_mult' :: "'a ^ 'm \<Rightarrow> ('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'n " (infixl "v*" 70)
+ where
+ "v v* m == v \<star> m"
+
+definition "(mat::'a::zero => 'a ^'n^'n) k = (\<chi> i j. if i = j then k else 0)"
+definition "(transp::'a^'n^'m \<Rightarrow> 'a^'m^'n) A = (\<chi> i j. ((A$j)$i))"
+definition "(row::'m => 'a ^'n^'m \<Rightarrow> 'a ^'n) i A = (\<chi> j. ((A$i)$j))"
+definition "(column::'n =>'a^'n^'m =>'a^'m) j A = (\<chi> i. ((A$i)$j))"
+definition "rows(A::'a^'n^'m) = { row i A | i. i \<in> (UNIV :: 'm set)}"
+definition "columns(A::'a^'n^'m) = { column i A | i. i \<in> (UNIV :: 'n set)}"
+
+lemma mat_0[simp]: "mat 0 = 0" by (vector mat_def)
+lemma matrix_add_ldistrib: "(A ** (B + C)) = (A \<star> B) + (A \<star> C)"
+ by (vector matrix_matrix_mult_def setsum_addf[symmetric] ring_simps)
+
+lemma matrix_mul_lid:
+ fixes A :: "'a::semiring_1 ^ 'm ^ 'n::finite"
+ shows "mat 1 ** A = A"
+ apply (simp add: matrix_matrix_mult_def mat_def)
+ apply vector
+ by (auto simp only: cond_value_iff cond_application_beta setsum_delta'[OF finite] mult_1_left mult_zero_left if_True UNIV_I)
+
+
+lemma matrix_mul_rid:
+ fixes A :: "'a::semiring_1 ^ 'm::finite ^ 'n"
+ shows "A ** mat 1 = A"
+ apply (simp add: matrix_matrix_mult_def mat_def)
+ apply vector
+ 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)
+
+lemma matrix_mul_assoc: "A ** (B ** C) = (A ** B) ** C"
+ apply (vector matrix_matrix_mult_def setsum_right_distrib setsum_left_distrib mult_assoc)
+ apply (subst setsum_commute)
+ apply simp
+ done
+
+lemma matrix_vector_mul_assoc: "A *v (B *v x) = (A ** B) *v x"
+ apply (vector matrix_matrix_mult_def matrix_vector_mult_def setsum_right_distrib setsum_left_distrib mult_assoc)
+ apply (subst setsum_commute)
+ apply simp
+ done
+
+lemma matrix_vector_mul_lid: "mat 1 *v x = (x::'a::semiring_1 ^ 'n::finite)"
+ apply (vector matrix_vector_mult_def mat_def)
+ by (simp add: cond_value_iff cond_application_beta
+ setsum_delta' cong del: if_weak_cong)
+
+lemma matrix_transp_mul: "transp(A ** B) = transp B ** transp (A::'a::comm_semiring_1^'m^'n)"
+ by (simp add: matrix_matrix_mult_def transp_def Cart_eq mult_commute)
+
+lemma matrix_eq:
+ fixes A B :: "'a::semiring_1 ^ 'n::finite ^ 'm"
+ shows "A = B \<longleftrightarrow> (\<forall>x. A *v x = B *v x)" (is "?lhs \<longleftrightarrow> ?rhs")
+ apply auto
+ apply (subst Cart_eq)
+ apply clarify
+ apply (clarsimp simp add: matrix_vector_mult_def basis_def cond_value_iff cond_application_beta Cart_eq cong del: if_weak_cong)
+ apply (erule_tac x="basis ia" in allE)
+ apply (erule_tac x="i" in allE)
+ by (auto simp add: basis_def cond_value_iff cond_application_beta setsum_delta[OF finite] cong del: if_weak_cong)
+
+lemma matrix_vector_mul_component:
+ shows "((A::'a::semiring_1^'n'^'m) *v x)$k = (A$k) \<bullet> x"
+ by (simp add: matrix_vector_mult_def dot_def)
+
+lemma dot_lmul_matrix: "((x::'a::comm_semiring_1 ^'n) v* A) \<bullet> y = x \<bullet> (A *v y)"
+ apply (simp add: dot_def matrix_vector_mult_def vector_matrix_mult_def setsum_left_distrib setsum_right_distrib mult_ac)
+ apply (subst setsum_commute)
+ by simp
+
+lemma transp_mat: "transp (mat n) = mat n"
+ by (vector transp_def mat_def)
+
+lemma transp_transp: "transp(transp A) = A"
+ by (vector transp_def)
+
+lemma row_transp:
+ fixes A:: "'a::semiring_1^'n^'m"
+ shows "row i (transp A) = column i A"
+ by (simp add: row_def column_def transp_def Cart_eq)
+
+lemma column_transp:
+ fixes A:: "'a::semiring_1^'n^'m"
+ shows "column i (transp A) = row i A"
+ by (simp add: row_def column_def transp_def Cart_eq)
+
+lemma rows_transp: "rows(transp (A::'a::semiring_1^'n^'m)) = columns A"
+by (auto simp add: rows_def columns_def row_transp intro: set_ext)
+
+lemma columns_transp: "columns(transp (A::'a::semiring_1^'n^'m)) = rows A" by (metis transp_transp rows_transp)
+
+text{* Two sometimes fruitful ways of looking at matrix-vector multiplication. *}
+
+lemma matrix_mult_dot: "A *v x = (\<chi> i. A$i \<bullet> x)"
+ by (simp add: matrix_vector_mult_def dot_def)
+
+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)"
+ by (simp add: matrix_vector_mult_def Cart_eq column_def mult_commute)
+
+lemma vector_componentwise:
+ "(x::'a::ring_1^'n::finite) = (\<chi> j. setsum (\<lambda>i. (x$i) * (basis i :: 'a^'n)$j) (UNIV :: 'n set))"
+ apply (subst basis_expansion[symmetric])
+ by (vector Cart_eq setsum_component)
+
+lemma linear_componentwise:
+ fixes f:: "'a::ring_1 ^ 'm::finite \<Rightarrow> 'a ^ 'n"
+ assumes lf: "linear f"
+ shows "(f x)$j = setsum (\<lambda>i. (x$i) * (f (basis i)$j)) (UNIV :: 'm set)" (is "?lhs = ?rhs")
+proof-
+ let ?M = "(UNIV :: 'm set)"
+ let ?N = "(UNIV :: 'n set)"
+ have fM: "finite ?M" by simp
+ have "?rhs = (setsum (\<lambda>i.(x$i) *s f (basis i) ) ?M)$j"
+ unfolding vector_smult_component[symmetric]
+ unfolding setsum_component[of "(\<lambda>i.(x$i) *s f (basis i :: 'a^'m))" ?M]
+ ..
+ then show ?thesis unfolding linear_setsum_mul[OF lf fM, symmetric] basis_expansion ..
+qed
+
+text{* Inverse matrices (not necessarily square) *}
+
+definition "invertible(A::'a::semiring_1^'n^'m) \<longleftrightarrow> (\<exists>A'::'a^'m^'n. A ** A' = mat 1 \<and> A' ** A = mat 1)"
+
+definition "matrix_inv(A:: 'a::semiring_1^'n^'m) =
+ (SOME A'::'a^'m^'n. A ** A' = mat 1 \<and> A' ** A = mat 1)"
+
+text{* Correspondence between matrices and linear operators. *}
+
+definition matrix:: "('a::{plus,times, one, zero}^'m \<Rightarrow> 'a ^ 'n) \<Rightarrow> 'a^'m^'n"
+where "matrix f = (\<chi> i j. (f(basis j))$i)"
+
+lemma matrix_vector_mul_linear: "linear(\<lambda>x. A *v (x::'a::comm_semiring_1 ^ 'n))"
+ by (simp add: linear_def matrix_vector_mult_def Cart_eq ring_simps setsum_right_distrib setsum_addf)
+
+lemma matrix_works: assumes lf: "linear f" shows "matrix f *v x = f (x::'a::comm_ring_1 ^ 'n::finite)"
+apply (simp add: matrix_def matrix_vector_mult_def Cart_eq mult_commute)
+apply clarify
+apply (rule linear_componentwise[OF lf, symmetric])
+done
+
+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)
+
+lemma matrix_of_matrix_vector_mul: "matrix(\<lambda>x. A *v (x :: 'a:: comm_ring_1 ^ 'n::finite)) = A"
+ by (simp add: matrix_eq matrix_vector_mul_linear matrix_works)
+
+lemma matrix_compose:
+ assumes lf: "linear (f::'a::comm_ring_1^'n::finite \<Rightarrow> 'a^'m::finite)"
+ and lg: "linear (g::'a::comm_ring_1^'m::finite \<Rightarrow> 'a^'k)"
+ shows "matrix (g o f) = matrix g ** matrix f"
+ using lf lg linear_compose[OF lf lg] matrix_works[OF linear_compose[OF lf lg]]
+ by (simp add: matrix_eq matrix_works matrix_vector_mul_assoc[symmetric] o_def)
+
+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)"
+ by (simp add: matrix_vector_mult_def transp_def Cart_eq mult_commute)
+
+lemma adjoint_matrix: "adjoint(\<lambda>x. (A::'a::comm_ring_1^'n::finite^'m::finite) *v x) = (\<lambda>x. transp A *v x)"
+ apply (rule adjoint_unique[symmetric])
+ apply (rule matrix_vector_mul_linear)
+ apply (simp add: transp_def dot_def matrix_vector_mult_def setsum_left_distrib setsum_right_distrib)
+ apply (subst setsum_commute)
+ apply (auto simp add: mult_ac)
+ done
+
+lemma matrix_adjoint: assumes lf: "linear (f :: 'a::comm_ring_1^'n::finite \<Rightarrow> 'a ^ 'm::finite)"
+ shows "matrix(adjoint f) = transp(matrix f)"
+ apply (subst matrix_vector_mul[OF lf])
+ unfolding adjoint_matrix matrix_of_matrix_vector_mul ..
+
+subsection{* Interlude: Some properties of real sets *}
+
+lemma seq_mono_lemma: assumes "\<forall>(n::nat) \<ge> m. (d n :: real) < e n" and "\<forall>n \<ge> m. e n <= e m"
+ shows "\<forall>n \<ge> m. d n < e m"
+ using prems apply auto
+ apply (erule_tac x="n" in allE)
+ apply (erule_tac x="n" in allE)
+ apply auto
+ done
+
+
+lemma real_convex_bound_lt:
+ assumes xa: "(x::real) < a" and ya: "y < a" and u: "0 <= u" and v: "0 <= v"
+ and uv: "u + v = 1"
+ shows "u * x + v * y < a"
+proof-
+ have uv': "u = 0 \<longrightarrow> v \<noteq> 0" using u v uv by arith
+ have "a = a * (u + v)" unfolding uv by simp
+ hence th: "u * a + v * a = a" by (simp add: ring_simps)
+ from xa u have "u \<noteq> 0 \<Longrightarrow> u*x < u*a" by (simp add: mult_compare_simps)
+ from ya v have "v \<noteq> 0 \<Longrightarrow> v * y < v * a" by (simp add: mult_compare_simps)
+ from xa ya u v have "u * x + v * y < u * a + v * a"
+ apply (cases "u = 0", simp_all add: uv')
+ apply(rule mult_strict_left_mono)
+ using uv' apply simp_all
+
+ apply (rule add_less_le_mono)
+ apply(rule mult_strict_left_mono)
+ apply simp_all
+ apply (rule mult_left_mono)
+ apply simp_all
+ done
+ thus ?thesis unfolding th .
+qed
+
+lemma real_convex_bound_le:
+ assumes xa: "(x::real) \<le> a" and ya: "y \<le> a" and u: "0 <= u" and v: "0 <= v"
+ and uv: "u + v = 1"
+ shows "u * x + v * y \<le> a"
+proof-
+ from xa ya u v have "u * x + v * y \<le> u * a + v * a" by (simp add: add_mono mult_left_mono)
+ also have "\<dots> \<le> (u + v) * a" by (simp add: ring_simps)
+ finally show ?thesis unfolding uv by simp
+qed
+
+lemma infinite_enumerate: assumes fS: "infinite S"
+ shows "\<exists>r. subseq r \<and> (\<forall>n. r n \<in> S)"
+unfolding subseq_def
+using enumerate_in_set[OF fS] enumerate_mono[of _ _ S] fS by auto
+
+lemma approachable_lt_le: "(\<exists>(d::real)>0. \<forall>x. f x < d \<longrightarrow> P x) \<longleftrightarrow> (\<exists>d>0. \<forall>x. f x \<le> d \<longrightarrow> P x)"
+apply auto
+apply (rule_tac x="d/2" in exI)
+apply auto
+done
+
+
+lemma triangle_lemma:
+ assumes x: "0 <= (x::real)" and y:"0 <= y" and z: "0 <= z" and xy: "x^2 <= y^2 + z^2"
+ shows "x <= y + z"
+proof-
+ have "y^2 + z^2 \<le> y^2 + 2*y*z + z^2" using z y by (simp add: zero_compare_simps)
+ with xy have th: "x ^2 \<le> (y+z)^2" by (simp add: power2_eq_square ring_simps)
+ from y z have yz: "y + z \<ge> 0" by arith
+ from power2_le_imp_le[OF th yz] show ?thesis .
+qed
+
+
+lemma lambda_skolem: "(\<forall>i. \<exists>x. P i x) \<longleftrightarrow>
+ (\<exists>x::'a ^ 'n. \<forall>i. P i (x$i))" (is "?lhs \<longleftrightarrow> ?rhs")
+proof-
+ let ?S = "(UNIV :: 'n set)"
+ {assume H: "?rhs"
+ then have ?lhs by auto}
+ moreover
+ {assume H: "?lhs"
+ then obtain f where f:"\<forall>i. P i (f i)" unfolding choice_iff by metis
+ let ?x = "(\<chi> i. (f i)) :: 'a ^ 'n"
+ {fix i
+ from f have "P i (f i)" by metis
+ then have "P i (?x$i)" by auto
+ }
+ hence "\<forall>i. P i (?x$i)" by metis
+ hence ?rhs by metis }
+ ultimately show ?thesis by metis
+qed
+
+(* Supremum and infimum of real sets *)
+
+
+definition rsup:: "real set \<Rightarrow> real" where
+ "rsup S = (SOME a. isLub UNIV S a)"
+
+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)
+
+lemma rsup: assumes Se: "S \<noteq> {}" and b: "\<exists>b. S *<= b"
+ shows "isLub UNIV S (rsup S)"
+using Se b
+unfolding rsup_def
+apply clarify
+apply (rule someI_ex)
+apply (rule reals_complete)
+by (auto simp add: isUb_def setle_def)
+
+lemma rsup_le: assumes Se: "S \<noteq> {}" and Sb: "S *<= b" shows "rsup S \<le> b"
+proof-
+ from Sb have bu: "isUb UNIV S b" by (simp add: isUb_def setle_def)
+ from rsup[OF Se] Sb have "isLub UNIV S (rsup S)" by blast
+ then show ?thesis using bu by (auto simp add: isLub_def leastP_def setle_def setge_def)
+qed
+
+lemma rsup_finite_Max: assumes fS: "finite S" and Se: "S \<noteq> {}"
+ shows "rsup S = Max S"
+using fS Se
+proof-
+ let ?m = "Max S"
+ from Max_ge[OF fS] have Sm: "\<forall> x\<in> S. x \<le> ?m" by metis
+ with rsup[OF Se] have lub: "isLub UNIV S (rsup S)" by (metis setle_def)
+ from Max_in[OF fS Se] lub have mrS: "?m \<le> rsup S"
+ by (auto simp add: isLub_def leastP_def setle_def setge_def isUb_def)
+ moreover
+ have "rsup S \<le> ?m" using Sm lub
+ by (auto simp add: isLub_def leastP_def isUb_def setle_def setge_def)
+ ultimately show ?thesis by arith
+qed
+
+lemma rsup_finite_in: assumes fS: "finite S" and Se: "S \<noteq> {}"
+ shows "rsup S \<in> S"
+ using rsup_finite_Max[OF fS Se] Max_in[OF fS Se] by metis
+
+lemma rsup_finite_Ub: assumes fS: "finite S" and Se: "S \<noteq> {}"
+ shows "isUb S S (rsup S)"
+ using rsup_finite_Max[OF fS Se] rsup_finite_in[OF fS Se] Max_ge[OF fS]
+ unfolding isUb_def setle_def by metis
+
+lemma rsup_finite_ge_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
+ shows "a \<le> rsup S \<longleftrightarrow> (\<exists> x \<in> S. a \<le> x)"
+using rsup_finite_Ub[OF fS Se] by (auto simp add: isUb_def setle_def)
+
+lemma rsup_finite_le_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
+ shows "a \<ge> rsup S \<longleftrightarrow> (\<forall> x \<in> S. a \<ge> x)"
+using rsup_finite_Ub[OF fS Se] by (auto simp add: isUb_def setle_def)
+
+lemma rsup_finite_gt_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
+ shows "a < rsup S \<longleftrightarrow> (\<exists> x \<in> S. a < x)"
+using rsup_finite_Ub[OF fS Se] by (auto simp add: isUb_def setle_def)
+
+lemma rsup_finite_lt_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
+ shows "a > rsup S \<longleftrightarrow> (\<forall> x \<in> S. a > x)"
+using rsup_finite_Ub[OF fS Se] by (auto simp add: isUb_def setle_def)
+
+lemma rsup_unique: assumes b: "S *<= b" and S: "\<forall>b' < b. \<exists>x \<in> S. b' < x"
+ shows "rsup S = b"
+using b S
+unfolding setle_def rsup_alt
+apply -
+apply (rule some_equality)
+apply (metis linorder_not_le order_eq_iff[symmetric])+
+done
+
+lemma rsup_le_subset: "S\<noteq>{} \<Longrightarrow> S \<subseteq> T \<Longrightarrow> (\<exists>b. T *<= b) \<Longrightarrow> rsup S \<le> rsup T"
+ apply (rule rsup_le)
+ apply simp
+ using rsup[of T] by (auto simp add: isLub_def leastP_def setge_def setle_def isUb_def)
+
+lemma isUb_def': "isUb R S = (\<lambda>x. S *<= x \<and> x \<in> R)"
+ apply (rule ext)
+ by (metis isUb_def)
+
+lemma UNIV_trivial: "UNIV x" using UNIV_I[of x] by (metis mem_def)
+lemma rsup_bounds: assumes Se: "S \<noteq> {}" and l: "a <=* S" and u: "S *<= b"
+ shows "a \<le> rsup S \<and> rsup S \<le> b"
+proof-
+ from rsup[OF Se] u have lub: "isLub UNIV S (rsup S)" by blast
+ hence b: "rsup S \<le> b" using u by (auto simp add: isLub_def leastP_def setle_def setge_def isUb_def')
+ from Se obtain y where y: "y \<in> S" by blast
+ from lub l have "a \<le> rsup S" apply (auto simp add: isLub_def leastP_def setle_def setge_def isUb_def')
+ apply (erule ballE[where x=y])
+ apply (erule ballE[where x=y])
+ apply arith
+ using y apply auto
+ done
+ with b show ?thesis by blast
+qed
+
+lemma rsup_abs_le: "S \<noteq> {} \<Longrightarrow> (\<forall>x\<in>S. \<bar>x\<bar> \<le> a) \<Longrightarrow> \<bar>rsup S\<bar> \<le> a"
+ unfolding abs_le_interval_iff using rsup_bounds[of S "-a" a]
+ by (auto simp add: setge_def setle_def)
+
+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"
+proof-
+ 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
+ show ?thesis using S b rsup_bounds[of S "l - e" "l+e"] unfolding th
+ by (auto simp add: setge_def setle_def)
+qed
+
+definition rinf:: "real set \<Rightarrow> real" where
+ "rinf S = (SOME a. isGlb UNIV S a)"
+
+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)
+
+lemma reals_complete_Glb: assumes Se: "\<exists>x. x \<in> S" and lb: "\<exists> y. isLb UNIV S y"
+ shows "\<exists>(t::real). isGlb UNIV S t"
+proof-
+ let ?M = "uminus ` S"
+ from lb have th: "\<exists>y. isUb UNIV ?M y" apply (auto simp add: isUb_def isLb_def setle_def setge_def)
+ by (rule_tac x="-y" in exI, auto)
+ from Se have Me: "\<exists>x. x \<in> ?M" by blast
+ from reals_complete[OF Me th] obtain t where t: "isLub UNIV ?M t" by blast
+ have "isGlb UNIV S (- t)" using t
+ apply (auto simp add: isLub_def isGlb_def leastP_def greatestP_def setle_def setge_def isUb_def isLb_def)
+ apply (erule_tac x="-y" in allE)
+ apply auto
+ done
+ then show ?thesis by metis
+qed
+
+lemma rinf: assumes Se: "S \<noteq> {}" and b: "\<exists>b. b <=* S"
+ shows "isGlb UNIV S (rinf S)"
+using Se b
+unfolding rinf_def
+apply clarify
+apply (rule someI_ex)
+apply (rule reals_complete_Glb)
+apply (auto simp add: isLb_def setle_def setge_def)
+done
+
+lemma rinf_ge: assumes Se: "S \<noteq> {}" and Sb: "b <=* S" shows "rinf S \<ge> b"
+proof-
+ from Sb have bu: "isLb UNIV S b" by (simp add: isLb_def setge_def)
+ from rinf[OF Se] Sb have "isGlb UNIV S (rinf S)" by blast
+ then show ?thesis using bu by (auto simp add: isGlb_def greatestP_def setle_def setge_def)
+qed
+
+lemma rinf_finite_Min: assumes fS: "finite S" and Se: "S \<noteq> {}"
+ shows "rinf S = Min S"
+using fS Se
+proof-
+ let ?m = "Min S"
+ from Min_le[OF fS] have Sm: "\<forall> x\<in> S. x \<ge> ?m" by metis
+ with rinf[OF Se] have glb: "isGlb UNIV S (rinf S)" by (metis setge_def)
+ from Min_in[OF fS Se] glb have mrS: "?m \<ge> rinf S"
+ by (auto simp add: isGlb_def greatestP_def setle_def setge_def isLb_def)
+ moreover
+ have "rinf S \<ge> ?m" using Sm glb
+ by (auto simp add: isGlb_def greatestP_def isLb_def setle_def setge_def)
+ ultimately show ?thesis by arith
+qed
+
+lemma rinf_finite_in: assumes fS: "finite S" and Se: "S \<noteq> {}"
+ shows "rinf S \<in> S"
+ using rinf_finite_Min[OF fS Se] Min_in[OF fS Se] by metis
+
+lemma rinf_finite_Lb: assumes fS: "finite S" and Se: "S \<noteq> {}"
+ shows "isLb S S (rinf S)"
+ using rinf_finite_Min[OF fS Se] rinf_finite_in[OF fS Se] Min_le[OF fS]
+ unfolding isLb_def setge_def by metis
+
+lemma rinf_finite_ge_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
+ shows "a \<le> rinf S \<longleftrightarrow> (\<forall> x \<in> S. a \<le> x)"
+using rinf_finite_Lb[OF fS Se] by (auto simp add: isLb_def setge_def)
+
+lemma rinf_finite_le_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
+ shows "a \<ge> rinf S \<longleftrightarrow> (\<exists> x \<in> S. a \<ge> x)"
+using rinf_finite_Lb[OF fS Se] by (auto simp add: isLb_def setge_def)
+
+lemma rinf_finite_gt_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
+ shows "a < rinf S \<longleftrightarrow> (\<forall> x \<in> S. a < x)"
+using rinf_finite_Lb[OF fS Se] by (auto simp add: isLb_def setge_def)
+
+lemma rinf_finite_lt_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
+ shows "a > rinf S \<longleftrightarrow> (\<exists> x \<in> S. a > x)"
+using rinf_finite_Lb[OF fS Se] by (auto simp add: isLb_def setge_def)
+
+lemma rinf_unique: assumes b: "b <=* S" and S: "\<forall>b' > b. \<exists>x \<in> S. b' > x"
+ shows "rinf S = b"
+using b S
+unfolding setge_def rinf_alt
+apply -
+apply (rule some_equality)
+apply (metis linorder_not_le order_eq_iff[symmetric])+
+done
+
+lemma rinf_ge_subset: "S\<noteq>{} \<Longrightarrow> S \<subseteq> T \<Longrightarrow> (\<exists>b. b <=* T) \<Longrightarrow> rinf S >= rinf T"
+ apply (rule rinf_ge)
+ apply simp
+ using rinf[of T] by (auto simp add: isGlb_def greatestP_def setge_def setle_def isLb_def)
+
+lemma isLb_def': "isLb R S = (\<lambda>x. x <=* S \<and> x \<in> R)"
+ apply (rule ext)
+ by (metis isLb_def)
+
+lemma rinf_bounds: assumes Se: "S \<noteq> {}" and l: "a <=* S" and u: "S *<= b"
+ shows "a \<le> rinf S \<and> rinf S \<le> b"
+proof-
+ from rinf[OF Se] l have lub: "isGlb UNIV S (rinf S)" by blast
+ hence b: "a \<le> rinf S" using l by (auto simp add: isGlb_def greatestP_def setle_def setge_def isLb_def')
+ from Se obtain y where y: "y \<in> S" by blast
+ from lub u have "b \<ge> rinf S" apply (auto simp add: isGlb_def greatestP_def setle_def setge_def isLb_def')
+ apply (erule ballE[where x=y])
+ apply (erule ballE[where x=y])
+ apply arith
+ using y apply auto
+ done
+ with b show ?thesis by blast
+qed
+
+lemma rinf_abs_ge: "S \<noteq> {} \<Longrightarrow> (\<forall>x\<in>S. \<bar>x\<bar> \<le> a) \<Longrightarrow> \<bar>rinf S\<bar> \<le> a"
+ unfolding abs_le_interval_iff using rinf_bounds[of S "-a" a]
+ by (auto simp add: setge_def setle_def)
+
+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"
+proof-
+ 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
+ show ?thesis using S b rinf_bounds[of S "l - e" "l+e"] unfolding th
+ by (auto simp add: setge_def setle_def)
+qed
+
+
+
+subsection{* Operator norm. *}
+
+definition "onorm f = rsup {norm (f x)| x. norm x = 1}"
+
+lemma norm_bound_generalize:
+ fixes f:: "real ^'n::finite \<Rightarrow> real^'m::finite"
+ assumes lf: "linear f"
+ 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")
+proof-
+ {assume H: ?rhs
+ {fix x :: "real^'n" assume x: "norm x = 1"
+ from H[rule_format, of x] x have "norm (f x) \<le> b" by simp}
+ then have ?lhs by blast }
+
+ moreover
+ {assume H: ?lhs
+ from H[rule_format, of "basis arbitrary"]
+ have bp: "b \<ge> 0" using norm_ge_zero[of "f (basis arbitrary)"]
+ by (auto simp add: norm_basis elim: order_trans [OF norm_ge_zero])
+ {fix x :: "real ^'n"
+ {assume "x = 0"
+ then have "norm (f x) \<le> b * norm x" by (simp add: linear_0[OF lf] bp)}
+ moreover
+ {assume x0: "x \<noteq> 0"
+ hence n0: "norm x \<noteq> 0" by (metis norm_eq_zero)
+ let ?c = "1/ norm x"
+ have "norm (?c*s x) = 1" using x0 by (simp add: n0 norm_mul)
+ with H have "norm (f(?c*s x)) \<le> b" by blast
+ hence "?c * norm (f x) \<le> b"
+ by (simp add: linear_cmul[OF lf] norm_mul)
+ hence "norm (f x) \<le> b * norm x"
+ using n0 norm_ge_zero[of x] by (auto simp add: field_simps)}
+ ultimately have "norm (f x) \<le> b * norm x" by blast}
+ then have ?rhs by blast}
+ ultimately show ?thesis by blast
+qed
+
+lemma onorm:
+ fixes f:: "real ^'n::finite \<Rightarrow> real ^'m::finite"
+ assumes lf: "linear f"
+ shows "norm (f x) <= onorm f * norm x"
+ and "\<forall>x. norm (f x) <= b * norm x \<Longrightarrow> onorm f <= b"
+proof-
+ {
+ let ?S = "{norm (f x) |x. norm x = 1}"
+ have Se: "?S \<noteq> {}" using norm_basis by auto
+ from linear_bounded[OF lf] have b: "\<exists> b. ?S *<= b"
+ unfolding norm_bound_generalize[OF lf, symmetric] by (auto simp add: setle_def)
+ {from rsup[OF Se b, unfolded onorm_def[symmetric]]
+ show "norm (f x) <= onorm f * norm x"
+ apply -
+ apply (rule spec[where x = x])
+ unfolding norm_bound_generalize[OF lf, symmetric]
+ by (auto simp add: isLub_def isUb_def leastP_def setge_def setle_def)}
+ {
+ show "\<forall>x. norm (f x) <= b * norm x \<Longrightarrow> onorm f <= b"
+ using rsup[OF Se b, unfolded onorm_def[symmetric]]
+ unfolding norm_bound_generalize[OF lf, symmetric]
+ by (auto simp add: isLub_def isUb_def leastP_def setge_def setle_def)}
+ }
+qed
+
+lemma onorm_pos_le: assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)" shows "0 <= onorm f"
+ using order_trans[OF norm_ge_zero onorm(1)[OF lf, of "basis arbitrary"], unfolded norm_basis] by simp
+
+lemma onorm_eq_0: assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)"
+ shows "onorm f = 0 \<longleftrightarrow> (\<forall>x. f x = 0)"
+ using onorm[OF lf]
+ apply (auto simp add: onorm_pos_le)
+ apply atomize
+ apply (erule allE[where x="0::real"])
+ using onorm_pos_le[OF lf]
+ apply arith
+ done
+
+lemma onorm_const: "onorm(\<lambda>x::real^'n::finite. (y::real ^ 'm::finite)) = norm y"
+proof-
+ let ?f = "\<lambda>x::real^'n. (y::real ^ 'm)"
+ have th: "{norm (?f x)| x. norm x = 1} = {norm y}"
+ by(auto intro: vector_choose_size set_ext)
+ show ?thesis
+ unfolding onorm_def th
+ apply (rule rsup_unique) by (simp_all add: setle_def)
+qed
+
+lemma onorm_pos_lt: assumes lf: "linear (f::real ^ 'n::finite \<Rightarrow> real ^'m::finite)"
+ shows "0 < onorm f \<longleftrightarrow> ~(\<forall>x. f x = 0)"
+ unfolding onorm_eq_0[OF lf, symmetric]
+ using onorm_pos_le[OF lf] by arith
+
+lemma onorm_compose:
+ assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)"
+ and lg: "linear (g::real^'k::finite \<Rightarrow> real^'n::finite)"
+ shows "onorm (f o g) <= onorm f * onorm g"
+ apply (rule onorm(2)[OF linear_compose[OF lg lf], rule_format])
+ unfolding o_def
+ apply (subst mult_assoc)
+ apply (rule order_trans)
+ apply (rule onorm(1)[OF lf])
+ apply (rule mult_mono1)
+ apply (rule onorm(1)[OF lg])
+ apply (rule onorm_pos_le[OF lf])
+ done
+
+lemma onorm_neg_lemma: assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real^'m::finite)"
+ shows "onorm (\<lambda>x. - f x) \<le> onorm f"
+ using onorm[OF linear_compose_neg[OF lf]] onorm[OF lf]
+ unfolding norm_minus_cancel by metis
+
+lemma onorm_neg: assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real^'m::finite)"
+ shows "onorm (\<lambda>x. - f x) = onorm f"
+ using onorm_neg_lemma[OF lf] onorm_neg_lemma[OF linear_compose_neg[OF lf]]
+ by simp
+
+lemma onorm_triangle:
+ assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)" and lg: "linear g"
+ shows "onorm (\<lambda>x. f x + g x) <= onorm f + onorm g"
+ apply(rule onorm(2)[OF linear_compose_add[OF lf lg], rule_format])
+ apply (rule order_trans)
+ apply (rule norm_triangle_ineq)
+ apply (simp add: distrib)
+ apply (rule add_mono)
+ apply (rule onorm(1)[OF lf])
+ apply (rule onorm(1)[OF lg])
+ done
+
+lemma onorm_triangle_le: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite) \<Longrightarrow> linear g \<Longrightarrow> onorm(f) + onorm(g) <= e
+ \<Longrightarrow> onorm(\<lambda>x. f x + g x) <= e"
+ apply (rule order_trans)
+ apply (rule onorm_triangle)
+ apply assumption+
+ done
+
+lemma onorm_triangle_lt: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite) \<Longrightarrow> linear g \<Longrightarrow> onorm(f) + onorm(g) < e
+ ==> onorm(\<lambda>x. f x + g x) < e"
+ apply (rule order_le_less_trans)
+ apply (rule onorm_triangle)
+ by assumption+
+
+(* "lift" from 'a to 'a^1 and "drop" from 'a^1 to 'a -- FIXME: potential use of transfer *)
+
+definition vec1:: "'a \<Rightarrow> 'a ^ 1" where "vec1 x = (\<chi> i. x)"
+
+definition dest_vec1:: "'a ^1 \<Rightarrow> 'a"
+ where "dest_vec1 x = (x$1)"
+
+lemma vec1_component[simp]: "(vec1 x)$1 = x"
+ by (simp add: vec1_def)
+
+lemma vec1_dest_vec1[simp]: "vec1(dest_vec1 x) = x" "dest_vec1(vec1 y) = y"
+ by (simp_all add: vec1_def dest_vec1_def Cart_eq forall_1)
+
+lemma forall_vec1: "(\<forall>x. P x) \<longleftrightarrow> (\<forall>x. P (vec1 x))" by (metis vec1_dest_vec1)
+
+lemma exists_vec1: "(\<exists>x. P x) \<longleftrightarrow> (\<exists>x. P(vec1 x))" by (metis vec1_dest_vec1)
+
+lemma forall_dest_vec1: "(\<forall>x. P x) \<longleftrightarrow> (\<forall>x. P(dest_vec1 x))" by (metis vec1_dest_vec1)
+
+lemma exists_dest_vec1: "(\<exists>x. P x) \<longleftrightarrow> (\<exists>x. P(dest_vec1 x))"by (metis vec1_dest_vec1)
+
+lemma vec1_eq[simp]: "vec1 x = vec1 y \<longleftrightarrow> x = y" by (metis vec1_dest_vec1)
+
+lemma dest_vec1_eq[simp]: "dest_vec1 x = dest_vec1 y \<longleftrightarrow> x = y" by (metis vec1_dest_vec1)
+
+lemma vec1_in_image_vec1: "vec1 x \<in> (vec1 ` S) \<longleftrightarrow> x \<in> S" by auto
+
+lemma vec1_vec: "vec1 x = vec x" by (vector vec1_def)
+
+lemma vec1_add: "vec1(x + y) = vec1 x + vec1 y" by (vector vec1_def)
+lemma vec1_sub: "vec1(x - y) = vec1 x - vec1 y" by (vector vec1_def)
+lemma vec1_cmul: "vec1(c* x) = c *s vec1 x " by (vector vec1_def)
+lemma vec1_neg: "vec1(- x) = - vec1 x " by (vector vec1_def)
+
+lemma vec1_setsum: assumes fS: "finite S"
+ shows "vec1(setsum f S) = setsum (vec1 o f) S"
+ apply (induct rule: finite_induct[OF fS])
+ apply (simp add: vec1_vec)
+ apply (auto simp add: vec1_add)
+ done
+
+lemma dest_vec1_lambda: "dest_vec1(\<chi> i. x i) = x 1"
+ by (simp add: dest_vec1_def)
+
+lemma dest_vec1_vec: "dest_vec1(vec x) = x"
+ by (simp add: vec1_vec[symmetric])
+
+lemma dest_vec1_add: "dest_vec1(x + y) = dest_vec1 x + dest_vec1 y"
+ by (metis vec1_dest_vec1 vec1_add)
+
+lemma dest_vec1_sub: "dest_vec1(x - y) = dest_vec1 x - dest_vec1 y"
+ by (metis vec1_dest_vec1 vec1_sub)
+
+lemma dest_vec1_cmul: "dest_vec1(c*sx) = c * dest_vec1 x"
+ by (metis vec1_dest_vec1 vec1_cmul)
+
+lemma dest_vec1_neg: "dest_vec1(- x) = - dest_vec1 x"
+ by (metis vec1_dest_vec1 vec1_neg)
+
+lemma dest_vec1_0[simp]: "dest_vec1 0 = 0" by (metis vec_0 dest_vec1_vec)
+
+lemma dest_vec1_sum: assumes fS: "finite S"
+ shows "dest_vec1(setsum f S) = setsum (dest_vec1 o f) S"
+ apply (induct rule: finite_induct[OF fS])
+ apply (simp add: dest_vec1_vec)
+ apply (auto simp add: dest_vec1_add)
+ done
+
+lemma norm_vec1: "norm(vec1 x) = abs(x)"
+ by (simp add: vec1_def norm_real)
+
+lemma dist_vec1: "dist(vec1 x) (vec1 y) = abs(x - y)"
+ by (simp only: dist_real vec1_component)
+lemma abs_dest_vec1: "norm x = \<bar>dest_vec1 x\<bar>"
+ by (metis vec1_dest_vec1 norm_vec1)
+
+lemma linear_vmul_dest_vec1:
+ fixes f:: "'a::semiring_1^'n \<Rightarrow> 'a^1"
+ shows "linear f \<Longrightarrow> linear (\<lambda>x. dest_vec1(f x) *s v)"
+ unfolding dest_vec1_def
+ apply (rule linear_vmul_component)
+ by auto
+
+lemma linear_from_scalars:
+ assumes lf: "linear (f::'a::comm_ring_1 ^1 \<Rightarrow> 'a^'n)"
+ shows "f = (\<lambda>x. dest_vec1 x *s column 1 (matrix f))"
+ apply (rule ext)
+ apply (subst matrix_works[OF lf, symmetric])
+ apply (auto simp add: Cart_eq matrix_vector_mult_def dest_vec1_def column_def mult_commute UNIV_1)
+ done
+
+lemma linear_to_scalars: assumes lf: "linear (f::'a::comm_ring_1 ^'n::finite \<Rightarrow> 'a^1)"
+ shows "f = (\<lambda>x. vec1(row 1 (matrix f) \<bullet> x))"
+ apply (rule ext)
+ apply (subst matrix_works[OF lf, symmetric])
+ apply (simp add: Cart_eq matrix_vector_mult_def vec1_def row_def dot_def mult_commute forall_1)
+ done
+
+lemma dest_vec1_eq_0: "dest_vec1 x = 0 \<longleftrightarrow> x = 0"
+ by (simp add: dest_vec1_eq[symmetric])
+
+lemma setsum_scalars: assumes fS: "finite S"
+ shows "setsum f S = vec1 (setsum (dest_vec1 o f) S)"
+ unfolding vec1_setsum[OF fS] by simp
+
+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"
+ apply (cases "dest_vec1 x \<le> dest_vec1 y")
+ apply simp
+ apply (subgoal_tac "dest_vec1 y \<le> dest_vec1 x")
+ apply (auto)
+ done
+
+text{* Pasting vectors. *}
+
+lemma linear_fstcart: "linear fstcart"
+ by (auto simp add: linear_def Cart_eq)
+
+lemma linear_sndcart: "linear sndcart"
+ by (auto simp add: linear_def Cart_eq)
+
+lemma fstcart_vec[simp]: "fstcart(vec x) = vec x"
+ by (simp add: Cart_eq)
+
+lemma fstcart_add[simp]:"fstcart(x + y) = fstcart (x::'a::{plus,times}^('b + 'c)) + fstcart y"
+ by (simp add: Cart_eq)
+
+lemma fstcart_cmul[simp]:"fstcart(c*s x) = c*s fstcart (x::'a::{plus,times}^('b + 'c))"
+ by (simp add: Cart_eq)
+
+lemma fstcart_neg[simp]:"fstcart(- x) = - fstcart (x::'a::ring_1^('b + 'c))"
+ by (simp add: Cart_eq)
+
+lemma fstcart_sub[simp]:"fstcart(x - y) = fstcart (x::'a::ring_1^('b + 'c)) - fstcart y"
+ by (simp add: Cart_eq)
+
+lemma fstcart_setsum:
+ fixes f:: "'d \<Rightarrow> 'a::semiring_1^_"
+ assumes fS: "finite S"
+ shows "fstcart (setsum f S) = setsum (\<lambda>i. fstcart (f i)) S"
+ by (induct rule: finite_induct[OF fS], simp_all add: vec_0[symmetric] del: vec_0)
+
+lemma sndcart_vec[simp]: "sndcart(vec x) = vec x"
+ by (simp add: Cart_eq)
+
+lemma sndcart_add[simp]:"sndcart(x + y) = sndcart (x::'a::{plus,times}^('b + 'c)) + sndcart y"
+ by (simp add: Cart_eq)
+
+lemma sndcart_cmul[simp]:"sndcart(c*s x) = c*s sndcart (x::'a::{plus,times}^('b + 'c))"
+ by (simp add: Cart_eq)
+
+lemma sndcart_neg[simp]:"sndcart(- x) = - sndcart (x::'a::ring_1^('b + 'c))"
+ by (simp add: Cart_eq)
+
+lemma sndcart_sub[simp]:"sndcart(x - y) = sndcart (x::'a::ring_1^('b + 'c)) - sndcart y"
+ by (simp add: Cart_eq)
+
+lemma sndcart_setsum:
+ fixes f:: "'d \<Rightarrow> 'a::semiring_1^_"
+ assumes fS: "finite S"
+ shows "sndcart (setsum f S) = setsum (\<lambda>i. sndcart (f i)) S"
+ by (induct rule: finite_induct[OF fS], simp_all add: vec_0[symmetric] del: vec_0)
+
+lemma pastecart_vec[simp]: "pastecart (vec x) (vec x) = vec x"
+ by (simp add: pastecart_eq fstcart_pastecart sndcart_pastecart)
+
+lemma pastecart_add[simp]:"pastecart (x1::'a::{plus,times}^_) y1 + pastecart x2 y2 = pastecart (x1 + x2) (y1 + y2)"
+ by (simp add: pastecart_eq fstcart_pastecart sndcart_pastecart)
+
+lemma pastecart_cmul[simp]: "pastecart (c *s (x1::'a::{plus,times}^_)) (c *s y1) = c *s pastecart x1 y1"
+ by (simp add: pastecart_eq fstcart_pastecart sndcart_pastecart)
+
+lemma pastecart_neg[simp]: "pastecart (- (x::'a::ring_1^_)) (- y) = - pastecart x y"
+ unfolding vector_sneg_minus1 pastecart_cmul ..
+
+lemma pastecart_sub: "pastecart (x1::'a::ring_1^_) y1 - pastecart x2 y2 = pastecart (x1 - x2) (y1 - y2)"
+ by (simp add: diff_def pastecart_neg[symmetric] del: pastecart_neg)
+
+lemma pastecart_setsum:
+ fixes f:: "'d \<Rightarrow> 'a::semiring_1^_"
+ assumes fS: "finite S"
+ shows "pastecart (setsum f S) (setsum g S) = setsum (\<lambda>i. pastecart (f i) (g i)) S"
+ by (simp add: pastecart_eq fstcart_setsum[OF fS] sndcart_setsum[OF fS] fstcart_pastecart sndcart_pastecart)
+
+lemma setsum_Plus:
+ "\<lbrakk>finite A; finite B\<rbrakk> \<Longrightarrow>
+ (\<Sum>x\<in>A <+> B. g x) = (\<Sum>x\<in>A. g (Inl x)) + (\<Sum>x\<in>B. g (Inr x))"
+ unfolding Plus_def
+ by (subst setsum_Un_disjoint, auto simp add: setsum_reindex)
+
+lemma setsum_UNIV_sum:
+ fixes g :: "'a::finite + 'b::finite \<Rightarrow> _"
+ shows "(\<Sum>x\<in>UNIV. g x) = (\<Sum>x\<in>UNIV. g (Inl x)) + (\<Sum>x\<in>UNIV. g (Inr x))"
+ apply (subst UNIV_Plus_UNIV [symmetric])
+ apply (rule setsum_Plus [OF finite finite])
+ done
+
+lemma norm_fstcart: "norm(fstcart x) <= norm (x::real ^('n::finite + 'm::finite))"
+proof-
+ have th0: "norm x = norm (pastecart (fstcart x) (sndcart x))"
+ by (simp add: pastecart_fst_snd)
+ have th1: "fstcart x \<bullet> fstcart x \<le> pastecart (fstcart x) (sndcart x) \<bullet> pastecart (fstcart x) (sndcart x)"
+ by (simp add: dot_def setsum_UNIV_sum pastecart_def setsum_nonneg)
+ then show ?thesis
+ unfolding th0
+ unfolding real_vector_norm_def real_sqrt_le_iff id_def
+ by (simp add: dot_def)
+qed
+
+lemma dist_fstcart: "dist(fstcart (x::real^_)) (fstcart y) <= dist x y"
+ unfolding dist_norm by (metis fstcart_sub[symmetric] norm_fstcart)
+
+lemma norm_sndcart: "norm(sndcart x) <= norm (x::real ^('n::finite + 'm::finite))"
+proof-
+ have th0: "norm x = norm (pastecart (fstcart x) (sndcart x))"
+ by (simp add: pastecart_fst_snd)
+ have th1: "sndcart x \<bullet> sndcart x \<le> pastecart (fstcart x) (sndcart x) \<bullet> pastecart (fstcart x) (sndcart x)"
+ by (simp add: dot_def setsum_UNIV_sum pastecart_def setsum_nonneg)
+ then show ?thesis
+ unfolding th0
+ unfolding real_vector_norm_def real_sqrt_le_iff id_def
+ by (simp add: dot_def)
+qed
+
+lemma dist_sndcart: "dist(sndcart (x::real^_)) (sndcart y) <= dist x y"
+ unfolding dist_norm by (metis sndcart_sub[symmetric] norm_sndcart)
+
+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"
+ by (simp add: dot_def setsum_UNIV_sum pastecart_def)
+
+text {* TODO: move to NthRoot *}
+lemma sqrt_add_le_add_sqrt:
+ assumes x: "0 \<le> x" and y: "0 \<le> y"
+ shows "sqrt (x + y) \<le> sqrt x + sqrt y"
+apply (rule power2_le_imp_le)
+apply (simp add: real_sum_squared_expand add_nonneg_nonneg x y)
+apply (simp add: mult_nonneg_nonneg x y)
+apply (simp add: add_nonneg_nonneg x y)
+done
+
+lemma norm_pastecart: "norm (pastecart x y) <= norm x + norm y"
+ unfolding norm_vector_def setL2_def setsum_UNIV_sum
+ by (simp add: sqrt_add_le_add_sqrt setsum_nonneg)
+
+subsection {* A generic notion of "hull" (convex, affine, conic hull and closure). *}
+
+definition hull :: "'a set set \<Rightarrow> 'a set \<Rightarrow> 'a set" (infixl "hull" 75) where
+ "S hull s = Inter {t. t \<in> S \<and> s \<subseteq> t}"
+
+lemma hull_same: "s \<in> S \<Longrightarrow> S hull s = s"
+ unfolding hull_def by auto
+
+lemma hull_in: "(\<And>T. T \<subseteq> S ==> Inter T \<in> S) ==> (S hull s) \<in> S"
+unfolding hull_def subset_iff by auto
+
+lemma hull_eq: "(\<And>T. T \<subseteq> S ==> Inter T \<in> S) ==> (S hull s) = s \<longleftrightarrow> s \<in> S"
+using hull_same[of s S] hull_in[of S s] by metis
+
+
+lemma hull_hull: "S hull (S hull s) = S hull s"
+ unfolding hull_def by blast
+
+lemma hull_subset: "s \<subseteq> (S hull s)"
+ unfolding hull_def by blast
+
+lemma hull_mono: " s \<subseteq> t ==> (S hull s) \<subseteq> (S hull t)"
+ unfolding hull_def by blast
+
+lemma hull_antimono: "S \<subseteq> T ==> (T hull s) \<subseteq> (S hull s)"
+ unfolding hull_def by blast
+
+lemma hull_minimal: "s \<subseteq> t \<Longrightarrow> t \<in> S ==> (S hull s) \<subseteq> t"
+ unfolding hull_def by blast
+
+lemma subset_hull: "t \<in> S ==> S hull s \<subseteq> t \<longleftrightarrow> s \<subseteq> t"
+ unfolding hull_def by blast
+
+lemma hull_unique: "s \<subseteq> t \<Longrightarrow> t \<in> S \<Longrightarrow> (\<And>t'. s \<subseteq> t' \<Longrightarrow> t' \<in> S ==> t \<subseteq> t')
+ ==> (S hull s = t)"
+unfolding hull_def by auto
+
+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"
+ using hull_minimal[of S "{x. P x}" Q]
+ by (auto simp add: subset_eq Collect_def mem_def)
+
+lemma hull_inc: "x \<in> S \<Longrightarrow> x \<in> P hull S" by (metis hull_subset subset_eq)
+
+lemma hull_union_subset: "(S hull s) \<union> (S hull t) \<subseteq> (S hull (s \<union> t))"
+unfolding Un_subset_iff by (metis hull_mono Un_upper1 Un_upper2)
+
+lemma hull_union: assumes T: "\<And>T. T \<subseteq> S ==> Inter T \<in> S"
+ shows "S hull (s \<union> t) = S hull (S hull s \<union> S hull t)"
+apply rule
+apply (rule hull_mono)
+unfolding Un_subset_iff
+apply (metis hull_subset Un_upper1 Un_upper2 subset_trans)
+apply (rule hull_minimal)
+apply (metis hull_union_subset)
+apply (metis hull_in T)
+done
+
+lemma hull_redundant_eq: "a \<in> (S hull s) \<longleftrightarrow> (S hull (insert a s) = S hull s)"
+ unfolding hull_def by blast
+
+lemma hull_redundant: "a \<in> (S hull s) ==> (S hull (insert a s) = S hull s)"
+by (metis hull_redundant_eq)
+
+text{* Archimedian properties and useful consequences. *}
+
+lemma real_arch_simple: "\<exists>n. x <= real (n::nat)"
+ using reals_Archimedean2[of x] apply auto by (rule_tac x="Suc n" in exI, auto)
+lemmas real_arch_lt = reals_Archimedean2
+
+lemmas real_arch = reals_Archimedean3
+
+lemma real_arch_inv: "0 < e \<longleftrightarrow> (\<exists>n::nat. n \<noteq> 0 \<and> 0 < inverse (real n) \<and> inverse (real n) < e)"
+ using reals_Archimedean
+ apply (auto simp add: field_simps inverse_positive_iff_positive)
+ apply (subgoal_tac "inverse (real n) > 0")
+ apply arith
+ apply simp
+ done
+
+lemma real_pow_lbound: "0 <= x ==> 1 + real n * x <= (1 + x) ^ n"
+proof(induct n)
+ case 0 thus ?case by simp
+next
+ case (Suc n)
+ hence h: "1 + real n * x \<le> (1 + x) ^ n" by simp
+ from h have p: "1 \<le> (1 + x) ^ n" using Suc.prems by simp
+ from h have "1 + real n * x + x \<le> (1 + x) ^ n + x" by simp
+ also have "\<dots> \<le> (1 + x) ^ Suc n" apply (subst diff_le_0_iff_le[symmetric])
+ apply (simp add: ring_simps)
+ using mult_left_mono[OF p Suc.prems] by simp
+ finally show ?case by (simp add: real_of_nat_Suc ring_simps)
+qed
+
+lemma real_arch_pow: assumes x: "1 < (x::real)" shows "\<exists>n. y < x^n"
+proof-
+ from x have x0: "x - 1 > 0" by arith
+ from real_arch[OF x0, rule_format, of y]
+ obtain n::nat where n:"y < real n * (x - 1)" by metis
+ from x0 have x00: "x- 1 \<ge> 0" by arith
+ from real_pow_lbound[OF x00, of n] n
+ have "y < x^n" by auto
+ then show ?thesis by metis
+qed
+
+lemma real_arch_pow2: "\<exists>n. (x::real) < 2^ n"
+ using real_arch_pow[of 2 x] by simp
+
+lemma real_arch_pow_inv: assumes y: "(y::real) > 0" and x1: "x < 1"
+ shows "\<exists>n. x^n < y"
+proof-
+ {assume x0: "x > 0"
+ from x0 x1 have ix: "1 < 1/x" by (simp add: field_simps)
+ from real_arch_pow[OF ix, of "1/y"]
+ obtain n where n: "1/y < (1/x)^n" by blast
+ then
+ have ?thesis using y x0 by (auto simp add: field_simps power_divide) }
+ moreover
+ {assume "\<not> x > 0" with y x1 have ?thesis apply auto by (rule exI[where x=1], auto)}
+ ultimately show ?thesis by metis
+qed
+
+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)"
+ by (metis real_arch_inv)
+
+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"
+ apply (rule forall_pos_mono)
+ apply auto
+ apply (atomize)
+ apply (erule_tac x="n - 1" in allE)
+ apply auto
+ done
+
+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"
+ shows "x = 0"
+proof-
+ {assume "x \<noteq> 0" with x0 have xp: "x > 0" by arith
+ from real_arch[OF xp, rule_format, of c] obtain n::nat where n: "c < real n * x" by blast
+ with xc[rule_format, of n] have "n = 0" by arith
+ with n c have False by simp}
+ then show ?thesis by blast
+qed
+
+(* ------------------------------------------------------------------------- *)
+(* Relate max and min to sup and inf. *)
+(* ------------------------------------------------------------------------- *)
+
+lemma real_max_rsup: "max x y = rsup {x,y}"
+proof-
+ have f: "finite {x, y}" "{x,y} \<noteq> {}" by simp_all
+ from rsup_finite_le_iff[OF f, of "max x y"] have "rsup {x,y} \<le> max x y" by simp
+ moreover
+ have "max x y \<le> rsup {x,y}" using rsup_finite_ge_iff[OF f, of "max x y"]
+ by (simp add: linorder_linear)
+ ultimately show ?thesis by arith
+qed
+
+lemma real_min_rinf: "min x y = rinf {x,y}"
+proof-
+ have f: "finite {x, y}" "{x,y} \<noteq> {}" by simp_all
+ from rinf_finite_le_iff[OF f, of "min x y"] have "rinf {x,y} \<le> min x y"
+ by (simp add: linorder_linear)
+ moreover
+ have "min x y \<le> rinf {x,y}" using rinf_finite_ge_iff[OF f, of "min x y"]
+ by simp
+ ultimately show ?thesis by arith
+qed
+
+(* ------------------------------------------------------------------------- *)
+(* Geometric progression. *)
+(* ------------------------------------------------------------------------- *)
+
+lemma sum_gp_basic: "((1::'a::{field}) - x) * setsum (\<lambda>i. x^i) {0 .. n} = (1 - x^(Suc n))"
+ (is "?lhs = ?rhs")
+proof-
+ {assume x1: "x = 1" hence ?thesis by simp}
+ moreover
+ {assume x1: "x\<noteq>1"
+ hence x1': "x - 1 \<noteq> 0" "1 - x \<noteq> 0" "x - 1 = - (1 - x)" "- (1 - x) \<noteq> 0" by auto
+ from geometric_sum[OF x1, of "Suc n", unfolded x1']
+ have "(- (1 - x)) * setsum (\<lambda>i. x^i) {0 .. n} = - (1 - x^(Suc n))"
+ unfolding atLeastLessThanSuc_atLeastAtMost
+ using x1' apply (auto simp only: field_simps)
+ apply (simp add: ring_simps)
+ done
+ then have ?thesis by (simp add: ring_simps) }
+ ultimately show ?thesis by metis
+qed
+
+lemma sum_gp_multiplied: assumes mn: "m <= n"
+ shows "((1::'a::{field}) - x) * setsum (op ^ x) {m..n} = x^m - x^ Suc n"
+ (is "?lhs = ?rhs")
+proof-
+ let ?S = "{0..(n - m)}"
+ from mn have mn': "n - m \<ge> 0" by arith
+ let ?f = "op + m"
+ have i: "inj_on ?f ?S" unfolding inj_on_def by auto
+ have f: "?f ` ?S = {m..n}"
+ using mn apply (auto simp add: image_iff Bex_def) by arith
+ have th: "op ^ x o op + m = (\<lambda>i. x^m * x^i)"
+ by (rule ext, simp add: power_add power_mult)
+ from setsum_reindex[OF i, of "op ^ x", unfolded f th setsum_right_distrib[symmetric]]
+ have "?lhs = x^m * ((1 - x) * setsum (op ^ x) {0..n - m})" by simp
+ then show ?thesis unfolding sum_gp_basic using mn
+ by (simp add: ring_simps power_add[symmetric])
+qed
+
+lemma sum_gp: "setsum (op ^ (x::'a::{field})) {m .. n} =
+ (if n < m then 0 else if x = 1 then of_nat ((n + 1) - m)
+ else (x^ m - x^ (Suc n)) / (1 - x))"
+proof-
+ {assume nm: "n < m" hence ?thesis by simp}
+ moreover
+ {assume "\<not> n < m" hence nm: "m \<le> n" by arith
+ {assume x: "x = 1" hence ?thesis by simp}
+ moreover
+ {assume x: "x \<noteq> 1" hence nz: "1 - x \<noteq> 0" by simp
+ from sum_gp_multiplied[OF nm, of x] nz have ?thesis by (simp add: field_simps)}
+ ultimately have ?thesis by metis
+ }
+ ultimately show ?thesis by metis
+qed
+
+lemma sum_gp_offset: "setsum (op ^ (x::'a::{field})) {m .. m+n} =
+ (if x = 1 then of_nat n + 1 else x^m * (1 - x^Suc n) / (1 - x))"
+ unfolding sum_gp[of x m "m + n"] power_Suc
+ by (simp add: ring_simps power_add)
+
+
+subsection{* A bit of linear algebra. *}
+
+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 )"
+definition "span S = (subspace hull S)"
+definition "dependent S \<longleftrightarrow> (\<exists>a \<in> S. a \<in> span(S - {a}))"
+abbreviation "independent s == ~(dependent s)"
+
+(* Closure properties of subspaces. *)
+
+lemma subspace_UNIV[simp]: "subspace(UNIV)" by (simp add: subspace_def)
+
+lemma subspace_0: "subspace S ==> 0 \<in> S" by (metis subspace_def)
+
+lemma subspace_add: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> y \<in> S ==> x + y \<in> S"
+ by (metis subspace_def)
+
+lemma subspace_mul: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> c *s x \<in> S"
+ by (metis subspace_def)
+
+lemma subspace_neg: "subspace S \<Longrightarrow> (x::'a::ring_1^'n) \<in> S \<Longrightarrow> - x \<in> S"
+ by (metis vector_sneg_minus1 subspace_mul)
+
+lemma subspace_sub: "subspace S \<Longrightarrow> (x::'a::ring_1^'n) \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x - y \<in> S"
+ by (metis diff_def subspace_add subspace_neg)
+
+lemma subspace_setsum:
+ assumes sA: "subspace A" and fB: "finite B"
+ and f: "\<forall>x\<in> B. f x \<in> A"
+ shows "setsum f B \<in> A"
+ using fB f sA
+ apply(induct rule: finite_induct[OF fB])
+ by (simp add: subspace_def sA, auto simp add: sA subspace_add)
+
+lemma subspace_linear_image:
+ assumes lf: "linear (f::'a::semiring_1^'n \<Rightarrow> _)" and sS: "subspace S"
+ shows "subspace(f ` S)"
+ using lf sS linear_0[OF lf]
+ unfolding linear_def subspace_def
+ apply (auto simp add: image_iff)
+ apply (rule_tac x="x + y" in bexI, auto)
+ apply (rule_tac x="c*s x" in bexI, auto)
+ done
+
+lemma subspace_linear_preimage: "linear (f::'a::semiring_1^'n \<Rightarrow> _) ==> subspace S ==> subspace {x. f x \<in> S}"
+ by (auto simp add: subspace_def linear_def linear_0[of f])
+
+lemma subspace_trivial: "subspace {0::'a::semiring_1 ^_}"
+ by (simp add: subspace_def)
+
+lemma subspace_inter: "subspace A \<Longrightarrow> subspace B ==> subspace (A \<inter> B)"
+ by (simp add: subspace_def)
+
+
+lemma span_mono: "A \<subseteq> B ==> span A \<subseteq> span B"
+ by (metis span_def hull_mono)
+
+lemma subspace_span: "subspace(span S)"
+ unfolding span_def
+ apply (rule hull_in[unfolded mem_def])
+ apply (simp only: subspace_def Inter_iff Int_iff subset_eq)
+ apply auto
+ apply (erule_tac x="X" in ballE)
+ apply (simp add: mem_def)
+ apply blast
+ apply (erule_tac x="X" in ballE)
+ apply (erule_tac x="X" in ballE)
+ apply (erule_tac x="X" in ballE)
+ apply (clarsimp simp add: mem_def)
+ apply simp
+ apply simp
+ apply simp
+ apply (erule_tac x="X" in ballE)
+ apply (erule_tac x="X" in ballE)
+ apply (simp add: mem_def)
+ apply simp
+ apply simp
+ done
+
+lemma span_clauses:
+ "a \<in> S ==> a \<in> span S"
+ "0 \<in> span S"
+ "x\<in> span S \<Longrightarrow> y \<in> span S ==> x + y \<in> span S"
+ "x \<in> span S \<Longrightarrow> c *s x \<in> span S"
+ by (metis span_def hull_subset subset_eq subspace_span subspace_def)+
+
+lemma span_induct: assumes SP: "\<And>x. x \<in> S ==> P x"
+ and P: "subspace P" and x: "x \<in> span S" shows "P x"
+proof-
+ from SP have SP': "S \<subseteq> P" by (simp add: mem_def subset_eq)
+ from P have P': "P \<in> subspace" by (simp add: mem_def)
+ from x hull_minimal[OF SP' P', unfolded span_def[symmetric]]
+ show "P x" by (metis mem_def subset_eq)
+qed
+
+lemma span_empty: "span {} = {(0::'a::semiring_0 ^ 'n)}"
+ apply (simp add: span_def)
+ apply (rule hull_unique)
+ apply (auto simp add: mem_def subspace_def)
+ unfolding mem_def[of "0::'a^'n", symmetric]
+ apply simp
+ done
+
+lemma independent_empty: "independent {}"
+ by (simp add: dependent_def)
+
+lemma independent_mono: "independent A \<Longrightarrow> B \<subseteq> A ==> independent B"
+ apply (clarsimp simp add: dependent_def span_mono)
+ apply (subgoal_tac "span (B - {a}) \<le> span (A - {a})")
+ apply force
+ apply (rule span_mono)
+ apply auto
+ done
+
+lemma span_subspace: "A \<subseteq> B \<Longrightarrow> B \<le> span A \<Longrightarrow> subspace B \<Longrightarrow> span A = B"
+ by (metis order_antisym span_def hull_minimal mem_def)
+
+lemma span_induct': assumes SP: "\<forall>x \<in> S. P x"
+ and P: "subspace P" shows "\<forall>x \<in> span S. P x"
+ using span_induct SP P by blast
+
+inductive span_induct_alt_help for S:: "'a::semiring_1^'n \<Rightarrow> bool"
+ where
+ span_induct_alt_help_0: "span_induct_alt_help S 0"
+ | 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)"
+
+lemma span_induct_alt':
+ 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"
+proof-
+ {fix x:: "'a^'n" assume x: "span_induct_alt_help S x"
+ have "h x"
+ apply (rule span_induct_alt_help.induct[OF x])
+ apply (rule h0)
+ apply (rule hS, assumption, assumption)
+ done}
+ note th0 = this
+ {fix x assume x: "x \<in> span S"
+
+ have "span_induct_alt_help S x"
+ proof(rule span_induct[where x=x and S=S])
+ show "x \<in> span S" using x .
+ next
+ fix x assume xS : "x \<in> S"
+ from span_induct_alt_help_S[OF xS span_induct_alt_help_0, of 1]
+ show "span_induct_alt_help S x" by simp
+ next
+ have "span_induct_alt_help S 0" by (rule span_induct_alt_help_0)
+ moreover
+ {fix x y assume h: "span_induct_alt_help S x" "span_induct_alt_help S y"
+ from h
+ have "span_induct_alt_help S (x + y)"
+ apply (induct rule: span_induct_alt_help.induct)
+ apply simp
+ unfolding add_assoc
+ apply (rule span_induct_alt_help_S)
+ apply assumption
+ apply simp
+ done}
+ moreover
+ {fix c x assume xt: "span_induct_alt_help S x"
+ then have "span_induct_alt_help S (c*s x)"
+ apply (induct rule: span_induct_alt_help.induct)
+ apply (simp add: span_induct_alt_help_0)
+ apply (simp add: vector_smult_assoc vector_add_ldistrib)
+ apply (rule span_induct_alt_help_S)
+ apply assumption
+ apply simp
+ done
+ }
+ ultimately show "subspace (span_induct_alt_help S)"
+ unfolding subspace_def mem_def Ball_def by blast
+ qed}
+ with th0 show ?thesis by blast
+qed
+
+lemma span_induct_alt:
+ 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"
+ shows "h x"
+using span_induct_alt'[of h S] h0 hS x by blast
+
+(* Individual closure properties. *)
+
+lemma span_superset: "x \<in> S ==> x \<in> span S" by (metis span_clauses)
+
+lemma span_0: "0 \<in> span S" by (metis subspace_span subspace_0)
+
+lemma span_add: "x \<in> span S \<Longrightarrow> y \<in> span S ==> x + y \<in> span S"
+ by (metis subspace_add subspace_span)
+
+lemma span_mul: "x \<in> span S ==> (c *s x) \<in> span S"
+ by (metis subspace_span subspace_mul)
+
+lemma span_neg: "x \<in> span S ==> - (x::'a::ring_1^'n) \<in> span S"
+ by (metis subspace_neg subspace_span)
+
+lemma span_sub: "(x::'a::ring_1^'n) \<in> span S \<Longrightarrow> y \<in> span S ==> x - y \<in> span S"
+ by (metis subspace_span subspace_sub)
+
+lemma span_setsum: "finite A \<Longrightarrow> \<forall>x \<in> A. f x \<in> span S ==> setsum f A \<in> span S"
+ apply (rule subspace_setsum)
+ by (metis subspace_span subspace_setsum)+
+
+lemma span_add_eq: "(x::'a::ring_1^'n) \<in> span S \<Longrightarrow> x + y \<in> span S \<longleftrightarrow> y \<in> span S"
+ apply (auto simp only: span_add span_sub)
+ apply (subgoal_tac "(x + y) - x \<in> span S", simp)
+ by (simp only: span_add span_sub)
+
+(* Mapping under linear image. *)
+
+lemma span_linear_image: assumes lf: "linear (f::'a::semiring_1 ^ 'n => _)"
+ shows "span (f ` S) = f ` (span S)"
+proof-
+ {fix x
+ assume x: "x \<in> span (f ` S)"
+ have "x \<in> f ` span S"
+ apply (rule span_induct[where x=x and S = "f ` S"])
+ apply (clarsimp simp add: image_iff)
+ apply (frule span_superset)
+ apply blast
+ apply (simp only: mem_def)
+ apply (rule subspace_linear_image[OF lf])
+ apply (rule subspace_span)
+ apply (rule x)
+ done}
+ moreover
+ {fix x assume x: "x \<in> span S"
+ have th0:"(\<lambda>a. f a \<in> span (f ` S)) = {x. f x \<in> span (f ` S)}" apply (rule set_ext)
+ unfolding mem_def Collect_def ..
+ have "f x \<in> span (f ` S)"
+ apply (rule span_induct[where S=S])
+ apply (rule span_superset)
+ apply simp
+ apply (subst th0)
+ apply (rule subspace_linear_preimage[OF lf subspace_span, of "f ` S"])
+ apply (rule x)
+ done}
+ ultimately show ?thesis by blast
+qed
+
+(* The key breakdown property. *)
+
+lemma span_breakdown:
+ assumes bS: "(b::'a::ring_1 ^ 'n) \<in> S" and aS: "a \<in> span S"
+ shows "\<exists>k. a - k*s b \<in> span (S - {b})" (is "?P a")
+proof-
+ {fix x assume xS: "x \<in> S"
+ {assume ab: "x = b"
+ then have "?P x"
+ apply simp
+ apply (rule exI[where x="1"], simp)
+ by (rule span_0)}
+ moreover
+ {assume ab: "x \<noteq> b"
+ then have "?P x" using xS
+ apply -
+ apply (rule exI[where x=0])
+ apply (rule span_superset)
+ by simp}
+ ultimately have "?P x" by blast}
+ moreover have "subspace ?P"
+ unfolding subspace_def
+ apply auto
+ apply (simp add: mem_def)
+ apply (rule exI[where x=0])
+ using span_0[of "S - {b}"]
+ apply (simp add: mem_def)
+ apply (clarsimp simp add: mem_def)
+ apply (rule_tac x="k + ka" in exI)
+ apply (subgoal_tac "x + y - (k + ka) *s b = (x - k*s b) + (y - ka *s b)")
+ apply (simp only: )
+ apply (rule span_add[unfolded mem_def])
+ apply assumption+
+ apply (vector ring_simps)
+ apply (clarsimp simp add: mem_def)
+ apply (rule_tac x= "c*k" in exI)
+ apply (subgoal_tac "c *s x - (c * k) *s b = c*s (x - k*s b)")
+ apply (simp only: )
+ apply (rule span_mul[unfolded mem_def])
+ apply assumption
+ by (vector ring_simps)
+ ultimately show "?P a" using aS span_induct[where S=S and P= "?P"] by metis
+qed
+
+lemma span_breakdown_eq:
+ "(x::'a::ring_1^'n) \<in> span (insert a S) \<longleftrightarrow> (\<exists>k. (x - k *s a) \<in> span S)" (is "?lhs \<longleftrightarrow> ?rhs")
+proof-
+ {assume x: "x \<in> span (insert a S)"
+ from x span_breakdown[of "a" "insert a S" "x"]
+ have ?rhs apply clarsimp
+ apply (rule_tac x= "k" in exI)
+ apply (rule set_rev_mp[of _ "span (S - {a})" _])
+ apply assumption
+ apply (rule span_mono)
+ apply blast
+ done}
+ moreover
+ { fix k assume k: "x - k *s a \<in> span S"
+ have eq: "x = (x - k *s a) + k *s a" by vector
+ have "(x - k *s a) + k *s a \<in> span (insert a S)"
+ apply (rule span_add)
+ apply (rule set_rev_mp[of _ "span S" _])
+ apply (rule k)
+ apply (rule span_mono)
+ apply blast
+ apply (rule span_mul)
+ apply (rule span_superset)
+ apply blast
+ done
+ then have ?lhs using eq by metis}
+ ultimately show ?thesis by blast
+qed
+
+(* Hence some "reversal" results.*)
+
+lemma in_span_insert:
+ assumes a: "(a::'a::field^'n) \<in> span (insert b S)" and na: "a \<notin> span S"
+ shows "b \<in> span (insert a S)"
+proof-
+ from span_breakdown[of b "insert b S" a, OF insertI1 a]
+ obtain k where k: "a - k*s b \<in> span (S - {b})" by auto
+ {assume k0: "k = 0"
+ with k have "a \<in> span S"
+ apply (simp)
+ apply (rule set_rev_mp)
+ apply assumption
+ apply (rule span_mono)
+ apply blast
+ done
+ with na have ?thesis by blast}
+ moreover
+ {assume k0: "k \<noteq> 0"
+ have eq: "b = (1/k) *s a - ((1/k) *s a - b)" by vector
+ from k0 have eq': "(1/k) *s (a - k*s b) = (1/k) *s a - b"
+ by (vector field_simps)
+ from k have "(1/k) *s (a - k*s b) \<in> span (S - {b})"
+ by (rule span_mul)
+ hence th: "(1/k) *s a - b \<in> span (S - {b})"
+ unfolding eq' .
+
+ from k
+ have ?thesis
+ apply (subst eq)
+ apply (rule span_sub)
+ apply (rule span_mul)
+ apply (rule span_superset)
+ apply blast
+ apply (rule set_rev_mp)
+ apply (rule th)
+ apply (rule span_mono)
+ using na by blast}
+ ultimately show ?thesis by blast
+qed
+
+lemma in_span_delete:
+ assumes a: "(a::'a::field^'n) \<in> span S"
+ and na: "a \<notin> span (S-{b})"
+ shows "b \<in> span (insert a (S - {b}))"
+ apply (rule in_span_insert)
+ apply (rule set_rev_mp)
+ apply (rule a)
+ apply (rule span_mono)
+ apply blast
+ apply (rule na)
+ done
+
+(* Transitivity property. *)
+
+lemma span_trans:
+ assumes x: "(x::'a::ring_1^'n) \<in> span S" and y: "y \<in> span (insert x S)"
+ shows "y \<in> span S"
+proof-
+ from span_breakdown[of x "insert x S" y, OF insertI1 y]
+ obtain k where k: "y -k*s x \<in> span (S - {x})" by auto
+ have eq: "y = (y - k *s x) + k *s x" by vector
+ show ?thesis
+ apply (subst eq)
+ apply (rule span_add)
+ apply (rule set_rev_mp)
+ apply (rule k)
+ apply (rule span_mono)
+ apply blast
+ apply (rule span_mul)
+ by (rule x)
+qed
+
+(* ------------------------------------------------------------------------- *)
+(* An explicit expansion is sometimes needed. *)
+(* ------------------------------------------------------------------------- *)
+
+lemma span_explicit:
+ "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}"
+ (is "_ = ?E" is "_ = {y. ?h y}" is "_ = {y. \<exists>S u. ?Q S u y}")
+proof-
+ {fix x assume x: "x \<in> ?E"
+ then obtain S u where fS: "finite S" and SP: "S\<subseteq>P" and u: "setsum (\<lambda>v. u v *s v) S = x"
+ by blast
+ have "x \<in> span P"
+ unfolding u[symmetric]
+ apply (rule span_setsum[OF fS])
+ using span_mono[OF SP]
+ by (auto intro: span_superset span_mul)}
+ moreover
+ have "\<forall>x \<in> span P. x \<in> ?E"
+ unfolding mem_def Collect_def
+ proof(rule span_induct_alt')
+ show "?h 0"
+ apply (rule exI[where x="{}"]) by simp
+ next
+ fix c x y
+ assume x: "x \<in> P" and hy: "?h y"
+ from hy obtain S u where fS: "finite S" and SP: "S\<subseteq>P"
+ and u: "setsum (\<lambda>v. u v *s v) S = y" by blast
+ let ?S = "insert x S"
+ let ?u = "\<lambda>y. if y = x then (if x \<in> S then u y + c else c)
+ else u y"
+ from fS SP x have th0: "finite (insert x S)" "insert x S \<subseteq> P" by blast+
+ {assume xS: "x \<in> S"
+ have S1: "S = (S - {x}) \<union> {x}"
+ and Sss:"finite (S - {x})" "finite {x}" "(S -{x}) \<inter> {x} = {}" using xS fS by auto
+ have "setsum (\<lambda>v. ?u v *s v) ?S =(\<Sum>v\<in>S - {x}. u v *s v) + (u x + c) *s x"
+ using xS
+ by (simp add: setsum_Un_disjoint[OF Sss, unfolded S1[symmetric]]
+ setsum_clauses(2)[OF fS] cong del: if_weak_cong)
+ also have "\<dots> = (\<Sum>v\<in>S. u v *s v) + c *s x"
+ apply (simp add: setsum_Un_disjoint[OF Sss, unfolded S1[symmetric]])
+ by (vector ring_simps)
+ also have "\<dots> = c*s x + y"
+ by (simp add: add_commute u)
+ finally have "setsum (\<lambda>v. ?u v *s v) ?S = c*s x + y" .
+ then have "?Q ?S ?u (c*s x + y)" using th0 by blast}
+ moreover
+ {assume xS: "x \<notin> S"
+ have th00: "(\<Sum>v\<in>S. (if v = x then c else u v) *s v) = y"
+ unfolding u[symmetric]
+ apply (rule setsum_cong2)
+ using xS by auto
+ have "?Q ?S ?u (c*s x + y)" using fS xS th0
+ by (simp add: th00 setsum_clauses add_commute cong del: if_weak_cong)}
+ ultimately have "?Q ?S ?u (c*s x + y)"
+ by (cases "x \<in> S", simp, simp)
+ then show "?h (c*s x + y)"
+ apply -
+ apply (rule exI[where x="?S"])
+ apply (rule exI[where x="?u"]) by metis
+ qed
+ ultimately show ?thesis by blast
+qed
+
+lemma dependent_explicit:
+ "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")
+proof-
+ {assume dP: "dependent P"
+ then obtain a S u where aP: "a \<in> P" and fS: "finite S"
+ and SP: "S \<subseteq> P - {a}" and ua: "setsum (\<lambda>v. u v *s v) S = a"
+ unfolding dependent_def span_explicit by blast
+ let ?S = "insert a S"
+ let ?u = "\<lambda>y. if y = a then - 1 else u y"
+ let ?v = a
+ from aP SP have aS: "a \<notin> S" by blast
+ from fS SP aP have th0: "finite ?S" "?S \<subseteq> P" "?v \<in> ?S" "?u ?v \<noteq> 0" by auto
+ have s0: "setsum (\<lambda>v. ?u v *s v) ?S = 0"
+ using fS aS
+ apply (simp add: vector_smult_lneg vector_smult_lid setsum_clauses ring_simps )
+ apply (subst (2) ua[symmetric])
+ apply (rule setsum_cong2)
+ by auto
+ with th0 have ?rhs
+ apply -
+ apply (rule exI[where x= "?S"])
+ apply (rule exI[where x= "?u"])
+ by clarsimp}
+ moreover
+ {fix S u v assume fS: "finite S"
+ and SP: "S \<subseteq> P" and vS: "v \<in> S" and uv: "u v \<noteq> 0"
+ and u: "setsum (\<lambda>v. u v *s v) S = 0"
+ let ?a = v
+ let ?S = "S - {v}"
+ let ?u = "\<lambda>i. (- u i) / u v"
+ have th0: "?a \<in> P" "finite ?S" "?S \<subseteq> P" using fS SP vS by auto
+ 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"
+ using fS vS uv
+ by (simp add: setsum_diff1 vector_smult_lneg divide_inverse
+ vector_smult_assoc field_simps)
+ also have "\<dots> = ?a"
+ unfolding setsum_cmul u
+ using uv by (simp add: vector_smult_lneg)
+ finally have "setsum (\<lambda>v. ?u v *s v) ?S = ?a" .
+ with th0 have ?lhs
+ unfolding dependent_def span_explicit
+ apply -
+ apply (rule bexI[where x= "?a"])
+ apply simp_all
+ apply (rule exI[where x= "?S"])
+ by auto}
+ ultimately show ?thesis by blast
+qed
+
+
+lemma span_finite:
+ assumes fS: "finite S"
+ shows "span S = {(y::'a::semiring_1^'n). \<exists>u. setsum (\<lambda>v. u v *s v) S = y}"
+ (is "_ = ?rhs")
+proof-
+ {fix y assume y: "y \<in> span S"
+ from y obtain S' u where fS': "finite S'" and SS': "S' \<subseteq> S" and
+ u: "setsum (\<lambda>v. u v *s v) S' = y" unfolding span_explicit by blast
+ let ?u = "\<lambda>x. if x \<in> S' then u x else 0"
+ from setsum_restrict_set[OF fS, of "\<lambda>v. u v *s v" S', symmetric] SS'
+ have "setsum (\<lambda>v. ?u v *s v) S = setsum (\<lambda>v. u v *s v) S'"
+ unfolding cond_value_iff cond_application_beta
+ by (simp add: cond_value_iff inf_absorb2 cong del: if_weak_cong)
+ hence "setsum (\<lambda>v. ?u v *s v) S = y" by (metis u)
+ hence "y \<in> ?rhs" by auto}
+ moreover
+ {fix y u assume u: "setsum (\<lambda>v. u v *s v) S = y"
+ then have "y \<in> span S" using fS unfolding span_explicit by auto}
+ ultimately show ?thesis by blast
+qed
+
+
+(* Standard bases are a spanning set, and obviously finite. *)
+
+lemma span_stdbasis:"span {basis i :: 'a::ring_1^'n::finite | i. i \<in> (UNIV :: 'n set)} = UNIV"
+apply (rule set_ext)
+apply auto
+apply (subst basis_expansion[symmetric])
+apply (rule span_setsum)
+apply simp
+apply auto
+apply (rule span_mul)
+apply (rule span_superset)
+apply (auto simp add: Collect_def mem_def)
+done
+
+lemma has_size_stdbasis: "{basis i ::real ^'n::finite | i. i \<in> (UNIV :: 'n set)} hassize CARD('n)" (is "?S hassize ?n")
+proof-
+ have eq: "?S = basis ` UNIV" by blast
+ show ?thesis unfolding eq
+ apply (rule hassize_image_inj[OF basis_inj])
+ by (simp add: hassize_def)
+qed
+
+lemma finite_stdbasis: "finite {basis i ::real^'n::finite |i. i\<in> (UNIV:: 'n set)}"
+ using has_size_stdbasis[unfolded hassize_def]
+ ..
+
+lemma card_stdbasis: "card {basis i ::real^'n::finite |i. i\<in> (UNIV :: 'n set)} = CARD('n)"
+ using has_size_stdbasis[unfolded hassize_def]
+ ..
+
+lemma independent_stdbasis_lemma:
+ assumes x: "(x::'a::semiring_1 ^ 'n) \<in> span (basis ` S)"
+ and iS: "i \<notin> S"
+ shows "(x$i) = 0"
+proof-
+ let ?U = "UNIV :: 'n set"
+ let ?B = "basis ` S"
+ let ?P = "\<lambda>(x::'a^'n). \<forall>i\<in> ?U. i \<notin> S \<longrightarrow> x$i =0"
+ {fix x::"'a^'n" assume xS: "x\<in> ?B"
+ from xS have "?P x" by auto}
+ moreover
+ have "subspace ?P"
+ by (auto simp add: subspace_def Collect_def mem_def)
+ ultimately show ?thesis
+ using x span_induct[of ?B ?P x] iS by blast
+qed
+
+lemma independent_stdbasis: "independent {basis i ::real^'n::finite |i. i\<in> (UNIV :: 'n set)}"
+proof-
+ let ?I = "UNIV :: 'n set"
+ let ?b = "basis :: _ \<Rightarrow> real ^'n"
+ let ?B = "?b ` ?I"
+ have eq: "{?b i|i. i \<in> ?I} = ?B"
+ by auto
+ {assume d: "dependent ?B"
+ then obtain k where k: "k \<in> ?I" "?b k \<in> span (?B - {?b k})"
+ unfolding dependent_def by auto
+ have eq1: "?B - {?b k} = ?B - ?b ` {k}" by simp
+ have eq2: "?B - {?b k} = ?b ` (?I - {k})"
+ unfolding eq1
+ apply (rule inj_on_image_set_diff[symmetric])
+ apply (rule basis_inj) using k(1) by auto
+ from k(2) have th0: "?b k \<in> span (?b ` (?I - {k}))" unfolding eq2 .
+ from independent_stdbasis_lemma[OF th0, of k, simplified]
+ have False by simp}
+ then show ?thesis unfolding eq dependent_def ..
+qed
+
+(* This is useful for building a basis step-by-step. *)
+
+lemma independent_insert:
+ "independent(insert (a::'a::field ^'n) S) \<longleftrightarrow>
+ (if a \<in> S then independent S
+ else independent S \<and> a \<notin> span S)" (is "?lhs \<longleftrightarrow> ?rhs")
+proof-
+ {assume aS: "a \<in> S"
+ hence ?thesis using insert_absorb[OF aS] by simp}
+ moreover
+ {assume aS: "a \<notin> S"
+ {assume i: ?lhs
+ then have ?rhs using aS
+ apply simp
+ apply (rule conjI)
+ apply (rule independent_mono)
+ apply assumption
+ apply blast
+ by (simp add: dependent_def)}
+ moreover
+ {assume i: ?rhs
+ have ?lhs using i aS
+ apply simp
+ apply (auto simp add: dependent_def)
+ apply (case_tac "aa = a", auto)
+ apply (subgoal_tac "insert a S - {aa} = insert a (S - {aa})")
+ apply simp
+ apply (subgoal_tac "a \<in> span (insert aa (S - {aa}))")
+ apply (subgoal_tac "insert aa (S - {aa}) = S")
+ apply simp
+ apply blast
+ apply (rule in_span_insert)
+ apply assumption
+ apply blast
+ apply blast
+ done}
+ ultimately have ?thesis by blast}
+ ultimately show ?thesis by blast
+qed
+
+(* The degenerate case of the Exchange Lemma. *)
+
+lemma mem_delete: "x \<in> (A - {a}) \<longleftrightarrow> x \<noteq> a \<and> x \<in> A"
+ by blast
+
+lemma span_span: "span (span A) = span A"
+ unfolding span_def hull_hull ..
+
+lemma span_inc: "S \<subseteq> span S"
+ by (metis subset_eq span_superset)
+
+lemma spanning_subset_independent:
+ assumes BA: "B \<subseteq> A" and iA: "independent (A::('a::field ^'n) set)"
+ and AsB: "A \<subseteq> span B"
+ shows "A = B"
+proof
+ from BA show "B \<subseteq> A" .
+next
+ from span_mono[OF BA] span_mono[OF AsB]
+ have sAB: "span A = span B" unfolding span_span by blast
+
+ {fix x assume x: "x \<in> A"
+ from iA have th0: "x \<notin> span (A - {x})"
+ unfolding dependent_def using x by blast
+ from x have xsA: "x \<in> span A" by (blast intro: span_superset)
+ have "A - {x} \<subseteq> A" by blast
+ hence th1:"span (A - {x}) \<subseteq> span A" by (metis span_mono)
+ {assume xB: "x \<notin> B"
+ from xB BA have "B \<subseteq> A -{x}" by blast
+ hence "span B \<subseteq> span (A - {x})" by (metis span_mono)
+ with th1 th0 sAB have "x \<notin> span A" by blast
+ with x have False by (metis span_superset)}
+ then have "x \<in> B" by blast}
+ then show "A \<subseteq> B" by blast
+qed
+
+(* The general case of the Exchange Lemma, the key to what follows. *)
+
+lemma exchange_lemma:
+ assumes f:"finite (t:: ('a::field^'n) set)" and i: "independent s"
+ and sp:"s \<subseteq> span t"
+ shows "\<exists>t'. (t' hassize card t) \<and> s \<subseteq> t' \<and> t' \<subseteq> s \<union> t \<and> s \<subseteq> span t'"
+using f i sp
+proof(induct c\<equiv>"card(t - s)" arbitrary: s t rule: nat_less_induct)
+ fix n:: nat and s t :: "('a ^'n) set"
+ assume H: " \<forall>m<n. \<forall>(x:: ('a ^'n) set) xa.
+ finite xa \<longrightarrow>
+ independent x \<longrightarrow>
+ x \<subseteq> span xa \<longrightarrow>
+ m = card (xa - x) \<longrightarrow>
+ (\<exists>t'. (t' hassize card xa) \<and>
+ x \<subseteq> t' \<and> t' \<subseteq> x \<union> xa \<and> x \<subseteq> span t')"
+ and ft: "finite t" and s: "independent s" and sp: "s \<subseteq> span t"
+ and n: "n = card (t - s)"
+ let ?P = "\<lambda>t'. (t' hassize card t) \<and> s \<subseteq> t' \<and> t' \<subseteq> s \<union> t \<and> s \<subseteq> span t'"
+ let ?ths = "\<exists>t'. ?P t'"
+ {assume st: "s \<subseteq> t"
+ from st ft span_mono[OF st] have ?ths apply - apply (rule exI[where x=t])
+ by (auto simp add: hassize_def intro: span_superset)}
+ moreover
+ {assume st: "t \<subseteq> s"
+
+ from spanning_subset_independent[OF st s sp]
+ st ft span_mono[OF st] have ?ths apply - apply (rule exI[where x=t])
+ by (auto simp add: hassize_def intro: span_superset)}
+ moreover
+ {assume st: "\<not> s \<subseteq> t" "\<not> t \<subseteq> s"
+ from st(2) obtain b where b: "b \<in> t" "b \<notin> s" by blast
+ from b have "t - {b} - s \<subset> t - s" by blast
+ then have cardlt: "card (t - {b} - s) < n" using n ft
+ by (auto intro: psubset_card_mono)
+ from b ft have ct0: "card t \<noteq> 0" by auto
+ {assume stb: "s \<subseteq> span(t -{b})"
+ from ft have ftb: "finite (t -{b})" by auto
+ from H[rule_format, OF cardlt ftb s stb]
+ obtain u where u: "u hassize card (t-{b})" "s \<subseteq> u" "u \<subseteq> s \<union> (t - {b})" "s \<subseteq> span u" by blast
+ let ?w = "insert b u"
+ have th0: "s \<subseteq> insert b u" using u by blast
+ from u(3) b have "u \<subseteq> s \<union> t" by blast
+ then have th1: "insert b u \<subseteq> s \<union> t" using u b by blast
+ have bu: "b \<notin> u" using b u by blast
+ from u(1) have fu: "finite u" by (simp add: hassize_def)
+ from u(1) ft b have "u hassize (card t - 1)" by auto
+ then
+ have th2: "insert b u hassize card t"
+ using card_insert_disjoint[OF fu bu] ct0 by (auto simp add: hassize_def)
+ from u(4) have "s \<subseteq> span u" .
+ also have "\<dots> \<subseteq> span (insert b u)" apply (rule span_mono) by blast
+ finally have th3: "s \<subseteq> span (insert b u)" . from th0 th1 th2 th3 have th: "?P ?w" by blast
+ from th have ?ths by blast}
+ moreover
+ {assume stb: "\<not> s \<subseteq> span(t -{b})"
+ from stb obtain a where a: "a \<in> s" "a \<notin> span (t - {b})" by blast
+ have ab: "a \<noteq> b" using a b by blast
+ have at: "a \<notin> t" using a ab span_superset[of a "t- {b}"] by auto
+ have mlt: "card ((insert a (t - {b})) - s) < n"
+ using cardlt ft n a b by auto
+ have ft': "finite (insert a (t - {b}))" using ft by auto
+ {fix x assume xs: "x \<in> s"
+ have t: "t \<subseteq> (insert b (insert a (t -{b})))" using b by auto
+ from b(1) have "b \<in> span t" by (simp add: span_superset)
+ have bs: "b \<in> span (insert a (t - {b}))"
+ by (metis in_span_delete a sp mem_def subset_eq)
+ from xs sp have "x \<in> span t" by blast
+ with span_mono[OF t]
+ have x: "x \<in> span (insert b (insert a (t - {b})))" ..
+ from span_trans[OF bs x] have "x \<in> span (insert a (t - {b}))" .}
+ then have sp': "s \<subseteq> span (insert a (t - {b}))" by blast
+
+ from H[rule_format, OF mlt ft' s sp' refl] obtain u where
+ u: "u hassize card (insert a (t -{b}))" "s \<subseteq> u" "u \<subseteq> s \<union> insert a (t -{b})"
+ "s \<subseteq> span u" by blast
+ from u a b ft at ct0 have "?P u" by (auto simp add: hassize_def)
+ then have ?ths by blast }
+ ultimately have ?ths by blast
+ }
+ ultimately
+ show ?ths by blast
+qed
+
+(* This implies corresponding size bounds. *)
+
+lemma independent_span_bound:
+ assumes f: "finite t" and i: "independent (s::('a::field^'n) set)" and sp:"s \<subseteq> span t"
+ shows "finite s \<and> card s \<le> card t"
+ by (metis exchange_lemma[OF f i sp] hassize_def finite_subset card_mono)
+
+
+lemma finite_Atleast_Atmost_nat[simp]: "finite {f x |x. x\<in> (UNIV::'a::finite set)}"
+proof-
+ have eq: "{f x |x. x\<in> UNIV} = f ` UNIV" by auto
+ show ?thesis unfolding eq
+ apply (rule finite_imageI)
+ apply (rule finite)
+ done
+qed
+
+
+lemma independent_bound:
+ fixes S:: "(real^'n::finite) set"
+ shows "independent S \<Longrightarrow> finite S \<and> card S <= CARD('n)"
+ apply (subst card_stdbasis[symmetric])
+ apply (rule independent_span_bound)
+ apply (rule finite_Atleast_Atmost_nat)
+ apply assumption
+ unfolding span_stdbasis
+ apply (rule subset_UNIV)
+ done
+
+lemma dependent_biggerset: "(finite (S::(real ^'n::finite) set) ==> card S > CARD('n)) ==> dependent S"
+ by (metis independent_bound not_less)
+
+(* Hence we can create a maximal independent subset. *)
+
+lemma maximal_independent_subset_extend:
+ assumes sv: "(S::(real^'n::finite) set) \<subseteq> V" and iS: "independent S"
+ shows "\<exists>B. S \<subseteq> B \<and> B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B"
+ using sv iS
+proof(induct d\<equiv> "CARD('n) - card S" arbitrary: S rule: nat_less_induct)
+ fix n and S:: "(real^'n) set"
+ assume H: "\<forall>m<n. \<forall>S \<subseteq> V. independent S \<longrightarrow> m = CARD('n) - card S \<longrightarrow>
+ (\<exists>B. S \<subseteq> B \<and> B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B)"
+ and sv: "S \<subseteq> V" and i: "independent S" and n: "n = CARD('n) - card S"
+ let ?P = "\<lambda>B. S \<subseteq> B \<and> B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B"
+ let ?ths = "\<exists>x. ?P x"
+ let ?d = "CARD('n)"
+ {assume "V \<subseteq> span S"
+ then have ?ths using sv i by blast }
+ moreover
+ {assume VS: "\<not> V \<subseteq> span S"
+ from VS obtain a where a: "a \<in> V" "a \<notin> span S" by blast
+ from a have aS: "a \<notin> S" by (auto simp add: span_superset)
+ have th0: "insert a S \<subseteq> V" using a sv by blast
+ from independent_insert[of a S] i a
+ have th1: "independent (insert a S)" by auto
+ have mlt: "?d - card (insert a S) < n"
+ using aS a n independent_bound[OF th1]
+ by auto
+
+ from H[rule_format, OF mlt th0 th1 refl]
+ obtain B where B: "insert a S \<subseteq> B" "B \<subseteq> V" "independent B" " V \<subseteq> span B"
+ by blast
+ from B have "?P B" by auto
+ then have ?ths by blast}
+ ultimately show ?ths by blast
+qed
+
+lemma maximal_independent_subset:
+ "\<exists>(B:: (real ^'n::finite) set). B\<subseteq> V \<and> independent B \<and> V \<subseteq> span B"
+ by (metis maximal_independent_subset_extend[of "{}:: (real ^'n) set"] empty_subsetI independent_empty)
+
+(* Notion of dimension. *)
+
+definition "dim V = (SOME n. \<exists>B. B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> (B hassize n))"
+
+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)"
+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)"]
+unfolding hassize_def
+using maximal_independent_subset[of V] independent_bound
+by auto
+
+(* Consequences of independence or spanning for cardinality. *)
+
+lemma independent_card_le_dim: "(B::(real ^'n::finite) set) \<subseteq> V \<Longrightarrow> independent B \<Longrightarrow> finite B \<and> card B \<le> dim V"
+by (metis basis_exists[of V] independent_span_bound[where ?'a=real] hassize_def subset_trans)
+
+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"
+ by (metis basis_exists[of V] independent_span_bound hassize_def subset_trans)
+
+lemma basis_card_eq_dim:
+ "B \<subseteq> (V:: (real ^'n::finite) set) \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> independent B \<Longrightarrow> finite B \<and> card B = dim V"
+ by (metis order_eq_iff independent_card_le_dim span_card_ge_dim independent_mono)
+
+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"
+ by (metis basis_card_eq_dim hassize_def)
+
+(* More lemmas about dimension. *)
+
+lemma dim_univ: "dim (UNIV :: (real^'n::finite) set) = CARD('n)"
+ apply (rule dim_unique[of "{basis i |i. i\<in> (UNIV :: 'n set)}"])
+ by (auto simp only: span_stdbasis has_size_stdbasis independent_stdbasis)
+
+lemma dim_subset:
+ "(S:: (real ^'n::finite) set) \<subseteq> T \<Longrightarrow> dim S \<le> dim T"
+ using basis_exists[of T] basis_exists[of S]
+ by (metis independent_span_bound[where ?'a = real and ?'n = 'n] subset_eq hassize_def)
+
+lemma dim_subset_univ: "dim (S:: (real^'n::finite) set) \<le> CARD('n)"
+ by (metis dim_subset subset_UNIV dim_univ)
+
+(* Converses to those. *)
+
+lemma card_ge_dim_independent:
+ assumes BV:"(B::(real ^'n::finite) set) \<subseteq> V" and iB:"independent B" and dVB:"dim V \<le> card B"
+ shows "V \<subseteq> span B"
+proof-
+ {fix a assume aV: "a \<in> V"
+ {assume aB: "a \<notin> span B"
+ then have iaB: "independent (insert a B)" using iB aV BV by (simp add: independent_insert)
+ from aV BV have th0: "insert a B \<subseteq> V" by blast
+ from aB have "a \<notin>B" by (auto simp add: span_superset)
+ with independent_card_le_dim[OF th0 iaB] dVB have False by auto}
+ then have "a \<in> span B" by blast}
+ then show ?thesis by blast
+qed
+
+lemma card_le_dim_spanning:
+ assumes BV: "(B:: (real ^'n::finite) set) \<subseteq> V" and VB: "V \<subseteq> span B"
+ and fB: "finite B" and dVB: "dim V \<ge> card B"
+ shows "independent B"
+proof-
+ {fix a assume a: "a \<in> B" "a \<in> span (B -{a})"
+ from a fB have c0: "card B \<noteq> 0" by auto
+ from a fB have cb: "card (B -{a}) = card B - 1" by auto
+ from BV a have th0: "B -{a} \<subseteq> V" by blast
+ {fix x assume x: "x \<in> V"
+ from a have eq: "insert a (B -{a}) = B" by blast
+ from x VB have x': "x \<in> span B" by blast
+ from span_trans[OF a(2), unfolded eq, OF x']
+ have "x \<in> span (B -{a})" . }
+ then have th1: "V \<subseteq> span (B -{a})" by blast
+ have th2: "finite (B -{a})" using fB by auto
+ from span_card_ge_dim[OF th0 th1 th2]
+ have c: "dim V \<le> card (B -{a})" .
+ from c c0 dVB cb have False by simp}
+ then show ?thesis unfolding dependent_def by blast
+qed
+
+lemma card_eq_dim: "(B:: (real ^'n::finite) set) \<subseteq> V \<Longrightarrow> B hassize dim V \<Longrightarrow> independent B \<longleftrightarrow> V \<subseteq> span B"
+ by (metis hassize_def order_eq_iff card_le_dim_spanning
+ card_ge_dim_independent)
+
+(* ------------------------------------------------------------------------- *)
+(* More general size bound lemmas. *)
+(* ------------------------------------------------------------------------- *)
+
+lemma independent_bound_general:
+ "independent (S:: (real^'n::finite) set) \<Longrightarrow> finite S \<and> card S \<le> dim S"
+ by (metis independent_card_le_dim independent_bound subset_refl)
+
+lemma dependent_biggerset_general: "(finite (S:: (real^'n::finite) set) \<Longrightarrow> card S > dim S) \<Longrightarrow> dependent S"
+ using independent_bound_general[of S] by (metis linorder_not_le)
+
+lemma dim_span: "dim (span (S:: (real ^'n::finite) set)) = dim S"
+proof-
+ have th0: "dim S \<le> dim (span S)"
+ by (auto simp add: subset_eq intro: dim_subset span_superset)
+ from basis_exists[of S]
+ obtain B where B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "B hassize dim S" by blast
+ from B have fB: "finite B" "card B = dim S" unfolding hassize_def by blast+
+ have bSS: "B \<subseteq> span S" using B(1) by (metis subset_eq span_inc)
+ have sssB: "span S \<subseteq> span B" using span_mono[OF B(3)] by (simp add: span_span)
+ from span_card_ge_dim[OF bSS sssB fB(1)] th0 show ?thesis
+ using fB(2) by arith
+qed
+
+lemma subset_le_dim: "(S:: (real ^'n::finite) set) \<subseteq> span T \<Longrightarrow> dim S \<le> dim T"
+ by (metis dim_span dim_subset)
+
+lemma span_eq_dim: "span (S:: (real ^'n::finite) set) = span T ==> dim S = dim T"
+ by (metis dim_span)
+
+lemma spans_image:
+ assumes lf: "linear (f::'a::semiring_1^'n \<Rightarrow> _)" and VB: "V \<subseteq> span B"
+ shows "f ` V \<subseteq> span (f ` B)"
+ unfolding span_linear_image[OF lf]
+ by (metis VB image_mono)
+
+lemma dim_image_le:
+ fixes f :: "real^'n::finite \<Rightarrow> real^'m::finite"
+ assumes lf: "linear f" shows "dim (f ` S) \<le> dim (S:: (real ^'n::finite) set)"
+proof-
+ from basis_exists[of S] obtain B where
+ B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "B hassize dim S" by blast
+ from B have fB: "finite B" "card B = dim S" unfolding hassize_def by blast+
+ have "dim (f ` S) \<le> card (f ` B)"
+ apply (rule span_card_ge_dim)
+ using lf B fB by (auto simp add: span_linear_image spans_image subset_image_iff)
+ also have "\<dots> \<le> dim S" using card_image_le[OF fB(1)] fB by simp
+ finally show ?thesis .
+qed
+
+(* Relation between bases and injectivity/surjectivity of map. *)
+
+lemma spanning_surjective_image:
+ assumes us: "UNIV \<subseteq> span (S:: ('a::semiring_1 ^'n) set)"
+ and lf: "linear f" and sf: "surj f"
+ shows "UNIV \<subseteq> span (f ` S)"
+proof-
+ have "UNIV \<subseteq> f ` UNIV" using sf by (auto simp add: surj_def)
+ also have " \<dots> \<subseteq> span (f ` S)" using spans_image[OF lf us] .
+finally show ?thesis .
+qed
+
+lemma independent_injective_image:
+ assumes iS: "independent (S::('a::semiring_1^'n) set)" and lf: "linear f" and fi: "inj f"
+ shows "independent (f ` S)"
+proof-
+ {fix a assume a: "a \<in> S" "f a \<in> span (f ` S - {f a})"
+ have eq: "f ` S - {f a} = f ` (S - {a})" using fi
+ by (auto simp add: inj_on_def)
+ from a have "f a \<in> f ` span (S -{a})"
+ unfolding eq span_linear_image[OF lf, of "S - {a}"] by blast
+ hence "a \<in> span (S -{a})" using fi by (auto simp add: inj_on_def)
+ with a(1) iS have False by (simp add: dependent_def) }
+ then show ?thesis unfolding dependent_def by blast
+qed
+
+(* ------------------------------------------------------------------------- *)
+(* Picking an orthogonal replacement for a spanning set. *)
+(* ------------------------------------------------------------------------- *)
+ (* FIXME : Move to some general theory ?*)
+definition "pairwise R S \<longleftrightarrow> (\<forall>x \<in> S. \<forall>y\<in> S. x\<noteq>y \<longrightarrow> R x y)"
+
+lemma vector_sub_project_orthogonal: "(b::'a::ordered_field^'n::finite) \<bullet> (x - ((b \<bullet> x) / (b\<bullet>b)) *s b) = 0"
+ apply (cases "b = 0", simp)
+ apply (simp add: dot_rsub dot_rmult)
+ unfolding times_divide_eq_right[symmetric]
+ by (simp add: field_simps dot_eq_0)
+
+lemma basis_orthogonal:
+ fixes B :: "(real ^'n::finite) set"
+ assumes fB: "finite B"
+ shows "\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C"
+ (is " \<exists>C. ?P B C")
+proof(induct rule: finite_induct[OF fB])
+ case 1 thus ?case apply (rule exI[where x="{}"]) by (auto simp add: pairwise_def)
+next
+ case (2 a B)
+ note fB = `finite B` and aB = `a \<notin> B`
+ from `\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C`
+ obtain C where C: "finite C" "card C \<le> card B"
+ "span C = span B" "pairwise orthogonal C" by blast
+ let ?a = "a - setsum (\<lambda>x. (x\<bullet>a / (x\<bullet>x)) *s x) C"
+ let ?C = "insert ?a C"
+ from C(1) have fC: "finite ?C" by simp
+ from fB aB C(1,2) have cC: "card ?C \<le> card (insert a B)" by (simp add: card_insert_if)
+ {fix x k
+ have th0: "\<And>(a::'b::comm_ring) b c. a - (b - c) = c + (a - b)" by (simp add: ring_simps)
+ 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"
+ apply (simp only: vector_ssub_ldistrib th0)
+ apply (rule span_add_eq)
+ apply (rule span_mul)
+ apply (rule span_setsum[OF C(1)])
+ apply clarify
+ apply (rule span_mul)
+ by (rule span_superset)}
+ then have SC: "span ?C = span (insert a B)"
+ unfolding expand_set_eq span_breakdown_eq C(3)[symmetric] by auto
+ thm pairwise_def
+ {fix x y assume xC: "x \<in> ?C" and yC: "y \<in> ?C" and xy: "x \<noteq> y"
+ {assume xa: "x = ?a" and ya: "y = ?a"
+ have "orthogonal x y" using xa ya xy by blast}
+ moreover
+ {assume xa: "x = ?a" and ya: "y \<noteq> ?a" "y \<in> C"
+ from ya have Cy: "C = insert y (C - {y})" by blast
+ have fth: "finite (C - {y})" using C by simp
+ have "orthogonal x y"
+ using xa ya
+ unfolding orthogonal_def xa dot_lsub dot_rsub diff_eq_0_iff_eq
+ apply simp
+ apply (subst Cy)
+ using C(1) fth
+ apply (simp only: setsum_clauses)
+ thm dot_ladd
+ apply (auto simp add: dot_ladd dot_radd dot_lmult dot_rmult dot_eq_0 dot_sym[of y a] dot_lsum[OF fth])
+ apply (rule setsum_0')
+ apply clarsimp
+ apply (rule C(4)[unfolded pairwise_def orthogonal_def, rule_format])
+ by auto}
+ moreover
+ {assume xa: "x \<noteq> ?a" "x \<in> C" and ya: "y = ?a"
+ from xa have Cx: "C = insert x (C - {x})" by blast
+ have fth: "finite (C - {x})" using C by simp
+ have "orthogonal x y"
+ using xa ya
+ unfolding orthogonal_def ya dot_rsub dot_lsub diff_eq_0_iff_eq
+ apply simp
+ apply (subst Cx)
+ using C(1) fth
+ apply (simp only: setsum_clauses)
+ apply (subst dot_sym[of x])
+ apply (auto simp add: dot_radd dot_rmult dot_eq_0 dot_sym[of x a] dot_rsum[OF fth])
+ apply (rule setsum_0')
+ apply clarsimp
+ apply (rule C(4)[unfolded pairwise_def orthogonal_def, rule_format])
+ by auto}
+ moreover
+ {assume xa: "x \<in> C" and ya: "y \<in> C"
+ have "orthogonal x y" using xa ya xy C(4) unfolding pairwise_def by blast}
+ ultimately have "orthogonal x y" using xC yC by blast}
+ then have CPO: "pairwise orthogonal ?C" unfolding pairwise_def by blast
+ from fC cC SC CPO have "?P (insert a B) ?C" by blast
+ then show ?case by blast
+qed
+
+lemma orthogonal_basis_exists:
+ fixes V :: "(real ^'n::finite) set"
+ shows "\<exists>B. independent B \<and> B \<subseteq> span V \<and> V \<subseteq> span B \<and> (B hassize dim V) \<and> pairwise orthogonal B"
+proof-
+ from basis_exists[of V] obtain B where B: "B \<subseteq> V" "independent B" "V \<subseteq> span B" "B hassize dim V" by blast
+ from B have fB: "finite B" "card B = dim V" by (simp_all add: hassize_def)
+ from basis_orthogonal[OF fB(1)] obtain C where
+ C: "finite C" "card C \<le> card B" "span C = span B" "pairwise orthogonal C" by blast
+ from C B
+ have CSV: "C \<subseteq> span V" by (metis span_inc span_mono subset_trans)
+ from span_mono[OF B(3)] C have SVC: "span V \<subseteq> span C" by (simp add: span_span)
+ from card_le_dim_spanning[OF CSV SVC C(1)] C(2,3) fB
+ have iC: "independent C" by (simp add: dim_span)
+ from C fB have "card C \<le> dim V" by simp
+ moreover have "dim V \<le> card C" using span_card_ge_dim[OF CSV SVC C(1)]
+ by (simp add: dim_span)
+ ultimately have CdV: "C hassize dim V" unfolding hassize_def using C(1) by simp
+ from C B CSV CdV iC show ?thesis by auto
+qed
+
+lemma span_eq: "span S = span T \<longleftrightarrow> S \<subseteq> span T \<and> T \<subseteq> span S"
+ by (metis set_eq_subset span_mono span_span span_inc) (* FIXME: slow *)
+
+(* ------------------------------------------------------------------------- *)
+(* Low-dimensional subset is in a hyperplane (weak orthogonal complement). *)
+(* ------------------------------------------------------------------------- *)
+
+lemma span_not_univ_orthogonal:
+ assumes sU: "span S \<noteq> UNIV"
+ shows "\<exists>(a:: real ^'n::finite). a \<noteq>0 \<and> (\<forall>x \<in> span S. a \<bullet> x = 0)"
+proof-
+ from sU obtain a where a: "a \<notin> span S" by blast
+ from orthogonal_basis_exists obtain B where
+ B: "independent B" "B \<subseteq> span S" "S \<subseteq> span B" "B hassize dim S" "pairwise orthogonal B"
+ by blast
+ from B have fB: "finite B" "card B = dim S" by (simp_all add: hassize_def)
+ from span_mono[OF B(2)] span_mono[OF B(3)]
+ have sSB: "span S = span B" by (simp add: span_span)
+ let ?a = "a - setsum (\<lambda>b. (a\<bullet>b / (b\<bullet>b)) *s b) B"
+ have "setsum (\<lambda>b. (a\<bullet>b / (b\<bullet>b)) *s b) B \<in> span S"
+ unfolding sSB
+ apply (rule span_setsum[OF fB(1)])
+ apply clarsimp
+ apply (rule span_mul)
+ by (rule span_superset)
+ with a have a0:"?a \<noteq> 0" by auto
+ have "\<forall>x\<in>span B. ?a \<bullet> x = 0"
+ proof(rule span_induct')
+ show "subspace (\<lambda>x. ?a \<bullet> x = 0)"
+ by (auto simp add: subspace_def mem_def dot_radd dot_rmult)
+ next
+ {fix x assume x: "x \<in> B"
+ from x have B': "B = insert x (B - {x})" by blast
+ have fth: "finite (B - {x})" using fB by simp
+ have "?a \<bullet> x = 0"
+ apply (subst B') using fB fth
+ unfolding setsum_clauses(2)[OF fth]
+ apply simp
+ apply (clarsimp simp add: dot_lsub dot_ladd dot_lmult dot_lsum dot_eq_0)
+ apply (rule setsum_0', rule ballI)
+ unfolding dot_sym
+ by (auto simp add: x field_simps dot_eq_0 intro: B(5)[unfolded pairwise_def orthogonal_def, rule_format])}
+ then show "\<forall>x \<in> B. ?a \<bullet> x = 0" by blast
+ qed
+ with a0 show ?thesis unfolding sSB by (auto intro: exI[where x="?a"])
+qed
+
+lemma span_not_univ_subset_hyperplane:
+ assumes SU: "span S \<noteq> (UNIV ::(real^'n::finite) set)"
+ shows "\<exists> a. a \<noteq>0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
+ using span_not_univ_orthogonal[OF SU] by auto
+
+lemma lowdim_subset_hyperplane:
+ assumes d: "dim S < CARD('n::finite)"
+ shows "\<exists>(a::real ^'n::finite). a \<noteq> 0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
+proof-
+ {assume "span S = UNIV"
+ hence "dim (span S) = dim (UNIV :: (real ^'n) set)" by simp
+ hence "dim S = CARD('n)" by (simp add: dim_span dim_univ)
+ with d have False by arith}
+ hence th: "span S \<noteq> UNIV" by blast
+ from span_not_univ_subset_hyperplane[OF th] show ?thesis .
+qed
+
+(* We can extend a linear basis-basis injection to the whole set. *)
+
+lemma linear_indep_image_lemma:
+ assumes lf: "linear f" and fB: "finite B"
+ and ifB: "independent (f ` B)"
+ and fi: "inj_on f B" and xsB: "x \<in> span B"
+ and fx: "f (x::'a::field^'n) = 0"
+ shows "x = 0"
+ using fB ifB fi xsB fx
+proof(induct arbitrary: x rule: finite_induct[OF fB])
+ case 1 thus ?case by (auto simp add: span_empty)
+next
+ case (2 a b x)
+ have fb: "finite b" using "2.prems" by simp
+ have th0: "f ` b \<subseteq> f ` (insert a b)"
+ apply (rule image_mono) by blast
+ from independent_mono[ OF "2.prems"(2) th0]
+ have ifb: "independent (f ` b)" .
+ have fib: "inj_on f b"
+ apply (rule subset_inj_on [OF "2.prems"(3)])
+ by blast
+ from span_breakdown[of a "insert a b", simplified, OF "2.prems"(4)]
+ obtain k where k: "x - k*s a \<in> span (b -{a})" by blast
+ have "f (x - k*s a) \<in> span (f ` b)"
+ unfolding span_linear_image[OF lf]
+ apply (rule imageI)
+ using k span_mono[of "b-{a}" b] by blast
+ hence "f x - k*s f a \<in> span (f ` b)"
+ by (simp add: linear_sub[OF lf] linear_cmul[OF lf])
+ hence th: "-k *s f a \<in> span (f ` b)"
+ using "2.prems"(5) by (simp add: vector_smult_lneg)
+ {assume k0: "k = 0"
+ from k0 k have "x \<in> span (b -{a})" by simp
+ then have "x \<in> span b" using span_mono[of "b-{a}" b]
+ by blast}
+ moreover
+ {assume k0: "k \<noteq> 0"
+ from span_mul[OF th, of "- 1/ k"] k0
+ have th1: "f a \<in> span (f ` b)"
+ by (auto simp add: vector_smult_assoc)
+ from inj_on_image_set_diff[OF "2.prems"(3), of "insert a b " "{a}", symmetric]
+ have tha: "f ` insert a b - f ` {a} = f ` (insert a b - {a})" by blast
+ from "2.prems"(2)[unfolded dependent_def bex_simps(10), rule_format, of "f a"]
+ have "f a \<notin> span (f ` b)" using tha
+ using "2.hyps"(2)
+ "2.prems"(3) by auto
+ with th1 have False by blast
+ then have "x \<in> span b" by blast}
+ ultimately have xsb: "x \<in> span b" by blast
+ from "2.hyps"(3)[OF fb ifb fib xsb "2.prems"(5)]
+ show "x = 0" .
+qed
+
+(* We can extend a linear mapping from basis. *)
+
+lemma linear_independent_extend_lemma:
+ assumes fi: "finite B" and ib: "independent B"
+ shows "\<exists>g. (\<forall>x\<in> span B. \<forall>y\<in> span B. g ((x::'a::field^'n) + y) = g x + g y)
+ \<and> (\<forall>x\<in> span B. \<forall>c. g (c*s x) = c *s g x)
+ \<and> (\<forall>x\<in> B. g x = f x)"
+using ib fi
+proof(induct rule: finite_induct[OF fi])
+ case 1 thus ?case by (auto simp add: span_empty)
+next
+ case (2 a b)
+ from "2.prems" "2.hyps" have ibf: "independent b" "finite b"
+ by (simp_all add: independent_insert)
+ from "2.hyps"(3)[OF ibf] obtain g where
+ g: "\<forall>x\<in>span b. \<forall>y\<in>span b. g (x + y) = g x + g y"
+ "\<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
+ let ?h = "\<lambda>z. SOME k. (z - k *s a) \<in> span b"
+ {fix z assume z: "z \<in> span (insert a b)"
+ have th0: "z - ?h z *s a \<in> span b"
+ apply (rule someI_ex)
+ unfolding span_breakdown_eq[symmetric]
+ using z .
+ {fix k assume k: "z - k *s a \<in> span b"
+ have eq: "z - ?h z *s a - (z - k*s a) = (k - ?h z) *s a"
+ by (simp add: ring_simps vector_sadd_rdistrib[symmetric])
+ from span_sub[OF th0 k]
+ have khz: "(k - ?h z) *s a \<in> span b" by (simp add: eq)
+ {assume "k \<noteq> ?h z" hence k0: "k - ?h z \<noteq> 0" by simp
+ from k0 span_mul[OF khz, of "1 /(k - ?h z)"]
+ have "a \<in> span b" by (simp add: vector_smult_assoc)
+ with "2.prems"(1) "2.hyps"(2) have False
+ by (auto simp add: dependent_def)}
+ then have "k = ?h z" by blast}
+ 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}
+ note h = this
+ let ?g = "\<lambda>z. ?h z *s f a + g (z - ?h z *s a)"
+ {fix x y assume x: "x \<in> span (insert a b)" and y: "y \<in> span (insert a b)"
+ have tha: "\<And>(x::'a^'n) y a k l. (x + y) - (k + l) *s a = (x - k *s a) + (y - l *s a)"
+ by (vector ring_simps)
+ have addh: "?h (x + y) = ?h x + ?h y"
+ apply (rule conjunct2[OF h, rule_format, symmetric])
+ apply (rule span_add[OF x y])
+ unfolding tha
+ by (metis span_add x y conjunct1[OF h, rule_format])
+ have "?g (x + y) = ?g x + ?g y"
+ unfolding addh tha
+ g(1)[rule_format,OF conjunct1[OF h, OF x] conjunct1[OF h, OF y]]
+ by (simp add: vector_sadd_rdistrib)}
+ moreover
+ {fix x:: "'a^'n" and c:: 'a assume x: "x \<in> span (insert a b)"
+ have tha: "\<And>(x::'a^'n) c k a. c *s x - (c * k) *s a = c *s (x - k *s a)"
+ by (vector ring_simps)
+ have hc: "?h (c *s x) = c * ?h x"
+ apply (rule conjunct2[OF h, rule_format, symmetric])
+ apply (metis span_mul x)
+ by (metis tha span_mul x conjunct1[OF h])
+ have "?g (c *s x) = c*s ?g x"
+ unfolding hc tha g(2)[rule_format, OF conjunct1[OF h, OF x]]
+ by (vector ring_simps)}
+ moreover
+ {fix x assume x: "x \<in> (insert a b)"
+ {assume xa: "x = a"
+ have ha1: "1 = ?h a"
+ apply (rule conjunct2[OF h, rule_format])
+ apply (metis span_superset insertI1)
+ using conjunct1[OF h, OF span_superset, OF insertI1]
+ by (auto simp add: span_0)
+
+ from xa ha1[symmetric] have "?g x = f x"
+ apply simp
+ using g(2)[rule_format, OF span_0, of 0]
+ by simp}
+ moreover
+ {assume xb: "x \<in> b"
+ have h0: "0 = ?h x"
+ apply (rule conjunct2[OF h, rule_format])
+ apply (metis span_superset insertI1 xb x)
+ apply simp
+ apply (metis span_superset xb)
+ done
+ have "?g x = f x"
+ by (simp add: h0[symmetric] g(3)[rule_format, OF xb])}
+ ultimately have "?g x = f x" using x by blast }
+ ultimately show ?case apply - apply (rule exI[where x="?g"]) by blast
+qed
+
+lemma linear_independent_extend:
+ assumes iB: "independent (B:: (real ^'n::finite) set)"
+ shows "\<exists>g. linear g \<and> (\<forall>x\<in>B. g x = f x)"
+proof-
+ from maximal_independent_subset_extend[of B UNIV] iB
+ obtain C where C: "B \<subseteq> C" "independent C" "\<And>x. x \<in> span C" by auto
+
+ from C(2) independent_bound[of C] linear_independent_extend_lemma[of C f]
+ obtain g where g: "(\<forall>x\<in> span C. \<forall>y\<in> span C. g (x + y) = g x + g y)
+ \<and> (\<forall>x\<in> span C. \<forall>c. g (c*s x) = c *s g x)
+ \<and> (\<forall>x\<in> C. g x = f x)" by blast
+ from g show ?thesis unfolding linear_def using C
+ apply clarsimp by blast
+qed
+
+(* Can construct an isomorphism between spaces of same dimension. *)
+
+lemma card_le_inj: assumes fA: "finite A" and fB: "finite B"
+ and c: "card A \<le> card B" shows "(\<exists>f. f ` A \<subseteq> B \<and> inj_on f A)"
+using fB c
+proof(induct arbitrary: B rule: finite_induct[OF fA])
+ case 1 thus ?case by simp
+next
+ case (2 x s t)
+ thus ?case
+ proof(induct rule: finite_induct[OF "2.prems"(1)])
+ case 1 then show ?case by simp
+ next
+ case (2 y t)
+ from "2.prems"(1,2,5) "2.hyps"(1,2) have cst:"card s \<le> card t" by simp
+ from "2.prems"(3) [OF "2.hyps"(1) cst] obtain f where
+ f: "f ` s \<subseteq> t \<and> inj_on f s" by blast
+ from f "2.prems"(2) "2.hyps"(2) show ?case
+ apply -
+ apply (rule exI[where x = "\<lambda>z. if z = x then y else f z"])
+ by (auto simp add: inj_on_def)
+ qed
+qed
+
+lemma card_subset_eq: assumes fB: "finite B" and AB: "A \<subseteq> B" and
+ c: "card A = card B"
+ shows "A = B"
+proof-
+ from fB AB have fA: "finite A" by (auto intro: finite_subset)
+ from fA fB have fBA: "finite (B - A)" by auto
+ have e: "A \<inter> (B - A) = {}" by blast
+ have eq: "A \<union> (B - A) = B" using AB by blast
+ from card_Un_disjoint[OF fA fBA e, unfolded eq c]
+ have "card (B - A) = 0" by arith
+ hence "B - A = {}" unfolding card_eq_0_iff using fA fB by simp
+ with AB show "A = B" by blast
+qed
+
+lemma subspace_isomorphism:
+ assumes s: "subspace (S:: (real ^'n::finite) set)"
+ and t: "subspace (T :: (real ^ 'm::finite) set)"
+ and d: "dim S = dim T"
+ shows "\<exists>f. linear f \<and> f ` S = T \<and> inj_on f S"
+proof-
+ from basis_exists[of S] obtain B where
+ B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "B hassize dim S" by blast
+ from basis_exists[of T] obtain C where
+ C: "C \<subseteq> T" "independent C" "T \<subseteq> span C" "C hassize dim T" by blast
+ from B(4) C(4) card_le_inj[of B C] d obtain f where
+ f: "f ` B \<subseteq> C" "inj_on f B" unfolding hassize_def by auto
+ from linear_independent_extend[OF B(2)] obtain g where
+ g: "linear g" "\<forall>x\<in> B. g x = f x" by blast
+ from B(4) have fB: "finite B" by (simp add: hassize_def)
+ from C(4) have fC: "finite C" by (simp add: hassize_def)
+ from inj_on_iff_eq_card[OF fB, of f] f(2)
+ have "card (f ` B) = card B" by simp
+ with B(4) C(4) have ceq: "card (f ` B) = card C" using d
+ by (simp add: hassize_def)
+ have "g ` B = f ` B" using g(2)
+ by (auto simp add: image_iff)
+ also have "\<dots> = C" using card_subset_eq[OF fC f(1) ceq] .
+ finally have gBC: "g ` B = C" .
+ have gi: "inj_on g B" using f(2) g(2)
+ by (auto simp add: inj_on_def)
+ note g0 = linear_indep_image_lemma[OF g(1) fB, unfolded gBC, OF C(2) gi]
+ {fix x y assume x: "x \<in> S" and y: "y \<in> S" and gxy:"g x = g y"
+ from B(3) x y have x': "x \<in> span B" and y': "y \<in> span B" by blast+
+ from gxy have th0: "g (x - y) = 0" by (simp add: linear_sub[OF g(1)])
+ have th1: "x - y \<in> span B" using x' y' by (metis span_sub)
+ have "x=y" using g0[OF th1 th0] by simp }
+ then have giS: "inj_on g S"
+ unfolding inj_on_def by blast
+ from span_subspace[OF B(1,3) s]
+ have "g ` S = span (g ` B)" by (simp add: span_linear_image[OF g(1)])
+ also have "\<dots> = span C" unfolding gBC ..
+ also have "\<dots> = T" using span_subspace[OF C(1,3) t] .
+ finally have gS: "g ` S = T" .
+ from g(1) gS giS show ?thesis by blast
+qed
+
+(* linear functions are equal on a subspace if they are on a spanning set. *)
+
+lemma subspace_kernel:
+ assumes lf: "linear (f::'a::semiring_1 ^'n \<Rightarrow> _)"
+ shows "subspace {x. f x = 0}"
+apply (simp add: subspace_def)
+by (simp add: linear_add[OF lf] linear_cmul[OF lf] linear_0[OF lf])
+
+lemma linear_eq_0_span:
+ assumes lf: "linear f" and f0: "\<forall>x\<in>B. f x = 0"
+ shows "\<forall>x \<in> span B. f x = (0::'a::semiring_1 ^'n)"
+proof
+ fix x assume x: "x \<in> span B"
+ let ?P = "\<lambda>x. f x = 0"
+ from subspace_kernel[OF lf] have "subspace ?P" unfolding Collect_def .
+ with x f0 span_induct[of B "?P" x] show "f x = 0" by blast
+qed
+
+lemma linear_eq_0:
+ assumes lf: "linear f" and SB: "S \<subseteq> span B" and f0: "\<forall>x\<in>B. f x = 0"
+ shows "\<forall>x \<in> S. f x = (0::'a::semiring_1^'n)"
+ by (metis linear_eq_0_span[OF lf] subset_eq SB f0)
+
+lemma linear_eq:
+ assumes lf: "linear (f::'a::ring_1^'n \<Rightarrow> _)" and lg: "linear g" and S: "S \<subseteq> span B"
+ and fg: "\<forall> x\<in> B. f x = g x"
+ shows "\<forall>x\<in> S. f x = g x"
+proof-
+ let ?h = "\<lambda>x. f x - g x"
+ from fg have fg': "\<forall>x\<in> B. ?h x = 0" by simp
+ from linear_eq_0[OF linear_compose_sub[OF lf lg] S fg']
+ show ?thesis by simp
+qed
+
+lemma linear_eq_stdbasis:
+ assumes lf: "linear (f::'a::ring_1^'m::finite \<Rightarrow> 'a^'n::finite)" and lg: "linear g"
+ and fg: "\<forall>i. f (basis i) = g(basis i)"
+ shows "f = g"
+proof-
+ let ?U = "UNIV :: 'm set"
+ let ?I = "{basis i:: 'a^'m|i. i \<in> ?U}"
+ {fix x assume x: "x \<in> (UNIV :: ('a^'m) set)"
+ from equalityD2[OF span_stdbasis]
+ have IU: " (UNIV :: ('a^'m) set) \<subseteq> span ?I" by blast
+ from linear_eq[OF lf lg IU] fg x
+ have "f x = g x" unfolding Collect_def Ball_def mem_def by metis}
+ then show ?thesis by (auto intro: ext)
+qed
+
+(* Similar results for bilinear functions. *)
+
+lemma bilinear_eq:
+ assumes bf: "bilinear (f:: 'a::ring^'m \<Rightarrow> 'a^'n \<Rightarrow> 'a^'p)"
+ and bg: "bilinear g"
+ and SB: "S \<subseteq> span B" and TC: "T \<subseteq> span C"
+ and fg: "\<forall>x\<in> B. \<forall>y\<in> C. f x y = g x y"
+ shows "\<forall>x\<in>S. \<forall>y\<in>T. f x y = g x y "
+proof-
+ let ?P = "\<lambda>x. \<forall>y\<in> span C. f x y = g x y"
+ from bf bg have sp: "subspace ?P"
+ unfolding bilinear_def linear_def subspace_def bf bg
+ 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])
+
+ have "\<forall>x \<in> span B. \<forall>y\<in> span C. f x y = g x y"
+ apply -
+ apply (rule ballI)
+ apply (rule span_induct[of B ?P])
+ defer
+ apply (rule sp)
+ apply assumption
+ apply (clarsimp simp add: Ball_def)
+ apply (rule_tac P="\<lambda>y. f xa y = g xa y" and S=C in span_induct)
+ using fg
+ apply (auto simp add: subspace_def)
+ using bf bg unfolding bilinear_def linear_def
+ 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])
+ then show ?thesis using SB TC by (auto intro: ext)
+qed
+
+lemma bilinear_eq_stdbasis:
+ assumes bf: "bilinear (f:: 'a::ring_1^'m::finite \<Rightarrow> 'a^'n::finite \<Rightarrow> 'a^'p)"
+ and bg: "bilinear g"
+ and fg: "\<forall>i j. f (basis i) (basis j) = g (basis i) (basis j)"
+ shows "f = g"
+proof-
+ 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
+ from bilinear_eq[OF bf bg equalityD2[OF span_stdbasis] equalityD2[OF span_stdbasis] th] show ?thesis by (blast intro: ext)
+qed
+
+(* Detailed theorems about left and right invertibility in general case. *)
+
+lemma left_invertible_transp:
+ "(\<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)"
+ by (metis matrix_transp_mul transp_mat transp_transp)
+
+lemma right_invertible_transp:
+ "(\<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)"
+ by (metis matrix_transp_mul transp_mat transp_transp)
+
+lemma linear_injective_left_inverse:
+ assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)" and fi: "inj f"
+ shows "\<exists>g. linear g \<and> g o f = id"
+proof-
+ from linear_independent_extend[OF independent_injective_image, OF independent_stdbasis, OF lf fi]
+ 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
+ from h(2)
+ have th: "\<forall>i. (h \<circ> f) (basis i) = id (basis i)"
+ using inv_o_cancel[OF fi, unfolded stupid_ext[symmetric] id_def o_def]
+ by auto
+
+ from linear_eq_stdbasis[OF linear_compose[OF lf h(1)] linear_id th]
+ have "h o f = id" .
+ then show ?thesis using h(1) by blast
+qed
+
+lemma linear_surjective_right_inverse:
+ assumes lf: "linear (f:: real ^'m::finite \<Rightarrow> real ^'n::finite)" and sf: "surj f"
+ shows "\<exists>g. linear g \<and> f o g = id"
+proof-
+ from linear_independent_extend[OF independent_stdbasis]
+ obtain h:: "real ^'n \<Rightarrow> real ^'m" where
+ h: "linear h" "\<forall> x\<in> {basis i| i. i\<in> (UNIV :: 'n set)}. h x = inv f x" by blast
+ from h(2)
+ have th: "\<forall>i. (f o h) (basis i) = id (basis i)"
+ using sf
+ apply (auto simp add: surj_iff o_def stupid_ext[symmetric])
+ apply (erule_tac x="basis i" in allE)
+ by auto
+
+ from linear_eq_stdbasis[OF linear_compose[OF h(1) lf] linear_id th]
+ have "f o h = id" .
+ then show ?thesis using h(1) by blast
+qed
+
+lemma matrix_left_invertible_injective:
+"(\<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)"
+proof-
+ {fix B:: "real^'m^'n" and x y assume B: "B ** A = mat 1" and xy: "A *v x = A*v y"
+ from xy have "B*v (A *v x) = B *v (A*v y)" by simp
+ hence "x = y"
+ unfolding matrix_vector_mul_assoc B matrix_vector_mul_lid .}
+ moreover
+ {assume A: "\<forall>x y. A *v x = A *v y \<longrightarrow> x = y"
+ hence i: "inj (op *v A)" unfolding inj_on_def by auto
+ from linear_injective_left_inverse[OF matrix_vector_mul_linear i]
+ obtain g where g: "linear g" "g o op *v A = id" by blast
+ have "matrix g ** A = mat 1"
+ unfolding matrix_eq matrix_vector_mul_lid matrix_vector_mul_assoc[symmetric] matrix_works[OF g(1)]
+ using g(2) by (simp add: o_def id_def stupid_ext)
+ then have "\<exists>B. (B::real ^'m^'n) ** A = mat 1" by blast}
+ ultimately show ?thesis by blast
+qed
+
+lemma matrix_left_invertible_ker:
+ "(\<exists>B. (B::real ^'m::finite^'n::finite) ** (A::real^'n^'m) = mat 1) \<longleftrightarrow> (\<forall>x. A *v x = 0 \<longrightarrow> x = 0)"
+ unfolding matrix_left_invertible_injective
+ using linear_injective_0[OF matrix_vector_mul_linear, of A]
+ by (simp add: inj_on_def)
+
+lemma matrix_right_invertible_surjective:
+"(\<exists>B. (A::real^'n::finite^'m::finite) ** (B::real^'m^'n) = mat 1) \<longleftrightarrow> surj (\<lambda>x. A *v x)"
+proof-
+ {fix B :: "real ^'m^'n" assume AB: "A ** B = mat 1"
+ {fix x :: "real ^ 'm"
+ have "A *v (B *v x) = x"
+ by (simp add: matrix_vector_mul_lid matrix_vector_mul_assoc AB)}
+ hence "surj (op *v A)" unfolding surj_def by metis }
+ moreover
+ {assume sf: "surj (op *v A)"
+ from linear_surjective_right_inverse[OF matrix_vector_mul_linear sf]
+ obtain g:: "real ^'m \<Rightarrow> real ^'n" where g: "linear g" "op *v A o g = id"
+ by blast
+
+ have "A ** (matrix g) = mat 1"
+ unfolding matrix_eq matrix_vector_mul_lid
+ matrix_vector_mul_assoc[symmetric] matrix_works[OF g(1)]
+ using g(2) unfolding o_def stupid_ext[symmetric] id_def
+ .
+ hence "\<exists>B. A ** (B::real^'m^'n) = mat 1" by blast
+ }
+ ultimately show ?thesis unfolding surj_def by blast
+qed
+
+lemma matrix_left_invertible_independent_columns:
+ fixes A :: "real^'n::finite^'m::finite"
+ 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))"
+ (is "?lhs \<longleftrightarrow> ?rhs")
+proof-
+ let ?U = "UNIV :: 'n set"
+ {assume k: "\<forall>x. A *v x = 0 \<longrightarrow> x = 0"
+ {fix c i assume c: "setsum (\<lambda>i. c i *s column i A) ?U = 0"
+ and i: "i \<in> ?U"
+ let ?x = "\<chi> i. c i"
+ have th0:"A *v ?x = 0"
+ using c
+ unfolding matrix_mult_vsum Cart_eq
+ by auto
+ from k[rule_format, OF th0] i
+ have "c i = 0" by (vector Cart_eq)}
+ hence ?rhs by blast}
+ moreover
+ {assume H: ?rhs
+ {fix x assume x: "A *v x = 0"
+ let ?c = "\<lambda>i. ((x$i ):: real)"
+ from H[rule_format, of ?c, unfolded matrix_mult_vsum[symmetric], OF x]
+ have "x = 0" by vector}}
+ ultimately show ?thesis unfolding matrix_left_invertible_ker by blast
+qed
+
+lemma matrix_right_invertible_independent_rows:
+ fixes A :: "real^'n::finite^'m::finite"
+ 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))"
+ unfolding left_invertible_transp[symmetric]
+ matrix_left_invertible_independent_columns
+ by (simp add: column_transp)
+
+lemma matrix_right_invertible_span_columns:
+ "(\<exists>(B::real ^'n::finite^'m::finite). (A::real ^'m^'n) ** B = mat 1) \<longleftrightarrow> span (columns A) = UNIV" (is "?lhs = ?rhs")
+proof-
+ let ?U = "UNIV :: 'm set"
+ have fU: "finite ?U" by simp
+ have lhseq: "?lhs \<longleftrightarrow> (\<forall>y. \<exists>(x::real^'m). setsum (\<lambda>i. (x$i) *s column i A) ?U = y)"
+ unfolding matrix_right_invertible_surjective matrix_mult_vsum surj_def
+ apply (subst eq_commute) ..
+ have rhseq: "?rhs \<longleftrightarrow> (\<forall>x. x \<in> span (columns A))" by blast
+ {assume h: ?lhs
+ {fix x:: "real ^'n"
+ from h[unfolded lhseq, rule_format, of x] obtain y:: "real ^'m"
+ where y: "setsum (\<lambda>i. (y$i) *s column i A) ?U = x" by blast
+ have "x \<in> span (columns A)"
+ unfolding y[symmetric]
+ apply (rule span_setsum[OF fU])
+ apply clarify
+ apply (rule span_mul)
+ apply (rule span_superset)
+ unfolding columns_def
+ by blast}
+ then have ?rhs unfolding rhseq by blast}
+ moreover
+ {assume h:?rhs
+ let ?P = "\<lambda>(y::real ^'n). \<exists>(x::real^'m). setsum (\<lambda>i. (x$i) *s column i A) ?U = y"
+ {fix y have "?P y"
+ proof(rule span_induct_alt[of ?P "columns A"])
+ show "\<exists>x\<Colon>real ^ 'm. setsum (\<lambda>i. (x$i) *s column i A) ?U = 0"
+ apply (rule exI[where x=0])
+ by (simp add: zero_index vector_smult_lzero)
+ next
+ fix c y1 y2 assume y1: "y1 \<in> columns A" and y2: "?P y2"
+ from y1 obtain i where i: "i \<in> ?U" "y1 = column i A"
+ unfolding columns_def by blast
+ from y2 obtain x:: "real ^'m" where
+ x: "setsum (\<lambda>i. (x$i) *s column i A) ?U = y2" by blast
+ let ?x = "(\<chi> j. if j = i then c + (x$i) else (x$j))::real^'m"
+ show "?P (c*s y1 + y2)"
+ 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)
+ fix j
+ have th: "\<forall>xa \<in> ?U. (if xa = i then (c + (x$i)) * ((column xa A)$j)
+ 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)
+ by (simp add: ring_simps)
+ have "setsum (\<lambda>xa. if xa = i then (c + (x$i)) * ((column xa A)$j)
+ 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"
+ apply (rule setsum_cong[OF refl])
+ using th by blast
+ 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"
+ by (simp add: setsum_addf)
+ also have "\<dots> = c * ((column i A)$j) + setsum (\<lambda>xa. ((x$xa) * ((column xa A)$j))) ?U"
+ unfolding setsum_delta[OF fU]
+ using i(1) by simp
+ finally show "setsum (\<lambda>xa. if xa = i then (c + (x$i)) * ((column xa A)$j)
+ else (x$xa) * ((column xa A$j))) ?U = c * ((column i A)$j) + setsum (\<lambda>xa. ((x$xa) * ((column xa A)$j))) ?U" .
+ qed
+ next
+ show "y \<in> span (columns A)" unfolding h by blast
+ qed}
+ then have ?lhs unfolding lhseq ..}
+ ultimately show ?thesis by blast
+qed
+
+lemma matrix_left_invertible_span_rows:
+ "(\<exists>(B::real^'m::finite^'n::finite). B ** (A::real^'n^'m) = mat 1) \<longleftrightarrow> span (rows A) = UNIV"
+ unfolding right_invertible_transp[symmetric]
+ unfolding columns_transp[symmetric]
+ unfolding matrix_right_invertible_span_columns
+ ..
+
+(* An injective map real^'n->real^'n is also surjective. *)
+
+lemma linear_injective_imp_surjective:
+ assumes lf: "linear (f:: real ^'n::finite \<Rightarrow> real ^'n)" and fi: "inj f"
+ shows "surj f"
+proof-
+ let ?U = "UNIV :: (real ^'n) set"
+ from basis_exists[of ?U] obtain B
+ where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" "B hassize dim ?U"
+ by blast
+ from B(4) have d: "dim ?U = card B" by (simp add: hassize_def)
+ have th: "?U \<subseteq> span (f ` B)"
+ apply (rule card_ge_dim_independent)
+ apply blast
+ apply (rule independent_injective_image[OF B(2) lf fi])
+ apply (rule order_eq_refl)
+ apply (rule sym)
+ unfolding d
+ apply (rule card_image)
+ apply (rule subset_inj_on[OF fi])
+ by blast
+ from th show ?thesis
+ unfolding span_linear_image[OF lf] surj_def
+ using B(3) by blast
+qed
+
+(* And vice versa. *)
+
+lemma surjective_iff_injective_gen:
+ assumes fS: "finite S" and fT: "finite T" and c: "card S = card T"
+ and ST: "f ` S \<subseteq> T"
+ shows "(\<forall>y \<in> T. \<exists>x \<in> S. f x = y) \<longleftrightarrow> inj_on f S" (is "?lhs \<longleftrightarrow> ?rhs")
+proof-
+ {assume h: "?lhs"
+ {fix x y assume x: "x \<in> S" and y: "y \<in> S" and f: "f x = f y"
+ from x fS have S0: "card S \<noteq> 0" by auto
+ {assume xy: "x \<noteq> y"
+ have th: "card S \<le> card (f ` (S - {y}))"
+ unfolding c
+ apply (rule card_mono)
+ apply (rule finite_imageI)
+ using fS apply simp
+ using h xy x y f unfolding subset_eq image_iff
+ apply auto
+ apply (case_tac "xa = f x")
+ apply (rule bexI[where x=x])
+ apply auto
+ done
+ also have " \<dots> \<le> card (S -{y})"
+ apply (rule card_image_le)
+ using fS by simp
+ also have "\<dots> \<le> card S - 1" using y fS by simp
+ finally have False using S0 by arith }
+ then have "x = y" by blast}
+ then have ?rhs unfolding inj_on_def by blast}
+ moreover
+ {assume h: ?rhs
+ have "f ` S = T"
+ apply (rule card_subset_eq[OF fT ST])
+ unfolding card_image[OF h] using c .
+ then have ?lhs by blast}
+ ultimately show ?thesis by blast
+qed
+
+lemma linear_surjective_imp_injective:
+ assumes lf: "linear (f::real ^'n::finite => real ^'n)" and sf: "surj f"
+ shows "inj f"
+proof-
+ let ?U = "UNIV :: (real ^'n) set"
+ from basis_exists[of ?U] obtain B
+ where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" "B hassize dim ?U"
+ by blast
+ {fix x assume x: "x \<in> span B" and fx: "f x = 0"
+ from B(4) have fB: "finite B" by (simp add: hassize_def)
+ from B(4) have d: "dim ?U = card B" by (simp add: hassize_def)
+ have fBi: "independent (f ` B)"
+ apply (rule card_le_dim_spanning[of "f ` B" ?U])
+ apply blast
+ using sf B(3)
+ unfolding span_linear_image[OF lf] surj_def subset_eq image_iff
+ apply blast
+ using fB apply (blast intro: finite_imageI)
+ unfolding d
+ apply (rule card_image_le)
+ apply (rule fB)
+ done
+ have th0: "dim ?U \<le> card (f ` B)"
+ apply (rule span_card_ge_dim)
+ apply blast
+ unfolding span_linear_image[OF lf]
+ apply (rule subset_trans[where B = "f ` UNIV"])
+ using sf unfolding surj_def apply blast
+ apply (rule image_mono)
+ apply (rule B(3))
+ apply (metis finite_imageI fB)
+ done
+
+ moreover have "card (f ` B) \<le> card B"
+ by (rule card_image_le, rule fB)
+ ultimately have th1: "card B = card (f ` B)" unfolding d by arith
+ have fiB: "inj_on f B"
+ unfolding surjective_iff_injective_gen[OF fB finite_imageI[OF fB] th1 subset_refl, symmetric] by blast
+ from linear_indep_image_lemma[OF lf fB fBi fiB x] fx
+ have "x = 0" by blast}
+ note th = this
+ from th show ?thesis unfolding linear_injective_0[OF lf]
+ using B(3) by blast
+qed
+
+(* Hence either is enough for isomorphism. *)
+
+lemma left_right_inverse_eq:
+ assumes fg: "f o g = id" and gh: "g o h = id"
+ shows "f = h"
+proof-
+ have "f = f o (g o h)" unfolding gh by simp
+ also have "\<dots> = (f o g) o h" by (simp add: o_assoc)
+ finally show "f = h" unfolding fg by simp
+qed
+
+lemma isomorphism_expand:
+ "f o g = id \<and> g o f = id \<longleftrightarrow> (\<forall>x. f(g x) = x) \<and> (\<forall>x. g(f x) = x)"
+ by (simp add: expand_fun_eq o_def id_def)
+
+lemma linear_injective_isomorphism:
+ assumes lf: "linear (f :: real^'n::finite \<Rightarrow> real ^'n)" and fi: "inj f"
+ shows "\<exists>f'. linear f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)"
+unfolding isomorphism_expand[symmetric]
+using linear_surjective_right_inverse[OF lf linear_injective_imp_surjective[OF lf fi]] linear_injective_left_inverse[OF lf fi]
+by (metis left_right_inverse_eq)
+
+lemma linear_surjective_isomorphism:
+ assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'n)" and sf: "surj f"
+ shows "\<exists>f'. linear f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)"
+unfolding isomorphism_expand[symmetric]
+using linear_surjective_right_inverse[OF lf sf] linear_injective_left_inverse[OF lf linear_surjective_imp_injective[OF lf sf]]
+by (metis left_right_inverse_eq)
+
+(* Left and right inverses are the same for R^N->R^N. *)
+
+lemma linear_inverse_left:
+ assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'n)" and lf': "linear f'"
+ shows "f o f' = id \<longleftrightarrow> f' o f = id"
+proof-
+ {fix f f':: "real ^'n \<Rightarrow> real ^'n"
+ assume lf: "linear f" "linear f'" and f: "f o f' = id"
+ from f have sf: "surj f"
+
+ apply (auto simp add: o_def stupid_ext[symmetric] id_def surj_def)
+ by metis
+ from linear_surjective_isomorphism[OF lf(1) sf] lf f
+ have "f' o f = id" unfolding stupid_ext[symmetric] o_def id_def
+ by metis}
+ then show ?thesis using lf lf' by metis
+qed
+
+(* Moreover, a one-sided inverse is automatically linear. *)
+
+lemma left_inverse_linear:
+ assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'n)" and gf: "g o f = id"
+ shows "linear g"
+proof-
+ from gf have fi: "inj f" apply (auto simp add: inj_on_def o_def id_def stupid_ext[symmetric])
+ by metis
+ from linear_injective_isomorphism[OF lf fi]
+ obtain h:: "real ^'n \<Rightarrow> real ^'n" where
+ h: "linear h" "\<forall>x. h (f x) = x" "\<forall>x. f (h x) = x" by blast
+ have "h = g" apply (rule ext) using gf h(2,3)
+ apply (simp add: o_def id_def stupid_ext[symmetric])
+ by metis
+ with h(1) show ?thesis by blast
+qed
+
+lemma right_inverse_linear:
+ assumes lf: "linear (f:: real ^'n::finite \<Rightarrow> real ^'n)" and gf: "f o g = id"
+ shows "linear g"
+proof-
+ from gf have fi: "surj f" apply (auto simp add: surj_def o_def id_def stupid_ext[symmetric])
+ by metis
+ from linear_surjective_isomorphism[OF lf fi]
+ obtain h:: "real ^'n \<Rightarrow> real ^'n" where
+ h: "linear h" "\<forall>x. h (f x) = x" "\<forall>x. f (h x) = x" by blast
+ have "h = g" apply (rule ext) using gf h(2,3)
+ apply (simp add: o_def id_def stupid_ext[symmetric])
+ by metis
+ with h(1) show ?thesis by blast
+qed
+
+(* The same result in terms of square matrices. *)
+
+lemma matrix_left_right_inverse:
+ fixes A A' :: "real ^'n::finite^'n"
+ shows "A ** A' = mat 1 \<longleftrightarrow> A' ** A = mat 1"
+proof-
+ {fix A A' :: "real ^'n^'n" assume AA': "A ** A' = mat 1"
+ have sA: "surj (op *v A)"
+ unfolding surj_def
+ apply clarify
+ apply (rule_tac x="(A' *v y)" in exI)
+ by (simp add: matrix_vector_mul_assoc AA' matrix_vector_mul_lid)
+ from linear_surjective_isomorphism[OF matrix_vector_mul_linear sA]
+ obtain f' :: "real ^'n \<Rightarrow> real ^'n"
+ where f': "linear f'" "\<forall>x. f' (A *v x) = x" "\<forall>x. A *v f' x = x" by blast
+ have th: "matrix f' ** A = mat 1"
+ by (simp add: matrix_eq matrix_works[OF f'(1)] matrix_vector_mul_assoc[symmetric] matrix_vector_mul_lid f'(2)[rule_format])
+ hence "(matrix f' ** A) ** A' = mat 1 ** A'" by simp
+ hence "matrix f' = A'" by (simp add: matrix_mul_assoc[symmetric] AA' matrix_mul_rid matrix_mul_lid)
+ hence "matrix f' ** A = A' ** A" by simp
+ hence "A' ** A = mat 1" by (simp add: th)}
+ then show ?thesis by blast
+qed
+
+(* Considering an n-element vector as an n-by-1 or 1-by-n matrix. *)
+
+definition "rowvector v = (\<chi> i j. (v$j))"
+
+definition "columnvector v = (\<chi> i j. (v$i))"
+
+lemma transp_columnvector:
+ "transp(columnvector v) = rowvector v"
+ by (simp add: transp_def rowvector_def columnvector_def Cart_eq)
+
+lemma transp_rowvector: "transp(rowvector v) = columnvector v"
+ by (simp add: transp_def columnvector_def rowvector_def Cart_eq)
+
+lemma dot_rowvector_columnvector:
+ "columnvector (A *v v) = A ** columnvector v"
+ by (vector columnvector_def matrix_matrix_mult_def matrix_vector_mult_def)
+
+lemma dot_matrix_product: "(x::'a::semiring_1^'n::finite) \<bullet> y = (((rowvector x ::'a^'n^1) ** (columnvector y :: 'a^1^'n))$1)$1"
+ by (vector matrix_matrix_mult_def rowvector_def columnvector_def dot_def)
+
+lemma dot_matrix_vector_mul:
+ fixes A B :: "real ^'n::finite ^'n" and x y :: "real ^'n"
+ shows "(A *v x) \<bullet> (B *v y) =
+ (((rowvector x :: real^'n^1) ** ((transp A ** B) ** (columnvector y :: real ^1^'n)))$1)$1"
+unfolding dot_matrix_product transp_columnvector[symmetric]
+ dot_rowvector_columnvector matrix_transp_mul matrix_mul_assoc ..
+
+(* Infinity norm. *)
+
+definition "infnorm (x::real^'n::finite) = rsup {abs(x$i) |i. i\<in> (UNIV :: 'n set)}"
+
+lemma numseg_dimindex_nonempty: "\<exists>i. i \<in> (UNIV :: 'n set)"
+ by auto
+
+lemma infnorm_set_image:
+ "{abs(x$i) |i. i\<in> (UNIV :: 'n set)} =
+ (\<lambda>i. abs(x$i)) ` (UNIV :: 'n set)" by blast
+
+lemma infnorm_set_lemma:
+ shows "finite {abs((x::'a::abs ^'n::finite)$i) |i. i\<in> (UNIV :: 'n set)}"
+ and "{abs(x$i) |i. i\<in> (UNIV :: 'n::finite set)} \<noteq> {}"
+ unfolding infnorm_set_image
+ by (auto intro: finite_imageI)
+
+lemma infnorm_pos_le: "0 \<le> infnorm (x::real^'n::finite)"
+ unfolding infnorm_def
+ unfolding rsup_finite_ge_iff[ OF infnorm_set_lemma]
+ unfolding infnorm_set_image
+ by auto
+
+lemma infnorm_triangle: "infnorm ((x::real^'n::finite) + y) \<le> infnorm x + infnorm y"
+proof-
+ have th: "\<And>x y (z::real). x - y <= z \<longleftrightarrow> x - z <= y" by arith
+ have th1: "\<And>S f. f ` S = { f i| i. i \<in> S}" by blast
+ have th2: "\<And>x (y::real). abs(x + y) - abs(x) <= abs(y)" by arith
+ show ?thesis
+ unfolding infnorm_def
+ unfolding rsup_finite_le_iff[ OF infnorm_set_lemma]
+ apply (subst diff_le_eq[symmetric])
+ unfolding rsup_finite_ge_iff[ OF infnorm_set_lemma]
+ unfolding infnorm_set_image bex_simps
+ apply (subst th)
+ unfolding th1
+ unfolding rsup_finite_ge_iff[ OF infnorm_set_lemma]
+
+ unfolding infnorm_set_image ball_simps bex_simps
+ apply simp
+ apply (metis th2)
+ done
+qed
+
+lemma infnorm_eq_0: "infnorm x = 0 \<longleftrightarrow> (x::real ^'n::finite) = 0"
+proof-
+ have "infnorm x <= 0 \<longleftrightarrow> x = 0"
+ unfolding infnorm_def
+ unfolding rsup_finite_le_iff[OF infnorm_set_lemma]
+ unfolding infnorm_set_image ball_simps
+ by vector
+ then show ?thesis using infnorm_pos_le[of x] by simp
+qed
+
+lemma infnorm_0: "infnorm 0 = 0"
+ by (simp add: infnorm_eq_0)
+
+lemma infnorm_neg: "infnorm (- x) = infnorm x"
+ unfolding infnorm_def
+ apply (rule cong[of "rsup" "rsup"])
+ apply blast
+ apply (rule set_ext)
+ apply auto
+ done
+
+lemma infnorm_sub: "infnorm (x - y) = infnorm (y - x)"
+proof-
+ have "y - x = - (x - y)" by simp
+ then show ?thesis by (metis infnorm_neg)
+qed
+
+lemma real_abs_sub_infnorm: "\<bar> infnorm x - infnorm y\<bar> \<le> infnorm (x - y)"
+proof-
+ have th: "\<And>(nx::real) n ny. nx <= n + ny \<Longrightarrow> ny <= n + nx ==> \<bar>nx - ny\<bar> <= n"
+ by arith
+ from infnorm_triangle[of "x - y" " y"] infnorm_triangle[of "x - y" "-x"]
+ have ths: "infnorm x \<le> infnorm (x - y) + infnorm y"
+ "infnorm y \<le> infnorm (x - y) + infnorm x"
+ by (simp_all add: ring_simps infnorm_neg diff_def[symmetric])
+ from th[OF ths] show ?thesis .
+qed
+
+lemma real_abs_infnorm: " \<bar>infnorm x\<bar> = infnorm x"
+ using infnorm_pos_le[of x] by arith
+
+lemma component_le_infnorm:
+ shows "\<bar>x$i\<bar> \<le> infnorm (x::real^'n::finite)"
+proof-
+ let ?U = "UNIV :: 'n set"
+ let ?S = "{\<bar>x$i\<bar> |i. i\<in> ?U}"
+ have fS: "finite ?S" unfolding image_Collect[symmetric]
+ apply (rule finite_imageI) unfolding Collect_def mem_def by simp
+ have S0: "?S \<noteq> {}" by blast
+ have th1: "\<And>S f. f ` S = { f i| i. i \<in> S}" by blast
+ from rsup_finite_in[OF fS S0] rsup_finite_Ub[OF fS S0]
+ show ?thesis unfolding infnorm_def isUb_def setle_def
+ unfolding infnorm_set_image ball_simps by auto
+qed
+
+lemma infnorm_mul_lemma: "infnorm(a *s x) <= \<bar>a\<bar> * infnorm x"
+ apply (subst infnorm_def)
+ unfolding rsup_finite_le_iff[OF infnorm_set_lemma]
+ unfolding infnorm_set_image ball_simps
+ apply (simp add: abs_mult)
+ apply (rule allI)
+ apply (cut_tac component_le_infnorm[of x])
+ apply (rule mult_mono)
+ apply auto
+ done
+
+lemma infnorm_mul: "infnorm(a *s x) = abs a * infnorm x"
+proof-
+ {assume a0: "a = 0" hence ?thesis by (simp add: infnorm_0) }
+ moreover
+ {assume a0: "a \<noteq> 0"
+ from a0 have th: "(1/a) *s (a *s x) = x"
+ by (simp add: vector_smult_assoc)
+ from a0 have ap: "\<bar>a\<bar> > 0" by arith
+ from infnorm_mul_lemma[of "1/a" "a *s x"]
+ have "infnorm x \<le> 1/\<bar>a\<bar> * infnorm (a*s x)"
+ unfolding th by simp
+ 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)
+ then have "\<bar>a\<bar> * infnorm x \<le> infnorm (a*s x)"
+ using ap by (simp add: field_simps)
+ with infnorm_mul_lemma[of a x] have ?thesis by arith }
+ ultimately show ?thesis by blast
+qed
+
+lemma infnorm_pos_lt: "infnorm x > 0 \<longleftrightarrow> x \<noteq> 0"
+ using infnorm_pos_le[of x] infnorm_eq_0[of x] by arith
+
+(* Prove that it differs only up to a bound from Euclidean norm. *)
+
+lemma infnorm_le_norm: "infnorm x \<le> norm x"
+ unfolding infnorm_def rsup_finite_le_iff[OF infnorm_set_lemma]
+ unfolding infnorm_set_image ball_simps
+ by (metis component_le_norm)
+lemma card_enum: "card {1 .. n} = n" by auto
+lemma norm_le_infnorm: "norm(x) <= sqrt(real CARD('n)) * infnorm(x::real ^'n::finite)"
+proof-
+ let ?d = "CARD('n)"
+ have "real ?d \<ge> 0" by simp
+ hence d2: "(sqrt (real ?d))^2 = real ?d"
+ by (auto intro: real_sqrt_pow2)
+ have th: "sqrt (real ?d) * infnorm x \<ge> 0"
+ by (simp add: zero_le_mult_iff real_sqrt_ge_0_iff infnorm_pos_le)
+ have th1: "x\<bullet>x \<le> (sqrt (real ?d) * infnorm x)^2"
+ unfolding power_mult_distrib d2
+ apply (subst power2_abs[symmetric])
+ unfolding real_of_nat_def dot_def power2_eq_square[symmetric]
+ apply (subst power2_abs[symmetric])
+ apply (rule setsum_bounded)
+ apply (rule power_mono)
+ unfolding abs_of_nonneg[OF infnorm_pos_le]
+ unfolding infnorm_def rsup_finite_ge_iff[OF infnorm_set_lemma]
+ unfolding infnorm_set_image bex_simps
+ apply blast
+ by (rule abs_ge_zero)
+ from real_le_lsqrt[OF dot_pos_le th th1]
+ show ?thesis unfolding real_vector_norm_def id_def .
+qed
+
+(* Equality in Cauchy-Schwarz and triangle inequalities. *)
+
+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")
+proof-
+ {assume h: "x = 0"
+ hence ?thesis by simp}
+ moreover
+ {assume h: "y = 0"
+ hence ?thesis by simp}
+ moreover
+ {assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
+ from dot_eq_0[of "norm y *s x - norm x *s y"]
+ 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)"
+ using x y
+ unfolding dot_rsub dot_lsub dot_lmult dot_rmult
+ unfolding norm_pow_2[symmetric] power2_eq_square diff_eq_0_iff_eq apply (simp add: dot_sym)
+ apply (simp add: ring_simps)
+ apply metis
+ done
+ also have "\<dots> \<longleftrightarrow> (2 * norm x * norm y * (norm x * norm y - x \<bullet> y) = 0)" using x y
+ by (simp add: ring_simps dot_sym)
+ also have "\<dots> \<longleftrightarrow> ?lhs" using x y
+ apply simp
+ by metis
+ finally have ?thesis by blast}
+ ultimately show ?thesis by blast
+qed
+
+lemma norm_cauchy_schwarz_abs_eq:
+ fixes x y :: "real ^ 'n::finite"
+ shows "abs(x \<bullet> y) = norm x * norm y \<longleftrightarrow>
+ norm x *s y = norm y *s x \<or> norm(x) *s y = - norm y *s x" (is "?lhs \<longleftrightarrow> ?rhs")
+proof-
+ have th: "\<And>(x::real) a. a \<ge> 0 \<Longrightarrow> abs x = a \<longleftrightarrow> x = a \<or> x = - a" by arith
+ have "?rhs \<longleftrightarrow> norm x *s y = norm y *s x \<or> norm (- x) *s y = norm y *s (- x)"
+ apply simp by vector
+ also have "\<dots> \<longleftrightarrow>(x \<bullet> y = norm x * norm y \<or>
+ (-x) \<bullet> y = norm x * norm y)"
+ unfolding norm_cauchy_schwarz_eq[symmetric]
+ unfolding norm_minus_cancel
+ norm_mul by blast
+ also have "\<dots> \<longleftrightarrow> ?lhs"
+ unfolding th[OF mult_nonneg_nonneg, OF norm_ge_zero[of x] norm_ge_zero[of y]] dot_lneg
+ by arith
+ finally show ?thesis ..
+qed
+
+lemma norm_triangle_eq:
+ fixes x y :: "real ^ 'n::finite"
+ shows "norm(x + y) = norm x + norm y \<longleftrightarrow> norm x *s y = norm y *s x"
+proof-
+ {assume x: "x =0 \<or> y =0"
+ hence ?thesis by (cases "x=0", simp_all)}
+ moreover
+ {assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
+ hence "norm x \<noteq> 0" "norm y \<noteq> 0"
+ by simp_all
+ hence n: "norm x > 0" "norm y > 0"
+ using norm_ge_zero[of x] norm_ge_zero[of y]
+ by arith+
+ have th: "\<And>(a::real) b c. a + b + c \<noteq> 0 ==> (a = b + c \<longleftrightarrow> a^2 = (b + c)^2)" by algebra
+ have "norm(x + y) = norm x + norm y \<longleftrightarrow> norm(x + y)^ 2 = (norm x + norm y) ^2"
+ apply (rule th) using n norm_ge_zero[of "x + y"]
+ by arith
+ also have "\<dots> \<longleftrightarrow> norm x *s y = norm y *s x"
+ unfolding norm_cauchy_schwarz_eq[symmetric]
+ unfolding norm_pow_2 dot_ladd dot_radd
+ by (simp add: norm_pow_2[symmetric] power2_eq_square dot_sym ring_simps)
+ finally have ?thesis .}
+ ultimately show ?thesis by blast
+qed
+
+(* Collinearity.*)
+
+definition "collinear S \<longleftrightarrow> (\<exists>u. \<forall>x \<in> S. \<forall> y \<in> S. \<exists>c. x - y = c *s u)"
+
+lemma collinear_empty: "collinear {}" by (simp add: collinear_def)
+
+lemma collinear_sing: "collinear {(x::'a::ring_1^'n)}"
+ apply (simp add: collinear_def)
+ apply (rule exI[where x=0])
+ by simp
+
+lemma collinear_2: "collinear {(x::'a::ring_1^'n),y}"
+ apply (simp add: collinear_def)
+ apply (rule exI[where x="x - y"])
+ apply auto
+ apply (rule exI[where x=0], simp)
+ apply (rule exI[where x=1], simp)
+ apply (rule exI[where x="- 1"], simp add: vector_sneg_minus1[symmetric])
+ apply (rule exI[where x=0], simp)
+ done
+
+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")
+proof-
+ {assume "x=0 \<or> y = 0" hence ?thesis
+ by (cases "x = 0", simp_all add: collinear_2 insert_commute)}
+ moreover
+ {assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
+ {assume h: "?lhs"
+ 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
+ from u[rule_format, of x 0] u[rule_format, of y 0]
+ obtain cx and cy where
+ cx: "x = cx*s u" and cy: "y = cy*s u"
+ by auto
+ from cx x have cx0: "cx \<noteq> 0" by auto
+ from cy y have cy0: "cy \<noteq> 0" by auto
+ let ?d = "cy / cx"
+ from cx cy cx0 have "y = ?d *s x"
+ by (simp add: vector_smult_assoc)
+ hence ?rhs using x y by blast}
+ moreover
+ {assume h: "?rhs"
+ then obtain c where c: "y = c*s x" using x y by blast
+ have ?lhs unfolding collinear_def c
+ apply (rule exI[where x=x])
+ apply auto
+ apply (rule exI[where x="- 1"], simp only: vector_smult_lneg vector_smult_lid)
+ apply (rule exI[where x= "-c"], simp only: vector_smult_lneg)
+ apply (rule exI[where x=1], simp)
+ apply (rule exI[where x="1 - c"], simp add: vector_smult_lneg vector_sub_rdistrib)
+ apply (rule exI[where x="c - 1"], simp add: vector_smult_lneg vector_sub_rdistrib)
+ done}
+ ultimately have ?thesis by blast}
+ ultimately show ?thesis by blast
+qed
+
+lemma norm_cauchy_schwarz_equal:
+ fixes x y :: "real ^ 'n::finite"
+ shows "abs(x \<bullet> y) = norm x * norm y \<longleftrightarrow> collinear {(0::real^'n),x,y}"
+unfolding norm_cauchy_schwarz_abs_eq
+apply (cases "x=0", simp_all add: collinear_2)
+apply (cases "y=0", simp_all add: collinear_2 insert_commute)
+unfolding collinear_lemma
+apply simp
+apply (subgoal_tac "norm x \<noteq> 0")
+apply (subgoal_tac "norm y \<noteq> 0")
+apply (rule iffI)
+apply (cases "norm x *s y = norm y *s x")
+apply (rule exI[where x="(1/norm x) * norm y"])
+apply (drule sym)
+unfolding vector_smult_assoc[symmetric]
+apply (simp add: vector_smult_assoc field_simps)
+apply (rule exI[where x="(1/norm x) * - norm y"])
+apply clarify
+apply (drule sym)
+unfolding vector_smult_assoc[symmetric]
+apply (simp add: vector_smult_assoc field_simps)
+apply (erule exE)
+apply (erule ssubst)
+unfolding vector_smult_assoc
+unfolding norm_mul
+apply (subgoal_tac "norm x * c = \<bar>c\<bar> * norm x \<or> norm x * c = - \<bar>c\<bar> * norm x")
+apply (case_tac "c <= 0", simp add: ring_simps)
+apply (simp add: ring_simps)
+apply (case_tac "c <= 0", simp add: ring_simps)
+apply (simp add: ring_simps)
+apply simp
+apply simp
+done
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Multivariate_Analysis/Finite_Cartesian_Product.thy Fri Oct 23 13:23:18 2009 +0200
@@ -0,0 +1,95 @@
+(* Title: HOL/Library/Finite_Cartesian_Product
+ Author: Amine Chaieb, University of Cambridge
+*)
+
+header {* Definition of finite Cartesian product types. *}
+
+theory Finite_Cartesian_Product
+imports Main (*FIXME: ATP_Linkup is only needed for metis at a few places. We could dispense of that by changing the proofs.*)
+begin
+
+definition hassize (infixr "hassize" 12) where
+ "(S hassize n) = (finite S \<and> card S = n)"
+
+lemma hassize_image_inj: assumes f: "inj_on f S" and S: "S hassize n"
+ shows "f ` S hassize n"
+ using f S card_image[OF f]
+ by (simp add: hassize_def inj_on_def)
+
+
+subsection {* Finite Cartesian products, with indexing and lambdas. *}
+
+typedef (open Cart)
+ ('a, 'b) "^" (infixl "^" 15)
+ = "UNIV :: ('b \<Rightarrow> 'a) set"
+ morphisms Cart_nth Cart_lambda ..
+
+notation Cart_nth (infixl "$" 90)
+
+notation (xsymbols) Cart_lambda (binder "\<chi>" 10)
+
+lemma stupid_ext: "(\<forall>x. f x = g x) \<longleftrightarrow> (f = g)"
+ apply auto
+ apply (rule ext)
+ apply auto
+ done
+
+lemma Cart_eq: "((x:: 'a ^ 'b) = y) \<longleftrightarrow> (\<forall>i. x$i = y$i)"
+ by (simp add: Cart_nth_inject [symmetric] expand_fun_eq)
+
+lemma Cart_lambda_beta [simp]: "Cart_lambda g $ i = g i"
+ by (simp add: Cart_lambda_inverse)
+
+lemma Cart_lambda_unique:
+ fixes f :: "'a ^ 'b"
+ shows "(\<forall>i. f$i = g i) \<longleftrightarrow> Cart_lambda g = f"
+ by (auto simp add: Cart_eq)
+
+lemma Cart_lambda_eta: "(\<chi> i. (g$i)) = g"
+ by (simp add: Cart_eq)
+
+text{* A non-standard sum to "paste" Cartesian products. *}
+
+definition pastecart :: "'a ^ 'm \<Rightarrow> 'a ^ 'n \<Rightarrow> 'a ^ ('m + 'n)" where
+ "pastecart f g = (\<chi> i. case i of Inl a \<Rightarrow> f$a | Inr b \<Rightarrow> g$b)"
+
+definition fstcart:: "'a ^('m + 'n) \<Rightarrow> 'a ^ 'm" where
+ "fstcart f = (\<chi> i. (f$(Inl i)))"
+
+definition sndcart:: "'a ^('m + 'n) \<Rightarrow> 'a ^ 'n" where
+ "sndcart f = (\<chi> i. (f$(Inr i)))"
+
+lemma nth_pastecart_Inl [simp]: "pastecart f g $ Inl a = f$a"
+ unfolding pastecart_def by simp
+
+lemma nth_pastecart_Inr [simp]: "pastecart f g $ Inr b = g$b"
+ unfolding pastecart_def by simp
+
+lemma nth_fstcart [simp]: "fstcart f $ i = f $ Inl i"
+ unfolding fstcart_def by simp
+
+lemma nth_sndtcart [simp]: "sndcart f $ i = f $ Inr i"
+ unfolding sndcart_def by simp
+
+lemma finite_sum_image: "(UNIV::('a + 'b) set) = range Inl \<union> range Inr"
+by (auto, case_tac x, auto)
+
+lemma fstcart_pastecart: "fstcart (pastecart (x::'a ^'m ) (y:: 'a ^ 'n)) = x"
+ by (simp add: Cart_eq)
+
+lemma sndcart_pastecart: "sndcart (pastecart (x::'a ^'m ) (y:: 'a ^ 'n)) = y"
+ by (simp add: Cart_eq)
+
+lemma pastecart_fst_snd: "pastecart (fstcart z) (sndcart z) = z"
+ by (simp add: Cart_eq pastecart_def fstcart_def sndcart_def split: sum.split)
+
+lemma pastecart_eq: "(x = y) \<longleftrightarrow> (fstcart x = fstcart y) \<and> (sndcart x = sndcart y)"
+ using pastecart_fst_snd[of x] pastecart_fst_snd[of y] by metis
+
+lemma forall_pastecart: "(\<forall>p. P p) \<longleftrightarrow> (\<forall>x y. P (pastecart x y))"
+ by (metis pastecart_fst_snd fstcart_pastecart sndcart_pastecart)
+
+lemma exists_pastecart: "(\<exists>p. P p) \<longleftrightarrow> (\<exists>x y. P (pastecart x y))"
+ by (metis pastecart_fst_snd fstcart_pastecart sndcart_pastecart)
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Multivariate_Analysis/Multivariate_Analysis.thy Fri Oct 23 13:23:18 2009 +0200
@@ -0,0 +1,6 @@
+theory Multivariate_Analysis imports
+ Convex_Euclidean_Space
+ Determinants
+begin
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Multivariate_Analysis/ROOT.ML Fri Oct 23 13:23:18 2009 +0200
@@ -0,0 +1,6 @@
+(*
+ no_document use_thy "ThisTheory";
+ use_thy "ThatTheory";
+*)
+
+use_thy "Multivariate_Analysis";
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy Fri Oct 23 13:23:18 2009 +0200
@@ -0,0 +1,6027 @@
+(* Title: HOL/Library/Topology_Euclidian_Space.thy
+ Author: Amine Chaieb, University of Cambridge
+ Author: Robert Himmelmann, TU Muenchen
+*)
+
+header {* Elementary topology in Euclidean space. *}
+
+theory Topology_Euclidean_Space
+imports SEQ Euclidean_Space Product_Vector
+begin
+
+declare fstcart_pastecart[simp] sndcart_pastecart[simp]
+
+subsection{* General notion of a topology *}
+
+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)"
+typedef (open) 'a topology = "{L::('a set) set. istopology L}"
+ morphisms "openin" "topology"
+ unfolding istopology_def by blast
+
+lemma istopology_open_in[intro]: "istopology(openin U)"
+ using openin[of U] by blast
+
+lemma topology_inverse': "istopology U \<Longrightarrow> openin (topology U) = U"
+ using topology_inverse[unfolded mem_def Collect_def] .
+
+lemma topology_inverse_iff: "istopology U \<longleftrightarrow> openin (topology U) = U"
+ using topology_inverse[of U] istopology_open_in[of "topology U"] by auto
+
+lemma topology_eq: "T1 = T2 \<longleftrightarrow> (\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S)"
+proof-
+ {assume "T1=T2" hence "\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S" by simp}
+ moreover
+ {assume H: "\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S"
+ hence "openin T1 = openin T2" by (metis mem_def set_ext)
+ hence "topology (openin T1) = topology (openin T2)" by simp
+ hence "T1 = T2" unfolding openin_inverse .}
+ ultimately show ?thesis by blast
+qed
+
+text{* Infer the "universe" from union of all sets in the topology. *}
+
+definition "topspace T = \<Union>{S. openin T S}"
+
+subsection{* Main properties of open sets *}
+
+lemma openin_clauses:
+ fixes U :: "'a topology"
+ shows "openin U {}"
+ "\<And>S T. openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S\<inter>T)"
+ "\<And>K. (\<forall>S \<in> K. openin U S) \<Longrightarrow> openin U (\<Union>K)"
+ using openin[of U] unfolding istopology_def Collect_def mem_def
+ by (metis mem_def subset_eq)+
+
+lemma openin_subset[intro]: "openin U S \<Longrightarrow> S \<subseteq> topspace U"
+ unfolding topspace_def by blast
+lemma openin_empty[simp]: "openin U {}" by (simp add: openin_clauses)
+
+lemma openin_Int[intro]: "openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S \<inter> T)"
+ by (simp add: openin_clauses)
+
+lemma openin_Union[intro]: "(\<forall>S \<in>K. openin U S) \<Longrightarrow> openin U (\<Union> K)" by (simp add: openin_clauses)
+
+lemma openin_Un[intro]: "openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S \<union> T)"
+ using openin_Union[of "{S,T}" U] by auto
+
+lemma openin_topspace[intro, simp]: "openin U (topspace U)" by (simp add: openin_Union topspace_def)
+
+lemma openin_subopen: "openin U S \<longleftrightarrow> (\<forall>x \<in> S. \<exists>T. openin U T \<and> x \<in> T \<and> T \<subseteq> S)" (is "?lhs \<longleftrightarrow> ?rhs")
+proof-
+ {assume ?lhs then have ?rhs by auto }
+ moreover
+ {assume H: ?rhs
+ then obtain t where t: "\<forall>x\<in>S. openin U (t x) \<and> x \<in> t x \<and> t x \<subseteq> S"
+ unfolding Ball_def ex_simps(6)[symmetric] choice_iff by blast
+ from t have th0: "\<forall>x\<in> t`S. openin U x" by auto
+ have "\<Union> t`S = S" using t by auto
+ with openin_Union[OF th0] have "openin U S" by simp }
+ ultimately show ?thesis by blast
+qed
+
+subsection{* Closed sets *}
+
+definition "closedin U S \<longleftrightarrow> S \<subseteq> topspace U \<and> openin U (topspace U - S)"
+
+lemma closedin_subset: "closedin U S \<Longrightarrow> S \<subseteq> topspace U" by (metis closedin_def)
+lemma closedin_empty[simp]: "closedin U {}" by (simp add: closedin_def)
+lemma closedin_topspace[intro,simp]:
+ "closedin U (topspace U)" by (simp add: closedin_def)
+lemma closedin_Un[intro]: "closedin U S \<Longrightarrow> closedin U T \<Longrightarrow> closedin U (S \<union> T)"
+ by (auto simp add: Diff_Un closedin_def)
+
+lemma Diff_Inter[intro]: "A - \<Inter>S = \<Union> {A - s|s. s\<in>S}" by auto
+lemma closedin_Inter[intro]: assumes Ke: "K \<noteq> {}" and Kc: "\<forall>S \<in>K. closedin U S"
+ shows "closedin U (\<Inter> K)" using Ke Kc unfolding closedin_def Diff_Inter by auto
+
+lemma closedin_Int[intro]: "closedin U S \<Longrightarrow> closedin U T \<Longrightarrow> closedin U (S \<inter> T)"
+ using closedin_Inter[of "{S,T}" U] by auto
+
+lemma Diff_Diff_Int: "A - (A - B) = A \<inter> B" by blast
+lemma openin_closedin_eq: "openin U S \<longleftrightarrow> S \<subseteq> topspace U \<and> closedin U (topspace U - S)"
+ apply (auto simp add: closedin_def Diff_Diff_Int inf_absorb2)
+ apply (metis openin_subset subset_eq)
+ done
+
+lemma openin_closedin: "S \<subseteq> topspace U \<Longrightarrow> (openin U S \<longleftrightarrow> closedin U (topspace U - S))"
+ by (simp add: openin_closedin_eq)
+
+lemma openin_diff[intro]: assumes oS: "openin U S" and cT: "closedin U T" shows "openin U (S - T)"
+proof-
+ have "S - T = S \<inter> (topspace U - T)" using openin_subset[of U S] oS cT
+ by (auto simp add: topspace_def openin_subset)
+ then show ?thesis using oS cT by (auto simp add: closedin_def)
+qed
+
+lemma closedin_diff[intro]: assumes oS: "closedin U S" and cT: "openin U T" shows "closedin U (S - T)"
+proof-
+ have "S - T = S \<inter> (topspace U - T)" using closedin_subset[of U S] oS cT
+ by (auto simp add: topspace_def )
+ then show ?thesis using oS cT by (auto simp add: openin_closedin_eq)
+qed
+
+subsection{* Subspace topology. *}
+
+definition "subtopology U V = topology {S \<inter> V |S. openin U S}"
+
+lemma istopology_subtopology: "istopology {S \<inter> V |S. openin U S}" (is "istopology ?L")
+proof-
+ have "{} \<in> ?L" by blast
+ {fix A B assume A: "A \<in> ?L" and B: "B \<in> ?L"
+ from A B obtain Sa and Sb where Sa: "openin U Sa" "A = Sa \<inter> V" and Sb: "openin U Sb" "B = Sb \<inter> V" by blast
+ have "A\<inter>B = (Sa \<inter> Sb) \<inter> V" "openin U (Sa \<inter> Sb)" using Sa Sb by blast+
+ then have "A \<inter> B \<in> ?L" by blast}
+ moreover
+ {fix K assume K: "K \<subseteq> ?L"
+ have th0: "?L = (\<lambda>S. S \<inter> V) ` openin U "
+ apply (rule set_ext)
+ apply (simp add: Ball_def image_iff)
+ by (metis mem_def)
+ from K[unfolded th0 subset_image_iff]
+ obtain Sk where Sk: "Sk \<subseteq> openin U" "K = (\<lambda>S. S \<inter> V) ` Sk" by blast
+ have "\<Union>K = (\<Union>Sk) \<inter> V" using Sk by auto
+ moreover have "openin U (\<Union> Sk)" using Sk by (auto simp add: subset_eq mem_def)
+ ultimately have "\<Union>K \<in> ?L" by blast}
+ ultimately show ?thesis unfolding istopology_def by blast
+qed
+
+lemma openin_subtopology:
+ "openin (subtopology U V) S \<longleftrightarrow> (\<exists> T. (openin U T) \<and> (S = T \<inter> V))"
+ unfolding subtopology_def topology_inverse'[OF istopology_subtopology]
+ by (auto simp add: Collect_def)
+
+lemma topspace_subtopology: "topspace(subtopology U V) = topspace U \<inter> V"
+ by (auto simp add: topspace_def openin_subtopology)
+
+lemma closedin_subtopology:
+ "closedin (subtopology U V) S \<longleftrightarrow> (\<exists>T. closedin U T \<and> S = T \<inter> V)"
+ unfolding closedin_def topspace_subtopology
+ apply (simp add: openin_subtopology)
+ apply (rule iffI)
+ apply clarify
+ apply (rule_tac x="topspace U - T" in exI)
+ by auto
+
+lemma openin_subtopology_refl: "openin (subtopology U V) V \<longleftrightarrow> V \<subseteq> topspace U"
+ unfolding openin_subtopology
+ apply (rule iffI, clarify)
+ apply (frule openin_subset[of U]) apply blast
+ apply (rule exI[where x="topspace U"])
+ by auto
+
+lemma subtopology_superset: assumes UV: "topspace U \<subseteq> V"
+ shows "subtopology U V = U"
+proof-
+ {fix S
+ {fix T assume T: "openin U T" "S = T \<inter> V"
+ from T openin_subset[OF T(1)] UV have eq: "S = T" by blast
+ have "openin U S" unfolding eq using T by blast}
+ moreover
+ {assume S: "openin U S"
+ hence "\<exists>T. openin U T \<and> S = T \<inter> V"
+ using openin_subset[OF S] UV by auto}
+ ultimately have "(\<exists>T. openin U T \<and> S = T \<inter> V) \<longleftrightarrow> openin U S" by blast}
+ then show ?thesis unfolding topology_eq openin_subtopology by blast
+qed
+
+
+lemma subtopology_topspace[simp]: "subtopology U (topspace U) = U"
+ by (simp add: subtopology_superset)
+
+lemma subtopology_UNIV[simp]: "subtopology U UNIV = U"
+ by (simp add: subtopology_superset)
+
+subsection{* The universal Euclidean versions are what we use most of the time *}
+
+definition
+ euclidean :: "'a::topological_space topology" where
+ "euclidean = topology open"
+
+lemma open_openin: "open S \<longleftrightarrow> openin euclidean S"
+ unfolding euclidean_def
+ apply (rule cong[where x=S and y=S])
+ apply (rule topology_inverse[symmetric])
+ apply (auto simp add: istopology_def)
+ by (auto simp add: mem_def subset_eq)
+
+lemma topspace_euclidean: "topspace euclidean = UNIV"
+ apply (simp add: topspace_def)
+ apply (rule set_ext)
+ by (auto simp add: open_openin[symmetric])
+
+lemma topspace_euclidean_subtopology[simp]: "topspace (subtopology euclidean S) = S"
+ by (simp add: topspace_euclidean topspace_subtopology)
+
+lemma closed_closedin: "closed S \<longleftrightarrow> closedin euclidean S"
+ by (simp add: closed_def closedin_def topspace_euclidean open_openin Compl_eq_Diff_UNIV)
+
+lemma open_subopen: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> S)"
+ by (simp add: open_openin openin_subopen[symmetric])
+
+subsection{* Open and closed balls. *}
+
+definition
+ ball :: "'a::metric_space \<Rightarrow> real \<Rightarrow> 'a set" where
+ "ball x e = {y. dist x y < e}"
+
+definition
+ cball :: "'a::metric_space \<Rightarrow> real \<Rightarrow> 'a set" where
+ "cball x e = {y. dist x y \<le> e}"
+
+lemma mem_ball[simp]: "y \<in> ball x e \<longleftrightarrow> dist x y < e" by (simp add: ball_def)
+lemma mem_cball[simp]: "y \<in> cball x e \<longleftrightarrow> dist x y \<le> e" by (simp add: cball_def)
+
+lemma mem_ball_0 [simp]:
+ fixes x :: "'a::real_normed_vector"
+ shows "x \<in> ball 0 e \<longleftrightarrow> norm x < e"
+ by (simp add: dist_norm)
+
+lemma mem_cball_0 [simp]:
+ fixes x :: "'a::real_normed_vector"
+ shows "x \<in> cball 0 e \<longleftrightarrow> norm x \<le> e"
+ by (simp add: dist_norm)
+
+lemma centre_in_cball[simp]: "x \<in> cball x e \<longleftrightarrow> 0\<le> e" by simp
+lemma ball_subset_cball[simp,intro]: "ball x e \<subseteq> cball x e" by (simp add: subset_eq)
+lemma subset_ball[intro]: "d <= e ==> ball x d \<subseteq> ball x e" by (simp add: subset_eq)
+lemma subset_cball[intro]: "d <= e ==> cball x d \<subseteq> cball x e" by (simp add: subset_eq)
+lemma ball_max_Un: "ball a (max r s) = ball a r \<union> ball a s"
+ by (simp add: expand_set_eq) arith
+
+lemma ball_min_Int: "ball a (min r s) = ball a r \<inter> ball a s"
+ by (simp add: expand_set_eq)
+
+subsection{* Topological properties of open balls *}
+
+lemma diff_less_iff: "(a::real) - b > 0 \<longleftrightarrow> a > b"
+ "(a::real) - b < 0 \<longleftrightarrow> a < b"
+ "a - b < c \<longleftrightarrow> a < c +b" "a - b > c \<longleftrightarrow> a > c +b" by arith+
+lemma diff_le_iff: "(a::real) - b \<ge> 0 \<longleftrightarrow> a \<ge> b" "(a::real) - b \<le> 0 \<longleftrightarrow> a \<le> b"
+ "a - b \<le> c \<longleftrightarrow> a \<le> c +b" "a - b \<ge> c \<longleftrightarrow> a \<ge> c +b" by arith+
+
+lemma open_ball[intro, simp]: "open (ball x e)"
+ unfolding open_dist ball_def Collect_def Ball_def mem_def
+ unfolding dist_commute
+ apply clarify
+ apply (rule_tac x="e - dist xa x" in exI)
+ using dist_triangle_alt[where z=x]
+ apply (clarsimp simp add: diff_less_iff)
+ apply atomize
+ apply (erule_tac x="y" in allE)
+ apply (erule_tac x="xa" in allE)
+ by arith
+
+lemma centre_in_ball[simp]: "x \<in> ball x e \<longleftrightarrow> e > 0" by (metis mem_ball dist_self)
+lemma open_contains_ball: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. ball x e \<subseteq> S)"
+ unfolding open_dist subset_eq mem_ball Ball_def dist_commute ..
+
+lemma open_contains_ball_eq: "open S \<Longrightarrow> \<forall>x. x\<in>S \<longleftrightarrow> (\<exists>e>0. ball x e \<subseteq> S)"
+ by (metis open_contains_ball subset_eq centre_in_ball)
+
+lemma ball_eq_empty[simp]: "ball x e = {} \<longleftrightarrow> e \<le> 0"
+ unfolding mem_ball expand_set_eq
+ apply (simp add: not_less)
+ by (metis zero_le_dist order_trans dist_self)
+
+lemma ball_empty[intro]: "e \<le> 0 ==> ball x e = {}" by simp
+
+subsection{* Basic "localization" results are handy for connectedness. *}
+
+lemma openin_open: "openin (subtopology euclidean U) S \<longleftrightarrow> (\<exists>T. open T \<and> (S = U \<inter> T))"
+ by (auto simp add: openin_subtopology open_openin[symmetric])
+
+lemma openin_open_Int[intro]: "open S \<Longrightarrow> openin (subtopology euclidean U) (U \<inter> S)"
+ by (auto simp add: openin_open)
+
+lemma open_openin_trans[trans]:
+ "open S \<Longrightarrow> open T \<Longrightarrow> T \<subseteq> S \<Longrightarrow> openin (subtopology euclidean S) T"
+ by (metis Int_absorb1 openin_open_Int)
+
+lemma open_subset: "S \<subseteq> T \<Longrightarrow> open S \<Longrightarrow> openin (subtopology euclidean T) S"
+ by (auto simp add: openin_open)
+
+lemma closedin_closed: "closedin (subtopology euclidean U) S \<longleftrightarrow> (\<exists>T. closed T \<and> S = U \<inter> T)"
+ by (simp add: closedin_subtopology closed_closedin Int_ac)
+
+lemma closedin_closed_Int: "closed S ==> closedin (subtopology euclidean U) (U \<inter> S)"
+ by (metis closedin_closed)
+
+lemma closed_closedin_trans: "closed S \<Longrightarrow> closed T \<Longrightarrow> T \<subseteq> S \<Longrightarrow> closedin (subtopology euclidean S) T"
+ apply (subgoal_tac "S \<inter> T = T" )
+ apply auto
+ apply (frule closedin_closed_Int[of T S])
+ by simp
+
+lemma closed_subset: "S \<subseteq> T \<Longrightarrow> closed S \<Longrightarrow> closedin (subtopology euclidean T) S"
+ by (auto simp add: closedin_closed)
+
+lemma openin_euclidean_subtopology_iff:
+ fixes S U :: "'a::metric_space set"
+ shows "openin (subtopology euclidean U) S
+ \<longleftrightarrow> S \<subseteq> U \<and> (\<forall>x\<in>S. \<exists>e>0. \<forall>x'\<in>U. dist x' x < e \<longrightarrow> x'\<in> S)" (is "?lhs \<longleftrightarrow> ?rhs")
+proof-
+ {assume ?lhs hence ?rhs unfolding openin_subtopology open_openin[symmetric]
+ by (simp add: open_dist) blast}
+ moreover
+ {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"
+ 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)"
+ by metis
+ let ?T = "\<Union>{B. \<exists>x\<in>S. B = ball x (d x)}"
+ have oT: "open ?T" by auto
+ { fix x assume "x\<in>S"
+ hence "x \<in> \<Union>{B. \<exists>x\<in>S. B = ball x (d x)}"
+ apply simp apply(rule_tac x="ball x(d x)" in exI) apply auto
+ by (rule d [THEN conjunct1])
+ hence "x\<in> ?T \<inter> U" using SU and `x\<in>S` by auto }
+ moreover
+ { fix y assume "y\<in>?T"
+ then obtain B where "y\<in>B" "B\<in>{B. \<exists>x\<in>S. B = ball x (d x)}" by auto
+ then obtain x where "x\<in>S" and x:"y \<in> ball x (d x)" by auto
+ assume "y\<in>U"
+ hence "y\<in>S" using d[OF `x\<in>S`] and x by(auto simp add: dist_commute) }
+ ultimately have "S = ?T \<inter> U" by blast
+ with oT have ?lhs unfolding openin_subtopology open_openin[symmetric] by blast}
+ ultimately show ?thesis by blast
+qed
+
+text{* These "transitivity" results are handy too. *}
+
+lemma openin_trans[trans]: "openin (subtopology euclidean T) S \<Longrightarrow> openin (subtopology euclidean U) T
+ \<Longrightarrow> openin (subtopology euclidean U) S"
+ unfolding open_openin openin_open by blast
+
+lemma openin_open_trans: "openin (subtopology euclidean T) S \<Longrightarrow> open T \<Longrightarrow> open S"
+ by (auto simp add: openin_open intro: openin_trans)
+
+lemma closedin_trans[trans]:
+ "closedin (subtopology euclidean T) S \<Longrightarrow>
+ closedin (subtopology euclidean U) T
+ ==> closedin (subtopology euclidean U) S"
+ by (auto simp add: closedin_closed closed_closedin closed_Inter Int_assoc)
+
+lemma closedin_closed_trans: "closedin (subtopology euclidean T) S \<Longrightarrow> closed T \<Longrightarrow> closed S"
+ by (auto simp add: closedin_closed intro: closedin_trans)
+
+subsection{* Connectedness *}
+
+definition "connected S \<longleftrightarrow>
+ ~(\<exists>e1 e2. open e1 \<and> open e2 \<and> S \<subseteq> (e1 \<union> e2) \<and> (e1 \<inter> e2 \<inter> S = {})
+ \<and> ~(e1 \<inter> S = {}) \<and> ~(e2 \<inter> S = {}))"
+
+lemma connected_local:
+ "connected S \<longleftrightarrow> ~(\<exists>e1 e2.
+ openin (subtopology euclidean S) e1 \<and>
+ openin (subtopology euclidean S) e2 \<and>
+ S \<subseteq> e1 \<union> e2 \<and>
+ e1 \<inter> e2 = {} \<and>
+ ~(e1 = {}) \<and>
+ ~(e2 = {}))"
+unfolding connected_def openin_open by (safe, blast+)
+
+lemma exists_diff: "(\<exists>S. P(UNIV - S)) \<longleftrightarrow> (\<exists>S. P S)" (is "?lhs \<longleftrightarrow> ?rhs")
+proof-
+
+ {assume "?lhs" hence ?rhs by blast }
+ moreover
+ {fix S assume H: "P S"
+ have "S = UNIV - (UNIV - S)" by auto
+ with H have "P (UNIV - (UNIV - S))" by metis }
+ ultimately show ?thesis by metis
+qed
+
+lemma connected_clopen: "connected S \<longleftrightarrow>
+ (\<forall>T. openin (subtopology euclidean S) T \<and>
+ closedin (subtopology euclidean S) T \<longrightarrow> T = {} \<or> T = S)" (is "?lhs \<longleftrightarrow> ?rhs")
+proof-
+ 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> {})"
+ unfolding connected_def openin_open closedin_closed
+ apply (subst exists_diff) by blast
+ 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> {})"
+ (is " _ \<longleftrightarrow> \<not> (\<exists>e2 e1. ?P e2 e1)") apply (simp add: closed_def Compl_eq_Diff_UNIV) by metis
+
+ have th1: "?rhs \<longleftrightarrow> \<not> (\<exists>t' t. closed t'\<and>t = S\<inter>t' \<and> t\<noteq>{} \<and> t\<noteq>S \<and> (\<exists>t'. open t' \<and> t = S \<inter> t'))"
+ (is "_ \<longleftrightarrow> \<not> (\<exists>t' t. ?Q t' t)")
+ unfolding connected_def openin_open closedin_closed by auto
+ {fix e2
+ {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)"
+ by auto}
+ then have "(\<exists>e1. ?P e2 e1) \<longleftrightarrow> (\<exists>t. ?Q e2 t)" by metis}
+ then have "\<forall>e2. (\<exists>e1. ?P e2 e1) \<longleftrightarrow> (\<exists>t. ?Q e2 t)" by blast
+ then show ?thesis unfolding th0 th1 by simp
+qed
+
+lemma connected_empty[simp, intro]: "connected {}"
+ by (simp add: connected_def)
+
+subsection{* Hausdorff and other separation properties *}
+
+class t0_space =
+ assumes t0_space: "x \<noteq> y \<Longrightarrow> \<exists>U. open U \<and> \<not> (x \<in> U \<longleftrightarrow> y \<in> U)"
+
+class t1_space =
+ 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"
+begin
+
+subclass t0_space
+proof
+qed (fast dest: t1_space)
+
+end
+
+text {* T2 spaces are also known as Hausdorff spaces. *}
+
+class t2_space =
+ 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 = {}"
+begin
+
+subclass t1_space
+proof
+qed (fast dest: hausdorff)
+
+end
+
+instance metric_space \<subseteq> t2_space
+proof
+ fix x y :: "'a::metric_space"
+ assume xy: "x \<noteq> y"
+ let ?U = "ball x (dist x y / 2)"
+ let ?V = "ball y (dist x y / 2)"
+ have th0: "\<And>d x y z. (d x z :: real) <= d x y + d y z \<Longrightarrow> d y z = d z y
+ ==> ~(d x y * 2 < d x z \<and> d z y * 2 < d x z)" by arith
+ have "open ?U \<and> open ?V \<and> x \<in> ?U \<and> y \<in> ?V \<and> ?U \<inter> ?V = {}"
+ using dist_pos_lt[OF xy] th0[of dist,OF dist_triangle dist_commute]
+ by (auto simp add: expand_set_eq)
+ then show "\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"
+ by blast
+qed
+
+lemma separation_t2:
+ fixes x y :: "'a::t2_space"
+ 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 = {})"
+ using hausdorff[of x y] by blast
+
+lemma separation_t1:
+ fixes x y :: "'a::t1_space"
+ 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)"
+ using t1_space[of x y] by blast
+
+lemma separation_t0:
+ fixes x y :: "'a::t0_space"
+ shows "x \<noteq> y \<longleftrightarrow> (\<exists>U. open U \<and> ~(x\<in>U \<longleftrightarrow> y\<in>U))"
+ using t0_space[of x y] by blast
+
+subsection{* Limit points *}
+
+definition
+ islimpt:: "'a::topological_space \<Rightarrow> 'a set \<Rightarrow> bool"
+ (infixr "islimpt" 60) where
+ "x islimpt S \<longleftrightarrow> (\<forall>T. x\<in>T \<longrightarrow> open T \<longrightarrow> (\<exists>y\<in>S. y\<in>T \<and> y\<noteq>x))"
+
+lemma islimptI:
+ assumes "\<And>T. x \<in> T \<Longrightarrow> open T \<Longrightarrow> \<exists>y\<in>S. y \<in> T \<and> y \<noteq> x"
+ shows "x islimpt S"
+ using assms unfolding islimpt_def by auto
+
+lemma islimptE:
+ assumes "x islimpt S" and "x \<in> T" and "open T"
+ obtains y where "y \<in> S" and "y \<in> T" and "y \<noteq> x"
+ using assms unfolding islimpt_def by auto
+
+lemma islimpt_subset: "x islimpt S \<Longrightarrow> S \<subseteq> T ==> x islimpt T" by (auto simp add: islimpt_def)
+
+lemma islimpt_approachable:
+ fixes x :: "'a::metric_space"
+ shows "x islimpt S \<longleftrightarrow> (\<forall>e>0. \<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e)"
+ unfolding islimpt_def
+ apply auto
+ apply(erule_tac x="ball x e" in allE)
+ apply auto
+ apply(rule_tac x=y in bexI)
+ apply (auto simp add: dist_commute)
+ apply (simp add: open_dist, drule (1) bspec)
+ apply (clarify, drule spec, drule (1) mp, auto)
+ done
+
+lemma islimpt_approachable_le:
+ fixes x :: "'a::metric_space"
+ shows "x islimpt S \<longleftrightarrow> (\<forall>e>0. \<exists>x'\<in> S. x' \<noteq> x \<and> dist x' x <= e)"
+ unfolding islimpt_approachable
+ using approachable_lt_le[where f="\<lambda>x'. dist x' x" and P="\<lambda>x'. \<not> (x'\<in>S \<and> x'\<noteq>x)"]
+ by metis (* FIXME: VERY slow! *)
+
+class perfect_space =
+ (* FIXME: perfect_space should inherit from topological_space *)
+ assumes islimpt_UNIV [simp, intro]: "(x::'a::metric_space) islimpt UNIV"
+
+lemma perfect_choose_dist:
+ fixes x :: "'a::perfect_space"
+ shows "0 < r \<Longrightarrow> \<exists>a. a \<noteq> x \<and> dist a x < r"
+using islimpt_UNIV [of x]
+by (simp add: islimpt_approachable)
+
+instance real :: perfect_space
+apply default
+apply (rule islimpt_approachable [THEN iffD2])
+apply (clarify, rule_tac x="x + e/2" in bexI)
+apply (auto simp add: dist_norm)
+done
+
+instance "^" :: (perfect_space, finite) perfect_space
+proof
+ fix x :: "'a ^ 'b"
+ {
+ fix e :: real assume "0 < e"
+ def a \<equiv> "x $ undefined"
+ have "a islimpt UNIV" by (rule islimpt_UNIV)
+ with `0 < e` obtain b where "b \<noteq> a" and "dist b a < e"
+ unfolding islimpt_approachable by auto
+ def y \<equiv> "Cart_lambda ((Cart_nth x)(undefined := b))"
+ from `b \<noteq> a` have "y \<noteq> x"
+ unfolding a_def y_def by (simp add: Cart_eq)
+ from `dist b a < e` have "dist y x < e"
+ unfolding dist_vector_def a_def y_def
+ apply simp
+ apply (rule le_less_trans [OF setL2_le_setsum [OF zero_le_dist]])
+ apply (subst setsum_diff1' [where a=undefined], simp, simp, simp)
+ done
+ from `y \<noteq> x` and `dist y x < e`
+ have "\<exists>y\<in>UNIV. y \<noteq> x \<and> dist y x < e" by auto
+ }
+ then show "x islimpt UNIV" unfolding islimpt_approachable by blast
+qed
+
+lemma closed_limpt: "closed S \<longleftrightarrow> (\<forall>x. x islimpt S \<longrightarrow> x \<in> S)"
+ unfolding closed_def
+ apply (subst open_subopen)
+ apply (simp add: islimpt_def subset_eq Compl_eq_Diff_UNIV)
+ by (metis DiffE DiffI UNIV_I insertCI insert_absorb mem_def)
+
+lemma islimpt_EMPTY[simp]: "\<not> x islimpt {}"
+ unfolding islimpt_def by auto
+
+lemma closed_positive_orthant: "closed {x::real^'n::finite. \<forall>i. 0 \<le>x$i}"
+proof-
+ let ?U = "UNIV :: 'n set"
+ let ?O = "{x::real^'n. \<forall>i. x$i\<ge>0}"
+ {fix x:: "real^'n" and i::'n assume H: "\<forall>e>0. \<exists>x'\<in>?O. x' \<noteq> x \<and> dist x' x < e"
+ and xi: "x$i < 0"
+ from xi have th0: "-x$i > 0" by arith
+ from H[rule_format, OF th0] obtain x' where x': "x' \<in>?O" "x' \<noteq> x" "dist x' x < -x $ i" by blast
+ have th:" \<And>b a (x::real). abs x <= b \<Longrightarrow> b <= a ==> ~(a + x < 0)" by arith
+ have th': "\<And>x (y::real). x < 0 \<Longrightarrow> 0 <= y ==> abs x <= abs (y - x)" by arith
+ have th1: "\<bar>x$i\<bar> \<le> \<bar>(x' - x)$i\<bar>" using x'(1) xi
+ apply (simp only: vector_component)
+ by (rule th') auto
+ have th2: "\<bar>dist x x'\<bar> \<ge> \<bar>(x' - x)$i\<bar>" using component_le_norm[of "x'-x" i]
+ apply (simp add: dist_norm) by norm
+ from th[OF th1 th2] x'(3) have False by (simp add: dist_commute) }
+ then show ?thesis unfolding closed_limpt islimpt_approachable
+ unfolding not_le[symmetric] by blast
+qed
+
+lemma finite_set_avoid:
+ fixes a :: "'a::metric_space"
+ assumes fS: "finite S" shows "\<exists>d>0. \<forall>x\<in>S. x \<noteq> a \<longrightarrow> d <= dist a x"
+proof(induct rule: finite_induct[OF fS])
+ case 1 thus ?case apply auto by ferrack
+next
+ case (2 x F)
+ from 2 obtain d where d: "d >0" "\<forall>x\<in>F. x\<noteq>a \<longrightarrow> d \<le> dist a x" by blast
+ {assume "x = a" hence ?case using d by auto }
+ moreover
+ {assume xa: "x\<noteq>a"
+ let ?d = "min d (dist a x)"
+ have dp: "?d > 0" using xa d(1) using dist_nz by auto
+ from d have d': "\<forall>x\<in>F. x\<noteq>a \<longrightarrow> ?d \<le> dist a x" by auto
+ with dp xa have ?case by(auto intro!: exI[where x="?d"]) }
+ ultimately show ?case by blast
+qed
+
+lemma islimpt_finite:
+ fixes S :: "'a::metric_space set"
+ assumes fS: "finite S" shows "\<not> a islimpt S"
+ unfolding islimpt_approachable
+ using finite_set_avoid[OF fS, of a] by (metis dist_commute not_le)
+
+lemma islimpt_Un: "x islimpt (S \<union> T) \<longleftrightarrow> x islimpt S \<or> x islimpt T"
+ apply (rule iffI)
+ defer
+ apply (metis Un_upper1 Un_upper2 islimpt_subset)
+ unfolding islimpt_def
+ apply (rule ccontr, clarsimp, rename_tac A B)
+ apply (drule_tac x="A \<inter> B" in spec)
+ apply (auto simp add: open_Int)
+ done
+
+lemma discrete_imp_closed:
+ fixes S :: "'a::metric_space set"
+ assumes e: "0 < e" and d: "\<forall>x \<in> S. \<forall>y \<in> S. dist y x < e \<longrightarrow> y = x"
+ shows "closed S"
+proof-
+ {fix x assume C: "\<forall>e>0. \<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e"
+ from e have e2: "e/2 > 0" by arith
+ from C[rule_format, OF e2] obtain y where y: "y \<in> S" "y\<noteq>x" "dist y x < e/2" by blast
+ let ?m = "min (e/2) (dist x y) "
+ from e2 y(2) have mp: "?m > 0" by (simp add: dist_nz[THEN sym])
+ from C[rule_format, OF mp] obtain z where z: "z \<in> S" "z\<noteq>x" "dist z x < ?m" by blast
+ have th: "dist z y < e" using z y
+ by (intro dist_triangle_lt [where z=x], simp)
+ from d[rule_format, OF y(1) z(1) th] y z
+ have False by (auto simp add: dist_commute)}
+ then show ?thesis by (metis islimpt_approachable closed_limpt [where 'a='a])
+qed
+
+subsection{* Interior of a Set *}
+definition "interior S = {x. \<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> S}"
+
+lemma interior_eq: "interior S = S \<longleftrightarrow> open S"
+ apply (simp add: expand_set_eq interior_def)
+ apply (subst (2) open_subopen) by (safe, blast+)
+
+lemma interior_open: "open S ==> (interior S = S)" by (metis interior_eq)
+
+lemma interior_empty[simp]: "interior {} = {}" by (simp add: interior_def)
+
+lemma open_interior[simp, intro]: "open(interior S)"
+ apply (simp add: interior_def)
+ apply (subst open_subopen) by blast
+
+lemma interior_interior[simp]: "interior(interior S) = interior S" by (metis interior_eq open_interior)
+lemma interior_subset: "interior S \<subseteq> S" by (auto simp add: interior_def)
+lemma subset_interior: "S \<subseteq> T ==> (interior S) \<subseteq> (interior T)" by (auto simp add: interior_def)
+lemma interior_maximal: "T \<subseteq> S \<Longrightarrow> open T ==> T \<subseteq> (interior S)" by (auto simp add: interior_def)
+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"
+ by (metis equalityI interior_maximal interior_subset open_interior)
+lemma mem_interior: "x \<in> interior S \<longleftrightarrow> (\<exists>e. 0 < e \<and> ball x e \<subseteq> S)"
+ apply (simp add: interior_def)
+ by (metis open_contains_ball centre_in_ball open_ball subset_trans)
+
+lemma open_subset_interior: "open S ==> S \<subseteq> interior T \<longleftrightarrow> S \<subseteq> T"
+ by (metis interior_maximal interior_subset subset_trans)
+
+lemma interior_inter[simp]: "interior(S \<inter> T) = interior S \<inter> interior T"
+ apply (rule equalityI, simp)
+ apply (metis Int_lower1 Int_lower2 subset_interior)
+ by (metis Int_mono interior_subset open_Int open_interior open_subset_interior)
+
+lemma interior_limit_point [intro]:
+ fixes x :: "'a::perfect_space"
+ assumes x: "x \<in> interior S" shows "x islimpt S"
+proof-
+ from x obtain e where e: "e>0" "\<forall>x'. dist x x' < e \<longrightarrow> x' \<in> S"
+ unfolding mem_interior subset_eq Ball_def mem_ball by blast
+ {
+ fix d::real assume d: "d>0"
+ let ?m = "min d e"
+ have mde2: "0 < ?m" using e(1) d(1) by simp
+ from perfect_choose_dist [OF mde2, of x]
+ obtain y where "y \<noteq> x" and "dist y x < ?m" by blast
+ then have "dist y x < e" "dist y x < d" by simp_all
+ from `dist y x < e` e(2) have "y \<in> S" by (simp add: dist_commute)
+ have "\<exists>x'\<in>S. x'\<noteq> x \<and> dist x' x < d"
+ using `y \<in> S` `y \<noteq> x` `dist y x < d` by fast
+ }
+ then show ?thesis unfolding islimpt_approachable by blast
+qed
+
+lemma interior_closed_Un_empty_interior:
+ assumes cS: "closed S" and iT: "interior T = {}"
+ shows "interior(S \<union> T) = interior S"
+proof
+ show "interior S \<subseteq> interior (S\<union>T)"
+ by (rule subset_interior, blast)
+next
+ show "interior (S \<union> T) \<subseteq> interior S"
+ proof
+ fix x assume "x \<in> interior (S \<union> T)"
+ then obtain R where "open R" "x \<in> R" "R \<subseteq> S \<union> T"
+ unfolding interior_def by fast
+ show "x \<in> interior S"
+ proof (rule ccontr)
+ assume "x \<notin> interior S"
+ with `x \<in> R` `open R` obtain y where "y \<in> R - S"
+ unfolding interior_def expand_set_eq by fast
+ from `open R` `closed S` have "open (R - S)" by (rule open_Diff)
+ from `R \<subseteq> S \<union> T` have "R - S \<subseteq> T" by fast
+ from `y \<in> R - S` `open (R - S)` `R - S \<subseteq> T` `interior T = {}`
+ show "False" unfolding interior_def by fast
+ qed
+ qed
+qed
+
+
+subsection{* Closure of a Set *}
+
+definition "closure S = S \<union> {x | x. x islimpt S}"
+
+lemma closure_interior: "closure S = UNIV - interior (UNIV - S)"
+proof-
+ { fix x
+ have "x\<in>UNIV - interior (UNIV - S) \<longleftrightarrow> x \<in> closure S" (is "?lhs = ?rhs")
+ proof
+ let ?exT = "\<lambda> y. (\<exists>T. open T \<and> y \<in> T \<and> T \<subseteq> UNIV - S)"
+ assume "?lhs"
+ hence *:"\<not> ?exT x"
+ unfolding interior_def
+ by simp
+ { assume "\<not> ?rhs"
+ hence False using *
+ unfolding closure_def islimpt_def
+ by blast
+ }
+ thus "?rhs"
+ by blast
+ next
+ assume "?rhs" thus "?lhs"
+ unfolding closure_def interior_def islimpt_def
+ by blast
+ qed
+ }
+ thus ?thesis
+ by blast
+qed
+
+lemma interior_closure: "interior S = UNIV - (closure (UNIV - S))"
+proof-
+ { fix x
+ have "x \<in> interior S \<longleftrightarrow> x \<in> UNIV - (closure (UNIV - S))"
+ unfolding interior_def closure_def islimpt_def
+ by blast (* FIXME: VERY slow! *)
+ }
+ thus ?thesis
+ by blast
+qed
+
+lemma closed_closure[simp, intro]: "closed (closure S)"
+proof-
+ have "closed (UNIV - interior (UNIV -S))" by blast
+ thus ?thesis using closure_interior[of S] by simp
+qed
+
+lemma closure_hull: "closure S = closed hull S"
+proof-
+ have "S \<subseteq> closure S"
+ unfolding closure_def
+ by blast
+ moreover
+ have "closed (closure S)"
+ using closed_closure[of S]
+ by assumption
+ moreover
+ { fix t
+ assume *:"S \<subseteq> t" "closed t"
+ { fix x
+ assume "x islimpt S"
+ hence "x islimpt t" using *(1)
+ using islimpt_subset[of x, of S, of t]
+ by blast
+ }
+ with * have "closure S \<subseteq> t"
+ unfolding closure_def
+ using closed_limpt[of t]
+ by auto
+ }
+ ultimately show ?thesis
+ using hull_unique[of S, of "closure S", of closed]
+ unfolding mem_def
+ by simp
+qed
+
+lemma closure_eq: "closure S = S \<longleftrightarrow> closed S"
+ unfolding closure_hull
+ using hull_eq[of closed, unfolded mem_def, OF closed_Inter, of S]
+ by (metis mem_def subset_eq)
+
+lemma closure_closed[simp]: "closed S \<Longrightarrow> closure S = S"
+ using closure_eq[of S]
+ by simp
+
+lemma closure_closure[simp]: "closure (closure S) = closure S"
+ unfolding closure_hull
+ using hull_hull[of closed S]
+ by assumption
+
+lemma closure_subset: "S \<subseteq> closure S"
+ unfolding closure_hull
+ using hull_subset[of S closed]
+ by assumption
+
+lemma subset_closure: "S \<subseteq> T \<Longrightarrow> closure S \<subseteq> closure T"
+ unfolding closure_hull
+ using hull_mono[of S T closed]
+ by assumption
+
+lemma closure_minimal: "S \<subseteq> T \<Longrightarrow> closed T \<Longrightarrow> closure S \<subseteq> T"
+ using hull_minimal[of S T closed]
+ unfolding closure_hull mem_def
+ by simp
+
+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"
+ using hull_unique[of S T closed]
+ unfolding closure_hull mem_def
+ by simp
+
+lemma closure_empty[simp]: "closure {} = {}"
+ using closed_empty closure_closed[of "{}"]
+ by simp
+
+lemma closure_univ[simp]: "closure UNIV = UNIV"
+ using closure_closed[of UNIV]
+ by simp
+
+lemma closure_eq_empty: "closure S = {} \<longleftrightarrow> S = {}"
+ using closure_empty closure_subset[of S]
+ by blast
+
+lemma closure_subset_eq: "closure S \<subseteq> S \<longleftrightarrow> closed S"
+ using closure_eq[of S] closure_subset[of S]
+ by simp
+
+lemma open_inter_closure_eq_empty:
+ "open S \<Longrightarrow> (S \<inter> closure T) = {} \<longleftrightarrow> S \<inter> T = {}"
+ using open_subset_interior[of S "UNIV - T"]
+ using interior_subset[of "UNIV - T"]
+ unfolding closure_interior
+ by auto
+
+lemma open_inter_closure_subset:
+ "open S \<Longrightarrow> (S \<inter> (closure T)) \<subseteq> closure(S \<inter> T)"
+proof
+ fix x
+ assume as: "open S" "x \<in> S \<inter> closure T"
+ { assume *:"x islimpt T"
+ have "x islimpt (S \<inter> T)"
+ proof (rule islimptI)
+ fix A
+ assume "x \<in> A" "open A"
+ with as have "x \<in> A \<inter> S" "open (A \<inter> S)"
+ by (simp_all add: open_Int)
+ with * obtain y where "y \<in> T" "y \<in> A \<inter> S" "y \<noteq> x"
+ by (rule islimptE)
+ hence "y \<in> S \<inter> T" "y \<in> A \<and> y \<noteq> x"
+ by simp_all
+ thus "\<exists>y\<in>(S \<inter> T). y \<in> A \<and> y \<noteq> x" ..
+ qed
+ }
+ then show "x \<in> closure (S \<inter> T)" using as
+ unfolding closure_def
+ by blast
+qed
+
+lemma closure_complement: "closure(UNIV - S) = UNIV - interior(S)"
+proof-
+ have "S = UNIV - (UNIV - S)"
+ by auto
+ thus ?thesis
+ unfolding closure_interior
+ by auto
+qed
+
+lemma interior_complement: "interior(UNIV - S) = UNIV - closure(S)"
+ unfolding closure_interior
+ by blast
+
+subsection{* Frontier (aka boundary) *}
+
+definition "frontier S = closure S - interior S"
+
+lemma frontier_closed: "closed(frontier S)"
+ by (simp add: frontier_def closed_Diff)
+
+lemma frontier_closures: "frontier S = (closure S) \<inter> (closure(UNIV - S))"
+ by (auto simp add: frontier_def interior_closure)
+
+lemma frontier_straddle:
+ fixes a :: "'a::metric_space"
+ 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")
+proof
+ assume "?lhs"
+ { fix e::real
+ assume "e > 0"
+ let ?rhse = "(\<exists>x\<in>S. dist a x < e) \<and> (\<exists>x. x \<notin> S \<and> dist a x < e)"
+ { assume "a\<in>S"
+ have "\<exists>x\<in>S. dist a x < e" using `e>0` `a\<in>S` by(rule_tac x=a in bexI) auto
+ moreover have "\<exists>x. x \<notin> S \<and> dist a x < e" using `?lhs` `a\<in>S`
+ unfolding frontier_closures closure_def islimpt_def using `e>0`
+ by (auto, erule_tac x="ball a e" in allE, auto)
+ ultimately have ?rhse by auto
+ }
+ moreover
+ { assume "a\<notin>S"
+ hence ?rhse using `?lhs`
+ unfolding frontier_closures closure_def islimpt_def
+ using open_ball[of a e] `e > 0`
+ by (auto, erule_tac x = "ball a e" in allE, auto) (* FIXME: VERY slow! *)
+ }
+ ultimately have ?rhse by auto
+ }
+ thus ?rhs by auto
+next
+ assume ?rhs
+ moreover
+ { fix T assume "a\<notin>S" and
+ 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"
+ from `open T` `a \<in> T` have "\<exists>e>0. ball a e \<subseteq> T" unfolding open_contains_ball[of T] by auto
+ then obtain e where "e>0" "ball a e \<subseteq> T" by auto
+ then obtain y where y:"y\<in>S" "dist a y < e" using as(1) by auto
+ have "\<exists>y\<in>S. y \<in> T \<and> y \<noteq> a"
+ using `dist a y < e` `ball a e \<subseteq> T` unfolding ball_def using `y\<in>S` `a\<notin>S` by auto
+ }
+ hence "a \<in> closure S" unfolding closure_def islimpt_def using `?rhs` by auto
+ moreover
+ { fix T assume "a \<in> T" "open T" "a\<in>S"
+ then obtain e where "e>0" and balle: "ball a e \<subseteq> T" unfolding open_contains_ball using `?rhs` by auto
+ obtain x where "x \<notin> S" "dist a x < e" using `?rhs` using `e>0` by auto
+ 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
+ }
+ hence "a islimpt (UNIV - S) \<or> a\<notin>S" unfolding islimpt_def by auto
+ ultimately show ?lhs unfolding frontier_closures using closure_def[of "UNIV - S"] by auto
+qed
+
+lemma frontier_subset_closed: "closed S \<Longrightarrow> frontier S \<subseteq> S"
+ by (metis frontier_def closure_closed Diff_subset)
+
+lemma frontier_empty: "frontier {} = {}"
+ by (simp add: frontier_def closure_empty)
+
+lemma frontier_subset_eq: "frontier S \<subseteq> S \<longleftrightarrow> closed S"
+proof-
+ { assume "frontier S \<subseteq> S"
+ hence "closure S \<subseteq> S" using interior_subset unfolding frontier_def by auto
+ hence "closed S" using closure_subset_eq by auto
+ }
+ thus ?thesis using frontier_subset_closed[of S] by auto
+qed
+
+lemma frontier_complement: "frontier(UNIV - S) = frontier S"
+ by (auto simp add: frontier_def closure_complement interior_complement)
+
+lemma frontier_disjoint_eq: "frontier S \<inter> S = {} \<longleftrightarrow> open S"
+ using frontier_complement frontier_subset_eq[of "UNIV - S"]
+ unfolding open_closed Compl_eq_Diff_UNIV by auto
+
+subsection{* Common nets and The "within" modifier for nets. *}
+
+definition
+ at_infinity :: "'a::real_normed_vector net" where
+ "at_infinity = Abs_net (range (\<lambda>r. {x. r \<le> norm x}))"
+
+definition
+ indirection :: "'a::real_normed_vector \<Rightarrow> 'a \<Rightarrow> 'a net" (infixr "indirection" 70) where
+ "a indirection v = (at a) within {b. \<exists>c\<ge>0. b - a = scaleR c v}"
+
+text{* Prove That They are all nets. *}
+
+lemma Rep_net_at_infinity:
+ "Rep_net at_infinity = range (\<lambda>r. {x. r \<le> norm x})"
+unfolding at_infinity_def
+apply (rule Abs_net_inverse')
+apply (rule image_nonempty, simp)
+apply (clarsimp, rename_tac r s)
+apply (rule_tac x="max r s" in exI, auto)
+done
+
+lemma within_UNIV: "net within UNIV = net"
+ by (simp add: Rep_net_inject [symmetric] Rep_net_within)
+
+subsection{* Identify Trivial limits, where we can't approach arbitrarily closely. *}
+
+definition
+ trivial_limit :: "'a net \<Rightarrow> bool" where
+ "trivial_limit net \<longleftrightarrow> {} \<in> Rep_net net"
+
+lemma trivial_limit_within:
+ shows "trivial_limit (at a within S) \<longleftrightarrow> \<not> a islimpt S"
+proof
+ assume "trivial_limit (at a within S)"
+ thus "\<not> a islimpt S"
+ unfolding trivial_limit_def
+ unfolding Rep_net_within Rep_net_at
+ unfolding islimpt_def
+ apply (clarsimp simp add: expand_set_eq)
+ apply (rename_tac T, rule_tac x=T in exI)
+ apply (clarsimp, drule_tac x=y in spec, simp)
+ done
+next
+ assume "\<not> a islimpt S"
+ thus "trivial_limit (at a within S)"
+ unfolding trivial_limit_def
+ unfolding Rep_net_within Rep_net_at
+ unfolding islimpt_def
+ apply (clarsimp simp add: image_image)
+ apply (rule_tac x=T in image_eqI)
+ apply (auto simp add: expand_set_eq)
+ done
+qed
+
+lemma trivial_limit_at_iff: "trivial_limit (at a) \<longleftrightarrow> \<not> a islimpt UNIV"
+ using trivial_limit_within [of a UNIV]
+ by (simp add: within_UNIV)
+
+lemma trivial_limit_at:
+ fixes a :: "'a::perfect_space"
+ shows "\<not> trivial_limit (at a)"
+ by (simp add: trivial_limit_at_iff)
+
+lemma trivial_limit_at_infinity:
+ "\<not> trivial_limit (at_infinity :: ('a::{real_normed_vector,zero_neq_one}) net)"
+ (* FIXME: find a more appropriate type class *)
+ unfolding trivial_limit_def Rep_net_at_infinity
+ apply (clarsimp simp add: expand_set_eq)
+ apply (drule_tac x="scaleR r (sgn 1)" in spec)
+ apply (simp add: norm_sgn)
+ done
+
+lemma trivial_limit_sequentially: "\<not> trivial_limit sequentially"
+ by (auto simp add: trivial_limit_def Rep_net_sequentially)
+
+subsection{* Some property holds "sufficiently close" to the limit point. *}
+
+lemma eventually_at: (* FIXME: this replaces Limits.eventually_at *)
+ "eventually P (at a) \<longleftrightarrow> (\<exists>d>0. \<forall>x. 0 < dist x a \<and> dist x a < d \<longrightarrow> P x)"
+unfolding eventually_at dist_nz by auto
+
+lemma eventually_at_infinity:
+ "eventually P at_infinity \<longleftrightarrow> (\<exists>b. \<forall>x. norm x >= b \<longrightarrow> P x)"
+unfolding eventually_def Rep_net_at_infinity by auto
+
+lemma eventually_within: "eventually P (at a within S) \<longleftrightarrow>
+ (\<exists>d>0. \<forall>x\<in>S. 0 < dist x a \<and> dist x a < d \<longrightarrow> P x)"
+unfolding eventually_within eventually_at dist_nz by auto
+
+lemma eventually_within_le: "eventually P (at a within S) \<longleftrightarrow>
+ (\<exists>d>0. \<forall>x\<in>S. 0 < dist x a \<and> dist x a <= d \<longrightarrow> P x)" (is "?lhs = ?rhs")
+unfolding eventually_within
+apply safe
+apply (rule_tac x="d/2" in exI, simp)
+apply (rule_tac x="d" in exI, simp)
+done
+
+lemma eventually_happens: "eventually P net ==> trivial_limit net \<or> (\<exists>x. P x)"
+ unfolding eventually_def trivial_limit_def
+ using Rep_net_nonempty [of net] by auto
+
+lemma always_eventually: "(\<forall>x. P x) ==> eventually P net"
+ unfolding eventually_def trivial_limit_def
+ using Rep_net_nonempty [of net] by auto
+
+lemma trivial_limit_eventually: "trivial_limit net \<Longrightarrow> eventually P net"
+ unfolding trivial_limit_def eventually_def by auto
+
+lemma eventually_False: "eventually (\<lambda>x. False) net \<longleftrightarrow> trivial_limit net"
+ unfolding trivial_limit_def eventually_def by auto
+
+lemma trivial_limit_eq: "trivial_limit net \<longleftrightarrow> (\<forall>P. eventually P net)"
+ apply (safe elim!: trivial_limit_eventually)
+ apply (simp add: eventually_False [symmetric])
+ done
+
+text{* Combining theorems for "eventually" *}
+
+lemma eventually_conjI:
+ "\<lbrakk>eventually (\<lambda>x. P x) net; eventually (\<lambda>x. Q x) net\<rbrakk>
+ \<Longrightarrow> eventually (\<lambda>x. P x \<and> Q x) net"
+by (rule eventually_conj)
+
+lemma eventually_rev_mono:
+ "eventually P net \<Longrightarrow> (\<forall>x. P x \<longrightarrow> Q x) \<Longrightarrow> eventually Q net"
+using eventually_mono [of P Q] by fast
+
+lemma eventually_and: " eventually (\<lambda>x. P x \<and> Q x) net \<longleftrightarrow> eventually P net \<and> eventually Q net"
+ by (auto intro!: eventually_conjI elim: eventually_rev_mono)
+
+lemma eventually_false: "eventually (\<lambda>x. False) net \<longleftrightarrow> trivial_limit net"
+ by (auto simp add: eventually_False)
+
+lemma not_eventually: "(\<forall>x. \<not> P x ) \<Longrightarrow> ~(trivial_limit net) ==> ~(eventually (\<lambda>x. P x) net)"
+ by (simp add: eventually_False)
+
+subsection{* Limits, defined as vacuously true when the limit is trivial. *}
+
+ text{* Notation Lim to avoid collition with lim defined in analysis *}
+definition
+ Lim :: "'a net \<Rightarrow> ('a \<Rightarrow> 'b::t2_space) \<Rightarrow> 'b" where
+ "Lim net f = (THE l. (f ---> l) net)"
+
+lemma Lim:
+ "(f ---> l) net \<longleftrightarrow>
+ trivial_limit net \<or>
+ (\<forall>e>0. eventually (\<lambda>x. dist (f x) l < e) net)"
+ unfolding tendsto_iff trivial_limit_eq by auto
+
+
+text{* Show that they yield usual definitions in the various cases. *}
+
+lemma Lim_within_le: "(f ---> l)(at a within S) \<longleftrightarrow>
+ (\<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)"
+ by (auto simp add: tendsto_iff eventually_within_le)
+
+lemma Lim_within: "(f ---> l) (at a within S) \<longleftrightarrow>
+ (\<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)"
+ by (auto simp add: tendsto_iff eventually_within)
+
+lemma Lim_at: "(f ---> l) (at a) \<longleftrightarrow>
+ (\<forall>e >0. \<exists>d>0. \<forall>x. 0 < dist x a \<and> dist x a < d \<longrightarrow> dist (f x) l < e)"
+ by (auto simp add: tendsto_iff eventually_at)
+
+lemma Lim_at_iff_LIM: "(f ---> l) (at a) \<longleftrightarrow> f -- a --> l"
+ unfolding Lim_at LIM_def by (simp only: zero_less_dist_iff)
+
+lemma Lim_at_infinity:
+ "(f ---> l) at_infinity \<longleftrightarrow> (\<forall>e>0. \<exists>b. \<forall>x. norm x >= b \<longrightarrow> dist (f x) l < e)"
+ by (auto simp add: tendsto_iff eventually_at_infinity)
+
+lemma Lim_sequentially:
+ "(S ---> l) sequentially \<longleftrightarrow>
+ (\<forall>e>0. \<exists>N. \<forall>n\<ge>N. dist (S n) l < e)"
+ by (auto simp add: tendsto_iff eventually_sequentially)
+
+lemma Lim_sequentially_iff_LIMSEQ: "(S ---> l) sequentially \<longleftrightarrow> S ----> l"
+ unfolding Lim_sequentially LIMSEQ_def ..
+
+lemma Lim_eventually: "eventually (\<lambda>x. f x = l) net \<Longrightarrow> (f ---> l) net"
+ by (rule topological_tendstoI, auto elim: eventually_rev_mono)
+
+text{* The expected monotonicity property. *}
+
+lemma Lim_within_empty: "(f ---> l) (net within {})"
+ unfolding tendsto_def Limits.eventually_within by simp
+
+lemma Lim_within_subset: "(f ---> l) (net within S) \<Longrightarrow> T \<subseteq> S \<Longrightarrow> (f ---> l) (net within T)"
+ unfolding tendsto_def Limits.eventually_within
+ by (auto elim!: eventually_elim1)
+
+lemma Lim_Un: assumes "(f ---> l) (net within S)" "(f ---> l) (net within T)"
+ shows "(f ---> l) (net within (S \<union> T))"
+ using assms unfolding tendsto_def Limits.eventually_within
+ apply clarify
+ apply (drule spec, drule (1) mp, drule (1) mp)
+ apply (drule spec, drule (1) mp, drule (1) mp)
+ apply (auto elim: eventually_elim2)
+ done
+
+lemma Lim_Un_univ:
+ "(f ---> l) (net within S) \<Longrightarrow> (f ---> l) (net within T) \<Longrightarrow> S \<union> T = UNIV
+ ==> (f ---> l) net"
+ by (metis Lim_Un within_UNIV)
+
+text{* Interrelations between restricted and unrestricted limits. *}
+
+lemma Lim_at_within: "(f ---> l) net ==> (f ---> l)(net within S)"
+ (* FIXME: rename *)
+ unfolding tendsto_def Limits.eventually_within
+ apply (clarify, drule spec, drule (1) mp, drule (1) mp)
+ by (auto elim!: eventually_elim1)
+
+lemma Lim_within_open:
+ fixes f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
+ assumes"a \<in> S" "open S"
+ shows "(f ---> l)(at a within S) \<longleftrightarrow> (f ---> l)(at a)" (is "?lhs \<longleftrightarrow> ?rhs")
+proof
+ assume ?lhs
+ { fix A assume "open A" "l \<in> A"
+ with `?lhs` have "eventually (\<lambda>x. f x \<in> A) (at a within S)"
+ by (rule topological_tendstoD)
+ hence "eventually (\<lambda>x. x \<in> S \<longrightarrow> f x \<in> A) (at a)"
+ unfolding Limits.eventually_within .
+ 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"
+ unfolding eventually_at_topological by fast
+ hence "open (T \<inter> S)" "a \<in> T \<inter> S" "\<forall>x\<in>(T \<inter> S). x \<noteq> a \<longrightarrow> f x \<in> A"
+ using assms by auto
+ hence "\<exists>T. open T \<and> a \<in> T \<and> (\<forall>x\<in>T. x \<noteq> a \<longrightarrow> f x \<in> A)"
+ by fast
+ hence "eventually (\<lambda>x. f x \<in> A) (at a)"
+ unfolding eventually_at_topological .
+ }
+ thus ?rhs by (rule topological_tendstoI)
+next
+ assume ?rhs
+ thus ?lhs by (rule Lim_at_within)
+qed
+
+text{* Another limit point characterization. *}
+
+lemma islimpt_sequential:
+ fixes x :: "'a::metric_space" (* FIXME: generalize to topological_space *)
+ shows "x islimpt S \<longleftrightarrow> (\<exists>f. (\<forall>n::nat. f n \<in> S -{x}) \<and> (f ---> x) sequentially)"
+ (is "?lhs = ?rhs")
+proof
+ assume ?lhs
+ 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"
+ 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
+ { fix n::nat
+ have "f (inverse (real n + 1)) \<in> S - {x}" using f by auto
+ }
+ moreover
+ { fix e::real assume "e>0"
+ 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
+ then obtain N::nat where "inverse (real (N + 1)) < e" by auto
+ 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)
+ moreover have "\<forall>n\<ge>N. dist (f (inverse (real n + 1))) x < (inverse (real n + 1))" using f `e>0` by auto
+ 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
+ }
+ hence " ((\<lambda>n. f (inverse (real n + 1))) ---> x) sequentially"
+ unfolding Lim_sequentially using f by auto
+ ultimately show ?rhs apply (rule_tac x="(\<lambda>n::nat. f (inverse (real n + 1)))" in exI) by auto
+next
+ assume ?rhs
+ 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
+ { fix e::real assume "e>0"
+ then obtain N where "dist (f N) x < e" using f(2) by auto
+ moreover have "f N\<in>S" "f N \<noteq> x" using f(1) by auto
+ ultimately have "\<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e" by auto
+ }
+ thus ?lhs unfolding islimpt_approachable by auto
+qed
+
+text{* Basic arithmetical combining theorems for limits. *}
+
+lemma Lim_linear:
+ assumes "(f ---> l) net" "bounded_linear h"
+ shows "((\<lambda>x. h (f x)) ---> h l) net"
+using `bounded_linear h` `(f ---> l) net`
+by (rule bounded_linear.tendsto)
+
+lemma Lim_ident_at: "((\<lambda>x. x) ---> a) (at a)"
+ unfolding tendsto_def Limits.eventually_at_topological by fast
+
+lemma Lim_const: "((\<lambda>x. a) ---> a) net"
+ by (rule tendsto_const)
+
+lemma Lim_cmul:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ shows "(f ---> l) net ==> ((\<lambda>x. c *\<^sub>R f x) ---> c *\<^sub>R l) net"
+ by (intro tendsto_intros)
+
+lemma Lim_neg:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ shows "(f ---> l) net ==> ((\<lambda>x. -(f x)) ---> -l) net"
+ by (rule tendsto_minus)
+
+lemma Lim_add: fixes f :: "'a \<Rightarrow> 'b::real_normed_vector" shows
+ "(f ---> l) net \<Longrightarrow> (g ---> m) net \<Longrightarrow> ((\<lambda>x. f(x) + g(x)) ---> l + m) net"
+ by (rule tendsto_add)
+
+lemma Lim_sub:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ shows "(f ---> l) net \<Longrightarrow> (g ---> m) net \<Longrightarrow> ((\<lambda>x. f(x) - g(x)) ---> l - m) net"
+ by (rule tendsto_diff)
+
+lemma Lim_null:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ shows "(f ---> l) net \<longleftrightarrow> ((\<lambda>x. f(x) - l) ---> 0) net" by (simp add: Lim dist_norm)
+
+lemma Lim_null_norm:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ shows "(f ---> 0) net \<longleftrightarrow> ((\<lambda>x. norm(f x)) ---> 0) net"
+ by (simp add: Lim dist_norm)
+
+lemma Lim_null_comparison:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ assumes "eventually (\<lambda>x. norm (f x) \<le> g x) net" "(g ---> 0) net"
+ shows "(f ---> 0) net"
+proof(simp add: tendsto_iff, rule+)
+ fix e::real assume "0<e"
+ { fix x
+ assume "norm (f x) \<le> g x" "dist (g x) 0 < e"
+ hence "dist (f x) 0 < e" by (simp add: dist_norm)
+ }
+ thus "eventually (\<lambda>x. dist (f x) 0 < e) net"
+ using eventually_and[of "\<lambda>x. norm(f x) <= g x" "\<lambda>x. dist (g x) 0 < e" net]
+ 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]
+ using assms `e>0` unfolding tendsto_iff by auto
+qed
+
+lemma Lim_component:
+ fixes f :: "'a \<Rightarrow> 'b::metric_space ^ 'n::finite"
+ shows "(f ---> l) net \<Longrightarrow> ((\<lambda>a. f a $i) ---> l$i) net"
+ unfolding tendsto_iff
+ apply (clarify)
+ apply (drule spec, drule (1) mp)
+ apply (erule eventually_elim1)
+ apply (erule le_less_trans [OF dist_nth_le])
+ done
+
+lemma Lim_transform_bound:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ fixes g :: "'a \<Rightarrow> 'c::real_normed_vector"
+ assumes "eventually (\<lambda>n. norm(f n) <= norm(g n)) net" "(g ---> 0) net"
+ shows "(f ---> 0) net"
+proof (rule tendstoI)
+ fix e::real assume "e>0"
+ { fix x
+ assume "norm (f x) \<le> norm (g x)" "dist (g x) 0 < e"
+ hence "dist (f x) 0 < e" by (simp add: dist_norm)}
+ thus "eventually (\<lambda>x. dist (f x) 0 < e) net"
+ using eventually_and[of "\<lambda>x. norm (f x) \<le> norm (g x)" "\<lambda>x. dist (g x) 0 < e" net]
+ 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]
+ using assms `e>0` unfolding tendsto_iff by blast
+qed
+
+text{* Deducing things about the limit from the elements. *}
+
+lemma Lim_in_closed_set:
+ assumes "closed S" "eventually (\<lambda>x. f(x) \<in> S) net" "\<not>(trivial_limit net)" "(f ---> l) net"
+ shows "l \<in> S"
+proof (rule ccontr)
+ assume "l \<notin> S"
+ with `closed S` have "open (- S)" "l \<in> - S"
+ by (simp_all add: open_Compl)
+ with assms(4) have "eventually (\<lambda>x. f x \<in> - S) net"
+ by (rule topological_tendstoD)
+ with assms(2) have "eventually (\<lambda>x. False) net"
+ by (rule eventually_elim2) simp
+ with assms(3) show "False"
+ by (simp add: eventually_False)
+qed
+
+text{* Need to prove closed(cball(x,e)) before deducing this as a corollary. *}
+
+lemma Lim_dist_ubound:
+ assumes "\<not>(trivial_limit net)" "(f ---> l) net" "eventually (\<lambda>x. dist a (f x) <= e) net"
+ shows "dist a l <= e"
+proof (rule ccontr)
+ assume "\<not> dist a l \<le> e"
+ then have "0 < dist a l - e" by simp
+ with assms(2) have "eventually (\<lambda>x. dist (f x) l < dist a l - e) net"
+ by (rule tendstoD)
+ with assms(3) have "eventually (\<lambda>x. dist a (f x) \<le> e \<and> dist (f x) l < dist a l - e) net"
+ by (rule eventually_conjI)
+ then obtain w where "dist a (f w) \<le> e" "dist (f w) l < dist a l - e"
+ using assms(1) eventually_happens by auto
+ hence "dist a (f w) + dist (f w) l < e + (dist a l - e)"
+ by (rule add_le_less_mono)
+ hence "dist a (f w) + dist (f w) l < dist a l"
+ by simp
+ also have "\<dots> \<le> dist a (f w) + dist (f w) l"
+ by (rule dist_triangle)
+ finally show False by simp
+qed
+
+lemma Lim_norm_ubound:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ assumes "\<not>(trivial_limit net)" "(f ---> l) net" "eventually (\<lambda>x. norm(f x) <= e) net"
+ shows "norm(l) <= e"
+proof (rule ccontr)
+ assume "\<not> norm l \<le> e"
+ then have "0 < norm l - e" by simp
+ with assms(2) have "eventually (\<lambda>x. dist (f x) l < norm l - e) net"
+ by (rule tendstoD)
+ with assms(3) have "eventually (\<lambda>x. norm (f x) \<le> e \<and> dist (f x) l < norm l - e) net"
+ by (rule eventually_conjI)
+ then obtain w where "norm (f w) \<le> e" "dist (f w) l < norm l - e"
+ using assms(1) eventually_happens by auto
+ hence "norm (f w - l) < norm l - e" "norm (f w) \<le> e" by (simp_all add: dist_norm)
+ hence "norm (f w - l) + norm (f w) < norm l" by simp
+ hence "norm (f w - l - f w) < norm l" by (rule le_less_trans [OF norm_triangle_ineq4])
+ thus False using `\<not> norm l \<le> e` by simp
+qed
+
+lemma Lim_norm_lbound:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ assumes "\<not> (trivial_limit net)" "(f ---> l) net" "eventually (\<lambda>x. e <= norm(f x)) net"
+ shows "e \<le> norm l"
+proof (rule ccontr)
+ assume "\<not> e \<le> norm l"
+ then have "0 < e - norm l" by simp
+ with assms(2) have "eventually (\<lambda>x. dist (f x) l < e - norm l) net"
+ by (rule tendstoD)
+ with assms(3) have "eventually (\<lambda>x. e \<le> norm (f x) \<and> dist (f x) l < e - norm l) net"
+ by (rule eventually_conjI)
+ then obtain w where "e \<le> norm (f w)" "dist (f w) l < e - norm l"
+ using assms(1) eventually_happens by auto
+ hence "norm (f w - l) + norm l < e" "e \<le> norm (f w)" by (simp_all add: dist_norm)
+ hence "norm (f w - l) + norm l < norm (f w)" by (rule less_le_trans)
+ hence "norm (f w - l + l) < norm (f w)" by (rule le_less_trans [OF norm_triangle_ineq])
+ thus False by simp
+qed
+
+text{* Uniqueness of the limit, when nontrivial. *}
+
+lemma Lim_unique:
+ fixes f :: "'a \<Rightarrow> 'b::t2_space"
+ assumes "\<not> trivial_limit net" "(f ---> l) net" "(f ---> l') net"
+ shows "l = l'"
+proof (rule ccontr)
+ assume "l \<noteq> l'"
+ obtain U V where "open U" "open V" "l \<in> U" "l' \<in> V" "U \<inter> V = {}"
+ using hausdorff [OF `l \<noteq> l'`] by fast
+ have "eventually (\<lambda>x. f x \<in> U) net"
+ using `(f ---> l) net` `open U` `l \<in> U` by (rule topological_tendstoD)
+ moreover
+ have "eventually (\<lambda>x. f x \<in> V) net"
+ using `(f ---> l') net` `open V` `l' \<in> V` by (rule topological_tendstoD)
+ ultimately
+ have "eventually (\<lambda>x. False) net"
+ proof (rule eventually_elim2)
+ fix x
+ assume "f x \<in> U" "f x \<in> V"
+ hence "f x \<in> U \<inter> V" by simp
+ with `U \<inter> V = {}` show "False" by simp
+ qed
+ with `\<not> trivial_limit net` show "False"
+ by (simp add: eventually_False)
+qed
+
+lemma tendsto_Lim:
+ fixes f :: "'a \<Rightarrow> 'b::t2_space"
+ shows "~(trivial_limit net) \<Longrightarrow> (f ---> l) net ==> Lim net f = l"
+ unfolding Lim_def using Lim_unique[of net f] by auto
+
+text{* Limit under bilinear function *}
+
+lemma Lim_bilinear:
+ assumes "(f ---> l) net" and "(g ---> m) net" and "bounded_bilinear h"
+ shows "((\<lambda>x. h (f x) (g x)) ---> (h l m)) net"
+using `bounded_bilinear h` `(f ---> l) net` `(g ---> m) net`
+by (rule bounded_bilinear.tendsto)
+
+text{* These are special for limits out of the same vector space. *}
+
+lemma Lim_within_id: "(id ---> a) (at a within s)"
+ unfolding tendsto_def Limits.eventually_within eventually_at_topological
+ by auto
+
+lemma Lim_at_id: "(id ---> a) (at a)"
+apply (subst within_UNIV[symmetric]) by (simp add: Lim_within_id)
+
+lemma Lim_at_zero:
+ fixes a :: "'a::real_normed_vector"
+ fixes l :: "'b::topological_space"
+ shows "(f ---> l) (at a) \<longleftrightarrow> ((\<lambda>x. f(a + x)) ---> l) (at 0)" (is "?lhs = ?rhs")
+proof
+ assume "?lhs"
+ { fix S assume "open S" "l \<in> S"
+ with `?lhs` have "eventually (\<lambda>x. f x \<in> S) (at a)"
+ by (rule topological_tendstoD)
+ then obtain d where d: "d>0" "\<forall>x. x \<noteq> a \<and> dist x a < d \<longrightarrow> f x \<in> S"
+ unfolding Limits.eventually_at by fast
+ { fix x::"'a" assume "x \<noteq> 0 \<and> dist x 0 < d"
+ hence "f (a + x) \<in> S" using d
+ apply(erule_tac x="x+a" in allE)
+ by(auto simp add: comm_monoid_add.mult_commute dist_norm dist_commute)
+ }
+ hence "\<exists>d>0. \<forall>x. x \<noteq> 0 \<and> dist x 0 < d \<longrightarrow> f (a + x) \<in> S"
+ using d(1) by auto
+ hence "eventually (\<lambda>x. f (a + x) \<in> S) (at 0)"
+ unfolding Limits.eventually_at .
+ }
+ thus "?rhs" by (rule topological_tendstoI)
+next
+ assume "?rhs"
+ { fix S assume "open S" "l \<in> S"
+ with `?rhs` have "eventually (\<lambda>x. f (a + x) \<in> S) (at 0)"
+ by (rule topological_tendstoD)
+ then obtain d where d: "d>0" "\<forall>x. x \<noteq> 0 \<and> dist x 0 < d \<longrightarrow> f (a + x) \<in> S"
+ unfolding Limits.eventually_at by fast
+ { fix x::"'a" assume "x \<noteq> a \<and> dist x a < d"
+ hence "f x \<in> S" using d apply(erule_tac x="x-a" in allE)
+ by(auto simp add: comm_monoid_add.mult_commute dist_norm dist_commute)
+ }
+ hence "\<exists>d>0. \<forall>x. x \<noteq> a \<and> dist x a < d \<longrightarrow> f x \<in> S" using d(1) by auto
+ hence "eventually (\<lambda>x. f x \<in> S) (at a)" unfolding Limits.eventually_at .
+ }
+ thus "?lhs" by (rule topological_tendstoI)
+qed
+
+text{* It's also sometimes useful to extract the limit point from the net. *}
+
+definition
+ netlimit :: "'a::t2_space net \<Rightarrow> 'a" where
+ "netlimit net = (SOME a. ((\<lambda>x. x) ---> a) net)"
+
+lemma netlimit_within:
+ assumes "\<not> trivial_limit (at a within S)"
+ shows "netlimit (at a within S) = a"
+unfolding netlimit_def
+apply (rule some_equality)
+apply (rule Lim_at_within)
+apply (rule Lim_ident_at)
+apply (erule Lim_unique [OF assms])
+apply (rule Lim_at_within)
+apply (rule Lim_ident_at)
+done
+
+lemma netlimit_at:
+ fixes a :: "'a::perfect_space"
+ shows "netlimit (at a) = a"
+ apply (subst within_UNIV[symmetric])
+ using netlimit_within[of a UNIV]
+ by (simp add: trivial_limit_at within_UNIV)
+
+text{* Transformation of limit. *}
+
+lemma Lim_transform:
+ fixes f g :: "'a::type \<Rightarrow> 'b::real_normed_vector"
+ assumes "((\<lambda>x. f x - g x) ---> 0) net" "(f ---> l) net"
+ shows "(g ---> l) net"
+proof-
+ 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
+ thus "?thesis" using Lim_neg [of "\<lambda> x. - g x" "-l" net] by auto
+qed
+
+lemma Lim_transform_eventually:
+ "eventually (\<lambda>x. f x = g x) net \<Longrightarrow> (f ---> l) net ==> (g ---> l) net"
+ apply (rule topological_tendstoI)
+ apply (drule (2) topological_tendstoD)
+ apply (erule (1) eventually_elim2, simp)
+ done
+
+lemma Lim_transform_within:
+ fixes l :: "'b::metric_space" (* TODO: generalize *)
+ assumes "0 < d" "(\<forall>x'\<in>S. 0 < dist x' x \<and> dist x' x < d \<longrightarrow> f x' = g x')"
+ "(f ---> l) (at x within S)"
+ shows "(g ---> l) (at x within S)"
+ using assms(1,3) unfolding Lim_within
+ apply -
+ apply (clarify, rename_tac e)
+ apply (drule_tac x=e in spec, clarsimp, rename_tac r)
+ apply (rule_tac x="min d r" in exI, clarsimp, rename_tac y)
+ apply (drule_tac x=y in bspec, assumption, clarsimp)
+ apply (simp add: assms(2))
+ done
+
+lemma Lim_transform_at:
+ fixes l :: "'b::metric_space" (* TODO: generalize *)
+ shows "0 < d \<Longrightarrow> (\<forall>x'. 0 < dist x' x \<and> dist x' x < d \<longrightarrow> f x' = g x') \<Longrightarrow>
+ (f ---> l) (at x) ==> (g ---> l) (at x)"
+ apply (subst within_UNIV[symmetric])
+ using Lim_transform_within[of d UNIV x f g l]
+ by (auto simp add: within_UNIV)
+
+text{* Common case assuming being away from some crucial point like 0. *}
+
+lemma Lim_transform_away_within:
+ fixes a b :: "'a::metric_space"
+ fixes l :: "'b::metric_space" (* TODO: generalize *)
+ assumes "a\<noteq>b" "\<forall>x\<in> S. x \<noteq> a \<and> x \<noteq> b \<longrightarrow> f x = g x"
+ and "(f ---> l) (at a within S)"
+ shows "(g ---> l) (at a within S)"
+proof-
+ have "\<forall>x'\<in>S. 0 < dist x' a \<and> dist x' a < dist a b \<longrightarrow> f x' = g x'" using assms(2)
+ apply auto apply(erule_tac x=x' in ballE) by (auto simp add: dist_commute)
+ thus ?thesis using Lim_transform_within[of "dist a b" S a f g l] using assms(1,3) unfolding dist_nz by auto
+qed
+
+lemma Lim_transform_away_at:
+ fixes a b :: "'a::metric_space"
+ fixes l :: "'b::metric_space" (* TODO: generalize *)
+ assumes ab: "a\<noteq>b" and fg: "\<forall>x. x \<noteq> a \<and> x \<noteq> b \<longrightarrow> f x = g x"
+ and fl: "(f ---> l) (at a)"
+ shows "(g ---> l) (at a)"
+ using Lim_transform_away_within[OF ab, of UNIV f g l] fg fl
+ by (auto simp add: within_UNIV)
+
+text{* Alternatively, within an open set. *}
+
+lemma Lim_transform_within_open:
+ fixes a :: "'a::metric_space"
+ fixes l :: "'b::metric_space" (* TODO: generalize *)
+ assumes "open S" "a \<in> S" "\<forall>x\<in>S. x \<noteq> a \<longrightarrow> f x = g x" "(f ---> l) (at a)"
+ shows "(g ---> l) (at a)"
+proof-
+ from assms(1,2) obtain e::real where "e>0" and e:"ball a e \<subseteq> S" unfolding open_contains_ball by auto
+ hence "\<forall>x'. 0 < dist x' a \<and> dist x' a < e \<longrightarrow> f x' = g x'" using assms(3)
+ 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)
+ thus ?thesis using Lim_transform_at[of e a f g l] `e>0` assms(4) by auto
+qed
+
+text{* A congruence rule allowing us to transform limits assuming not at point. *}
+
+(* FIXME: Only one congruence rule for tendsto can be used at a time! *)
+
+lemma Lim_cong_within[cong add]:
+ fixes a :: "'a::metric_space"
+ fixes l :: "'b::metric_space" (* TODO: generalize *)
+ 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))"
+ by (simp add: Lim_within dist_nz[symmetric])
+
+lemma Lim_cong_at[cong add]:
+ fixes a :: "'a::metric_space"
+ fixes l :: "'b::metric_space" (* TODO: generalize *)
+ shows "(\<And>x. x \<noteq> a ==> f x = g x) ==> (((\<lambda>x. f x) ---> l) (at a) \<longleftrightarrow> ((g ---> l) (at a)))"
+ by (simp add: Lim_at dist_nz[symmetric])
+
+text{* Useful lemmas on closure and set of possible sequential limits.*}
+
+lemma closure_sequential:
+ fixes l :: "'a::metric_space" (* TODO: generalize *)
+ shows "l \<in> closure S \<longleftrightarrow> (\<exists>x. (\<forall>n. x n \<in> S) \<and> (x ---> l) sequentially)" (is "?lhs = ?rhs")
+proof
+ assume "?lhs" moreover
+ { assume "l \<in> S"
+ hence "?rhs" using Lim_const[of l sequentially] by auto
+ } moreover
+ { assume "l islimpt S"
+ hence "?rhs" unfolding islimpt_sequential by auto
+ } ultimately
+ show "?rhs" unfolding closure_def by auto
+next
+ assume "?rhs"
+ thus "?lhs" unfolding closure_def unfolding islimpt_sequential by auto
+qed
+
+lemma closed_sequential_limits:
+ fixes S :: "'a::metric_space set"
+ shows "closed S \<longleftrightarrow> (\<forall>x l. (\<forall>n. x n \<in> S) \<and> (x ---> l) sequentially \<longrightarrow> l \<in> S)"
+ unfolding closed_limpt
+ 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]
+ by metis
+
+lemma closure_approachable:
+ fixes S :: "'a::metric_space set"
+ shows "x \<in> closure S \<longleftrightarrow> (\<forall>e>0. \<exists>y\<in>S. dist y x < e)"
+ apply (auto simp add: closure_def islimpt_approachable)
+ by (metis dist_self)
+
+lemma closed_approachable:
+ fixes S :: "'a::metric_space set"
+ shows "closed S ==> (\<forall>e>0. \<exists>y\<in>S. dist y x < e) \<longleftrightarrow> x \<in> S"
+ by (metis closure_closed closure_approachable)
+
+text{* Some other lemmas about sequences. *}
+
+lemma seq_offset:
+ fixes l :: "'a::metric_space" (* TODO: generalize *)
+ shows "(f ---> l) sequentially ==> ((\<lambda>i. f( i + k)) ---> l) sequentially"
+ apply (auto simp add: Lim_sequentially)
+ by (metis trans_le_add1 )
+
+lemma seq_offset_neg:
+ "(f ---> l) sequentially ==> ((\<lambda>i. f(i - k)) ---> l) sequentially"
+ apply (rule topological_tendstoI)
+ apply (drule (2) topological_tendstoD)
+ apply (simp only: eventually_sequentially)
+ apply (subgoal_tac "\<And>N k (n::nat). N + k <= n ==> N <= n - k")
+ apply metis
+ by arith
+
+lemma seq_offset_rev:
+ "((\<lambda>i. f(i + k)) ---> l) sequentially ==> (f ---> l) sequentially"
+ apply (rule topological_tendstoI)
+ apply (drule (2) topological_tendstoD)
+ apply (simp only: eventually_sequentially)
+ apply (subgoal_tac "\<And>N k (n::nat). N + k <= n ==> N <= n - k \<and> (n - k) + k = n")
+ by metis arith
+
+lemma seq_harmonic: "((\<lambda>n. inverse (real n)) ---> 0) sequentially"
+proof-
+ { fix e::real assume "e>0"
+ hence "\<exists>N::nat. \<forall>n::nat\<ge>N. inverse (real n) < e"
+ using real_arch_inv[of e] apply auto apply(rule_tac x=n in exI)
+ by (metis not_le le_imp_inverse_le not_less real_of_nat_gt_zero_cancel_iff real_of_nat_less_iff xt1(7))
+ }
+ thus ?thesis unfolding Lim_sequentially dist_norm by simp
+qed
+
+text{* More properties of closed balls. *}
+
+lemma closed_cball: "closed (cball x e)"
+unfolding cball_def closed_def
+unfolding Collect_neg_eq [symmetric] not_le
+apply (clarsimp simp add: open_dist, rename_tac y)
+apply (rule_tac x="dist x y - e" in exI, clarsimp)
+apply (rename_tac x')
+apply (cut_tac x=x and y=x' and z=y in dist_triangle)
+apply simp
+done
+
+lemma open_contains_cball: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. cball x e \<subseteq> S)"
+proof-
+ { fix x and e::real assume "x\<in>S" "e>0" "ball x e \<subseteq> S"
+ hence "\<exists>d>0. cball x d \<subseteq> S" unfolding subset_eq by (rule_tac x="e/2" in exI, auto)
+ } moreover
+ { fix x and e::real assume "x\<in>S" "e>0" "cball x e \<subseteq> S"
+ hence "\<exists>d>0. ball x d \<subseteq> S" unfolding subset_eq apply(rule_tac x="e/2" in exI) by auto
+ } ultimately
+ show ?thesis unfolding open_contains_ball by auto
+qed
+
+lemma open_contains_cball_eq: "open S ==> (\<forall>x. x \<in> S \<longleftrightarrow> (\<exists>e>0. cball x e \<subseteq> S))"
+ by (metis open_contains_cball subset_eq order_less_imp_le centre_in_cball mem_def)
+
+lemma mem_interior_cball: "x \<in> interior S \<longleftrightarrow> (\<exists>e>0. cball x e \<subseteq> S)"
+ apply (simp add: interior_def, safe)
+ apply (force simp add: open_contains_cball)
+ apply (rule_tac x="ball x e" in exI)
+ apply (simp add: open_ball centre_in_ball subset_trans [OF ball_subset_cball])
+ done
+
+lemma islimpt_ball:
+ fixes x y :: "'a::{real_normed_vector,perfect_space}"
+ shows "y islimpt ball x e \<longleftrightarrow> 0 < e \<and> y \<in> cball x e" (is "?lhs = ?rhs")
+proof
+ assume "?lhs"
+ { assume "e \<le> 0"
+ hence *:"ball x e = {}" using ball_eq_empty[of x e] by auto
+ have False using `?lhs` unfolding * using islimpt_EMPTY[of y] by auto
+ }
+ hence "e > 0" by (metis not_less)
+ moreover
+ 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
+ ultimately show "?rhs" by auto
+next
+ assume "?rhs" hence "e>0" by auto
+ { fix d::real assume "d>0"
+ have "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
+ proof(cases "d \<le> dist x y")
+ case True thus "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
+ proof(cases "x=y")
+ case True hence False using `d \<le> dist x y` `d>0` by auto
+ thus "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d" by auto
+ next
+ case False
+
+ have "dist x (y - (d / (2 * dist y x)) *\<^sub>R (y - x))
+ = norm (x - y + (d / (2 * norm (y - x))) *\<^sub>R (y - x))"
+ unfolding mem_cball mem_ball dist_norm diff_diff_eq2 diff_add_eq[THEN sym] by auto
+ also have "\<dots> = \<bar>- 1 + d / (2 * norm (x - y))\<bar> * norm (x - y)"
+ using scaleR_left_distrib[of "- 1" "d / (2 * norm (y - x))", THEN sym, of "y - x"]
+ unfolding scaleR_minus_left scaleR_one
+ by (auto simp add: norm_minus_commute)
+ also have "\<dots> = \<bar>- norm (x - y) + d / 2\<bar>"
+ unfolding abs_mult_pos[of "norm (x - y)", OF norm_ge_zero[of "x - y"]]
+ unfolding real_add_mult_distrib using `x\<noteq>y`[unfolded dist_nz, unfolded dist_norm] by auto
+ also have "\<dots> \<le> e - d/2" using `d \<le> dist x y` and `d>0` and `?rhs` by(auto simp add: dist_norm)
+ finally have "y - (d / (2 * dist y x)) *\<^sub>R (y - x) \<in> ball x e" using `d>0` by auto
+
+ moreover
+
+ have "(d / (2*dist y x)) *\<^sub>R (y - x) \<noteq> 0"
+ using `x\<noteq>y`[unfolded dist_nz] `d>0` unfolding scaleR_eq_0_iff by (auto simp add: dist_commute)
+ moreover
+ have "dist (y - (d / (2 * dist y x)) *\<^sub>R (y - x)) y < d" unfolding dist_norm apply simp unfolding norm_minus_cancel
+ using `d>0` `x\<noteq>y`[unfolded dist_nz] dist_commute[of x y]
+ unfolding dist_norm by auto
+ 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
+ qed
+ next
+ case False hence "d > dist x y" by auto
+ show "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
+ proof(cases "x=y")
+ case True
+ obtain z where **: "z \<noteq> y" "dist z y < min e d"
+ using perfect_choose_dist[of "min e d" y]
+ using `d > 0` `e>0` by auto
+ show "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
+ unfolding `x = y`
+ using `z \<noteq> y` **
+ by (rule_tac x=z in bexI, auto simp add: dist_commute)
+ next
+ case False thus "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
+ using `d>0` `d > dist x y` `?rhs` by(rule_tac x=x in bexI, auto)
+ qed
+ qed }
+ thus "?lhs" unfolding mem_cball islimpt_approachable mem_ball by auto
+qed
+
+lemma closure_ball_lemma:
+ fixes x y :: "'a::real_normed_vector"
+ assumes "x \<noteq> y" shows "y islimpt ball x (dist x y)"
+proof (rule islimptI)
+ fix T assume "y \<in> T" "open T"
+ then obtain r where "0 < r" "\<forall>z. dist z y < r \<longrightarrow> z \<in> T"
+ unfolding open_dist by fast
+ (* choose point between x and y, within distance r of y. *)
+ def k \<equiv> "min 1 (r / (2 * dist x y))"
+ def z \<equiv> "y + scaleR k (x - y)"
+ have z_def2: "z = x + scaleR (1 - k) (y - x)"
+ unfolding z_def by (simp add: algebra_simps)
+ have "dist z y < r"
+ unfolding z_def k_def using `0 < r`
+ by (simp add: dist_norm min_def)
+ hence "z \<in> T" using `\<forall>z. dist z y < r \<longrightarrow> z \<in> T` by simp
+ have "dist x z < dist x y"
+ unfolding z_def2 dist_norm
+ apply (simp add: norm_minus_commute)
+ apply (simp only: dist_norm [symmetric])
+ apply (subgoal_tac "\<bar>1 - k\<bar> * dist x y < 1 * dist x y", simp)
+ apply (rule mult_strict_right_mono)
+ apply (simp add: k_def divide_pos_pos zero_less_dist_iff `0 < r` `x \<noteq> y`)
+ apply (simp add: zero_less_dist_iff `x \<noteq> y`)
+ done
+ hence "z \<in> ball x (dist x y)" by simp
+ have "z \<noteq> y"
+ unfolding z_def k_def using `x \<noteq> y` `0 < r`
+ by (simp add: min_def)
+ show "\<exists>z\<in>ball x (dist x y). z \<in> T \<and> z \<noteq> y"
+ using `z \<in> ball x (dist x y)` `z \<in> T` `z \<noteq> y`
+ by fast
+qed
+
+lemma closure_ball:
+ fixes x :: "'a::real_normed_vector"
+ shows "0 < e \<Longrightarrow> closure (ball x e) = cball x e"
+apply (rule equalityI)
+apply (rule closure_minimal)
+apply (rule ball_subset_cball)
+apply (rule closed_cball)
+apply (rule subsetI, rename_tac y)
+apply (simp add: le_less [where 'a=real])
+apply (erule disjE)
+apply (rule subsetD [OF closure_subset], simp)
+apply (simp add: closure_def)
+apply clarify
+apply (rule closure_ball_lemma)
+apply (simp add: zero_less_dist_iff)
+done
+
+(* In a trivial vector space, this fails for e = 0. *)
+lemma interior_cball:
+ fixes x :: "'a::{real_normed_vector, perfect_space}"
+ shows "interior (cball x e) = ball x e"
+proof(cases "e\<ge>0")
+ case False note cs = this
+ from cs have "ball x e = {}" using ball_empty[of e x] by auto moreover
+ { fix y assume "y \<in> cball x e"
+ hence False unfolding mem_cball using dist_nz[of x y] cs by auto }
+ hence "cball x e = {}" by auto
+ hence "interior (cball x e) = {}" using interior_empty by auto
+ ultimately show ?thesis by blast
+next
+ case True note cs = this
+ have "ball x e \<subseteq> cball x e" using ball_subset_cball by auto moreover
+ { fix S y assume as: "S \<subseteq> cball x e" "open S" "y\<in>S"
+ then obtain d where "d>0" and d:"\<forall>x'. dist x' y < d \<longrightarrow> x' \<in> S" unfolding open_dist by blast
+
+ then obtain xa where xa_y: "xa \<noteq> y" and xa: "dist xa y < d"
+ using perfect_choose_dist [of d] by auto
+ have "xa\<in>S" using d[THEN spec[where x=xa]] using xa by(auto simp add: dist_commute)
+ hence xa_cball:"xa \<in> cball x e" using as(1) by auto
+
+ hence "y \<in> ball x e" proof(cases "x = y")
+ case True
+ hence "e>0" using xa_y[unfolded dist_nz] xa_cball[unfolded mem_cball] by (auto simp add: dist_commute)
+ thus "y \<in> ball x e" using `x = y ` by simp
+ next
+ case False
+ have "dist (y + (d / 2 / dist y x) *\<^sub>R (y - x)) y < d" unfolding dist_norm
+ using `d>0` norm_ge_zero[of "y - x"] `x \<noteq> y` by auto
+ hence *:"y + (d / 2 / dist y x) *\<^sub>R (y - x) \<in> cball x e" using d as(1)[unfolded subset_eq] by blast
+ have "y - x \<noteq> 0" using `x \<noteq> y` by auto
+ hence **:"d / (2 * norm (y - x)) > 0" unfolding zero_less_norm_iff[THEN sym]
+ using `d>0` divide_pos_pos[of d "2*norm (y - x)"] by auto
+
+ 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)"
+ by (auto simp add: dist_norm algebra_simps)
+ also have "\<dots> = norm ((1 + d / (2 * norm (y - x))) *\<^sub>R (y - x))"
+ by (auto simp add: algebra_simps)
+ also have "\<dots> = \<bar>1 + d / (2 * norm (y - x))\<bar> * norm (y - x)"
+ using ** by auto
+ also have "\<dots> = (dist y x) + d/2"using ** by (auto simp add: left_distrib dist_norm)
+ finally have "e \<ge> dist x y +d/2" using *[unfolded mem_cball] by (auto simp add: dist_commute)
+ thus "y \<in> ball x e" unfolding mem_ball using `d>0` by auto
+ qed }
+ hence "\<forall>S \<subseteq> cball x e. open S \<longrightarrow> S \<subseteq> ball x e" by auto
+ ultimately show ?thesis using interior_unique[of "ball x e" "cball x e"] using open_ball[of x e] by auto
+qed
+
+lemma frontier_ball:
+ fixes a :: "'a::real_normed_vector"
+ shows "0 < e ==> frontier(ball a e) = {x. dist a x = e}"
+ apply (simp add: frontier_def closure_ball interior_open open_ball order_less_imp_le)
+ apply (simp add: expand_set_eq)
+ by arith
+
+lemma frontier_cball:
+ fixes a :: "'a::{real_normed_vector, perfect_space}"
+ shows "frontier(cball a e) = {x. dist a x = e}"
+ apply (simp add: frontier_def interior_cball closed_cball closure_closed order_less_imp_le)
+ apply (simp add: expand_set_eq)
+ by arith
+
+lemma cball_eq_empty: "(cball x e = {}) \<longleftrightarrow> e < 0"
+ apply (simp add: expand_set_eq not_le)
+ by (metis zero_le_dist dist_self order_less_le_trans)
+lemma cball_empty: "e < 0 ==> cball x e = {}" by (simp add: cball_eq_empty)
+
+lemma cball_eq_sing:
+ fixes x :: "'a::perfect_space"
+ shows "(cball x e = {x}) \<longleftrightarrow> e = 0"
+proof (rule linorder_cases)
+ assume e: "0 < e"
+ obtain a where "a \<noteq> x" "dist a x < e"
+ using perfect_choose_dist [OF e] by auto
+ hence "a \<noteq> x" "dist x a \<le> e" by (auto simp add: dist_commute)
+ with e show ?thesis by (auto simp add: expand_set_eq)
+qed auto
+
+lemma cball_sing:
+ fixes x :: "'a::metric_space"
+ shows "e = 0 ==> cball x e = {x}"
+ by (auto simp add: expand_set_eq)
+
+text{* For points in the interior, localization of limits makes no difference. *}
+
+lemma eventually_within_interior:
+ assumes "x \<in> interior S"
+ shows "eventually P (at x within S) \<longleftrightarrow> eventually P (at x)" (is "?lhs = ?rhs")
+proof-
+ from assms obtain T where T: "open T" "x \<in> T" "T \<subseteq> S"
+ unfolding interior_def by fast
+ { assume "?lhs"
+ then obtain A where "open A" "x \<in> A" "\<forall>y\<in>A. y \<noteq> x \<longrightarrow> y \<in> S \<longrightarrow> P y"
+ unfolding Limits.eventually_within Limits.eventually_at_topological
+ by auto
+ with T have "open (A \<inter> T)" "x \<in> A \<inter> T" "\<forall>y\<in>(A \<inter> T). y \<noteq> x \<longrightarrow> P y"
+ by auto
+ then have "?rhs"
+ unfolding Limits.eventually_at_topological by auto
+ } moreover
+ { assume "?rhs" hence "?lhs"
+ unfolding Limits.eventually_within
+ by (auto elim: eventually_elim1)
+ } ultimately
+ show "?thesis" ..
+qed
+
+lemma lim_within_interior:
+ "x \<in> interior S \<Longrightarrow> (f ---> l) (at x within S) \<longleftrightarrow> (f ---> l) (at x)"
+ unfolding tendsto_def by (simp add: eventually_within_interior)
+
+lemma netlimit_within_interior:
+ fixes x :: "'a::{perfect_space, real_normed_vector}"
+ (* FIXME: generalize to perfect_space *)
+ assumes "x \<in> interior S"
+ shows "netlimit(at x within S) = x" (is "?lhs = ?rhs")
+proof-
+ 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
+ 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
+ thus ?thesis using netlimit_within by auto
+qed
+
+subsection{* Boundedness. *}
+
+ (* FIXME: This has to be unified with BSEQ!! *)
+definition
+ bounded :: "'a::metric_space set \<Rightarrow> bool" where
+ "bounded S \<longleftrightarrow> (\<exists>x e. \<forall>y\<in>S. dist x y \<le> e)"
+
+lemma bounded_any_center: "bounded S \<longleftrightarrow> (\<exists>e. \<forall>y\<in>S. dist a y \<le> e)"
+unfolding bounded_def
+apply safe
+apply (rule_tac x="dist a x + e" in exI, clarify)
+apply (drule (1) bspec)
+apply (erule order_trans [OF dist_triangle add_left_mono])
+apply auto
+done
+
+lemma bounded_iff: "bounded S \<longleftrightarrow> (\<exists>a. \<forall>x\<in>S. norm x \<le> a)"
+unfolding bounded_any_center [where a=0]
+by (simp add: dist_norm)
+
+lemma bounded_empty[simp]: "bounded {}" by (simp add: bounded_def)
+lemma bounded_subset: "bounded T \<Longrightarrow> S \<subseteq> T ==> bounded S"
+ by (metis bounded_def subset_eq)
+
+lemma bounded_interior[intro]: "bounded S ==> bounded(interior S)"
+ by (metis bounded_subset interior_subset)
+
+lemma bounded_closure[intro]: assumes "bounded S" shows "bounded(closure S)"
+proof-
+ from assms obtain x and a where a: "\<forall>y\<in>S. dist x y \<le> a" unfolding bounded_def by auto
+ { fix y assume "y \<in> closure S"
+ then obtain f where f: "\<forall>n. f n \<in> S" "(f ---> y) sequentially"
+ unfolding closure_sequential by auto
+ have "\<forall>n. f n \<in> S \<longrightarrow> dist x (f n) \<le> a" using a by simp
+ hence "eventually (\<lambda>n. dist x (f n) \<le> a) sequentially"
+ by (rule eventually_mono, simp add: f(1))
+ have "dist x y \<le> a"
+ apply (rule Lim_dist_ubound [of sequentially f])
+ apply (rule trivial_limit_sequentially)
+ apply (rule f(2))
+ apply fact
+ done
+ }
+ thus ?thesis unfolding bounded_def by auto
+qed
+
+lemma bounded_cball[simp,intro]: "bounded (cball x e)"
+ apply (simp add: bounded_def)
+ apply (rule_tac x=x in exI)
+ apply (rule_tac x=e in exI)
+ apply auto
+ done
+
+lemma bounded_ball[simp,intro]: "bounded(ball x e)"
+ by (metis ball_subset_cball bounded_cball bounded_subset)
+
+lemma finite_imp_bounded[intro]: assumes "finite S" shows "bounded S"
+proof-
+ { fix a F assume as:"bounded F"
+ then obtain x e where "\<forall>y\<in>F. dist x y \<le> e" unfolding bounded_def by auto
+ hence "\<forall>y\<in>(insert a F). dist x y \<le> max e (dist x a)" by auto
+ hence "bounded (insert a F)" unfolding bounded_def by (intro exI)
+ }
+ thus ?thesis using finite_induct[of S bounded] using bounded_empty assms by auto
+qed
+
+lemma bounded_Un[simp]: "bounded (S \<union> T) \<longleftrightarrow> bounded S \<and> bounded T"
+ apply (auto simp add: bounded_def)
+ apply (rename_tac x y r s)
+ apply (rule_tac x=x in exI)
+ apply (rule_tac x="max r (dist x y + s)" in exI)
+ apply (rule ballI, rename_tac z, safe)
+ apply (drule (1) bspec, simp)
+ apply (drule (1) bspec)
+ apply (rule min_max.le_supI2)
+ apply (erule order_trans [OF dist_triangle add_left_mono])
+ done
+
+lemma bounded_Union[intro]: "finite F \<Longrightarrow> (\<forall>S\<in>F. bounded S) \<Longrightarrow> bounded(\<Union>F)"
+ by (induct rule: finite_induct[of F], auto)
+
+lemma bounded_pos: "bounded S \<longleftrightarrow> (\<exists>b>0. \<forall>x\<in> S. norm x <= b)"
+ apply (simp add: bounded_iff)
+ apply (subgoal_tac "\<And>x (y::real). 0 < 1 + abs y \<and> (x <= y \<longrightarrow> x <= 1 + abs y)")
+ by metis arith
+
+lemma bounded_Int[intro]: "bounded S \<or> bounded T \<Longrightarrow> bounded (S \<inter> T)"
+ by (metis Int_lower1 Int_lower2 bounded_subset)
+
+lemma bounded_diff[intro]: "bounded S ==> bounded (S - T)"
+apply (metis Diff_subset bounded_subset)
+done
+
+lemma bounded_insert[intro]:"bounded(insert x S) \<longleftrightarrow> bounded S"
+ by (metis Diff_cancel Un_empty_right Un_insert_right bounded_Un bounded_subset finite.emptyI finite_imp_bounded infinite_remove subset_insertI)
+
+lemma not_bounded_UNIV[simp, intro]:
+ "\<not> bounded (UNIV :: 'a::{real_normed_vector, perfect_space} set)"
+proof(auto simp add: bounded_pos not_le)
+ obtain x :: 'a where "x \<noteq> 0"
+ using perfect_choose_dist [OF zero_less_one] by fast
+ fix b::real assume b: "b >0"
+ have b1: "b +1 \<ge> 0" using b by simp
+ with `x \<noteq> 0` have "b < norm (scaleR (b + 1) (sgn x))"
+ by (simp add: norm_sgn)
+ then show "\<exists>x::'a. b < norm x" ..
+qed
+
+lemma bounded_linear_image:
+ assumes "bounded S" "bounded_linear f"
+ shows "bounded(f ` S)"
+proof-
+ from assms(1) obtain b where b:"b>0" "\<forall>x\<in>S. norm x \<le> b" unfolding bounded_pos by auto
+ 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)
+ { fix x assume "x\<in>S"
+ hence "norm x \<le> b" using b by auto
+ hence "norm (f x) \<le> B * b" using B(2) apply(erule_tac x=x in allE)
+ by (metis B(1) B(2) real_le_trans real_mult_le_cancel_iff2)
+ }
+ thus ?thesis unfolding bounded_pos apply(rule_tac x="b*B" in exI)
+ using b B real_mult_order[of b B] by (auto simp add: real_mult_commute)
+qed
+
+lemma bounded_scaling:
+ fixes S :: "'a::real_normed_vector set"
+ shows "bounded S \<Longrightarrow> bounded ((\<lambda>x. c *\<^sub>R x) ` S)"
+ apply (rule bounded_linear_image, assumption)
+ apply (rule scaleR.bounded_linear_right)
+ done
+
+lemma bounded_translation:
+ fixes S :: "'a::real_normed_vector set"
+ assumes "bounded S" shows "bounded ((\<lambda>x. a + x) ` S)"
+proof-
+ from assms obtain b where b:"b>0" "\<forall>x\<in>S. norm x \<le> b" unfolding bounded_pos by auto
+ { fix x assume "x\<in>S"
+ hence "norm (a + x) \<le> b + norm a" using norm_triangle_ineq[of a x] b by auto
+ }
+ thus ?thesis unfolding bounded_pos using norm_ge_zero[of a] b(1) using add_strict_increasing[of b 0 "norm a"]
+ by (auto intro!: add exI[of _ "b + norm a"])
+qed
+
+
+text{* Some theorems on sups and infs using the notion "bounded". *}
+
+lemma bounded_real:
+ fixes S :: "real set"
+ shows "bounded S \<longleftrightarrow> (\<exists>a. \<forall>x\<in>S. abs x <= a)"
+ by (simp add: bounded_iff)
+
+lemma bounded_has_rsup: assumes "bounded S" "S \<noteq> {}"
+ shows "\<forall>x\<in>S. x <= rsup S" and "\<forall>b. (\<forall>x\<in>S. x <= b) \<longrightarrow> rsup S <= b"
+proof
+ fix x assume "x\<in>S"
+ from assms(1) obtain a where a:"\<forall>x\<in>S. \<bar>x\<bar> \<le> a" unfolding bounded_real by auto
+ hence *:"S *<= a" using setleI[of S a] by (metis abs_le_interval_iff mem_def)
+ 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
+next
+ show "\<forall>b. (\<forall>x\<in>S. x \<le> b) \<longrightarrow> rsup S \<le> b" using assms
+ using rsup[of S, unfolded isLub_def isUb_def leastP_def setle_def setge_def]
+ apply (auto simp add: bounded_real)
+ by (auto simp add: isLub_def isUb_def leastP_def setle_def setge_def)
+qed
+
+lemma rsup_insert: assumes "bounded S"
+ shows "rsup(insert x S) = (if S = {} then x else max x (rsup S))"
+proof(cases "S={}")
+ case True thus ?thesis using rsup_finite_in[of "{x}"] by auto
+next
+ let ?S = "insert x S"
+ case False
+ hence *:"\<forall>x\<in>S. x \<le> rsup S" using bounded_has_rsup(1)[of S] using assms by auto
+ hence "insert x S *<= max x (rsup S)" unfolding setle_def by auto
+ hence "isLub UNIV ?S (rsup ?S)" using rsup[of ?S] by auto
+ moreover
+ have **:"isUb UNIV ?S (max x (rsup S))" unfolding isUb_def setle_def using * by auto
+ { fix y assume as:"isUb UNIV (insert x S) y"
+ hence "max x (rsup S) \<le> y" unfolding isUb_def using rsup_le[OF `S\<noteq>{}`]
+ unfolding setle_def by auto }
+ hence "max x (rsup S) <=* isUb UNIV (insert x S)" unfolding setge_def Ball_def mem_def by auto
+ hence "isLub UNIV ?S (max x (rsup S))" using ** isLubI2[of UNIV ?S "max x (rsup S)"] unfolding Collect_def by auto
+ ultimately show ?thesis using real_isLub_unique[of UNIV ?S] using `S\<noteq>{}` by auto
+qed
+
+lemma sup_insert_finite: "finite S \<Longrightarrow> rsup(insert x S) = (if S = {} then x else max x (rsup S))"
+ apply (rule rsup_insert)
+ apply (rule finite_imp_bounded)
+ by simp
+
+lemma bounded_has_rinf:
+ assumes "bounded S" "S \<noteq> {}"
+ shows "\<forall>x\<in>S. x >= rinf S" and "\<forall>b. (\<forall>x\<in>S. x >= b) \<longrightarrow> rinf S >= b"
+proof
+ fix x assume "x\<in>S"
+ from assms(1) obtain a where a:"\<forall>x\<in>S. \<bar>x\<bar> \<le> a" unfolding bounded_real by auto
+ hence *:"- a <=* S" using setgeI[of S "-a"] unfolding abs_le_interval_iff by auto
+ thus "x \<ge> rinf S" using rinf[OF `S\<noteq>{}`] using isGlbD2[of UNIV S "rinf S" x] using `x\<in>S` by auto
+next
+ show "\<forall>b. (\<forall>x\<in>S. x >= b) \<longrightarrow> rinf S \<ge> b" using assms
+ using rinf[of S, unfolded isGlb_def isLb_def greatestP_def setle_def setge_def]
+ apply (auto simp add: bounded_real)
+ by (auto simp add: isGlb_def isLb_def greatestP_def setle_def setge_def)
+qed
+
+(* TODO: Move this to RComplete.thy -- would need to include Glb into RComplete *)
+lemma real_isGlb_unique: "[| isGlb R S x; isGlb R S y |] ==> x = (y::real)"
+ apply (frule isGlb_isLb)
+ apply (frule_tac x = y in isGlb_isLb)
+ apply (blast intro!: order_antisym dest!: isGlb_le_isLb)
+ done
+
+lemma rinf_insert: assumes "bounded S"
+ shows "rinf(insert x S) = (if S = {} then x else min x (rinf S))" (is "?lhs = ?rhs")
+proof(cases "S={}")
+ case True thus ?thesis using rinf_finite_in[of "{x}"] by auto
+next
+ let ?S = "insert x S"
+ case False
+ hence *:"\<forall>x\<in>S. x \<ge> rinf S" using bounded_has_rinf(1)[of S] using assms by auto
+ hence "min x (rinf S) <=* insert x S" unfolding setge_def by auto
+ hence "isGlb UNIV ?S (rinf ?S)" using rinf[of ?S] by auto
+ moreover
+ have **:"isLb UNIV ?S (min x (rinf S))" unfolding isLb_def setge_def using * by auto
+ { fix y assume as:"isLb UNIV (insert x S) y"
+ hence "min x (rinf S) \<ge> y" unfolding isLb_def using rinf_ge[OF `S\<noteq>{}`]
+ unfolding setge_def by auto }
+ hence "isLb UNIV (insert x S) *<= min x (rinf S)" unfolding setle_def Ball_def mem_def by auto
+ hence "isGlb UNIV ?S (min x (rinf S))" using ** isGlbI2[of UNIV ?S "min x (rinf S)"] unfolding Collect_def by auto
+ ultimately show ?thesis using real_isGlb_unique[of UNIV ?S] using `S\<noteq>{}` by auto
+qed
+
+lemma inf_insert_finite: "finite S ==> rinf(insert x S) = (if S = {} then x else min x (rinf S))"
+ by (rule rinf_insert, rule finite_imp_bounded, simp)
+
+subsection{* Compactness (the definition is the one based on convegent subsequences). *}
+
+definition
+ compact :: "'a::metric_space set \<Rightarrow> bool" where (* TODO: generalize *)
+ "compact S \<longleftrightarrow>
+ (\<forall>f. (\<forall>n. f n \<in> S) \<longrightarrow>
+ (\<exists>l\<in>S. \<exists>r. subseq r \<and> ((f o r) ---> l) sequentially))"
+
+text {*
+ A metric space (or topological vector space) is said to have the
+ Heine-Borel property if every closed and bounded subset is compact.
+*}
+
+class heine_borel =
+ assumes bounded_imp_convergent_subsequence:
+ "bounded s \<Longrightarrow> \<forall>n. f n \<in> s
+ \<Longrightarrow> \<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
+
+lemma bounded_closed_imp_compact:
+ fixes s::"'a::heine_borel set"
+ assumes "bounded s" and "closed s" shows "compact s"
+proof (unfold compact_def, clarify)
+ fix f :: "nat \<Rightarrow> 'a" assume f: "\<forall>n. f n \<in> s"
+ obtain l r where r: "subseq r" and l: "((f \<circ> r) ---> l) sequentially"
+ using bounded_imp_convergent_subsequence [OF `bounded s` `\<forall>n. f n \<in> s`] by auto
+ from f have fr: "\<forall>n. (f \<circ> r) n \<in> s" by simp
+ have "l \<in> s" using `closed s` fr l
+ unfolding closed_sequential_limits by blast
+ show "\<exists>l\<in>s. \<exists>r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
+ using `l \<in> s` r l by blast
+qed
+
+lemma subseq_bigger: assumes "subseq r" shows "n \<le> r n"
+proof(induct n)
+ show "0 \<le> r 0" by auto
+next
+ fix n assume "n \<le> r n"
+ moreover have "r n < r (Suc n)"
+ using assms [unfolded subseq_def] by auto
+ ultimately show "Suc n \<le> r (Suc n)" by auto
+qed
+
+lemma eventually_subseq:
+ assumes r: "subseq r"
+ shows "eventually P sequentially \<Longrightarrow> eventually (\<lambda>n. P (r n)) sequentially"
+unfolding eventually_sequentially
+by (metis subseq_bigger [OF r] le_trans)
+
+lemma lim_subseq:
+ "subseq r \<Longrightarrow> (s ---> l) sequentially \<Longrightarrow> ((s o r) ---> l) sequentially"
+unfolding tendsto_def eventually_sequentially o_def
+by (metis subseq_bigger le_trans)
+
+lemma num_Axiom: "EX! g. g 0 = e \<and> (\<forall>n. g (Suc n) = f n (g n))"
+ unfolding Ex1_def
+ apply (rule_tac x="nat_rec e f" in exI)
+ apply (rule conjI)+
+apply (rule def_nat_rec_0, simp)
+apply (rule allI, rule def_nat_rec_Suc, simp)
+apply (rule allI, rule impI, rule ext)
+apply (erule conjE)
+apply (induct_tac x)
+apply (simp add: nat_rec_0)
+apply (erule_tac x="n" in allE)
+apply (simp)
+done
+
+lemma convergent_bounded_increasing: fixes s ::"nat\<Rightarrow>real"
+ assumes "incseq s" and "\<forall>n. abs(s n) \<le> b"
+ shows "\<exists> l. \<forall>e::real>0. \<exists> N. \<forall>n \<ge> N. abs(s n - l) < e"
+proof-
+ have "isUb UNIV (range s) b" using assms(2) and abs_le_D1 unfolding isUb_def and setle_def by auto
+ then obtain t where t:"isLub UNIV (range s) t" using reals_complete[of "range s" ] by auto
+ { fix e::real assume "e>0" and as:"\<forall>N. \<exists>n\<ge>N. \<not> \<bar>s n - t\<bar> < e"
+ { fix n::nat
+ obtain N where "N\<ge>n" and n:"\<bar>s N - t\<bar> \<ge> e" using as[THEN spec[where x=n]] by auto
+ have "t \<ge> s N" using isLub_isUb[OF t, unfolded isUb_def setle_def] by auto
+ with n have "s N \<le> t - e" using `e>0` by auto
+ 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 }
+ hence "isUb UNIV (range s) (t - e)" unfolding isUb_def and setle_def by auto
+ hence False using isLub_le_isUb[OF t, of "t - e"] and `e>0` by auto }
+ thus ?thesis by blast
+qed
+
+lemma convergent_bounded_monotone: fixes s::"nat \<Rightarrow> real"
+ assumes "\<forall>n. abs(s n) \<le> b" and "monoseq s"
+ shows "\<exists>l. \<forall>e::real>0. \<exists>N. \<forall>n\<ge>N. abs(s n - l) < e"
+ using convergent_bounded_increasing[of s b] assms using convergent_bounded_increasing[of "\<lambda>n. - s n" b]
+ unfolding monoseq_def incseq_def
+ apply auto unfolding minus_add_distrib[THEN sym, unfolded diff_minus[THEN sym]]
+ unfolding abs_minus_cancel by(rule_tac x="-l" in exI)auto
+
+lemma compact_real_lemma:
+ assumes "\<forall>n::nat. abs(s n) \<le> b"
+ shows "\<exists>(l::real) r. subseq r \<and> ((s \<circ> r) ---> l) sequentially"
+proof-
+ obtain r where r:"subseq r" "monoseq (\<lambda>n. s (r n))"
+ using seq_monosub[of s] by auto
+ thus ?thesis using convergent_bounded_monotone[of "\<lambda>n. s (r n)" b] and assms
+ unfolding tendsto_iff dist_norm eventually_sequentially by auto
+qed
+
+instance real :: heine_borel
+proof
+ fix s :: "real set" and f :: "nat \<Rightarrow> real"
+ assume s: "bounded s" and f: "\<forall>n. f n \<in> s"
+ then obtain b where b: "\<forall>n. abs (f n) \<le> b"
+ unfolding bounded_iff by auto
+ obtain l :: real and r :: "nat \<Rightarrow> nat" where
+ r: "subseq r" and l: "((f \<circ> r) ---> l) sequentially"
+ using compact_real_lemma [OF b] by auto
+ thus "\<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
+ by auto
+qed
+
+lemma bounded_component: "bounded s \<Longrightarrow> bounded ((\<lambda>x. x $ i) ` s)"
+unfolding bounded_def
+apply clarify
+apply (rule_tac x="x $ i" in exI)
+apply (rule_tac x="e" in exI)
+apply clarify
+apply (rule order_trans [OF dist_nth_le], simp)
+done
+
+lemma compact_lemma:
+ fixes f :: "nat \<Rightarrow> 'a::heine_borel ^ 'n::finite"
+ assumes "bounded s" and "\<forall>n. f n \<in> s"
+ shows "\<forall>d.
+ \<exists>l r. subseq r \<and>
+ (\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r n) $ i) (l $ i) < e) sequentially)"
+proof
+ fix d::"'n set" have "finite d" by simp
+ thus "\<exists>l::'a ^ 'n. \<exists>r. subseq r \<and>
+ (\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r n) $ i) (l $ i) < e) sequentially)"
+ proof(induct d) case empty thus ?case unfolding subseq_def by auto
+ next case (insert k d)
+ have s': "bounded ((\<lambda>x. x $ k) ` s)" using `bounded s` by (rule bounded_component)
+ 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"
+ using insert(3) by auto
+ have f': "\<forall>n. f (r1 n) $ k \<in> (\<lambda>x. x $ k) ` s" using `\<forall>n. f n \<in> s` by simp
+ obtain l2 r2 where r2:"subseq r2" and lr2:"((\<lambda>i. f (r1 (r2 i)) $ k) ---> l2) sequentially"
+ using bounded_imp_convergent_subsequence[OF s' f'] unfolding o_def by auto
+ def r \<equiv> "r1 \<circ> r2" have r:"subseq r"
+ using r1 and r2 unfolding r_def o_def subseq_def by auto
+ moreover
+ def l \<equiv> "(\<chi> i. if i = k then l2 else l1$i)::'a^'n"
+ { fix e::real assume "e>0"
+ from lr1 `e>0` have N1:"eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r1 n) $ i) (l1 $ i) < e) sequentially" by blast
+ from lr2 `e>0` have N2:"eventually (\<lambda>n. dist (f (r1 (r2 n)) $ k) l2 < e) sequentially" by (rule tendstoD)
+ from r2 N1 have N1': "eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r1 (r2 n)) $ i) (l1 $ i) < e) sequentially"
+ by (rule eventually_subseq)
+ have "eventually (\<lambda>n. \<forall>i\<in>(insert k d). dist (f (r n) $ i) (l $ i) < e) sequentially"
+ using N1' N2 by (rule eventually_elim2, simp add: l_def r_def)
+ }
+ ultimately show ?case by auto
+ qed
+qed
+
+instance "^" :: (heine_borel, finite) heine_borel
+proof
+ fix s :: "('a ^ 'b) set" and f :: "nat \<Rightarrow> 'a ^ 'b"
+ assume s: "bounded s" and f: "\<forall>n. f n \<in> s"
+ then obtain l r where r: "subseq r"
+ and l: "\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>UNIV. dist (f (r n) $ i) (l $ i) < e) sequentially"
+ using compact_lemma [OF s f] by blast
+ let ?d = "UNIV::'b set"
+ { fix e::real assume "e>0"
+ hence "0 < e / (real_of_nat (card ?d))"
+ using zero_less_card_finite using divide_pos_pos[of e, of "real_of_nat (card ?d)"] by auto
+ with l have "eventually (\<lambda>n. \<forall>i. dist (f (r n) $ i) (l $ i) < e / (real_of_nat (card ?d))) sequentially"
+ by simp
+ moreover
+ { fix n assume n: "\<forall>i. dist (f (r n) $ i) (l $ i) < e / (real_of_nat (card ?d))"
+ have "dist (f (r n)) l \<le> (\<Sum>i\<in>?d. dist (f (r n) $ i) (l $ i))"
+ unfolding dist_vector_def using zero_le_dist by (rule setL2_le_setsum)
+ also have "\<dots> < (\<Sum>i\<in>?d. e / (real_of_nat (card ?d)))"
+ by (rule setsum_strict_mono) (simp_all add: n)
+ finally have "dist (f (r n)) l < e" by simp
+ }
+ ultimately have "eventually (\<lambda>n. dist (f (r n)) l < e) sequentially"
+ by (rule eventually_elim1)
+ }
+ hence *:"((f \<circ> r) ---> l) sequentially" unfolding o_def tendsto_iff by simp
+ with r show "\<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially" by auto
+qed
+
+lemma bounded_fst: "bounded s \<Longrightarrow> bounded (fst ` s)"
+unfolding bounded_def
+apply clarify
+apply (rule_tac x="a" in exI)
+apply (rule_tac x="e" in exI)
+apply clarsimp
+apply (drule (1) bspec)
+apply (simp add: dist_Pair_Pair)
+apply (erule order_trans [OF real_sqrt_sum_squares_ge1])
+done
+
+lemma bounded_snd: "bounded s \<Longrightarrow> bounded (snd ` s)"
+unfolding bounded_def
+apply clarify
+apply (rule_tac x="b" in exI)
+apply (rule_tac x="e" in exI)
+apply clarsimp
+apply (drule (1) bspec)
+apply (simp add: dist_Pair_Pair)
+apply (erule order_trans [OF real_sqrt_sum_squares_ge2])
+done
+
+instance "*" :: (heine_borel, heine_borel) heine_borel
+proof
+ fix s :: "('a * 'b) set" and f :: "nat \<Rightarrow> 'a * 'b"
+ assume s: "bounded s" and f: "\<forall>n. f n \<in> s"
+ from s have s1: "bounded (fst ` s)" by (rule bounded_fst)
+ from f have f1: "\<forall>n. fst (f n) \<in> fst ` s" by simp
+ obtain l1 r1 where r1: "subseq r1"
+ and l1: "((\<lambda>n. fst (f (r1 n))) ---> l1) sequentially"
+ using bounded_imp_convergent_subsequence [OF s1 f1]
+ unfolding o_def by fast
+ from s have s2: "bounded (snd ` s)" by (rule bounded_snd)
+ from f have f2: "\<forall>n. snd (f (r1 n)) \<in> snd ` s" by simp
+ obtain l2 r2 where r2: "subseq r2"
+ and l2: "((\<lambda>n. snd (f (r1 (r2 n)))) ---> l2) sequentially"
+ using bounded_imp_convergent_subsequence [OF s2 f2]
+ unfolding o_def by fast
+ have l1': "((\<lambda>n. fst (f (r1 (r2 n)))) ---> l1) sequentially"
+ using lim_subseq [OF r2 l1] unfolding o_def .
+ have l: "((f \<circ> (r1 \<circ> r2)) ---> (l1, l2)) sequentially"
+ using tendsto_Pair [OF l1' l2] unfolding o_def by simp
+ have r: "subseq (r1 \<circ> r2)"
+ using r1 r2 unfolding subseq_def by simp
+ show "\<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
+ using l r by fast
+qed
+
+subsection{* Completeness. *}
+
+lemma cauchy_def:
+ "Cauchy s \<longleftrightarrow> (\<forall>e>0. \<exists>N. \<forall>m n. m \<ge> N \<and> n \<ge> N --> dist(s m)(s n) < e)"
+unfolding Cauchy_def by blast
+
+definition
+ complete :: "'a::metric_space set \<Rightarrow> bool" where
+ "complete s \<longleftrightarrow> (\<forall>f. (\<forall>n. f n \<in> s) \<and> Cauchy f
+ --> (\<exists>l \<in> s. (f ---> l) sequentially))"
+
+lemma cauchy: "Cauchy s \<longleftrightarrow> (\<forall>e>0.\<exists> N::nat. \<forall>n\<ge>N. dist(s n)(s N) < e)" (is "?lhs = ?rhs")
+proof-
+ { assume ?rhs
+ { fix e::real
+ assume "e>0"
+ with `?rhs` obtain N where N:"\<forall>n\<ge>N. dist (s n) (s N) < e/2"
+ by (erule_tac x="e/2" in allE) auto
+ { fix n m
+ assume nm:"N \<le> m \<and> N \<le> n"
+ hence "dist (s m) (s n) < e" using N
+ using dist_triangle_half_l[of "s m" "s N" "e" "s n"]
+ by blast
+ }
+ hence "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (s m) (s n) < e"
+ by blast
+ }
+ hence ?lhs
+ unfolding cauchy_def
+ by blast
+ }
+ thus ?thesis
+ unfolding cauchy_def
+ using dist_triangle_half_l
+ by blast
+qed
+
+lemma convergent_imp_cauchy:
+ "(s ---> l) sequentially ==> Cauchy s"
+proof(simp only: cauchy_def, rule, rule)
+ fix e::real assume "e>0" "(s ---> l) sequentially"
+ 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
+ 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
+qed
+
+lemma cauchy_imp_bounded: assumes "Cauchy s" shows "bounded {y. (\<exists>n::nat. y = s n)}"
+proof-
+ 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
+ hence N:"\<forall>n. N \<le> n \<longrightarrow> dist (s N) (s n) < 1" by auto
+ moreover
+ have "bounded (s ` {0..N})" using finite_imp_bounded[of "s ` {1..N}"] by auto
+ then obtain a where a:"\<forall>x\<in>s ` {0..N}. dist (s N) x \<le> a"
+ unfolding bounded_any_center [where a="s N"] by auto
+ ultimately show "?thesis"
+ unfolding bounded_any_center [where a="s N"]
+ apply(rule_tac x="max a 1" in exI) apply auto
+ apply(erule_tac x=n in allE) apply(erule_tac x=n in ballE) by auto
+qed
+
+lemma compact_imp_complete: assumes "compact s" shows "complete s"
+proof-
+ { fix f assume as: "(\<forall>n::nat. f n \<in> s)" "Cauchy f"
+ 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
+
+ note lr' = subseq_bigger [OF lr(2)]
+
+ { fix e::real assume "e>0"
+ 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
+ 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
+ { fix n::nat assume n:"n \<ge> max N M"
+ have "dist ((f \<circ> r) n) l < e/2" using n M by auto
+ moreover have "r n \<ge> N" using lr'[of n] n by auto
+ hence "dist (f n) ((f \<circ> r) n) < e / 2" using N using n by auto
+ 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) }
+ hence "\<exists>N. \<forall>n\<ge>N. dist (f n) l < e" by blast }
+ hence "\<exists>l\<in>s. (f ---> l) sequentially" using `l\<in>s` unfolding Lim_sequentially by auto }
+ thus ?thesis unfolding complete_def by auto
+qed
+
+instance heine_borel < complete_space
+proof
+ fix f :: "nat \<Rightarrow> 'a" assume "Cauchy f"
+ hence "bounded (range f)" unfolding image_def
+ using cauchy_imp_bounded [of f] by auto
+ hence "compact (closure (range f))"
+ using bounded_closed_imp_compact [of "closure (range f)"] by auto
+ hence "complete (closure (range f))"
+ using compact_imp_complete by auto
+ moreover have "\<forall>n. f n \<in> closure (range f)"
+ using closure_subset [of "range f"] by auto
+ ultimately have "\<exists>l\<in>closure (range f). (f ---> l) sequentially"
+ using `Cauchy f` unfolding complete_def by auto
+ then show "convergent f"
+ unfolding convergent_def LIMSEQ_conv_tendsto [symmetric] by auto
+qed
+
+lemma complete_univ: "complete (UNIV :: 'a::complete_space set)"
+proof(simp add: complete_def, rule, rule)
+ fix f :: "nat \<Rightarrow> 'a" assume "Cauchy f"
+ hence "convergent f" by (rule Cauchy_convergent)
+ hence "\<exists>l. f ----> l" unfolding convergent_def .
+ thus "\<exists>l. (f ---> l) sequentially" unfolding LIMSEQ_conv_tendsto .
+qed
+
+lemma complete_imp_closed: assumes "complete s" shows "closed s"
+proof -
+ { fix x assume "x islimpt s"
+ then obtain f where f: "\<forall>n. f n \<in> s - {x}" "(f ---> x) sequentially"
+ unfolding islimpt_sequential by auto
+ then obtain l where l: "l\<in>s" "(f ---> l) sequentially"
+ using `complete s`[unfolded complete_def] using convergent_imp_cauchy[of f x] by auto
+ hence "x \<in> s" using Lim_unique[of sequentially f l x] trivial_limit_sequentially f(2) by auto
+ }
+ thus "closed s" unfolding closed_limpt by auto
+qed
+
+lemma complete_eq_closed:
+ fixes s :: "'a::complete_space set"
+ shows "complete s \<longleftrightarrow> closed s" (is "?lhs = ?rhs")
+proof
+ assume ?lhs thus ?rhs by (rule complete_imp_closed)
+next
+ assume ?rhs
+ { fix f assume as:"\<forall>n::nat. f n \<in> s" "Cauchy f"
+ then obtain l where "(f ---> l) sequentially" using complete_univ[unfolded complete_def, THEN spec[where x=f]] by auto
+ 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 }
+ thus ?lhs unfolding complete_def by auto
+qed
+
+lemma convergent_eq_cauchy:
+ fixes s :: "nat \<Rightarrow> 'a::complete_space"
+ shows "(\<exists>l. (s ---> l) sequentially) \<longleftrightarrow> Cauchy s" (is "?lhs = ?rhs")
+proof
+ assume ?lhs then obtain l where "(s ---> l) sequentially" by auto
+ thus ?rhs using convergent_imp_cauchy by auto
+next
+ assume ?rhs thus ?lhs using complete_univ[unfolded complete_def, THEN spec[where x=s]] by auto
+qed
+
+lemma convergent_imp_bounded:
+ fixes s :: "nat \<Rightarrow> 'a::metric_space"
+ shows "(s ---> l) sequentially ==> bounded (s ` (UNIV::(nat set)))"
+ using convergent_imp_cauchy[of s]
+ using cauchy_imp_bounded[of s]
+ unfolding image_def
+ by auto
+
+subsection{* Total boundedness. *}
+
+fun helper_1::"('a::metric_space set) \<Rightarrow> real \<Rightarrow> nat \<Rightarrow> 'a" where
+ "helper_1 s e n = (SOME y::'a. y \<in> s \<and> (\<forall>m<n. \<not> (dist (helper_1 s e m) y < e)))"
+declare helper_1.simps[simp del]
+
+lemma compact_imp_totally_bounded:
+ assumes "compact s"
+ shows "\<forall>e>0. \<exists>k. finite k \<and> k \<subseteq> s \<and> s \<subseteq> (\<Union>((\<lambda>x. ball x e) ` k))"
+proof(rule, rule, rule ccontr)
+ 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)"
+ def x \<equiv> "helper_1 s e"
+ { fix n
+ have "x n \<in> s \<and> (\<forall>m<n. \<not> dist (x m) (x n) < e)"
+ proof(induct_tac rule:nat_less_induct)
+ fix n def Q \<equiv> "(\<lambda>y. y \<in> s \<and> (\<forall>m<n. \<not> dist (x m) y < e))"
+ assume as:"\<forall>m<n. x m \<in> s \<and> (\<forall>ma<m. \<not> dist (x ma) (x m) < e)"
+ 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
+ then obtain z where z:"z\<in>s" "z \<notin> (\<Union>x\<in>x ` {0..<n}. ball x e)" unfolding subset_eq by auto
+ have "Q (x n)" unfolding x_def and helper_1.simps[of s e n]
+ apply(rule someI2[where a=z]) unfolding x_def[symmetric] and Q_def using z by auto
+ thus "x n \<in> s \<and> (\<forall>m<n. \<not> dist (x m) (x n) < e)" unfolding Q_def by auto
+ qed }
+ hence "\<forall>n::nat. x n \<in> s" and x:"\<forall>n. \<forall>m < n. \<not> (dist (x m) (x n) < e)" by blast+
+ 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
+ from this(3) have "Cauchy (x \<circ> r)" using convergent_imp_cauchy by auto
+ 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
+ show False
+ using N[THEN spec[where x=N], THEN spec[where x="N+1"]]
+ using r[unfolded subseq_def, THEN spec[where x=N], THEN spec[where x="N+1"]]
+ using x[THEN spec[where x="r (N+1)"], THEN spec[where x="r (N)"]] by auto
+qed
+
+subsection{* Heine-Borel theorem (following Burkill \& Burkill vol. 2) *}
+
+lemma heine_borel_lemma: fixes s::"'a::metric_space set"
+ assumes "compact s" "s \<subseteq> (\<Union> t)" "\<forall>b \<in> t. open b"
+ shows "\<exists>e>0. \<forall>x \<in> s. \<exists>b \<in> t. ball x e \<subseteq> b"
+proof(rule ccontr)
+ assume "\<not> (\<exists>e>0. \<forall>x\<in>s. \<exists>b\<in>t. ball x e \<subseteq> b)"
+ hence cont:"\<forall>e>0. \<exists>x\<in>s. \<forall>xa\<in>t. \<not> (ball x e \<subseteq> xa)" by auto
+ { fix n::nat
+ have "1 / real (n + 1) > 0" by auto
+ 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 }
+ 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
+ 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)"
+ 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
+
+ then obtain l r where l:"l\<in>s" and r:"subseq r" and lr:"((f \<circ> r) ---> l) sequentially"
+ using assms(1)[unfolded compact_def, THEN spec[where x=f]] by auto
+
+ obtain b where "l\<in>b" "b\<in>t" using assms(2) and l by auto
+ then obtain e where "e>0" and e:"\<forall>z. dist z l < e \<longrightarrow> z\<in>b"
+ using assms(3)[THEN bspec[where x=b]] unfolding open_dist by auto
+
+ then obtain N1 where N1:"\<forall>n\<ge>N1. dist ((f \<circ> r) n) l < e / 2"
+ using lr[unfolded Lim_sequentially, THEN spec[where x="e/2"]] by auto
+
+ obtain N2::nat where N2:"N2>0" "inverse (real N2) < e /2" using real_arch_inv[of "e/2"] and `e>0` by auto
+ have N2':"inverse (real (r (N1 + N2) +1 )) < e/2"
+ apply(rule order_less_trans) apply(rule less_imp_inverse_less) using N2
+ using subseq_bigger[OF r, of "N1 + N2"] by auto
+
+ def x \<equiv> "(f (r (N1 + N2)))"
+ have x:"\<not> ball x (inverse (real (r (N1 + N2) + 1))) \<subseteq> b" unfolding x_def
+ using f[THEN spec[where x="r (N1 + N2)"]] using `b\<in>t` by auto
+ have "\<exists>y\<in>ball x (inverse (real (r (N1 + N2) + 1))). y\<notin>b" apply(rule ccontr) using x by auto
+ then obtain y where y:"y \<in> ball x (inverse (real (r (N1 + N2) + 1)))" "y \<notin> b" by auto
+
+ have "dist x l < e/2" using N1 unfolding x_def o_def by auto
+ hence "dist y l < e" using y N2' using dist_triangle[of y l x]by (auto simp add:dist_commute)
+
+ thus False using e and `y\<notin>b` by auto
+qed
+
+lemma compact_imp_heine_borel: "compact s ==> (\<forall>f. (\<forall>t \<in> f. open t) \<and> s \<subseteq> (\<Union> f)
+ \<longrightarrow> (\<exists>f'. f' \<subseteq> f \<and> finite f' \<and> s \<subseteq> (\<Union> f')))"
+proof clarify
+ fix f assume "compact s" " \<forall>t\<in>f. open t" "s \<subseteq> \<Union>f"
+ 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
+ hence "\<forall>x\<in>s. \<exists>b. b\<in>f \<and> ball x e \<subseteq> b" by auto
+ 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
+ then obtain bb where bb:"\<forall>x\<in>s. (bb x) \<in> f \<and> ball x e \<subseteq> (bb x)" by blast
+
+ 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
+ then obtain k where k:"finite k" "k \<subseteq> s" "s \<subseteq> \<Union>(\<lambda>x. ball x e) ` k" by auto
+
+ have "finite (bb ` k)" using k(1) by auto
+ moreover
+ { fix x assume "x\<in>s"
+ hence "x\<in>\<Union>(\<lambda>x. ball x e) ` k" using k(3) unfolding subset_eq by auto
+ hence "\<exists>X\<in>bb ` k. x \<in> X" using bb k(2) by blast
+ hence "x \<in> \<Union>(bb ` k)" using Union_iff[of x "bb ` k"] by auto
+ }
+ 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
+qed
+
+subsection{* Bolzano-Weierstrass property. *}
+
+lemma heine_borel_imp_bolzano_weierstrass:
+ 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'))"
+ "infinite t" "t \<subseteq> s"
+ shows "\<exists>x \<in> s. x islimpt t"
+proof(rule ccontr)
+ assume "\<not> (\<exists>x \<in> s. x islimpt t)"
+ 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
+ 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
+ obtain g where g:"g\<subseteq>{t. \<exists>x. x \<in> s \<and> t = f x}" "finite g" "s \<subseteq> \<Union>g"
+ using assms(1)[THEN spec[where x="{t. \<exists>x. x\<in>s \<and> t = f x}"]] using f by auto
+ from g(1,3) have g':"\<forall>x\<in>g. \<exists>xa \<in> s. x = f xa" by auto
+ { fix x y assume "x\<in>t" "y\<in>t" "f x = f y"
+ 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
+ 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 }
+ hence "infinite (f ` t)" using assms(2) using finite_imageD[unfolded inj_on_def, of f t] by auto
+ moreover
+ { fix x assume "x\<in>t" "f x \<notin> g"
+ from g(3) assms(3) `x\<in>t` obtain h where "h\<in>g" and "x\<in>h" by auto
+ then obtain y where "y\<in>s" "h = f y" using g'[THEN bspec[where x=h]] by auto
+ hence "y = x" using f[THEN bspec[where x=y]] and `x\<in>t` and `x\<in>h`[unfolded `h = f y`] by auto
+ hence False using `f x \<notin> g` `h\<in>g` unfolding `h = f y` by auto }
+ hence "f ` t \<subseteq> g" by auto
+ ultimately show False using g(2) using finite_subset by auto
+qed
+
+subsection{* Complete the chain of compactness variants. *}
+
+primrec helper_2::"(real \<Rightarrow> 'a::metric_space) \<Rightarrow> nat \<Rightarrow> 'a" where
+ "helper_2 beyond 0 = beyond 0" |
+ "helper_2 beyond (Suc n) = beyond (dist undefined (helper_2 beyond n) + 1 )"
+
+lemma bolzano_weierstrass_imp_bounded: fixes s::"'a::metric_space set"
+ assumes "\<forall>t. infinite t \<and> t \<subseteq> s --> (\<exists>x \<in> s. x islimpt t)"
+ shows "bounded s"
+proof(rule ccontr)
+ assume "\<not> bounded s"
+ then obtain beyond where "\<forall>a. beyond a \<in>s \<and> \<not> dist undefined (beyond a) \<le> a"
+ unfolding bounded_any_center [where a=undefined]
+ apply simp using choice[of "\<lambda>a x. x\<in>s \<and> \<not> dist undefined x \<le> a"] by auto
+ hence beyond:"\<And>a. beyond a \<in>s" "\<And>a. dist undefined (beyond a) > a"
+ unfolding linorder_not_le by auto
+ def x \<equiv> "helper_2 beyond"
+
+ { fix m n ::nat assume "m<n"
+ hence "dist undefined (x m) + 1 < dist undefined (x n)"
+ proof(induct n)
+ case 0 thus ?case by auto
+ next
+ case (Suc n)
+ have *:"dist undefined (x n) + 1 < dist undefined (x (Suc n))"
+ unfolding x_def and helper_2.simps
+ using beyond(2)[of "dist undefined (helper_2 beyond n) + 1"] by auto
+ thus ?case proof(cases "m < n")
+ case True thus ?thesis using Suc and * by auto
+ next
+ case False hence "m = n" using Suc(2) by auto
+ thus ?thesis using * by auto
+ qed
+ qed } note * = this
+ { fix m n ::nat assume "m\<noteq>n"
+ have "1 < dist (x m) (x n)"
+ proof(cases "m<n")
+ case True
+ hence "1 < dist undefined (x n) - dist undefined (x m)" using *[of m n] by auto
+ thus ?thesis using dist_triangle [of undefined "x n" "x m"] by arith
+ next
+ case False hence "n<m" using `m\<noteq>n` by auto
+ hence "1 < dist undefined (x m) - dist undefined (x n)" using *[of n m] by auto
+ thus ?thesis using dist_triangle2 [of undefined "x m" "x n"] by arith
+ qed } note ** = this
+ { fix a b assume "x a = x b" "a \<noteq> b"
+ hence False using **[of a b] by auto }
+ hence "inj x" unfolding inj_on_def by auto
+ moreover
+ { fix n::nat
+ have "x n \<in> s"
+ proof(cases "n = 0")
+ case True thus ?thesis unfolding x_def using beyond by auto
+ next
+ case False then obtain z where "n = Suc z" using not0_implies_Suc by auto
+ thus ?thesis unfolding x_def using beyond by auto
+ qed }
+ 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
+
+ then obtain l where "l\<in>s" and l:"l islimpt range x" using assms[THEN spec[where x="range x"]] by auto
+ 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
+ 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"]]
+ unfolding dist_nz by auto
+ show False using y and z and dist_triangle_half_l[of "x y" l 1 "x z"] and **[of y z] by auto
+qed
+
+lemma sequence_infinite_lemma:
+ fixes l :: "'a::metric_space" (* TODO: generalize *)
+ assumes "\<forall>n::nat. (f n \<noteq> l)" "(f ---> l) sequentially"
+ shows "infinite {y. (\<exists> n. y = f n)}"
+proof(rule ccontr)
+ let ?A = "(\<lambda>x. dist x l) ` {y. \<exists>n. y = f n}"
+ assume "\<not> infinite {y. \<exists>n. y = f n}"
+ hence **:"finite ?A" "?A \<noteq> {}" by auto
+ obtain k where k:"dist (f k) l = Min ?A" using Min_in[OF **] by auto
+ have "0 < Min ?A" using assms(1) unfolding dist_nz unfolding Min_gr_iff[OF **] by auto
+ then obtain N where "dist (f N) l < Min ?A" using assms(2)[unfolded Lim_sequentially, THEN spec[where x="Min ?A"]] by auto
+ moreover have "dist (f N) l \<in> ?A" by auto
+ ultimately show False using Min_le[OF **(1), of "dist (f N) l"] by auto
+qed
+
+lemma sequence_unique_limpt:
+ fixes l :: "'a::metric_space" (* TODO: generalize *)
+ assumes "\<forall>n::nat. (f n \<noteq> l)" "(f ---> l) sequentially" "l' islimpt {y. (\<exists>n. y = f n)}"
+ shows "l' = l"
+proof(rule ccontr)
+ def e \<equiv> "dist l' l"
+ assume "l' \<noteq> l" hence "e>0" unfolding dist_nz e_def by auto
+ then obtain N::nat where N:"\<forall>n\<ge>N. dist (f n) l < e / 2"
+ using assms(2)[unfolded Lim_sequentially, THEN spec[where x="e/2"]] by auto
+ 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}))"
+ have "d>0" using `e>0` unfolding d_def e_def using zero_le_dist[of _ l', unfolded order_le_less] by auto
+ 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
+ have "k\<ge>N" using k(1)[unfolded dist_nz] using k(2)[unfolded d_def]
+ by force
+ 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
+ thus False unfolding e_def by auto
+qed
+
+lemma bolzano_weierstrass_imp_closed:
+ fixes s :: "'a::metric_space set" (* TODO: can this be generalized? *)
+ assumes "\<forall>t. infinite t \<and> t \<subseteq> s --> (\<exists>x \<in> s. x islimpt t)"
+ shows "closed s"
+proof-
+ { fix x l assume as: "\<forall>n::nat. x n \<in> s" "(x ---> l) sequentially"
+ hence "l \<in> s"
+ proof(cases "\<forall>n. x n \<noteq> l")
+ case False thus "l\<in>s" using as(1) by auto
+ next
+ case True note cas = this
+ with as(2) have "infinite {y. \<exists>n. y = x n}" using sequence_infinite_lemma[of x l] by auto
+ 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
+ thus "l\<in>s" using sequence_unique_limpt[of x l l'] using as cas by auto
+ qed }
+ thus ?thesis unfolding closed_sequential_limits by fast
+qed
+
+text{* Hence express everything as an equivalence. *}
+
+lemma compact_eq_heine_borel:
+ fixes s :: "'a::heine_borel set"
+ shows "compact s \<longleftrightarrow>
+ (\<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')))" (is "?lhs = ?rhs")
+proof
+ assume ?lhs thus ?rhs using compact_imp_heine_borel[of s] by blast
+next
+ assume ?rhs
+ hence "\<forall>t. infinite t \<and> t \<subseteq> s \<longrightarrow> (\<exists>x\<in>s. x islimpt t)"
+ by (blast intro: heine_borel_imp_bolzano_weierstrass[of s])
+ thus ?lhs using bolzano_weierstrass_imp_bounded[of s] bolzano_weierstrass_imp_closed[of s] bounded_closed_imp_compact[of s] by blast
+qed
+
+lemma compact_eq_bolzano_weierstrass:
+ fixes s :: "'a::heine_borel set"
+ shows "compact s \<longleftrightarrow> (\<forall>t. infinite t \<and> t \<subseteq> s --> (\<exists>x \<in> s. x islimpt t))" (is "?lhs = ?rhs")
+proof
+ assume ?lhs thus ?rhs unfolding compact_eq_heine_borel using heine_borel_imp_bolzano_weierstrass[of s] by auto
+next
+ assume ?rhs thus ?lhs using bolzano_weierstrass_imp_bounded bolzano_weierstrass_imp_closed bounded_closed_imp_compact by auto
+qed
+
+lemma compact_eq_bounded_closed:
+ fixes s :: "'a::heine_borel set"
+ shows "compact s \<longleftrightarrow> bounded s \<and> closed s" (is "?lhs = ?rhs")
+proof
+ assume ?lhs thus ?rhs unfolding compact_eq_bolzano_weierstrass using bolzano_weierstrass_imp_bounded bolzano_weierstrass_imp_closed by auto
+next
+ assume ?rhs thus ?lhs using bounded_closed_imp_compact by auto
+qed
+
+lemma compact_imp_bounded:
+ fixes s :: "'a::metric_space set"
+ shows "compact s ==> bounded s"
+proof -
+ assume "compact s"
+ 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')"
+ by (rule compact_imp_heine_borel)
+ hence "\<forall>t. infinite t \<and> t \<subseteq> s \<longrightarrow> (\<exists>x \<in> s. x islimpt t)"
+ using heine_borel_imp_bolzano_weierstrass[of s] by auto
+ thus "bounded s"
+ by (rule bolzano_weierstrass_imp_bounded)
+qed
+
+lemma compact_imp_closed:
+ fixes s :: "'a::metric_space set"
+ shows "compact s ==> closed s"
+proof -
+ assume "compact s"
+ 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')"
+ by (rule compact_imp_heine_borel)
+ hence "\<forall>t. infinite t \<and> t \<subseteq> s \<longrightarrow> (\<exists>x \<in> s. x islimpt t)"
+ using heine_borel_imp_bolzano_weierstrass[of s] by auto
+ thus "closed s"
+ by (rule bolzano_weierstrass_imp_closed)
+qed
+
+text{* In particular, some common special cases. *}
+
+lemma compact_empty[simp]:
+ "compact {}"
+ unfolding compact_def
+ by simp
+
+(* TODO: can any of the next 3 lemmas be generalized to metric spaces? *)
+
+ (* FIXME : Rename *)
+lemma compact_union[intro]:
+ fixes s t :: "'a::heine_borel set"
+ shows "compact s \<Longrightarrow> compact t ==> compact (s \<union> t)"
+ unfolding compact_eq_bounded_closed
+ using bounded_Un[of s t]
+ using closed_Un[of s t]
+ by simp
+
+lemma compact_inter[intro]:
+ fixes s t :: "'a::heine_borel set"
+ shows "compact s \<Longrightarrow> compact t ==> compact (s \<inter> t)"
+ unfolding compact_eq_bounded_closed
+ using bounded_Int[of s t]
+ using closed_Int[of s t]
+ by simp
+
+lemma compact_inter_closed[intro]:
+ fixes s t :: "'a::heine_borel set"
+ shows "compact s \<Longrightarrow> closed t ==> compact (s \<inter> t)"
+ unfolding compact_eq_bounded_closed
+ using closed_Int[of s t]
+ using bounded_subset[of "s \<inter> t" s]
+ by blast
+
+lemma closed_inter_compact[intro]:
+ fixes s t :: "'a::heine_borel set"
+ shows "closed s \<Longrightarrow> compact t ==> compact (s \<inter> t)"
+proof-
+ assume "closed s" "compact t"
+ moreover
+ have "s \<inter> t = t \<inter> s" by auto ultimately
+ show ?thesis
+ using compact_inter_closed[of t s]
+ by auto
+qed
+
+lemma closed_sing [simp]:
+ fixes a :: "'a::metric_space"
+ shows "closed {a}"
+ apply (clarsimp simp add: closed_def open_dist)
+ apply (rule ccontr)
+ apply (drule_tac x="dist x a" in spec)
+ apply (simp add: dist_nz dist_commute)
+ done
+
+lemma finite_imp_closed:
+ fixes s :: "'a::metric_space set"
+ shows "finite s ==> closed s"
+proof (induct set: finite)
+ case empty show "closed {}" by simp
+next
+ case (insert x F)
+ hence "closed ({x} \<union> F)" by (simp only: closed_Un closed_sing)
+ thus "closed (insert x F)" by simp
+qed
+
+lemma finite_imp_compact:
+ fixes s :: "'a::heine_borel set"
+ shows "finite s ==> compact s"
+ unfolding compact_eq_bounded_closed
+ using finite_imp_closed finite_imp_bounded
+ by blast
+
+lemma compact_sing [simp]: "compact {a}"
+ unfolding compact_def o_def subseq_def
+ by (auto simp add: tendsto_const)
+
+lemma compact_cball[simp]:
+ fixes x :: "'a::heine_borel"
+ shows "compact(cball x e)"
+ using compact_eq_bounded_closed bounded_cball closed_cball
+ by blast
+
+lemma compact_frontier_bounded[intro]:
+ fixes s :: "'a::heine_borel set"
+ shows "bounded s ==> compact(frontier s)"
+ unfolding frontier_def
+ using compact_eq_bounded_closed
+ by blast
+
+lemma compact_frontier[intro]:
+ fixes s :: "'a::heine_borel set"
+ shows "compact s ==> compact (frontier s)"
+ using compact_eq_bounded_closed compact_frontier_bounded
+ by blast
+
+lemma frontier_subset_compact:
+ fixes s :: "'a::heine_borel set"
+ shows "compact s ==> frontier s \<subseteq> s"
+ using frontier_subset_closed compact_eq_bounded_closed
+ by blast
+
+lemma open_delete:
+ fixes s :: "'a::metric_space set"
+ shows "open s ==> open(s - {x})"
+ using open_Diff[of s "{x}"] closed_sing
+ by blast
+
+text{* Finite intersection property. I could make it an equivalence in fact. *}
+
+lemma compact_imp_fip:
+ fixes s :: "'a::heine_borel set"
+ assumes "compact s" "\<forall>t \<in> f. closed t"
+ "\<forall>f'. finite f' \<and> f' \<subseteq> f --> (s \<inter> (\<Inter> f') \<noteq> {})"
+ shows "s \<inter> (\<Inter> f) \<noteq> {}"
+proof
+ assume as:"s \<inter> (\<Inter> f) = {}"
+ hence "s \<subseteq> \<Union>op - UNIV ` f" by auto
+ moreover have "Ball (op - UNIV ` f) open" using open_Diff closed_Diff using assms(2) by auto
+ 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
+ hence "finite (op - UNIV ` f') \<and> op - UNIV ` f' \<subseteq> f" by(auto simp add: Diff_Diff_Int)
+ hence "s \<inter> \<Inter>op - UNIV ` f' \<noteq> {}" using assms(3)[THEN spec[where x="op - UNIV ` f'"]] by auto
+ thus False using f'(3) unfolding subset_eq and Union_iff by blast
+qed
+
+subsection{* Bounded closed nest property (proof does not use Heine-Borel). *}
+
+lemma bounded_closed_nest:
+ assumes "\<forall>n. closed(s n)" "\<forall>n. (s n \<noteq> {})"
+ "(\<forall>m n. m \<le> n --> s n \<subseteq> s m)" "bounded(s 0)"
+ shows "\<exists>a::'a::heine_borel. \<forall>n::nat. a \<in> s(n)"
+proof-
+ 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
+ from assms(4,1) have *:"compact (s 0)" using bounded_closed_imp_compact[of "s 0"] by auto
+
+ then obtain l r where lr:"l\<in>s 0" "subseq r" "((x \<circ> r) ---> l) sequentially"
+ unfolding compact_def apply(erule_tac x=x in allE) using x using assms(3) by blast
+
+ { fix n::nat
+ { fix e::real assume "e>0"
+ with lr(3) obtain N where N:"\<forall>m\<ge>N. dist ((x \<circ> r) m) l < e" unfolding Lim_sequentially by auto
+ hence "dist ((x \<circ> r) (max N n)) l < e" by auto
+ moreover
+ have "r (max N n) \<ge> n" using lr(2) using subseq_bigger[of r "max N n"] by auto
+ hence "(x \<circ> r) (max N n) \<in> s n"
+ using x apply(erule_tac x=n in allE)
+ using x apply(erule_tac x="r (max N n)" in allE)
+ using assms(3) apply(erule_tac x=n in allE)apply( erule_tac x="r (max N n)" in allE) by auto
+ ultimately have "\<exists>y\<in>s n. dist y l < e" by auto
+ }
+ hence "l \<in> s n" using closed_approachable[of "s n" l] assms(1) by blast
+ }
+ thus ?thesis by auto
+qed
+
+text{* Decreasing case does not even need compactness, just completeness. *}
+
+lemma decreasing_closed_nest:
+ assumes "\<forall>n. closed(s n)"
+ "\<forall>n. (s n \<noteq> {})"
+ "\<forall>m n. m \<le> n --> s n \<subseteq> s m"
+ "\<forall>e>0. \<exists>n. \<forall>x \<in> (s n). \<forall> y \<in> (s n). dist x y < e"
+ shows "\<exists>a::'a::heine_borel. \<forall>n::nat. a \<in> s n"
+proof-
+ have "\<forall>n. \<exists> x. x\<in>s n" using assms(2) by auto
+ hence "\<exists>t. \<forall>n. t n \<in> s n" using choice[of "\<lambda> n x. x \<in> s n"] by auto
+ then obtain t where t: "\<forall>n. t n \<in> s n" by auto
+ { fix e::real assume "e>0"
+ then obtain N where N:"\<forall>x\<in>s N. \<forall>y\<in>s N. dist x y < e" using assms(4) by auto
+ { fix m n ::nat assume "N \<le> m \<and> N \<le> n"
+ hence "t m \<in> s N" "t n \<in> s N" using assms(3) t unfolding subset_eq t by blast+
+ hence "dist (t m) (t n) < e" using N by auto
+ }
+ hence "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (t m) (t n) < e" by auto
+ }
+ hence "Cauchy t" unfolding cauchy_def by auto
+ then obtain l where l:"(t ---> l) sequentially" using complete_univ unfolding complete_def by auto
+ { fix n::nat
+ { fix e::real assume "e>0"
+ then obtain N::nat where N:"\<forall>n\<ge>N. dist (t n) l < e" using l[unfolded Lim_sequentially] by auto
+ 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
+ hence "\<exists>y\<in>s n. dist y l < e" apply(rule_tac x="t (max n N)" in bexI) using N by auto
+ }
+ hence "l \<in> s n" using closed_approachable[of "s n" l] assms(1) by auto
+ }
+ then show ?thesis by auto
+qed
+
+text{* Strengthen it to the intersection actually being a singleton. *}
+
+lemma decreasing_closed_nest_sing:
+ assumes "\<forall>n. closed(s n)"
+ "\<forall>n. s n \<noteq> {}"
+ "\<forall>m n. m \<le> n --> s n \<subseteq> s m"
+ "\<forall>e>0. \<exists>n. \<forall>x \<in> (s n). \<forall> y\<in>(s n). dist x y < e"
+ shows "\<exists>a::'a::heine_borel. \<Inter> {t. (\<exists>n::nat. t = s n)} = {a}"
+proof-
+ obtain a where a:"\<forall>n. a \<in> s n" using decreasing_closed_nest[of s] using assms by auto
+ { fix b assume b:"b \<in> \<Inter>{t. \<exists>n. t = s n}"
+ { fix e::real assume "e>0"
+ hence "dist a b < e" using assms(4 )using b using a by blast
+ }
+ hence "dist a b = 0" by (metis dist_eq_0_iff dist_nz real_less_def)
+ }
+ with a have "\<Inter>{t. \<exists>n. t = s n} = {a}" by auto
+ thus ?thesis by auto
+qed
+
+text{* Cauchy-type criteria for uniform convergence. *}
+
+lemma uniformly_convergent_eq_cauchy: fixes s::"nat \<Rightarrow> 'b \<Rightarrow> 'a::heine_borel" shows
+ "(\<exists>l. \<forall>e>0. \<exists>N. \<forall>n x. N \<le> n \<and> P x --> dist(s n x)(l x) < e) \<longleftrightarrow>
+ (\<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")
+proof(rule)
+ assume ?lhs
+ 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
+ { fix e::real assume "e>0"
+ 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
+ { fix n m::nat and x::"'b" assume "N \<le> m \<and> N \<le> n \<and> P x"
+ hence "dist (s m x) (s n x) < e"
+ using N[THEN spec[where x=m], THEN spec[where x=x]]
+ using N[THEN spec[where x=n], THEN spec[where x=x]]
+ using dist_triangle_half_l[of "s m x" "l x" e "s n x"] by auto }
+ 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 }
+ thus ?rhs by auto
+next
+ assume ?rhs
+ 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
+ then obtain l where l:"\<forall>x. P x \<longrightarrow> ((\<lambda>n. s n x) ---> l x) sequentially" unfolding convergent_eq_cauchy[THEN sym]
+ using choice[of "\<lambda>x l. P x \<longrightarrow> ((\<lambda>n. s n x) ---> l) sequentially"] by auto
+ { fix e::real assume "e>0"
+ 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"
+ using `?rhs`[THEN spec[where x="e/2"]] by auto
+ { fix x assume "P x"
+ then obtain M where M:"\<forall>n\<ge>M. dist (s n x) (l x) < e/2"
+ using l[THEN spec[where x=x], unfolded Lim_sequentially] using `e>0` by(auto elim!: allE[where x="e/2"])
+ fix n::nat assume "n\<ge>N"
+ 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]]
+ 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) }
+ hence "\<exists>N. \<forall>n x. N \<le> n \<and> P x \<longrightarrow> dist(s n x)(l x) < e" by auto }
+ thus ?lhs by auto
+qed
+
+lemma uniformly_cauchy_imp_uniformly_convergent:
+ fixes s :: "nat \<Rightarrow> 'a \<Rightarrow> 'b::heine_borel"
+ 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"
+ "\<forall>x. P x --> (\<forall>e>0. \<exists>N. \<forall>n. N \<le> n --> dist(s n x)(l x) < e)"
+ shows "\<forall>e>0. \<exists>N. \<forall>n x. N \<le> n \<and> P x --> dist(s n x)(l x) < e"
+proof-
+ 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"
+ using assms(1) unfolding uniformly_convergent_eq_cauchy[THEN sym] by auto
+ moreover
+ { fix x assume "P x"
+ hence "l x = l' x" using Lim_unique[OF trivial_limit_sequentially, of "\<lambda>n. s n x" "l x" "l' x"]
+ using l and assms(2) unfolding Lim_sequentially by blast }
+ ultimately show ?thesis by auto
+qed
+
+subsection{* Define continuity over a net to take in restrictions of the set. *}
+
+definition
+ continuous :: "'a::t2_space net \<Rightarrow> ('a \<Rightarrow> 'b::topological_space) \<Rightarrow> bool" where
+ "continuous net f \<longleftrightarrow> (f ---> f(netlimit net)) net"
+
+lemma continuous_trivial_limit:
+ "trivial_limit net ==> continuous net f"
+ unfolding continuous_def tendsto_def trivial_limit_eq by auto
+
+lemma continuous_within: "continuous (at x within s) f \<longleftrightarrow> (f ---> f(x)) (at x within s)"
+ unfolding continuous_def
+ unfolding tendsto_def
+ using netlimit_within[of x s]
+ by (cases "trivial_limit (at x within s)") (auto simp add: trivial_limit_eventually)
+
+lemma continuous_at: "continuous (at x) f \<longleftrightarrow> (f ---> f(x)) (at x)"
+ using continuous_within [of x UNIV f] by (simp add: within_UNIV)
+
+lemma continuous_at_within:
+ assumes "continuous (at x) f" shows "continuous (at x within s) f"
+ using assms unfolding continuous_at continuous_within
+ by (rule Lim_at_within)
+
+text{* Derive the epsilon-delta forms, which we often use as "definitions" *}
+
+lemma continuous_within_eps_delta:
+ "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)"
+ unfolding continuous_within and Lim_within
+ apply auto unfolding dist_nz[THEN sym] apply(auto elim!:allE) apply(rule_tac x=d in exI) by auto
+
+lemma continuous_at_eps_delta: "continuous (at x) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0.
+ \<forall>x'. dist x' x < d --> dist(f x')(f x) < e)"
+ using continuous_within_eps_delta[of x UNIV f]
+ unfolding within_UNIV by blast
+
+text{* Versions in terms of open balls. *}
+
+lemma continuous_within_ball:
+ "continuous (at x within s) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0.
+ f ` (ball x d \<inter> s) \<subseteq> ball (f x) e)" (is "?lhs = ?rhs")
+proof
+ assume ?lhs
+ { fix e::real assume "e>0"
+ 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 `?lhs`[unfolded continuous_within Lim_within] by auto
+ { fix y assume "y\<in>f ` (ball x d \<inter> s)"
+ hence "y \<in> ball (f x) e" using d(2) unfolding dist_nz[THEN sym]
+ apply (auto simp add: dist_commute mem_ball) apply(erule_tac x=xa in ballE) apply auto using `e>0` by auto
+ }
+ 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) }
+ thus ?rhs by auto
+next
+ assume ?rhs thus ?lhs unfolding continuous_within Lim_within ball_def subset_eq
+ apply (auto simp add: dist_commute) apply(erule_tac x=e in allE) by auto
+qed
+
+lemma continuous_at_ball:
+ "continuous (at x) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0. f ` (ball x d) \<subseteq> ball (f x) e)" (is "?lhs = ?rhs")
+proof
+ assume ?lhs thus ?rhs unfolding continuous_at Lim_at subset_eq Ball_def Bex_def image_iff mem_ball
+ 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)
+ unfolding dist_nz[THEN sym] by auto
+next
+ assume ?rhs thus ?lhs unfolding continuous_at Lim_at subset_eq Ball_def Bex_def image_iff mem_ball
+ 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)
+qed
+
+text{* For setwise continuity, just start from the epsilon-delta definitions. *}
+
+definition
+ continuous_on :: "'a::metric_space set \<Rightarrow> ('a \<Rightarrow> 'b::metric_space) \<Rightarrow> bool" where
+ "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)"
+
+
+definition
+ uniformly_continuous_on ::
+ "'a::metric_space set \<Rightarrow> ('a \<Rightarrow> 'b::metric_space) \<Rightarrow> bool" where
+ "uniformly_continuous_on s f \<longleftrightarrow>
+ (\<forall>e>0. \<exists>d>0. \<forall>x\<in>s. \<forall> x'\<in>s. dist x' x < d
+ --> dist (f x') (f x) < e)"
+
+text{* Some simple consequential lemmas. *}
+
+lemma uniformly_continuous_imp_continuous:
+ " uniformly_continuous_on s f ==> continuous_on s f"
+ unfolding uniformly_continuous_on_def continuous_on_def by blast
+
+lemma continuous_at_imp_continuous_within:
+ "continuous (at x) f ==> continuous (at x within s) f"
+ unfolding continuous_within continuous_at using Lim_at_within by auto
+
+lemma continuous_at_imp_continuous_on: assumes "(\<forall>x \<in> s. continuous (at x) f)"
+ shows "continuous_on s f"
+proof(simp add: continuous_at continuous_on_def, rule, rule, rule)
+ fix x and e::real assume "x\<in>s" "e>0"
+ hence "eventually (\<lambda>xa. dist (f xa) (f x) < e) (at x)" using assms unfolding continuous_at tendsto_iff by auto
+ 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
+ { fix x' assume "\<not> 0 < dist x' x"
+ hence "x=x'"
+ using dist_nz[of x' x] by auto
+ hence "dist (f x') (f x) < e" using `e>0` by auto
+ }
+ thus "\<exists>d>0. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e" using d by auto
+qed
+
+lemma continuous_on_eq_continuous_within:
+ "continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. continuous (at x within s) f)" (is "?lhs = ?rhs")
+proof
+ assume ?rhs
+ { fix x assume "x\<in>s"
+ fix e::real assume "e>0"
+ assume "\<exists>d>0. \<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e"
+ 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
+ { fix x' assume as:"x'\<in>s" "dist x' x < d"
+ 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) }
+ hence "\<exists>d>0. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e" using `d>0` by auto
+ }
+ thus ?lhs using `?rhs` unfolding continuous_on_def continuous_within Lim_within by auto
+next
+ assume ?lhs
+ thus ?rhs unfolding continuous_on_def continuous_within Lim_within by blast
+qed
+
+lemma continuous_on:
+ "continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. (f ---> f(x)) (at x within s))"
+ by (auto simp add: continuous_on_eq_continuous_within continuous_within)
+
+lemma continuous_on_eq_continuous_at:
+ "open s ==> (continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. continuous (at x) f))"
+ by (auto simp add: continuous_on continuous_at Lim_within_open)
+
+lemma continuous_within_subset:
+ "continuous (at x within s) f \<Longrightarrow> t \<subseteq> s
+ ==> continuous (at x within t) f"
+ unfolding continuous_within by(metis Lim_within_subset)
+
+lemma continuous_on_subset:
+ "continuous_on s f \<Longrightarrow> t \<subseteq> s ==> continuous_on t f"
+ unfolding continuous_on by (metis subset_eq Lim_within_subset)
+
+lemma continuous_on_interior:
+ "continuous_on s f \<Longrightarrow> x \<in> interior s ==> continuous (at x) f"
+unfolding interior_def
+apply simp
+by (meson continuous_on_eq_continuous_at continuous_on_subset)
+
+lemma continuous_on_eq:
+ "(\<forall>x \<in> s. f x = g x) \<Longrightarrow> continuous_on s f
+ ==> continuous_on s g"
+ by (simp add: continuous_on_def)
+
+text{* Characterization of various kinds of continuity in terms of sequences. *}
+
+(* \<longrightarrow> could be generalized, but \<longleftarrow> requires metric space *)
+lemma continuous_within_sequentially:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
+ shows "continuous (at a within s) f \<longleftrightarrow>
+ (\<forall>x. (\<forall>n::nat. x n \<in> s) \<and> (x ---> a) sequentially
+ --> ((f o x) ---> f a) sequentially)" (is "?lhs = ?rhs")
+proof
+ assume ?lhs
+ { 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"
+ fix e::real assume "e>0"
+ 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
+ from x(2) `d>0` obtain N where N:"\<forall>n\<ge>N. dist (x n) a < d" by auto
+ hence "\<exists>N. \<forall>n\<ge>N. dist ((f \<circ> x) n) (f a) < e"
+ apply(rule_tac x=N in exI) using N d apply auto using x(1)
+ apply(erule_tac x=n in allE) apply(erule_tac x=n in allE)
+ apply(erule_tac x="x n" in ballE) apply auto unfolding dist_nz[THEN sym] apply auto using `e>0` by auto
+ }
+ thus ?rhs unfolding continuous_within unfolding Lim_sequentially by simp
+next
+ assume ?rhs
+ { fix e::real assume "e>0"
+ 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)"
+ 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
+ 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)"
+ 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
+ { fix d::real assume "d>0"
+ 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
+ then obtain N::nat where N:"inverse (real (N + 1)) < d" by auto
+ { fix n::nat assume n:"n\<ge>N"
+ hence "dist (x (inverse (real (n + 1)))) a < inverse (real (n + 1))" using x[THEN spec[where x="inverse (real (n + 1))"]] by auto
+ 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)
+ ultimately have "dist (x (inverse (real (n + 1)))) a < d" by auto
+ }
+ hence "\<exists>N::nat. \<forall>n\<ge>N. dist (x (inverse (real (n + 1)))) a < d" by auto
+ }
+ 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
+ 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
+ hence "False" apply(erule_tac x=e in allE) using `e>0` using x by auto
+ }
+ thus ?lhs unfolding continuous_within unfolding Lim_within unfolding Lim_sequentially by blast
+qed
+
+lemma continuous_at_sequentially:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
+ shows "continuous (at a) f \<longleftrightarrow> (\<forall>x. (x ---> a) sequentially
+ --> ((f o x) ---> f a) sequentially)"
+ using continuous_within_sequentially[of a UNIV f] unfolding within_UNIV by auto
+
+lemma continuous_on_sequentially:
+ "continuous_on s f \<longleftrightarrow> (\<forall>x. \<forall>a \<in> s. (\<forall>n. x(n) \<in> s) \<and> (x ---> a) sequentially
+ --> ((f o x) ---> f(a)) sequentially)" (is "?lhs = ?rhs")
+proof
+ assume ?rhs thus ?lhs using continuous_within_sequentially[of _ s f] unfolding continuous_on_eq_continuous_within by auto
+next
+ assume ?lhs thus ?rhs unfolding continuous_on_eq_continuous_within using continuous_within_sequentially[of _ s f] by auto
+qed
+
+lemma uniformly_continuous_on_sequentially:
+ fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
+ shows "uniformly_continuous_on s f \<longleftrightarrow> (\<forall>x y. (\<forall>n. x n \<in> s) \<and> (\<forall>n. y n \<in> s) \<and>
+ ((\<lambda>n. x n - y n) ---> 0) sequentially
+ \<longrightarrow> ((\<lambda>n. f(x n) - f(y n)) ---> 0) sequentially)" (is "?lhs = ?rhs")
+proof
+ assume ?lhs
+ { 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"
+ { fix e::real assume "e>0"
+ 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"
+ using `?lhs`[unfolded uniformly_continuous_on_def, THEN spec[where x=e]] by auto
+ 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
+ { fix n assume "n\<ge>N"
+ hence "norm (f (x n) - f (y n) - 0) < e"
+ 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
+ unfolding dist_commute and dist_norm by simp }
+ hence "\<exists>N. \<forall>n\<ge>N. norm (f (x n) - f (y n) - 0) < e" by auto }
+ hence "((\<lambda>n. f(x n) - f(y n)) ---> 0) sequentially" unfolding Lim_sequentially and dist_norm by auto }
+ thus ?rhs by auto
+next
+ assume ?rhs
+ { assume "\<not> ?lhs"
+ 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
+ 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"
+ 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
+ by (auto simp add: dist_commute)
+ def x \<equiv> "\<lambda>n::nat. fst (fa (inverse (real n + 1)))"
+ def y \<equiv> "\<lambda>n::nat. snd (fa (inverse (real n + 1)))"
+ 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"
+ unfolding x_def and y_def using fa by auto
+ have 1:"\<And>(x::'a) y. dist (x - y) 0 = dist x y" unfolding dist_norm by auto
+ have 2:"\<And>(x::'b) y. dist (x - y) 0 = dist x y" unfolding dist_norm by auto
+ { fix e::real assume "e>0"
+ 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
+ { fix n::nat assume "n\<ge>N"
+ hence "inverse (real n + 1) < inverse (real N)" using real_of_nat_ge_zero and `N\<noteq>0` by auto
+ also have "\<dots> < e" using N by auto
+ finally have "inverse (real n + 1) < e" by auto
+ hence "dist (x n - y n) 0 < e" unfolding 1 using xy0[THEN spec[where x=n]] by auto }
+ hence "\<exists>N. \<forall>n\<ge>N. dist (x n - y n) 0 < e" by auto }
+ 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
+ hence False unfolding 2 using fxy and `e>0` by auto }
+ thus ?lhs unfolding uniformly_continuous_on_def by blast
+qed
+
+text{* The usual transformation theorems. *}
+
+lemma continuous_transform_within:
+ fixes f g :: "'a::metric_space \<Rightarrow> 'b::metric_space"
+ assumes "0 < d" "x \<in> s" "\<forall>x' \<in> s. dist x' x < d --> f x' = g x'"
+ "continuous (at x within s) f"
+ shows "continuous (at x within s) g"
+proof-
+ { fix e::real assume "e>0"
+ 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
+ { fix x' assume "x'\<in>s" "0 < dist x' x" "dist x' x < (min d d')"
+ hence "dist (f x') (g x) < e" using assms(2,3) apply(erule_tac x=x in ballE) using d' by auto }
+ 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
+ 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 }
+ hence "(f ---> g x) (at x within s)" unfolding Lim_within using assms(1) by auto
+ thus ?thesis unfolding continuous_within using Lim_transform_within[of d s x f g "g x"] using assms by blast
+qed
+
+lemma continuous_transform_at:
+ fixes f g :: "'a::metric_space \<Rightarrow> 'b::metric_space"
+ assumes "0 < d" "\<forall>x'. dist x' x < d --> f x' = g x'"
+ "continuous (at x) f"
+ shows "continuous (at x) g"
+proof-
+ { fix e::real assume "e>0"
+ 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
+ { fix x' assume "0 < dist x' x" "dist x' x < (min d d')"
+ hence "dist (f x') (g x) < e" using assms(2) apply(erule_tac x=x in allE) using d' by auto
+ }
+ hence "\<forall>xa. 0 < dist xa x \<and> dist xa x < (min d d') \<longrightarrow> dist (f xa) (g x) < e" by blast
+ 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
+ }
+ hence "(f ---> g x) (at x)" unfolding Lim_at using assms(1) by auto
+ thus ?thesis unfolding continuous_at using Lim_transform_at[of d x f g "g x"] using assms by blast
+qed
+
+text{* Combination results for pointwise continuity. *}
+
+lemma continuous_const: "continuous net (\<lambda>x. c)"
+ by (auto simp add: continuous_def Lim_const)
+
+lemma continuous_cmul:
+ fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
+ shows "continuous net f ==> continuous net (\<lambda>x. c *\<^sub>R f x)"
+ by (auto simp add: continuous_def Lim_cmul)
+
+lemma continuous_neg:
+ fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
+ shows "continuous net f ==> continuous net (\<lambda>x. -(f x))"
+ by (auto simp add: continuous_def Lim_neg)
+
+lemma continuous_add:
+ fixes f g :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
+ shows "continuous net f \<Longrightarrow> continuous net g \<Longrightarrow> continuous net (\<lambda>x. f x + g x)"
+ by (auto simp add: continuous_def Lim_add)
+
+lemma continuous_sub:
+ fixes f g :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
+ shows "continuous net f \<Longrightarrow> continuous net g \<Longrightarrow> continuous net (\<lambda>x. f x - g x)"
+ by (auto simp add: continuous_def Lim_sub)
+
+text{* Same thing for setwise continuity. *}
+
+lemma continuous_on_const:
+ "continuous_on s (\<lambda>x. c)"
+ unfolding continuous_on_eq_continuous_within using continuous_const by blast
+
+lemma continuous_on_cmul:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
+ shows "continuous_on s f ==> continuous_on s (\<lambda>x. c *\<^sub>R (f x))"
+ unfolding continuous_on_eq_continuous_within using continuous_cmul by blast
+
+lemma continuous_on_neg:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
+ shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. - f x)"
+ unfolding continuous_on_eq_continuous_within using continuous_neg by blast
+
+lemma continuous_on_add:
+ fixes f g :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
+ shows "continuous_on s f \<Longrightarrow> continuous_on s g
+ \<Longrightarrow> continuous_on s (\<lambda>x. f x + g x)"
+ unfolding continuous_on_eq_continuous_within using continuous_add by blast
+
+lemma continuous_on_sub:
+ fixes f g :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
+ shows "continuous_on s f \<Longrightarrow> continuous_on s g
+ \<Longrightarrow> continuous_on s (\<lambda>x. f x - g x)"
+ unfolding continuous_on_eq_continuous_within using continuous_sub by blast
+
+text{* Same thing for uniform continuity, using sequential formulations. *}
+
+lemma uniformly_continuous_on_const:
+ "uniformly_continuous_on s (\<lambda>x. c)"
+ unfolding uniformly_continuous_on_def by simp
+
+lemma uniformly_continuous_on_cmul:
+ fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
+ (* FIXME: generalize 'a to metric_space *)
+ assumes "uniformly_continuous_on s f"
+ shows "uniformly_continuous_on s (\<lambda>x. c *\<^sub>R f(x))"
+proof-
+ { fix x y assume "((\<lambda>n. f (x n) - f (y n)) ---> 0) sequentially"
+ hence "((\<lambda>n. c *\<^sub>R f (x n) - c *\<^sub>R f (y n)) ---> 0) sequentially"
+ using Lim_cmul[of "(\<lambda>n. f (x n) - f (y n))" 0 sequentially c]
+ unfolding scaleR_zero_right scaleR_right_diff_distrib by auto
+ }
+ thus ?thesis using assms unfolding uniformly_continuous_on_sequentially by auto
+qed
+
+lemma dist_minus:
+ fixes x y :: "'a::real_normed_vector"
+ shows "dist (- x) (- y) = dist x y"
+ unfolding dist_norm minus_diff_minus norm_minus_cancel ..
+
+lemma uniformly_continuous_on_neg:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
+ shows "uniformly_continuous_on s f
+ ==> uniformly_continuous_on s (\<lambda>x. -(f x))"
+ unfolding uniformly_continuous_on_def dist_minus .
+
+lemma uniformly_continuous_on_add:
+ fixes f g :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector" (* FIXME: generalize 'a *)
+ assumes "uniformly_continuous_on s f" "uniformly_continuous_on s g"
+ shows "uniformly_continuous_on s (\<lambda>x. f x + g x)"
+proof-
+ { fix x y assume "((\<lambda>n. f (x n) - f (y n)) ---> 0) sequentially"
+ "((\<lambda>n. g (x n) - g (y n)) ---> 0) sequentially"
+ hence "((\<lambda>xa. f (x xa) - f (y xa) + (g (x xa) - g (y xa))) ---> 0 + 0) sequentially"
+ 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
+ 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 }
+ thus ?thesis using assms unfolding uniformly_continuous_on_sequentially by auto
+qed
+
+lemma uniformly_continuous_on_sub:
+ fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector" (* FIXME: generalize 'a *)
+ shows "uniformly_continuous_on s f \<Longrightarrow> uniformly_continuous_on s g
+ ==> uniformly_continuous_on s (\<lambda>x. f x - g x)"
+ unfolding ab_diff_minus
+ using uniformly_continuous_on_add[of s f "\<lambda>x. - g x"]
+ using uniformly_continuous_on_neg[of s g] by auto
+
+text{* Identity function is continuous in every sense. *}
+
+lemma continuous_within_id:
+ "continuous (at a within s) (\<lambda>x. x)"
+ unfolding continuous_within by (rule Lim_at_within [OF Lim_ident_at])
+
+lemma continuous_at_id:
+ "continuous (at a) (\<lambda>x. x)"
+ unfolding continuous_at by (rule Lim_ident_at)
+
+lemma continuous_on_id:
+ "continuous_on s (\<lambda>x. x)"
+ unfolding continuous_on Lim_within by auto
+
+lemma uniformly_continuous_on_id:
+ "uniformly_continuous_on s (\<lambda>x. x)"
+ unfolding uniformly_continuous_on_def by auto
+
+text{* Continuity of all kinds is preserved under composition. *}
+
+lemma continuous_within_compose:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
+ fixes g :: "'b::metric_space \<Rightarrow> 'c::metric_space"
+ assumes "continuous (at x within s) f" "continuous (at (f x) within f ` s) g"
+ shows "continuous (at x within s) (g o f)"
+proof-
+ { fix e::real assume "e>0"
+ 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
+ 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
+ { fix y assume as:"y\<in>s" "0 < dist y x" "dist y x < d'"
+ hence "dist (f y) (f x) < d" using d'[THEN bspec[where x=y]] by (auto simp add:dist_commute)
+ 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 }
+ 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 }
+ thus ?thesis unfolding continuous_within Lim_within by auto
+qed
+
+lemma continuous_at_compose:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
+ fixes g :: "'b::metric_space \<Rightarrow> 'c::metric_space"
+ assumes "continuous (at x) f" "continuous (at (f x)) g"
+ shows "continuous (at x) (g o f)"
+proof-
+ 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
+ thus ?thesis using assms(1) using continuous_within_compose[of x UNIV f g, unfolded within_UNIV] by auto
+qed
+
+lemma continuous_on_compose:
+ "continuous_on s f \<Longrightarrow> continuous_on (f ` s) g \<Longrightarrow> continuous_on s (g o f)"
+ unfolding continuous_on_eq_continuous_within using continuous_within_compose[of _ s f g] by auto
+
+lemma uniformly_continuous_on_compose:
+ assumes "uniformly_continuous_on s f" "uniformly_continuous_on (f ` s) g"
+ shows "uniformly_continuous_on s (g o f)"
+proof-
+ { fix e::real assume "e>0"
+ 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
+ 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
+ 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 }
+ thus ?thesis using assms unfolding uniformly_continuous_on_def by auto
+qed
+
+text{* Continuity in terms of open preimages. *}
+
+lemma continuous_at_open:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
+ 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")
+proof
+ assume ?lhs
+ { fix t assume as: "open t" "f x \<in> t"
+ then obtain e where "e>0" and e:"ball (f x) e \<subseteq> t" unfolding open_contains_ball by auto
+
+ 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
+
+ have "open (ball x d)" using open_ball by auto
+ moreover have "x \<in> ball x d" unfolding centre_in_ball using `d>0` by simp
+ moreover
+ { fix x' assume "x'\<in>ball x d" hence "f x' \<in> t"
+ using e[unfolded subset_eq Ball_def mem_ball, THEN spec[where x="f x'"]] d[THEN spec[where x=x']]
+ unfolding mem_ball apply (auto simp add: dist_commute)
+ unfolding dist_nz[THEN sym] using as(2) by auto }
+ hence "\<forall>x'\<in>ball x d. f x' \<in> t" by auto
+ ultimately have "\<exists>s. open s \<and> x \<in> s \<and> (\<forall>x'\<in>s. f x' \<in> t)"
+ apply(rule_tac x="ball x d" in exI) by simp }
+ thus ?rhs by auto
+next
+ assume ?rhs
+ { fix e::real assume "e>0"
+ 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"]]
+ unfolding centre_in_ball[of "f x" e, THEN sym] by auto
+ then obtain d where "d>0" and d:"ball x d \<subseteq> s" unfolding open_contains_ball by auto
+ { fix y assume "0 < dist y x \<and> dist y x < d"
+ hence "dist (f y) (f x) < e" using d[unfolded subset_eq Ball_def mem_ball, THEN spec[where x=y]]
+ using s(3)[THEN bspec[where x=y], unfolded mem_ball] by (auto simp add: dist_commute) }
+ 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 }
+ thus ?lhs unfolding continuous_at Lim_at by auto
+qed
+
+lemma continuous_on_open:
+ "continuous_on s f \<longleftrightarrow>
+ (\<forall>t. openin (subtopology euclidean (f ` s)) t
+ --> openin (subtopology euclidean s) {x \<in> s. f x \<in> t})" (is "?lhs = ?rhs")
+proof
+ assume ?lhs
+ { fix t assume as:"openin (subtopology euclidean (f ` s)) t"
+ have "{x \<in> s. f x \<in> t} \<subseteq> s" using as[unfolded openin_euclidean_subtopology_iff] by auto
+ moreover
+ { fix x assume as':"x\<in>{x \<in> s. f x \<in> t}"
+ 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
+ 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
+ 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) }
+ ultimately have "openin (subtopology euclidean s) {x \<in> s. f x \<in> t}" unfolding openin_euclidean_subtopology_iff by auto }
+ thus ?rhs unfolding continuous_on Lim_within using openin by auto
+next
+ assume ?rhs
+ { fix e::real and x assume "x\<in>s" "e>0"
+ { 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)"
+ hence "dist (f x') (f x) < e" using dist_triangle[of "f x'" "f x" "f xa"]
+ by (auto simp add: dist_commute) }
+ 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
+ apply(rule_tac x="e - dist (f xa) (f x)" in exI) using `e>0` by (auto simp add: dist_commute)
+ 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}"
+ using `?rhs`[unfolded openin_euclidean_subtopology_iff, THEN spec[where x="ball (f x) e \<inter> f ` s"]] by auto
+ 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) }
+ thus ?lhs unfolding continuous_on Lim_within by auto
+qed
+
+(* ------------------------------------------------------------------------- *)
+(* Similarly in terms of closed sets. *)
+(* ------------------------------------------------------------------------- *)
+
+lemma continuous_on_closed:
+ "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")
+proof
+ assume ?lhs
+ { fix t
+ have *:"s - {x \<in> s. f x \<in> f ` s - t} = {x \<in> s. f x \<in> t}" by auto
+ have **:"f ` s - (f ` s - (f ` s - t)) = f ` s - t" by auto
+ assume as:"closedin (subtopology euclidean (f ` s)) t"
+ hence "closedin (subtopology euclidean (f ` s)) (f ` s - (f ` s - t))" unfolding closedin_def topspace_euclidean_subtopology unfolding ** by auto
+ 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"]]
+ unfolding openin_closedin_eq topspace_euclidean_subtopology unfolding * by auto }
+ thus ?rhs by auto
+next
+ assume ?rhs
+ { fix t
+ have *:"s - {x \<in> s. f x \<in> f ` s - t} = {x \<in> s. f x \<in> t}" by auto
+ assume as:"openin (subtopology euclidean (f ` s)) t"
+ hence "openin (subtopology euclidean s) {x \<in> s. f x \<in> t}" using `?rhs`[THEN spec[where x="(f ` s) - t"]]
+ unfolding openin_closedin_eq topspace_euclidean_subtopology *[THEN sym] closedin_subtopology by auto }
+ thus ?lhs unfolding continuous_on_open by auto
+qed
+
+text{* Half-global and completely global cases. *}
+
+lemma continuous_open_in_preimage:
+ assumes "continuous_on s f" "open t"
+ shows "openin (subtopology euclidean s) {x \<in> s. f x \<in> t}"
+proof-
+ 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
+ have "openin (subtopology euclidean (f ` s)) (t \<inter> f ` s)"
+ using openin_open_Int[of t "f ` s", OF assms(2)] unfolding openin_open by auto
+ thus ?thesis using assms(1)[unfolded continuous_on_open, THEN spec[where x="t \<inter> f ` s"]] using * by auto
+qed
+
+lemma continuous_closed_in_preimage:
+ assumes "continuous_on s f" "closed t"
+ shows "closedin (subtopology euclidean s) {x \<in> s. f x \<in> t}"
+proof-
+ 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
+ have "closedin (subtopology euclidean (f ` s)) (t \<inter> f ` s)"
+ using closedin_closed_Int[of t "f ` s", OF assms(2)] unfolding Int_commute by auto
+ thus ?thesis
+ using assms(1)[unfolded continuous_on_closed, THEN spec[where x="t \<inter> f ` s"]] using * by auto
+qed
+
+lemma continuous_open_preimage:
+ assumes "continuous_on s f" "open s" "open t"
+ shows "open {x \<in> s. f x \<in> t}"
+proof-
+ obtain T where T: "open T" "{x \<in> s. f x \<in> t} = s \<inter> T"
+ using continuous_open_in_preimage[OF assms(1,3)] unfolding openin_open by auto
+ thus ?thesis using open_Int[of s T, OF assms(2)] by auto
+qed
+
+lemma continuous_closed_preimage:
+ assumes "continuous_on s f" "closed s" "closed t"
+ shows "closed {x \<in> s. f x \<in> t}"
+proof-
+ obtain T where T: "closed T" "{x \<in> s. f x \<in> t} = s \<inter> T"
+ using continuous_closed_in_preimage[OF assms(1,3)] unfolding closedin_closed by auto
+ thus ?thesis using closed_Int[of s T, OF assms(2)] by auto
+qed
+
+lemma continuous_open_preimage_univ:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
+ shows "\<forall>x. continuous (at x) f \<Longrightarrow> open s \<Longrightarrow> open {x. f x \<in> s}"
+ using continuous_open_preimage[of UNIV f s] open_UNIV continuous_at_imp_continuous_on by auto
+
+lemma continuous_closed_preimage_univ:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
+ shows "(\<forall>x. continuous (at x) f) \<Longrightarrow> closed s ==> closed {x. f x \<in> s}"
+ using continuous_closed_preimage[of UNIV f s] closed_UNIV continuous_at_imp_continuous_on by auto
+
+lemma continuous_open_vimage:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
+ shows "\<forall>x. continuous (at x) f \<Longrightarrow> open s \<Longrightarrow> open (f -` s)"
+ unfolding vimage_def by (rule continuous_open_preimage_univ)
+
+lemma continuous_closed_vimage:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
+ shows "\<forall>x. continuous (at x) f \<Longrightarrow> closed s \<Longrightarrow> closed (f -` s)"
+ unfolding vimage_def by (rule continuous_closed_preimage_univ)
+
+text{* Equality of continuous functions on closure and related results. *}
+
+lemma continuous_closed_in_preimage_constant:
+ "continuous_on s f ==> closedin (subtopology euclidean s) {x \<in> s. f x = a}"
+ using continuous_closed_in_preimage[of s f "{a}"] closed_sing by auto
+
+lemma continuous_closed_preimage_constant:
+ "continuous_on s f \<Longrightarrow> closed s ==> closed {x \<in> s. f x = a}"
+ using continuous_closed_preimage[of s f "{a}"] closed_sing by auto
+
+lemma continuous_constant_on_closure:
+ assumes "continuous_on (closure s) f"
+ "\<forall>x \<in> s. f x = a"
+ shows "\<forall>x \<in> (closure s). f x = a"
+ using continuous_closed_preimage_constant[of "closure s" f a]
+ assms closure_minimal[of s "{x \<in> closure s. f x = a}"] closure_subset unfolding subset_eq by auto
+
+lemma image_closure_subset:
+ assumes "continuous_on (closure s) f" "closed t" "(f ` s) \<subseteq> t"
+ shows "f ` (closure s) \<subseteq> t"
+proof-
+ have "s \<subseteq> {x \<in> closure s. f x \<in> t}" using assms(3) closure_subset by auto
+ moreover have "closed {x \<in> closure s. f x \<in> t}"
+ using continuous_closed_preimage[OF assms(1)] and assms(2) by auto
+ ultimately have "closure s = {x \<in> closure s . f x \<in> t}"
+ using closure_minimal[of s "{x \<in> closure s. f x \<in> t}"] by auto
+ thus ?thesis by auto
+qed
+
+lemma continuous_on_closure_norm_le:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
+ assumes "continuous_on (closure s) f" "\<forall>y \<in> s. norm(f y) \<le> b" "x \<in> (closure s)"
+ shows "norm(f x) \<le> b"
+proof-
+ have *:"f ` s \<subseteq> cball 0 b" using assms(2)[unfolded mem_cball_0[THEN sym]] by auto
+ show ?thesis
+ using image_closure_subset[OF assms(1) closed_cball[of 0 b] *] assms(3)
+ unfolding subset_eq apply(erule_tac x="f x" in ballE) by (auto simp add: dist_norm)
+qed
+
+text{* Making a continuous function avoid some value in a neighbourhood. *}
+
+lemma continuous_within_avoid:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
+ assumes "continuous (at x within s) f" "x \<in> s" "f x \<noteq> a"
+ shows "\<exists>e>0. \<forall>y \<in> s. dist x y < e --> f y \<noteq> a"
+proof-
+ 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"
+ using assms(1)[unfolded continuous_within Lim_within, THEN spec[where x="dist (f x) a"]] assms(3)[unfolded dist_nz] by auto
+ { fix y assume " y\<in>s" "dist x y < d"
+ hence "f y \<noteq> a" using d[THEN bspec[where x=y]] assms(3)[unfolded dist_nz]
+ apply auto unfolding dist_nz[THEN sym] by (auto simp add: dist_commute) }
+ thus ?thesis using `d>0` by auto
+qed
+
+lemma continuous_at_avoid:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
+ assumes "continuous (at x) f" "f x \<noteq> a"
+ shows "\<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> f y \<noteq> a"
+using assms using continuous_within_avoid[of x UNIV f a, unfolded within_UNIV] by auto
+
+lemma continuous_on_avoid:
+ assumes "continuous_on s f" "x \<in> s" "f x \<noteq> a"
+ shows "\<exists>e>0. \<forall>y \<in> s. dist x y < e \<longrightarrow> f y \<noteq> a"
+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
+
+lemma continuous_on_open_avoid:
+ assumes "continuous_on s f" "open s" "x \<in> s" "f x \<noteq> a"
+ shows "\<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> f y \<noteq> a"
+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
+
+text{* Proving a function is constant by proving open-ness of level set. *}
+
+lemma continuous_levelset_open_in_cases:
+ "connected s \<Longrightarrow> continuous_on s f \<Longrightarrow>
+ openin (subtopology euclidean s) {x \<in> s. f x = a}
+ ==> (\<forall>x \<in> s. f x \<noteq> a) \<or> (\<forall>x \<in> s. f x = a)"
+unfolding connected_clopen using continuous_closed_in_preimage_constant by auto
+
+lemma continuous_levelset_open_in:
+ "connected s \<Longrightarrow> continuous_on s f \<Longrightarrow>
+ openin (subtopology euclidean s) {x \<in> s. f x = a} \<Longrightarrow>
+ (\<exists>x \<in> s. f x = a) ==> (\<forall>x \<in> s. f x = a)"
+using continuous_levelset_open_in_cases[of s f ]
+by meson
+
+lemma continuous_levelset_open:
+ assumes "connected s" "continuous_on s f" "open {x \<in> s. f x = a}" "\<exists>x \<in> s. f x = a"
+ shows "\<forall>x \<in> s. f x = a"
+using continuous_levelset_open_in[OF assms(1,2), of a, unfolded openin_open] using assms (3,4) by auto
+
+text{* Some arithmetical combinations (more to prove). *}
+
+lemma open_scaling[intro]:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "c \<noteq> 0" "open s"
+ shows "open((\<lambda>x. c *\<^sub>R x) ` s)"
+proof-
+ { fix x assume "x \<in> s"
+ 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
+ have "e * abs c > 0" using assms(1)[unfolded zero_less_abs_iff[THEN sym]] using real_mult_order[OF `e>0`] by auto
+ moreover
+ { fix y assume "dist y (c *\<^sub>R x) < e * \<bar>c\<bar>"
+ hence "norm ((1 / c) *\<^sub>R y - x) < e" unfolding dist_norm
+ using norm_scaleR[of c "(1 / c) *\<^sub>R y - x", unfolded scaleR_right_diff_distrib, unfolded scaleR_scaleR] assms(1)
+ assms(1)[unfolded zero_less_abs_iff[THEN sym]] by (simp del:zero_less_abs_iff)
+ 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 }
+ 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 }
+ thus ?thesis unfolding open_dist by auto
+qed
+
+lemma minus_image_eq_vimage:
+ fixes A :: "'a::ab_group_add set"
+ shows "(\<lambda>x. - x) ` A = (\<lambda>x. - x) -` A"
+ by (auto intro!: image_eqI [where f="\<lambda>x. - x"])
+
+lemma open_negations:
+ fixes s :: "'a::real_normed_vector set"
+ shows "open s ==> open ((\<lambda> x. -x) ` s)"
+ unfolding scaleR_minus1_left [symmetric]
+ by (rule open_scaling, auto)
+
+lemma open_translation:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "open s" shows "open((\<lambda>x. a + x) ` s)"
+proof-
+ { 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 }
+ 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
+ ultimately show ?thesis using continuous_open_preimage_univ[of "\<lambda>x. x - a" s] using assms by auto
+qed
+
+lemma open_affinity:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "open s" "c \<noteq> 0"
+ shows "open ((\<lambda>x. a + c *\<^sub>R x) ` s)"
+proof-
+ have *:"(\<lambda>x. a + c *\<^sub>R x) = (\<lambda>x. a + x) \<circ> (\<lambda>x. c *\<^sub>R x)" unfolding o_def ..
+ have "op + a ` op *\<^sub>R c ` s = (op + a \<circ> op *\<^sub>R c) ` s" by auto
+ thus ?thesis using assms open_translation[of "op *\<^sub>R c ` s" a] unfolding * by auto
+qed
+
+lemma interior_translation:
+ fixes s :: "'a::real_normed_vector set"
+ shows "interior ((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (interior s)"
+proof (rule set_ext, rule)
+ fix x assume "x \<in> interior (op + a ` s)"
+ then obtain e where "e>0" and e:"ball x e \<subseteq> op + a ` s" unfolding mem_interior by auto
+ 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
+ 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
+next
+ fix x assume "x \<in> op + a ` interior s"
+ 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
+ { fix z have *:"a + y - z = y + a - z" by auto
+ assume "z\<in>ball x e"
+ 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
+ hence "z \<in> op + a ` s" unfolding image_iff by(auto intro!: bexI[where x="z - a"]) }
+ hence "ball x e \<subseteq> op + a ` s" unfolding subset_eq by auto
+ thus "x \<in> interior (op + a ` s)" unfolding mem_interior using `e>0` by auto
+qed
+
+subsection {* Preservation of compactness and connectedness under continuous function. *}
+
+lemma compact_continuous_image:
+ assumes "continuous_on s f" "compact s"
+ shows "compact(f ` s)"
+proof-
+ { fix x assume x:"\<forall>n::nat. x n \<in> f ` s"
+ 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
+ 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
+ { fix e::real assume "e>0"
+ 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
+ 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
+ { 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 }
+ hence "\<exists>N. \<forall>n\<ge>N. dist ((x \<circ> r) n) (f l) < e" by auto }
+ 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 }
+ thus ?thesis unfolding compact_def by auto
+qed
+
+lemma connected_continuous_image:
+ assumes "continuous_on s f" "connected s"
+ shows "connected(f ` s)"
+proof-
+ { fix T assume as: "T \<noteq> {}" "T \<noteq> f ` s" "openin (subtopology euclidean (f ` s)) T" "closedin (subtopology euclidean (f ` s)) T"
+ have "{x \<in> s. f x \<in> T} = {} \<or> {x \<in> s. f x \<in> T} = s"
+ using assms(1)[unfolded continuous_on_open, THEN spec[where x=T]]
+ using assms(1)[unfolded continuous_on_closed, THEN spec[where x=T]]
+ using assms(2)[unfolded connected_clopen, THEN spec[where x="{x \<in> s. f x \<in> T}"]] as(3,4) by auto
+ hence False using as(1,2)
+ using as(4)[unfolded closedin_def topspace_euclidean_subtopology] by auto }
+ thus ?thesis unfolding connected_clopen by auto
+qed
+
+text{* Continuity implies uniform continuity on a compact domain. *}
+
+lemma compact_uniformly_continuous:
+ assumes "continuous_on s f" "compact s"
+ shows "uniformly_continuous_on s f"
+proof-
+ { fix x assume x:"x\<in>s"
+ 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
+ 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 }
+ 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
+ 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)"
+ 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
+
+ { fix e::real assume "e>0"
+
+ { 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 }
+ hence "s \<subseteq> \<Union>{ball x (d x (e / 2)) |x. x \<in> s}" unfolding subset_eq by auto
+ moreover
+ { fix b assume "b\<in>{ball x (d x (e / 2)) |x. x \<in> s}" hence "open b" by auto }
+ 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
+
+ { fix x y assume "x\<in>s" "y\<in>s" and as:"dist y x < ea"
+ 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
+ hence "x\<in>ball z (d z (e / 2))" using `ea>0` unfolding subset_eq by auto
+ 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`
+ by (auto simp add: dist_commute)
+ moreover have "y\<in>ball z (d z (e / 2))" using as and `ea>0` and z[unfolded subset_eq]
+ by (auto simp add: dist_commute)
+ 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`
+ by (auto simp add: dist_commute)
+ ultimately have "dist (f y) (f x) < e" using dist_triangle_half_r[of "f z" "f x" e "f y"]
+ by (auto simp add: dist_commute) }
+ 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 }
+ thus ?thesis unfolding uniformly_continuous_on_def by auto
+qed
+
+text{* Continuity of inverse function on compact domain. *}
+
+lemma continuous_on_inverse:
+ fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
+ (* TODO: can this be generalized more? *)
+ assumes "continuous_on s f" "compact s" "\<forall>x \<in> s. g (f x) = x"
+ shows "continuous_on (f ` s) g"
+proof-
+ have *:"g ` f ` s = s" using assms(3) by (auto simp add: image_iff)
+ { fix t assume t:"closedin (subtopology euclidean (g ` f ` s)) t"
+ then obtain T where T: "closed T" "t = s \<inter> T" unfolding closedin_closed unfolding * by auto
+ have "continuous_on (s \<inter> T) f" using continuous_on_subset[OF assms(1), of "s \<inter> t"]
+ unfolding T(2) and Int_left_absorb by auto
+ moreover have "compact (s \<inter> T)"
+ using assms(2) unfolding compact_eq_bounded_closed
+ using bounded_subset[of s "s \<inter> T"] and T(1) by auto
+ ultimately have "closed (f ` t)" using T(1) unfolding T(2)
+ using compact_continuous_image [of "s \<inter> T" f] unfolding compact_eq_bounded_closed by auto
+ moreover have "{x \<in> f ` s. g x \<in> t} = f ` s \<inter> f ` t" using assms(3) unfolding T(2) by auto
+ ultimately have "closedin (subtopology euclidean (f ` s)) {x \<in> f ` s. g x \<in> t}"
+ unfolding closedin_closed by auto }
+ thus ?thesis unfolding continuous_on_closed by auto
+qed
+
+subsection{* A uniformly convergent limit of continuous functions is continuous. *}
+
+lemma norm_triangle_lt:
+ fixes x y :: "'a::real_normed_vector"
+ shows "norm x + norm y < e \<Longrightarrow> norm (x + y) < e"
+by (rule le_less_trans [OF norm_triangle_ineq])
+
+lemma continuous_uniform_limit:
+ fixes f :: "'a \<Rightarrow> 'b::metric_space \<Rightarrow> 'c::real_normed_vector"
+ assumes "\<not> (trivial_limit net)" "eventually (\<lambda>n. continuous_on s (f n)) net"
+ "\<forall>e>0. eventually (\<lambda>n. \<forall>x \<in> s. norm(f n x - g x) < e) net"
+ shows "continuous_on s g"
+proof-
+ { fix x and e::real assume "x\<in>s" "e>0"
+ 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
+ then obtain n where n:"\<forall>xa\<in>s. norm (f n xa - g xa) < e / 3" "continuous_on s (f n)"
+ 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
+ have "e / 3 > 0" using `e>0` by auto
+ 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"
+ using n(2)[unfolded continuous_on_def, THEN bspec[where x=x], OF `x\<in>s`, THEN spec[where x="e/3"]] by blast
+ { fix y assume "y\<in>s" "dist y x < d"
+ hence "dist (f n y) (f n x) < e / 3" using d[THEN bspec[where x=y]] by auto
+ 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"]
+ 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
+ hence "dist (g y) (g x) < e" unfolding dist_norm using n(1)[THEN bspec[where x=y], OF `y\<in>s`]
+ 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) }
+ hence "\<exists>d>0. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (g x') (g x) < e" using `d>0` by auto }
+ thus ?thesis unfolding continuous_on_def by auto
+qed
+
+subsection{* Topological properties of linear functions. *}
+
+lemma linear_lim_0:
+ assumes "bounded_linear f" shows "(f ---> 0) (at (0))"
+proof-
+ interpret f: bounded_linear f by fact
+ have "(f ---> f 0) (at 0)"
+ using tendsto_ident_at by (rule f.tendsto)
+ thus ?thesis unfolding f.zero .
+qed
+
+lemma linear_continuous_at:
+ assumes "bounded_linear f" shows "continuous (at a) f"
+ unfolding continuous_at using assms
+ apply (rule bounded_linear.tendsto)
+ apply (rule tendsto_ident_at)
+ done
+
+lemma linear_continuous_within:
+ shows "bounded_linear f ==> continuous (at x within s) f"
+ using continuous_at_imp_continuous_within[of x f s] using linear_continuous_at[of f] by auto
+
+lemma linear_continuous_on:
+ shows "bounded_linear f ==> continuous_on s f"
+ using continuous_at_imp_continuous_on[of s f] using linear_continuous_at[of f] by auto
+
+text{* Also bilinear functions, in composition form. *}
+
+lemma bilinear_continuous_at_compose:
+ shows "continuous (at x) f \<Longrightarrow> continuous (at x) g \<Longrightarrow> bounded_bilinear h
+ ==> continuous (at x) (\<lambda>x. h (f x) (g x))"
+ unfolding continuous_at using Lim_bilinear[of f "f x" "(at x)" g "g x" h] by auto
+
+lemma bilinear_continuous_within_compose:
+ shows "continuous (at x within s) f \<Longrightarrow> continuous (at x within s) g \<Longrightarrow> bounded_bilinear h
+ ==> continuous (at x within s) (\<lambda>x. h (f x) (g x))"
+ unfolding continuous_within using Lim_bilinear[of f "f x"] by auto
+
+lemma bilinear_continuous_on_compose:
+ shows "continuous_on s f \<Longrightarrow> continuous_on s g \<Longrightarrow> bounded_bilinear h
+ ==> continuous_on s (\<lambda>x. h (f x) (g x))"
+ 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
+ using bilinear_continuous_within_compose[of _ s f g h] by auto
+
+subsection{* Topological stuff lifted from and dropped to R *}
+
+
+lemma open_real:
+ fixes s :: "real set" shows
+ "open s \<longleftrightarrow>
+ (\<forall>x \<in> s. \<exists>e>0. \<forall>x'. abs(x' - x) < e --> x' \<in> s)" (is "?lhs = ?rhs")
+ unfolding open_dist dist_norm by simp
+
+lemma islimpt_approachable_real:
+ fixes s :: "real set"
+ shows "x islimpt s \<longleftrightarrow> (\<forall>e>0. \<exists>x'\<in> s. x' \<noteq> x \<and> abs(x' - x) < e)"
+ unfolding islimpt_approachable dist_norm by simp
+
+lemma closed_real:
+ fixes s :: "real set"
+ shows "closed s \<longleftrightarrow>
+ (\<forall>x. (\<forall>e>0. \<exists>x' \<in> s. x' \<noteq> x \<and> abs(x' - x) < e)
+ --> x \<in> s)"
+ unfolding closed_limpt islimpt_approachable dist_norm by simp
+
+lemma continuous_at_real_range:
+ fixes f :: "'a::real_normed_vector \<Rightarrow> real"
+ shows "continuous (at x) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0.
+ \<forall>x'. norm(x' - x) < d --> abs(f x' - f x) < e)"
+ unfolding continuous_at unfolding Lim_at
+ unfolding dist_nz[THEN sym] unfolding dist_norm apply auto
+ 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
+ apply(erule_tac x=e in allE) by auto
+
+lemma continuous_on_real_range:
+ fixes f :: "'a::real_normed_vector \<Rightarrow> real"
+ 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))"
+ unfolding continuous_on_def dist_norm by simp
+
+lemma continuous_at_norm: "continuous (at x) norm"
+ unfolding continuous_at by (intro tendsto_intros)
+
+lemma continuous_on_norm: "continuous_on s norm"
+unfolding continuous_on by (intro ballI tendsto_intros)
+
+lemma continuous_at_component: "continuous (at a) (\<lambda>x. x $ i)"
+unfolding continuous_at by (intro tendsto_intros)
+
+lemma continuous_on_component: "continuous_on s (\<lambda>x. x $ i)"
+unfolding continuous_on by (intro ballI tendsto_intros)
+
+lemma continuous_at_infnorm: "continuous (at x) infnorm"
+ unfolding continuous_at Lim_at o_def unfolding dist_norm
+ apply auto apply (rule_tac x=e in exI) apply auto
+ using order_trans[OF real_abs_sub_infnorm infnorm_le_norm, of _ x] by (metis xt1(7))
+
+text{* Hence some handy theorems on distance, diameter etc. of/from a set. *}
+
+lemma compact_attains_sup:
+ fixes s :: "real set"
+ assumes "compact s" "s \<noteq> {}"
+ shows "\<exists>x \<in> s. \<forall>y \<in> s. y \<le> x"
+proof-
+ from assms(1) have a:"bounded s" "closed s" unfolding compact_eq_bounded_closed by auto
+ { 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"
+ have "isLub UNIV s (rsup s)" using rsup[OF assms(2)] unfolding setle_def using as(1) by auto
+ moreover have "isUb UNIV s (rsup s - e)" unfolding isUb_def unfolding setle_def using as(4,2) by auto
+ ultimately have False using isLub_le_isUb[of UNIV s "rsup s" "rsup s - e"] using `e>0` by auto }
+ thus ?thesis using bounded_has_rsup(1)[OF a(1) assms(2)] using a(2)[unfolded closed_real, THEN spec[where x="rsup s"]]
+ apply(rule_tac x="rsup s" in bexI) by auto
+qed
+
+lemma compact_attains_inf:
+ fixes s :: "real set"
+ assumes "compact s" "s \<noteq> {}" shows "\<exists>x \<in> s. \<forall>y \<in> s. x \<le> y"
+proof-
+ from assms(1) have a:"bounded s" "closed s" unfolding compact_eq_bounded_closed by auto
+ { fix e::real assume as: "\<forall>x\<in>s. x \<ge> rinf s" "rinf s \<notin> s" "0 < e"
+ "\<forall>x'\<in>s. x' = rinf s \<or> \<not> abs (x' - rinf s) < e"
+ have "isGlb UNIV s (rinf s)" using rinf[OF assms(2)] unfolding setge_def using as(1) by auto
+ moreover
+ { fix x assume "x \<in> s"
+ hence *:"abs (x - rinf s) = x - rinf s" using as(1)[THEN bspec[where x=x]] by auto
+ have "rinf s + e \<le> x" using as(4)[THEN bspec[where x=x]] using as(2) `x\<in>s` unfolding * by auto }
+ hence "isLb UNIV s (rinf s + e)" unfolding isLb_def and setge_def by auto
+ ultimately have False using isGlb_le_isLb[of UNIV s "rinf s" "rinf s + e"] using `e>0` by auto }
+ thus ?thesis using bounded_has_rinf(1)[OF a(1) assms(2)] using a(2)[unfolded closed_real, THEN spec[where x="rinf s"]]
+ apply(rule_tac x="rinf s" in bexI) by auto
+qed
+
+lemma continuous_attains_sup:
+ fixes f :: "'a::metric_space \<Rightarrow> real"
+ shows "compact s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> continuous_on s f
+ ==> (\<exists>x \<in> s. \<forall>y \<in> s. f y \<le> f x)"
+ using compact_attains_sup[of "f ` s"]
+ using compact_continuous_image[of s f] by auto
+
+lemma continuous_attains_inf:
+ fixes f :: "'a::metric_space \<Rightarrow> real"
+ shows "compact s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> continuous_on s f
+ \<Longrightarrow> (\<exists>x \<in> s. \<forall>y \<in> s. f x \<le> f y)"
+ using compact_attains_inf[of "f ` s"]
+ using compact_continuous_image[of s f] by auto
+
+lemma distance_attains_sup:
+ assumes "compact s" "s \<noteq> {}"
+ shows "\<exists>x \<in> s. \<forall>y \<in> s. dist a y \<le> dist a x"
+proof (rule continuous_attains_sup [OF assms])
+ { fix x assume "x\<in>s"
+ have "(dist a ---> dist a x) (at x within s)"
+ by (intro tendsto_dist tendsto_const Lim_at_within Lim_ident_at)
+ }
+ thus "continuous_on s (dist a)"
+ unfolding continuous_on ..
+qed
+
+text{* For *minimal* distance, we only need closure, not compactness. *}
+
+lemma distance_attains_inf:
+ fixes a :: "'a::heine_borel"
+ assumes "closed s" "s \<noteq> {}"
+ shows "\<exists>x \<in> s. \<forall>y \<in> s. dist a x \<le> dist a y"
+proof-
+ from assms(2) obtain b where "b\<in>s" by auto
+ let ?B = "cball a (dist b a) \<inter> s"
+ have "b \<in> ?B" using `b\<in>s` by (simp add: dist_commute)
+ hence "?B \<noteq> {}" by auto
+ moreover
+ { fix x assume "x\<in>?B"
+ fix e::real assume "e>0"
+ { fix x' assume "x'\<in>?B" and as:"dist x' x < e"
+ from as have "\<bar>dist a x' - dist a x\<bar> < e"
+ unfolding abs_less_iff minus_diff_eq
+ using dist_triangle2 [of a x' x]
+ using dist_triangle [of a x x']
+ by arith
+ }
+ hence "\<exists>d>0. \<forall>x'\<in>?B. dist x' x < d \<longrightarrow> \<bar>dist a x' - dist a x\<bar> < e"
+ using `e>0` by auto
+ }
+ hence "continuous_on (cball a (dist b a) \<inter> s) (dist a)"
+ unfolding continuous_on Lim_within dist_norm real_norm_def
+ by fast
+ moreover have "compact ?B"
+ using compact_cball[of a "dist b a"]
+ unfolding compact_eq_bounded_closed
+ using bounded_Int and closed_Int and assms(1) by auto
+ 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"
+ using continuous_attains_inf[of ?B "dist a"] by fastsimp
+ thus ?thesis by fastsimp
+qed
+
+subsection{* We can now extend limit compositions to consider the scalar multiplier. *}
+
+lemma Lim_mul:
+ fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
+ assumes "(c ---> d) net" "(f ---> l) net"
+ shows "((\<lambda>x. c(x) *\<^sub>R f x) ---> (d *\<^sub>R l)) net"
+ using assms by (rule scaleR.tendsto)
+
+lemma Lim_vmul:
+ fixes c :: "'a \<Rightarrow> real" and v :: "'b::real_normed_vector"
+ shows "(c ---> d) net ==> ((\<lambda>x. c(x) *\<^sub>R v) ---> d *\<^sub>R v) net"
+ by (intro tendsto_intros)
+
+lemma continuous_vmul:
+ fixes c :: "'a::metric_space \<Rightarrow> real" and v :: "'b::real_normed_vector"
+ shows "continuous net c ==> continuous net (\<lambda>x. c(x) *\<^sub>R v)"
+ unfolding continuous_def using Lim_vmul[of c] by auto
+
+lemma continuous_mul:
+ fixes c :: "'a::metric_space \<Rightarrow> real"
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
+ shows "continuous net c \<Longrightarrow> continuous net f
+ ==> continuous net (\<lambda>x. c(x) *\<^sub>R f x) "
+ unfolding continuous_def by (intro tendsto_intros)
+
+lemma continuous_on_vmul:
+ fixes c :: "'a::metric_space \<Rightarrow> real" and v :: "'b::real_normed_vector"
+ shows "continuous_on s c ==> continuous_on s (\<lambda>x. c(x) *\<^sub>R v)"
+ unfolding continuous_on_eq_continuous_within using continuous_vmul[of _ c] by auto
+
+lemma continuous_on_mul:
+ fixes c :: "'a::metric_space \<Rightarrow> real"
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
+ shows "continuous_on s c \<Longrightarrow> continuous_on s f
+ ==> continuous_on s (\<lambda>x. c(x) *\<^sub>R f x)"
+ unfolding continuous_on_eq_continuous_within using continuous_mul[of _ c] by auto
+
+text{* And so we have continuity of inverse. *}
+
+lemma Lim_inv:
+ fixes f :: "'a \<Rightarrow> real"
+ assumes "(f ---> l) (net::'a net)" "l \<noteq> 0"
+ shows "((inverse o f) ---> inverse l) net"
+ unfolding o_def using assms by (rule tendsto_inverse)
+
+lemma continuous_inv:
+ fixes f :: "'a::metric_space \<Rightarrow> real"
+ shows "continuous net f \<Longrightarrow> f(netlimit net) \<noteq> 0
+ ==> continuous net (inverse o f)"
+ unfolding continuous_def using Lim_inv by auto
+
+lemma continuous_at_within_inv:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_field"
+ assumes "continuous (at a within s) f" "f a \<noteq> 0"
+ shows "continuous (at a within s) (inverse o f)"
+ using assms unfolding continuous_within o_def
+ by (intro tendsto_intros)
+
+lemma continuous_at_inv:
+ fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_field"
+ shows "continuous (at a) f \<Longrightarrow> f a \<noteq> 0
+ ==> continuous (at a) (inverse o f) "
+ using within_UNIV[THEN sym, of "at a"] using continuous_at_within_inv[of a UNIV] by auto
+
+subsection{* Preservation properties for pasted sets. *}
+
+lemma bounded_pastecart:
+ fixes s :: "('a::real_normed_vector ^ _) set" (* FIXME: generalize to metric_space *)
+ assumes "bounded s" "bounded t"
+ shows "bounded { pastecart x y | x y . (x \<in> s \<and> y \<in> t)}"
+proof-
+ 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
+ { fix x y assume "x\<in>s" "y\<in>t"
+ hence "norm x \<le> a" "norm y \<le> b" using ab by auto
+ hence "norm (pastecart x y) \<le> a + b" using norm_pastecart[of x y] by auto }
+ thus ?thesis unfolding bounded_iff by auto
+qed
+
+lemma bounded_Times:
+ assumes "bounded s" "bounded t" shows "bounded (s \<times> t)"
+proof-
+ obtain x y a b where "\<forall>z\<in>s. dist x z \<le> a" "\<forall>z\<in>t. dist y z \<le> b"
+ using assms [unfolded bounded_def] by auto
+ then have "\<forall>z\<in>s \<times> t. dist (x, y) z \<le> sqrt (a\<twosuperior> + b\<twosuperior>)"
+ by (auto simp add: dist_Pair_Pair real_sqrt_le_mono add_mono power_mono)
+ thus ?thesis unfolding bounded_any_center [where a="(x, y)"] by auto
+qed
+
+lemma closed_pastecart:
+ fixes s :: "(real ^ 'a::finite) set" (* FIXME: generalize *)
+ assumes "closed s" "closed t"
+ shows "closed {pastecart x y | x y . x \<in> s \<and> y \<in> t}"
+proof-
+ { 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"
+ { 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
+ moreover
+ { fix e::real assume "e>0"
+ 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
+ { fix n::nat assume "n\<ge>N"
+ hence "dist (fstcart (x n)) (fstcart l) < e" "dist (sndcart (x n)) (sndcart l) < e"
+ using N[THEN spec[where x=n]] dist_fstcart[of "x n" l] dist_sndcart[of "x n" l] by auto }
+ 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 }
+ ultimately have "fstcart l \<in> s" "sndcart l \<in> t"
+ using assms(1)[unfolded closed_sequential_limits, THEN spec[where x="\<lambda>n. fstcart (x n)"], THEN spec[where x="fstcart l"]]
+ using assms(2)[unfolded closed_sequential_limits, THEN spec[where x="\<lambda>n. sndcart (x n)"], THEN spec[where x="sndcart l"]]
+ unfolding Lim_sequentially by auto
+ 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 }
+ thus ?thesis unfolding closed_sequential_limits by auto
+qed
+
+lemma compact_pastecart:
+ fixes s t :: "(real ^ _) set"
+ shows "compact s \<Longrightarrow> compact t ==> compact {pastecart x y | x y . x \<in> s \<and> y \<in> t}"
+ unfolding compact_eq_bounded_closed using bounded_pastecart[of s t] closed_pastecart[of s t] by auto
+
+lemma mem_Times_iff: "x \<in> A \<times> B \<longleftrightarrow> fst x \<in> A \<and> snd x \<in> B"
+by (induct x) simp
+
+lemma compact_Times: "compact s \<Longrightarrow> compact t \<Longrightarrow> compact (s \<times> t)"
+unfolding compact_def
+apply clarify
+apply (drule_tac x="fst \<circ> f" in spec)
+apply (drule mp, simp add: mem_Times_iff)
+apply (clarify, rename_tac l1 r1)
+apply (drule_tac x="snd \<circ> f \<circ> r1" in spec)
+apply (drule mp, simp add: mem_Times_iff)
+apply (clarify, rename_tac l2 r2)
+apply (rule_tac x="(l1, l2)" in rev_bexI, simp)
+apply (rule_tac x="r1 \<circ> r2" in exI)
+apply (rule conjI, simp add: subseq_def)
+apply (drule_tac r=r2 in lim_subseq [COMP swap_prems_rl], assumption)
+apply (drule (1) tendsto_Pair) back
+apply (simp add: o_def)
+done
+
+text{* Hence some useful properties follow quite easily. *}
+
+lemma compact_scaling:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "compact s" shows "compact ((\<lambda>x. c *\<^sub>R x) ` s)"
+proof-
+ let ?f = "\<lambda>x. scaleR c x"
+ have *:"bounded_linear ?f" by (rule scaleR.bounded_linear_right)
+ show ?thesis using compact_continuous_image[of s ?f] continuous_at_imp_continuous_on[of s ?f]
+ using linear_continuous_at[OF *] assms by auto
+qed
+
+lemma compact_negations:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "compact s" shows "compact ((\<lambda>x. -x) ` s)"
+ using compact_scaling [OF assms, of "- 1"] by auto
+
+lemma compact_sums:
+ fixes s t :: "'a::real_normed_vector set"
+ assumes "compact s" "compact t" shows "compact {x + y | x y. x \<in> s \<and> y \<in> t}"
+proof-
+ have *:"{x + y | x y. x \<in> s \<and> y \<in> t} = (\<lambda>z. fst z + snd z) ` (s \<times> t)"
+ apply auto unfolding image_iff apply(rule_tac x="(xa, y)" in bexI) by auto
+ have "continuous_on (s \<times> t) (\<lambda>z. fst z + snd z)"
+ unfolding continuous_on by (rule ballI) (intro tendsto_intros)
+ thus ?thesis unfolding * using compact_continuous_image compact_Times [OF assms] by auto
+qed
+
+lemma compact_differences:
+ fixes s t :: "'a::real_normed_vector set"
+ assumes "compact s" "compact t" shows "compact {x - y | x y. x \<in> s \<and> y \<in> t}"
+proof-
+ have "{x - y | x y. x\<in>s \<and> y \<in> t} = {x + y | x y. x \<in> s \<and> y \<in> (uminus ` t)}"
+ apply auto apply(rule_tac x= xa in exI) apply auto apply(rule_tac x=xa in exI) by auto
+ thus ?thesis using compact_sums[OF assms(1) compact_negations[OF assms(2)]] by auto
+qed
+
+lemma compact_translation:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "compact s" shows "compact ((\<lambda>x. a + x) ` s)"
+proof-
+ have "{x + y |x y. x \<in> s \<and> y \<in> {a}} = (\<lambda>x. a + x) ` s" by auto
+ thus ?thesis using compact_sums[OF assms compact_sing[of a]] by auto
+qed
+
+lemma compact_affinity:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "compact s" shows "compact ((\<lambda>x. a + c *\<^sub>R x) ` s)"
+proof-
+ have "op + a ` op *\<^sub>R c ` s = (\<lambda>x. a + c *\<^sub>R x) ` s" by auto
+ thus ?thesis using compact_translation[OF compact_scaling[OF assms], of a c] by auto
+qed
+
+text{* Hence we get the following. *}
+
+lemma compact_sup_maxdistance:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "compact s" "s \<noteq> {}"
+ shows "\<exists>x\<in>s. \<exists>y\<in>s. \<forall>u\<in>s. \<forall>v\<in>s. norm(u - v) \<le> norm(x - y)"
+proof-
+ have "{x - y | x y . x\<in>s \<and> y\<in>s} \<noteq> {}" using `s \<noteq> {}` by auto
+ 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"
+ using compact_differences[OF assms(1) assms(1)]
+ 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)
+ from x(1) obtain a b where "a\<in>s" "b\<in>s" "x = a - b" by auto
+ thus ?thesis using x(2)[unfolded `x = a - b`] by blast
+qed
+
+text{* We can state this in terms of diameter of a set. *}
+
+definition "diameter s = (if s = {} then 0::real else rsup {norm(x - y) | x y. x \<in> s \<and> y \<in> s})"
+ (* TODO: generalize to class metric_space *)
+
+lemma diameter_bounded:
+ assumes "bounded s"
+ shows "\<forall>x\<in>s. \<forall>y\<in>s. norm(x - y) \<le> diameter s"
+ "\<forall>d>0. d < diameter s --> (\<exists>x\<in>s. \<exists>y\<in>s. norm(x - y) > d)"
+proof-
+ let ?D = "{norm (x - y) |x y. x \<in> s \<and> y \<in> s}"
+ obtain a where a:"\<forall>x\<in>s. norm x \<le> a" using assms[unfolded bounded_iff] by auto
+ { fix x y assume "x \<in> s" "y \<in> s"
+ 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) }
+ note * = this
+ { fix x y assume "x\<in>s" "y\<in>s" hence "s \<noteq> {}" by auto
+ have lub:"isLub UNIV ?D (rsup ?D)" using * rsup[of ?D] using `s\<noteq>{}` unfolding setle_def by auto
+ 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 }
+ moreover
+ { fix d::real assume "d>0" "d < diameter s"
+ hence "s\<noteq>{}" unfolding diameter_def by auto
+ hence lub:"isLub UNIV ?D (rsup ?D)" using * rsup[of ?D] unfolding setle_def by auto
+ have "\<exists>d' \<in> ?D. d' > d"
+ proof(rule ccontr)
+ assume "\<not> (\<exists>d'\<in>{norm (x - y) |x y. x \<in> s \<and> y \<in> s}. d < d')"
+ hence as:"\<forall>d'\<in>?D. d' \<le> d" apply auto apply(erule_tac x="norm (x - y)" in allE) by auto
+ hence "isUb UNIV ?D d" unfolding isUb_def unfolding setle_def by auto
+ thus False using `d < diameter s` `s\<noteq>{}` isLub_le_isUb[OF lub, of d] unfolding diameter_def by auto
+ qed
+ hence "\<exists>x\<in>s. \<exists>y\<in>s. norm(x - y) > d" by auto }
+ ultimately show "\<forall>x\<in>s. \<forall>y\<in>s. norm(x - y) \<le> diameter s"
+ "\<forall>d>0. d < diameter s --> (\<exists>x\<in>s. \<exists>y\<in>s. norm(x - y) > d)" by auto
+qed
+
+lemma diameter_bounded_bound:
+ "bounded s \<Longrightarrow> x \<in> s \<Longrightarrow> y \<in> s ==> norm(x - y) \<le> diameter s"
+ using diameter_bounded by blast
+
+lemma diameter_compact_attained:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "compact s" "s \<noteq> {}"
+ shows "\<exists>x\<in>s. \<exists>y\<in>s. (norm(x - y) = diameter s)"
+proof-
+ have b:"bounded s" using assms(1) by (rule compact_imp_bounded)
+ 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
+ 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)"]
+ unfolding setle_def and diameter_def by auto
+ thus ?thesis using diameter_bounded(1)[OF b, THEN bspec[where x=x], THEN bspec[where x=y], OF xys] and xys by auto
+qed
+
+text{* Related results with closure as the conclusion. *}
+
+lemma closed_scaling:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "closed s" shows "closed ((\<lambda>x. c *\<^sub>R x) ` s)"
+proof(cases "s={}")
+ case True thus ?thesis by auto
+next
+ case False
+ show ?thesis
+ proof(cases "c=0")
+ have *:"(\<lambda>x. 0) ` s = {0}" using `s\<noteq>{}` by auto
+ case True thus ?thesis apply auto unfolding * using closed_sing by auto
+ next
+ case False
+ { fix x l assume as:"\<forall>n::nat. x n \<in> scaleR c ` s" "(x ---> l) sequentially"
+ { fix n::nat have "scaleR (1 / c) (x n) \<in> s"
+ using as(1)[THEN spec[where x=n]]
+ using `c\<noteq>0` by (auto simp add: vector_smult_assoc)
+ }
+ moreover
+ { fix e::real assume "e>0"
+ hence "0 < e *\<bar>c\<bar>" using `c\<noteq>0` mult_pos_pos[of e "abs c"] by auto
+ then obtain N where "\<forall>n\<ge>N. dist (x n) l < e * \<bar>c\<bar>"
+ using as(2)[unfolded Lim_sequentially, THEN spec[where x="e * abs c"]] by auto
+ hence "\<exists>N. \<forall>n\<ge>N. dist (scaleR (1 / c) (x n)) (scaleR (1 / c) l) < e"
+ unfolding dist_norm unfolding scaleR_right_diff_distrib[THEN sym]
+ using mult_imp_div_pos_less[of "abs c" _ e] `c\<noteq>0` by auto }
+ hence "((\<lambda>n. scaleR (1 / c) (x n)) ---> scaleR (1 / c) l) sequentially" unfolding Lim_sequentially by auto
+ ultimately have "l \<in> scaleR c ` s"
+ 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"]]
+ unfolding image_iff using `c\<noteq>0` apply(rule_tac x="scaleR (1 / c) l" in bexI) by auto }
+ thus ?thesis unfolding closed_sequential_limits by fast
+ qed
+qed
+
+lemma closed_negations:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "closed s" shows "closed ((\<lambda>x. -x) ` s)"
+ using closed_scaling[OF assms, of "- 1"] by simp
+
+lemma compact_closed_sums:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "compact s" "closed t" shows "closed {x + y | x y. x \<in> s \<and> y \<in> t}"
+proof-
+ let ?S = "{x + y |x y. x \<in> s \<and> y \<in> t}"
+ { fix x l assume as:"\<forall>n. x n \<in> ?S" "(x ---> l) sequentially"
+ 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"
+ using choice[of "\<lambda>n y. x n = (fst y) + (snd y) \<and> fst y \<in> s \<and> snd y \<in> t"] by auto
+ obtain l' r where "l'\<in>s" and r:"subseq r" and lr:"(((\<lambda>n. fst (f n)) \<circ> r) ---> l') sequentially"
+ using assms(1)[unfolded compact_def, THEN spec[where x="\<lambda> n. fst (f n)"]] using f(2) by auto
+ have "((\<lambda>n. snd (f (r n))) ---> l - l') sequentially"
+ using Lim_sub[OF lim_subseq[OF r as(2)] lr] and f(1) unfolding o_def by auto
+ hence "l - l' \<in> t"
+ using assms(2)[unfolded closed_sequential_limits, THEN spec[where x="\<lambda> n. snd (f (r n))"], THEN spec[where x="l - l'"]]
+ using f(3) by auto
+ 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
+ }
+ thus ?thesis unfolding closed_sequential_limits by fast
+qed
+
+lemma closed_compact_sums:
+ fixes s t :: "'a::real_normed_vector set"
+ assumes "closed s" "compact t"
+ shows "closed {x + y | x y. x \<in> s \<and> y \<in> t}"
+proof-
+ 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
+ apply(rule_tac x=y in exI) apply auto apply(rule_tac x=y in exI) by auto
+ thus ?thesis using compact_closed_sums[OF assms(2,1)] by simp
+qed
+
+lemma compact_closed_differences:
+ fixes s t :: "'a::real_normed_vector set"
+ assumes "compact s" "closed t"
+ shows "closed {x - y | x y. x \<in> s \<and> y \<in> t}"
+proof-
+ have "{x + y |x y. x \<in> s \<and> y \<in> uminus ` t} = {x - y |x y. x \<in> s \<and> y \<in> t}"
+ apply auto apply(rule_tac x=xa in exI) apply auto apply(rule_tac x=xa in exI) by auto
+ thus ?thesis using compact_closed_sums[OF assms(1) closed_negations[OF assms(2)]] by auto
+qed
+
+lemma closed_compact_differences:
+ fixes s t :: "'a::real_normed_vector set"
+ assumes "closed s" "compact t"
+ shows "closed {x - y | x y. x \<in> s \<and> y \<in> t}"
+proof-
+ have "{x + y |x y. x \<in> s \<and> y \<in> uminus ` t} = {x - y |x y. x \<in> s \<and> y \<in> t}"
+ apply auto apply(rule_tac x=xa in exI) apply auto apply(rule_tac x=xa in exI) by auto
+ thus ?thesis using closed_compact_sums[OF assms(1) compact_negations[OF assms(2)]] by simp
+qed
+
+lemma closed_translation:
+ fixes a :: "'a::real_normed_vector"
+ assumes "closed s" shows "closed ((\<lambda>x. a + x) ` s)"
+proof-
+ have "{a + y |y. y \<in> s} = (op + a ` s)" by auto
+ thus ?thesis using compact_closed_sums[OF compact_sing[of a] assms] by auto
+qed
+
+lemma translation_UNIV:
+ fixes a :: "'a::ab_group_add" shows "range (\<lambda>x. a + x) = UNIV"
+ apply (auto simp add: image_iff) apply(rule_tac x="x - a" in exI) by auto
+
+lemma translation_diff:
+ fixes a :: "'a::ab_group_add"
+ shows "(\<lambda>x. a + x) ` (s - t) = ((\<lambda>x. a + x) ` s) - ((\<lambda>x. a + x) ` t)"
+ by auto
+
+lemma closure_translation:
+ fixes a :: "'a::real_normed_vector"
+ shows "closure ((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (closure s)"
+proof-
+ have *:"op + a ` (UNIV - s) = UNIV - op + a ` s"
+ apply auto unfolding image_iff apply(rule_tac x="x - a" in bexI) by auto
+ show ?thesis unfolding closure_interior translation_diff translation_UNIV
+ using interior_translation[of a "UNIV - s"] unfolding * by auto
+qed
+
+lemma frontier_translation:
+ fixes a :: "'a::real_normed_vector"
+ shows "frontier((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (frontier s)"
+ unfolding frontier_def translation_diff interior_translation closure_translation by auto
+
+subsection{* Separation between points and sets. *}
+
+lemma separate_point_closed:
+ fixes s :: "'a::heine_borel set"
+ shows "closed s \<Longrightarrow> a \<notin> s ==> (\<exists>d>0. \<forall>x\<in>s. d \<le> dist a x)"
+proof(cases "s = {}")
+ case True
+ thus ?thesis by(auto intro!: exI[where x=1])
+next
+ case False
+ assume "closed s" "a \<notin> s"
+ 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
+ with `x\<in>s` show ?thesis using dist_pos_lt[of a x] and`a \<notin> s` by blast
+qed
+
+lemma separate_compact_closed:
+ fixes s t :: "'a::{heine_borel, real_normed_vector} set"
+ (* TODO: does this generalize to heine_borel? *)
+ assumes "compact s" and "closed t" and "s \<inter> t = {}"
+ shows "\<exists>d>0. \<forall>x\<in>s. \<forall>y\<in>t. d \<le> dist x y"
+proof-
+ have "0 \<notin> {x - y |x y. x \<in> s \<and> y \<in> t}" using assms(3) by auto
+ 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"
+ using separate_point_closed[OF compact_closed_differences[OF assms(1,2)], of 0] by auto
+ { fix x y assume "x\<in>s" "y\<in>t"
+ hence "x - y \<in> {x - y |x y. x \<in> s \<and> y \<in> t}" by auto
+ hence "d \<le> dist (x - y) 0" using d[THEN bspec[where x="x - y"]] using dist_commute
+ by (auto simp add: dist_commute)
+ hence "d \<le> dist x y" unfolding dist_norm by auto }
+ thus ?thesis using `d>0` by auto
+qed
+
+lemma separate_closed_compact:
+ fixes s t :: "'a::{heine_borel, real_normed_vector} set"
+ assumes "closed s" and "compact t" and "s \<inter> t = {}"
+ shows "\<exists>d>0. \<forall>x\<in>s. \<forall>y\<in>t. d \<le> dist x y"
+proof-
+ have *:"t \<inter> s = {}" using assms(3) by auto
+ show ?thesis using separate_compact_closed[OF assms(2,1) *]
+ apply auto apply(rule_tac x=d in exI) apply auto apply (erule_tac x=y in ballE)
+ by (auto simp add: dist_commute)
+qed
+
+(* A cute way of denoting open and closed intervals using overloading. *)
+
+lemma interval: fixes a :: "'a::ord^'n::finite" shows
+ "{a <..< b} = {x::'a^'n. \<forall>i. a$i < x$i \<and> x$i < b$i}" and
+ "{a .. b} = {x::'a^'n. \<forall>i. a$i \<le> x$i \<and> x$i \<le> b$i}"
+ by (auto simp add: expand_set_eq vector_less_def vector_less_eq_def)
+
+lemma mem_interval: fixes a :: "'a::ord^'n::finite" shows
+ "x \<in> {a<..<b} \<longleftrightarrow> (\<forall>i. a$i < x$i \<and> x$i < b$i)"
+ "x \<in> {a .. b} \<longleftrightarrow> (\<forall>i. a$i \<le> x$i \<and> x$i \<le> b$i)"
+ using interval[of a b] by(auto simp add: expand_set_eq vector_less_def vector_less_eq_def)
+
+lemma mem_interval_1: fixes x :: "real^1" shows
+ "(x \<in> {a .. b} \<longleftrightarrow> dest_vec1 a \<le> dest_vec1 x \<and> dest_vec1 x \<le> dest_vec1 b)"
+ "(x \<in> {a<..<b} \<longleftrightarrow> dest_vec1 a < dest_vec1 x \<and> dest_vec1 x < dest_vec1 b)"
+by(simp_all add: Cart_eq vector_less_def vector_less_eq_def dest_vec1_def forall_1)
+
+lemma interval_eq_empty: fixes a :: "real^'n::finite" shows
+ "({a <..< b} = {} \<longleftrightarrow> (\<exists>i. b$i \<le> a$i))" (is ?th1) and
+ "({a .. b} = {} \<longleftrightarrow> (\<exists>i. b$i < a$i))" (is ?th2)
+proof-
+ { fix i x assume as:"b$i \<le> a$i" and x:"x\<in>{a <..< b}"
+ hence "a $ i < x $ i \<and> x $ i < b $ i" unfolding mem_interval by auto
+ hence "a$i < b$i" by auto
+ hence False using as by auto }
+ moreover
+ { assume as:"\<forall>i. \<not> (b$i \<le> a$i)"
+ let ?x = "(1/2) *\<^sub>R (a + b)"
+ { fix i
+ have "a$i < b$i" using as[THEN spec[where x=i]] by auto
+ hence "a$i < ((1/2) *\<^sub>R (a+b)) $ i" "((1/2) *\<^sub>R (a+b)) $ i < b$i"
+ unfolding vector_smult_component and vector_add_component
+ by (auto simp add: less_divide_eq_number_of1) }
+ hence "{a <..< b} \<noteq> {}" using mem_interval(1)[of "?x" a b] by auto }
+ ultimately show ?th1 by blast
+
+ { fix i x assume as:"b$i < a$i" and x:"x\<in>{a .. b}"
+ hence "a $ i \<le> x $ i \<and> x $ i \<le> b $ i" unfolding mem_interval by auto
+ hence "a$i \<le> b$i" by auto
+ hence False using as by auto }
+ moreover
+ { assume as:"\<forall>i. \<not> (b$i < a$i)"
+ let ?x = "(1/2) *\<^sub>R (a + b)"
+ { fix i
+ have "a$i \<le> b$i" using as[THEN spec[where x=i]] by auto
+ hence "a$i \<le> ((1/2) *\<^sub>R (a+b)) $ i" "((1/2) *\<^sub>R (a+b)) $ i \<le> b$i"
+ unfolding vector_smult_component and vector_add_component
+ by (auto simp add: less_divide_eq_number_of1) }
+ hence "{a .. b} \<noteq> {}" using mem_interval(2)[of "?x" a b] by auto }
+ ultimately show ?th2 by blast
+qed
+
+lemma interval_ne_empty: fixes a :: "real^'n::finite" shows
+ "{a .. b} \<noteq> {} \<longleftrightarrow> (\<forall>i. a$i \<le> b$i)" and
+ "{a <..< b} \<noteq> {} \<longleftrightarrow> (\<forall>i. a$i < b$i)"
+ unfolding interval_eq_empty[of a b] by (auto simp add: not_less not_le) (* BH: Why doesn't just "auto" work here? *)
+
+lemma subset_interval_imp: fixes a :: "real^'n::finite" shows
+ "(\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i) \<Longrightarrow> {c .. d} \<subseteq> {a .. b}" and
+ "(\<forall>i. a$i < c$i \<and> d$i < b$i) \<Longrightarrow> {c .. d} \<subseteq> {a<..<b}" and
+ "(\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i) \<Longrightarrow> {c<..<d} \<subseteq> {a .. b}" and
+ "(\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i) \<Longrightarrow> {c<..<d} \<subseteq> {a<..<b}"
+ unfolding subset_eq[unfolded Ball_def] unfolding mem_interval
+ by (auto intro: order_trans less_le_trans le_less_trans less_imp_le) (* BH: Why doesn't just "auto" work here? *)
+
+lemma interval_sing: fixes a :: "'a::linorder^'n::finite" shows
+ "{a .. a} = {a} \<and> {a<..<a} = {}"
+apply(auto simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
+apply (simp add: order_eq_iff)
+apply (auto simp add: not_less less_imp_le)
+done
+
+lemma interval_open_subset_closed: fixes a :: "'a::preorder^'n::finite" shows
+ "{a<..<b} \<subseteq> {a .. b}"
+proof(simp add: subset_eq, rule)
+ fix x
+ assume x:"x \<in>{a<..<b}"
+ { fix i
+ have "a $ i \<le> x $ i"
+ using x order_less_imp_le[of "a$i" "x$i"]
+ by(simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
+ }
+ moreover
+ { fix i
+ have "x $ i \<le> b $ i"
+ using x order_less_imp_le[of "x$i" "b$i"]
+ by(simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
+ }
+ ultimately
+ show "a \<le> x \<and> x \<le> b"
+ by(simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
+qed
+
+lemma subset_interval: fixes a :: "real^'n::finite" shows
+ "{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
+ "{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
+ "{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
+ "{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)
+proof-
+ show ?th1 unfolding subset_eq and Ball_def and mem_interval by (auto intro: order_trans)
+ 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)
+ { assume as: "{c<..<d} \<subseteq> {a .. b}" "\<forall>i. c$i < d$i"
+ hence "{c<..<d} \<noteq> {}" unfolding interval_eq_empty by (auto, drule_tac x=i in spec, simp) (* BH: Why doesn't just "auto" work? *)
+ fix i
+ (** TODO combine the following two parts as done in the HOL_light version. **)
+ { let ?x = "(\<chi> j. (if j=i then ((min (a$j) (d$j))+c$j)/2 else (c$j+d$j)/2))::real^'n"
+ assume as2: "a$i > c$i"
+ { fix j
+ have "c $ j < ?x $ j \<and> ?x $ j < d $ j" unfolding Cart_lambda_beta
+ apply(cases "j=i") using as(2)[THEN spec[where x=j]]
+ by (auto simp add: less_divide_eq_number_of1 as2) }
+ hence "?x\<in>{c<..<d}" unfolding mem_interval by auto
+ moreover
+ have "?x\<notin>{a .. b}"
+ unfolding mem_interval apply auto apply(rule_tac x=i in exI)
+ using as(2)[THEN spec[where x=i]] and as2
+ by (auto simp add: less_divide_eq_number_of1)
+ ultimately have False using as by auto }
+ hence "a$i \<le> c$i" by(rule ccontr)auto
+ moreover
+ { let ?x = "(\<chi> j. (if j=i then ((max (b$j) (c$j))+d$j)/2 else (c$j+d$j)/2))::real^'n"
+ assume as2: "b$i < d$i"
+ { fix j
+ have "d $ j > ?x $ j \<and> ?x $ j > c $ j" unfolding Cart_lambda_beta
+ apply(cases "j=i") using as(2)[THEN spec[where x=j]]
+ by (auto simp add: less_divide_eq_number_of1 as2) }
+ hence "?x\<in>{c<..<d}" unfolding mem_interval by auto
+ moreover
+ have "?x\<notin>{a .. b}"
+ unfolding mem_interval apply auto apply(rule_tac x=i in exI)
+ using as(2)[THEN spec[where x=i]] and as2
+ by (auto simp add: less_divide_eq_number_of1)
+ ultimately have False using as by auto }
+ hence "b$i \<ge> d$i" by(rule ccontr)auto
+ ultimately
+ have "a$i \<le> c$i \<and> d$i \<le> b$i" by auto
+ } note part1 = this
+ 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)+
+ { assume as:"{c<..<d} \<subseteq> {a<..<b}" "\<forall>i. c$i < d$i"
+ fix i
+ from as(1) have "{c<..<d} \<subseteq> {a..b}" using interval_open_subset_closed[of a b] by auto
+ hence "a$i \<le> c$i \<and> d$i \<le> b$i" using part1 and as(2) by auto } note * = this
+ 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)+
+qed
+
+lemma disjoint_interval: fixes a::"real^'n::finite" shows
+ "{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
+ "{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
+ "{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
+ "{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)
+proof-
+ let ?z = "(\<chi> i. ((max (a$i) (c$i)) + (min (b$i) (d$i))) / 2)::real^'n"
+ show ?th1 ?th2 ?th3 ?th4
+ unfolding expand_set_eq and Int_iff and empty_iff and mem_interval and all_conj_distrib[THEN sym] and eq_False
+ apply (auto elim!: allE[where x="?z"])
+ apply ((rule_tac x=x in exI, force) | (rule_tac x=i in exI, force))+
+ done
+qed
+
+lemma inter_interval: fixes a :: "'a::linorder^'n::finite" shows
+ "{a .. b} \<inter> {c .. d} = {(\<chi> i. max (a$i) (c$i)) .. (\<chi> i. min (b$i) (d$i))}"
+ unfolding expand_set_eq and Int_iff and mem_interval
+ by (auto simp add: less_divide_eq_number_of1 intro!: bexI)
+
+(* Moved interval_open_subset_closed a bit upwards *)
+
+lemma open_interval_lemma: fixes x :: "real" shows
+ "a < x \<Longrightarrow> x < b ==> (\<exists>d>0. \<forall>x'. abs(x' - x) < d --> a < x' \<and> x' < b)"
+ by(rule_tac x="min (x - a) (b - x)" in exI, auto)
+
+lemma open_interval: fixes a :: "real^'n::finite" shows "open {a<..<b}"
+proof-
+ { fix x assume x:"x\<in>{a<..<b}"
+ { fix i
+ have "\<exists>d>0. \<forall>x'. abs (x' - (x$i)) < d \<longrightarrow> a$i < x' \<and> x' < b$i"
+ using x[unfolded mem_interval, THEN spec[where x=i]]
+ using open_interval_lemma[of "a$i" "x$i" "b$i"] by auto }
+
+ hence "\<forall>i. \<exists>d>0. \<forall>x'. abs (x' - (x$i)) < d \<longrightarrow> a$i < x' \<and> x' < b$i" by auto
+ 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)"
+ 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
+
+ let ?d = "Min (range d)"
+ have **:"finite (range d)" "range d \<noteq> {}" by auto
+ have "?d>0" unfolding Min_gr_iff[OF **] using d by auto
+ moreover
+ { fix x' assume as:"dist x' x < ?d"
+ { fix i
+ have "\<bar>x'$i - x $ i\<bar> < d i"
+ using norm_bound_component_lt[OF as[unfolded dist_norm], of i]
+ unfolding vector_minus_component and Min_gr_iff[OF **] by auto
+ hence "a $ i < x' $ i" "x' $ i < b $ i" using d[THEN spec[where x=i]] by auto }
+ hence "a < x' \<and> x' < b" unfolding vector_less_def by auto }
+ 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)
+ }
+ thus ?thesis unfolding open_dist using open_interval_lemma by auto
+qed
+
+lemma closed_interval: fixes a :: "real^'n::finite" shows "closed {a .. b}"
+proof-
+ { 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"*)
+ { assume xa:"a$i > x$i"
+ 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
+ hence False unfolding mem_interval and dist_norm
+ using component_le_norm[of "y-x" i, unfolded vector_minus_component] and xa by(auto elim!: allE[where x=i])
+ } hence "a$i \<le> x$i" by(rule ccontr)auto
+ moreover
+ { assume xb:"b$i < x$i"
+ 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
+ hence False unfolding mem_interval and dist_norm
+ using component_le_norm[of "y-x" i, unfolded vector_minus_component] and xb by(auto elim!: allE[where x=i])
+ } hence "x$i \<le> b$i" by(rule ccontr)auto
+ ultimately
+ have "a $ i \<le> x $ i \<and> x $ i \<le> b $ i" by auto }
+ thus ?thesis unfolding closed_limpt islimpt_approachable mem_interval by auto
+qed
+
+lemma interior_closed_interval: fixes a :: "real^'n::finite" shows
+ "interior {a .. b} = {a<..<b}" (is "?L = ?R")
+proof(rule subset_antisym)
+ show "?R \<subseteq> ?L" using interior_maximal[OF interval_open_subset_closed open_interval] by auto
+next
+ { fix x assume "\<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> {a..b}"
+ then obtain s where s:"open s" "x \<in> s" "s \<subseteq> {a..b}" by auto
+ 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
+ { fix i
+ have "dist (x - (e / 2) *\<^sub>R basis i) x < e"
+ "dist (x + (e / 2) *\<^sub>R basis i) x < e"
+ unfolding dist_norm apply auto
+ unfolding norm_minus_cancel using norm_basis[of i] and `e>0` by auto
+ hence "a $ i \<le> (x - (e / 2) *\<^sub>R basis i) $ i"
+ "(x + (e / 2) *\<^sub>R basis i) $ i \<le> b $ i"
+ using e[THEN spec[where x="x - (e/2) *\<^sub>R basis i"]]
+ and e[THEN spec[where x="x + (e/2) *\<^sub>R basis i"]]
+ unfolding mem_interval by (auto elim!: allE[where x=i])
+ hence "a $ i < x $ i" and "x $ i < b $ i"
+ unfolding vector_minus_component and vector_add_component
+ unfolding vector_smult_component and basis_component using `e>0` by auto }
+ hence "x \<in> {a<..<b}" unfolding mem_interval by auto }
+ thus "?L \<subseteq> ?R" unfolding interior_def and subset_eq by auto
+qed
+
+lemma bounded_closed_interval: fixes a :: "real^'n::finite" shows
+ "bounded {a .. b}"
+proof-
+ let ?b = "\<Sum>i\<in>UNIV. \<bar>a$i\<bar> + \<bar>b$i\<bar>"
+ { fix x::"real^'n" assume x:"\<forall>i. a $ i \<le> x $ i \<and> x $ i \<le> b $ i"
+ { fix i
+ have "\<bar>x$i\<bar> \<le> \<bar>a$i\<bar> + \<bar>b$i\<bar>" using x[THEN spec[where x=i]] by auto }
+ hence "(\<Sum>i\<in>UNIV. \<bar>x $ i\<bar>) \<le> ?b" by(rule setsum_mono)
+ hence "norm x \<le> ?b" using norm_le_l1[of x] by auto }
+ thus ?thesis unfolding interval and bounded_iff by auto
+qed
+
+lemma bounded_interval: fixes a :: "real^'n::finite" shows
+ "bounded {a .. b} \<and> bounded {a<..<b}"
+ using bounded_closed_interval[of a b]
+ using interval_open_subset_closed[of a b]
+ using bounded_subset[of "{a..b}" "{a<..<b}"]
+ by simp
+
+lemma not_interval_univ: fixes a :: "real^'n::finite" shows
+ "({a .. b} \<noteq> UNIV) \<and> ({a<..<b} \<noteq> UNIV)"
+ using bounded_interval[of a b]
+ by auto
+
+lemma compact_interval: fixes a :: "real^'n::finite" shows
+ "compact {a .. b}"
+ using bounded_closed_imp_compact using bounded_interval[of a b] using closed_interval[of a b] by auto
+
+lemma open_interval_midpoint: fixes a :: "real^'n::finite"
+ assumes "{a<..<b} \<noteq> {}" shows "((1/2) *\<^sub>R (a + b)) \<in> {a<..<b}"
+proof-
+ { fix i
+ have "a $ i < ((1 / 2) *\<^sub>R (a + b)) $ i \<and> ((1 / 2) *\<^sub>R (a + b)) $ i < b $ i"
+ using assms[unfolded interval_ne_empty, THEN spec[where x=i]]
+ unfolding vector_smult_component and vector_add_component
+ by(auto simp add: less_divide_eq_number_of1) }
+ thus ?thesis unfolding mem_interval by auto
+qed
+
+lemma open_closed_interval_convex: fixes x :: "real^'n::finite"
+ assumes x:"x \<in> {a<..<b}" and y:"y \<in> {a .. b}" and e:"0 < e" "e \<le> 1"
+ shows "(e *\<^sub>R x + (1 - e) *\<^sub>R y) \<in> {a<..<b}"
+proof-
+ { fix i
+ have "a $ i = e * a$i + (1 - e) * a$i" unfolding left_diff_distrib by simp
+ also have "\<dots> < e * x $ i + (1 - e) * y $ i" apply(rule add_less_le_mono)
+ using e unfolding mult_less_cancel_left and mult_le_cancel_left apply simp_all
+ using x unfolding mem_interval apply simp
+ using y unfolding mem_interval apply simp
+ done
+ finally have "a $ i < (e *\<^sub>R x + (1 - e) *\<^sub>R y) $ i" by auto
+ moreover {
+ have "b $ i = e * b$i + (1 - e) * b$i" unfolding left_diff_distrib by simp
+ also have "\<dots> > e * x $ i + (1 - e) * y $ i" apply(rule add_less_le_mono)
+ using e unfolding mult_less_cancel_left and mult_le_cancel_left apply simp_all
+ using x unfolding mem_interval apply simp
+ using y unfolding mem_interval apply simp
+ done
+ finally have "(e *\<^sub>R x + (1 - e) *\<^sub>R y) $ i < b $ i" by auto
+ } 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 }
+ thus ?thesis unfolding mem_interval by auto
+qed
+
+lemma closure_open_interval: fixes a :: "real^'n::finite"
+ assumes "{a<..<b} \<noteq> {}"
+ shows "closure {a<..<b} = {a .. b}"
+proof-
+ have ab:"a < b" using assms[unfolded interval_ne_empty] unfolding vector_less_def by auto
+ let ?c = "(1 / 2) *\<^sub>R (a + b)"
+ { fix x assume as:"x \<in> {a .. b}"
+ def f == "\<lambda>n::nat. x + (inverse (real n + 1)) *\<^sub>R (?c - x)"
+ { fix n assume fn:"f n < b \<longrightarrow> a < f n \<longrightarrow> f n = x" and xc:"x \<noteq> ?c"
+ have *:"0 < inverse (real n + 1)" "inverse (real n + 1) \<le> 1" unfolding inverse_le_1_iff by auto
+ have "(inverse (real n + 1)) *\<^sub>R ((1 / 2) *\<^sub>R (a + b)) + (1 - inverse (real n + 1)) *\<^sub>R x =
+ x + (inverse (real n + 1)) *\<^sub>R (((1 / 2) *\<^sub>R (a + b)) - x)"
+ by (auto simp add: algebra_simps)
+ 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
+ hence False using fn unfolding f_def using xc by(auto simp add: vector_mul_lcancel vector_ssub_ldistrib) }
+ moreover
+ { assume "\<not> (f ---> x) sequentially"
+ { fix e::real assume "e>0"
+ 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
+ then obtain N::nat where "inverse (real (N + 1)) < e" by auto
+ 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)
+ hence "\<exists>N::nat. \<forall>n\<ge>N. inverse (real n + 1) < e" by auto }
+ hence "((\<lambda>n. inverse (real n + 1)) ---> 0) sequentially"
+ unfolding Lim_sequentially by(auto simp add: dist_norm)
+ hence "(f ---> x) sequentially" unfolding f_def
+ 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]
+ using Lim_vmul[of "\<lambda>n::nat. inverse (real n + 1)" 0 sequentially "((1 / 2) *\<^sub>R (a + b) - x)"] by auto }
+ ultimately have "x \<in> closure {a<..<b}"
+ using as and open_interval_midpoint[OF assms] unfolding closure_def unfolding islimpt_sequential by(cases "x=?c")auto }
+ thus ?thesis using closure_minimal[OF interval_open_subset_closed closed_interval, of a b] by blast
+qed
+
+lemma bounded_subset_open_interval_symmetric: fixes s::"(real^'n::finite) set"
+ assumes "bounded s" shows "\<exists>a. s \<subseteq> {-a<..<a}"
+proof-
+ obtain b where "b>0" and b:"\<forall>x\<in>s. norm x \<le> b" using assms[unfolded bounded_pos] by auto
+ def a \<equiv> "(\<chi> i. b+1)::real^'n"
+ { fix x assume "x\<in>s"
+ fix i
+ 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]
+ unfolding vector_uminus_component and a_def and Cart_lambda_beta by auto
+ }
+ thus ?thesis by(auto intro: exI[where x=a] simp add: vector_less_def)
+qed
+
+lemma bounded_subset_open_interval:
+ fixes s :: "(real ^ 'n::finite) set"
+ shows "bounded s ==> (\<exists>a b. s \<subseteq> {a<..<b})"
+ by (auto dest!: bounded_subset_open_interval_symmetric)
+
+lemma bounded_subset_closed_interval_symmetric:
+ fixes s :: "(real ^ 'n::finite) set"
+ assumes "bounded s" shows "\<exists>a. s \<subseteq> {-a .. a}"
+proof-
+ obtain a where "s \<subseteq> {- a<..<a}" using bounded_subset_open_interval_symmetric[OF assms] by auto
+ thus ?thesis using interval_open_subset_closed[of "-a" a] by auto
+qed
+
+lemma bounded_subset_closed_interval:
+ fixes s :: "(real ^ 'n::finite) set"
+ shows "bounded s ==> (\<exists>a b. s \<subseteq> {a .. b})"
+ using bounded_subset_closed_interval_symmetric[of s] by auto
+
+lemma frontier_closed_interval:
+ fixes a b :: "real ^ _"
+ shows "frontier {a .. b} = {a .. b} - {a<..<b}"
+ unfolding frontier_def unfolding interior_closed_interval and closure_closed[OF closed_interval] ..
+
+lemma frontier_open_interval:
+ fixes a b :: "real ^ _"
+ shows "frontier {a<..<b} = (if {a<..<b} = {} then {} else {a .. b} - {a<..<b})"
+proof(cases "{a<..<b} = {}")
+ case True thus ?thesis using frontier_empty by auto
+next
+ case False thus ?thesis unfolding frontier_def and closure_open_interval[OF False] and interior_open[OF open_interval] by auto
+qed
+
+lemma inter_interval_mixed_eq_empty: fixes a :: "real^'n::finite"
+ assumes "{c<..<d} \<noteq> {}" shows "{a<..<b} \<inter> {c .. d} = {} \<longleftrightarrow> {a<..<b} \<inter> {c<..<d} = {}"
+ unfolding closure_open_interval[OF assms, THEN sym] unfolding open_inter_closure_eq_empty[OF open_interval] ..
+
+
+(* Some special cases for intervals in R^1. *)
+
+lemma all_1: "(\<forall>x::1. P x) \<longleftrightarrow> P 1"
+ by (metis num1_eq_iff)
+
+lemma ex_1: "(\<exists>x::1. P x) \<longleftrightarrow> P 1"
+ by auto (metis num1_eq_iff)
+
+lemma interval_cases_1: fixes x :: "real^1" shows
+ "x \<in> {a .. b} ==> x \<in> {a<..<b} \<or> (x = a) \<or> (x = b)"
+ by(simp add: Cart_eq vector_less_def vector_less_eq_def all_1, auto)
+
+lemma in_interval_1: fixes x :: "real^1" shows
+ "(x \<in> {a .. b} \<longleftrightarrow> dest_vec1 a \<le> dest_vec1 x \<and> dest_vec1 x \<le> dest_vec1 b) \<and>
+ (x \<in> {a<..<b} \<longleftrightarrow> dest_vec1 a < dest_vec1 x \<and> dest_vec1 x < dest_vec1 b)"
+by(simp add: Cart_eq vector_less_def vector_less_eq_def all_1 dest_vec1_def)
+
+lemma interval_eq_empty_1: fixes a :: "real^1" shows
+ "{a .. b} = {} \<longleftrightarrow> dest_vec1 b < dest_vec1 a"
+ "{a<..<b} = {} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a"
+ unfolding interval_eq_empty and ex_1 and dest_vec1_def by auto
+
+lemma subset_interval_1: fixes a :: "real^1" shows
+ "({a .. b} \<subseteq> {c .. d} \<longleftrightarrow> dest_vec1 b < dest_vec1 a \<or>
+ dest_vec1 c \<le> dest_vec1 a \<and> dest_vec1 a \<le> dest_vec1 b \<and> dest_vec1 b \<le> dest_vec1 d)"
+ "({a .. b} \<subseteq> {c<..<d} \<longleftrightarrow> dest_vec1 b < dest_vec1 a \<or>
+ dest_vec1 c < dest_vec1 a \<and> dest_vec1 a \<le> dest_vec1 b \<and> dest_vec1 b < dest_vec1 d)"
+ "({a<..<b} \<subseteq> {c .. d} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a \<or>
+ dest_vec1 c \<le> dest_vec1 a \<and> dest_vec1 a < dest_vec1 b \<and> dest_vec1 b \<le> dest_vec1 d)"
+ "({a<..<b} \<subseteq> {c<..<d} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a \<or>
+ dest_vec1 c \<le> dest_vec1 a \<and> dest_vec1 a < dest_vec1 b \<and> dest_vec1 b \<le> dest_vec1 d)"
+ unfolding subset_interval[of a b c d] unfolding all_1 and dest_vec1_def by auto
+
+lemma eq_interval_1: fixes a :: "real^1" shows
+ "{a .. b} = {c .. d} \<longleftrightarrow>
+ dest_vec1 b < dest_vec1 a \<and> dest_vec1 d < dest_vec1 c \<or>
+ dest_vec1 a = dest_vec1 c \<and> dest_vec1 b = dest_vec1 d"
+using set_eq_subset[of "{a .. b}" "{c .. d}"]
+using subset_interval_1(1)[of a b c d]
+using subset_interval_1(1)[of c d a b]
+by auto (* FIXME: slow *)
+
+lemma disjoint_interval_1: fixes a :: "real^1" shows
+ "{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"
+ "{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"
+ "{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"
+ "{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"
+ unfolding disjoint_interval and dest_vec1_def ex_1 by auto
+
+lemma open_closed_interval_1: fixes a :: "real^1" shows
+ "{a<..<b} = {a .. b} - {a, b}"
+ 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
+
+lemma closed_open_interval_1: "dest_vec1 (a::real^1) \<le> dest_vec1 b ==> {a .. b} = {a<..<b} \<union> {a,b}"
+ 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
+
+(* Some stuff for half-infinite intervals too; FIXME: notation? *)
+
+lemma closed_interval_left: fixes b::"real^'n::finite"
+ shows "closed {x::real^'n. \<forall>i. x$i \<le> b$i}"
+proof-
+ { fix i
+ 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"
+ { assume "x$i > b$i"
+ 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
+ hence False using component_le_norm[of "y - x" i] unfolding dist_norm and vector_minus_component by auto }
+ hence "x$i \<le> b$i" by(rule ccontr)auto }
+ thus ?thesis unfolding closed_limpt unfolding islimpt_approachable by blast
+qed
+
+lemma closed_interval_right: fixes a::"real^'n::finite"
+ shows "closed {x::real^'n. \<forall>i. a$i \<le> x$i}"
+proof-
+ { fix i
+ 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"
+ { assume "a$i > x$i"
+ 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
+ hence False using component_le_norm[of "y - x" i] unfolding dist_norm and vector_minus_component by auto }
+ hence "a$i \<le> x$i" by(rule ccontr)auto }
+ thus ?thesis unfolding closed_limpt unfolding islimpt_approachable by blast
+qed
+
+subsection{* Intervals in general, including infinite and mixtures of open and closed. *}
+
+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)"
+
+lemma is_interval_interval: "is_interval {a .. b::real^'n::finite}" (is ?th1) "is_interval {a<..<b}" (is ?th2) proof -
+ have *:"\<And>x y z::real. x < y \<Longrightarrow> y < z \<Longrightarrow> x < z" by auto
+ show ?th1 ?th2 unfolding is_interval_def mem_interval Ball_def atLeastAtMost_iff
+ by(meson real_le_trans le_less_trans less_le_trans *)+ qed
+
+lemma is_interval_empty:
+ "is_interval {}"
+ unfolding is_interval_def
+ by simp
+
+lemma is_interval_univ:
+ "is_interval UNIV"
+ unfolding is_interval_def
+ by simp
+
+subsection{* Closure of halfspaces and hyperplanes. *}
+
+lemma Lim_inner:
+ assumes "(f ---> l) net" shows "((\<lambda>y. inner a (f y)) ---> inner a l) net"
+ by (intro tendsto_intros assms)
+
+lemma continuous_at_inner: "continuous (at x) (inner a)"
+ unfolding continuous_at by (intro tendsto_intros)
+
+lemma continuous_on_inner:
+ fixes s :: "'a::real_inner set"
+ shows "continuous_on s (inner a)"
+ unfolding continuous_on by (rule ballI) (intro tendsto_intros)
+
+lemma closed_halfspace_le: "closed {x. inner a x \<le> b}"
+proof-
+ have "\<forall>x. continuous (at x) (inner a)"
+ unfolding continuous_at by (rule allI) (intro tendsto_intros)
+ hence "closed (inner a -` {..b})"
+ using closed_real_atMost by (rule continuous_closed_vimage)
+ moreover have "{x. inner a x \<le> b} = inner a -` {..b}" by auto
+ ultimately show ?thesis by simp
+qed
+
+lemma closed_halfspace_ge: "closed {x. inner a x \<ge> b}"
+ using closed_halfspace_le[of "-a" "-b"] unfolding inner_minus_left by auto
+
+lemma closed_hyperplane: "closed {x. inner a x = b}"
+proof-
+ have "{x. inner a x = b} = {x. inner a x \<ge> b} \<inter> {x. inner a x \<le> b}" by auto
+ thus ?thesis using closed_halfspace_le[of a b] and closed_halfspace_ge[of b a] using closed_Int by auto
+qed
+
+lemma closed_halfspace_component_le:
+ shows "closed {x::real^'n::finite. x$i \<le> a}"
+ using closed_halfspace_le[of "(basis i)::real^'n" a] unfolding inner_basis[OF assms] by auto
+
+lemma closed_halfspace_component_ge:
+ shows "closed {x::real^'n::finite. x$i \<ge> a}"
+ using closed_halfspace_ge[of a "(basis i)::real^'n"] unfolding inner_basis[OF assms] by auto
+
+text{* Openness of halfspaces. *}
+
+lemma open_halfspace_lt: "open {x. inner a x < b}"
+proof-
+ have "UNIV - {x. b \<le> inner a x} = {x. inner a x < b}" by auto
+ thus ?thesis using closed_halfspace_ge[unfolded closed_def Compl_eq_Diff_UNIV, of b a] by auto
+qed
+
+lemma open_halfspace_gt: "open {x. inner a x > b}"
+proof-
+ have "UNIV - {x. b \<ge> inner a x} = {x. inner a x > b}" by auto
+ thus ?thesis using closed_halfspace_le[unfolded closed_def Compl_eq_Diff_UNIV, of a b] by auto
+qed
+
+lemma open_halfspace_component_lt:
+ shows "open {x::real^'n::finite. x$i < a}"
+ using open_halfspace_lt[of "(basis i)::real^'n" a] unfolding inner_basis[OF assms] by auto
+
+lemma open_halfspace_component_gt:
+ shows "open {x::real^'n::finite. x$i > a}"
+ using open_halfspace_gt[of a "(basis i)::real^'n"] unfolding inner_basis[OF assms] by auto
+
+text{* This gives a simple derivation of limit component bounds. *}
+
+lemma Lim_component_le: fixes f :: "'a \<Rightarrow> real^'n::finite"
+ assumes "(f ---> l) net" "\<not> (trivial_limit net)" "eventually (\<lambda>x. f(x)$i \<le> b) net"
+ shows "l$i \<le> b"
+proof-
+ { 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
+ show ?thesis using Lim_in_closed_set[of "{x. inner (basis i) x \<le> b}" f net l] unfolding *
+ using closed_halfspace_le[of "(basis i)::real^'n" b] and assms(1,2,3) by auto
+qed
+
+lemma Lim_component_ge: fixes f :: "'a \<Rightarrow> real^'n::finite"
+ assumes "(f ---> l) net" "\<not> (trivial_limit net)" "eventually (\<lambda>x. b \<le> (f x)$i) net"
+ shows "b \<le> l$i"
+proof-
+ { 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
+ show ?thesis using Lim_in_closed_set[of "{x. inner (basis i) x \<ge> b}" f net l] unfolding *
+ using closed_halfspace_ge[of b "(basis i)::real^'n"] and assms(1,2,3) by auto
+qed
+
+lemma Lim_component_eq: fixes f :: "'a \<Rightarrow> real^'n::finite"
+ assumes net:"(f ---> l) net" "~(trivial_limit net)" and ev:"eventually (\<lambda>x. f(x)$i = b) net"
+ shows "l$i = b"
+ 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
+
+lemma Lim_drop_le: fixes f :: "'a \<Rightarrow> real^1" shows
+ "(f ---> l) net \<Longrightarrow> ~(trivial_limit net) \<Longrightarrow> eventually (\<lambda>x. dest_vec1 (f x) \<le> b) net ==> dest_vec1 l \<le> b"
+ using Lim_component_le[of f l net 1 b] unfolding dest_vec1_def by auto
+
+lemma Lim_drop_ge: fixes f :: "'a \<Rightarrow> real^1" shows
+ "(f ---> l) net \<Longrightarrow> ~(trivial_limit net) \<Longrightarrow> eventually (\<lambda>x. b \<le> dest_vec1 (f x)) net ==> b \<le> dest_vec1 l"
+ using Lim_component_ge[of f l net b 1] unfolding dest_vec1_def by auto
+
+text{* Limits relative to a union. *}
+
+lemma eventually_within_Un:
+ "eventually P (net within (s \<union> t)) \<longleftrightarrow>
+ eventually P (net within s) \<and> eventually P (net within t)"
+ unfolding Limits.eventually_within
+ by (auto elim!: eventually_rev_mp)
+
+lemma Lim_within_union:
+ "(f ---> l) (net within (s \<union> t)) \<longleftrightarrow>
+ (f ---> l) (net within s) \<and> (f ---> l) (net within t)"
+ unfolding tendsto_def
+ by (auto simp add: eventually_within_Un)
+
+lemma continuous_on_union:
+ assumes "closed s" "closed t" "continuous_on s f" "continuous_on t f"
+ shows "continuous_on (s \<union> t) f"
+ using assms unfolding continuous_on unfolding Lim_within_union
+ unfolding Lim unfolding trivial_limit_within unfolding closed_limpt by auto
+
+lemma continuous_on_cases:
+ assumes "closed s" "closed t" "continuous_on s f" "continuous_on t g"
+ "\<forall>x. (x\<in>s \<and> \<not> P x) \<or> (x \<in> t \<and> P x) \<longrightarrow> f x = g x"
+ shows "continuous_on (s \<union> t) (\<lambda>x. if P x then f x else g x)"
+proof-
+ let ?h = "(\<lambda>x. if P x then f x else g x)"
+ have "\<forall>x\<in>s. f x = (if P x then f x else g x)" using assms(5) by auto
+ hence "continuous_on s ?h" using continuous_on_eq[of s f ?h] using assms(3) by auto
+ moreover
+ have "\<forall>x\<in>t. g x = (if P x then f x else g x)" using assms(5) by auto
+ hence "continuous_on t ?h" using continuous_on_eq[of t g ?h] using assms(4) by auto
+ ultimately show ?thesis using continuous_on_union[OF assms(1,2), of ?h] by auto
+qed
+
+
+text{* Some more convenient intermediate-value theorem formulations. *}
+
+lemma connected_ivt_hyperplane:
+ assumes "connected s" "x \<in> s" "y \<in> s" "inner a x \<le> b" "b \<le> inner a y"
+ shows "\<exists>z \<in> s. inner a z = b"
+proof(rule ccontr)
+ assume as:"\<not> (\<exists>z\<in>s. inner a z = b)"
+ let ?A = "{x. inner a x < b}"
+ let ?B = "{x. inner a x > b}"
+ have "open ?A" "open ?B" using open_halfspace_lt and open_halfspace_gt by auto
+ moreover have "?A \<inter> ?B = {}" by auto
+ moreover have "s \<subseteq> ?A \<union> ?B" using as by auto
+ ultimately show False using assms(1)[unfolded connected_def not_ex, THEN spec[where x="?A"], THEN spec[where x="?B"]] and assms(2-5) by auto
+qed
+
+lemma connected_ivt_component: fixes x::"real^'n::finite" shows
+ "connected s \<Longrightarrow> x \<in> s \<Longrightarrow> y \<in> s \<Longrightarrow> x$k \<le> a \<Longrightarrow> a \<le> y$k \<Longrightarrow> (\<exists>z\<in>s. z$k = a)"
+ using connected_ivt_hyperplane[of s x y "(basis k)::real^'n" a] by (auto simp add: inner_basis)
+
+text{* Also more convenient formulations of monotone convergence. *}
+
+lemma bounded_increasing_convergent: fixes s::"nat \<Rightarrow> real^1"
+ assumes "bounded {s n| n::nat. True}" "\<forall>n. dest_vec1(s n) \<le> dest_vec1(s(Suc n))"
+ shows "\<exists>l. (s ---> l) sequentially"
+proof-
+ 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
+ { fix m::nat
+ have "\<And> n. n\<ge>m \<longrightarrow> dest_vec1 (s m) \<le> dest_vec1 (s n)"
+ apply(induct_tac n) apply simp using assms(2) apply(erule_tac x="na" in allE) by(auto simp add: not_less_eq_eq) }
+ hence "\<forall>m n. m \<le> n \<longrightarrow> dest_vec1 (s m) \<le> dest_vec1 (s n)" by auto
+ 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
+ thus ?thesis unfolding Lim_sequentially apply(rule_tac x="vec1 l" in exI)
+ unfolding dist_norm unfolding abs_dest_vec1 and dest_vec1_sub by auto
+qed
+
+subsection{* Basic homeomorphism definitions. *}
+
+definition "homeomorphism s t f g \<equiv>
+ (\<forall>x\<in>s. (g(f x) = x)) \<and> (f ` s = t) \<and> continuous_on s f \<and>
+ (\<forall>y\<in>t. (f(g y) = y)) \<and> (g ` t = s) \<and> continuous_on t g"
+
+definition
+ homeomorphic :: "'a::metric_space set \<Rightarrow> 'b::metric_space set \<Rightarrow> bool"
+ (infixr "homeomorphic" 60) where
+ homeomorphic_def: "s homeomorphic t \<equiv> (\<exists>f g. homeomorphism s t f g)"
+
+lemma homeomorphic_refl: "s homeomorphic s"
+ unfolding homeomorphic_def
+ unfolding homeomorphism_def
+ using continuous_on_id
+ apply(rule_tac x = "(\<lambda>x. x)" in exI)
+ apply(rule_tac x = "(\<lambda>x. x)" in exI)
+ by blast
+
+lemma homeomorphic_sym:
+ "s homeomorphic t \<longleftrightarrow> t homeomorphic s"
+unfolding homeomorphic_def
+unfolding homeomorphism_def
+by blast (* FIXME: slow *)
+
+lemma homeomorphic_trans:
+ assumes "s homeomorphic t" "t homeomorphic u" shows "s homeomorphic u"
+proof-
+ 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"
+ using assms(1) unfolding homeomorphic_def homeomorphism_def by auto
+ 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"
+ using assms(2) unfolding homeomorphic_def homeomorphism_def by auto
+
+ { 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 }
+ moreover have "(f2 \<circ> f1) ` s = u" using fg1(2) fg2(2) by auto
+ moreover have "continuous_on s (f2 \<circ> f1)" using continuous_on_compose[OF fg1(3)] and fg2(3) unfolding fg1(2) by auto
+ 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 }
+ moreover have "(g1 \<circ> g2) ` u = s" using fg1(5) fg2(5) by auto
+ moreover have "continuous_on u (g1 \<circ> g2)" using continuous_on_compose[OF fg2(6)] and fg1(6) unfolding fg2(5) by auto
+ 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
+qed
+
+lemma homeomorphic_minimal:
+ "s homeomorphic t \<longleftrightarrow>
+ (\<exists>f g. (\<forall>x\<in>s. f(x) \<in> t \<and> (g(f(x)) = x)) \<and>
+ (\<forall>y\<in>t. g(y) \<in> s \<and> (f(g(y)) = y)) \<and>
+ continuous_on s f \<and> continuous_on t g)"
+unfolding homeomorphic_def homeomorphism_def
+apply auto apply (rule_tac x=f in exI) apply (rule_tac x=g in exI)
+apply auto apply (rule_tac x=f in exI) apply (rule_tac x=g in exI) apply auto
+unfolding image_iff
+apply(erule_tac x="g x" in ballE) apply(erule_tac x="x" in ballE)
+apply auto apply(rule_tac x="g x" in bexI) apply auto
+apply(erule_tac x="f x" in ballE) apply(erule_tac x="x" in ballE)
+apply auto apply(rule_tac x="f x" in bexI) by auto
+
+subsection{* Relatively weak hypotheses if a set is compact. *}
+
+definition "inv_on f s = (\<lambda>x. SOME y. y\<in>s \<and> f y = x)"
+
+lemma assumes "inj_on f s" "x\<in>s"
+ shows "inv_on f s (f x) = x"
+ using assms unfolding inj_on_def inv_on_def by auto
+
+lemma homeomorphism_compact:
+ fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
+ (* class constraint due to continuous_on_inverse *)
+ assumes "compact s" "continuous_on s f" "f ` s = t" "inj_on f s"
+ shows "\<exists>g. homeomorphism s t f g"
+proof-
+ def g \<equiv> "\<lambda>x. SOME y. y\<in>s \<and> f y = x"
+ have g:"\<forall>x\<in>s. g (f x) = x" using assms(3) assms(4)[unfolded inj_on_def] unfolding g_def by auto
+ { fix y assume "y\<in>t"
+ then obtain x where x:"f x = y" "x\<in>s" using assms(3) by auto
+ hence "g (f x) = x" using g by auto
+ hence "f (g y) = y" unfolding x(1)[THEN sym] by auto }
+ hence g':"\<forall>x\<in>t. f (g x) = x" by auto
+ moreover
+ { fix x
+ 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"])
+ moreover
+ { assume "x\<in>g ` t"
+ then obtain y where y:"y\<in>t" "g y = x" by auto
+ then obtain x' where x':"x'\<in>s" "f x' = y" using assms(3) by auto
+ 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 }
+ ultimately have "x\<in>s \<longleftrightarrow> x \<in> g ` t" by auto }
+ hence "g ` t = s" by auto
+ ultimately
+ show ?thesis unfolding homeomorphism_def homeomorphic_def
+ 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
+qed
+
+lemma homeomorphic_compact:
+ fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
+ (* class constraint due to continuous_on_inverse *)
+ shows "compact s \<Longrightarrow> continuous_on s f \<Longrightarrow> (f ` s = t) \<Longrightarrow> inj_on f s
+ \<Longrightarrow> s homeomorphic t"
+ unfolding homeomorphic_def by(metis homeomorphism_compact)
+
+text{* Preservation of topological properties. *}
+
+lemma homeomorphic_compactness:
+ "s homeomorphic t ==> (compact s \<longleftrightarrow> compact t)"
+unfolding homeomorphic_def homeomorphism_def
+by (metis compact_continuous_image)
+
+text{* Results on translation, scaling etc. *}
+
+lemma homeomorphic_scaling:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "c \<noteq> 0" shows "s homeomorphic ((\<lambda>x. c *\<^sub>R x) ` s)"
+ unfolding homeomorphic_minimal
+ apply(rule_tac x="\<lambda>x. c *\<^sub>R x" in exI)
+ apply(rule_tac x="\<lambda>x. (1 / c) *\<^sub>R x" in exI)
+ using assms apply auto
+ using continuous_on_cmul[OF continuous_on_id] by auto
+
+lemma homeomorphic_translation:
+ fixes s :: "'a::real_normed_vector set"
+ shows "s homeomorphic ((\<lambda>x. a + x) ` s)"
+ unfolding homeomorphic_minimal
+ apply(rule_tac x="\<lambda>x. a + x" in exI)
+ apply(rule_tac x="\<lambda>x. -a + x" in exI)
+ using continuous_on_add[OF continuous_on_const continuous_on_id] by auto
+
+lemma homeomorphic_affinity:
+ fixes s :: "'a::real_normed_vector set"
+ assumes "c \<noteq> 0" shows "s homeomorphic ((\<lambda>x. a + c *\<^sub>R x) ` s)"
+proof-
+ have *:"op + a ` op *\<^sub>R c ` s = (\<lambda>x. a + c *\<^sub>R x) ` s" by auto
+ show ?thesis
+ using homeomorphic_trans
+ using homeomorphic_scaling[OF assms, of s]
+ using homeomorphic_translation[of "(\<lambda>x. c *\<^sub>R x) ` s" a] unfolding * by auto
+qed
+
+lemma homeomorphic_balls:
+ fixes a b ::"'a::real_normed_vector" (* FIXME: generalize to metric_space *)
+ assumes "0 < d" "0 < e"
+ shows "(ball a d) homeomorphic (ball b e)" (is ?th)
+ "(cball a d) homeomorphic (cball b e)" (is ?cth)
+proof-
+ have *:"\<bar>e / d\<bar> > 0" "\<bar>d / e\<bar> >0" using assms using divide_pos_pos by auto
+ show ?th unfolding homeomorphic_minimal
+ apply(rule_tac x="\<lambda>x. b + (e/d) *\<^sub>R (x - a)" in exI)
+ apply(rule_tac x="\<lambda>x. a + (d/e) *\<^sub>R (x - b)" in exI)
+ using assms apply (auto simp add: dist_commute)
+ unfolding dist_norm
+ apply (auto simp add: pos_divide_less_eq mult_strict_left_mono)
+ unfolding continuous_on
+ by (intro ballI tendsto_intros, simp, assumption)+
+next
+ have *:"\<bar>e / d\<bar> > 0" "\<bar>d / e\<bar> >0" using assms using divide_pos_pos by auto
+ show ?cth unfolding homeomorphic_minimal
+ apply(rule_tac x="\<lambda>x. b + (e/d) *\<^sub>R (x - a)" in exI)
+ apply(rule_tac x="\<lambda>x. a + (d/e) *\<^sub>R (x - b)" in exI)
+ using assms apply (auto simp add: dist_commute)
+ unfolding dist_norm
+ apply (auto simp add: pos_divide_le_eq)
+ unfolding continuous_on
+ by (intro ballI tendsto_intros, simp, assumption)+
+qed
+
+text{* "Isometry" (up to constant bounds) of injective linear map etc. *}
+
+lemma cauchy_isometric:
+ fixes x :: "nat \<Rightarrow> real ^ 'n::finite"
+ 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)"
+ shows "Cauchy x"
+proof-
+ interpret f: bounded_linear f by fact
+ { fix d::real assume "d>0"
+ then obtain N where N:"\<forall>n\<ge>N. norm (f (x n) - f (x N)) < e * d"
+ 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
+ { fix n assume "n\<ge>N"
+ hence "norm (f (x n - x N)) < e * d" using N[THEN spec[where x=n]] unfolding f.diff[THEN sym] by auto
+ moreover have "e * norm (x n - x N) \<le> norm (f (x n - x N))"
+ using subspace_sub[OF s, of "x n" "x N"] using xs[THEN spec[where x=N]] and xs[THEN spec[where x=n]]
+ using normf[THEN bspec[where x="x n - x N"]] by auto
+ ultimately have "norm (x n - x N) < d" using `e>0`
+ using mult_left_less_imp_less[of e "norm (x n - x N)" d] by auto }
+ hence "\<exists>N. \<forall>n\<ge>N. norm (x n - x N) < d" by auto }
+ thus ?thesis unfolding cauchy and dist_norm by auto
+qed
+
+lemma complete_isometric_image:
+ fixes f :: "real ^ _ \<Rightarrow> real ^ _"
+ 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"
+ shows "complete(f ` s)"
+proof-
+ { fix g assume as:"\<forall>n::nat. g n \<in> f ` s" and cfg:"Cauchy g"
+ then obtain x where "\<forall>n. x n \<in> s \<and> g n = f (x n)" unfolding image_iff and Bex_def
+ using choice[of "\<lambda> n xa. xa \<in> s \<and> g n = f xa"] by auto
+ hence x:"\<forall>n. x n \<in> s" "\<forall>n. g n = f (x n)" by auto
+ hence "f \<circ> x = g" unfolding expand_fun_eq by auto
+ then obtain l where "l\<in>s" and l:"(x ---> l) sequentially"
+ using cs[unfolded complete_def, THEN spec[where x="x"]]
+ using cauchy_isometric[OF `0<e` s f normf] and cfg and x(1) by auto
+ hence "\<exists>l\<in>f ` s. (g ---> l) sequentially"
+ using linear_continuous_at[OF f, unfolded continuous_at_sequentially, THEN spec[where x=x], of l]
+ unfolding `f \<circ> x = g` by auto }
+ thus ?thesis unfolding complete_def by auto
+qed
+
+lemma dist_0_norm:
+ fixes x :: "'a::real_normed_vector"
+ shows "dist 0 x = norm x"
+unfolding dist_norm by simp
+
+lemma injective_imp_isometric: fixes f::"real^'m::finite \<Rightarrow> real^'n::finite"
+ assumes s:"closed s" "subspace s" and f:"bounded_linear f" "\<forall>x\<in>s. (f x = 0) \<longrightarrow> (x = 0)"
+ shows "\<exists>e>0. \<forall>x\<in>s. norm (f x) \<ge> e * norm(x)"
+proof(cases "s \<subseteq> {0::real^'m}")
+ case True
+ { fix x assume "x \<in> s"
+ hence "x = 0" using True by auto
+ hence "norm x \<le> norm (f x)" by auto }
+ thus ?thesis by(auto intro!: exI[where x=1])
+next
+ interpret f: bounded_linear f by fact
+ case False
+ then obtain a where a:"a\<noteq>0" "a\<in>s" by auto
+ from False have "s \<noteq> {}" by auto
+ let ?S = "{f x| x. (x \<in> s \<and> norm x = norm a)}"
+ let ?S' = "{x::real^'m. x\<in>s \<and> norm x = norm a}"
+ let ?S'' = "{x::real^'m. norm x = norm a}"
+
+ have "?S'' = frontier(cball 0 (norm a))" unfolding frontier_cball and dist_norm by (auto simp add: norm_minus_cancel)
+ hence "compact ?S''" using compact_frontier[OF compact_cball, of 0 "norm a"] by auto
+ moreover have "?S' = s \<inter> ?S''" by auto
+ ultimately have "compact ?S'" using closed_inter_compact[of s ?S''] using s(1) by auto
+ moreover have *:"f ` ?S' = ?S" by auto
+ ultimately have "compact ?S" using compact_continuous_image[OF linear_continuous_on[OF f(1)], of ?S'] by auto
+ hence "closed ?S" using compact_imp_closed by auto
+ moreover have "?S \<noteq> {}" using a by auto
+ ultimately obtain b' where "b'\<in>?S" "\<forall>y\<in>?S. norm b' \<le> norm y" using distance_attains_inf[of ?S 0] unfolding dist_0_norm by auto
+ then obtain b where "b\<in>s" and ba:"norm b = norm a" and b:"\<forall>x\<in>{x \<in> s. norm x = norm a}. norm (f b) \<le> norm (f x)" unfolding *[THEN sym] unfolding image_iff by auto
+
+ let ?e = "norm (f b) / norm b"
+ have "norm b > 0" using ba and a and norm_ge_zero by auto
+ moreover have "norm (f b) > 0" using f(2)[THEN bspec[where x=b], OF `b\<in>s`] using `norm b >0` unfolding zero_less_norm_iff by auto
+ ultimately have "0 < norm (f b) / norm b" by(simp only: divide_pos_pos)
+ moreover
+ { fix x assume "x\<in>s"
+ hence "norm (f b) / norm b * norm x \<le> norm (f x)"
+ proof(cases "x=0")
+ case True thus "norm (f b) / norm b * norm x \<le> norm (f x)" by auto
+ next
+ case False
+ hence *:"0 < norm a / norm x" using `a\<noteq>0` unfolding zero_less_norm_iff[THEN sym] by(simp only: divide_pos_pos)
+ have "\<forall>c. \<forall>x\<in>s. c *\<^sub>R x \<in> s" using s[unfolded subspace_def smult_conv_scaleR] by auto
+ 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
+ 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"]]
+ unfolding f.scaleR and ba using `x\<noteq>0` `a\<noteq>0`
+ by (auto simp add: real_mult_commute pos_le_divide_eq pos_divide_le_eq)
+ qed }
+ ultimately
+ show ?thesis by auto
+qed
+
+lemma closed_injective_image_subspace:
+ fixes f :: "real ^ _ \<Rightarrow> real ^ _"
+ assumes "subspace s" "bounded_linear f" "\<forall>x\<in>s. f x = 0 --> x = 0" "closed s"
+ shows "closed(f ` s)"
+proof-
+ obtain e where "e>0" and e:"\<forall>x\<in>s. e * norm x \<le> norm (f x)" using injective_imp_isometric[OF assms(4,1,2,3)] by auto
+ show ?thesis using complete_isometric_image[OF `e>0` assms(1,2) e] and assms(4)
+ unfolding complete_eq_closed[THEN sym] by auto
+qed
+
+subsection{* Some properties of a canonical subspace. *}
+
+lemma subspace_substandard:
+ "subspace {x::real^'n. (\<forall>i. P i \<longrightarrow> x$i = 0)}"
+ unfolding subspace_def by(auto simp add: vector_add_component vector_smult_component elim!: ballE)
+
+lemma closed_substandard:
+ "closed {x::real^'n::finite. \<forall>i. P i --> x$i = 0}" (is "closed ?A")
+proof-
+ let ?D = "{i. P i}"
+ let ?Bs = "{{x::real^'n. inner (basis i) x = 0}| i. i \<in> ?D}"
+ { fix x
+ { assume "x\<in>?A"
+ hence x:"\<forall>i\<in>?D. x $ i = 0" by auto
+ hence "x\<in> \<Inter> ?Bs" by(auto simp add: inner_basis x) }
+ moreover
+ { assume x:"x\<in>\<Inter>?Bs"
+ { fix i assume i:"i \<in> ?D"
+ then obtain B where BB:"B \<in> ?Bs" and B:"B = {x::real^'n. inner (basis i) x = 0}" by auto
+ hence "x $ i = 0" unfolding B using x unfolding inner_basis by auto }
+ hence "x\<in>?A" by auto }
+ ultimately have "x\<in>?A \<longleftrightarrow> x\<in> \<Inter>?Bs" by auto }
+ hence "?A = \<Inter> ?Bs" by auto
+ thus ?thesis by(auto simp add: closed_Inter closed_hyperplane)
+qed
+
+lemma dim_substandard:
+ shows "dim {x::real^'n::finite. \<forall>i. i \<notin> d \<longrightarrow> x$i = 0} = card d" (is "dim ?A = _")
+proof-
+ let ?D = "UNIV::'n set"
+ let ?B = "(basis::'n\<Rightarrow>real^'n) ` d"
+
+ let ?bas = "basis::'n \<Rightarrow> real^'n"
+
+ have "?B \<subseteq> ?A" by auto
+
+ moreover
+ { fix x::"real^'n" assume "x\<in>?A"
+ with finite[of d]
+ have "x\<in> span ?B"
+ proof(induct d arbitrary: x)
+ case empty hence "x=0" unfolding Cart_eq by auto
+ thus ?case using subspace_0[OF subspace_span[of "{}"]] by auto
+ next
+ case (insert k F)
+ hence *:"\<forall>i. i \<notin> insert k F \<longrightarrow> x $ i = 0" by auto
+ have **:"F \<subseteq> insert k F" by auto
+ def y \<equiv> "x - x$k *\<^sub>R basis k"
+ have y:"x = y + (x$k) *\<^sub>R basis k" unfolding y_def by auto
+ { fix i assume i':"i \<notin> F"
+ hence "y $ i = 0" unfolding y_def unfolding vector_minus_component
+ and vector_smult_component and basis_component
+ using *[THEN spec[where x=i]] by auto }
+ hence "y \<in> span (basis ` (insert k F))" using insert(3)
+ using span_mono[of "?bas ` F" "?bas ` (insert k F)"]
+ using image_mono[OF **, of basis] by auto
+ moreover
+ have "basis k \<in> span (?bas ` (insert k F))" by(rule span_superset, auto)
+ hence "x$k *\<^sub>R basis k \<in> span (?bas ` (insert k F))"
+ using span_mul [where 'a=real, unfolded smult_conv_scaleR] by auto
+ ultimately
+ have "y + x$k *\<^sub>R basis k \<in> span (?bas ` (insert k F))"
+ using span_add by auto
+ thus ?case using y by auto
+ qed
+ }
+ hence "?A \<subseteq> span ?B" by auto
+
+ moreover
+ { fix x assume "x \<in> ?B"
+ hence "x\<in>{(basis i)::real^'n |i. i \<in> ?D}" using assms by auto }
+ hence "independent ?B" using independent_mono[OF independent_stdbasis, of ?B] and assms by auto
+
+ moreover
+ have "d \<subseteq> ?D" unfolding subset_eq using assms by auto
+ hence *:"inj_on (basis::'n\<Rightarrow>real^'n) d" using subset_inj_on[OF basis_inj, of "d"] by auto
+ have "?B hassize (card d)" unfolding hassize_def and card_image[OF *] by auto
+
+ ultimately show ?thesis using dim_unique[of "basis ` d" ?A] by auto
+qed
+
+text{* Hence closure and completeness of all subspaces. *}
+
+lemma closed_subspace_lemma: "n \<le> card (UNIV::'n::finite set) \<Longrightarrow> \<exists>A::'n set. card A = n"
+apply (induct n)
+apply (rule_tac x="{}" in exI, simp)
+apply clarsimp
+apply (subgoal_tac "\<exists>x. x \<notin> A")
+apply (erule exE)
+apply (rule_tac x="insert x A" in exI, simp)
+apply (subgoal_tac "A \<noteq> UNIV", auto)
+done
+
+lemma closed_subspace: fixes s::"(real^'n::finite) set"
+ assumes "subspace s" shows "closed s"
+proof-
+ have "dim s \<le> card (UNIV :: 'n set)" using dim_subset_univ by auto
+ then obtain d::"'n set" where t: "card d = dim s"
+ using closed_subspace_lemma by auto
+ let ?t = "{x::real^'n. \<forall>i. i \<notin> d \<longrightarrow> x$i = 0}"
+ obtain f where f:"bounded_linear f" "f ` ?t = s" "inj_on f ?t"
+ using subspace_isomorphism[unfolded linear_conv_bounded_linear, OF subspace_substandard[of "\<lambda>i. i \<notin> d"] assms]
+ using dim_substandard[of d] and t by auto
+ interpret f: bounded_linear f by fact
+ have "\<forall>x\<in>?t. f x = 0 \<longrightarrow> x = 0" using f.zero using f(3)[unfolded inj_on_def]
+ by(erule_tac x=0 in ballE) auto
+ moreover have "closed ?t" using closed_substandard .
+ moreover have "subspace ?t" using subspace_substandard .
+ ultimately show ?thesis using closed_injective_image_subspace[of ?t f]
+ unfolding f(2) using f(1) by auto
+qed
+
+lemma complete_subspace:
+ fixes s :: "(real ^ _) set" shows "subspace s ==> complete s"
+ using complete_eq_closed closed_subspace
+ by auto
+
+lemma dim_closure:
+ fixes s :: "(real ^ _) set"
+ shows "dim(closure s) = dim s" (is "?dc = ?d")
+proof-
+ have "?dc \<le> ?d" using closure_minimal[OF span_inc, of s]
+ using closed_subspace[OF subspace_span, of s]
+ using dim_subset[of "closure s" "span s"] unfolding dim_span by auto
+ thus ?thesis using dim_subset[OF closure_subset, of s] by auto
+qed
+
+text{* Affine transformations of intervals. *}
+
+lemma affinity_inverses:
+ assumes m0: "m \<noteq> (0::'a::field)"
+ shows "(\<lambda>x. m *s x + c) o (\<lambda>x. inverse(m) *s x + (-(inverse(m) *s c))) = id"
+ "(\<lambda>x. inverse(m) *s x + (-(inverse(m) *s c))) o (\<lambda>x. m *s x + c) = id"
+ using m0
+apply (auto simp add: expand_fun_eq vector_add_ldistrib vector_smult_assoc)
+by (simp add: vector_smult_lneg[symmetric] vector_smult_assoc vector_sneg_minus1[symmetric])
+
+lemma real_affinity_le:
+ "0 < (m::'a::ordered_field) ==> (m * x + c \<le> y \<longleftrightarrow> x \<le> inverse(m) * y + -(c / m))"
+ by (simp add: field_simps inverse_eq_divide)
+
+lemma real_le_affinity:
+ "0 < (m::'a::ordered_field) ==> (y \<le> m * x + c \<longleftrightarrow> inverse(m) * y + -(c / m) \<le> x)"
+ by (simp add: field_simps inverse_eq_divide)
+
+lemma real_affinity_lt:
+ "0 < (m::'a::ordered_field) ==> (m * x + c < y \<longleftrightarrow> x < inverse(m) * y + -(c / m))"
+ by (simp add: field_simps inverse_eq_divide)
+
+lemma real_lt_affinity:
+ "0 < (m::'a::ordered_field) ==> (y < m * x + c \<longleftrightarrow> inverse(m) * y + -(c / m) < x)"
+ by (simp add: field_simps inverse_eq_divide)
+
+lemma real_affinity_eq:
+ "(m::'a::ordered_field) \<noteq> 0 ==> (m * x + c = y \<longleftrightarrow> x = inverse(m) * y + -(c / m))"
+ by (simp add: field_simps inverse_eq_divide)
+
+lemma real_eq_affinity:
+ "(m::'a::ordered_field) \<noteq> 0 ==> (y = m * x + c \<longleftrightarrow> inverse(m) * y + -(c / m) = x)"
+ by (simp add: field_simps inverse_eq_divide)
+
+lemma vector_affinity_eq:
+ assumes m0: "(m::'a::field) \<noteq> 0"
+ shows "m *s x + c = y \<longleftrightarrow> x = inverse m *s y + -(inverse m *s c)"
+proof
+ assume h: "m *s x + c = y"
+ hence "m *s x = y - c" by (simp add: ring_simps)
+ hence "inverse m *s (m *s x) = inverse m *s (y - c)" by simp
+ then show "x = inverse m *s y + - (inverse m *s c)"
+ using m0 by (simp add: vector_smult_assoc vector_ssub_ldistrib)
+next
+ assume h: "x = inverse m *s y + - (inverse m *s c)"
+ show "m *s x + c = y" unfolding h diff_minus[symmetric]
+ using m0 by (simp add: vector_smult_assoc vector_ssub_ldistrib)
+qed
+
+lemma vector_eq_affinity:
+ "(m::'a::field) \<noteq> 0 ==> (y = m *s x + c \<longleftrightarrow> inverse(m) *s y + -(inverse(m) *s c) = x)"
+ using vector_affinity_eq[where m=m and x=x and y=y and c=c]
+ by metis
+
+lemma image_affinity_interval: fixes m::real
+ fixes a b c :: "real^'n::finite"
+ shows "(\<lambda>x. m *\<^sub>R x + c) ` {a .. b} =
+ (if {a .. b} = {} then {}
+ else (if 0 \<le> m then {m *\<^sub>R a + c .. m *\<^sub>R b + c}
+ else {m *\<^sub>R b + c .. m *\<^sub>R a + c}))"
+proof(cases "m=0")
+ { fix x assume "x \<le> c" "c \<le> x"
+ hence "x=c" unfolding vector_less_eq_def and Cart_eq by (auto intro: order_antisym) }
+ moreover case True
+ moreover have "c \<in> {m *\<^sub>R a + c..m *\<^sub>R b + c}" unfolding True by(auto simp add: vector_less_eq_def)
+ ultimately show ?thesis by auto
+next
+ case False
+ { fix y assume "a \<le> y" "y \<le> b" "m > 0"
+ hence "m *\<^sub>R a + c \<le> m *\<^sub>R y + c" "m *\<^sub>R y + c \<le> m *\<^sub>R b + c"
+ unfolding vector_less_eq_def by(auto simp add: vector_smult_component vector_add_component)
+ } moreover
+ { fix y assume "a \<le> y" "y \<le> b" "m < 0"
+ hence "m *\<^sub>R b + c \<le> m *\<^sub>R y + c" "m *\<^sub>R y + c \<le> m *\<^sub>R a + c"
+ unfolding vector_less_eq_def by(auto simp add: vector_smult_component vector_add_component mult_left_mono_neg elim!:ballE)
+ } moreover
+ { fix y assume "m > 0" "m *\<^sub>R a + c \<le> y" "y \<le> m *\<^sub>R b + c"
+ hence "y \<in> (\<lambda>x. m *\<^sub>R x + c) ` {a..b}"
+ unfolding image_iff Bex_def mem_interval vector_less_eq_def
+ apply(auto simp add: vector_smult_component vector_add_component vector_minus_component vector_smult_assoc pth_3[symmetric]
+ intro!: exI[where x="(1 / m) *\<^sub>R (y - c)"])
+ by(auto simp add: pos_le_divide_eq pos_divide_le_eq real_mult_commute diff_le_iff)
+ } moreover
+ { fix y assume "m *\<^sub>R b + c \<le> y" "y \<le> m *\<^sub>R a + c" "m < 0"
+ hence "y \<in> (\<lambda>x. m *\<^sub>R x + c) ` {a..b}"
+ unfolding image_iff Bex_def mem_interval vector_less_eq_def
+ apply(auto simp add: vector_smult_component vector_add_component vector_minus_component vector_smult_assoc pth_3[symmetric]
+ intro!: exI[where x="(1 / m) *\<^sub>R (y - c)"])
+ by(auto simp add: neg_le_divide_eq neg_divide_le_eq real_mult_commute diff_le_iff)
+ }
+ ultimately show ?thesis using False by auto
+qed
+
+lemma image_smult_interval:"(\<lambda>x. m *\<^sub>R (x::real^'n::finite)) ` {a..b} =
+ (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})"
+ using image_affinity_interval[of m 0 a b] by auto
+
+subsection{* Banach fixed point theorem (not really topological...) *}
+
+lemma banach_fix:
+ assumes s:"complete s" "s \<noteq> {}" and c:"0 \<le> c" "c < 1" and f:"(f ` s) \<subseteq> s" and
+ lipschitz:"\<forall>x\<in>s. \<forall>y\<in>s. dist (f x) (f y) \<le> c * dist x y"
+ shows "\<exists>! x\<in>s. (f x = x)"
+proof-
+ have "1 - c > 0" using c by auto
+
+ from s(2) obtain z0 where "z0 \<in> s" by auto
+ def z \<equiv> "\<lambda>n. (f ^^ n) z0"
+ { fix n::nat
+ have "z n \<in> s" unfolding z_def
+ proof(induct n) case 0 thus ?case using `z0 \<in>s` by auto
+ next case Suc thus ?case using f by auto qed }
+ note z_in_s = this
+
+ def d \<equiv> "dist (z 0) (z 1)"
+
+ have fzn:"\<And>n. f (z n) = z (Suc n)" unfolding z_def by auto
+ { fix n::nat
+ have "dist (z n) (z (Suc n)) \<le> (c ^ n) * d"
+ proof(induct n)
+ case 0 thus ?case unfolding d_def by auto
+ next
+ case (Suc m)
+ hence "c * dist (z m) (z (Suc m)) \<le> c ^ Suc m * d"
+ using `0 \<le> c` using mult_mono1_class.mult_mono1[of "dist (z m) (z (Suc m))" "c ^ m * d" c] by auto
+ 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]
+ unfolding fzn and mult_le_cancel_left by auto
+ qed
+ } note cf_z = this
+
+ { fix n m::nat
+ have "(1 - c) * dist (z m) (z (m+n)) \<le> (c ^ m) * d * (1 - c ^ n)"
+ proof(induct n)
+ case 0 show ?case by auto
+ next
+ case (Suc k)
+ 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))))"
+ using dist_triangle and c by(auto simp add: dist_triangle)
+ also have "\<dots> \<le> (1 - c) * (dist (z m) (z (m + k)) + c ^ (m + k) * d)"
+ using cf_z[of "m + k"] and c by auto
+ also have "\<dots> \<le> c ^ m * d * (1 - c ^ k) + (1 - c) * c ^ (m + k) * d"
+ using Suc by (auto simp add: ring_simps)
+ also have "\<dots> = (c ^ m) * (d * (1 - c ^ k) + (1 - c) * c ^ k * d)"
+ unfolding power_add by (auto simp add: ring_simps)
+ also have "\<dots> \<le> (c ^ m) * d * (1 - c ^ Suc k)"
+ using c by (auto simp add: ring_simps)
+ finally show ?case by auto
+ qed
+ } note cf_z2 = this
+ { fix e::real assume "e>0"
+ hence "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (z m) (z n) < e"
+ proof(cases "d = 0")
+ case True
+ 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`])
+ thus ?thesis using `e>0` by auto
+ next
+ case False hence "d>0" unfolding d_def using zero_le_dist[of "z 0" "z 1"]
+ by (metis False d_def real_less_def)
+ hence "0 < e * (1 - c) / d" using `e>0` and `1-c>0`
+ using divide_pos_pos[of "e * (1 - c)" d] and mult_pos_pos[of e "1 - c"] by auto
+ 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
+ { fix m n::nat assume "m>n" and as:"m\<ge>N" "n\<ge>N"
+ have *:"c ^ n \<le> c ^ N" using `n\<ge>N` and c using power_decreasing[OF `n\<ge>N`, of c] by auto
+ have "1 - c ^ (m - n) > 0" using c and power_strict_mono[of c 1 "m - n"] using `m>n` by auto
+ hence **:"d * (1 - c ^ (m - n)) / (1 - c) > 0"
+ using real_mult_order[OF `d>0`, of "1 - c ^ (m - n)"]
+ using divide_pos_pos[of "d * (1 - c ^ (m - n))" "1 - c"]
+ using `0 < 1 - c` by auto
+
+ have "dist (z m) (z n) \<le> c ^ n * d * (1 - c ^ (m - n)) / (1 - c)"
+ using cf_z2[of n "m - n"] and `m>n` unfolding pos_le_divide_eq[OF `1-c>0`]
+ by (auto simp add: real_mult_commute dist_commute)
+ also have "\<dots> \<le> c ^ N * d * (1 - c ^ (m - n)) / (1 - c)"
+ using mult_right_mono[OF * order_less_imp_le[OF **]]
+ unfolding real_mult_assoc by auto
+ also have "\<dots> < (e * (1 - c) / d) * d * (1 - c ^ (m - n)) / (1 - c)"
+ using mult_strict_right_mono[OF N **] unfolding real_mult_assoc by auto
+ also have "\<dots> = e * (1 - c ^ (m - n))" using c and `d>0` and `1 - c > 0` by auto
+ 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
+ finally have "dist (z m) (z n) < e" by auto
+ } note * = this
+ { fix m n::nat assume as:"N\<le>m" "N\<le>n"
+ hence "dist (z n) (z m) < e"
+ proof(cases "n = m")
+ case True thus ?thesis using `e>0` by auto
+ next
+ case False thus ?thesis using as and *[of n m] *[of m n] unfolding nat_neq_iff by (auto simp add: dist_commute)
+ qed }
+ thus ?thesis by auto
+ qed
+ }
+ hence "Cauchy z" unfolding cauchy_def by auto
+ 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
+
+ def e \<equiv> "dist (f x) x"
+ have "e = 0" proof(rule ccontr)
+ assume "e \<noteq> 0" hence "e>0" unfolding e_def using zero_le_dist[of "f x" x]
+ by (metis dist_eq_0_iff dist_nz e_def)
+ then obtain N where N:"\<forall>n\<ge>N. dist (z n) x < e / 2"
+ using x[unfolded Lim_sequentially, THEN spec[where x="e/2"]] by auto
+ hence N':"dist (z N) x < e / 2" by auto
+
+ have *:"c * dist (z N) x \<le> dist (z N) x" unfolding mult_le_cancel_right2
+ using zero_le_dist[of "z N" x] and c
+ by (metis dist_eq_0_iff dist_nz order_less_asym real_less_def)
+ 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]]
+ using z_in_s[of N] `x\<in>s` using c by auto
+ also have "\<dots> < e / 2" using N' and c using * by auto
+ finally show False unfolding fzn
+ using N[THEN spec[where x="Suc N"]] and dist_triangle_half_r[of "z (Suc N)" "f x" e x]
+ unfolding e_def by auto
+ qed
+ hence "f x = x" unfolding e_def by auto
+ moreover
+ { fix y assume "f y = y" "y\<in>s"
+ hence "dist x y \<le> c * dist x y" using lipschitz[THEN bspec[where x=x], THEN bspec[where x=y]]
+ using `x\<in>s` and `f x = x` by auto
+ hence "dist x y = 0" unfolding mult_le_cancel_right1
+ using c and zero_le_dist[of x y] by auto
+ hence "y = x" by auto
+ }
+ ultimately show ?thesis unfolding Bex1_def using `x\<in>s` by blast+
+qed
+
+subsection{* Edelstein fixed point theorem. *}
+
+lemma edelstein_fix:
+ fixes s :: "'a::real_normed_vector set"
+ assumes s:"compact s" "s \<noteq> {}" and gs:"(g ` s) \<subseteq> s"
+ and dist:"\<forall>x\<in>s. \<forall>y\<in>s. x \<noteq> y \<longrightarrow> dist (g x) (g y) < dist x y"
+ shows "\<exists>! x\<in>s. g x = x"
+proof(cases "\<exists>x\<in>s. g x \<noteq> x")
+ obtain x where "x\<in>s" using s(2) by auto
+ case False hence g:"\<forall>x\<in>s. g x = x" by auto
+ { fix y assume "y\<in>s"
+ hence "x = y" using `x\<in>s` and dist[THEN bspec[where x=x], THEN bspec[where x=y]]
+ unfolding g[THEN bspec[where x=x], OF `x\<in>s`]
+ unfolding g[THEN bspec[where x=y], OF `y\<in>s`] by auto }
+ thus ?thesis unfolding Bex1_def using `x\<in>s` and g by blast+
+next
+ case True
+ then obtain x where [simp]:"x\<in>s" and "g x \<noteq> x" by auto
+ { fix x y assume "x \<in> s" "y \<in> s"
+ hence "dist (g x) (g y) \<le> dist x y"
+ using dist[THEN bspec[where x=x], THEN bspec[where x=y]] by auto } note dist' = this
+ def y \<equiv> "g x"
+ have [simp]:"y\<in>s" unfolding y_def using gs[unfolded image_subset_iff] and `x\<in>s` by blast
+ def f \<equiv> "\<lambda>n. g ^^ n"
+ have [simp]:"\<And>n z. g (f n z) = f (Suc n) z" unfolding f_def by auto
+ have [simp]:"\<And>z. f 0 z = z" unfolding f_def by auto
+ { fix n::nat and z assume "z\<in>s"
+ have "f n z \<in> s" unfolding f_def
+ proof(induct n)
+ case 0 thus ?case using `z\<in>s` by simp
+ next
+ case (Suc n) thus ?case using gs[unfolded image_subset_iff] by auto
+ qed } note fs = this
+ { fix m n ::nat assume "m\<le>n"
+ fix w z assume "w\<in>s" "z\<in>s"
+ have "dist (f n w) (f n z) \<le> dist (f m w) (f m z)" using `m\<le>n`
+ proof(induct n)
+ case 0 thus ?case by auto
+ next
+ case (Suc n)
+ thus ?case proof(cases "m\<le>n")
+ case True thus ?thesis using Suc(1)
+ using dist'[OF fs fs, OF `w\<in>s` `z\<in>s`, of n n] by auto
+ next
+ case False hence mn:"m = Suc n" using Suc(2) by simp
+ show ?thesis unfolding mn by auto
+ qed
+ qed } note distf = this
+
+ def h \<equiv> "\<lambda>n. (f n x, f n y)"
+ let ?s2 = "s \<times> s"
+ obtain l r where "l\<in>?s2" and r:"subseq r" and lr:"((h \<circ> r) ---> l) sequentially"
+ using compact_Times [OF s(1) s(1), unfolded compact_def, THEN spec[where x=h]] unfolding h_def
+ using fs[OF `x\<in>s`] and fs[OF `y\<in>s`] by blast
+ def a \<equiv> "fst l" def b \<equiv> "snd l"
+ have lab:"l = (a, b)" unfolding a_def b_def by simp
+ have [simp]:"a\<in>s" "b\<in>s" unfolding a_def b_def using `l\<in>?s2` by auto
+
+ have lima:"((fst \<circ> (h \<circ> r)) ---> a) sequentially"
+ and limb:"((snd \<circ> (h \<circ> r)) ---> b) sequentially"
+ using lr
+ unfolding o_def a_def b_def by (simp_all add: tendsto_intros)
+
+ { fix n::nat
+ 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
+ { fix x y :: 'a
+ have "dist (-x) (-y) = dist x y" unfolding dist_norm
+ using norm_minus_cancel[of "x - y"] by (auto simp add: uminus_add_conv_diff) } note ** = this
+
+ { assume as:"dist a b > dist (f n x) (f n y)"
+ 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"
+ and "\<forall>m\<ge>Nb. dist (f (r m) y) b < (dist a b - dist (f n x) (f n y)) / 2"
+ using lima limb unfolding h_def Lim_sequentially by (fastsimp simp del: less_divide_eq_number_of1)
+ 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)"
+ apply(erule_tac x="Na+Nb+n" in allE)
+ apply(erule_tac x="Na+Nb+n" in allE) apply simp
+ using dist_triangle_add_half[of a "f (r (Na + Nb + n)) x" "dist a b - dist (f n x) (f n y)"
+ "-b" "- f (r (Na + Nb + n)) y"]
+ unfolding ** unfolding group_simps(12) by (auto simp add: dist_commute)
+ moreover
+ 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)"
+ using distf[of n "r (Na+Nb+n)", OF _ `x\<in>s` `y\<in>s`]
+ using subseq_bigger[OF r, of "Na+Nb+n"]
+ using *[of "f (r (Na + Nb + n)) x" "f (r (Na + Nb + n)) y" "f n x" "f n y"] by auto
+ ultimately have False by simp
+ }
+ hence "dist a b \<le> dist (f n x) (f n y)" by(rule ccontr)auto }
+ note ab_fn = this
+
+ have [simp]:"a = b" proof(rule ccontr)
+ def e \<equiv> "dist a b - dist (g a) (g b)"
+ assume "a\<noteq>b" hence "e > 0" unfolding e_def using dist by fastsimp
+ hence "\<exists>n. dist (f n x) a < e/2 \<and> dist (f n y) b < e/2"
+ using lima limb unfolding Lim_sequentially
+ apply (auto elim!: allE[where x="e/2"]) apply(rule_tac x="r (max N Na)" in exI) unfolding h_def by fastsimp
+ then obtain n where n:"dist (f n x) a < e/2 \<and> dist (f n y) b < e/2" by auto
+ have "dist (f (Suc n) x) (g a) \<le> dist (f n x) a"
+ using dist[THEN bspec[where x="f n x"], THEN bspec[where x="a"]] and fs by auto
+ moreover have "dist (f (Suc n) y) (g b) \<le> dist (f n y) b"
+ using dist[THEN bspec[where x="f n y"], THEN bspec[where x="b"]] and fs by auto
+ ultimately have "dist (f (Suc n) x) (g a) + dist (f (Suc n) y) (g b) < e" using n by auto
+ thus False unfolding e_def using ab_fn[of "Suc n"] by norm
+ qed
+
+ have [simp]:"\<And>n. f (Suc n) x = f n y" unfolding f_def y_def by(induct_tac n)auto
+ { fix x y assume "x\<in>s" "y\<in>s" moreover
+ fix e::real assume "e>0" ultimately
+ have "dist y x < e \<longrightarrow> dist (g y) (g x) < e" using dist by fastsimp }
+ hence "continuous_on s g" unfolding continuous_on_def by auto
+
+ hence "((snd \<circ> h \<circ> r) ---> g a) sequentially" unfolding continuous_on_sequentially
+ apply (rule allE[where x="\<lambda>n. (fst \<circ> h \<circ> r) n"]) apply (erule ballE[where x=a])
+ using lima unfolding h_def o_def using fs[OF `x\<in>s`] by (auto simp add: y_def)
+ hence "g a = a" using Lim_unique[OF trivial_limit_sequentially limb, of "g a"]
+ unfolding `a=b` and o_assoc by auto
+ moreover
+ { fix x assume "x\<in>s" "g x = x" "x\<noteq>a"
+ hence "False" using dist[THEN bspec[where x=a], THEN bspec[where x=x]]
+ using `g a = a` and `a\<in>s` by auto }
+ ultimately show "\<exists>!x\<in>s. g x = x" unfolding Bex1_def using `a\<in>s` by blast
+qed
+
+end