# HG changeset patch # User paulson # Date 1524688142 -3600 # Node ID d45b78cb86cffec4f3b4e87db3c3f0c520d0401d # Parent 362baebe25a57e5dbfc623ee34f1ed3092949fd4 more messy proofs redone, and new material diff -r 362baebe25a5 -r d45b78cb86cf src/HOL/Analysis/Cartesian_Euclidean_Space.thy --- a/src/HOL/Analysis/Cartesian_Euclidean_Space.thy Wed Apr 25 16:40:29 2018 +0100 +++ b/src/HOL/Analysis/Cartesian_Euclidean_Space.thy Wed Apr 25 21:29:02 2018 +0100 @@ -1078,23 +1078,18 @@ have fU: "finite ?U" by simp have lhseq: "?lhs \ (\y. \(x::real^'m). sum (\i. (x$i) *s column i A) ?U = y)" unfolding matrix_right_invertible_surjective matrix_mult_sum surj_def - apply (subst eq_commute) - apply rule - done + by (simp add: eq_commute) have rhseq: "?rhs \ (\x. x \ 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: "sum (\i. (y$i) *s column i A) ?U = x" by blast have "x \ span (columns A)" - unfolding y[symmetric] - apply (rule span_sum) - unfolding scalar_mult_eq_scaleR - apply (rule span_mul) - apply (rule span_superset) - unfolding columns_def - apply blast - done + unfolding y[symmetric] scalar_mult_eq_scaleR + proof (rule span_sum [OF span_mul]) + show "column i A \ span (columns A)" for i + using columns_def span_inc by auto + qed } then have ?rhs unfolding rhseq by blast } moreover @@ -1121,9 +1116,7 @@ using i(1) by (simp add: field_simps) have "sum (\xa. if xa = i then (c + (x$i)) * ((column xa A)$j) else (x$xa) * ((column xa A$j))) ?U = sum (\xa. (if xa = i then c * ((column i A)$j) else 0) + ((x$xa) * ((column xa A)$j))) ?U" - apply (rule sum.cong[OF refl]) - using th apply blast - done + by (rule sum.cong[OF refl]) (use th in blast) also have "\ = sum (\xa. if xa = i then c * ((column i A)$j) else 0) ?U + sum (\xa. ((x$xa) * ((column xa A)$j))) ?U" by (simp add: sum.distrib) also have "\ = c * ((column i A)$j) + sum (\xa. ((x$xa) * ((column xa A)$j))) ?U" @@ -1164,10 +1157,10 @@ where f': "linear f'" "\x. f' (A *v x) = x" "\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]) + matrix_vector_mul_assoc[symmetric] 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) + by (simp add: matrix_mul_assoc[symmetric] AA') hence "matrix f' ** A = A' ** A" by simp hence "A' ** A = mat 1" by (simp add: th) } @@ -1186,6 +1179,26 @@ shows "invertible (transpose A)" by (meson assms invertible_def matrix_left_right_inverse right_invertible_transpose) +lemma vector_matrix_mul_assoc: + fixes v :: "('a::comm_semiring_1)^'n" + shows "(v v* M) v* N = v v* (M ** N)" +proof - + from matrix_vector_mul_assoc + have "transpose N *v (transpose M *v v) = (transpose N ** transpose M) *v v" by fast + thus "(v v* M) v* N = v v* (M ** N)" + by (simp add: matrix_transpose_mul [symmetric]) +qed + +lemma matrix_scalar_vector_ac: + fixes A :: "real^('m::finite)^'n" + shows "A *v (k *\<^sub>R v) = k *\<^sub>R A *v v" + by (metis matrix_vector_mult_scaleR transpose_scalar vector_scalar_matrix_ac vector_transpose_matrix) + +lemma scalar_matrix_vector_assoc: + fixes A :: "real^('m::finite)^'n" + shows "k *\<^sub>R (A *v v) = k *\<^sub>R A *v v" + by (metis matrix_scalar_vector_ac matrix_vector_mult_scaleR) + text \Considering an n-element vector as an n-by-1 or 1-by-n matrix.\ definition "rowvector v = (\ i j. (v$j))" diff -r 362baebe25a5 -r d45b78cb86cf src/HOL/Analysis/Convex_Euclidean_Space.thy --- a/src/HOL/Analysis/Convex_Euclidean_Space.thy Wed Apr 25 16:40:29 2018 +0100 +++ b/src/HOL/Analysis/Convex_Euclidean_Space.thy Wed Apr 25 21:29:02 2018 +0100 @@ -2191,64 +2191,58 @@ proposition%important affine_dependent_explicit: "affine_dependent p \ - (\s u. finite s \ s \ p \ sum u s = 0 \ - (\v\s. u v \ 0) \ sum (\v. u v *\<^sub>R v) s = 0)" - unfolding%unimportant 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 \ p" "finite s" "s \ {}" "s \ p - {x}" "sum u s = 1" "(\v\s. u v *\<^sub>R v) = x" - have "x \ s" using as(1,4) by auto - show "\s u. finite s \ s \ p \ sum u s = 0 \ (\v\s. u v \ 0) \ (\v\s. u v *\<^sub>R v) = 0" - apply (rule_tac x="insert x s" in exI, rule_tac x="\v. if v = x then - 1 else u v" in exI) - unfolding if_smult and sum_clauses(2)[OF as(2)] and sum_delta_notmem[OF \x\s\] and as - using as - apply auto - done -next - fix s u v - assume as: "finite s" "s \ p" "sum u s = 0" "(\v\s. u v *\<^sub>R v) = 0" "v \ s" "u v \ 0" - have "s \ {v}" - using as(3,6) by auto - then show "\x\p. \s u. finite s \ s \ {} \ s \ p - {x} \ sum u s = 1 \ (\v\s. u v *\<^sub>R v) = x" - apply (rule_tac x=v in bexI) - apply (rule_tac x="s - {v}" in exI) - apply (rule_tac x="\x. - (1 / u v) * u x" in exI) - unfolding scaleR_scaleR[symmetric] and scaleR_right.sum [symmetric] - unfolding sum_distrib_left[symmetric] and sum_diff1[OF as(1)] - using as - apply auto - done + (\S u. finite S \ S \ p \ sum u S = 0 \ (\v\S. u v \ 0) \ sum (\v. u v *\<^sub>R v) S = 0)" +proof - + have "\S u. finite S \ S \ p \ sum u S = 0 \ (\v\S. u v \ 0) \ (\w\S. u w *\<^sub>R w) = 0" + if "(\w\S. u w *\<^sub>R w) = x" "x \ p" "finite S" "S \ {}" "S \ p - {x}" "sum u S = 1" for x S u + proof (intro exI conjI) + have "x \ S" + using that by auto + then show "(\v \ insert x S. if v = x then - 1 else u v) = 0" + using that by (simp add: sum_delta_notmem) + show "(\w \ insert x S. (if w = x then - 1 else u w) *\<^sub>R w) = 0" + using that \x \ S\ by (simp add: if_smult sum_delta_notmem cong: if_cong) + qed (use that in auto) + moreover have "\x\p. \S u. finite S \ S \ {} \ S \ p - {x} \ sum u S = 1 \ (\v\S. u v *\<^sub>R v) = x" + if "(\v\S. u v *\<^sub>R v) = 0" "finite S" "S \ p" "sum u S = 0" "v \ S" "u v \ 0" for S u v + proof (intro bexI exI conjI) + have "S \ {v}" + using that by auto + then show "S - {v} \ {}" + using that by auto + show "(\x \ S - {v}. - (1 / u v) * u x) = 1" + unfolding sum_distrib_left[symmetric] sum_diff1[OF \finite S\] by (simp add: that) + show "(\x\S - {v}. (- (1 / u v) * u x) *\<^sub>R x) = v" + unfolding sum_distrib_left [symmetric] scaleR_scaleR[symmetric] + scaleR_right.sum [symmetric] sum_diff1[OF \finite S\] + using that by auto + show "S - {v} \ p - {v}" + using that by auto + qed (use that in auto) + ultimately show ?thesis + unfolding affine_dependent_def affine_hull_explicit by auto qed lemma affine_dependent_explicit_finite: - fixes s :: "'a::real_vector set" - assumes "finite s" - shows "affine_dependent s \ - (\u. sum u s = 0 \ (\v\s. u v \ 0) \ sum (\v. u v *\<^sub>R v) s = 0)" + fixes S :: "'a::real_vector set" + assumes "finite S" + shows "affine_dependent S \ + (\u. sum u S = 0 \ (\v\S. u v \ 0) \ sum (\v. u v *\<^sub>R v) S = 0)" (is "?lhs = ?rhs") proof have *: "\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 \ s" "sum u t = 0" "v\t" "u v \ 0" "(\v\t. u v *\<^sub>R v) = 0" + "finite t" "t \ S" "sum u t = 0" "v\t" "u v \ 0" "(\v\t. u v *\<^sub>R v) = 0" unfolding affine_dependent_explicit by auto then show ?rhs apply (rule_tac x="\x. if x\t then u x else 0" in exI) - apply auto unfolding * and sum.inter_restrict[OF assms, symmetric] - unfolding Int_absorb1[OF \t\s\] - apply auto + apply (auto simp: * sum.inter_restrict[OF assms, symmetric] Int_absorb1[OF \t\S\]) done next assume ?rhs - then obtain u v where "sum u s = 0" "v\s" "u v \ 0" "(\v\s. u v *\<^sub>R v) = 0" + then obtain u v where "sum u S = 0" "v\S" "u v \ 0" "(\v\S. u v *\<^sub>R v) = 0" by auto then show ?lhs unfolding affine_dependent_explicit using assms by auto @@ -2262,15 +2256,15 @@ by (rule Topological_Spaces.topological_space_class.connectedD) lemma convex_connected: - fixes s :: "'a::real_normed_vector set" - assumes "convex s" - shows "connected s" + fixes S :: "'a::real_normed_vector set" + assumes "convex S" + shows "connected S" proof (rule connectedI) fix A B - assume "open A" "open B" "A \ B \ s = {}" "s \ A \ B" + assume "open A" "open B" "A \ B \ S = {}" "S \ A \ B" moreover - assume "A \ s \ {}" "B \ s \ {}" - then obtain a b where a: "a \ A" "a \ s" and b: "b \ B" "b \ s" by auto + assume "A \ S \ {}" "B \ S \ {}" + then obtain a b where a: "a \ A" "a \ S" and b: "b \ B" "b \ S" by auto define f where [abs_def]: "f u = u *\<^sub>R a + (1 - u) *\<^sub>R b" for u then have "continuous_on {0 .. 1} f" by (auto intro!: continuous_intros) @@ -2281,8 +2275,8 @@ using a by (auto intro!: image_eqI[of _ _ 1] simp: f_def) moreover have "b \ B \ f ` {0 .. 1}" using b by (auto intro!: image_eqI[of _ _ 0] simp: f_def) - moreover have "f ` {0 .. 1} \ s" - using \convex s\ a b unfolding convex_def f_def by auto + moreover have "f ` {0 .. 1} \ S" + using \convex S\ a b unfolding convex_def f_def by auto ultimately show False by auto qed @@ -2515,10 +2509,10 @@ by (rule hull_unique) auto lemma convex_hull_insert: - fixes s :: "'a::real_vector set" - assumes "s \ {}" - shows "convex hull (insert a s) = - {x. \u\0. \v\0. \b. (u + v = 1) \ b \ (convex hull s) \ (x = u *\<^sub>R a + v *\<^sub>R b)}" + fixes S :: "'a::real_vector set" + assumes "S \ {}" + shows "convex hull (insert a S) = + {x. \u\0. \v\0. \b. (u + v = 1) \ b \ (convex hull S) \ (x = u *\<^sub>R a + v *\<^sub>R b)}" (is "_ = ?hull") apply (rule, rule hull_minimal, rule) unfolding insert_iff @@ -2526,55 +2520,56 @@ apply rule proof - fix x - assume x: "x = a \ x \ s" + assume x: "x = a \ x \ S" + then have "\u\0. \v\0. u + v = 1 \ (\b. b \ convex hull S \ x = u *\<^sub>R a + v *\<^sub>R b)" + proof + assume "x = a" + then show ?thesis + by (rule_tac x=1 in exI) (use assms hull_subset in fastforce) + next + assume "x \ S" + with hull_subset[of S convex] show ?thesis + by force + qed then show "x \ ?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] - apply auto - done + by simp next fix x assume "x \ ?hull" - then obtain u v b where obt: "u\0" "v\0" "u + v = 1" "b \ convex hull s" "x = u *\<^sub>R a + v *\<^sub>R b" + then obtain u v b where obt: "u\0" "v\0" "u + v = 1" "b \ convex hull S" "x = u *\<^sub>R a + v *\<^sub>R b" by auto - have "a \ convex hull insert a s" "b \ 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) + have "a \ convex hull insert a S" "b \ 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 - then show "x \ convex hull insert a s" + then show "x \ convex hull insert a S" unfolding obt(5) using obt(1-3) by (rule convexD [OF convex_convex_hull]) next show "convex ?hull" proof (rule convexI) fix x y u v - assume as: "(0::real) \ u" "0 \ v" "u + v = 1" "x\?hull" "y\?hull" - from as(4) obtain u1 v1 b1 where - obt1: "u1\0" "v1\0" "u1 + v1 = 1" "b1 \ convex hull s" "x = u1 *\<^sub>R a + v1 *\<^sub>R b1" + assume as: "(0::real) \ u" "0 \ v" "u + v = 1" and x: "x \ ?hull" and y: "y \ ?hull" + from x obtain u1 v1 b1 where + obt1: "u1\0" "v1\0" "u1 + v1 = 1" "b1 \ convex hull S" and xeq: "x = u1 *\<^sub>R a + v1 *\<^sub>R b1" by auto - from as(5) obtain u2 v2 b2 where - obt2: "u2\0" "v2\0" "u2 + v2 = 1" "b2 \ convex hull s" "y = u2 *\<^sub>R a + v2 *\<^sub>R b2" + from y obtain u2 v2 b2 where + obt2: "u2\0" "v2\0" "u2 + v2 = 1" "b2 \ convex hull S" and yeq: "y = u2 *\<^sub>R a + v2 *\<^sub>R b2" by auto have *: "\(x::'a) s1 s2. x - s1 *\<^sub>R x - s2 *\<^sub>R x = ((1::real) - (s1 + s2)) *\<^sub>R x" by (auto simp: algebra_simps) - have **: "\b \ convex hull s. u *\<^sub>R x + v *\<^sub>R y = + have "\b \ 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") case True have *: "\(x::'a) s1 s2. x - s1 *\<^sub>R x - s2 *\<^sub>R x = ((1::real) - (s1 + s2)) *\<^sub>R x" by (auto simp: algebra_simps) - from True have ***: "u * v1 = 0" "v * v2 = 0" - using mult_nonneg_nonneg[OF \u\0\ \v1\0\] mult_nonneg_nonneg[OF \v\0\ \v2\0\] + have eq0: "u * v1 = 0" "v * v2 = 0" + using True mult_nonneg_nonneg[OF \u\0\ \v1\0\] mult_nonneg_nonneg[OF \v\0\ \v2\0\] by arith+ then have "u * u1 + v * u2 = 1" using as(3) obt1(3) obt2(3) by auto then show ?thesis - unfolding obt1(5) obt2(5) * - using assms hull_subset[of s convex] - by (auto simp: *** scaleR_right_distrib) + using "*" eq0 as obt1(4) xeq yeq by auto next case False have "1 - (u * u1 + v * u2) = (u + v) - (u * u1 + v * u2)" @@ -2587,8 +2582,7 @@ have "0 \ u * v1 + v * v2" "0 \ u * v1" "0 \ u * v1 + v * v2" "0 \ v * v2" using as(1,2) obt1(1,2) obt2(1,2) by auto then show ?thesis - unfolding obt1(5) obt2(5) - unfolding * and ** + unfolding xeq yeq * ** 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) @@ -2599,28 +2593,28 @@ apply (auto simp: scaleR_left_distrib scaleR_right_distrib) done qed + then obtain b where b: "b \ 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)" .. + have u1: "u1 \ 1" unfolding obt1(3)[symmetric] and not_le using obt1(2) by auto have u2: "u2 \ 1" unfolding obt2(3)[symmetric] and not_le using obt2(2) by auto have "u1 * u + u2 * v \ 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) - apply auto - done + proof (rule add_mono) + show "u1 * u \ max u1 u2 * u" "u2 * v \ max u1 u2 * v" + by (simp_all add: as mult_right_mono) + qed also have "\ \ 1" unfolding distrib_left[symmetric] and as(3) using u1 u2 by auto - finally show "u *\<^sub>R x + v *\<^sub>R y \ ?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) ** - apply (auto simp: algebra_simps) - done + finally have le1: "u1 * u + u2 * v \ 1" . + show "u *\<^sub>R x + v *\<^sub>R y \ ?hull" + proof (intro CollectI exI conjI) + show "0 \ u * u1 + v * u2" + by (simp add: as(1) as(2) obt1(1) obt2(1)) + show "0 \ 1 - u * u1 - v * u2" + by (simp add: le1 diff_diff_add mult.commute) + qed (use b in \auto simp: algebra_simps\) qed qed @@ -2921,20 +2915,13 @@ done next assume ?rhs - then obtain v u where - uv: "v\0" "\x\s. 0 \ u x" "sum u s = w - v" "(\x\s. u x *\<^sub>R x) = y - v *\<^sub>R a" + then obtain v u where uv: "v\0" "\x\s. 0 \ u x" "sum u s = w - v" "(\x\s. u x *\<^sub>R x) = y - v *\<^sub>R a" by auto - moreover - assume "a \ s" + moreover assume "a \ s" moreover - have "(\x\s. if a = x then v else u x) = sum u s" - and "(\x\s. (if a = x then v else u x) *\<^sub>R x) = (\x\s. u x *\<^sub>R x)" - apply (rule_tac sum.cong) apply rule - defer - apply (rule_tac sum.cong) apply rule + have "(\x\s. if a = x then v else u x) = sum u s" "(\x\s. (if a = x then v else u x) *\<^sub>R x) = (\x\s. u x *\<^sub>R x)" using \a \ s\ - apply auto - done + by (auto simp: intro!: sum.cong) ultimately show ?lhs apply (rule_tac x="\x. if a = x then v else u x" in exI) unfolding sum_clauses(2)[OF assms] @@ -6673,22 +6660,12 @@ assumes "finite A" and "\i\A. finite (B i)" shows "finite (\i\A. B i)" using assms by (induct set: finite, simp, simp add: finite_set_plus) -lemma set_sum_eq: - "finite A \ (\i\A. B i) = {\i\A. f i |f. \i\A. f i \ B i}" - apply (induct set: finite, simp) - apply simp - apply (safe elim!: set_plus_elim) - apply (rule_tac x="fun_upd f x a" in exI, simp) - apply (rule_tac f="\x. a + x" in arg_cong) - apply (rule sum.cong [OF refl], clarsimp) - apply fast - done - lemma box_eq_set_sum_Basis: shows "{x. \i\Basis. x\i \ B i} = (\i\Basis. image (\x. x *\<^sub>R i) (B i))" - apply (subst set_sum_eq [OF finite_Basis], safe) + apply (subst set_sum_alt [OF finite_Basis], safe) apply (fast intro: euclidean_representation [symmetric]) apply (subst inner_sum_left) +apply (rename_tac f) apply (subgoal_tac "(\x\Basis. f x \ i) = f i \ i") apply (drule (1) bspec) apply clarsimp