src/HOL/Analysis/Linear_Algebra.thy
author paulson <lp15@cam.ac.uk>
Thu Sep 22 15:44:47 2016 +0100 (2016-09-22)
changeset 63938 f6ce08859d4c
parent 63918 6bf55e6e0b75
child 64122 74fde524799e
permissions -rw-r--r--
More mainly topological results
     1 (*  Title:      HOL/Analysis/Linear_Algebra.thy
     2     Author:     Amine Chaieb, University of Cambridge
     3 *)
     4 
     5 section \<open>Elementary linear algebra on Euclidean spaces\<close>
     6 
     7 theory Linear_Algebra
     8 imports
     9   Euclidean_Space
    10   "~~/src/HOL/Library/Infinite_Set"
    11 begin
    12 
    13 lemma linear_simps:
    14   assumes "bounded_linear f"
    15   shows
    16     "f (a + b) = f a + f b"
    17     "f (a - b) = f a - f b"
    18     "f 0 = 0"
    19     "f (- a) = - f a"
    20     "f (s *\<^sub>R v) = s *\<^sub>R (f v)"
    21 proof -
    22   interpret f: bounded_linear f by fact
    23   show "f (a + b) = f a + f b" by (rule f.add)
    24   show "f (a - b) = f a - f b" by (rule f.diff)
    25   show "f 0 = 0" by (rule f.zero)
    26   show "f (- a) = - f a" by (rule f.minus)
    27   show "f (s *\<^sub>R v) = s *\<^sub>R (f v)" by (rule f.scaleR)
    28 qed
    29 
    30 lemma bounded_linearI:
    31   assumes "\<And>x y. f (x + y) = f x + f y"
    32     and "\<And>r x. f (r *\<^sub>R x) = r *\<^sub>R f x"
    33     and "\<And>x. norm (f x) \<le> norm x * K"
    34   shows "bounded_linear f"
    35   using assms by (rule bounded_linear_intro) (* FIXME: duplicate *)
    36 
    37 subsection \<open>A generic notion of "hull" (convex, affine, conic hull and closure).\<close>
    38 
    39 definition hull :: "('a set \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> 'a set"  (infixl "hull" 75)
    40   where "S hull s = \<Inter>{t. S t \<and> s \<subseteq> t}"
    41 
    42 lemma hull_same: "S s \<Longrightarrow> S hull s = s"
    43   unfolding hull_def by auto
    44 
    45 lemma hull_in: "(\<And>T. Ball T S \<Longrightarrow> S (\<Inter>T)) \<Longrightarrow> S (S hull s)"
    46   unfolding hull_def Ball_def by auto
    47 
    48 lemma hull_eq: "(\<And>T. Ball T S \<Longrightarrow> S (\<Inter>T)) \<Longrightarrow> (S hull s) = s \<longleftrightarrow> S s"
    49   using hull_same[of S s] hull_in[of S s] by metis
    50 
    51 lemma hull_hull [simp]: "S hull (S hull s) = S hull s"
    52   unfolding hull_def by blast
    53 
    54 lemma hull_subset[intro]: "s \<subseteq> (S hull s)"
    55   unfolding hull_def by blast
    56 
    57 lemma hull_mono: "s \<subseteq> t \<Longrightarrow> (S hull s) \<subseteq> (S hull t)"
    58   unfolding hull_def by blast
    59 
    60 lemma hull_antimono: "\<forall>x. S x \<longrightarrow> T x \<Longrightarrow> (T hull s) \<subseteq> (S hull s)"
    61   unfolding hull_def by blast
    62 
    63 lemma hull_minimal: "s \<subseteq> t \<Longrightarrow> S t \<Longrightarrow> (S hull s) \<subseteq> t"
    64   unfolding hull_def by blast
    65 
    66 lemma subset_hull: "S t \<Longrightarrow> S hull s \<subseteq> t \<longleftrightarrow> s \<subseteq> t"
    67   unfolding hull_def by blast
    68 
    69 lemma hull_UNIV [simp]: "S hull UNIV = UNIV"
    70   unfolding hull_def by auto
    71 
    72 lemma hull_unique: "s \<subseteq> t \<Longrightarrow> S t \<Longrightarrow> (\<And>t'. s \<subseteq> t' \<Longrightarrow> S t' \<Longrightarrow> t \<subseteq> t') \<Longrightarrow> (S hull s = t)"
    73   unfolding hull_def by auto
    74 
    75 lemma hull_induct: "(\<And>x. x\<in> S \<Longrightarrow> P x) \<Longrightarrow> Q {x. P x} \<Longrightarrow> \<forall>x\<in> Q hull S. P x"
    76   using hull_minimal[of S "{x. P x}" Q]
    77   by (auto simp add: subset_eq)
    78 
    79 lemma hull_inc: "x \<in> S \<Longrightarrow> x \<in> P hull S"
    80   by (metis hull_subset subset_eq)
    81 
    82 lemma hull_union_subset: "(S hull s) \<union> (S hull t) \<subseteq> (S hull (s \<union> t))"
    83   unfolding Un_subset_iff by (metis hull_mono Un_upper1 Un_upper2)
    84 
    85 lemma hull_union:
    86   assumes T: "\<And>T. Ball T S \<Longrightarrow> S (\<Inter>T)"
    87   shows "S hull (s \<union> t) = S hull (S hull s \<union> S hull t)"
    88   apply rule
    89   apply (rule hull_mono)
    90   unfolding Un_subset_iff
    91   apply (metis hull_subset Un_upper1 Un_upper2 subset_trans)
    92   apply (rule hull_minimal)
    93   apply (metis hull_union_subset)
    94   apply (metis hull_in T)
    95   done
    96 
    97 lemma hull_redundant_eq: "a \<in> (S hull s) \<longleftrightarrow> S hull (insert a s) = S hull s"
    98   unfolding hull_def by blast
    99 
   100 lemma hull_redundant: "a \<in> (S hull s) \<Longrightarrow> S hull (insert a s) = S hull s"
   101   by (metis hull_redundant_eq)
   102 
   103 subsection \<open>Linear functions.\<close>
   104 
   105 lemma linear_iff:
   106   "linear f \<longleftrightarrow> (\<forall>x y. f (x + y) = f x + f y) \<and> (\<forall>c x. f (c *\<^sub>R x) = c *\<^sub>R f x)"
   107   (is "linear f \<longleftrightarrow> ?rhs")
   108 proof
   109   assume "linear f"
   110   then interpret f: linear f .
   111   show "?rhs" by (simp add: f.add f.scaleR)
   112 next
   113   assume "?rhs"
   114   then show "linear f" by unfold_locales simp_all
   115 qed
   116 
   117 lemma linear_compose_cmul: "linear f \<Longrightarrow> linear (\<lambda>x. c *\<^sub>R f x)"
   118   by (simp add: linear_iff algebra_simps)
   119 
   120 lemma linear_compose_scaleR: "linear f \<Longrightarrow> linear (\<lambda>x. f x *\<^sub>R c)"
   121   by (simp add: linear_iff scaleR_add_left)
   122 
   123 lemma linear_compose_neg: "linear f \<Longrightarrow> linear (\<lambda>x. - f x)"
   124   by (simp add: linear_iff)
   125 
   126 lemma linear_compose_add: "linear f \<Longrightarrow> linear g \<Longrightarrow> linear (\<lambda>x. f x + g x)"
   127   by (simp add: linear_iff algebra_simps)
   128 
   129 lemma linear_compose_sub: "linear f \<Longrightarrow> linear g \<Longrightarrow> linear (\<lambda>x. f x - g x)"
   130   by (simp add: linear_iff algebra_simps)
   131 
   132 lemma linear_compose: "linear f \<Longrightarrow> linear g \<Longrightarrow> linear (g \<circ> f)"
   133   by (simp add: linear_iff)
   134 
   135 lemma linear_id: "linear id"
   136   by (simp add: linear_iff id_def)
   137 
   138 lemma linear_zero: "linear (\<lambda>x. 0)"
   139   by (simp add: linear_iff)
   140 
   141 lemma linear_uminus: "linear uminus"
   142 by (simp add: linear_iff)
   143 
   144 lemma linear_compose_setsum:
   145   assumes lS: "\<forall>a \<in> S. linear (f a)"
   146   shows "linear (\<lambda>x. setsum (\<lambda>a. f a x) S)"
   147 proof (cases "finite S")
   148   case True
   149   then show ?thesis
   150     using lS by induct (simp_all add: linear_zero linear_compose_add)
   151 next
   152   case False
   153   then show ?thesis
   154     by (simp add: linear_zero)
   155 qed
   156 
   157 lemma linear_0: "linear f \<Longrightarrow> f 0 = 0"
   158   unfolding linear_iff
   159   apply clarsimp
   160   apply (erule allE[where x="0::'a"])
   161   apply simp
   162   done
   163 
   164 lemma linear_cmul: "linear f \<Longrightarrow> f (c *\<^sub>R x) = c *\<^sub>R f x"
   165   by (rule linear.scaleR)
   166 
   167 lemma linear_neg: "linear f \<Longrightarrow> f (- x) = - f x"
   168   using linear_cmul [where c="-1"] by simp
   169 
   170 lemma linear_add: "linear f \<Longrightarrow> f (x + y) = f x + f y"
   171   by (metis linear_iff)
   172 
   173 lemma linear_diff: "linear f \<Longrightarrow> f (x - y) = f x - f y"
   174   using linear_add [of f x "- y"] by (simp add: linear_neg)
   175 
   176 lemma linear_setsum:
   177   assumes f: "linear f"
   178   shows "f (setsum g S) = setsum (f \<circ> g) S"
   179 proof (cases "finite S")
   180   case True
   181   then show ?thesis
   182     by induct (simp_all add: linear_0 [OF f] linear_add [OF f])
   183 next
   184   case False
   185   then show ?thesis
   186     by (simp add: linear_0 [OF f])
   187 qed
   188 
   189 lemma linear_setsum_mul:
   190   assumes lin: "linear f"
   191   shows "f (setsum (\<lambda>i. c i *\<^sub>R v i) S) = setsum (\<lambda>i. c i *\<^sub>R f (v i)) S"
   192   using linear_setsum[OF lin, of "\<lambda>i. c i *\<^sub>R v i" , unfolded o_def] linear_cmul[OF lin]
   193   by simp
   194 
   195 lemma linear_injective_0:
   196   assumes lin: "linear f"
   197   shows "inj f \<longleftrightarrow> (\<forall>x. f x = 0 \<longrightarrow> x = 0)"
   198 proof -
   199   have "inj f \<longleftrightarrow> (\<forall> x y. f x = f y \<longrightarrow> x = y)"
   200     by (simp add: inj_on_def)
   201   also have "\<dots> \<longleftrightarrow> (\<forall> x y. f x - f y = 0 \<longrightarrow> x - y = 0)"
   202     by simp
   203   also have "\<dots> \<longleftrightarrow> (\<forall> x y. f (x - y) = 0 \<longrightarrow> x - y = 0)"
   204     by (simp add: linear_diff[OF lin])
   205   also have "\<dots> \<longleftrightarrow> (\<forall> x. f x = 0 \<longrightarrow> x = 0)"
   206     by auto
   207   finally show ?thesis .
   208 qed
   209 
   210 lemma linear_scaleR  [simp]: "linear (\<lambda>x. scaleR c x)"
   211   by (simp add: linear_iff scaleR_add_right)
   212 
   213 lemma linear_scaleR_left [simp]: "linear (\<lambda>r. scaleR r x)"
   214   by (simp add: linear_iff scaleR_add_left)
   215 
   216 lemma injective_scaleR: "c \<noteq> 0 \<Longrightarrow> inj (\<lambda>x::'a::real_vector. scaleR c x)"
   217   by (simp add: inj_on_def)
   218 
   219 lemma linear_add_cmul:
   220   assumes "linear f"
   221   shows "f (a *\<^sub>R x + b *\<^sub>R y) = a *\<^sub>R f x +  b *\<^sub>R f y"
   222   using linear_add[of f] linear_cmul[of f] assms by simp
   223 
   224 subsection \<open>Subspaces of vector spaces\<close>
   225 
   226 definition (in real_vector) subspace :: "'a set \<Rightarrow> bool"
   227   where "subspace S \<longleftrightarrow> 0 \<in> S \<and> (\<forall>x \<in> S. \<forall>y \<in> S. x + y \<in> S) \<and> (\<forall>c. \<forall>x \<in> S. c *\<^sub>R x \<in> S)"
   228 
   229 definition (in real_vector) "span S = (subspace hull S)"
   230 definition (in real_vector) "dependent S \<longleftrightarrow> (\<exists>a \<in> S. a \<in> span (S - {a}))"
   231 abbreviation (in real_vector) "independent s \<equiv> \<not> dependent s"
   232 
   233 text \<open>Closure properties of subspaces.\<close>
   234 
   235 lemma subspace_UNIV[simp]: "subspace UNIV"
   236   by (simp add: subspace_def)
   237 
   238 lemma (in real_vector) subspace_0: "subspace S \<Longrightarrow> 0 \<in> S"
   239   by (metis subspace_def)
   240 
   241 lemma (in real_vector) subspace_add: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x + y \<in> S"
   242   by (metis subspace_def)
   243 
   244 lemma (in real_vector) subspace_mul: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> c *\<^sub>R x \<in> S"
   245   by (metis subspace_def)
   246 
   247 lemma subspace_neg: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> - x \<in> S"
   248   by (metis scaleR_minus1_left subspace_mul)
   249 
   250 lemma subspace_diff: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x - y \<in> S"
   251   using subspace_add [of S x "- y"] by (simp add: subspace_neg)
   252 
   253 lemma (in real_vector) subspace_setsum:
   254   assumes sA: "subspace A"
   255     and f: "\<And>x. x \<in> B \<Longrightarrow> f x \<in> A"
   256   shows "setsum f B \<in> A"
   257 proof (cases "finite B")
   258   case True
   259   then show ?thesis
   260     using f by induct (simp_all add: subspace_0 [OF sA] subspace_add [OF sA])
   261 qed (simp add: subspace_0 [OF sA])
   262 
   263 lemma subspace_trivial [iff]: "subspace {0}"
   264   by (simp add: subspace_def)
   265 
   266 lemma (in real_vector) subspace_inter: "subspace A \<Longrightarrow> subspace B \<Longrightarrow> subspace (A \<inter> B)"
   267   by (simp add: subspace_def)
   268 
   269 lemma subspace_Times: "subspace A \<Longrightarrow> subspace B \<Longrightarrow> subspace (A \<times> B)"
   270   unfolding subspace_def zero_prod_def by simp
   271 
   272 lemma subspace_sums: "\<lbrakk>subspace S; subspace T\<rbrakk> \<Longrightarrow> subspace {x + y|x y. x \<in> S \<and> y \<in> T}"
   273 apply (simp add: subspace_def)
   274 apply (intro conjI impI allI)
   275   using add.right_neutral apply blast
   276  apply clarify
   277  apply (metis add.assoc add.left_commute)
   278 using scaleR_add_right by blast
   279 
   280 subsection \<open>Properties of span\<close>
   281 
   282 lemma (in real_vector) span_mono: "A \<subseteq> B \<Longrightarrow> span A \<subseteq> span B"
   283   by (metis span_def hull_mono)
   284 
   285 lemma (in real_vector) subspace_span [iff]: "subspace (span S)"
   286   unfolding span_def
   287   apply (rule hull_in)
   288   apply (simp only: subspace_def Inter_iff Int_iff subset_eq)
   289   apply auto
   290   done
   291 
   292 lemma (in real_vector) span_clauses:
   293   "a \<in> S \<Longrightarrow> a \<in> span S"
   294   "0 \<in> span S"
   295   "x\<in> span S \<Longrightarrow> y \<in> span S \<Longrightarrow> x + y \<in> span S"
   296   "x \<in> span S \<Longrightarrow> c *\<^sub>R x \<in> span S"
   297   by (metis span_def hull_subset subset_eq) (metis subspace_span subspace_def)+
   298 
   299 lemma span_unique:
   300   "S \<subseteq> T \<Longrightarrow> subspace T \<Longrightarrow> (\<And>T'. S \<subseteq> T' \<Longrightarrow> subspace T' \<Longrightarrow> T \<subseteq> T') \<Longrightarrow> span S = T"
   301   unfolding span_def by (rule hull_unique)
   302 
   303 lemma span_minimal: "S \<subseteq> T \<Longrightarrow> subspace T \<Longrightarrow> span S \<subseteq> T"
   304   unfolding span_def by (rule hull_minimal)
   305 
   306 lemma span_UNIV: "span UNIV = UNIV"
   307   by (intro span_unique) auto
   308 
   309 lemma (in real_vector) span_induct:
   310   assumes x: "x \<in> span S"
   311     and P: "subspace (Collect P)"
   312     and SP: "\<And>x. x \<in> S \<Longrightarrow> P x"
   313   shows "P x"
   314 proof -
   315   from SP have SP': "S \<subseteq> Collect P"
   316     by (simp add: subset_eq)
   317   from x hull_minimal[where S=subspace, OF SP' P, unfolded span_def[symmetric]]
   318   show ?thesis
   319     using subset_eq by force
   320 qed
   321 
   322 lemma span_empty[simp]: "span {} = {0}"
   323   apply (simp add: span_def)
   324   apply (rule hull_unique)
   325   apply (auto simp add: subspace_def)
   326   done
   327 
   328 lemma (in real_vector) independent_empty [iff]: "independent {}"
   329   by (simp add: dependent_def)
   330 
   331 lemma dependent_single[simp]: "dependent {x} \<longleftrightarrow> x = 0"
   332   unfolding dependent_def by auto
   333 
   334 lemma (in real_vector) independent_mono: "independent A \<Longrightarrow> B \<subseteq> A \<Longrightarrow> independent B"
   335   apply (clarsimp simp add: dependent_def span_mono)
   336   apply (subgoal_tac "span (B - {a}) \<le> span (A - {a})")
   337   apply force
   338   apply (rule span_mono)
   339   apply auto
   340   done
   341 
   342 lemma (in real_vector) span_subspace: "A \<subseteq> B \<Longrightarrow> B \<le> span A \<Longrightarrow>  subspace B \<Longrightarrow> span A = B"
   343   by (metis order_antisym span_def hull_minimal)
   344 
   345 lemma (in real_vector) span_induct':
   346   "\<forall>x \<in> S. P x \<Longrightarrow> subspace {x. P x} \<Longrightarrow> \<forall>x \<in> span S. P x"
   347   unfolding span_def by (rule hull_induct) auto
   348 
   349 inductive_set (in real_vector) span_induct_alt_help for S :: "'a set"
   350 where
   351   span_induct_alt_help_0: "0 \<in> span_induct_alt_help S"
   352 | span_induct_alt_help_S:
   353     "x \<in> S \<Longrightarrow> z \<in> span_induct_alt_help S \<Longrightarrow>
   354       (c *\<^sub>R x + z) \<in> span_induct_alt_help S"
   355 
   356 lemma span_induct_alt':
   357   assumes h0: "h 0"
   358     and hS: "\<And>c x y. x \<in> S \<Longrightarrow> h y \<Longrightarrow> h (c *\<^sub>R x + y)"
   359   shows "\<forall>x \<in> span S. h x"
   360 proof -
   361   {
   362     fix x :: 'a
   363     assume x: "x \<in> span_induct_alt_help S"
   364     have "h x"
   365       apply (rule span_induct_alt_help.induct[OF x])
   366       apply (rule h0)
   367       apply (rule hS)
   368       apply assumption
   369       apply assumption
   370       done
   371   }
   372   note th0 = this
   373   {
   374     fix x
   375     assume x: "x \<in> span S"
   376     have "x \<in> span_induct_alt_help S"
   377     proof (rule span_induct[where x=x and S=S])
   378       show "x \<in> span S" by (rule x)
   379     next
   380       fix x
   381       assume xS: "x \<in> S"
   382       from span_induct_alt_help_S[OF xS span_induct_alt_help_0, of 1]
   383       show "x \<in> span_induct_alt_help S"
   384         by simp
   385     next
   386       have "0 \<in> span_induct_alt_help S" by (rule span_induct_alt_help_0)
   387       moreover
   388       {
   389         fix x y
   390         assume h: "x \<in> span_induct_alt_help S" "y \<in> span_induct_alt_help S"
   391         from h have "(x + y) \<in> span_induct_alt_help S"
   392           apply (induct rule: span_induct_alt_help.induct)
   393           apply simp
   394           unfolding add.assoc
   395           apply (rule span_induct_alt_help_S)
   396           apply assumption
   397           apply simp
   398           done
   399       }
   400       moreover
   401       {
   402         fix c x
   403         assume xt: "x \<in> span_induct_alt_help S"
   404         then have "(c *\<^sub>R x) \<in> span_induct_alt_help S"
   405           apply (induct rule: span_induct_alt_help.induct)
   406           apply (simp add: span_induct_alt_help_0)
   407           apply (simp add: scaleR_right_distrib)
   408           apply (rule span_induct_alt_help_S)
   409           apply assumption
   410           apply simp
   411           done }
   412       ultimately show "subspace {a. a \<in> span_induct_alt_help S}"
   413         unfolding subspace_def Ball_def by blast
   414     qed
   415   }
   416   with th0 show ?thesis by blast
   417 qed
   418 
   419 lemma span_induct_alt:
   420   assumes h0: "h 0"
   421     and hS: "\<And>c x y. x \<in> S \<Longrightarrow> h y \<Longrightarrow> h (c *\<^sub>R x + y)"
   422     and x: "x \<in> span S"
   423   shows "h x"
   424   using span_induct_alt'[of h S] h0 hS x by blast
   425 
   426 text \<open>Individual closure properties.\<close>
   427 
   428 lemma span_span: "span (span A) = span A"
   429   unfolding span_def hull_hull ..
   430 
   431 lemma (in real_vector) span_superset: "x \<in> S \<Longrightarrow> x \<in> span S"
   432   by (metis span_clauses(1))
   433 
   434 lemma (in real_vector) span_0 [simp]: "0 \<in> span S"
   435   by (metis subspace_span subspace_0)
   436 
   437 lemma span_inc: "S \<subseteq> span S"
   438   by (metis subset_eq span_superset)
   439 
   440 lemma span_eq: "span S = span T \<longleftrightarrow> S \<subseteq> span T \<and> T \<subseteq> span S"
   441   using span_inc[unfolded subset_eq] using span_mono[of T "span S"] span_mono[of S "span T"]
   442   by (auto simp add: span_span)
   443 
   444 lemma (in real_vector) dependent_0:
   445   assumes "0 \<in> A"
   446   shows "dependent A"
   447   unfolding dependent_def
   448   using assms span_0
   449   by blast
   450 
   451 lemma (in real_vector) span_add: "x \<in> span S \<Longrightarrow> y \<in> span S \<Longrightarrow> x + y \<in> span S"
   452   by (metis subspace_add subspace_span)
   453 
   454 lemma (in real_vector) span_mul: "x \<in> span S \<Longrightarrow> c *\<^sub>R x \<in> span S"
   455   by (metis subspace_span subspace_mul)
   456 
   457 lemma span_neg: "x \<in> span S \<Longrightarrow> - x \<in> span S"
   458   by (metis subspace_neg subspace_span)
   459 
   460 lemma span_diff: "x \<in> span S \<Longrightarrow> y \<in> span S \<Longrightarrow> x - y \<in> span S"
   461   by (metis subspace_span subspace_diff)
   462 
   463 lemma (in real_vector) span_setsum: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> span S) \<Longrightarrow> setsum f A \<in> span S"
   464   by (rule subspace_setsum [OF subspace_span])
   465 
   466 lemma span_add_eq: "x \<in> span S \<Longrightarrow> x + y \<in> span S \<longleftrightarrow> y \<in> span S"
   467   by (metis add_minus_cancel scaleR_minus1_left subspace_def subspace_span)
   468 
   469 text \<open>The key breakdown property.\<close>
   470 
   471 lemma span_singleton: "span {x} = range (\<lambda>k. k *\<^sub>R x)"
   472 proof (rule span_unique)
   473   show "{x} \<subseteq> range (\<lambda>k. k *\<^sub>R x)"
   474     by (fast intro: scaleR_one [symmetric])
   475   show "subspace (range (\<lambda>k. k *\<^sub>R x))"
   476     unfolding subspace_def
   477     by (auto intro: scaleR_add_left [symmetric])
   478 next
   479   fix T
   480   assume "{x} \<subseteq> T" and "subspace T"
   481   then show "range (\<lambda>k. k *\<^sub>R x) \<subseteq> T"
   482     unfolding subspace_def by auto
   483 qed
   484 
   485 text \<open>Mapping under linear image.\<close>
   486 
   487 lemma subspace_linear_image:
   488   assumes lf: "linear f"
   489     and sS: "subspace S"
   490   shows "subspace (f ` S)"
   491   using lf sS linear_0[OF lf]
   492   unfolding linear_iff subspace_def
   493   apply (auto simp add: image_iff)
   494   apply (rule_tac x="x + y" in bexI)
   495   apply auto
   496   apply (rule_tac x="c *\<^sub>R x" in bexI)
   497   apply auto
   498   done
   499 
   500 lemma subspace_linear_vimage: "linear f \<Longrightarrow> subspace S \<Longrightarrow> subspace (f -` S)"
   501   by (auto simp add: subspace_def linear_iff linear_0[of f])
   502 
   503 lemma subspace_linear_preimage: "linear f \<Longrightarrow> subspace S \<Longrightarrow> subspace {x. f x \<in> S}"
   504   by (auto simp add: subspace_def linear_iff linear_0[of f])
   505 
   506 lemma span_linear_image:
   507   assumes lf: "linear f"
   508   shows "span (f ` S) = f ` span S"
   509 proof (rule span_unique)
   510   show "f ` S \<subseteq> f ` span S"
   511     by (intro image_mono span_inc)
   512   show "subspace (f ` span S)"
   513     using lf subspace_span by (rule subspace_linear_image)
   514 next
   515   fix T
   516   assume "f ` S \<subseteq> T" and "subspace T"
   517   then show "f ` span S \<subseteq> T"
   518     unfolding image_subset_iff_subset_vimage
   519     by (intro span_minimal subspace_linear_vimage lf)
   520 qed
   521 
   522 lemma spans_image:
   523   assumes lf: "linear f"
   524     and VB: "V \<subseteq> span B"
   525   shows "f ` V \<subseteq> span (f ` B)"
   526   unfolding span_linear_image[OF lf] by (metis VB image_mono)
   527 
   528 lemma span_Un: "span (A \<union> B) = (\<lambda>(a, b). a + b) ` (span A \<times> span B)"
   529 proof (rule span_unique)
   530   show "A \<union> B \<subseteq> (\<lambda>(a, b). a + b) ` (span A \<times> span B)"
   531     by safe (force intro: span_clauses)+
   532 next
   533   have "linear (\<lambda>(a, b). a + b)"
   534     by (simp add: linear_iff scaleR_add_right)
   535   moreover have "subspace (span A \<times> span B)"
   536     by (intro subspace_Times subspace_span)
   537   ultimately show "subspace ((\<lambda>(a, b). a + b) ` (span A \<times> span B))"
   538     by (rule subspace_linear_image)
   539 next
   540   fix T
   541   assume "A \<union> B \<subseteq> T" and "subspace T"
   542   then show "(\<lambda>(a, b). a + b) ` (span A \<times> span B) \<subseteq> T"
   543     by (auto intro!: subspace_add elim: span_induct)
   544 qed
   545 
   546 lemma span_insert: "span (insert a S) = {x. \<exists>k. (x - k *\<^sub>R a) \<in> span S}"
   547 proof -
   548   have "span ({a} \<union> S) = {x. \<exists>k. (x - k *\<^sub>R a) \<in> span S}"
   549     unfolding span_Un span_singleton
   550     apply safe
   551     apply (rule_tac x=k in exI, simp)
   552     apply (erule rev_image_eqI [OF SigmaI [OF rangeI]])
   553     apply auto
   554     done
   555   then show ?thesis by simp
   556 qed
   557 
   558 lemma span_breakdown:
   559   assumes bS: "b \<in> S"
   560     and aS: "a \<in> span S"
   561   shows "\<exists>k. a - k *\<^sub>R b \<in> span (S - {b})"
   562   using assms span_insert [of b "S - {b}"]
   563   by (simp add: insert_absorb)
   564 
   565 lemma span_breakdown_eq: "x \<in> span (insert a S) \<longleftrightarrow> (\<exists>k. x - k *\<^sub>R a \<in> span S)"
   566   by (simp add: span_insert)
   567 
   568 text \<open>Hence some "reversal" results.\<close>
   569 
   570 lemma in_span_insert:
   571   assumes a: "a \<in> span (insert b S)"
   572     and na: "a \<notin> span S"
   573   shows "b \<in> span (insert a S)"
   574 proof -
   575   from a obtain k where k: "a - k *\<^sub>R b \<in> span S"
   576     unfolding span_insert by fast
   577   show ?thesis
   578   proof (cases "k = 0")
   579     case True
   580     with k have "a \<in> span S" by simp
   581     with na show ?thesis by simp
   582   next
   583     case False
   584     from k have "(- inverse k) *\<^sub>R (a - k *\<^sub>R b) \<in> span S"
   585       by (rule span_mul)
   586     then have "b - inverse k *\<^sub>R a \<in> span S"
   587       using \<open>k \<noteq> 0\<close> by (simp add: scaleR_diff_right)
   588     then show ?thesis
   589       unfolding span_insert by fast
   590   qed
   591 qed
   592 
   593 lemma in_span_delete:
   594   assumes a: "a \<in> span S"
   595     and na: "a \<notin> span (S - {b})"
   596   shows "b \<in> span (insert a (S - {b}))"
   597   apply (rule in_span_insert)
   598   apply (rule set_rev_mp)
   599   apply (rule a)
   600   apply (rule span_mono)
   601   apply blast
   602   apply (rule na)
   603   done
   604 
   605 text \<open>Transitivity property.\<close>
   606 
   607 lemma span_redundant: "x \<in> span S \<Longrightarrow> span (insert x S) = span S"
   608   unfolding span_def by (rule hull_redundant)
   609 
   610 lemma span_trans:
   611   assumes x: "x \<in> span S"
   612     and y: "y \<in> span (insert x S)"
   613   shows "y \<in> span S"
   614   using assms by (simp only: span_redundant)
   615 
   616 lemma span_insert_0[simp]: "span (insert 0 S) = span S"
   617   by (simp only: span_redundant span_0)
   618 
   619 text \<open>An explicit expansion is sometimes needed.\<close>
   620 
   621 lemma span_explicit:
   622   "span P = {y. \<exists>S u. finite S \<and> S \<subseteq> P \<and> setsum (\<lambda>v. u v *\<^sub>R v) S = y}"
   623   (is "_ = ?E" is "_ = {y. ?h y}" is "_ = {y. \<exists>S u. ?Q S u y}")
   624 proof -
   625   {
   626     fix x
   627     assume "?h x"
   628     then obtain S u where "finite S" and "S \<subseteq> P" and "setsum (\<lambda>v. u v *\<^sub>R v) S = x"
   629       by blast
   630     then have "x \<in> span P"
   631       by (auto intro: span_setsum span_mul span_superset)
   632   }
   633   moreover
   634   have "\<forall>x \<in> span P. ?h x"
   635   proof (rule span_induct_alt')
   636     show "?h 0"
   637       by (rule exI[where x="{}"], simp)
   638   next
   639     fix c x y
   640     assume x: "x \<in> P"
   641     assume hy: "?h y"
   642     from hy obtain S u where fS: "finite S" and SP: "S\<subseteq>P"
   643       and u: "setsum (\<lambda>v. u v *\<^sub>R v) S = y" by blast
   644     let ?S = "insert x S"
   645     let ?u = "\<lambda>y. if y = x then (if x \<in> S then u y + c else c) else u y"
   646     from fS SP x have th0: "finite (insert x S)" "insert x S \<subseteq> P"
   647       by blast+
   648     have "?Q ?S ?u (c*\<^sub>R x + y)"
   649     proof cases
   650       assume xS: "x \<in> S"
   651       have "setsum (\<lambda>v. ?u v *\<^sub>R v) ?S = (\<Sum>v\<in>S - {x}. u v *\<^sub>R v) + (u x + c) *\<^sub>R x"
   652         using xS by (simp add: setsum.remove [OF fS xS] insert_absorb)
   653       also have "\<dots> = (\<Sum>v\<in>S. u v *\<^sub>R v) + c *\<^sub>R x"
   654         by (simp add: setsum.remove [OF fS xS] algebra_simps)
   655       also have "\<dots> = c*\<^sub>R x + y"
   656         by (simp add: add.commute u)
   657       finally have "setsum (\<lambda>v. ?u v *\<^sub>R v) ?S = c*\<^sub>R x + y" .
   658       then show ?thesis using th0 by blast
   659     next
   660       assume xS: "x \<notin> S"
   661       have th00: "(\<Sum>v\<in>S. (if v = x then c else u v) *\<^sub>R v) = y"
   662         unfolding u[symmetric]
   663         apply (rule setsum.cong)
   664         using xS
   665         apply auto
   666         done
   667       show ?thesis using fS xS th0
   668         by (simp add: th00 add.commute cong del: if_weak_cong)
   669     qed
   670     then show "?h (c*\<^sub>R x + y)"
   671       by fast
   672   qed
   673   ultimately show ?thesis by blast
   674 qed
   675 
   676 lemma dependent_explicit:
   677   "dependent P \<longleftrightarrow> (\<exists>S u. finite S \<and> S \<subseteq> P \<and> (\<exists>v\<in>S. u v \<noteq> 0 \<and> setsum (\<lambda>v. u v *\<^sub>R v) S = 0))"
   678   (is "?lhs = ?rhs")
   679 proof -
   680   {
   681     assume dP: "dependent P"
   682     then obtain a S u where aP: "a \<in> P" and fS: "finite S"
   683       and SP: "S \<subseteq> P - {a}" and ua: "setsum (\<lambda>v. u v *\<^sub>R v) S = a"
   684       unfolding dependent_def span_explicit by blast
   685     let ?S = "insert a S"
   686     let ?u = "\<lambda>y. if y = a then - 1 else u y"
   687     let ?v = a
   688     from aP SP have aS: "a \<notin> S"
   689       by blast
   690     from fS SP aP have th0: "finite ?S" "?S \<subseteq> P" "?v \<in> ?S" "?u ?v \<noteq> 0"
   691       by auto
   692     have s0: "setsum (\<lambda>v. ?u v *\<^sub>R v) ?S = 0"
   693       using fS aS
   694       apply simp
   695       apply (subst (2) ua[symmetric])
   696       apply (rule setsum.cong)
   697       apply auto
   698       done
   699     with th0 have ?rhs by fast
   700   }
   701   moreover
   702   {
   703     fix S u v
   704     assume fS: "finite S"
   705       and SP: "S \<subseteq> P"
   706       and vS: "v \<in> S"
   707       and uv: "u v \<noteq> 0"
   708       and u: "setsum (\<lambda>v. u v *\<^sub>R v) S = 0"
   709     let ?a = v
   710     let ?S = "S - {v}"
   711     let ?u = "\<lambda>i. (- u i) / u v"
   712     have th0: "?a \<in> P" "finite ?S" "?S \<subseteq> P"
   713       using fS SP vS by auto
   714     have "setsum (\<lambda>v. ?u v *\<^sub>R v) ?S =
   715       setsum (\<lambda>v. (- (inverse (u ?a))) *\<^sub>R (u v *\<^sub>R v)) S - ?u v *\<^sub>R v"
   716       using fS vS uv by (simp add: setsum_diff1 field_simps)
   717     also have "\<dots> = ?a"
   718       unfolding scaleR_right.setsum [symmetric] u using uv by simp
   719     finally have "setsum (\<lambda>v. ?u v *\<^sub>R v) ?S = ?a" .
   720     with th0 have ?lhs
   721       unfolding dependent_def span_explicit
   722       apply -
   723       apply (rule bexI[where x= "?a"])
   724       apply (simp_all del: scaleR_minus_left)
   725       apply (rule exI[where x= "?S"])
   726       apply (auto simp del: scaleR_minus_left)
   727       done
   728   }
   729   ultimately show ?thesis by blast
   730 qed
   731 
   732 lemma dependent_finite:
   733   assumes "finite S"
   734     shows "dependent S \<longleftrightarrow> (\<exists>u. (\<exists>v \<in> S. u v \<noteq> 0) \<and> (\<Sum>v\<in>S. u v *\<^sub>R v) = 0)"
   735            (is "?lhs = ?rhs")
   736 proof
   737   assume ?lhs
   738   then obtain T u v
   739          where "finite T" "T \<subseteq> S" "v\<in>T" "u v \<noteq> 0" "(\<Sum>v\<in>T. u v *\<^sub>R v) = 0"
   740     by (force simp: dependent_explicit)
   741   with assms show ?rhs
   742     apply (rule_tac x="\<lambda>v. if v \<in> T then u v else 0" in exI)
   743     apply (auto simp: setsum.mono_neutral_right)
   744     done
   745 next
   746   assume ?rhs  with assms show ?lhs
   747     by (fastforce simp add: dependent_explicit)
   748 qed
   749 
   750 lemma span_alt:
   751   "span B = {(\<Sum>x | f x \<noteq> 0. f x *\<^sub>R x) | f. {x. f x \<noteq> 0} \<subseteq> B \<and> finite {x. f x \<noteq> 0}}"
   752   unfolding span_explicit
   753   apply safe
   754   subgoal for x S u
   755     by (intro exI[of _ "\<lambda>x. if x \<in> S then u x else 0"])
   756         (auto intro!: setsum.mono_neutral_cong_right)
   757   apply auto
   758   done
   759 
   760 lemma dependent_alt:
   761   "dependent B \<longleftrightarrow>
   762     (\<exists>X. finite {x. X x \<noteq> 0} \<and> {x. X x \<noteq> 0} \<subseteq> B \<and> (\<Sum>x|X x \<noteq> 0. X x *\<^sub>R x) = 0 \<and> (\<exists>x. X x \<noteq> 0))"
   763   unfolding dependent_explicit
   764   apply safe
   765   subgoal for S u v
   766     apply (intro exI[of _ "\<lambda>x. if x \<in> S then u x else 0"])
   767     apply (subst setsum.mono_neutral_cong_left[where T=S])
   768     apply (auto intro!: setsum.mono_neutral_cong_right cong: rev_conj_cong)
   769     done
   770   apply auto
   771   done
   772 
   773 lemma independent_alt:
   774   "independent B \<longleftrightarrow>
   775     (\<forall>X. finite {x. X x \<noteq> 0} \<longrightarrow> {x. X x \<noteq> 0} \<subseteq> B \<longrightarrow> (\<Sum>x|X x \<noteq> 0. X x *\<^sub>R x) = 0 \<longrightarrow> (\<forall>x. X x = 0))"
   776   unfolding dependent_alt by auto
   777 
   778 lemma independentD_alt:
   779   "independent B \<Longrightarrow> finite {x. X x \<noteq> 0} \<Longrightarrow> {x. X x \<noteq> 0} \<subseteq> B \<Longrightarrow> (\<Sum>x|X x \<noteq> 0. X x *\<^sub>R x) = 0 \<Longrightarrow> X x = 0"
   780   unfolding independent_alt by blast
   781 
   782 lemma independentD_unique:
   783   assumes B: "independent B"
   784     and X: "finite {x. X x \<noteq> 0}" "{x. X x \<noteq> 0} \<subseteq> B"
   785     and Y: "finite {x. Y x \<noteq> 0}" "{x. Y x \<noteq> 0} \<subseteq> B"
   786     and "(\<Sum>x | X x \<noteq> 0. X x *\<^sub>R x) = (\<Sum>x| Y x \<noteq> 0. Y x *\<^sub>R x)"
   787   shows "X = Y"
   788 proof -
   789   have "X x - Y x = 0" for x
   790     using B
   791   proof (rule independentD_alt)
   792     have "{x. X x - Y x \<noteq> 0} \<subseteq> {x. X x \<noteq> 0} \<union> {x. Y x \<noteq> 0}"
   793       by auto
   794     then show "finite {x. X x - Y x \<noteq> 0}" "{x. X x - Y x \<noteq> 0} \<subseteq> B"
   795       using X Y by (auto dest: finite_subset)
   796     then have "(\<Sum>x | X x - Y x \<noteq> 0. (X x - Y x) *\<^sub>R x) = (\<Sum>v\<in>{S. X S \<noteq> 0} \<union> {S. Y S \<noteq> 0}. (X v - Y v) *\<^sub>R v)"
   797       using X Y by (intro setsum.mono_neutral_cong_left) auto
   798     also have "\<dots> = (\<Sum>v\<in>{S. X S \<noteq> 0} \<union> {S. Y S \<noteq> 0}. X v *\<^sub>R v) - (\<Sum>v\<in>{S. X S \<noteq> 0} \<union> {S. Y S \<noteq> 0}. Y v *\<^sub>R v)"
   799       by (simp add: scaleR_diff_left setsum_subtractf assms)
   800     also have "(\<Sum>v\<in>{S. X S \<noteq> 0} \<union> {S. Y S \<noteq> 0}. X v *\<^sub>R v) = (\<Sum>v\<in>{S. X S \<noteq> 0}. X v *\<^sub>R v)"
   801       using X Y by (intro setsum.mono_neutral_cong_right) auto
   802     also have "(\<Sum>v\<in>{S. X S \<noteq> 0} \<union> {S. Y S \<noteq> 0}. Y v *\<^sub>R v) = (\<Sum>v\<in>{S. Y S \<noteq> 0}. Y v *\<^sub>R v)"
   803       using X Y by (intro setsum.mono_neutral_cong_right) auto
   804     finally show "(\<Sum>x | X x - Y x \<noteq> 0. (X x - Y x) *\<^sub>R x) = 0"
   805       using assms by simp
   806   qed
   807   then show ?thesis
   808     by auto
   809 qed
   810 
   811 text \<open>This is useful for building a basis step-by-step.\<close>
   812 
   813 lemma independent_insert:
   814   "independent (insert a S) \<longleftrightarrow>
   815     (if a \<in> S then independent S else independent S \<and> a \<notin> span S)"
   816   (is "?lhs \<longleftrightarrow> ?rhs")
   817 proof (cases "a \<in> S")
   818   case True
   819   then show ?thesis
   820     using insert_absorb[OF True] by simp
   821 next
   822   case False
   823   show ?thesis
   824   proof
   825     assume i: ?lhs
   826     then show ?rhs
   827       using False
   828       apply simp
   829       apply (rule conjI)
   830       apply (rule independent_mono)
   831       apply assumption
   832       apply blast
   833       apply (simp add: dependent_def)
   834       done
   835   next
   836     assume i: ?rhs
   837     show ?lhs
   838       using i False
   839       apply (auto simp add: dependent_def)
   840       by (metis in_span_insert insert_Diff_if insert_Diff_single insert_absorb)
   841   qed
   842 qed
   843 
   844 lemma independent_Union_directed:
   845   assumes directed: "\<And>c d. c \<in> C \<Longrightarrow> d \<in> C \<Longrightarrow> c \<subseteq> d \<or> d \<subseteq> c"
   846   assumes indep: "\<And>c. c \<in> C \<Longrightarrow> independent c"
   847   shows "independent (\<Union>C)"
   848 proof
   849   assume "dependent (\<Union>C)"
   850   then obtain u v S where S: "finite S" "S \<subseteq> \<Union>C" "v \<in> S" "u v \<noteq> 0" "(\<Sum>v\<in>S. u v *\<^sub>R v) = 0"
   851     by (auto simp: dependent_explicit)
   852 
   853   have "S \<noteq> {}"
   854     using \<open>v \<in> S\<close> by auto
   855   have "\<exists>c\<in>C. S \<subseteq> c"
   856     using \<open>finite S\<close> \<open>S \<noteq> {}\<close> \<open>S \<subseteq> \<Union>C\<close>
   857   proof (induction rule: finite_ne_induct)
   858     case (insert i I)
   859     then obtain c d where cd: "c \<in> C" "d \<in> C" and iI: "I \<subseteq> c" "i \<in> d"
   860       by blast
   861     from directed[OF cd] cd have "c \<union> d \<in> C"
   862       by (auto simp: sup.absorb1 sup.absorb2)
   863     with iI show ?case
   864       by (intro bexI[of _ "c \<union> d"]) auto
   865   qed auto
   866   then obtain c where "c \<in> C" "S \<subseteq> c"
   867     by auto
   868   have "dependent c"
   869     unfolding dependent_explicit
   870     by (intro exI[of _ S] exI[of _ u] bexI[of _ v] conjI) fact+
   871   with indep[OF \<open>c \<in> C\<close>] show False
   872     by auto
   873 qed
   874 
   875 text \<open>Hence we can create a maximal independent subset.\<close>
   876 
   877 lemma maximal_independent_subset_extend:
   878   assumes "S \<subseteq> V" "independent S"
   879   shows "\<exists>B. S \<subseteq> B \<and> B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B"
   880 proof -
   881   let ?C = "{B. S \<subseteq> B \<and> independent B \<and> B \<subseteq> V}"
   882   have "\<exists>M\<in>?C. \<forall>X\<in>?C. M \<subseteq> X \<longrightarrow> X = M"
   883   proof (rule subset_Zorn)
   884     fix C :: "'a set set" assume "subset.chain ?C C"
   885     then have C: "\<And>c. c \<in> C \<Longrightarrow> c \<subseteq> V" "\<And>c. c \<in> C \<Longrightarrow> S \<subseteq> c" "\<And>c. c \<in> C \<Longrightarrow> independent c"
   886       "\<And>c d. c \<in> C \<Longrightarrow> d \<in> C \<Longrightarrow> c \<subseteq> d \<or> d \<subseteq> c"
   887       unfolding subset.chain_def by blast+
   888 
   889     show "\<exists>U\<in>?C. \<forall>X\<in>C. X \<subseteq> U"
   890     proof cases
   891       assume "C = {}" with assms show ?thesis
   892         by (auto intro!: exI[of _ S])
   893     next
   894       assume "C \<noteq> {}"
   895       with C(2) have "S \<subseteq> \<Union>C"
   896         by auto
   897       moreover have "independent (\<Union>C)"
   898         by (intro independent_Union_directed C)
   899       moreover have "\<Union>C \<subseteq> V"
   900         using C by auto
   901       ultimately show ?thesis
   902         by auto
   903     qed
   904   qed
   905   then obtain B where B: "independent B" "B \<subseteq> V" "S \<subseteq> B"
   906     and max: "\<And>S. independent S \<Longrightarrow> S \<subseteq> V \<Longrightarrow> B \<subseteq> S \<Longrightarrow> S = B"
   907     by auto
   908   moreover
   909   { assume "\<not> V \<subseteq> span B"
   910     then obtain v where "v \<in> V" "v \<notin> span B"
   911       by auto
   912     with B have "independent (insert v B)"
   913       unfolding independent_insert by auto
   914     from max[OF this] \<open>v \<in> V\<close> \<open>B \<subseteq> V\<close>
   915     have "v \<in> B"
   916       by auto
   917     with \<open>v \<notin> span B\<close> have False
   918       by (auto intro: span_superset) }
   919   ultimately show ?thesis
   920     by (auto intro!: exI[of _ B])
   921 qed
   922 
   923 
   924 lemma maximal_independent_subset:
   925   "\<exists>B. B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B"
   926   by (metis maximal_independent_subset_extend[of "{}"] empty_subsetI independent_empty)
   927 
   928 lemma span_finite:
   929   assumes fS: "finite S"
   930   shows "span S = {y. \<exists>u. setsum (\<lambda>v. u v *\<^sub>R v) S = y}"
   931   (is "_ = ?rhs")
   932 proof -
   933   {
   934     fix y
   935     assume y: "y \<in> span S"
   936     from y obtain S' u where fS': "finite S'"
   937       and SS': "S' \<subseteq> S"
   938       and u: "setsum (\<lambda>v. u v *\<^sub>R v) S' = y"
   939       unfolding span_explicit by blast
   940     let ?u = "\<lambda>x. if x \<in> S' then u x else 0"
   941     have "setsum (\<lambda>v. ?u v *\<^sub>R v) S = setsum (\<lambda>v. u v *\<^sub>R v) S'"
   942       using SS' fS by (auto intro!: setsum.mono_neutral_cong_right)
   943     then have "setsum (\<lambda>v. ?u v *\<^sub>R v) S = y" by (metis u)
   944     then have "y \<in> ?rhs" by auto
   945   }
   946   moreover
   947   {
   948     fix y u
   949     assume u: "setsum (\<lambda>v. u v *\<^sub>R v) S = y"
   950     then have "y \<in> span S" using fS unfolding span_explicit by auto
   951   }
   952   ultimately show ?thesis by blast
   953 qed
   954 
   955 lemma linear_independent_extend_subspace:
   956   assumes "independent B"
   957   shows "\<exists>g. linear g \<and> (\<forall>x\<in>B. g x = f x) \<and> range g = span (f`B)"
   958 proof -
   959   from maximal_independent_subset_extend[OF _ \<open>independent B\<close>, of UNIV]
   960   obtain B' where "B \<subseteq> B'" "independent B'" "span B' = UNIV"
   961     by (auto simp: top_unique)
   962   have "\<forall>y. \<exists>X. {x. X x \<noteq> 0} \<subseteq> B' \<and> finite {x. X x \<noteq> 0} \<and> y = (\<Sum>x|X x \<noteq> 0. X x *\<^sub>R x)"
   963     using \<open>span B' = UNIV\<close> unfolding span_alt by auto
   964   then obtain X where X: "\<And>y. {x. X y x \<noteq> 0} \<subseteq> B'" "\<And>y. finite {x. X y x \<noteq> 0}"
   965     "\<And>y. y = (\<Sum>x|X y x \<noteq> 0. X y x *\<^sub>R x)"
   966     unfolding choice_iff by auto
   967 
   968   have X_add: "X (x + y) = (\<lambda>z. X x z + X y z)" for x y
   969     using \<open>independent B'\<close>
   970   proof (rule independentD_unique)
   971     have "(\<Sum>z | X x z + X y z \<noteq> 0. (X x z + X y z) *\<^sub>R z)
   972       = (\<Sum>z\<in>{z. X x z \<noteq> 0} \<union> {z. X y z \<noteq> 0}. (X x z + X y z) *\<^sub>R z)"
   973       by (intro setsum.mono_neutral_cong_left) (auto intro: X)
   974     also have "\<dots> = (\<Sum>z\<in>{z. X x z \<noteq> 0}. X x z *\<^sub>R z) + (\<Sum>z\<in>{z. X y z \<noteq> 0}. X y z *\<^sub>R z)"
   975       by (auto simp add: scaleR_add_left setsum.distrib
   976                intro!: arg_cong2[where f="op +"]  setsum.mono_neutral_cong_right X)
   977     also have "\<dots> = x + y"
   978       by (simp add: X(3)[symmetric])
   979     also have "\<dots> = (\<Sum>z | X (x + y) z \<noteq> 0. X (x + y) z *\<^sub>R z)"
   980       by (rule X(3))
   981     finally show "(\<Sum>z | X (x + y) z \<noteq> 0. X (x + y) z *\<^sub>R z) = (\<Sum>z | X x z + X y z \<noteq> 0. (X x z + X y z) *\<^sub>R z)"
   982       ..
   983     have "{z. X x z + X y z \<noteq> 0} \<subseteq> {z. X x z \<noteq> 0} \<union> {z. X y z \<noteq> 0}"
   984       by auto
   985     then show "finite {z. X x z + X y z \<noteq> 0}" "{xa. X x xa + X y xa \<noteq> 0} \<subseteq> B'"
   986         "finite {xa. X (x + y) xa \<noteq> 0}" "{xa. X (x + y) xa \<noteq> 0} \<subseteq> B'"
   987       using X(1) by (auto dest: finite_subset intro: X)
   988   qed
   989 
   990   have X_cmult: "X (c *\<^sub>R x) = (\<lambda>z. c * X x z)" for x c
   991     using \<open>independent B'\<close>
   992   proof (rule independentD_unique)
   993     show "finite {z. X (c *\<^sub>R x) z \<noteq> 0}" "{z. X (c *\<^sub>R x) z \<noteq> 0} \<subseteq> B'"
   994       "finite {z. c * X x z \<noteq> 0}" "{z. c * X x z \<noteq> 0} \<subseteq> B' "
   995       using X(1,2) by auto
   996     show "(\<Sum>z | X (c *\<^sub>R x) z \<noteq> 0. X (c *\<^sub>R x) z *\<^sub>R z) = (\<Sum>z | c * X x z \<noteq> 0. (c * X x z) *\<^sub>R z)"
   997       unfolding scaleR_scaleR[symmetric] scaleR_setsum_right[symmetric]
   998       by (cases "c = 0") (auto simp: X(3)[symmetric])
   999   qed
  1000 
  1001   have X_B': "x \<in> B' \<Longrightarrow> X x = (\<lambda>z. if z = x then 1 else 0)" for x
  1002     using \<open>independent B'\<close>
  1003     by (rule independentD_unique[OF _ X(2) X(1)]) (auto intro: X simp: X(3)[symmetric])
  1004 
  1005   define f' where "f' y = (if y \<in> B then f y else 0)" for y
  1006   define g where "g y = (\<Sum>x|X y x \<noteq> 0. X y x *\<^sub>R f' x)" for y
  1007 
  1008   have g_f': "x \<in> B' \<Longrightarrow> g x = f' x" for x
  1009     by (auto simp: g_def X_B')
  1010 
  1011   have "linear g"
  1012   proof
  1013     fix x y
  1014     have *: "(\<Sum>z | X x z + X y z \<noteq> 0. (X x z + X y z) *\<^sub>R f' z)
  1015       = (\<Sum>z\<in>{z. X x z \<noteq> 0} \<union> {z. X y z \<noteq> 0}. (X x z + X y z) *\<^sub>R f' z)"
  1016       by (intro setsum.mono_neutral_cong_left) (auto intro: X)
  1017     show "g (x + y) = g x + g y"
  1018       unfolding g_def X_add *
  1019       by (auto simp add: scaleR_add_left setsum.distrib
  1020                intro!: arg_cong2[where f="op +"]  setsum.mono_neutral_cong_right X)
  1021   next
  1022     show "g (r *\<^sub>R x) = r *\<^sub>R g x" for r x
  1023       by (auto simp add: g_def X_cmult scaleR_setsum_right intro!: setsum.mono_neutral_cong_left X)
  1024   qed
  1025   moreover have "\<forall>x\<in>B. g x = f x"
  1026     using \<open>B \<subseteq> B'\<close> by (auto simp: g_f' f'_def)
  1027   moreover have "range g = span (f`B)"
  1028     unfolding \<open>span B' = UNIV\<close>[symmetric] span_linear_image[OF \<open>linear g\<close>, symmetric]
  1029   proof (rule span_subspace)
  1030     have "g ` B' \<subseteq> f`B \<union> {0}"
  1031       by (auto simp: g_f' f'_def)
  1032     also have "\<dots> \<subseteq> span (f`B)"
  1033       by (auto intro: span_superset span_0)
  1034     finally show "g ` B' \<subseteq> span (f`B)"
  1035       by auto
  1036     have "x \<in> B \<Longrightarrow> f x = g x" for x
  1037       using \<open>B \<subseteq> B'\<close> by (auto simp add: g_f' f'_def)
  1038     then show "span (f ` B) \<subseteq> span (g ` B')"
  1039       using \<open>B \<subseteq> B'\<close> by (intro span_mono) auto
  1040   qed (rule subspace_span)
  1041   ultimately show ?thesis
  1042     by auto
  1043 qed
  1044 
  1045 lemma linear_independent_extend:
  1046   "independent B \<Longrightarrow> \<exists>g. linear g \<and> (\<forall>x\<in>B. g x = f x)"
  1047   using linear_independent_extend_subspace[of B f] by auto
  1048 
  1049 text \<open>Linear functions are equal on a subspace if they are on a spanning set.\<close>
  1050 
  1051 lemma subspace_kernel:
  1052   assumes lf: "linear f"
  1053   shows "subspace {x. f x = 0}"
  1054   apply (simp add: subspace_def)
  1055   apply (simp add: linear_add[OF lf] linear_cmul[OF lf] linear_0[OF lf])
  1056   done
  1057 
  1058 lemma linear_eq_0_span:
  1059   assumes lf: "linear f" and f0: "\<forall>x\<in>B. f x = 0"
  1060   shows "\<forall>x \<in> span B. f x = 0"
  1061   using f0 subspace_kernel[OF lf]
  1062   by (rule span_induct')
  1063 
  1064 lemma linear_eq_0: "linear f \<Longrightarrow> S \<subseteq> span B \<Longrightarrow> \<forall>x\<in>B. f x = 0 \<Longrightarrow> \<forall>x\<in>S. f x = 0"
  1065   using linear_eq_0_span[of f B] by auto
  1066 
  1067 lemma linear_eq_span:  "linear f \<Longrightarrow> linear g \<Longrightarrow> \<forall>x\<in>B. f x = g x \<Longrightarrow> \<forall>x \<in> span B. f x = g x"
  1068   using linear_eq_0_span[of "\<lambda>x. f x - g x" B] by (auto simp: linear_compose_sub)
  1069 
  1070 lemma linear_eq: "linear f \<Longrightarrow> linear g \<Longrightarrow> S \<subseteq> span B \<Longrightarrow> \<forall>x\<in>B. f x = g x \<Longrightarrow> \<forall>x\<in>S. f x = g x"
  1071   using linear_eq_span[of f g B] by auto
  1072 
  1073 text \<open>The degenerate case of the Exchange Lemma.\<close>
  1074 
  1075 lemma spanning_subset_independent:
  1076   assumes BA: "B \<subseteq> A"
  1077     and iA: "independent A"
  1078     and AsB: "A \<subseteq> span B"
  1079   shows "A = B"
  1080 proof
  1081   show "B \<subseteq> A" by (rule BA)
  1082 
  1083   from span_mono[OF BA] span_mono[OF AsB]
  1084   have sAB: "span A = span B" unfolding span_span by blast
  1085 
  1086   {
  1087     fix x
  1088     assume x: "x \<in> A"
  1089     from iA have th0: "x \<notin> span (A - {x})"
  1090       unfolding dependent_def using x by blast
  1091     from x have xsA: "x \<in> span A"
  1092       by (blast intro: span_superset)
  1093     have "A - {x} \<subseteq> A" by blast
  1094     then have th1: "span (A - {x}) \<subseteq> span A"
  1095       by (metis span_mono)
  1096     {
  1097       assume xB: "x \<notin> B"
  1098       from xB BA have "B \<subseteq> A - {x}"
  1099         by blast
  1100       then have "span B \<subseteq> span (A - {x})"
  1101         by (metis span_mono)
  1102       with th1 th0 sAB have "x \<notin> span A"
  1103         by blast
  1104       with x have False
  1105         by (metis span_superset)
  1106     }
  1107     then have "x \<in> B" by blast
  1108   }
  1109   then show "A \<subseteq> B" by blast
  1110 qed
  1111 
  1112 text \<open>Relation between bases and injectivity/surjectivity of map.\<close>
  1113 
  1114 lemma spanning_surjective_image:
  1115   assumes us: "UNIV \<subseteq> span S"
  1116     and lf: "linear f"
  1117     and sf: "surj f"
  1118   shows "UNIV \<subseteq> span (f ` S)"
  1119 proof -
  1120   have "UNIV \<subseteq> f ` UNIV"
  1121     using sf by (auto simp add: surj_def)
  1122   also have " \<dots> \<subseteq> span (f ` S)"
  1123     using spans_image[OF lf us] .
  1124   finally show ?thesis .
  1125 qed
  1126 
  1127 lemma independent_inj_on_image:
  1128   assumes iS: "independent S"
  1129     and lf: "linear f"
  1130     and fi: "inj_on f (span S)"
  1131   shows "independent (f ` S)"
  1132 proof -
  1133   {
  1134     fix a
  1135     assume a: "a \<in> S" "f a \<in> span (f ` S - {f a})"
  1136     have eq: "f ` S - {f a} = f ` (S - {a})"
  1137       using fi \<open>a\<in>S\<close> by (auto simp add: inj_on_def span_superset)
  1138     from a have "f a \<in> f ` span (S - {a})"
  1139       unfolding eq span_linear_image[OF lf, of "S - {a}"] by blast
  1140     then have "a \<in> span (S - {a})"
  1141       by (rule inj_on_image_mem_iff_alt[OF fi, rotated])
  1142          (insert span_mono[of "S - {a}" S], auto intro: span_superset \<open>a\<in>S\<close>)
  1143     with a(1) iS have False
  1144       by (simp add: dependent_def)
  1145   }
  1146   then show ?thesis
  1147     unfolding dependent_def by blast
  1148 qed
  1149 
  1150 lemma independent_injective_image:
  1151   "independent S \<Longrightarrow> linear f \<Longrightarrow> inj f \<Longrightarrow> independent (f ` S)"
  1152   using independent_inj_on_image[of S f] by (auto simp: subset_inj_on)
  1153 
  1154 text \<open>Detailed theorems about left and right invertibility in general case.\<close>
  1155 
  1156 lemma linear_inj_on_left_inverse:
  1157   assumes lf: "linear f" and fi: "inj_on f (span S)"
  1158   shows "\<exists>g. range g \<subseteq> span S \<and> linear g \<and> (\<forall>x\<in>span S. g (f x) = x)"
  1159 proof -
  1160   obtain B where "independent B" "B \<subseteq> S" "S \<subseteq> span B"
  1161     using maximal_independent_subset[of S] by auto
  1162   then have "span S = span B"
  1163     unfolding span_eq by (auto simp: span_superset)
  1164   with linear_independent_extend_subspace[OF independent_inj_on_image, OF \<open>independent B\<close> lf] fi
  1165   obtain g where g: "linear g" "\<forall>x\<in>f ` B. g x = inv_into B f x" "range g = span (inv_into B f ` f ` B)"
  1166     by fastforce
  1167   have fB: "inj_on f B"
  1168     using fi by (auto simp: \<open>span S = span B\<close> intro: subset_inj_on span_superset)
  1169 
  1170   have "\<forall>x\<in>span B. g (f x) = x"
  1171   proof (intro linear_eq_span)
  1172     show "linear (\<lambda>x. x)" "linear (\<lambda>x. g (f x))"
  1173       using linear_id linear_compose[OF \<open>linear f\<close> \<open>linear g\<close>] by (auto simp: id_def comp_def)
  1174     show "\<forall>x \<in> B. g (f x) = x"
  1175       using g fi \<open>span S = span B\<close> by (auto simp: fB)
  1176   qed
  1177   moreover
  1178   have "inv_into B f ` f ` B \<subseteq> B"
  1179     by (auto simp: fB)
  1180   then have "range g \<subseteq> span S"
  1181     unfolding g \<open>span S = span B\<close> by (intro span_mono)
  1182   ultimately show ?thesis
  1183     using \<open>span S = span B\<close> \<open>linear g\<close> by auto
  1184 qed
  1185 
  1186 lemma linear_injective_left_inverse: "linear f \<Longrightarrow> inj f \<Longrightarrow> \<exists>g. linear g \<and> g \<circ> f = id"
  1187   using linear_inj_on_left_inverse[of f UNIV] by (auto simp: fun_eq_iff span_UNIV)
  1188 
  1189 lemma linear_surj_right_inverse:
  1190   assumes lf: "linear f" and sf: "span T \<subseteq> f`span S"
  1191   shows "\<exists>g. range g \<subseteq> span S \<and> linear g \<and> (\<forall>x\<in>span T. f (g x) = x)"
  1192 proof -
  1193   obtain B where "independent B" "B \<subseteq> T" "T \<subseteq> span B"
  1194     using maximal_independent_subset[of T] by auto
  1195   then have "span T = span B"
  1196     unfolding span_eq by (auto simp: span_superset)
  1197 
  1198   from linear_independent_extend_subspace[OF \<open>independent B\<close>, of "inv_into (span S) f"]
  1199   obtain g where g: "linear g" "\<forall>x\<in>B. g x = inv_into (span S) f x" "range g = span (inv_into (span S) f`B)"
  1200     by auto
  1201   moreover have "x \<in> B \<Longrightarrow> f (inv_into (span S) f x) = x" for x
  1202     using \<open>B \<subseteq> T\<close> \<open>span T \<subseteq> f`span S\<close> by (intro f_inv_into_f) (auto intro: span_superset)
  1203   ultimately have "\<forall>x\<in>B. f (g x) = x"
  1204     by auto
  1205   then have "\<forall>x\<in>span B. f (g x) = x"
  1206     using linear_id linear_compose[OF \<open>linear g\<close> \<open>linear f\<close>]
  1207     by (intro linear_eq_span) (auto simp: id_def comp_def)
  1208   moreover have "inv_into (span S) f ` B \<subseteq> span S"
  1209     using \<open>B \<subseteq> T\<close> \<open>span T \<subseteq> f`span S\<close> by (auto intro: inv_into_into span_superset)
  1210   then have "range g \<subseteq> span S"
  1211     unfolding g by (intro span_minimal subspace_span) auto
  1212   ultimately show ?thesis
  1213     using \<open>linear g\<close> \<open>span T = span B\<close> by auto
  1214 qed
  1215 
  1216 lemma linear_surjective_right_inverse: "linear f \<Longrightarrow> surj f \<Longrightarrow> \<exists>g. linear g \<and> f \<circ> g = id"
  1217   using linear_surj_right_inverse[of f UNIV UNIV]
  1218   by (auto simp: span_UNIV fun_eq_iff)
  1219 
  1220 text \<open>The general case of the Exchange Lemma, the key to what follows.\<close>
  1221 
  1222 lemma exchange_lemma:
  1223   assumes f:"finite t"
  1224     and i: "independent s"
  1225     and sp: "s \<subseteq> span t"
  1226   shows "\<exists>t'. card t' = card t \<and> finite t' \<and> s \<subseteq> t' \<and> t' \<subseteq> s \<union> t \<and> s \<subseteq> span t'"
  1227   using f i sp
  1228 proof (induct "card (t - s)" arbitrary: s t rule: less_induct)
  1229   case less
  1230   note ft = \<open>finite t\<close> and s = \<open>independent s\<close> and sp = \<open>s \<subseteq> span t\<close>
  1231   let ?P = "\<lambda>t'. card t' = card t \<and> finite t' \<and> s \<subseteq> t' \<and> t' \<subseteq> s \<union> t \<and> s \<subseteq> span t'"
  1232   let ?ths = "\<exists>t'. ?P t'"
  1233   {
  1234     assume "s \<subseteq> t"
  1235     then have ?ths
  1236       by (metis ft Un_commute sp sup_ge1)
  1237   }
  1238   moreover
  1239   {
  1240     assume st: "t \<subseteq> s"
  1241     from spanning_subset_independent[OF st s sp] st ft span_mono[OF st]
  1242     have ?ths
  1243       by (metis Un_absorb sp)
  1244   }
  1245   moreover
  1246   {
  1247     assume st: "\<not> s \<subseteq> t" "\<not> t \<subseteq> s"
  1248     from st(2) obtain b where b: "b \<in> t" "b \<notin> s"
  1249       by blast
  1250     from b have "t - {b} - s \<subset> t - s"
  1251       by blast
  1252     then have cardlt: "card (t - {b} - s) < card (t - s)"
  1253       using ft by (auto intro: psubset_card_mono)
  1254     from b ft have ct0: "card t \<noteq> 0"
  1255       by auto
  1256     have ?ths
  1257     proof cases
  1258       assume stb: "s \<subseteq> span (t - {b})"
  1259       from ft have ftb: "finite (t - {b})"
  1260         by auto
  1261       from less(1)[OF cardlt ftb s stb]
  1262       obtain u where u: "card u = card (t - {b})" "s \<subseteq> u" "u \<subseteq> s \<union> (t - {b})" "s \<subseteq> span u"
  1263         and fu: "finite u" by blast
  1264       let ?w = "insert b u"
  1265       have th0: "s \<subseteq> insert b u"
  1266         using u by blast
  1267       from u(3) b have "u \<subseteq> s \<union> t"
  1268         by blast
  1269       then have th1: "insert b u \<subseteq> s \<union> t"
  1270         using u b by blast
  1271       have bu: "b \<notin> u"
  1272         using b u by blast
  1273       from u(1) ft b have "card u = (card t - 1)"
  1274         by auto
  1275       then have th2: "card (insert b u) = card t"
  1276         using card_insert_disjoint[OF fu bu] ct0 by auto
  1277       from u(4) have "s \<subseteq> span u" .
  1278       also have "\<dots> \<subseteq> span (insert b u)"
  1279         by (rule span_mono) blast
  1280       finally have th3: "s \<subseteq> span (insert b u)" .
  1281       from th0 th1 th2 th3 fu have th: "?P ?w"
  1282         by blast
  1283       from th show ?thesis by blast
  1284     next
  1285       assume stb: "\<not> s \<subseteq> span (t - {b})"
  1286       from stb obtain a where a: "a \<in> s" "a \<notin> span (t - {b})"
  1287         by blast
  1288       have ab: "a \<noteq> b"
  1289         using a b by blast
  1290       have at: "a \<notin> t"
  1291         using a ab span_superset[of a "t- {b}"] by auto
  1292       have mlt: "card ((insert a (t - {b})) - s) < card (t - s)"
  1293         using cardlt ft a b by auto
  1294       have ft': "finite (insert a (t - {b}))"
  1295         using ft by auto
  1296       {
  1297         fix x
  1298         assume xs: "x \<in> s"
  1299         have t: "t \<subseteq> insert b (insert a (t - {b}))"
  1300           using b by auto
  1301         from b(1) have "b \<in> span t"
  1302           by (simp add: span_superset)
  1303         have bs: "b \<in> span (insert a (t - {b}))"
  1304           apply (rule in_span_delete)
  1305           using a sp unfolding subset_eq
  1306           apply auto
  1307           done
  1308         from xs sp have "x \<in> span t"
  1309           by blast
  1310         with span_mono[OF t] have x: "x \<in> span (insert b (insert a (t - {b})))" ..
  1311         from span_trans[OF bs x] have "x \<in> span (insert a (t - {b}))" .
  1312       }
  1313       then have sp': "s \<subseteq> span (insert a (t - {b}))"
  1314         by blast
  1315       from less(1)[OF mlt ft' s sp'] obtain u where u:
  1316         "card u = card (insert a (t - {b}))"
  1317         "finite u" "s \<subseteq> u" "u \<subseteq> s \<union> insert a (t - {b})"
  1318         "s \<subseteq> span u" by blast
  1319       from u a b ft at ct0 have "?P u"
  1320         by auto
  1321       then show ?thesis by blast
  1322     qed
  1323   }
  1324   ultimately show ?ths by blast
  1325 qed
  1326 
  1327 text \<open>This implies corresponding size bounds.\<close>
  1328 
  1329 lemma independent_span_bound:
  1330   assumes f: "finite t"
  1331     and i: "independent s"
  1332     and sp: "s \<subseteq> span t"
  1333   shows "finite s \<and> card s \<le> card t"
  1334   by (metis exchange_lemma[OF f i sp] finite_subset card_mono)
  1335 
  1336 lemma finite_Atleast_Atmost_nat[simp]: "finite {f x |x. x\<in> (UNIV::'a::finite set)}"
  1337 proof -
  1338   have eq: "{f x |x. x\<in> UNIV} = f ` UNIV"
  1339     by auto
  1340   show ?thesis unfolding eq
  1341     apply (rule finite_imageI)
  1342     apply (rule finite)
  1343     done
  1344 qed
  1345 
  1346 
  1347 subsection \<open>More interesting properties of the norm.\<close>
  1348 
  1349 lemma cond_application_beta: "(if b then f else g) x = (if b then f x else g x)"
  1350   by auto
  1351 
  1352 notation inner (infix "\<bullet>" 70)
  1353 
  1354 lemma square_bound_lemma:
  1355   fixes x :: real
  1356   shows "x < (1 + x) * (1 + x)"
  1357 proof -
  1358   have "(x + 1/2)\<^sup>2 + 3/4 > 0"
  1359     using zero_le_power2[of "x+1/2"] by arith
  1360   then show ?thesis
  1361     by (simp add: field_simps power2_eq_square)
  1362 qed
  1363 
  1364 lemma square_continuous:
  1365   fixes e :: real
  1366   shows "e > 0 \<Longrightarrow> \<exists>d. 0 < d \<and> (\<forall>y. \<bar>y - x\<bar> < d \<longrightarrow> \<bar>y * y - x * x\<bar> < e)"
  1367   using isCont_power[OF continuous_ident, of x, unfolded isCont_def LIM_eq, rule_format, of e 2]
  1368   by (force simp add: power2_eq_square)
  1369 
  1370 
  1371 lemma norm_eq_0_dot: "norm x = 0 \<longleftrightarrow> x \<bullet> x = (0::real)"
  1372   by simp (* TODO: delete *)
  1373 
  1374 lemma norm_triangle_sub:
  1375   fixes x y :: "'a::real_normed_vector"
  1376   shows "norm x \<le> norm y + norm (x - y)"
  1377   using norm_triangle_ineq[of "y" "x - y"] by (simp add: field_simps)
  1378 
  1379 lemma norm_le: "norm x \<le> norm y \<longleftrightarrow> x \<bullet> x \<le> y \<bullet> y"
  1380   by (simp add: norm_eq_sqrt_inner)
  1381 
  1382 lemma norm_lt: "norm x < norm y \<longleftrightarrow> x \<bullet> x < y \<bullet> y"
  1383   by (simp add: norm_eq_sqrt_inner)
  1384 
  1385 lemma norm_eq: "norm x = norm y \<longleftrightarrow> x \<bullet> x = y \<bullet> y"
  1386   apply (subst order_eq_iff)
  1387   apply (auto simp: norm_le)
  1388   done
  1389 
  1390 lemma norm_eq_1: "norm x = 1 \<longleftrightarrow> x \<bullet> x = 1"
  1391   by (simp add: norm_eq_sqrt_inner)
  1392 
  1393 text\<open>Squaring equations and inequalities involving norms.\<close>
  1394 
  1395 lemma dot_square_norm: "x \<bullet> x = (norm x)\<^sup>2"
  1396   by (simp only: power2_norm_eq_inner) (* TODO: move? *)
  1397 
  1398 lemma norm_eq_square: "norm x = a \<longleftrightarrow> 0 \<le> a \<and> x \<bullet> x = a\<^sup>2"
  1399   by (auto simp add: norm_eq_sqrt_inner)
  1400 
  1401 lemma norm_le_square: "norm x \<le> a \<longleftrightarrow> 0 \<le> a \<and> x \<bullet> x \<le> a\<^sup>2"
  1402   apply (simp add: dot_square_norm abs_le_square_iff[symmetric])
  1403   using norm_ge_zero[of x]
  1404   apply arith
  1405   done
  1406 
  1407 lemma norm_ge_square: "norm x \<ge> a \<longleftrightarrow> a \<le> 0 \<or> x \<bullet> x \<ge> a\<^sup>2"
  1408   apply (simp add: dot_square_norm abs_le_square_iff[symmetric])
  1409   using norm_ge_zero[of x]
  1410   apply arith
  1411   done
  1412 
  1413 lemma norm_lt_square: "norm x < a \<longleftrightarrow> 0 < a \<and> x \<bullet> x < a\<^sup>2"
  1414   by (metis not_le norm_ge_square)
  1415 
  1416 lemma norm_gt_square: "norm x > a \<longleftrightarrow> a < 0 \<or> x \<bullet> x > a\<^sup>2"
  1417   by (metis norm_le_square not_less)
  1418 
  1419 text\<open>Dot product in terms of the norm rather than conversely.\<close>
  1420 
  1421 lemmas inner_simps = inner_add_left inner_add_right inner_diff_right inner_diff_left
  1422   inner_scaleR_left inner_scaleR_right
  1423 
  1424 lemma dot_norm: "x \<bullet> y = ((norm (x + y))\<^sup>2 - (norm x)\<^sup>2 - (norm y)\<^sup>2) / 2"
  1425   by (simp only: power2_norm_eq_inner inner_simps inner_commute) auto
  1426 
  1427 lemma dot_norm_neg: "x \<bullet> y = (((norm x)\<^sup>2 + (norm y)\<^sup>2) - (norm (x - y))\<^sup>2) / 2"
  1428   by (simp only: power2_norm_eq_inner inner_simps inner_commute)
  1429     (auto simp add: algebra_simps)
  1430 
  1431 text\<open>Equality of vectors in terms of @{term "op \<bullet>"} products.\<close>
  1432 
  1433 lemma linear_componentwise:
  1434   fixes f:: "'a::euclidean_space \<Rightarrow> 'b::real_inner"
  1435   assumes lf: "linear f"
  1436   shows "(f x) \<bullet> j = (\<Sum>i\<in>Basis. (x\<bullet>i) * (f i\<bullet>j))" (is "?lhs = ?rhs")
  1437 proof -
  1438   have "?rhs = (\<Sum>i\<in>Basis. (x\<bullet>i) *\<^sub>R (f i))\<bullet>j"
  1439     by (simp add: inner_setsum_left)
  1440   then show ?thesis
  1441     unfolding linear_setsum_mul[OF lf, symmetric]
  1442     unfolding euclidean_representation ..
  1443 qed
  1444 
  1445 lemma vector_eq: "x = y \<longleftrightarrow> x \<bullet> x = x \<bullet> y \<and> y \<bullet> y = x \<bullet> x"
  1446   (is "?lhs \<longleftrightarrow> ?rhs")
  1447 proof
  1448   assume ?lhs
  1449   then show ?rhs by simp
  1450 next
  1451   assume ?rhs
  1452   then have "x \<bullet> x - x \<bullet> y = 0 \<and> x \<bullet> y - y \<bullet> y = 0"
  1453     by simp
  1454   then have "x \<bullet> (x - y) = 0 \<and> y \<bullet> (x - y) = 0"
  1455     by (simp add: inner_diff inner_commute)
  1456   then have "(x - y) \<bullet> (x - y) = 0"
  1457     by (simp add: field_simps inner_diff inner_commute)
  1458   then show "x = y" by simp
  1459 qed
  1460 
  1461 lemma norm_triangle_half_r:
  1462   "norm (y - x1) < e / 2 \<Longrightarrow> norm (y - x2) < e / 2 \<Longrightarrow> norm (x1 - x2) < e"
  1463   using dist_triangle_half_r unfolding dist_norm[symmetric] by auto
  1464 
  1465 lemma norm_triangle_half_l:
  1466   assumes "norm (x - y) < e / 2"
  1467     and "norm (x' - y) < e / 2"
  1468   shows "norm (x - x') < e"
  1469   using dist_triangle_half_l[OF assms[unfolded dist_norm[symmetric]]]
  1470   unfolding dist_norm[symmetric] .
  1471 
  1472 lemma norm_triangle_le: "norm x + norm y \<le> e \<Longrightarrow> norm (x + y) \<le> e"
  1473   by (rule norm_triangle_ineq [THEN order_trans])
  1474 
  1475 lemma norm_triangle_lt: "norm x + norm y < e \<Longrightarrow> norm (x + y) < e"
  1476   by (rule norm_triangle_ineq [THEN le_less_trans])
  1477 
  1478 lemma setsum_clauses:
  1479   shows "setsum f {} = 0"
  1480     and "finite S \<Longrightarrow> setsum f (insert x S) = (if x \<in> S then setsum f S else f x + setsum f S)"
  1481   by (auto simp add: insert_absorb)
  1482 
  1483 lemma setsum_norm_le:
  1484   fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
  1485   assumes fg: "\<forall>x \<in> S. norm (f x) \<le> g x"
  1486   shows "norm (setsum f S) \<le> setsum g S"
  1487   by (rule order_trans [OF norm_setsum setsum_mono]) (simp add: fg)
  1488 
  1489 lemma setsum_norm_bound:
  1490   fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
  1491   assumes K: "\<forall>x \<in> S. norm (f x) \<le> K"
  1492   shows "norm (setsum f S) \<le> of_nat (card S) * K"
  1493   using setsum_norm_le[OF K] setsum_constant[symmetric]
  1494   by simp
  1495 
  1496 lemma setsum_group:
  1497   assumes fS: "finite S" and fT: "finite T" and fST: "f ` S \<subseteq> T"
  1498   shows "setsum (\<lambda>y. setsum g {x. x \<in> S \<and> f x = y}) T = setsum g S"
  1499   apply (subst setsum_image_gen[OF fS, of g f])
  1500   apply (rule setsum.mono_neutral_right[OF fT fST])
  1501   apply (auto intro: setsum.neutral)
  1502   done
  1503 
  1504 lemma vector_eq_ldot: "(\<forall>x. x \<bullet> y = x \<bullet> z) \<longleftrightarrow> y = z"
  1505 proof
  1506   assume "\<forall>x. x \<bullet> y = x \<bullet> z"
  1507   then have "\<forall>x. x \<bullet> (y - z) = 0"
  1508     by (simp add: inner_diff)
  1509   then have "(y - z) \<bullet> (y - z) = 0" ..
  1510   then show "y = z" by simp
  1511 qed simp
  1512 
  1513 lemma vector_eq_rdot: "(\<forall>z. x \<bullet> z = y \<bullet> z) \<longleftrightarrow> x = y"
  1514 proof
  1515   assume "\<forall>z. x \<bullet> z = y \<bullet> z"
  1516   then have "\<forall>z. (x - y) \<bullet> z = 0"
  1517     by (simp add: inner_diff)
  1518   then have "(x - y) \<bullet> (x - y) = 0" ..
  1519   then show "x = y" by simp
  1520 qed simp
  1521 
  1522 
  1523 subsection \<open>Orthogonality.\<close>
  1524 
  1525 context real_inner
  1526 begin
  1527 
  1528 definition "orthogonal x y \<longleftrightarrow> x \<bullet> y = 0"
  1529 
  1530 lemma orthogonal_self: "orthogonal x x \<longleftrightarrow> x = 0"
  1531   by (simp add: orthogonal_def)
  1532 
  1533 lemma orthogonal_clauses:
  1534   "orthogonal a 0"
  1535   "orthogonal a x \<Longrightarrow> orthogonal a (c *\<^sub>R x)"
  1536   "orthogonal a x \<Longrightarrow> orthogonal a (- x)"
  1537   "orthogonal a x \<Longrightarrow> orthogonal a y \<Longrightarrow> orthogonal a (x + y)"
  1538   "orthogonal a x \<Longrightarrow> orthogonal a y \<Longrightarrow> orthogonal a (x - y)"
  1539   "orthogonal 0 a"
  1540   "orthogonal x a \<Longrightarrow> orthogonal (c *\<^sub>R x) a"
  1541   "orthogonal x a \<Longrightarrow> orthogonal (- x) a"
  1542   "orthogonal x a \<Longrightarrow> orthogonal y a \<Longrightarrow> orthogonal (x + y) a"
  1543   "orthogonal x a \<Longrightarrow> orthogonal y a \<Longrightarrow> orthogonal (x - y) a"
  1544   unfolding orthogonal_def inner_add inner_diff by auto
  1545 
  1546 end
  1547 
  1548 lemma orthogonal_commute: "orthogonal x y \<longleftrightarrow> orthogonal y x"
  1549   by (simp add: orthogonal_def inner_commute)
  1550 
  1551 lemma orthogonal_scaleR [simp]: "c \<noteq> 0 \<Longrightarrow> orthogonal (c *\<^sub>R x) = orthogonal x"
  1552   by (rule ext) (simp add: orthogonal_def)
  1553 
  1554 lemma pairwise_ortho_scaleR:
  1555     "pairwise (\<lambda>i j. orthogonal (f i) (g j)) B
  1556     \<Longrightarrow> pairwise (\<lambda>i j. orthogonal (a i *\<^sub>R f i) (a j *\<^sub>R g j)) B"
  1557   by (auto simp: pairwise_def orthogonal_clauses)
  1558 
  1559 lemma orthogonal_rvsum:
  1560     "\<lbrakk>finite s; \<And>y. y \<in> s \<Longrightarrow> orthogonal x (f y)\<rbrakk> \<Longrightarrow> orthogonal x (setsum f s)"
  1561   by (induction s rule: finite_induct) (auto simp: orthogonal_clauses)
  1562 
  1563 lemma orthogonal_lvsum:
  1564     "\<lbrakk>finite s; \<And>x. x \<in> s \<Longrightarrow> orthogonal (f x) y\<rbrakk> \<Longrightarrow> orthogonal (setsum f s) y"
  1565   by (induction s rule: finite_induct) (auto simp: orthogonal_clauses)
  1566 
  1567 lemma norm_add_Pythagorean:
  1568   assumes "orthogonal a b"
  1569     shows "norm(a + b) ^ 2 = norm a ^ 2 + norm b ^ 2"
  1570 proof -
  1571   from assms have "(a - (0 - b)) \<bullet> (a - (0 - b)) = a \<bullet> a - (0 - b \<bullet> b)"
  1572     by (simp add: algebra_simps orthogonal_def inner_commute)
  1573   then show ?thesis
  1574     by (simp add: power2_norm_eq_inner)
  1575 qed
  1576 
  1577 lemma norm_setsum_Pythagorean:
  1578   assumes "finite I" "pairwise (\<lambda>i j. orthogonal (f i) (f j)) I"
  1579     shows "(norm (setsum f I))\<^sup>2 = (\<Sum>i\<in>I. (norm (f i))\<^sup>2)"
  1580 using assms
  1581 proof (induction I rule: finite_induct)
  1582   case empty then show ?case by simp
  1583 next
  1584   case (insert x I)
  1585   then have "orthogonal (f x) (setsum f I)"
  1586     by (metis pairwise_insert orthogonal_rvsum)
  1587   with insert show ?case
  1588     by (simp add: pairwise_insert norm_add_Pythagorean)
  1589 qed
  1590 
  1591 
  1592 subsection \<open>Bilinear functions.\<close>
  1593 
  1594 definition "bilinear f \<longleftrightarrow> (\<forall>x. linear (\<lambda>y. f x y)) \<and> (\<forall>y. linear (\<lambda>x. f x y))"
  1595 
  1596 lemma bilinear_ladd: "bilinear h \<Longrightarrow> h (x + y) z = h x z + h y z"
  1597   by (simp add: bilinear_def linear_iff)
  1598 
  1599 lemma bilinear_radd: "bilinear h \<Longrightarrow> h x (y + z) = h x y + h x z"
  1600   by (simp add: bilinear_def linear_iff)
  1601 
  1602 lemma bilinear_lmul: "bilinear h \<Longrightarrow> h (c *\<^sub>R x) y = c *\<^sub>R h x y"
  1603   by (simp add: bilinear_def linear_iff)
  1604 
  1605 lemma bilinear_rmul: "bilinear h \<Longrightarrow> h x (c *\<^sub>R y) = c *\<^sub>R h x y"
  1606   by (simp add: bilinear_def linear_iff)
  1607 
  1608 lemma bilinear_lneg: "bilinear h \<Longrightarrow> h (- x) y = - h x y"
  1609   by (drule bilinear_lmul [of _ "- 1"]) simp
  1610 
  1611 lemma bilinear_rneg: "bilinear h \<Longrightarrow> h x (- y) = - h x y"
  1612   by (drule bilinear_rmul [of _ _ "- 1"]) simp
  1613 
  1614 lemma (in ab_group_add) eq_add_iff: "x = x + y \<longleftrightarrow> y = 0"
  1615   using add_left_imp_eq[of x y 0] by auto
  1616 
  1617 lemma bilinear_lzero:
  1618   assumes "bilinear h"
  1619   shows "h 0 x = 0"
  1620   using bilinear_ladd [OF assms, of 0 0 x] by (simp add: eq_add_iff field_simps)
  1621 
  1622 lemma bilinear_rzero:
  1623   assumes "bilinear h"
  1624   shows "h x 0 = 0"
  1625   using bilinear_radd [OF assms, of x 0 0 ] by (simp add: eq_add_iff field_simps)
  1626 
  1627 lemma bilinear_lsub: "bilinear h \<Longrightarrow> h (x - y) z = h x z - h y z"
  1628   using bilinear_ladd [of h x "- y"] by (simp add: bilinear_lneg)
  1629 
  1630 lemma bilinear_rsub: "bilinear h \<Longrightarrow> h z (x - y) = h z x - h z y"
  1631   using bilinear_radd [of h _ x "- y"] by (simp add: bilinear_rneg)
  1632 
  1633 lemma bilinear_setsum:
  1634   assumes bh: "bilinear h"
  1635     and fS: "finite S"
  1636     and fT: "finite T"
  1637   shows "h (setsum f S) (setsum g T) = setsum (\<lambda>(i,j). h (f i) (g j)) (S \<times> T) "
  1638 proof -
  1639   have "h (setsum f S) (setsum g T) = setsum (\<lambda>x. h (f x) (setsum g T)) S"
  1640     apply (rule linear_setsum[unfolded o_def])
  1641     using bh fS
  1642     apply (auto simp add: bilinear_def)
  1643     done
  1644   also have "\<dots> = setsum (\<lambda>x. setsum (\<lambda>y. h (f x) (g y)) T) S"
  1645     apply (rule setsum.cong, simp)
  1646     apply (rule linear_setsum[unfolded o_def])
  1647     using bh fT
  1648     apply (auto simp add: bilinear_def)
  1649     done
  1650   finally show ?thesis
  1651     unfolding setsum.cartesian_product .
  1652 qed
  1653 
  1654 
  1655 subsection \<open>Adjoints.\<close>
  1656 
  1657 definition "adjoint f = (SOME f'. \<forall>x y. f x \<bullet> y = x \<bullet> f' y)"
  1658 
  1659 lemma adjoint_unique:
  1660   assumes "\<forall>x y. inner (f x) y = inner x (g y)"
  1661   shows "adjoint f = g"
  1662   unfolding adjoint_def
  1663 proof (rule some_equality)
  1664   show "\<forall>x y. inner (f x) y = inner x (g y)"
  1665     by (rule assms)
  1666 next
  1667   fix h
  1668   assume "\<forall>x y. inner (f x) y = inner x (h y)"
  1669   then have "\<forall>x y. inner x (g y) = inner x (h y)"
  1670     using assms by simp
  1671   then have "\<forall>x y. inner x (g y - h y) = 0"
  1672     by (simp add: inner_diff_right)
  1673   then have "\<forall>y. inner (g y - h y) (g y - h y) = 0"
  1674     by simp
  1675   then have "\<forall>y. h y = g y"
  1676     by simp
  1677   then show "h = g" by (simp add: ext)
  1678 qed
  1679 
  1680 text \<open>TODO: The following lemmas about adjoints should hold for any
  1681   Hilbert space (i.e. complete inner product space).
  1682   (see \<^url>\<open>http://en.wikipedia.org/wiki/Hermitian_adjoint\<close>)
  1683 \<close>
  1684 
  1685 lemma adjoint_works:
  1686   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
  1687   assumes lf: "linear f"
  1688   shows "x \<bullet> adjoint f y = f x \<bullet> y"
  1689 proof -
  1690   have "\<forall>y. \<exists>w. \<forall>x. f x \<bullet> y = x \<bullet> w"
  1691   proof (intro allI exI)
  1692     fix y :: "'m" and x
  1693     let ?w = "(\<Sum>i\<in>Basis. (f i \<bullet> y) *\<^sub>R i) :: 'n"
  1694     have "f x \<bullet> y = f (\<Sum>i\<in>Basis. (x \<bullet> i) *\<^sub>R i) \<bullet> y"
  1695       by (simp add: euclidean_representation)
  1696     also have "\<dots> = (\<Sum>i\<in>Basis. (x \<bullet> i) *\<^sub>R f i) \<bullet> y"
  1697       unfolding linear_setsum[OF lf]
  1698       by (simp add: linear_cmul[OF lf])
  1699     finally show "f x \<bullet> y = x \<bullet> ?w"
  1700       by (simp add: inner_setsum_left inner_setsum_right mult.commute)
  1701   qed
  1702   then show ?thesis
  1703     unfolding adjoint_def choice_iff
  1704     by (intro someI2_ex[where Q="\<lambda>f'. x \<bullet> f' y = f x \<bullet> y"]) auto
  1705 qed
  1706 
  1707 lemma adjoint_clauses:
  1708   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
  1709   assumes lf: "linear f"
  1710   shows "x \<bullet> adjoint f y = f x \<bullet> y"
  1711     and "adjoint f y \<bullet> x = y \<bullet> f x"
  1712   by (simp_all add: adjoint_works[OF lf] inner_commute)
  1713 
  1714 lemma adjoint_linear:
  1715   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
  1716   assumes lf: "linear f"
  1717   shows "linear (adjoint f)"
  1718   by (simp add: lf linear_iff euclidean_eq_iff[where 'a='n] euclidean_eq_iff[where 'a='m]
  1719     adjoint_clauses[OF lf] inner_distrib)
  1720 
  1721 lemma adjoint_adjoint:
  1722   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
  1723   assumes lf: "linear f"
  1724   shows "adjoint (adjoint f) = f"
  1725   by (rule adjoint_unique, simp add: adjoint_clauses [OF lf])
  1726 
  1727 
  1728 subsection \<open>Interlude: Some properties of real sets\<close>
  1729 
  1730 lemma seq_mono_lemma:
  1731   assumes "\<forall>(n::nat) \<ge> m. (d n :: real) < e n"
  1732     and "\<forall>n \<ge> m. e n \<le> e m"
  1733   shows "\<forall>n \<ge> m. d n < e m"
  1734   using assms
  1735   apply auto
  1736   apply (erule_tac x="n" in allE)
  1737   apply (erule_tac x="n" in allE)
  1738   apply auto
  1739   done
  1740 
  1741 lemma infinite_enumerate:
  1742   assumes fS: "infinite S"
  1743   shows "\<exists>r. subseq r \<and> (\<forall>n. r n \<in> S)"
  1744   unfolding subseq_def
  1745   using enumerate_in_set[OF fS] enumerate_mono[of _ _ S] fS by auto
  1746 
  1747 lemma approachable_lt_le: "(\<exists>(d::real) > 0. \<forall>x. f x < d \<longrightarrow> P x) \<longleftrightarrow> (\<exists>d>0. \<forall>x. f x \<le> d \<longrightarrow> P x)"
  1748   apply auto
  1749   apply (rule_tac x="d/2" in exI)
  1750   apply auto
  1751   done
  1752 
  1753 lemma approachable_lt_le2:  \<comment>\<open>like the above, but pushes aside an extra formula\<close>
  1754     "(\<exists>(d::real) > 0. \<forall>x. Q x \<longrightarrow> f x < d \<longrightarrow> P x) \<longleftrightarrow> (\<exists>d>0. \<forall>x. f x \<le> d \<longrightarrow> Q x \<longrightarrow> P x)"
  1755   apply auto
  1756   apply (rule_tac x="d/2" in exI, auto)
  1757   done
  1758 
  1759 lemma triangle_lemma:
  1760   fixes x y z :: real
  1761   assumes x: "0 \<le> x"
  1762     and y: "0 \<le> y"
  1763     and z: "0 \<le> z"
  1764     and xy: "x\<^sup>2 \<le> y\<^sup>2 + z\<^sup>2"
  1765   shows "x \<le> y + z"
  1766 proof -
  1767   have "y\<^sup>2 + z\<^sup>2 \<le> y\<^sup>2 + 2 * y * z + z\<^sup>2"
  1768     using z y by simp
  1769   with xy have th: "x\<^sup>2 \<le> (y + z)\<^sup>2"
  1770     by (simp add: power2_eq_square field_simps)
  1771   from y z have yz: "y + z \<ge> 0"
  1772     by arith
  1773   from power2_le_imp_le[OF th yz] show ?thesis .
  1774 qed
  1775 
  1776 
  1777 
  1778 subsection \<open>Archimedean properties and useful consequences\<close>
  1779 
  1780 text\<open>Bernoulli's inequality\<close>
  1781 proposition Bernoulli_inequality:
  1782   fixes x :: real
  1783   assumes "-1 \<le> x"
  1784     shows "1 + n * x \<le> (1 + x) ^ n"
  1785 proof (induct n)
  1786   case 0
  1787   then show ?case by simp
  1788 next
  1789   case (Suc n)
  1790   have "1 + Suc n * x \<le> 1 + (Suc n)*x + n * x^2"
  1791     by (simp add: algebra_simps)
  1792   also have "... = (1 + x) * (1 + n*x)"
  1793     by (auto simp: power2_eq_square algebra_simps  of_nat_Suc)
  1794   also have "... \<le> (1 + x) ^ Suc n"
  1795     using Suc.hyps assms mult_left_mono by fastforce
  1796   finally show ?case .
  1797 qed
  1798 
  1799 corollary Bernoulli_inequality_even:
  1800   fixes x :: real
  1801   assumes "even n"
  1802     shows "1 + n * x \<le> (1 + x) ^ n"
  1803 proof (cases "-1 \<le> x \<or> n=0")
  1804   case True
  1805   then show ?thesis
  1806     by (auto simp: Bernoulli_inequality)
  1807 next
  1808   case False
  1809   then have "real n \<ge> 1"
  1810     by simp
  1811   with False have "n * x \<le> -1"
  1812     by (metis linear minus_zero mult.commute mult.left_neutral mult_left_mono_neg neg_le_iff_le order_trans zero_le_one)
  1813   then have "1 + n * x \<le> 0"
  1814     by auto
  1815   also have "... \<le> (1 + x) ^ n"
  1816     using assms
  1817     using zero_le_even_power by blast
  1818   finally show ?thesis .
  1819 qed
  1820 
  1821 corollary real_arch_pow:
  1822   fixes x :: real
  1823   assumes x: "1 < x"
  1824   shows "\<exists>n. y < x^n"
  1825 proof -
  1826   from x have x0: "x - 1 > 0"
  1827     by arith
  1828   from reals_Archimedean3[OF x0, rule_format, of y]
  1829   obtain n :: nat where n: "y < real n * (x - 1)" by metis
  1830   from x0 have x00: "x- 1 \<ge> -1" by arith
  1831   from Bernoulli_inequality[OF x00, of n] n
  1832   have "y < x^n" by auto
  1833   then show ?thesis by metis
  1834 qed
  1835 
  1836 corollary real_arch_pow_inv:
  1837   fixes x y :: real
  1838   assumes y: "y > 0"
  1839     and x1: "x < 1"
  1840   shows "\<exists>n. x^n < y"
  1841 proof (cases "x > 0")
  1842   case True
  1843   with x1 have ix: "1 < 1/x" by (simp add: field_simps)
  1844   from real_arch_pow[OF ix, of "1/y"]
  1845   obtain n where n: "1/y < (1/x)^n" by blast
  1846   then show ?thesis using y \<open>x > 0\<close>
  1847     by (auto simp add: field_simps)
  1848 next
  1849   case False
  1850   with y x1 show ?thesis
  1851     apply auto
  1852     apply (rule exI[where x=1])
  1853     apply auto
  1854     done
  1855 qed
  1856 
  1857 lemma forall_pos_mono:
  1858   "(\<And>d e::real. d < e \<Longrightarrow> P d \<Longrightarrow> P e) \<Longrightarrow>
  1859     (\<And>n::nat. n \<noteq> 0 \<Longrightarrow> P (inverse (real n))) \<Longrightarrow> (\<And>e. 0 < e \<Longrightarrow> P e)"
  1860   by (metis real_arch_inverse)
  1861 
  1862 lemma forall_pos_mono_1:
  1863   "(\<And>d e::real. d < e \<Longrightarrow> P d \<Longrightarrow> P e) \<Longrightarrow>
  1864     (\<And>n. P (inverse (real (Suc n)))) \<Longrightarrow> 0 < e \<Longrightarrow> P e"
  1865   apply (rule forall_pos_mono)
  1866   apply auto
  1867   apply (metis Suc_pred of_nat_Suc)
  1868   done
  1869 
  1870 
  1871 subsection \<open>Euclidean Spaces as Typeclass\<close>
  1872 
  1873 lemma independent_Basis: "independent Basis"
  1874   unfolding dependent_def
  1875   apply (subst span_finite)
  1876   apply simp
  1877   apply clarify
  1878   apply (drule_tac f="inner a" in arg_cong)
  1879   apply (simp add: inner_Basis inner_setsum_right eq_commute)
  1880   done
  1881 
  1882 lemma span_Basis [simp]: "span Basis = UNIV"
  1883   unfolding span_finite [OF finite_Basis]
  1884   by (fast intro: euclidean_representation)
  1885 
  1886 lemma in_span_Basis: "x \<in> span Basis"
  1887   unfolding span_Basis ..
  1888 
  1889 lemma Basis_le_norm: "b \<in> Basis \<Longrightarrow> \<bar>x \<bullet> b\<bar> \<le> norm x"
  1890   by (rule order_trans [OF Cauchy_Schwarz_ineq2]) simp
  1891 
  1892 lemma norm_bound_Basis_le: "b \<in> Basis \<Longrightarrow> norm x \<le> e \<Longrightarrow> \<bar>x \<bullet> b\<bar> \<le> e"
  1893   by (metis Basis_le_norm order_trans)
  1894 
  1895 lemma norm_bound_Basis_lt: "b \<in> Basis \<Longrightarrow> norm x < e \<Longrightarrow> \<bar>x \<bullet> b\<bar> < e"
  1896   by (metis Basis_le_norm le_less_trans)
  1897 
  1898 lemma norm_le_l1: "norm x \<le> (\<Sum>b\<in>Basis. \<bar>x \<bullet> b\<bar>)"
  1899   apply (subst euclidean_representation[of x, symmetric])
  1900   apply (rule order_trans[OF norm_setsum])
  1901   apply (auto intro!: setsum_mono)
  1902   done
  1903 
  1904 lemma setsum_norm_allsubsets_bound:
  1905   fixes f :: "'a \<Rightarrow> 'n::euclidean_space"
  1906   assumes fP: "finite P"
  1907     and fPs: "\<And>Q. Q \<subseteq> P \<Longrightarrow> norm (setsum f Q) \<le> e"
  1908   shows "(\<Sum>x\<in>P. norm (f x)) \<le> 2 * real DIM('n) * e"
  1909 proof -
  1910   have "(\<Sum>x\<in>P. norm (f x)) \<le> (\<Sum>x\<in>P. \<Sum>b\<in>Basis. \<bar>f x \<bullet> b\<bar>)"
  1911     by (rule setsum_mono) (rule norm_le_l1)
  1912   also have "(\<Sum>x\<in>P. \<Sum>b\<in>Basis. \<bar>f x \<bullet> b\<bar>) = (\<Sum>b\<in>Basis. \<Sum>x\<in>P. \<bar>f x \<bullet> b\<bar>)"
  1913     by (rule setsum.commute)
  1914   also have "\<dots> \<le> of_nat (card (Basis :: 'n set)) * (2 * e)"
  1915   proof (rule setsum_bounded_above)
  1916     fix i :: 'n
  1917     assume i: "i \<in> Basis"
  1918     have "norm (\<Sum>x\<in>P. \<bar>f x \<bullet> i\<bar>) \<le>
  1919       norm ((\<Sum>x\<in>P \<inter> - {x. f x \<bullet> i < 0}. f x) \<bullet> i) + norm ((\<Sum>x\<in>P \<inter> {x. f x \<bullet> i < 0}. f x) \<bullet> i)"
  1920       by (simp add: abs_real_def setsum.If_cases[OF fP] setsum_negf norm_triangle_ineq4 inner_setsum_left
  1921         del: real_norm_def)
  1922     also have "\<dots> \<le> e + e"
  1923       unfolding real_norm_def
  1924       by (intro add_mono norm_bound_Basis_le i fPs) auto
  1925     finally show "(\<Sum>x\<in>P. \<bar>f x \<bullet> i\<bar>) \<le> 2*e" by simp
  1926   qed
  1927   also have "\<dots> = 2 * real DIM('n) * e" by simp
  1928   finally show ?thesis .
  1929 qed
  1930 
  1931 
  1932 subsection \<open>Linearity and Bilinearity continued\<close>
  1933 
  1934 lemma linear_bounded:
  1935   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  1936   assumes lf: "linear f"
  1937   shows "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
  1938 proof
  1939   let ?B = "\<Sum>b\<in>Basis. norm (f b)"
  1940   show "\<forall>x. norm (f x) \<le> ?B * norm x"
  1941   proof
  1942     fix x :: 'a
  1943     let ?g = "\<lambda>b. (x \<bullet> b) *\<^sub>R f b"
  1944     have "norm (f x) = norm (f (\<Sum>b\<in>Basis. (x \<bullet> b) *\<^sub>R b))"
  1945       unfolding euclidean_representation ..
  1946     also have "\<dots> = norm (setsum ?g Basis)"
  1947       by (simp add: linear_setsum [OF lf] linear_cmul [OF lf])
  1948     finally have th0: "norm (f x) = norm (setsum ?g Basis)" .
  1949     have th: "\<forall>b\<in>Basis. norm (?g b) \<le> norm (f b) * norm x"
  1950     proof
  1951       fix i :: 'a
  1952       assume i: "i \<in> Basis"
  1953       from Basis_le_norm[OF i, of x]
  1954       show "norm (?g i) \<le> norm (f i) * norm x"
  1955         unfolding norm_scaleR
  1956         apply (subst mult.commute)
  1957         apply (rule mult_mono)
  1958         apply (auto simp add: field_simps)
  1959         done
  1960     qed
  1961     from setsum_norm_le[of _ ?g, OF th]
  1962     show "norm (f x) \<le> ?B * norm x"
  1963       unfolding th0 setsum_distrib_right by metis
  1964   qed
  1965 qed
  1966 
  1967 lemma linear_conv_bounded_linear:
  1968   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  1969   shows "linear f \<longleftrightarrow> bounded_linear f"
  1970 proof
  1971   assume "linear f"
  1972   then interpret f: linear f .
  1973   show "bounded_linear f"
  1974   proof
  1975     have "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
  1976       using \<open>linear f\<close> by (rule linear_bounded)
  1977     then show "\<exists>K. \<forall>x. norm (f x) \<le> norm x * K"
  1978       by (simp add: mult.commute)
  1979   qed
  1980 next
  1981   assume "bounded_linear f"
  1982   then interpret f: bounded_linear f .
  1983   show "linear f" ..
  1984 qed
  1985 
  1986 lemmas linear_linear = linear_conv_bounded_linear[symmetric]
  1987 
  1988 lemma linear_bounded_pos:
  1989   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  1990   assumes lf: "linear f"
  1991   shows "\<exists>B > 0. \<forall>x. norm (f x) \<le> B * norm x"
  1992 proof -
  1993   have "\<exists>B > 0. \<forall>x. norm (f x) \<le> norm x * B"
  1994     using lf unfolding linear_conv_bounded_linear
  1995     by (rule bounded_linear.pos_bounded)
  1996   then show ?thesis
  1997     by (simp only: mult.commute)
  1998 qed
  1999 
  2000 lemma bounded_linearI':
  2001   fixes f ::"'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  2002   assumes "\<And>x y. f (x + y) = f x + f y"
  2003     and "\<And>c x. f (c *\<^sub>R x) = c *\<^sub>R f x"
  2004   shows "bounded_linear f"
  2005   unfolding linear_conv_bounded_linear[symmetric]
  2006   by (rule linearI[OF assms])
  2007 
  2008 lemma bilinear_bounded:
  2009   fixes h :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space \<Rightarrow> 'k::real_normed_vector"
  2010   assumes bh: "bilinear h"
  2011   shows "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
  2012 proof (clarify intro!: exI[of _ "\<Sum>i\<in>Basis. \<Sum>j\<in>Basis. norm (h i j)"])
  2013   fix x :: 'm
  2014   fix y :: 'n
  2015   have "norm (h x y) = norm (h (setsum (\<lambda>i. (x \<bullet> i) *\<^sub>R i) Basis) (setsum (\<lambda>i. (y \<bullet> i) *\<^sub>R i) Basis))"
  2016     apply (subst euclidean_representation[where 'a='m])
  2017     apply (subst euclidean_representation[where 'a='n])
  2018     apply rule
  2019     done
  2020   also have "\<dots> = norm (setsum (\<lambda> (i,j). h ((x \<bullet> i) *\<^sub>R i) ((y \<bullet> j) *\<^sub>R j)) (Basis \<times> Basis))"
  2021     unfolding bilinear_setsum[OF bh finite_Basis finite_Basis] ..
  2022   finally have th: "norm (h x y) = \<dots>" .
  2023   show "norm (h x y) \<le> (\<Sum>i\<in>Basis. \<Sum>j\<in>Basis. norm (h i j)) * norm x * norm y"
  2024     apply (auto simp add: setsum_distrib_right th setsum.cartesian_product)
  2025     apply (rule setsum_norm_le)
  2026     apply simp
  2027     apply (auto simp add: bilinear_rmul[OF bh] bilinear_lmul[OF bh]
  2028       field_simps simp del: scaleR_scaleR)
  2029     apply (rule mult_mono)
  2030     apply (auto simp add: zero_le_mult_iff Basis_le_norm)
  2031     apply (rule mult_mono)
  2032     apply (auto simp add: zero_le_mult_iff Basis_le_norm)
  2033     done
  2034 qed
  2035 
  2036 lemma bilinear_conv_bounded_bilinear:
  2037   fixes h :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::real_normed_vector"
  2038   shows "bilinear h \<longleftrightarrow> bounded_bilinear h"
  2039 proof
  2040   assume "bilinear h"
  2041   show "bounded_bilinear h"
  2042   proof
  2043     fix x y z
  2044     show "h (x + y) z = h x z + h y z"
  2045       using \<open>bilinear h\<close> unfolding bilinear_def linear_iff by simp
  2046   next
  2047     fix x y z
  2048     show "h x (y + z) = h x y + h x z"
  2049       using \<open>bilinear h\<close> unfolding bilinear_def linear_iff by simp
  2050   next
  2051     fix r x y
  2052     show "h (scaleR r x) y = scaleR r (h x y)"
  2053       using \<open>bilinear h\<close> unfolding bilinear_def linear_iff
  2054       by simp
  2055   next
  2056     fix r x y
  2057     show "h x (scaleR r y) = scaleR r (h x y)"
  2058       using \<open>bilinear h\<close> unfolding bilinear_def linear_iff
  2059       by simp
  2060   next
  2061     have "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
  2062       using \<open>bilinear h\<close> by (rule bilinear_bounded)
  2063     then show "\<exists>K. \<forall>x y. norm (h x y) \<le> norm x * norm y * K"
  2064       by (simp add: ac_simps)
  2065   qed
  2066 next
  2067   assume "bounded_bilinear h"
  2068   then interpret h: bounded_bilinear h .
  2069   show "bilinear h"
  2070     unfolding bilinear_def linear_conv_bounded_linear
  2071     using h.bounded_linear_left h.bounded_linear_right by simp
  2072 qed
  2073 
  2074 lemma bilinear_bounded_pos:
  2075   fixes h :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::real_normed_vector"
  2076   assumes bh: "bilinear h"
  2077   shows "\<exists>B > 0. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
  2078 proof -
  2079   have "\<exists>B > 0. \<forall>x y. norm (h x y) \<le> norm x * norm y * B"
  2080     using bh [unfolded bilinear_conv_bounded_bilinear]
  2081     by (rule bounded_bilinear.pos_bounded)
  2082   then show ?thesis
  2083     by (simp only: ac_simps)
  2084 qed
  2085 
  2086 lemma bounded_linear_imp_has_derivative:
  2087      "bounded_linear f \<Longrightarrow> (f has_derivative f) net"
  2088   by (simp add: has_derivative_def bounded_linear.linear linear_diff)
  2089 
  2090 lemma linear_imp_has_derivative:
  2091   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  2092   shows "linear f \<Longrightarrow> (f has_derivative f) net"
  2093 by (simp add: has_derivative_def linear_conv_bounded_linear linear_diff)
  2094 
  2095 lemma bounded_linear_imp_differentiable: "bounded_linear f \<Longrightarrow> f differentiable net"
  2096   using bounded_linear_imp_has_derivative differentiable_def by blast
  2097 
  2098 lemma linear_imp_differentiable:
  2099   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  2100   shows "linear f \<Longrightarrow> f differentiable net"
  2101 by (metis linear_imp_has_derivative differentiable_def)
  2102 
  2103 
  2104 subsection \<open>We continue.\<close>
  2105 
  2106 lemma independent_bound:
  2107   fixes S :: "'a::euclidean_space set"
  2108   shows "independent S \<Longrightarrow> finite S \<and> card S \<le> DIM('a)"
  2109   using independent_span_bound[OF finite_Basis, of S] by auto
  2110 
  2111 corollary
  2112   fixes S :: "'a::euclidean_space set"
  2113   assumes "independent S"
  2114   shows independent_imp_finite: "finite S" and independent_card_le:"card S \<le> DIM('a)"
  2115 using assms independent_bound by auto
  2116 
  2117 lemma independent_explicit:
  2118   fixes B :: "'a::euclidean_space set"
  2119   shows "independent B \<longleftrightarrow>
  2120          finite B \<and> (\<forall>c. (\<Sum>v\<in>B. c v *\<^sub>R v) = 0 \<longrightarrow> (\<forall>v \<in> B. c v = 0))"
  2121 apply (cases "finite B")
  2122  apply (force simp: dependent_finite)
  2123 using independent_bound
  2124 apply auto
  2125 done
  2126 
  2127 lemma dependent_biggerset:
  2128   fixes S :: "'a::euclidean_space set"
  2129   shows "(finite S \<Longrightarrow> card S > DIM('a)) \<Longrightarrow> dependent S"
  2130   by (metis independent_bound not_less)
  2131 
  2132 text \<open>Notion of dimension.\<close>
  2133 
  2134 definition "dim V = (SOME n. \<exists>B. B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> card B = n)"
  2135 
  2136 lemma basis_exists:
  2137   "\<exists>B. (B :: ('a::euclidean_space) set) \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> (card B = dim V)"
  2138   unfolding dim_def some_eq_ex[of "\<lambda>n. \<exists>B. B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> (card B = n)"]
  2139   using maximal_independent_subset[of V] independent_bound
  2140   by auto
  2141 
  2142 corollary dim_le_card:
  2143   fixes s :: "'a::euclidean_space set"
  2144   shows "finite s \<Longrightarrow> dim s \<le> card s"
  2145 by (metis basis_exists card_mono)
  2146 
  2147 text \<open>Consequences of independence or spanning for cardinality.\<close>
  2148 
  2149 lemma independent_card_le_dim:
  2150   fixes B :: "'a::euclidean_space set"
  2151   assumes "B \<subseteq> V"
  2152     and "independent B"
  2153   shows "card B \<le> dim V"
  2154 proof -
  2155   from basis_exists[of V] \<open>B \<subseteq> V\<close>
  2156   obtain B' where "independent B'"
  2157     and "B \<subseteq> span B'"
  2158     and "card B' = dim V"
  2159     by blast
  2160   with independent_span_bound[OF _ \<open>independent B\<close> \<open>B \<subseteq> span B'\<close>] independent_bound[of B']
  2161   show ?thesis by auto
  2162 qed
  2163 
  2164 lemma span_card_ge_dim:
  2165   fixes B :: "'a::euclidean_space set"
  2166   shows "B \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> finite B \<Longrightarrow> dim V \<le> card B"
  2167   by (metis basis_exists[of V] independent_span_bound subset_trans)
  2168 
  2169 lemma basis_card_eq_dim:
  2170   fixes V :: "'a::euclidean_space set"
  2171   shows "B \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> independent B \<Longrightarrow> finite B \<and> card B = dim V"
  2172   by (metis order_eq_iff independent_card_le_dim span_card_ge_dim independent_bound)
  2173 
  2174 lemma dim_unique:
  2175   fixes B :: "'a::euclidean_space set"
  2176   shows "B \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> independent B \<Longrightarrow> card B = n \<Longrightarrow> dim V = n"
  2177   by (metis basis_card_eq_dim)
  2178 
  2179 text \<open>More lemmas about dimension.\<close>
  2180 
  2181 lemma dim_UNIV: "dim (UNIV :: 'a::euclidean_space set) = DIM('a)"
  2182   using independent_Basis
  2183   by (intro dim_unique[of Basis]) auto
  2184 
  2185 lemma dim_subset:
  2186   fixes S :: "'a::euclidean_space set"
  2187   shows "S \<subseteq> T \<Longrightarrow> dim S \<le> dim T"
  2188   using basis_exists[of T] basis_exists[of S]
  2189   by (metis independent_card_le_dim subset_trans)
  2190 
  2191 lemma dim_subset_UNIV:
  2192   fixes S :: "'a::euclidean_space set"
  2193   shows "dim S \<le> DIM('a)"
  2194   by (metis dim_subset subset_UNIV dim_UNIV)
  2195 
  2196 text \<open>Converses to those.\<close>
  2197 
  2198 lemma card_ge_dim_independent:
  2199   fixes B :: "'a::euclidean_space set"
  2200   assumes BV: "B \<subseteq> V"
  2201     and iB: "independent B"
  2202     and dVB: "dim V \<le> card B"
  2203   shows "V \<subseteq> span B"
  2204 proof
  2205   fix a
  2206   assume aV: "a \<in> V"
  2207   {
  2208     assume aB: "a \<notin> span B"
  2209     then have iaB: "independent (insert a B)"
  2210       using iB aV BV by (simp add: independent_insert)
  2211     from aV BV have th0: "insert a B \<subseteq> V"
  2212       by blast
  2213     from aB have "a \<notin>B"
  2214       by (auto simp add: span_superset)
  2215     with independent_card_le_dim[OF th0 iaB] dVB independent_bound[OF iB]
  2216     have False by auto
  2217   }
  2218   then show "a \<in> span B" by blast
  2219 qed
  2220 
  2221 lemma card_le_dim_spanning:
  2222   assumes BV: "(B:: ('a::euclidean_space) set) \<subseteq> V"
  2223     and VB: "V \<subseteq> span B"
  2224     and fB: "finite B"
  2225     and dVB: "dim V \<ge> card B"
  2226   shows "independent B"
  2227 proof -
  2228   {
  2229     fix a
  2230     assume a: "a \<in> B" "a \<in> span (B - {a})"
  2231     from a fB have c0: "card B \<noteq> 0"
  2232       by auto
  2233     from a fB have cb: "card (B - {a}) = card B - 1"
  2234       by auto
  2235     from BV a have th0: "B - {a} \<subseteq> V"
  2236       by blast
  2237     {
  2238       fix x
  2239       assume x: "x \<in> V"
  2240       from a have eq: "insert a (B - {a}) = B"
  2241         by blast
  2242       from x VB have x': "x \<in> span B"
  2243         by blast
  2244       from span_trans[OF a(2), unfolded eq, OF x']
  2245       have "x \<in> span (B - {a})" .
  2246     }
  2247     then have th1: "V \<subseteq> span (B - {a})"
  2248       by blast
  2249     have th2: "finite (B - {a})"
  2250       using fB by auto
  2251     from span_card_ge_dim[OF th0 th1 th2]
  2252     have c: "dim V \<le> card (B - {a})" .
  2253     from c c0 dVB cb have False by simp
  2254   }
  2255   then show ?thesis
  2256     unfolding dependent_def by blast
  2257 qed
  2258 
  2259 lemma card_eq_dim:
  2260   fixes B :: "'a::euclidean_space set"
  2261   shows "B \<subseteq> V \<Longrightarrow> card B = dim V \<Longrightarrow> finite B \<Longrightarrow> independent B \<longleftrightarrow> V \<subseteq> span B"
  2262   by (metis order_eq_iff card_le_dim_spanning card_ge_dim_independent)
  2263 
  2264 text \<open>More general size bound lemmas.\<close>
  2265 
  2266 lemma independent_bound_general:
  2267   fixes S :: "'a::euclidean_space set"
  2268   shows "independent S \<Longrightarrow> finite S \<and> card S \<le> dim S"
  2269   by (metis independent_card_le_dim independent_bound subset_refl)
  2270 
  2271 lemma dependent_biggerset_general:
  2272   fixes S :: "'a::euclidean_space set"
  2273   shows "(finite S \<Longrightarrow> card S > dim S) \<Longrightarrow> dependent S"
  2274   using independent_bound_general[of S] by (metis linorder_not_le)
  2275 
  2276 lemma dim_span [simp]:
  2277   fixes S :: "'a::euclidean_space set"
  2278   shows "dim (span S) = dim S"
  2279 proof -
  2280   have th0: "dim S \<le> dim (span S)"
  2281     by (auto simp add: subset_eq intro: dim_subset span_superset)
  2282   from basis_exists[of S]
  2283   obtain B where B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "card B = dim S"
  2284     by blast
  2285   from B have fB: "finite B" "card B = dim S"
  2286     using independent_bound by blast+
  2287   have bSS: "B \<subseteq> span S"
  2288     using B(1) by (metis subset_eq span_inc)
  2289   have sssB: "span S \<subseteq> span B"
  2290     using span_mono[OF B(3)] by (simp add: span_span)
  2291   from span_card_ge_dim[OF bSS sssB fB(1)] th0 show ?thesis
  2292     using fB(2) by arith
  2293 qed
  2294 
  2295 lemma subset_le_dim:
  2296   fixes S :: "'a::euclidean_space set"
  2297   shows "S \<subseteq> span T \<Longrightarrow> dim S \<le> dim T"
  2298   by (metis dim_span dim_subset)
  2299 
  2300 lemma span_eq_dim:
  2301   fixes S :: "'a::euclidean_space set"
  2302   shows "span S = span T \<Longrightarrow> dim S = dim T"
  2303   by (metis dim_span)
  2304 
  2305 lemma dim_image_le:
  2306   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2307   assumes lf: "linear f"
  2308   shows "dim (f ` S) \<le> dim (S)"
  2309 proof -
  2310   from basis_exists[of S] obtain B where
  2311     B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "card B = dim S" by blast
  2312   from B have fB: "finite B" "card B = dim S"
  2313     using independent_bound by blast+
  2314   have "dim (f ` S) \<le> card (f ` B)"
  2315     apply (rule span_card_ge_dim)
  2316     using lf B fB
  2317     apply (auto simp add: span_linear_image spans_image subset_image_iff)
  2318     done
  2319   also have "\<dots> \<le> dim S"
  2320     using card_image_le[OF fB(1)] fB by simp
  2321   finally show ?thesis .
  2322 qed
  2323 
  2324 text \<open>Picking an orthogonal replacement for a spanning set.\<close>
  2325 
  2326 lemma vector_sub_project_orthogonal:
  2327   fixes b x :: "'a::euclidean_space"
  2328   shows "b \<bullet> (x - ((b \<bullet> x) / (b \<bullet> b)) *\<^sub>R b) = 0"
  2329   unfolding inner_simps by auto
  2330 
  2331 lemma pairwise_orthogonal_insert:
  2332   assumes "pairwise orthogonal S"
  2333     and "\<And>y. y \<in> S \<Longrightarrow> orthogonal x y"
  2334   shows "pairwise orthogonal (insert x S)"
  2335   using assms unfolding pairwise_def
  2336   by (auto simp add: orthogonal_commute)
  2337 
  2338 lemma basis_orthogonal:
  2339   fixes B :: "'a::real_inner set"
  2340   assumes fB: "finite B"
  2341   shows "\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C"
  2342   (is " \<exists>C. ?P B C")
  2343   using fB
  2344 proof (induct rule: finite_induct)
  2345   case empty
  2346   then show ?case
  2347     apply (rule exI[where x="{}"])
  2348     apply (auto simp add: pairwise_def)
  2349     done
  2350 next
  2351   case (insert a B)
  2352   note fB = \<open>finite B\<close> and aB = \<open>a \<notin> B\<close>
  2353   from \<open>\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C\<close>
  2354   obtain C where C: "finite C" "card C \<le> card B"
  2355     "span C = span B" "pairwise orthogonal C" by blast
  2356   let ?a = "a - setsum (\<lambda>x. (x \<bullet> a / (x \<bullet> x)) *\<^sub>R x) C"
  2357   let ?C = "insert ?a C"
  2358   from C(1) have fC: "finite ?C"
  2359     by simp
  2360   from fB aB C(1,2) have cC: "card ?C \<le> card (insert a B)"
  2361     by (simp add: card_insert_if)
  2362   {
  2363     fix x k
  2364     have th0: "\<And>(a::'a) b c. a - (b - c) = c + (a - b)"
  2365       by (simp add: field_simps)
  2366     have "x - k *\<^sub>R (a - (\<Sum>x\<in>C. (x \<bullet> a / (x \<bullet> x)) *\<^sub>R x)) \<in> span C \<longleftrightarrow> x - k *\<^sub>R a \<in> span C"
  2367       apply (simp only: scaleR_right_diff_distrib th0)
  2368       apply (rule span_add_eq)
  2369       apply (rule span_mul)
  2370       apply (rule span_setsum)
  2371       apply (rule span_mul)
  2372       apply (rule span_superset)
  2373       apply assumption
  2374       done
  2375   }
  2376   then have SC: "span ?C = span (insert a B)"
  2377     unfolding set_eq_iff span_breakdown_eq C(3)[symmetric] by auto
  2378   {
  2379     fix y
  2380     assume yC: "y \<in> C"
  2381     then have Cy: "C = insert y (C - {y})"
  2382       by blast
  2383     have fth: "finite (C - {y})"
  2384       using C by simp
  2385     have "orthogonal ?a y"
  2386       unfolding orthogonal_def
  2387       unfolding inner_diff inner_setsum_left right_minus_eq
  2388       unfolding setsum.remove [OF \<open>finite C\<close> \<open>y \<in> C\<close>]
  2389       apply (clarsimp simp add: inner_commute[of y a])
  2390       apply (rule setsum.neutral)
  2391       apply clarsimp
  2392       apply (rule C(4)[unfolded pairwise_def orthogonal_def, rule_format])
  2393       using \<open>y \<in> C\<close> by auto
  2394   }
  2395   with \<open>pairwise orthogonal C\<close> have CPO: "pairwise orthogonal ?C"
  2396     by (rule pairwise_orthogonal_insert)
  2397   from fC cC SC CPO have "?P (insert a B) ?C"
  2398     by blast
  2399   then show ?case by blast
  2400 qed
  2401 
  2402 lemma orthogonal_basis_exists:
  2403   fixes V :: "('a::euclidean_space) set"
  2404   shows "\<exists>B. independent B \<and> B \<subseteq> span V \<and> V \<subseteq> span B \<and> (card B = dim V) \<and> pairwise orthogonal B"
  2405 proof -
  2406   from basis_exists[of V] obtain B where
  2407     B: "B \<subseteq> V" "independent B" "V \<subseteq> span B" "card B = dim V"
  2408     by blast
  2409   from B have fB: "finite B" "card B = dim V"
  2410     using independent_bound by auto
  2411   from basis_orthogonal[OF fB(1)] obtain C where
  2412     C: "finite C" "card C \<le> card B" "span C = span B" "pairwise orthogonal C"
  2413     by blast
  2414   from C B have CSV: "C \<subseteq> span V"
  2415     by (metis span_inc span_mono subset_trans)
  2416   from span_mono[OF B(3)] C have SVC: "span V \<subseteq> span C"
  2417     by (simp add: span_span)
  2418   from card_le_dim_spanning[OF CSV SVC C(1)] C(2,3) fB
  2419   have iC: "independent C"
  2420     by (simp add: dim_span)
  2421   from C fB have "card C \<le> dim V"
  2422     by simp
  2423   moreover have "dim V \<le> card C"
  2424     using span_card_ge_dim[OF CSV SVC C(1)]
  2425     by (simp add: dim_span)
  2426   ultimately have CdV: "card C = dim V"
  2427     using C(1) by simp
  2428   from C B CSV CdV iC show ?thesis
  2429     by auto
  2430 qed
  2431 
  2432 text \<open>Low-dimensional subset is in a hyperplane (weak orthogonal complement).\<close>
  2433 
  2434 lemma span_not_univ_orthogonal:
  2435   fixes S :: "'a::euclidean_space set"
  2436   assumes sU: "span S \<noteq> UNIV"
  2437   shows "\<exists>a::'a. a \<noteq> 0 \<and> (\<forall>x \<in> span S. a \<bullet> x = 0)"
  2438 proof -
  2439   from sU obtain a where a: "a \<notin> span S"
  2440     by blast
  2441   from orthogonal_basis_exists obtain B where
  2442     B: "independent B" "B \<subseteq> span S" "S \<subseteq> span B" "card B = dim S" "pairwise orthogonal B"
  2443     by blast
  2444   from B have fB: "finite B" "card B = dim S"
  2445     using independent_bound by auto
  2446   from span_mono[OF B(2)] span_mono[OF B(3)]
  2447   have sSB: "span S = span B"
  2448     by (simp add: span_span)
  2449   let ?a = "a - setsum (\<lambda>b. (a \<bullet> b / (b \<bullet> b)) *\<^sub>R b) B"
  2450   have "setsum (\<lambda>b. (a \<bullet> b / (b \<bullet> b)) *\<^sub>R b) B \<in> span S"
  2451     unfolding sSB
  2452     apply (rule span_setsum)
  2453     apply (rule span_mul)
  2454     apply (rule span_superset)
  2455     apply assumption
  2456     done
  2457   with a have a0:"?a  \<noteq> 0"
  2458     by auto
  2459   have "\<forall>x\<in>span B. ?a \<bullet> x = 0"
  2460   proof (rule span_induct')
  2461     show "subspace {x. ?a \<bullet> x = 0}"
  2462       by (auto simp add: subspace_def inner_add)
  2463   next
  2464     {
  2465       fix x
  2466       assume x: "x \<in> B"
  2467       from x have B': "B = insert x (B - {x})"
  2468         by blast
  2469       have fth: "finite (B - {x})"
  2470         using fB by simp
  2471       have "?a \<bullet> x = 0"
  2472         apply (subst B')
  2473         using fB fth
  2474         unfolding setsum_clauses(2)[OF fth]
  2475         apply simp unfolding inner_simps
  2476         apply (clarsimp simp add: inner_add inner_setsum_left)
  2477         apply (rule setsum.neutral, rule ballI)
  2478         apply (simp only: inner_commute)
  2479         apply (auto simp add: x field_simps
  2480           intro: B(5)[unfolded pairwise_def orthogonal_def, rule_format])
  2481         done
  2482     }
  2483     then show "\<forall>x \<in> B. ?a \<bullet> x = 0"
  2484       by blast
  2485   qed
  2486   with a0 show ?thesis
  2487     unfolding sSB by (auto intro: exI[where x="?a"])
  2488 qed
  2489 
  2490 lemma span_not_univ_subset_hyperplane:
  2491   fixes S :: "'a::euclidean_space set"
  2492   assumes SU: "span S \<noteq> UNIV"
  2493   shows "\<exists> a. a \<noteq>0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
  2494   using span_not_univ_orthogonal[OF SU] by auto
  2495 
  2496 lemma lowdim_subset_hyperplane:
  2497   fixes S :: "'a::euclidean_space set"
  2498   assumes d: "dim S < DIM('a)"
  2499   shows "\<exists>a::'a. a \<noteq> 0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
  2500 proof -
  2501   {
  2502     assume "span S = UNIV"
  2503     then have "dim (span S) = dim (UNIV :: ('a) set)"
  2504       by simp
  2505     then have "dim S = DIM('a)"
  2506       by (simp add: dim_span dim_UNIV)
  2507     with d have False by arith
  2508   }
  2509   then have th: "span S \<noteq> UNIV"
  2510     by blast
  2511   from span_not_univ_subset_hyperplane[OF th] show ?thesis .
  2512 qed
  2513 
  2514 text \<open>We can extend a linear basis-basis injection to the whole set.\<close>
  2515 
  2516 lemma linear_indep_image_lemma:
  2517   assumes lf: "linear f"
  2518     and fB: "finite B"
  2519     and ifB: "independent (f ` B)"
  2520     and fi: "inj_on f B"
  2521     and xsB: "x \<in> span B"
  2522     and fx: "f x = 0"
  2523   shows "x = 0"
  2524   using fB ifB fi xsB fx
  2525 proof (induct arbitrary: x rule: finite_induct[OF fB])
  2526   case 1
  2527   then show ?case by auto
  2528 next
  2529   case (2 a b x)
  2530   have fb: "finite b" using "2.prems" by simp
  2531   have th0: "f ` b \<subseteq> f ` (insert a b)"
  2532     apply (rule image_mono)
  2533     apply blast
  2534     done
  2535   from independent_mono[ OF "2.prems"(2) th0]
  2536   have ifb: "independent (f ` b)"  .
  2537   have fib: "inj_on f b"
  2538     apply (rule subset_inj_on [OF "2.prems"(3)])
  2539     apply blast
  2540     done
  2541   from span_breakdown[of a "insert a b", simplified, OF "2.prems"(4)]
  2542   obtain k where k: "x - k*\<^sub>R a \<in> span (b - {a})"
  2543     by blast
  2544   have "f (x - k*\<^sub>R a) \<in> span (f ` b)"
  2545     unfolding span_linear_image[OF lf]
  2546     apply (rule imageI)
  2547     using k span_mono[of "b - {a}" b]
  2548     apply blast
  2549     done
  2550   then have "f x - k*\<^sub>R f a \<in> span (f ` b)"
  2551     by (simp add: linear_diff[OF lf] linear_cmul[OF lf])
  2552   then have th: "-k *\<^sub>R f a \<in> span (f ` b)"
  2553     using "2.prems"(5) by simp
  2554   have xsb: "x \<in> span b"
  2555   proof (cases "k = 0")
  2556     case True
  2557     with k have "x \<in> span (b - {a})" by simp
  2558     then show ?thesis using span_mono[of "b - {a}" b]
  2559       by blast
  2560   next
  2561     case False
  2562     with span_mul[OF th, of "- 1/ k"]
  2563     have th1: "f a \<in> span (f ` b)"
  2564       by auto
  2565     from inj_on_image_set_diff[OF "2.prems"(3), of "insert a b " "{a}", symmetric]
  2566     have tha: "f ` insert a b - f ` {a} = f ` (insert a b - {a})" by blast
  2567     from "2.prems"(2) [unfolded dependent_def bex_simps(8), rule_format, of "f a"]
  2568     have "f a \<notin> span (f ` b)" using tha
  2569       using "2.hyps"(2)
  2570       "2.prems"(3) by auto
  2571     with th1 have False by blast
  2572     then show ?thesis by blast
  2573   qed
  2574   from "2.hyps"(3)[OF fb ifb fib xsb "2.prems"(5)] show "x = 0" .
  2575 qed
  2576 
  2577 text \<open>Can construct an isomorphism between spaces of same dimension.\<close>
  2578 
  2579 lemma subspace_isomorphism:
  2580   fixes S :: "'a::euclidean_space set"
  2581     and T :: "'b::euclidean_space set"
  2582   assumes s: "subspace S"
  2583     and t: "subspace T"
  2584     and d: "dim S = dim T"
  2585   shows "\<exists>f. linear f \<and> f ` S = T \<and> inj_on f S"
  2586 proof -
  2587   from basis_exists[of S] independent_bound
  2588   obtain B where B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "card B = dim S" and fB: "finite B"
  2589     by blast
  2590   from basis_exists[of T] independent_bound
  2591   obtain C where C: "C \<subseteq> T" "independent C" "T \<subseteq> span C" "card C = dim T" and fC: "finite C"
  2592     by blast
  2593   from B(4) C(4) card_le_inj[of B C] d
  2594   obtain f where f: "f ` B \<subseteq> C" "inj_on f B" using \<open>finite B\<close> \<open>finite C\<close>
  2595     by auto
  2596   from linear_independent_extend[OF B(2)]
  2597   obtain g where g: "linear g" "\<forall>x\<in> B. g x = f x"
  2598     by blast
  2599   from inj_on_iff_eq_card[OF fB, of f] f(2) have "card (f ` B) = card B"
  2600     by simp
  2601   with B(4) C(4) have ceq: "card (f ` B) = card C"
  2602     using d by simp
  2603   have "g ` B = f ` B"
  2604     using g(2) by (auto simp add: image_iff)
  2605   also have "\<dots> = C" using card_subset_eq[OF fC f(1) ceq] .
  2606   finally have gBC: "g ` B = C" .
  2607   have gi: "inj_on g B"
  2608     using f(2) g(2) by (auto simp add: inj_on_def)
  2609   note g0 = linear_indep_image_lemma[OF g(1) fB, unfolded gBC, OF C(2) gi]
  2610   {
  2611     fix x y
  2612     assume x: "x \<in> S" and y: "y \<in> S" and gxy: "g x = g y"
  2613     from B(3) x y have x': "x \<in> span B" and y': "y \<in> span B"
  2614       by blast+
  2615     from gxy have th0: "g (x - y) = 0"
  2616       by (simp add: linear_diff[OF g(1)])
  2617     have th1: "x - y \<in> span B"
  2618       using x' y' by (metis span_diff)
  2619     have "x = y"
  2620       using g0[OF th1 th0] by simp
  2621   }
  2622   then have giS: "inj_on g S"
  2623     unfolding inj_on_def by blast
  2624   from span_subspace[OF B(1,3) s] have "g ` S = span (g ` B)"
  2625     by (simp add: span_linear_image[OF g(1)])
  2626   also have "\<dots> = span C" unfolding gBC ..
  2627   also have "\<dots> = T" using span_subspace[OF C(1,3) t] .
  2628   finally have gS: "g ` S = T" .
  2629   from g(1) gS giS show ?thesis
  2630     by blast
  2631 qed
  2632 
  2633 lemma linear_eq_stdbasis:
  2634   fixes f :: "'a::euclidean_space \<Rightarrow> _"
  2635   assumes lf: "linear f"
  2636     and lg: "linear g"
  2637     and fg: "\<forall>b\<in>Basis. f b = g b"
  2638   shows "f = g"
  2639   using linear_eq[OF lf lg, of _ Basis] fg by auto
  2640 
  2641 text \<open>Similar results for bilinear functions.\<close>
  2642 
  2643 lemma bilinear_eq:
  2644   assumes bf: "bilinear f"
  2645     and bg: "bilinear g"
  2646     and SB: "S \<subseteq> span B"
  2647     and TC: "T \<subseteq> span C"
  2648     and fg: "\<forall>x\<in> B. \<forall>y\<in> C. f x y = g x y"
  2649   shows "\<forall>x\<in>S. \<forall>y\<in>T. f x y = g x y "
  2650 proof -
  2651   let ?P = "{x. \<forall>y\<in> span C. f x y = g x y}"
  2652   from bf bg have sp: "subspace ?P"
  2653     unfolding bilinear_def linear_iff subspace_def bf bg
  2654     by (auto simp add: span_0 bilinear_lzero[OF bf] bilinear_lzero[OF bg] span_add Ball_def
  2655       intro: bilinear_ladd[OF bf])
  2656 
  2657   have "\<forall>x \<in> span B. \<forall>y\<in> span C. f x y = g x y"
  2658     apply (rule span_induct' [OF _ sp])
  2659     apply (rule ballI)
  2660     apply (rule span_induct')
  2661     apply (simp add: fg)
  2662     apply (auto simp add: subspace_def)
  2663     using bf bg unfolding bilinear_def linear_iff
  2664     apply (auto simp add: span_0 bilinear_rzero[OF bf] bilinear_rzero[OF bg] span_add Ball_def
  2665       intro: bilinear_ladd[OF bf])
  2666     done
  2667   then show ?thesis
  2668     using SB TC by auto
  2669 qed
  2670 
  2671 lemma bilinear_eq_stdbasis:
  2672   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> _"
  2673   assumes bf: "bilinear f"
  2674     and bg: "bilinear g"
  2675     and fg: "\<forall>i\<in>Basis. \<forall>j\<in>Basis. f i j = g i j"
  2676   shows "f = g"
  2677   using bilinear_eq[OF bf bg equalityD2[OF span_Basis] equalityD2[OF span_Basis] fg] by blast
  2678 
  2679 text \<open>An injective map @{typ "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"} is also surjective.\<close>
  2680 
  2681 lemma linear_injective_imp_surjective:
  2682   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2683   assumes lf: "linear f"
  2684     and fi: "inj f"
  2685   shows "surj f"
  2686 proof -
  2687   let ?U = "UNIV :: 'a set"
  2688   from basis_exists[of ?U] obtain B
  2689     where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" "card B = dim ?U"
  2690     by blast
  2691   from B(4) have d: "dim ?U = card B"
  2692     by simp
  2693   have th: "?U \<subseteq> span (f ` B)"
  2694     apply (rule card_ge_dim_independent)
  2695     apply blast
  2696     apply (rule independent_injective_image[OF B(2) lf fi])
  2697     apply (rule order_eq_refl)
  2698     apply (rule sym)
  2699     unfolding d
  2700     apply (rule card_image)
  2701     apply (rule subset_inj_on[OF fi])
  2702     apply blast
  2703     done
  2704   from th show ?thesis
  2705     unfolding span_linear_image[OF lf] surj_def
  2706     using B(3) by blast
  2707 qed
  2708 
  2709 text \<open>And vice versa.\<close>
  2710 
  2711 lemma surjective_iff_injective_gen:
  2712   assumes fS: "finite S"
  2713     and fT: "finite T"
  2714     and c: "card S = card T"
  2715     and ST: "f ` S \<subseteq> T"
  2716   shows "(\<forall>y \<in> T. \<exists>x \<in> S. f x = y) \<longleftrightarrow> inj_on f S"
  2717   (is "?lhs \<longleftrightarrow> ?rhs")
  2718 proof
  2719   assume h: "?lhs"
  2720   {
  2721     fix x y
  2722     assume x: "x \<in> S"
  2723     assume y: "y \<in> S"
  2724     assume f: "f x = f y"
  2725     from x fS have S0: "card S \<noteq> 0"
  2726       by auto
  2727     have "x = y"
  2728     proof (rule ccontr)
  2729       assume xy: "\<not> ?thesis"
  2730       have th: "card S \<le> card (f ` (S - {y}))"
  2731         unfolding c
  2732         apply (rule card_mono)
  2733         apply (rule finite_imageI)
  2734         using fS apply simp
  2735         using h xy x y f unfolding subset_eq image_iff
  2736         apply auto
  2737         apply (case_tac "xa = f x")
  2738         apply (rule bexI[where x=x])
  2739         apply auto
  2740         done
  2741       also have " \<dots> \<le> card (S - {y})"
  2742         apply (rule card_image_le)
  2743         using fS by simp
  2744       also have "\<dots> \<le> card S - 1" using y fS by simp
  2745       finally show False using S0 by arith
  2746     qed
  2747   }
  2748   then show ?rhs
  2749     unfolding inj_on_def by blast
  2750 next
  2751   assume h: ?rhs
  2752   have "f ` S = T"
  2753     apply (rule card_subset_eq[OF fT ST])
  2754     unfolding card_image[OF h]
  2755     apply (rule c)
  2756     done
  2757   then show ?lhs by blast
  2758 qed
  2759 
  2760 lemma linear_surjective_imp_injective:
  2761   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2762   assumes lf: "linear f"
  2763     and sf: "surj f"
  2764   shows "inj f"
  2765 proof -
  2766   let ?U = "UNIV :: 'a set"
  2767   from basis_exists[of ?U] obtain B
  2768     where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" and d: "card B = dim ?U"
  2769     by blast
  2770   {
  2771     fix x
  2772     assume x: "x \<in> span B"
  2773     assume fx: "f x = 0"
  2774     from B(2) have fB: "finite B"
  2775       using independent_bound by auto
  2776     have fBi: "independent (f ` B)"
  2777       apply (rule card_le_dim_spanning[of "f ` B" ?U])
  2778       apply blast
  2779       using sf B(3)
  2780       unfolding span_linear_image[OF lf] surj_def subset_eq image_iff
  2781       apply blast
  2782       using fB apply blast
  2783       unfolding d[symmetric]
  2784       apply (rule card_image_le)
  2785       apply (rule fB)
  2786       done
  2787     have th0: "dim ?U \<le> card (f ` B)"
  2788       apply (rule span_card_ge_dim)
  2789       apply blast
  2790       unfolding span_linear_image[OF lf]
  2791       apply (rule subset_trans[where B = "f ` UNIV"])
  2792       using sf unfolding surj_def
  2793       apply blast
  2794       apply (rule image_mono)
  2795       apply (rule B(3))
  2796       apply (metis finite_imageI fB)
  2797       done
  2798     moreover have "card (f ` B) \<le> card B"
  2799       by (rule card_image_le, rule fB)
  2800     ultimately have th1: "card B = card (f ` B)"
  2801       unfolding d by arith
  2802     have fiB: "inj_on f B"
  2803       unfolding surjective_iff_injective_gen[OF fB finite_imageI[OF fB] th1 subset_refl, symmetric]
  2804       by blast
  2805     from linear_indep_image_lemma[OF lf fB fBi fiB x] fx
  2806     have "x = 0" by blast
  2807   }
  2808   then show ?thesis
  2809     unfolding linear_injective_0[OF lf]
  2810     using B(3)
  2811     by blast
  2812 qed
  2813 
  2814 text \<open>Hence either is enough for isomorphism.\<close>
  2815 
  2816 lemma left_right_inverse_eq:
  2817   assumes fg: "f \<circ> g = id"
  2818     and gh: "g \<circ> h = id"
  2819   shows "f = h"
  2820 proof -
  2821   have "f = f \<circ> (g \<circ> h)"
  2822     unfolding gh by simp
  2823   also have "\<dots> = (f \<circ> g) \<circ> h"
  2824     by (simp add: o_assoc)
  2825   finally show "f = h"
  2826     unfolding fg by simp
  2827 qed
  2828 
  2829 lemma isomorphism_expand:
  2830   "f \<circ> g = id \<and> g \<circ> f = id \<longleftrightarrow> (\<forall>x. f (g x) = x) \<and> (\<forall>x. g (f x) = x)"
  2831   by (simp add: fun_eq_iff o_def id_def)
  2832 
  2833 lemma linear_injective_isomorphism:
  2834   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2835   assumes lf: "linear f"
  2836     and fi: "inj f"
  2837   shows "\<exists>f'. linear f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)"
  2838   unfolding isomorphism_expand[symmetric]
  2839   using linear_surjective_right_inverse[OF lf linear_injective_imp_surjective[OF lf fi]]
  2840     linear_injective_left_inverse[OF lf fi]
  2841   by (metis left_right_inverse_eq)
  2842 
  2843 lemma linear_surjective_isomorphism:
  2844   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2845   assumes lf: "linear f"
  2846     and sf: "surj f"
  2847   shows "\<exists>f'. linear f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)"
  2848   unfolding isomorphism_expand[symmetric]
  2849   using linear_surjective_right_inverse[OF lf sf]
  2850     linear_injective_left_inverse[OF lf linear_surjective_imp_injective[OF lf sf]]
  2851   by (metis left_right_inverse_eq)
  2852 
  2853 text \<open>Left and right inverses are the same for
  2854   @{typ "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"}.\<close>
  2855 
  2856 lemma linear_inverse_left:
  2857   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2858   assumes lf: "linear f"
  2859     and lf': "linear f'"
  2860   shows "f \<circ> f' = id \<longleftrightarrow> f' \<circ> f = id"
  2861 proof -
  2862   {
  2863     fix f f':: "'a \<Rightarrow> 'a"
  2864     assume lf: "linear f" "linear f'"
  2865     assume f: "f \<circ> f' = id"
  2866     from f have sf: "surj f"
  2867       apply (auto simp add: o_def id_def surj_def)
  2868       apply metis
  2869       done
  2870     from linear_surjective_isomorphism[OF lf(1) sf] lf f
  2871     have "f' \<circ> f = id"
  2872       unfolding fun_eq_iff o_def id_def by metis
  2873   }
  2874   then show ?thesis
  2875     using lf lf' by metis
  2876 qed
  2877 
  2878 text \<open>Moreover, a one-sided inverse is automatically linear.\<close>
  2879 
  2880 lemma left_inverse_linear:
  2881   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2882   assumes lf: "linear f"
  2883     and gf: "g \<circ> f = id"
  2884   shows "linear g"
  2885 proof -
  2886   from gf have fi: "inj f"
  2887     apply (auto simp add: inj_on_def o_def id_def fun_eq_iff)
  2888     apply metis
  2889     done
  2890   from linear_injective_isomorphism[OF lf fi]
  2891   obtain h :: "'a \<Rightarrow> 'a" where h: "linear h" "\<forall>x. h (f x) = x" "\<forall>x. f (h x) = x"
  2892     by blast
  2893   have "h = g"
  2894     apply (rule ext) using gf h(2,3)
  2895     apply (simp add: o_def id_def fun_eq_iff)
  2896     apply metis
  2897     done
  2898   with h(1) show ?thesis by blast
  2899 qed
  2900 
  2901 lemma inj_linear_imp_inv_linear:
  2902   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2903   assumes "linear f" "inj f" shows "linear (inv f)"
  2904 using assms inj_iff left_inverse_linear by blast
  2905 
  2906 
  2907 subsection \<open>Infinity norm\<close>
  2908 
  2909 definition "infnorm (x::'a::euclidean_space) = Sup {\<bar>x \<bullet> b\<bar> |b. b \<in> Basis}"
  2910 
  2911 lemma infnorm_set_image:
  2912   fixes x :: "'a::euclidean_space"
  2913   shows "{\<bar>x \<bullet> i\<bar> |i. i \<in> Basis} = (\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis"
  2914   by blast
  2915 
  2916 lemma infnorm_Max:
  2917   fixes x :: "'a::euclidean_space"
  2918   shows "infnorm x = Max ((\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis)"
  2919   by (simp add: infnorm_def infnorm_set_image cSup_eq_Max)
  2920 
  2921 lemma infnorm_set_lemma:
  2922   fixes x :: "'a::euclidean_space"
  2923   shows "finite {\<bar>x \<bullet> i\<bar> |i. i \<in> Basis}"
  2924     and "{\<bar>x \<bullet> i\<bar> |i. i \<in> Basis} \<noteq> {}"
  2925   unfolding infnorm_set_image
  2926   by auto
  2927 
  2928 lemma infnorm_pos_le:
  2929   fixes x :: "'a::euclidean_space"
  2930   shows "0 \<le> infnorm x"
  2931   by (simp add: infnorm_Max Max_ge_iff ex_in_conv)
  2932 
  2933 lemma infnorm_triangle:
  2934   fixes x :: "'a::euclidean_space"
  2935   shows "infnorm (x + y) \<le> infnorm x + infnorm y"
  2936 proof -
  2937   have *: "\<And>a b c d :: real. \<bar>a\<bar> \<le> c \<Longrightarrow> \<bar>b\<bar> \<le> d \<Longrightarrow> \<bar>a + b\<bar> \<le> c + d"
  2938     by simp
  2939   show ?thesis
  2940     by (auto simp: infnorm_Max inner_add_left intro!: *)
  2941 qed
  2942 
  2943 lemma infnorm_eq_0:
  2944   fixes x :: "'a::euclidean_space"
  2945   shows "infnorm x = 0 \<longleftrightarrow> x = 0"
  2946 proof -
  2947   have "infnorm x \<le> 0 \<longleftrightarrow> x = 0"
  2948     unfolding infnorm_Max by (simp add: euclidean_all_zero_iff)
  2949   then show ?thesis
  2950     using infnorm_pos_le[of x] by simp
  2951 qed
  2952 
  2953 lemma infnorm_0: "infnorm 0 = 0"
  2954   by (simp add: infnorm_eq_0)
  2955 
  2956 lemma infnorm_neg: "infnorm (- x) = infnorm x"
  2957   unfolding infnorm_def
  2958   apply (rule cong[of "Sup" "Sup"])
  2959   apply blast
  2960   apply auto
  2961   done
  2962 
  2963 lemma infnorm_sub: "infnorm (x - y) = infnorm (y - x)"
  2964 proof -
  2965   have "y - x = - (x - y)" by simp
  2966   then show ?thesis
  2967     by (metis infnorm_neg)
  2968 qed
  2969 
  2970 lemma real_abs_sub_infnorm: "\<bar>infnorm x - infnorm y\<bar> \<le> infnorm (x - y)"
  2971 proof -
  2972   have th: "\<And>(nx::real) n ny. nx \<le> n + ny \<Longrightarrow> ny \<le> n + nx \<Longrightarrow> \<bar>nx - ny\<bar> \<le> n"
  2973     by arith
  2974   from infnorm_triangle[of "x - y" " y"] infnorm_triangle[of "x - y" "-x"]
  2975   have ths: "infnorm x \<le> infnorm (x - y) + infnorm y"
  2976     "infnorm y \<le> infnorm (x - y) + infnorm x"
  2977     by (simp_all add: field_simps infnorm_neg)
  2978   from th[OF ths] show ?thesis .
  2979 qed
  2980 
  2981 lemma real_abs_infnorm: "\<bar>infnorm x\<bar> = infnorm x"
  2982   using infnorm_pos_le[of x] by arith
  2983 
  2984 lemma Basis_le_infnorm:
  2985   fixes x :: "'a::euclidean_space"
  2986   shows "b \<in> Basis \<Longrightarrow> \<bar>x \<bullet> b\<bar> \<le> infnorm x"
  2987   by (simp add: infnorm_Max)
  2988 
  2989 lemma infnorm_mul: "infnorm (a *\<^sub>R x) = \<bar>a\<bar> * infnorm x"
  2990   unfolding infnorm_Max
  2991 proof (safe intro!: Max_eqI)
  2992   let ?B = "(\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis"
  2993   {
  2994     fix b :: 'a
  2995     assume "b \<in> Basis"
  2996     then show "\<bar>a *\<^sub>R x \<bullet> b\<bar> \<le> \<bar>a\<bar> * Max ?B"
  2997       by (simp add: abs_mult mult_left_mono)
  2998   next
  2999     from Max_in[of ?B] obtain b where "b \<in> Basis" "Max ?B = \<bar>x \<bullet> b\<bar>"
  3000       by (auto simp del: Max_in)
  3001     then show "\<bar>a\<bar> * Max ((\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis) \<in> (\<lambda>i. \<bar>a *\<^sub>R x \<bullet> i\<bar>) ` Basis"
  3002       by (intro image_eqI[where x=b]) (auto simp: abs_mult)
  3003   }
  3004 qed simp
  3005 
  3006 lemma infnorm_mul_lemma: "infnorm (a *\<^sub>R x) \<le> \<bar>a\<bar> * infnorm x"
  3007   unfolding infnorm_mul ..
  3008 
  3009 lemma infnorm_pos_lt: "infnorm x > 0 \<longleftrightarrow> x \<noteq> 0"
  3010   using infnorm_pos_le[of x] infnorm_eq_0[of x] by arith
  3011 
  3012 text \<open>Prove that it differs only up to a bound from Euclidean norm.\<close>
  3013 
  3014 lemma infnorm_le_norm: "infnorm x \<le> norm x"
  3015   by (simp add: Basis_le_norm infnorm_Max)
  3016 
  3017 lemma (in euclidean_space) euclidean_inner: "inner x y = (\<Sum>b\<in>Basis. (x \<bullet> b) * (y \<bullet> b))"
  3018   by (subst (1 2) euclidean_representation [symmetric])
  3019     (simp add: inner_setsum_right inner_Basis ac_simps)
  3020 
  3021 lemma norm_le_infnorm:
  3022   fixes x :: "'a::euclidean_space"
  3023   shows "norm x \<le> sqrt DIM('a) * infnorm x"
  3024 proof -
  3025   let ?d = "DIM('a)"
  3026   have "real ?d \<ge> 0"
  3027     by simp
  3028   then have d2: "(sqrt (real ?d))\<^sup>2 = real ?d"
  3029     by (auto intro: real_sqrt_pow2)
  3030   have th: "sqrt (real ?d) * infnorm x \<ge> 0"
  3031     by (simp add: zero_le_mult_iff infnorm_pos_le)
  3032   have th1: "x \<bullet> x \<le> (sqrt (real ?d) * infnorm x)\<^sup>2"
  3033     unfolding power_mult_distrib d2
  3034     apply (subst euclidean_inner)
  3035     apply (subst power2_abs[symmetric])
  3036     apply (rule order_trans[OF setsum_bounded_above[where K="\<bar>infnorm x\<bar>\<^sup>2"]])
  3037     apply (auto simp add: power2_eq_square[symmetric])
  3038     apply (subst power2_abs[symmetric])
  3039     apply (rule power_mono)
  3040     apply (auto simp: infnorm_Max)
  3041     done
  3042   from real_le_lsqrt[OF inner_ge_zero th th1]
  3043   show ?thesis
  3044     unfolding norm_eq_sqrt_inner id_def .
  3045 qed
  3046 
  3047 lemma tendsto_infnorm [tendsto_intros]:
  3048   assumes "(f \<longlongrightarrow> a) F"
  3049   shows "((\<lambda>x. infnorm (f x)) \<longlongrightarrow> infnorm a) F"
  3050 proof (rule tendsto_compose [OF LIM_I assms])
  3051   fix r :: real
  3052   assume "r > 0"
  3053   then show "\<exists>s>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < s \<longrightarrow> norm (infnorm x - infnorm a) < r"
  3054     by (metis real_norm_def le_less_trans real_abs_sub_infnorm infnorm_le_norm)
  3055 qed
  3056 
  3057 text \<open>Equality in Cauchy-Schwarz and triangle inequalities.\<close>
  3058 
  3059 lemma norm_cauchy_schwarz_eq: "x \<bullet> y = norm x * norm y \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
  3060   (is "?lhs \<longleftrightarrow> ?rhs")
  3061 proof -
  3062   {
  3063     assume h: "x = 0"
  3064     then have ?thesis by simp
  3065   }
  3066   moreover
  3067   {
  3068     assume h: "y = 0"
  3069     then have ?thesis by simp
  3070   }
  3071   moreover
  3072   {
  3073     assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
  3074     from inner_eq_zero_iff[of "norm y *\<^sub>R x - norm x *\<^sub>R y"]
  3075     have "?rhs \<longleftrightarrow>
  3076       (norm y * (norm y * norm x * norm x - norm x * (x \<bullet> y)) -
  3077         norm x * (norm y * (y \<bullet> x) - norm x * norm y * norm y) =  0)"
  3078       using x y
  3079       unfolding inner_simps
  3080       unfolding power2_norm_eq_inner[symmetric] power2_eq_square right_minus_eq
  3081       apply (simp add: inner_commute)
  3082       apply (simp add: field_simps)
  3083       apply metis
  3084       done
  3085     also have "\<dots> \<longleftrightarrow> (2 * norm x * norm y * (norm x * norm y - x \<bullet> y) = 0)" using x y
  3086       by (simp add: field_simps inner_commute)
  3087     also have "\<dots> \<longleftrightarrow> ?lhs" using x y
  3088       apply simp
  3089       apply metis
  3090       done
  3091     finally have ?thesis by blast
  3092   }
  3093   ultimately show ?thesis by blast
  3094 qed
  3095 
  3096 lemma norm_cauchy_schwarz_abs_eq:
  3097   "\<bar>x \<bullet> y\<bar> = norm x * norm y \<longleftrightarrow>
  3098     norm x *\<^sub>R y = norm y *\<^sub>R x \<or> norm x *\<^sub>R y = - norm y *\<^sub>R x"
  3099   (is "?lhs \<longleftrightarrow> ?rhs")
  3100 proof -
  3101   have th: "\<And>(x::real) a. a \<ge> 0 \<Longrightarrow> \<bar>x\<bar> = a \<longleftrightarrow> x = a \<or> x = - a"
  3102     by arith
  3103   have "?rhs \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x \<or> norm (- x) *\<^sub>R y = norm y *\<^sub>R (- x)"
  3104     by simp
  3105   also have "\<dots> \<longleftrightarrow>(x \<bullet> y = norm x * norm y \<or> (- x) \<bullet> y = norm x * norm y)"
  3106     unfolding norm_cauchy_schwarz_eq[symmetric]
  3107     unfolding norm_minus_cancel norm_scaleR ..
  3108   also have "\<dots> \<longleftrightarrow> ?lhs"
  3109     unfolding th[OF mult_nonneg_nonneg, OF norm_ge_zero[of x] norm_ge_zero[of y]] inner_simps
  3110     by auto
  3111   finally show ?thesis ..
  3112 qed
  3113 
  3114 lemma norm_triangle_eq:
  3115   fixes x y :: "'a::real_inner"
  3116   shows "norm (x + y) = norm x + norm y \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
  3117 proof -
  3118   {
  3119     assume x: "x = 0 \<or> y = 0"
  3120     then have ?thesis
  3121       by (cases "x = 0") simp_all
  3122   }
  3123   moreover
  3124   {
  3125     assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
  3126     then have "norm x \<noteq> 0" "norm y \<noteq> 0"
  3127       by simp_all
  3128     then have n: "norm x > 0" "norm y > 0"
  3129       using norm_ge_zero[of x] norm_ge_zero[of y] by arith+
  3130     have th: "\<And>(a::real) b c. a + b + c \<noteq> 0 \<Longrightarrow> a = b + c \<longleftrightarrow> a\<^sup>2 = (b + c)\<^sup>2"
  3131       by algebra
  3132     have "norm (x + y) = norm x + norm y \<longleftrightarrow> (norm (x + y))\<^sup>2 = (norm x + norm y)\<^sup>2"
  3133       apply (rule th)
  3134       using n norm_ge_zero[of "x + y"]
  3135       apply arith
  3136       done
  3137     also have "\<dots> \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
  3138       unfolding norm_cauchy_schwarz_eq[symmetric]
  3139       unfolding power2_norm_eq_inner inner_simps
  3140       by (simp add: power2_norm_eq_inner[symmetric] power2_eq_square inner_commute field_simps)
  3141     finally have ?thesis .
  3142   }
  3143   ultimately show ?thesis by blast
  3144 qed
  3145 
  3146 
  3147 subsection \<open>Collinearity\<close>
  3148 
  3149 definition collinear :: "'a::real_vector set \<Rightarrow> bool"
  3150   where "collinear S \<longleftrightarrow> (\<exists>u. \<forall>x \<in> S. \<forall> y \<in> S. \<exists>c. x - y = c *\<^sub>R u)"
  3151 
  3152 lemma collinear_subset: "\<lbrakk>collinear T; S \<subseteq> T\<rbrakk> \<Longrightarrow> collinear S"
  3153   by (meson collinear_def subsetCE)
  3154 
  3155 lemma collinear_empty [iff]: "collinear {}"
  3156   by (simp add: collinear_def)
  3157 
  3158 lemma collinear_sing [iff]: "collinear {x}"
  3159   by (simp add: collinear_def)
  3160 
  3161 lemma collinear_2 [iff]: "collinear {x, y}"
  3162   apply (simp add: collinear_def)
  3163   apply (rule exI[where x="x - y"])
  3164   apply auto
  3165   apply (rule exI[where x=1], simp)
  3166   apply (rule exI[where x="- 1"], simp)
  3167   done
  3168 
  3169 lemma collinear_lemma: "collinear {0, x, y} \<longleftrightarrow> x = 0 \<or> y = 0 \<or> (\<exists>c. y = c *\<^sub>R x)"
  3170   (is "?lhs \<longleftrightarrow> ?rhs")
  3171 proof -
  3172   {
  3173     assume "x = 0 \<or> y = 0"
  3174     then have ?thesis
  3175       by (cases "x = 0") (simp_all add: collinear_2 insert_commute)
  3176   }
  3177   moreover
  3178   {
  3179     assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
  3180     have ?thesis
  3181     proof
  3182       assume h: "?lhs"
  3183       then obtain u where u: "\<forall> x\<in> {0,x,y}. \<forall>y\<in> {0,x,y}. \<exists>c. x - y = c *\<^sub>R u"
  3184         unfolding collinear_def by blast
  3185       from u[rule_format, of x 0] u[rule_format, of y 0]
  3186       obtain cx and cy where
  3187         cx: "x = cx *\<^sub>R u" and cy: "y = cy *\<^sub>R u"
  3188         by auto
  3189       from cx x have cx0: "cx \<noteq> 0" by auto
  3190       from cy y have cy0: "cy \<noteq> 0" by auto
  3191       let ?d = "cy / cx"
  3192       from cx cy cx0 have "y = ?d *\<^sub>R x"
  3193         by simp
  3194       then show ?rhs using x y by blast
  3195     next
  3196       assume h: "?rhs"
  3197       then obtain c where c: "y = c *\<^sub>R x"
  3198         using x y by blast
  3199       show ?lhs
  3200         unfolding collinear_def c
  3201         apply (rule exI[where x=x])
  3202         apply auto
  3203         apply (rule exI[where x="- 1"], simp)
  3204         apply (rule exI[where x= "-c"], simp)
  3205         apply (rule exI[where x=1], simp)
  3206         apply (rule exI[where x="1 - c"], simp add: scaleR_left_diff_distrib)
  3207         apply (rule exI[where x="c - 1"], simp add: scaleR_left_diff_distrib)
  3208         done
  3209     qed
  3210   }
  3211   ultimately show ?thesis by blast
  3212 qed
  3213 
  3214 lemma norm_cauchy_schwarz_equal: "\<bar>x \<bullet> y\<bar> = norm x * norm y \<longleftrightarrow> collinear {0, x, y}"
  3215   unfolding norm_cauchy_schwarz_abs_eq
  3216   apply (cases "x=0", simp_all)
  3217   apply (cases "y=0", simp_all add: insert_commute)
  3218   unfolding collinear_lemma
  3219   apply simp
  3220   apply (subgoal_tac "norm x \<noteq> 0")
  3221   apply (subgoal_tac "norm y \<noteq> 0")
  3222   apply (rule iffI)
  3223   apply (cases "norm x *\<^sub>R y = norm y *\<^sub>R x")
  3224   apply (rule exI[where x="(1/norm x) * norm y"])
  3225   apply (drule sym)
  3226   unfolding scaleR_scaleR[symmetric]
  3227   apply (simp add: field_simps)
  3228   apply (rule exI[where x="(1/norm x) * - norm y"])
  3229   apply clarify
  3230   apply (drule sym)
  3231   unfolding scaleR_scaleR[symmetric]
  3232   apply (simp add: field_simps)
  3233   apply (erule exE)
  3234   apply (erule ssubst)
  3235   unfolding scaleR_scaleR
  3236   unfolding norm_scaleR
  3237   apply (subgoal_tac "norm x * c = \<bar>c\<bar> * norm x \<or> norm x * c = - \<bar>c\<bar> * norm x")
  3238   apply (auto simp add: field_simps)
  3239   done
  3240 
  3241 end