src/HOL/Analysis/Linear_Algebra.thy
author paulson <lp15@cam.ac.uk>
Wed Jul 19 16:41:26 2017 +0100 (22 months ago)
changeset 66287 005a30862ed0
parent 65680 378a2f11bec9
child 66297 d425bdf419f5
permissions -rw-r--r--
new material: Colinearity, convex sets, polytopes
     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_bound:
  1484   fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
  1485   assumes K: "\<And>x. x \<in> S \<Longrightarrow> norm (f x) \<le> K"
  1486   shows "norm (sum f S) \<le> of_nat (card S)*K"
  1487   using sum_norm_le[OF K] sum_constant[symmetric]
  1488   by simp
  1489 
  1490 lemma sum_group:
  1491   assumes fS: "finite S" and fT: "finite T" and fST: "f ` S \<subseteq> T"
  1492   shows "sum (\<lambda>y. sum g {x. x \<in> S \<and> f x = y}) T = sum g S"
  1493   apply (subst sum_image_gen[OF fS, of g f])
  1494   apply (rule sum.mono_neutral_right[OF fT fST])
  1495   apply (auto intro: sum.neutral)
  1496   done
  1497 
  1498 lemma vector_eq_ldot: "(\<forall>x. x \<bullet> y = x \<bullet> z) \<longleftrightarrow> y = z"
  1499 proof
  1500   assume "\<forall>x. x \<bullet> y = x \<bullet> z"
  1501   then have "\<forall>x. x \<bullet> (y - z) = 0"
  1502     by (simp add: inner_diff)
  1503   then have "(y - z) \<bullet> (y - z) = 0" ..
  1504   then show "y = z" by simp
  1505 qed simp
  1506 
  1507 lemma vector_eq_rdot: "(\<forall>z. x \<bullet> z = y \<bullet> z) \<longleftrightarrow> x = y"
  1508 proof
  1509   assume "\<forall>z. x \<bullet> z = y \<bullet> z"
  1510   then have "\<forall>z. (x - y) \<bullet> z = 0"
  1511     by (simp add: inner_diff)
  1512   then have "(x - y) \<bullet> (x - y) = 0" ..
  1513   then show "x = y" by simp
  1514 qed simp
  1515 
  1516 
  1517 subsection \<open>Orthogonality.\<close>
  1518 
  1519 context real_inner
  1520 begin
  1521 
  1522 definition "orthogonal x y \<longleftrightarrow> x \<bullet> y = 0"
  1523 
  1524 lemma orthogonal_self: "orthogonal x x \<longleftrightarrow> x = 0"
  1525   by (simp add: orthogonal_def)
  1526 
  1527 lemma orthogonal_clauses:
  1528   "orthogonal a 0"
  1529   "orthogonal a x \<Longrightarrow> orthogonal a (c *\<^sub>R x)"
  1530   "orthogonal a x \<Longrightarrow> orthogonal a (- x)"
  1531   "orthogonal a x \<Longrightarrow> orthogonal a y \<Longrightarrow> orthogonal a (x + y)"
  1532   "orthogonal a x \<Longrightarrow> orthogonal a y \<Longrightarrow> orthogonal a (x - y)"
  1533   "orthogonal 0 a"
  1534   "orthogonal x a \<Longrightarrow> orthogonal (c *\<^sub>R x) a"
  1535   "orthogonal x a \<Longrightarrow> orthogonal (- x) a"
  1536   "orthogonal x a \<Longrightarrow> orthogonal y a \<Longrightarrow> orthogonal (x + y) a"
  1537   "orthogonal x a \<Longrightarrow> orthogonal y a \<Longrightarrow> orthogonal (x - y) a"
  1538   unfolding orthogonal_def inner_add inner_diff by auto
  1539 
  1540 end
  1541 
  1542 lemma orthogonal_commute: "orthogonal x y \<longleftrightarrow> orthogonal y x"
  1543   by (simp add: orthogonal_def inner_commute)
  1544 
  1545 lemma orthogonal_scaleR [simp]: "c \<noteq> 0 \<Longrightarrow> orthogonal (c *\<^sub>R x) = orthogonal x"
  1546   by (rule ext) (simp add: orthogonal_def)
  1547 
  1548 lemma pairwise_ortho_scaleR:
  1549     "pairwise (\<lambda>i j. orthogonal (f i) (g j)) B
  1550     \<Longrightarrow> pairwise (\<lambda>i j. orthogonal (a i *\<^sub>R f i) (a j *\<^sub>R g j)) B"
  1551   by (auto simp: pairwise_def orthogonal_clauses)
  1552 
  1553 lemma orthogonal_rvsum:
  1554     "\<lbrakk>finite s; \<And>y. y \<in> s \<Longrightarrow> orthogonal x (f y)\<rbrakk> \<Longrightarrow> orthogonal x (sum f s)"
  1555   by (induction s rule: finite_induct) (auto simp: orthogonal_clauses)
  1556 
  1557 lemma orthogonal_lvsum:
  1558     "\<lbrakk>finite s; \<And>x. x \<in> s \<Longrightarrow> orthogonal (f x) y\<rbrakk> \<Longrightarrow> orthogonal (sum f s) y"
  1559   by (induction s rule: finite_induct) (auto simp: orthogonal_clauses)
  1560 
  1561 lemma norm_add_Pythagorean:
  1562   assumes "orthogonal a b"
  1563     shows "norm(a + b) ^ 2 = norm a ^ 2 + norm b ^ 2"
  1564 proof -
  1565   from assms have "(a - (0 - b)) \<bullet> (a - (0 - b)) = a \<bullet> a - (0 - b \<bullet> b)"
  1566     by (simp add: algebra_simps orthogonal_def inner_commute)
  1567   then show ?thesis
  1568     by (simp add: power2_norm_eq_inner)
  1569 qed
  1570 
  1571 lemma norm_sum_Pythagorean:
  1572   assumes "finite I" "pairwise (\<lambda>i j. orthogonal (f i) (f j)) I"
  1573     shows "(norm (sum f I))\<^sup>2 = (\<Sum>i\<in>I. (norm (f i))\<^sup>2)"
  1574 using assms
  1575 proof (induction I rule: finite_induct)
  1576   case empty then show ?case by simp
  1577 next
  1578   case (insert x I)
  1579   then have "orthogonal (f x) (sum f I)"
  1580     by (metis pairwise_insert orthogonal_rvsum)
  1581   with insert show ?case
  1582     by (simp add: pairwise_insert norm_add_Pythagorean)
  1583 qed
  1584 
  1585 
  1586 subsection \<open>Bilinear functions.\<close>
  1587 
  1588 definition "bilinear f \<longleftrightarrow> (\<forall>x. linear (\<lambda>y. f x y)) \<and> (\<forall>y. linear (\<lambda>x. f x y))"
  1589 
  1590 lemma bilinear_ladd: "bilinear h \<Longrightarrow> h (x + y) z = h x z + h y z"
  1591   by (simp add: bilinear_def linear_iff)
  1592 
  1593 lemma bilinear_radd: "bilinear h \<Longrightarrow> h x (y + z) = h x y + h x z"
  1594   by (simp add: bilinear_def linear_iff)
  1595 
  1596 lemma bilinear_lmul: "bilinear h \<Longrightarrow> h (c *\<^sub>R x) y = c *\<^sub>R h x y"
  1597   by (simp add: bilinear_def linear_iff)
  1598 
  1599 lemma bilinear_rmul: "bilinear h \<Longrightarrow> h x (c *\<^sub>R y) = c *\<^sub>R h x y"
  1600   by (simp add: bilinear_def linear_iff)
  1601 
  1602 lemma bilinear_lneg: "bilinear h \<Longrightarrow> h (- x) y = - h x y"
  1603   by (drule bilinear_lmul [of _ "- 1"]) simp
  1604 
  1605 lemma bilinear_rneg: "bilinear h \<Longrightarrow> h x (- y) = - h x y"
  1606   by (drule bilinear_rmul [of _ _ "- 1"]) simp
  1607 
  1608 lemma (in ab_group_add) eq_add_iff: "x = x + y \<longleftrightarrow> y = 0"
  1609   using add_left_imp_eq[of x y 0] by auto
  1610 
  1611 lemma bilinear_lzero:
  1612   assumes "bilinear h"
  1613   shows "h 0 x = 0"
  1614   using bilinear_ladd [OF assms, of 0 0 x] by (simp add: eq_add_iff field_simps)
  1615 
  1616 lemma bilinear_rzero:
  1617   assumes "bilinear h"
  1618   shows "h x 0 = 0"
  1619   using bilinear_radd [OF assms, of x 0 0 ] by (simp add: eq_add_iff field_simps)
  1620 
  1621 lemma bilinear_lsub: "bilinear h \<Longrightarrow> h (x - y) z = h x z - h y z"
  1622   using bilinear_ladd [of h x "- y"] by (simp add: bilinear_lneg)
  1623 
  1624 lemma bilinear_rsub: "bilinear h \<Longrightarrow> h z (x - y) = h z x - h z y"
  1625   using bilinear_radd [of h _ x "- y"] by (simp add: bilinear_rneg)
  1626 
  1627 lemma bilinear_sum:
  1628   assumes bh: "bilinear h"
  1629     and fS: "finite S"
  1630     and fT: "finite T"
  1631   shows "h (sum f S) (sum g T) = sum (\<lambda>(i,j). h (f i) (g j)) (S \<times> T) "
  1632 proof -
  1633   have "h (sum f S) (sum g T) = sum (\<lambda>x. h (f x) (sum g T)) S"
  1634     apply (rule linear_sum[unfolded o_def])
  1635     using bh fS
  1636     apply (auto simp add: bilinear_def)
  1637     done
  1638   also have "\<dots> = sum (\<lambda>x. sum (\<lambda>y. h (f x) (g y)) T) S"
  1639     apply (rule sum.cong, simp)
  1640     apply (rule linear_sum[unfolded o_def])
  1641     using bh fT
  1642     apply (auto simp add: bilinear_def)
  1643     done
  1644   finally show ?thesis
  1645     unfolding sum.cartesian_product .
  1646 qed
  1647 
  1648 
  1649 subsection \<open>Adjoints.\<close>
  1650 
  1651 definition "adjoint f = (SOME f'. \<forall>x y. f x \<bullet> y = x \<bullet> f' y)"
  1652 
  1653 lemma adjoint_unique:
  1654   assumes "\<forall>x y. inner (f x) y = inner x (g y)"
  1655   shows "adjoint f = g"
  1656   unfolding adjoint_def
  1657 proof (rule some_equality)
  1658   show "\<forall>x y. inner (f x) y = inner x (g y)"
  1659     by (rule assms)
  1660 next
  1661   fix h
  1662   assume "\<forall>x y. inner (f x) y = inner x (h y)"
  1663   then have "\<forall>x y. inner x (g y) = inner x (h y)"
  1664     using assms by simp
  1665   then have "\<forall>x y. inner x (g y - h y) = 0"
  1666     by (simp add: inner_diff_right)
  1667   then have "\<forall>y. inner (g y - h y) (g y - h y) = 0"
  1668     by simp
  1669   then have "\<forall>y. h y = g y"
  1670     by simp
  1671   then show "h = g" by (simp add: ext)
  1672 qed
  1673 
  1674 text \<open>TODO: The following lemmas about adjoints should hold for any
  1675   Hilbert space (i.e. complete inner product space).
  1676   (see \<^url>\<open>http://en.wikipedia.org/wiki/Hermitian_adjoint\<close>)
  1677 \<close>
  1678 
  1679 lemma adjoint_works:
  1680   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
  1681   assumes lf: "linear f"
  1682   shows "x \<bullet> adjoint f y = f x \<bullet> y"
  1683 proof -
  1684   have "\<forall>y. \<exists>w. \<forall>x. f x \<bullet> y = x \<bullet> w"
  1685   proof (intro allI exI)
  1686     fix y :: "'m" and x
  1687     let ?w = "(\<Sum>i\<in>Basis. (f i \<bullet> y) *\<^sub>R i) :: 'n"
  1688     have "f x \<bullet> y = f (\<Sum>i\<in>Basis. (x \<bullet> i) *\<^sub>R i) \<bullet> y"
  1689       by (simp add: euclidean_representation)
  1690     also have "\<dots> = (\<Sum>i\<in>Basis. (x \<bullet> i) *\<^sub>R f i) \<bullet> y"
  1691       unfolding linear_sum[OF lf]
  1692       by (simp add: linear_cmul[OF lf])
  1693     finally show "f x \<bullet> y = x \<bullet> ?w"
  1694       by (simp add: inner_sum_left inner_sum_right mult.commute)
  1695   qed
  1696   then show ?thesis
  1697     unfolding adjoint_def choice_iff
  1698     by (intro someI2_ex[where Q="\<lambda>f'. x \<bullet> f' y = f x \<bullet> y"]) auto
  1699 qed
  1700 
  1701 lemma adjoint_clauses:
  1702   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
  1703   assumes lf: "linear f"
  1704   shows "x \<bullet> adjoint f y = f x \<bullet> y"
  1705     and "adjoint f y \<bullet> x = y \<bullet> f x"
  1706   by (simp_all add: adjoint_works[OF lf] inner_commute)
  1707 
  1708 lemma adjoint_linear:
  1709   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
  1710   assumes lf: "linear f"
  1711   shows "linear (adjoint f)"
  1712   by (simp add: lf linear_iff euclidean_eq_iff[where 'a='n] euclidean_eq_iff[where 'a='m]
  1713     adjoint_clauses[OF lf] inner_distrib)
  1714 
  1715 lemma adjoint_adjoint:
  1716   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
  1717   assumes lf: "linear f"
  1718   shows "adjoint (adjoint f) = f"
  1719   by (rule adjoint_unique, simp add: adjoint_clauses [OF lf])
  1720 
  1721 
  1722 subsection \<open>Interlude: Some properties of real sets\<close>
  1723 
  1724 lemma seq_mono_lemma:
  1725   assumes "\<forall>(n::nat) \<ge> m. (d n :: real) < e n"
  1726     and "\<forall>n \<ge> m. e n \<le> e m"
  1727   shows "\<forall>n \<ge> m. d n < e m"
  1728   using assms
  1729   apply auto
  1730   apply (erule_tac x="n" in allE)
  1731   apply (erule_tac x="n" in allE)
  1732   apply auto
  1733   done
  1734 
  1735 lemma infinite_enumerate:
  1736   assumes fS: "infinite S"
  1737   shows "\<exists>r. subseq r \<and> (\<forall>n. r n \<in> S)"
  1738   unfolding subseq_def
  1739   using enumerate_in_set[OF fS] enumerate_mono[of _ _ S] fS by auto
  1740 
  1741 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)"
  1742   apply auto
  1743   apply (rule_tac x="d/2" in exI)
  1744   apply auto
  1745   done
  1746 
  1747 lemma approachable_lt_le2:  \<comment>\<open>like the above, but pushes aside an extra formula\<close>
  1748     "(\<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)"
  1749   apply auto
  1750   apply (rule_tac x="d/2" in exI, auto)
  1751   done
  1752 
  1753 lemma triangle_lemma:
  1754   fixes x y z :: real
  1755   assumes x: "0 \<le> x"
  1756     and y: "0 \<le> y"
  1757     and z: "0 \<le> z"
  1758     and xy: "x\<^sup>2 \<le> y\<^sup>2 + z\<^sup>2"
  1759   shows "x \<le> y + z"
  1760 proof -
  1761   have "y\<^sup>2 + z\<^sup>2 \<le> y\<^sup>2 + 2 * y * z + z\<^sup>2"
  1762     using z y by simp
  1763   with xy have th: "x\<^sup>2 \<le> (y + z)\<^sup>2"
  1764     by (simp add: power2_eq_square field_simps)
  1765   from y z have yz: "y + z \<ge> 0"
  1766     by arith
  1767   from power2_le_imp_le[OF th yz] show ?thesis .
  1768 qed
  1769 
  1770 
  1771 
  1772 subsection \<open>Archimedean properties and useful consequences\<close>
  1773 
  1774 text\<open>Bernoulli's inequality\<close>
  1775 proposition Bernoulli_inequality:
  1776   fixes x :: real
  1777   assumes "-1 \<le> x"
  1778     shows "1 + n * x \<le> (1 + x) ^ n"
  1779 proof (induct n)
  1780   case 0
  1781   then show ?case by simp
  1782 next
  1783   case (Suc n)
  1784   have "1 + Suc n * x \<le> 1 + (Suc n)*x + n * x^2"
  1785     by (simp add: algebra_simps)
  1786   also have "... = (1 + x) * (1 + n*x)"
  1787     by (auto simp: power2_eq_square algebra_simps  of_nat_Suc)
  1788   also have "... \<le> (1 + x) ^ Suc n"
  1789     using Suc.hyps assms mult_left_mono by fastforce
  1790   finally show ?case .
  1791 qed
  1792 
  1793 corollary Bernoulli_inequality_even:
  1794   fixes x :: real
  1795   assumes "even n"
  1796     shows "1 + n * x \<le> (1 + x) ^ n"
  1797 proof (cases "-1 \<le> x \<or> n=0")
  1798   case True
  1799   then show ?thesis
  1800     by (auto simp: Bernoulli_inequality)
  1801 next
  1802   case False
  1803   then have "real n \<ge> 1"
  1804     by simp
  1805   with False have "n * x \<le> -1"
  1806     by (metis linear minus_zero mult.commute mult.left_neutral mult_left_mono_neg neg_le_iff_le order_trans zero_le_one)
  1807   then have "1 + n * x \<le> 0"
  1808     by auto
  1809   also have "... \<le> (1 + x) ^ n"
  1810     using assms
  1811     using zero_le_even_power by blast
  1812   finally show ?thesis .
  1813 qed
  1814 
  1815 corollary real_arch_pow:
  1816   fixes x :: real
  1817   assumes x: "1 < x"
  1818   shows "\<exists>n. y < x^n"
  1819 proof -
  1820   from x have x0: "x - 1 > 0"
  1821     by arith
  1822   from reals_Archimedean3[OF x0, rule_format, of y]
  1823   obtain n :: nat where n: "y < real n * (x - 1)" by metis
  1824   from x0 have x00: "x- 1 \<ge> -1" by arith
  1825   from Bernoulli_inequality[OF x00, of n] n
  1826   have "y < x^n" by auto
  1827   then show ?thesis by metis
  1828 qed
  1829 
  1830 corollary real_arch_pow_inv:
  1831   fixes x y :: real
  1832   assumes y: "y > 0"
  1833     and x1: "x < 1"
  1834   shows "\<exists>n. x^n < y"
  1835 proof (cases "x > 0")
  1836   case True
  1837   with x1 have ix: "1 < 1/x" by (simp add: field_simps)
  1838   from real_arch_pow[OF ix, of "1/y"]
  1839   obtain n where n: "1/y < (1/x)^n" by blast
  1840   then show ?thesis using y \<open>x > 0\<close>
  1841     by (auto simp add: field_simps)
  1842 next
  1843   case False
  1844   with y x1 show ?thesis
  1845     apply auto
  1846     apply (rule exI[where x=1])
  1847     apply auto
  1848     done
  1849 qed
  1850 
  1851 lemma forall_pos_mono:
  1852   "(\<And>d e::real. d < e \<Longrightarrow> P d \<Longrightarrow> P e) \<Longrightarrow>
  1853     (\<And>n::nat. n \<noteq> 0 \<Longrightarrow> P (inverse (real n))) \<Longrightarrow> (\<And>e. 0 < e \<Longrightarrow> P e)"
  1854   by (metis real_arch_inverse)
  1855 
  1856 lemma forall_pos_mono_1:
  1857   "(\<And>d e::real. d < e \<Longrightarrow> P d \<Longrightarrow> P e) \<Longrightarrow>
  1858     (\<And>n. P (inverse (real (Suc n)))) \<Longrightarrow> 0 < e \<Longrightarrow> P e"
  1859   apply (rule forall_pos_mono)
  1860   apply auto
  1861   apply (metis Suc_pred of_nat_Suc)
  1862   done
  1863 
  1864 
  1865 subsection \<open>Euclidean Spaces as Typeclass\<close>
  1866 
  1867 lemma independent_Basis: "independent Basis"
  1868   unfolding dependent_def
  1869   apply (subst span_finite)
  1870   apply simp
  1871   apply clarify
  1872   apply (drule_tac f="inner a" in arg_cong)
  1873   apply (simp add: inner_Basis inner_sum_right eq_commute)
  1874   done
  1875 
  1876 lemma span_Basis [simp]: "span Basis = UNIV"
  1877   unfolding span_finite [OF finite_Basis]
  1878   by (fast intro: euclidean_representation)
  1879 
  1880 lemma in_span_Basis: "x \<in> span Basis"
  1881   unfolding span_Basis ..
  1882 
  1883 lemma Basis_le_norm: "b \<in> Basis \<Longrightarrow> \<bar>x \<bullet> b\<bar> \<le> norm x"
  1884   by (rule order_trans [OF Cauchy_Schwarz_ineq2]) simp
  1885 
  1886 lemma norm_bound_Basis_le: "b \<in> Basis \<Longrightarrow> norm x \<le> e \<Longrightarrow> \<bar>x \<bullet> b\<bar> \<le> e"
  1887   by (metis Basis_le_norm order_trans)
  1888 
  1889 lemma norm_bound_Basis_lt: "b \<in> Basis \<Longrightarrow> norm x < e \<Longrightarrow> \<bar>x \<bullet> b\<bar> < e"
  1890   by (metis Basis_le_norm le_less_trans)
  1891 
  1892 lemma norm_le_l1: "norm x \<le> (\<Sum>b\<in>Basis. \<bar>x \<bullet> b\<bar>)"
  1893   apply (subst euclidean_representation[of x, symmetric])
  1894   apply (rule order_trans[OF norm_sum])
  1895   apply (auto intro!: sum_mono)
  1896   done
  1897 
  1898 lemma sum_norm_allsubsets_bound:
  1899   fixes f :: "'a \<Rightarrow> 'n::euclidean_space"
  1900   assumes fP: "finite P"
  1901     and fPs: "\<And>Q. Q \<subseteq> P \<Longrightarrow> norm (sum f Q) \<le> e"
  1902   shows "(\<Sum>x\<in>P. norm (f x)) \<le> 2 * real DIM('n) * e"
  1903 proof -
  1904   have "(\<Sum>x\<in>P. norm (f x)) \<le> (\<Sum>x\<in>P. \<Sum>b\<in>Basis. \<bar>f x \<bullet> b\<bar>)"
  1905     by (rule sum_mono) (rule norm_le_l1)
  1906   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>)"
  1907     by (rule sum.commute)
  1908   also have "\<dots> \<le> of_nat (card (Basis :: 'n set)) * (2 * e)"
  1909   proof (rule sum_bounded_above)
  1910     fix i :: 'n
  1911     assume i: "i \<in> Basis"
  1912     have "norm (\<Sum>x\<in>P. \<bar>f x \<bullet> i\<bar>) \<le>
  1913       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)"
  1914       by (simp add: abs_real_def sum.If_cases[OF fP] sum_negf norm_triangle_ineq4 inner_sum_left
  1915         del: real_norm_def)
  1916     also have "\<dots> \<le> e + e"
  1917       unfolding real_norm_def
  1918       by (intro add_mono norm_bound_Basis_le i fPs) auto
  1919     finally show "(\<Sum>x\<in>P. \<bar>f x \<bullet> i\<bar>) \<le> 2*e" by simp
  1920   qed
  1921   also have "\<dots> = 2 * real DIM('n) * e" by simp
  1922   finally show ?thesis .
  1923 qed
  1924 
  1925 
  1926 subsection \<open>Linearity and Bilinearity continued\<close>
  1927 
  1928 lemma linear_bounded:
  1929   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  1930   assumes lf: "linear f"
  1931   shows "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
  1932 proof
  1933   let ?B = "\<Sum>b\<in>Basis. norm (f b)"
  1934   show "\<forall>x. norm (f x) \<le> ?B * norm x"
  1935   proof
  1936     fix x :: 'a
  1937     let ?g = "\<lambda>b. (x \<bullet> b) *\<^sub>R f b"
  1938     have "norm (f x) = norm (f (\<Sum>b\<in>Basis. (x \<bullet> b) *\<^sub>R b))"
  1939       unfolding euclidean_representation ..
  1940     also have "\<dots> = norm (sum ?g Basis)"
  1941       by (simp add: linear_sum [OF lf] linear_cmul [OF lf])
  1942     finally have th0: "norm (f x) = norm (sum ?g Basis)" .
  1943     have th: "norm (?g i) \<le> norm (f i) * norm x" if "i \<in> Basis" for i
  1944     proof -
  1945       from Basis_le_norm[OF that, of x]
  1946       show "norm (?g i) \<le> norm (f i) * norm x"
  1947         unfolding norm_scaleR
  1948         apply (subst mult.commute)
  1949         apply (rule mult_mono)
  1950         apply (auto simp add: field_simps)
  1951         done
  1952     qed
  1953     from sum_norm_le[of _ ?g, OF th]
  1954     show "norm (f x) \<le> ?B * norm x"
  1955       unfolding th0 sum_distrib_right by metis
  1956   qed
  1957 qed
  1958 
  1959 lemma linear_conv_bounded_linear:
  1960   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  1961   shows "linear f \<longleftrightarrow> bounded_linear f"
  1962 proof
  1963   assume "linear f"
  1964   then interpret f: linear f .
  1965   show "bounded_linear f"
  1966   proof
  1967     have "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
  1968       using \<open>linear f\<close> by (rule linear_bounded)
  1969     then show "\<exists>K. \<forall>x. norm (f x) \<le> norm x * K"
  1970       by (simp add: mult.commute)
  1971   qed
  1972 next
  1973   assume "bounded_linear f"
  1974   then interpret f: bounded_linear f .
  1975   show "linear f" ..
  1976 qed
  1977 
  1978 lemmas linear_linear = linear_conv_bounded_linear[symmetric]
  1979 
  1980 lemma linear_bounded_pos:
  1981   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  1982   assumes lf: "linear f"
  1983   shows "\<exists>B > 0. \<forall>x. norm (f x) \<le> B * norm x"
  1984 proof -
  1985   have "\<exists>B > 0. \<forall>x. norm (f x) \<le> norm x * B"
  1986     using lf unfolding linear_conv_bounded_linear
  1987     by (rule bounded_linear.pos_bounded)
  1988   then show ?thesis
  1989     by (simp only: mult.commute)
  1990 qed
  1991 
  1992 lemma bounded_linearI':
  1993   fixes f ::"'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  1994   assumes "\<And>x y. f (x + y) = f x + f y"
  1995     and "\<And>c x. f (c *\<^sub>R x) = c *\<^sub>R f x"
  1996   shows "bounded_linear f"
  1997   unfolding linear_conv_bounded_linear[symmetric]
  1998   by (rule linearI[OF assms])
  1999 
  2000 lemma bilinear_bounded:
  2001   fixes h :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space \<Rightarrow> 'k::real_normed_vector"
  2002   assumes bh: "bilinear h"
  2003   shows "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
  2004 proof (clarify intro!: exI[of _ "\<Sum>i\<in>Basis. \<Sum>j\<in>Basis. norm (h i j)"])
  2005   fix x :: 'm
  2006   fix y :: 'n
  2007   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))"
  2008     apply (subst euclidean_representation[where 'a='m])
  2009     apply (subst euclidean_representation[where 'a='n])
  2010     apply rule
  2011     done
  2012   also have "\<dots> = norm (sum (\<lambda> (i,j). h ((x \<bullet> i) *\<^sub>R i) ((y \<bullet> j) *\<^sub>R j)) (Basis \<times> Basis))"
  2013     unfolding bilinear_sum[OF bh finite_Basis finite_Basis] ..
  2014   finally have th: "norm (h x y) = \<dots>" .
  2015   show "norm (h x y) \<le> (\<Sum>i\<in>Basis. \<Sum>j\<in>Basis. norm (h i j)) * norm x * norm y"
  2016     apply (auto simp add: sum_distrib_right th sum.cartesian_product)
  2017     apply (rule sum_norm_le)
  2018     apply (auto simp add: bilinear_rmul[OF bh] bilinear_lmul[OF bh]
  2019       field_simps simp del: scaleR_scaleR)
  2020     apply (rule mult_mono)
  2021     apply (auto simp add: zero_le_mult_iff Basis_le_norm)
  2022     apply (rule mult_mono)
  2023     apply (auto simp add: zero_le_mult_iff Basis_le_norm)
  2024     done
  2025 qed
  2026 
  2027 lemma bilinear_conv_bounded_bilinear:
  2028   fixes h :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::real_normed_vector"
  2029   shows "bilinear h \<longleftrightarrow> bounded_bilinear h"
  2030 proof
  2031   assume "bilinear h"
  2032   show "bounded_bilinear h"
  2033   proof
  2034     fix x y z
  2035     show "h (x + y) z = h x z + h y z"
  2036       using \<open>bilinear h\<close> unfolding bilinear_def linear_iff by simp
  2037   next
  2038     fix x y z
  2039     show "h x (y + z) = h x y + h x z"
  2040       using \<open>bilinear h\<close> unfolding bilinear_def linear_iff by simp
  2041   next
  2042     fix r x y
  2043     show "h (scaleR r x) y = scaleR r (h x y)"
  2044       using \<open>bilinear h\<close> unfolding bilinear_def linear_iff
  2045       by simp
  2046   next
  2047     fix r x y
  2048     show "h x (scaleR r y) = scaleR r (h x y)"
  2049       using \<open>bilinear h\<close> unfolding bilinear_def linear_iff
  2050       by simp
  2051   next
  2052     have "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
  2053       using \<open>bilinear h\<close> by (rule bilinear_bounded)
  2054     then show "\<exists>K. \<forall>x y. norm (h x y) \<le> norm x * norm y * K"
  2055       by (simp add: ac_simps)
  2056   qed
  2057 next
  2058   assume "bounded_bilinear h"
  2059   then interpret h: bounded_bilinear h .
  2060   show "bilinear h"
  2061     unfolding bilinear_def linear_conv_bounded_linear
  2062     using h.bounded_linear_left h.bounded_linear_right by simp
  2063 qed
  2064 
  2065 lemma bilinear_bounded_pos:
  2066   fixes h :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::real_normed_vector"
  2067   assumes bh: "bilinear h"
  2068   shows "\<exists>B > 0. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
  2069 proof -
  2070   have "\<exists>B > 0. \<forall>x y. norm (h x y) \<le> norm x * norm y * B"
  2071     using bh [unfolded bilinear_conv_bounded_bilinear]
  2072     by (rule bounded_bilinear.pos_bounded)
  2073   then show ?thesis
  2074     by (simp only: ac_simps)
  2075 qed
  2076 
  2077 lemma bounded_linear_imp_has_derivative:
  2078      "bounded_linear f \<Longrightarrow> (f has_derivative f) net"
  2079   by (simp add: has_derivative_def bounded_linear.linear linear_diff)
  2080 
  2081 lemma linear_imp_has_derivative:
  2082   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  2083   shows "linear f \<Longrightarrow> (f has_derivative f) net"
  2084 by (simp add: has_derivative_def linear_conv_bounded_linear linear_diff)
  2085 
  2086 lemma bounded_linear_imp_differentiable: "bounded_linear f \<Longrightarrow> f differentiable net"
  2087   using bounded_linear_imp_has_derivative differentiable_def by blast
  2088 
  2089 lemma linear_imp_differentiable:
  2090   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  2091   shows "linear f \<Longrightarrow> f differentiable net"
  2092 by (metis linear_imp_has_derivative differentiable_def)
  2093 
  2094 
  2095 subsection \<open>We continue.\<close>
  2096 
  2097 lemma independent_bound:
  2098   fixes S :: "'a::euclidean_space set"
  2099   shows "independent S \<Longrightarrow> finite S \<and> card S \<le> DIM('a)"
  2100   using independent_span_bound[OF finite_Basis, of S] by auto
  2101 
  2102 corollary
  2103   fixes S :: "'a::euclidean_space set"
  2104   assumes "independent S"
  2105   shows independent_imp_finite: "finite S" and independent_card_le:"card S \<le> DIM('a)"
  2106 using assms independent_bound by auto
  2107 
  2108 lemma independent_explicit:
  2109   fixes B :: "'a::euclidean_space set"
  2110   shows "independent B \<longleftrightarrow>
  2111          finite B \<and> (\<forall>c. (\<Sum>v\<in>B. c v *\<^sub>R v) = 0 \<longrightarrow> (\<forall>v \<in> B. c v = 0))"
  2112 apply (cases "finite B")
  2113  apply (force simp: dependent_finite)
  2114 using independent_bound
  2115 apply auto
  2116 done
  2117 
  2118 lemma dependent_biggerset:
  2119   fixes S :: "'a::euclidean_space set"
  2120   shows "(finite S \<Longrightarrow> card S > DIM('a)) \<Longrightarrow> dependent S"
  2121   by (metis independent_bound not_less)
  2122 
  2123 text \<open>Notion of dimension.\<close>
  2124 
  2125 definition "dim V = (SOME n. \<exists>B. B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> card B = n)"
  2126 
  2127 lemma basis_exists:
  2128   "\<exists>B. (B :: ('a::euclidean_space) set) \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> (card B = dim V)"
  2129   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)"]
  2130   using maximal_independent_subset[of V] independent_bound
  2131   by auto
  2132 
  2133 corollary dim_le_card:
  2134   fixes s :: "'a::euclidean_space set"
  2135   shows "finite s \<Longrightarrow> dim s \<le> card s"
  2136 by (metis basis_exists card_mono)
  2137 
  2138 text \<open>Consequences of independence or spanning for cardinality.\<close>
  2139 
  2140 lemma independent_card_le_dim:
  2141   fixes B :: "'a::euclidean_space set"
  2142   assumes "B \<subseteq> V"
  2143     and "independent B"
  2144   shows "card B \<le> dim V"
  2145 proof -
  2146   from basis_exists[of V] \<open>B \<subseteq> V\<close>
  2147   obtain B' where "independent B'"
  2148     and "B \<subseteq> span B'"
  2149     and "card B' = dim V"
  2150     by blast
  2151   with independent_span_bound[OF _ \<open>independent B\<close> \<open>B \<subseteq> span B'\<close>] independent_bound[of B']
  2152   show ?thesis by auto
  2153 qed
  2154 
  2155 lemma span_card_ge_dim:
  2156   fixes B :: "'a::euclidean_space set"
  2157   shows "B \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> finite B \<Longrightarrow> dim V \<le> card B"
  2158   by (metis basis_exists[of V] independent_span_bound subset_trans)
  2159 
  2160 lemma basis_card_eq_dim:
  2161   fixes V :: "'a::euclidean_space set"
  2162   shows "B \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> independent B \<Longrightarrow> finite B \<and> card B = dim V"
  2163   by (metis order_eq_iff independent_card_le_dim span_card_ge_dim independent_bound)
  2164 
  2165 lemma dim_unique:
  2166   fixes B :: "'a::euclidean_space set"
  2167   shows "B \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> independent B \<Longrightarrow> card B = n \<Longrightarrow> dim V = n"
  2168   by (metis basis_card_eq_dim)
  2169 
  2170 text \<open>More lemmas about dimension.\<close>
  2171 
  2172 lemma dim_UNIV [simp]: "dim (UNIV :: 'a::euclidean_space set) = DIM('a)"
  2173   using independent_Basis
  2174   by (intro dim_unique[of Basis]) auto
  2175 
  2176 lemma dim_subset:
  2177   fixes S :: "'a::euclidean_space set"
  2178   shows "S \<subseteq> T \<Longrightarrow> dim S \<le> dim T"
  2179   using basis_exists[of T] basis_exists[of S]
  2180   by (metis independent_card_le_dim subset_trans)
  2181 
  2182 lemma dim_subset_UNIV:
  2183   fixes S :: "'a::euclidean_space set"
  2184   shows "dim S \<le> DIM('a)"
  2185   by (metis dim_subset subset_UNIV dim_UNIV)
  2186 
  2187 text \<open>Converses to those.\<close>
  2188 
  2189 lemma card_ge_dim_independent:
  2190   fixes B :: "'a::euclidean_space set"
  2191   assumes BV: "B \<subseteq> V"
  2192     and iB: "independent B"
  2193     and dVB: "dim V \<le> card B"
  2194   shows "V \<subseteq> span B"
  2195 proof
  2196   fix a
  2197   assume aV: "a \<in> V"
  2198   {
  2199     assume aB: "a \<notin> span B"
  2200     then have iaB: "independent (insert a B)"
  2201       using iB aV BV by (simp add: independent_insert)
  2202     from aV BV have th0: "insert a B \<subseteq> V"
  2203       by blast
  2204     from aB have "a \<notin>B"
  2205       by (auto simp add: span_superset)
  2206     with independent_card_le_dim[OF th0 iaB] dVB independent_bound[OF iB]
  2207     have False by auto
  2208   }
  2209   then show "a \<in> span B" by blast
  2210 qed
  2211 
  2212 lemma card_le_dim_spanning:
  2213   assumes BV: "(B:: ('a::euclidean_space) set) \<subseteq> V"
  2214     and VB: "V \<subseteq> span B"
  2215     and fB: "finite B"
  2216     and dVB: "dim V \<ge> card B"
  2217   shows "independent B"
  2218 proof -
  2219   {
  2220     fix a
  2221     assume a: "a \<in> B" "a \<in> span (B - {a})"
  2222     from a fB have c0: "card B \<noteq> 0"
  2223       by auto
  2224     from a fB have cb: "card (B - {a}) = card B - 1"
  2225       by auto
  2226     from BV a have th0: "B - {a} \<subseteq> V"
  2227       by blast
  2228     {
  2229       fix x
  2230       assume x: "x \<in> V"
  2231       from a have eq: "insert a (B - {a}) = B"
  2232         by blast
  2233       from x VB have x': "x \<in> span B"
  2234         by blast
  2235       from span_trans[OF a(2), unfolded eq, OF x']
  2236       have "x \<in> span (B - {a})" .
  2237     }
  2238     then have th1: "V \<subseteq> span (B - {a})"
  2239       by blast
  2240     have th2: "finite (B - {a})"
  2241       using fB by auto
  2242     from span_card_ge_dim[OF th0 th1 th2]
  2243     have c: "dim V \<le> card (B - {a})" .
  2244     from c c0 dVB cb have False by simp
  2245   }
  2246   then show ?thesis
  2247     unfolding dependent_def by blast
  2248 qed
  2249 
  2250 lemma card_eq_dim:
  2251   fixes B :: "'a::euclidean_space set"
  2252   shows "B \<subseteq> V \<Longrightarrow> card B = dim V \<Longrightarrow> finite B \<Longrightarrow> independent B \<longleftrightarrow> V \<subseteq> span B"
  2253   by (metis order_eq_iff card_le_dim_spanning card_ge_dim_independent)
  2254 
  2255 text \<open>More general size bound lemmas.\<close>
  2256 
  2257 lemma independent_bound_general:
  2258   fixes S :: "'a::euclidean_space set"
  2259   shows "independent S \<Longrightarrow> finite S \<and> card S \<le> dim S"
  2260   by (metis independent_card_le_dim independent_bound subset_refl)
  2261 
  2262 lemma dependent_biggerset_general:
  2263   fixes S :: "'a::euclidean_space set"
  2264   shows "(finite S \<Longrightarrow> card S > dim S) \<Longrightarrow> dependent S"
  2265   using independent_bound_general[of S] by (metis linorder_not_le)
  2266 
  2267 lemma dim_span [simp]:
  2268   fixes S :: "'a::euclidean_space set"
  2269   shows "dim (span S) = dim S"
  2270 proof -
  2271   have th0: "dim S \<le> dim (span S)"
  2272     by (auto simp add: subset_eq intro: dim_subset span_superset)
  2273   from basis_exists[of S]
  2274   obtain B where B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "card B = dim S"
  2275     by blast
  2276   from B have fB: "finite B" "card B = dim S"
  2277     using independent_bound by blast+
  2278   have bSS: "B \<subseteq> span S"
  2279     using B(1) by (metis subset_eq span_inc)
  2280   have sssB: "span S \<subseteq> span B"
  2281     using span_mono[OF B(3)] by (simp add: span_span)
  2282   from span_card_ge_dim[OF bSS sssB fB(1)] th0 show ?thesis
  2283     using fB(2) by arith
  2284 qed
  2285 
  2286 lemma subset_le_dim:
  2287   fixes S :: "'a::euclidean_space set"
  2288   shows "S \<subseteq> span T \<Longrightarrow> dim S \<le> dim T"
  2289   by (metis dim_span dim_subset)
  2290 
  2291 lemma span_eq_dim:
  2292   fixes S :: "'a::euclidean_space set"
  2293   shows "span S = span T \<Longrightarrow> dim S = dim T"
  2294   by (metis dim_span)
  2295 
  2296 lemma dim_image_le:
  2297   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  2298   assumes lf: "linear f"
  2299   shows "dim (f ` S) \<le> dim (S)"
  2300 proof -
  2301   from basis_exists[of S] obtain B where
  2302     B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "card B = dim S" by blast
  2303   from B have fB: "finite B" "card B = dim S"
  2304     using independent_bound by blast+
  2305   have "dim (f ` S) \<le> card (f ` B)"
  2306     apply (rule span_card_ge_dim)
  2307     using lf B fB
  2308     apply (auto simp add: span_linear_image spans_image subset_image_iff)
  2309     done
  2310   also have "\<dots> \<le> dim S"
  2311     using card_image_le[OF fB(1)] fB by simp
  2312   finally show ?thesis .
  2313 qed
  2314 
  2315 text \<open>Picking an orthogonal replacement for a spanning set.\<close>
  2316 
  2317 lemma vector_sub_project_orthogonal:
  2318   fixes b x :: "'a::euclidean_space"
  2319   shows "b \<bullet> (x - ((b \<bullet> x) / (b \<bullet> b)) *\<^sub>R b) = 0"
  2320   unfolding inner_simps by auto
  2321 
  2322 lemma pairwise_orthogonal_insert:
  2323   assumes "pairwise orthogonal S"
  2324     and "\<And>y. y \<in> S \<Longrightarrow> orthogonal x y"
  2325   shows "pairwise orthogonal (insert x S)"
  2326   using assms unfolding pairwise_def
  2327   by (auto simp add: orthogonal_commute)
  2328 
  2329 lemma basis_orthogonal:
  2330   fixes B :: "'a::real_inner set"
  2331   assumes fB: "finite B"
  2332   shows "\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C"
  2333   (is " \<exists>C. ?P B C")
  2334   using fB
  2335 proof (induct rule: finite_induct)
  2336   case empty
  2337   then show ?case
  2338     apply (rule exI[where x="{}"])
  2339     apply (auto simp add: pairwise_def)
  2340     done
  2341 next
  2342   case (insert a B)
  2343   note fB = \<open>finite B\<close> and aB = \<open>a \<notin> B\<close>
  2344   from \<open>\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C\<close>
  2345   obtain C where C: "finite C" "card C \<le> card B"
  2346     "span C = span B" "pairwise orthogonal C" by blast
  2347   let ?a = "a - sum (\<lambda>x. (x \<bullet> a / (x \<bullet> x)) *\<^sub>R x) C"
  2348   let ?C = "insert ?a C"
  2349   from C(1) have fC: "finite ?C"
  2350     by simp
  2351   from fB aB C(1,2) have cC: "card ?C \<le> card (insert a B)"
  2352     by (simp add: card_insert_if)
  2353   {
  2354     fix x k
  2355     have th0: "\<And>(a::'a) b c. a - (b - c) = c + (a - b)"
  2356       by (simp add: field_simps)
  2357     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"
  2358       apply (simp only: scaleR_right_diff_distrib th0)
  2359       apply (rule span_add_eq)
  2360       apply (rule span_mul)
  2361       apply (rule span_sum)
  2362       apply (rule span_mul)
  2363       apply (rule span_superset)
  2364       apply assumption
  2365       done
  2366   }
  2367   then have SC: "span ?C = span (insert a B)"
  2368     unfolding set_eq_iff span_breakdown_eq C(3)[symmetric] by auto
  2369   {
  2370     fix y
  2371     assume yC: "y \<in> C"
  2372     then have Cy: "C = insert y (C - {y})"
  2373       by blast
  2374     have fth: "finite (C - {y})"
  2375       using C by simp
  2376     have "orthogonal ?a y"
  2377       unfolding orthogonal_def
  2378       unfolding inner_diff inner_sum_left right_minus_eq
  2379       unfolding sum.remove [OF \<open>finite C\<close> \<open>y \<in> C\<close>]
  2380       apply (clarsimp simp add: inner_commute[of y a])
  2381       apply (rule sum.neutral)
  2382       apply clarsimp
  2383       apply (rule C(4)[unfolded pairwise_def orthogonal_def, rule_format])
  2384       using \<open>y \<in> C\<close> by auto
  2385   }
  2386   with \<open>pairwise orthogonal C\<close> have CPO: "pairwise orthogonal ?C"
  2387     by (rule pairwise_orthogonal_insert)
  2388   from fC cC SC CPO have "?P (insert a B) ?C"
  2389     by blast
  2390   then show ?case by blast
  2391 qed
  2392 
  2393 lemma orthogonal_basis_exists:
  2394   fixes V :: "('a::euclidean_space) set"
  2395   shows "\<exists>B. independent B \<and> B \<subseteq> span V \<and> V \<subseteq> span B \<and> (card B = dim V) \<and> pairwise orthogonal B"
  2396 proof -
  2397   from basis_exists[of V] obtain B where
  2398     B: "B \<subseteq> V" "independent B" "V \<subseteq> span B" "card B = dim V"
  2399     by blast
  2400   from B have fB: "finite B" "card B = dim V"
  2401     using independent_bound by auto
  2402   from basis_orthogonal[OF fB(1)] obtain C where
  2403     C: "finite C" "card C \<le> card B" "span C = span B" "pairwise orthogonal C"
  2404     by blast
  2405   from C B have CSV: "C \<subseteq> span V"
  2406     by (metis span_inc span_mono subset_trans)
  2407   from span_mono[OF B(3)] C have SVC: "span V \<subseteq> span C"
  2408     by (simp add: span_span)
  2409   from card_le_dim_spanning[OF CSV SVC C(1)] C(2,3) fB
  2410   have iC: "independent C"
  2411     by (simp add: dim_span)
  2412   from C fB have "card C \<le> dim V"
  2413     by simp
  2414   moreover have "dim V \<le> card C"
  2415     using span_card_ge_dim[OF CSV SVC C(1)]
  2416     by (simp add: dim_span)
  2417   ultimately have CdV: "card C = dim V"
  2418     using C(1) by simp
  2419   from C B CSV CdV iC show ?thesis
  2420     by auto
  2421 qed
  2422 
  2423 text \<open>Low-dimensional subset is in a hyperplane (weak orthogonal complement).\<close>
  2424 
  2425 lemma span_not_univ_orthogonal:
  2426   fixes S :: "'a::euclidean_space set"
  2427   assumes sU: "span S \<noteq> UNIV"
  2428   shows "\<exists>a::'a. a \<noteq> 0 \<and> (\<forall>x \<in> span S. a \<bullet> x = 0)"
  2429 proof -
  2430   from sU obtain a where a: "a \<notin> span S"
  2431     by blast
  2432   from orthogonal_basis_exists obtain B where
  2433     B: "independent B" "B \<subseteq> span S" "S \<subseteq> span B" "card B = dim S" "pairwise orthogonal B"
  2434     by blast
  2435   from B have fB: "finite B" "card B = dim S"
  2436     using independent_bound by auto
  2437   from span_mono[OF B(2)] span_mono[OF B(3)]
  2438   have sSB: "span S = span B"
  2439     by (simp add: span_span)
  2440   let ?a = "a - sum (\<lambda>b. (a \<bullet> b / (b \<bullet> b)) *\<^sub>R b) B"
  2441   have "sum (\<lambda>b. (a \<bullet> b / (b \<bullet> b)) *\<^sub>R b) B \<in> span S"
  2442     unfolding sSB
  2443     apply (rule span_sum)
  2444     apply (rule span_mul)
  2445     apply (rule span_superset)
  2446     apply assumption
  2447     done
  2448   with a have a0:"?a  \<noteq> 0"
  2449     by auto
  2450   have "\<forall>x\<in>span B. ?a \<bullet> x = 0"
  2451   proof (rule span_induct')
  2452     show "subspace {x. ?a \<bullet> x = 0}"
  2453       by (auto simp add: subspace_def inner_add)
  2454   next
  2455     {
  2456       fix x
  2457       assume x: "x \<in> B"
  2458       from x have B': "B = insert x (B - {x})"
  2459         by blast
  2460       have fth: "finite (B - {x})"
  2461         using fB by simp
  2462       have "?a \<bullet> x = 0"
  2463         apply (subst B')
  2464         using fB fth
  2465         unfolding sum_clauses(2)[OF fth]
  2466         apply simp unfolding inner_simps
  2467         apply (clarsimp simp add: inner_add inner_sum_left)
  2468         apply (rule sum.neutral, rule ballI)
  2469         apply (simp only: inner_commute)
  2470         apply (auto simp add: x field_simps
  2471           intro: B(5)[unfolded pairwise_def orthogonal_def, rule_format])
  2472         done
  2473     }
  2474     then show "\<forall>x \<in> B. ?a \<bullet> x = 0"
  2475       by blast
  2476   qed
  2477   with a0 show ?thesis
  2478     unfolding sSB by (auto intro: exI[where x="?a"])
  2479 qed
  2480 
  2481 lemma span_not_univ_subset_hyperplane:
  2482   fixes S :: "'a::euclidean_space set"
  2483   assumes SU: "span S \<noteq> UNIV"
  2484   shows "\<exists> a. a \<noteq>0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
  2485   using span_not_univ_orthogonal[OF SU] by auto
  2486 
  2487 lemma lowdim_subset_hyperplane:
  2488   fixes S :: "'a::euclidean_space set"
  2489   assumes d: "dim S < DIM('a)"
  2490   shows "\<exists>a::'a. a \<noteq> 0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
  2491 proof -
  2492   {
  2493     assume "span S = UNIV"
  2494     then have "dim (span S) = dim (UNIV :: ('a) set)"
  2495       by simp
  2496     then have "dim S = DIM('a)"
  2497       by (simp add: dim_span dim_UNIV)
  2498     with d have False by arith
  2499   }
  2500   then have th: "span S \<noteq> UNIV"
  2501     by blast
  2502   from span_not_univ_subset_hyperplane[OF th] show ?thesis .
  2503 qed
  2504 
  2505 text \<open>We can extend a linear basis-basis injection to the whole set.\<close>
  2506 
  2507 lemma linear_indep_image_lemma:
  2508   assumes lf: "linear f"
  2509     and fB: "finite B"
  2510     and ifB: "independent (f ` B)"
  2511     and fi: "inj_on f B"
  2512     and xsB: "x \<in> span B"
  2513     and fx: "f x = 0"
  2514   shows "x = 0"
  2515   using fB ifB fi xsB fx
  2516 proof (induct arbitrary: x rule: finite_induct[OF fB])
  2517   case 1
  2518   then show ?case by auto
  2519 next
  2520   case (2 a b x)
  2521   have fb: "finite b" using "2.prems" by simp
  2522   have th0: "f ` b \<subseteq> f ` (insert a b)"
  2523     apply (rule image_mono)
  2524     apply blast
  2525     done
  2526   from independent_mono[ OF "2.prems"(2) th0]
  2527   have ifb: "independent (f ` b)"  .
  2528   have fib: "inj_on f b"
  2529     apply (rule subset_inj_on [OF "2.prems"(3)])
  2530     apply blast
  2531     done
  2532   from span_breakdown[of a "insert a b", simplified, OF "2.prems"(4)]
  2533   obtain k where k: "x - k*\<^sub>R a \<in> span (b - {a})"
  2534     by blast
  2535   have "f (x - k*\<^sub>R a) \<in> span (f ` b)"
  2536     unfolding span_linear_image[OF lf]
  2537     apply (rule imageI)
  2538     using k span_mono[of "b - {a}" b]
  2539     apply blast
  2540     done
  2541   then have "f x - k*\<^sub>R f a \<in> span (f ` b)"
  2542     by (simp add: linear_diff[OF lf] linear_cmul[OF lf])
  2543   then have th: "-k *\<^sub>R f a \<in> span (f ` b)"
  2544     using "2.prems"(5) by simp
  2545   have xsb: "x \<in> span b"
  2546   proof (cases "k = 0")
  2547     case True
  2548     with k have "x \<in> span (b - {a})" by simp
  2549     then show ?thesis using span_mono[of "b - {a}" b]
  2550       by blast
  2551   next
  2552     case False
  2553     with span_mul[OF th, of "- 1/ k"]
  2554     have th1: "f a \<in> span (f ` b)"
  2555       by auto
  2556     from inj_on_image_set_diff[OF "2.prems"(3), of "insert a b " "{a}", symmetric]
  2557     have tha: "f ` insert a b - f ` {a} = f ` (insert a b - {a})" by blast
  2558     from "2.prems"(2) [unfolded dependent_def bex_simps(8), rule_format, of "f a"]
  2559     have "f a \<notin> span (f ` b)" using tha
  2560       using "2.hyps"(2)
  2561       "2.prems"(3) by auto
  2562     with th1 have False by blast
  2563     then show ?thesis by blast
  2564   qed
  2565   from "2.hyps"(3)[OF fb ifb fib xsb "2.prems"(5)] show "x = 0" .
  2566 qed
  2567 
  2568 text \<open>Can construct an isomorphism between spaces of same dimension.\<close>
  2569 
  2570 lemma subspace_isomorphism:
  2571   fixes S :: "'a::euclidean_space set"
  2572     and T :: "'b::euclidean_space set"
  2573   assumes s: "subspace S"
  2574     and t: "subspace T"
  2575     and d: "dim S = dim T"
  2576   shows "\<exists>f. linear f \<and> f ` S = T \<and> inj_on f S"
  2577 proof -
  2578   from basis_exists[of S] independent_bound
  2579   obtain B where B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "card B = dim S" and fB: "finite B"
  2580     by blast
  2581   from basis_exists[of T] independent_bound
  2582   obtain C where C: "C \<subseteq> T" "independent C" "T \<subseteq> span C" "card C = dim T" and fC: "finite C"
  2583     by blast
  2584   from B(4) C(4) card_le_inj[of B C] d
  2585   obtain f where f: "f ` B \<subseteq> C" "inj_on f B" using \<open>finite B\<close> \<open>finite C\<close>
  2586     by auto
  2587   from linear_independent_extend[OF B(2)]
  2588   obtain g where g: "linear g" "\<forall>x\<in> B. g x = f x"
  2589     by blast
  2590   from inj_on_iff_eq_card[OF fB, of f] f(2) have "card (f ` B) = card B"
  2591     by simp
  2592   with B(4) C(4) have ceq: "card (f ` B) = card C"
  2593     using d by simp
  2594   have "g ` B = f ` B"
  2595     using g(2) by (auto simp add: image_iff)
  2596   also have "\<dots> = C" using card_subset_eq[OF fC f(1) ceq] .
  2597   finally have gBC: "g ` B = C" .
  2598   have gi: "inj_on g B"
  2599     using f(2) g(2) by (auto simp add: inj_on_def)
  2600   note g0 = linear_indep_image_lemma[OF g(1) fB, unfolded gBC, OF C(2) gi]
  2601   {
  2602     fix x y
  2603     assume x: "x \<in> S" and y: "y \<in> S" and gxy: "g x = g y"
  2604     from B(3) x y have x': "x \<in> span B" and y': "y \<in> span B"
  2605       by blast+
  2606     from gxy have th0: "g (x - y) = 0"
  2607       by (simp add: linear_diff[OF g(1)])
  2608     have th1: "x - y \<in> span B"
  2609       using x' y' by (metis span_diff)
  2610     have "x = y"
  2611       using g0[OF th1 th0] by simp
  2612   }
  2613   then have giS: "inj_on g S"
  2614     unfolding inj_on_def by blast
  2615   from span_subspace[OF B(1,3) s] have "g ` S = span (g ` B)"
  2616     by (simp add: span_linear_image[OF g(1)])
  2617   also have "\<dots> = span C" unfolding gBC ..
  2618   also have "\<dots> = T" using span_subspace[OF C(1,3) t] .
  2619   finally have gS: "g ` S = T" .
  2620   from g(1) gS giS show ?thesis
  2621     by blast
  2622 qed
  2623 
  2624 lemma linear_eq_stdbasis:
  2625   fixes f :: "'a::euclidean_space \<Rightarrow> _"
  2626   assumes lf: "linear f"
  2627     and lg: "linear g"
  2628     and fg: "\<forall>b\<in>Basis. f b = g b"
  2629   shows "f = g"
  2630   using linear_eq[OF lf lg, of _ Basis] fg by auto
  2631 
  2632 text \<open>Similar results for bilinear functions.\<close>
  2633 
  2634 lemma bilinear_eq:
  2635   assumes bf: "bilinear f"
  2636     and bg: "bilinear g"
  2637     and SB: "S \<subseteq> span B"
  2638     and TC: "T \<subseteq> span C"
  2639     and fg: "\<forall>x\<in> B. \<forall>y\<in> C. f x y = g x y"
  2640   shows "\<forall>x\<in>S. \<forall>y\<in>T. f x y = g x y "
  2641 proof -
  2642   let ?P = "{x. \<forall>y\<in> span C. f x y = g x y}"
  2643   from bf bg have sp: "subspace ?P"
  2644     unfolding bilinear_def linear_iff subspace_def bf bg
  2645     by (auto simp add: span_0 bilinear_lzero[OF bf] bilinear_lzero[OF bg] span_add Ball_def
  2646       intro: bilinear_ladd[OF bf])
  2647 
  2648   have "\<forall>x \<in> span B. \<forall>y\<in> span C. f x y = g x y"
  2649     apply (rule span_induct' [OF _ sp])
  2650     apply (rule ballI)
  2651     apply (rule span_induct')
  2652     apply (simp add: fg)
  2653     apply (auto simp add: subspace_def)
  2654     using bf bg unfolding bilinear_def linear_iff
  2655     apply (auto simp add: span_0 bilinear_rzero[OF bf] bilinear_rzero[OF bg] span_add Ball_def
  2656       intro: bilinear_ladd[OF bf])
  2657     done
  2658   then show ?thesis
  2659     using SB TC by auto
  2660 qed
  2661 
  2662 lemma bilinear_eq_stdbasis:
  2663   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> _"
  2664   assumes bf: "bilinear f"
  2665     and bg: "bilinear g"
  2666     and fg: "\<forall>i\<in>Basis. \<forall>j\<in>Basis. f i j = g i j"
  2667   shows "f = g"
  2668   using bilinear_eq[OF bf bg equalityD2[OF span_Basis] equalityD2[OF span_Basis] fg] by blast
  2669 
  2670 text \<open>An injective map @{typ "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"} is also surjective.\<close>
  2671 
  2672 lemma linear_injective_imp_surjective:
  2673   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2674   assumes lf: "linear f"
  2675     and fi: "inj f"
  2676   shows "surj f"
  2677 proof -
  2678   let ?U = "UNIV :: 'a set"
  2679   from basis_exists[of ?U] obtain B
  2680     where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" "card B = dim ?U"
  2681     by blast
  2682   from B(4) have d: "dim ?U = card B"
  2683     by simp
  2684   have th: "?U \<subseteq> span (f ` B)"
  2685     apply (rule card_ge_dim_independent)
  2686     apply blast
  2687     apply (rule independent_injective_image[OF B(2) lf fi])
  2688     apply (rule order_eq_refl)
  2689     apply (rule sym)
  2690     unfolding d
  2691     apply (rule card_image)
  2692     apply (rule subset_inj_on[OF fi])
  2693     apply blast
  2694     done
  2695   from th show ?thesis
  2696     unfolding span_linear_image[OF lf] surj_def
  2697     using B(3) by blast
  2698 qed
  2699 
  2700 text \<open>And vice versa.\<close>
  2701 
  2702 lemma surjective_iff_injective_gen:
  2703   assumes fS: "finite S"
  2704     and fT: "finite T"
  2705     and c: "card S = card T"
  2706     and ST: "f ` S \<subseteq> T"
  2707   shows "(\<forall>y \<in> T. \<exists>x \<in> S. f x = y) \<longleftrightarrow> inj_on f S"
  2708   (is "?lhs \<longleftrightarrow> ?rhs")
  2709 proof
  2710   assume h: "?lhs"
  2711   {
  2712     fix x y
  2713     assume x: "x \<in> S"
  2714     assume y: "y \<in> S"
  2715     assume f: "f x = f y"
  2716     from x fS have S0: "card S \<noteq> 0"
  2717       by auto
  2718     have "x = y"
  2719     proof (rule ccontr)
  2720       assume xy: "\<not> ?thesis"
  2721       have th: "card S \<le> card (f ` (S - {y}))"
  2722         unfolding c
  2723         apply (rule card_mono)
  2724         apply (rule finite_imageI)
  2725         using fS apply simp
  2726         using h xy x y f unfolding subset_eq image_iff
  2727         apply auto
  2728         apply (case_tac "xa = f x")
  2729         apply (rule bexI[where x=x])
  2730         apply auto
  2731         done
  2732       also have " \<dots> \<le> card (S - {y})"
  2733         apply (rule card_image_le)
  2734         using fS by simp
  2735       also have "\<dots> \<le> card S - 1" using y fS by simp
  2736       finally show False using S0 by arith
  2737     qed
  2738   }
  2739   then show ?rhs
  2740     unfolding inj_on_def by blast
  2741 next
  2742   assume h: ?rhs
  2743   have "f ` S = T"
  2744     apply (rule card_subset_eq[OF fT ST])
  2745     unfolding card_image[OF h]
  2746     apply (rule c)
  2747     done
  2748   then show ?lhs by blast
  2749 qed
  2750 
  2751 lemma linear_surjective_imp_injective:
  2752   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2753   assumes lf: "linear f"
  2754     and sf: "surj f"
  2755   shows "inj f"
  2756 proof -
  2757   let ?U = "UNIV :: 'a set"
  2758   from basis_exists[of ?U] obtain B
  2759     where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" and d: "card B = dim ?U"
  2760     by blast
  2761   {
  2762     fix x
  2763     assume x: "x \<in> span B"
  2764     assume fx: "f x = 0"
  2765     from B(2) have fB: "finite B"
  2766       using independent_bound by auto
  2767     have fBi: "independent (f ` B)"
  2768       apply (rule card_le_dim_spanning[of "f ` B" ?U])
  2769       apply blast
  2770       using sf B(3)
  2771       unfolding span_linear_image[OF lf] surj_def subset_eq image_iff
  2772       apply blast
  2773       using fB apply blast
  2774       unfolding d[symmetric]
  2775       apply (rule card_image_le)
  2776       apply (rule fB)
  2777       done
  2778     have th0: "dim ?U \<le> card (f ` B)"
  2779       apply (rule span_card_ge_dim)
  2780       apply blast
  2781       unfolding span_linear_image[OF lf]
  2782       apply (rule subset_trans[where B = "f ` UNIV"])
  2783       using sf unfolding surj_def
  2784       apply blast
  2785       apply (rule image_mono)
  2786       apply (rule B(3))
  2787       apply (metis finite_imageI fB)
  2788       done
  2789     moreover have "card (f ` B) \<le> card B"
  2790       by (rule card_image_le, rule fB)
  2791     ultimately have th1: "card B = card (f ` B)"
  2792       unfolding d by arith
  2793     have fiB: "inj_on f B"
  2794       unfolding surjective_iff_injective_gen[OF fB finite_imageI[OF fB] th1 subset_refl, symmetric]
  2795       by blast
  2796     from linear_indep_image_lemma[OF lf fB fBi fiB x] fx
  2797     have "x = 0" by blast
  2798   }
  2799   then show ?thesis
  2800     unfolding linear_injective_0[OF lf]
  2801     using B(3)
  2802     by blast
  2803 qed
  2804 
  2805 text \<open>Hence either is enough for isomorphism.\<close>
  2806 
  2807 lemma left_right_inverse_eq:
  2808   assumes fg: "f \<circ> g = id"
  2809     and gh: "g \<circ> h = id"
  2810   shows "f = h"
  2811 proof -
  2812   have "f = f \<circ> (g \<circ> h)"
  2813     unfolding gh by simp
  2814   also have "\<dots> = (f \<circ> g) \<circ> h"
  2815     by (simp add: o_assoc)
  2816   finally show "f = h"
  2817     unfolding fg by simp
  2818 qed
  2819 
  2820 lemma isomorphism_expand:
  2821   "f \<circ> g = id \<and> g \<circ> f = id \<longleftrightarrow> (\<forall>x. f (g x) = x) \<and> (\<forall>x. g (f x) = x)"
  2822   by (simp add: fun_eq_iff o_def id_def)
  2823 
  2824 lemma linear_injective_isomorphism:
  2825   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2826   assumes lf: "linear f"
  2827     and fi: "inj f"
  2828   shows "\<exists>f'. linear f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)"
  2829   unfolding isomorphism_expand[symmetric]
  2830   using linear_surjective_right_inverse[OF lf linear_injective_imp_surjective[OF lf fi]]
  2831     linear_injective_left_inverse[OF lf fi]
  2832   by (metis left_right_inverse_eq)
  2833 
  2834 lemma linear_surjective_isomorphism:
  2835   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2836   assumes lf: "linear f"
  2837     and sf: "surj f"
  2838   shows "\<exists>f'. linear f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)"
  2839   unfolding isomorphism_expand[symmetric]
  2840   using linear_surjective_right_inverse[OF lf sf]
  2841     linear_injective_left_inverse[OF lf linear_surjective_imp_injective[OF lf sf]]
  2842   by (metis left_right_inverse_eq)
  2843 
  2844 text \<open>Left and right inverses are the same for
  2845   @{typ "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"}.\<close>
  2846 
  2847 lemma linear_inverse_left:
  2848   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2849   assumes lf: "linear f"
  2850     and lf': "linear f'"
  2851   shows "f \<circ> f' = id \<longleftrightarrow> f' \<circ> f = id"
  2852 proof -
  2853   {
  2854     fix f f':: "'a \<Rightarrow> 'a"
  2855     assume lf: "linear f" "linear f'"
  2856     assume f: "f \<circ> f' = id"
  2857     from f have sf: "surj f"
  2858       apply (auto simp add: o_def id_def surj_def)
  2859       apply metis
  2860       done
  2861     from linear_surjective_isomorphism[OF lf(1) sf] lf f
  2862     have "f' \<circ> f = id"
  2863       unfolding fun_eq_iff o_def id_def by metis
  2864   }
  2865   then show ?thesis
  2866     using lf lf' by metis
  2867 qed
  2868 
  2869 text \<open>Moreover, a one-sided inverse is automatically linear.\<close>
  2870 
  2871 lemma left_inverse_linear:
  2872   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2873   assumes lf: "linear f"
  2874     and gf: "g \<circ> f = id"
  2875   shows "linear g"
  2876 proof -
  2877   from gf have fi: "inj f"
  2878     apply (auto simp add: inj_on_def o_def id_def fun_eq_iff)
  2879     apply metis
  2880     done
  2881   from linear_injective_isomorphism[OF lf fi]
  2882   obtain h :: "'a \<Rightarrow> 'a" where h: "linear h" "\<forall>x. h (f x) = x" "\<forall>x. f (h x) = x"
  2883     by blast
  2884   have "h = g"
  2885     apply (rule ext) using gf h(2,3)
  2886     apply (simp add: o_def id_def fun_eq_iff)
  2887     apply metis
  2888     done
  2889   with h(1) show ?thesis by blast
  2890 qed
  2891 
  2892 lemma inj_linear_imp_inv_linear:
  2893   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2894   assumes "linear f" "inj f" shows "linear (inv f)"
  2895 using assms inj_iff left_inverse_linear by blast
  2896 
  2897 
  2898 subsection \<open>Infinity norm\<close>
  2899 
  2900 definition "infnorm (x::'a::euclidean_space) = Sup {\<bar>x \<bullet> b\<bar> |b. b \<in> Basis}"
  2901 
  2902 lemma infnorm_set_image:
  2903   fixes x :: "'a::euclidean_space"
  2904   shows "{\<bar>x \<bullet> i\<bar> |i. i \<in> Basis} = (\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis"
  2905   by blast
  2906 
  2907 lemma infnorm_Max:
  2908   fixes x :: "'a::euclidean_space"
  2909   shows "infnorm x = Max ((\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis)"
  2910   by (simp add: infnorm_def infnorm_set_image cSup_eq_Max)
  2911 
  2912 lemma infnorm_set_lemma:
  2913   fixes x :: "'a::euclidean_space"
  2914   shows "finite {\<bar>x \<bullet> i\<bar> |i. i \<in> Basis}"
  2915     and "{\<bar>x \<bullet> i\<bar> |i. i \<in> Basis} \<noteq> {}"
  2916   unfolding infnorm_set_image
  2917   by auto
  2918 
  2919 lemma infnorm_pos_le:
  2920   fixes x :: "'a::euclidean_space"
  2921   shows "0 \<le> infnorm x"
  2922   by (simp add: infnorm_Max Max_ge_iff ex_in_conv)
  2923 
  2924 lemma infnorm_triangle:
  2925   fixes x :: "'a::euclidean_space"
  2926   shows "infnorm (x + y) \<le> infnorm x + infnorm y"
  2927 proof -
  2928   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"
  2929     by simp
  2930   show ?thesis
  2931     by (auto simp: infnorm_Max inner_add_left intro!: *)
  2932 qed
  2933 
  2934 lemma infnorm_eq_0:
  2935   fixes x :: "'a::euclidean_space"
  2936   shows "infnorm x = 0 \<longleftrightarrow> x = 0"
  2937 proof -
  2938   have "infnorm x \<le> 0 \<longleftrightarrow> x = 0"
  2939     unfolding infnorm_Max by (simp add: euclidean_all_zero_iff)
  2940   then show ?thesis
  2941     using infnorm_pos_le[of x] by simp
  2942 qed
  2943 
  2944 lemma infnorm_0: "infnorm 0 = 0"
  2945   by (simp add: infnorm_eq_0)
  2946 
  2947 lemma infnorm_neg: "infnorm (- x) = infnorm x"
  2948   unfolding infnorm_def
  2949   apply (rule cong[of "Sup" "Sup"])
  2950   apply blast
  2951   apply auto
  2952   done
  2953 
  2954 lemma infnorm_sub: "infnorm (x - y) = infnorm (y - x)"
  2955 proof -
  2956   have "y - x = - (x - y)" by simp
  2957   then show ?thesis
  2958     by (metis infnorm_neg)
  2959 qed
  2960 
  2961 lemma real_abs_sub_infnorm: "\<bar>infnorm x - infnorm y\<bar> \<le> infnorm (x - y)"
  2962 proof -
  2963   have th: "\<And>(nx::real) n ny. nx \<le> n + ny \<Longrightarrow> ny \<le> n + nx \<Longrightarrow> \<bar>nx - ny\<bar> \<le> n"
  2964     by arith
  2965   from infnorm_triangle[of "x - y" " y"] infnorm_triangle[of "x - y" "-x"]
  2966   have ths: "infnorm x \<le> infnorm (x - y) + infnorm y"
  2967     "infnorm y \<le> infnorm (x - y) + infnorm x"
  2968     by (simp_all add: field_simps infnorm_neg)
  2969   from th[OF ths] show ?thesis .
  2970 qed
  2971 
  2972 lemma real_abs_infnorm: "\<bar>infnorm x\<bar> = infnorm x"
  2973   using infnorm_pos_le[of x] by arith
  2974 
  2975 lemma Basis_le_infnorm:
  2976   fixes x :: "'a::euclidean_space"
  2977   shows "b \<in> Basis \<Longrightarrow> \<bar>x \<bullet> b\<bar> \<le> infnorm x"
  2978   by (simp add: infnorm_Max)
  2979 
  2980 lemma infnorm_mul: "infnorm (a *\<^sub>R x) = \<bar>a\<bar> * infnorm x"
  2981   unfolding infnorm_Max
  2982 proof (safe intro!: Max_eqI)
  2983   let ?B = "(\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis"
  2984   {
  2985     fix b :: 'a
  2986     assume "b \<in> Basis"
  2987     then show "\<bar>a *\<^sub>R x \<bullet> b\<bar> \<le> \<bar>a\<bar> * Max ?B"
  2988       by (simp add: abs_mult mult_left_mono)
  2989   next
  2990     from Max_in[of ?B] obtain b where "b \<in> Basis" "Max ?B = \<bar>x \<bullet> b\<bar>"
  2991       by (auto simp del: Max_in)
  2992     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"
  2993       by (intro image_eqI[where x=b]) (auto simp: abs_mult)
  2994   }
  2995 qed simp
  2996 
  2997 lemma infnorm_mul_lemma: "infnorm (a *\<^sub>R x) \<le> \<bar>a\<bar> * infnorm x"
  2998   unfolding infnorm_mul ..
  2999 
  3000 lemma infnorm_pos_lt: "infnorm x > 0 \<longleftrightarrow> x \<noteq> 0"
  3001   using infnorm_pos_le[of x] infnorm_eq_0[of x] by arith
  3002 
  3003 text \<open>Prove that it differs only up to a bound from Euclidean norm.\<close>
  3004 
  3005 lemma infnorm_le_norm: "infnorm x \<le> norm x"
  3006   by (simp add: Basis_le_norm infnorm_Max)
  3007 
  3008 lemma (in euclidean_space) euclidean_inner: "inner x y = (\<Sum>b\<in>Basis. (x \<bullet> b) * (y \<bullet> b))"
  3009   by (subst (1 2) euclidean_representation [symmetric])
  3010     (simp add: inner_sum_right inner_Basis ac_simps)
  3011 
  3012 lemma norm_le_infnorm:
  3013   fixes x :: "'a::euclidean_space"
  3014   shows "norm x \<le> sqrt DIM('a) * infnorm x"
  3015 proof -
  3016   let ?d = "DIM('a)"
  3017   have "real ?d \<ge> 0"
  3018     by simp
  3019   then have d2: "(sqrt (real ?d))\<^sup>2 = real ?d"
  3020     by (auto intro: real_sqrt_pow2)
  3021   have th: "sqrt (real ?d) * infnorm x \<ge> 0"
  3022     by (simp add: zero_le_mult_iff infnorm_pos_le)
  3023   have th1: "x \<bullet> x \<le> (sqrt (real ?d) * infnorm x)\<^sup>2"
  3024     unfolding power_mult_distrib d2
  3025     apply (subst euclidean_inner)
  3026     apply (subst power2_abs[symmetric])
  3027     apply (rule order_trans[OF sum_bounded_above[where K="\<bar>infnorm x\<bar>\<^sup>2"]])
  3028     apply (auto simp add: power2_eq_square[symmetric])
  3029     apply (subst power2_abs[symmetric])
  3030     apply (rule power_mono)
  3031     apply (auto simp: infnorm_Max)
  3032     done
  3033   from real_le_lsqrt[OF inner_ge_zero th th1]
  3034   show ?thesis
  3035     unfolding norm_eq_sqrt_inner id_def .
  3036 qed
  3037 
  3038 lemma tendsto_infnorm [tendsto_intros]:
  3039   assumes "(f \<longlongrightarrow> a) F"
  3040   shows "((\<lambda>x. infnorm (f x)) \<longlongrightarrow> infnorm a) F"
  3041 proof (rule tendsto_compose [OF LIM_I assms])
  3042   fix r :: real
  3043   assume "r > 0"
  3044   then show "\<exists>s>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < s \<longrightarrow> norm (infnorm x - infnorm a) < r"
  3045     by (metis real_norm_def le_less_trans real_abs_sub_infnorm infnorm_le_norm)
  3046 qed
  3047 
  3048 text \<open>Equality in Cauchy-Schwarz and triangle inequalities.\<close>
  3049 
  3050 lemma norm_cauchy_schwarz_eq: "x \<bullet> y = norm x * norm y \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
  3051   (is "?lhs \<longleftrightarrow> ?rhs")
  3052 proof -
  3053   {
  3054     assume h: "x = 0"
  3055     then have ?thesis by simp
  3056   }
  3057   moreover
  3058   {
  3059     assume h: "y = 0"
  3060     then have ?thesis by simp
  3061   }
  3062   moreover
  3063   {
  3064     assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
  3065     from inner_eq_zero_iff[of "norm y *\<^sub>R x - norm x *\<^sub>R y"]
  3066     have "?rhs \<longleftrightarrow>
  3067       (norm y * (norm y * norm x * norm x - norm x * (x \<bullet> y)) -
  3068         norm x * (norm y * (y \<bullet> x) - norm x * norm y * norm y) =  0)"
  3069       using x y
  3070       unfolding inner_simps
  3071       unfolding power2_norm_eq_inner[symmetric] power2_eq_square right_minus_eq
  3072       apply (simp add: inner_commute)
  3073       apply (simp add: field_simps)
  3074       apply metis
  3075       done
  3076     also have "\<dots> \<longleftrightarrow> (2 * norm x * norm y * (norm x * norm y - x \<bullet> y) = 0)" using x y
  3077       by (simp add: field_simps inner_commute)
  3078     also have "\<dots> \<longleftrightarrow> ?lhs" using x y
  3079       apply simp
  3080       apply metis
  3081       done
  3082     finally have ?thesis by blast
  3083   }
  3084   ultimately show ?thesis by blast
  3085 qed
  3086 
  3087 lemma norm_cauchy_schwarz_abs_eq:
  3088   "\<bar>x \<bullet> y\<bar> = norm x * norm y \<longleftrightarrow>
  3089     norm x *\<^sub>R y = norm y *\<^sub>R x \<or> norm x *\<^sub>R y = - norm y *\<^sub>R x"
  3090   (is "?lhs \<longleftrightarrow> ?rhs")
  3091 proof -
  3092   have th: "\<And>(x::real) a. a \<ge> 0 \<Longrightarrow> \<bar>x\<bar> = a \<longleftrightarrow> x = a \<or> x = - a"
  3093     by arith
  3094   have "?rhs \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x \<or> norm (- x) *\<^sub>R y = norm y *\<^sub>R (- x)"
  3095     by simp
  3096   also have "\<dots> \<longleftrightarrow>(x \<bullet> y = norm x * norm y \<or> (- x) \<bullet> y = norm x * norm y)"
  3097     unfolding norm_cauchy_schwarz_eq[symmetric]
  3098     unfolding norm_minus_cancel norm_scaleR ..
  3099   also have "\<dots> \<longleftrightarrow> ?lhs"
  3100     unfolding th[OF mult_nonneg_nonneg, OF norm_ge_zero[of x] norm_ge_zero[of y]] inner_simps
  3101     by auto
  3102   finally show ?thesis ..
  3103 qed
  3104 
  3105 lemma norm_triangle_eq:
  3106   fixes x y :: "'a::real_inner"
  3107   shows "norm (x + y) = norm x + norm y \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
  3108 proof -
  3109   {
  3110     assume x: "x = 0 \<or> y = 0"
  3111     then have ?thesis
  3112       by (cases "x = 0") simp_all
  3113   }
  3114   moreover
  3115   {
  3116     assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
  3117     then have "norm x \<noteq> 0" "norm y \<noteq> 0"
  3118       by simp_all
  3119     then have n: "norm x > 0" "norm y > 0"
  3120       using norm_ge_zero[of x] norm_ge_zero[of y] by arith+
  3121     have th: "\<And>(a::real) b c. a + b + c \<noteq> 0 \<Longrightarrow> a = b + c \<longleftrightarrow> a\<^sup>2 = (b + c)\<^sup>2"
  3122       by algebra
  3123     have "norm (x + y) = norm x + norm y \<longleftrightarrow> (norm (x + y))\<^sup>2 = (norm x + norm y)\<^sup>2"
  3124       apply (rule th)
  3125       using n norm_ge_zero[of "x + y"]
  3126       apply arith
  3127       done
  3128     also have "\<dots> \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
  3129       unfolding norm_cauchy_schwarz_eq[symmetric]
  3130       unfolding power2_norm_eq_inner inner_simps
  3131       by (simp add: power2_norm_eq_inner[symmetric] power2_eq_square inner_commute field_simps)
  3132     finally have ?thesis .
  3133   }
  3134   ultimately show ?thesis by blast
  3135 qed
  3136 
  3137 
  3138 subsection \<open>Collinearity\<close>
  3139 
  3140 definition collinear :: "'a::real_vector set \<Rightarrow> bool"
  3141   where "collinear S \<longleftrightarrow> (\<exists>u. \<forall>x \<in> S. \<forall> y \<in> S. \<exists>c. x - y = c *\<^sub>R u)"
  3142 
  3143 lemma collinear_alt:
  3144      "collinear S \<longleftrightarrow> (\<exists>u v. \<forall>x \<in> S. \<exists>c. x = u + c *\<^sub>R v)" (is "?lhs = ?rhs")
  3145 proof
  3146   assume ?lhs
  3147   then show ?rhs
  3148     unfolding collinear_def by (metis Groups.add_ac(2) diff_add_cancel)
  3149 next
  3150   assume ?rhs
  3151   then obtain u v where *: "\<And>x. x \<in> S \<Longrightarrow> \<exists>c. x = u + c *\<^sub>R v"
  3152     by (auto simp: )
  3153   have "\<exists>c. x - y = c *\<^sub>R v" if "x \<in> S" "y \<in> S" for x y
  3154         by (metis *[OF \<open>x \<in> S\<close>] *[OF \<open>y \<in> S\<close>] scaleR_left.diff add_diff_cancel_left)
  3155   then show ?lhs
  3156     using collinear_def by blast
  3157 qed
  3158 
  3159 lemma collinear:
  3160   fixes S :: "'a::{perfect_space,real_vector} set"
  3161   shows "collinear S \<longleftrightarrow> (\<exists>u. u \<noteq> 0 \<and> (\<forall>x \<in> S. \<forall> y \<in> S. \<exists>c. x - y = c *\<^sub>R u))"
  3162 proof -
  3163   have "\<exists>v. v \<noteq> 0 \<and> (\<forall>x\<in>S. \<forall>y\<in>S. \<exists>c. x - y = c *\<^sub>R v)"
  3164     if "\<forall>x\<in>S. \<forall>y\<in>S. \<exists>c. x - y = c *\<^sub>R u" "u=0" for u
  3165   proof -
  3166     have "\<forall>x\<in>S. \<forall>y\<in>S. x = y"
  3167       using that by auto
  3168     moreover
  3169     obtain v::'a where "v \<noteq> 0"
  3170       using UNIV_not_singleton [of 0] by auto
  3171     ultimately have "\<forall>x\<in>S. \<forall>y\<in>S. \<exists>c. x - y = c *\<^sub>R v"
  3172       by auto
  3173     then show ?thesis
  3174       using \<open>v \<noteq> 0\<close> by blast
  3175   qed
  3176   then show ?thesis
  3177     apply (clarsimp simp: collinear_def)
  3178     by (metis real_vector.scale_zero_right vector_fraction_eq_iff)
  3179 qed
  3180 
  3181 lemma collinear_subset: "\<lbrakk>collinear T; S \<subseteq> T\<rbrakk> \<Longrightarrow> collinear S"
  3182   by (meson collinear_def subsetCE)
  3183 
  3184 lemma collinear_empty [iff]: "collinear {}"
  3185   by (simp add: collinear_def)
  3186 
  3187 lemma collinear_sing [iff]: "collinear {x}"
  3188   by (simp add: collinear_def)
  3189 
  3190 lemma collinear_2 [iff]: "collinear {x, y}"
  3191   apply (simp add: collinear_def)
  3192   apply (rule exI[where x="x - y"])
  3193   apply auto
  3194   apply (rule exI[where x=1], simp)
  3195   apply (rule exI[where x="- 1"], simp)
  3196   done
  3197 
  3198 lemma collinear_lemma: "collinear {0, x, y} \<longleftrightarrow> x = 0 \<or> y = 0 \<or> (\<exists>c. y = c *\<^sub>R x)"
  3199   (is "?lhs \<longleftrightarrow> ?rhs")
  3200 proof -
  3201   {
  3202     assume "x = 0 \<or> y = 0"
  3203     then have ?thesis
  3204       by (cases "x = 0") (simp_all add: collinear_2 insert_commute)
  3205   }
  3206   moreover
  3207   {
  3208     assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
  3209     have ?thesis
  3210     proof
  3211       assume h: "?lhs"
  3212       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"
  3213         unfolding collinear_def by blast
  3214       from u[rule_format, of x 0] u[rule_format, of y 0]
  3215       obtain cx and cy where
  3216         cx: "x = cx *\<^sub>R u" and cy: "y = cy *\<^sub>R u"
  3217         by auto
  3218       from cx x have cx0: "cx \<noteq> 0" by auto
  3219       from cy y have cy0: "cy \<noteq> 0" by auto
  3220       let ?d = "cy / cx"
  3221       from cx cy cx0 have "y = ?d *\<^sub>R x"
  3222         by simp
  3223       then show ?rhs using x y by blast
  3224     next
  3225       assume h: "?rhs"
  3226       then obtain c where c: "y = c *\<^sub>R x"
  3227         using x y by blast
  3228       show ?lhs
  3229         unfolding collinear_def c
  3230         apply (rule exI[where x=x])
  3231         apply auto
  3232         apply (rule exI[where x="- 1"], simp)
  3233         apply (rule exI[where x= "-c"], simp)
  3234         apply (rule exI[where x=1], simp)
  3235         apply (rule exI[where x="1 - c"], simp add: scaleR_left_diff_distrib)
  3236         apply (rule exI[where x="c - 1"], simp add: scaleR_left_diff_distrib)
  3237         done
  3238     qed
  3239   }
  3240   ultimately show ?thesis by blast
  3241 qed
  3242 
  3243 lemma norm_cauchy_schwarz_equal: "\<bar>x \<bullet> y\<bar> = norm x * norm y \<longleftrightarrow> collinear {0, x, y}"
  3244   unfolding norm_cauchy_schwarz_abs_eq
  3245   apply (cases "x=0", simp_all)
  3246   apply (cases "y=0", simp_all add: insert_commute)
  3247   unfolding collinear_lemma
  3248   apply simp
  3249   apply (subgoal_tac "norm x \<noteq> 0")
  3250   apply (subgoal_tac "norm y \<noteq> 0")
  3251   apply (rule iffI)
  3252   apply (cases "norm x *\<^sub>R y = norm y *\<^sub>R x")
  3253   apply (rule exI[where x="(1/norm x) * norm y"])
  3254   apply (drule sym)
  3255   unfolding scaleR_scaleR[symmetric]
  3256   apply (simp add: field_simps)
  3257   apply (rule exI[where x="(1/norm x) * - norm y"])
  3258   apply clarify
  3259   apply (drule sym)
  3260   unfolding scaleR_scaleR[symmetric]
  3261   apply (simp add: field_simps)
  3262   apply (erule exE)
  3263   apply (erule ssubst)
  3264   unfolding scaleR_scaleR
  3265   unfolding norm_scaleR
  3266   apply (subgoal_tac "norm x * c = \<bar>c\<bar> * norm x \<or> norm x * c = - \<bar>c\<bar> * norm x")
  3267   apply (auto simp add: field_simps)
  3268   done
  3269 
  3270 end