src/HOL/Analysis/Linear_Algebra.thy
author paulson <lp15@cam.ac.uk>
Wed Jan 04 16:18:50 2017 +0000 (2017-01-04)
changeset 64773 223b2ebdda79
parent 64267 b9a1486e79be
child 65680 378a2f11bec9
permissions -rw-r--r--
Many new theorems, and more tidying
     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_sum:
   145   assumes lS: "\<forall>a \<in> S. linear (f a)"
   146   shows "linear (\<lambda>x. sum (\<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_sum:
   177   assumes f: "linear f"
   178   shows "f (sum g S) = sum (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_sum_mul:
   190   assumes lin: "linear f"
   191   shows "f (sum (\<lambda>i. c i *\<^sub>R v i) S) = sum (\<lambda>i. c i *\<^sub>R f (v i)) S"
   192   using linear_sum[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_sum:
   254   assumes sA: "subspace A"
   255     and f: "\<And>x. x \<in> B \<Longrightarrow> f x \<in> A"
   256   shows "sum 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_sum: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> span S) \<Longrightarrow> sum f A \<in> span S"
   464   by (rule subspace_sum [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> sum (\<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 "sum (\<lambda>v. u v *\<^sub>R v) S = x"
   629       by blast
   630     then have "x \<in> span P"
   631       by (auto intro: span_sum 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: "sum (\<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 "sum (\<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: sum.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: sum.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 "sum (\<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 sum.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> sum (\<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: "sum (\<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: "sum (\<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 sum.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: "sum (\<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 "sum (\<lambda>v. ?u v *\<^sub>R v) ?S =
   715       sum (\<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: sum_diff1 field_simps)
   717     also have "\<dots> = ?a"
   718       unfolding scaleR_right.sum [symmetric] u using uv by simp
   719     finally have "sum (\<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: sum.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!: sum.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 sum.mono_neutral_cong_left[where T=S])
   768     apply (auto intro!: sum.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 sum.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 sum_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 sum.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 sum.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. sum (\<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: "sum (\<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 "sum (\<lambda>v. ?u v *\<^sub>R v) S = sum (\<lambda>v. u v *\<^sub>R v) S'"
   942       using SS' fS by (auto intro!: sum.mono_neutral_cong_right)
   943     then have "sum (\<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: "sum (\<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 sum.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 sum.distrib
   976                intro!: arg_cong2[where f="op +"]  sum.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_sum_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 sum.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 sum.distrib
  1020                intro!: arg_cong2[where f="op +"]  sum.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_sum_right intro!: sum.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_sum_left)
  1440   then show ?thesis
  1441     unfolding linear_sum_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 sum_clauses:
  1479   shows "sum f {} = 0"
  1480     and "finite S \<Longrightarrow> sum f (insert x S) = (if x \<in> S then sum f S else f x + sum f S)"
  1481   by (auto simp add: insert_absorb)
  1482 
  1483 lemma sum_norm_le:
  1484   fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
  1485   assumes fg: "\<And>x. x \<in> S \<Longrightarrow> norm (f x) \<le> g x"
  1486   shows "norm (sum f S) \<le> sum g S"
  1487   by (rule order_trans [OF norm_sum sum_mono]) (simp add: fg)
  1488 
  1489 lemma sum_norm_bound:
  1490   fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
  1491   assumes K: "\<And>x. x \<in> S \<Longrightarrow> norm (f x) \<le> K"
  1492   shows "norm (sum f S) \<le> of_nat (card S)*K"
  1493   using sum_norm_le[OF K] sum_constant[symmetric]
  1494   by simp
  1495 
  1496 lemma sum_group:
  1497   assumes fS: "finite S" and fT: "finite T" and fST: "f ` S \<subseteq> T"
  1498   shows "sum (\<lambda>y. sum g {x. x \<in> S \<and> f x = y}) T = sum g S"
  1499   apply (subst sum_image_gen[OF fS, of g f])
  1500   apply (rule sum.mono_neutral_right[OF fT fST])
  1501   apply (auto intro: sum.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 (sum 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 (sum 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_sum_Pythagorean:
  1578   assumes "finite I" "pairwise (\<lambda>i j. orthogonal (f i) (f j)) I"
  1579     shows "(norm (sum 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) (sum 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_sum:
  1634   assumes bh: "bilinear h"
  1635     and fS: "finite S"
  1636     and fT: "finite T"
  1637   shows "h (sum f S) (sum g T) = sum (\<lambda>(i,j). h (f i) (g j)) (S \<times> T) "
  1638 proof -
  1639   have "h (sum f S) (sum g T) = sum (\<lambda>x. h (f x) (sum g T)) S"
  1640     apply (rule linear_sum[unfolded o_def])
  1641     using bh fS
  1642     apply (auto simp add: bilinear_def)
  1643     done
  1644   also have "\<dots> = sum (\<lambda>x. sum (\<lambda>y. h (f x) (g y)) T) S"
  1645     apply (rule sum.cong, simp)
  1646     apply (rule linear_sum[unfolded o_def])
  1647     using bh fT
  1648     apply (auto simp add: bilinear_def)
  1649     done
  1650   finally show ?thesis
  1651     unfolding sum.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_sum[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_sum_left inner_sum_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_sum_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_sum])
  1901   apply (auto intro!: sum_mono)
  1902   done
  1903 
  1904 lemma sum_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 (sum 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 sum_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 sum.commute)
  1914   also have "\<dots> \<le> of_nat (card (Basis :: 'n set)) * (2 * e)"
  1915   proof (rule sum_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 sum.If_cases[OF fP] sum_negf norm_triangle_ineq4 inner_sum_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 (sum ?g Basis)"
  1947       by (simp add: linear_sum [OF lf] linear_cmul [OF lf])
  1948     finally have th0: "norm (f x) = norm (sum ?g Basis)" .
  1949     have th: "norm (?g i) \<le> norm (f i) * norm x" if "i \<in> Basis" for i
  1950     proof -
  1951       from Basis_le_norm[OF that, of x]
  1952       show "norm (?g i) \<le> norm (f i) * norm x"
  1953         unfolding norm_scaleR
  1954         apply (subst mult.commute)
  1955         apply (rule mult_mono)
  1956         apply (auto simp add: field_simps)
  1957         done
  1958     qed
  1959     from sum_norm_le[of _ ?g, OF th]
  1960     show "norm (f x) \<le> ?B * norm x"
  1961       unfolding th0 sum_distrib_right by metis
  1962   qed
  1963 qed
  1964 
  1965 lemma linear_conv_bounded_linear:
  1966   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  1967   shows "linear f \<longleftrightarrow> bounded_linear f"
  1968 proof
  1969   assume "linear f"
  1970   then interpret f: linear f .
  1971   show "bounded_linear f"
  1972   proof
  1973     have "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
  1974       using \<open>linear f\<close> by (rule linear_bounded)
  1975     then show "\<exists>K. \<forall>x. norm (f x) \<le> norm x * K"
  1976       by (simp add: mult.commute)
  1977   qed
  1978 next
  1979   assume "bounded_linear f"
  1980   then interpret f: bounded_linear f .
  1981   show "linear f" ..
  1982 qed
  1983 
  1984 lemmas linear_linear = linear_conv_bounded_linear[symmetric]
  1985 
  1986 lemma linear_bounded_pos:
  1987   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  1988   assumes lf: "linear f"
  1989   shows "\<exists>B > 0. \<forall>x. norm (f x) \<le> B * norm x"
  1990 proof -
  1991   have "\<exists>B > 0. \<forall>x. norm (f x) \<le> norm x * B"
  1992     using lf unfolding linear_conv_bounded_linear
  1993     by (rule bounded_linear.pos_bounded)
  1994   then show ?thesis
  1995     by (simp only: mult.commute)
  1996 qed
  1997 
  1998 lemma bounded_linearI':
  1999   fixes f ::"'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  2000   assumes "\<And>x y. f (x + y) = f x + f y"
  2001     and "\<And>c x. f (c *\<^sub>R x) = c *\<^sub>R f x"
  2002   shows "bounded_linear f"
  2003   unfolding linear_conv_bounded_linear[symmetric]
  2004   by (rule linearI[OF assms])
  2005 
  2006 lemma bilinear_bounded:
  2007   fixes h :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space \<Rightarrow> 'k::real_normed_vector"
  2008   assumes bh: "bilinear h"
  2009   shows "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
  2010 proof (clarify intro!: exI[of _ "\<Sum>i\<in>Basis. \<Sum>j\<in>Basis. norm (h i j)"])
  2011   fix x :: 'm
  2012   fix y :: 'n
  2013   have "norm (h x y) = norm (h (sum (\<lambda>i. (x \<bullet> i) *\<^sub>R i) Basis) (sum (\<lambda>i. (y \<bullet> i) *\<^sub>R i) Basis))"
  2014     apply (subst euclidean_representation[where 'a='m])
  2015     apply (subst euclidean_representation[where 'a='n])
  2016     apply rule
  2017     done
  2018   also have "\<dots> = norm (sum (\<lambda> (i,j). h ((x \<bullet> i) *\<^sub>R i) ((y \<bullet> j) *\<^sub>R j)) (Basis \<times> Basis))"
  2019     unfolding bilinear_sum[OF bh finite_Basis finite_Basis] ..
  2020   finally have th: "norm (h x y) = \<dots>" .
  2021   show "norm (h x y) \<le> (\<Sum>i\<in>Basis. \<Sum>j\<in>Basis. norm (h i j)) * norm x * norm y"
  2022     apply (auto simp add: sum_distrib_right th sum.cartesian_product)
  2023     apply (rule sum_norm_le)
  2024     apply (auto simp add: bilinear_rmul[OF bh] bilinear_lmul[OF bh]
  2025       field_simps simp del: scaleR_scaleR)
  2026     apply (rule mult_mono)
  2027     apply (auto simp add: zero_le_mult_iff Basis_le_norm)
  2028     apply (rule mult_mono)
  2029     apply (auto simp add: zero_le_mult_iff Basis_le_norm)
  2030     done
  2031 qed
  2032 
  2033 lemma bilinear_conv_bounded_bilinear:
  2034   fixes h :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::real_normed_vector"
  2035   shows "bilinear h \<longleftrightarrow> bounded_bilinear h"
  2036 proof
  2037   assume "bilinear h"
  2038   show "bounded_bilinear h"
  2039   proof
  2040     fix x y z
  2041     show "h (x + y) z = h x z + h y z"
  2042       using \<open>bilinear h\<close> unfolding bilinear_def linear_iff by simp
  2043   next
  2044     fix x y z
  2045     show "h x (y + z) = h x y + h x z"
  2046       using \<open>bilinear h\<close> unfolding bilinear_def linear_iff by simp
  2047   next
  2048     fix r x y
  2049     show "h (scaleR r x) y = scaleR r (h x y)"
  2050       using \<open>bilinear h\<close> unfolding bilinear_def linear_iff
  2051       by simp
  2052   next
  2053     fix r x y
  2054     show "h x (scaleR r y) = scaleR r (h x y)"
  2055       using \<open>bilinear h\<close> unfolding bilinear_def linear_iff
  2056       by simp
  2057   next
  2058     have "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
  2059       using \<open>bilinear h\<close> by (rule bilinear_bounded)
  2060     then show "\<exists>K. \<forall>x y. norm (h x y) \<le> norm x * norm y * K"
  2061       by (simp add: ac_simps)
  2062   qed
  2063 next
  2064   assume "bounded_bilinear h"
  2065   then interpret h: bounded_bilinear h .
  2066   show "bilinear h"
  2067     unfolding bilinear_def linear_conv_bounded_linear
  2068     using h.bounded_linear_left h.bounded_linear_right by simp
  2069 qed
  2070 
  2071 lemma bilinear_bounded_pos:
  2072   fixes h :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::real_normed_vector"
  2073   assumes bh: "bilinear h"
  2074   shows "\<exists>B > 0. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
  2075 proof -
  2076   have "\<exists>B > 0. \<forall>x y. norm (h x y) \<le> norm x * norm y * B"
  2077     using bh [unfolded bilinear_conv_bounded_bilinear]
  2078     by (rule bounded_bilinear.pos_bounded)
  2079   then show ?thesis
  2080     by (simp only: ac_simps)
  2081 qed
  2082 
  2083 lemma bounded_linear_imp_has_derivative:
  2084      "bounded_linear f \<Longrightarrow> (f has_derivative f) net"
  2085   by (simp add: has_derivative_def bounded_linear.linear linear_diff)
  2086 
  2087 lemma linear_imp_has_derivative:
  2088   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  2089   shows "linear f \<Longrightarrow> (f has_derivative f) net"
  2090 by (simp add: has_derivative_def linear_conv_bounded_linear linear_diff)
  2091 
  2092 lemma bounded_linear_imp_differentiable: "bounded_linear f \<Longrightarrow> f differentiable net"
  2093   using bounded_linear_imp_has_derivative differentiable_def by blast
  2094 
  2095 lemma linear_imp_differentiable:
  2096   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  2097   shows "linear f \<Longrightarrow> f differentiable net"
  2098 by (metis linear_imp_has_derivative differentiable_def)
  2099 
  2100 
  2101 subsection \<open>We continue.\<close>
  2102 
  2103 lemma independent_bound:
  2104   fixes S :: "'a::euclidean_space set"
  2105   shows "independent S \<Longrightarrow> finite S \<and> card S \<le> DIM('a)"
  2106   using independent_span_bound[OF finite_Basis, of S] by auto
  2107 
  2108 corollary
  2109   fixes S :: "'a::euclidean_space set"
  2110   assumes "independent S"
  2111   shows independent_imp_finite: "finite S" and independent_card_le:"card S \<le> DIM('a)"
  2112 using assms independent_bound by auto
  2113 
  2114 lemma independent_explicit:
  2115   fixes B :: "'a::euclidean_space set"
  2116   shows "independent B \<longleftrightarrow>
  2117          finite B \<and> (\<forall>c. (\<Sum>v\<in>B. c v *\<^sub>R v) = 0 \<longrightarrow> (\<forall>v \<in> B. c v = 0))"
  2118 apply (cases "finite B")
  2119  apply (force simp: dependent_finite)
  2120 using independent_bound
  2121 apply auto
  2122 done
  2123 
  2124 lemma dependent_biggerset:
  2125   fixes S :: "'a::euclidean_space set"
  2126   shows "(finite S \<Longrightarrow> card S > DIM('a)) \<Longrightarrow> dependent S"
  2127   by (metis independent_bound not_less)
  2128 
  2129 text \<open>Notion of dimension.\<close>
  2130 
  2131 definition "dim V = (SOME n. \<exists>B. B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> card B = n)"
  2132 
  2133 lemma basis_exists:
  2134   "\<exists>B. (B :: ('a::euclidean_space) set) \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> (card B = dim V)"
  2135   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)"]
  2136   using maximal_independent_subset[of V] independent_bound
  2137   by auto
  2138 
  2139 corollary dim_le_card:
  2140   fixes s :: "'a::euclidean_space set"
  2141   shows "finite s \<Longrightarrow> dim s \<le> card s"
  2142 by (metis basis_exists card_mono)
  2143 
  2144 text \<open>Consequences of independence or spanning for cardinality.\<close>
  2145 
  2146 lemma independent_card_le_dim:
  2147   fixes B :: "'a::euclidean_space set"
  2148   assumes "B \<subseteq> V"
  2149     and "independent B"
  2150   shows "card B \<le> dim V"
  2151 proof -
  2152   from basis_exists[of V] \<open>B \<subseteq> V\<close>
  2153   obtain B' where "independent B'"
  2154     and "B \<subseteq> span B'"
  2155     and "card B' = dim V"
  2156     by blast
  2157   with independent_span_bound[OF _ \<open>independent B\<close> \<open>B \<subseteq> span B'\<close>] independent_bound[of B']
  2158   show ?thesis by auto
  2159 qed
  2160 
  2161 lemma span_card_ge_dim:
  2162   fixes B :: "'a::euclidean_space set"
  2163   shows "B \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> finite B \<Longrightarrow> dim V \<le> card B"
  2164   by (metis basis_exists[of V] independent_span_bound subset_trans)
  2165 
  2166 lemma basis_card_eq_dim:
  2167   fixes V :: "'a::euclidean_space set"
  2168   shows "B \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> independent B \<Longrightarrow> finite B \<and> card B = dim V"
  2169   by (metis order_eq_iff independent_card_le_dim span_card_ge_dim independent_bound)
  2170 
  2171 lemma dim_unique:
  2172   fixes B :: "'a::euclidean_space set"
  2173   shows "B \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> independent B \<Longrightarrow> card B = n \<Longrightarrow> dim V = n"
  2174   by (metis basis_card_eq_dim)
  2175 
  2176 text \<open>More lemmas about dimension.\<close>
  2177 
  2178 lemma dim_UNIV [simp]: "dim (UNIV :: 'a::euclidean_space set) = DIM('a)"
  2179   using independent_Basis
  2180   by (intro dim_unique[of Basis]) auto
  2181 
  2182 lemma dim_subset:
  2183   fixes S :: "'a::euclidean_space set"
  2184   shows "S \<subseteq> T \<Longrightarrow> dim S \<le> dim T"
  2185   using basis_exists[of T] basis_exists[of S]
  2186   by (metis independent_card_le_dim subset_trans)
  2187 
  2188 lemma dim_subset_UNIV:
  2189   fixes S :: "'a::euclidean_space set"
  2190   shows "dim S \<le> DIM('a)"
  2191   by (metis dim_subset subset_UNIV dim_UNIV)
  2192 
  2193 text \<open>Converses to those.\<close>
  2194 
  2195 lemma card_ge_dim_independent:
  2196   fixes B :: "'a::euclidean_space set"
  2197   assumes BV: "B \<subseteq> V"
  2198     and iB: "independent B"
  2199     and dVB: "dim V \<le> card B"
  2200   shows "V \<subseteq> span B"
  2201 proof
  2202   fix a
  2203   assume aV: "a \<in> V"
  2204   {
  2205     assume aB: "a \<notin> span B"
  2206     then have iaB: "independent (insert a B)"
  2207       using iB aV BV by (simp add: independent_insert)
  2208     from aV BV have th0: "insert a B \<subseteq> V"
  2209       by blast
  2210     from aB have "a \<notin>B"
  2211       by (auto simp add: span_superset)
  2212     with independent_card_le_dim[OF th0 iaB] dVB independent_bound[OF iB]
  2213     have False by auto
  2214   }
  2215   then show "a \<in> span B" by blast
  2216 qed
  2217 
  2218 lemma card_le_dim_spanning:
  2219   assumes BV: "(B:: ('a::euclidean_space) set) \<subseteq> V"
  2220     and VB: "V \<subseteq> span B"
  2221     and fB: "finite B"
  2222     and dVB: "dim V \<ge> card B"
  2223   shows "independent B"
  2224 proof -
  2225   {
  2226     fix a
  2227     assume a: "a \<in> B" "a \<in> span (B - {a})"
  2228     from a fB have c0: "card B \<noteq> 0"
  2229       by auto
  2230     from a fB have cb: "card (B - {a}) = card B - 1"
  2231       by auto
  2232     from BV a have th0: "B - {a} \<subseteq> V"
  2233       by blast
  2234     {
  2235       fix x
  2236       assume x: "x \<in> V"
  2237       from a have eq: "insert a (B - {a}) = B"
  2238         by blast
  2239       from x VB have x': "x \<in> span B"
  2240         by blast
  2241       from span_trans[OF a(2), unfolded eq, OF x']
  2242       have "x \<in> span (B - {a})" .
  2243     }
  2244     then have th1: "V \<subseteq> span (B - {a})"
  2245       by blast
  2246     have th2: "finite (B - {a})"
  2247       using fB by auto
  2248     from span_card_ge_dim[OF th0 th1 th2]
  2249     have c: "dim V \<le> card (B - {a})" .
  2250     from c c0 dVB cb have False by simp
  2251   }
  2252   then show ?thesis
  2253     unfolding dependent_def by blast
  2254 qed
  2255 
  2256 lemma card_eq_dim:
  2257   fixes B :: "'a::euclidean_space set"
  2258   shows "B \<subseteq> V \<Longrightarrow> card B = dim V \<Longrightarrow> finite B \<Longrightarrow> independent B \<longleftrightarrow> V \<subseteq> span B"
  2259   by (metis order_eq_iff card_le_dim_spanning card_ge_dim_independent)
  2260 
  2261 text \<open>More general size bound lemmas.\<close>
  2262 
  2263 lemma independent_bound_general:
  2264   fixes S :: "'a::euclidean_space set"
  2265   shows "independent S \<Longrightarrow> finite S \<and> card S \<le> dim S"
  2266   by (metis independent_card_le_dim independent_bound subset_refl)
  2267 
  2268 lemma dependent_biggerset_general:
  2269   fixes S :: "'a::euclidean_space set"
  2270   shows "(finite S \<Longrightarrow> card S > dim S) \<Longrightarrow> dependent S"
  2271   using independent_bound_general[of S] by (metis linorder_not_le)
  2272 
  2273 lemma dim_span [simp]:
  2274   fixes S :: "'a::euclidean_space set"
  2275   shows "dim (span S) = dim S"
  2276 proof -
  2277   have th0: "dim S \<le> dim (span S)"
  2278     by (auto simp add: subset_eq intro: dim_subset span_superset)
  2279   from basis_exists[of S]
  2280   obtain B where B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "card B = dim S"
  2281     by blast
  2282   from B have fB: "finite B" "card B = dim S"
  2283     using independent_bound by blast+
  2284   have bSS: "B \<subseteq> span S"
  2285     using B(1) by (metis subset_eq span_inc)
  2286   have sssB: "span S \<subseteq> span B"
  2287     using span_mono[OF B(3)] by (simp add: span_span)
  2288   from span_card_ge_dim[OF bSS sssB fB(1)] th0 show ?thesis
  2289     using fB(2) by arith
  2290 qed
  2291 
  2292 lemma subset_le_dim:
  2293   fixes S :: "'a::euclidean_space set"
  2294   shows "S \<subseteq> span T \<Longrightarrow> dim S \<le> dim T"
  2295   by (metis dim_span dim_subset)
  2296 
  2297 lemma span_eq_dim:
  2298   fixes S :: "'a::euclidean_space set"
  2299   shows "span S = span T \<Longrightarrow> dim S = dim T"
  2300   by (metis dim_span)
  2301 
  2302 lemma dim_image_le:
  2303   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2304   assumes lf: "linear f"
  2305   shows "dim (f ` S) \<le> dim (S)"
  2306 proof -
  2307   from basis_exists[of S] obtain B where
  2308     B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "card B = dim S" by blast
  2309   from B have fB: "finite B" "card B = dim S"
  2310     using independent_bound by blast+
  2311   have "dim (f ` S) \<le> card (f ` B)"
  2312     apply (rule span_card_ge_dim)
  2313     using lf B fB
  2314     apply (auto simp add: span_linear_image spans_image subset_image_iff)
  2315     done
  2316   also have "\<dots> \<le> dim S"
  2317     using card_image_le[OF fB(1)] fB by simp
  2318   finally show ?thesis .
  2319 qed
  2320 
  2321 text \<open>Picking an orthogonal replacement for a spanning set.\<close>
  2322 
  2323 lemma vector_sub_project_orthogonal:
  2324   fixes b x :: "'a::euclidean_space"
  2325   shows "b \<bullet> (x - ((b \<bullet> x) / (b \<bullet> b)) *\<^sub>R b) = 0"
  2326   unfolding inner_simps by auto
  2327 
  2328 lemma pairwise_orthogonal_insert:
  2329   assumes "pairwise orthogonal S"
  2330     and "\<And>y. y \<in> S \<Longrightarrow> orthogonal x y"
  2331   shows "pairwise orthogonal (insert x S)"
  2332   using assms unfolding pairwise_def
  2333   by (auto simp add: orthogonal_commute)
  2334 
  2335 lemma basis_orthogonal:
  2336   fixes B :: "'a::real_inner set"
  2337   assumes fB: "finite B"
  2338   shows "\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C"
  2339   (is " \<exists>C. ?P B C")
  2340   using fB
  2341 proof (induct rule: finite_induct)
  2342   case empty
  2343   then show ?case
  2344     apply (rule exI[where x="{}"])
  2345     apply (auto simp add: pairwise_def)
  2346     done
  2347 next
  2348   case (insert a B)
  2349   note fB = \<open>finite B\<close> and aB = \<open>a \<notin> B\<close>
  2350   from \<open>\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C\<close>
  2351   obtain C where C: "finite C" "card C \<le> card B"
  2352     "span C = span B" "pairwise orthogonal C" by blast
  2353   let ?a = "a - sum (\<lambda>x. (x \<bullet> a / (x \<bullet> x)) *\<^sub>R x) C"
  2354   let ?C = "insert ?a C"
  2355   from C(1) have fC: "finite ?C"
  2356     by simp
  2357   from fB aB C(1,2) have cC: "card ?C \<le> card (insert a B)"
  2358     by (simp add: card_insert_if)
  2359   {
  2360     fix x k
  2361     have th0: "\<And>(a::'a) b c. a - (b - c) = c + (a - b)"
  2362       by (simp add: field_simps)
  2363     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"
  2364       apply (simp only: scaleR_right_diff_distrib th0)
  2365       apply (rule span_add_eq)
  2366       apply (rule span_mul)
  2367       apply (rule span_sum)
  2368       apply (rule span_mul)
  2369       apply (rule span_superset)
  2370       apply assumption
  2371       done
  2372   }
  2373   then have SC: "span ?C = span (insert a B)"
  2374     unfolding set_eq_iff span_breakdown_eq C(3)[symmetric] by auto
  2375   {
  2376     fix y
  2377     assume yC: "y \<in> C"
  2378     then have Cy: "C = insert y (C - {y})"
  2379       by blast
  2380     have fth: "finite (C - {y})"
  2381       using C by simp
  2382     have "orthogonal ?a y"
  2383       unfolding orthogonal_def
  2384       unfolding inner_diff inner_sum_left right_minus_eq
  2385       unfolding sum.remove [OF \<open>finite C\<close> \<open>y \<in> C\<close>]
  2386       apply (clarsimp simp add: inner_commute[of y a])
  2387       apply (rule sum.neutral)
  2388       apply clarsimp
  2389       apply (rule C(4)[unfolded pairwise_def orthogonal_def, rule_format])
  2390       using \<open>y \<in> C\<close> by auto
  2391   }
  2392   with \<open>pairwise orthogonal C\<close> have CPO: "pairwise orthogonal ?C"
  2393     by (rule pairwise_orthogonal_insert)
  2394   from fC cC SC CPO have "?P (insert a B) ?C"
  2395     by blast
  2396   then show ?case by blast
  2397 qed
  2398 
  2399 lemma orthogonal_basis_exists:
  2400   fixes V :: "('a::euclidean_space) set"
  2401   shows "\<exists>B. independent B \<and> B \<subseteq> span V \<and> V \<subseteq> span B \<and> (card B = dim V) \<and> pairwise orthogonal B"
  2402 proof -
  2403   from basis_exists[of V] obtain B where
  2404     B: "B \<subseteq> V" "independent B" "V \<subseteq> span B" "card B = dim V"
  2405     by blast
  2406   from B have fB: "finite B" "card B = dim V"
  2407     using independent_bound by auto
  2408   from basis_orthogonal[OF fB(1)] obtain C where
  2409     C: "finite C" "card C \<le> card B" "span C = span B" "pairwise orthogonal C"
  2410     by blast
  2411   from C B have CSV: "C \<subseteq> span V"
  2412     by (metis span_inc span_mono subset_trans)
  2413   from span_mono[OF B(3)] C have SVC: "span V \<subseteq> span C"
  2414     by (simp add: span_span)
  2415   from card_le_dim_spanning[OF CSV SVC C(1)] C(2,3) fB
  2416   have iC: "independent C"
  2417     by (simp add: dim_span)
  2418   from C fB have "card C \<le> dim V"
  2419     by simp
  2420   moreover have "dim V \<le> card C"
  2421     using span_card_ge_dim[OF CSV SVC C(1)]
  2422     by (simp add: dim_span)
  2423   ultimately have CdV: "card C = dim V"
  2424     using C(1) by simp
  2425   from C B CSV CdV iC show ?thesis
  2426     by auto
  2427 qed
  2428 
  2429 text \<open>Low-dimensional subset is in a hyperplane (weak orthogonal complement).\<close>
  2430 
  2431 lemma span_not_univ_orthogonal:
  2432   fixes S :: "'a::euclidean_space set"
  2433   assumes sU: "span S \<noteq> UNIV"
  2434   shows "\<exists>a::'a. a \<noteq> 0 \<and> (\<forall>x \<in> span S. a \<bullet> x = 0)"
  2435 proof -
  2436   from sU obtain a where a: "a \<notin> span S"
  2437     by blast
  2438   from orthogonal_basis_exists obtain B where
  2439     B: "independent B" "B \<subseteq> span S" "S \<subseteq> span B" "card B = dim S" "pairwise orthogonal B"
  2440     by blast
  2441   from B have fB: "finite B" "card B = dim S"
  2442     using independent_bound by auto
  2443   from span_mono[OF B(2)] span_mono[OF B(3)]
  2444   have sSB: "span S = span B"
  2445     by (simp add: span_span)
  2446   let ?a = "a - sum (\<lambda>b. (a \<bullet> b / (b \<bullet> b)) *\<^sub>R b) B"
  2447   have "sum (\<lambda>b. (a \<bullet> b / (b \<bullet> b)) *\<^sub>R b) B \<in> span S"
  2448     unfolding sSB
  2449     apply (rule span_sum)
  2450     apply (rule span_mul)
  2451     apply (rule span_superset)
  2452     apply assumption
  2453     done
  2454   with a have a0:"?a  \<noteq> 0"
  2455     by auto
  2456   have "\<forall>x\<in>span B. ?a \<bullet> x = 0"
  2457   proof (rule span_induct')
  2458     show "subspace {x. ?a \<bullet> x = 0}"
  2459       by (auto simp add: subspace_def inner_add)
  2460   next
  2461     {
  2462       fix x
  2463       assume x: "x \<in> B"
  2464       from x have B': "B = insert x (B - {x})"
  2465         by blast
  2466       have fth: "finite (B - {x})"
  2467         using fB by simp
  2468       have "?a \<bullet> x = 0"
  2469         apply (subst B')
  2470         using fB fth
  2471         unfolding sum_clauses(2)[OF fth]
  2472         apply simp unfolding inner_simps
  2473         apply (clarsimp simp add: inner_add inner_sum_left)
  2474         apply (rule sum.neutral, rule ballI)
  2475         apply (simp only: inner_commute)
  2476         apply (auto simp add: x field_simps
  2477           intro: B(5)[unfolded pairwise_def orthogonal_def, rule_format])
  2478         done
  2479     }
  2480     then show "\<forall>x \<in> B. ?a \<bullet> x = 0"
  2481       by blast
  2482   qed
  2483   with a0 show ?thesis
  2484     unfolding sSB by (auto intro: exI[where x="?a"])
  2485 qed
  2486 
  2487 lemma span_not_univ_subset_hyperplane:
  2488   fixes S :: "'a::euclidean_space set"
  2489   assumes SU: "span S \<noteq> UNIV"
  2490   shows "\<exists> a. a \<noteq>0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
  2491   using span_not_univ_orthogonal[OF SU] by auto
  2492 
  2493 lemma lowdim_subset_hyperplane:
  2494   fixes S :: "'a::euclidean_space set"
  2495   assumes d: "dim S < DIM('a)"
  2496   shows "\<exists>a::'a. a \<noteq> 0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
  2497 proof -
  2498   {
  2499     assume "span S = UNIV"
  2500     then have "dim (span S) = dim (UNIV :: ('a) set)"
  2501       by simp
  2502     then have "dim S = DIM('a)"
  2503       by (simp add: dim_span dim_UNIV)
  2504     with d have False by arith
  2505   }
  2506   then have th: "span S \<noteq> UNIV"
  2507     by blast
  2508   from span_not_univ_subset_hyperplane[OF th] show ?thesis .
  2509 qed
  2510 
  2511 text \<open>We can extend a linear basis-basis injection to the whole set.\<close>
  2512 
  2513 lemma linear_indep_image_lemma:
  2514   assumes lf: "linear f"
  2515     and fB: "finite B"
  2516     and ifB: "independent (f ` B)"
  2517     and fi: "inj_on f B"
  2518     and xsB: "x \<in> span B"
  2519     and fx: "f x = 0"
  2520   shows "x = 0"
  2521   using fB ifB fi xsB fx
  2522 proof (induct arbitrary: x rule: finite_induct[OF fB])
  2523   case 1
  2524   then show ?case by auto
  2525 next
  2526   case (2 a b x)
  2527   have fb: "finite b" using "2.prems" by simp
  2528   have th0: "f ` b \<subseteq> f ` (insert a b)"
  2529     apply (rule image_mono)
  2530     apply blast
  2531     done
  2532   from independent_mono[ OF "2.prems"(2) th0]
  2533   have ifb: "independent (f ` b)"  .
  2534   have fib: "inj_on f b"
  2535     apply (rule subset_inj_on [OF "2.prems"(3)])
  2536     apply blast
  2537     done
  2538   from span_breakdown[of a "insert a b", simplified, OF "2.prems"(4)]
  2539   obtain k where k: "x - k*\<^sub>R a \<in> span (b - {a})"
  2540     by blast
  2541   have "f (x - k*\<^sub>R a) \<in> span (f ` b)"
  2542     unfolding span_linear_image[OF lf]
  2543     apply (rule imageI)
  2544     using k span_mono[of "b - {a}" b]
  2545     apply blast
  2546     done
  2547   then have "f x - k*\<^sub>R f a \<in> span (f ` b)"
  2548     by (simp add: linear_diff[OF lf] linear_cmul[OF lf])
  2549   then have th: "-k *\<^sub>R f a \<in> span (f ` b)"
  2550     using "2.prems"(5) by simp
  2551   have xsb: "x \<in> span b"
  2552   proof (cases "k = 0")
  2553     case True
  2554     with k have "x \<in> span (b - {a})" by simp
  2555     then show ?thesis using span_mono[of "b - {a}" b]
  2556       by blast
  2557   next
  2558     case False
  2559     with span_mul[OF th, of "- 1/ k"]
  2560     have th1: "f a \<in> span (f ` b)"
  2561       by auto
  2562     from inj_on_image_set_diff[OF "2.prems"(3), of "insert a b " "{a}", symmetric]
  2563     have tha: "f ` insert a b - f ` {a} = f ` (insert a b - {a})" by blast
  2564     from "2.prems"(2) [unfolded dependent_def bex_simps(8), rule_format, of "f a"]
  2565     have "f a \<notin> span (f ` b)" using tha
  2566       using "2.hyps"(2)
  2567       "2.prems"(3) by auto
  2568     with th1 have False by blast
  2569     then show ?thesis by blast
  2570   qed
  2571   from "2.hyps"(3)[OF fb ifb fib xsb "2.prems"(5)] show "x = 0" .
  2572 qed
  2573 
  2574 text \<open>Can construct an isomorphism between spaces of same dimension.\<close>
  2575 
  2576 lemma subspace_isomorphism:
  2577   fixes S :: "'a::euclidean_space set"
  2578     and T :: "'b::euclidean_space set"
  2579   assumes s: "subspace S"
  2580     and t: "subspace T"
  2581     and d: "dim S = dim T"
  2582   shows "\<exists>f. linear f \<and> f ` S = T \<and> inj_on f S"
  2583 proof -
  2584   from basis_exists[of S] independent_bound
  2585   obtain B where B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "card B = dim S" and fB: "finite B"
  2586     by blast
  2587   from basis_exists[of T] independent_bound
  2588   obtain C where C: "C \<subseteq> T" "independent C" "T \<subseteq> span C" "card C = dim T" and fC: "finite C"
  2589     by blast
  2590   from B(4) C(4) card_le_inj[of B C] d
  2591   obtain f where f: "f ` B \<subseteq> C" "inj_on f B" using \<open>finite B\<close> \<open>finite C\<close>
  2592     by auto
  2593   from linear_independent_extend[OF B(2)]
  2594   obtain g where g: "linear g" "\<forall>x\<in> B. g x = f x"
  2595     by blast
  2596   from inj_on_iff_eq_card[OF fB, of f] f(2) have "card (f ` B) = card B"
  2597     by simp
  2598   with B(4) C(4) have ceq: "card (f ` B) = card C"
  2599     using d by simp
  2600   have "g ` B = f ` B"
  2601     using g(2) by (auto simp add: image_iff)
  2602   also have "\<dots> = C" using card_subset_eq[OF fC f(1) ceq] .
  2603   finally have gBC: "g ` B = C" .
  2604   have gi: "inj_on g B"
  2605     using f(2) g(2) by (auto simp add: inj_on_def)
  2606   note g0 = linear_indep_image_lemma[OF g(1) fB, unfolded gBC, OF C(2) gi]
  2607   {
  2608     fix x y
  2609     assume x: "x \<in> S" and y: "y \<in> S" and gxy: "g x = g y"
  2610     from B(3) x y have x': "x \<in> span B" and y': "y \<in> span B"
  2611       by blast+
  2612     from gxy have th0: "g (x - y) = 0"
  2613       by (simp add: linear_diff[OF g(1)])
  2614     have th1: "x - y \<in> span B"
  2615       using x' y' by (metis span_diff)
  2616     have "x = y"
  2617       using g0[OF th1 th0] by simp
  2618   }
  2619   then have giS: "inj_on g S"
  2620     unfolding inj_on_def by blast
  2621   from span_subspace[OF B(1,3) s] have "g ` S = span (g ` B)"
  2622     by (simp add: span_linear_image[OF g(1)])
  2623   also have "\<dots> = span C" unfolding gBC ..
  2624   also have "\<dots> = T" using span_subspace[OF C(1,3) t] .
  2625   finally have gS: "g ` S = T" .
  2626   from g(1) gS giS show ?thesis
  2627     by blast
  2628 qed
  2629 
  2630 lemma linear_eq_stdbasis:
  2631   fixes f :: "'a::euclidean_space \<Rightarrow> _"
  2632   assumes lf: "linear f"
  2633     and lg: "linear g"
  2634     and fg: "\<forall>b\<in>Basis. f b = g b"
  2635   shows "f = g"
  2636   using linear_eq[OF lf lg, of _ Basis] fg by auto
  2637 
  2638 text \<open>Similar results for bilinear functions.\<close>
  2639 
  2640 lemma bilinear_eq:
  2641   assumes bf: "bilinear f"
  2642     and bg: "bilinear g"
  2643     and SB: "S \<subseteq> span B"
  2644     and TC: "T \<subseteq> span C"
  2645     and fg: "\<forall>x\<in> B. \<forall>y\<in> C. f x y = g x y"
  2646   shows "\<forall>x\<in>S. \<forall>y\<in>T. f x y = g x y "
  2647 proof -
  2648   let ?P = "{x. \<forall>y\<in> span C. f x y = g x y}"
  2649   from bf bg have sp: "subspace ?P"
  2650     unfolding bilinear_def linear_iff subspace_def bf bg
  2651     by (auto simp add: span_0 bilinear_lzero[OF bf] bilinear_lzero[OF bg] span_add Ball_def
  2652       intro: bilinear_ladd[OF bf])
  2653 
  2654   have "\<forall>x \<in> span B. \<forall>y\<in> span C. f x y = g x y"
  2655     apply (rule span_induct' [OF _ sp])
  2656     apply (rule ballI)
  2657     apply (rule span_induct')
  2658     apply (simp add: fg)
  2659     apply (auto simp add: subspace_def)
  2660     using bf bg unfolding bilinear_def linear_iff
  2661     apply (auto simp add: span_0 bilinear_rzero[OF bf] bilinear_rzero[OF bg] span_add Ball_def
  2662       intro: bilinear_ladd[OF bf])
  2663     done
  2664   then show ?thesis
  2665     using SB TC by auto
  2666 qed
  2667 
  2668 lemma bilinear_eq_stdbasis:
  2669   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> _"
  2670   assumes bf: "bilinear f"
  2671     and bg: "bilinear g"
  2672     and fg: "\<forall>i\<in>Basis. \<forall>j\<in>Basis. f i j = g i j"
  2673   shows "f = g"
  2674   using bilinear_eq[OF bf bg equalityD2[OF span_Basis] equalityD2[OF span_Basis] fg] by blast
  2675 
  2676 text \<open>An injective map @{typ "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"} is also surjective.\<close>
  2677 
  2678 lemma linear_injective_imp_surjective:
  2679   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2680   assumes lf: "linear f"
  2681     and fi: "inj f"
  2682   shows "surj f"
  2683 proof -
  2684   let ?U = "UNIV :: 'a set"
  2685   from basis_exists[of ?U] obtain B
  2686     where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" "card B = dim ?U"
  2687     by blast
  2688   from B(4) have d: "dim ?U = card B"
  2689     by simp
  2690   have th: "?U \<subseteq> span (f ` B)"
  2691     apply (rule card_ge_dim_independent)
  2692     apply blast
  2693     apply (rule independent_injective_image[OF B(2) lf fi])
  2694     apply (rule order_eq_refl)
  2695     apply (rule sym)
  2696     unfolding d
  2697     apply (rule card_image)
  2698     apply (rule subset_inj_on[OF fi])
  2699     apply blast
  2700     done
  2701   from th show ?thesis
  2702     unfolding span_linear_image[OF lf] surj_def
  2703     using B(3) by blast
  2704 qed
  2705 
  2706 text \<open>And vice versa.\<close>
  2707 
  2708 lemma surjective_iff_injective_gen:
  2709   assumes fS: "finite S"
  2710     and fT: "finite T"
  2711     and c: "card S = card T"
  2712     and ST: "f ` S \<subseteq> T"
  2713   shows "(\<forall>y \<in> T. \<exists>x \<in> S. f x = y) \<longleftrightarrow> inj_on f S"
  2714   (is "?lhs \<longleftrightarrow> ?rhs")
  2715 proof
  2716   assume h: "?lhs"
  2717   {
  2718     fix x y
  2719     assume x: "x \<in> S"
  2720     assume y: "y \<in> S"
  2721     assume f: "f x = f y"
  2722     from x fS have S0: "card S \<noteq> 0"
  2723       by auto
  2724     have "x = y"
  2725     proof (rule ccontr)
  2726       assume xy: "\<not> ?thesis"
  2727       have th: "card S \<le> card (f ` (S - {y}))"
  2728         unfolding c
  2729         apply (rule card_mono)
  2730         apply (rule finite_imageI)
  2731         using fS apply simp
  2732         using h xy x y f unfolding subset_eq image_iff
  2733         apply auto
  2734         apply (case_tac "xa = f x")
  2735         apply (rule bexI[where x=x])
  2736         apply auto
  2737         done
  2738       also have " \<dots> \<le> card (S - {y})"
  2739         apply (rule card_image_le)
  2740         using fS by simp
  2741       also have "\<dots> \<le> card S - 1" using y fS by simp
  2742       finally show False using S0 by arith
  2743     qed
  2744   }
  2745   then show ?rhs
  2746     unfolding inj_on_def by blast
  2747 next
  2748   assume h: ?rhs
  2749   have "f ` S = T"
  2750     apply (rule card_subset_eq[OF fT ST])
  2751     unfolding card_image[OF h]
  2752     apply (rule c)
  2753     done
  2754   then show ?lhs by blast
  2755 qed
  2756 
  2757 lemma linear_surjective_imp_injective:
  2758   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2759   assumes lf: "linear f"
  2760     and sf: "surj f"
  2761   shows "inj f"
  2762 proof -
  2763   let ?U = "UNIV :: 'a set"
  2764   from basis_exists[of ?U] obtain B
  2765     where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" and d: "card B = dim ?U"
  2766     by blast
  2767   {
  2768     fix x
  2769     assume x: "x \<in> span B"
  2770     assume fx: "f x = 0"
  2771     from B(2) have fB: "finite B"
  2772       using independent_bound by auto
  2773     have fBi: "independent (f ` B)"
  2774       apply (rule card_le_dim_spanning[of "f ` B" ?U])
  2775       apply blast
  2776       using sf B(3)
  2777       unfolding span_linear_image[OF lf] surj_def subset_eq image_iff
  2778       apply blast
  2779       using fB apply blast
  2780       unfolding d[symmetric]
  2781       apply (rule card_image_le)
  2782       apply (rule fB)
  2783       done
  2784     have th0: "dim ?U \<le> card (f ` B)"
  2785       apply (rule span_card_ge_dim)
  2786       apply blast
  2787       unfolding span_linear_image[OF lf]
  2788       apply (rule subset_trans[where B = "f ` UNIV"])
  2789       using sf unfolding surj_def
  2790       apply blast
  2791       apply (rule image_mono)
  2792       apply (rule B(3))
  2793       apply (metis finite_imageI fB)
  2794       done
  2795     moreover have "card (f ` B) \<le> card B"
  2796       by (rule card_image_le, rule fB)
  2797     ultimately have th1: "card B = card (f ` B)"
  2798       unfolding d by arith
  2799     have fiB: "inj_on f B"
  2800       unfolding surjective_iff_injective_gen[OF fB finite_imageI[OF fB] th1 subset_refl, symmetric]
  2801       by blast
  2802     from linear_indep_image_lemma[OF lf fB fBi fiB x] fx
  2803     have "x = 0" by blast
  2804   }
  2805   then show ?thesis
  2806     unfolding linear_injective_0[OF lf]
  2807     using B(3)
  2808     by blast
  2809 qed
  2810 
  2811 text \<open>Hence either is enough for isomorphism.\<close>
  2812 
  2813 lemma left_right_inverse_eq:
  2814   assumes fg: "f \<circ> g = id"
  2815     and gh: "g \<circ> h = id"
  2816   shows "f = h"
  2817 proof -
  2818   have "f = f \<circ> (g \<circ> h)"
  2819     unfolding gh by simp
  2820   also have "\<dots> = (f \<circ> g) \<circ> h"
  2821     by (simp add: o_assoc)
  2822   finally show "f = h"
  2823     unfolding fg by simp
  2824 qed
  2825 
  2826 lemma isomorphism_expand:
  2827   "f \<circ> g = id \<and> g \<circ> f = id \<longleftrightarrow> (\<forall>x. f (g x) = x) \<and> (\<forall>x. g (f x) = x)"
  2828   by (simp add: fun_eq_iff o_def id_def)
  2829 
  2830 lemma linear_injective_isomorphism:
  2831   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2832   assumes lf: "linear f"
  2833     and fi: "inj f"
  2834   shows "\<exists>f'. linear f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)"
  2835   unfolding isomorphism_expand[symmetric]
  2836   using linear_surjective_right_inverse[OF lf linear_injective_imp_surjective[OF lf fi]]
  2837     linear_injective_left_inverse[OF lf fi]
  2838   by (metis left_right_inverse_eq)
  2839 
  2840 lemma linear_surjective_isomorphism:
  2841   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2842   assumes lf: "linear f"
  2843     and sf: "surj f"
  2844   shows "\<exists>f'. linear f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)"
  2845   unfolding isomorphism_expand[symmetric]
  2846   using linear_surjective_right_inverse[OF lf sf]
  2847     linear_injective_left_inverse[OF lf linear_surjective_imp_injective[OF lf sf]]
  2848   by (metis left_right_inverse_eq)
  2849 
  2850 text \<open>Left and right inverses are the same for
  2851   @{typ "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"}.\<close>
  2852 
  2853 lemma linear_inverse_left:
  2854   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2855   assumes lf: "linear f"
  2856     and lf': "linear f'"
  2857   shows "f \<circ> f' = id \<longleftrightarrow> f' \<circ> f = id"
  2858 proof -
  2859   {
  2860     fix f f':: "'a \<Rightarrow> 'a"
  2861     assume lf: "linear f" "linear f'"
  2862     assume f: "f \<circ> f' = id"
  2863     from f have sf: "surj f"
  2864       apply (auto simp add: o_def id_def surj_def)
  2865       apply metis
  2866       done
  2867     from linear_surjective_isomorphism[OF lf(1) sf] lf f
  2868     have "f' \<circ> f = id"
  2869       unfolding fun_eq_iff o_def id_def by metis
  2870   }
  2871   then show ?thesis
  2872     using lf lf' by metis
  2873 qed
  2874 
  2875 text \<open>Moreover, a one-sided inverse is automatically linear.\<close>
  2876 
  2877 lemma left_inverse_linear:
  2878   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2879   assumes lf: "linear f"
  2880     and gf: "g \<circ> f = id"
  2881   shows "linear g"
  2882 proof -
  2883   from gf have fi: "inj f"
  2884     apply (auto simp add: inj_on_def o_def id_def fun_eq_iff)
  2885     apply metis
  2886     done
  2887   from linear_injective_isomorphism[OF lf fi]
  2888   obtain h :: "'a \<Rightarrow> 'a" where h: "linear h" "\<forall>x. h (f x) = x" "\<forall>x. f (h x) = x"
  2889     by blast
  2890   have "h = g"
  2891     apply (rule ext) using gf h(2,3)
  2892     apply (simp add: o_def id_def fun_eq_iff)
  2893     apply metis
  2894     done
  2895   with h(1) show ?thesis by blast
  2896 qed
  2897 
  2898 lemma inj_linear_imp_inv_linear:
  2899   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2900   assumes "linear f" "inj f" shows "linear (inv f)"
  2901 using assms inj_iff left_inverse_linear by blast
  2902 
  2903 
  2904 subsection \<open>Infinity norm\<close>
  2905 
  2906 definition "infnorm (x::'a::euclidean_space) = Sup {\<bar>x \<bullet> b\<bar> |b. b \<in> Basis}"
  2907 
  2908 lemma infnorm_set_image:
  2909   fixes x :: "'a::euclidean_space"
  2910   shows "{\<bar>x \<bullet> i\<bar> |i. i \<in> Basis} = (\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis"
  2911   by blast
  2912 
  2913 lemma infnorm_Max:
  2914   fixes x :: "'a::euclidean_space"
  2915   shows "infnorm x = Max ((\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis)"
  2916   by (simp add: infnorm_def infnorm_set_image cSup_eq_Max)
  2917 
  2918 lemma infnorm_set_lemma:
  2919   fixes x :: "'a::euclidean_space"
  2920   shows "finite {\<bar>x \<bullet> i\<bar> |i. i \<in> Basis}"
  2921     and "{\<bar>x \<bullet> i\<bar> |i. i \<in> Basis} \<noteq> {}"
  2922   unfolding infnorm_set_image
  2923   by auto
  2924 
  2925 lemma infnorm_pos_le:
  2926   fixes x :: "'a::euclidean_space"
  2927   shows "0 \<le> infnorm x"
  2928   by (simp add: infnorm_Max Max_ge_iff ex_in_conv)
  2929 
  2930 lemma infnorm_triangle:
  2931   fixes x :: "'a::euclidean_space"
  2932   shows "infnorm (x + y) \<le> infnorm x + infnorm y"
  2933 proof -
  2934   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"
  2935     by simp
  2936   show ?thesis
  2937     by (auto simp: infnorm_Max inner_add_left intro!: *)
  2938 qed
  2939 
  2940 lemma infnorm_eq_0:
  2941   fixes x :: "'a::euclidean_space"
  2942   shows "infnorm x = 0 \<longleftrightarrow> x = 0"
  2943 proof -
  2944   have "infnorm x \<le> 0 \<longleftrightarrow> x = 0"
  2945     unfolding infnorm_Max by (simp add: euclidean_all_zero_iff)
  2946   then show ?thesis
  2947     using infnorm_pos_le[of x] by simp
  2948 qed
  2949 
  2950 lemma infnorm_0: "infnorm 0 = 0"
  2951   by (simp add: infnorm_eq_0)
  2952 
  2953 lemma infnorm_neg: "infnorm (- x) = infnorm x"
  2954   unfolding infnorm_def
  2955   apply (rule cong[of "Sup" "Sup"])
  2956   apply blast
  2957   apply auto
  2958   done
  2959 
  2960 lemma infnorm_sub: "infnorm (x - y) = infnorm (y - x)"
  2961 proof -
  2962   have "y - x = - (x - y)" by simp
  2963   then show ?thesis
  2964     by (metis infnorm_neg)
  2965 qed
  2966 
  2967 lemma real_abs_sub_infnorm: "\<bar>infnorm x - infnorm y\<bar> \<le> infnorm (x - y)"
  2968 proof -
  2969   have th: "\<And>(nx::real) n ny. nx \<le> n + ny \<Longrightarrow> ny \<le> n + nx \<Longrightarrow> \<bar>nx - ny\<bar> \<le> n"
  2970     by arith
  2971   from infnorm_triangle[of "x - y" " y"] infnorm_triangle[of "x - y" "-x"]
  2972   have ths: "infnorm x \<le> infnorm (x - y) + infnorm y"
  2973     "infnorm y \<le> infnorm (x - y) + infnorm x"
  2974     by (simp_all add: field_simps infnorm_neg)
  2975   from th[OF ths] show ?thesis .
  2976 qed
  2977 
  2978 lemma real_abs_infnorm: "\<bar>infnorm x\<bar> = infnorm x"
  2979   using infnorm_pos_le[of x] by arith
  2980 
  2981 lemma Basis_le_infnorm:
  2982   fixes x :: "'a::euclidean_space"
  2983   shows "b \<in> Basis \<Longrightarrow> \<bar>x \<bullet> b\<bar> \<le> infnorm x"
  2984   by (simp add: infnorm_Max)
  2985 
  2986 lemma infnorm_mul: "infnorm (a *\<^sub>R x) = \<bar>a\<bar> * infnorm x"
  2987   unfolding infnorm_Max
  2988 proof (safe intro!: Max_eqI)
  2989   let ?B = "(\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis"
  2990   {
  2991     fix b :: 'a
  2992     assume "b \<in> Basis"
  2993     then show "\<bar>a *\<^sub>R x \<bullet> b\<bar> \<le> \<bar>a\<bar> * Max ?B"
  2994       by (simp add: abs_mult mult_left_mono)
  2995   next
  2996     from Max_in[of ?B] obtain b where "b \<in> Basis" "Max ?B = \<bar>x \<bullet> b\<bar>"
  2997       by (auto simp del: Max_in)
  2998     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"
  2999       by (intro image_eqI[where x=b]) (auto simp: abs_mult)
  3000   }
  3001 qed simp
  3002 
  3003 lemma infnorm_mul_lemma: "infnorm (a *\<^sub>R x) \<le> \<bar>a\<bar> * infnorm x"
  3004   unfolding infnorm_mul ..
  3005 
  3006 lemma infnorm_pos_lt: "infnorm x > 0 \<longleftrightarrow> x \<noteq> 0"
  3007   using infnorm_pos_le[of x] infnorm_eq_0[of x] by arith
  3008 
  3009 text \<open>Prove that it differs only up to a bound from Euclidean norm.\<close>
  3010 
  3011 lemma infnorm_le_norm: "infnorm x \<le> norm x"
  3012   by (simp add: Basis_le_norm infnorm_Max)
  3013 
  3014 lemma (in euclidean_space) euclidean_inner: "inner x y = (\<Sum>b\<in>Basis. (x \<bullet> b) * (y \<bullet> b))"
  3015   by (subst (1 2) euclidean_representation [symmetric])
  3016     (simp add: inner_sum_right inner_Basis ac_simps)
  3017 
  3018 lemma norm_le_infnorm:
  3019   fixes x :: "'a::euclidean_space"
  3020   shows "norm x \<le> sqrt DIM('a) * infnorm x"
  3021 proof -
  3022   let ?d = "DIM('a)"
  3023   have "real ?d \<ge> 0"
  3024     by simp
  3025   then have d2: "(sqrt (real ?d))\<^sup>2 = real ?d"
  3026     by (auto intro: real_sqrt_pow2)
  3027   have th: "sqrt (real ?d) * infnorm x \<ge> 0"
  3028     by (simp add: zero_le_mult_iff infnorm_pos_le)
  3029   have th1: "x \<bullet> x \<le> (sqrt (real ?d) * infnorm x)\<^sup>2"
  3030     unfolding power_mult_distrib d2
  3031     apply (subst euclidean_inner)
  3032     apply (subst power2_abs[symmetric])
  3033     apply (rule order_trans[OF sum_bounded_above[where K="\<bar>infnorm x\<bar>\<^sup>2"]])
  3034     apply (auto simp add: power2_eq_square[symmetric])
  3035     apply (subst power2_abs[symmetric])
  3036     apply (rule power_mono)
  3037     apply (auto simp: infnorm_Max)
  3038     done
  3039   from real_le_lsqrt[OF inner_ge_zero th th1]
  3040   show ?thesis
  3041     unfolding norm_eq_sqrt_inner id_def .
  3042 qed
  3043 
  3044 lemma tendsto_infnorm [tendsto_intros]:
  3045   assumes "(f \<longlongrightarrow> a) F"
  3046   shows "((\<lambda>x. infnorm (f x)) \<longlongrightarrow> infnorm a) F"
  3047 proof (rule tendsto_compose [OF LIM_I assms])
  3048   fix r :: real
  3049   assume "r > 0"
  3050   then show "\<exists>s>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < s \<longrightarrow> norm (infnorm x - infnorm a) < r"
  3051     by (metis real_norm_def le_less_trans real_abs_sub_infnorm infnorm_le_norm)
  3052 qed
  3053 
  3054 text \<open>Equality in Cauchy-Schwarz and triangle inequalities.\<close>
  3055 
  3056 lemma norm_cauchy_schwarz_eq: "x \<bullet> y = norm x * norm y \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
  3057   (is "?lhs \<longleftrightarrow> ?rhs")
  3058 proof -
  3059   {
  3060     assume h: "x = 0"
  3061     then have ?thesis by simp
  3062   }
  3063   moreover
  3064   {
  3065     assume h: "y = 0"
  3066     then have ?thesis by simp
  3067   }
  3068   moreover
  3069   {
  3070     assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
  3071     from inner_eq_zero_iff[of "norm y *\<^sub>R x - norm x *\<^sub>R y"]
  3072     have "?rhs \<longleftrightarrow>
  3073       (norm y * (norm y * norm x * norm x - norm x * (x \<bullet> y)) -
  3074         norm x * (norm y * (y \<bullet> x) - norm x * norm y * norm y) =  0)"
  3075       using x y
  3076       unfolding inner_simps
  3077       unfolding power2_norm_eq_inner[symmetric] power2_eq_square right_minus_eq
  3078       apply (simp add: inner_commute)
  3079       apply (simp add: field_simps)
  3080       apply metis
  3081       done
  3082     also have "\<dots> \<longleftrightarrow> (2 * norm x * norm y * (norm x * norm y - x \<bullet> y) = 0)" using x y
  3083       by (simp add: field_simps inner_commute)
  3084     also have "\<dots> \<longleftrightarrow> ?lhs" using x y
  3085       apply simp
  3086       apply metis
  3087       done
  3088     finally have ?thesis by blast
  3089   }
  3090   ultimately show ?thesis by blast
  3091 qed
  3092 
  3093 lemma norm_cauchy_schwarz_abs_eq:
  3094   "\<bar>x \<bullet> y\<bar> = norm x * norm y \<longleftrightarrow>
  3095     norm x *\<^sub>R y = norm y *\<^sub>R x \<or> norm x *\<^sub>R y = - norm y *\<^sub>R x"
  3096   (is "?lhs \<longleftrightarrow> ?rhs")
  3097 proof -
  3098   have th: "\<And>(x::real) a. a \<ge> 0 \<Longrightarrow> \<bar>x\<bar> = a \<longleftrightarrow> x = a \<or> x = - a"
  3099     by arith
  3100   have "?rhs \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x \<or> norm (- x) *\<^sub>R y = norm y *\<^sub>R (- x)"
  3101     by simp
  3102   also have "\<dots> \<longleftrightarrow>(x \<bullet> y = norm x * norm y \<or> (- x) \<bullet> y = norm x * norm y)"
  3103     unfolding norm_cauchy_schwarz_eq[symmetric]
  3104     unfolding norm_minus_cancel norm_scaleR ..
  3105   also have "\<dots> \<longleftrightarrow> ?lhs"
  3106     unfolding th[OF mult_nonneg_nonneg, OF norm_ge_zero[of x] norm_ge_zero[of y]] inner_simps
  3107     by auto
  3108   finally show ?thesis ..
  3109 qed
  3110 
  3111 lemma norm_triangle_eq:
  3112   fixes x y :: "'a::real_inner"
  3113   shows "norm (x + y) = norm x + norm y \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
  3114 proof -
  3115   {
  3116     assume x: "x = 0 \<or> y = 0"
  3117     then have ?thesis
  3118       by (cases "x = 0") simp_all
  3119   }
  3120   moreover
  3121   {
  3122     assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
  3123     then have "norm x \<noteq> 0" "norm y \<noteq> 0"
  3124       by simp_all
  3125     then have n: "norm x > 0" "norm y > 0"
  3126       using norm_ge_zero[of x] norm_ge_zero[of y] by arith+
  3127     have th: "\<And>(a::real) b c. a + b + c \<noteq> 0 \<Longrightarrow> a = b + c \<longleftrightarrow> a\<^sup>2 = (b + c)\<^sup>2"
  3128       by algebra
  3129     have "norm (x + y) = norm x + norm y \<longleftrightarrow> (norm (x + y))\<^sup>2 = (norm x + norm y)\<^sup>2"
  3130       apply (rule th)
  3131       using n norm_ge_zero[of "x + y"]
  3132       apply arith
  3133       done
  3134     also have "\<dots> \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
  3135       unfolding norm_cauchy_schwarz_eq[symmetric]
  3136       unfolding power2_norm_eq_inner inner_simps
  3137       by (simp add: power2_norm_eq_inner[symmetric] power2_eq_square inner_commute field_simps)
  3138     finally have ?thesis .
  3139   }
  3140   ultimately show ?thesis by blast
  3141 qed
  3142 
  3143 
  3144 subsection \<open>Collinearity\<close>
  3145 
  3146 definition collinear :: "'a::real_vector set \<Rightarrow> bool"
  3147   where "collinear S \<longleftrightarrow> (\<exists>u. \<forall>x \<in> S. \<forall> y \<in> S. \<exists>c. x - y = c *\<^sub>R u)"
  3148 
  3149 lemma collinear_subset: "\<lbrakk>collinear T; S \<subseteq> T\<rbrakk> \<Longrightarrow> collinear S"
  3150   by (meson collinear_def subsetCE)
  3151 
  3152 lemma collinear_empty [iff]: "collinear {}"
  3153   by (simp add: collinear_def)
  3154 
  3155 lemma collinear_sing [iff]: "collinear {x}"
  3156   by (simp add: collinear_def)
  3157 
  3158 lemma collinear_2 [iff]: "collinear {x, y}"
  3159   apply (simp add: collinear_def)
  3160   apply (rule exI[where x="x - y"])
  3161   apply auto
  3162   apply (rule exI[where x=1], simp)
  3163   apply (rule exI[where x="- 1"], simp)
  3164   done
  3165 
  3166 lemma collinear_lemma: "collinear {0, x, y} \<longleftrightarrow> x = 0 \<or> y = 0 \<or> (\<exists>c. y = c *\<^sub>R x)"
  3167   (is "?lhs \<longleftrightarrow> ?rhs")
  3168 proof -
  3169   {
  3170     assume "x = 0 \<or> y = 0"
  3171     then have ?thesis
  3172       by (cases "x = 0") (simp_all add: collinear_2 insert_commute)
  3173   }
  3174   moreover
  3175   {
  3176     assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
  3177     have ?thesis
  3178     proof
  3179       assume h: "?lhs"
  3180       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"
  3181         unfolding collinear_def by blast
  3182       from u[rule_format, of x 0] u[rule_format, of y 0]
  3183       obtain cx and cy where
  3184         cx: "x = cx *\<^sub>R u" and cy: "y = cy *\<^sub>R u"
  3185         by auto
  3186       from cx x have cx0: "cx \<noteq> 0" by auto
  3187       from cy y have cy0: "cy \<noteq> 0" by auto
  3188       let ?d = "cy / cx"
  3189       from cx cy cx0 have "y = ?d *\<^sub>R x"
  3190         by simp
  3191       then show ?rhs using x y by blast
  3192     next
  3193       assume h: "?rhs"
  3194       then obtain c where c: "y = c *\<^sub>R x"
  3195         using x y by blast
  3196       show ?lhs
  3197         unfolding collinear_def c
  3198         apply (rule exI[where x=x])
  3199         apply auto
  3200         apply (rule exI[where x="- 1"], simp)
  3201         apply (rule exI[where x= "-c"], simp)
  3202         apply (rule exI[where x=1], simp)
  3203         apply (rule exI[where x="1 - c"], simp add: scaleR_left_diff_distrib)
  3204         apply (rule exI[where x="c - 1"], simp add: scaleR_left_diff_distrib)
  3205         done
  3206     qed
  3207   }
  3208   ultimately show ?thesis by blast
  3209 qed
  3210 
  3211 lemma norm_cauchy_schwarz_equal: "\<bar>x \<bullet> y\<bar> = norm x * norm y \<longleftrightarrow> collinear {0, x, y}"
  3212   unfolding norm_cauchy_schwarz_abs_eq
  3213   apply (cases "x=0", simp_all)
  3214   apply (cases "y=0", simp_all add: insert_commute)
  3215   unfolding collinear_lemma
  3216   apply simp
  3217   apply (subgoal_tac "norm x \<noteq> 0")
  3218   apply (subgoal_tac "norm y \<noteq> 0")
  3219   apply (rule iffI)
  3220   apply (cases "norm x *\<^sub>R y = norm y *\<^sub>R x")
  3221   apply (rule exI[where x="(1/norm x) * norm y"])
  3222   apply (drule sym)
  3223   unfolding scaleR_scaleR[symmetric]
  3224   apply (simp add: field_simps)
  3225   apply (rule exI[where x="(1/norm x) * - norm y"])
  3226   apply clarify
  3227   apply (drule sym)
  3228   unfolding scaleR_scaleR[symmetric]
  3229   apply (simp add: field_simps)
  3230   apply (erule exE)
  3231   apply (erule ssubst)
  3232   unfolding scaleR_scaleR
  3233   unfolding norm_scaleR
  3234   apply (subgoal_tac "norm x * c = \<bar>c\<bar> * norm x \<or> norm x * c = - \<bar>c\<bar> * norm x")
  3235   apply (auto simp add: field_simps)
  3236   done
  3237 
  3238 end