src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy
changeset 63075 60a42a4166af
parent 63072 eb5d493a9e03
child 63077 844725394a37
equal deleted inserted replaced
63072:eb5d493a9e03 63075:60a42a4166af
  2134   by (metis hull_minimal span_inc subspace_imp_convex subspace_span)
  2134   by (metis hull_minimal span_inc subspace_imp_convex subspace_span)
  2135 
  2135 
  2136 lemma convex_hull_subset_affine_hull: "(convex hull s) \<subseteq> (affine hull s)"
  2136 lemma convex_hull_subset_affine_hull: "(convex hull s) \<subseteq> (affine hull s)"
  2137   by (metis affine_affine_hull affine_imp_convex hull_minimal hull_subset)
  2137   by (metis affine_affine_hull affine_imp_convex hull_minimal hull_subset)
  2138 
  2138 
  2139 
       
  2140 lemma affine_dependent_imp_dependent: "affine_dependent s \<Longrightarrow> dependent s"
  2139 lemma affine_dependent_imp_dependent: "affine_dependent s \<Longrightarrow> dependent s"
  2141   unfolding affine_dependent_def dependent_def
  2140   unfolding affine_dependent_def dependent_def
  2142   using affine_hull_subset_span by auto
  2141   using affine_hull_subset_span by auto
  2143 
  2142 
  2144 lemma dependent_imp_affine_dependent:
  2143 lemma dependent_imp_affine_dependent:
  2667 corollary dim_eq_span:
  2666 corollary dim_eq_span:
  2668   fixes S :: "'a::euclidean_space set"
  2667   fixes S :: "'a::euclidean_space set"
  2669   shows "\<lbrakk>S \<subseteq> T; dim T \<le> dim S\<rbrakk> \<Longrightarrow> span S = span T"
  2668   shows "\<lbrakk>S \<subseteq> T; dim T \<le> dim S\<rbrakk> \<Longrightarrow> span S = span T"
  2670 by (simp add: span_mono subspace_dim_equal subspace_span)
  2669 by (simp add: span_mono subspace_dim_equal subspace_span)
  2671 
  2670 
       
  2671 lemma dim_eq_full:
       
  2672     fixes S :: "'a :: euclidean_space set"
       
  2673     shows "dim S = DIM('a) \<longleftrightarrow> span S = UNIV"
       
  2674 apply (rule iffI)
       
  2675  apply (metis dim_eq_span dim_subset_UNIV span_Basis span_span subset_UNIV)
       
  2676 by (metis dim_UNIV dim_span)
       
  2677 
  2672 lemma span_substd_basis:
  2678 lemma span_substd_basis:
  2673   assumes d: "d \<subseteq> Basis"
  2679   assumes d: "d \<subseteq> Basis"
  2674   shows "span d = {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0}"
  2680   shows "span d = {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0}"
  2675   (is "_ = ?B")
  2681   (is "_ = ?B")
  2676 proof -
  2682 proof -
  2739 qed
  2745 qed
  2740 
  2746 
  2741 lemma aff_dim_empty_eq [simp]: "aff_dim ({}::'a::euclidean_space set) = -1"
  2747 lemma aff_dim_empty_eq [simp]: "aff_dim ({}::'a::euclidean_space set) = -1"
  2742   by (simp add: aff_dim_empty [symmetric])
  2748   by (simp add: aff_dim_empty [symmetric])
  2743 
  2749 
  2744 lemma aff_dim_affine_hull: "aff_dim (affine hull S) = aff_dim S"
  2750 lemma aff_dim_affine_hull [simp]: "aff_dim (affine hull S) = aff_dim S"
  2745   unfolding aff_dim_def using hull_hull[of _ S] by auto
  2751   unfolding aff_dim_def using hull_hull[of _ S] by auto
  2746 
  2752 
  2747 lemma aff_dim_affine_hull2:
  2753 lemma aff_dim_affine_hull2:
  2748   assumes "affine hull S = affine hull T"
  2754   assumes "affine hull S = affine hull T"
  2749   shows "aff_dim S = aff_dim T"
  2755   shows "aff_dim S = aff_dim T"
  3670   shows "aff_dim (closure S) = aff_dim S"
  3676   shows "aff_dim (closure S) = aff_dim S"
  3671 proof -
  3677 proof -
  3672   have "aff_dim S \<le> aff_dim (closure S)"
  3678   have "aff_dim S \<le> aff_dim (closure S)"
  3673     using aff_dim_subset closure_subset by auto
  3679     using aff_dim_subset closure_subset by auto
  3674   moreover have "aff_dim (closure S) \<le> aff_dim (affine hull S)"
  3680   moreover have "aff_dim (closure S) \<le> aff_dim (affine hull S)"
  3675     using aff_dim_subset closure_affine_hull by auto
  3681     using aff_dim_subset closure_affine_hull by blast
  3676   moreover have "aff_dim (affine hull S) = aff_dim S"
  3682   moreover have "aff_dim (affine hull S) = aff_dim S"
  3677     using aff_dim_affine_hull by auto
  3683     using aff_dim_affine_hull by auto
  3678   ultimately show ?thesis by auto
  3684   ultimately show ?thesis by auto
  3679 qed
  3685 qed
  3680 
  3686 
  4576     and "s \<noteq> {}"
  4582     and "s \<noteq> {}"
  4577     and "z \<notin> s"
  4583     and "z \<notin> s"
  4578   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)"
  4584   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)"
  4579 proof -
  4585 proof -
  4580   obtain y where "y \<in> s" and y: "\<forall>x\<in>s. dist z y \<le> dist z x"
  4586   obtain y where "y \<in> s" and y: "\<forall>x\<in>s. dist z y \<le> dist z x"
  4581     by (metis distance_attains_inf[OF assms(2-3)]) 
  4587     by (metis distance_attains_inf[OF assms(2-3)])
  4582   show ?thesis
  4588   show ?thesis
  4583     apply (rule_tac x="y - z" in exI)
  4589     apply (rule_tac x="y - z" in exI)
  4584     apply (rule_tac x="inner (y - z) y" in exI)
  4590     apply (rule_tac x="inner (y - z) y" in exI)
  4585     apply (rule_tac x=y in bexI)
  4591     apply (rule_tac x=y in bexI)
  4586     apply rule
  4592     apply rule
  6749 lemma open_segment_idem [simp]: "open_segment a a = {}"
  6755 lemma open_segment_idem [simp]: "open_segment a a = {}"
  6750   by (simp add: open_segment_def)
  6756   by (simp add: open_segment_def)
  6751 
  6757 
  6752 lemma closed_segment_eq_open: "closed_segment a b = open_segment a b \<union> {a,b}"
  6758 lemma closed_segment_eq_open: "closed_segment a b = open_segment a b \<union> {a,b}"
  6753   using open_segment_def by auto
  6759   using open_segment_def by auto
  6754   
  6760 
       
  6761 lemma convex_contains_open_segment:
       
  6762   "convex s \<longleftrightarrow> (\<forall>a\<in>s. \<forall>b\<in>s. open_segment a b \<subseteq> s)"
       
  6763   by (simp add: convex_contains_segment closed_segment_eq_open)
       
  6764 
  6755 lemma closed_segment_eq_real_ivl:
  6765 lemma closed_segment_eq_real_ivl:
  6756   fixes a b::real
  6766   fixes a b::real
  6757   shows "closed_segment a b = (if a \<le> b then {a .. b} else {b .. a})"
  6767   shows "closed_segment a b = (if a \<le> b then {a .. b} else {b .. a})"
  6758 proof -
  6768 proof -
  6759   have "b \<le> a \<Longrightarrow> closed_segment b a = {b .. a}"
  6769   have "b \<le> a \<Longrightarrow> closed_segment b a = {b .. a}"
  7757         then have "x \<in> span d"
  7767         then have "x \<in> span d"
  7758           using span_superset[of _ "d"] by auto
  7768           using span_superset[of _ "d"] by auto
  7759         then have "x /\<^sub>R (2 * real (card d)) \<in> span d"
  7769         then have "x /\<^sub>R (2 * real (card d)) \<in> span d"
  7760           using span_mul[of x "d" "(inverse (real (card d)) / 2)"] by auto
  7770           using span_mul[of x "d" "(inverse (real (card d)) / 2)"] by auto
  7761       }
  7771       }
  7762       then show "\<forall>x\<in>d. x /\<^sub>R (2 * real (card d)) \<in> span d"
  7772       then show "\<And>x. x\<in>d \<Longrightarrow> x /\<^sub>R (2 * real (card d)) \<in> span d"
  7763         by auto
  7773         by auto
  7764     qed
  7774     qed
  7765     then show "?a \<bullet> i = 0 "
  7775     then show "?a \<bullet> i = 0 "
  7766       using \<open>i \<notin> d\<close> unfolding span_substd_basis[OF assms(2)] using \<open>i \<in> Basis\<close> by auto
  7776       using \<open>i \<notin> d\<close> unfolding span_substd_basis[OF assms(2)] using \<open>i \<in> Basis\<close> by auto
  7767   qed
  7777   qed
  8122   assumes "convex S" "S \<noteq> {}" and ST: "rel_interior S \<subseteq> T" and TS: "T \<subseteq> closure S"
  8132   assumes "convex S" "S \<noteq> {}" and ST: "rel_interior S \<subseteq> T" and TS: "T \<subseteq> closure S"
  8123   shows "starlike T"
  8133   shows "starlike T"
  8124 proof -
  8134 proof -
  8125   have "rel_interior S \<noteq> {}"
  8135   have "rel_interior S \<noteq> {}"
  8126     by (simp add: assms rel_interior_eq_empty)
  8136     by (simp add: assms rel_interior_eq_empty)
  8127   then obtain a where a: "a \<in> rel_interior S"  by blast 
  8137   then obtain a where a: "a \<in> rel_interior S"  by blast
  8128   with ST have "a \<in> T"  by blast 
  8138   with ST have "a \<in> T"  by blast
  8129   have *: "\<And>x. x \<in> T \<Longrightarrow> open_segment a x \<subseteq> rel_interior S"
  8139   have *: "\<And>x. x \<in> T \<Longrightarrow> open_segment a x \<subseteq> rel_interior S"
  8130     apply (rule rel_interior_closure_convex_segment [OF \<open>convex S\<close> a])
  8140     apply (rule rel_interior_closure_convex_segment [OF \<open>convex S\<close> a])
  8131     using assms by blast
  8141     using assms by blast
  8132   show ?thesis
  8142   show ?thesis
  8133     unfolding starlike_def
  8143     unfolding starlike_def
 11011   proof (cases "c = 0")
 11021   proof (cases "c = 0")
 11012     case True show ?thesis
 11022     case True show ?thesis
 11013     apply (simp add: aff_dim_eq_dim [of c] affine_hull_span_gen [of c] \<open>c \<in> S\<close> hull_inc dim_eq_hyperplane
 11023     apply (simp add: aff_dim_eq_dim [of c] affine_hull_span_gen [of c] \<open>c \<in> S\<close> hull_inc dim_eq_hyperplane
 11014                 del: One_nat_def)
 11024                 del: One_nat_def)
 11015     apply (rule ex_cong)
 11025     apply (rule ex_cong)
 11016     using span_0
 11026     apply (metis (mono_tags) span_0 \<open>c = 0\<close> image_add_0 inner_zero_right mem_Collect_eq)
 11017     apply (force simp: \<open>c = 0\<close>)
       
 11018     done
 11027     done
 11019   next
 11028   next
 11020     case False
 11029     case False
 11021     have xc_im: "x \<in> op + c ` {y. a \<bullet> y = 0}" if "a \<bullet> x = a \<bullet> c" for a x
 11030     have xc_im: "x \<in> op + c ` {y. a \<bullet> y = 0}" if "a \<bullet> x = a \<bullet> c" for a x
 11022     proof -
 11031     proof -
 11046       apply (force simp: intro!: 2)
 11055       apply (force simp: intro!: 2)
 11047       done
 11056       done
 11048   qed
 11057   qed
 11049 qed
 11058 qed
 11050 
 11059 
 11051 corollary aff_dim_hyperplane:
 11060 corollary aff_dim_hyperplane [simp]:
 11052   fixes a :: "'a::euclidean_space"
 11061   fixes a :: "'a::euclidean_space"
 11053   shows "a \<noteq> 0 \<Longrightarrow> aff_dim {x. a \<bullet> x = r} = DIM('a) - 1"
 11062   shows "a \<noteq> 0 \<Longrightarrow> aff_dim {x. a \<bullet> x = r} = DIM('a) - 1"
 11054 by (metis aff_dim_eq_hyperplane affine_hull_eq affine_hyperplane)
 11063 by (metis aff_dim_eq_hyperplane affine_hull_eq affine_hyperplane)
 11055 
 11064 
 11056 subsection\<open>Some stepping theorems\<close>
 11065 subsection\<open>Some stepping theorems\<close>
 11377 using supporting_hyperplane_rel_boundary [of "closure S" x]
 11386 using supporting_hyperplane_rel_boundary [of "closure S" x]
 11378 by (metis assms convex_closure convex_rel_interior_closure)
 11387 by (metis assms convex_closure convex_rel_interior_closure)
 11379 
 11388 
 11380 subsection\<open> Some results on decomposing convex hulls, e.g. simplicial subdivision\<close>
 11389 subsection\<open> Some results on decomposing convex hulls, e.g. simplicial subdivision\<close>
 11381 
 11390 
 11382 lemma 
 11391 lemma
 11383   fixes s :: "'a::euclidean_space set"
 11392   fixes s :: "'a::euclidean_space set"
 11384   assumes "~ (affine_dependent(s \<union> t))" 
 11393   assumes "~ (affine_dependent(s \<union> t))"
 11385     shows convex_hull_Int_subset: "convex hull s \<inter> convex hull t \<subseteq> convex hull (s \<inter> t)" (is ?C)
 11394     shows convex_hull_Int_subset: "convex hull s \<inter> convex hull t \<subseteq> convex hull (s \<inter> t)" (is ?C)
 11386       and affine_hull_Int_subset: "affine hull s \<inter> affine hull t \<subseteq> affine hull (s \<inter> t)" (is ?A)
 11395       and affine_hull_Int_subset: "affine hull s \<inter> affine hull t \<subseteq> affine hull (s \<inter> t)" (is ?A)
 11387 proof -
 11396 proof -
 11388   have [simp]: "finite s" "finite t"
 11397   have [simp]: "finite s" "finite t"
 11389     using aff_independent_finite assms by blast+
 11398     using aff_independent_finite assms by blast+
 11390     have "setsum u (s \<inter> t) = 1 \<and> 
 11399     have "setsum u (s \<inter> t) = 1 \<and>
 11391           (\<Sum>v\<in>s \<inter> t. u v *\<^sub>R v) = (\<Sum>v\<in>s. u v *\<^sub>R v)" 
 11400           (\<Sum>v\<in>s \<inter> t. u v *\<^sub>R v) = (\<Sum>v\<in>s. u v *\<^sub>R v)"
 11392       if [simp]:  "setsum u s = 1" 
 11401       if [simp]:  "setsum u s = 1"
 11393                  "setsum v t = 1"
 11402                  "setsum v t = 1"
 11394          and eq: "(\<Sum>x\<in>t. v x *\<^sub>R x) = (\<Sum>x\<in>s. u x *\<^sub>R x)" for u v
 11403          and eq: "(\<Sum>x\<in>t. v x *\<^sub>R x) = (\<Sum>x\<in>s. u x *\<^sub>R x)" for u v
 11395     proof -
 11404     proof -
 11396     define f where "f x = (if x \<in> s then u x else 0) - (if x \<in> t then v x else 0)" for x
 11405     define f where "f x = (if x \<in> s then u x else 0) - (if x \<in> t then v x else 0)" for x
 11397     have "setsum f (s \<union> t) = 0"
 11406     have "setsum f (s \<union> t) = 0"
 11406       using aff_independent_finite assms unfolding affine_dependent_explicit
 11415       using aff_independent_finite assms unfolding affine_dependent_explicit
 11407       by blast
 11416       by blast
 11408     then have u [simp]: "\<And>x. x \<in> s \<Longrightarrow> u x = (if x \<in> t then v x else 0)"
 11417     then have u [simp]: "\<And>x. x \<in> s \<Longrightarrow> u x = (if x \<in> t then v x else 0)"
 11409       by (simp add: f_def) presburger
 11418       by (simp add: f_def) presburger
 11410     have "setsum u (s \<inter> t) = setsum u s"
 11419     have "setsum u (s \<inter> t) = setsum u s"
 11411       by (simp add: setsum.inter_restrict) 
 11420       by (simp add: setsum.inter_restrict)
 11412     then have "setsum u (s \<inter> t) = 1"
 11421     then have "setsum u (s \<inter> t) = 1"
 11413       using that by linarith
 11422       using that by linarith
 11414     moreover have "(\<Sum>v\<in>s \<inter> t. u v *\<^sub>R v) = (\<Sum>v\<in>s. u v *\<^sub>R v)"
 11423     moreover have "(\<Sum>v\<in>s \<inter> t. u v *\<^sub>R v) = (\<Sum>v\<in>s. u v *\<^sub>R v)"
 11415       by (auto simp: if_smult setsum.inter_restrict intro: setsum.cong)
 11424       by (auto simp: if_smult setsum.inter_restrict intro: setsum.cong)
 11416     ultimately show ?thesis
 11425     ultimately show ?thesis
 11421 qed
 11430 qed
 11422 
 11431 
 11423 
 11432 
 11424 proposition affine_hull_Int:
 11433 proposition affine_hull_Int:
 11425   fixes s :: "'a::euclidean_space set"
 11434   fixes s :: "'a::euclidean_space set"
 11426   assumes "~ (affine_dependent(s \<union> t))" 
 11435   assumes "~ (affine_dependent(s \<union> t))"
 11427     shows "affine hull (s \<inter> t) = affine hull s \<inter> affine hull t"
 11436     shows "affine hull (s \<inter> t) = affine hull s \<inter> affine hull t"
 11428 apply (rule subset_antisym)
 11437 apply (rule subset_antisym)
 11429 apply (simp add: hull_mono)
 11438 apply (simp add: hull_mono)
 11430 by (simp add: affine_hull_Int_subset assms)
 11439 by (simp add: affine_hull_Int_subset assms)
 11431 
 11440 
 11432 proposition convex_hull_Int:
 11441 proposition convex_hull_Int:
 11433   fixes s :: "'a::euclidean_space set"
 11442   fixes s :: "'a::euclidean_space set"
 11434   assumes "~ (affine_dependent(s \<union> t))" 
 11443   assumes "~ (affine_dependent(s \<union> t))"
 11435     shows "convex hull (s \<inter> t) = convex hull s \<inter> convex hull t"
 11444     shows "convex hull (s \<inter> t) = convex hull s \<inter> convex hull t"
 11436 apply (rule subset_antisym)
 11445 apply (rule subset_antisym)
 11437 apply (simp add: hull_mono)
 11446 apply (simp add: hull_mono)
 11438 by (simp add: convex_hull_Int_subset assms)
 11447 by (simp add: convex_hull_Int_subset assms)
 11439 
 11448 
 11440 proposition 
 11449 proposition
 11441   fixes s :: "'a::euclidean_space set set"
 11450   fixes s :: "'a::euclidean_space set set"
 11442   assumes "~ (affine_dependent (\<Union>s))" 
 11451   assumes "~ (affine_dependent (\<Union>s))"
 11443     shows affine_hull_Inter: "affine hull (\<Inter>s) = (\<Inter>t\<in>s. affine hull t)" (is "?A")
 11452     shows affine_hull_Inter: "affine hull (\<Inter>s) = (\<Inter>t\<in>s. affine hull t)" (is "?A")
 11444       and convex_hull_Inter: "convex hull (\<Inter>s) = (\<Inter>t\<in>s. convex hull t)" (is "?C")
 11453       and convex_hull_Inter: "convex hull (\<Inter>s) = (\<Inter>t\<in>s. convex hull t)" (is "?C")
 11445 proof -
 11454 proof -
 11446   have "finite s"
 11455   have "finite s"
 11447     using aff_independent_finite assms finite_UnionD by blast  
 11456     using aff_independent_finite assms finite_UnionD by blast
 11448   then have "?A \<and> ?C" using assms
 11457   then have "?A \<and> ?C" using assms
 11449   proof (induction s rule: finite_induct)
 11458   proof (induction s rule: finite_induct)
 11450     case empty then show ?case by auto
 11459     case empty then show ?case by auto
 11451   next
 11460   next
 11452     case (insert t F)
 11461     case (insert t F)
 11513   next
 11522   next
 11514     case False
 11523     case False
 11515     have ind: "\<not> affine_dependent (\<Union>a\<in>c - b. c - {a})"
 11524     have ind: "\<not> affine_dependent (\<Union>a\<in>c - b. c - {a})"
 11516       by (rule affine_independent_subset [OF indc]) auto
 11525       by (rule affine_independent_subset [OF indc]) auto
 11517     have affeq: "affine hull s = (\<Inter>x\<in>(\<lambda>a. c - {a}) ` (c - b). affine hull x)"
 11526     have affeq: "affine hull s = (\<Inter>x\<in>(\<lambda>a. c - {a}) ` (c - b). affine hull x)"
 11518       using \<open>b \<subseteq> c\<close> False 
 11527       using \<open>b \<subseteq> c\<close> False
 11519       apply (subst affine_hull_Inter [OF ind, symmetric])
 11528       apply (subst affine_hull_Inter [OF ind, symmetric])
 11520       apply (simp add: eq double_diff)
 11529       apply (simp add: eq double_diff)
 11521       done
 11530       done
 11522     have *: "1 + aff_dim (c - {t}) = int (DIM('a))" 
 11531     have *: "1 + aff_dim (c - {t}) = int (DIM('a))"
 11523             if t: "t \<in> c" for t
 11532             if t: "t \<in> c" for t
 11524     proof -
 11533     proof -
 11525       have "insert t c = c"
 11534       have "insert t c = c"
 11526         using t by blast
 11535         using t by blast
 11527       then show ?thesis
 11536       then show ?thesis
 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