11535 apply (metis DIM_positive One_nat_def Suc_leI add_diff_cancel_left' of_nat_1 aff_dim_eq_hyperplane of_nat_diff *) |
11544 apply (metis DIM_positive One_nat_def Suc_leI add_diff_cancel_left' of_nat_1 aff_dim_eq_hyperplane of_nat_diff *) |
11536 done |
11545 done |
11537 qed |
11546 qed |
11538 qed |
11547 qed |
11539 |
11548 |
|
11549 subsection\<open>Misc results about span\<close> |
|
11550 |
|
11551 lemma eq_span_insert_eq: |
|
11552 assumes "(x - y) \<in> span S" |
|
11553 shows "span(insert x S) = span(insert y S)" |
|
11554 proof - |
|
11555 have *: "span(insert x S) \<subseteq> span(insert y S)" if "(x - y) \<in> span S" for x y |
|
11556 proof - |
|
11557 have 1: "(r *\<^sub>R x - r *\<^sub>R y) \<in> span S" for r |
|
11558 by (metis real_vector.scale_right_diff_distrib span_mul that) |
|
11559 have 2: "(z - k *\<^sub>R y) - k *\<^sub>R (x - y) = z - k *\<^sub>R x" for z k |
|
11560 by (simp add: real_vector.scale_right_diff_distrib) |
|
11561 show ?thesis |
|
11562 apply (clarsimp simp add: span_breakdown_eq) |
|
11563 by (metis 1 2 diff_add_cancel real_vector.scale_right_diff_distrib span_add_eq) |
|
11564 qed |
|
11565 show ?thesis |
|
11566 apply (intro subset_antisym * assms) |
|
11567 using assms subspace_neg subspace_span minus_diff_eq by force |
|
11568 qed |
|
11569 |
|
11570 lemma dim_psubset: |
|
11571 fixes S :: "'a :: euclidean_space set" |
|
11572 shows "span S \<subset> span T \<Longrightarrow> dim S < dim T" |
|
11573 by (metis (no_types, hide_lams) dim_span less_le not_le subspace_dim_equal subspace_span) |
|
11574 |
|
11575 |
|
11576 lemma basis_subspace_exists: |
|
11577 fixes S :: "'a::euclidean_space set" |
|
11578 shows |
|
11579 "subspace S |
|
11580 \<Longrightarrow> \<exists>b. finite b \<and> b \<subseteq> S \<and> |
|
11581 independent b \<and> span b = S \<and> card b = dim S" |
|
11582 by (metis span_subspace basis_exists independent_imp_finite) |
|
11583 |
|
11584 lemma affine_hyperplane_sums_eq_UNIV_0: |
|
11585 fixes S :: "'a :: euclidean_space set" |
|
11586 assumes "affine S" |
|
11587 and "0 \<in> S" and "w \<in> S" |
|
11588 and "a \<bullet> w \<noteq> 0" |
|
11589 shows "{x + y| x y. x \<in> S \<and> a \<bullet> y = 0} = UNIV" |
|
11590 proof - |
|
11591 have "subspace S" |
|
11592 by (simp add: assms subspace_affine) |
|
11593 have span1: "span {y. a \<bullet> y = 0} \<subseteq> span {x + y |x y. x \<in> S \<and> a \<bullet> y = 0}" |
|
11594 apply (rule span_mono) |
|
11595 using \<open>0 \<in> S\<close> add.left_neutral by force |
|
11596 have "w \<notin> span {y. a \<bullet> y = 0}" |
|
11597 using \<open>a \<bullet> w \<noteq> 0\<close> span_induct subspace_hyperplane by auto |
|
11598 moreover have "w \<in> span {x + y |x y. x \<in> S \<and> a \<bullet> y = 0}" |
|
11599 using \<open>w \<in> S\<close> |
|
11600 by (metis (mono_tags, lifting) inner_zero_right mem_Collect_eq pth_d span_superset) |
|
11601 ultimately have span2: "span {y. a \<bullet> y = 0} \<noteq> span {x + y |x y. x \<in> S \<and> a \<bullet> y = 0}" |
|
11602 by blast |
|
11603 have "a \<noteq> 0" using assms inner_zero_left by blast |
|
11604 then have "DIM('a) - 1 = dim {y. a \<bullet> y = 0}" |
|
11605 by (simp add: dim_hyperplane) |
|
11606 also have "... < dim {x + y |x y. x \<in> S \<and> a \<bullet> y = 0}" |
|
11607 using span1 span2 by (blast intro: dim_psubset) |
|
11608 finally have DIM_lt: "DIM('a) - 1 < dim {x + y |x y. x \<in> S \<and> a \<bullet> y = 0}" . |
|
11609 have subs: "subspace {x + y| x y. x \<in> S \<and> a \<bullet> y = 0}" |
|
11610 using subspace_sums [OF \<open>subspace S\<close> subspace_hyperplane] by simp |
|
11611 moreover have "span {x + y| x y. x \<in> S \<and> a \<bullet> y = 0} = UNIV" |
|
11612 apply (rule dim_eq_full [THEN iffD1]) |
|
11613 apply (rule antisym [OF dim_subset_UNIV]) |
|
11614 using DIM_lt apply simp |
|
11615 done |
|
11616 ultimately show ?thesis |
|
11617 by (simp add: subs) (metis (lifting) span_eq subs) |
|
11618 qed |
|
11619 |
|
11620 proposition affine_hyperplane_sums_eq_UNIV: |
|
11621 fixes S :: "'a :: euclidean_space set" |
|
11622 assumes "affine S" |
|
11623 and "S \<inter> {v. a \<bullet> v = b} \<noteq> {}" |
|
11624 and "S - {v. a \<bullet> v = b} \<noteq> {}" |
|
11625 shows "{x + y| x y. x \<in> S \<and> a \<bullet> y = b} = UNIV" |
|
11626 proof (cases "a = 0") |
|
11627 case True with assms show ?thesis |
|
11628 by (auto simp: if_splits) |
|
11629 next |
|
11630 case False |
|
11631 obtain c where "c \<in> S" and c: "a \<bullet> c = b" |
|
11632 using assms by force |
|
11633 with affine_diffs_subspace [OF \<open>affine S\<close>] |
|
11634 have "subspace (op + (- c) ` S)" by blast |
|
11635 then have aff: "affine (op + (- c) ` S)" |
|
11636 by (simp add: subspace_imp_affine) |
|
11637 have 0: "0 \<in> op + (- c) ` S" |
|
11638 by (simp add: \<open>c \<in> S\<close>) |
|
11639 obtain d where "d \<in> S" and "a \<bullet> d \<noteq> b" and dc: "d-c \<in> op + (- c) ` S" |
|
11640 using assms by auto |
|
11641 then have adc: "a \<bullet> (d - c) \<noteq> 0" |
|
11642 by (simp add: c inner_diff_right) |
|
11643 let ?U = "op + (c+c) ` {x + y |x y. x \<in> op + (- c) ` S \<and> a \<bullet> y = 0}" |
|
11644 have "u + v \<in> op + (c + c) ` {x + v |x v. x \<in> op + (- c) ` S \<and> a \<bullet> v = 0}" |
|
11645 if "u \<in> S" "b = a \<bullet> v" for u v |
|
11646 apply (rule_tac x="u+v-c-c" in image_eqI) |
|
11647 apply (simp_all add: algebra_simps) |
|
11648 apply (rule_tac x="u-c" in exI) |
|
11649 apply (rule_tac x="v-c" in exI) |
|
11650 apply (simp add: algebra_simps that c) |
|
11651 done |
|
11652 moreover have "\<lbrakk>a \<bullet> v = 0; u \<in> S\<rbrakk> |
|
11653 \<Longrightarrow> \<exists>x ya. v + (u + c) = x + ya \<and> x \<in> S \<and> a \<bullet> ya = b" for v u |
|
11654 by (metis add.left_commute c inner_right_distrib pth_d) |
|
11655 ultimately have "{x + y |x y. x \<in> S \<and> a \<bullet> y = b} = ?U" |
|
11656 by (fastforce simp: algebra_simps) |
|
11657 also have "... = op + (c+c) ` UNIV" |
|
11658 by (simp add: affine_hyperplane_sums_eq_UNIV_0 [OF aff 0 dc adc]) |
|
11659 also have "... = UNIV" |
|
11660 by (simp add: translation_UNIV) |
|
11661 finally show ?thesis . |
|
11662 qed |
|
11663 |
|
11664 proposition dim_sums_Int: |
|
11665 fixes S :: "'a :: euclidean_space set" |
|
11666 assumes "subspace S" "subspace T" |
|
11667 shows "dim {x + y |x y. x \<in> S \<and> y \<in> T} + dim(S \<inter> T) = dim S + dim T" |
|
11668 proof - |
|
11669 obtain B where B: "B \<subseteq> S \<inter> T" "S \<inter> T \<subseteq> span B" |
|
11670 and indB: "independent B" |
|
11671 and cardB: "card B = dim (S \<inter> T)" |
|
11672 using basis_exists by blast |
|
11673 then obtain C D where "B \<subseteq> C" "C \<subseteq> S" "independent C" "S \<subseteq> span C" |
|
11674 and "B \<subseteq> D" "D \<subseteq> T" "independent D" "T \<subseteq> span D" |
|
11675 using maximal_independent_subset_extend |
|
11676 by (metis Int_subset_iff \<open>B \<subseteq> S \<inter> T\<close> indB) |
|
11677 then have "finite B" "finite C" "finite D" |
|
11678 by (simp_all add: independent_imp_finite indB independent_bound) |
|
11679 have Beq: "B = C \<inter> D" |
|
11680 apply (rule sym) |
|
11681 apply (rule spanning_subset_independent) |
|
11682 using \<open>B \<subseteq> C\<close> \<open>B \<subseteq> D\<close> apply blast |
|
11683 apply (meson \<open>independent C\<close> independent_mono inf.cobounded1) |
|
11684 using B \<open>C \<subseteq> S\<close> \<open>D \<subseteq> T\<close> apply auto |
|
11685 done |
|
11686 then have Deq: "D = B \<union> (D - C)" |
|
11687 by blast |
|
11688 have CUD: "C \<union> D \<subseteq> {x + y |x y. x \<in> S \<and> y \<in> T}" |
|
11689 apply safe |
|
11690 apply (metis add.right_neutral subsetCE \<open>C \<subseteq> S\<close> \<open>subspace T\<close> set_eq_subset span_0 span_minimal) |
|
11691 apply (metis add.left_neutral subsetCE \<open>D \<subseteq> T\<close> \<open>subspace S\<close> set_eq_subset span_0 span_minimal) |
|
11692 done |
|
11693 have "a v = 0" if 0: "(\<Sum>v\<in>C. a v *\<^sub>R v) + (\<Sum>v\<in>D - C. a v *\<^sub>R v) = 0" |
|
11694 and v: "v \<in> C \<union> (D-C)" for a v |
|
11695 proof - |
|
11696 have eq: "(\<Sum>v\<in>D - C. a v *\<^sub>R v) = - (\<Sum>v\<in>C. a v *\<^sub>R v)" |
|
11697 using that add_eq_0_iff by blast |
|
11698 have "(\<Sum>v\<in>D - C. a v *\<^sub>R v) \<in> S" |
|
11699 apply (subst eq) |
|
11700 apply (rule subspace_neg [OF \<open>subspace S\<close>]) |
|
11701 apply (rule subspace_setsum [OF \<open>subspace S\<close>]) |
|
11702 by (meson subsetCE subspace_mul \<open>C \<subseteq> S\<close> \<open>subspace S\<close>) |
|
11703 moreover have "(\<Sum>v\<in>D - C. a v *\<^sub>R v) \<in> T" |
|
11704 apply (rule subspace_setsum [OF \<open>subspace T\<close>]) |
|
11705 by (meson DiffD1 \<open>D \<subseteq> T\<close> \<open>subspace T\<close> subset_eq subspace_def) |
|
11706 ultimately have "(\<Sum>v \<in> D-C. a v *\<^sub>R v) \<in> span B" |
|
11707 using B by blast |
|
11708 then obtain e where e: "(\<Sum>v\<in>B. e v *\<^sub>R v) = (\<Sum>v \<in> D-C. a v *\<^sub>R v)" |
|
11709 using span_finite [OF \<open>finite B\<close>] by blast |
|
11710 have "\<And>c v. \<lbrakk>(\<Sum>v\<in>C. c v *\<^sub>R v) = 0; v \<in> C\<rbrakk> \<Longrightarrow> c v = 0" |
|
11711 using independent_explicit \<open>independent C\<close> by blast |
|
11712 def cc \<equiv> "(\<lambda>x. if x \<in> B then a x + e x else a x)" |
|
11713 have [simp]: "C \<inter> B = B" "D \<inter> B = B" "C \<inter> - B = C-D" "B \<inter> (D - C) = {}" |
|
11714 using \<open>B \<subseteq> C\<close> \<open>B \<subseteq> D\<close> Beq by blast+ |
|
11715 have f2: "(\<Sum>v\<in>C \<inter> D. e v *\<^sub>R v) = (\<Sum>v\<in>D - C. a v *\<^sub>R v)" |
|
11716 using Beq e by presburger |
|
11717 have f3: "(\<Sum>v\<in>C \<union> D. a v *\<^sub>R v) = (\<Sum>v\<in>C - D. a v *\<^sub>R v) + (\<Sum>v\<in>D - C. a v *\<^sub>R v) + (\<Sum>v\<in>C \<inter> D. a v *\<^sub>R v)" |
|
11718 using \<open>finite C\<close> \<open>finite D\<close> setsum.union_diff2 by blast |
|
11719 have f4: "(\<Sum>v\<in>C \<union> (D - C). a v *\<^sub>R v) = (\<Sum>v\<in>C. a v *\<^sub>R v) + (\<Sum>v\<in>D - C. a v *\<^sub>R v)" |
|
11720 by (meson Diff_disjoint \<open>finite C\<close> \<open>finite D\<close> finite_Diff setsum.union_disjoint) |
|
11721 have "(\<Sum>v\<in>C. cc v *\<^sub>R v) = 0" |
|
11722 using 0 f2 f3 f4 |
|
11723 apply (simp add: cc_def Beq if_smult \<open>finite C\<close> setsum.If_cases algebra_simps setsum.distrib) |
|
11724 apply (simp add: add.commute add.left_commute diff_eq) |
|
11725 done |
|
11726 then have "\<And>v. v \<in> C \<Longrightarrow> cc v = 0" |
|
11727 using independent_explicit \<open>independent C\<close> by blast |
|
11728 then have C0: "\<And>v. v \<in> C - B \<Longrightarrow> a v = 0" |
|
11729 by (simp add: cc_def Beq) meson |
|
11730 then have [simp]: "(\<Sum>x\<in>C - B. a x *\<^sub>R x) = 0" |
|
11731 by simp |
|
11732 have "(\<Sum>x\<in>C. a x *\<^sub>R x) = (\<Sum>x\<in>B. a x *\<^sub>R x)" |
|
11733 proof - |
|
11734 have "C - D = C - B" |
|
11735 using Beq by blast |
|
11736 then show ?thesis |
|
11737 using Beq \<open>(\<Sum>x\<in>C - B. a x *\<^sub>R x) = 0\<close> f3 f4 by auto |
|
11738 qed |
|
11739 with 0 have Dcc0: "(\<Sum>v\<in>D. a v *\<^sub>R v) = 0" |
|
11740 apply (subst Deq) |
|
11741 by (simp add: \<open>finite B\<close> \<open>finite D\<close> setsum_Un) |
|
11742 then have D0: "\<And>v. v \<in> D \<Longrightarrow> a v = 0" |
|
11743 using independent_explicit \<open>independent D\<close> by blast |
|
11744 show ?thesis |
|
11745 using v C0 D0 Beq by blast |
|
11746 qed |
|
11747 then have "independent (C \<union> (D - C))" |
|
11748 by (simp add: independent_explicit \<open>finite C\<close> \<open>finite D\<close> setsum_Un del: Un_Diff_cancel) |
|
11749 then have indCUD: "independent (C \<union> D)" by simp |
|
11750 have "dim (S \<inter> T) = card B" |
|
11751 by (rule dim_unique [OF B indB refl]) |
|
11752 moreover have "dim S = card C" |
|
11753 by (metis \<open>C \<subseteq> S\<close> \<open>independent C\<close> \<open>S \<subseteq> span C\<close> basis_card_eq_dim) |
|
11754 moreover have "dim T = card D" |
|
11755 by (metis \<open>D \<subseteq> T\<close> \<open>independent D\<close> \<open>T \<subseteq> span D\<close> basis_card_eq_dim) |
|
11756 moreover have "dim {x + y |x y. x \<in> S \<and> y \<in> T} = card(C \<union> D)" |
|
11757 apply (rule dim_unique [OF CUD _ indCUD refl], clarify) |
|
11758 apply (meson \<open>S \<subseteq> span C\<close> \<open>T \<subseteq> span D\<close> span_add span_inc span_minimal subsetCE subspace_span sup.bounded_iff) |
|
11759 done |
|
11760 ultimately show ?thesis |
|
11761 using \<open>B = C \<inter> D\<close> [symmetric] |
|
11762 by (simp add: \<open>independent C\<close> \<open>independent D\<close> card_Un_Int independent_finite) |
|
11763 qed |
|
11764 |
|
11765 |
|
11766 lemma aff_dim_sums_Int_0: |
|
11767 assumes "affine S" |
|
11768 and "affine T" |
|
11769 and "0 \<in> S" "0 \<in> T" |
|
11770 shows "aff_dim {x + y| x y. x \<in> S \<and> y \<in> T} = (aff_dim S + aff_dim T) - aff_dim(S \<inter> T)" |
|
11771 proof - |
|
11772 have "0 \<in> {x + y |x y. x \<in> S \<and> y \<in> T}" |
|
11773 using assms by force |
|
11774 then have 0: "0 \<in> affine hull {x + y |x y. x \<in> S \<and> y \<in> T}" |
|
11775 by (metis (lifting) hull_inc) |
|
11776 have sub: "subspace S" "subspace T" |
|
11777 using assms by (auto simp: subspace_affine) |
|
11778 show ?thesis |
|
11779 using dim_sums_Int [OF sub] by (simp add: aff_dim_zero assms 0 hull_inc) |
|
11780 qed |
|
11781 |
|
11782 proposition aff_dim_sums_Int: |
|
11783 assumes "affine S" |
|
11784 and "affine T" |
|
11785 and "S \<inter> T \<noteq> {}" |
|
11786 shows "aff_dim {x + y| x y. x \<in> S \<and> y \<in> T} = (aff_dim S + aff_dim T) - aff_dim(S \<inter> T)" |
|
11787 proof - |
|
11788 obtain a where a: "a \<in> S" "a \<in> T" using assms by force |
|
11789 have aff: "affine (op+ (-a) ` S)" "affine (op+ (-a) ` T)" |
|
11790 using assms by (auto simp: affine_translation [symmetric]) |
|
11791 have zero: "0 \<in> (op+ (-a) ` S)" "0 \<in> (op+ (-a) ` T)" |
|
11792 using a assms by auto |
|
11793 have [simp]: "{x + y |x y. x \<in> op + (- a) ` S \<and> y \<in> op + (- a) ` T} = |
|
11794 op + (- 2 *\<^sub>R a) ` {x + y| x y. x \<in> S \<and> y \<in> T}" |
|
11795 by (force simp: algebra_simps scaleR_2) |
|
11796 have [simp]: "op + (- a) ` S \<inter> op + (- a) ` T = op + (- a) ` (S \<inter> T)" |
|
11797 by auto |
|
11798 show ?thesis |
|
11799 using aff_dim_sums_Int_0 [OF aff zero] |
|
11800 by (auto simp: aff_dim_translation_eq) |
|
11801 qed |
|
11802 |
|
11803 lemma aff_dim_affine_Int_hyperplane: |
|
11804 fixes a :: "'a::euclidean_space" |
|
11805 assumes "affine S" |
|
11806 shows "aff_dim(S \<inter> {x. a \<bullet> x = b}) = |
|
11807 (if S \<inter> {v. a \<bullet> v = b} = {} then - 1 |
|
11808 else if S \<subseteq> {v. a \<bullet> v = b} then aff_dim S |
|
11809 else aff_dim S - 1)" |
|
11810 proof (cases "a = 0") |
|
11811 case True with assms show ?thesis |
|
11812 by auto |
|
11813 next |
|
11814 case False |
|
11815 then have "aff_dim (S \<inter> {x. a \<bullet> x = b}) = aff_dim S - 1" |
|
11816 if "x \<in> S" "a \<bullet> x \<noteq> b" and non: "S \<inter> {v. a \<bullet> v = b} \<noteq> {}" for x |
|
11817 proof - |
|
11818 have [simp]: "{x + y| x y. x \<in> S \<and> a \<bullet> y = b} = UNIV" |
|
11819 using affine_hyperplane_sums_eq_UNIV [OF assms non] that by blast |
|
11820 show ?thesis |
|
11821 using aff_dim_sums_Int [OF assms affine_hyperplane non] |
|
11822 by (simp add: of_nat_diff False) |
|
11823 qed |
|
11824 then show ?thesis |
|
11825 by (metis (mono_tags, lifting) inf.orderE aff_dim_empty_eq mem_Collect_eq subsetI) |
|
11826 qed |
|
11827 |
|
11828 lemma aff_dim_lt_full: |
|
11829 fixes S :: "'a::euclidean_space set" |
|
11830 shows "aff_dim S < DIM('a) \<longleftrightarrow> (affine hull S \<noteq> UNIV)" |
|
11831 by (metis (no_types) aff_dim_affine_hull aff_dim_le_DIM aff_dim_UNIV affine_hull_UNIV less_le) |
|
11832 |
|
11833 subsection\<open> Orthogonal bases, Gram-Schmidt process, and related theorems\<close> |
|
11834 |
|
11835 lemma span_delete_0 [simp]: "span(S - {0}) = span S" |
|
11836 proof |
|
11837 show "span (S - {0}) \<subseteq> span S" |
|
11838 by (blast intro!: span_mono) |
|
11839 next |
|
11840 have "span S \<subseteq> span(insert 0 (S - {0}))" |
|
11841 by (blast intro!: span_mono) |
|
11842 also have "... \<subseteq> span(S - {0})" |
|
11843 using span_insert_0 by blast |
|
11844 finally show "span S \<subseteq> span (S - {0})" . |
|
11845 qed |
|
11846 |
|
11847 lemma span_image_scale: |
|
11848 assumes "finite S" and nz: "\<And>x. x \<in> S \<Longrightarrow> c x \<noteq> 0" |
|
11849 shows "span ((\<lambda>x. c x *\<^sub>R x) ` S) = span S" |
|
11850 using assms |
|
11851 proof (induction S arbitrary: c) |
|
11852 case (empty c) show ?case by simp |
|
11853 next |
|
11854 case (insert x F c) |
|
11855 show ?case |
|
11856 proof (intro set_eqI iffI) |
|
11857 fix y |
|
11858 assume "y \<in> span ((\<lambda>x. c x *\<^sub>R x) ` insert x F)" |
|
11859 then show "y \<in> span (insert x F)" |
|
11860 using insert by (force simp: span_breakdown_eq) |
|
11861 next |
|
11862 fix y |
|
11863 assume "y \<in> span (insert x F)" |
|
11864 then show "y \<in> span ((\<lambda>x. c x *\<^sub>R x) ` insert x F)" |
|
11865 using insert |
|
11866 apply (clarsimp simp: span_breakdown_eq) |
|
11867 apply (rule_tac x="k / c x" in exI) |
|
11868 by simp |
|
11869 qed |
|
11870 qed |
|
11871 |
|
11872 lemma pairwise_orthogonal_independent: |
|
11873 assumes "pairwise orthogonal S" and "0 \<notin> S" |
|
11874 shows "independent S" |
|
11875 proof - |
|
11876 have 0: "\<And>x y. \<lbrakk>x \<noteq> y; x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> x \<bullet> y = 0" |
|
11877 using assms by (simp add: pairwise_def orthogonal_def) |
|
11878 have "False" if "a \<in> S" and a: "a \<in> span (S - {a})" for a |
|
11879 proof - |
|
11880 obtain T U where "T \<subseteq> S - {a}" "a = (\<Sum>v\<in>T. U v *\<^sub>R v)" |
|
11881 using a by (force simp: span_explicit) |
|
11882 then have "a \<bullet> a = a \<bullet> (\<Sum>v\<in>T. U v *\<^sub>R v)" |
|
11883 by simp |
|
11884 also have "... = 0" |
|
11885 apply (simp add: inner_setsum_right) |
|
11886 apply (rule comm_monoid_add_class.setsum.neutral) |
|
11887 by (metis "0" DiffE \<open>T \<subseteq> S - {a}\<close> mult_not_zero singletonI subsetCE \<open>a \<in> S\<close>) |
|
11888 finally show ?thesis |
|
11889 using \<open>0 \<notin> S\<close> \<open>a \<in> S\<close> by auto |
|
11890 qed |
|
11891 then show ?thesis |
|
11892 by (force simp: dependent_def) |
|
11893 qed |
|
11894 |
|
11895 lemma pairwise_orthogonal_imp_finite: |
|
11896 fixes S :: "'a::euclidean_space set" |
|
11897 assumes "pairwise orthogonal S" |
|
11898 shows "finite S" |
|
11899 proof - |
|
11900 have "independent (S - {0})" |
|
11901 apply (rule pairwise_orthogonal_independent) |
|
11902 apply (metis Diff_iff assms pairwise_def) |
|
11903 by blast |
|
11904 then show ?thesis |
|
11905 by (meson independent_imp_finite infinite_remove) |
|
11906 qed |
|
11907 |
|
11908 lemma subspace_orthogonal_to_vector: "subspace {y. orthogonal x y}" |
|
11909 by (simp add: subspace_def orthogonal_clauses) |
|
11910 |
|
11911 lemma subspace_orthogonal_to_vectors: "subspace {y. \<forall>x \<in> S. orthogonal x y}" |
|
11912 by (simp add: subspace_def orthogonal_clauses) |
|
11913 |
|
11914 lemma orthogonal_to_span: |
|
11915 assumes a: "a \<in> span S" and x: "\<And>y. y \<in> S \<Longrightarrow> orthogonal x y" |
|
11916 shows "orthogonal x a" |
|
11917 apply (rule CollectD, rule span_induct [OF a subspace_orthogonal_to_vector]) |
|
11918 apply (simp add: x) |
|
11919 done |
|
11920 |
|
11921 proposition Gram_Schmidt_step: |
|
11922 fixes S :: "'a::euclidean_space set" |
|
11923 assumes S: "pairwise orthogonal S" and x: "x \<in> span S" |
|
11924 shows "orthogonal x (a - (\<Sum>b\<in>S. (b \<bullet> a / (b \<bullet> b)) *\<^sub>R b))" |
|
11925 proof - |
|
11926 have "finite S" |
|
11927 by (simp add: S pairwise_orthogonal_imp_finite) |
|
11928 have "orthogonal (a - (\<Sum>b\<in>S. (b \<bullet> a / (b \<bullet> b)) *\<^sub>R b)) x" |
|
11929 if "x \<in> S" for x |
|
11930 proof - |
|
11931 have "a \<bullet> x = (\<Sum>y\<in>S. if y = x then y \<bullet> a else 0)" |
|
11932 by (simp add: \<open>finite S\<close> inner_commute setsum.delta that) |
|
11933 also have "... = (\<Sum>b\<in>S. b \<bullet> a * (b \<bullet> x) / (b \<bullet> b))" |
|
11934 apply (rule setsum.cong [OF refl], simp) |
|
11935 by (meson S orthogonal_def pairwise_def that) |
|
11936 finally show ?thesis |
|
11937 by (simp add: orthogonal_def algebra_simps inner_setsum_left) |
|
11938 qed |
|
11939 then show ?thesis |
|
11940 using orthogonal_to_span orthogonal_commute x by blast |
|
11941 qed |
|
11942 |
|
11943 |
|
11944 lemma orthogonal_extension_aux: |
|
11945 fixes S :: "'a::euclidean_space set" |
|
11946 assumes "finite T" "finite S" "pairwise orthogonal S" |
|
11947 shows "\<exists>U. pairwise orthogonal (S \<union> U) \<and> span (S \<union> U) = span (S \<union> T)" |
|
11948 using assms |
|
11949 proof (induction arbitrary: S) |
|
11950 case empty then show ?case |
|
11951 by simp (metis sup_bot_right) |
|
11952 next |
|
11953 case (insert a T) |
|
11954 have 0: "\<And>x y. \<lbrakk>x \<noteq> y; x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> x \<bullet> y = 0" |
|
11955 using insert by (simp add: pairwise_def orthogonal_def) |
|
11956 def a' \<equiv> "a - (\<Sum>b\<in>S. (b \<bullet> a / (b \<bullet> b)) *\<^sub>R b)" |
|
11957 obtain U where orthU: "pairwise orthogonal (S \<union> insert a' U)" |
|
11958 and spanU: "span (insert a' S \<union> U) = span (insert a' S \<union> T)" |
|
11959 apply (rule exE [OF insert.IH [of "insert a' S"]]) |
|
11960 apply (auto simp: Gram_Schmidt_step a'_def insert.prems orthogonal_commute pairwise_orthogonal_insert span_clauses) |
|
11961 done |
|
11962 have orthS: "\<And>x. x \<in> S \<Longrightarrow> a' \<bullet> x = 0" |
|
11963 apply (simp add: a'_def) |
|
11964 using Gram_Schmidt_step [OF \<open>pairwise orthogonal S\<close>] |
|
11965 apply (force simp: orthogonal_def inner_commute span_inc [THEN subsetD]) |
|
11966 done |
|
11967 have "span (S \<union> insert a' U) = span (insert a' (S \<union> T))" |
|
11968 using spanU by simp |
|
11969 also have "... = span (insert a (S \<union> T))" |
|
11970 apply (rule eq_span_insert_eq) |
|
11971 apply (simp add: a'_def span_neg span_setsum span_clauses(1) span_mul) |
|
11972 done |
|
11973 also have "... = span (S \<union> insert a T)" |
|
11974 by simp |
|
11975 finally show ?case |
|
11976 apply (rule_tac x="insert a' U" in exI) |
|
11977 using orthU apply auto |
|
11978 done |
|
11979 qed |
|
11980 |
|
11981 |
|
11982 proposition orthogonal_extension: |
|
11983 fixes S :: "'a::euclidean_space set" |
|
11984 assumes S: "pairwise orthogonal S" |
|
11985 obtains U where "pairwise orthogonal (S \<union> U)" "span (S \<union> U) = span (S \<union> T)" |
|
11986 proof - |
|
11987 obtain B where "finite B" "span B = span T" |
|
11988 using basis_subspace_exists [of "span T"] subspace_span by auto |
|
11989 with orthogonal_extension_aux [of B S] |
|
11990 obtain U where "pairwise orthogonal (S \<union> U)" "span (S \<union> U) = span (S \<union> B)" |
|
11991 using assms pairwise_orthogonal_imp_finite by auto |
|
11992 show ?thesis |
|
11993 apply (rule_tac U=U in that) |
|
11994 apply (simp add: \<open>pairwise orthogonal (S \<union> U)\<close>) |
|
11995 by (metis \<open>span (S \<union> U) = span (S \<union> B)\<close> \<open>span B = span T\<close> span_union) |
|
11996 qed |
|
11997 |
|
11998 corollary orthogonal_extension_strong: |
|
11999 fixes S :: "'a::euclidean_space set" |
|
12000 assumes S: "pairwise orthogonal S" |
|
12001 obtains U where "U \<inter> (insert 0 S) = {}" "pairwise orthogonal (S \<union> U)" |
|
12002 "span (S \<union> U) = span (S \<union> T)" |
|
12003 proof - |
|
12004 obtain U where "pairwise orthogonal (S \<union> U)" "span (S \<union> U) = span (S \<union> T)" |
|
12005 using orthogonal_extension assms by blast |
|
12006 then show ?thesis |
|
12007 apply (rule_tac U = "U - (insert 0 S)" in that) |
|
12008 apply blast |
|
12009 apply (force simp: pairwise_def) |
|
12010 apply (metis (no_types, lifting) Un_Diff_cancel span_insert_0 span_union) |
|
12011 done |
|
12012 qed |
|
12013 |
|
12014 subsection\<open>Decomposing a vector into parts in orthogonal subspaces.\<close> |
|
12015 |
|
12016 text\<open>existence of orthonormal basis for a subspace.\<close> |
|
12017 |
|
12018 lemma orthogonal_spanningset_subspace: |
|
12019 fixes S :: "'a :: euclidean_space set" |
|
12020 assumes "subspace S" |
|
12021 obtains B where "B \<subseteq> S" "pairwise orthogonal B" "span B = S" |
|
12022 proof - |
|
12023 obtain B where "B \<subseteq> S" "independent B" "S \<subseteq> span B" "card B = dim S" |
|
12024 using basis_exists by blast |
|
12025 with orthogonal_extension [of "{}" B] |
|
12026 show ?thesis |
|
12027 by (metis Un_empty_left assms pairwise_empty span_inc span_subspace that) |
|
12028 qed |
|
12029 |
|
12030 lemma orthogonal_basis_subspace: |
|
12031 fixes S :: "'a :: euclidean_space set" |
|
12032 assumes "subspace S" |
|
12033 obtains B where "0 \<notin> B" "B \<subseteq> S" "pairwise orthogonal B" "independent B" |
|
12034 "card B = dim S" "span B = S" |
|
12035 proof - |
|
12036 obtain B where "B \<subseteq> S" "pairwise orthogonal B" "span B = S" |
|
12037 using assms orthogonal_spanningset_subspace by blast |
|
12038 then show ?thesis |
|
12039 apply (rule_tac B = "B - {0}" in that) |
|
12040 apply (auto simp: indep_card_eq_dim_span pairwise_subset Diff_subset pairwise_orthogonal_independent elim: pairwise_subset) |
|
12041 done |
|
12042 qed |
|
12043 |
|
12044 proposition orthogonal_subspace_decomp_exists: |
|
12045 fixes S :: "'a :: euclidean_space set" |
|
12046 obtains y z where "y \<in> span S" "\<And>w. w \<in> span S \<Longrightarrow> orthogonal z w" "x = y + z" |
|
12047 proof - |
|
12048 obtain T where "0 \<notin> T" "T \<subseteq> span S" "pairwise orthogonal T" "independent T" "card T = dim (span S)" "span T = span S" |
|
12049 using orthogonal_basis_subspace subspace_span by blast |
|
12050 let ?a = "\<Sum>b\<in>T. (b \<bullet> x / (b \<bullet> b)) *\<^sub>R b" |
|
12051 have orth: "orthogonal (x - ?a) w" if "w \<in> span S" for w |
|
12052 by (simp add: Gram_Schmidt_step \<open>pairwise orthogonal T\<close> \<open>span T = span S\<close> orthogonal_commute that) |
|
12053 show ?thesis |
|
12054 apply (rule_tac y = "?a" and z = "x - ?a" in that) |
|
12055 apply (meson \<open>T \<subseteq> span S\<close> span_mul span_setsum subsetCE) |
|
12056 apply (fact orth, simp) |
|
12057 done |
|
12058 qed |
|
12059 |
|
12060 lemma orthogonal_subspace_decomp_unique: |
|
12061 fixes S :: "'a :: euclidean_space set" |
|
12062 assumes "x + y = x' + y'" |
|
12063 and ST: "x \<in> span S" "x' \<in> span S" "y \<in> span T" "y' \<in> span T" |
|
12064 and orth: "\<And>a b. \<lbrakk>a \<in> S; b \<in> T\<rbrakk> \<Longrightarrow> orthogonal a b" |
|
12065 shows "x = x' \<and> y = y'" |
|
12066 proof - |
|
12067 have "x + y - y' = x'" |
|
12068 by (simp add: assms) |
|
12069 moreover have "\<And>a b. \<lbrakk>a \<in> span S; b \<in> span T\<rbrakk> \<Longrightarrow> orthogonal a b" |
|
12070 by (meson orth orthogonal_commute orthogonal_to_span) |
|
12071 ultimately have "0 = x' - x" |
|
12072 by (metis (full_types) add_diff_cancel_left' ST diff_right_commute orthogonal_clauses(10) orthogonal_clauses(5) orthogonal_self) |
|
12073 with assms show ?thesis by auto |
|
12074 qed |
|
12075 |
|
12076 |
|
12077 text\<open> If we take a slice out of a set, we can do it perpendicularly, |
|
12078 with the normal vector to the slice parallel to the affine hull.\<close> |
|
12079 |
|
12080 proposition affine_parallel_slice: |
|
12081 fixes S :: "'a :: euclidean_space set" |
|
12082 assumes "affine S" |
|
12083 and "S \<inter> {x. a \<bullet> x \<le> b} \<noteq> {}" |
|
12084 and "~ (S \<subseteq> {x. a \<bullet> x \<le> b})" |
|
12085 obtains a' b' where "a' \<noteq> 0" |
|
12086 "S \<inter> {x. a' \<bullet> x \<le> b'} = S \<inter> {x. a \<bullet> x \<le> b}" |
|
12087 "S \<inter> {x. a' \<bullet> x = b'} = S \<inter> {x. a \<bullet> x = b}" |
|
12088 "\<And>w. w \<in> S \<Longrightarrow> (w + a') \<in> S" |
|
12089 proof (cases "S \<inter> {x. a \<bullet> x = b} = {}") |
|
12090 case True |
|
12091 then obtain u v where "u \<in> S" "v \<in> S" "a \<bullet> u \<le> b" "a \<bullet> v > b" |
|
12092 using assms by (auto simp: not_le) |
|
12093 def \<eta> \<equiv> "u + ((b - a \<bullet> u) / (a \<bullet> v - a \<bullet> u)) *\<^sub>R (v - u)" |
|
12094 have "\<eta> \<in> S" |
|
12095 by (simp add: \<eta>_def \<open>u \<in> S\<close> \<open>v \<in> S\<close> \<open>affine S\<close> mem_affine_3_minus) |
|
12096 moreover have "a \<bullet> \<eta> = b" |
|
12097 using \<open>a \<bullet> u \<le> b\<close> \<open>b < a \<bullet> v\<close> |
|
12098 by (simp add: \<eta>_def algebra_simps) (simp add: field_simps) |
|
12099 ultimately have False |
|
12100 using True by force |
|
12101 then show ?thesis .. |
|
12102 next |
|
12103 case False |
|
12104 then obtain z where "z \<in> S" and z: "a \<bullet> z = b" |
|
12105 using assms by auto |
|
12106 with affine_diffs_subspace [OF \<open>affine S\<close>] |
|
12107 have sub: "subspace (op + (- z) ` S)" by blast |
|
12108 then have aff: "affine (op + (- z) ` S)" and span: "span (op + (- z) ` S) = (op + (- z) ` S)" |
|
12109 by (auto simp: subspace_imp_affine) |
|
12110 obtain a' a'' where a': "a' \<in> span (op + (- z) ` S)" and a: "a = a' + a''" |
|
12111 and "\<And>w. w \<in> span (op + (- z) ` S) \<Longrightarrow> orthogonal a'' w" |
|
12112 using orthogonal_subspace_decomp_exists [of "op + (- z) ` S" "a"] by metis |
|
12113 then have "\<And>w. w \<in> S \<Longrightarrow> a'' \<bullet> (w-z) = 0" |
|
12114 by (simp add: imageI orthogonal_def span) |
|
12115 then have a'': "\<And>w. w \<in> S \<Longrightarrow> a'' \<bullet> w = (a - a') \<bullet> z" |
|
12116 by (simp add: a inner_diff_right) |
|
12117 then have ba'': "\<And>w. w \<in> S \<Longrightarrow> a'' \<bullet> w = b - a' \<bullet> z" |
|
12118 by (simp add: inner_diff_left z) |
|
12119 have "\<And>w. w \<in> op + (- z) ` S \<Longrightarrow> (w + a') \<in> op + (- z) ` S" |
|
12120 by (metis subspace_add a' span_eq sub) |
|
12121 then have Sclo: "\<And>w. w \<in> S \<Longrightarrow> (w + a') \<in> S" |
|
12122 by fastforce |
|
12123 show ?thesis |
|
12124 proof (cases "a' = 0") |
|
12125 case True |
|
12126 with a assms True a'' diff_zero less_irrefl show ?thesis |
|
12127 by auto |
|
12128 next |
|
12129 case False |
|
12130 show ?thesis |
|
12131 apply (rule_tac a' = "a'" and b' = "a' \<bullet> z" in that) |
|
12132 apply (auto simp: a ba'' inner_left_distrib False Sclo) |
|
12133 done |
|
12134 qed |
|
12135 qed |
|
12136 |
11540 end |
12137 end |