src/HOL/Analysis/Affine.thy
changeset 78516 56a408fa2440
parent 76836 30182f9e1818
equal deleted inserted replaced
78481:1425a366fe7f 78516:56a408fa2440
     3 theory Affine
     3 theory Affine
     4 imports Linear_Algebra
     4 imports Linear_Algebra
     5 begin
     5 begin
     6 
     6 
     7 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)"
     7 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)"
     8   by (fact if_distrib)
     8   by simp
     9 
     9 
    10 lemma sum_delta_notmem:
    10 lemma sum_delta_notmem:
    11   assumes "x \<notin> s"
    11   assumes "x \<notin> s"
    12   shows "sum (\<lambda>y. if (y = x) then P x else Q y) s = sum Q s"
    12   shows "sum (\<lambda>y. if (y = x) then P x else Q y) s = sum Q s"
    13     and "sum (\<lambda>y. if (x = y) then P x else Q y) s = sum Q s"
    13     and "sum (\<lambda>y. if (x = y) then P x else Q y) s = sum Q s"
    14     and "sum (\<lambda>y. if (y = x) then P y else Q y) s = sum Q s"
    14     and "sum (\<lambda>y. if (y = x) then P y else Q y) s = sum Q s"
    15     and "sum (\<lambda>y. if (x = y) then P y else Q y) s = sum Q s"
    15     and "sum (\<lambda>y. if (x = y) then P y else Q y) s = sum Q s"
    16   apply (rule_tac [!] sum.cong)
    16   by (smt (verit, best) assms sum.cong)+
    17   using assms
       
    18   apply auto
       
    19   done
       
    20 
       
    21 lemmas independent_finite = independent_imp_finite
       
    22 
    17 
    23 lemma span_substd_basis:
    18 lemma span_substd_basis:
    24   assumes d: "d \<subseteq> Basis"
    19   assumes d: "d \<subseteq> Basis"
    25   shows "span d = {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0}"
    20   shows "span d = {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0}"
    26   (is "_ = ?B")
    21   (is "_ = ?B")
    30   moreover have s: "subspace ?B"
    25   moreover have s: "subspace ?B"
    31     using subspace_substandard[of "\<lambda>i. i \<notin> d"] .
    26     using subspace_substandard[of "\<lambda>i. i \<notin> d"] .
    32   ultimately have "span d \<subseteq> ?B"
    27   ultimately have "span d \<subseteq> ?B"
    33     using span_mono[of d "?B"] span_eq_iff[of "?B"] by blast
    28     using span_mono[of d "?B"] span_eq_iff[of "?B"] by blast
    34   moreover have *: "card d \<le> dim (span d)"
    29   moreover have *: "card d \<le> dim (span d)"
    35     using independent_card_le_dim[of d "span d"] independent_substdbasis[OF assms]
    30     by (simp add: d dim_eq_card_independent independent_substdbasis)
    36       span_superset[of d]
       
    37     by auto
       
    38   moreover from * have "dim ?B \<le> dim (span d)"
    31   moreover from * have "dim ?B \<le> dim (span d)"
    39     using dim_substandard[OF assms] by auto
    32     using dim_substandard[OF assms] by auto
    40   ultimately show ?thesis
    33   ultimately show ?thesis
    41     using s subspace_dim_equal[of "span d" "?B"] subspace_span[of d] by auto
    34     by (simp add: s subspace_dim_equal)
    42 qed
    35 qed
    43 
    36 
    44 lemma basis_to_substdbasis_subspace_isomorphism:
    37 lemma basis_to_substdbasis_subspace_isomorphism:
    45   fixes B :: "'a::euclidean_space set"
    38   fixes B :: "'a::euclidean_space set"
    46   assumes "independent B"
    39   assumes "independent B"
    49 proof -
    42 proof -
    50   have B: "card B = dim B"
    43   have B: "card B = dim B"
    51     using dim_unique[of B B "card B"] assms span_superset[of B] by auto
    44     using dim_unique[of B B "card B"] assms span_superset[of B] by auto
    52   have "dim B \<le> card (Basis :: 'a set)"
    45   have "dim B \<le> card (Basis :: 'a set)"
    53     using dim_subset_UNIV[of B] by simp
    46     using dim_subset_UNIV[of B] by simp
    54   from obtain_subset_with_card_n[OF this] obtain d :: "'a set" where d: "d \<subseteq> Basis" and t: "card d = dim B"
    47   from obtain_subset_with_card_n[OF this] 
       
    48   obtain d :: "'a set" where d: "d \<subseteq> Basis" and t: "card d = dim B"
    55     by auto
    49     by auto
    56   let ?t = "{x::'a::euclidean_space. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0}"
    50   let ?t = "{x::'a::euclidean_space. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0}"
    57   have "\<exists>f. linear f \<and> f ` B = d \<and> f ` span B = ?t \<and> inj_on f (span B)"
    51   have "\<exists>f. linear f \<and> f ` B = d \<and> f ` span B = ?t \<and> inj_on f (span B)"
    58   proof (intro basis_to_basis_subspace_isomorphism subspace_span subspace_substandard span_superset)
    52   proof (intro basis_to_basis_subspace_isomorphism subspace_span subspace_substandard span_superset)
    59     show "d \<subseteq> {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = 0}"
    53     show "d \<subseteq> {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = 0}"
    63 qed
    57 qed
    64 
    58 
    65 subsection \<open>Affine set and affine hull\<close>
    59 subsection \<open>Affine set and affine hull\<close>
    66 
    60 
    67 definition\<^marker>\<open>tag important\<close> affine :: "'a::real_vector set \<Rightarrow> bool"
    61 definition\<^marker>\<open>tag important\<close> affine :: "'a::real_vector set \<Rightarrow> bool"
    68   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)"
    62   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)"
    69 
    63 
    70 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)"
    64 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)"
    71   unfolding affine_def by (metis eq_diff_eq')
    65   unfolding affine_def by (metis eq_diff_eq')
    72 
    66 
    73 lemma affine_empty [iff]: "affine {}"
    67 lemma affine_empty [iff]: "affine {}"
    74   unfolding affine_def by auto
    68   unfolding affine_def by auto
    75 
    69 
    77   unfolding affine_alt by (auto simp: scaleR_left_distrib [symmetric])
    71   unfolding affine_alt by (auto simp: scaleR_left_distrib [symmetric])
    78 
    72 
    79 lemma affine_UNIV [iff]: "affine UNIV"
    73 lemma affine_UNIV [iff]: "affine UNIV"
    80   unfolding affine_def by auto
    74   unfolding affine_def by auto
    81 
    75 
    82 lemma affine_Inter [intro]: "(\<And>s. s\<in>f \<Longrightarrow> affine s) \<Longrightarrow> affine (\<Inter>f)"
    76 lemma affine_Inter [intro]: "(\<And>S. S\<in>\<F> \<Longrightarrow> affine S) \<Longrightarrow> affine (\<Inter>\<F>)"
    83   unfolding affine_def by auto
    77   unfolding affine_def by auto
    84 
    78 
    85 lemma affine_Int[intro]: "affine s \<Longrightarrow> affine t \<Longrightarrow> affine (s \<inter> t)"
    79 lemma affine_Int[intro]: "affine S \<Longrightarrow> affine T \<Longrightarrow> affine (S \<inter> T)"
    86   unfolding affine_def by auto
    80   unfolding affine_def by auto
    87 
    81 
    88 lemma affine_scaling: "affine s \<Longrightarrow> affine (image (\<lambda>x. c *\<^sub>R x) s)"
    82 lemma affine_scaling: "affine S \<Longrightarrow> affine ((*\<^sub>R) c ` S)"
    89   apply (clarsimp simp add: affine_def)
    83   apply (clarsimp simp: affine_def)
    90   apply (rule_tac x="u *\<^sub>R x + v *\<^sub>R y" in image_eqI)
    84   apply (rule_tac x="u *\<^sub>R x + v *\<^sub>R y" in image_eqI)
    91   apply (auto simp: algebra_simps)
    85   apply (auto simp: algebra_simps)
    92   done
    86   done
    93 
    87 
    94 lemma affine_affine_hull [simp]: "affine(affine hull s)"
    88 lemma affine_affine_hull [simp]: "affine(affine hull S)"
    95   unfolding hull_def
    89   unfolding hull_def
    96   using affine_Inter[of "{t. affine t \<and> s \<subseteq> t}"] by auto
    90   using affine_Inter[of "{T. affine T \<and> S \<subseteq> T}"] by auto
    97 
    91 
    98 lemma affine_hull_eq[simp]: "(affine hull s = s) \<longleftrightarrow> affine s"
    92 lemma affine_hull_eq[simp]: "(affine hull s = s) \<longleftrightarrow> affine s"
    99   by (metis affine_affine_hull hull_same)
    93   by (metis affine_affine_hull hull_same)
   100 
    94 
   101 lemma affine_hyperplane: "affine {x. a \<bullet> x = b}"
    95 lemma affine_hyperplane: "affine {x. a \<bullet> x = b}"
   196 
   190 
   197 lemma affine_hull_explicit:
   191 lemma affine_hull_explicit:
   198   "affine hull p = {y. \<exists>S u. finite S \<and> S \<noteq> {} \<and> S \<subseteq> p \<and> sum u S = 1 \<and> sum (\<lambda>v. u v *\<^sub>R v) S = y}"
   192   "affine hull p = {y. \<exists>S u. finite S \<and> S \<noteq> {} \<and> S \<subseteq> p \<and> sum u S = 1 \<and> sum (\<lambda>v. u v *\<^sub>R v) S = y}"
   199   (is "_ = ?rhs")
   193   (is "_ = ?rhs")
   200 proof (rule hull_unique)
   194 proof (rule hull_unique)
       
   195   have "\<And>x. sum (\<lambda>z. 1) {x} = 1"
       
   196       by auto
   201   show "p \<subseteq> ?rhs"
   197   show "p \<subseteq> ?rhs"
   202   proof (intro subsetI CollectI exI conjI)
   198   proof (intro subsetI CollectI exI conjI)
   203     show "\<And>x. sum (\<lambda>z. 1) {x} = 1"
   199     show "\<And>x. sum (\<lambda>z. 1) {x} = 1"
   204       by auto
   200       by auto
   205   qed auto
   201   qed auto
   450 
   446 
   451 lemma affine_parallel_reflex: "affine_parallel S S"
   447 lemma affine_parallel_reflex: "affine_parallel S S"
   452   unfolding affine_parallel_def
   448   unfolding affine_parallel_def
   453   using image_add_0 by blast
   449   using image_add_0 by blast
   454 
   450 
   455 lemma affine_parallel_commut:
   451 lemma affine_parallel_commute:
   456   assumes "affine_parallel A B"
   452   assumes "affine_parallel A B"
   457   shows "affine_parallel B A"
   453   shows "affine_parallel B A"
   458 proof -
   454   by (metis affine_parallel_def assms translation_galois)
   459   from assms obtain a where B: "B = (\<lambda>x. a + x) ` A"
       
   460     unfolding affine_parallel_def by auto
       
   461   have [simp]: "(\<lambda>x. x - a) = plus (- a)" by (simp add: fun_eq_iff)
       
   462   from B show ?thesis
       
   463     using translation_galois [of B a A]
       
   464     unfolding affine_parallel_def by blast
       
   465 qed
       
   466 
   455 
   467 lemma affine_parallel_assoc:
   456 lemma affine_parallel_assoc:
   468   assumes "affine_parallel A B"
   457   assumes "affine_parallel A B"
   469     and "affine_parallel B C"
   458     and "affine_parallel B C"
   470   shows "affine_parallel A C"
   459   shows "affine_parallel A C"
   471 proof -
   460   by (metis affine_parallel_def assms translation_assoc)
   472   from assms obtain ab where "B = (\<lambda>x. ab + x) ` A"
       
   473     unfolding affine_parallel_def by auto
       
   474   moreover
       
   475   from assms obtain bc where "C = (\<lambda>x. bc + x) ` B"
       
   476     unfolding affine_parallel_def by auto
       
   477   ultimately show ?thesis
       
   478     using translation_assoc[of bc ab A] unfolding affine_parallel_def by auto
       
   479 qed
       
   480 
   461 
   481 lemma affine_translation_aux:
   462 lemma affine_translation_aux:
   482   fixes a :: "'a::real_vector"
   463   fixes a :: "'a::real_vector"
   483   assumes "affine ((\<lambda>x. a + x) ` S)"
   464   assumes "affine ((\<lambda>x. a + x) ` S)"
   484   shows "affine S"
   465   shows "affine S"
   501   then show ?thesis unfolding affine_def by auto
   482   then show ?thesis unfolding affine_def by auto
   502 qed
   483 qed
   503 
   484 
   504 lemma affine_translation:
   485 lemma affine_translation:
   505   "affine S \<longleftrightarrow> affine ((+) a ` S)" for a :: "'a::real_vector"
   486   "affine S \<longleftrightarrow> affine ((+) a ` S)" for a :: "'a::real_vector"
   506 proof
   487   by (metis affine_translation_aux translation_galois)
   507   show "affine ((+) a ` S)" if "affine S"
       
   508     using that translation_assoc [of "- a" a S]
       
   509     by (auto intro: affine_translation_aux [of "- a" "((+) a ` S)"])
       
   510   show "affine S" if "affine ((+) a ` S)"
       
   511     using that by (rule affine_translation_aux)
       
   512 qed
       
   513 
   488 
   514 lemma parallel_is_affine:
   489 lemma parallel_is_affine:
   515   fixes S T :: "'a::real_vector set"
   490   fixes S T :: "'a::real_vector set"
   516   assumes "affine S" "affine_parallel S T"
   491   assumes "affine S" "affine_parallel S T"
   517   shows "affine T"
   492   shows "affine T"
   518 proof -
   493   by (metis affine_parallel_def affine_translation assms)
   519   from assms obtain a where "T = (\<lambda>x. a + x) ` S"
       
   520     unfolding affine_parallel_def by auto
       
   521   then show ?thesis
       
   522     using affine_translation assms by auto
       
   523 qed
       
   524 
   494 
   525 lemma subspace_imp_affine: "subspace s \<Longrightarrow> affine s"
   495 lemma subspace_imp_affine: "subspace s \<Longrightarrow> affine s"
   526   unfolding subspace_def affine_def by auto
   496   unfolding subspace_def affine_def by auto
   527 
   497 
   528 lemma affine_hull_subset_span: "(affine hull s) \<subseteq> (span s)"
   498 lemma affine_hull_subset_span: "(affine hull s) \<subseteq> (span s)"
   530 
   500 
   531 
   501 
   532 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Subspace parallel to an affine set\<close>
   502 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Subspace parallel to an affine set\<close>
   533 
   503 
   534 lemma subspace_affine: "subspace S \<longleftrightarrow> affine S \<and> 0 \<in> S"
   504 lemma subspace_affine: "subspace S \<longleftrightarrow> affine S \<and> 0 \<in> S"
   535 proof -
   505   by (metis add_cancel_right_left affine_alt diff_add_cancel mem_affine_3 scaleR_eq_0_iff subspace_def vector_space_assms(4))
   536   have h0: "subspace S \<Longrightarrow> affine S \<and> 0 \<in> S"
       
   537     using subspace_imp_affine[of S] subspace_0 by auto
       
   538   {
       
   539     assume assm: "affine S \<and> 0 \<in> S"
       
   540     {
       
   541       fix c :: real
       
   542       fix x
       
   543       assume x: "x \<in> S"
       
   544       have "c *\<^sub>R x = (1-c) *\<^sub>R 0 + c *\<^sub>R x" by auto
       
   545       moreover
       
   546       have "(1 - c) *\<^sub>R 0 + c *\<^sub>R x \<in> S"
       
   547         using affine_alt[of S] assm x by auto
       
   548       ultimately have "c *\<^sub>R x \<in> S" by auto
       
   549     }
       
   550     then have h1: "\<forall>c. \<forall>x \<in> S. c *\<^sub>R x \<in> S" by auto
       
   551 
       
   552     {
       
   553       fix x y
       
   554       assume xy: "x \<in> S" "y \<in> S"
       
   555       define u where "u = (1 :: real)/2"
       
   556       have "(1/2) *\<^sub>R (x+y) = (1/2) *\<^sub>R (x+y)"
       
   557         by auto
       
   558       moreover
       
   559       have "(1/2) *\<^sub>R (x+y)=(1/2) *\<^sub>R x + (1-(1/2)) *\<^sub>R y"
       
   560         by (simp add: algebra_simps)
       
   561       moreover
       
   562       have "(1 - u) *\<^sub>R x + u *\<^sub>R y \<in> S"
       
   563         using affine_alt[of S] assm xy by auto
       
   564       ultimately
       
   565       have "(1/2) *\<^sub>R (x+y) \<in> S"
       
   566         using u_def by auto
       
   567       moreover
       
   568       have "x + y = 2 *\<^sub>R ((1/2) *\<^sub>R (x+y))"
       
   569         by auto
       
   570       ultimately
       
   571       have "x + y \<in> S"
       
   572         using h1[rule_format, of "(1/2) *\<^sub>R (x+y)" "2"] by auto
       
   573     }
       
   574     then have "\<forall>x \<in> S. \<forall>y \<in> S. x + y \<in> S"
       
   575       by auto
       
   576     then have "subspace S"
       
   577       using h1 assm unfolding subspace_def by auto
       
   578   }
       
   579   then show ?thesis using h0 by metis
       
   580 qed
       
   581 
   506 
   582 lemma affine_diffs_subspace:
   507 lemma affine_diffs_subspace:
   583   assumes "affine S" "a \<in> S"
   508   assumes "affine S" "a \<in> S"
   584   shows "subspace ((\<lambda>x. (-a)+x) ` S)"
   509   shows "subspace ((\<lambda>x. (-a)+x) ` S)"
   585 proof -
   510   by (metis ab_left_minus affine_translation assms image_eqI subspace_affine)
   586   have [simp]: "(\<lambda>x. x - a) = plus (- a)" by (simp add: fun_eq_iff)
       
   587   have "affine ((\<lambda>x. (-a)+x) ` S)"
       
   588     using affine_translation assms by blast
       
   589   moreover have "0 \<in> ((\<lambda>x. (-a)+x) ` S)"
       
   590     using assms exI[of "(\<lambda>x. x\<in>S \<and> -a+x = 0)" a] by auto
       
   591   ultimately show ?thesis using subspace_affine by auto
       
   592 qed
       
   593 
   511 
   594 lemma affine_diffs_subspace_subtract:
   512 lemma affine_diffs_subspace_subtract:
   595   "subspace ((\<lambda>x. x - a) ` S)" if "affine S" "a \<in> S"
   513   "subspace ((\<lambda>x. x - a) ` S)" if "affine S" "a \<in> S"
   596   using that affine_diffs_subspace [of _ a] by simp
   514   using that affine_diffs_subspace [of _ a] by simp
   597 
   515 
   598 lemma parallel_subspace_explicit:
   516 lemma parallel_subspace_explicit:
   599   assumes "affine S"
   517   assumes "affine S"
   600     and "a \<in> S"
   518     and "a \<in> S"
   601   assumes "L \<equiv> {y. \<exists>x \<in> S. (-a) + x = y}"
   519   assumes "L \<equiv> {y. \<exists>x \<in> S. (-a) + x = y}"
   602   shows "subspace L \<and> affine_parallel S L"
   520   shows "subspace L \<and> affine_parallel S L"
   603 proof -
   521   by (smt (verit) Collect_cong ab_left_minus affine_parallel_def assms image_def mem_Collect_eq parallel_is_affine subspace_affine)
   604   from assms have "L = plus (- a) ` S" by auto
       
   605   then have par: "affine_parallel S L"
       
   606     unfolding affine_parallel_def ..
       
   607   then have "affine L" using assms parallel_is_affine by auto
       
   608   moreover have "0 \<in> L"
       
   609     using assms by auto
       
   610   ultimately show ?thesis
       
   611     using subspace_affine par by auto
       
   612 qed
       
   613 
   522 
   614 lemma parallel_subspace_aux:
   523 lemma parallel_subspace_aux:
   615   assumes "subspace A"
   524   assumes "subspace A"
   616     and "subspace B"
   525     and "subspace B"
   617     and "affine_parallel A B"
   526     and "affine_parallel A B"
   618   shows "A \<supseteq> B"
   527   shows "A \<supseteq> B"
   619 proof -
   528   by (metis add.right_neutral affine_parallel_expl assms subsetI subspace_def)
   620   from assms obtain a where a: "\<forall>x. x \<in> A \<longleftrightarrow> a + x \<in> B"
       
   621     using affine_parallel_expl[of A B] by auto
       
   622   then have "-a \<in> A"
       
   623     using assms subspace_0[of B] by auto
       
   624   then have "a \<in> A"
       
   625     using assms subspace_neg[of A "-a"] by auto
       
   626   then show ?thesis
       
   627     using assms a unfolding subspace_def by auto
       
   628 qed
       
   629 
   529 
   630 lemma parallel_subspace:
   530 lemma parallel_subspace:
   631   assumes "subspace A"
   531   assumes "subspace A"
   632     and "subspace B"
   532     and "subspace B"
   633     and "affine_parallel A B"
   533     and "affine_parallel A B"
   634   shows "A = B"
   534   shows "A = B"
   635 proof
   535   by (simp add: affine_parallel_commute assms parallel_subspace_aux subset_antisym)
   636   show "A \<supseteq> B"
       
   637     using assms parallel_subspace_aux by auto
       
   638   show "A \<subseteq> B"
       
   639     using assms parallel_subspace_aux[of B A] affine_parallel_commut by auto
       
   640 qed
       
   641 
   536 
   642 lemma affine_parallel_subspace:
   537 lemma affine_parallel_subspace:
   643   assumes "affine S" "S \<noteq> {}"
   538   assumes "affine S" "S \<noteq> {}"
   644   shows "\<exists>!L. subspace L \<and> affine_parallel S L"
   539   shows "\<exists>!L. subspace L \<and> affine_parallel S L"
   645 proof -
   540   by (meson affine_parallel_assoc affine_parallel_commute assms equals0I parallel_subspace parallel_subspace_explicit)
   646   have ex: "\<exists>L. subspace L \<and> affine_parallel S L"
       
   647     using assms parallel_subspace_explicit by auto
       
   648   {
       
   649     fix L1 L2
       
   650     assume ass: "subspace L1 \<and> affine_parallel S L1" "subspace L2 \<and> affine_parallel S L2"
       
   651     then have "affine_parallel L1 L2"
       
   652       using affine_parallel_commut[of S L1] affine_parallel_assoc[of L1 S L2] by auto
       
   653     then have "L1 = L2"
       
   654       using ass parallel_subspace by auto
       
   655   }
       
   656   then show ?thesis using ex by auto
       
   657 qed
       
   658 
   541 
   659 
   542 
   660 subsection \<open>Affine Dependence\<close>
   543 subsection \<open>Affine Dependence\<close>
   661 
   544 
   662 text "Formalized by Lars Schewe."
   545 text "Formalized by Lars Schewe."
   663 
   546 
   664 definition\<^marker>\<open>tag important\<close> affine_dependent :: "'a::real_vector set \<Rightarrow> bool"
   547 definition\<^marker>\<open>tag important\<close> affine_dependent :: "'a::real_vector set \<Rightarrow> bool"
   665   where "affine_dependent s \<longleftrightarrow> (\<exists>x\<in>s. x \<in> affine hull (s - {x}))"
   548   where "affine_dependent S \<longleftrightarrow> (\<exists>x\<in>S. x \<in> affine hull (S - {x}))"
   666 
   549 
   667 lemma affine_dependent_imp_dependent: "affine_dependent s \<Longrightarrow> dependent s"
   550 lemma affine_dependent_imp_dependent: "affine_dependent S \<Longrightarrow> dependent S"
   668   unfolding affine_dependent_def dependent_def
   551   unfolding affine_dependent_def dependent_def
   669   using affine_hull_subset_span by auto
   552   using affine_hull_subset_span by auto
   670 
   553 
   671 lemma affine_dependent_subset:
   554 lemma affine_dependent_subset:
   672    "\<lbrakk>affine_dependent s; s \<subseteq> t\<rbrakk> \<Longrightarrow> affine_dependent t"
   555    "\<lbrakk>affine_dependent S; S \<subseteq> T\<rbrakk> \<Longrightarrow> affine_dependent T"
   673 apply (simp add: affine_dependent_def Bex_def)
   556   using hull_mono [OF Diff_mono [OF _ subset_refl]]
   674 apply (blast dest: hull_mono [OF Diff_mono [OF _ subset_refl]])
   557   by (smt (verit) affine_dependent_def subsetD)
   675 done
       
   676 
   558 
   677 lemma affine_independent_subset:
   559 lemma affine_independent_subset:
   678   shows "\<lbrakk>\<not> affine_dependent t; s \<subseteq> t\<rbrakk> \<Longrightarrow> \<not> affine_dependent s"
   560   shows "\<lbrakk>\<not> affine_dependent T; S \<subseteq> T\<rbrakk> \<Longrightarrow> \<not> affine_dependent S"
   679 by (metis affine_dependent_subset)
   561   by (metis affine_dependent_subset)
   680 
   562 
   681 lemma affine_independent_Diff:
   563 lemma affine_independent_Diff:
   682    "\<not> affine_dependent s \<Longrightarrow> \<not> affine_dependent(s - t)"
   564    "\<not> affine_dependent S \<Longrightarrow> \<not> affine_dependent(S - T)"
   683 by (meson Diff_subset affine_dependent_subset)
   565 by (meson Diff_subset affine_dependent_subset)
   684 
   566 
   685 proposition affine_dependent_explicit:
   567 proposition affine_dependent_explicit:
   686   "affine_dependent p \<longleftrightarrow>
   568   "affine_dependent p \<longleftrightarrow>
   687     (\<exists>S u. finite S \<and> S \<subseteq> p \<and> sum u S = 0 \<and> (\<exists>v\<in>S. u v \<noteq> 0) \<and> sum (\<lambda>v. u v *\<^sub>R v) S = 0)"
   569     (\<exists>S U. finite S \<and> S \<subseteq> p \<and> sum U S = 0 \<and> (\<exists>v\<in>S. U v \<noteq> 0) \<and> sum (\<lambda>v. U v *\<^sub>R v) S = 0)"
   688 proof -
   570 proof -
   689   have "\<exists>S u. finite S \<and> S \<subseteq> p \<and> sum u S = 0 \<and> (\<exists>v\<in>S. u v \<noteq> 0) \<and> (\<Sum>w\<in>S. u w *\<^sub>R w) = 0"
   571   have "\<exists>S U. finite S \<and> S \<subseteq> p \<and> sum U S = 0 \<and> (\<exists>v\<in>S. U v \<noteq> 0) \<and> (\<Sum>w\<in>S. U w *\<^sub>R w) = 0"
   690     if "(\<Sum>w\<in>S. u w *\<^sub>R w) = x" "x \<in> p" "finite S" "S \<noteq> {}" "S \<subseteq> p - {x}" "sum u S = 1" for x S u
   572     if "(\<Sum>w\<in>S. U w *\<^sub>R w) = x" "x \<in> p" "finite S" "S \<noteq> {}" "S \<subseteq> p - {x}" "sum U S = 1" for x S U
   691   proof (intro exI conjI)
   573   proof (intro exI conjI)
   692     have "x \<notin> S" 
   574     have "x \<notin> S" 
   693       using that by auto
   575       using that by auto
   694     then show "(\<Sum>v \<in> insert x S. if v = x then - 1 else u v) = 0"
   576     then show "(\<Sum>v \<in> insert x S. if v = x then - 1 else U v) = 0"
   695       using that by (simp add: sum_delta_notmem)
   577       using that by (simp add: sum_delta_notmem)
   696     show "(\<Sum>w \<in> insert x S. (if w = x then - 1 else u w) *\<^sub>R w) = 0"
   578     show "(\<Sum>w \<in> insert x S. (if w = x then - 1 else U w) *\<^sub>R w) = 0"
   697       using that \<open>x \<notin> S\<close> by (simp add: if_smult sum_delta_notmem cong: if_cong)
   579       using that \<open>x \<notin> S\<close> by (simp add: if_smult sum_delta_notmem cong: if_cong)
   698   qed (use that in auto)
   580   qed (use that in auto)
   699   moreover have "\<exists>x\<in>p. \<exists>S u. finite S \<and> S \<noteq> {} \<and> S \<subseteq> p - {x} \<and> sum u S = 1 \<and> (\<Sum>v\<in>S. u v *\<^sub>R v) = x"
   581   moreover have "\<exists>x\<in>p. \<exists>S U. finite S \<and> S \<noteq> {} \<and> S \<subseteq> p - {x} \<and> sum U S = 1 \<and> (\<Sum>v\<in>S. U v *\<^sub>R v) = x"
   700     if "(\<Sum>v\<in>S. u v *\<^sub>R v) = 0" "finite S" "S \<subseteq> p" "sum u S = 0" "v \<in> S" "u v \<noteq> 0" for S u v
   582     if "(\<Sum>v\<in>S. U v *\<^sub>R v) = 0" "finite S" "S \<subseteq> p" "sum U S = 0" "v \<in> S" "U v \<noteq> 0" for S U v
   701   proof (intro bexI exI conjI)
   583   proof (intro bexI exI conjI)
   702     have "S \<noteq> {v}"
   584     have "S \<noteq> {v}"
   703       using that by auto
   585       using that by auto
   704     then show "S - {v} \<noteq> {}"
   586     then show "S - {v} \<noteq> {}"
   705       using that by auto
   587       using that by auto
   706     show "(\<Sum>x \<in> S - {v}. - (1 / u v) * u x) = 1"
   588     show "(\<Sum>x \<in> S - {v}. - (1 / U v) * U x) = 1"
   707       unfolding sum_distrib_left[symmetric] sum_diff1[OF \<open>finite S\<close>] by (simp add: that)
   589       unfolding sum_distrib_left[symmetric] sum_diff1[OF \<open>finite S\<close>] by (simp add: that)
   708     show "(\<Sum>x\<in>S - {v}. (- (1 / u v) * u x) *\<^sub>R x) = v"
   590     show "(\<Sum>x\<in>S - {v}. (- (1 / U v) * U x) *\<^sub>R x) = v"
   709       unfolding sum_distrib_left [symmetric] scaleR_scaleR[symmetric]
   591       unfolding sum_distrib_left [symmetric] scaleR_scaleR[symmetric]
   710                 scaleR_right.sum [symmetric] sum_diff1[OF \<open>finite S\<close>] 
   592                 scaleR_right.sum [symmetric] sum_diff1[OF \<open>finite S\<close>] 
   711       using that by auto
   593       using that by auto
   712     show "S - {v} \<subseteq> p - {v}"
   594     show "S - {v} \<subseteq> p - {v}"
   713       using that by auto
   595       using that by auto
   718 
   600 
   719 lemma affine_dependent_explicit_finite:
   601 lemma affine_dependent_explicit_finite:
   720   fixes S :: "'a::real_vector set"
   602   fixes S :: "'a::real_vector set"
   721   assumes "finite S"
   603   assumes "finite S"
   722   shows "affine_dependent S \<longleftrightarrow>
   604   shows "affine_dependent S \<longleftrightarrow>
   723     (\<exists>u. sum u S = 0 \<and> (\<exists>v\<in>S. u v \<noteq> 0) \<and> sum (\<lambda>v. u v *\<^sub>R v) S = 0)"
   605     (\<exists>U. sum U S = 0 \<and> (\<exists>v\<in>S. U v \<noteq> 0) \<and> sum (\<lambda>v. U v *\<^sub>R v) S = 0)"
   724   (is "?lhs = ?rhs")
   606   (is "?lhs = ?rhs")
   725 proof
   607 proof
   726   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)"
   608   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)"
   727     by auto
   609     by auto
   728   assume ?lhs
   610   assume ?lhs
   729   then obtain t u v where
   611   then obtain T U v where
   730     "finite t" "t \<subseteq> S" "sum u t = 0" "v\<in>t" "u v \<noteq> 0"  "(\<Sum>v\<in>t. u v *\<^sub>R v) = 0"
   612     "finite T" "T \<subseteq> S" "sum U T = 0" "v\<in>T" "U v \<noteq> 0"  "(\<Sum>v\<in>T. U v *\<^sub>R v) = 0"
   731     unfolding affine_dependent_explicit by auto
   613     unfolding affine_dependent_explicit by auto
   732   then show ?rhs
   614   then show ?rhs
   733     apply (rule_tac x="\<lambda>x. if x\<in>t then u x else 0" in exI)
   615     apply (rule_tac x="\<lambda>x. if x\<in>T then U x else 0" in exI)
   734     apply (auto simp: * sum.inter_restrict[OF assms, symmetric] Int_absorb1[OF \<open>t\<subseteq>S\<close>])
   616     apply (auto simp: * sum.inter_restrict[OF assms, symmetric] Int_absorb1[OF \<open>T\<subseteq>S\<close>])
   735     done
   617     done
   736 next
   618 next
   737   assume ?rhs
   619   assume ?rhs
   738   then obtain u v where "sum u S = 0"  "v\<in>S" "u v \<noteq> 0" "(\<Sum>v\<in>S. u v *\<^sub>R v) = 0"
   620   then obtain U v where "sum U S = 0"  "v\<in>S" "U v \<noteq> 0" "(\<Sum>v\<in>S. U v *\<^sub>R v) = 0"
   739     by auto
   621     by auto
   740   then show ?lhs unfolding affine_dependent_explicit
   622   then show ?lhs unfolding affine_dependent_explicit
   741     using assms by auto
   623     using assms by auto
   742 qed
   624 qed
   743 
   625 
   744 lemma dependent_imp_affine_dependent:
   626 lemma dependent_imp_affine_dependent:
   745   assumes "dependent {x - a| x . x \<in> s}"
   627   assumes "dependent {x - a| x . x \<in> S}"
   746     and "a \<notin> s"
   628     and "a \<notin> S"
   747   shows "affine_dependent (insert a s)"
   629   shows "affine_dependent (insert a S)"
   748 proof -
   630 proof -
   749   from assms(1)[unfolded dependent_explicit] obtain S u v
   631   from assms(1)[unfolded dependent_explicit] obtain S' U v
   750     where obt: "finite S" "S \<subseteq> {x - a |x. x \<in> s}" "v\<in>S" "u v  \<noteq> 0" "(\<Sum>v\<in>S. u v *\<^sub>R v) = 0"
   632     where S: "finite S'" "S' \<subseteq> {x - a |x. x \<in> S}" "v\<in>S'" "U v  \<noteq> 0" "(\<Sum>v\<in>S'. U v *\<^sub>R v) = 0"
   751     by auto
   633     by auto
   752   define t where "t = (\<lambda>x. x + a) ` S"
   634   define T where "T = (\<lambda>x. x + a) ` S'"
   753 
   635   have inj: "inj_on (\<lambda>x. x + a) S'"
   754   have inj: "inj_on (\<lambda>x. x + a) S"
       
   755     unfolding inj_on_def by auto
   636     unfolding inj_on_def by auto
   756   have "0 \<notin> S"
   637   have "0 \<notin> S'"
   757     using obt(2) assms(2) unfolding subset_eq by auto
   638     using S(2) assms(2) unfolding subset_eq by auto
   758   have fin: "finite t" and "t \<subseteq> s"
   639   have fin: "finite T" and "T \<subseteq> S"
   759     unfolding t_def using obt(1,2) by auto
   640     unfolding T_def using S(1,2) by auto
   760   then have "finite (insert a t)" and "insert a t \<subseteq> insert a s"
   641   then have "finite (insert a T)" and "insert a T \<subseteq> insert a S"
   761     by auto
   642     by auto
   762   moreover have *: "\<And>P Q. (\<Sum>x\<in>t. (if x = a then P x else Q x)) = (\<Sum>x\<in>t. Q x)"
   643   moreover have *: "\<And>P Q. (\<Sum>x\<in>T. (if x = a then P x else Q x)) = (\<Sum>x\<in>T. Q x)"
   763     apply (rule sum.cong)
   644     by (smt (verit, best) \<open>T \<subseteq> S\<close> assms(2) subsetD sum.cong)
   764     using \<open>a\<notin>s\<close> \<open>t\<subseteq>s\<close>
   645   have "(\<Sum>x\<in>insert a T. if x = a then - (\<Sum>x\<in>T. U (x - a)) else U (x - a)) = 0"
   765     apply auto
   646     by (smt (verit) \<open>T \<subseteq> S\<close> assms(2) fin insert_absorb insert_subset sum.insert sum_mono)
   766     done
   647   moreover have "\<exists>v\<in>insert a T. (if v = a then - (\<Sum>x\<in>T. U (x - a)) else U (v - a)) \<noteq> 0"
   767   have "(\<Sum>x\<in>insert a t. if x = a then - (\<Sum>x\<in>t. u (x - a)) else u (x - a)) = 0"
   648     using S(3,4) \<open>0\<notin>S'\<close>
   768     unfolding sum_clauses(2)[OF fin] * using \<open>a\<notin>s\<close> \<open>t\<subseteq>s\<close> by auto
   649     by (rule_tac x="v + a" in bexI) (auto simp: T_def)
   769   moreover have "\<exists>v\<in>insert a t. (if v = a then - (\<Sum>x\<in>t. u (x - a)) else u (v - a)) \<noteq> 0"
   650   moreover have *: "\<And>P Q. (\<Sum>x\<in>T. (if x = a then P x else Q x) *\<^sub>R x) = (\<Sum>x\<in>T. Q x *\<^sub>R x)"
   770     using obt(3,4) \<open>0\<notin>S\<close>
   651     using \<open>a\<notin>S\<close> \<open>T\<subseteq>S\<close> by (auto intro!: sum.cong)
   771     by (rule_tac x="v + a" in bexI) (auto simp: t_def)
   652   have "(\<Sum>x\<in>T. U (x - a)) *\<^sub>R a = (\<Sum>v\<in>T. U (v - a) *\<^sub>R v)"
   772   moreover have *: "\<And>P Q. (\<Sum>x\<in>t. (if x = a then P x else Q x) *\<^sub>R x) = (\<Sum>x\<in>t. Q x *\<^sub>R x)"
       
   773     using \<open>a\<notin>s\<close> \<open>t\<subseteq>s\<close> by (auto intro!: sum.cong)
       
   774   have "(\<Sum>x\<in>t. u (x - a)) *\<^sub>R a = (\<Sum>v\<in>t. u (v - a) *\<^sub>R v)"
       
   775     unfolding scaleR_left.sum
   653     unfolding scaleR_left.sum
   776     unfolding t_def and sum.reindex[OF inj] and o_def
   654     unfolding T_def and sum.reindex[OF inj] and o_def
   777     using obt(5)
   655     using S(5)
   778     by (auto simp: sum.distrib scaleR_right_distrib)
   656     by (auto simp: sum.distrib scaleR_right_distrib)
   779   then have "(\<Sum>v\<in>insert a t. (if v = a then - (\<Sum>x\<in>t. u (x - a)) else u (v - a)) *\<^sub>R v) = 0"
   657   then have "(\<Sum>v\<in>insert a T. (if v = a then - (\<Sum>x\<in>T. U (x - a)) else U (v - a)) *\<^sub>R v) = 0"
   780     unfolding sum_clauses(2)[OF fin]
   658     unfolding sum_clauses(2)[OF fin] using \<open>a\<notin>S\<close> \<open>T\<subseteq>S\<close> by (auto simp: *)
   781     using \<open>a\<notin>s\<close> \<open>t\<subseteq>s\<close>
       
   782     by (auto simp: *)
       
   783   ultimately show ?thesis
   659   ultimately show ?thesis
   784     unfolding affine_dependent_explicit
   660     unfolding affine_dependent_explicit
   785     apply (rule_tac x="insert a t" in exI, auto)
   661     by (force intro!: exI[where x="insert a T"])
   786     done
       
   787 qed
   662 qed
   788 
   663 
   789 lemma affine_dependent_biggerset:
   664 lemma affine_dependent_biggerset:
   790   fixes s :: "'a::euclidean_space set"
   665   fixes S :: "'a::euclidean_space set"
   791   assumes "finite s" "card s \<ge> DIM('a) + 2"
   666   assumes "finite S" "card S \<ge> DIM('a) + 2"
   792   shows "affine_dependent s"
   667   shows "affine_dependent S"
   793 proof -
   668 proof -
   794   have "s \<noteq> {}" using assms by auto
   669   have "S \<noteq> {}" using assms by auto
   795   then obtain a where "a\<in>s" by auto
   670   then obtain a where "a\<in>S" by auto
   796   have *: "{x - a |x. x \<in> s - {a}} = (\<lambda>x. x - a) ` (s - {a})"
   671   have *: "{x - a |x. x \<in> S - {a}} = (\<lambda>x. x - a) ` (S - {a})"
   797     by auto
   672     by auto
   798   have "card {x - a |x. x \<in> s - {a}} = card (s - {a})"
   673   have "card {x - a |x. x \<in> S - {a}} = card (S - {a})"
   799     unfolding * by (simp add: card_image inj_on_def)
   674     unfolding * by (simp add: card_image inj_on_def)
   800   also have "\<dots> > DIM('a)" using assms(2)
   675   also have "\<dots> > DIM('a)" using assms(2)
   801     unfolding card_Diff_singleton[OF \<open>a\<in>s\<close>] by auto
   676     unfolding card_Diff_singleton[OF \<open>a\<in>S\<close>] by auto
   802   finally show ?thesis
   677   finally  have "affine_dependent (insert a (S - {a}))"
   803     apply (subst insert_Diff[OF \<open>a\<in>s\<close>, symmetric])
   678     using dependent_biggerset dependent_imp_affine_dependent by blast
   804     apply (rule dependent_imp_affine_dependent)
   679   then show ?thesis
   805     apply (rule dependent_biggerset, auto)
   680     by (simp add: \<open>a \<in> S\<close> insert_absorb)
   806     done
       
   807 qed
   681 qed
   808 
   682 
   809 lemma affine_dependent_biggerset_general:
   683 lemma affine_dependent_biggerset_general:
   810   assumes "finite (S :: 'a::euclidean_space set)"
   684   assumes "finite (S :: 'a::euclidean_space set)"
   811     and "card S \<ge> dim S + 2"
   685     and "card S \<ge> dim S + 2"
   820   have "dim {x - a |x. x \<in> S - {a}} \<le> dim S"
   694   have "dim {x - a |x. x \<in> S - {a}} \<le> dim S"
   821     using \<open>a\<in>S\<close> by (auto simp: span_base span_diff intro: subset_le_dim)
   695     using \<open>a\<in>S\<close> by (auto simp: span_base span_diff intro: subset_le_dim)
   822   also have "\<dots> < dim S + 1" by auto
   696   also have "\<dots> < dim S + 1" by auto
   823   also have "\<dots> \<le> card (S - {a})"
   697   also have "\<dots> \<le> card (S - {a})"
   824     using assms card_Diff_singleton[OF \<open>a\<in>S\<close>] by auto
   698     using assms card_Diff_singleton[OF \<open>a\<in>S\<close>] by auto
   825   finally show ?thesis
   699   finally have "affine_dependent (insert a (S - {a}))"
   826     apply (subst insert_Diff[OF \<open>a\<in>S\<close>, symmetric])
   700     by (smt (verit) Collect_cong dependent_imp_affine_dependent dependent_biggerset_general ** Diff_iff insertCI)
   827     apply (rule dependent_imp_affine_dependent)
   701   then show ?thesis
   828     apply (rule dependent_biggerset_general)
   702     by (simp add: \<open>a \<in> S\<close> insert_absorb)
   829     unfolding **
       
   830     apply auto
       
   831     done
       
   832 qed
   703 qed
   833 
   704 
   834 
   705 
   835 subsection\<^marker>\<open>tag unimportant\<close> \<open>Some Properties of Affine Dependent Sets\<close>
   706 subsection\<^marker>\<open>tag unimportant\<close> \<open>Some Properties of Affine Dependent Sets\<close>
   836 
   707 
   880     unfolding affine_dependent_def by auto
   751     unfolding affine_dependent_def by auto
   881 qed
   752 qed
   882 
   753 
   883 lemma affine_dependent_translation_eq:
   754 lemma affine_dependent_translation_eq:
   884   "affine_dependent S \<longleftrightarrow> affine_dependent ((\<lambda>x. a + x) ` S)"
   755   "affine_dependent S \<longleftrightarrow> affine_dependent ((\<lambda>x. a + x) ` S)"
   885 proof -
   756   by (metis affine_dependent_translation translation_galois)
   886   {
       
   887     assume "affine_dependent ((\<lambda>x. a + x) ` S)"
       
   888     then have "affine_dependent S"
       
   889       using affine_dependent_translation[of "((\<lambda>x. a + x) ` S)" "-a"] translation_assoc[of "-a" a]
       
   890       by auto
       
   891   }
       
   892   then show ?thesis
       
   893     using affine_dependent_translation by auto
       
   894 qed
       
   895 
   757 
   896 lemma affine_hull_0_dependent:
   758 lemma affine_hull_0_dependent:
   897   assumes "0 \<in> affine hull S"
   759   assumes "0 \<in> affine hull S"
   898   shows "dependent S"
   760   shows "dependent S"
   899 proof -
   761 proof -
   917   moreover have "span (insert 0 S - {x}) = span (S - {x})"
   779   moreover have "span (insert 0 S - {x}) = span (S - {x})"
   918     using insert_Diff_if[of "0" S "{x}"] span_insert_0[of "S-{x}"] by auto
   780     using insert_Diff_if[of "0" S "{x}"] span_insert_0[of "S-{x}"] by auto
   919   ultimately have "x \<in> span (S - {x})" by auto
   781   ultimately have "x \<in> span (S - {x})" by auto
   920   then have "x \<noteq> 0 \<Longrightarrow> dependent S"
   782   then have "x \<noteq> 0 \<Longrightarrow> dependent S"
   921     using x dependent_def by auto
   783     using x dependent_def by auto
   922   moreover
   784   moreover have "dependent S" if "x = 0"
   923   {
   785     by (metis that affine_hull_0_dependent Diff_insert_absorb dependent_zero x)
   924     assume "x = 0"
       
   925     then have "0 \<in> affine hull S"
       
   926       using x hull_mono[of "S - {0}" S] by auto
       
   927     then have "dependent S"
       
   928       using affine_hull_0_dependent by auto
       
   929   }
       
   930   ultimately show ?thesis by auto
   786   ultimately show ?thesis by auto
   931 qed
   787 qed
   932 
   788 
   933 lemma affine_dependent_iff_dependent:
   789 lemma affine_dependent_iff_dependent:
   934   assumes "a \<notin> S"
   790   assumes "a \<notin> S"
   943 qed
   799 qed
   944 
   800 
   945 lemma affine_dependent_iff_dependent2:
   801 lemma affine_dependent_iff_dependent2:
   946   assumes "a \<in> S"
   802   assumes "a \<in> S"
   947   shows "affine_dependent S \<longleftrightarrow> dependent ((\<lambda>x. -a + x) ` (S-{a}))"
   803   shows "affine_dependent S \<longleftrightarrow> dependent ((\<lambda>x. -a + x) ` (S-{a}))"
   948 proof -
   804   by (metis Diff_iff affine_dependent_iff_dependent assms insert_Diff singletonI)
   949   have "insert a (S - {a}) = S"
       
   950     using assms by auto
       
   951   then show ?thesis
       
   952     using assms affine_dependent_iff_dependent[of a "S-{a}"] by auto
       
   953 qed
       
   954 
   805 
   955 lemma affine_hull_insert_span_gen:
   806 lemma affine_hull_insert_span_gen:
   956   "affine hull (insert a s) = (\<lambda>x. a + x) ` span ((\<lambda>x. - a + x) ` s)"
   807   "affine hull (insert a S) = (\<lambda>x. a + x) ` span ((\<lambda>x. - a + x) ` S)"
   957 proof -
   808 proof -
   958   have h1: "{x - a |x. x \<in> s} = ((\<lambda>x. -a+x) ` s)"
   809   have h1: "{x - a |x. x \<in> S} = ((\<lambda>x. -a+x) ` S)"
   959     by auto
   810     by auto
   960   {
   811   {
   961     assume "a \<notin> s"
   812     assume "a \<notin> S"
   962     then have ?thesis
   813     then have ?thesis
   963       using affine_hull_insert_span[of a s] h1 by auto
   814       using affine_hull_insert_span[of a S] h1 by auto
   964   }
   815   }
   965   moreover
   816   moreover
   966   {
   817   {
   967     assume a1: "a \<in> s"
   818     assume a1: "a \<in> S"
   968     have "\<exists>x. x \<in> s \<and> -a+x=0"
   819     then have "insert 0 ((\<lambda>x. -a+x) ` (S - {a})) = (\<lambda>x. -a+x) ` S"
   969       apply (rule exI[of _ a])
       
   970       using a1
       
   971       apply auto
       
   972       done
       
   973     then have "insert 0 ((\<lambda>x. -a+x) ` (s - {a})) = (\<lambda>x. -a+x) ` s"
       
   974       by auto
   820       by auto
   975     then have "span ((\<lambda>x. -a+x) ` (s - {a}))=span ((\<lambda>x. -a+x) ` s)"
   821     then have "span ((\<lambda>x. -a+x) ` (S - {a})) = span ((\<lambda>x. -a+x) ` S)"
   976       using span_insert_0[of "(+) (- a) ` (s - {a})"] by (auto simp del: uminus_add_conv_diff)
   822       using span_insert_0[of "(+) (- a) ` (S - {a})"]
   977     moreover have "{x - a |x. x \<in> (s - {a})} = ((\<lambda>x. -a+x) ` (s - {a}))"
   823       by presburger
       
   824     moreover have "{x - a |x. x \<in> (S - {a})} = ((\<lambda>x. -a+x) ` (S - {a}))"
   978       by auto
   825       by auto
   979     moreover have "insert a (s - {a}) = insert a s"
   826     moreover have "insert a (S - {a}) = insert a S"
   980       by auto
   827       by auto
   981     ultimately have ?thesis
   828     ultimately have ?thesis
   982       using affine_hull_insert_span[of "a" "s-{a}"] by auto
   829       using affine_hull_insert_span[of "a" "S-{a}"] by auto
   983   }
   830   }
   984   ultimately show ?thesis by auto
   831   ultimately show ?thesis by auto
   985 qed
   832 qed
   986 
   833 
   987 lemma affine_hull_span2:
   834 lemma affine_hull_span2:
   988   assumes "a \<in> s"
   835   assumes "a \<in> S"
   989   shows "affine hull s = (\<lambda>x. a+x) ` span ((\<lambda>x. -a+x) ` (s-{a}))"
   836   shows "affine hull S = (\<lambda>x. a+x) ` span ((\<lambda>x. -a+x) ` (S-{a}))"
   990   using affine_hull_insert_span_gen[of a "s - {a}", unfolded insert_Diff[OF assms]]
   837   by (metis affine_hull_insert_span_gen assms insert_Diff)
   991   by auto
       
   992 
   838 
   993 lemma affine_hull_span_gen:
   839 lemma affine_hull_span_gen:
   994   assumes "a \<in> affine hull s"
   840   assumes "a \<in> affine hull S"
   995   shows "affine hull s = (\<lambda>x. a+x) ` span ((\<lambda>x. -a+x) ` s)"
   841   shows "affine hull S = (\<lambda>x. a+x) ` span ((\<lambda>x. -a+x) ` S)"
   996 proof -
   842   by (metis affine_hull_insert_span_gen assms hull_redundant)
   997   have "affine hull (insert a s) = affine hull s"
       
   998     using hull_redundant[of a affine s] assms by auto
       
   999   then show ?thesis
       
  1000     using affine_hull_insert_span_gen[of a "s"] by auto
       
  1001 qed
       
  1002 
   843 
  1003 lemma affine_hull_span_0:
   844 lemma affine_hull_span_0:
  1004   assumes "0 \<in> affine hull S"
   845   assumes "0 \<in> affine hull S"
  1005   shows "affine hull S = span S"
   846   shows "affine hull S = span S"
  1006   using affine_hull_span_gen[of "0" S] assms by auto
   847   using affine_hull_span_gen[of "0" S] assms by auto
  1042 qed
   883 qed
  1043 
   884 
  1044 lemma affine_basis_exists:
   885 lemma affine_basis_exists:
  1045   fixes V :: "'n::real_vector set"
   886   fixes V :: "'n::real_vector set"
  1046   shows "\<exists>B. B \<subseteq> V \<and> \<not> affine_dependent B \<and> affine hull V = affine hull B"
   887   shows "\<exists>B. B \<subseteq> V \<and> \<not> affine_dependent B \<and> affine hull V = affine hull B"
  1047 proof (cases "V = {}")
   888   by (metis affine_dependent_def affine_independent_1 empty_subsetI extend_to_affine_basis_nonempty insert_subset order_refl)
  1048   case True
       
  1049   then show ?thesis
       
  1050     using affine_independent_0 by auto
       
  1051 next
       
  1052   case False
       
  1053   then obtain x where "x \<in> V" by auto
       
  1054   then show ?thesis
       
  1055     using affine_dependent_def[of "{x}"] extend_to_affine_basis_nonempty[of "{x}" V]
       
  1056     by auto
       
  1057 qed
       
  1058 
   889 
  1059 proposition extend_to_affine_basis:
   890 proposition extend_to_affine_basis:
  1060   fixes S V :: "'n::real_vector set"
   891   fixes S V :: "'n::real_vector set"
  1061   assumes "\<not> affine_dependent S" "S \<subseteq> V"
   892   assumes "\<not> affine_dependent S" "S \<subseteq> V"
  1062   obtains T where "\<not> affine_dependent T" "S \<subseteq> T" "T \<subseteq> V" "affine hull T = affine hull V"
   893   obtains T where "\<not> affine_dependent T" "S \<subseteq> T" "T \<subseteq> V" "affine hull T = affine hull V"
  1063 proof (cases "S = {}")
   894   by (metis affine_basis_exists assms(1) assms(2) bot.extremum extend_to_affine_basis_nonempty)
  1064   case True then show ?thesis
       
  1065     using affine_basis_exists by (metis empty_subsetI that)
       
  1066 next
       
  1067   case False
       
  1068   then show ?thesis by (metis assms extend_to_affine_basis_nonempty that)
       
  1069 qed
       
  1070 
   895 
  1071 
   896 
  1072 subsection \<open>Affine Dimension of a Set\<close>
   897 subsection \<open>Affine Dimension of a Set\<close>
  1073 
   898 
  1074 definition\<^marker>\<open>tag important\<close> aff_dim :: "('a::euclidean_space) set \<Rightarrow> int"
   899 definition\<^marker>\<open>tag important\<close> aff_dim :: "('a::euclidean_space) set \<Rightarrow> int"
  1093 
   918 
  1094 lemma affine_hull_eq_empty [simp]: "affine hull S = {} \<longleftrightarrow> S = {}"
   919 lemma affine_hull_eq_empty [simp]: "affine hull S = {} \<longleftrightarrow> S = {}"
  1095 by (metis affine_empty subset_empty subset_hull)
   920 by (metis affine_empty subset_empty subset_hull)
  1096 
   921 
  1097 lemma empty_eq_affine_hull[simp]: "{} = affine hull S \<longleftrightarrow> S = {}"
   922 lemma empty_eq_affine_hull[simp]: "{} = affine hull S \<longleftrightarrow> S = {}"
  1098 by (metis affine_hull_eq_empty)
   923   by (metis affine_hull_eq_empty)
  1099 
   924 
  1100 lemma aff_dim_parallel_subspace_aux:
   925 lemma aff_dim_parallel_subspace_aux:
  1101   fixes B :: "'n::euclidean_space set"
   926   fixes B :: "'n::euclidean_space set"
  1102   assumes "\<not> affine_dependent B" "a \<in> B"
   927   assumes "\<not> affine_dependent B" "a \<in> B"
  1103   shows "finite B \<and> ((card B) - 1 = dim (span ((\<lambda>x. -a+x) ` (B-{a}))))"
   928   shows "finite B \<and> ((card B) - 1 = dim (span ((\<lambda>x. -a+x) ` (B-{a}))))"
  1144     by auto
   969     by auto
  1145   then obtain a where a: "a \<in> B" by auto
   970   then obtain a where a: "a \<in> B" by auto
  1146   define Lb where "Lb = span ((\<lambda>x. -a+x) ` (B-{a}))"
   971   define Lb where "Lb = span ((\<lambda>x. -a+x) ` (B-{a}))"
  1147   moreover have "affine_parallel (affine hull B) Lb"
   972   moreover have "affine_parallel (affine hull B) Lb"
  1148     using Lb_def B assms affine_hull_span2[of a B] a
   973     using Lb_def B assms affine_hull_span2[of a B] a
  1149       affine_parallel_commut[of "Lb" "(affine hull B)"]
   974       affine_parallel_commute[of "Lb" "(affine hull B)"]
  1150     unfolding affine_parallel_def
   975     unfolding affine_parallel_def
  1151     by auto
   976     by auto
  1152   moreover have "subspace Lb"
   977   moreover have "subspace Lb"
  1153     using Lb_def subspace_span by auto
   978     using Lb_def subspace_span by auto
  1154   moreover have "affine hull B \<noteq> {}"
   979   moreover have "affine hull B \<noteq> {}"
  1166 
   991 
  1167 lemma aff_independent_finite:
   992 lemma aff_independent_finite:
  1168   fixes B :: "'n::euclidean_space set"
   993   fixes B :: "'n::euclidean_space set"
  1169   assumes "\<not> affine_dependent B"
   994   assumes "\<not> affine_dependent B"
  1170   shows "finite B"
   995   shows "finite B"
  1171 proof -
   996   using aff_dim_parallel_subspace_aux assms finite.simps by fastforce
  1172   {
       
  1173     assume "B \<noteq> {}"
       
  1174     then obtain a where "a \<in> B" by auto
       
  1175     then have ?thesis
       
  1176       using aff_dim_parallel_subspace_aux assms by auto
       
  1177   }
       
  1178   then show ?thesis by auto
       
  1179 qed
       
  1180 
   997 
  1181 
   998 
  1182 lemma aff_dim_empty:
   999 lemma aff_dim_empty:
  1183   fixes S :: "'n::euclidean_space set"
  1000   fixes S :: "'n::euclidean_space set"
  1184   shows "S = {} \<longleftrightarrow> aff_dim S = -1"
  1001   shows "S = {} \<longleftrightarrow> aff_dim S = -1"
  1193   ultimately show ?thesis
  1010   ultimately show ?thesis
  1194     using aff_independent_finite[of B] card_gt_0_iff[of B] by auto
  1011     using aff_independent_finite[of B] card_gt_0_iff[of B] by auto
  1195 qed
  1012 qed
  1196 
  1013 
  1197 lemma aff_dim_empty_eq [simp]: "aff_dim ({}::'a::euclidean_space set) = -1"
  1014 lemma aff_dim_empty_eq [simp]: "aff_dim ({}::'a::euclidean_space set) = -1"
  1198   by (simp add: aff_dim_empty [symmetric])
  1015   using aff_dim_empty by blast
  1199 
  1016 
  1200 lemma aff_dim_affine_hull [simp]: "aff_dim (affine hull S) = aff_dim S"
  1017 lemma aff_dim_affine_hull [simp]: "aff_dim (affine hull S) = aff_dim S"
  1201   unfolding aff_dim_def using hull_hull[of _ S] by auto
  1018   unfolding aff_dim_def using hull_hull[of _ S] by auto
  1202 
  1019 
  1203 lemma aff_dim_affine_hull2:
  1020 lemma aff_dim_affine_hull2:
  1222   case False
  1039   case False
  1223   then obtain a where a: "a \<in> B" by auto
  1040   then obtain a where a: "a \<in> B" by auto
  1224   define Lb where "Lb = span ((\<lambda>x. -a+x) ` (B-{a}))"
  1041   define Lb where "Lb = span ((\<lambda>x. -a+x) ` (B-{a}))"
  1225   have "affine_parallel (affine hull B) Lb"
  1042   have "affine_parallel (affine hull B) Lb"
  1226     using Lb_def affine_hull_span2[of a B] a
  1043     using Lb_def affine_hull_span2[of a B] a
  1227       affine_parallel_commut[of "Lb" "(affine hull B)"]
  1044       affine_parallel_commute[of "Lb" "(affine hull B)"]
  1228     unfolding affine_parallel_def by auto
  1045     unfolding affine_parallel_def by auto
  1229   moreover have "subspace Lb"
  1046   moreover have "subspace Lb"
  1230     using Lb_def subspace_span by auto
  1047     using Lb_def subspace_span by auto
  1231   ultimately have "aff_dim B = int(dim Lb)"
  1048   ultimately have "aff_dim B = int(dim Lb)"
  1232     using aff_dim_parallel_subspace[of B Lb] \<open>B \<noteq> {}\<close> by auto
  1049     using aff_dim_parallel_subspace[of B Lb] \<open>B \<noteq> {}\<close> by auto
  1243   assumes "\<not> affine_dependent B"
  1060   assumes "\<not> affine_dependent B"
  1244   shows "of_nat (card B) = aff_dim B + 1"
  1061   shows "of_nat (card B) = aff_dim B + 1"
  1245   using aff_dim_unique[of B B] assms by auto
  1062   using aff_dim_unique[of B B] assms by auto
  1246 
  1063 
  1247 lemma affine_independent_iff_card:
  1064 lemma affine_independent_iff_card:
  1248     fixes s :: "'a::euclidean_space set"
  1065     fixes S :: "'a::euclidean_space set"
  1249     shows "\<not> affine_dependent s \<longleftrightarrow> finite s \<and> aff_dim s = int(card s) - 1"
  1066     shows "\<not> affine_dependent S \<longleftrightarrow> finite S \<and> aff_dim S = int(card S) - 1" (is "?lhs = ?rhs")
  1250   apply (rule iffI)
  1067 proof
  1251   apply (simp add: aff_dim_affine_independent aff_independent_finite)
  1068   show "?lhs \<Longrightarrow> ?rhs" 
  1252   by (metis affine_basis_exists [of s] aff_dim_unique card_subset_eq diff_add_cancel of_nat_eq_iff)
  1069     by (simp add: aff_dim_affine_independent aff_independent_finite)
       
  1070   show "?rhs \<Longrightarrow> ?lhs" 
       
  1071     by (metis of_nat_eq_iff affine_basis_exists aff_dim_unique card_subset_eq diff_add_cancel)
       
  1072 qed
  1253 
  1073 
  1254 lemma aff_dim_sing [simp]:
  1074 lemma aff_dim_sing [simp]:
  1255   fixes a :: "'n::euclidean_space"
  1075   fixes a :: "'n::euclidean_space"
  1256   shows "aff_dim {a} = 0"
  1076   shows "aff_dim {a} = 0"
  1257   using aff_dim_affine_independent[of "{a}"] affine_independent_1 by auto
  1077   using aff_dim_affine_independent[of "{a}"] affine_independent_1 by auto
  1270 
  1090 
  1271 lemma aff_dim_inner_basis_exists:
  1091 lemma aff_dim_inner_basis_exists:
  1272   fixes V :: "('n::euclidean_space) set"
  1092   fixes V :: "('n::euclidean_space) set"
  1273   shows "\<exists>B. B \<subseteq> V \<and> affine hull B = affine hull V \<and>
  1093   shows "\<exists>B. B \<subseteq> V \<and> affine hull B = affine hull V \<and>
  1274     \<not> affine_dependent B \<and> of_nat (card B) = aff_dim V + 1"
  1094     \<not> affine_dependent B \<and> of_nat (card B) = aff_dim V + 1"
  1275 proof -
  1095   by (metis aff_dim_unique affine_basis_exists)
  1276   obtain B where B: "\<not> affine_dependent B" "B \<subseteq> V" "affine hull B = affine hull V"
       
  1277     using affine_basis_exists[of V] by auto
       
  1278   then have "of_nat(card B) = aff_dim V+1" using aff_dim_unique by auto
       
  1279   with B show ?thesis by auto
       
  1280 qed
       
  1281 
  1096 
  1282 lemma aff_dim_le_card:
  1097 lemma aff_dim_le_card:
  1283   fixes V :: "'n::euclidean_space set"
  1098   fixes V :: "'n::euclidean_space set"
  1284   assumes "finite V"
  1099   assumes "finite V"
  1285   shows "aff_dim V \<le> of_nat (card V) - 1"
  1100   shows "aff_dim V \<le> of_nat (card V) - 1"
  1286 proof -
  1101   by (metis aff_dim_inner_basis_exists assms card_mono le_diff_eq of_nat_le_iff)
  1287   obtain B where B: "B \<subseteq> V" "of_nat (card B) = aff_dim V + 1"
  1102 
  1288     using aff_dim_inner_basis_exists[of V] by auto
  1103 lemma aff_dim_parallel_le:
  1289   then have "card B \<le> card V"
  1104   fixes S T :: "'n::euclidean_space set"
  1290     using assms card_mono by auto
  1105   assumes "affine_parallel (affine hull S) (affine hull T)"
  1291   with B show ?thesis by auto
  1106   shows "aff_dim S \<le> aff_dim T"
       
  1107 proof (cases "S={} \<or> T={}")
       
  1108   case True
       
  1109   then show ?thesis
       
  1110     by (smt (verit, best) aff_dim_affine_hull2 affine_hull_empty affine_parallel_def assms empty_is_image)
       
  1111 next
       
  1112   case False
       
  1113     then obtain L where L: "subspace L" "affine_parallel (affine hull T) L"
       
  1114       by (metis affine_affine_hull affine_hull_eq_empty affine_parallel_subspace)
       
  1115     with False show ?thesis
       
  1116       by (metis aff_dim_parallel_subspace affine_parallel_assoc assms dual_order.refl)
  1292 qed
  1117 qed
  1293 
  1118 
  1294 lemma aff_dim_parallel_eq:
  1119 lemma aff_dim_parallel_eq:
  1295   fixes S T :: "'n::euclidean_space set"
  1120   fixes S T :: "'n::euclidean_space set"
  1296   assumes "affine_parallel (affine hull S) (affine hull T)"
  1121   assumes "affine_parallel (affine hull S) (affine hull T)"
  1297   shows "aff_dim S = aff_dim T"
  1122   shows "aff_dim S = aff_dim T"
  1298 proof -
  1123   by (smt (verit, del_insts) aff_dim_parallel_le affine_parallel_commute assms)
  1299   {
       
  1300     assume "T \<noteq> {}" "S \<noteq> {}"
       
  1301     then obtain L where L: "subspace L \<and> affine_parallel (affine hull T) L"
       
  1302       using affine_parallel_subspace[of "affine hull T"]
       
  1303         affine_affine_hull[of T]
       
  1304       by auto
       
  1305     then have "aff_dim T = int (dim L)"
       
  1306       using aff_dim_parallel_subspace \<open>T \<noteq> {}\<close> by auto
       
  1307     moreover have *: "subspace L \<and> affine_parallel (affine hull S) L"
       
  1308        using L affine_parallel_assoc[of "affine hull S" "affine hull T" L] assms by auto
       
  1309     moreover from * have "aff_dim S = int (dim L)"
       
  1310       using aff_dim_parallel_subspace \<open>S \<noteq> {}\<close> by auto
       
  1311     ultimately have ?thesis by auto
       
  1312   }
       
  1313   moreover
       
  1314   {
       
  1315     assume "S = {}"
       
  1316     then have "S = {}" and "T = {}"
       
  1317       using assms
       
  1318       unfolding affine_parallel_def
       
  1319       by auto
       
  1320     then have ?thesis using aff_dim_empty by auto
       
  1321   }
       
  1322   moreover
       
  1323   {
       
  1324     assume "T = {}"
       
  1325     then have "S = {}" and "T = {}"
       
  1326       using assms
       
  1327       unfolding affine_parallel_def
       
  1328       by auto
       
  1329     then have ?thesis
       
  1330       using aff_dim_empty by auto
       
  1331   }
       
  1332   ultimately show ?thesis by blast
       
  1333 qed
       
  1334 
  1124 
  1335 lemma aff_dim_translation_eq:
  1125 lemma aff_dim_translation_eq:
  1336   "aff_dim ((+) a ` S) = aff_dim S" for a :: "'n::euclidean_space"
  1126   "aff_dim ((+) a ` S) = aff_dim S" for a :: "'n::euclidean_space"
  1337 proof -
  1127   by (metis aff_dim_parallel_eq affine_hull_translation affine_parallel_def)
  1338   have "affine_parallel (affine hull S) (affine hull ((\<lambda>x. a + x) ` S))"
       
  1339     unfolding affine_parallel_def
       
  1340     apply (rule exI[of _ "a"])
       
  1341     using affine_hull_translation[of a S]
       
  1342     apply auto
       
  1343     done
       
  1344   then show ?thesis
       
  1345     using aff_dim_parallel_eq[of S "(\<lambda>x. a + x) ` S"] by auto
       
  1346 qed
       
  1347 
  1128 
  1348 lemma aff_dim_translation_eq_subtract:
  1129 lemma aff_dim_translation_eq_subtract:
  1349   "aff_dim ((\<lambda>x. x - a) ` S) = aff_dim S" for a :: "'n::euclidean_space"
  1130   "aff_dim ((\<lambda>x. x - a) ` S) = aff_dim S" for a :: "'n::euclidean_space"
  1350   using aff_dim_translation_eq [of "- a"] by (simp cong: image_cong_simp)
  1131   using aff_dim_translation_eq [of "- a"] by (simp cong: image_cong_simp)
  1351 
  1132 
  1352 lemma aff_dim_affine:
  1133 lemma aff_dim_affine:
  1353   fixes S L :: "'n::euclidean_space set"
  1134   fixes S L :: "'n::euclidean_space set"
  1354   assumes "S \<noteq> {}"
  1135   assumes "affine S" "subspace L" "affine_parallel S L" "S \<noteq> {}"
  1355     and "affine S"
       
  1356     and "subspace L"
       
  1357     and "affine_parallel S L"
       
  1358   shows "aff_dim S = int (dim L)"
  1136   shows "aff_dim S = int (dim L)"
  1359 proof -
  1137   by (simp add: aff_dim_parallel_subspace assms hull_same)
  1360   have *: "affine hull S = S"
  1138 
  1361     using assms affine_hull_eq[of S] by auto
  1139 lemma dim_affine_hull [simp]:
  1362   then have "affine_parallel (affine hull S) L"
       
  1363     using assms by (simp add: *)
       
  1364   then show ?thesis
       
  1365     using assms aff_dim_parallel_subspace[of S L] by blast
       
  1366 qed
       
  1367 
       
  1368 lemma dim_affine_hull:
       
  1369   fixes S :: "'n::euclidean_space set"
  1140   fixes S :: "'n::euclidean_space set"
  1370   shows "dim (affine hull S) = dim S"
  1141   shows "dim (affine hull S) = dim S"
  1371 proof -
  1142   by (metis affine_hull_subset_span dim_eq_span dim_mono hull_subset span_eq_dim)
  1372   have "dim (affine hull S) \<ge> dim S"
       
  1373     using dim_subset by auto
       
  1374   moreover have "dim (span S) \<ge> dim (affine hull S)"
       
  1375     using dim_subset affine_hull_subset_span by blast
       
  1376   moreover have "dim (span S) = dim S"
       
  1377     using dim_span by auto
       
  1378   ultimately show ?thesis by auto
       
  1379 qed
       
  1380 
  1143 
  1381 lemma aff_dim_subspace:
  1144 lemma aff_dim_subspace:
  1382   fixes S :: "'n::euclidean_space set"
  1145   fixes S :: "'n::euclidean_space set"
  1383   assumes "subspace S"
  1146   assumes "subspace S"
  1384   shows "aff_dim S = int (dim S)"
  1147   shows "aff_dim S = int (dim S)"
  1385 proof (cases "S={}")
  1148   by (metis aff_dim_affine affine_parallel_subspace assms empty_iff parallel_subspace subspace_affine)
  1386   case True with assms show ?thesis
       
  1387     by (simp add: subspace_affine)
       
  1388 next
       
  1389   case False
       
  1390   with aff_dim_affine[of S S] assms subspace_imp_affine[of S] affine_parallel_reflex[of S] subspace_affine
       
  1391   show ?thesis by auto
       
  1392 qed
       
  1393 
  1149 
  1394 lemma aff_dim_zero:
  1150 lemma aff_dim_zero:
  1395   fixes S :: "'n::euclidean_space set"
  1151   fixes S :: "'n::euclidean_space set"
  1396   assumes "0 \<in> affine hull S"
  1152   assumes "0 \<in> affine hull S"
  1397   shows "aff_dim S = int (dim S)"
  1153   shows "aff_dim S = int (dim S)"
  1398 proof -
  1154   by (metis aff_dim_affine_hull aff_dim_subspace affine_hull_span_0 assms dim_span subspace_span)
  1399   have "subspace (affine hull S)"
       
  1400     using subspace_affine[of "affine hull S"] affine_affine_hull assms
       
  1401     by auto
       
  1402   then have "aff_dim (affine hull S) = int (dim (affine hull S))"
       
  1403     using assms aff_dim_subspace[of "affine hull S"] by auto
       
  1404   then show ?thesis
       
  1405     using aff_dim_affine_hull[of S] dim_affine_hull[of S]
       
  1406     by auto
       
  1407 qed
       
  1408 
  1155 
  1409 lemma aff_dim_eq_dim:
  1156 lemma aff_dim_eq_dim:
  1410   "aff_dim S = int (dim ((+) (- a) ` S))" if "a \<in> affine hull S"
  1157   fixes S :: "'n::euclidean_space set"
  1411     for S :: "'n::euclidean_space set"
  1158   assumes "a \<in> affine hull S"
  1412 proof -
  1159   shows "aff_dim S = int (dim ((+) (- a) ` S))" 
  1413   have "0 \<in> affine hull (+) (- a) ` S"
  1160   by (metis ab_left_minus aff_dim_translation_eq aff_dim_zero affine_hull_translation image_eqI assms)
  1414     unfolding affine_hull_translation
       
  1415     using that by (simp add: ac_simps)
       
  1416   with aff_dim_zero show ?thesis
       
  1417     by (metis aff_dim_translation_eq)
       
  1418 qed
       
  1419 
  1161 
  1420 lemma aff_dim_eq_dim_subtract:
  1162 lemma aff_dim_eq_dim_subtract:
  1421   "aff_dim S = int (dim ((\<lambda>x. x - a) ` S))" if "a \<in> affine hull S"
  1163   fixes S :: "'n::euclidean_space set"
  1422     for S :: "'n::euclidean_space set"
  1164   assumes "a \<in> affine hull S"
  1423   using aff_dim_eq_dim [of a] that by (simp cong: image_cong_simp)
  1165   shows "aff_dim S = int (dim ((\<lambda>x. x - a) ` S))"
       
  1166   using aff_dim_eq_dim assms by auto
  1424 
  1167 
  1425 lemma aff_dim_UNIV [simp]: "aff_dim (UNIV :: 'n::euclidean_space set) = int(DIM('n))"
  1168 lemma aff_dim_UNIV [simp]: "aff_dim (UNIV :: 'n::euclidean_space set) = int(DIM('n))"
  1426   using aff_dim_subspace[of "(UNIV :: 'n::euclidean_space set)"]
  1169   by (simp add: aff_dim_subspace)
  1427     dim_UNIV[where 'a="'n::euclidean_space"]
       
  1428   by auto
       
  1429 
  1170 
  1430 lemma aff_dim_geq:
  1171 lemma aff_dim_geq:
  1431   fixes V :: "'n::euclidean_space set"
  1172   fixes V :: "'n::euclidean_space set"
  1432   shows "aff_dim V \<ge> -1"
  1173   shows "aff_dim V \<ge> -1"
  1433 proof -
  1174   by (metis add_le_cancel_right aff_dim_basis_exists diff_self of_nat_0_le_iff uminus_add_conv_diff)
  1434   obtain B where "affine hull B = affine hull V"
       
  1435     and "\<not> affine_dependent B"
       
  1436     and "int (card B) = aff_dim V + 1"
       
  1437     using aff_dim_basis_exists by auto
       
  1438   then show ?thesis by auto
       
  1439 qed
       
  1440 
  1175 
  1441 lemma aff_dim_negative_iff [simp]:
  1176 lemma aff_dim_negative_iff [simp]:
  1442   fixes S :: "'n::euclidean_space set"
  1177   fixes S :: "'n::euclidean_space set"
  1443   shows "aff_dim S < 0 \<longleftrightarrow>S = {}"
  1178   shows "aff_dim S < 0 \<longleftrightarrow> S = {}"
  1444 by (metis aff_dim_empty aff_dim_geq diff_0 eq_iff zle_diff1_eq)
  1179   by (metis aff_dim_empty aff_dim_geq diff_0 eq_iff zle_diff1_eq)
  1445 
  1180 
  1446 lemma aff_lowdim_subset_hyperplane:
  1181 lemma aff_lowdim_subset_hyperplane:
  1447   fixes S :: "'a::euclidean_space set"
  1182   fixes S :: "'a::euclidean_space set"
  1448   assumes "aff_dim S < DIM('a)"
  1183   assumes "aff_dim S < DIM('a)"
  1449   obtains a b where "a \<noteq> 0" "S \<subseteq> {x. a \<bullet> x = b}"
  1184   obtains a b where "a \<noteq> 0" "S \<subseteq> {x. a \<bullet> x = b}"
  1480 
  1215 
  1481 lemma affine_independent_card_dim_diffs:
  1216 lemma affine_independent_card_dim_diffs:
  1482   fixes S :: "'a :: euclidean_space set"
  1217   fixes S :: "'a :: euclidean_space set"
  1483   assumes "\<not> affine_dependent S" "a \<in> S"
  1218   assumes "\<not> affine_dependent S" "a \<in> S"
  1484     shows "card S = dim ((\<lambda>x. x - a) ` S) + 1"
  1219     shows "card S = dim ((\<lambda>x. x - a) ` S) + 1"
  1485 proof -
  1220   using aff_dim_affine_independent aff_dim_eq_dim_subtract assms hull_subset by fastforce
  1486   have non: "\<not> affine_dependent (insert a S)"
       
  1487     by (simp add: assms insert_absorb)
       
  1488   have "finite S"
       
  1489     by (meson assms aff_independent_finite)
       
  1490   with \<open>a \<in> S\<close> have "card S \<noteq> 0" by auto
       
  1491   moreover have "dim ((\<lambda>x. x - a) ` S) = card S - 1"
       
  1492     using aff_dim_eq_dim_subtract aff_dim_unique \<open>a \<in> S\<close> hull_inc insert_absorb non by fastforce
       
  1493   ultimately show ?thesis
       
  1494     by auto
       
  1495 qed
       
  1496 
  1221 
  1497 lemma independent_card_le_aff_dim:
  1222 lemma independent_card_le_aff_dim:
  1498   fixes B :: "'n::euclidean_space set"
  1223   fixes B :: "'n::euclidean_space set"
  1499   assumes "B \<subseteq> V"
  1224   assumes "B \<subseteq> V"
  1500   assumes "\<not> affine_dependent B"
  1225   assumes "\<not> affine_dependent B"
  1501   shows "int (card B) \<le> aff_dim V + 1"
  1226   shows "int (card B) \<le> aff_dim V + 1"
  1502 proof -
  1227   by (metis aff_dim_unique aff_independent_finite assms card_mono extend_to_affine_basis of_nat_mono)
  1503   obtain T where T: "\<not> affine_dependent T \<and> B \<subseteq> T \<and> T \<subseteq> V \<and> affine hull T = affine hull V"
       
  1504     by (metis assms extend_to_affine_basis[of B V])
       
  1505   then have "of_nat (card T) = aff_dim V + 1"
       
  1506     using aff_dim_unique by auto
       
  1507   then show ?thesis
       
  1508     using T card_mono[of T B] aff_independent_finite[of T] by auto
       
  1509 qed
       
  1510 
  1228 
  1511 lemma aff_dim_subset:
  1229 lemma aff_dim_subset:
  1512   fixes S T :: "'n::euclidean_space set"
  1230   fixes S T :: "'n::euclidean_space set"
  1513   assumes "S \<subseteq> T"
  1231   assumes "S \<subseteq> T"
  1514   shows "aff_dim S \<le> aff_dim T"
  1232   shows "aff_dim S \<le> aff_dim T"
  1515 proof -
  1233   by (metis add_le_cancel_right aff_dim_inner_basis_exists assms dual_order.trans independent_card_le_aff_dim)
  1516   obtain B where B: "\<not> affine_dependent B" "B \<subseteq> S" "affine hull B = affine hull S"
       
  1517     "of_nat (card B) = aff_dim S + 1"
       
  1518     using aff_dim_inner_basis_exists[of S] by auto
       
  1519   then have "int (card B) \<le> aff_dim T + 1"
       
  1520     using assms independent_card_le_aff_dim[of B T] by auto
       
  1521   with B show ?thesis by auto
       
  1522 qed
       
  1523 
  1234 
  1524 lemma aff_dim_le_DIM:
  1235 lemma aff_dim_le_DIM:
  1525   fixes S :: "'n::euclidean_space set"
  1236   fixes S :: "'n::euclidean_space set"
  1526   shows "aff_dim S \<le> int (DIM('n))"
  1237   shows "aff_dim S \<le> int (DIM('n))"
  1527 proof -
  1238   by (metis aff_dim_UNIV aff_dim_subset top_greatest)
  1528   have "aff_dim (UNIV :: 'n::euclidean_space set) = int(DIM('n))"
       
  1529     using aff_dim_UNIV by auto
       
  1530   then show "aff_dim (S:: 'n::euclidean_space set) \<le> int(DIM('n))"
       
  1531     using aff_dim_subset[of S "(UNIV :: ('n::euclidean_space) set)"] subset_UNIV by auto
       
  1532 qed
       
  1533 
  1239 
  1534 lemma affine_dim_equal:
  1240 lemma affine_dim_equal:
  1535   fixes S :: "'n::euclidean_space set"
  1241   fixes S :: "'n::euclidean_space set"
  1536   assumes "affine S" "affine T" "S \<noteq> {}" "S \<subseteq> T" "aff_dim S = aff_dim T"
  1242   assumes "affine S" "affine T" "S \<noteq> {}" "S \<subseteq> T" "aff_dim S = aff_dim T"
  1537   shows "S = T"
  1243   shows "S = T"
  1538 proof -
  1244 proof -
  1539   obtain a where "a \<in> S" using assms by auto
  1245   obtain a where "a \<in> S" "a \<in> T" "T \<noteq> {}" using assms by auto
  1540   then have "a \<in> T" using assms by auto
       
  1541   define LS where "LS = {y. \<exists>x \<in> S. (-a) + x = y}"
  1246   define LS where "LS = {y. \<exists>x \<in> S. (-a) + x = y}"
  1542   then have ls: "subspace LS" "affine_parallel S LS"
  1247   then have ls: "subspace LS" "affine_parallel S LS"
  1543     using assms parallel_subspace_explicit[of S a LS] \<open>a \<in> S\<close> by auto
  1248     using assms parallel_subspace_explicit[of S a LS] \<open>a \<in> S\<close> by auto
  1544   then have h1: "int(dim LS) = aff_dim S"
  1249   then have h1: "int(dim LS) = aff_dim S"
  1545     using assms aff_dim_affine[of S LS] by auto
  1250     using assms aff_dim_affine[of S LS] by auto
  1546   have "T \<noteq> {}" using assms by auto
       
  1547   define LT where "LT = {y. \<exists>x \<in> T. (-a) + x = y}"
  1251   define LT where "LT = {y. \<exists>x \<in> T. (-a) + x = y}"
  1548   then have lt: "subspace LT \<and> affine_parallel T LT"
  1252   then have lt: "subspace LT \<and> affine_parallel T LT"
  1549     using assms parallel_subspace_explicit[of T a LT] \<open>a \<in> T\<close> by auto
  1253     using assms parallel_subspace_explicit[of T a LT] \<open>a \<in> T\<close> by auto
  1550   then have "int(dim LT) = aff_dim T"
       
  1551     using assms aff_dim_affine[of T LT] \<open>T \<noteq> {}\<close> by auto
       
  1552   then have "dim LS = dim LT"
  1254   then have "dim LS = dim LT"
  1553     using h1 assms by auto
  1255     using assms aff_dim_affine[of T LT] \<open>T \<noteq> {}\<close>  h1 by auto
  1554   moreover have "LS \<le> LT"
  1256   moreover have "LS \<le> LT"
  1555     using LS_def LT_def assms by auto
  1257     using LS_def LT_def assms by auto
  1556   ultimately have "LS = LT"
  1258   ultimately have "LS = LT"
  1557     using subspace_dim_equal[of LS LT] ls lt by auto
  1259     using subspace_dim_equal[of LS LT] ls lt by auto
  1558   moreover have "S = {x. \<exists>y \<in> LS. a+y=x}"
  1260   moreover have "S = {x. \<exists>y \<in> LS. a+y=x}" "T = {x. \<exists>y \<in> LT. a+y=x}"
  1559     using LS_def by auto
  1261     using LS_def LT_def by auto
  1560   moreover have "T = {x. \<exists>y \<in> LT. a+y=x}"
       
  1561     using LT_def by auto
       
  1562   ultimately show ?thesis by auto
  1262   ultimately show ?thesis by auto
  1563 qed
  1263 qed
  1564 
  1264 
  1565 lemma aff_dim_eq_0:
  1265 lemma aff_dim_eq_0:
  1566   fixes S :: "'a::euclidean_space set"
  1266   fixes S :: "'a::euclidean_space set"
  1567   shows "aff_dim S = 0 \<longleftrightarrow> (\<exists>a. S = {a})"
  1267   shows "aff_dim S = 0 \<longleftrightarrow> (\<exists>a. S = {a})"
  1568 proof (cases "S = {}")
  1268 proof (cases "S = {}")
  1569   case True
       
  1570   then show ?thesis
       
  1571     by auto
       
  1572 next
       
  1573   case False
  1269   case False
  1574   then obtain a where "a \<in> S" by auto
  1270   then obtain a where "a \<in> S" by auto
  1575   show ?thesis
  1271   show ?thesis
  1576   proof safe
  1272   proof safe
  1577     assume 0: "aff_dim S = 0"
  1273     assume 0: "aff_dim S = 0"
  1578     have "\<not> {a,b} \<subseteq> S" if "b \<noteq> a" for b
  1274     have "\<not> {a,b} \<subseteq> S" if "b \<noteq> a" for b
  1579       by (metis "0" aff_dim_2 aff_dim_subset not_one_le_zero that)
  1275       by (metis "0" aff_dim_2 aff_dim_subset not_one_le_zero that)
  1580     then show "\<exists>a. S = {a}"
  1276     then show "\<exists>a. S = {a}"
  1581       using \<open>a \<in> S\<close> by blast
  1277       using \<open>a \<in> S\<close> by blast
  1582   qed auto
  1278   qed auto
  1583 qed
  1279 qed auto
  1584 
  1280 
  1585 lemma affine_hull_UNIV:
  1281 lemma affine_hull_UNIV:
  1586   fixes S :: "'n::euclidean_space set"
  1282   fixes S :: "'n::euclidean_space set"
  1587   assumes "aff_dim S = int(DIM('n))"
  1283   assumes "aff_dim S = int(DIM('n))"
  1588   shows "affine hull S = (UNIV :: ('n::euclidean_space) set)"
  1284   shows "affine hull S = (UNIV :: ('n::euclidean_space) set)"
  1589 proof -
  1285   by (simp add: aff_dim_empty affine_dim_equal assms)
  1590   have "S \<noteq> {}"
       
  1591     using assms aff_dim_empty[of S] by auto
       
  1592   have h0: "S \<subseteq> affine hull S"
       
  1593     using hull_subset[of S _] by auto
       
  1594   have h1: "aff_dim (UNIV :: ('n::euclidean_space) set) = aff_dim S"
       
  1595     using aff_dim_UNIV assms by auto
       
  1596   then have h2: "aff_dim (affine hull S) \<le> aff_dim (UNIV :: ('n::euclidean_space) set)"
       
  1597     using aff_dim_le_DIM[of "affine hull S"] assms h0 by auto
       
  1598   have h3: "aff_dim S \<le> aff_dim (affine hull S)"
       
  1599     using h0 aff_dim_subset[of S "affine hull S"] assms by auto
       
  1600   then have h4: "aff_dim (affine hull S) = aff_dim (UNIV :: ('n::euclidean_space) set)"
       
  1601     using h0 h1 h2 by auto
       
  1602   then show ?thesis
       
  1603     using affine_dim_equal[of "affine hull S" "(UNIV :: ('n::euclidean_space) set)"]
       
  1604       affine_affine_hull[of S] affine_UNIV assms h4 h0 \<open>S \<noteq> {}\<close>
       
  1605     by auto
       
  1606 qed
       
  1607 
  1286 
  1608 lemma disjoint_affine_hull:
  1287 lemma disjoint_affine_hull:
  1609   fixes s :: "'n::euclidean_space set"
  1288   fixes S :: "'n::euclidean_space set"
  1610   assumes "\<not> affine_dependent s" "t \<subseteq> s" "u \<subseteq> s" "t \<inter> u = {}"
  1289   assumes "\<not> affine_dependent S" "T \<subseteq> S" "U \<subseteq> S" "T \<inter> U = {}"
  1611     shows "(affine hull t) \<inter> (affine hull u) = {}"
  1290     shows "(affine hull T) \<inter> (affine hull U) = {}"
  1612 proof -
  1291 proof -
  1613   from assms(1) have "finite s"
  1292   obtain "finite S" "finite T" "finite U"
  1614     by (simp add: aff_independent_finite)
  1293     using assms by (simp add: aff_independent_finite finite_subset)
  1615   with assms(2,3) have "finite t" "finite u"
  1294   have False if "y \<in> affine hull T" and "y \<in> affine hull U" for y
  1616     by (blast intro: finite_subset)+
       
  1617   have False if "y \<in> affine hull t" and "y \<in> affine hull u" for y
       
  1618   proof -
  1295   proof -
  1619     from that obtain a b
  1296     from that obtain a b
  1620       where a1 [simp]: "sum a t = 1"
  1297       where a1 [simp]: "sum a T = 1"
  1621         and [simp]: "sum (\<lambda>v. a v *\<^sub>R v) t = y"
  1298         and [simp]: "sum (\<lambda>v. a v *\<^sub>R v) T = y"
  1622         and [simp]: "sum b u = 1" "sum (\<lambda>v. b v *\<^sub>R v) u = y"
  1299         and [simp]: "sum b U = 1" "sum (\<lambda>v. b v *\<^sub>R v) U = y"
  1623       by (auto simp: affine_hull_finite \<open>finite t\<close> \<open>finite u\<close>)
  1300       by (auto simp: affine_hull_finite \<open>finite T\<close> \<open>finite U\<close>)
  1624     define c where "c x = (if x \<in> t then a x else if x \<in> u then -(b x) else 0)" for x
  1301     define c where "c x = (if x \<in> T then a x else if x \<in> U then -(b x) else 0)" for x
  1625     from assms(2,3,4) have [simp]: "s \<inter> t = t" "s \<inter> - t \<inter> u = u"
  1302     have [simp]: "S \<inter> T = T" "S \<inter> - T \<inter> U = U"
  1626       by auto
  1303       using assms by auto
  1627     have "sum c s = 0"
  1304     have "sum c S = 0"
  1628       by (simp add: c_def comm_monoid_add_class.sum.If_cases \<open>finite s\<close> sum_negf)
  1305       by (simp add: c_def comm_monoid_add_class.sum.If_cases \<open>finite S\<close> sum_negf)
  1629     moreover have "\<not> (\<forall>v\<in>s. c v = 0)"
  1306     moreover have "\<not> (\<forall>v\<in>S. c v = 0)"
  1630       by (metis (no_types) IntD1 \<open>s \<inter> t = t\<close> a1 c_def sum.neutral zero_neq_one)
  1307       by (metis (no_types) IntD1 \<open>S \<inter> T = T\<close> a1 c_def sum.neutral zero_neq_one)
  1631     moreover have "(\<Sum>v\<in>s. c v *\<^sub>R v) = 0"
  1308     moreover have "(\<Sum>v\<in>S. c v *\<^sub>R v) = 0"
  1632       by (simp add: c_def if_smult sum_negf comm_monoid_add_class.sum.If_cases \<open>finite s\<close>)
  1309       by (simp add: c_def if_smult sum_negf comm_monoid_add_class.sum.If_cases \<open>finite S\<close>)
  1633     ultimately show ?thesis
  1310     ultimately show ?thesis
  1634       using assms(1) \<open>finite s\<close> by (auto simp: affine_dependent_explicit)
  1311       using assms(1) \<open>finite S\<close> by (auto simp: affine_dependent_explicit)
  1635   qed
  1312   qed
  1636   then show ?thesis by blast
  1313   then show ?thesis by blast
  1637 qed
  1314 qed
  1638 
  1315 
  1639 end
  1316 end