src/HOL/Analysis/Linear_Algebra.thy
changeset 63627 6ddb43c6b711
parent 63469 b6900858dcb9
child 63680 6e1e8b5abbfa
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/HOL/Analysis/Linear_Algebra.thy	Mon Aug 08 14:13:14 2016 +0200
     1.3 @@ -0,0 +1,3214 @@
     1.4 +(*  Title:      HOL/Analysis/Linear_Algebra.thy
     1.5 +    Author:     Amine Chaieb, University of Cambridge
     1.6 +*)
     1.7 +
     1.8 +section \<open>Elementary linear algebra on Euclidean spaces\<close>
     1.9 +
    1.10 +theory Linear_Algebra
    1.11 +imports
    1.12 +  Euclidean_Space
    1.13 +  "~~/src/HOL/Library/Infinite_Set"
    1.14 +begin
    1.15 +
    1.16 +subsection \<open>A generic notion of "hull" (convex, affine, conic hull and closure).\<close>
    1.17 +
    1.18 +definition hull :: "('a set \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> 'a set"  (infixl "hull" 75)
    1.19 +  where "S hull s = \<Inter>{t. S t \<and> s \<subseteq> t}"
    1.20 +
    1.21 +lemma hull_same: "S s \<Longrightarrow> S hull s = s"
    1.22 +  unfolding hull_def by auto
    1.23 +
    1.24 +lemma hull_in: "(\<And>T. Ball T S \<Longrightarrow> S (\<Inter>T)) \<Longrightarrow> S (S hull s)"
    1.25 +  unfolding hull_def Ball_def by auto
    1.26 +
    1.27 +lemma hull_eq: "(\<And>T. Ball T S \<Longrightarrow> S (\<Inter>T)) \<Longrightarrow> (S hull s) = s \<longleftrightarrow> S s"
    1.28 +  using hull_same[of S s] hull_in[of S s] by metis
    1.29 +
    1.30 +lemma hull_hull [simp]: "S hull (S hull s) = S hull s"
    1.31 +  unfolding hull_def by blast
    1.32 +
    1.33 +lemma hull_subset[intro]: "s \<subseteq> (S hull s)"
    1.34 +  unfolding hull_def by blast
    1.35 +
    1.36 +lemma hull_mono: "s \<subseteq> t \<Longrightarrow> (S hull s) \<subseteq> (S hull t)"
    1.37 +  unfolding hull_def by blast
    1.38 +
    1.39 +lemma hull_antimono: "\<forall>x. S x \<longrightarrow> T x \<Longrightarrow> (T hull s) \<subseteq> (S hull s)"
    1.40 +  unfolding hull_def by blast
    1.41 +
    1.42 +lemma hull_minimal: "s \<subseteq> t \<Longrightarrow> S t \<Longrightarrow> (S hull s) \<subseteq> t"
    1.43 +  unfolding hull_def by blast
    1.44 +
    1.45 +lemma subset_hull: "S t \<Longrightarrow> S hull s \<subseteq> t \<longleftrightarrow> s \<subseteq> t"
    1.46 +  unfolding hull_def by blast
    1.47 +
    1.48 +lemma hull_UNIV [simp]: "S hull UNIV = UNIV"
    1.49 +  unfolding hull_def by auto
    1.50 +
    1.51 +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)"
    1.52 +  unfolding hull_def by auto
    1.53 +
    1.54 +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"
    1.55 +  using hull_minimal[of S "{x. P x}" Q]
    1.56 +  by (auto simp add: subset_eq)
    1.57 +
    1.58 +lemma hull_inc: "x \<in> S \<Longrightarrow> x \<in> P hull S"
    1.59 +  by (metis hull_subset subset_eq)
    1.60 +
    1.61 +lemma hull_union_subset: "(S hull s) \<union> (S hull t) \<subseteq> (S hull (s \<union> t))"
    1.62 +  unfolding Un_subset_iff by (metis hull_mono Un_upper1 Un_upper2)
    1.63 +
    1.64 +lemma hull_union:
    1.65 +  assumes T: "\<And>T. Ball T S \<Longrightarrow> S (\<Inter>T)"
    1.66 +  shows "S hull (s \<union> t) = S hull (S hull s \<union> S hull t)"
    1.67 +  apply rule
    1.68 +  apply (rule hull_mono)
    1.69 +  unfolding Un_subset_iff
    1.70 +  apply (metis hull_subset Un_upper1 Un_upper2 subset_trans)
    1.71 +  apply (rule hull_minimal)
    1.72 +  apply (metis hull_union_subset)
    1.73 +  apply (metis hull_in T)
    1.74 +  done
    1.75 +
    1.76 +lemma hull_redundant_eq: "a \<in> (S hull s) \<longleftrightarrow> S hull (insert a s) = S hull s"
    1.77 +  unfolding hull_def by blast
    1.78 +
    1.79 +lemma hull_redundant: "a \<in> (S hull s) \<Longrightarrow> S hull (insert a s) = S hull s"
    1.80 +  by (metis hull_redundant_eq)
    1.81 +
    1.82 +subsection \<open>Linear functions.\<close>
    1.83 +
    1.84 +lemma linear_iff:
    1.85 +  "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)"
    1.86 +  (is "linear f \<longleftrightarrow> ?rhs")
    1.87 +proof
    1.88 +  assume "linear f"
    1.89 +  then interpret f: linear f .
    1.90 +  show "?rhs" by (simp add: f.add f.scaleR)
    1.91 +next
    1.92 +  assume "?rhs"
    1.93 +  then show "linear f" by unfold_locales simp_all
    1.94 +qed
    1.95 +
    1.96 +lemma linear_compose_cmul: "linear f \<Longrightarrow> linear (\<lambda>x. c *\<^sub>R f x)"
    1.97 +  by (simp add: linear_iff algebra_simps)
    1.98 +
    1.99 +lemma linear_compose_scaleR: "linear f \<Longrightarrow> linear (\<lambda>x. f x *\<^sub>R c)"
   1.100 +  by (simp add: linear_iff scaleR_add_left)
   1.101 +
   1.102 +lemma linear_compose_neg: "linear f \<Longrightarrow> linear (\<lambda>x. - f x)"
   1.103 +  by (simp add: linear_iff)
   1.104 +
   1.105 +lemma linear_compose_add: "linear f \<Longrightarrow> linear g \<Longrightarrow> linear (\<lambda>x. f x + g x)"
   1.106 +  by (simp add: linear_iff algebra_simps)
   1.107 +
   1.108 +lemma linear_compose_sub: "linear f \<Longrightarrow> linear g \<Longrightarrow> linear (\<lambda>x. f x - g x)"
   1.109 +  by (simp add: linear_iff algebra_simps)
   1.110 +
   1.111 +lemma linear_compose: "linear f \<Longrightarrow> linear g \<Longrightarrow> linear (g \<circ> f)"
   1.112 +  by (simp add: linear_iff)
   1.113 +
   1.114 +lemma linear_id: "linear id"
   1.115 +  by (simp add: linear_iff id_def)
   1.116 +
   1.117 +lemma linear_zero: "linear (\<lambda>x. 0)"
   1.118 +  by (simp add: linear_iff)
   1.119 +
   1.120 +lemma linear_uminus: "linear uminus"
   1.121 +by (simp add: linear_iff)
   1.122 +
   1.123 +lemma linear_compose_setsum:
   1.124 +  assumes lS: "\<forall>a \<in> S. linear (f a)"
   1.125 +  shows "linear (\<lambda>x. setsum (\<lambda>a. f a x) S)"
   1.126 +proof (cases "finite S")
   1.127 +  case True
   1.128 +  then show ?thesis
   1.129 +    using lS by induct (simp_all add: linear_zero linear_compose_add)
   1.130 +next
   1.131 +  case False
   1.132 +  then show ?thesis
   1.133 +    by (simp add: linear_zero)
   1.134 +qed
   1.135 +
   1.136 +lemma linear_0: "linear f \<Longrightarrow> f 0 = 0"
   1.137 +  unfolding linear_iff
   1.138 +  apply clarsimp
   1.139 +  apply (erule allE[where x="0::'a"])
   1.140 +  apply simp
   1.141 +  done
   1.142 +
   1.143 +lemma linear_cmul: "linear f \<Longrightarrow> f (c *\<^sub>R x) = c *\<^sub>R f x"
   1.144 +  by (rule linear.scaleR)
   1.145 +
   1.146 +lemma linear_neg: "linear f \<Longrightarrow> f (- x) = - f x"
   1.147 +  using linear_cmul [where c="-1"] by simp
   1.148 +
   1.149 +lemma linear_add: "linear f \<Longrightarrow> f (x + y) = f x + f y"
   1.150 +  by (metis linear_iff)
   1.151 +
   1.152 +lemma linear_diff: "linear f \<Longrightarrow> f (x - y) = f x - f y"
   1.153 +  using linear_add [of f x "- y"] by (simp add: linear_neg)
   1.154 +
   1.155 +lemma linear_setsum:
   1.156 +  assumes f: "linear f"
   1.157 +  shows "f (setsum g S) = setsum (f \<circ> g) S"
   1.158 +proof (cases "finite S")
   1.159 +  case True
   1.160 +  then show ?thesis
   1.161 +    by induct (simp_all add: linear_0 [OF f] linear_add [OF f])
   1.162 +next
   1.163 +  case False
   1.164 +  then show ?thesis
   1.165 +    by (simp add: linear_0 [OF f])
   1.166 +qed
   1.167 +
   1.168 +lemma linear_setsum_mul:
   1.169 +  assumes lin: "linear f"
   1.170 +  shows "f (setsum (\<lambda>i. c i *\<^sub>R v i) S) = setsum (\<lambda>i. c i *\<^sub>R f (v i)) S"
   1.171 +  using linear_setsum[OF lin, of "\<lambda>i. c i *\<^sub>R v i" , unfolded o_def] linear_cmul[OF lin]
   1.172 +  by simp
   1.173 +
   1.174 +lemma linear_injective_0:
   1.175 +  assumes lin: "linear f"
   1.176 +  shows "inj f \<longleftrightarrow> (\<forall>x. f x = 0 \<longrightarrow> x = 0)"
   1.177 +proof -
   1.178 +  have "inj f \<longleftrightarrow> (\<forall> x y. f x = f y \<longrightarrow> x = y)"
   1.179 +    by (simp add: inj_on_def)
   1.180 +  also have "\<dots> \<longleftrightarrow> (\<forall> x y. f x - f y = 0 \<longrightarrow> x - y = 0)"
   1.181 +    by simp
   1.182 +  also have "\<dots> \<longleftrightarrow> (\<forall> x y. f (x - y) = 0 \<longrightarrow> x - y = 0)"
   1.183 +    by (simp add: linear_diff[OF lin])
   1.184 +  also have "\<dots> \<longleftrightarrow> (\<forall> x. f x = 0 \<longrightarrow> x = 0)"
   1.185 +    by auto
   1.186 +  finally show ?thesis .
   1.187 +qed
   1.188 +
   1.189 +lemma linear_scaleR  [simp]: "linear (\<lambda>x. scaleR c x)"
   1.190 +  by (simp add: linear_iff scaleR_add_right)
   1.191 +
   1.192 +lemma linear_scaleR_left [simp]: "linear (\<lambda>r. scaleR r x)"
   1.193 +  by (simp add: linear_iff scaleR_add_left)
   1.194 +
   1.195 +lemma injective_scaleR: "c \<noteq> 0 \<Longrightarrow> inj (\<lambda>x::'a::real_vector. scaleR c x)"
   1.196 +  by (simp add: inj_on_def)
   1.197 +
   1.198 +lemma linear_add_cmul:
   1.199 +  assumes "linear f"
   1.200 +  shows "f (a *\<^sub>R x + b *\<^sub>R y) = a *\<^sub>R f x +  b *\<^sub>R f y"
   1.201 +  using linear_add[of f] linear_cmul[of f] assms by simp
   1.202 +
   1.203 +subsection \<open>Subspaces of vector spaces\<close>
   1.204 +
   1.205 +definition (in real_vector) subspace :: "'a set \<Rightarrow> bool"
   1.206 +  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)"
   1.207 +
   1.208 +definition (in real_vector) "span S = (subspace hull S)"
   1.209 +definition (in real_vector) "dependent S \<longleftrightarrow> (\<exists>a \<in> S. a \<in> span (S - {a}))"
   1.210 +abbreviation (in real_vector) "independent s \<equiv> \<not> dependent s"
   1.211 +
   1.212 +text \<open>Closure properties of subspaces.\<close>
   1.213 +
   1.214 +lemma subspace_UNIV[simp]: "subspace UNIV"
   1.215 +  by (simp add: subspace_def)
   1.216 +
   1.217 +lemma (in real_vector) subspace_0: "subspace S \<Longrightarrow> 0 \<in> S"
   1.218 +  by (metis subspace_def)
   1.219 +
   1.220 +lemma (in real_vector) subspace_add: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x + y \<in> S"
   1.221 +  by (metis subspace_def)
   1.222 +
   1.223 +lemma (in real_vector) subspace_mul: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> c *\<^sub>R x \<in> S"
   1.224 +  by (metis subspace_def)
   1.225 +
   1.226 +lemma subspace_neg: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> - x \<in> S"
   1.227 +  by (metis scaleR_minus1_left subspace_mul)
   1.228 +
   1.229 +lemma subspace_diff: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x - y \<in> S"
   1.230 +  using subspace_add [of S x "- y"] by (simp add: subspace_neg)
   1.231 +
   1.232 +lemma (in real_vector) subspace_setsum:
   1.233 +  assumes sA: "subspace A"
   1.234 +    and f: "\<And>x. x \<in> B \<Longrightarrow> f x \<in> A"
   1.235 +  shows "setsum f B \<in> A"
   1.236 +proof (cases "finite B")
   1.237 +  case True
   1.238 +  then show ?thesis
   1.239 +    using f by induct (simp_all add: subspace_0 [OF sA] subspace_add [OF sA])
   1.240 +qed (simp add: subspace_0 [OF sA])
   1.241 +
   1.242 +lemma subspace_trivial [iff]: "subspace {0}"
   1.243 +  by (simp add: subspace_def)
   1.244 +
   1.245 +lemma (in real_vector) subspace_inter: "subspace A \<Longrightarrow> subspace B \<Longrightarrow> subspace (A \<inter> B)"
   1.246 +  by (simp add: subspace_def)
   1.247 +
   1.248 +lemma subspace_Times: "subspace A \<Longrightarrow> subspace B \<Longrightarrow> subspace (A \<times> B)"
   1.249 +  unfolding subspace_def zero_prod_def by simp
   1.250 +
   1.251 +lemma subspace_sums: "\<lbrakk>subspace S; subspace T\<rbrakk> \<Longrightarrow> subspace {x + y|x y. x \<in> S \<and> y \<in> T}"
   1.252 +apply (simp add: subspace_def)
   1.253 +apply (intro conjI impI allI)
   1.254 +  using add.right_neutral apply blast
   1.255 + apply clarify
   1.256 + apply (metis add.assoc add.left_commute)
   1.257 +using scaleR_add_right by blast
   1.258 +
   1.259 +subsection \<open>Properties of span\<close>
   1.260 +
   1.261 +lemma (in real_vector) span_mono: "A \<subseteq> B \<Longrightarrow> span A \<subseteq> span B"
   1.262 +  by (metis span_def hull_mono)
   1.263 +
   1.264 +lemma (in real_vector) subspace_span [iff]: "subspace (span S)"
   1.265 +  unfolding span_def
   1.266 +  apply (rule hull_in)
   1.267 +  apply (simp only: subspace_def Inter_iff Int_iff subset_eq)
   1.268 +  apply auto
   1.269 +  done
   1.270 +
   1.271 +lemma (in real_vector) span_clauses:
   1.272 +  "a \<in> S \<Longrightarrow> a \<in> span S"
   1.273 +  "0 \<in> span S"
   1.274 +  "x\<in> span S \<Longrightarrow> y \<in> span S \<Longrightarrow> x + y \<in> span S"
   1.275 +  "x \<in> span S \<Longrightarrow> c *\<^sub>R x \<in> span S"
   1.276 +  by (metis span_def hull_subset subset_eq) (metis subspace_span subspace_def)+
   1.277 +
   1.278 +lemma span_unique:
   1.279 +  "S \<subseteq> T \<Longrightarrow> subspace T \<Longrightarrow> (\<And>T'. S \<subseteq> T' \<Longrightarrow> subspace T' \<Longrightarrow> T \<subseteq> T') \<Longrightarrow> span S = T"
   1.280 +  unfolding span_def by (rule hull_unique)
   1.281 +
   1.282 +lemma span_minimal: "S \<subseteq> T \<Longrightarrow> subspace T \<Longrightarrow> span S \<subseteq> T"
   1.283 +  unfolding span_def by (rule hull_minimal)
   1.284 +
   1.285 +lemma span_UNIV: "span UNIV = UNIV"
   1.286 +  by (intro span_unique) auto
   1.287 +
   1.288 +lemma (in real_vector) span_induct:
   1.289 +  assumes x: "x \<in> span S"
   1.290 +    and P: "subspace (Collect P)"
   1.291 +    and SP: "\<And>x. x \<in> S \<Longrightarrow> P x"
   1.292 +  shows "P x"
   1.293 +proof -
   1.294 +  from SP have SP': "S \<subseteq> Collect P"
   1.295 +    by (simp add: subset_eq)
   1.296 +  from x hull_minimal[where S=subspace, OF SP' P, unfolded span_def[symmetric]]
   1.297 +  show ?thesis
   1.298 +    using subset_eq by force
   1.299 +qed
   1.300 +
   1.301 +lemma span_empty[simp]: "span {} = {0}"
   1.302 +  apply (simp add: span_def)
   1.303 +  apply (rule hull_unique)
   1.304 +  apply (auto simp add: subspace_def)
   1.305 +  done
   1.306 +
   1.307 +lemma (in real_vector) independent_empty [iff]: "independent {}"
   1.308 +  by (simp add: dependent_def)
   1.309 +
   1.310 +lemma dependent_single[simp]: "dependent {x} \<longleftrightarrow> x = 0"
   1.311 +  unfolding dependent_def by auto
   1.312 +
   1.313 +lemma (in real_vector) independent_mono: "independent A \<Longrightarrow> B \<subseteq> A \<Longrightarrow> independent B"
   1.314 +  apply (clarsimp simp add: dependent_def span_mono)
   1.315 +  apply (subgoal_tac "span (B - {a}) \<le> span (A - {a})")
   1.316 +  apply force
   1.317 +  apply (rule span_mono)
   1.318 +  apply auto
   1.319 +  done
   1.320 +
   1.321 +lemma (in real_vector) span_subspace: "A \<subseteq> B \<Longrightarrow> B \<le> span A \<Longrightarrow>  subspace B \<Longrightarrow> span A = B"
   1.322 +  by (metis order_antisym span_def hull_minimal)
   1.323 +
   1.324 +lemma (in real_vector) span_induct':
   1.325 +  "\<forall>x \<in> S. P x \<Longrightarrow> subspace {x. P x} \<Longrightarrow> \<forall>x \<in> span S. P x"
   1.326 +  unfolding span_def by (rule hull_induct) auto
   1.327 +
   1.328 +inductive_set (in real_vector) span_induct_alt_help for S :: "'a set"
   1.329 +where
   1.330 +  span_induct_alt_help_0: "0 \<in> span_induct_alt_help S"
   1.331 +| span_induct_alt_help_S:
   1.332 +    "x \<in> S \<Longrightarrow> z \<in> span_induct_alt_help S \<Longrightarrow>
   1.333 +      (c *\<^sub>R x + z) \<in> span_induct_alt_help S"
   1.334 +
   1.335 +lemma span_induct_alt':
   1.336 +  assumes h0: "h 0"
   1.337 +    and hS: "\<And>c x y. x \<in> S \<Longrightarrow> h y \<Longrightarrow> h (c *\<^sub>R x + y)"
   1.338 +  shows "\<forall>x \<in> span S. h x"
   1.339 +proof -
   1.340 +  {
   1.341 +    fix x :: 'a
   1.342 +    assume x: "x \<in> span_induct_alt_help S"
   1.343 +    have "h x"
   1.344 +      apply (rule span_induct_alt_help.induct[OF x])
   1.345 +      apply (rule h0)
   1.346 +      apply (rule hS)
   1.347 +      apply assumption
   1.348 +      apply assumption
   1.349 +      done
   1.350 +  }
   1.351 +  note th0 = this
   1.352 +  {
   1.353 +    fix x
   1.354 +    assume x: "x \<in> span S"
   1.355 +    have "x \<in> span_induct_alt_help S"
   1.356 +    proof (rule span_induct[where x=x and S=S])
   1.357 +      show "x \<in> span S" by (rule x)
   1.358 +    next
   1.359 +      fix x
   1.360 +      assume xS: "x \<in> S"
   1.361 +      from span_induct_alt_help_S[OF xS span_induct_alt_help_0, of 1]
   1.362 +      show "x \<in> span_induct_alt_help S"
   1.363 +        by simp
   1.364 +    next
   1.365 +      have "0 \<in> span_induct_alt_help S" by (rule span_induct_alt_help_0)
   1.366 +      moreover
   1.367 +      {
   1.368 +        fix x y
   1.369 +        assume h: "x \<in> span_induct_alt_help S" "y \<in> span_induct_alt_help S"
   1.370 +        from h have "(x + y) \<in> span_induct_alt_help S"
   1.371 +          apply (induct rule: span_induct_alt_help.induct)
   1.372 +          apply simp
   1.373 +          unfolding add.assoc
   1.374 +          apply (rule span_induct_alt_help_S)
   1.375 +          apply assumption
   1.376 +          apply simp
   1.377 +          done
   1.378 +      }
   1.379 +      moreover
   1.380 +      {
   1.381 +        fix c x
   1.382 +        assume xt: "x \<in> span_induct_alt_help S"
   1.383 +        then have "(c *\<^sub>R x) \<in> span_induct_alt_help S"
   1.384 +          apply (induct rule: span_induct_alt_help.induct)
   1.385 +          apply (simp add: span_induct_alt_help_0)
   1.386 +          apply (simp add: scaleR_right_distrib)
   1.387 +          apply (rule span_induct_alt_help_S)
   1.388 +          apply assumption
   1.389 +          apply simp
   1.390 +          done }
   1.391 +      ultimately show "subspace {a. a \<in> span_induct_alt_help S}"
   1.392 +        unfolding subspace_def Ball_def by blast
   1.393 +    qed
   1.394 +  }
   1.395 +  with th0 show ?thesis by blast
   1.396 +qed
   1.397 +
   1.398 +lemma span_induct_alt:
   1.399 +  assumes h0: "h 0"
   1.400 +    and hS: "\<And>c x y. x \<in> S \<Longrightarrow> h y \<Longrightarrow> h (c *\<^sub>R x + y)"
   1.401 +    and x: "x \<in> span S"
   1.402 +  shows "h x"
   1.403 +  using span_induct_alt'[of h S] h0 hS x by blast
   1.404 +
   1.405 +text \<open>Individual closure properties.\<close>
   1.406 +
   1.407 +lemma span_span: "span (span A) = span A"
   1.408 +  unfolding span_def hull_hull ..
   1.409 +
   1.410 +lemma (in real_vector) span_superset: "x \<in> S \<Longrightarrow> x \<in> span S"
   1.411 +  by (metis span_clauses(1))
   1.412 +
   1.413 +lemma (in real_vector) span_0 [simp]: "0 \<in> span S"
   1.414 +  by (metis subspace_span subspace_0)
   1.415 +
   1.416 +lemma span_inc: "S \<subseteq> span S"
   1.417 +  by (metis subset_eq span_superset)
   1.418 +
   1.419 +lemma span_eq: "span S = span T \<longleftrightarrow> S \<subseteq> span T \<and> T \<subseteq> span S"
   1.420 +  using span_inc[unfolded subset_eq] using span_mono[of T "span S"] span_mono[of S "span T"]
   1.421 +  by (auto simp add: span_span)
   1.422 +
   1.423 +lemma (in real_vector) dependent_0:
   1.424 +  assumes "0 \<in> A"
   1.425 +  shows "dependent A"
   1.426 +  unfolding dependent_def
   1.427 +  using assms span_0
   1.428 +  by blast
   1.429 +
   1.430 +lemma (in real_vector) span_add: "x \<in> span S \<Longrightarrow> y \<in> span S \<Longrightarrow> x + y \<in> span S"
   1.431 +  by (metis subspace_add subspace_span)
   1.432 +
   1.433 +lemma (in real_vector) span_mul: "x \<in> span S \<Longrightarrow> c *\<^sub>R x \<in> span S"
   1.434 +  by (metis subspace_span subspace_mul)
   1.435 +
   1.436 +lemma span_neg: "x \<in> span S \<Longrightarrow> - x \<in> span S"
   1.437 +  by (metis subspace_neg subspace_span)
   1.438 +
   1.439 +lemma span_sub: "x \<in> span S \<Longrightarrow> y \<in> span S \<Longrightarrow> x - y \<in> span S"
   1.440 +  by (metis subspace_span subspace_diff)
   1.441 +
   1.442 +lemma (in real_vector) span_setsum: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> span S) \<Longrightarrow> setsum f A \<in> span S"
   1.443 +  by (rule subspace_setsum [OF subspace_span])
   1.444 +
   1.445 +lemma span_add_eq: "x \<in> span S \<Longrightarrow> x + y \<in> span S \<longleftrightarrow> y \<in> span S"
   1.446 +  by (metis add_minus_cancel scaleR_minus1_left subspace_def subspace_span)
   1.447 +
   1.448 +text \<open>The key breakdown property.\<close>
   1.449 +
   1.450 +lemma span_singleton: "span {x} = range (\<lambda>k. k *\<^sub>R x)"
   1.451 +proof (rule span_unique)
   1.452 +  show "{x} \<subseteq> range (\<lambda>k. k *\<^sub>R x)"
   1.453 +    by (fast intro: scaleR_one [symmetric])
   1.454 +  show "subspace (range (\<lambda>k. k *\<^sub>R x))"
   1.455 +    unfolding subspace_def
   1.456 +    by (auto intro: scaleR_add_left [symmetric])
   1.457 +next
   1.458 +  fix T
   1.459 +  assume "{x} \<subseteq> T" and "subspace T"
   1.460 +  then show "range (\<lambda>k. k *\<^sub>R x) \<subseteq> T"
   1.461 +    unfolding subspace_def by auto
   1.462 +qed
   1.463 +
   1.464 +text \<open>Mapping under linear image.\<close>
   1.465 +
   1.466 +lemma subspace_linear_image:
   1.467 +  assumes lf: "linear f"
   1.468 +    and sS: "subspace S"
   1.469 +  shows "subspace (f ` S)"
   1.470 +  using lf sS linear_0[OF lf]
   1.471 +  unfolding linear_iff subspace_def
   1.472 +  apply (auto simp add: image_iff)
   1.473 +  apply (rule_tac x="x + y" in bexI)
   1.474 +  apply auto
   1.475 +  apply (rule_tac x="c *\<^sub>R x" in bexI)
   1.476 +  apply auto
   1.477 +  done
   1.478 +
   1.479 +lemma subspace_linear_vimage: "linear f \<Longrightarrow> subspace S \<Longrightarrow> subspace (f -` S)"
   1.480 +  by (auto simp add: subspace_def linear_iff linear_0[of f])
   1.481 +
   1.482 +lemma subspace_linear_preimage: "linear f \<Longrightarrow> subspace S \<Longrightarrow> subspace {x. f x \<in> S}"
   1.483 +  by (auto simp add: subspace_def linear_iff linear_0[of f])
   1.484 +
   1.485 +lemma span_linear_image:
   1.486 +  assumes lf: "linear f"
   1.487 +  shows "span (f ` S) = f ` span S"
   1.488 +proof (rule span_unique)
   1.489 +  show "f ` S \<subseteq> f ` span S"
   1.490 +    by (intro image_mono span_inc)
   1.491 +  show "subspace (f ` span S)"
   1.492 +    using lf subspace_span by (rule subspace_linear_image)
   1.493 +next
   1.494 +  fix T
   1.495 +  assume "f ` S \<subseteq> T" and "subspace T"
   1.496 +  then show "f ` span S \<subseteq> T"
   1.497 +    unfolding image_subset_iff_subset_vimage
   1.498 +    by (intro span_minimal subspace_linear_vimage lf)
   1.499 +qed
   1.500 +
   1.501 +lemma spans_image:
   1.502 +  assumes lf: "linear f"
   1.503 +    and VB: "V \<subseteq> span B"
   1.504 +  shows "f ` V \<subseteq> span (f ` B)"
   1.505 +  unfolding span_linear_image[OF lf] by (metis VB image_mono)
   1.506 +
   1.507 +lemma span_Un: "span (A \<union> B) = (\<lambda>(a, b). a + b) ` (span A \<times> span B)"
   1.508 +proof (rule span_unique)
   1.509 +  show "A \<union> B \<subseteq> (\<lambda>(a, b). a + b) ` (span A \<times> span B)"
   1.510 +    by safe (force intro: span_clauses)+
   1.511 +next
   1.512 +  have "linear (\<lambda>(a, b). a + b)"
   1.513 +    by (simp add: linear_iff scaleR_add_right)
   1.514 +  moreover have "subspace (span A \<times> span B)"
   1.515 +    by (intro subspace_Times subspace_span)
   1.516 +  ultimately show "subspace ((\<lambda>(a, b). a + b) ` (span A \<times> span B))"
   1.517 +    by (rule subspace_linear_image)
   1.518 +next
   1.519 +  fix T
   1.520 +  assume "A \<union> B \<subseteq> T" and "subspace T"
   1.521 +  then show "(\<lambda>(a, b). a + b) ` (span A \<times> span B) \<subseteq> T"
   1.522 +    by (auto intro!: subspace_add elim: span_induct)
   1.523 +qed
   1.524 +
   1.525 +lemma span_insert: "span (insert a S) = {x. \<exists>k. (x - k *\<^sub>R a) \<in> span S}"
   1.526 +proof -
   1.527 +  have "span ({a} \<union> S) = {x. \<exists>k. (x - k *\<^sub>R a) \<in> span S}"
   1.528 +    unfolding span_Un span_singleton
   1.529 +    apply safe
   1.530 +    apply (rule_tac x=k in exI, simp)
   1.531 +    apply (erule rev_image_eqI [OF SigmaI [OF rangeI]])
   1.532 +    apply auto
   1.533 +    done
   1.534 +  then show ?thesis by simp
   1.535 +qed
   1.536 +
   1.537 +lemma span_breakdown:
   1.538 +  assumes bS: "b \<in> S"
   1.539 +    and aS: "a \<in> span S"
   1.540 +  shows "\<exists>k. a - k *\<^sub>R b \<in> span (S - {b})"
   1.541 +  using assms span_insert [of b "S - {b}"]
   1.542 +  by (simp add: insert_absorb)
   1.543 +
   1.544 +lemma span_breakdown_eq: "x \<in> span (insert a S) \<longleftrightarrow> (\<exists>k. x - k *\<^sub>R a \<in> span S)"
   1.545 +  by (simp add: span_insert)
   1.546 +
   1.547 +text \<open>Hence some "reversal" results.\<close>
   1.548 +
   1.549 +lemma in_span_insert:
   1.550 +  assumes a: "a \<in> span (insert b S)"
   1.551 +    and na: "a \<notin> span S"
   1.552 +  shows "b \<in> span (insert a S)"
   1.553 +proof -
   1.554 +  from a obtain k where k: "a - k *\<^sub>R b \<in> span S"
   1.555 +    unfolding span_insert by fast
   1.556 +  show ?thesis
   1.557 +  proof (cases "k = 0")
   1.558 +    case True
   1.559 +    with k have "a \<in> span S" by simp
   1.560 +    with na show ?thesis by simp
   1.561 +  next
   1.562 +    case False
   1.563 +    from k have "(- inverse k) *\<^sub>R (a - k *\<^sub>R b) \<in> span S"
   1.564 +      by (rule span_mul)
   1.565 +    then have "b - inverse k *\<^sub>R a \<in> span S"
   1.566 +      using \<open>k \<noteq> 0\<close> by (simp add: scaleR_diff_right)
   1.567 +    then show ?thesis
   1.568 +      unfolding span_insert by fast
   1.569 +  qed
   1.570 +qed
   1.571 +
   1.572 +lemma in_span_delete:
   1.573 +  assumes a: "a \<in> span S"
   1.574 +    and na: "a \<notin> span (S - {b})"
   1.575 +  shows "b \<in> span (insert a (S - {b}))"
   1.576 +  apply (rule in_span_insert)
   1.577 +  apply (rule set_rev_mp)
   1.578 +  apply (rule a)
   1.579 +  apply (rule span_mono)
   1.580 +  apply blast
   1.581 +  apply (rule na)
   1.582 +  done
   1.583 +
   1.584 +text \<open>Transitivity property.\<close>
   1.585 +
   1.586 +lemma span_redundant: "x \<in> span S \<Longrightarrow> span (insert x S) = span S"
   1.587 +  unfolding span_def by (rule hull_redundant)
   1.588 +
   1.589 +lemma span_trans:
   1.590 +  assumes x: "x \<in> span S"
   1.591 +    and y: "y \<in> span (insert x S)"
   1.592 +  shows "y \<in> span S"
   1.593 +  using assms by (simp only: span_redundant)
   1.594 +
   1.595 +lemma span_insert_0[simp]: "span (insert 0 S) = span S"
   1.596 +  by (simp only: span_redundant span_0)
   1.597 +
   1.598 +text \<open>An explicit expansion is sometimes needed.\<close>
   1.599 +
   1.600 +lemma span_explicit:
   1.601 +  "span P = {y. \<exists>S u. finite S \<and> S \<subseteq> P \<and> setsum (\<lambda>v. u v *\<^sub>R v) S = y}"
   1.602 +  (is "_ = ?E" is "_ = {y. ?h y}" is "_ = {y. \<exists>S u. ?Q S u y}")
   1.603 +proof -
   1.604 +  {
   1.605 +    fix x
   1.606 +    assume "?h x"
   1.607 +    then obtain S u where "finite S" and "S \<subseteq> P" and "setsum (\<lambda>v. u v *\<^sub>R v) S = x"
   1.608 +      by blast
   1.609 +    then have "x \<in> span P"
   1.610 +      by (auto intro: span_setsum span_mul span_superset)
   1.611 +  }
   1.612 +  moreover
   1.613 +  have "\<forall>x \<in> span P. ?h x"
   1.614 +  proof (rule span_induct_alt')
   1.615 +    show "?h 0"
   1.616 +      by (rule exI[where x="{}"], simp)
   1.617 +  next
   1.618 +    fix c x y
   1.619 +    assume x: "x \<in> P"
   1.620 +    assume hy: "?h y"
   1.621 +    from hy obtain S u where fS: "finite S" and SP: "S\<subseteq>P"
   1.622 +      and u: "setsum (\<lambda>v. u v *\<^sub>R v) S = y" by blast
   1.623 +    let ?S = "insert x S"
   1.624 +    let ?u = "\<lambda>y. if y = x then (if x \<in> S then u y + c else c) else u y"
   1.625 +    from fS SP x have th0: "finite (insert x S)" "insert x S \<subseteq> P"
   1.626 +      by blast+
   1.627 +    have "?Q ?S ?u (c*\<^sub>R x + y)"
   1.628 +    proof cases
   1.629 +      assume xS: "x \<in> S"
   1.630 +      have "setsum (\<lambda>v. ?u v *\<^sub>R v) ?S = (\<Sum>v\<in>S - {x}. u v *\<^sub>R v) + (u x + c) *\<^sub>R x"
   1.631 +        using xS by (simp add: setsum.remove [OF fS xS] insert_absorb)
   1.632 +      also have "\<dots> = (\<Sum>v\<in>S. u v *\<^sub>R v) + c *\<^sub>R x"
   1.633 +        by (simp add: setsum.remove [OF fS xS] algebra_simps)
   1.634 +      also have "\<dots> = c*\<^sub>R x + y"
   1.635 +        by (simp add: add.commute u)
   1.636 +      finally have "setsum (\<lambda>v. ?u v *\<^sub>R v) ?S = c*\<^sub>R x + y" .
   1.637 +      then show ?thesis using th0 by blast
   1.638 +    next
   1.639 +      assume xS: "x \<notin> S"
   1.640 +      have th00: "(\<Sum>v\<in>S. (if v = x then c else u v) *\<^sub>R v) = y"
   1.641 +        unfolding u[symmetric]
   1.642 +        apply (rule setsum.cong)
   1.643 +        using xS
   1.644 +        apply auto
   1.645 +        done
   1.646 +      show ?thesis using fS xS th0
   1.647 +        by (simp add: th00 add.commute cong del: if_weak_cong)
   1.648 +    qed
   1.649 +    then show "?h (c*\<^sub>R x + y)"
   1.650 +      by fast
   1.651 +  qed
   1.652 +  ultimately show ?thesis by blast
   1.653 +qed
   1.654 +
   1.655 +lemma dependent_explicit:
   1.656 +  "dependent P \<longleftrightarrow> (\<exists>S u. finite S \<and> S \<subseteq> P \<and> (\<exists>v\<in>S. u v \<noteq> 0 \<and> setsum (\<lambda>v. u v *\<^sub>R v) S = 0))"
   1.657 +  (is "?lhs = ?rhs")
   1.658 +proof -
   1.659 +  {
   1.660 +    assume dP: "dependent P"
   1.661 +    then obtain a S u where aP: "a \<in> P" and fS: "finite S"
   1.662 +      and SP: "S \<subseteq> P - {a}" and ua: "setsum (\<lambda>v. u v *\<^sub>R v) S = a"
   1.663 +      unfolding dependent_def span_explicit by blast
   1.664 +    let ?S = "insert a S"
   1.665 +    let ?u = "\<lambda>y. if y = a then - 1 else u y"
   1.666 +    let ?v = a
   1.667 +    from aP SP have aS: "a \<notin> S"
   1.668 +      by blast
   1.669 +    from fS SP aP have th0: "finite ?S" "?S \<subseteq> P" "?v \<in> ?S" "?u ?v \<noteq> 0"
   1.670 +      by auto
   1.671 +    have s0: "setsum (\<lambda>v. ?u v *\<^sub>R v) ?S = 0"
   1.672 +      using fS aS
   1.673 +      apply simp
   1.674 +      apply (subst (2) ua[symmetric])
   1.675 +      apply (rule setsum.cong)
   1.676 +      apply auto
   1.677 +      done
   1.678 +    with th0 have ?rhs by fast
   1.679 +  }
   1.680 +  moreover
   1.681 +  {
   1.682 +    fix S u v
   1.683 +    assume fS: "finite S"
   1.684 +      and SP: "S \<subseteq> P"
   1.685 +      and vS: "v \<in> S"
   1.686 +      and uv: "u v \<noteq> 0"
   1.687 +      and u: "setsum (\<lambda>v. u v *\<^sub>R v) S = 0"
   1.688 +    let ?a = v
   1.689 +    let ?S = "S - {v}"
   1.690 +    let ?u = "\<lambda>i. (- u i) / u v"
   1.691 +    have th0: "?a \<in> P" "finite ?S" "?S \<subseteq> P"
   1.692 +      using fS SP vS by auto
   1.693 +    have "setsum (\<lambda>v. ?u v *\<^sub>R v) ?S =
   1.694 +      setsum (\<lambda>v. (- (inverse (u ?a))) *\<^sub>R (u v *\<^sub>R v)) S - ?u v *\<^sub>R v"
   1.695 +      using fS vS uv by (simp add: setsum_diff1 field_simps)
   1.696 +    also have "\<dots> = ?a"
   1.697 +      unfolding scaleR_right.setsum [symmetric] u using uv by simp
   1.698 +    finally have "setsum (\<lambda>v. ?u v *\<^sub>R v) ?S = ?a" .
   1.699 +    with th0 have ?lhs
   1.700 +      unfolding dependent_def span_explicit
   1.701 +      apply -
   1.702 +      apply (rule bexI[where x= "?a"])
   1.703 +      apply (simp_all del: scaleR_minus_left)
   1.704 +      apply (rule exI[where x= "?S"])
   1.705 +      apply (auto simp del: scaleR_minus_left)
   1.706 +      done
   1.707 +  }
   1.708 +  ultimately show ?thesis by blast
   1.709 +qed
   1.710 +
   1.711 +lemma dependent_finite:
   1.712 +  assumes "finite S"
   1.713 +    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)"
   1.714 +           (is "?lhs = ?rhs")
   1.715 +proof
   1.716 +  assume ?lhs
   1.717 +  then obtain T u v
   1.718 +         where "finite T" "T \<subseteq> S" "v\<in>T" "u v \<noteq> 0" "(\<Sum>v\<in>T. u v *\<^sub>R v) = 0"
   1.719 +    by (force simp: dependent_explicit)
   1.720 +  with assms show ?rhs
   1.721 +    apply (rule_tac x="\<lambda>v. if v \<in> T then u v else 0" in exI)
   1.722 +    apply (auto simp: setsum.mono_neutral_right)
   1.723 +    done
   1.724 +next
   1.725 +  assume ?rhs  with assms show ?lhs
   1.726 +    by (fastforce simp add: dependent_explicit)
   1.727 +qed
   1.728 +
   1.729 +lemma span_alt:
   1.730 +  "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}}"
   1.731 +  unfolding span_explicit
   1.732 +  apply safe
   1.733 +  subgoal for x S u
   1.734 +    by (intro exI[of _ "\<lambda>x. if x \<in> S then u x else 0"])
   1.735 +        (auto intro!: setsum.mono_neutral_cong_right)
   1.736 +  apply auto
   1.737 +  done
   1.738 +
   1.739 +lemma dependent_alt:
   1.740 +  "dependent B \<longleftrightarrow>
   1.741 +    (\<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))"
   1.742 +  unfolding dependent_explicit
   1.743 +  apply safe
   1.744 +  subgoal for S u v
   1.745 +    apply (intro exI[of _ "\<lambda>x. if x \<in> S then u x else 0"])
   1.746 +    apply (subst setsum.mono_neutral_cong_left[where T=S])
   1.747 +    apply (auto intro!: setsum.mono_neutral_cong_right cong: rev_conj_cong)
   1.748 +    done
   1.749 +  apply auto
   1.750 +  done
   1.751 +
   1.752 +lemma independent_alt:
   1.753 +  "independent B \<longleftrightarrow>
   1.754 +    (\<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))"
   1.755 +  unfolding dependent_alt by auto
   1.756 +
   1.757 +lemma independentD_alt:
   1.758 +  "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"
   1.759 +  unfolding independent_alt by blast
   1.760 +
   1.761 +lemma independentD_unique:
   1.762 +  assumes B: "independent B"
   1.763 +    and X: "finite {x. X x \<noteq> 0}" "{x. X x \<noteq> 0} \<subseteq> B"
   1.764 +    and Y: "finite {x. Y x \<noteq> 0}" "{x. Y x \<noteq> 0} \<subseteq> B"
   1.765 +    and "(\<Sum>x | X x \<noteq> 0. X x *\<^sub>R x) = (\<Sum>x| Y x \<noteq> 0. Y x *\<^sub>R x)"
   1.766 +  shows "X = Y"
   1.767 +proof -
   1.768 +  have "X x - Y x = 0" for x
   1.769 +    using B
   1.770 +  proof (rule independentD_alt)
   1.771 +    have "{x. X x - Y x \<noteq> 0} \<subseteq> {x. X x \<noteq> 0} \<union> {x. Y x \<noteq> 0}"
   1.772 +      by auto
   1.773 +    then show "finite {x. X x - Y x \<noteq> 0}" "{x. X x - Y x \<noteq> 0} \<subseteq> B"
   1.774 +      using X Y by (auto dest: finite_subset)
   1.775 +    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)"
   1.776 +      using X Y by (intro setsum.mono_neutral_cong_left) auto
   1.777 +    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)"
   1.778 +      by (simp add: scaleR_diff_left setsum_subtractf assms)
   1.779 +    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)"
   1.780 +      using X Y by (intro setsum.mono_neutral_cong_right) auto
   1.781 +    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)"
   1.782 +      using X Y by (intro setsum.mono_neutral_cong_right) auto
   1.783 +    finally show "(\<Sum>x | X x - Y x \<noteq> 0. (X x - Y x) *\<^sub>R x) = 0"
   1.784 +      using assms by simp
   1.785 +  qed
   1.786 +  then show ?thesis
   1.787 +    by auto
   1.788 +qed
   1.789 +
   1.790 +text \<open>This is useful for building a basis step-by-step.\<close>
   1.791 +
   1.792 +lemma independent_insert:
   1.793 +  "independent (insert a S) \<longleftrightarrow>
   1.794 +    (if a \<in> S then independent S else independent S \<and> a \<notin> span S)"
   1.795 +  (is "?lhs \<longleftrightarrow> ?rhs")
   1.796 +proof (cases "a \<in> S")
   1.797 +  case True
   1.798 +  then show ?thesis
   1.799 +    using insert_absorb[OF True] by simp
   1.800 +next
   1.801 +  case False
   1.802 +  show ?thesis
   1.803 +  proof
   1.804 +    assume i: ?lhs
   1.805 +    then show ?rhs
   1.806 +      using False
   1.807 +      apply simp
   1.808 +      apply (rule conjI)
   1.809 +      apply (rule independent_mono)
   1.810 +      apply assumption
   1.811 +      apply blast
   1.812 +      apply (simp add: dependent_def)
   1.813 +      done
   1.814 +  next
   1.815 +    assume i: ?rhs
   1.816 +    show ?lhs
   1.817 +      using i False
   1.818 +      apply (auto simp add: dependent_def)
   1.819 +      by (metis in_span_insert insert_Diff_if insert_Diff_single insert_absorb)
   1.820 +  qed
   1.821 +qed
   1.822 +
   1.823 +lemma independent_Union_directed:
   1.824 +  assumes directed: "\<And>c d. c \<in> C \<Longrightarrow> d \<in> C \<Longrightarrow> c \<subseteq> d \<or> d \<subseteq> c"
   1.825 +  assumes indep: "\<And>c. c \<in> C \<Longrightarrow> independent c"
   1.826 +  shows "independent (\<Union>C)"
   1.827 +proof
   1.828 +  assume "dependent (\<Union>C)"
   1.829 +  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"
   1.830 +    by (auto simp: dependent_explicit)
   1.831 +
   1.832 +  have "S \<noteq> {}"
   1.833 +    using \<open>v \<in> S\<close> by auto
   1.834 +  have "\<exists>c\<in>C. S \<subseteq> c"
   1.835 +    using \<open>finite S\<close> \<open>S \<noteq> {}\<close> \<open>S \<subseteq> \<Union>C\<close>
   1.836 +  proof (induction rule: finite_ne_induct)
   1.837 +    case (insert i I)
   1.838 +    then obtain c d where cd: "c \<in> C" "d \<in> C" and iI: "I \<subseteq> c" "i \<in> d"
   1.839 +      by blast
   1.840 +    from directed[OF cd] cd have "c \<union> d \<in> C"
   1.841 +      by (auto simp: sup.absorb1 sup.absorb2)
   1.842 +    with iI show ?case
   1.843 +      by (intro bexI[of _ "c \<union> d"]) auto
   1.844 +  qed auto
   1.845 +  then obtain c where "c \<in> C" "S \<subseteq> c"
   1.846 +    by auto
   1.847 +  have "dependent c"
   1.848 +    unfolding dependent_explicit
   1.849 +    by (intro exI[of _ S] exI[of _ u] bexI[of _ v] conjI) fact+
   1.850 +  with indep[OF \<open>c \<in> C\<close>] show False
   1.851 +    by auto
   1.852 +qed
   1.853 +
   1.854 +text \<open>Hence we can create a maximal independent subset.\<close>
   1.855 +
   1.856 +lemma maximal_independent_subset_extend:
   1.857 +  assumes "S \<subseteq> V" "independent S"
   1.858 +  shows "\<exists>B. S \<subseteq> B \<and> B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B"
   1.859 +proof -
   1.860 +  let ?C = "{B. S \<subseteq> B \<and> independent B \<and> B \<subseteq> V}"
   1.861 +  have "\<exists>M\<in>?C. \<forall>X\<in>?C. M \<subseteq> X \<longrightarrow> X = M"
   1.862 +  proof (rule subset_Zorn)
   1.863 +    fix C :: "'a set set" assume "subset.chain ?C C"
   1.864 +    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"
   1.865 +      "\<And>c d. c \<in> C \<Longrightarrow> d \<in> C \<Longrightarrow> c \<subseteq> d \<or> d \<subseteq> c"
   1.866 +      unfolding subset.chain_def by blast+
   1.867 +
   1.868 +    show "\<exists>U\<in>?C. \<forall>X\<in>C. X \<subseteq> U"
   1.869 +    proof cases
   1.870 +      assume "C = {}" with assms show ?thesis
   1.871 +        by (auto intro!: exI[of _ S])
   1.872 +    next
   1.873 +      assume "C \<noteq> {}"
   1.874 +      with C(2) have "S \<subseteq> \<Union>C"
   1.875 +        by auto
   1.876 +      moreover have "independent (\<Union>C)"
   1.877 +        by (intro independent_Union_directed C)
   1.878 +      moreover have "\<Union>C \<subseteq> V"
   1.879 +        using C by auto
   1.880 +      ultimately show ?thesis
   1.881 +        by auto
   1.882 +    qed
   1.883 +  qed
   1.884 +  then obtain B where B: "independent B" "B \<subseteq> V" "S \<subseteq> B"
   1.885 +    and max: "\<And>S. independent S \<Longrightarrow> S \<subseteq> V \<Longrightarrow> B \<subseteq> S \<Longrightarrow> S = B"
   1.886 +    by auto
   1.887 +  moreover
   1.888 +  { assume "\<not> V \<subseteq> span B"
   1.889 +    then obtain v where "v \<in> V" "v \<notin> span B"
   1.890 +      by auto
   1.891 +    with B have "independent (insert v B)"
   1.892 +      unfolding independent_insert by auto
   1.893 +    from max[OF this] \<open>v \<in> V\<close> \<open>B \<subseteq> V\<close>
   1.894 +    have "v \<in> B"
   1.895 +      by auto
   1.896 +    with \<open>v \<notin> span B\<close> have False
   1.897 +      by (auto intro: span_superset) }
   1.898 +  ultimately show ?thesis
   1.899 +    by (auto intro!: exI[of _ B])
   1.900 +qed
   1.901 +
   1.902 +
   1.903 +lemma maximal_independent_subset:
   1.904 +  "\<exists>B. B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B"
   1.905 +  by (metis maximal_independent_subset_extend[of "{}"] empty_subsetI independent_empty)
   1.906 +
   1.907 +lemma span_finite:
   1.908 +  assumes fS: "finite S"
   1.909 +  shows "span S = {y. \<exists>u. setsum (\<lambda>v. u v *\<^sub>R v) S = y}"
   1.910 +  (is "_ = ?rhs")
   1.911 +proof -
   1.912 +  {
   1.913 +    fix y
   1.914 +    assume y: "y \<in> span S"
   1.915 +    from y obtain S' u where fS': "finite S'"
   1.916 +      and SS': "S' \<subseteq> S"
   1.917 +      and u: "setsum (\<lambda>v. u v *\<^sub>R v) S' = y"
   1.918 +      unfolding span_explicit by blast
   1.919 +    let ?u = "\<lambda>x. if x \<in> S' then u x else 0"
   1.920 +    have "setsum (\<lambda>v. ?u v *\<^sub>R v) S = setsum (\<lambda>v. u v *\<^sub>R v) S'"
   1.921 +      using SS' fS by (auto intro!: setsum.mono_neutral_cong_right)
   1.922 +    then have "setsum (\<lambda>v. ?u v *\<^sub>R v) S = y" by (metis u)
   1.923 +    then have "y \<in> ?rhs" by auto
   1.924 +  }
   1.925 +  moreover
   1.926 +  {
   1.927 +    fix y u
   1.928 +    assume u: "setsum (\<lambda>v. u v *\<^sub>R v) S = y"
   1.929 +    then have "y \<in> span S" using fS unfolding span_explicit by auto
   1.930 +  }
   1.931 +  ultimately show ?thesis by blast
   1.932 +qed
   1.933 +
   1.934 +lemma linear_independent_extend_subspace:
   1.935 +  assumes "independent B"
   1.936 +  shows "\<exists>g. linear g \<and> (\<forall>x\<in>B. g x = f x) \<and> range g = span (f`B)"
   1.937 +proof -
   1.938 +  from maximal_independent_subset_extend[OF _ \<open>independent B\<close>, of UNIV]
   1.939 +  obtain B' where "B \<subseteq> B'" "independent B'" "span B' = UNIV"
   1.940 +    by (auto simp: top_unique)
   1.941 +  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)"
   1.942 +    using \<open>span B' = UNIV\<close> unfolding span_alt by auto
   1.943 +  then obtain X where X: "\<And>y. {x. X y x \<noteq> 0} \<subseteq> B'" "\<And>y. finite {x. X y x \<noteq> 0}"
   1.944 +    "\<And>y. y = (\<Sum>x|X y x \<noteq> 0. X y x *\<^sub>R x)"
   1.945 +    unfolding choice_iff by auto
   1.946 +
   1.947 +  have X_add: "X (x + y) = (\<lambda>z. X x z + X y z)" for x y
   1.948 +    using \<open>independent B'\<close>
   1.949 +  proof (rule independentD_unique)
   1.950 +    have "(\<Sum>z | X x z + X y z \<noteq> 0. (X x z + X y z) *\<^sub>R z)
   1.951 +      = (\<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)"
   1.952 +      by (intro setsum.mono_neutral_cong_left) (auto intro: X)
   1.953 +    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)"
   1.954 +      by (auto simp add: scaleR_add_left setsum.distrib
   1.955 +               intro!: arg_cong2[where f="op +"]  setsum.mono_neutral_cong_right X)
   1.956 +    also have "\<dots> = x + y"
   1.957 +      by (simp add: X(3)[symmetric])
   1.958 +    also have "\<dots> = (\<Sum>z | X (x + y) z \<noteq> 0. X (x + y) z *\<^sub>R z)"
   1.959 +      by (rule X(3))
   1.960 +    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)"
   1.961 +      ..
   1.962 +    have "{z. X x z + X y z \<noteq> 0} \<subseteq> {z. X x z \<noteq> 0} \<union> {z. X y z \<noteq> 0}"
   1.963 +      by auto
   1.964 +    then show "finite {z. X x z + X y z \<noteq> 0}" "{xa. X x xa + X y xa \<noteq> 0} \<subseteq> B'"
   1.965 +        "finite {xa. X (x + y) xa \<noteq> 0}" "{xa. X (x + y) xa \<noteq> 0} \<subseteq> B'"
   1.966 +      using X(1) by (auto dest: finite_subset intro: X)
   1.967 +  qed
   1.968 +
   1.969 +  have X_cmult: "X (c *\<^sub>R x) = (\<lambda>z. c * X x z)" for x c
   1.970 +    using \<open>independent B'\<close>
   1.971 +  proof (rule independentD_unique)
   1.972 +    show "finite {z. X (c *\<^sub>R x) z \<noteq> 0}" "{z. X (c *\<^sub>R x) z \<noteq> 0} \<subseteq> B'"
   1.973 +      "finite {z. c * X x z \<noteq> 0}" "{z. c * X x z \<noteq> 0} \<subseteq> B' "
   1.974 +      using X(1,2) by auto
   1.975 +    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)"
   1.976 +      unfolding scaleR_scaleR[symmetric] scaleR_setsum_right[symmetric]
   1.977 +      by (cases "c = 0") (auto simp: X(3)[symmetric])
   1.978 +  qed
   1.979 +
   1.980 +  have X_B': "x \<in> B' \<Longrightarrow> X x = (\<lambda>z. if z = x then 1 else 0)" for x
   1.981 +    using \<open>independent B'\<close>
   1.982 +    by (rule independentD_unique[OF _ X(2) X(1)]) (auto intro: X simp: X(3)[symmetric])
   1.983 +
   1.984 +  define f' where "f' y = (if y \<in> B then f y else 0)" for y
   1.985 +  define g where "g y = (\<Sum>x|X y x \<noteq> 0. X y x *\<^sub>R f' x)" for y
   1.986 +
   1.987 +  have g_f': "x \<in> B' \<Longrightarrow> g x = f' x" for x
   1.988 +    by (auto simp: g_def X_B')
   1.989 +
   1.990 +  have "linear g"
   1.991 +  proof
   1.992 +    fix x y
   1.993 +    have *: "(\<Sum>z | X x z + X y z \<noteq> 0. (X x z + X y z) *\<^sub>R f' z)
   1.994 +      = (\<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)"
   1.995 +      by (intro setsum.mono_neutral_cong_left) (auto intro: X)
   1.996 +    show "g (x + y) = g x + g y"
   1.997 +      unfolding g_def X_add *
   1.998 +      by (auto simp add: scaleR_add_left setsum.distrib
   1.999 +               intro!: arg_cong2[where f="op +"]  setsum.mono_neutral_cong_right X)
  1.1000 +  next
  1.1001 +    show "g (r *\<^sub>R x) = r *\<^sub>R g x" for r x
  1.1002 +      by (auto simp add: g_def X_cmult scaleR_setsum_right intro!: setsum.mono_neutral_cong_left X)
  1.1003 +  qed
  1.1004 +  moreover have "\<forall>x\<in>B. g x = f x"
  1.1005 +    using \<open>B \<subseteq> B'\<close> by (auto simp: g_f' f'_def)
  1.1006 +  moreover have "range g = span (f`B)"
  1.1007 +    unfolding \<open>span B' = UNIV\<close>[symmetric] span_linear_image[OF \<open>linear g\<close>, symmetric]
  1.1008 +  proof (rule span_subspace)
  1.1009 +    have "g ` B' \<subseteq> f`B \<union> {0}"
  1.1010 +      by (auto simp: g_f' f'_def)
  1.1011 +    also have "\<dots> \<subseteq> span (f`B)"
  1.1012 +      by (auto intro: span_superset span_0)
  1.1013 +    finally show "g ` B' \<subseteq> span (f`B)"
  1.1014 +      by auto
  1.1015 +    have "x \<in> B \<Longrightarrow> f x = g x" for x
  1.1016 +      using \<open>B \<subseteq> B'\<close> by (auto simp add: g_f' f'_def)
  1.1017 +    then show "span (f ` B) \<subseteq> span (g ` B')"
  1.1018 +      using \<open>B \<subseteq> B'\<close> by (intro span_mono) auto
  1.1019 +  qed (rule subspace_span)
  1.1020 +  ultimately show ?thesis
  1.1021 +    by auto
  1.1022 +qed
  1.1023 +
  1.1024 +lemma linear_independent_extend:
  1.1025 +  "independent B \<Longrightarrow> \<exists>g. linear g \<and> (\<forall>x\<in>B. g x = f x)"
  1.1026 +  using linear_independent_extend_subspace[of B f] by auto
  1.1027 +
  1.1028 +text \<open>Linear functions are equal on a subspace if they are on a spanning set.\<close>
  1.1029 +
  1.1030 +lemma subspace_kernel:
  1.1031 +  assumes lf: "linear f"
  1.1032 +  shows "subspace {x. f x = 0}"
  1.1033 +  apply (simp add: subspace_def)
  1.1034 +  apply (simp add: linear_add[OF lf] linear_cmul[OF lf] linear_0[OF lf])
  1.1035 +  done
  1.1036 +
  1.1037 +lemma linear_eq_0_span:
  1.1038 +  assumes lf: "linear f" and f0: "\<forall>x\<in>B. f x = 0"
  1.1039 +  shows "\<forall>x \<in> span B. f x = 0"
  1.1040 +  using f0 subspace_kernel[OF lf]
  1.1041 +  by (rule span_induct')
  1.1042 +
  1.1043 +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"
  1.1044 +  using linear_eq_0_span[of f B] by auto
  1.1045 +
  1.1046 +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"
  1.1047 +  using linear_eq_0_span[of "\<lambda>x. f x - g x" B] by (auto simp: linear_compose_sub)
  1.1048 +
  1.1049 +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"
  1.1050 +  using linear_eq_span[of f g B] by auto
  1.1051 +
  1.1052 +text \<open>The degenerate case of the Exchange Lemma.\<close>
  1.1053 +
  1.1054 +lemma spanning_subset_independent:
  1.1055 +  assumes BA: "B \<subseteq> A"
  1.1056 +    and iA: "independent A"
  1.1057 +    and AsB: "A \<subseteq> span B"
  1.1058 +  shows "A = B"
  1.1059 +proof
  1.1060 +  show "B \<subseteq> A" by (rule BA)
  1.1061 +
  1.1062 +  from span_mono[OF BA] span_mono[OF AsB]
  1.1063 +  have sAB: "span A = span B" unfolding span_span by blast
  1.1064 +
  1.1065 +  {
  1.1066 +    fix x
  1.1067 +    assume x: "x \<in> A"
  1.1068 +    from iA have th0: "x \<notin> span (A - {x})"
  1.1069 +      unfolding dependent_def using x by blast
  1.1070 +    from x have xsA: "x \<in> span A"
  1.1071 +      by (blast intro: span_superset)
  1.1072 +    have "A - {x} \<subseteq> A" by blast
  1.1073 +    then have th1: "span (A - {x}) \<subseteq> span A"
  1.1074 +      by (metis span_mono)
  1.1075 +    {
  1.1076 +      assume xB: "x \<notin> B"
  1.1077 +      from xB BA have "B \<subseteq> A - {x}"
  1.1078 +        by blast
  1.1079 +      then have "span B \<subseteq> span (A - {x})"
  1.1080 +        by (metis span_mono)
  1.1081 +      with th1 th0 sAB have "x \<notin> span A"
  1.1082 +        by blast
  1.1083 +      with x have False
  1.1084 +        by (metis span_superset)
  1.1085 +    }
  1.1086 +    then have "x \<in> B" by blast
  1.1087 +  }
  1.1088 +  then show "A \<subseteq> B" by blast
  1.1089 +qed
  1.1090 +
  1.1091 +text \<open>Relation between bases and injectivity/surjectivity of map.\<close>
  1.1092 +
  1.1093 +lemma spanning_surjective_image:
  1.1094 +  assumes us: "UNIV \<subseteq> span S"
  1.1095 +    and lf: "linear f"
  1.1096 +    and sf: "surj f"
  1.1097 +  shows "UNIV \<subseteq> span (f ` S)"
  1.1098 +proof -
  1.1099 +  have "UNIV \<subseteq> f ` UNIV"
  1.1100 +    using sf by (auto simp add: surj_def)
  1.1101 +  also have " \<dots> \<subseteq> span (f ` S)"
  1.1102 +    using spans_image[OF lf us] .
  1.1103 +  finally show ?thesis .
  1.1104 +qed
  1.1105 +
  1.1106 +lemma independent_inj_on_image:
  1.1107 +  assumes iS: "independent S"
  1.1108 +    and lf: "linear f"
  1.1109 +    and fi: "inj_on f (span S)"
  1.1110 +  shows "independent (f ` S)"
  1.1111 +proof -
  1.1112 +  {
  1.1113 +    fix a
  1.1114 +    assume a: "a \<in> S" "f a \<in> span (f ` S - {f a})"
  1.1115 +    have eq: "f ` S - {f a} = f ` (S - {a})"
  1.1116 +      using fi \<open>a\<in>S\<close> by (auto simp add: inj_on_def span_superset)
  1.1117 +    from a have "f a \<in> f ` span (S - {a})"
  1.1118 +      unfolding eq span_linear_image[OF lf, of "S - {a}"] by blast
  1.1119 +    then have "a \<in> span (S - {a})"
  1.1120 +      by (rule inj_on_image_mem_iff_alt[OF fi, rotated])
  1.1121 +         (insert span_mono[of "S - {a}" S], auto intro: span_superset \<open>a\<in>S\<close>)
  1.1122 +    with a(1) iS have False
  1.1123 +      by (simp add: dependent_def)
  1.1124 +  }
  1.1125 +  then show ?thesis
  1.1126 +    unfolding dependent_def by blast
  1.1127 +qed
  1.1128 +
  1.1129 +lemma independent_injective_image:
  1.1130 +  "independent S \<Longrightarrow> linear f \<Longrightarrow> inj f \<Longrightarrow> independent (f ` S)"
  1.1131 +  using independent_inj_on_image[of S f] by (auto simp: subset_inj_on)
  1.1132 +
  1.1133 +text \<open>Detailed theorems about left and right invertibility in general case.\<close>
  1.1134 +
  1.1135 +lemma linear_inj_on_left_inverse:
  1.1136 +  assumes lf: "linear f" and fi: "inj_on f (span S)"
  1.1137 +  shows "\<exists>g. range g \<subseteq> span S \<and> linear g \<and> (\<forall>x\<in>span S. g (f x) = x)"
  1.1138 +proof -
  1.1139 +  obtain B where "independent B" "B \<subseteq> S" "S \<subseteq> span B"
  1.1140 +    using maximal_independent_subset[of S] by auto
  1.1141 +  then have "span S = span B"
  1.1142 +    unfolding span_eq by (auto simp: span_superset)
  1.1143 +  with linear_independent_extend_subspace[OF independent_inj_on_image, OF \<open>independent B\<close> lf] fi
  1.1144 +  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)"
  1.1145 +    by fastforce
  1.1146 +  have fB: "inj_on f B"
  1.1147 +    using fi by (auto simp: \<open>span S = span B\<close> intro: subset_inj_on span_superset)
  1.1148 +
  1.1149 +  have "\<forall>x\<in>span B. g (f x) = x"
  1.1150 +  proof (intro linear_eq_span)
  1.1151 +    show "linear (\<lambda>x. x)" "linear (\<lambda>x. g (f x))"
  1.1152 +      using linear_id linear_compose[OF \<open>linear f\<close> \<open>linear g\<close>] by (auto simp: id_def comp_def)
  1.1153 +    show "\<forall>x \<in> B. g (f x) = x"
  1.1154 +      using g fi \<open>span S = span B\<close> by (auto simp: fB)
  1.1155 +  qed
  1.1156 +  moreover
  1.1157 +  have "inv_into B f ` f ` B \<subseteq> B"
  1.1158 +    by (auto simp: fB)
  1.1159 +  then have "range g \<subseteq> span S"
  1.1160 +    unfolding g \<open>span S = span B\<close> by (intro span_mono)
  1.1161 +  ultimately show ?thesis
  1.1162 +    using \<open>span S = span B\<close> \<open>linear g\<close> by auto
  1.1163 +qed
  1.1164 +
  1.1165 +lemma linear_injective_left_inverse: "linear f \<Longrightarrow> inj f \<Longrightarrow> \<exists>g. linear g \<and> g \<circ> f = id"
  1.1166 +  using linear_inj_on_left_inverse[of f UNIV] by (auto simp: fun_eq_iff span_UNIV)
  1.1167 +
  1.1168 +lemma linear_surj_right_inverse:
  1.1169 +  assumes lf: "linear f" and sf: "span T \<subseteq> f`span S"
  1.1170 +  shows "\<exists>g. range g \<subseteq> span S \<and> linear g \<and> (\<forall>x\<in>span T. f (g x) = x)"
  1.1171 +proof -
  1.1172 +  obtain B where "independent B" "B \<subseteq> T" "T \<subseteq> span B"
  1.1173 +    using maximal_independent_subset[of T] by auto
  1.1174 +  then have "span T = span B"
  1.1175 +    unfolding span_eq by (auto simp: span_superset)
  1.1176 +
  1.1177 +  from linear_independent_extend_subspace[OF \<open>independent B\<close>, of "inv_into (span S) f"]
  1.1178 +  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)"
  1.1179 +    by auto
  1.1180 +  moreover have "x \<in> B \<Longrightarrow> f (inv_into (span S) f x) = x" for x
  1.1181 +    using \<open>B \<subseteq> T\<close> \<open>span T \<subseteq> f`span S\<close> by (intro f_inv_into_f) (auto intro: span_superset)
  1.1182 +  ultimately have "\<forall>x\<in>B. f (g x) = x"
  1.1183 +    by auto
  1.1184 +  then have "\<forall>x\<in>span B. f (g x) = x"
  1.1185 +    using linear_id linear_compose[OF \<open>linear g\<close> \<open>linear f\<close>]
  1.1186 +    by (intro linear_eq_span) (auto simp: id_def comp_def)
  1.1187 +  moreover have "inv_into (span S) f ` B \<subseteq> span S"
  1.1188 +    using \<open>B \<subseteq> T\<close> \<open>span T \<subseteq> f`span S\<close> by (auto intro: inv_into_into span_superset)
  1.1189 +  then have "range g \<subseteq> span S"
  1.1190 +    unfolding g by (intro span_minimal subspace_span) auto
  1.1191 +  ultimately show ?thesis
  1.1192 +    using \<open>linear g\<close> \<open>span T = span B\<close> by auto
  1.1193 +qed
  1.1194 +
  1.1195 +lemma linear_surjective_right_inverse: "linear f \<Longrightarrow> surj f \<Longrightarrow> \<exists>g. linear g \<and> f \<circ> g = id"
  1.1196 +  using linear_surj_right_inverse[of f UNIV UNIV]
  1.1197 +  by (auto simp: span_UNIV fun_eq_iff)
  1.1198 +
  1.1199 +text \<open>The general case of the Exchange Lemma, the key to what follows.\<close>
  1.1200 +
  1.1201 +lemma exchange_lemma:
  1.1202 +  assumes f:"finite t"
  1.1203 +    and i: "independent s"
  1.1204 +    and sp: "s \<subseteq> span t"
  1.1205 +  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'"
  1.1206 +  using f i sp
  1.1207 +proof (induct "card (t - s)" arbitrary: s t rule: less_induct)
  1.1208 +  case less
  1.1209 +  note ft = \<open>finite t\<close> and s = \<open>independent s\<close> and sp = \<open>s \<subseteq> span t\<close>
  1.1210 +  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'"
  1.1211 +  let ?ths = "\<exists>t'. ?P t'"
  1.1212 +  {
  1.1213 +    assume "s \<subseteq> t"
  1.1214 +    then have ?ths
  1.1215 +      by (metis ft Un_commute sp sup_ge1)
  1.1216 +  }
  1.1217 +  moreover
  1.1218 +  {
  1.1219 +    assume st: "t \<subseteq> s"
  1.1220 +    from spanning_subset_independent[OF st s sp] st ft span_mono[OF st]
  1.1221 +    have ?ths
  1.1222 +      by (metis Un_absorb sp)
  1.1223 +  }
  1.1224 +  moreover
  1.1225 +  {
  1.1226 +    assume st: "\<not> s \<subseteq> t" "\<not> t \<subseteq> s"
  1.1227 +    from st(2) obtain b where b: "b \<in> t" "b \<notin> s"
  1.1228 +      by blast
  1.1229 +    from b have "t - {b} - s \<subset> t - s"
  1.1230 +      by blast
  1.1231 +    then have cardlt: "card (t - {b} - s) < card (t - s)"
  1.1232 +      using ft by (auto intro: psubset_card_mono)
  1.1233 +    from b ft have ct0: "card t \<noteq> 0"
  1.1234 +      by auto
  1.1235 +    have ?ths
  1.1236 +    proof cases
  1.1237 +      assume stb: "s \<subseteq> span (t - {b})"
  1.1238 +      from ft have ftb: "finite (t - {b})"
  1.1239 +        by auto
  1.1240 +      from less(1)[OF cardlt ftb s stb]
  1.1241 +      obtain u where u: "card u = card (t - {b})" "s \<subseteq> u" "u \<subseteq> s \<union> (t - {b})" "s \<subseteq> span u"
  1.1242 +        and fu: "finite u" by blast
  1.1243 +      let ?w = "insert b u"
  1.1244 +      have th0: "s \<subseteq> insert b u"
  1.1245 +        using u by blast
  1.1246 +      from u(3) b have "u \<subseteq> s \<union> t"
  1.1247 +        by blast
  1.1248 +      then have th1: "insert b u \<subseteq> s \<union> t"
  1.1249 +        using u b by blast
  1.1250 +      have bu: "b \<notin> u"
  1.1251 +        using b u by blast
  1.1252 +      from u(1) ft b have "card u = (card t - 1)"
  1.1253 +        by auto
  1.1254 +      then have th2: "card (insert b u) = card t"
  1.1255 +        using card_insert_disjoint[OF fu bu] ct0 by auto
  1.1256 +      from u(4) have "s \<subseteq> span u" .
  1.1257 +      also have "\<dots> \<subseteq> span (insert b u)"
  1.1258 +        by (rule span_mono) blast
  1.1259 +      finally have th3: "s \<subseteq> span (insert b u)" .
  1.1260 +      from th0 th1 th2 th3 fu have th: "?P ?w"
  1.1261 +        by blast
  1.1262 +      from th show ?thesis by blast
  1.1263 +    next
  1.1264 +      assume stb: "\<not> s \<subseteq> span (t - {b})"
  1.1265 +      from stb obtain a where a: "a \<in> s" "a \<notin> span (t - {b})"
  1.1266 +        by blast
  1.1267 +      have ab: "a \<noteq> b"
  1.1268 +        using a b by blast
  1.1269 +      have at: "a \<notin> t"
  1.1270 +        using a ab span_superset[of a "t- {b}"] by auto
  1.1271 +      have mlt: "card ((insert a (t - {b})) - s) < card (t - s)"
  1.1272 +        using cardlt ft a b by auto
  1.1273 +      have ft': "finite (insert a (t - {b}))"
  1.1274 +        using ft by auto
  1.1275 +      {
  1.1276 +        fix x
  1.1277 +        assume xs: "x \<in> s"
  1.1278 +        have t: "t \<subseteq> insert b (insert a (t - {b}))"
  1.1279 +          using b by auto
  1.1280 +        from b(1) have "b \<in> span t"
  1.1281 +          by (simp add: span_superset)
  1.1282 +        have bs: "b \<in> span (insert a (t - {b}))"
  1.1283 +          apply (rule in_span_delete)
  1.1284 +          using a sp unfolding subset_eq
  1.1285 +          apply auto
  1.1286 +          done
  1.1287 +        from xs sp have "x \<in> span t"
  1.1288 +          by blast
  1.1289 +        with span_mono[OF t] have x: "x \<in> span (insert b (insert a (t - {b})))" ..
  1.1290 +        from span_trans[OF bs x] have "x \<in> span (insert a (t - {b}))" .
  1.1291 +      }
  1.1292 +      then have sp': "s \<subseteq> span (insert a (t - {b}))"
  1.1293 +        by blast
  1.1294 +      from less(1)[OF mlt ft' s sp'] obtain u where u:
  1.1295 +        "card u = card (insert a (t - {b}))"
  1.1296 +        "finite u" "s \<subseteq> u" "u \<subseteq> s \<union> insert a (t - {b})"
  1.1297 +        "s \<subseteq> span u" by blast
  1.1298 +      from u a b ft at ct0 have "?P u"
  1.1299 +        by auto
  1.1300 +      then show ?thesis by blast
  1.1301 +    qed
  1.1302 +  }
  1.1303 +  ultimately show ?ths by blast
  1.1304 +qed
  1.1305 +
  1.1306 +text \<open>This implies corresponding size bounds.\<close>
  1.1307 +
  1.1308 +lemma independent_span_bound:
  1.1309 +  assumes f: "finite t"
  1.1310 +    and i: "independent s"
  1.1311 +    and sp: "s \<subseteq> span t"
  1.1312 +  shows "finite s \<and> card s \<le> card t"
  1.1313 +  by (metis exchange_lemma[OF f i sp] finite_subset card_mono)
  1.1314 +
  1.1315 +lemma finite_Atleast_Atmost_nat[simp]: "finite {f x |x. x\<in> (UNIV::'a::finite set)}"
  1.1316 +proof -
  1.1317 +  have eq: "{f x |x. x\<in> UNIV} = f ` UNIV"
  1.1318 +    by auto
  1.1319 +  show ?thesis unfolding eq
  1.1320 +    apply (rule finite_imageI)
  1.1321 +    apply (rule finite)
  1.1322 +    done
  1.1323 +qed
  1.1324 +
  1.1325 +
  1.1326 +subsection \<open>More interesting properties of the norm.\<close>
  1.1327 +
  1.1328 +lemma cond_application_beta: "(if b then f else g) x = (if b then f x else g x)"
  1.1329 +  by auto
  1.1330 +
  1.1331 +notation inner (infix "\<bullet>" 70)
  1.1332 +
  1.1333 +lemma square_bound_lemma:
  1.1334 +  fixes x :: real
  1.1335 +  shows "x < (1 + x) * (1 + x)"
  1.1336 +proof -
  1.1337 +  have "(x + 1/2)\<^sup>2 + 3/4 > 0"
  1.1338 +    using zero_le_power2[of "x+1/2"] by arith
  1.1339 +  then show ?thesis
  1.1340 +    by (simp add: field_simps power2_eq_square)
  1.1341 +qed
  1.1342 +
  1.1343 +lemma square_continuous:
  1.1344 +  fixes e :: real
  1.1345 +  shows "e > 0 \<Longrightarrow> \<exists>d. 0 < d \<and> (\<forall>y. \<bar>y - x\<bar> < d \<longrightarrow> \<bar>y * y - x * x\<bar> < e)"
  1.1346 +  using isCont_power[OF continuous_ident, of x, unfolded isCont_def LIM_eq, rule_format, of e 2]
  1.1347 +  by (force simp add: power2_eq_square)
  1.1348 +
  1.1349 +
  1.1350 +lemma norm_eq_0_dot: "norm x = 0 \<longleftrightarrow> x \<bullet> x = (0::real)"
  1.1351 +  by simp (* TODO: delete *)
  1.1352 +
  1.1353 +lemma norm_triangle_sub:
  1.1354 +  fixes x y :: "'a::real_normed_vector"
  1.1355 +  shows "norm x \<le> norm y + norm (x - y)"
  1.1356 +  using norm_triangle_ineq[of "y" "x - y"] by (simp add: field_simps)
  1.1357 +
  1.1358 +lemma norm_le: "norm x \<le> norm y \<longleftrightarrow> x \<bullet> x \<le> y \<bullet> y"
  1.1359 +  by (simp add: norm_eq_sqrt_inner)
  1.1360 +
  1.1361 +lemma norm_lt: "norm x < norm y \<longleftrightarrow> x \<bullet> x < y \<bullet> y"
  1.1362 +  by (simp add: norm_eq_sqrt_inner)
  1.1363 +
  1.1364 +lemma norm_eq: "norm x = norm y \<longleftrightarrow> x \<bullet> x = y \<bullet> y"
  1.1365 +  apply (subst order_eq_iff)
  1.1366 +  apply (auto simp: norm_le)
  1.1367 +  done
  1.1368 +
  1.1369 +lemma norm_eq_1: "norm x = 1 \<longleftrightarrow> x \<bullet> x = 1"
  1.1370 +  by (simp add: norm_eq_sqrt_inner)
  1.1371 +
  1.1372 +text\<open>Squaring equations and inequalities involving norms.\<close>
  1.1373 +
  1.1374 +lemma dot_square_norm: "x \<bullet> x = (norm x)\<^sup>2"
  1.1375 +  by (simp only: power2_norm_eq_inner) (* TODO: move? *)
  1.1376 +
  1.1377 +lemma norm_eq_square: "norm x = a \<longleftrightarrow> 0 \<le> a \<and> x \<bullet> x = a\<^sup>2"
  1.1378 +  by (auto simp add: norm_eq_sqrt_inner)
  1.1379 +
  1.1380 +lemma norm_le_square: "norm x \<le> a \<longleftrightarrow> 0 \<le> a \<and> x \<bullet> x \<le> a\<^sup>2"
  1.1381 +  apply (simp add: dot_square_norm abs_le_square_iff[symmetric])
  1.1382 +  using norm_ge_zero[of x]
  1.1383 +  apply arith
  1.1384 +  done
  1.1385 +
  1.1386 +lemma norm_ge_square: "norm x \<ge> a \<longleftrightarrow> a \<le> 0 \<or> x \<bullet> x \<ge> a\<^sup>2"
  1.1387 +  apply (simp add: dot_square_norm abs_le_square_iff[symmetric])
  1.1388 +  using norm_ge_zero[of x]
  1.1389 +  apply arith
  1.1390 +  done
  1.1391 +
  1.1392 +lemma norm_lt_square: "norm x < a \<longleftrightarrow> 0 < a \<and> x \<bullet> x < a\<^sup>2"
  1.1393 +  by (metis not_le norm_ge_square)
  1.1394 +
  1.1395 +lemma norm_gt_square: "norm x > a \<longleftrightarrow> a < 0 \<or> x \<bullet> x > a\<^sup>2"
  1.1396 +  by (metis norm_le_square not_less)
  1.1397 +
  1.1398 +text\<open>Dot product in terms of the norm rather than conversely.\<close>
  1.1399 +
  1.1400 +lemmas inner_simps = inner_add_left inner_add_right inner_diff_right inner_diff_left
  1.1401 +  inner_scaleR_left inner_scaleR_right
  1.1402 +
  1.1403 +lemma dot_norm: "x \<bullet> y = ((norm (x + y))\<^sup>2 - (norm x)\<^sup>2 - (norm y)\<^sup>2) / 2"
  1.1404 +  by (simp only: power2_norm_eq_inner inner_simps inner_commute) auto
  1.1405 +
  1.1406 +lemma dot_norm_neg: "x \<bullet> y = (((norm x)\<^sup>2 + (norm y)\<^sup>2) - (norm (x - y))\<^sup>2) / 2"
  1.1407 +  by (simp only: power2_norm_eq_inner inner_simps inner_commute)
  1.1408 +    (auto simp add: algebra_simps)
  1.1409 +
  1.1410 +text\<open>Equality of vectors in terms of @{term "op \<bullet>"} products.\<close>
  1.1411 +
  1.1412 +lemma linear_componentwise:
  1.1413 +  fixes f:: "'a::euclidean_space \<Rightarrow> 'b::real_inner"
  1.1414 +  assumes lf: "linear f"
  1.1415 +  shows "(f x) \<bullet> j = (\<Sum>i\<in>Basis. (x\<bullet>i) * (f i\<bullet>j))" (is "?lhs = ?rhs")
  1.1416 +proof -
  1.1417 +  have "?rhs = (\<Sum>i\<in>Basis. (x\<bullet>i) *\<^sub>R (f i))\<bullet>j"
  1.1418 +    by (simp add: inner_setsum_left)
  1.1419 +  then show ?thesis
  1.1420 +    unfolding linear_setsum_mul[OF lf, symmetric]
  1.1421 +    unfolding euclidean_representation ..
  1.1422 +qed
  1.1423 +
  1.1424 +lemma vector_eq: "x = y \<longleftrightarrow> x \<bullet> x = x \<bullet> y \<and> y \<bullet> y = x \<bullet> x"
  1.1425 +  (is "?lhs \<longleftrightarrow> ?rhs")
  1.1426 +proof
  1.1427 +  assume ?lhs
  1.1428 +  then show ?rhs by simp
  1.1429 +next
  1.1430 +  assume ?rhs
  1.1431 +  then have "x \<bullet> x - x \<bullet> y = 0 \<and> x \<bullet> y - y \<bullet> y = 0"
  1.1432 +    by simp
  1.1433 +  then have "x \<bullet> (x - y) = 0 \<and> y \<bullet> (x - y) = 0"
  1.1434 +    by (simp add: inner_diff inner_commute)
  1.1435 +  then have "(x - y) \<bullet> (x - y) = 0"
  1.1436 +    by (simp add: field_simps inner_diff inner_commute)
  1.1437 +  then show "x = y" by simp
  1.1438 +qed
  1.1439 +
  1.1440 +lemma norm_triangle_half_r:
  1.1441 +  "norm (y - x1) < e / 2 \<Longrightarrow> norm (y - x2) < e / 2 \<Longrightarrow> norm (x1 - x2) < e"
  1.1442 +  using dist_triangle_half_r unfolding dist_norm[symmetric] by auto
  1.1443 +
  1.1444 +lemma norm_triangle_half_l:
  1.1445 +  assumes "norm (x - y) < e / 2"
  1.1446 +    and "norm (x' - y) < e / 2"
  1.1447 +  shows "norm (x - x') < e"
  1.1448 +  using dist_triangle_half_l[OF assms[unfolded dist_norm[symmetric]]]
  1.1449 +  unfolding dist_norm[symmetric] .
  1.1450 +
  1.1451 +lemma norm_triangle_le: "norm x + norm y \<le> e \<Longrightarrow> norm (x + y) \<le> e"
  1.1452 +  by (rule norm_triangle_ineq [THEN order_trans])
  1.1453 +
  1.1454 +lemma norm_triangle_lt: "norm x + norm y < e \<Longrightarrow> norm (x + y) < e"
  1.1455 +  by (rule norm_triangle_ineq [THEN le_less_trans])
  1.1456 +
  1.1457 +lemma setsum_clauses:
  1.1458 +  shows "setsum f {} = 0"
  1.1459 +    and "finite S \<Longrightarrow> setsum f (insert x S) = (if x \<in> S then setsum f S else f x + setsum f S)"
  1.1460 +  by (auto simp add: insert_absorb)
  1.1461 +
  1.1462 +lemma setsum_norm_le:
  1.1463 +  fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
  1.1464 +  assumes fg: "\<forall>x \<in> S. norm (f x) \<le> g x"
  1.1465 +  shows "norm (setsum f S) \<le> setsum g S"
  1.1466 +  by (rule order_trans [OF norm_setsum setsum_mono]) (simp add: fg)
  1.1467 +
  1.1468 +lemma setsum_norm_bound:
  1.1469 +  fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
  1.1470 +  assumes K: "\<forall>x \<in> S. norm (f x) \<le> K"
  1.1471 +  shows "norm (setsum f S) \<le> of_nat (card S) * K"
  1.1472 +  using setsum_norm_le[OF K] setsum_constant[symmetric]
  1.1473 +  by simp
  1.1474 +
  1.1475 +lemma setsum_group:
  1.1476 +  assumes fS: "finite S" and fT: "finite T" and fST: "f ` S \<subseteq> T"
  1.1477 +  shows "setsum (\<lambda>y. setsum g {x. x \<in> S \<and> f x = y}) T = setsum g S"
  1.1478 +  apply (subst setsum_image_gen[OF fS, of g f])
  1.1479 +  apply (rule setsum.mono_neutral_right[OF fT fST])
  1.1480 +  apply (auto intro: setsum.neutral)
  1.1481 +  done
  1.1482 +
  1.1483 +lemma vector_eq_ldot: "(\<forall>x. x \<bullet> y = x \<bullet> z) \<longleftrightarrow> y = z"
  1.1484 +proof
  1.1485 +  assume "\<forall>x. x \<bullet> y = x \<bullet> z"
  1.1486 +  then have "\<forall>x. x \<bullet> (y - z) = 0"
  1.1487 +    by (simp add: inner_diff)
  1.1488 +  then have "(y - z) \<bullet> (y - z) = 0" ..
  1.1489 +  then show "y = z" by simp
  1.1490 +qed simp
  1.1491 +
  1.1492 +lemma vector_eq_rdot: "(\<forall>z. x \<bullet> z = y \<bullet> z) \<longleftrightarrow> x = y"
  1.1493 +proof
  1.1494 +  assume "\<forall>z. x \<bullet> z = y \<bullet> z"
  1.1495 +  then have "\<forall>z. (x - y) \<bullet> z = 0"
  1.1496 +    by (simp add: inner_diff)
  1.1497 +  then have "(x - y) \<bullet> (x - y) = 0" ..
  1.1498 +  then show "x = y" by simp
  1.1499 +qed simp
  1.1500 +
  1.1501 +
  1.1502 +subsection \<open>Orthogonality.\<close>
  1.1503 +
  1.1504 +context real_inner
  1.1505 +begin
  1.1506 +
  1.1507 +definition "orthogonal x y \<longleftrightarrow> x \<bullet> y = 0"
  1.1508 +
  1.1509 +lemma orthogonal_self: "orthogonal x x \<longleftrightarrow> x = 0"
  1.1510 +  by (simp add: orthogonal_def)
  1.1511 +
  1.1512 +lemma orthogonal_clauses:
  1.1513 +  "orthogonal a 0"
  1.1514 +  "orthogonal a x \<Longrightarrow> orthogonal a (c *\<^sub>R x)"
  1.1515 +  "orthogonal a x \<Longrightarrow> orthogonal a (- x)"
  1.1516 +  "orthogonal a x \<Longrightarrow> orthogonal a y \<Longrightarrow> orthogonal a (x + y)"
  1.1517 +  "orthogonal a x \<Longrightarrow> orthogonal a y \<Longrightarrow> orthogonal a (x - y)"
  1.1518 +  "orthogonal 0 a"
  1.1519 +  "orthogonal x a \<Longrightarrow> orthogonal (c *\<^sub>R x) a"
  1.1520 +  "orthogonal x a \<Longrightarrow> orthogonal (- x) a"
  1.1521 +  "orthogonal x a \<Longrightarrow> orthogonal y a \<Longrightarrow> orthogonal (x + y) a"
  1.1522 +  "orthogonal x a \<Longrightarrow> orthogonal y a \<Longrightarrow> orthogonal (x - y) a"
  1.1523 +  unfolding orthogonal_def inner_add inner_diff by auto
  1.1524 +
  1.1525 +end
  1.1526 +
  1.1527 +lemma orthogonal_commute: "orthogonal x y \<longleftrightarrow> orthogonal y x"
  1.1528 +  by (simp add: orthogonal_def inner_commute)
  1.1529 +
  1.1530 +lemma orthogonal_scaleR [simp]: "c \<noteq> 0 \<Longrightarrow> orthogonal (c *\<^sub>R x) = orthogonal x"
  1.1531 +  by (rule ext) (simp add: orthogonal_def)
  1.1532 +
  1.1533 +lemma pairwise_ortho_scaleR:
  1.1534 +    "pairwise (\<lambda>i j. orthogonal (f i) (g j)) B
  1.1535 +    \<Longrightarrow> pairwise (\<lambda>i j. orthogonal (a i *\<^sub>R f i) (a j *\<^sub>R g j)) B"
  1.1536 +  by (auto simp: pairwise_def orthogonal_clauses)
  1.1537 +
  1.1538 +lemma orthogonal_rvsum:
  1.1539 +    "\<lbrakk>finite s; \<And>y. y \<in> s \<Longrightarrow> orthogonal x (f y)\<rbrakk> \<Longrightarrow> orthogonal x (setsum f s)"
  1.1540 +  by (induction s rule: finite_induct) (auto simp: orthogonal_clauses)
  1.1541 +
  1.1542 +lemma orthogonal_lvsum:
  1.1543 +    "\<lbrakk>finite s; \<And>x. x \<in> s \<Longrightarrow> orthogonal (f x) y\<rbrakk> \<Longrightarrow> orthogonal (setsum f s) y"
  1.1544 +  by (induction s rule: finite_induct) (auto simp: orthogonal_clauses)
  1.1545 +
  1.1546 +lemma norm_add_Pythagorean:
  1.1547 +  assumes "orthogonal a b"
  1.1548 +    shows "norm(a + b) ^ 2 = norm a ^ 2 + norm b ^ 2"
  1.1549 +proof -
  1.1550 +  from assms have "(a - (0 - b)) \<bullet> (a - (0 - b)) = a \<bullet> a - (0 - b \<bullet> b)"
  1.1551 +    by (simp add: algebra_simps orthogonal_def inner_commute)
  1.1552 +  then show ?thesis
  1.1553 +    by (simp add: power2_norm_eq_inner)
  1.1554 +qed
  1.1555 +
  1.1556 +lemma norm_setsum_Pythagorean:
  1.1557 +  assumes "finite I" "pairwise (\<lambda>i j. orthogonal (f i) (f j)) I"
  1.1558 +    shows "(norm (setsum f I))\<^sup>2 = (\<Sum>i\<in>I. (norm (f i))\<^sup>2)"
  1.1559 +using assms
  1.1560 +proof (induction I rule: finite_induct)
  1.1561 +  case empty then show ?case by simp
  1.1562 +next
  1.1563 +  case (insert x I)
  1.1564 +  then have "orthogonal (f x) (setsum f I)"
  1.1565 +    by (metis pairwise_insert orthogonal_rvsum)
  1.1566 +  with insert show ?case
  1.1567 +    by (simp add: pairwise_insert norm_add_Pythagorean)
  1.1568 +qed
  1.1569 +
  1.1570 +
  1.1571 +subsection \<open>Bilinear functions.\<close>
  1.1572 +
  1.1573 +definition "bilinear f \<longleftrightarrow> (\<forall>x. linear (\<lambda>y. f x y)) \<and> (\<forall>y. linear (\<lambda>x. f x y))"
  1.1574 +
  1.1575 +lemma bilinear_ladd: "bilinear h \<Longrightarrow> h (x + y) z = h x z + h y z"
  1.1576 +  by (simp add: bilinear_def linear_iff)
  1.1577 +
  1.1578 +lemma bilinear_radd: "bilinear h \<Longrightarrow> h x (y + z) = h x y + h x z"
  1.1579 +  by (simp add: bilinear_def linear_iff)
  1.1580 +
  1.1581 +lemma bilinear_lmul: "bilinear h \<Longrightarrow> h (c *\<^sub>R x) y = c *\<^sub>R h x y"
  1.1582 +  by (simp add: bilinear_def linear_iff)
  1.1583 +
  1.1584 +lemma bilinear_rmul: "bilinear h \<Longrightarrow> h x (c *\<^sub>R y) = c *\<^sub>R h x y"
  1.1585 +  by (simp add: bilinear_def linear_iff)
  1.1586 +
  1.1587 +lemma bilinear_lneg: "bilinear h \<Longrightarrow> h (- x) y = - h x y"
  1.1588 +  by (drule bilinear_lmul [of _ "- 1"]) simp
  1.1589 +
  1.1590 +lemma bilinear_rneg: "bilinear h \<Longrightarrow> h x (- y) = - h x y"
  1.1591 +  by (drule bilinear_rmul [of _ _ "- 1"]) simp
  1.1592 +
  1.1593 +lemma (in ab_group_add) eq_add_iff: "x = x + y \<longleftrightarrow> y = 0"
  1.1594 +  using add_left_imp_eq[of x y 0] by auto
  1.1595 +
  1.1596 +lemma bilinear_lzero:
  1.1597 +  assumes "bilinear h"
  1.1598 +  shows "h 0 x = 0"
  1.1599 +  using bilinear_ladd [OF assms, of 0 0 x] by (simp add: eq_add_iff field_simps)
  1.1600 +
  1.1601 +lemma bilinear_rzero:
  1.1602 +  assumes "bilinear h"
  1.1603 +  shows "h x 0 = 0"
  1.1604 +  using bilinear_radd [OF assms, of x 0 0 ] by (simp add: eq_add_iff field_simps)
  1.1605 +
  1.1606 +lemma bilinear_lsub: "bilinear h \<Longrightarrow> h (x - y) z = h x z - h y z"
  1.1607 +  using bilinear_ladd [of h x "- y"] by (simp add: bilinear_lneg)
  1.1608 +
  1.1609 +lemma bilinear_rsub: "bilinear h \<Longrightarrow> h z (x - y) = h z x - h z y"
  1.1610 +  using bilinear_radd [of h _ x "- y"] by (simp add: bilinear_rneg)
  1.1611 +
  1.1612 +lemma bilinear_setsum:
  1.1613 +  assumes bh: "bilinear h"
  1.1614 +    and fS: "finite S"
  1.1615 +    and fT: "finite T"
  1.1616 +  shows "h (setsum f S) (setsum g T) = setsum (\<lambda>(i,j). h (f i) (g j)) (S \<times> T) "
  1.1617 +proof -
  1.1618 +  have "h (setsum f S) (setsum g T) = setsum (\<lambda>x. h (f x) (setsum g T)) S"
  1.1619 +    apply (rule linear_setsum[unfolded o_def])
  1.1620 +    using bh fS
  1.1621 +    apply (auto simp add: bilinear_def)
  1.1622 +    done
  1.1623 +  also have "\<dots> = setsum (\<lambda>x. setsum (\<lambda>y. h (f x) (g y)) T) S"
  1.1624 +    apply (rule setsum.cong, simp)
  1.1625 +    apply (rule linear_setsum[unfolded o_def])
  1.1626 +    using bh fT
  1.1627 +    apply (auto simp add: bilinear_def)
  1.1628 +    done
  1.1629 +  finally show ?thesis
  1.1630 +    unfolding setsum.cartesian_product .
  1.1631 +qed
  1.1632 +
  1.1633 +
  1.1634 +subsection \<open>Adjoints.\<close>
  1.1635 +
  1.1636 +definition "adjoint f = (SOME f'. \<forall>x y. f x \<bullet> y = x \<bullet> f' y)"
  1.1637 +
  1.1638 +lemma adjoint_unique:
  1.1639 +  assumes "\<forall>x y. inner (f x) y = inner x (g y)"
  1.1640 +  shows "adjoint f = g"
  1.1641 +  unfolding adjoint_def
  1.1642 +proof (rule some_equality)
  1.1643 +  show "\<forall>x y. inner (f x) y = inner x (g y)"
  1.1644 +    by (rule assms)
  1.1645 +next
  1.1646 +  fix h
  1.1647 +  assume "\<forall>x y. inner (f x) y = inner x (h y)"
  1.1648 +  then have "\<forall>x y. inner x (g y) = inner x (h y)"
  1.1649 +    using assms by simp
  1.1650 +  then have "\<forall>x y. inner x (g y - h y) = 0"
  1.1651 +    by (simp add: inner_diff_right)
  1.1652 +  then have "\<forall>y. inner (g y - h y) (g y - h y) = 0"
  1.1653 +    by simp
  1.1654 +  then have "\<forall>y. h y = g y"
  1.1655 +    by simp
  1.1656 +  then show "h = g" by (simp add: ext)
  1.1657 +qed
  1.1658 +
  1.1659 +text \<open>TODO: The following lemmas about adjoints should hold for any
  1.1660 +Hilbert space (i.e. complete inner product space).
  1.1661 +(see @{url "http://en.wikipedia.org/wiki/Hermitian_adjoint"})
  1.1662 +\<close>
  1.1663 +
  1.1664 +lemma adjoint_works:
  1.1665 +  fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
  1.1666 +  assumes lf: "linear f"
  1.1667 +  shows "x \<bullet> adjoint f y = f x \<bullet> y"
  1.1668 +proof -
  1.1669 +  have "\<forall>y. \<exists>w. \<forall>x. f x \<bullet> y = x \<bullet> w"
  1.1670 +  proof (intro allI exI)
  1.1671 +    fix y :: "'m" and x
  1.1672 +    let ?w = "(\<Sum>i\<in>Basis. (f i \<bullet> y) *\<^sub>R i) :: 'n"
  1.1673 +    have "f x \<bullet> y = f (\<Sum>i\<in>Basis. (x \<bullet> i) *\<^sub>R i) \<bullet> y"
  1.1674 +      by (simp add: euclidean_representation)
  1.1675 +    also have "\<dots> = (\<Sum>i\<in>Basis. (x \<bullet> i) *\<^sub>R f i) \<bullet> y"
  1.1676 +      unfolding linear_setsum[OF lf]
  1.1677 +      by (simp add: linear_cmul[OF lf])
  1.1678 +    finally show "f x \<bullet> y = x \<bullet> ?w"
  1.1679 +      by (simp add: inner_setsum_left inner_setsum_right mult.commute)
  1.1680 +  qed
  1.1681 +  then show ?thesis
  1.1682 +    unfolding adjoint_def choice_iff
  1.1683 +    by (intro someI2_ex[where Q="\<lambda>f'. x \<bullet> f' y = f x \<bullet> y"]) auto
  1.1684 +qed
  1.1685 +
  1.1686 +lemma adjoint_clauses:
  1.1687 +  fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
  1.1688 +  assumes lf: "linear f"
  1.1689 +  shows "x \<bullet> adjoint f y = f x \<bullet> y"
  1.1690 +    and "adjoint f y \<bullet> x = y \<bullet> f x"
  1.1691 +  by (simp_all add: adjoint_works[OF lf] inner_commute)
  1.1692 +
  1.1693 +lemma adjoint_linear:
  1.1694 +  fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
  1.1695 +  assumes lf: "linear f"
  1.1696 +  shows "linear (adjoint f)"
  1.1697 +  by (simp add: lf linear_iff euclidean_eq_iff[where 'a='n] euclidean_eq_iff[where 'a='m]
  1.1698 +    adjoint_clauses[OF lf] inner_distrib)
  1.1699 +
  1.1700 +lemma adjoint_adjoint:
  1.1701 +  fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
  1.1702 +  assumes lf: "linear f"
  1.1703 +  shows "adjoint (adjoint f) = f"
  1.1704 +  by (rule adjoint_unique, simp add: adjoint_clauses [OF lf])
  1.1705 +
  1.1706 +
  1.1707 +subsection \<open>Interlude: Some properties of real sets\<close>
  1.1708 +
  1.1709 +lemma seq_mono_lemma:
  1.1710 +  assumes "\<forall>(n::nat) \<ge> m. (d n :: real) < e n"
  1.1711 +    and "\<forall>n \<ge> m. e n \<le> e m"
  1.1712 +  shows "\<forall>n \<ge> m. d n < e m"
  1.1713 +  using assms
  1.1714 +  apply auto
  1.1715 +  apply (erule_tac x="n" in allE)
  1.1716 +  apply (erule_tac x="n" in allE)
  1.1717 +  apply auto
  1.1718 +  done
  1.1719 +
  1.1720 +lemma infinite_enumerate:
  1.1721 +  assumes fS: "infinite S"
  1.1722 +  shows "\<exists>r. subseq r \<and> (\<forall>n. r n \<in> S)"
  1.1723 +  unfolding subseq_def
  1.1724 +  using enumerate_in_set[OF fS] enumerate_mono[of _ _ S] fS by auto
  1.1725 +
  1.1726 +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)"
  1.1727 +  apply auto
  1.1728 +  apply (rule_tac x="d/2" in exI)
  1.1729 +  apply auto
  1.1730 +  done
  1.1731 +
  1.1732 +lemma approachable_lt_le2:  \<comment>\<open>like the above, but pushes aside an extra formula\<close>
  1.1733 +    "(\<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)"
  1.1734 +  apply auto
  1.1735 +  apply (rule_tac x="d/2" in exI, auto)
  1.1736 +  done
  1.1737 +
  1.1738 +lemma triangle_lemma:
  1.1739 +  fixes x y z :: real
  1.1740 +  assumes x: "0 \<le> x"
  1.1741 +    and y: "0 \<le> y"
  1.1742 +    and z: "0 \<le> z"
  1.1743 +    and xy: "x\<^sup>2 \<le> y\<^sup>2 + z\<^sup>2"
  1.1744 +  shows "x \<le> y + z"
  1.1745 +proof -
  1.1746 +  have "y\<^sup>2 + z\<^sup>2 \<le> y\<^sup>2 + 2 * y * z + z\<^sup>2"
  1.1747 +    using z y by simp
  1.1748 +  with xy have th: "x\<^sup>2 \<le> (y + z)\<^sup>2"
  1.1749 +    by (simp add: power2_eq_square field_simps)
  1.1750 +  from y z have yz: "y + z \<ge> 0"
  1.1751 +    by arith
  1.1752 +  from power2_le_imp_le[OF th yz] show ?thesis .
  1.1753 +qed
  1.1754 +
  1.1755 +
  1.1756 +
  1.1757 +subsection \<open>Archimedean properties and useful consequences\<close>
  1.1758 +
  1.1759 +text\<open>Bernoulli's inequality\<close>
  1.1760 +proposition Bernoulli_inequality:
  1.1761 +  fixes x :: real
  1.1762 +  assumes "-1 \<le> x"
  1.1763 +    shows "1 + n * x \<le> (1 + x) ^ n"
  1.1764 +proof (induct n)
  1.1765 +  case 0
  1.1766 +  then show ?case by simp
  1.1767 +next
  1.1768 +  case (Suc n)
  1.1769 +  have "1 + Suc n * x \<le> 1 + (Suc n)*x + n * x^2"
  1.1770 +    by (simp add: algebra_simps)
  1.1771 +  also have "... = (1 + x) * (1 + n*x)"
  1.1772 +    by (auto simp: power2_eq_square algebra_simps  of_nat_Suc)
  1.1773 +  also have "... \<le> (1 + x) ^ Suc n"
  1.1774 +    using Suc.hyps assms mult_left_mono by fastforce
  1.1775 +  finally show ?case .
  1.1776 +qed
  1.1777 +
  1.1778 +corollary Bernoulli_inequality_even:
  1.1779 +  fixes x :: real
  1.1780 +  assumes "even n"
  1.1781 +    shows "1 + n * x \<le> (1 + x) ^ n"
  1.1782 +proof (cases "-1 \<le> x \<or> n=0")
  1.1783 +  case True
  1.1784 +  then show ?thesis
  1.1785 +    by (auto simp: Bernoulli_inequality)
  1.1786 +next
  1.1787 +  case False
  1.1788 +  then have "real n \<ge> 1"
  1.1789 +    by simp
  1.1790 +  with False have "n * x \<le> -1"
  1.1791 +    by (metis linear minus_zero mult.commute mult.left_neutral mult_left_mono_neg neg_le_iff_le order_trans zero_le_one)
  1.1792 +  then have "1 + n * x \<le> 0"
  1.1793 +    by auto
  1.1794 +  also have "... \<le> (1 + x) ^ n"
  1.1795 +    using assms
  1.1796 +    using zero_le_even_power by blast
  1.1797 +  finally show ?thesis .
  1.1798 +qed
  1.1799 +
  1.1800 +corollary real_arch_pow:
  1.1801 +  fixes x :: real
  1.1802 +  assumes x: "1 < x"
  1.1803 +  shows "\<exists>n. y < x^n"
  1.1804 +proof -
  1.1805 +  from x have x0: "x - 1 > 0"
  1.1806 +    by arith
  1.1807 +  from reals_Archimedean3[OF x0, rule_format, of y]
  1.1808 +  obtain n :: nat where n: "y < real n * (x - 1)" by metis
  1.1809 +  from x0 have x00: "x- 1 \<ge> -1" by arith
  1.1810 +  from Bernoulli_inequality[OF x00, of n] n
  1.1811 +  have "y < x^n" by auto
  1.1812 +  then show ?thesis by metis
  1.1813 +qed
  1.1814 +
  1.1815 +corollary real_arch_pow_inv:
  1.1816 +  fixes x y :: real
  1.1817 +  assumes y: "y > 0"
  1.1818 +    and x1: "x < 1"
  1.1819 +  shows "\<exists>n. x^n < y"
  1.1820 +proof (cases "x > 0")
  1.1821 +  case True
  1.1822 +  with x1 have ix: "1 < 1/x" by (simp add: field_simps)
  1.1823 +  from real_arch_pow[OF ix, of "1/y"]
  1.1824 +  obtain n where n: "1/y < (1/x)^n" by blast
  1.1825 +  then show ?thesis using y \<open>x > 0\<close>
  1.1826 +    by (auto simp add: field_simps)
  1.1827 +next
  1.1828 +  case False
  1.1829 +  with y x1 show ?thesis
  1.1830 +    apply auto
  1.1831 +    apply (rule exI[where x=1])
  1.1832 +    apply auto
  1.1833 +    done
  1.1834 +qed
  1.1835 +
  1.1836 +lemma forall_pos_mono:
  1.1837 +  "(\<And>d e::real. d < e \<Longrightarrow> P d \<Longrightarrow> P e) \<Longrightarrow>
  1.1838 +    (\<And>n::nat. n \<noteq> 0 \<Longrightarrow> P (inverse (real n))) \<Longrightarrow> (\<And>e. 0 < e \<Longrightarrow> P e)"
  1.1839 +  by (metis real_arch_inverse)
  1.1840 +
  1.1841 +lemma forall_pos_mono_1:
  1.1842 +  "(\<And>d e::real. d < e \<Longrightarrow> P d \<Longrightarrow> P e) \<Longrightarrow>
  1.1843 +    (\<And>n. P (inverse (real (Suc n)))) \<Longrightarrow> 0 < e \<Longrightarrow> P e"
  1.1844 +  apply (rule forall_pos_mono)
  1.1845 +  apply auto
  1.1846 +  apply (metis Suc_pred of_nat_Suc)
  1.1847 +  done
  1.1848 +
  1.1849 +
  1.1850 +subsection \<open>Euclidean Spaces as Typeclass\<close>
  1.1851 +
  1.1852 +lemma independent_Basis: "independent Basis"
  1.1853 +  unfolding dependent_def
  1.1854 +  apply (subst span_finite)
  1.1855 +  apply simp
  1.1856 +  apply clarify
  1.1857 +  apply (drule_tac f="inner a" in arg_cong)
  1.1858 +  apply (simp add: inner_Basis inner_setsum_right eq_commute)
  1.1859 +  done
  1.1860 +
  1.1861 +lemma span_Basis [simp]: "span Basis = UNIV"
  1.1862 +  unfolding span_finite [OF finite_Basis]
  1.1863 +  by (fast intro: euclidean_representation)
  1.1864 +
  1.1865 +lemma in_span_Basis: "x \<in> span Basis"
  1.1866 +  unfolding span_Basis ..
  1.1867 +
  1.1868 +lemma Basis_le_norm: "b \<in> Basis \<Longrightarrow> \<bar>x \<bullet> b\<bar> \<le> norm x"
  1.1869 +  by (rule order_trans [OF Cauchy_Schwarz_ineq2]) simp
  1.1870 +
  1.1871 +lemma norm_bound_Basis_le: "b \<in> Basis \<Longrightarrow> norm x \<le> e \<Longrightarrow> \<bar>x \<bullet> b\<bar> \<le> e"
  1.1872 +  by (metis Basis_le_norm order_trans)
  1.1873 +
  1.1874 +lemma norm_bound_Basis_lt: "b \<in> Basis \<Longrightarrow> norm x < e \<Longrightarrow> \<bar>x \<bullet> b\<bar> < e"
  1.1875 +  by (metis Basis_le_norm le_less_trans)
  1.1876 +
  1.1877 +lemma norm_le_l1: "norm x \<le> (\<Sum>b\<in>Basis. \<bar>x \<bullet> b\<bar>)"
  1.1878 +  apply (subst euclidean_representation[of x, symmetric])
  1.1879 +  apply (rule order_trans[OF norm_setsum])
  1.1880 +  apply (auto intro!: setsum_mono)
  1.1881 +  done
  1.1882 +
  1.1883 +lemma setsum_norm_allsubsets_bound:
  1.1884 +  fixes f :: "'a \<Rightarrow> 'n::euclidean_space"
  1.1885 +  assumes fP: "finite P"
  1.1886 +    and fPs: "\<And>Q. Q \<subseteq> P \<Longrightarrow> norm (setsum f Q) \<le> e"
  1.1887 +  shows "(\<Sum>x\<in>P. norm (f x)) \<le> 2 * real DIM('n) * e"
  1.1888 +proof -
  1.1889 +  have "(\<Sum>x\<in>P. norm (f x)) \<le> (\<Sum>x\<in>P. \<Sum>b\<in>Basis. \<bar>f x \<bullet> b\<bar>)"
  1.1890 +    by (rule setsum_mono) (rule norm_le_l1)
  1.1891 +  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>)"
  1.1892 +    by (rule setsum.commute)
  1.1893 +  also have "\<dots> \<le> of_nat (card (Basis :: 'n set)) * (2 * e)"
  1.1894 +  proof (rule setsum_bounded_above)
  1.1895 +    fix i :: 'n
  1.1896 +    assume i: "i \<in> Basis"
  1.1897 +    have "norm (\<Sum>x\<in>P. \<bar>f x \<bullet> i\<bar>) \<le>
  1.1898 +      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)"
  1.1899 +      by (simp add: abs_real_def setsum.If_cases[OF fP] setsum_negf norm_triangle_ineq4 inner_setsum_left
  1.1900 +        del: real_norm_def)
  1.1901 +    also have "\<dots> \<le> e + e"
  1.1902 +      unfolding real_norm_def
  1.1903 +      by (intro add_mono norm_bound_Basis_le i fPs) auto
  1.1904 +    finally show "(\<Sum>x\<in>P. \<bar>f x \<bullet> i\<bar>) \<le> 2*e" by simp
  1.1905 +  qed
  1.1906 +  also have "\<dots> = 2 * real DIM('n) * e" by simp
  1.1907 +  finally show ?thesis .
  1.1908 +qed
  1.1909 +
  1.1910 +
  1.1911 +subsection \<open>Linearity and Bilinearity continued\<close>
  1.1912 +
  1.1913 +lemma linear_bounded:
  1.1914 +  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  1.1915 +  assumes lf: "linear f"
  1.1916 +  shows "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
  1.1917 +proof
  1.1918 +  let ?B = "\<Sum>b\<in>Basis. norm (f b)"
  1.1919 +  show "\<forall>x. norm (f x) \<le> ?B * norm x"
  1.1920 +  proof
  1.1921 +    fix x :: 'a
  1.1922 +    let ?g = "\<lambda>b. (x \<bullet> b) *\<^sub>R f b"
  1.1923 +    have "norm (f x) = norm (f (\<Sum>b\<in>Basis. (x \<bullet> b) *\<^sub>R b))"
  1.1924 +      unfolding euclidean_representation ..
  1.1925 +    also have "\<dots> = norm (setsum ?g Basis)"
  1.1926 +      by (simp add: linear_setsum [OF lf] linear_cmul [OF lf])
  1.1927 +    finally have th0: "norm (f x) = norm (setsum ?g Basis)" .
  1.1928 +    have th: "\<forall>b\<in>Basis. norm (?g b) \<le> norm (f b) * norm x"
  1.1929 +    proof
  1.1930 +      fix i :: 'a
  1.1931 +      assume i: "i \<in> Basis"
  1.1932 +      from Basis_le_norm[OF i, of x]
  1.1933 +      show "norm (?g i) \<le> norm (f i) * norm x"
  1.1934 +        unfolding norm_scaleR
  1.1935 +        apply (subst mult.commute)
  1.1936 +        apply (rule mult_mono)
  1.1937 +        apply (auto simp add: field_simps)
  1.1938 +        done
  1.1939 +    qed
  1.1940 +    from setsum_norm_le[of _ ?g, OF th]
  1.1941 +    show "norm (f x) \<le> ?B * norm x"
  1.1942 +      unfolding th0 setsum_left_distrib by metis
  1.1943 +  qed
  1.1944 +qed
  1.1945 +
  1.1946 +lemma linear_conv_bounded_linear:
  1.1947 +  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  1.1948 +  shows "linear f \<longleftrightarrow> bounded_linear f"
  1.1949 +proof
  1.1950 +  assume "linear f"
  1.1951 +  then interpret f: linear f .
  1.1952 +  show "bounded_linear f"
  1.1953 +  proof
  1.1954 +    have "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
  1.1955 +      using \<open>linear f\<close> by (rule linear_bounded)
  1.1956 +    then show "\<exists>K. \<forall>x. norm (f x) \<le> norm x * K"
  1.1957 +      by (simp add: mult.commute)
  1.1958 +  qed
  1.1959 +next
  1.1960 +  assume "bounded_linear f"
  1.1961 +  then interpret f: bounded_linear f .
  1.1962 +  show "linear f" ..
  1.1963 +qed
  1.1964 +
  1.1965 +lemmas linear_linear = linear_conv_bounded_linear[symmetric]
  1.1966 +
  1.1967 +lemma linear_bounded_pos:
  1.1968 +  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  1.1969 +  assumes lf: "linear f"
  1.1970 +  shows "\<exists>B > 0. \<forall>x. norm (f x) \<le> B * norm x"
  1.1971 +proof -
  1.1972 +  have "\<exists>B > 0. \<forall>x. norm (f x) \<le> norm x * B"
  1.1973 +    using lf unfolding linear_conv_bounded_linear
  1.1974 +    by (rule bounded_linear.pos_bounded)
  1.1975 +  then show ?thesis
  1.1976 +    by (simp only: mult.commute)
  1.1977 +qed
  1.1978 +
  1.1979 +lemma bounded_linearI':
  1.1980 +  fixes f ::"'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  1.1981 +  assumes "\<And>x y. f (x + y) = f x + f y"
  1.1982 +    and "\<And>c x. f (c *\<^sub>R x) = c *\<^sub>R f x"
  1.1983 +  shows "bounded_linear f"
  1.1984 +  unfolding linear_conv_bounded_linear[symmetric]
  1.1985 +  by (rule linearI[OF assms])
  1.1986 +
  1.1987 +lemma bilinear_bounded:
  1.1988 +  fixes h :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space \<Rightarrow> 'k::real_normed_vector"
  1.1989 +  assumes bh: "bilinear h"
  1.1990 +  shows "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
  1.1991 +proof (clarify intro!: exI[of _ "\<Sum>i\<in>Basis. \<Sum>j\<in>Basis. norm (h i j)"])
  1.1992 +  fix x :: 'm
  1.1993 +  fix y :: 'n
  1.1994 +  have "norm (h x y) = norm (h (setsum (\<lambda>i. (x \<bullet> i) *\<^sub>R i) Basis) (setsum (\<lambda>i. (y \<bullet> i) *\<^sub>R i) Basis))"
  1.1995 +    apply (subst euclidean_representation[where 'a='m])
  1.1996 +    apply (subst euclidean_representation[where 'a='n])
  1.1997 +    apply rule
  1.1998 +    done
  1.1999 +  also have "\<dots> = norm (setsum (\<lambda> (i,j). h ((x \<bullet> i) *\<^sub>R i) ((y \<bullet> j) *\<^sub>R j)) (Basis \<times> Basis))"
  1.2000 +    unfolding bilinear_setsum[OF bh finite_Basis finite_Basis] ..
  1.2001 +  finally have th: "norm (h x y) = \<dots>" .
  1.2002 +  show "norm (h x y) \<le> (\<Sum>i\<in>Basis. \<Sum>j\<in>Basis. norm (h i j)) * norm x * norm y"
  1.2003 +    apply (auto simp add: setsum_left_distrib th setsum.cartesian_product)
  1.2004 +    apply (rule setsum_norm_le)
  1.2005 +    apply simp
  1.2006 +    apply (auto simp add: bilinear_rmul[OF bh] bilinear_lmul[OF bh]
  1.2007 +      field_simps simp del: scaleR_scaleR)
  1.2008 +    apply (rule mult_mono)
  1.2009 +    apply (auto simp add: zero_le_mult_iff Basis_le_norm)
  1.2010 +    apply (rule mult_mono)
  1.2011 +    apply (auto simp add: zero_le_mult_iff Basis_le_norm)
  1.2012 +    done
  1.2013 +qed
  1.2014 +
  1.2015 +lemma bilinear_conv_bounded_bilinear:
  1.2016 +  fixes h :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::real_normed_vector"
  1.2017 +  shows "bilinear h \<longleftrightarrow> bounded_bilinear h"
  1.2018 +proof
  1.2019 +  assume "bilinear h"
  1.2020 +  show "bounded_bilinear h"
  1.2021 +  proof
  1.2022 +    fix x y z
  1.2023 +    show "h (x + y) z = h x z + h y z"
  1.2024 +      using \<open>bilinear h\<close> unfolding bilinear_def linear_iff by simp
  1.2025 +  next
  1.2026 +    fix x y z
  1.2027 +    show "h x (y + z) = h x y + h x z"
  1.2028 +      using \<open>bilinear h\<close> unfolding bilinear_def linear_iff by simp
  1.2029 +  next
  1.2030 +    fix r x y
  1.2031 +    show "h (scaleR r x) y = scaleR r (h x y)"
  1.2032 +      using \<open>bilinear h\<close> unfolding bilinear_def linear_iff
  1.2033 +      by simp
  1.2034 +  next
  1.2035 +    fix r x y
  1.2036 +    show "h x (scaleR r y) = scaleR r (h x y)"
  1.2037 +      using \<open>bilinear h\<close> unfolding bilinear_def linear_iff
  1.2038 +      by simp
  1.2039 +  next
  1.2040 +    have "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
  1.2041 +      using \<open>bilinear h\<close> by (rule bilinear_bounded)
  1.2042 +    then show "\<exists>K. \<forall>x y. norm (h x y) \<le> norm x * norm y * K"
  1.2043 +      by (simp add: ac_simps)
  1.2044 +  qed
  1.2045 +next
  1.2046 +  assume "bounded_bilinear h"
  1.2047 +  then interpret h: bounded_bilinear h .
  1.2048 +  show "bilinear h"
  1.2049 +    unfolding bilinear_def linear_conv_bounded_linear
  1.2050 +    using h.bounded_linear_left h.bounded_linear_right by simp
  1.2051 +qed
  1.2052 +
  1.2053 +lemma bilinear_bounded_pos:
  1.2054 +  fixes h :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::real_normed_vector"
  1.2055 +  assumes bh: "bilinear h"
  1.2056 +  shows "\<exists>B > 0. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
  1.2057 +proof -
  1.2058 +  have "\<exists>B > 0. \<forall>x y. norm (h x y) \<le> norm x * norm y * B"
  1.2059 +    using bh [unfolded bilinear_conv_bounded_bilinear]
  1.2060 +    by (rule bounded_bilinear.pos_bounded)
  1.2061 +  then show ?thesis
  1.2062 +    by (simp only: ac_simps)
  1.2063 +qed
  1.2064 +
  1.2065 +lemma bounded_linear_imp_has_derivative:
  1.2066 +     "bounded_linear f \<Longrightarrow> (f has_derivative f) net"
  1.2067 +  by (simp add: has_derivative_def bounded_linear.linear linear_diff)
  1.2068 +
  1.2069 +lemma linear_imp_has_derivative:
  1.2070 +  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  1.2071 +  shows "linear f \<Longrightarrow> (f has_derivative f) net"
  1.2072 +by (simp add: has_derivative_def linear_conv_bounded_linear linear_diff)
  1.2073 +
  1.2074 +lemma bounded_linear_imp_differentiable: "bounded_linear f \<Longrightarrow> f differentiable net"
  1.2075 +  using bounded_linear_imp_has_derivative differentiable_def by blast
  1.2076 +
  1.2077 +lemma linear_imp_differentiable:
  1.2078 +  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  1.2079 +  shows "linear f \<Longrightarrow> f differentiable net"
  1.2080 +by (metis linear_imp_has_derivative differentiable_def)
  1.2081 +
  1.2082 +
  1.2083 +subsection \<open>We continue.\<close>
  1.2084 +
  1.2085 +lemma independent_bound:
  1.2086 +  fixes S :: "'a::euclidean_space set"
  1.2087 +  shows "independent S \<Longrightarrow> finite S \<and> card S \<le> DIM('a)"
  1.2088 +  using independent_span_bound[OF finite_Basis, of S] by auto
  1.2089 +
  1.2090 +corollary
  1.2091 +  fixes S :: "'a::euclidean_space set"
  1.2092 +  assumes "independent S"
  1.2093 +  shows independent_imp_finite: "finite S" and independent_card_le:"card S \<le> DIM('a)"
  1.2094 +using assms independent_bound by auto
  1.2095 +
  1.2096 +lemma independent_explicit:
  1.2097 +  fixes B :: "'a::euclidean_space set"
  1.2098 +  shows "independent B \<longleftrightarrow>
  1.2099 +         finite B \<and> (\<forall>c. (\<Sum>v\<in>B. c v *\<^sub>R v) = 0 \<longrightarrow> (\<forall>v \<in> B. c v = 0))"
  1.2100 +apply (cases "finite B")
  1.2101 + apply (force simp: dependent_finite)
  1.2102 +using independent_bound
  1.2103 +apply auto
  1.2104 +done
  1.2105 +
  1.2106 +lemma dependent_biggerset:
  1.2107 +  fixes S :: "'a::euclidean_space set"
  1.2108 +  shows "(finite S \<Longrightarrow> card S > DIM('a)) \<Longrightarrow> dependent S"
  1.2109 +  by (metis independent_bound not_less)
  1.2110 +
  1.2111 +text \<open>Notion of dimension.\<close>
  1.2112 +
  1.2113 +definition "dim V = (SOME n. \<exists>B. B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> card B = n)"
  1.2114 +
  1.2115 +lemma basis_exists:
  1.2116 +  "\<exists>B. (B :: ('a::euclidean_space) set) \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> (card B = dim V)"
  1.2117 +  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)"]
  1.2118 +  using maximal_independent_subset[of V] independent_bound
  1.2119 +  by auto
  1.2120 +
  1.2121 +corollary dim_le_card:
  1.2122 +  fixes s :: "'a::euclidean_space set"
  1.2123 +  shows "finite s \<Longrightarrow> dim s \<le> card s"
  1.2124 +by (metis basis_exists card_mono)
  1.2125 +
  1.2126 +text \<open>Consequences of independence or spanning for cardinality.\<close>
  1.2127 +
  1.2128 +lemma independent_card_le_dim:
  1.2129 +  fixes B :: "'a::euclidean_space set"
  1.2130 +  assumes "B \<subseteq> V"
  1.2131 +    and "independent B"
  1.2132 +  shows "card B \<le> dim V"
  1.2133 +proof -
  1.2134 +  from basis_exists[of V] \<open>B \<subseteq> V\<close>
  1.2135 +  obtain B' where "independent B'"
  1.2136 +    and "B \<subseteq> span B'"
  1.2137 +    and "card B' = dim V"
  1.2138 +    by blast
  1.2139 +  with independent_span_bound[OF _ \<open>independent B\<close> \<open>B \<subseteq> span B'\<close>] independent_bound[of B']
  1.2140 +  show ?thesis by auto
  1.2141 +qed
  1.2142 +
  1.2143 +lemma span_card_ge_dim:
  1.2144 +  fixes B :: "'a::euclidean_space set"
  1.2145 +  shows "B \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> finite B \<Longrightarrow> dim V \<le> card B"
  1.2146 +  by (metis basis_exists[of V] independent_span_bound subset_trans)
  1.2147 +
  1.2148 +lemma basis_card_eq_dim:
  1.2149 +  fixes V :: "'a::euclidean_space set"
  1.2150 +  shows "B \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> independent B \<Longrightarrow> finite B \<and> card B = dim V"
  1.2151 +  by (metis order_eq_iff independent_card_le_dim span_card_ge_dim independent_bound)
  1.2152 +
  1.2153 +lemma dim_unique:
  1.2154 +  fixes B :: "'a::euclidean_space set"
  1.2155 +  shows "B \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> independent B \<Longrightarrow> card B = n \<Longrightarrow> dim V = n"
  1.2156 +  by (metis basis_card_eq_dim)
  1.2157 +
  1.2158 +text \<open>More lemmas about dimension.\<close>
  1.2159 +
  1.2160 +lemma dim_UNIV: "dim (UNIV :: 'a::euclidean_space set) = DIM('a)"
  1.2161 +  using independent_Basis
  1.2162 +  by (intro dim_unique[of Basis]) auto
  1.2163 +
  1.2164 +lemma dim_subset:
  1.2165 +  fixes S :: "'a::euclidean_space set"
  1.2166 +  shows "S \<subseteq> T \<Longrightarrow> dim S \<le> dim T"
  1.2167 +  using basis_exists[of T] basis_exists[of S]
  1.2168 +  by (metis independent_card_le_dim subset_trans)
  1.2169 +
  1.2170 +lemma dim_subset_UNIV:
  1.2171 +  fixes S :: "'a::euclidean_space set"
  1.2172 +  shows "dim S \<le> DIM('a)"
  1.2173 +  by (metis dim_subset subset_UNIV dim_UNIV)
  1.2174 +
  1.2175 +text \<open>Converses to those.\<close>
  1.2176 +
  1.2177 +lemma card_ge_dim_independent:
  1.2178 +  fixes B :: "'a::euclidean_space set"
  1.2179 +  assumes BV: "B \<subseteq> V"
  1.2180 +    and iB: "independent B"
  1.2181 +    and dVB: "dim V \<le> card B"
  1.2182 +  shows "V \<subseteq> span B"
  1.2183 +proof
  1.2184 +  fix a
  1.2185 +  assume aV: "a \<in> V"
  1.2186 +  {
  1.2187 +    assume aB: "a \<notin> span B"
  1.2188 +    then have iaB: "independent (insert a B)"
  1.2189 +      using iB aV BV by (simp add: independent_insert)
  1.2190 +    from aV BV have th0: "insert a B \<subseteq> V"
  1.2191 +      by blast
  1.2192 +    from aB have "a \<notin>B"
  1.2193 +      by (auto simp add: span_superset)
  1.2194 +    with independent_card_le_dim[OF th0 iaB] dVB independent_bound[OF iB]
  1.2195 +    have False by auto
  1.2196 +  }
  1.2197 +  then show "a \<in> span B" by blast
  1.2198 +qed
  1.2199 +
  1.2200 +lemma card_le_dim_spanning:
  1.2201 +  assumes BV: "(B:: ('a::euclidean_space) set) \<subseteq> V"
  1.2202 +    and VB: "V \<subseteq> span B"
  1.2203 +    and fB: "finite B"
  1.2204 +    and dVB: "dim V \<ge> card B"
  1.2205 +  shows "independent B"
  1.2206 +proof -
  1.2207 +  {
  1.2208 +    fix a
  1.2209 +    assume a: "a \<in> B" "a \<in> span (B - {a})"
  1.2210 +    from a fB have c0: "card B \<noteq> 0"
  1.2211 +      by auto
  1.2212 +    from a fB have cb: "card (B - {a}) = card B - 1"
  1.2213 +      by auto
  1.2214 +    from BV a have th0: "B - {a} \<subseteq> V"
  1.2215 +      by blast
  1.2216 +    {
  1.2217 +      fix x
  1.2218 +      assume x: "x \<in> V"
  1.2219 +      from a have eq: "insert a (B - {a}) = B"
  1.2220 +        by blast
  1.2221 +      from x VB have x': "x \<in> span B"
  1.2222 +        by blast
  1.2223 +      from span_trans[OF a(2), unfolded eq, OF x']
  1.2224 +      have "x \<in> span (B - {a})" .
  1.2225 +    }
  1.2226 +    then have th1: "V \<subseteq> span (B - {a})"
  1.2227 +      by blast
  1.2228 +    have th2: "finite (B - {a})"
  1.2229 +      using fB by auto
  1.2230 +    from span_card_ge_dim[OF th0 th1 th2]
  1.2231 +    have c: "dim V \<le> card (B - {a})" .
  1.2232 +    from c c0 dVB cb have False by simp
  1.2233 +  }
  1.2234 +  then show ?thesis
  1.2235 +    unfolding dependent_def by blast
  1.2236 +qed
  1.2237 +
  1.2238 +lemma card_eq_dim:
  1.2239 +  fixes B :: "'a::euclidean_space set"
  1.2240 +  shows "B \<subseteq> V \<Longrightarrow> card B = dim V \<Longrightarrow> finite B \<Longrightarrow> independent B \<longleftrightarrow> V \<subseteq> span B"
  1.2241 +  by (metis order_eq_iff card_le_dim_spanning card_ge_dim_independent)
  1.2242 +
  1.2243 +text \<open>More general size bound lemmas.\<close>
  1.2244 +
  1.2245 +lemma independent_bound_general:
  1.2246 +  fixes S :: "'a::euclidean_space set"
  1.2247 +  shows "independent S \<Longrightarrow> finite S \<and> card S \<le> dim S"
  1.2248 +  by (metis independent_card_le_dim independent_bound subset_refl)
  1.2249 +
  1.2250 +lemma dependent_biggerset_general:
  1.2251 +  fixes S :: "'a::euclidean_space set"
  1.2252 +  shows "(finite S \<Longrightarrow> card S > dim S) \<Longrightarrow> dependent S"
  1.2253 +  using independent_bound_general[of S] by (metis linorder_not_le)
  1.2254 +
  1.2255 +lemma dim_span [simp]:
  1.2256 +  fixes S :: "'a::euclidean_space set"
  1.2257 +  shows "dim (span S) = dim S"
  1.2258 +proof -
  1.2259 +  have th0: "dim S \<le> dim (span S)"
  1.2260 +    by (auto simp add: subset_eq intro: dim_subset span_superset)
  1.2261 +  from basis_exists[of S]
  1.2262 +  obtain B where B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "card B = dim S"
  1.2263 +    by blast
  1.2264 +  from B have fB: "finite B" "card B = dim S"
  1.2265 +    using independent_bound by blast+
  1.2266 +  have bSS: "B \<subseteq> span S"
  1.2267 +    using B(1) by (metis subset_eq span_inc)
  1.2268 +  have sssB: "span S \<subseteq> span B"
  1.2269 +    using span_mono[OF B(3)] by (simp add: span_span)
  1.2270 +  from span_card_ge_dim[OF bSS sssB fB(1)] th0 show ?thesis
  1.2271 +    using fB(2) by arith
  1.2272 +qed
  1.2273 +
  1.2274 +lemma subset_le_dim:
  1.2275 +  fixes S :: "'a::euclidean_space set"
  1.2276 +  shows "S \<subseteq> span T \<Longrightarrow> dim S \<le> dim T"
  1.2277 +  by (metis dim_span dim_subset)
  1.2278 +
  1.2279 +lemma span_eq_dim:
  1.2280 +  fixes S :: "'a::euclidean_space set"
  1.2281 +  shows "span S = span T \<Longrightarrow> dim S = dim T"
  1.2282 +  by (metis dim_span)
  1.2283 +
  1.2284 +lemma dim_image_le:
  1.2285 +  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  1.2286 +  assumes lf: "linear f"
  1.2287 +  shows "dim (f ` S) \<le> dim (S)"
  1.2288 +proof -
  1.2289 +  from basis_exists[of S] obtain B where
  1.2290 +    B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "card B = dim S" by blast
  1.2291 +  from B have fB: "finite B" "card B = dim S"
  1.2292 +    using independent_bound by blast+
  1.2293 +  have "dim (f ` S) \<le> card (f ` B)"
  1.2294 +    apply (rule span_card_ge_dim)
  1.2295 +    using lf B fB
  1.2296 +    apply (auto simp add: span_linear_image spans_image subset_image_iff)
  1.2297 +    done
  1.2298 +  also have "\<dots> \<le> dim S"
  1.2299 +    using card_image_le[OF fB(1)] fB by simp
  1.2300 +  finally show ?thesis .
  1.2301 +qed
  1.2302 +
  1.2303 +text \<open>Picking an orthogonal replacement for a spanning set.\<close>
  1.2304 +
  1.2305 +lemma vector_sub_project_orthogonal:
  1.2306 +  fixes b x :: "'a::euclidean_space"
  1.2307 +  shows "b \<bullet> (x - ((b \<bullet> x) / (b \<bullet> b)) *\<^sub>R b) = 0"
  1.2308 +  unfolding inner_simps by auto
  1.2309 +
  1.2310 +lemma pairwise_orthogonal_insert:
  1.2311 +  assumes "pairwise orthogonal S"
  1.2312 +    and "\<And>y. y \<in> S \<Longrightarrow> orthogonal x y"
  1.2313 +  shows "pairwise orthogonal (insert x S)"
  1.2314 +  using assms unfolding pairwise_def
  1.2315 +  by (auto simp add: orthogonal_commute)
  1.2316 +
  1.2317 +lemma basis_orthogonal:
  1.2318 +  fixes B :: "'a::real_inner set"
  1.2319 +  assumes fB: "finite B"
  1.2320 +  shows "\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C"
  1.2321 +  (is " \<exists>C. ?P B C")
  1.2322 +  using fB
  1.2323 +proof (induct rule: finite_induct)
  1.2324 +  case empty
  1.2325 +  then show ?case
  1.2326 +    apply (rule exI[where x="{}"])
  1.2327 +    apply (auto simp add: pairwise_def)
  1.2328 +    done
  1.2329 +next
  1.2330 +  case (insert a B)
  1.2331 +  note fB = \<open>finite B\<close> and aB = \<open>a \<notin> B\<close>
  1.2332 +  from \<open>\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C\<close>
  1.2333 +  obtain C where C: "finite C" "card C \<le> card B"
  1.2334 +    "span C = span B" "pairwise orthogonal C" by blast
  1.2335 +  let ?a = "a - setsum (\<lambda>x. (x \<bullet> a / (x \<bullet> x)) *\<^sub>R x) C"
  1.2336 +  let ?C = "insert ?a C"
  1.2337 +  from C(1) have fC: "finite ?C"
  1.2338 +    by simp
  1.2339 +  from fB aB C(1,2) have cC: "card ?C \<le> card (insert a B)"
  1.2340 +    by (simp add: card_insert_if)
  1.2341 +  {
  1.2342 +    fix x k
  1.2343 +    have th0: "\<And>(a::'a) b c. a - (b - c) = c + (a - b)"
  1.2344 +      by (simp add: field_simps)
  1.2345 +    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"
  1.2346 +      apply (simp only: scaleR_right_diff_distrib th0)
  1.2347 +      apply (rule span_add_eq)
  1.2348 +      apply (rule span_mul)
  1.2349 +      apply (rule span_setsum)
  1.2350 +      apply (rule span_mul)
  1.2351 +      apply (rule span_superset)
  1.2352 +      apply assumption
  1.2353 +      done
  1.2354 +  }
  1.2355 +  then have SC: "span ?C = span (insert a B)"
  1.2356 +    unfolding set_eq_iff span_breakdown_eq C(3)[symmetric] by auto
  1.2357 +  {
  1.2358 +    fix y
  1.2359 +    assume yC: "y \<in> C"
  1.2360 +    then have Cy: "C = insert y (C - {y})"
  1.2361 +      by blast
  1.2362 +    have fth: "finite (C - {y})"
  1.2363 +      using C by simp
  1.2364 +    have "orthogonal ?a y"
  1.2365 +      unfolding orthogonal_def
  1.2366 +      unfolding inner_diff inner_setsum_left right_minus_eq
  1.2367 +      unfolding setsum.remove [OF \<open>finite C\<close> \<open>y \<in> C\<close>]
  1.2368 +      apply (clarsimp simp add: inner_commute[of y a])
  1.2369 +      apply (rule setsum.neutral)
  1.2370 +      apply clarsimp
  1.2371 +      apply (rule C(4)[unfolded pairwise_def orthogonal_def, rule_format])
  1.2372 +      using \<open>y \<in> C\<close> by auto
  1.2373 +  }
  1.2374 +  with \<open>pairwise orthogonal C\<close> have CPO: "pairwise orthogonal ?C"
  1.2375 +    by (rule pairwise_orthogonal_insert)
  1.2376 +  from fC cC SC CPO have "?P (insert a B) ?C"
  1.2377 +    by blast
  1.2378 +  then show ?case by blast
  1.2379 +qed
  1.2380 +
  1.2381 +lemma orthogonal_basis_exists:
  1.2382 +  fixes V :: "('a::euclidean_space) set"
  1.2383 +  shows "\<exists>B. independent B \<and> B \<subseteq> span V \<and> V \<subseteq> span B \<and> (card B = dim V) \<and> pairwise orthogonal B"
  1.2384 +proof -
  1.2385 +  from basis_exists[of V] obtain B where
  1.2386 +    B: "B \<subseteq> V" "independent B" "V \<subseteq> span B" "card B = dim V"
  1.2387 +    by blast
  1.2388 +  from B have fB: "finite B" "card B = dim V"
  1.2389 +    using independent_bound by auto
  1.2390 +  from basis_orthogonal[OF fB(1)] obtain C where
  1.2391 +    C: "finite C" "card C \<le> card B" "span C = span B" "pairwise orthogonal C"
  1.2392 +    by blast
  1.2393 +  from C B have CSV: "C \<subseteq> span V"
  1.2394 +    by (metis span_inc span_mono subset_trans)
  1.2395 +  from span_mono[OF B(3)] C have SVC: "span V \<subseteq> span C"
  1.2396 +    by (simp add: span_span)
  1.2397 +  from card_le_dim_spanning[OF CSV SVC C(1)] C(2,3) fB
  1.2398 +  have iC: "independent C"
  1.2399 +    by (simp add: dim_span)
  1.2400 +  from C fB have "card C \<le> dim V"
  1.2401 +    by simp
  1.2402 +  moreover have "dim V \<le> card C"
  1.2403 +    using span_card_ge_dim[OF CSV SVC C(1)]
  1.2404 +    by (simp add: dim_span)
  1.2405 +  ultimately have CdV: "card C = dim V"
  1.2406 +    using C(1) by simp
  1.2407 +  from C B CSV CdV iC show ?thesis
  1.2408 +    by auto
  1.2409 +qed
  1.2410 +
  1.2411 +text \<open>Low-dimensional subset is in a hyperplane (weak orthogonal complement).\<close>
  1.2412 +
  1.2413 +lemma span_not_univ_orthogonal:
  1.2414 +  fixes S :: "'a::euclidean_space set"
  1.2415 +  assumes sU: "span S \<noteq> UNIV"
  1.2416 +  shows "\<exists>a::'a. a \<noteq> 0 \<and> (\<forall>x \<in> span S. a \<bullet> x = 0)"
  1.2417 +proof -
  1.2418 +  from sU obtain a where a: "a \<notin> span S"
  1.2419 +    by blast
  1.2420 +  from orthogonal_basis_exists obtain B where
  1.2421 +    B: "independent B" "B \<subseteq> span S" "S \<subseteq> span B" "card B = dim S" "pairwise orthogonal B"
  1.2422 +    by blast
  1.2423 +  from B have fB: "finite B" "card B = dim S"
  1.2424 +    using independent_bound by auto
  1.2425 +  from span_mono[OF B(2)] span_mono[OF B(3)]
  1.2426 +  have sSB: "span S = span B"
  1.2427 +    by (simp add: span_span)
  1.2428 +  let ?a = "a - setsum (\<lambda>b. (a \<bullet> b / (b \<bullet> b)) *\<^sub>R b) B"
  1.2429 +  have "setsum (\<lambda>b. (a \<bullet> b / (b \<bullet> b)) *\<^sub>R b) B \<in> span S"
  1.2430 +    unfolding sSB
  1.2431 +    apply (rule span_setsum)
  1.2432 +    apply (rule span_mul)
  1.2433 +    apply (rule span_superset)
  1.2434 +    apply assumption
  1.2435 +    done
  1.2436 +  with a have a0:"?a  \<noteq> 0"
  1.2437 +    by auto
  1.2438 +  have "\<forall>x\<in>span B. ?a \<bullet> x = 0"
  1.2439 +  proof (rule span_induct')
  1.2440 +    show "subspace {x. ?a \<bullet> x = 0}"
  1.2441 +      by (auto simp add: subspace_def inner_add)
  1.2442 +  next
  1.2443 +    {
  1.2444 +      fix x
  1.2445 +      assume x: "x \<in> B"
  1.2446 +      from x have B': "B = insert x (B - {x})"
  1.2447 +        by blast
  1.2448 +      have fth: "finite (B - {x})"
  1.2449 +        using fB by simp
  1.2450 +      have "?a \<bullet> x = 0"
  1.2451 +        apply (subst B')
  1.2452 +        using fB fth
  1.2453 +        unfolding setsum_clauses(2)[OF fth]
  1.2454 +        apply simp unfolding inner_simps
  1.2455 +        apply (clarsimp simp add: inner_add inner_setsum_left)
  1.2456 +        apply (rule setsum.neutral, rule ballI)
  1.2457 +        apply (simp only: inner_commute)
  1.2458 +        apply (auto simp add: x field_simps
  1.2459 +          intro: B(5)[unfolded pairwise_def orthogonal_def, rule_format])
  1.2460 +        done
  1.2461 +    }
  1.2462 +    then show "\<forall>x \<in> B. ?a \<bullet> x = 0"
  1.2463 +      by blast
  1.2464 +  qed
  1.2465 +  with a0 show ?thesis
  1.2466 +    unfolding sSB by (auto intro: exI[where x="?a"])
  1.2467 +qed
  1.2468 +
  1.2469 +lemma span_not_univ_subset_hyperplane:
  1.2470 +  fixes S :: "'a::euclidean_space set"
  1.2471 +  assumes SU: "span S \<noteq> UNIV"
  1.2472 +  shows "\<exists> a. a \<noteq>0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
  1.2473 +  using span_not_univ_orthogonal[OF SU] by auto
  1.2474 +
  1.2475 +lemma lowdim_subset_hyperplane:
  1.2476 +  fixes S :: "'a::euclidean_space set"
  1.2477 +  assumes d: "dim S < DIM('a)"
  1.2478 +  shows "\<exists>a::'a. a \<noteq> 0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
  1.2479 +proof -
  1.2480 +  {
  1.2481 +    assume "span S = UNIV"
  1.2482 +    then have "dim (span S) = dim (UNIV :: ('a) set)"
  1.2483 +      by simp
  1.2484 +    then have "dim S = DIM('a)"
  1.2485 +      by (simp add: dim_span dim_UNIV)
  1.2486 +    with d have False by arith
  1.2487 +  }
  1.2488 +  then have th: "span S \<noteq> UNIV"
  1.2489 +    by blast
  1.2490 +  from span_not_univ_subset_hyperplane[OF th] show ?thesis .
  1.2491 +qed
  1.2492 +
  1.2493 +text \<open>We can extend a linear basis-basis injection to the whole set.\<close>
  1.2494 +
  1.2495 +lemma linear_indep_image_lemma:
  1.2496 +  assumes lf: "linear f"
  1.2497 +    and fB: "finite B"
  1.2498 +    and ifB: "independent (f ` B)"
  1.2499 +    and fi: "inj_on f B"
  1.2500 +    and xsB: "x \<in> span B"
  1.2501 +    and fx: "f x = 0"
  1.2502 +  shows "x = 0"
  1.2503 +  using fB ifB fi xsB fx
  1.2504 +proof (induct arbitrary: x rule: finite_induct[OF fB])
  1.2505 +  case 1
  1.2506 +  then show ?case by auto
  1.2507 +next
  1.2508 +  case (2 a b x)
  1.2509 +  have fb: "finite b" using "2.prems" by simp
  1.2510 +  have th0: "f ` b \<subseteq> f ` (insert a b)"
  1.2511 +    apply (rule image_mono)
  1.2512 +    apply blast
  1.2513 +    done
  1.2514 +  from independent_mono[ OF "2.prems"(2) th0]
  1.2515 +  have ifb: "independent (f ` b)"  .
  1.2516 +  have fib: "inj_on f b"
  1.2517 +    apply (rule subset_inj_on [OF "2.prems"(3)])
  1.2518 +    apply blast
  1.2519 +    done
  1.2520 +  from span_breakdown[of a "insert a b", simplified, OF "2.prems"(4)]
  1.2521 +  obtain k where k: "x - k*\<^sub>R a \<in> span (b - {a})"
  1.2522 +    by blast
  1.2523 +  have "f (x - k*\<^sub>R a) \<in> span (f ` b)"
  1.2524 +    unfolding span_linear_image[OF lf]
  1.2525 +    apply (rule imageI)
  1.2526 +    using k span_mono[of "b - {a}" b]
  1.2527 +    apply blast
  1.2528 +    done
  1.2529 +  then have "f x - k*\<^sub>R f a \<in> span (f ` b)"
  1.2530 +    by (simp add: linear_diff[OF lf] linear_cmul[OF lf])
  1.2531 +  then have th: "-k *\<^sub>R f a \<in> span (f ` b)"
  1.2532 +    using "2.prems"(5) by simp
  1.2533 +  have xsb: "x \<in> span b"
  1.2534 +  proof (cases "k = 0")
  1.2535 +    case True
  1.2536 +    with k have "x \<in> span (b - {a})" by simp
  1.2537 +    then show ?thesis using span_mono[of "b - {a}" b]
  1.2538 +      by blast
  1.2539 +  next
  1.2540 +    case False
  1.2541 +    with span_mul[OF th, of "- 1/ k"]
  1.2542 +    have th1: "f a \<in> span (f ` b)"
  1.2543 +      by auto
  1.2544 +    from inj_on_image_set_diff[OF "2.prems"(3), of "insert a b " "{a}", symmetric]
  1.2545 +    have tha: "f ` insert a b - f ` {a} = f ` (insert a b - {a})" by blast
  1.2546 +    from "2.prems"(2) [unfolded dependent_def bex_simps(8), rule_format, of "f a"]
  1.2547 +    have "f a \<notin> span (f ` b)" using tha
  1.2548 +      using "2.hyps"(2)
  1.2549 +      "2.prems"(3) by auto
  1.2550 +    with th1 have False by blast
  1.2551 +    then show ?thesis by blast
  1.2552 +  qed
  1.2553 +  from "2.hyps"(3)[OF fb ifb fib xsb "2.prems"(5)] show "x = 0" .
  1.2554 +qed
  1.2555 +
  1.2556 +text \<open>Can construct an isomorphism between spaces of same dimension.\<close>
  1.2557 +
  1.2558 +lemma subspace_isomorphism:
  1.2559 +  fixes S :: "'a::euclidean_space set"
  1.2560 +    and T :: "'b::euclidean_space set"
  1.2561 +  assumes s: "subspace S"
  1.2562 +    and t: "subspace T"
  1.2563 +    and d: "dim S = dim T"
  1.2564 +  shows "\<exists>f. linear f \<and> f ` S = T \<and> inj_on f S"
  1.2565 +proof -
  1.2566 +  from basis_exists[of S] independent_bound
  1.2567 +  obtain B where B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "card B = dim S" and fB: "finite B"
  1.2568 +    by blast
  1.2569 +  from basis_exists[of T] independent_bound
  1.2570 +  obtain C where C: "C \<subseteq> T" "independent C" "T \<subseteq> span C" "card C = dim T" and fC: "finite C"
  1.2571 +    by blast
  1.2572 +  from B(4) C(4) card_le_inj[of B C] d
  1.2573 +  obtain f where f: "f ` B \<subseteq> C" "inj_on f B" using \<open>finite B\<close> \<open>finite C\<close>
  1.2574 +    by auto
  1.2575 +  from linear_independent_extend[OF B(2)]
  1.2576 +  obtain g where g: "linear g" "\<forall>x\<in> B. g x = f x"
  1.2577 +    by blast
  1.2578 +  from inj_on_iff_eq_card[OF fB, of f] f(2) have "card (f ` B) = card B"
  1.2579 +    by simp
  1.2580 +  with B(4) C(4) have ceq: "card (f ` B) = card C"
  1.2581 +    using d by simp
  1.2582 +  have "g ` B = f ` B"
  1.2583 +    using g(2) by (auto simp add: image_iff)
  1.2584 +  also have "\<dots> = C" using card_subset_eq[OF fC f(1) ceq] .
  1.2585 +  finally have gBC: "g ` B = C" .
  1.2586 +  have gi: "inj_on g B"
  1.2587 +    using f(2) g(2) by (auto simp add: inj_on_def)
  1.2588 +  note g0 = linear_indep_image_lemma[OF g(1) fB, unfolded gBC, OF C(2) gi]
  1.2589 +  {
  1.2590 +    fix x y
  1.2591 +    assume x: "x \<in> S" and y: "y \<in> S" and gxy: "g x = g y"
  1.2592 +    from B(3) x y have x': "x \<in> span B" and y': "y \<in> span B"
  1.2593 +      by blast+
  1.2594 +    from gxy have th0: "g (x - y) = 0"
  1.2595 +      by (simp add: linear_diff[OF g(1)])
  1.2596 +    have th1: "x - y \<in> span B"
  1.2597 +      using x' y' by (metis span_sub)
  1.2598 +    have "x = y"
  1.2599 +      using g0[OF th1 th0] by simp
  1.2600 +  }
  1.2601 +  then have giS: "inj_on g S"
  1.2602 +    unfolding inj_on_def by blast
  1.2603 +  from span_subspace[OF B(1,3) s] have "g ` S = span (g ` B)"
  1.2604 +    by (simp add: span_linear_image[OF g(1)])
  1.2605 +  also have "\<dots> = span C" unfolding gBC ..
  1.2606 +  also have "\<dots> = T" using span_subspace[OF C(1,3) t] .
  1.2607 +  finally have gS: "g ` S = T" .
  1.2608 +  from g(1) gS giS show ?thesis
  1.2609 +    by blast
  1.2610 +qed
  1.2611 +
  1.2612 +lemma linear_eq_stdbasis:
  1.2613 +  fixes f :: "'a::euclidean_space \<Rightarrow> _"
  1.2614 +  assumes lf: "linear f"
  1.2615 +    and lg: "linear g"
  1.2616 +    and fg: "\<forall>b\<in>Basis. f b = g b"
  1.2617 +  shows "f = g"
  1.2618 +  using linear_eq[OF lf lg, of _ Basis] fg by auto
  1.2619 +
  1.2620 +text \<open>Similar results for bilinear functions.\<close>
  1.2621 +
  1.2622 +lemma bilinear_eq:
  1.2623 +  assumes bf: "bilinear f"
  1.2624 +    and bg: "bilinear g"
  1.2625 +    and SB: "S \<subseteq> span B"
  1.2626 +    and TC: "T \<subseteq> span C"
  1.2627 +    and fg: "\<forall>x\<in> B. \<forall>y\<in> C. f x y = g x y"
  1.2628 +  shows "\<forall>x\<in>S. \<forall>y\<in>T. f x y = g x y "
  1.2629 +proof -
  1.2630 +  let ?P = "{x. \<forall>y\<in> span C. f x y = g x y}"
  1.2631 +  from bf bg have sp: "subspace ?P"
  1.2632 +    unfolding bilinear_def linear_iff subspace_def bf bg
  1.2633 +    by (auto simp add: span_0 bilinear_lzero[OF bf] bilinear_lzero[OF bg] span_add Ball_def
  1.2634 +      intro: bilinear_ladd[OF bf])
  1.2635 +
  1.2636 +  have "\<forall>x \<in> span B. \<forall>y\<in> span C. f x y = g x y"
  1.2637 +    apply (rule span_induct' [OF _ sp])
  1.2638 +    apply (rule ballI)
  1.2639 +    apply (rule span_induct')
  1.2640 +    apply (simp add: fg)
  1.2641 +    apply (auto simp add: subspace_def)
  1.2642 +    using bf bg unfolding bilinear_def linear_iff
  1.2643 +    apply (auto simp add: span_0 bilinear_rzero[OF bf] bilinear_rzero[OF bg] span_add Ball_def
  1.2644 +      intro: bilinear_ladd[OF bf])
  1.2645 +    done
  1.2646 +  then show ?thesis
  1.2647 +    using SB TC by auto
  1.2648 +qed
  1.2649 +
  1.2650 +lemma bilinear_eq_stdbasis:
  1.2651 +  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> _"
  1.2652 +  assumes bf: "bilinear f"
  1.2653 +    and bg: "bilinear g"
  1.2654 +    and fg: "\<forall>i\<in>Basis. \<forall>j\<in>Basis. f i j = g i j"
  1.2655 +  shows "f = g"
  1.2656 +  using bilinear_eq[OF bf bg equalityD2[OF span_Basis] equalityD2[OF span_Basis] fg] by blast
  1.2657 +
  1.2658 +text \<open>An injective map @{typ "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"} is also surjective.\<close>
  1.2659 +
  1.2660 +lemma linear_injective_imp_surjective:
  1.2661 +  fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  1.2662 +  assumes lf: "linear f"
  1.2663 +    and fi: "inj f"
  1.2664 +  shows "surj f"
  1.2665 +proof -
  1.2666 +  let ?U = "UNIV :: 'a set"
  1.2667 +  from basis_exists[of ?U] obtain B
  1.2668 +    where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" "card B = dim ?U"
  1.2669 +    by blast
  1.2670 +  from B(4) have d: "dim ?U = card B"
  1.2671 +    by simp
  1.2672 +  have th: "?U \<subseteq> span (f ` B)"
  1.2673 +    apply (rule card_ge_dim_independent)
  1.2674 +    apply blast
  1.2675 +    apply (rule independent_injective_image[OF B(2) lf fi])
  1.2676 +    apply (rule order_eq_refl)
  1.2677 +    apply (rule sym)
  1.2678 +    unfolding d
  1.2679 +    apply (rule card_image)
  1.2680 +    apply (rule subset_inj_on[OF fi])
  1.2681 +    apply blast
  1.2682 +    done
  1.2683 +  from th show ?thesis
  1.2684 +    unfolding span_linear_image[OF lf] surj_def
  1.2685 +    using B(3) by blast
  1.2686 +qed
  1.2687 +
  1.2688 +text \<open>And vice versa.\<close>
  1.2689 +
  1.2690 +lemma surjective_iff_injective_gen:
  1.2691 +  assumes fS: "finite S"
  1.2692 +    and fT: "finite T"
  1.2693 +    and c: "card S = card T"
  1.2694 +    and ST: "f ` S \<subseteq> T"
  1.2695 +  shows "(\<forall>y \<in> T. \<exists>x \<in> S. f x = y) \<longleftrightarrow> inj_on f S"
  1.2696 +  (is "?lhs \<longleftrightarrow> ?rhs")
  1.2697 +proof
  1.2698 +  assume h: "?lhs"
  1.2699 +  {
  1.2700 +    fix x y
  1.2701 +    assume x: "x \<in> S"
  1.2702 +    assume y: "y \<in> S"
  1.2703 +    assume f: "f x = f y"
  1.2704 +    from x fS have S0: "card S \<noteq> 0"
  1.2705 +      by auto
  1.2706 +    have "x = y"
  1.2707 +    proof (rule ccontr)
  1.2708 +      assume xy: "\<not> ?thesis"
  1.2709 +      have th: "card S \<le> card (f ` (S - {y}))"
  1.2710 +        unfolding c
  1.2711 +        apply (rule card_mono)
  1.2712 +        apply (rule finite_imageI)
  1.2713 +        using fS apply simp
  1.2714 +        using h xy x y f unfolding subset_eq image_iff
  1.2715 +        apply auto
  1.2716 +        apply (case_tac "xa = f x")
  1.2717 +        apply (rule bexI[where x=x])
  1.2718 +        apply auto
  1.2719 +        done
  1.2720 +      also have " \<dots> \<le> card (S - {y})"
  1.2721 +        apply (rule card_image_le)
  1.2722 +        using fS by simp
  1.2723 +      also have "\<dots> \<le> card S - 1" using y fS by simp
  1.2724 +      finally show False using S0 by arith
  1.2725 +    qed
  1.2726 +  }
  1.2727 +  then show ?rhs
  1.2728 +    unfolding inj_on_def by blast
  1.2729 +next
  1.2730 +  assume h: ?rhs
  1.2731 +  have "f ` S = T"
  1.2732 +    apply (rule card_subset_eq[OF fT ST])
  1.2733 +    unfolding card_image[OF h]
  1.2734 +    apply (rule c)
  1.2735 +    done
  1.2736 +  then show ?lhs by blast
  1.2737 +qed
  1.2738 +
  1.2739 +lemma linear_surjective_imp_injective:
  1.2740 +  fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  1.2741 +  assumes lf: "linear f"
  1.2742 +    and sf: "surj f"
  1.2743 +  shows "inj f"
  1.2744 +proof -
  1.2745 +  let ?U = "UNIV :: 'a set"
  1.2746 +  from basis_exists[of ?U] obtain B
  1.2747 +    where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" and d: "card B = dim ?U"
  1.2748 +    by blast
  1.2749 +  {
  1.2750 +    fix x
  1.2751 +    assume x: "x \<in> span B"
  1.2752 +    assume fx: "f x = 0"
  1.2753 +    from B(2) have fB: "finite B"
  1.2754 +      using independent_bound by auto
  1.2755 +    have fBi: "independent (f ` B)"
  1.2756 +      apply (rule card_le_dim_spanning[of "f ` B" ?U])
  1.2757 +      apply blast
  1.2758 +      using sf B(3)
  1.2759 +      unfolding span_linear_image[OF lf] surj_def subset_eq image_iff
  1.2760 +      apply blast
  1.2761 +      using fB apply blast
  1.2762 +      unfolding d[symmetric]
  1.2763 +      apply (rule card_image_le)
  1.2764 +      apply (rule fB)
  1.2765 +      done
  1.2766 +    have th0: "dim ?U \<le> card (f ` B)"
  1.2767 +      apply (rule span_card_ge_dim)
  1.2768 +      apply blast
  1.2769 +      unfolding span_linear_image[OF lf]
  1.2770 +      apply (rule subset_trans[where B = "f ` UNIV"])
  1.2771 +      using sf unfolding surj_def
  1.2772 +      apply blast
  1.2773 +      apply (rule image_mono)
  1.2774 +      apply (rule B(3))
  1.2775 +      apply (metis finite_imageI fB)
  1.2776 +      done
  1.2777 +    moreover have "card (f ` B) \<le> card B"
  1.2778 +      by (rule card_image_le, rule fB)
  1.2779 +    ultimately have th1: "card B = card (f ` B)"
  1.2780 +      unfolding d by arith
  1.2781 +    have fiB: "inj_on f B"
  1.2782 +      unfolding surjective_iff_injective_gen[OF fB finite_imageI[OF fB] th1 subset_refl, symmetric]
  1.2783 +      by blast
  1.2784 +    from linear_indep_image_lemma[OF lf fB fBi fiB x] fx
  1.2785 +    have "x = 0" by blast
  1.2786 +  }
  1.2787 +  then show ?thesis
  1.2788 +    unfolding linear_injective_0[OF lf]
  1.2789 +    using B(3)
  1.2790 +    by blast
  1.2791 +qed
  1.2792 +
  1.2793 +text \<open>Hence either is enough for isomorphism.\<close>
  1.2794 +
  1.2795 +lemma left_right_inverse_eq:
  1.2796 +  assumes fg: "f \<circ> g = id"
  1.2797 +    and gh: "g \<circ> h = id"
  1.2798 +  shows "f = h"
  1.2799 +proof -
  1.2800 +  have "f = f \<circ> (g \<circ> h)"
  1.2801 +    unfolding gh by simp
  1.2802 +  also have "\<dots> = (f \<circ> g) \<circ> h"
  1.2803 +    by (simp add: o_assoc)
  1.2804 +  finally show "f = h"
  1.2805 +    unfolding fg by simp
  1.2806 +qed
  1.2807 +
  1.2808 +lemma isomorphism_expand:
  1.2809 +  "f \<circ> g = id \<and> g \<circ> f = id \<longleftrightarrow> (\<forall>x. f (g x) = x) \<and> (\<forall>x. g (f x) = x)"
  1.2810 +  by (simp add: fun_eq_iff o_def id_def)
  1.2811 +
  1.2812 +lemma linear_injective_isomorphism:
  1.2813 +  fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  1.2814 +  assumes lf: "linear f"
  1.2815 +    and fi: "inj f"
  1.2816 +  shows "\<exists>f'. linear f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)"
  1.2817 +  unfolding isomorphism_expand[symmetric]
  1.2818 +  using linear_surjective_right_inverse[OF lf linear_injective_imp_surjective[OF lf fi]]
  1.2819 +    linear_injective_left_inverse[OF lf fi]
  1.2820 +  by (metis left_right_inverse_eq)
  1.2821 +
  1.2822 +lemma linear_surjective_isomorphism:
  1.2823 +  fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  1.2824 +  assumes lf: "linear f"
  1.2825 +    and sf: "surj f"
  1.2826 +  shows "\<exists>f'. linear f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)"
  1.2827 +  unfolding isomorphism_expand[symmetric]
  1.2828 +  using linear_surjective_right_inverse[OF lf sf]
  1.2829 +    linear_injective_left_inverse[OF lf linear_surjective_imp_injective[OF lf sf]]
  1.2830 +  by (metis left_right_inverse_eq)
  1.2831 +
  1.2832 +text \<open>Left and right inverses are the same for
  1.2833 +  @{typ "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"}.\<close>
  1.2834 +
  1.2835 +lemma linear_inverse_left:
  1.2836 +  fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  1.2837 +  assumes lf: "linear f"
  1.2838 +    and lf': "linear f'"
  1.2839 +  shows "f \<circ> f' = id \<longleftrightarrow> f' \<circ> f = id"
  1.2840 +proof -
  1.2841 +  {
  1.2842 +    fix f f':: "'a \<Rightarrow> 'a"
  1.2843 +    assume lf: "linear f" "linear f'"
  1.2844 +    assume f: "f \<circ> f' = id"
  1.2845 +    from f have sf: "surj f"
  1.2846 +      apply (auto simp add: o_def id_def surj_def)
  1.2847 +      apply metis
  1.2848 +      done
  1.2849 +    from linear_surjective_isomorphism[OF lf(1) sf] lf f
  1.2850 +    have "f' \<circ> f = id"
  1.2851 +      unfolding fun_eq_iff o_def id_def by metis
  1.2852 +  }
  1.2853 +  then show ?thesis
  1.2854 +    using lf lf' by metis
  1.2855 +qed
  1.2856 +
  1.2857 +text \<open>Moreover, a one-sided inverse is automatically linear.\<close>
  1.2858 +
  1.2859 +lemma left_inverse_linear:
  1.2860 +  fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  1.2861 +  assumes lf: "linear f"
  1.2862 +    and gf: "g \<circ> f = id"
  1.2863 +  shows "linear g"
  1.2864 +proof -
  1.2865 +  from gf have fi: "inj f"
  1.2866 +    apply (auto simp add: inj_on_def o_def id_def fun_eq_iff)
  1.2867 +    apply metis
  1.2868 +    done
  1.2869 +  from linear_injective_isomorphism[OF lf fi]
  1.2870 +  obtain h :: "'a \<Rightarrow> 'a" where h: "linear h" "\<forall>x. h (f x) = x" "\<forall>x. f (h x) = x"
  1.2871 +    by blast
  1.2872 +  have "h = g"
  1.2873 +    apply (rule ext) using gf h(2,3)
  1.2874 +    apply (simp add: o_def id_def fun_eq_iff)
  1.2875 +    apply metis
  1.2876 +    done
  1.2877 +  with h(1) show ?thesis by blast
  1.2878 +qed
  1.2879 +
  1.2880 +lemma inj_linear_imp_inv_linear:
  1.2881 +  fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  1.2882 +  assumes "linear f" "inj f" shows "linear (inv f)"
  1.2883 +using assms inj_iff left_inverse_linear by blast
  1.2884 +
  1.2885 +
  1.2886 +subsection \<open>Infinity norm\<close>
  1.2887 +
  1.2888 +definition "infnorm (x::'a::euclidean_space) = Sup {\<bar>x \<bullet> b\<bar> |b. b \<in> Basis}"
  1.2889 +
  1.2890 +lemma infnorm_set_image:
  1.2891 +  fixes x :: "'a::euclidean_space"
  1.2892 +  shows "{\<bar>x \<bullet> i\<bar> |i. i \<in> Basis} = (\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis"
  1.2893 +  by blast
  1.2894 +
  1.2895 +lemma infnorm_Max:
  1.2896 +  fixes x :: "'a::euclidean_space"
  1.2897 +  shows "infnorm x = Max ((\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis)"
  1.2898 +  by (simp add: infnorm_def infnorm_set_image cSup_eq_Max)
  1.2899 +
  1.2900 +lemma infnorm_set_lemma:
  1.2901 +  fixes x :: "'a::euclidean_space"
  1.2902 +  shows "finite {\<bar>x \<bullet> i\<bar> |i. i \<in> Basis}"
  1.2903 +    and "{\<bar>x \<bullet> i\<bar> |i. i \<in> Basis} \<noteq> {}"
  1.2904 +  unfolding infnorm_set_image
  1.2905 +  by auto
  1.2906 +
  1.2907 +lemma infnorm_pos_le:
  1.2908 +  fixes x :: "'a::euclidean_space"
  1.2909 +  shows "0 \<le> infnorm x"
  1.2910 +  by (simp add: infnorm_Max Max_ge_iff ex_in_conv)
  1.2911 +
  1.2912 +lemma infnorm_triangle:
  1.2913 +  fixes x :: "'a::euclidean_space"
  1.2914 +  shows "infnorm (x + y) \<le> infnorm x + infnorm y"
  1.2915 +proof -
  1.2916 +  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"
  1.2917 +    by simp
  1.2918 +  show ?thesis
  1.2919 +    by (auto simp: infnorm_Max inner_add_left intro!: *)
  1.2920 +qed
  1.2921 +
  1.2922 +lemma infnorm_eq_0:
  1.2923 +  fixes x :: "'a::euclidean_space"
  1.2924 +  shows "infnorm x = 0 \<longleftrightarrow> x = 0"
  1.2925 +proof -
  1.2926 +  have "infnorm x \<le> 0 \<longleftrightarrow> x = 0"
  1.2927 +    unfolding infnorm_Max by (simp add: euclidean_all_zero_iff)
  1.2928 +  then show ?thesis
  1.2929 +    using infnorm_pos_le[of x] by simp
  1.2930 +qed
  1.2931 +
  1.2932 +lemma infnorm_0: "infnorm 0 = 0"
  1.2933 +  by (simp add: infnorm_eq_0)
  1.2934 +
  1.2935 +lemma infnorm_neg: "infnorm (- x) = infnorm x"
  1.2936 +  unfolding infnorm_def
  1.2937 +  apply (rule cong[of "Sup" "Sup"])
  1.2938 +  apply blast
  1.2939 +  apply auto
  1.2940 +  done
  1.2941 +
  1.2942 +lemma infnorm_sub: "infnorm (x - y) = infnorm (y - x)"
  1.2943 +proof -
  1.2944 +  have "y - x = - (x - y)" by simp
  1.2945 +  then show ?thesis
  1.2946 +    by (metis infnorm_neg)
  1.2947 +qed
  1.2948 +
  1.2949 +lemma real_abs_sub_infnorm: "\<bar>infnorm x - infnorm y\<bar> \<le> infnorm (x - y)"
  1.2950 +proof -
  1.2951 +  have th: "\<And>(nx::real) n ny. nx \<le> n + ny \<Longrightarrow> ny \<le> n + nx \<Longrightarrow> \<bar>nx - ny\<bar> \<le> n"
  1.2952 +    by arith
  1.2953 +  from infnorm_triangle[of "x - y" " y"] infnorm_triangle[of "x - y" "-x"]
  1.2954 +  have ths: "infnorm x \<le> infnorm (x - y) + infnorm y"
  1.2955 +    "infnorm y \<le> infnorm (x - y) + infnorm x"
  1.2956 +    by (simp_all add: field_simps infnorm_neg)
  1.2957 +  from th[OF ths] show ?thesis .
  1.2958 +qed
  1.2959 +
  1.2960 +lemma real_abs_infnorm: "\<bar>infnorm x\<bar> = infnorm x"
  1.2961 +  using infnorm_pos_le[of x] by arith
  1.2962 +
  1.2963 +lemma Basis_le_infnorm:
  1.2964 +  fixes x :: "'a::euclidean_space"
  1.2965 +  shows "b \<in> Basis \<Longrightarrow> \<bar>x \<bullet> b\<bar> \<le> infnorm x"
  1.2966 +  by (simp add: infnorm_Max)
  1.2967 +
  1.2968 +lemma infnorm_mul: "infnorm (a *\<^sub>R x) = \<bar>a\<bar> * infnorm x"
  1.2969 +  unfolding infnorm_Max
  1.2970 +proof (safe intro!: Max_eqI)
  1.2971 +  let ?B = "(\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis"
  1.2972 +  {
  1.2973 +    fix b :: 'a
  1.2974 +    assume "b \<in> Basis"
  1.2975 +    then show "\<bar>a *\<^sub>R x \<bullet> b\<bar> \<le> \<bar>a\<bar> * Max ?B"
  1.2976 +      by (simp add: abs_mult mult_left_mono)
  1.2977 +  next
  1.2978 +    from Max_in[of ?B] obtain b where "b \<in> Basis" "Max ?B = \<bar>x \<bullet> b\<bar>"
  1.2979 +      by (auto simp del: Max_in)
  1.2980 +    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"
  1.2981 +      by (intro image_eqI[where x=b]) (auto simp: abs_mult)
  1.2982 +  }
  1.2983 +qed simp
  1.2984 +
  1.2985 +lemma infnorm_mul_lemma: "infnorm (a *\<^sub>R x) \<le> \<bar>a\<bar> * infnorm x"
  1.2986 +  unfolding infnorm_mul ..
  1.2987 +
  1.2988 +lemma infnorm_pos_lt: "infnorm x > 0 \<longleftrightarrow> x \<noteq> 0"
  1.2989 +  using infnorm_pos_le[of x] infnorm_eq_0[of x] by arith
  1.2990 +
  1.2991 +text \<open>Prove that it differs only up to a bound from Euclidean norm.\<close>
  1.2992 +
  1.2993 +lemma infnorm_le_norm: "infnorm x \<le> norm x"
  1.2994 +  by (simp add: Basis_le_norm infnorm_Max)
  1.2995 +
  1.2996 +lemma (in euclidean_space) euclidean_inner: "inner x y = (\<Sum>b\<in>Basis. (x \<bullet> b) * (y \<bullet> b))"
  1.2997 +  by (subst (1 2) euclidean_representation [symmetric])
  1.2998 +    (simp add: inner_setsum_right inner_Basis ac_simps)
  1.2999 +
  1.3000 +lemma norm_le_infnorm:
  1.3001 +  fixes x :: "'a::euclidean_space"
  1.3002 +  shows "norm x \<le> sqrt DIM('a) * infnorm x"
  1.3003 +proof -
  1.3004 +  let ?d = "DIM('a)"
  1.3005 +  have "real ?d \<ge> 0"
  1.3006 +    by simp
  1.3007 +  then have d2: "(sqrt (real ?d))\<^sup>2 = real ?d"
  1.3008 +    by (auto intro: real_sqrt_pow2)
  1.3009 +  have th: "sqrt (real ?d) * infnorm x \<ge> 0"
  1.3010 +    by (simp add: zero_le_mult_iff infnorm_pos_le)
  1.3011 +  have th1: "x \<bullet> x \<le> (sqrt (real ?d) * infnorm x)\<^sup>2"
  1.3012 +    unfolding power_mult_distrib d2
  1.3013 +    apply (subst euclidean_inner)
  1.3014 +    apply (subst power2_abs[symmetric])
  1.3015 +    apply (rule order_trans[OF setsum_bounded_above[where K="\<bar>infnorm x\<bar>\<^sup>2"]])
  1.3016 +    apply (auto simp add: power2_eq_square[symmetric])
  1.3017 +    apply (subst power2_abs[symmetric])
  1.3018 +    apply (rule power_mono)
  1.3019 +    apply (auto simp: infnorm_Max)
  1.3020 +    done
  1.3021 +  from real_le_lsqrt[OF inner_ge_zero th th1]
  1.3022 +  show ?thesis
  1.3023 +    unfolding norm_eq_sqrt_inner id_def .
  1.3024 +qed
  1.3025 +
  1.3026 +lemma tendsto_infnorm [tendsto_intros]:
  1.3027 +  assumes "(f \<longlongrightarrow> a) F"
  1.3028 +  shows "((\<lambda>x. infnorm (f x)) \<longlongrightarrow> infnorm a) F"
  1.3029 +proof (rule tendsto_compose [OF LIM_I assms])
  1.3030 +  fix r :: real
  1.3031 +  assume "r > 0"
  1.3032 +  then show "\<exists>s>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < s \<longrightarrow> norm (infnorm x - infnorm a) < r"
  1.3033 +    by (metis real_norm_def le_less_trans real_abs_sub_infnorm infnorm_le_norm)
  1.3034 +qed
  1.3035 +
  1.3036 +text \<open>Equality in Cauchy-Schwarz and triangle inequalities.\<close>
  1.3037 +
  1.3038 +lemma norm_cauchy_schwarz_eq: "x \<bullet> y = norm x * norm y \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
  1.3039 +  (is "?lhs \<longleftrightarrow> ?rhs")
  1.3040 +proof -
  1.3041 +  {
  1.3042 +    assume h: "x = 0"
  1.3043 +    then have ?thesis by simp
  1.3044 +  }
  1.3045 +  moreover
  1.3046 +  {
  1.3047 +    assume h: "y = 0"
  1.3048 +    then have ?thesis by simp
  1.3049 +  }
  1.3050 +  moreover
  1.3051 +  {
  1.3052 +    assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
  1.3053 +    from inner_eq_zero_iff[of "norm y *\<^sub>R x - norm x *\<^sub>R y"]
  1.3054 +    have "?rhs \<longleftrightarrow>
  1.3055 +      (norm y * (norm y * norm x * norm x - norm x * (x \<bullet> y)) -
  1.3056 +        norm x * (norm y * (y \<bullet> x) - norm x * norm y * norm y) =  0)"
  1.3057 +      using x y
  1.3058 +      unfolding inner_simps
  1.3059 +      unfolding power2_norm_eq_inner[symmetric] power2_eq_square right_minus_eq
  1.3060 +      apply (simp add: inner_commute)
  1.3061 +      apply (simp add: field_simps)
  1.3062 +      apply metis
  1.3063 +      done
  1.3064 +    also have "\<dots> \<longleftrightarrow> (2 * norm x * norm y * (norm x * norm y - x \<bullet> y) = 0)" using x y
  1.3065 +      by (simp add: field_simps inner_commute)
  1.3066 +    also have "\<dots> \<longleftrightarrow> ?lhs" using x y
  1.3067 +      apply simp
  1.3068 +      apply metis
  1.3069 +      done
  1.3070 +    finally have ?thesis by blast
  1.3071 +  }
  1.3072 +  ultimately show ?thesis by blast
  1.3073 +qed
  1.3074 +
  1.3075 +lemma norm_cauchy_schwarz_abs_eq:
  1.3076 +  "\<bar>x \<bullet> y\<bar> = norm x * norm y \<longleftrightarrow>
  1.3077 +    norm x *\<^sub>R y = norm y *\<^sub>R x \<or> norm x *\<^sub>R y = - norm y *\<^sub>R x"
  1.3078 +  (is "?lhs \<longleftrightarrow> ?rhs")
  1.3079 +proof -
  1.3080 +  have th: "\<And>(x::real) a. a \<ge> 0 \<Longrightarrow> \<bar>x\<bar> = a \<longleftrightarrow> x = a \<or> x = - a"
  1.3081 +    by arith
  1.3082 +  have "?rhs \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x \<or> norm (- x) *\<^sub>R y = norm y *\<^sub>R (- x)"
  1.3083 +    by simp
  1.3084 +  also have "\<dots> \<longleftrightarrow>(x \<bullet> y = norm x * norm y \<or> (- x) \<bullet> y = norm x * norm y)"
  1.3085 +    unfolding norm_cauchy_schwarz_eq[symmetric]
  1.3086 +    unfolding norm_minus_cancel norm_scaleR ..
  1.3087 +  also have "\<dots> \<longleftrightarrow> ?lhs"
  1.3088 +    unfolding th[OF mult_nonneg_nonneg, OF norm_ge_zero[of x] norm_ge_zero[of y]] inner_simps
  1.3089 +    by auto
  1.3090 +  finally show ?thesis ..
  1.3091 +qed
  1.3092 +
  1.3093 +lemma norm_triangle_eq:
  1.3094 +  fixes x y :: "'a::real_inner"
  1.3095 +  shows "norm (x + y) = norm x + norm y \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
  1.3096 +proof -
  1.3097 +  {
  1.3098 +    assume x: "x = 0 \<or> y = 0"
  1.3099 +    then have ?thesis
  1.3100 +      by (cases "x = 0") simp_all
  1.3101 +  }
  1.3102 +  moreover
  1.3103 +  {
  1.3104 +    assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
  1.3105 +    then have "norm x \<noteq> 0" "norm y \<noteq> 0"
  1.3106 +      by simp_all
  1.3107 +    then have n: "norm x > 0" "norm y > 0"
  1.3108 +      using norm_ge_zero[of x] norm_ge_zero[of y] by arith+
  1.3109 +    have th: "\<And>(a::real) b c. a + b + c \<noteq> 0 \<Longrightarrow> a = b + c \<longleftrightarrow> a\<^sup>2 = (b + c)\<^sup>2"
  1.3110 +      by algebra
  1.3111 +    have "norm (x + y) = norm x + norm y \<longleftrightarrow> (norm (x + y))\<^sup>2 = (norm x + norm y)\<^sup>2"
  1.3112 +      apply (rule th)
  1.3113 +      using n norm_ge_zero[of "x + y"]
  1.3114 +      apply arith
  1.3115 +      done
  1.3116 +    also have "\<dots> \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
  1.3117 +      unfolding norm_cauchy_schwarz_eq[symmetric]
  1.3118 +      unfolding power2_norm_eq_inner inner_simps
  1.3119 +      by (simp add: power2_norm_eq_inner[symmetric] power2_eq_square inner_commute field_simps)
  1.3120 +    finally have ?thesis .
  1.3121 +  }
  1.3122 +  ultimately show ?thesis by blast
  1.3123 +qed
  1.3124 +
  1.3125 +
  1.3126 +subsection \<open>Collinearity\<close>
  1.3127 +
  1.3128 +definition collinear :: "'a::real_vector set \<Rightarrow> bool"
  1.3129 +  where "collinear S \<longleftrightarrow> (\<exists>u. \<forall>x \<in> S. \<forall> y \<in> S. \<exists>c. x - y = c *\<^sub>R u)"
  1.3130 +
  1.3131 +lemma collinear_empty [iff]: "collinear {}"
  1.3132 +  by (simp add: collinear_def)
  1.3133 +
  1.3134 +lemma collinear_sing [iff]: "collinear {x}"
  1.3135 +  by (simp add: collinear_def)
  1.3136 +
  1.3137 +lemma collinear_2 [iff]: "collinear {x, y}"
  1.3138 +  apply (simp add: collinear_def)
  1.3139 +  apply (rule exI[where x="x - y"])
  1.3140 +  apply auto
  1.3141 +  apply (rule exI[where x=1], simp)
  1.3142 +  apply (rule exI[where x="- 1"], simp)
  1.3143 +  done
  1.3144 +
  1.3145 +lemma collinear_lemma: "collinear {0, x, y} \<longleftrightarrow> x = 0 \<or> y = 0 \<or> (\<exists>c. y = c *\<^sub>R x)"
  1.3146 +  (is "?lhs \<longleftrightarrow> ?rhs")
  1.3147 +proof -
  1.3148 +  {
  1.3149 +    assume "x = 0 \<or> y = 0"
  1.3150 +    then have ?thesis
  1.3151 +      by (cases "x = 0") (simp_all add: collinear_2 insert_commute)
  1.3152 +  }
  1.3153 +  moreover
  1.3154 +  {
  1.3155 +    assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
  1.3156 +    have ?thesis
  1.3157 +    proof
  1.3158 +      assume h: "?lhs"
  1.3159 +      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"
  1.3160 +        unfolding collinear_def by blast
  1.3161 +      from u[rule_format, of x 0] u[rule_format, of y 0]
  1.3162 +      obtain cx and cy where
  1.3163 +        cx: "x = cx *\<^sub>R u" and cy: "y = cy *\<^sub>R u"
  1.3164 +        by auto
  1.3165 +      from cx x have cx0: "cx \<noteq> 0" by auto
  1.3166 +      from cy y have cy0: "cy \<noteq> 0" by auto
  1.3167 +      let ?d = "cy / cx"
  1.3168 +      from cx cy cx0 have "y = ?d *\<^sub>R x"
  1.3169 +        by simp
  1.3170 +      then show ?rhs using x y by blast
  1.3171 +    next
  1.3172 +      assume h: "?rhs"
  1.3173 +      then obtain c where c: "y = c *\<^sub>R x"
  1.3174 +        using x y by blast
  1.3175 +      show ?lhs
  1.3176 +        unfolding collinear_def c
  1.3177 +        apply (rule exI[where x=x])
  1.3178 +        apply auto
  1.3179 +        apply (rule exI[where x="- 1"], simp)
  1.3180 +        apply (rule exI[where x= "-c"], simp)
  1.3181 +        apply (rule exI[where x=1], simp)
  1.3182 +        apply (rule exI[where x="1 - c"], simp add: scaleR_left_diff_distrib)
  1.3183 +        apply (rule exI[where x="c - 1"], simp add: scaleR_left_diff_distrib)
  1.3184 +        done
  1.3185 +    qed
  1.3186 +  }
  1.3187 +  ultimately show ?thesis by blast
  1.3188 +qed
  1.3189 +
  1.3190 +lemma norm_cauchy_schwarz_equal: "\<bar>x \<bullet> y\<bar> = norm x * norm y \<longleftrightarrow> collinear {0, x, y}"
  1.3191 +  unfolding norm_cauchy_schwarz_abs_eq
  1.3192 +  apply (cases "x=0", simp_all)
  1.3193 +  apply (cases "y=0", simp_all add: insert_commute)
  1.3194 +  unfolding collinear_lemma
  1.3195 +  apply simp
  1.3196 +  apply (subgoal_tac "norm x \<noteq> 0")
  1.3197 +  apply (subgoal_tac "norm y \<noteq> 0")
  1.3198 +  apply (rule iffI)
  1.3199 +  apply (cases "norm x *\<^sub>R y = norm y *\<^sub>R x")
  1.3200 +  apply (rule exI[where x="(1/norm x) * norm y"])
  1.3201 +  apply (drule sym)
  1.3202 +  unfolding scaleR_scaleR[symmetric]
  1.3203 +  apply (simp add: field_simps)
  1.3204 +  apply (rule exI[where x="(1/norm x) * - norm y"])
  1.3205 +  apply clarify
  1.3206 +  apply (drule sym)
  1.3207 +  unfolding scaleR_scaleR[symmetric]
  1.3208 +  apply (simp add: field_simps)
  1.3209 +  apply (erule exE)
  1.3210 +  apply (erule ssubst)
  1.3211 +  unfolding scaleR_scaleR
  1.3212 +  unfolding norm_scaleR
  1.3213 +  apply (subgoal_tac "norm x * c = \<bar>c\<bar> * norm x \<or> norm x * c = - \<bar>c\<bar> * norm x")
  1.3214 +  apply (auto simp add: field_simps)
  1.3215 +  done
  1.3216 +
  1.3217 +end