src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy
changeset 49529 d523702bdae7
parent 47445 69e96e5500df
child 49530 7faf67b411b4
equal deleted inserted replaced
49528:789b73fcca72 49529:d523702bdae7
    22 
    22 
    23 lemma injective_scaleR: "c \<noteq> 0 \<Longrightarrow> inj (\<lambda>(x::'a::real_vector). scaleR c x)"
    23 lemma injective_scaleR: "c \<noteq> 0 \<Longrightarrow> inj (\<lambda>(x::'a::real_vector). scaleR c x)"
    24   by (simp add: inj_on_def)
    24   by (simp add: inj_on_def)
    25 
    25 
    26 lemma linear_add_cmul:
    26 lemma linear_add_cmul:
    27 assumes "linear f"
    27   assumes "linear f"
    28 shows "f(a *\<^sub>R x + b *\<^sub>R y) = a *\<^sub>R f x +  b *\<^sub>R f y"
    28   shows "f(a *\<^sub>R x + b *\<^sub>R y) = a *\<^sub>R f x +  b *\<^sub>R f y"
    29 using linear_add[of f] linear_cmul[of f] assms by (simp) 
    29   using linear_add[of f] linear_cmul[of f] assms by simp
    30 
    30 
    31 lemma mem_convex_2:
    31 lemma mem_convex_2:
    32   assumes "convex S" "x : S" "y : S" "u>=0" "v>=0" "u+v=1"
    32   assumes "convex S" "x : S" "y : S" "u>=0" "v>=0" "u+v=1"
    33   shows "(u *\<^sub>R x + v *\<^sub>R y) : S"
    33   shows "(u *\<^sub>R x + v *\<^sub>R y) : S"
    34   using assms convex_def[of S] by auto
    34   using assms convex_def[of S] by auto
    35 
    35 
    36 lemma mem_convex_alt:
    36 lemma mem_convex_alt:
    37   assumes "convex S" "x : S" "y : S" "u>=0" "v>=0" "u+v>0"
    37   assumes "convex S" "x : S" "y : S" "u>=0" "v>=0" "u+v>0"
    38   shows "((u/(u+v)) *\<^sub>R x + (v/(u+v)) *\<^sub>R y) : S"
    38   shows "((u/(u+v)) *\<^sub>R x + (v/(u+v)) *\<^sub>R y) : S"
    39 apply (subst mem_convex_2) 
    39   apply (subst mem_convex_2) 
    40 using assms apply (auto simp add: algebra_simps zero_le_divide_iff)
    40   using assms apply (auto simp add: algebra_simps zero_le_divide_iff)
    41 using add_divide_distrib[of u v "u+v"] by auto
    41   using add_divide_distrib[of u v "u+v"] apply auto
       
    42   done
    42 
    43 
    43 lemma inj_on_image_mem_iff: "inj_on f B ==> (A <= B) ==> (f a : f`A) ==> (a : B) ==> (a : A)" 
    44 lemma inj_on_image_mem_iff: "inj_on f B ==> (A <= B) ==> (f a : f`A) ==> (a : B) ==> (a : A)" 
    44 by (blast dest: inj_onD)
    45   by (blast dest: inj_onD)
    45 
    46 
    46 lemma independent_injective_on_span_image:
    47 lemma independent_injective_on_span_image:
    47   assumes iS: "independent S" 
    48   assumes iS: "independent S" 
    48      and lf: "linear f" and fi: "inj_on f (span S)"
    49     and lf: "linear f" and fi: "inj_on f (span S)"
    49   shows "independent (f ` S)"
    50   shows "independent (f ` S)"
    50 proof-
    51 proof -
    51   {fix a assume a: "a : S" "f a : span (f ` S - {f a})"
    52   {
    52     have eq: "f ` S - {f a} = f ` (S - {a})" using fi a span_inc
    53     fix a
    53       by (auto simp add: inj_on_def)
    54     assume a: "a : S" "f a : span (f ` S - {f a})"
       
    55     have eq: "f ` S - {f a} = f ` (S - {a})"
       
    56       using fi a span_inc by (auto simp add: inj_on_def)
    54     from a have "f a : f ` span (S -{a})"
    57     from a have "f a : f ` span (S -{a})"
    55       unfolding eq span_linear_image[OF lf, of "S - {a}"]  by blast
    58       unfolding eq span_linear_image[OF lf, of "S - {a}"] by blast
    56     moreover have "span (S -{a}) <= span S" using span_mono[of "S-{a}" S] by auto
    59     moreover have "span (S -{a}) <= span S" using span_mono[of "S-{a}" S] by auto
    57     ultimately have "a : span (S -{a})" using fi a span_inc by (auto simp add: inj_on_def)
    60     ultimately have "a : span (S -{a})" using fi a span_inc by (auto simp add: inj_on_def)
    58     with a(1) iS  have False by (simp add: dependent_def) }
    61     with a(1) iS have False by (simp add: dependent_def)
       
    62   }
    59   then show ?thesis unfolding dependent_def by blast
    63   then show ?thesis unfolding dependent_def by blast
    60 qed
    64 qed
    61 
    65 
    62 lemma dim_image_eq:
    66 lemma dim_image_eq:
    63 fixes f :: "'n::euclidean_space => 'm::euclidean_space"
    67   fixes f :: "'n::euclidean_space => 'm::euclidean_space"
    64 assumes lf: "linear f" and fi: "inj_on f (span S)" 
    68   assumes lf: "linear f" and fi: "inj_on f (span S)" 
    65 shows "dim (f ` S) = dim (S:: ('n::euclidean_space) set)"
    69   shows "dim (f ` S) = dim (S:: ('n::euclidean_space) set)"
    66 proof-
    70 proof -
    67 obtain B where B_def: "B<=S & independent B & S <= span B & card B = dim S" 
    71   obtain B where B_def: "B<=S & independent B & S <= span B & card B = dim S" 
    68   using basis_exists[of S] by auto
    72     using basis_exists[of S] by auto
    69 hence "span S = span B" using span_mono[of B S] span_mono[of S "span B"] span_span[of B] by auto
    73   then have "span S = span B"
    70 hence "independent (f ` B)" using independent_injective_on_span_image[of B f] B_def assms by auto
    74     using span_mono[of B S] span_mono[of S "span B"] span_span[of B] by auto
    71 moreover have "card (f ` B) = card B" using assms card_image[of f B] subset_inj_on[of f "span S" B] 
    75   then have "independent (f ` B)"
    72    B_def span_inc by auto
    76     using independent_injective_on_span_image[of B f] B_def assms by auto
    73 moreover have "(f ` B) <= (f ` S)" using B_def by auto
    77   moreover have "card (f ` B) = card B"
    74 ultimately have "dim (f ` S) >= dim S" 
    78     using assms card_image[of f B] subset_inj_on[of f "span S" B] B_def span_inc by auto
    75   using independent_card_le_dim[of "f ` B" "f ` S"] B_def by auto
    79   moreover have "(f ` B) <= (f ` S)" using B_def by auto
    76 from this show ?thesis using dim_image_le[of f S] assms by auto
    80   ultimately have "dim (f ` S) >= dim S"
       
    81     using independent_card_le_dim[of "f ` B" "f ` S"] B_def by auto
       
    82   then show ?thesis using dim_image_le[of f S] assms by auto
    77 qed
    83 qed
    78 
    84 
    79 lemma linear_injective_on_subspace_0:
    85 lemma linear_injective_on_subspace_0:
    80 assumes lf: "linear f" and "subspace S"
    86   assumes lf: "linear f" and "subspace S"
    81   shows "inj_on f S <-> (!x : S. f x = 0 --> x = 0)"
    87   shows "inj_on f S <-> (!x : S. f x = 0 --> x = 0)"
    82 proof-
    88 proof -
    83   have "inj_on f S <-> (!x : S. !y : S. f x = f y --> x = y)" by (simp add: inj_on_def)
    89   have "inj_on f S <-> (!x : S. !y : S. f x = f y --> x = y)" by (simp add: inj_on_def)
    84   also have "... <-> (!x : S. !y : S. f x - f y = 0 --> x - y = 0)" by simp
    90   also have "... <-> (!x : S. !y : S. f x - f y = 0 --> x - y = 0)" by simp
    85   also have "... <-> (!x : S. !y : S. f (x - y) = 0 --> x - y = 0)"
    91   also have "... <-> (!x : S. !y : S. f (x - y) = 0 --> x - y = 0)"
    86     by (simp add: linear_sub[OF lf])
    92     by (simp add: linear_sub[OF lf])
    87   also have "... <-> (! x : S. f x = 0 --> x = 0)" 
    93   also have "... <-> (! x : S. f x = 0 --> x = 0)" 
    94 
   100 
    95 lemma span_eq[simp]: "(span s = s) <-> subspace s"
   101 lemma span_eq[simp]: "(span s = s) <-> subspace s"
    96   unfolding span_def by (rule hull_eq, rule subspace_Inter)
   102   unfolding span_def by (rule hull_eq, rule subspace_Inter)
    97 
   103 
    98 lemma basis_inj_on: "d \<subseteq> {..<DIM('n)} \<Longrightarrow> inj_on (basis :: nat => 'n::euclidean_space) d"
   104 lemma basis_inj_on: "d \<subseteq> {..<DIM('n)} \<Longrightarrow> inj_on (basis :: nat => 'n::euclidean_space) d"
    99   by(auto simp add: inj_on_def euclidean_eq[where 'a='n])
   105   by (auto simp add: inj_on_def euclidean_eq[where 'a='n])
   100   
   106   
   101 lemma finite_substdbasis: "finite {basis i ::'n::euclidean_space |i. i : (d:: nat set)}" (is "finite ?S")
   107 lemma finite_substdbasis: "finite {basis i ::'n::euclidean_space |i. i : (d:: nat set)}" (is "finite ?S")
   102 proof-
   108 proof -
   103   have eq: "?S = basis ` d" by blast
   109   have eq: "?S = basis ` d" by blast
   104   show ?thesis unfolding eq apply(rule finite_subset[OF _ range_basis_finite]) by auto
   110   show ?thesis
   105 qed
   111     unfolding eq
   106 
   112     apply (rule finite_subset[OF _ range_basis_finite])
   107 lemma card_substdbasis: assumes "d \<subseteq> {..<DIM('n::euclidean_space)}"
   113     apply auto
       
   114     done
       
   115 qed
       
   116 
       
   117 lemma card_substdbasis:
       
   118   assumes "d \<subseteq> {..<DIM('n::euclidean_space)}"
   108   shows "card {basis i ::'n::euclidean_space | i. i : d} = card d" (is "card ?S = _")
   119   shows "card {basis i ::'n::euclidean_space | i. i : d} = card d" (is "card ?S = _")
   109 proof-
   120 proof -
   110   have eq: "?S = basis ` d" by blast
   121   have eq: "?S = basis ` d" by blast
   111   show ?thesis unfolding eq using card_image[OF basis_inj_on[of d]] assms by auto
   122   show ?thesis
   112 qed
   123     unfolding eq
   113 
   124     using card_image[OF basis_inj_on[of d]] assms by auto
   114 lemma substdbasis_expansion_unique: assumes "d\<subseteq>{..<DIM('a::euclidean_space)}"
   125 qed
       
   126 
       
   127 lemma substdbasis_expansion_unique:
       
   128   assumes "d\<subseteq>{..<DIM('a::euclidean_space)}"
   115   shows "setsum (%i. f i *\<^sub>R basis i) d = (x::'a::euclidean_space)
   129   shows "setsum (%i. f i *\<^sub>R basis i) d = (x::'a::euclidean_space)
   116       <-> (!i<DIM('a). (i:d --> f i = x$$i) & (i ~: d --> x $$ i = 0))"
   130       <-> (!i<DIM('a). (i:d --> f i = x$$i) & (i ~: d --> x $$ i = 0))"
   117 proof- have *:"\<And>x a b P. x * (if P then a else b) = (if P then x*a else x*b)" by auto
   131 proof -
   118   have **:"finite d" apply(rule finite_subset[OF assms]) by fastforce
   132   have *: "\<And>x a b P. x * (if P then a else b) = (if P then x*a else x*b)" by auto
   119   have ***:"\<And>i. (setsum (%i. f i *\<^sub>R ((basis i)::'a)) d) $$ i = (\<Sum>x\<in>d. if x = i then f x else 0)"
   133   have **: "finite d" apply(rule finite_subset[OF assms]) by fastforce
       
   134   have ***: "\<And>i. (setsum (%i. f i *\<^sub>R ((basis i)::'a)) d) $$ i = (\<Sum>x\<in>d. if x = i then f x else 0)"
   120     unfolding euclidean_component_setsum euclidean_component_scaleR basis_component *
   135     unfolding euclidean_component_setsum euclidean_component_scaleR basis_component *
   121     apply(rule setsum_cong2) using assms by auto
   136     apply (rule setsum_cong2)
   122   show ?thesis unfolding euclidean_eq[where 'a='a] *** setsum_delta[OF **] using assms by auto
   137     using assms apply auto
   123 qed
   138     done
   124 
   139   show ?thesis
   125 lemma independent_substdbasis: assumes "d\<subseteq>{..<DIM('a::euclidean_space)}"
   140     unfolding euclidean_eq[where 'a='a] *** setsum_delta[OF **] using assms by auto
   126   shows "independent {basis i ::'a::euclidean_space |i. i : (d :: nat set)}" (is "independent ?A")
   141 qed
       
   142 
       
   143 lemma independent_substdbasis:
       
   144   assumes "d \<subseteq> {..<DIM('a::euclidean_space)}"
       
   145   shows "independent {basis i ::'a::euclidean_space |i. i : (d :: nat set)}"
       
   146   (is "independent ?A")
   127 proof -
   147 proof -
   128   have *: "{basis i |i. i < DIM('a)} = basis ` {..<DIM('a)}" by auto
   148   have *: "{basis i |i. i < DIM('a)} = basis ` {..<DIM('a)}" by auto
   129   show ?thesis
   149   show ?thesis
   130     apply(intro independent_mono[of "{basis i ::'a |i. i : {..<DIM('a::euclidean_space)}}" "?A"] )
   150     apply(intro independent_mono[of "{basis i ::'a |i. i : {..<DIM('a::euclidean_space)}}" "?A"] )
   131     using independent_basis[where 'a='a] assms by (auto simp: *)
   151     using independent_basis[where 'a='a] assms apply (auto simp: *)
       
   152     done
   132 qed
   153 qed
   133 
   154 
   134 lemma dim_cball: 
   155 lemma dim_cball: 
   135 assumes "0<e"
   156   assumes "0<e"
   136 shows "dim (cball (0 :: 'n::euclidean_space) e) = DIM('n)"
   157   shows "dim (cball (0 :: 'n::euclidean_space) e) = DIM('n)"
   137 proof-
   158 proof -
   138 { fix x :: "'n::euclidean_space" def y == "(e/norm x) *\<^sub>R x"
   159   { fix x :: "'n::euclidean_space"
   139   hence "y : cball 0 e" using cball_def dist_norm[of 0 y] assms by auto
   160     def y == "(e/norm x) *\<^sub>R x"
   140   moreover have "x = (norm x/e) *\<^sub>R y" using y_def assms by simp
   161     then have "y : cball 0 e" using cball_def dist_norm[of 0 y] assms by auto
   141   moreover hence "x = (norm x/e) *\<^sub>R y"  by auto
   162     moreover have "x = (norm x/e) *\<^sub>R y" using y_def assms by simp
   142   ultimately have "x : span (cball 0 e)"
   163     moreover hence "x = (norm x/e) *\<^sub>R y" by auto
   143      using span_mul[of y "cball 0 e" "norm x/e"] span_inc[of "cball 0 e"] by auto
   164     ultimately have "x : span (cball 0 e)"
   144 } hence "span (cball 0 e) = (UNIV :: ('n::euclidean_space) set)" by auto 
   165       using span_mul[of y "cball 0 e" "norm x/e"] span_inc[of "cball 0 e"] by auto
   145 from this show ?thesis using dim_span[of "cball (0 :: 'n::euclidean_space) e"] by (auto simp add: dim_UNIV)
   166   } then have "span (cball 0 e) = (UNIV :: ('n::euclidean_space) set)" by auto 
       
   167   then show ?thesis
       
   168     using dim_span[of "cball (0 :: 'n::euclidean_space) e"] by (auto simp add: dim_UNIV)
   146 qed
   169 qed
   147 
   170 
   148 lemma indep_card_eq_dim_span:
   171 lemma indep_card_eq_dim_span:
   149 fixes B :: "('n::euclidean_space) set"
   172   fixes B :: "('n::euclidean_space) set"
   150 assumes "independent B"
   173   assumes "independent B"
   151 shows "finite B & card B = dim (span B)" 
   174   shows "finite B & card B = dim (span B)" 
   152   using assms basis_card_eq_dim[of B "span B"] span_inc by auto
   175   using assms basis_card_eq_dim[of B "span B"] span_inc by auto
   153 
   176 
   154 lemma setsum_not_0: "setsum f A ~= 0 ==> EX a:A. f a ~= 0"
   177 lemma setsum_not_0: "setsum f A ~= 0 ==> EX a:A. f a ~= 0"
   155   apply(rule ccontr) by auto
   178   by (rule ccontr) auto
   156 
   179 
   157 lemma translate_inj_on: 
   180 lemma translate_inj_on: 
   158 fixes A :: "('a::ab_group_add) set"
   181   fixes A :: "('a::ab_group_add) set"
   159 shows "inj_on (%x. a+x) A" unfolding inj_on_def by auto
   182   shows "inj_on (%x. a+x) A"
       
   183   unfolding inj_on_def by auto
   160 
   184 
   161 lemma translation_assoc:
   185 lemma translation_assoc:
   162   fixes a b :: "'a::ab_group_add"
   186   fixes a b :: "'a::ab_group_add"
   163   shows "(\<lambda>x. b+x) ` ((\<lambda>x. a+x) ` S) = (\<lambda>x. (a+b)+x) ` S" by auto
   187   shows "(\<lambda>x. b+x) ` ((\<lambda>x. a+x) ` S) = (\<lambda>x. (a+b)+x) ` S"
       
   188   by auto
   164 
   189 
   165 lemma translation_invert:
   190 lemma translation_invert:
   166   fixes a :: "'a::ab_group_add"
   191   fixes a :: "'a::ab_group_add"
   167   assumes "(\<lambda>x. a+x) ` A = (\<lambda>x. a+x) ` B"
   192   assumes "(\<lambda>x. a+x) ` A = (\<lambda>x. a+x) ` B"
   168   shows "A=B"
   193   shows "A = B"
   169 proof-
   194 proof -
   170   have "(%x. -a+x) ` ((%x. a+x) ` A) = (%x. -a+x) ` ((%x. a+x) ` B)" using assms by auto
   195   have "(%x. -a+x) ` ((%x. a+x) ` A) = (%x. -a+x) ` ((%x. a+x) ` B)"
   171   from this show ?thesis using translation_assoc[of "-a" a A] translation_assoc[of "-a" a B] by auto 
   196     using assms by auto
       
   197   then show ?thesis
       
   198     using translation_assoc[of "-a" a A] translation_assoc[of "-a" a B] by auto
   172 qed
   199 qed
   173 
   200 
   174 lemma translation_galois:
   201 lemma translation_galois:
   175   fixes a :: "'a::ab_group_add"
   202   fixes a :: "'a::ab_group_add"
   176   shows "T=((\<lambda>x. a+x) ` S) <-> S=((\<lambda>x. (-a)+x) ` T)"
   203   shows "T=((\<lambda>x. a+x) ` S) <-> S=((\<lambda>x. (-a)+x) ` T)"
   177   using translation_assoc[of "-a" a S] apply auto
   204   using translation_assoc[of "-a" a S] apply auto
   178   using translation_assoc[of a "-a" T] by auto
   205   using translation_assoc[of a "-a" T] apply auto
       
   206   done
   179 
   207 
   180 lemma translation_inverse_subset:
   208 lemma translation_inverse_subset:
   181   assumes "((%x. -a+x) ` V) <= (S :: 'n::ab_group_add set)" 
   209   assumes "((%x. -a+x) ` V) <= (S :: 'n::ab_group_add set)" 
   182   shows "V <= ((%x. a+x) ` S)"
   210   shows "V <= ((%x. a+x) ` S)"
   183 proof-
   211 proof -
   184 { fix x assume "x:V" hence "x-a : S" using assms by auto 
   212   { fix x
   185   hence "x : {a + v |v. v : S}" apply auto apply (rule exI[of _ "x-a"]) apply simp done 
   213     assume "x:V"
   186   hence "x : ((%x. a+x) ` S)" by auto }
   214     then have "x-a : S" using assms by auto
   187   from this show ?thesis by auto
   215     then have "x : {a + v |v. v : S}"
       
   216       apply auto
       
   217       apply (rule exI[of _ "x-a"])
       
   218       apply simp
       
   219       done
       
   220     then have "x : ((%x. a+x) ` S)" by auto
       
   221   } then show ?thesis by auto
   188 qed
   222 qed
   189 
   223 
   190 lemma basis_to_basis_subspace_isomorphism:
   224 lemma basis_to_basis_subspace_isomorphism:
   191   assumes s: "subspace (S:: ('n::euclidean_space) set)"
   225   assumes s: "subspace (S:: ('n::euclidean_space) set)"
   192   and t: "subspace (T :: ('m::euclidean_space) set)"
   226     and t: "subspace (T :: ('m::euclidean_space) set)"
   193   and d: "dim S = dim T"
   227     and d: "dim S = dim T"
   194   and B: "B <= S" "independent B" "S <= span B" "card B = dim S"
   228     and B: "B <= S" "independent B" "S <= span B" "card B = dim S"
   195   and C: "C <= T" "independent C" "T <= span C" "card C = dim T"
   229     and C: "C <= T" "independent C" "T <= span C" "card C = dim T"
   196   shows "EX f. linear f & f ` B = C & f ` S = T & inj_on f S"
   230   shows "EX f. linear f & f ` B = C & f ` S = T & inj_on f S"
   197 proof-
   231 proof -
   198 (* Proof is a modified copy of the proof of similar lemma subspace_isomorphism
   232 (* Proof is a modified copy of the proof of similar lemma subspace_isomorphism
   199 *)
   233 *)
   200   from B independent_bound have fB: "finite B" by blast
   234   from B independent_bound have fB: "finite B" by blast
   201   from C independent_bound have fC: "finite C" by blast
   235   from C independent_bound have fC: "finite C" by blast
   202   from B(4) C(4) card_le_inj[of B C] d obtain f where
   236   from B(4) C(4) card_le_inj[of B C] d obtain f where
   212   also have "\<dots> = C" using card_subset_eq[OF fC f(1) ceq] .
   246   also have "\<dots> = C" using card_subset_eq[OF fC f(1) ceq] .
   213   finally have gBC: "g ` B = C" .
   247   finally have gBC: "g ` B = C" .
   214   have gi: "inj_on g B" using f(2) g(2)
   248   have gi: "inj_on g B" using f(2) g(2)
   215     by (auto simp add: inj_on_def)
   249     by (auto simp add: inj_on_def)
   216   note g0 = linear_indep_image_lemma[OF g(1) fB, unfolded gBC, OF C(2) gi]
   250   note g0 = linear_indep_image_lemma[OF g(1) fB, unfolded gBC, OF C(2) gi]
   217   {fix x y assume x: "x \<in> S" and y: "y \<in> S" and gxy:"g x = g y"
   251   { fix x y
       
   252     assume x: "x \<in> S" and y: "y \<in> S" and gxy: "g x = g y"
   218     from B(3) x y have x': "x \<in> span B" and y': "y \<in> span B" by blast+
   253     from B(3) x y have x': "x \<in> span B" and y': "y \<in> span B" by blast+
   219     from gxy have th0: "g (x - y) = 0" by (simp add: linear_sub[OF g(1)])
   254     from gxy have th0: "g (x - y) = 0" by (simp add: linear_sub[OF g(1)])
   220     have th1: "x - y \<in> span B" using x' y' by (metis span_sub)
   255     have th1: "x - y \<in> span B" using x' y' by (metis span_sub)
   221     have "x=y" using g0[OF th1 th0] by simp }
   256     have "x=y" using g0[OF th1 th0] by simp
   222   then have giS: "inj_on g S"
   257   } then have giS: "inj_on g S" unfolding inj_on_def by blast
   223     unfolding inj_on_def by blast
       
   224   from span_subspace[OF B(1,3) s]
   258   from span_subspace[OF B(1,3) s]
   225   have "g ` S = span (g ` B)" by (simp add: span_linear_image[OF g(1)])
   259   have "g ` S = span (g ` B)" by (simp add: span_linear_image[OF g(1)])
   226   also have "\<dots> = span C" unfolding gBC ..
   260   also have "\<dots> = span C" unfolding gBC ..
   227   also have "\<dots> = T" using span_subspace[OF C(1,3) t] .
   261   also have "\<dots> = T" using span_subspace[OF C(1,3) t] .
   228   finally have gS: "g ` S = T" .
   262   finally have gS: "g ` S = T" .
   234   shows "f ` (closure S) \<subseteq> closure (f ` S)"
   268   shows "f ` (closure S) \<subseteq> closure (f ` S)"
   235   using linear_continuous_on [OF f] closed_closure closure_subset
   269   using linear_continuous_on [OF f] closed_closure closure_subset
   236   by (rule image_closure_subset)
   270   by (rule image_closure_subset)
   237 
   271 
   238 lemma closure_linear_image:
   272 lemma closure_linear_image:
   239 fixes f :: "('m::euclidean_space) => ('n::real_normed_vector)"
   273   fixes f :: "('m::euclidean_space) => ('n::real_normed_vector)"
   240 assumes "linear f"
   274   assumes "linear f"
   241 shows "f ` (closure S) <= closure (f ` S)"
   275   shows "f ` (closure S) <= closure (f ` S)"
   242   using assms unfolding linear_conv_bounded_linear
   276   using assms unfolding linear_conv_bounded_linear
   243   by (rule closure_bounded_linear_image)
   277   by (rule closure_bounded_linear_image)
   244 
   278 
   245 lemma closure_injective_linear_image:
   279 lemma closure_injective_linear_image:
   246 fixes f :: "('n::euclidean_space) => ('n::euclidean_space)"
   280   fixes f :: "('n::euclidean_space) => ('n::euclidean_space)"
   247 assumes "linear f" "inj f"
   281   assumes "linear f" "inj f"
   248 shows "f ` (closure S) = closure (f ` S)"
   282   shows "f ` (closure S) = closure (f ` S)"
   249 proof-
   283 proof -
   250 obtain f' where f'_def: "linear f' & f o f' = id & f' o f = id" 
   284   obtain f' where f'_def: "linear f' & f o f' = id & f' o f = id"
   251    using assms linear_injective_isomorphism[of f] isomorphism_expand by auto
   285     using assms linear_injective_isomorphism[of f] isomorphism_expand by auto
   252 hence "f' ` closure (f ` S) <= closure (S)"
   286   then have "f' ` closure (f ` S) <= closure (S)"
   253    using closure_linear_image[of f' "f ` S"] image_compose[of f' f] by auto
   287     using closure_linear_image[of f' "f ` S"] image_compose[of f' f] by auto
   254 hence "f ` f' ` closure (f ` S) <= f ` closure (S)" by auto
   288   then have "f ` f' ` closure (f ` S) <= f ` closure (S)" by auto
   255 hence "closure (f ` S) <= f ` closure (S)" using image_compose[of f f' "closure (f ` S)"] f'_def by auto
   289   then have "closure (f ` S) <= f ` closure (S)"
   256 from this show ?thesis using closure_linear_image[of f S] assms by auto 
   290     using image_compose[of f f' "closure (f ` S)"] f'_def by auto
       
   291   then show ?thesis using closure_linear_image[of f S] assms by auto
   257 qed
   292 qed
   258 
   293 
   259 lemma closure_direct_sum:
   294 lemma closure_direct_sum:
   260 shows "closure (S <*> T) = closure S <*> closure T"
   295   shows "closure (S <*> T) = closure S <*> closure T"
   261   by (rule closure_Times)
   296   by (rule closure_Times)
   262 
   297 
   263 lemma closure_scaleR:
   298 lemma closure_scaleR:
   264   fixes S :: "('a::real_normed_vector) set"
   299   fixes S :: "('a::real_normed_vector) set"
   265   shows "(op *\<^sub>R c) ` (closure S) = closure ((op *\<^sub>R c) ` S)"
   300   shows "(op *\<^sub>R c) ` (closure S) = closure ((op *\<^sub>R c) ` S)"
   266 proof
   301 proof
   267   show "(op *\<^sub>R c) ` (closure S) \<subseteq> closure ((op *\<^sub>R c) ` S)"
   302   show "(op *\<^sub>R c) ` (closure S) \<subseteq> closure ((op *\<^sub>R c) ` S)"
   268     using bounded_linear_scaleR_right
   303     using bounded_linear_scaleR_right by (rule closure_bounded_linear_image)
   269     by (rule closure_bounded_linear_image)
       
   270   show "closure ((op *\<^sub>R c) ` S) \<subseteq> (op *\<^sub>R c) ` (closure S)"
   304   show "closure ((op *\<^sub>R c) ` S) \<subseteq> (op *\<^sub>R c) ` (closure S)"
   271     by (intro closure_minimal image_mono closure_subset
   305     by (intro closure_minimal image_mono closure_subset closed_scaling closed_closure)
   272       closed_scaling closed_closure)
   306 qed
   273 qed
   307 
   274 
   308 lemma fst_linear: "linear fst"
   275 lemma fst_linear: "linear fst" unfolding linear_def by (simp add: algebra_simps)
   309   unfolding linear_def by (simp add: algebra_simps)
   276 
   310 
   277 lemma snd_linear: "linear snd" unfolding linear_def by (simp add: algebra_simps)
   311 lemma snd_linear: "linear snd"
   278 
   312   unfolding linear_def by (simp add: algebra_simps)
   279 lemma fst_snd_linear: "linear (%(x,y). x + y)" unfolding linear_def by (simp add: algebra_simps)
   313 
       
   314 lemma fst_snd_linear: "linear (%(x,y). x + y)"
       
   315   unfolding linear_def by (simp add: algebra_simps)
   280 
   316 
   281 lemma scaleR_2:
   317 lemma scaleR_2:
   282   fixes x :: "'a::real_vector"
   318   fixes x :: "'a::real_vector"
   283   shows "scaleR 2 x = x + x"
   319   shows "scaleR 2 x = x + x"
   284 unfolding one_add_one [symmetric] scaleR_left_distrib by simp
   320   unfolding one_add_one [symmetric] scaleR_left_distrib by simp
   285 
   321 
   286 lemma vector_choose_size: "0 <= c ==> \<exists>(x::'a::euclidean_space). norm x = c"
   322 lemma vector_choose_size:
   287   apply (rule exI[where x="c *\<^sub>R basis 0 ::'a"]) using DIM_positive[where 'a='a] by auto
   323   "0 <= c ==> \<exists>(x::'a::euclidean_space). norm x = c"
   288 
   324   apply (rule exI[where x="c *\<^sub>R basis 0 ::'a"])
   289 lemma setsum_delta_notmem: assumes "x\<notin>s"
   325   using DIM_positive[where 'a='a] apply auto
       
   326   done
       
   327 
       
   328 lemma setsum_delta_notmem:
       
   329   assumes "x \<notin> s"
   290   shows "setsum (\<lambda>y. if (y = x) then P x else Q y) s = setsum Q s"
   330   shows "setsum (\<lambda>y. if (y = x) then P x else Q y) s = setsum Q s"
   291         "setsum (\<lambda>y. if (x = y) then P x else Q y) s = setsum Q s"
   331     and "setsum (\<lambda>y. if (x = y) then P x else Q y) s = setsum Q s"
   292         "setsum (\<lambda>y. if (y = x) then P y else Q y) s = setsum Q s"
   332     and "setsum (\<lambda>y. if (y = x) then P y else Q y) s = setsum Q s"
   293         "setsum (\<lambda>y. if (x = y) then P y else Q y) s = setsum Q s"
   333     and "setsum (\<lambda>y. if (x = y) then P y else Q y) s = setsum Q s"
   294   apply(rule_tac [!] setsum_cong2) using assms by auto
   334   apply(rule_tac [!] setsum_cong2)
       
   335   using assms apply auto
       
   336   done
   295 
   337 
   296 lemma setsum_delta'':
   338 lemma setsum_delta'':
   297   fixes s::"'a::real_vector set" assumes "finite s"
   339   fixes s::"'a::real_vector set"
       
   340   assumes "finite s"
   298   shows "(\<Sum>x\<in>s. (if y = x then f x else 0) *\<^sub>R x) = (if y\<in>s then (f y) *\<^sub>R y else 0)"
   341   shows "(\<Sum>x\<in>s. (if y = x then f x else 0) *\<^sub>R x) = (if y\<in>s then (f y) *\<^sub>R y else 0)"
   299 proof-
   342 proof -
   300   have *:"\<And>x y. (if y = x then f x else (0::real)) *\<^sub>R x = (if x=y then (f x) *\<^sub>R x else 0)" by auto
   343   have *: "\<And>x y. (if y = x then f x else (0::real)) *\<^sub>R x = (if x=y then (f x) *\<^sub>R x else 0)"
   301   show ?thesis unfolding * using setsum_delta[OF assms, of y "\<lambda>x. f x *\<^sub>R x"] by auto
   344     by auto
       
   345   show ?thesis
       
   346     unfolding * using setsum_delta[OF assms, of y "\<lambda>x. f x *\<^sub>R x"] by auto
   302 qed
   347 qed
   303 
   348 
   304 lemma if_smult:"(if P then x else (y::real)) *\<^sub>R v = (if P then x *\<^sub>R v else y *\<^sub>R v)" by auto
   349 lemma if_smult:"(if P then x else (y::real)) *\<^sub>R v = (if P then x *\<^sub>R v else y *\<^sub>R v)" by auto
   305 
   350 
   306 lemma image_smult_interval:"(\<lambda>x. m *\<^sub>R (x::'a::ordered_euclidean_space)) ` {a..b} =
   351 lemma image_smult_interval:
   307   (if {a..b} = {} then {} else if 0 \<le> m then {m *\<^sub>R a..m *\<^sub>R b} else {m *\<^sub>R b..m *\<^sub>R a})"
   352   "(\<lambda>x. m *\<^sub>R (x::'a::ordered_euclidean_space)) ` {a..b} =
       
   353     (if {a..b} = {} then {} else if 0 \<le> m then {m *\<^sub>R a..m *\<^sub>R b} else {m *\<^sub>R b..m *\<^sub>R a})"
   308   using image_affinity_interval[of m 0 a b] by auto
   354   using image_affinity_interval[of m 0 a b] by auto
   309 
   355 
   310 lemma dist_triangle_eq:
   356 lemma dist_triangle_eq:
   311   fixes x y z :: "'a::real_inner"
   357   fixes x y z :: "'a::real_inner"
   312   shows "dist x z = dist x y + dist y z \<longleftrightarrow> norm (x - y) *\<^sub>R (y - z) = norm (y - z) *\<^sub>R (x - y)"
   358   shows "dist x z = dist x y + dist y z \<longleftrightarrow> norm (x - y) *\<^sub>R (y - z) = norm (y - z) *\<^sub>R (x - y)"
   313 proof- have *:"x - y + (y - z) = x - z" by auto
   359 proof -
       
   360   have *: "x - y + (y - z) = x - z" by auto
   314   show ?thesis unfolding dist_norm norm_triangle_eq[of "x - y" "y - z", unfolded *]
   361   show ?thesis unfolding dist_norm norm_triangle_eq[of "x - y" "y - z", unfolded *]
   315     by(auto simp add:norm_minus_commute) qed
   362     by (auto simp add:norm_minus_commute)
       
   363 qed
   316 
   364 
   317 lemma norm_minus_eqI:"x = - y \<Longrightarrow> norm x = norm y" by auto
   365 lemma norm_minus_eqI:"x = - y \<Longrightarrow> norm x = norm y" by auto
   318 
   366 
   319 lemma Min_grI: assumes "finite A" "A \<noteq> {}" "\<forall>a\<in>A. x < a" shows "x < Min A"
   367 lemma Min_grI:
       
   368   assumes "finite A" "A \<noteq> {}" "\<forall>a\<in>A. x < a"
       
   369   shows "x < Min A"
   320   unfolding Min_gr_iff[OF assms(1,2)] using assms(3) by auto
   370   unfolding Min_gr_iff[OF assms(1,2)] using assms(3) by auto
   321 
   371 
   322 lemma norm_lt: "norm x < norm y \<longleftrightarrow> inner x x < inner y y"
   372 lemma norm_lt: "norm x < norm y \<longleftrightarrow> inner x x < inner y y"
   323   unfolding norm_eq_sqrt_inner by simp
   373   unfolding norm_eq_sqrt_inner by simp
   324 
   374 
   326   unfolding norm_eq_sqrt_inner by simp
   376   unfolding norm_eq_sqrt_inner by simp
   327 
   377 
   328 
   378 
   329 subsection {* Affine set and affine hull *}
   379 subsection {* Affine set and affine hull *}
   330 
   380 
   331 definition
   381 definition affine :: "'a::real_vector set \<Rightarrow> bool"
   332   affine :: "'a::real_vector set \<Rightarrow> bool" where
   382   where "affine s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> s)"
   333   "affine s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> s)"
       
   334 
   383 
   335 lemma affine_alt: "affine s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u::real. (1 - u) *\<^sub>R x + u *\<^sub>R y \<in> s)"
   384 lemma affine_alt: "affine s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u::real. (1 - u) *\<^sub>R x + u *\<^sub>R y \<in> s)"
   336 unfolding affine_def by(metis eq_diff_eq')
   385   unfolding affine_def by (metis eq_diff_eq')
   337 
   386 
   338 lemma affine_empty[intro]: "affine {}"
   387 lemma affine_empty[intro]: "affine {}"
   339   unfolding affine_def by auto
   388   unfolding affine_def by auto
   340 
   389 
   341 lemma affine_sing[intro]: "affine {x}"
   390 lemma affine_sing[intro]: "affine {x}"
   349 
   398 
   350 lemma affine_Int: "affine s \<Longrightarrow> affine t \<Longrightarrow> affine (s \<inter> t)"
   399 lemma affine_Int: "affine s \<Longrightarrow> affine t \<Longrightarrow> affine (s \<inter> t)"
   351   unfolding affine_def by auto
   400   unfolding affine_def by auto
   352 
   401 
   353 lemma affine_affine_hull: "affine(affine hull s)"
   402 lemma affine_affine_hull: "affine(affine hull s)"
   354   unfolding hull_def using affine_Inter[of "{t. affine t \<and> s \<subseteq> t}"]
   403   unfolding hull_def
   355   by auto
   404   using affine_Inter[of "{t. affine t \<and> s \<subseteq> t}"] by auto
   356 
   405 
   357 lemma affine_hull_eq[simp]: "(affine hull s = s) \<longleftrightarrow> affine s"
   406 lemma affine_hull_eq[simp]: "(affine hull s = s) \<longleftrightarrow> affine s"
   358 by (metis affine_affine_hull hull_same)
   407   by (metis affine_affine_hull hull_same)
       
   408 
   359 
   409 
   360 subsubsection {* Some explicit formulations (from Lars Schewe) *}
   410 subsubsection {* Some explicit formulations (from Lars Schewe) *}
   361 
   411 
   362 lemma affine: fixes V::"'a::real_vector set"
   412 lemma affine:
   363   shows "affine V \<longleftrightarrow> (\<forall>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> V \<and> setsum u s = 1 \<longrightarrow> (setsum (\<lambda>x. (u x) *\<^sub>R x)) s \<in> V)"
   413   fixes V::"'a::real_vector set"
   364 unfolding affine_def apply rule apply(rule, rule, rule) apply(erule conjE)+ 
   414   shows "affine V \<longleftrightarrow>
   365 defer apply(rule, rule, rule, rule, rule) proof-
   415     (\<forall>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> V \<and> setsum u s = 1 \<longrightarrow> (setsum (\<lambda>x. (u x) *\<^sub>R x)) s \<in> V)"
   366   fix x y u v assume as:"x \<in> V" "y \<in> V" "u + v = (1::real)"
   416   unfolding affine_def
       
   417   apply rule
       
   418   apply(rule, rule, rule)
       
   419   apply(erule conjE)+ 
       
   420   defer
       
   421   apply (rule, rule, rule, rule, rule)
       
   422 proof -
       
   423   fix x y u v
       
   424   assume as: "x \<in> V" "y \<in> V" "u + v = (1::real)"
   367     "\<forall>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> V \<and> setsum u s = 1 \<longrightarrow> (\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V"
   425     "\<forall>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> V \<and> setsum u s = 1 \<longrightarrow> (\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V"
   368   thus "u *\<^sub>R x + v *\<^sub>R y \<in> V" apply(cases "x=y")
   426   then show "u *\<^sub>R x + v *\<^sub>R y \<in> V"
   369     using as(4)[THEN spec[where x="{x,y}"], THEN spec[where x="\<lambda>w. if w = x then u else v"]] and as(1-3) 
   427     apply (cases "x = y")
   370     by(auto simp add: scaleR_left_distrib[THEN sym])
   428     using as(4)[THEN spec[where x="{x,y}"], THEN spec[where x="\<lambda>w. if w = x then u else v"]]
       
   429       and as(1-3)
       
   430     by (auto simp add: scaleR_left_distrib[THEN sym])
   371 next
   431 next
   372   fix s u assume as:"\<forall>x\<in>V. \<forall>y\<in>V. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> V"
   432   fix s u
       
   433   assume as: "\<forall>x\<in>V. \<forall>y\<in>V. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> V"
   373     "finite s" "s \<noteq> {}" "s \<subseteq> V" "setsum u s = (1::real)"
   434     "finite s" "s \<noteq> {}" "s \<subseteq> V" "setsum u s = (1::real)"
   374   def n \<equiv> "card s"
   435   def n \<equiv> "card s"
   375   have "card s = 0 \<or> card s = 1 \<or> card s = 2 \<or> card s > 2" by auto
   436   have "card s = 0 \<or> card s = 1 \<or> card s = 2 \<or> card s > 2" by auto
   376   thus "(\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V" proof(auto simp only: disjE)
   437   then show "(\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V"
   377     assume "card s = 2" hence "card s = Suc (Suc 0)" by auto
   438   proof (auto simp only: disjE)
       
   439     assume "card s = 2"
       
   440     then have "card s = Suc (Suc 0)" by auto
   378     then obtain a b where "s = {a, b}" unfolding card_Suc_eq by auto
   441     then obtain a b where "s = {a, b}" unfolding card_Suc_eq by auto
   379     thus ?thesis using as(1)[THEN bspec[where x=a], THEN bspec[where x=b]] using as(4,5)
   442     then show ?thesis
   380       by(auto simp add: setsum_clauses(2))
   443       using as(1)[THEN bspec[where x=a], THEN bspec[where x=b]] using as(4,5)
   381   next assume "card s > 2" thus ?thesis using as and n_def proof(induct n arbitrary: u s)
   444       by (auto simp add: setsum_clauses(2))
   382       case (Suc n) fix s::"'a set" and u::"'a \<Rightarrow> real"
   445   next
   383       assume IA:"\<And>u s.  \<lbrakk>2 < card s; \<forall>x\<in>V. \<forall>y\<in>V. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> V; finite s;
   446     assume "card s > 2"
   384                s \<noteq> {}; s \<subseteq> V; setsum u s = 1; n = card s \<rbrakk> \<Longrightarrow> (\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V" and
   447     then show ?thesis using as and n_def
   385         as:"Suc n = card s" "2 < card s" "\<forall>x\<in>V. \<forall>y\<in>V. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> V"
   448     proof (induct n arbitrary: u s)
       
   449       case 0
       
   450       then show ?case by auto
       
   451     next
       
   452       case (Suc n)
       
   453       fix s :: "'a set" and u :: "'a \<Rightarrow> real"
       
   454       assume IA:
       
   455         "\<And>u s.  \<lbrakk>2 < card s; \<forall>x\<in>V. \<forall>y\<in>V. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> V; finite s;
       
   456           s \<noteq> {}; s \<subseteq> V; setsum u s = 1; n = card s \<rbrakk> \<Longrightarrow> (\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V"
       
   457         and as:
       
   458           "Suc n = card s" "2 < card s" "\<forall>x\<in>V. \<forall>y\<in>V. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> V"
   386            "finite s" "s \<noteq> {}" "s \<subseteq> V" "setsum u s = 1"
   459            "finite s" "s \<noteq> {}" "s \<subseteq> V" "setsum u s = 1"
   387       have "\<exists>x\<in>s. u x \<noteq> 1" proof(rule_tac ccontr)
   460       have "\<exists>x\<in>s. u x \<noteq> 1"
   388         assume " \<not> (\<exists>x\<in>s. u x \<noteq> 1)" hence "setsum u s = real_of_nat (card s)" unfolding card_eq_setsum by auto
   461       proof (rule ccontr)
   389         thus False using as(7) and `card s > 2` by (metis One_nat_def
   462         assume "\<not> ?thesis"
   390           less_Suc0 Zero_not_Suc of_nat_1 of_nat_eq_iff numeral_2_eq_2)
   463         then have "setsum u s = real_of_nat (card s)" unfolding card_eq_setsum by auto
       
   464         then show False
       
   465           using as(7) and `card s > 2`
       
   466           by (metis One_nat_def less_Suc0 Zero_not_Suc of_nat_1 of_nat_eq_iff numeral_2_eq_2)
   391       qed
   467       qed
   392       then obtain x where x:"x\<in>s" "u x \<noteq> 1" by auto
   468       then obtain x where x:"x\<in>s" "u x \<noteq> 1" by auto
   393 
   469 
   394       have c:"card (s - {x}) = card s - 1" apply(rule card_Diff_singleton) using `x\<in>s` as(4) by auto
   470       have c: "card (s - {x}) = card s - 1"
   395       have *:"s = insert x (s - {x})" "finite (s - {x})" using `x\<in>s` and as(4) by auto
   471         apply (rule card_Diff_singleton) using `x\<in>s` as(4) by auto
   396       have **:"setsum u (s - {x}) = 1 - u x"
   472       have *: "s = insert x (s - {x})" "finite (s - {x})"
       
   473         using `x\<in>s` and as(4) by auto
       
   474       have **: "setsum u (s - {x}) = 1 - u x"
   397         using setsum_clauses(2)[OF *(2), of u x, unfolded *(1)[THEN sym] as(7)] by auto
   475         using setsum_clauses(2)[OF *(2), of u x, unfolded *(1)[THEN sym] as(7)] by auto
   398       have ***:"inverse (1 - u x) * setsum u (s - {x}) = 1" unfolding ** using `u x \<noteq> 1` by auto
   476       have ***: "inverse (1 - u x) * setsum u (s - {x}) = 1"
   399       have "(\<Sum>xa\<in>s - {x}. (inverse (1 - u x) * u xa) *\<^sub>R xa) \<in> V" proof(cases "card (s - {x}) > 2")
   477         unfolding ** using `u x \<noteq> 1` by auto
   400         case True hence "s - {x} \<noteq> {}" "card (s - {x}) = n" unfolding c and as(1)[symmetric] proof(rule_tac ccontr) 
   478       have "(\<Sum>xa\<in>s - {x}. (inverse (1 - u x) * u xa) *\<^sub>R xa) \<in> V"
   401           assume "\<not> s - {x} \<noteq> {}" hence "card (s - {x}) = 0" unfolding card_0_eq[OF *(2)] by simp 
   479       proof (cases "card (s - {x}) > 2")
   402           thus False using True by auto qed auto
   480         case True
   403         thus ?thesis apply(rule_tac IA[of "s - {x}" "\<lambda>y. (inverse (1 - u x) * u y)"])
   481         then have "s - {x} \<noteq> {}" "card (s - {x}) = n"
   404         unfolding setsum_right_distrib[THEN sym] using as and *** and True by auto
   482           unfolding c and as(1)[symmetric]
   405       next case False hence "card (s - {x}) = Suc (Suc 0)" using as(2) and c by auto
   483         proof (rule_tac ccontr) 
       
   484           assume "\<not> s - {x} \<noteq> {}"
       
   485           then have "card (s - {x}) = 0" unfolding card_0_eq[OF *(2)] by simp 
       
   486           then show False using True by auto
       
   487         qed auto
       
   488         then show ?thesis
       
   489           apply (rule_tac IA[of "s - {x}" "\<lambda>y. (inverse (1 - u x) * u y)"])
       
   490           unfolding setsum_right_distrib[THEN sym] using as and *** and True
       
   491           apply auto
       
   492           done
       
   493       next
       
   494         case False
       
   495         then have "card (s - {x}) = Suc (Suc 0)" using as(2) and c by auto
   406         then obtain a b where "(s - {x}) = {a, b}" "a\<noteq>b" unfolding card_Suc_eq by auto
   496         then obtain a b where "(s - {x}) = {a, b}" "a\<noteq>b" unfolding card_Suc_eq by auto
   407         thus ?thesis using as(3)[THEN bspec[where x=a], THEN bspec[where x=b]]
   497         then show ?thesis using as(3)[THEN bspec[where x=a], THEN bspec[where x=b]]
   408           using *** *(2) and `s \<subseteq> V` unfolding setsum_right_distrib by(auto simp add: setsum_clauses(2)) qed
   498           using *** *(2) and `s \<subseteq> V`
   409       hence "u x + (1 - u x) = 1 \<Longrightarrow> u x *\<^sub>R x + (1 - u x) *\<^sub>R ((\<Sum>xa\<in>s - {x}. u xa *\<^sub>R xa) /\<^sub>R (1 - u x)) \<in> V"
   499           unfolding setsum_right_distrib by (auto simp add: setsum_clauses(2))
   410         apply-apply(rule as(3)[rule_format]) 
   500       qed
   411         unfolding  RealVector.scaleR_right.setsum using x(1) as(6) by auto
   501       then have "u x + (1 - u x) = 1 \<Longrightarrow>
   412       thus "(\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V" unfolding scaleR_scaleR[THEN sym] and scaleR_right.setsum [symmetric]
   502           u x *\<^sub>R x + (1 - u x) *\<^sub>R ((\<Sum>xa\<in>s - {x}. u xa *\<^sub>R xa) /\<^sub>R (1 - u x)) \<in> V"
   413          apply(subst *) unfolding setsum_clauses(2)[OF *(2)]
   503         apply -
   414          using `u x \<noteq> 1` by auto 
   504         apply (rule as(3)[rule_format])
   415     qed auto
   505         unfolding  RealVector.scaleR_right.setsum
   416   next assume "card s = 1" then obtain a where "s={a}" by(auto simp add: card_Suc_eq)
   506         using x(1) as(6) apply auto
   417     thus ?thesis using as(4,5) by simp
   507         done
   418   qed(insert `s\<noteq>{}` `finite s`, auto)
   508       then show "(\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V"
       
   509         unfolding scaleR_scaleR[THEN sym] and scaleR_right.setsum [symmetric]
       
   510         apply (subst *)
       
   511         unfolding setsum_clauses(2)[OF *(2)]
       
   512         using `u x \<noteq> 1` apply auto
       
   513         done
       
   514     qed
       
   515   next
       
   516     assume "card s = 1"
       
   517     then obtain a where "s={a}" by (auto simp add: card_Suc_eq)
       
   518     then show ?thesis using as(4,5) by simp
       
   519   qed (insert `s\<noteq>{}` `finite s`, auto)
   419 qed
   520 qed
   420 
   521 
   421 lemma affine_hull_explicit:
   522 lemma affine_hull_explicit:
   422   "affine hull p = {y. \<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum u s = 1 \<and> setsum (\<lambda>v. (u v) *\<^sub>R v) s = y}"
   523   "affine hull p = {y. \<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum u s = 1 \<and> setsum (\<lambda>v. (u v) *\<^sub>R v) s = y}"
   423   apply(rule hull_unique) apply(subst subset_eq) prefer 3 apply rule unfolding mem_Collect_eq
   524   apply (rule hull_unique)
   424   apply (erule exE)+ apply(erule conjE)+ prefer 2 apply rule proof-
   525   apply (subst subset_eq)
   425   fix x assume "x\<in>p" thus "\<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x"
   526   prefer 3
   426     apply(rule_tac x="{x}" in exI, rule_tac x="\<lambda>x. 1" in exI) by auto
   527   apply rule
       
   528   unfolding mem_Collect_eq
       
   529   apply (erule exE)+
       
   530   apply (erule conjE)+
       
   531   prefer 2
       
   532   apply rule
       
   533 proof -
       
   534   fix x
       
   535   assume "x\<in>p"
       
   536   then show "\<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x"
       
   537     apply (rule_tac x="{x}" in exI, rule_tac x="\<lambda>x. 1" in exI)
       
   538     apply auto
       
   539     done
   427 next
   540 next
   428   fix t x s u assume as:"p \<subseteq> t" "affine t" "finite s" "s \<noteq> {}" "s \<subseteq> p" "setsum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = x" 
   541   fix t x s u
   429   thus "x \<in> t" using as(2)[unfolded affine, THEN spec[where x=s], THEN spec[where x=u]] by auto
   542   assume as: "p \<subseteq> t" "affine t" "finite s" "s \<noteq> {}" "s \<subseteq> p" "setsum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = x"
       
   543   then show "x \<in> t"
       
   544     using as(2)[unfolded affine, THEN spec[where x=s], THEN spec[where x=u]] by auto
   430 next
   545 next
   431   show "affine {y. \<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y}" unfolding affine_def
   546   show "affine {y. \<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y}"
   432     apply(rule,rule,rule,rule,rule) unfolding mem_Collect_eq proof-
   547     unfolding affine_def
   433     fix u v ::real assume uv:"u + v = 1"
   548     apply (rule, rule, rule, rule, rule)
   434     fix x assume "\<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x"
   549     unfolding mem_Collect_eq
   435     then obtain sx ux where x:"finite sx" "sx \<noteq> {}" "sx \<subseteq> p" "setsum ux sx = 1" "(\<Sum>v\<in>sx. ux v *\<^sub>R v) = x" by auto
   550   proof -
       
   551     fix u v :: real
       
   552     assume uv: "u + v = 1"
       
   553     fix x
       
   554     assume "\<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x"
       
   555     then obtain sx ux where
       
   556       x: "finite sx" "sx \<noteq> {}" "sx \<subseteq> p" "setsum ux sx = 1" "(\<Sum>v\<in>sx. ux v *\<^sub>R v) = x" by auto
   436     fix y assume "\<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y"
   557     fix y assume "\<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y"
   437     then obtain sy uy where y:"finite sy" "sy \<noteq> {}" "sy \<subseteq> p" "setsum uy sy = 1" "(\<Sum>v\<in>sy. uy v *\<^sub>R v) = y" by auto
   558     then obtain sy uy where
   438     have xy:"finite (sx \<union> sy)" using x(1) y(1) by auto
   559       y: "finite sy" "sy \<noteq> {}" "sy \<subseteq> p" "setsum uy sy = 1" "(\<Sum>v\<in>sy. uy v *\<^sub>R v) = y" by auto
   439     have **:"(sx \<union> sy) \<inter> sx = sx" "(sx \<union> sy) \<inter> sy = sy" by auto
   560     have xy: "finite (sx \<union> sy)" using x(1) y(1) by auto
   440     show "\<exists>s ua. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum ua s = 1 \<and> (\<Sum>v\<in>s. ua v *\<^sub>R v) = u *\<^sub>R x + v *\<^sub>R y"
   561     have **: "(sx \<union> sy) \<inter> sx = sx" "(sx \<union> sy) \<inter> sy = sy" by auto
   441       apply(rule_tac x="sx \<union> sy" in exI)
   562     show "\<exists>s ua. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and>
   442       apply(rule_tac x="\<lambda>a. (if a\<in>sx then u * ux a else 0) + (if a\<in>sy then v * uy a else 0)" in exI)
   563         setsum ua s = 1 \<and> (\<Sum>v\<in>s. ua v *\<^sub>R v) = u *\<^sub>R x + v *\<^sub>R y"
   443       unfolding scaleR_left_distrib setsum_addf if_smult scaleR_zero_left  ** setsum_restrict_set[OF xy, THEN sym]
   564       apply (rule_tac x="sx \<union> sy" in exI)
       
   565       apply (rule_tac x="\<lambda>a. (if a\<in>sx then u * ux a else 0) + (if a\<in>sy then v * uy a else 0)" in exI)
       
   566       unfolding scaleR_left_distrib setsum_addf if_smult scaleR_zero_left ** setsum_restrict_set[OF xy, THEN sym]
   444       unfolding scaleR_scaleR[THEN sym] RealVector.scaleR_right.setsum [symmetric] and setsum_right_distrib[THEN sym]
   567       unfolding scaleR_scaleR[THEN sym] RealVector.scaleR_right.setsum [symmetric] and setsum_right_distrib[THEN sym]
   445       unfolding x y using x(1-3) y(1-3) uv by simp qed qed
   568       unfolding x y
       
   569       using x(1-3) y(1-3) uv apply simp
       
   570       done
       
   571   qed
       
   572 qed
   446 
   573 
   447 lemma affine_hull_finite:
   574 lemma affine_hull_finite:
   448   assumes "finite s"
   575   assumes "finite s"
   449   shows "affine hull s = {y. \<exists>u. setsum u s = 1 \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = y}"
   576   shows "affine hull s = {y. \<exists>u. setsum u s = 1 \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = y}"
   450   unfolding affine_hull_explicit and set_eq_iff and mem_Collect_eq apply (rule,rule)
   577   unfolding affine_hull_explicit and set_eq_iff and mem_Collect_eq apply (rule,rule)
   451   apply(erule exE)+ apply(erule conjE)+ defer apply(erule exE) apply(erule conjE) proof-
   578   apply(erule exE)+
   452   fix x u assume "setsum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = x"
   579   apply(erule conjE)+
   453   thus "\<exists>sa u. finite sa \<and> \<not> (\<forall>x. (x \<in> sa) = (x \<in> {})) \<and> sa \<subseteq> s \<and> setsum u sa = 1 \<and> (\<Sum>v\<in>sa. u v *\<^sub>R v) = x"
   580   defer
   454     apply(rule_tac x=s in exI, rule_tac x=u in exI) using assms by auto
   581   apply (erule exE)
       
   582   apply (erule conjE)
       
   583 proof -
       
   584   fix x u
       
   585   assume "setsum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = x"
       
   586   then show "\<exists>sa u. finite sa \<and>
       
   587       \<not> (\<forall>x. (x \<in> sa) = (x \<in> {})) \<and> sa \<subseteq> s \<and> setsum u sa = 1 \<and> (\<Sum>v\<in>sa. u v *\<^sub>R v) = x"
       
   588     apply (rule_tac x=s in exI, rule_tac x=u in exI)
       
   589     using assms apply auto
       
   590     done
   455 next
   591 next
   456   fix x t u assume "t \<subseteq> s" hence *:"s \<inter> t = t" by auto
   592   fix x t u
       
   593   assume "t \<subseteq> s"
       
   594   then have *: "s \<inter> t = t" by auto
   457   assume "finite t" "\<not> (\<forall>x. (x \<in> t) = (x \<in> {}))" "setsum u t = 1" "(\<Sum>v\<in>t. u v *\<^sub>R v) = x"
   595   assume "finite t" "\<not> (\<forall>x. (x \<in> t) = (x \<in> {}))" "setsum u t = 1" "(\<Sum>v\<in>t. u v *\<^sub>R v) = x"
   458   thus "\<exists>u. setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x" apply(rule_tac x="\<lambda>x. if x\<in>t then u x else 0" in exI)
   596   then show "\<exists>u. setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x"
   459     unfolding if_smult scaleR_zero_left and setsum_restrict_set[OF assms, THEN sym] and * by auto qed
   597     apply (rule_tac x="\<lambda>x. if x\<in>t then u x else 0" in exI)
       
   598     unfolding if_smult scaleR_zero_left and setsum_restrict_set[OF assms, THEN sym] and *
       
   599     apply auto
       
   600     done
       
   601 qed
       
   602 
   460 
   603 
   461 subsubsection {* Stepping theorems and hence small special cases *}
   604 subsubsection {* Stepping theorems and hence small special cases *}
   462 
   605 
   463 lemma affine_hull_empty[simp]: "affine hull {} = {}"
   606 lemma affine_hull_empty[simp]: "affine hull {} = {}"
   464   apply(rule hull_unique) by auto
   607   by (rule hull_unique) auto
   465 
   608 
   466 lemma affine_hull_finite_step:
   609 lemma affine_hull_finite_step:
   467   fixes y :: "'a::real_vector"
   610   fixes y :: "'a::real_vector"
   468   shows "(\<exists>u. setsum u {} = w \<and> setsum (\<lambda>x. u x *\<^sub>R x) {} = y) \<longleftrightarrow> w = 0 \<and> y = 0" (is ?th1)
   611   shows
   469   "finite s \<Longrightarrow> (\<exists>u. setsum u (insert a s) = w \<and> setsum (\<lambda>x. u x *\<^sub>R x) (insert a s) = y) \<longleftrightarrow>
   612     "(\<exists>u. setsum u {} = w \<and> setsum (\<lambda>x. u x *\<^sub>R x) {} = y) \<longleftrightarrow> w = 0 \<and> y = 0" (is ?th1)
   470                 (\<exists>v u. setsum u s = w - v \<and> setsum (\<lambda>x. u x *\<^sub>R x) s = y - v *\<^sub>R a)" (is "?as \<Longrightarrow> (?lhs = ?rhs)")
   613     "finite s \<Longrightarrow>
   471 proof-
   614       (\<exists>u. setsum u (insert a s) = w \<and> setsum (\<lambda>x. u x *\<^sub>R x) (insert a s) = y) \<longleftrightarrow>
       
   615       (\<exists>v u. setsum u s = w - v \<and> setsum (\<lambda>x. u x *\<^sub>R x) s = y - v *\<^sub>R a)" (is "?as \<Longrightarrow> (?lhs = ?rhs)")
       
   616 proof -
   472   show ?th1 by simp
   617   show ?th1 by simp
   473   assume ?as 
   618   assume ?as
   474   { assume ?lhs
   619   { assume ?lhs
   475     then obtain u where u:"setsum u (insert a s) = w \<and> (\<Sum>x\<in>insert a s. u x *\<^sub>R x) = y" by auto
   620     then obtain u where u:"setsum u (insert a s) = w \<and> (\<Sum>x\<in>insert a s. u x *\<^sub>R x) = y" by auto
   476     have ?rhs proof(cases "a\<in>s")
   621     have ?rhs
   477       case True hence *:"insert a s = s" by auto
   622     proof (cases "a \<in> s")
       
   623       case True
       
   624       then have *: "insert a s = s" by auto
   478       show ?thesis using u[unfolded *] apply(rule_tac x=0 in exI) by auto
   625       show ?thesis using u[unfolded *] apply(rule_tac x=0 in exI) by auto
   479     next
   626     next
   480       case False thus ?thesis apply(rule_tac x="u a" in exI) using u and `?as` by auto 
   627       case False
   481     qed  } moreover
   628       then show ?thesis
       
   629         apply (rule_tac x="u a" in exI)
       
   630         using u and `?as` apply auto
       
   631         done
       
   632     qed }
       
   633   moreover
   482   { assume ?rhs
   634   { assume ?rhs
   483     then obtain v u where vu:"setsum u s = w - v"  "(\<Sum>x\<in>s. u x *\<^sub>R x) = y - v *\<^sub>R a" by auto
   635     then obtain v u where vu:"setsum u s = w - v"  "(\<Sum>x\<in>s. u x *\<^sub>R x) = y - v *\<^sub>R a" by auto
   484     have *:"\<And>x M. (if x = a then v else M) *\<^sub>R x = (if x = a then v *\<^sub>R x else M *\<^sub>R x)" by auto
   636     have *: "\<And>x M. (if x = a then v else M) *\<^sub>R x = (if x = a then v *\<^sub>R x else M *\<^sub>R x)" by auto
   485     have ?lhs proof(cases "a\<in>s")
   637     have ?lhs
   486       case True thus ?thesis
   638     proof (cases "a \<in> s")
   487         apply(rule_tac x="\<lambda>x. (if x=a then v else 0) + u x" in exI)
   639       case True
   488         unfolding setsum_clauses(2)[OF `?as`]  apply simp
   640       then show ?thesis
       
   641         apply (rule_tac x="\<lambda>x. (if x=a then v else 0) + u x" in exI)
       
   642         unfolding setsum_clauses(2)[OF `?as`] apply simp
   489         unfolding scaleR_left_distrib and setsum_addf 
   643         unfolding scaleR_left_distrib and setsum_addf 
   490         unfolding vu and * and scaleR_zero_left
   644         unfolding vu and * and scaleR_zero_left
   491         by (auto simp add: setsum_delta[OF `?as`])
   645         apply (auto simp add: setsum_delta[OF `?as`])
       
   646         done
   492     next
   647     next
   493       case False 
   648       case False 
   494       hence **:"\<And>x. x \<in> s \<Longrightarrow> u x = (if x = a then v else u x)"
   649       then have **:
   495                "\<And>x. x \<in> s \<Longrightarrow> u x *\<^sub>R x = (if x = a then v *\<^sub>R x else u x *\<^sub>R x)" by auto
   650         "\<And>x. x \<in> s \<Longrightarrow> u x = (if x = a then v else u x)"
       
   651         "\<And>x. x \<in> s \<Longrightarrow> u x *\<^sub>R x = (if x = a then v *\<^sub>R x else u x *\<^sub>R x)" by auto
   496       from False show ?thesis
   652       from False show ?thesis
   497         apply(rule_tac x="\<lambda>x. if x=a then v else u x" in exI)
   653         apply (rule_tac x="\<lambda>x. if x=a then v else u x" in exI)
   498         unfolding setsum_clauses(2)[OF `?as`] and * using vu
   654         unfolding setsum_clauses(2)[OF `?as`] and * using vu
   499         using setsum_cong2[of s "\<lambda>x. u x *\<^sub>R x" "\<lambda>x. if x = a then v *\<^sub>R x else u x *\<^sub>R x", OF **(2)]
   655         using setsum_cong2[of s "\<lambda>x. u x *\<^sub>R x" "\<lambda>x. if x = a then v *\<^sub>R x else u x *\<^sub>R x", OF **(2)]
   500         using setsum_cong2[of s u "\<lambda>x. if x = a then v else u x", OF **(1)] by auto  
   656         using setsum_cong2[of s u "\<lambda>x. if x = a then v else u x", OF **(1)]
   501     qed }
   657         apply auto
       
   658         done
       
   659     qed
       
   660   }
   502   ultimately show "?lhs = ?rhs" by blast
   661   ultimately show "?lhs = ?rhs" by blast
   503 qed
   662 qed
   504 
   663 
   505 lemma affine_hull_2:
   664 lemma affine_hull_2:
   506   fixes a b :: "'a::real_vector"
   665   fixes a b :: "'a::real_vector"
   507   shows "affine hull {a,b} = {u *\<^sub>R a + v *\<^sub>R b| u v. (u + v = 1)}" (is "?lhs = ?rhs")
   666   shows "affine hull {a,b} = {u *\<^sub>R a + v *\<^sub>R b| u v. (u + v = 1)}" (is "?lhs = ?rhs")
   508 proof-
   667 proof -
   509   have *:"\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::real)" 
   668   have *:
   510          "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::'a)" by auto
   669     "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::real)" 
       
   670     "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::'a)" by auto
   511   have "?lhs = {y. \<exists>u. setsum u {a, b} = 1 \<and> (\<Sum>v\<in>{a, b}. u v *\<^sub>R v) = y}"
   671   have "?lhs = {y. \<exists>u. setsum u {a, b} = 1 \<and> (\<Sum>v\<in>{a, b}. u v *\<^sub>R v) = y}"
   512     using affine_hull_finite[of "{a,b}"] by auto
   672     using affine_hull_finite[of "{a,b}"] by auto
   513   also have "\<dots> = {y. \<exists>v u. u b = 1 - v \<and> u b *\<^sub>R b = y - v *\<^sub>R a}"
   673   also have "\<dots> = {y. \<exists>v u. u b = 1 - v \<and> u b *\<^sub>R b = y - v *\<^sub>R a}"
   514     by(simp add: affine_hull_finite_step(2)[of "{b}" a]) 
   674     by (simp add: affine_hull_finite_step(2)[of "{b}" a])
   515   also have "\<dots> = ?rhs" unfolding * by auto
   675   also have "\<dots> = ?rhs" unfolding * by auto
   516   finally show ?thesis by auto
   676   finally show ?thesis by auto
   517 qed
   677 qed
   518 
   678 
   519 lemma affine_hull_3:
   679 lemma affine_hull_3:
   520   fixes a b c :: "'a::real_vector"
   680   fixes a b c :: "'a::real_vector"
   521   shows "affine hull {a,b,c} = { u *\<^sub>R a + v *\<^sub>R b + w *\<^sub>R c| u v w. u + v + w = 1}" (is "?lhs = ?rhs")
   681   shows "affine hull {a,b,c} = { u *\<^sub>R a + v *\<^sub>R b + w *\<^sub>R c| u v w. u + v + w = 1}" (is "?lhs = ?rhs")
   522 proof-
   682 proof -
   523   have *:"\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::real)" 
   683   have *:
   524          "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::'a)" by auto
   684     "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::real)" 
   525   show ?thesis apply(simp add: affine_hull_finite affine_hull_finite_step)
   685     "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::'a)" by auto
   526     unfolding * apply auto
   686   show ?thesis
   527     apply(rule_tac x=v in exI) apply(rule_tac x=va in exI) apply auto
   687     apply (simp add: affine_hull_finite affine_hull_finite_step)
   528     apply(rule_tac x=u in exI) by force
   688     unfolding *
       
   689     apply auto
       
   690     apply (rule_tac x=v in exI) apply(rule_tac x=va in exI) apply auto
       
   691     apply (rule_tac x=u in exI) apply force
       
   692     done
   529 qed
   693 qed
   530 
   694 
   531 lemma mem_affine:
   695 lemma mem_affine:
   532   assumes "affine S" "x : S" "y : S" "u+v=1"
   696   assumes "affine S" "x : S" "y : S" "u+v=1"
   533   shows "(u *\<^sub>R x + v *\<^sub>R y) : S"
   697   shows "(u *\<^sub>R x + v *\<^sub>R y) : S"
   534   using assms affine_def[of S] by auto
   698   using assms affine_def[of S] by auto
   535 
   699 
   536 lemma mem_affine_3:
   700 lemma mem_affine_3:
   537   assumes "affine S" "x : S" "y : S" "z : S" "u+v+w=1"
   701   assumes "affine S" "x : S" "y : S" "z : S" "u+v+w=1"
   538   shows "(u *\<^sub>R x + v *\<^sub>R y + w *\<^sub>R z) : S"
   702   shows "(u *\<^sub>R x + v *\<^sub>R y + w *\<^sub>R z) : S"
   539 proof-
   703 proof -
   540 have "(u *\<^sub>R x + v *\<^sub>R y + w *\<^sub>R z) : affine hull {x, y, z}"
   704   have "(u *\<^sub>R x + v *\<^sub>R y + w *\<^sub>R z) : affine hull {x, y, z}"
   541   using affine_hull_3[of x y z] assms by auto
   705     using affine_hull_3[of x y z] assms by auto
   542 moreover have " affine hull {x, y, z} <= affine hull S" 
   706   moreover
   543   using hull_mono[of "{x, y, z}" "S"] assms by auto
   707   have "affine hull {x, y, z} <= affine hull S"
   544 moreover have "affine hull S = S" 
   708     using hull_mono[of "{x, y, z}" "S"] assms by auto
   545   using assms affine_hull_eq[of S] by auto
   709   moreover
   546 ultimately show ?thesis by auto 
   710   have "affine hull S = S" using assms affine_hull_eq[of S] by auto
       
   711   ultimately show ?thesis by auto 
   547 qed
   712 qed
   548 
   713 
   549 lemma mem_affine_3_minus:
   714 lemma mem_affine_3_minus:
   550   assumes "affine S" "x : S" "y : S" "z : S"
   715   assumes "affine S" "x : S" "y : S" "z : S"
   551   shows "x + v *\<^sub>R (y-z) : S"
   716   shows "x + v *\<^sub>R (y-z) : S"
   552 using mem_affine_3[of S x y z 1 v "-v"] assms by (simp add: algebra_simps)
   717   using mem_affine_3[of S x y z 1 v "-v"] assms by (simp add: algebra_simps)
   553 
   718 
   554 
   719 
   555 subsubsection {* Some relations between affine hull and subspaces *}
   720 subsubsection {* Some relations between affine hull and subspaces *}
   556 
   721 
   557 lemma affine_hull_insert_subset_span:
   722 lemma affine_hull_insert_subset_span:
   558   shows "affine hull (insert a s) \<subseteq> {a + v| v . v \<in> span {x - a | x . x \<in> s}}"
   723   "affine hull (insert a s) \<subseteq> {a + v| v . v \<in> span {x - a | x . x \<in> s}}"
   559   unfolding subset_eq Ball_def unfolding affine_hull_explicit span_explicit mem_Collect_eq
   724   unfolding subset_eq Ball_def
   560   apply(rule,rule) apply(erule exE)+ apply(erule conjE)+ proof-
   725   unfolding affine_hull_explicit span_explicit mem_Collect_eq
   561   fix x t u assume as:"finite t" "t \<noteq> {}" "t \<subseteq> insert a s" "setsum u t = 1" "(\<Sum>v\<in>t. u v *\<^sub>R v) = x"
   726   apply (rule, rule) apply (erule exE)+ apply (erule conjE)+
       
   727 proof -
       
   728   fix x t u
       
   729   assume as: "finite t" "t \<noteq> {}" "t \<subseteq> insert a s" "setsum u t = 1" "(\<Sum>v\<in>t. u v *\<^sub>R v) = x"
   562   have "(\<lambda>x. x - a) ` (t - {a}) \<subseteq> {x - a |x. x \<in> s}" using as(3) by auto
   730   have "(\<lambda>x. x - a) ` (t - {a}) \<subseteq> {x - a |x. x \<in> s}" using as(3) by auto
   563   thus "\<exists>v. x = a + v \<and> (\<exists>S u. finite S \<and> S \<subseteq> {x - a |x. x \<in> s} \<and> (\<Sum>v\<in>S. u v *\<^sub>R v) = v)"
   731   then show "\<exists>v. x = a + v \<and> (\<exists>S u. finite S \<and> S \<subseteq> {x - a |x. x \<in> s} \<and> (\<Sum>v\<in>S. u v *\<^sub>R v) = v)"
   564     apply(rule_tac x="x - a" in exI)
   732     apply (rule_tac x="x - a" in exI)
   565     apply (rule conjI, simp)
   733     apply (rule conjI, simp)
   566     apply(rule_tac x="(\<lambda>x. x - a) ` (t - {a})" in exI)
   734     apply (rule_tac x="(\<lambda>x. x - a) ` (t - {a})" in exI)
   567     apply(rule_tac x="\<lambda>x. u (x + a)" in exI)
   735     apply (rule_tac x="\<lambda>x. u (x + a)" in exI)
   568     apply (rule conjI) using as(1) apply simp
   736     apply (rule conjI) using as(1) apply simp
   569     apply (erule conjI)
   737     apply (erule conjI)
   570     using as(1)
   738     using as(1)
   571     apply (simp add: setsum_reindex[unfolded inj_on_def] scaleR_right_diff_distrib setsum_subtractf scaleR_left.setsum[THEN sym] setsum_diff1 scaleR_left_diff_distrib)
   739     apply (simp add: setsum_reindex[unfolded inj_on_def] scaleR_right_diff_distrib
   572     unfolding as by simp qed
   740       setsum_subtractf scaleR_left.setsum[THEN sym] setsum_diff1 scaleR_left_diff_distrib)
       
   741     unfolding as
       
   742     apply simp
       
   743     done
       
   744 qed
   573 
   745 
   574 lemma affine_hull_insert_span:
   746 lemma affine_hull_insert_span:
   575   assumes "a \<notin> s"
   747   assumes "a \<notin> s"
   576   shows "affine hull (insert a s) =
   748   shows "affine hull (insert a s) = {a + v | v . v \<in> span {x - a | x.  x \<in> s}}"
   577             {a + v | v . v \<in> span {x - a | x.  x \<in> s}}"
   749   apply (rule, rule affine_hull_insert_subset_span)
   578   apply(rule, rule affine_hull_insert_subset_span) unfolding subset_eq Ball_def
   750   unfolding subset_eq Ball_def
   579   unfolding affine_hull_explicit and mem_Collect_eq proof(rule,rule,erule exE,erule conjE)
   751   unfolding affine_hull_explicit and mem_Collect_eq
   580   fix y v assume "y = a + v" "v \<in> span {x - a |x. x \<in> s}"
   752 proof (rule, rule, erule exE, erule conjE)
   581   then obtain t u where obt:"finite t" "t \<subseteq> {x - a |x. x \<in> s}" "a + (\<Sum>v\<in>t. u v *\<^sub>R v) = y" unfolding span_explicit by auto
   753   fix y v 
       
   754   assume "y = a + v" "v \<in> span {x - a |x. x \<in> s}"
       
   755   then obtain t u where obt:"finite t" "t \<subseteq> {x - a |x. x \<in> s}" "a + (\<Sum>v\<in>t. u v *\<^sub>R v) = y"
       
   756     unfolding span_explicit by auto
   582   def f \<equiv> "(\<lambda>x. x + a) ` t"
   757   def f \<equiv> "(\<lambda>x. x + a) ` t"
   583   have f:"finite f" "f \<subseteq> s" "(\<Sum>v\<in>f. u (v - a) *\<^sub>R (v - a)) = y - a" unfolding f_def using obt 
   758   have f:"finite f" "f \<subseteq> s" "(\<Sum>v\<in>f. u (v - a) *\<^sub>R (v - a)) = y - a"
   584     by(auto simp add: setsum_reindex[unfolded inj_on_def])
   759     unfolding f_def using obt by (auto simp add: setsum_reindex[unfolded inj_on_def])
   585   have *:"f \<inter> {a} = {}" "f \<inter> - {a} = f" using f(2) assms by auto
   760   have *: "f \<inter> {a} = {}" "f \<inter> - {a} = f" using f(2) assms by auto
   586   show "\<exists>sa u. finite sa \<and> sa \<noteq> {} \<and> sa \<subseteq> insert a s \<and> setsum u sa = 1 \<and> (\<Sum>v\<in>sa. u v *\<^sub>R v) = y"
   761   show "\<exists>sa u. finite sa \<and> sa \<noteq> {} \<and> sa \<subseteq> insert a s \<and> setsum u sa = 1 \<and> (\<Sum>v\<in>sa. u v *\<^sub>R v) = y"
   587     apply(rule_tac x="insert a f" in exI)
   762     apply (rule_tac x = "insert a f" in exI)
   588     apply(rule_tac x="\<lambda>x. if x=a then 1 - setsum (\<lambda>x. u (x - a)) f else u (x - a)" in exI)
   763     apply (rule_tac x = "\<lambda>x. if x=a then 1 - setsum (\<lambda>x. u (x - a)) f else u (x - a)" in exI)
   589     using assms and f unfolding setsum_clauses(2)[OF f(1)] and if_smult
   764     using assms and f unfolding setsum_clauses(2)[OF f(1)] and if_smult
   590     unfolding setsum_cases[OF f(1), of "\<lambda>x. x = a"]
   765     unfolding setsum_cases[OF f(1), of "\<lambda>x. x = a"]
   591     by (auto simp add: setsum_subtractf scaleR_left.setsum algebra_simps *) qed
   766     apply (auto simp add: setsum_subtractf scaleR_left.setsum algebra_simps *)
       
   767     done
       
   768 qed
   592 
   769 
   593 lemma affine_hull_span:
   770 lemma affine_hull_span:
   594   assumes "a \<in> s"
   771   assumes "a \<in> s"
   595   shows "affine hull s = {a + v | v. v \<in> span {x - a | x. x \<in> s - {a}}}"
   772   shows "affine hull s = {a + v | v. v \<in> span {x - a | x. x \<in> s - {a}}}"
   596   using affine_hull_insert_span[of a "s - {a}", unfolded insert_Diff[OF assms]] by auto
   773   using affine_hull_insert_span[of a "s - {a}", unfolded insert_Diff[OF assms]] by auto
   597 
   774 
       
   775 
   598 subsubsection {* Parallel affine sets *}
   776 subsubsection {* Parallel affine sets *}
   599 
   777 
   600 definition affine_parallel :: "'a::real_vector set => 'a::real_vector set => bool"
   778 definition affine_parallel :: "'a::real_vector set => 'a::real_vector set => bool"
   601 where "affine_parallel S T = (? a. T = ((%x. a + x) ` S))"
   779   where "affine_parallel S T = (? a. T = ((%x. a + x) ` S))"
   602 
   780 
   603 lemma affine_parallel_expl_aux:
   781 lemma affine_parallel_expl_aux:
   604    fixes S T :: "'a::real_vector set"
   782   fixes S T :: "'a::real_vector set"
   605    assumes "!x. (x : S <-> (a+x) : T)" 
   783   assumes "!x. (x : S <-> (a+x) : T)" 
   606    shows "T = ((%x. a + x) ` S)"
   784   shows "T = ((%x. a + x) ` S)"
   607 proof-
   785 proof -
   608 { fix x assume "x : T" hence "(-a)+x : S" using assms by auto
   786   { fix x
   609   hence " x : ((%x. a + x) ` S)" using imageI[of "-a+x" S "(%x. a+x)"] by auto}
   787     assume "x : T"
   610 moreover have "T >= ((%x. a + x) ` S)" using assms by auto 
   788     then have "(-a)+x : S" using assms by auto
   611 ultimately show ?thesis by auto
   789     then have "x : ((%x. a + x) ` S)"
   612 qed
   790       using imageI[of "-a+x" S "(%x. a+x)"] by auto }
   613 
   791   moreover have "T >= ((%x. a + x) ` S)" using assms by auto 
   614 lemma affine_parallel_expl: 
   792   ultimately show ?thesis by auto
   615    "affine_parallel S T = (? a. !x. (x : S <-> (a+x) : T))" 
   793 qed
   616    unfolding affine_parallel_def using affine_parallel_expl_aux[of S _ T] by auto
   794 
   617 
   795 lemma affine_parallel_expl: "affine_parallel S T = (? a. !x. (x : S <-> (a+x) : T))"
   618 lemma affine_parallel_reflex: "affine_parallel S S" unfolding affine_parallel_def apply (rule exI[of _ "0"]) by auto
   796   unfolding affine_parallel_def
       
   797   using affine_parallel_expl_aux[of S _ T] by auto
       
   798 
       
   799 lemma affine_parallel_reflex: "affine_parallel S S"
       
   800   unfolding affine_parallel_def apply (rule exI[of _ "0"]) by auto
   619 
   801 
   620 lemma affine_parallel_commut:
   802 lemma affine_parallel_commut:
   621 assumes "affine_parallel A B" shows "affine_parallel B A" 
   803   assumes "affine_parallel A B"
   622 proof-
   804   shows "affine_parallel B A"
   623 from assms obtain a where "B=((%x. a + x) ` A)" unfolding affine_parallel_def by auto 
   805 proof -
   624 from this show ?thesis using translation_galois[of B a A] unfolding affine_parallel_def by auto
   806   from assms obtain a where "B=((%x. a + x) ` A)"
       
   807     unfolding affine_parallel_def by auto
       
   808   then show ?thesis
       
   809     using translation_galois[of B a A] unfolding affine_parallel_def by auto
   625 qed
   810 qed
   626 
   811 
   627 lemma affine_parallel_assoc:
   812 lemma affine_parallel_assoc:
   628 assumes "affine_parallel A B" "affine_parallel B C"
   813   assumes "affine_parallel A B" "affine_parallel B C"
   629 shows "affine_parallel A C" 
   814   shows "affine_parallel A C" 
   630 proof-
   815 proof -
   631 from assms obtain ab where "B=((%x. ab + x) ` A)" unfolding affine_parallel_def by auto 
   816   from assms obtain ab where "B=((%x. ab + x) ` A)"
   632 moreover 
   817     unfolding affine_parallel_def by auto 
   633 from assms obtain bc where "C=((%x. bc + x) ` B)" unfolding affine_parallel_def by auto
   818   moreover 
   634 ultimately show ?thesis using translation_assoc[of bc ab A] unfolding affine_parallel_def by auto 
   819   from assms obtain bc where "C=((%x. bc + x) ` B)"
       
   820     unfolding affine_parallel_def by auto
       
   821   ultimately show ?thesis
       
   822     using translation_assoc[of bc ab A] unfolding affine_parallel_def by auto
   635 qed
   823 qed
   636 
   824 
   637 lemma affine_translation_aux:
   825 lemma affine_translation_aux:
   638   fixes a :: "'a::real_vector"
   826   fixes a :: "'a::real_vector"
   639   assumes "affine ((%x. a + x) ` S)" shows "affine S"
   827   assumes "affine ((%x. a + x) ` S)" shows "affine S"
   640 proof-
   828 proof-
   641 { fix x y u v
   829   { fix x y u v
   642   assume xy: "x : S" "y : S" "(u :: real)+v=1"
   830     assume xy: "x : S" "y : S" "(u :: real)+v=1"
   643   hence "(a+x):((%x. a + x) ` S)" "(a+y):((%x. a + x) ` S)" by auto
   831     then have "(a+x):((%x. a + x) ` S)" "(a+y):((%x. a + x) ` S)" by auto
   644   hence h1: "u *\<^sub>R  (a+x) + v *\<^sub>R (a+y) : ((%x. a + x) ` S)" using xy assms unfolding affine_def by auto
   832     then have h1: "u *\<^sub>R  (a+x) + v *\<^sub>R (a+y) : ((%x. a + x) ` S)"
   645   have "u *\<^sub>R (a+x) + v *\<^sub>R (a+y) = (u+v) *\<^sub>R a + (u *\<^sub>R x + v *\<^sub>R y)" by (simp add:algebra_simps)
   833       using xy assms unfolding affine_def by auto
   646   also have "...= a + (u *\<^sub>R x + v *\<^sub>R y)" using `u+v=1` by auto
   834     have "u *\<^sub>R (a+x) + v *\<^sub>R (a+y) = (u+v) *\<^sub>R a + (u *\<^sub>R x + v *\<^sub>R y)"
   647   ultimately have "a + (u *\<^sub>R x + v *\<^sub>R y) : ((%x. a + x) ` S)" using h1 by auto
   835       by (simp add: algebra_simps)
   648   hence "u *\<^sub>R x + v *\<^sub>R y : S" by auto
   836     also have "...= a + (u *\<^sub>R x + v *\<^sub>R y)" using `u+v=1` by auto
   649 } from this show ?thesis unfolding affine_def by auto
   837     ultimately have "a + (u *\<^sub>R x + v *\<^sub>R y) : ((%x. a + x) ` S)" using h1 by auto
       
   838     then have "u *\<^sub>R x + v *\<^sub>R y : S" by auto
       
   839   }
       
   840   then show ?thesis unfolding affine_def by auto
   650 qed
   841 qed
   651 
   842 
   652 lemma affine_translation:
   843 lemma affine_translation:
   653   fixes a :: "'a::real_vector"
   844   fixes a :: "'a::real_vector"
   654   shows "affine S <-> affine ((%x. a + x) ` S)"
   845   shows "affine S <-> affine ((%x. a + x) ` S)"
   655 proof-
   846 proof -
   656 have "affine S ==> affine ((%x. a + x) ` S)" using affine_translation_aux[of "-a" "((%x. a + x) ` S)"]  using translation_assoc[of "-a" a S] by auto
   847   have "affine S ==> affine ((%x. a + x) ` S)"
   657 from this show ?thesis using affine_translation_aux by auto
   848     using affine_translation_aux[of "-a" "((%x. a + x) ` S)"]
       
   849     using translation_assoc[of "-a" a S] by auto
       
   850   then show ?thesis using affine_translation_aux by auto
   658 qed
   851 qed
   659 
   852 
   660 lemma parallel_is_affine:
   853 lemma parallel_is_affine:
   661 fixes S T :: "'a::real_vector set"
   854   fixes S T :: "'a::real_vector set"
   662 assumes "affine S" "affine_parallel S T"
   855   assumes "affine S" "affine_parallel S T"
   663 shows "affine T"
   856   shows "affine T"
   664 proof-
   857 proof -
   665   from assms obtain a where "T=((%x. a + x) ` S)" unfolding affine_parallel_def by auto 
   858   from assms obtain a where "T=((%x. a + x) ` S)"
   666   from this show ?thesis using affine_translation assms by auto
   859     unfolding affine_parallel_def by auto 
       
   860   then show ?thesis using affine_translation assms by auto
   667 qed
   861 qed
   668 
   862 
   669 lemma subspace_imp_affine: "subspace s \<Longrightarrow> affine s"
   863 lemma subspace_imp_affine: "subspace s \<Longrightarrow> affine s"
   670   unfolding subspace_def affine_def by auto
   864   unfolding subspace_def affine_def by auto
   671 
   865 
       
   866 
   672 subsubsection {* Subspace parallel to an affine set *}
   867 subsubsection {* Subspace parallel to an affine set *}
   673 
   868 
   674 lemma subspace_affine:
   869 lemma subspace_affine: "subspace S <-> (affine S & 0 : S)"
   675   shows "subspace S <-> (affine S & 0 : S)"
   870 proof -
   676 proof-
   871   have h0: "subspace S ==> (affine S & 0 : S)"
   677 have h0: "subspace S ==> (affine S & 0 : S)" using subspace_imp_affine[of S] subspace_0 by auto
   872     using subspace_imp_affine[of S] subspace_0 by auto
   678 { assume assm: "affine S & 0 : S"
   873   { assume assm: "affine S & 0 : S"
   679   { fix c :: real 
   874     { fix c :: real 
   680     fix x assume x_def: "x : S"
   875       fix x assume x_def: "x : S"
   681     have "c *\<^sub>R x = (1-c) *\<^sub>R 0 + c *\<^sub>R x" by auto
   876       have "c *\<^sub>R x = (1-c) *\<^sub>R 0 + c *\<^sub>R x" by auto
   682     moreover have "(1-c) *\<^sub>R 0 + c *\<^sub>R x : S" using affine_alt[of S] assm x_def by auto
   877       moreover
   683     ultimately have "c *\<^sub>R x : S" by auto
   878       have "(1-c) *\<^sub>R 0 + c *\<^sub>R x : S" using affine_alt[of S] assm x_def by auto
   684   } hence h1: "!c. !x : S. c *\<^sub>R x : S" by auto
   879       ultimately have "c *\<^sub>R x : S" by auto
   685   { fix x y assume xy_def: "x : S" "y : S"
   880     }
   686     def u == "(1 :: real)/2"
   881     then have h1: "!c. !x : S. c *\<^sub>R x : S" by auto
   687     have "(1/2) *\<^sub>R (x+y) = (1/2) *\<^sub>R (x+y)" by auto
   882 
   688     moreover have "(1/2) *\<^sub>R (x+y)=(1/2) *\<^sub>R x + (1-(1/2)) *\<^sub>R y" by (simp add: algebra_simps)
   883     { fix x y assume xy_def: "x : S" "y : S"
   689     moreover have "(1-u) *\<^sub>R x + u *\<^sub>R y : S" using affine_alt[of S] assm xy_def by auto
   884       def u == "(1 :: real)/2"
   690     ultimately have "(1/2) *\<^sub>R (x+y) : S" using u_def by auto
   885       have "(1/2) *\<^sub>R (x+y) = (1/2) *\<^sub>R (x+y)" by auto
   691     moreover have "(x+y) = 2 *\<^sub>R ((1/2) *\<^sub>R (x+y))" by auto
   886       moreover
   692     ultimately have "(x+y) : S" using h1[rule_format, of "(1/2) *\<^sub>R (x+y)" "2"] by auto
   887       have "(1/2) *\<^sub>R (x+y)=(1/2) *\<^sub>R x + (1-(1/2)) *\<^sub>R y" by (simp add: algebra_simps)
   693   } hence "!x : S. !y : S. (x+y) : S" by auto 
   888       moreover
   694   hence "subspace S" using h1 assm unfolding subspace_def by auto
   889       have "(1-u) *\<^sub>R x + u *\<^sub>R y : S" using affine_alt[of S] assm xy_def by auto
   695 } from this show ?thesis using h0 by metis
   890       ultimately
       
   891       have "(1/2) *\<^sub>R (x+y) : S" using u_def by auto
       
   892       moreover
       
   893       have "(x+y) = 2 *\<^sub>R ((1/2) *\<^sub>R (x+y))" by auto
       
   894       ultimately
       
   895       have "(x+y) : S" using h1[rule_format, of "(1/2) *\<^sub>R (x+y)" "2"] by auto
       
   896     }
       
   897     then have "!x : S. !y : S. (x+y) : S" by auto 
       
   898     then have "subspace S" using h1 assm unfolding subspace_def by auto
       
   899   }
       
   900   then show ?thesis using h0 by metis
   696 qed
   901 qed
   697 
   902 
   698 lemma affine_diffs_subspace:
   903 lemma affine_diffs_subspace:
   699   assumes "affine S" "a : S"
   904   assumes "affine S" "a : S"
   700   shows "subspace ((%x. (-a)+x) ` S)"
   905   shows "subspace ((%x. (-a)+x) ` S)"
   701 proof-
   906 proof -
   702 have "affine ((%x. (-a)+x) ` S)" using  affine_translation assms by auto  
   907   have "affine ((%x. (-a)+x) ` S)"
   703 moreover have "0 : ((%x. (-a)+x) ` S)" using assms exI[of "(%x. x:S & -a+x=0)" a] by auto
   908     using  affine_translation assms by auto  
   704 ultimately show ?thesis using subspace_affine by auto 
   909   moreover have "0 : ((%x. (-a)+x) ` S)"
       
   910     using assms exI[of "(%x. x:S & -a+x=0)" a] by auto
       
   911   ultimately show ?thesis using subspace_affine by auto 
   705 qed
   912 qed
   706 
   913 
   707 lemma parallel_subspace_explicit:
   914 lemma parallel_subspace_explicit:
   708 assumes "affine S" "a : S"
   915   assumes "affine S" "a : S"
   709 assumes "L == {y. ? x : S. (-a)+x=y}" 
   916   assumes "L == {y. ? x : S. (-a)+x=y}" 
   710 shows "subspace L & affine_parallel S L" 
   917   shows "subspace L & affine_parallel S L" 
   711 proof-
   918 proof -
   712 have par: "affine_parallel S L" unfolding affine_parallel_def using assms by auto
   919   have par: "affine_parallel S L"
   713 hence "affine L" using assms parallel_is_affine by auto  
   920     unfolding affine_parallel_def using assms by auto
   714 moreover have "0 : L" using assms apply auto using exI[of "(%x. x:S & -a+x=0)" a] by auto
   921   then have "affine L" using assms parallel_is_affine by auto  
   715 ultimately show ?thesis using subspace_affine par by auto 
   922   moreover have "0 : L"
       
   923     using assms apply auto
       
   924     using exI[of "(%x. x:S & -a+x=0)" a] apply auto
       
   925     done
       
   926   ultimately show ?thesis using subspace_affine par by auto 
   716 qed
   927 qed
   717 
   928 
   718 lemma parallel_subspace_aux:
   929 lemma parallel_subspace_aux:
   719 assumes "subspace A" "subspace B" "affine_parallel A B"
   930   assumes "subspace A" "subspace B" "affine_parallel A B"
   720 shows "A>=B"
   931   shows "A>=B"
   721 proof-
   932 proof -
   722 from assms obtain a where a_def: "!x. (x : A <-> (a+x) : B)" using affine_parallel_expl[of A B] by auto
   933   from assms obtain a where a_def: "!x. (x : A <-> (a+x) : B)"
   723 hence "-a : A" using assms subspace_0[of B] by auto
   934     using affine_parallel_expl[of A B] by auto
   724 hence "a : A" using assms subspace_neg[of A "-a"] by auto
   935   then have "-a : A" using assms subspace_0[of B] by auto
   725 from this show ?thesis using assms a_def unfolding subspace_def by auto
   936   then have "a : A" using assms subspace_neg[of A "-a"] by auto
       
   937   then show ?thesis using assms a_def unfolding subspace_def by auto
   726 qed
   938 qed
   727 
   939 
   728 lemma parallel_subspace:
   940 lemma parallel_subspace:
   729 assumes "subspace A" "subspace B" "affine_parallel A B"
   941   assumes "subspace A" "subspace B" "affine_parallel A B"
   730 shows "A=B"
   942   shows "A = B"
   731 proof-
   943 proof
   732 have "A>=B" using assms parallel_subspace_aux by auto
   944   show "A >= B"
   733 moreover have "A<=B" using assms parallel_subspace_aux[of B A] affine_parallel_commut by auto
   945     using assms parallel_subspace_aux by auto
   734 ultimately show ?thesis by auto  
   946   show "A <= B"
       
   947     using assms parallel_subspace_aux[of B A] affine_parallel_commut by auto
   735 qed
   948 qed
   736 
   949 
   737 lemma affine_parallel_subspace:
   950 lemma affine_parallel_subspace:
   738 assumes "affine S" "S ~= {}"
   951   assumes "affine S" "S ~= {}"
   739 shows "?!L. subspace L & affine_parallel S L" 
   952   shows "?!L. subspace L & affine_parallel S L" 
   740 proof-
   953 proof -
   741 have ex: "? L. subspace L & affine_parallel S L" using assms  parallel_subspace_explicit by auto 
   954   have ex: "? L. subspace L & affine_parallel S L"
   742 { fix L1 L2 assume ass: "subspace L1 & affine_parallel S L1" "subspace L2 & affine_parallel S L2"
   955     using assms parallel_subspace_explicit by auto 
   743   hence "affine_parallel L1 L2" using affine_parallel_commut[of S L1] affine_parallel_assoc[of L1 S L2] by auto
   956   { fix L1 L2
   744   hence "L1=L2" using ass parallel_subspace by auto
   957     assume ass: "subspace L1 & affine_parallel S L1" "subspace L2 & affine_parallel S L2"
   745 } from this show ?thesis using ex by auto
   958     then have "affine_parallel L1 L2"
   746 qed
   959       using affine_parallel_commut[of S L1] affine_parallel_assoc[of L1 S L2] by auto
       
   960     then have "L1 = L2"
       
   961       using ass parallel_subspace by auto
       
   962   }
       
   963   then show ?thesis using ex by auto
       
   964 qed
       
   965 
   747 
   966 
   748 subsection {* Cones *}
   967 subsection {* Cones *}
   749 
   968 
   750 definition
   969 definition cone :: "'a::real_vector set \<Rightarrow> bool"
   751   cone :: "'a::real_vector set \<Rightarrow> bool" where
   970   where "cone s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>c\<ge>0. (c *\<^sub>R x) \<in> s)"
   752   "cone s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>c\<ge>0. (c *\<^sub>R x) \<in> s)"
       
   753 
   971 
   754 lemma cone_empty[intro, simp]: "cone {}"
   972 lemma cone_empty[intro, simp]: "cone {}"
   755   unfolding cone_def by auto
   973   unfolding cone_def by auto
   756 
   974 
   757 lemma cone_univ[intro, simp]: "cone UNIV"
   975 lemma cone_univ[intro, simp]: "cone UNIV"
   758   unfolding cone_def by auto
   976   unfolding cone_def by auto
   759 
   977 
   760 lemma cone_Inter[intro]: "(\<forall>s\<in>f. cone s) \<Longrightarrow> cone(\<Inter> f)"
   978 lemma cone_Inter[intro]: "(\<forall>s\<in>f. cone s) \<Longrightarrow> cone(\<Inter> f)"
   761   unfolding cone_def by auto
   979   unfolding cone_def by auto
   762 
   980 
       
   981 
   763 subsubsection {* Conic hull *}
   982 subsubsection {* Conic hull *}
   764 
   983 
   765 lemma cone_cone_hull: "cone (cone hull s)"
   984 lemma cone_cone_hull: "cone (cone hull s)"
   766   unfolding hull_def by auto
   985   unfolding hull_def by auto
   767 
   986 
   768 lemma cone_hull_eq: "(cone hull s = s) \<longleftrightarrow> cone s"
   987 lemma cone_hull_eq: "(cone hull s = s) \<longleftrightarrow> cone s"
   769   apply(rule hull_eq)
   988   apply (rule hull_eq)
   770   using cone_Inter unfolding subset_eq by auto
   989   using cone_Inter unfolding subset_eq apply auto
       
   990   done
   771 
   991 
   772 lemma mem_cone:
   992 lemma mem_cone:
   773   assumes "cone S" "x : S" "c>=0"
   993   assumes "cone S" "x : S" "c>=0"
   774   shows "c *\<^sub>R x : S"
   994   shows "c *\<^sub>R x : S"
   775   using assms cone_def[of S] by auto
   995   using assms cone_def[of S] by auto
   776 
   996 
   777 lemma cone_contains_0:
   997 lemma cone_contains_0:
   778 assumes "cone S"
   998   assumes "cone S"
   779 shows "(S ~= {}) <-> (0 : S)"
   999   shows "(S ~= {}) <-> (0 : S)"
   780 proof-
  1000 proof -
   781 { assume "S ~= {}" from this obtain a where "a:S" by auto
  1001   { assume "S ~= {}" then obtain a where "a:S" by auto
   782   hence "0 : S" using assms mem_cone[of S a 0] by auto
  1002     then have "0 : S" using assms mem_cone[of S a 0] by auto
   783 } from this show ?thesis by auto
  1003   }
       
  1004   then show ?thesis by auto
   784 qed
  1005 qed
   785 
  1006 
   786 lemma cone_0: "cone {0}"
  1007 lemma cone_0: "cone {0}"
   787 unfolding cone_def by auto
  1008   unfolding cone_def by auto
   788 
  1009 
   789 lemma cone_Union[intro]: "(!s:f. cone s) --> (cone (Union f))"
  1010 lemma cone_Union[intro]: "(!s:f. cone s) --> (cone (Union f))"
   790   unfolding cone_def by blast
  1011   unfolding cone_def by blast
   791 
  1012 
   792 lemma cone_iff:
  1013 lemma cone_iff:
   793 assumes "S ~= {}"
  1014   assumes "S ~= {}"
   794 shows "cone S <-> 0:S & (!c. c>0 --> ((op *\<^sub>R c) ` S) = S)"
  1015   shows "cone S <-> 0:S & (!c. c>0 --> ((op *\<^sub>R c) ` S) = S)"
   795 proof-
  1016 proof -
   796 { assume "cone S"
  1017   { assume "cone S"
   797   { fix c assume "(c :: real)>0"
  1018     { fix c
   798     { fix x assume "x : S" hence "x : (op *\<^sub>R c) ` S" unfolding image_def
  1019       assume "(c :: real) > 0"
   799         using `cone S` `c>0` mem_cone[of S x "1/c"]
  1020       { fix x
   800         exI[of "(%t. t:S & x = c *\<^sub>R t)" "(1 / c) *\<^sub>R x"] by auto
  1021         assume "x : S"
       
  1022         then have "x : (op *\<^sub>R c) ` S"
       
  1023           unfolding image_def
       
  1024           using `cone S` `c>0` mem_cone[of S x "1/c"]
       
  1025             exI[of "(%t. t:S & x = c *\<^sub>R t)" "(1 / c) *\<^sub>R x"] apply auto
       
  1026           done
       
  1027       }
       
  1028       moreover
       
  1029       { fix x assume "x : (op *\<^sub>R c) ` S"
       
  1030         (*from this obtain t where "t:S & x = c *\<^sub>R t" by auto*)
       
  1031         then have "x:S"
       
  1032           using `cone S` `c>0` unfolding cone_def image_def `c>0` by auto
       
  1033       }
       
  1034       ultimately have "((op *\<^sub>R c) ` S) = S" by auto
   801     }
  1035     }
   802     moreover
  1036     then have "0:S & (!c. c>0 --> ((op *\<^sub>R c) ` S) = S)"
   803     { fix x assume "x : (op *\<^sub>R c) ` S"
  1037       using `cone S` cone_contains_0[of S] assms by auto
   804       (*from this obtain t where "t:S & x = c *\<^sub>R t" by auto*)
  1038   }
   805       hence "x:S" using `cone S` `c>0` unfolding cone_def image_def `c>0` by auto
  1039   moreover
       
  1040   { assume a: "0:S & (!c. c>0 --> ((op *\<^sub>R c) ` S) = S)"
       
  1041     { fix x assume "x:S"
       
  1042       fix c1
       
  1043       assume "(c1 :: real) >= 0"
       
  1044       then have "(c1=0) | (c1>0)" by auto
       
  1045       then have "c1 *\<^sub>R x : S" using a `x:S` by auto
   806     }
  1046     }
   807     ultimately have "((op *\<^sub>R c) ` S) = S" by auto
  1047     then have "cone S" unfolding cone_def by auto
   808   } hence "0:S & (!c. c>0 --> ((op *\<^sub>R c) ` S) = S)" using `cone S` cone_contains_0[of S] assms by auto
       
   809 }
       
   810 moreover
       
   811 { assume a: "0:S & (!c. c>0 --> ((op *\<^sub>R c) ` S) = S)"
       
   812   { fix x assume "x:S"
       
   813     fix c1 assume "(c1 :: real)>=0"
       
   814     hence "(c1=0) | (c1>0)" by auto
       
   815     hence "c1 *\<^sub>R x : S" using a `x:S` by auto
       
   816   }
  1048   }
   817  hence "cone S" unfolding cone_def by auto
  1049   ultimately show ?thesis by blast
   818 } ultimately show ?thesis by blast
  1050 qed
   819 qed
  1051 
   820 
  1052 lemma cone_hull_empty: "cone hull {} = {}"
   821 lemma cone_hull_empty:
  1053   by (metis cone_empty cone_hull_eq)
   822 "cone hull {} = {}"
  1054 
   823 by (metis cone_empty cone_hull_eq)
  1055 lemma cone_hull_empty_iff: "(S = {}) <-> (cone hull S = {})"
   824 
  1056   by (metis bot_least cone_hull_empty hull_subset xtrans(5))
   825 lemma cone_hull_empty_iff:
  1057 
   826 shows "(S = {}) <-> (cone hull S = {})"
  1058 lemma cone_hull_contains_0: "(S ~= {}) <-> (0 : cone hull S)"
   827 by (metis bot_least cone_hull_empty hull_subset xtrans(5))
  1059   using cone_cone_hull[of S] cone_contains_0[of "cone hull S"] cone_hull_empty_iff[of S]
   828 
  1060   by auto
   829 lemma cone_hull_contains_0: 
       
   830 shows "(S ~= {}) <-> (0 : cone hull S)"
       
   831 using cone_cone_hull[of S] cone_contains_0[of "cone hull S"] cone_hull_empty_iff[of S] by auto
       
   832 
  1061 
   833 lemma mem_cone_hull:
  1062 lemma mem_cone_hull:
   834   assumes "x : S" "c>=0"
  1063   assumes "x : S" "c>=0"
   835   shows "c *\<^sub>R x : cone hull S"
  1064   shows "c *\<^sub>R x : cone hull S"
   836 by (metis assms cone_cone_hull hull_inc mem_cone)
  1065   by (metis assms cone_cone_hull hull_inc mem_cone)
   837 
  1066 
   838 lemma cone_hull_expl:
  1067 lemma cone_hull_expl: "cone hull S = {c *\<^sub>R x | c x. c>=0 & x : S}" (is "?lhs = ?rhs")
   839 shows "cone hull S = {c *\<^sub>R x | c x. c>=0 & x : S}" (is "?lhs = ?rhs")
  1068 proof -
   840 proof-
  1069   { fix x
   841 { fix x assume "x : ?rhs"
  1070     assume "x : ?rhs"
   842   from this obtain cx xx where x_def: "x= cx *\<^sub>R xx & (cx :: real)>=0 & xx : S" by auto
  1071     then obtain cx xx where x_def: "x= cx *\<^sub>R xx & (cx :: real)>=0 & xx : S"
   843   fix c assume c_def: "(c :: real)>=0"
  1072       by auto
   844   hence "c *\<^sub>R x = (c*cx) *\<^sub>R xx" using x_def by (simp add: algebra_simps)
  1073     fix c
   845   moreover have "(c*cx) >= 0" using c_def x_def using mult_nonneg_nonneg by auto
  1074     assume c_def: "(c :: real) >= 0"
   846   ultimately have "c *\<^sub>R x : ?rhs" using x_def by auto
  1075     then have "c *\<^sub>R x = (c*cx) *\<^sub>R xx"
   847 } hence "cone ?rhs" unfolding cone_def by auto
  1076       using x_def by (simp add: algebra_simps)
   848   hence "?rhs : Collect cone" unfolding mem_Collect_eq by auto
  1077     moreover
   849 { fix x assume "x : S" hence "1 *\<^sub>R x : ?rhs" apply auto apply(rule_tac x="1" in exI) by auto
  1078     have "(c*cx) >= 0"
   850   hence "x : ?rhs" by auto
  1079       using c_def x_def using mult_nonneg_nonneg by auto
   851 } hence "S <= ?rhs" by auto
  1080     ultimately
   852 hence "?lhs <= ?rhs" using `?rhs : Collect cone` hull_minimal[of S "?rhs" "cone"] by auto
  1081     have "c *\<^sub>R x : ?rhs" using x_def by auto
   853 moreover
  1082   } then have "cone ?rhs" unfolding cone_def by auto
   854 { fix x assume "x : ?rhs"
  1083   then have "?rhs : Collect cone" unfolding mem_Collect_eq by auto
   855   from this obtain cx xx where x_def: "x= cx *\<^sub>R xx & (cx :: real)>=0 & xx : S" by auto
  1084   { fix x
   856   hence "xx : cone hull S" using hull_subset[of S] by auto
  1085     assume "x : S"
   857   hence "x : ?lhs" using x_def cone_cone_hull[of S] cone_def[of "cone hull S"] by auto
  1086     then have "1 *\<^sub>R x : ?rhs"
   858 } ultimately show ?thesis by auto
  1087       apply auto  
       
  1088       apply (rule_tac x="1" in exI)
       
  1089       apply auto
       
  1090       done
       
  1091     then have "x : ?rhs" by auto
       
  1092   } then have "S <= ?rhs" by auto
       
  1093   then have "?lhs <= ?rhs"
       
  1094     using `?rhs : Collect cone` hull_minimal[of S "?rhs" "cone"] by auto
       
  1095   moreover
       
  1096   { fix x
       
  1097     assume "x : ?rhs"
       
  1098     then obtain cx xx where x_def: "x= cx *\<^sub>R xx & (cx :: real)>=0 & xx : S" by auto
       
  1099     then have "xx : cone hull S" using hull_subset[of S] by auto
       
  1100     then have "x : ?lhs"
       
  1101       using x_def cone_cone_hull[of S] cone_def[of "cone hull S"] by auto
       
  1102   }
       
  1103   ultimately show ?thesis by auto
   859 qed
  1104 qed
   860 
  1105 
   861 lemma cone_closure:
  1106 lemma cone_closure:
   862   fixes S :: "('a::real_normed_vector) set"
  1107   fixes S :: "('a::real_normed_vector) set"
   863   assumes "cone S" shows "cone (closure S)"
  1108   assumes "cone S"
   864 proof-
  1109   shows "cone (closure S)"
   865 { assume "S = {}" hence ?thesis by auto }
  1110 proof (cases "S = {}")
   866 moreover
  1111   case True
   867 { assume "S ~= {}" hence "0:S & (!c. c>0 --> op *\<^sub>R c ` S = S)" using cone_iff[of S] assms by auto
  1112   then show ?thesis by auto
   868   hence "0:(closure S) & (!c. c>0 --> op *\<^sub>R c ` (closure S) = (closure S))"
  1113 next
   869      using closure_subset by (auto simp add: closure_scaleR)
  1114   case False
   870   hence ?thesis using cone_iff[of "closure S"] by auto
  1115   then have "0:S & (!c. c>0 --> op *\<^sub>R c ` S = S)"
   871 }
  1116     using cone_iff[of S] assms by auto
   872 ultimately show ?thesis by blast
  1117   then have "0:(closure S) & (!c. c>0 --> op *\<^sub>R c ` (closure S) = (closure S))"
   873 qed
  1118     using closure_subset by (auto simp add: closure_scaleR)
       
  1119   then show ?thesis using cone_iff[of "closure S"] by auto
       
  1120 qed
       
  1121 
   874 
  1122 
   875 subsection {* Affine dependence and consequential theorems (from Lars Schewe) *}
  1123 subsection {* Affine dependence and consequential theorems (from Lars Schewe) *}
   876 
  1124 
   877 definition
  1125 definition affine_dependent :: "'a::real_vector set \<Rightarrow> bool"
   878   affine_dependent :: "'a::real_vector set \<Rightarrow> bool" where
  1126   where "affine_dependent s \<longleftrightarrow> (\<exists>x\<in>s. x \<in> (affine hull (s - {x})))"
   879   "affine_dependent s \<longleftrightarrow> (\<exists>x\<in>s. x \<in> (affine hull (s - {x})))"
       
   880 
  1127 
   881 lemma affine_dependent_explicit:
  1128 lemma affine_dependent_explicit:
   882   "affine_dependent p \<longleftrightarrow>
  1129   "affine_dependent p \<longleftrightarrow>
   883     (\<exists>s u. finite s \<and> s \<subseteq> p \<and> setsum u s = 0 \<and>
  1130     (\<exists>s u. finite s \<and> s \<subseteq> p \<and> setsum u s = 0 \<and>
   884     (\<exists>v\<in>s. u v \<noteq> 0) \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = 0)"
  1131     (\<exists>v\<in>s. u v \<noteq> 0) \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = 0)"
   885   unfolding affine_dependent_def affine_hull_explicit mem_Collect_eq apply(rule)
  1132   unfolding affine_dependent_def affine_hull_explicit mem_Collect_eq
   886   apply(erule bexE,erule exE,erule exE) apply(erule conjE)+ defer apply(erule exE,erule exE) apply(erule conjE)+ apply(erule bexE)
  1133   apply rule
   887 proof-
  1134   apply (erule bexE, erule exE, erule exE)
   888   fix x s u assume as:"x \<in> p" "finite s" "s \<noteq> {}" "s \<subseteq> p - {x}" "setsum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = x"
  1135   apply (erule conjE)+
       
  1136   defer
       
  1137   apply (erule exE, erule exE)
       
  1138   apply (erule conjE)+
       
  1139   apply (erule bexE)
       
  1140 proof -
       
  1141   fix x s u
       
  1142   assume as: "x \<in> p" "finite s" "s \<noteq> {}" "s \<subseteq> p - {x}" "setsum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = x"
   889   have "x\<notin>s" using as(1,4) by auto
  1143   have "x\<notin>s" using as(1,4) by auto
   890   show "\<exists>s u. finite s \<and> s \<subseteq> p \<and> setsum u s = 0 \<and> (\<exists>v\<in>s. u v \<noteq> 0) \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = 0"
  1144   show "\<exists>s u. finite s \<and> s \<subseteq> p \<and> setsum u s = 0 \<and> (\<exists>v\<in>s. u v \<noteq> 0) \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = 0"
   891     apply(rule_tac x="insert x s" in exI, rule_tac x="\<lambda>v. if v = x then - 1 else u v" in exI)
  1145     apply (rule_tac x="insert x s" in exI, rule_tac x="\<lambda>v. if v = x then - 1 else u v" in exI)
   892     unfolding if_smult and setsum_clauses(2)[OF as(2)] and setsum_delta_notmem[OF `x\<notin>s`] and as using as by auto 
  1146     unfolding if_smult and setsum_clauses(2)[OF as(2)] and setsum_delta_notmem[OF `x\<notin>s`] and as
       
  1147     using as apply auto
       
  1148     done
   893 next
  1149 next
   894   fix s u v assume as:"finite s" "s \<subseteq> p" "setsum u s = 0" "(\<Sum>v\<in>s. u v *\<^sub>R v) = 0" "v \<in> s" "u v \<noteq> 0"
  1150   fix s u v
       
  1151   assume as:"finite s" "s \<subseteq> p" "setsum u s = 0" "(\<Sum>v\<in>s. u v *\<^sub>R v) = 0" "v \<in> s" "u v \<noteq> 0"
   895   have "s \<noteq> {v}" using as(3,6) by auto
  1152   have "s \<noteq> {v}" using as(3,6) by auto
   896   thus "\<exists>x\<in>p. \<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p - {x} \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x" 
  1153   then show "\<exists>x\<in>p. \<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p - {x} \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x"
   897     apply(rule_tac x=v in bexI, rule_tac x="s - {v}" in exI, rule_tac x="\<lambda>x. - (1 / u v) * u x" in exI)
  1154     apply (rule_tac x=v in bexI, rule_tac x="s - {v}" in exI,
   898     unfolding scaleR_scaleR[THEN sym] and scaleR_right.setsum [symmetric] unfolding setsum_right_distrib[THEN sym] and setsum_diff1[OF as(1)] using as by auto
  1155       rule_tac x="\<lambda>x. - (1 / u v) * u x" in exI)
       
  1156     unfolding scaleR_scaleR[THEN sym] and scaleR_right.setsum [symmetric]
       
  1157     unfolding setsum_right_distrib[THEN sym] and setsum_diff1[OF as(1)]
       
  1158     using as apply auto
       
  1159     done
   899 qed
  1160 qed
   900 
  1161 
   901 lemma affine_dependent_explicit_finite:
  1162 lemma affine_dependent_explicit_finite:
   902   fixes s :: "'a::real_vector set" assumes "finite s"
  1163   fixes s :: "'a::real_vector set"
       
  1164   assumes "finite s"
   903   shows "affine_dependent s \<longleftrightarrow> (\<exists>u. setsum u s = 0 \<and> (\<exists>v\<in>s. u v \<noteq> 0) \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = 0)"
  1165   shows "affine_dependent s \<longleftrightarrow> (\<exists>u. setsum u s = 0 \<and> (\<exists>v\<in>s. u v \<noteq> 0) \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = 0)"
   904   (is "?lhs = ?rhs")
  1166   (is "?lhs = ?rhs")
   905 proof
  1167 proof
   906   have *:"\<And>vt u v. (if vt then u v else 0) *\<^sub>R v = (if vt then (u v) *\<^sub>R v else (0::'a))" by auto
  1168   have *: "\<And>vt u v. (if vt then u v else 0) *\<^sub>R v = (if vt then (u v) *\<^sub>R v else (0::'a))"
       
  1169     by auto
   907   assume ?lhs
  1170   assume ?lhs
   908   then obtain t u v where "finite t" "t \<subseteq> s" "setsum u t = 0" "v\<in>t" "u v \<noteq> 0"  "(\<Sum>v\<in>t. u v *\<^sub>R v) = 0"
  1171   then obtain t u v where
       
  1172       "finite t" "t \<subseteq> s" "setsum u t = 0" "v\<in>t" "u v \<noteq> 0"  "(\<Sum>v\<in>t. u v *\<^sub>R v) = 0"
   909     unfolding affine_dependent_explicit by auto
  1173     unfolding affine_dependent_explicit by auto
   910   thus ?rhs apply(rule_tac x="\<lambda>x. if x\<in>t then u x else 0" in exI)
  1174   then show ?rhs
       
  1175     apply (rule_tac x="\<lambda>x. if x\<in>t then u x else 0" in exI)
   911     apply auto unfolding * and setsum_restrict_set[OF assms, THEN sym]
  1176     apply auto unfolding * and setsum_restrict_set[OF assms, THEN sym]
   912     unfolding Int_absorb1[OF `t\<subseteq>s`] by auto
  1177     unfolding Int_absorb1[OF `t\<subseteq>s`]
       
  1178     apply auto
       
  1179     done
   913 next
  1180 next
   914   assume ?rhs
  1181   assume ?rhs
   915   then obtain u v where "setsum u s = 0"  "v\<in>s" "u v \<noteq> 0" "(\<Sum>v\<in>s. u v *\<^sub>R v) = 0" by auto
  1182   then obtain u v where "setsum u s = 0"  "v\<in>s" "u v \<noteq> 0" "(\<Sum>v\<in>s. u v *\<^sub>R v) = 0" by auto
   916   thus ?lhs unfolding affine_dependent_explicit using assms by auto
  1183   then show ?lhs unfolding affine_dependent_explicit
   917 qed
  1184     using assms by auto
       
  1185 qed
       
  1186 
   918 
  1187 
   919 subsection {* Connectedness of convex sets *}
  1188 subsection {* Connectedness of convex sets *}
   920 
  1189 
   921 lemma connected_real_lemma:
  1190 lemma connected_real_lemma:
   922   fixes f :: "real \<Rightarrow> 'a::metric_space"
  1191   fixes f :: "real \<Rightarrow> 'a::metric_space"
   923   assumes ab: "a \<le> b" and fa: "f a \<in> e1" and fb: "f b \<in> e2"
  1192   assumes ab: "a \<le> b" and fa: "f a \<in> e1" and fb: "f b \<in> e2"
   924   and dst: "\<And>e x. a <= x \<Longrightarrow> x <= b \<Longrightarrow> 0 < e ==> \<exists>d > 0. \<forall>y. abs(y - x) < d \<longrightarrow> dist(f y) (f x) < e"
  1193     and dst: "\<And>e x. a <= x \<Longrightarrow> x <= b \<Longrightarrow> 0 < e ==> \<exists>d > 0. \<forall>y. abs(y - x) < d \<longrightarrow> dist(f y) (f x) < e"
   925   and e1: "\<forall>y \<in> e1. \<exists>e > 0. \<forall>y'. dist y' y < e \<longrightarrow> y' \<in> e1"
  1194     and e1: "\<forall>y \<in> e1. \<exists>e > 0. \<forall>y'. dist y' y < e \<longrightarrow> y' \<in> e1"
   926   and e2: "\<forall>y \<in> e2. \<exists>e > 0. \<forall>y'. dist y' y < e \<longrightarrow> y' \<in> e2"
  1195     and e2: "\<forall>y \<in> e2. \<exists>e > 0. \<forall>y'. dist y' y < e \<longrightarrow> y' \<in> e2"
   927   and e12: "~(\<exists>x \<ge> a. x <= b \<and> f x \<in> e1 \<and> f x \<in> e2)"
  1196     and e12: "~(\<exists>x \<ge> a. x <= b \<and> f x \<in> e1 \<and> f x \<in> e2)"
   928   shows "\<exists>x \<ge> a. x <= b \<and> f x \<notin> e1 \<and> f x \<notin> e2" (is "\<exists> x. ?P x")
  1197   shows "\<exists>x \<ge> a. x <= b \<and> f x \<notin> e1 \<and> f x \<notin> e2" (is "\<exists> x. ?P x")
   929 proof-
  1198 proof -
   930   let ?S = "{c. \<forall>x \<ge> a. x <= c \<longrightarrow> f x \<in> e1}"
  1199   let ?S = "{c. \<forall>x \<ge> a. x <= c \<longrightarrow> f x \<in> e1}"
   931   have Se: " \<exists>x. x \<in> ?S" apply (rule exI[where x=a]) by (auto simp add: fa)
  1200   have Se: " \<exists>x. x \<in> ?S" apply (rule exI[where x=a]) by (auto simp add: fa)
   932   have Sub: "\<exists>y. isUb UNIV ?S y"
  1201   have Sub: "\<exists>y. isUb UNIV ?S y"
   933     apply (rule exI[where x= b])
  1202     apply (rule exI[where x= b])
   934     using ab fb e12 by (auto simp add: isUb_def setle_def)
  1203     using ab fb e12 by (auto simp add: isUb_def setle_def)