diff --git a/src/HOL/Analysis/Cartesian_Space.thy b/src/HOL/Analysis/Cartesian_Space.thy
--- a/src/HOL/Analysis/Cartesian_Space.thy
+++ b/src/HOL/Analysis/Cartesian_Space.thy
@@ -1,1441 +1,1442 @@
 (*  Title:      HOL/Analysis/Cartesian_Space.thy
     Author:     Amine Chaieb, University of Cambridge
     Author:     Jose Divasón <jose.divasonm at unirioja.es>
     Author:     Jesús Aransay <jesus-maria.aransay at unirioja.es>
     Author:     Johannes Hölzl, VU Amsterdam
     Author:     Fabian Immler, TUM
 *)
 
 section "Linear Algebra on Finite Cartesian Products"
 
 theory Cartesian_Space
   imports
     Finite_Cartesian_Product Linear_Algebra
 begin
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Type @{typ \<open>'a ^ 'n\<close>} and fields as vector spaces\<close> (*much of the following
 is really basic linear algebra, check for overlap? rename subsection?  *)
 
 definition "cart_basis = {axis i 1 | i. i\<in>UNIV}"
 
 lemma finite_cart_basis: "finite (cart_basis)" unfolding cart_basis_def
   using finite_Atleast_Atmost_nat by fastforce
 
 lemma card_cart_basis: "card (cart_basis::('a::zero_neq_one^'i) set) = CARD('i)"
   unfolding cart_basis_def Setcompr_eq_image
   by (rule card_image) (auto simp: inj_on_def axis_eq_axis)
 
 interpretation vec: vector_space "(*s) "
   by unfold_locales (vector algebra_simps)+
 
 lemma independent_cart_basis:
   "vec.independent (cart_basis)"
 proof (rule vec.independent_if_scalars_zero)
   show "finite (cart_basis)" using finite_cart_basis .
   fix f::"('a, 'b) vec \<Rightarrow> 'a" and x::"('a, 'b) vec"
   assume eq_0: "(\<Sum>x\<in>cart_basis. f x *s x) = 0" and x_in: "x \<in> cart_basis"
   obtain i where x: "x = axis i 1" using x_in unfolding cart_basis_def by auto
   have sum_eq_0: "(\<Sum>x\<in>(cart_basis) - {x}. f x * (x $ i)) = 0"
   proof (rule sum.neutral, rule ballI)
     fix xa assume xa: "xa \<in> cart_basis - {x}"
     obtain a where a: "xa = axis a 1" and a_not_i: "a \<noteq> i"
       using xa x unfolding cart_basis_def by auto
     have "xa $ i = 0" unfolding a axis_def using a_not_i by auto
     thus "f xa * xa $ i = 0" by simp
   qed
   have "0 = (\<Sum>x\<in>cart_basis. f x *s x) $ i" using eq_0 by simp
   also have "... = (\<Sum>x\<in>cart_basis. (f x *s x) $ i)" unfolding sum_component ..
   also have "... = (\<Sum>x\<in>cart_basis. f x * (x $ i))" unfolding vector_smult_component ..
   also have "... = f x * (x $ i) + (\<Sum>x\<in>(cart_basis) - {x}. f x * (x $ i))"
     by (rule sum.remove[OF finite_cart_basis x_in])
   also have "... =  f x * (x $ i)" unfolding sum_eq_0 by simp
   also have "... = f x" unfolding x axis_def by auto
   finally show "f x = 0" ..
 qed
 
 lemma span_cart_basis:
   "vec.span (cart_basis) = UNIV"
 proof (auto)
   fix x::"('a, 'b) vec"
   let ?f="\<lambda>v. x $ (THE i. v = axis i 1)"
   show "x \<in> vec.span (cart_basis)"
     apply (unfold vec.span_finite[OF finite_cart_basis])
     apply (rule image_eqI[of _ _ ?f])
      apply (subst  vec_eq_iff)
      apply clarify
   proof -
     fix i::'b
     let ?w = "axis i (1::'a)"
     have the_eq_i: "(THE a. ?w = axis a 1) = i"
       by (rule the_equality, auto simp: axis_eq_axis)
     have sum_eq_0: "(\<Sum>v\<in>(cart_basis) - {?w}. x $ (THE i. v = axis i 1) * v $ i) = 0"
     proof (rule sum.neutral, rule ballI)
       fix xa::"('a, 'b) vec"
       assume xa: "xa \<in> cart_basis - {?w}"
       obtain j where j: "xa = axis j 1" and i_not_j: "i \<noteq> j" using xa unfolding cart_basis_def by auto
       have the_eq_j: "(THE i. xa = axis i 1) = j"
       proof (rule the_equality)
         show "xa = axis j 1" using j .
         show "\<And>i. xa = axis i 1 \<Longrightarrow> i = j" by (metis axis_eq_axis j zero_neq_one)
       qed
       show "x $ (THE i. xa = axis i 1) * xa $ i = 0"
         apply (subst (2) j)
         unfolding the_eq_j unfolding axis_def using i_not_j by simp
     qed
     have "(\<Sum>v\<in>cart_basis. x $ (THE i. v = axis i 1) *s v) $ i =
   (\<Sum>v\<in>cart_basis. (x $ (THE i. v = axis i 1) *s v) $ i)" unfolding sum_component ..
     also have "... = (\<Sum>v\<in>cart_basis. x $ (THE i. v = axis i 1) * v $ i)"
       unfolding vector_smult_component ..
     also have "... = x $ (THE a. ?w = axis a 1) * ?w $ i + (\<Sum>v\<in>(cart_basis) - {?w}. x $ (THE i. v = axis i 1) * v $ i)"
       by (rule sum.remove[OF finite_cart_basis], auto simp add: cart_basis_def)
     also have "... = x $ (THE a. ?w = axis a 1) * ?w $ i" unfolding sum_eq_0 by simp
     also have "... = x $ i" unfolding the_eq_i unfolding axis_def by auto
     finally show "x $ i = (\<Sum>v\<in>cart_basis. x $ (THE i. v = axis i 1) *s v) $ i" by simp
   qed simp
 qed
 
 (*Some interpretations:*)
 interpretation vec: finite_dimensional_vector_space "(*s)" "cart_basis"
   by (unfold_locales, auto simp add: finite_cart_basis independent_cart_basis span_cart_basis)
 
 lemma matrix_vector_mul_linear_gen[intro, simp]:
   "Vector_Spaces.linear (*s) (*s) ((*v) A)"
   by unfold_locales
     (vector matrix_vector_mult_def sum.distrib algebra_simps)+
 
 lemma span_vec_eq: "vec.span X = span X"
   and dim_vec_eq: "vec.dim X = dim X"
   and dependent_vec_eq: "vec.dependent X = dependent X"
   and subspace_vec_eq: "vec.subspace X = subspace X"
   for X::"(real^'n) set"
   unfolding span_raw_def dim_raw_def dependent_raw_def subspace_raw_def
   by (auto simp: scalar_mult_eq_scaleR)
 
 lemma linear_componentwise:
   fixes f:: "'a::field ^'m \<Rightarrow> 'a ^ 'n"
   assumes lf: "Vector_Spaces.linear (*s) (*s) f"
   shows "(f x)$j = sum (\<lambda>i. (x$i) * (f (axis i 1)$j)) (UNIV :: 'm set)" (is "?lhs = ?rhs")
 proof -
   interpret lf: Vector_Spaces.linear "(*s)" "(*s)" f
     using lf .
   let ?M = "(UNIV :: 'm set)"
   let ?N = "(UNIV :: 'n set)"
   have fM: "finite ?M" by simp
   have "?rhs = (sum (\<lambda>i. (x$i) *s (f (axis i 1))) ?M)$j"
     unfolding sum_component by simp
   then show ?thesis
     unfolding lf.sum[symmetric] lf.scale[symmetric]
     unfolding basis_expansion by auto
 qed
 
 interpretation vec: Vector_Spaces.linear "(*s)" "(*s)" "(*v) A"
   using matrix_vector_mul_linear_gen.
 
 interpretation vec: finite_dimensional_vector_space_pair "(*s)" cart_basis "(*s)" cart_basis ..
 
 lemma matrix_works:
   assumes lf: "Vector_Spaces.linear (*s) (*s) f"
   shows "matrix f *v x = f (x::'a::field ^ 'n)"
   apply (simp add: matrix_def matrix_vector_mult_def vec_eq_iff mult.commute)
   apply clarify
   apply (rule linear_componentwise[OF lf, symmetric])
   done
 
 lemma matrix_of_matrix_vector_mul[simp]: "matrix(\<lambda>x. A *v (x :: 'a::field ^ 'n)) = A"
   by (simp add: matrix_eq matrix_works)
 
 lemma matrix_compose_gen:
   assumes lf: "Vector_Spaces.linear (*s) (*s) (f::'a::{field}^'n \<Rightarrow> 'a^'m)"
     and lg: "Vector_Spaces.linear (*s) (*s) (g::'a^'m \<Rightarrow> 'a^_)"
   shows "matrix (g o f) = matrix g ** matrix f"
   using lf lg Vector_Spaces.linear_compose[OF lf lg] matrix_works[OF Vector_Spaces.linear_compose[OF lf lg]]
   by (simp add: matrix_eq matrix_works matrix_vector_mul_assoc[symmetric] o_def)
 
 lemma matrix_compose:
   assumes "linear (f::real^'n \<Rightarrow> real^'m)" "linear (g::real^'m \<Rightarrow> real^_)"
   shows "matrix (g o f) = matrix g ** matrix f"
   using matrix_compose_gen[of f g] assms
   by (simp add: linear_def scalar_mult_eq_scaleR)
 
 lemma left_invertible_transpose:
   "(\<exists>(B). B ** transpose (A) = mat (1::'a::comm_semiring_1)) \<longleftrightarrow> (\<exists>(B). A ** B = mat 1)"
   by (metis matrix_transpose_mul transpose_mat transpose_transpose)
 
 lemma right_invertible_transpose:
   "(\<exists>(B). transpose (A) ** B = mat (1::'a::comm_semiring_1)) \<longleftrightarrow> (\<exists>(B). B ** A = mat 1)"
   by (metis matrix_transpose_mul transpose_mat transpose_transpose)
 
 lemma linear_matrix_vector_mul_eq:
   "Vector_Spaces.linear (*s) (*s) f \<longleftrightarrow> linear (f :: real^'n \<Rightarrow> real ^'m)"
   by (simp add: scalar_mult_eq_scaleR linear_def)
 
 lemma matrix_vector_mul[simp]:
   "Vector_Spaces.linear (*s) (*s) g \<Longrightarrow> (\<lambda>y. matrix g *v y) = g"
   "linear f \<Longrightarrow> (\<lambda>x. matrix f *v x) = f"
   "bounded_linear f \<Longrightarrow> (\<lambda>x. matrix f *v x) = f"
   for f :: "real^'n \<Rightarrow> real ^'m"
   by (simp_all add: ext matrix_works linear_matrix_vector_mul_eq linear_linear)
 
 lemma matrix_left_invertible_injective:
   fixes A :: "'a::field^'n^'m"
   shows "(\<exists>B. B ** A = mat 1) \<longleftrightarrow> inj ((*v) A)"
 proof safe
   fix B
   assume B: "B ** A = mat 1"
   show "inj ((*v) A)"
     unfolding inj_on_def
       by (metis B matrix_vector_mul_assoc matrix_vector_mul_lid)
 next
   assume "inj ((*v) A)"
   from vec.linear_injective_left_inverse[OF matrix_vector_mul_linear_gen this]
   obtain g where "Vector_Spaces.linear (*s) (*s) g" and g: "g \<circ> (*v) A = id"
     by blast
   have "matrix g ** A = mat 1"
     by (metis matrix_vector_mul_linear_gen \<open>Vector_Spaces.linear (*s) (*s) g\<close> g matrix_compose_gen
         matrix_eq matrix_id_mat_1 matrix_vector_mul(1))
   then show "\<exists>B. B ** A = mat 1"
     by metis
 qed
 
 lemma matrix_left_invertible_ker:
   "(\<exists>B. (B::'a::{field} ^'m^'n) ** (A::'a::{field}^'n^'m) = mat 1) \<longleftrightarrow> (\<forall>x. A *v x = 0 \<longrightarrow> x = 0)"
   unfolding matrix_left_invertible_injective
   using vec.inj_on_iff_eq_0[OF vec.subspace_UNIV, of A]
   by (simp add: inj_on_def)
 
 lemma matrix_right_invertible_surjective:
   "(\<exists>B. (A::'a::field^'n^'m) ** (B::'a::field^'m^'n) = mat 1) \<longleftrightarrow> surj (\<lambda>x. A *v x)"
 proof -
   { fix B :: "'a ^'m^'n"
     assume AB: "A ** B = mat 1"
     { fix x :: "'a ^ 'm"
       have "A *v (B *v x) = x"
         by (simp add: matrix_vector_mul_assoc AB) }
     hence "surj ((*v) A)" unfolding surj_def by metis }
   moreover
   { assume sf: "surj ((*v) A)"
     from vec.linear_surjective_right_inverse[OF _ this]
     obtain g:: "'a ^'m \<Rightarrow> 'a ^'n" where g: "Vector_Spaces.linear (*s) (*s) g" "(*v) A \<circ> g = id"
       by blast
 
     have "A ** (matrix g) = mat 1"
       unfolding matrix_eq  matrix_vector_mul_lid
         matrix_vector_mul_assoc[symmetric] matrix_works[OF g(1)]
       using g(2) unfolding o_def fun_eq_iff id_def
       .
     hence "\<exists>B. A ** (B::'a^'m^'n) = mat 1" by blast
   }
   ultimately show ?thesis unfolding surj_def by blast
 qed
 
 lemma matrix_left_invertible_independent_columns:
   fixes A :: "'a::{field}^'n^'m"
   shows "(\<exists>(B::'a ^'m^'n). B ** A = mat 1) \<longleftrightarrow>
       (\<forall>c. sum (\<lambda>i. c i *s column i A) (UNIV :: 'n set) = 0 \<longrightarrow> (\<forall>i. c i = 0))"
     (is "?lhs \<longleftrightarrow> ?rhs")
 proof -
   let ?U = "UNIV :: 'n set"
   { assume k: "\<forall>x. A *v x = 0 \<longrightarrow> x = 0"
     { fix c i
       assume c: "sum (\<lambda>i. c i *s column i A) ?U = 0" and i: "i \<in> ?U"
       let ?x = "\<chi> i. c i"
       have th0:"A *v ?x = 0"
         using c
         by (vector matrix_mult_sum)
       from k[rule_format, OF th0] i
       have "c i = 0" by (vector vec_eq_iff)}
     hence ?rhs by blast }
   moreover
   { assume H: ?rhs
     { fix x assume x: "A *v x = 0"
       let ?c = "\<lambda>i. ((x$i ):: 'a)"
       from H[rule_format, of ?c, unfolded matrix_mult_sum[symmetric], OF x]
       have "x = 0" by vector }
   }
   ultimately show ?thesis unfolding matrix_left_invertible_ker by auto
 qed
 
 lemma matrix_right_invertible_independent_rows:
   fixes A :: "'a::{field}^'n^'m"
   shows "(\<exists>(B::'a^'m^'n). A ** B = mat 1) \<longleftrightarrow>
     (\<forall>c. sum (\<lambda>i. c i *s row i A) (UNIV :: 'm set) = 0 \<longrightarrow> (\<forall>i. c i = 0))"
   unfolding left_invertible_transpose[symmetric]
     matrix_left_invertible_independent_columns
   by (simp add:)
 
 lemma matrix_right_invertible_span_columns:
   "(\<exists>(B::'a::field ^'n^'m). (A::'a ^'m^'n) ** B = mat 1) \<longleftrightarrow>
     vec.span (columns A) = UNIV" (is "?lhs = ?rhs")
 proof -
   let ?U = "UNIV :: 'm set"
   have fU: "finite ?U" by simp
   have lhseq: "?lhs \<longleftrightarrow> (\<forall>y. \<exists>(x::'a^'m). sum (\<lambda>i. (x$i) *s column i A) ?U = y)"
     unfolding matrix_right_invertible_surjective matrix_mult_sum surj_def
     by (simp add: eq_commute)
   have rhseq: "?rhs \<longleftrightarrow> (\<forall>x. x \<in> vec.span (columns A))" by blast
   { assume h: ?lhs
     { fix x:: "'a ^'n"
       from h[unfolded lhseq, rule_format, of x] obtain y :: "'a ^'m"
         where y: "sum (\<lambda>i. (y$i) *s column i A) ?U = x" by blast
       have "x \<in> vec.span (columns A)"
         unfolding y[symmetric] scalar_mult_eq_scaleR
       proof (rule vec.span_sum [OF vec.span_scale])
         show "column i A \<in> vec.span (columns A)" for i
           using columns_def vec.span_superset by auto
       qed
     }
     then have ?rhs unfolding rhseq by blast }
   moreover
   { assume h:?rhs
     let ?P = "\<lambda>(y::'a ^'n). \<exists>(x::'a^'m). sum (\<lambda>i. (x$i) *s column i A) ?U = y"
     { fix y
       have "y \<in> vec.span (columns A)"
         unfolding h by blast
       then have "?P y"
       proof (induction rule: vec.span_induct_alt)
         case base
         then show ?case
           by (metis (full_types) matrix_mult_sum matrix_vector_mult_0_right)
       next
         case (step c y1 y2)
         from step obtain i where i: "i \<in> ?U" "y1 = column i A"
           unfolding columns_def by blast
         obtain x:: "'a ^'m" where x: "sum (\<lambda>i. (x$i) *s column i A) ?U = y2"
           using step by blast
         let ?x = "(\<chi> j. if j = i then c + (x$i) else (x$j))::'a^'m"
         show ?case
         proof (rule exI[where x= "?x"], vector, auto simp add: i x[symmetric] if_distrib distrib_left if_distribR cong del: if_weak_cong)
           fix j
           have th: "\<forall>xa \<in> ?U. (if xa = i then (c + (x$i)) * ((column xa A)$j)
               else (x$xa) * ((column xa A$j))) = (if xa = i then c * ((column i A)$j) else 0) + ((x$xa) * ((column xa A)$j))"
             using i(1) by (simp add: field_simps)
           have "sum (\<lambda>xa. if xa = i then (c + (x$i)) * ((column xa A)$j)
               else (x$xa) * ((column xa A$j))) ?U = sum (\<lambda>xa. (if xa = i then c * ((column i A)$j) else 0) + ((x$xa) * ((column xa A)$j))) ?U"
             by (rule sum.cong[OF refl]) (use th in blast)
           also have "\<dots> = sum (\<lambda>xa. if xa = i then c * ((column i A)$j) else 0) ?U + sum (\<lambda>xa. ((x$xa) * ((column xa A)$j))) ?U"
             by (simp add: sum.distrib)
           also have "\<dots> = c * ((column i A)$j) + sum (\<lambda>xa. ((x$xa) * ((column xa A)$j))) ?U"
             unfolding sum.delta[OF fU]
             using i(1) by simp
           finally show "sum (\<lambda>xa. if xa = i then (c + (x$i)) * ((column xa A)$j)
             else (x$xa) * ((column xa A$j))) ?U = c * ((column i A)$j) + sum (\<lambda>xa. ((x$xa) * ((column xa A)$j))) ?U" .
         qed
       qed
     }
     then have ?lhs unfolding lhseq ..
   }
   ultimately show ?thesis by blast
 qed
 
 lemma matrix_left_invertible_span_rows_gen:
   "(\<exists>(B::'a^'m^'n). B ** (A::'a::field^'n^'m) = mat 1) \<longleftrightarrow> vec.span (rows A) = UNIV"
   unfolding right_invertible_transpose[symmetric]
   unfolding columns_transpose[symmetric]
   unfolding matrix_right_invertible_span_columns
   ..
 
 lemma matrix_left_invertible_span_rows:
   "(\<exists>(B::real^'m^'n). B ** (A::real^'n^'m) = mat 1) \<longleftrightarrow> span (rows A) = UNIV"
   using matrix_left_invertible_span_rows_gen[of A] by (simp add: span_vec_eq)
 
 lemma matrix_left_right_inverse:
   fixes A A' :: "'a::{field}^'n^'n"
   shows "A ** A' = mat 1 \<longleftrightarrow> A' ** A = mat 1"
 proof -
   { fix A A' :: "'a ^'n^'n"
     assume AA': "A ** A' = mat 1"
     have sA: "surj ((*v) A)"
       using AA' matrix_right_invertible_surjective by auto
     from vec.linear_surjective_isomorphism[OF matrix_vector_mul_linear_gen sA]
     obtain f' :: "'a ^'n \<Rightarrow> 'a ^'n"
       where f': "Vector_Spaces.linear (*s) (*s) f'" "\<forall>x. f' (A *v x) = x" "\<forall>x. A *v f' x = x" by blast
     have th: "matrix f' ** A = mat 1"
       by (simp add: matrix_eq matrix_works[OF f'(1)]
           matrix_vector_mul_assoc[symmetric] f'(2)[rule_format])
     hence "(matrix f' ** A) ** A' = mat 1 ** A'" by simp
     hence "matrix f' = A'"
       by (simp add: matrix_mul_assoc[symmetric] AA')
     hence "matrix f' ** A = A' ** A" by simp
     hence "A' ** A = mat 1" by (simp add: th)
   }
   then show ?thesis by blast
 qed
 
 lemma invertible_left_inverse:
   fixes A :: "'a::{field}^'n^'n"
   shows "invertible A \<longleftrightarrow> (\<exists>(B::'a^'n^'n). B ** A = mat 1)"
   by (metis invertible_def matrix_left_right_inverse)
 
 lemma invertible_right_inverse:
   fixes A :: "'a::{field}^'n^'n"
   shows "invertible A \<longleftrightarrow> (\<exists>(B::'a^'n^'n). A** B = mat 1)"
   by (metis invertible_def matrix_left_right_inverse)
 
 lemma invertible_mult:
   assumes inv_A: "invertible A"
   and inv_B: "invertible B"
   shows "invertible (A**B)"
 proof -
   obtain A' where AA': "A ** A' = mat 1" and A'A: "A' ** A = mat 1" 
     using inv_A unfolding invertible_def by blast
   obtain B' where BB': "B ** B' = mat 1" and B'B: "B' ** B = mat 1" 
     using inv_B unfolding invertible_def by blast
   show ?thesis
   proof (unfold invertible_def, rule exI[of _ "B'**A'"], rule conjI)
     have "A ** B ** (B' ** A') = A ** (B ** (B' ** A'))" 
       using matrix_mul_assoc[of A B "(B' ** A')", symmetric] .
     also have "... = A ** (B ** B' ** A')" unfolding matrix_mul_assoc[of B "B'" "A'"] ..
     also have "... = A ** (mat 1 ** A')" unfolding BB' ..
     also have "... = A ** A'" unfolding matrix_mul_lid ..
     also have "... = mat 1" unfolding AA' ..
     finally show "A ** B ** (B' ** A') = mat (1::'a)" .    
     have "B' ** A' ** (A ** B) = B' ** (A' ** (A ** B))" using matrix_mul_assoc[of B' A' "(A ** B)", symmetric] .
     also have "... =  B' ** (A' ** A ** B)" unfolding matrix_mul_assoc[of A' A B] ..
     also have "... =  B' ** (mat 1 ** B)" unfolding A'A ..
     also have "... = B' ** B"  unfolding matrix_mul_lid ..
     also have "... = mat 1" unfolding B'B ..
     finally show "B' ** A' ** (A ** B) = mat 1" .
   qed
 qed
 
 lemma transpose_invertible:
   fixes A :: "real^'n^'n"
   assumes "invertible A"
   shows "invertible (transpose A)"
   by (meson assms invertible_def matrix_left_right_inverse right_invertible_transpose)
 
 lemma vector_matrix_mul_assoc:
   fixes v :: "('a::comm_semiring_1)^'n"
   shows "(v v* M) v* N = v v* (M ** N)"
 proof -
   from matrix_vector_mul_assoc
   have "transpose N *v (transpose M *v v) = (transpose N ** transpose M) *v v" by fast
   thus "(v v* M) v* N = v v* (M ** N)"
     by (simp add: matrix_transpose_mul [symmetric])
 qed
 
 lemma matrix_scaleR_vector_ac:
   fixes A :: "real^('m::finite)^'n"
   shows "A *v (k *\<^sub>R v) = k *\<^sub>R A *v v"
   by (metis matrix_vector_mult_scaleR transpose_scalar vector_scaleR_matrix_ac vector_transpose_matrix)
 
 lemma scaleR_matrix_vector_assoc:
   fixes A :: "real^('m::finite)^'n"
   shows "k *\<^sub>R (A *v v) = k *\<^sub>R A *v v"
   by (metis matrix_scaleR_vector_ac matrix_vector_mult_scaleR)
 
 (*Finally, some interesting theorems and interpretations that don't appear in any file of the
   library.*)
 
 locale linear_first_finite_dimensional_vector_space =
   l?: Vector_Spaces.linear scaleB scaleC f +
   B?: finite_dimensional_vector_space scaleB BasisB
   for scaleB :: "('a::field => 'b::ab_group_add => 'b)" (infixr "*b" 75)
   and scaleC :: "('a => 'c::ab_group_add => 'c)" (infixr "*c" 75)
   and BasisB :: "('b set)"
   and f :: "('b=>'c)"
 
 lemma vec_dim_card: "vec.dim (UNIV::('a::{field}^'n) set) = CARD ('n)"
 proof -
   let ?f="\<lambda>i::'n. axis i (1::'a)"
   have "vec.dim (UNIV::('a::{field}^'n) set) = card (cart_basis::('a^'n) set)"
     unfolding vec.dim_UNIV ..
   also have "... = card ({i. i\<in> UNIV}::('n) set)"
     proof (rule bij_betw_same_card[of ?f, symmetric], unfold bij_betw_def, auto)
       show "inj (\<lambda>i::'n. axis i (1::'a))"  by (simp add: inj_on_def axis_eq_axis)
       fix i::'n
       show "axis i 1 \<in> cart_basis" unfolding cart_basis_def by auto
       fix x::"'a^'n"
       assume "x \<in> cart_basis"
       thus "x \<in> range (\<lambda>i. axis i 1)" unfolding cart_basis_def by auto
     qed
   also have "... = CARD('n)" by auto
   finally show ?thesis .
 qed
 
 interpretation vector_space_over_itself: vector_space "(*) :: 'a::field \<Rightarrow> 'a \<Rightarrow> 'a"
 by unfold_locales (simp_all add: algebra_simps)
 
 lemmas [simp del] = vector_space_over_itself.scale_scale
 
 interpretation vector_space_over_itself: finite_dimensional_vector_space
   "(*) :: 'a::field => 'a => 'a" "{1}"
   by unfold_locales (auto simp: vector_space_over_itself.span_singleton)
 
 lemma dimension_eq_1[code_unfold]: "vector_space_over_itself.dimension TYPE('a::field)= 1"
   unfolding vector_space_over_itself.dimension_def by simp
 
 
 lemma dim_subset_UNIV_cart_gen:
   fixes S :: "('a::field^'n) set"
   shows "vec.dim S \<le> CARD('n)"
   by (metis vec.dim_eq_full vec.dim_subset_UNIV vec.span_UNIV vec_dim_card)
 
 lemma dim_subset_UNIV_cart:
   fixes S :: "(real^'n) set"
   shows "dim S \<le> CARD('n)"
   using dim_subset_UNIV_cart_gen[of S] by (simp add: dim_vec_eq)
 
 text\<open>Two sometimes fruitful ways of looking at matrix-vector multiplication.\<close>
 
 lemma matrix_mult_dot: "A *v x = (\<chi> i. inner (A$i) x)"
   by (simp add: matrix_vector_mult_def inner_vec_def)
 
 lemma adjoint_matrix: "adjoint(\<lambda>x. (A::real^'n^'m) *v x) = (\<lambda>x. transpose A *v x)"
   apply (rule adjoint_unique)
   apply (simp add: transpose_def inner_vec_def matrix_vector_mult_def
     sum_distrib_right sum_distrib_left)
   apply (subst sum.swap)
   apply (simp add:  ac_simps)
   done
 
 lemma matrix_adjoint: assumes lf: "linear (f :: real^'n \<Rightarrow> real ^'m)"
   shows "matrix(adjoint f) = transpose(matrix f)"
 proof -
   have "matrix(adjoint f) = matrix(adjoint ((*v) (matrix f)))"
     by (simp add: lf)
   also have "\<dots> = transpose(matrix f)"
     unfolding adjoint_matrix matrix_of_matrix_vector_mul
     apply rule
     done
   finally show ?thesis .
 qed
 
 
 subsection\<open> Rank of a matrix\<close>
 
 text\<open>Equivalence of row and column rank is taken from George Mackiw's paper, Mathematics Magazine 1995, p. 285.\<close>
 
 lemma matrix_vector_mult_in_columnspace_gen:
   fixes A :: "'a::field^'n^'m"
   shows "(A *v x) \<in> vec.span(columns A)"
   apply (simp add: matrix_vector_column columns_def transpose_def column_def)
   apply (intro vec.span_sum vec.span_scale)
   apply (force intro: vec.span_base)
   done
 
 lemma matrix_vector_mult_in_columnspace:
   fixes A :: "real^'n^'m"
   shows "(A *v x) \<in> span(columns A)"
   using matrix_vector_mult_in_columnspace_gen[of A x] by (simp add: span_vec_eq)
 
 lemma subspace_orthogonal_to_vector: "subspace {y. orthogonal x y}"
   by (simp add: subspace_def orthogonal_clauses)
 
 lemma orthogonal_nullspace_rowspace:
   fixes A :: "real^'n^'m"
   assumes 0: "A *v x = 0" and y: "y \<in> span(rows A)"
   shows "orthogonal x y"
   using y
 proof (induction rule: span_induct)
   case base
   then show ?case
     by (simp add: subspace_orthogonal_to_vector)
 next
   case (step v)
   then obtain i where "v = row i A"
     by (auto simp: rows_def)
   with 0 show ?case
     unfolding orthogonal_def inner_vec_def matrix_vector_mult_def row_def
     by (simp add: mult.commute) (metis (no_types) vec_lambda_beta zero_index)
 qed
 
 lemma nullspace_inter_rowspace:
   fixes A :: "real^'n^'m"
   shows "A *v x = 0 \<and> x \<in> span(rows A) \<longleftrightarrow> x = 0"
   using orthogonal_nullspace_rowspace orthogonal_self span_zero matrix_vector_mult_0_right
   by blast
 
 lemma matrix_vector_mul_injective_on_rowspace:
   fixes A :: "real^'n^'m"
   shows "\<lbrakk>A *v x = A *v y; x \<in> span(rows A); y \<in> span(rows A)\<rbrakk> \<Longrightarrow> x = y"
   using nullspace_inter_rowspace [of A "x-y"]
   by (metis diff_eq_diff_eq diff_self matrix_vector_mult_diff_distrib span_diff)
 
 definition\<^marker>\<open>tag important\<close> rank :: "'a::field^'n^'m=>nat"
   where row_rank_def_gen: "rank A \<equiv> vec.dim(rows A)"
 
 lemma row_rank_def: "rank A = dim (rows A)" for A::"real^'n^'m"
   by (auto simp: row_rank_def_gen dim_vec_eq)
 
 lemma dim_rows_le_dim_columns:
   fixes A :: "real^'n^'m"
   shows "dim(rows A) \<le> dim(columns A)"
 proof -
   have "dim (span (rows A)) \<le> dim (span (columns A))"
   proof -
     obtain B where "independent B" "span(rows A) \<subseteq> span B"
               and B: "B \<subseteq> span(rows A)""card B = dim (span(rows A))"
       using basis_exists [of "span(rows A)"] by metis
     with span_subspace have eq: "span B = span(rows A)"
       by auto
     then have inj: "inj_on ((*v) A) (span B)"
       by (simp add: inj_on_def matrix_vector_mul_injective_on_rowspace)
     then have ind: "independent ((*v) A ` B)"
       by (rule linear_independent_injective_image [OF Finite_Cartesian_Product.matrix_vector_mul_linear \<open>independent B\<close>])
     have "dim (span (rows A)) \<le> card ((*v) A ` B)"
       unfolding B(2)[symmetric]
       using inj
       by (auto simp: card_image inj_on_subset span_superset)
     also have "\<dots> \<le> dim (span (columns A))"
       using _ ind
       by (rule independent_card_le_dim) (auto intro!: matrix_vector_mult_in_columnspace)
     finally show ?thesis .
   qed
   then show ?thesis
-    by (simp add: dim_span)
+    by (simp)
 qed
 
 lemma column_rank_def:
   fixes A :: "real^'n^'m"
   shows "rank A = dim(columns A)"
   unfolding row_rank_def
   by (metis columns_transpose dim_rows_le_dim_columns le_antisym rows_transpose)
 
 lemma rank_transpose:
   fixes A :: "real^'n^'m"
   shows "rank(transpose A) = rank A"
   by (metis column_rank_def row_rank_def rows_transpose)
 
 lemma matrix_vector_mult_basis:
   fixes A :: "real^'n^'m"
   shows "A *v (axis k 1) = column k A"
   by (simp add: cart_eq_inner_axis column_def matrix_mult_dot)
 
 lemma columns_image_basis:
   fixes A :: "real^'n^'m"
   shows "columns A = (*v) A ` (range (\<lambda>i. axis i 1))"
   by (force simp: columns_def matrix_vector_mult_basis [symmetric])
 
 lemma rank_dim_range:
   fixes A :: "real^'n^'m"
   shows "rank A = dim(range (\<lambda>x. A *v x))"
   unfolding column_rank_def
 proof (rule span_eq_dim)
   have "span (columns A) \<subseteq> span (range ((*v) A))" (is "?l \<subseteq> ?r")
     by (simp add: columns_image_basis image_subsetI span_mono)
   then show "?l = ?r"
     by (metis (no_types, lifting) image_subset_iff matrix_vector_mult_in_columnspace
         span_eq span_span)
 qed
 
 lemma rank_bound:
   fixes A :: "real^'n^'m"
   shows "rank A \<le> min CARD('m) (CARD('n))"
   by (metis (mono_tags, lifting) dim_subset_UNIV_cart min.bounded_iff
       column_rank_def row_rank_def)
 
 lemma full_rank_injective:
   fixes A :: "real^'n^'m"
   shows "rank A = CARD('n) \<longleftrightarrow> inj ((*v) A)"
   by (simp add: matrix_left_invertible_injective [symmetric] matrix_left_invertible_span_rows row_rank_def
       dim_eq_full [symmetric] card_cart_basis vec.dimension_def)
 
 lemma full_rank_surjective:
   fixes A :: "real^'n^'m"
   shows "rank A = CARD('m) \<longleftrightarrow> surj ((*v) A)"
   by (simp add: matrix_right_invertible_surjective [symmetric] left_invertible_transpose [symmetric]
                 matrix_left_invertible_injective full_rank_injective [symmetric] rank_transpose)
 
 lemma rank_I: "rank(mat 1::real^'n^'n) = CARD('n)"
   by (simp add: full_rank_injective inj_on_def)
 
 lemma less_rank_noninjective:
   fixes A :: "real^'n^'m"
   shows "rank A < CARD('n) \<longleftrightarrow> \<not> inj ((*v) A)"
 using less_le rank_bound by (auto simp: full_rank_injective [symmetric])
 
 lemma matrix_nonfull_linear_equations_eq:
   fixes A :: "real^'n^'m"
   shows "(\<exists>x. (x \<noteq> 0) \<and> A *v x = 0) \<longleftrightarrow> rank A \<noteq> CARD('n)"
   by (meson matrix_left_invertible_injective full_rank_injective matrix_left_invertible_ker)
 
 lemma rank_eq_0: "rank A = 0 \<longleftrightarrow> A = 0" and rank_0 [simp]: "rank (0::real^'n^'m) = 0"
   for A :: "real^'n^'m"
   by (auto simp: rank_dim_range matrix_eq)
 
 lemma rank_mul_le_right:
   fixes A :: "real^'n^'m" and B :: "real^'p^'n"
   shows "rank(A ** B) \<le> rank B"
 proof -
   have "rank(A ** B) \<le> dim ((*v) A ` range ((*v) B))"
     by (auto simp: rank_dim_range image_comp o_def matrix_vector_mul_assoc)
   also have "\<dots> \<le> rank B"
     by (simp add: rank_dim_range dim_image_le)
   finally show ?thesis .
 qed
 
 lemma rank_mul_le_left:
   fixes A :: "real^'n^'m" and B :: "real^'p^'n"
   shows "rank(A ** B) \<le> rank A"
   by (metis matrix_transpose_mul rank_mul_le_right rank_transpose)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Lemmas for working on \<open>real^1/2/3/4\<close>\<close>
 
 lemma exhaust_2:
   fixes x :: 2
   shows "x = 1 \<or> x = 2"
 proof (induct x)
   case (of_int z)
   then have "0 \<le> z" and "z < 2" by simp_all
   then have "z = 0 | z = 1" by arith
   then show ?case by auto
 qed
 
 lemma forall_2: "(\<forall>i::2. P i) \<longleftrightarrow> P 1 \<and> P 2"
   by (metis exhaust_2)
 
 lemma exhaust_3:
   fixes x :: 3
   shows "x = 1 \<or> x = 2 \<or> x = 3"
 proof (induct x)
   case (of_int z)
   then have "0 \<le> z" and "z < 3" by simp_all
   then have "z = 0 \<or> z = 1 \<or> z = 2" by arith
   then show ?case by auto
 qed
 
 lemma forall_3: "(\<forall>i::3. P i) \<longleftrightarrow> P 1 \<and> P 2 \<and> P 3"
   by (metis exhaust_3)
 
 lemma exhaust_4:
   fixes x :: 4
   shows "x = 1 \<or> x = 2 \<or> x = 3 \<or> x = 4"
 proof (induct x)
   case (of_int z)
   then have "0 \<le> z" and "z < 4" by simp_all
   then have "z = 0 \<or> z = 1 \<or> z = 2 \<or> z = 3" by arith
   then show ?case by auto
 qed
 
 lemma forall_4: "(\<forall>i::4. P i) \<longleftrightarrow> P 1 \<and> P 2 \<and> P 3 \<and> P 4"
   by (metis exhaust_4)
 
 lemma UNIV_1 [simp]: "UNIV = {1::1}"
   by (auto simp add: num1_eq_iff)
 
 lemma UNIV_2: "UNIV = {1::2, 2::2}"
   using exhaust_2 by auto
 
 lemma UNIV_3: "UNIV = {1::3, 2::3, 3::3}"
   using exhaust_3 by auto
 
 lemma UNIV_4: "UNIV = {1::4, 2::4, 3::4, 4::4}"
   using exhaust_4 by auto
 
 lemma sum_1: "sum f (UNIV::1 set) = f 1"
   unfolding UNIV_1 by simp
 
 lemma sum_2: "sum f (UNIV::2 set) = f 1 + f 2"
   unfolding UNIV_2 by simp
 
 lemma sum_3: "sum f (UNIV::3 set) = f 1 + f 2 + f 3"
   unfolding UNIV_3 by (simp add: ac_simps)
 
 lemma sum_4: "sum f (UNIV::4 set) = f 1 + f 2 + f 3 + f 4"
   unfolding UNIV_4 by (simp add: ac_simps)
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>The collapse of the general concepts to dimension one\<close>
 
 lemma vector_one: "(x::'a ^1) = (\<chi> i. (x$1))"
   by (simp add: vec_eq_iff)
 
 lemma forall_one: "(\<forall>(x::'a ^1). P x) \<longleftrightarrow> (\<forall>x. P(\<chi> i. x))"
   apply auto
   apply (erule_tac x= "x$1" in allE)
   apply (simp only: vector_one[symmetric])
   done
 
 lemma norm_vector_1: "norm (x :: _^1) = norm (x$1)"
   by (simp add: norm_vec_def)
 
 lemma dist_vector_1:
   fixes x :: "'a::real_normed_vector^1"
   shows "dist x y = dist (x$1) (y$1)"
   by (simp add: dist_norm norm_vector_1)
 
 lemma norm_real: "norm(x::real ^ 1) = \<bar>x$1\<bar>"
   by (simp add: norm_vector_1)
 
 lemma dist_real: "dist(x::real ^ 1) y = \<bar>(x$1) - (y$1)\<bar>"
   by (auto simp add: norm_real dist_norm)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Routine results connecting the types \<^typ>\<open>real^1\<close> and \<^typ>\<open>real\<close>\<close>
 
 lemma vector_one_nth [simp]:
   fixes x :: "'a^1" shows "vec (x $ 1) = x"
   by (metis vec_def vector_one)
 
 lemma tendsto_at_within_vector_1:
   fixes S :: "'a :: metric_space set"
   assumes "(f \<longlongrightarrow> fx) (at x within S)"
   shows "((\<lambda>y::'a^1. \<chi> i. f (y $ 1)) \<longlongrightarrow> (vec fx::'a^1)) (at (vec x) within vec ` S)"
 proof (rule topological_tendstoI)
   fix T :: "('a^1) set"
   assume "open T" "vec fx \<in> T"
   have "\<forall>\<^sub>F x in at x within S. f x \<in> (\<lambda>x. x $ 1) ` T"
     using \<open>open T\<close> \<open>vec fx \<in> T\<close> assms open_image_vec_nth tendsto_def by fastforce
   then show "\<forall>\<^sub>F x::'a^1 in at (vec x) within vec ` S. (\<chi> i. f (x $ 1)) \<in> T"
     unfolding eventually_at dist_norm [symmetric]
     by (rule ex_forward)
        (use \<open>open T\<close> in 
          \<open>fastforce simp: dist_norm dist_vec_def L2_set_def image_iff vector_one open_vec_def\<close>)
 qed
 
 lemma has_derivative_vector_1:
   assumes der_g: "(g has_derivative (\<lambda>x. x * g' a)) (at a within S)"
   shows "((\<lambda>x. vec (g (x $ 1))) has_derivative (*\<^sub>R) (g' a))
          (at ((vec a)::real^1) within vec ` S)"
     using der_g
     apply (auto simp: Deriv.has_derivative_within bounded_linear_scaleR_right norm_vector_1)
     apply (drule tendsto_at_within_vector_1, vector)
     apply (auto simp: algebra_simps eventually_at tendsto_def)
     done
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Explicit vector construction from lists\<close>
 
 definition "vector l = (\<chi> i. foldr (\<lambda>x f n. fun_upd (f (n+1)) n x) l (\<lambda>n x. 0) 1 i)"
 
 lemma vector_1 [simp]: "(vector[x]) $1 = x"
   unfolding vector_def by simp
 
 lemma vector_2 [simp]: "(vector[x,y]) $1 = x" "(vector[x,y] :: 'a^2)$2 = (y::'a::zero)"
   unfolding vector_def by simp_all
 
 lemma vector_3 [simp]:
  "(vector [x,y,z] ::('a::zero)^3)$1 = x"
  "(vector [x,y,z] ::('a::zero)^3)$2 = y"
  "(vector [x,y,z] ::('a::zero)^3)$3 = z"
   unfolding vector_def by simp_all
 
 lemma forall_vector_1: "(\<forall>v::'a::zero^1. P v) \<longleftrightarrow> (\<forall>x. P(vector[x]))"
   by (metis vector_1 vector_one)
 
 lemma forall_vector_2: "(\<forall>v::'a::zero^2. P v) \<longleftrightarrow> (\<forall>x y. P(vector[x, y]))"
   apply auto
   apply (erule_tac x="v$1" in allE)
   apply (erule_tac x="v$2" in allE)
   apply (subgoal_tac "vector [v$1, v$2] = v")
   apply simp
   apply (vector vector_def)
   apply (simp add: forall_2)
   done
 
 lemma forall_vector_3: "(\<forall>v::'a::zero^3. P v) \<longleftrightarrow> (\<forall>x y z. P(vector[x, y, z]))"
   apply auto
   apply (erule_tac x="v$1" in allE)
   apply (erule_tac x="v$2" in allE)
   apply (erule_tac x="v$3" in allE)
   apply (subgoal_tac "vector [v$1, v$2, v$3] = v")
   apply simp
   apply (vector vector_def)
   apply (simp add: forall_3)
   done
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>lambda skolemization on cartesian products\<close>
 
 lemma lambda_skolem: "(\<forall>i. \<exists>x. P i x) \<longleftrightarrow>
    (\<exists>x::'a ^ 'n. \<forall>i. P i (x $ i))" (is "?lhs \<longleftrightarrow> ?rhs")
 proof -
   let ?S = "(UNIV :: 'n set)"
   { assume H: "?rhs"
     then have ?lhs by auto }
   moreover
   { assume H: "?lhs"
     then obtain f where f:"\<forall>i. P i (f i)" unfolding choice_iff by metis
     let ?x = "(\<chi> i. (f i)) :: 'a ^ 'n"
     { fix i
       from f have "P i (f i)" by metis
       then have "P i (?x $ i)" by auto
     }
     hence "\<forall>i. P i (?x$i)" by metis
     hence ?rhs by metis }
   ultimately show ?thesis by metis
 qed
 
 
 text \<open>The same result in terms of square matrices.\<close>
 
 
 text \<open>Considering an n-element vector as an n-by-1 or 1-by-n matrix.\<close>
 
 definition "rowvector v = (\<chi> i j. (v$j))"
 
 definition "columnvector v = (\<chi> i j. (v$i))"
 
 lemma transpose_columnvector: "transpose(columnvector v) = rowvector v"
   by (simp add: transpose_def rowvector_def columnvector_def vec_eq_iff)
 
 lemma transpose_rowvector: "transpose(rowvector v) = columnvector v"
   by (simp add: transpose_def columnvector_def rowvector_def vec_eq_iff)
 
 lemma dot_rowvector_columnvector: "columnvector (A *v v) = A ** columnvector v"
   by (vector columnvector_def matrix_matrix_mult_def matrix_vector_mult_def)
 
 lemma dot_matrix_product:
   "(x::real^'n) \<bullet> y = (((rowvector x ::real^'n^1) ** (columnvector y :: real^1^'n))$1)$1"
   by (vector matrix_matrix_mult_def rowvector_def columnvector_def inner_vec_def)
 
 lemma dot_matrix_vector_mul:
   fixes A B :: "real ^'n ^'n" and x y :: "real ^'n"
   shows "(A *v x) \<bullet> (B *v y) =
       (((rowvector x :: real^'n^1) ** ((transpose A ** B) ** (columnvector y :: real ^1^'n)))$1)$1"
   unfolding dot_matrix_product transpose_columnvector[symmetric]
     dot_rowvector_columnvector matrix_transpose_mul matrix_mul_assoc ..
 
 
 lemma dim_substandard_cart: "vec.dim {x::'a::field^'n. \<forall>i. i \<notin> d \<longrightarrow> x$i = 0} = card d"
   (is "vec.dim ?A = _")
 proof (rule vec.dim_unique)
   let ?B = "((\<lambda>x. axis x 1) ` d)"
   have subset_basis: "?B \<subseteq> cart_basis"
     by (auto simp: cart_basis_def)
   show "?B \<subseteq> ?A"
     by (auto simp: axis_def)
   show "vec.independent ((\<lambda>x. axis x 1) ` d)"
     using subset_basis
     by (rule vec.independent_mono[OF vec.independent_Basis])
   have "x \<in> vec.span ?B" if "\<forall>i. i \<notin> d \<longrightarrow> x $ i = 0" for x::"'a^'n"
   proof -
     have "finite ?B"
       using subset_basis finite_cart_basis
       by (rule finite_subset)
     have "x = (\<Sum>i\<in>UNIV. x $ i *s axis i 1)"
       by (rule basis_expansion[symmetric])
     also have "\<dots> = (\<Sum>i\<in>d. (x $ i) *s axis i 1)"
       by (rule sum.mono_neutral_cong_right) (auto simp: that)
     also have "\<dots> \<in> vec.span ?B"
       by (simp add: vec.span_sum vec.span_clauses)
     finally show "x \<in> vec.span ?B" .
   qed
   then show "?A \<subseteq> vec.span ?B" by auto
 qed (simp add: card_image inj_on_def axis_eq_axis)
 
 lemma affinity_inverses:
   assumes m0: "m \<noteq> (0::'a::field)"
   shows "(\<lambda>x. m *s x + c) \<circ> (\<lambda>x. inverse(m) *s x + (-(inverse(m) *s c))) = id"
   "(\<lambda>x. inverse(m) *s x + (-(inverse(m) *s c))) \<circ> (\<lambda>x. m *s x + c) = id"
   using m0
   by (auto simp add: fun_eq_iff vector_add_ldistrib diff_conv_add_uminus simp del: add_uminus_conv_diff)
 
 lemma vector_affinity_eq:
   assumes m0: "(m::'a::field) \<noteq> 0"
   shows "m *s x + c = y \<longleftrightarrow> x = inverse m *s y + -(inverse m *s c)"
 proof
   assume h: "m *s x + c = y"
   hence "m *s x = y - c" by (simp add: field_simps)
   hence "inverse m *s (m *s x) = inverse m *s (y - c)" by simp
   then show "x = inverse m *s y + - (inverse m *s c)"
     using m0 by (simp add: vector_smult_assoc vector_ssub_ldistrib)
 next
   assume h: "x = inverse m *s y + - (inverse m *s c)"
   show "m *s x + c = y" unfolding h
     using m0 by (simp add: vector_smult_assoc vector_ssub_ldistrib)
 qed
 
 lemma vector_eq_affinity:
     "(m::'a::field) \<noteq> 0 ==> (y = m *s x + c \<longleftrightarrow> inverse(m) *s y + -(inverse(m) *s c) = x)"
   using vector_affinity_eq[where m=m and x=x and y=y and c=c]
   by metis
 
 lemma vector_cart:
   fixes f :: "real^'n \<Rightarrow> real"
   shows "(\<chi> i. f (axis i 1)) = (\<Sum>i\<in>Basis. f i *\<^sub>R i)"
   unfolding euclidean_eq_iff[where 'a="real^'n"]
   by simp (simp add: Basis_vec_def inner_axis)
 
 lemma const_vector_cart:"((\<chi> i. d)::real^'n) = (\<Sum>i\<in>Basis. d *\<^sub>R i)"
   by (rule vector_cart)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Explicit formulas for low dimensions\<close>
 
 lemma  prod_neutral_const: "prod f {(1::nat)..1} = f 1"
   by simp
 
 lemma  prod_2: "prod f {(1::nat)..2} = f 1 * f 2"
   by (simp add: eval_nat_numeral atLeastAtMostSuc_conv mult.commute)
 
 lemma  prod_3: "prod f {(1::nat)..3} = f 1 * f 2 * f 3"
   by (simp add: eval_nat_numeral atLeastAtMostSuc_conv mult.commute)
 
 
 subsection  \<open>Orthogonality of a matrix\<close>
 
 definition\<^marker>\<open>tag important\<close>  "orthogonal_matrix (Q::'a::semiring_1^'n^'n) \<longleftrightarrow>
   transpose Q ** Q = mat 1 \<and> Q ** transpose Q = mat 1"
 
 lemma  orthogonal_matrix: "orthogonal_matrix (Q:: real ^'n^'n) \<longleftrightarrow> transpose Q ** Q = mat 1"
   by (metis matrix_left_right_inverse orthogonal_matrix_def)
 
 lemma  orthogonal_matrix_id: "orthogonal_matrix (mat 1 :: _^'n^'n)"
   by (simp add: orthogonal_matrix_def)
 
 proposition  orthogonal_matrix_mul:
   fixes A :: "real ^'n^'n"
   assumes  "orthogonal_matrix A" "orthogonal_matrix B"
   shows "orthogonal_matrix(A ** B)"
   using assms
   by (simp add: orthogonal_matrix matrix_transpose_mul matrix_left_right_inverse matrix_mul_assoc)
 
 proposition  orthogonal_transformation_matrix:
   fixes f:: "real^'n \<Rightarrow> real^'n"
   shows "orthogonal_transformation f \<longleftrightarrow> linear f \<and> orthogonal_matrix(matrix f)"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof -
   let ?mf = "matrix f"
   let ?ot = "orthogonal_transformation f"
   let ?U = "UNIV :: 'n set"
   have fU: "finite ?U" by simp
   let ?m1 = "mat 1 :: real ^'n^'n"
   {
     assume ot: ?ot
     from ot have lf: "Vector_Spaces.linear (*s) (*s) f" and fd: "\<And>v w. f v \<bullet> f w = v \<bullet> w"
       unfolding orthogonal_transformation_def orthogonal_matrix linear_def scalar_mult_eq_scaleR
       by blast+
     {
       fix i j
       let ?A = "transpose ?mf ** ?mf"
       have th0: "\<And>b (x::'a::comm_ring_1). (if b then 1 else 0)*x = (if b then x else 0)"
         "\<And>b (x::'a::comm_ring_1). x*(if b then 1 else 0) = (if b then x else 0)"
         by simp_all
       from fd[of "axis i 1" "axis j 1",
         simplified matrix_works[OF lf, symmetric] dot_matrix_vector_mul]
       have "?A$i$j = ?m1 $ i $ j"
         by (simp add: inner_vec_def matrix_matrix_mult_def columnvector_def rowvector_def
             th0 sum.delta[OF fU] mat_def axis_def)
     }
     then have "orthogonal_matrix ?mf"
       unfolding orthogonal_matrix
       by vector
     with lf have ?rhs
       unfolding linear_def scalar_mult_eq_scaleR
       by blast
   }
   moreover
   {
     assume lf: "Vector_Spaces.linear (*s) (*s) f" and om: "orthogonal_matrix ?mf"
     from lf om have ?lhs
       unfolding orthogonal_matrix_def norm_eq orthogonal_transformation
       apply (simp only: matrix_works[OF lf, symmetric] dot_matrix_vector_mul)
       apply (simp add: dot_matrix_product linear_def scalar_mult_eq_scaleR)
       done
   }
   ultimately show ?thesis
     by (auto simp: linear_def scalar_mult_eq_scaleR)
 qed
 
 
-subsection \<open> We can find an orthogonal matrix taking any unit vector to any other\<close>
+subsection \<open>Finding an Orthogonal Matrix\<close>
+
+text \<open>We can find an orthogonal matrix taking any unit vector to any other.\<close>
 
 lemma  orthogonal_matrix_transpose [simp]:
      "orthogonal_matrix(transpose A) \<longleftrightarrow> orthogonal_matrix A"
   by (auto simp: orthogonal_matrix_def)
 
 lemma  orthogonal_matrix_orthonormal_columns:
   fixes A :: "real^'n^'n"
   shows "orthogonal_matrix A \<longleftrightarrow>
           (\<forall>i. norm(column i A) = 1) \<and>
           (\<forall>i j. i \<noteq> j \<longrightarrow> orthogonal (column i A) (column j A))"
   by (auto simp: orthogonal_matrix matrix_mult_transpose_dot_column vec_eq_iff mat_def norm_eq_1 orthogonal_def)
 
 lemma  orthogonal_matrix_orthonormal_rows:
   fixes A :: "real^'n^'n"
   shows "orthogonal_matrix A \<longleftrightarrow>
           (\<forall>i. norm(row i A) = 1) \<and>
           (\<forall>i j. i \<noteq> j \<longrightarrow> orthogonal (row i A) (row j A))"
   using orthogonal_matrix_orthonormal_columns [of "transpose A"] by simp
 
 proposition  orthogonal_matrix_exists_basis:
   fixes a :: "real^'n"
   assumes "norm a = 1"
   obtains A where "orthogonal_matrix A" "A *v (axis k 1) = a"
 proof -
   obtain S where "a \<in> S" "pairwise orthogonal S" and noS: "\<And>x. x \<in> S \<Longrightarrow> norm x = 1"
    and "independent S" "card S = CARD('n)" "span S = UNIV"
     using vector_in_orthonormal_basis assms by force
   then obtain f0 where "bij_betw f0 (UNIV::'n set) S"
     by (metis finite_class.finite_UNIV finite_same_card_bij finiteI_independent)
   then obtain f where f: "bij_betw f (UNIV::'n set) S" and a: "a = f k"
     using bij_swap_iff [of k "inv f0 a" f0]
     by (metis UNIV_I \<open>a \<in> S\<close> bij_betw_inv_into_right bij_betw_swap_iff swap_apply(1))
   show thesis
   proof
     have [simp]: "\<And>i. norm (f i) = 1"
       using bij_betwE [OF \<open>bij_betw f UNIV S\<close>] by (blast intro: noS)
     have [simp]: "\<And>i j. i \<noteq> j \<Longrightarrow> orthogonal (f i) (f j)"
       using \<open>pairwise orthogonal S\<close> \<open>bij_betw f UNIV S\<close>
       by (auto simp: pairwise_def bij_betw_def inj_on_def)
     show "orthogonal_matrix (\<chi> i j. f j $ i)"
       by (simp add: orthogonal_matrix_orthonormal_columns column_def)
     show "(\<chi> i j. f j $ i) *v axis k 1 = a"
       by (simp add: matrix_vector_mult_def axis_def a if_distrib cong: if_cong)
   qed
 qed
 
 lemma  orthogonal_transformation_exists_1:
   fixes a b :: "real^'n"
   assumes "norm a = 1" "norm b = 1"
   obtains f where "orthogonal_transformation f" "f a = b"
 proof -
   obtain k::'n where True
     by simp
   obtain A B where AB: "orthogonal_matrix A" "orthogonal_matrix B" and eq: "A *v (axis k 1) = a" "B *v (axis k 1) = b"
     using orthogonal_matrix_exists_basis assms by metis
   let ?f = "\<lambda>x. (B ** transpose A) *v x"
   show thesis
   proof
     show "orthogonal_transformation ?f"
       by (subst orthogonal_transformation_matrix)
         (auto simp: AB orthogonal_matrix_mul)
   next
     show "?f a = b"
       using \<open>orthogonal_matrix A\<close> unfolding orthogonal_matrix_def
       by (metis eq matrix_mul_rid matrix_vector_mul_assoc)
   qed
 qed
 
 proposition  orthogonal_transformation_exists:
   fixes a b :: "real^'n"
   assumes "norm a = norm b"
   obtains f where "orthogonal_transformation f" "f a = b"
 proof (cases "a = 0 \<or> b = 0")
   case True
   with assms show ?thesis
     using that by force
 next
   case False
   then obtain f where f: "orthogonal_transformation f" and eq: "f (a /\<^sub>R norm a) = (b /\<^sub>R norm b)"
     by (auto intro: orthogonal_transformation_exists_1 [of "a /\<^sub>R norm a" "b /\<^sub>R norm b"])
   show ?thesis
   proof
     interpret linear f
       using f by (simp add: orthogonal_transformation_linear)
     have "f a /\<^sub>R norm a = f (a /\<^sub>R norm a)"
       by (simp add: scale)
     also have "\<dots> = b /\<^sub>R norm a"
       by (simp add: eq assms [symmetric])
     finally show "f a = b"
       using False by auto
   qed (use f in auto)
 qed
 
 
-subsection  \<open>Linearity of scaling, and hence isometry, that preserves origin\<close>
+subsection  \<open>Scaling and isometry\<close>
 
-lemma  scaling_linear:
+proposition scaling_linear:
   fixes f :: "'a::real_inner \<Rightarrow> 'a::real_inner"
   assumes f0: "f 0 = 0"
     and fd: "\<forall>x y. dist (f x) (f y) = c * dist x y"
   shows "linear f"
 proof -
   {
     fix v w
     have "norm (f x) = c * norm x" for x
       by (metis dist_0_norm f0 fd)
     then have "f v \<bullet> f w = c\<^sup>2 * (v \<bullet> w)"
       unfolding dot_norm_neg dist_norm[symmetric]
       by (simp add: fd power2_eq_square field_simps)
   }
   then show ?thesis
     unfolding linear_iff vector_eq[where 'a="'a"] scalar_mult_eq_scaleR
     by (simp add: inner_add field_simps)
 qed
 
 lemma  isometry_linear:
   "f (0::'a::real_inner) = (0::'a) \<Longrightarrow> \<forall>x y. dist(f x) (f y) = dist x y \<Longrightarrow> linear f"
   by (rule scaling_linear[where c=1]) simp_all
 
 text \<open>Hence another formulation of orthogonal transformation\<close>
 
 proposition  orthogonal_transformation_isometry:
   "orthogonal_transformation f \<longleftrightarrow> f(0::'a::real_inner) = (0::'a) \<and> (\<forall>x y. dist(f x) (f y) = dist x y)"
   unfolding orthogonal_transformation
   apply (auto simp: linear_0 isometry_linear)
    apply (metis (no_types, hide_lams) dist_norm linear_diff)
   by (metis dist_0_norm)
 
 
-subsection  \<open>Can extend an isometry from unit sphere\<close>
+text \<open>Can extend an isometry from unit sphere:\<close>
 
 lemma  isometry_sphere_extend:
   fixes f:: "'a::real_inner \<Rightarrow> 'a"
   assumes f1: "\<And>x. norm x = 1 \<Longrightarrow> norm (f x) = 1"
     and fd1: "\<And>x y. \<lbrakk>norm x = 1; norm y = 1\<rbrakk> \<Longrightarrow> dist (f x) (f y) = dist x y"
   shows "\<exists>g. orthogonal_transformation g \<and> (\<forall>x. norm x = 1 \<longrightarrow> g x = f x)"
 proof -
   {
     fix x y x' y' u v u' v' :: "'a"
     assume H: "x = norm x *\<^sub>R u" "y = norm y *\<^sub>R v"
               "x' = norm x *\<^sub>R u'" "y' = norm y *\<^sub>R v'"
       and J: "norm u = 1" "norm u' = 1" "norm v = 1" "norm v' = 1" "norm(u' - v') = norm(u - v)"
     then have *: "u \<bullet> v = u' \<bullet> v' + v' \<bullet> u' - v \<bullet> u "
       by (simp add: norm_eq norm_eq_1 inner_add inner_diff)
     have "norm (norm x *\<^sub>R u' - norm y *\<^sub>R v') = norm (norm x *\<^sub>R u - norm y *\<^sub>R v)"
       using J by (simp add: norm_eq norm_eq_1 inner_diff * field_simps)
     then have "norm(x' - y') = norm(x - y)"
       using H by metis
   }
   note norm_eq = this
   let ?g = "\<lambda>x. if x = 0 then 0 else norm x *\<^sub>R f (x /\<^sub>R norm x)"
   have thfg: "?g x = f x" if "norm x = 1" for x
     using that by auto
   have thd: "dist (?g x) (?g y) = dist x y" for x y
   proof (cases "x=0 \<or> y=0")
     case False
     show "dist (?g x) (?g y) = dist x y"
       unfolding dist_norm
     proof (rule norm_eq)
       show "x = norm x *\<^sub>R (x /\<^sub>R norm x)" "y = norm y *\<^sub>R (y /\<^sub>R norm y)"
            "norm (f (x /\<^sub>R norm x)) = 1" "norm (f (y /\<^sub>R norm y)) = 1"
         using False f1 by auto
     qed (use False in \<open>auto simp: field_simps intro: f1 fd1[unfolded dist_norm]\<close>)
   qed (auto simp: f1)
   show ?thesis
     unfolding orthogonal_transformation_isometry
     by (rule exI[where x= ?g]) (metis thfg thd)
 qed
 
 subsection\<open>Induction on matrix row operations\<close>
 
 lemma induct_matrix_row_operations:
   fixes P :: "real^'n^'n \<Rightarrow> bool"
   assumes zero_row: "\<And>A i. row i A = 0 \<Longrightarrow> P A"
     and diagonal: "\<And>A. (\<And>i j. i \<noteq> j \<Longrightarrow> A$i$j = 0) \<Longrightarrow> P A"
     and swap_cols: "\<And>A m n. \<lbrakk>P A; m \<noteq> n\<rbrakk> \<Longrightarrow> P(\<chi> i j. A $ i $ Fun.swap m n id j)"
     and row_op: "\<And>A m n c. \<lbrakk>P A; m \<noteq> n\<rbrakk>
                    \<Longrightarrow> P(\<chi> i. if i = m then row m A + c *\<^sub>R row n A else row i A)"
   shows "P A"
 proof -
   have "P A" if "(\<And>i j. \<lbrakk>j \<in> -K;  i \<noteq> j\<rbrakk> \<Longrightarrow> A$i$j = 0)" for A K
   proof -
     have "finite K"
       by simp
     then show ?thesis using that
     proof (induction arbitrary: A rule: finite_induct)
       case empty
       with diagonal show ?case
         by simp
     next
       case (insert k K)
       note insertK = insert
       have "P A" if kk: "A$k$k \<noteq> 0"
         and 0: "\<And>i j. \<lbrakk>j \<in> - insert k K; i \<noteq> j\<rbrakk> \<Longrightarrow> A$i$j = 0"
                "\<And>i. \<lbrakk>i \<in> -L; i \<noteq> k\<rbrakk> \<Longrightarrow> A$i$k = 0" for A L
       proof -
         have "finite L"
           by simp
         then show ?thesis using 0 kk
         proof (induction arbitrary: A rule: finite_induct)
           case (empty B)
           show ?case
           proof (rule insertK)
             fix i j
             assume "i \<in> - K" "j \<noteq> i"
             show "B $ j $ i = 0"
               using \<open>j \<noteq> i\<close> \<open>i \<in> - K\<close> empty
               by (metis ComplD ComplI Compl_eq_Diff_UNIV Diff_empty UNIV_I insert_iff)
           qed
         next
           case (insert l L B)
           show ?case
           proof (cases "k = l")
             case True
             with insert show ?thesis
               by auto
           next
             case False
             let ?C = "\<chi> i. if i = l then row l B - (B $ l $ k / B $ k $ k) *\<^sub>R row k B else row i B"
             have 1: "\<lbrakk>j \<in> - insert k K; i \<noteq> j\<rbrakk> \<Longrightarrow> ?C $ i $ j = 0" for j i
               by (auto simp: insert.prems(1) row_def)
             have 2: "?C $ i $ k = 0"
               if "i \<in> - L" "i \<noteq> k" for i
             proof (cases "i=l")
               case True
               with that insert.prems show ?thesis
                 by (simp add: row_def)
             next
               case False
               with that show ?thesis
                 by (simp add: insert.prems(2) row_def)
             qed
             have 3: "?C $ k $ k \<noteq> 0"
               by (auto simp: insert.prems row_def \<open>k \<noteq> l\<close>)
             have PC: "P ?C"
               using insert.IH [OF 1 2 3] by auto
             have eqB: "(\<chi> i. if i = l then row l ?C + (B $ l $ k / B $ k $ k) *\<^sub>R row k ?C else row i ?C) = B"
               using \<open>k \<noteq> l\<close> by (simp add: vec_eq_iff row_def)
             show ?thesis
               using row_op [OF PC, of l k, where c = "B$l$k / B$k$k"] eqB \<open>k \<noteq> l\<close>
               by (simp add: cong: if_cong)
           qed
         qed
       qed
       then have nonzero_hyp: "P A"
         if kk: "A$k$k \<noteq> 0" and zeroes: "\<And>i j. j \<in> - insert k K \<and> i\<noteq>j \<Longrightarrow> A$i$j = 0" for A
         by (auto simp: intro!: kk zeroes)
       show ?case
       proof (cases "row k A = 0")
         case True
         with zero_row show ?thesis by auto
       next
         case False
         then obtain l where l: "A$k$l \<noteq> 0"
           by (auto simp: row_def zero_vec_def vec_eq_iff)
         show ?thesis
         proof (cases "k = l")
           case True
           with l nonzero_hyp insert.prems show ?thesis
             by blast
         next
           case False
           have *: "A $ i $ Fun.swap k l id j = 0" if "j \<noteq> k" "j \<notin> K" "i \<noteq> j" for i j
             using False l insert.prems that
             by (auto simp: swap_def insert split: if_split_asm)
           have "P (\<chi> i j. (\<chi> i j. A $ i $ Fun.swap k l id j) $ i $ Fun.swap k l id j)"
             by (rule swap_cols [OF nonzero_hyp False]) (auto simp: l *)
           moreover
           have "(\<chi> i j. (\<chi> i j. A $ i $ Fun.swap k l id j) $ i $ Fun.swap k l id j) = A"
             by (vector Fun.swap_def)
           ultimately show ?thesis
             by simp
         qed
       qed
     qed
   qed
   then show ?thesis
     by blast
 qed
 
 lemma induct_matrix_elementary:
   fixes P :: "real^'n^'n \<Rightarrow> bool"
   assumes mult: "\<And>A B. \<lbrakk>P A; P B\<rbrakk> \<Longrightarrow> P(A ** B)"
     and zero_row: "\<And>A i. row i A = 0 \<Longrightarrow> P A"
     and diagonal: "\<And>A. (\<And>i j. i \<noteq> j \<Longrightarrow> A$i$j = 0) \<Longrightarrow> P A"
     and swap1: "\<And>m n. m \<noteq> n \<Longrightarrow> P(\<chi> i j. mat 1 $ i $ Fun.swap m n id j)"
     and idplus: "\<And>m n c. m \<noteq> n \<Longrightarrow> P(\<chi> i j. if i = m \<and> j = n then c else of_bool (i = j))"
   shows "P A"
 proof -
   have swap: "P (\<chi> i j. A $ i $ Fun.swap m n id j)"  (is "P ?C")
     if "P A" "m \<noteq> n" for A m n
   proof -
     have "A ** (\<chi> i j. mat 1 $ i $ Fun.swap m n id j) = ?C"
       by (simp add: matrix_matrix_mult_def mat_def vec_eq_iff if_distrib sum.delta_remove)
     then show ?thesis
       using mult swap1 that by metis
   qed
   have row: "P (\<chi> i. if i = m then row m A + c *\<^sub>R row n A else row i A)"  (is "P ?C")
     if "P A" "m \<noteq> n" for A m n c
   proof -
     let ?B = "\<chi> i j. if i = m \<and> j = n then c else of_bool (i = j)"
     have "?B ** A = ?C"
       using \<open>m \<noteq> n\<close> unfolding matrix_matrix_mult_def row_def of_bool_def
       by (auto simp: vec_eq_iff if_distrib [of "\<lambda>x. x * y" for y] sum.remove cong: if_cong)
     then show ?thesis
       by (rule subst) (auto simp: that mult idplus)
   qed
   show ?thesis
     by (rule induct_matrix_row_operations [OF zero_row diagonal swap row])
 qed
 
 lemma induct_matrix_elementary_alt:
   fixes P :: "real^'n^'n \<Rightarrow> bool"
   assumes mult: "\<And>A B. \<lbrakk>P A; P B\<rbrakk> \<Longrightarrow> P(A ** B)"
     and zero_row: "\<And>A i. row i A = 0 \<Longrightarrow> P A"
     and diagonal: "\<And>A. (\<And>i j. i \<noteq> j \<Longrightarrow> A$i$j = 0) \<Longrightarrow> P A"
     and swap1: "\<And>m n. m \<noteq> n \<Longrightarrow> P(\<chi> i j. mat 1 $ i $ Fun.swap m n id j)"
     and idplus: "\<And>m n. m \<noteq> n \<Longrightarrow> P(\<chi> i j. of_bool (i = m \<and> j = n \<or> i = j))"
   shows "P A"
 proof -
   have *: "P (\<chi> i j. if i = m \<and> j = n then c else of_bool (i = j))"
     if "m \<noteq> n" for m n c
   proof (cases "c = 0")
     case True
     with diagonal show ?thesis by auto
   next
     case False
     then have eq: "(\<chi> i j. if i = m \<and> j = n then c else of_bool (i = j)) =
                       (\<chi> i j. if i = j then (if j = n then inverse c else 1) else 0) **
                       (\<chi> i j. of_bool (i = m \<and> j = n \<or> i = j)) **
                       (\<chi> i j. if i = j then if j = n then c else 1 else 0)"
       using \<open>m \<noteq> n\<close>
       apply (simp add: matrix_matrix_mult_def vec_eq_iff of_bool_def if_distrib [of "\<lambda>x. y * x" for y] cong: if_cong)
       apply (simp add: if_if_eq_conj sum.neutral conj_commute cong: conj_cong)
       done
     show ?thesis
       apply (subst eq)
       apply (intro mult idplus that)
        apply (auto intro: diagonal)
       done
   qed
   show ?thesis
     by (rule induct_matrix_elementary) (auto intro: assms *)
 qed
 
 lemma matrix_vector_mult_matrix_matrix_mult_compose:
   "(*v) (A ** B) = (*v) A \<circ> (*v) B"
   by (auto simp: matrix_vector_mul_assoc)
 
 lemma induct_linear_elementary:
   fixes f :: "real^'n \<Rightarrow> real^'n"
   assumes "linear f"
     and comp: "\<And>f g. \<lbrakk>linear f; linear g; P f; P g\<rbrakk> \<Longrightarrow> P(f \<circ> g)"
     and zeroes: "\<And>f i. \<lbrakk>linear f; \<And>x. (f x) $ i = 0\<rbrakk> \<Longrightarrow> P f"
     and const: "\<And>c. P(\<lambda>x. \<chi> i. c i * x$i)"
     and swap: "\<And>m n::'n. m \<noteq> n \<Longrightarrow> P(\<lambda>x. \<chi> i. x $ Fun.swap m n id i)"
     and idplus: "\<And>m n::'n. m \<noteq> n \<Longrightarrow> P(\<lambda>x. \<chi> i. if i = m then x$m + x$n else x$i)"
   shows "P f"
 proof -
   have "P ((*v) A)" for A
   proof (rule induct_matrix_elementary_alt)
     fix A B
     assume "P ((*v) A)" and "P ((*v) B)"
     then show "P ((*v) (A ** B))"
-      by (auto simp add: matrix_vector_mult_matrix_matrix_mult_compose matrix_vector_mul_linear
-          intro!: comp)
+      by (auto simp add: matrix_vector_mult_matrix_matrix_mult_compose intro!: comp)
   next
     fix A :: "real^'n^'n" and i
     assume "row i A = 0"
     show "P ((*v) A)"
       using matrix_vector_mul_linear
       by (rule zeroes[where i=i])
         (metis \<open>row i A = 0\<close> inner_zero_left matrix_vector_mul_component row_def vec_lambda_eta)
   next
     fix A :: "real^'n^'n"
     assume 0: "\<And>i j. i \<noteq> j \<Longrightarrow> A $ i $ j = 0"
     have "A $ i $ i * x $ i = (\<Sum>j\<in>UNIV. A $ i $ j * x $ j)" for x and i :: "'n"
       by (simp add: 0 comm_monoid_add_class.sum.remove [where x=i])
     then have "(\<lambda>x. \<chi> i. A $ i $ i * x $ i) = ((*v) A)"
       by (auto simp: 0 matrix_vector_mult_def)
     then show "P ((*v) A)"
       using const [of "\<lambda>i. A $ i $ i"] by simp
   next
     fix m n :: "'n"
     assume "m \<noteq> n"
     have eq: "(\<Sum>j\<in>UNIV. if i = Fun.swap m n id j then x $ j else 0) =
               (\<Sum>j\<in>UNIV. if j = Fun.swap m n id i then x $ j else 0)"
       for i and x :: "real^'n"
       unfolding swap_def by (rule sum.cong) auto
     have "(\<lambda>x::real^'n. \<chi> i. x $ Fun.swap m n id i) = ((*v) (\<chi> i j. if i = Fun.swap m n id j then 1 else 0))"
       by (auto simp: mat_def matrix_vector_mult_def eq if_distrib [of "\<lambda>x. x * y" for y] cong: if_cong)
     with swap [OF \<open>m \<noteq> n\<close>] show "P ((*v) (\<chi> i j. mat 1 $ i $ Fun.swap m n id j))"
       by (simp add: mat_def matrix_vector_mult_def)
   next
     fix m n :: "'n"
     assume "m \<noteq> n"
     then have "x $ m + x $ n = (\<Sum>j\<in>UNIV. of_bool (j = n \<or> m = j) * x $ j)" for x :: "real^'n"
       by (auto simp: of_bool_def if_distrib [of "\<lambda>x. x * y" for y] sum.remove cong: if_cong)
     then have "(\<lambda>x::real^'n. \<chi> i. if i = m then x $ m + x $ n else x $ i) =
                ((*v) (\<chi> i j. of_bool (i = m \<and> j = n \<or> i = j)))"
       unfolding matrix_vector_mult_def of_bool_def
       by (auto simp: vec_eq_iff if_distrib [of "\<lambda>x. x * y" for y] cong: if_cong)
     then show "P ((*v) (\<chi> i j. of_bool (i = m \<and> j = n \<or> i = j)))"
       using idplus [OF \<open>m \<noteq> n\<close>] by simp
   qed
   then show ?thesis
     by (metis \<open>linear f\<close> matrix_vector_mul)
 qed
 
 end
\ No newline at end of file
diff --git a/src/HOL/Analysis/Convex.thy b/src/HOL/Analysis/Convex.thy
--- a/src/HOL/Analysis/Convex.thy
+++ b/src/HOL/Analysis/Convex.thy
@@ -1,4140 +1,4140 @@
 (* Title:      HOL/Analysis/Convex.thy
    Author:     L C Paulson, University of Cambridge
    Author:     Robert Himmelmann, TU Muenchen
    Author:     Bogdan Grechuk, University of Edinburgh
    Author:     Armin Heller, TU Muenchen
    Author:     Johannes Hoelzl, TU Muenchen
 *)
 
 section \<open>Convex Sets and Functions\<close>
 
 theory Convex
 imports
   Linear_Algebra
   "HOL-Library.Set_Algebras"
 begin
 
-subsection \<open>Convexity\<close>
+subsection \<open>Convex Sets\<close>
 
 definition\<^marker>\<open>tag important\<close> convex :: "'a::real_vector set \<Rightarrow> bool"
   where "convex s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u\<ge>0. \<forall>v\<ge>0. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> s)"
 
 lemma convexI:
   assumes "\<And>x y u v. x \<in> s \<Longrightarrow> y \<in> s \<Longrightarrow> 0 \<le> u \<Longrightarrow> 0 \<le> v \<Longrightarrow> u + v = 1 \<Longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> s"
   shows "convex s"
   using assms unfolding convex_def by fast
 
 lemma convexD:
   assumes "convex s" and "x \<in> s" and "y \<in> s" and "0 \<le> u" and "0 \<le> v" and "u + v = 1"
   shows "u *\<^sub>R x + v *\<^sub>R y \<in> s"
   using assms unfolding convex_def by fast
 
 lemma convex_alt: "convex s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u. 0 \<le> u \<and> u \<le> 1 \<longrightarrow> ((1 - u) *\<^sub>R x + u *\<^sub>R y) \<in> s)"
   (is "_ \<longleftrightarrow> ?alt")
 proof
   show "convex s" if alt: ?alt
   proof -
     {
       fix x y and u v :: real
       assume mem: "x \<in> s" "y \<in> s"
       assume "0 \<le> u" "0 \<le> v"
       moreover
       assume "u + v = 1"
       then have "u = 1 - v" by auto
       ultimately have "u *\<^sub>R x + v *\<^sub>R y \<in> s"
         using alt [rule_format, OF mem] by auto
     }
     then show ?thesis
       unfolding convex_def by auto
   qed
   show ?alt if "convex s"
     using that by (auto simp: convex_def)
 qed
 
 lemma convexD_alt:
   assumes "convex s" "a \<in> s" "b \<in> s" "0 \<le> u" "u \<le> 1"
   shows "((1 - u) *\<^sub>R a + u *\<^sub>R b) \<in> s"
   using assms unfolding convex_alt by auto
 
 lemma mem_convex_alt:
   assumes "convex S" "x \<in> S" "y \<in> S" "u \<ge> 0" "v \<ge> 0" "u + v > 0"
   shows "((u/(u+v)) *\<^sub>R x + (v/(u+v)) *\<^sub>R y) \<in> S"
   apply (rule convexD)
   using assms
        apply (simp_all add: zero_le_divide_iff add_divide_distrib [symmetric])
   done
 
 lemma convex_empty[intro,simp]: "convex {}"
   unfolding convex_def by simp
 
 lemma convex_singleton[intro,simp]: "convex {a}"
   unfolding convex_def by (auto simp: scaleR_left_distrib[symmetric])
 
 lemma convex_UNIV[intro,simp]: "convex UNIV"
   unfolding convex_def by auto
 
 lemma convex_Inter: "(\<And>s. s\<in>f \<Longrightarrow> convex s) \<Longrightarrow> convex(\<Inter>f)"
   unfolding convex_def by auto
 
 lemma convex_Int: "convex s \<Longrightarrow> convex t \<Longrightarrow> convex (s \<inter> t)"
   unfolding convex_def by auto
 
 lemma convex_INT: "(\<And>i. i \<in> A \<Longrightarrow> convex (B i)) \<Longrightarrow> convex (\<Inter>i\<in>A. B i)"
   unfolding convex_def by auto
 
 lemma convex_Times: "convex s \<Longrightarrow> convex t \<Longrightarrow> convex (s \<times> t)"
   unfolding convex_def by auto
 
 lemma convex_halfspace_le: "convex {x. inner a x \<le> b}"
   unfolding convex_def
   by (auto simp: inner_add intro!: convex_bound_le)
 
 lemma convex_halfspace_ge: "convex {x. inner a x \<ge> b}"
 proof -
   have *: "{x. inner a x \<ge> b} = {x. inner (-a) x \<le> -b}"
     by auto
   show ?thesis
     unfolding * using convex_halfspace_le[of "-a" "-b"] by auto
 qed
 
 lemma convex_halfspace_abs_le: "convex {x. \<bar>inner a x\<bar> \<le> b}"
 proof -
   have *: "{x. \<bar>inner a x\<bar> \<le> b} = {x. inner a x \<le> b} \<inter> {x. -b \<le> inner a x}"
     by auto
   show ?thesis
     unfolding * by (simp add: convex_Int convex_halfspace_ge convex_halfspace_le)
 qed
 
 lemma convex_hyperplane: "convex {x. inner a x = b}"
 proof -
   have *: "{x. inner a x = b} = {x. inner a x \<le> b} \<inter> {x. inner a x \<ge> b}"
     by auto
   show ?thesis using convex_halfspace_le convex_halfspace_ge
     by (auto intro!: convex_Int simp: *)
 qed
 
 lemma convex_halfspace_lt: "convex {x. inner a x < b}"
   unfolding convex_def
   by (auto simp: convex_bound_lt inner_add)
 
 lemma convex_halfspace_gt: "convex {x. inner a x > b}"
   using convex_halfspace_lt[of "-a" "-b"] by auto
 
 lemma convex_halfspace_Re_ge: "convex {x. Re x \<ge> b}"
   using convex_halfspace_ge[of b "1::complex"] by simp
 
 lemma convex_halfspace_Re_le: "convex {x. Re x \<le> b}"
   using convex_halfspace_le[of "1::complex" b] by simp
 
 lemma convex_halfspace_Im_ge: "convex {x. Im x \<ge> b}"
   using convex_halfspace_ge[of b \<i>] by simp
 
 lemma convex_halfspace_Im_le: "convex {x. Im x \<le> b}"
   using convex_halfspace_le[of \<i> b] by simp
 
 lemma convex_halfspace_Re_gt: "convex {x. Re x > b}"
   using convex_halfspace_gt[of b "1::complex"] by simp
 
 lemma convex_halfspace_Re_lt: "convex {x. Re x < b}"
   using convex_halfspace_lt[of "1::complex" b] by simp
 
 lemma convex_halfspace_Im_gt: "convex {x. Im x > b}"
   using convex_halfspace_gt[of b \<i>] by simp
 
 lemma convex_halfspace_Im_lt: "convex {x. Im x < b}"
   using convex_halfspace_lt[of \<i> b] by simp
 
 lemma convex_real_interval [iff]:
   fixes a b :: "real"
   shows "convex {a..}" and "convex {..b}"
     and "convex {a<..}" and "convex {..<b}"
     and "convex {a..b}" and "convex {a<..b}"
     and "convex {a..<b}" and "convex {a<..<b}"
 proof -
   have "{a..} = {x. a \<le> inner 1 x}"
     by auto
   then show 1: "convex {a..}"
     by (simp only: convex_halfspace_ge)
   have "{..b} = {x. inner 1 x \<le> b}"
     by auto
   then show 2: "convex {..b}"
     by (simp only: convex_halfspace_le)
   have "{a<..} = {x. a < inner 1 x}"
     by auto
   then show 3: "convex {a<..}"
     by (simp only: convex_halfspace_gt)
   have "{..<b} = {x. inner 1 x < b}"
     by auto
   then show 4: "convex {..<b}"
     by (simp only: convex_halfspace_lt)
   have "{a..b} = {a..} \<inter> {..b}"
     by auto
   then show "convex {a..b}"
     by (simp only: convex_Int 1 2)
   have "{a<..b} = {a<..} \<inter> {..b}"
     by auto
   then show "convex {a<..b}"
     by (simp only: convex_Int 3 2)
   have "{a..<b} = {a..} \<inter> {..<b}"
     by auto
   then show "convex {a..<b}"
     by (simp only: convex_Int 1 4)
   have "{a<..<b} = {a<..} \<inter> {..<b}"
     by auto
   then show "convex {a<..<b}"
     by (simp only: convex_Int 3 4)
 qed
 
 lemma convex_Reals: "convex \<real>"
   by (simp add: convex_def scaleR_conv_of_real)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Explicit expressions for convexity in terms of arbitrary sums\<close>
 
 lemma convex_sum:
   fixes C :: "'a::real_vector set"
   assumes "finite s"
     and "convex C"
     and "(\<Sum> i \<in> s. a i) = 1"
   assumes "\<And>i. i \<in> s \<Longrightarrow> a i \<ge> 0"
     and "\<And>i. i \<in> s \<Longrightarrow> y i \<in> C"
   shows "(\<Sum> j \<in> s. a j *\<^sub>R y j) \<in> C"
   using assms(1,3,4,5)
 proof (induct arbitrary: a set: finite)
   case empty
   then show ?case by simp
 next
   case (insert i s) note IH = this(3)
   have "a i + sum a s = 1"
     and "0 \<le> a i"
     and "\<forall>j\<in>s. 0 \<le> a j"
     and "y i \<in> C"
     and "\<forall>j\<in>s. y j \<in> C"
     using insert.hyps(1,2) insert.prems by simp_all
   then have "0 \<le> sum a s"
     by (simp add: sum_nonneg)
   have "a i *\<^sub>R y i + (\<Sum>j\<in>s. a j *\<^sub>R y j) \<in> C"
   proof (cases "sum a s = 0")
     case True
     with \<open>a i + sum a s = 1\<close> have "a i = 1"
       by simp
     from sum_nonneg_0 [OF \<open>finite s\<close> _ True] \<open>\<forall>j\<in>s. 0 \<le> a j\<close> have "\<forall>j\<in>s. a j = 0"
       by simp
     show ?thesis using \<open>a i = 1\<close> and \<open>\<forall>j\<in>s. a j = 0\<close> and \<open>y i \<in> C\<close>
       by simp
   next
     case False
     with \<open>0 \<le> sum a s\<close> have "0 < sum a s"
       by simp
     then have "(\<Sum>j\<in>s. (a j / sum a s) *\<^sub>R y j) \<in> C"
       using \<open>\<forall>j\<in>s. 0 \<le> a j\<close> and \<open>\<forall>j\<in>s. y j \<in> C\<close>
       by (simp add: IH sum_divide_distrib [symmetric])
     from \<open>convex C\<close> and \<open>y i \<in> C\<close> and this and \<open>0 \<le> a i\<close>
       and \<open>0 \<le> sum a s\<close> and \<open>a i + sum a s = 1\<close>
     have "a i *\<^sub>R y i + sum a s *\<^sub>R (\<Sum>j\<in>s. (a j / sum a s) *\<^sub>R y j) \<in> C"
       by (rule convexD)
     then show ?thesis
       by (simp add: scaleR_sum_right False)
   qed
   then show ?case using \<open>finite s\<close> and \<open>i \<notin> s\<close>
     by simp
 qed
 
 lemma convex:
   "convex s \<longleftrightarrow> (\<forall>(k::nat) u x. (\<forall>i. 1\<le>i \<and> i\<le>k \<longrightarrow> 0 \<le> u i \<and> x i \<in>s) \<and> (sum u {1..k} = 1)
       \<longrightarrow> sum (\<lambda>i. u i *\<^sub>R x i) {1..k} \<in> s)"
 proof safe
   fix k :: nat
   fix u :: "nat \<Rightarrow> real"
   fix x
   assume "convex s"
     "\<forall>i. 1 \<le> i \<and> i \<le> k \<longrightarrow> 0 \<le> u i \<and> x i \<in> s"
     "sum u {1..k} = 1"
   with convex_sum[of "{1 .. k}" s] show "(\<Sum>j\<in>{1 .. k}. u j *\<^sub>R x j) \<in> s"
     by auto
 next
   assume *: "\<forall>k u x. (\<forall> i :: nat. 1 \<le> i \<and> i \<le> k \<longrightarrow> 0 \<le> u i \<and> x i \<in> s) \<and> sum u {1..k} = 1
     \<longrightarrow> (\<Sum>i = 1..k. u i *\<^sub>R (x i :: 'a)) \<in> s"
   {
     fix \<mu> :: real
     fix x y :: 'a
     assume xy: "x \<in> s" "y \<in> s"
     assume mu: "\<mu> \<ge> 0" "\<mu> \<le> 1"
     let ?u = "\<lambda>i. if (i :: nat) = 1 then \<mu> else 1 - \<mu>"
     let ?x = "\<lambda>i. if (i :: nat) = 1 then x else y"
     have "{1 :: nat .. 2} \<inter> - {x. x = 1} = {2}"
       by auto
     then have card: "card ({1 :: nat .. 2} \<inter> - {x. x = 1}) = 1"
       by simp
     then have "sum ?u {1 .. 2} = 1"
       using sum.If_cases[of "{(1 :: nat) .. 2}" "\<lambda> x. x = 1" "\<lambda> x. \<mu>" "\<lambda> x. 1 - \<mu>"]
       by auto
     with *[rule_format, of "2" ?u ?x] have s: "(\<Sum>j \<in> {1..2}. ?u j *\<^sub>R ?x j) \<in> s"
       using mu xy by auto
     have grarr: "(\<Sum>j \<in> {Suc (Suc 0)..2}. ?u j *\<^sub>R ?x j) = (1 - \<mu>) *\<^sub>R y"
       using sum.atLeast_Suc_atMost[of "Suc (Suc 0)" 2 "\<lambda> j. (1 - \<mu>) *\<^sub>R y"] by auto
     from sum.atLeast_Suc_atMost[of "Suc 0" 2 "\<lambda> j. ?u j *\<^sub>R ?x j", simplified this]
     have "(\<Sum>j \<in> {1..2}. ?u j *\<^sub>R ?x j) = \<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y"
       by auto
     then have "(1 - \<mu>) *\<^sub>R y + \<mu> *\<^sub>R x \<in> s"
       using s by (auto simp: add.commute)
   }
   then show "convex s"
     unfolding convex_alt by auto
 qed
 
 
 lemma convex_explicit:
   fixes s :: "'a::real_vector set"
   shows "convex s \<longleftrightarrow>
     (\<forall>t u. finite t \<and> t \<subseteq> s \<and> (\<forall>x\<in>t. 0 \<le> u x) \<and> sum u t = 1 \<longrightarrow> sum (\<lambda>x. u x *\<^sub>R x) t \<in> s)"
 proof safe
   fix t
   fix u :: "'a \<Rightarrow> real"
   assume "convex s"
     and "finite t"
     and "t \<subseteq> s" "\<forall>x\<in>t. 0 \<le> u x" "sum u t = 1"
   then show "(\<Sum>x\<in>t. u x *\<^sub>R x) \<in> s"
     using convex_sum[of t s u "\<lambda> x. x"] by auto
 next
   assume *: "\<forall>t. \<forall> u. finite t \<and> t \<subseteq> s \<and> (\<forall>x\<in>t. 0 \<le> u x) \<and>
     sum u t = 1 \<longrightarrow> (\<Sum>x\<in>t. u x *\<^sub>R x) \<in> s"
   show "convex s"
     unfolding convex_alt
   proof safe
     fix x y
     fix \<mu> :: real
     assume **: "x \<in> s" "y \<in> s" "0 \<le> \<mu>" "\<mu> \<le> 1"
     show "(1 - \<mu>) *\<^sub>R x + \<mu> *\<^sub>R y \<in> s"
     proof (cases "x = y")
       case False
       then show ?thesis
         using *[rule_format, of "{x, y}" "\<lambda> z. if z = x then 1 - \<mu> else \<mu>"] **
         by auto
     next
       case True
       then show ?thesis
         using *[rule_format, of "{x, y}" "\<lambda> z. 1"] **
         by (auto simp: field_simps real_vector.scale_left_diff_distrib)
     qed
   qed
 qed
 
 lemma convex_finite:
   assumes "finite s"
   shows "convex s \<longleftrightarrow> (\<forall>u. (\<forall>x\<in>s. 0 \<le> u x) \<and> sum u s = 1 \<longrightarrow> sum (\<lambda>x. u x *\<^sub>R x) s \<in> s)"
   unfolding convex_explicit
   apply safe
   subgoal for u by (erule allE [where x=s], erule allE [where x=u]) auto
   subgoal for t u
   proof -
     have if_distrib_arg: "\<And>P f g x. (if P then f else g) x = (if P then f x else g x)"
       by simp
     assume sum: "\<forall>u. (\<forall>x\<in>s. 0 \<le> u x) \<and> sum u s = 1 \<longrightarrow> (\<Sum>x\<in>s. u x *\<^sub>R x) \<in> s"
     assume *: "\<forall>x\<in>t. 0 \<le> u x" "sum u t = 1"
     assume "t \<subseteq> s"
     then have "s \<inter> t = t" by auto
     with sum[THEN spec[where x="\<lambda>x. if x\<in>t then u x else 0"]] * show "(\<Sum>x\<in>t. u x *\<^sub>R x) \<in> s"
       by (auto simp: assms sum.If_cases if_distrib if_distrib_arg)
   qed
   done
 
 
-subsection \<open>Functions that are convex on a set\<close>
+subsection \<open>Convex Functions on a Set\<close>
 
 definition\<^marker>\<open>tag important\<close> convex_on :: "'a::real_vector set \<Rightarrow> ('a \<Rightarrow> real) \<Rightarrow> bool"
   where "convex_on s f \<longleftrightarrow>
     (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u\<ge>0. \<forall>v\<ge>0. u + v = 1 \<longrightarrow> f (u *\<^sub>R x + v *\<^sub>R y) \<le> u * f x + v * f y)"
 
 lemma convex_onI [intro?]:
   assumes "\<And>t x y. t > 0 \<Longrightarrow> t < 1 \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow>
     f ((1 - t) *\<^sub>R x + t *\<^sub>R y) \<le> (1 - t) * f x + t * f y"
   shows "convex_on A f"
   unfolding convex_on_def
 proof clarify
   fix x y
   fix u v :: real
   assume A: "x \<in> A" "y \<in> A" "u \<ge> 0" "v \<ge> 0" "u + v = 1"
   from A(5) have [simp]: "v = 1 - u"
     by (simp add: algebra_simps)
   from A(1-4) show "f (u *\<^sub>R x + v *\<^sub>R y) \<le> u * f x + v * f y"
     using assms[of u y x]
     by (cases "u = 0 \<or> u = 1") (auto simp: algebra_simps)
 qed
 
 lemma convex_on_linorderI [intro?]:
   fixes A :: "('a::{linorder,real_vector}) set"
   assumes "\<And>t x y. t > 0 \<Longrightarrow> t < 1 \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x < y \<Longrightarrow>
     f ((1 - t) *\<^sub>R x + t *\<^sub>R y) \<le> (1 - t) * f x + t * f y"
   shows "convex_on A f"
 proof
   fix x y
   fix t :: real
   assume A: "x \<in> A" "y \<in> A" "t > 0" "t < 1"
   with assms [of t x y] assms [of "1 - t" y x]
   show "f ((1 - t) *\<^sub>R x + t *\<^sub>R y) \<le> (1 - t) * f x + t * f y"
     by (cases x y rule: linorder_cases) (auto simp: algebra_simps)
 qed
 
 lemma convex_onD:
   assumes "convex_on A f"
   shows "\<And>t x y. t \<ge> 0 \<Longrightarrow> t \<le> 1 \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow>
     f ((1 - t) *\<^sub>R x + t *\<^sub>R y) \<le> (1 - t) * f x + t * f y"
   using assms by (auto simp: convex_on_def)
 
 lemma convex_onD_Icc:
   assumes "convex_on {x..y} f" "x \<le> (y :: _ :: {real_vector,preorder})"
   shows "\<And>t. t \<ge> 0 \<Longrightarrow> t \<le> 1 \<Longrightarrow>
     f ((1 - t) *\<^sub>R x + t *\<^sub>R y) \<le> (1 - t) * f x + t * f y"
   using assms(2) by (intro convex_onD [OF assms(1)]) simp_all
 
 lemma convex_on_subset: "convex_on t f \<Longrightarrow> s \<subseteq> t \<Longrightarrow> convex_on s f"
   unfolding convex_on_def by auto
 
 lemma convex_on_add [intro]:
   assumes "convex_on s f"
     and "convex_on s g"
   shows "convex_on s (\<lambda>x. f x + g x)"
 proof -
   {
     fix x y
     assume "x \<in> s" "y \<in> s"
     moreover
     fix u v :: real
     assume "0 \<le> u" "0 \<le> v" "u + v = 1"
     ultimately
     have "f (u *\<^sub>R x + v *\<^sub>R y) + g (u *\<^sub>R x + v *\<^sub>R y) \<le> (u * f x + v * f y) + (u * g x + v * g y)"
       using assms unfolding convex_on_def by (auto simp: add_mono)
     then have "f (u *\<^sub>R x + v *\<^sub>R y) + g (u *\<^sub>R x + v *\<^sub>R y) \<le> u * (f x + g x) + v * (f y + g y)"
       by (simp add: field_simps)
   }
   then show ?thesis
     unfolding convex_on_def by auto
 qed
 
 lemma convex_on_cmul [intro]:
   fixes c :: real
   assumes "0 \<le> c"
     and "convex_on s f"
   shows "convex_on s (\<lambda>x. c * f x)"
 proof -
   have *: "u * (c * fx) + v * (c * fy) = c * (u * fx + v * fy)"
     for u c fx v fy :: real
     by (simp add: field_simps)
   show ?thesis using assms(2) and mult_left_mono [OF _ assms(1)]
     unfolding convex_on_def and * by auto
 qed
 
 lemma convex_lower:
   assumes "convex_on s f"
     and "x \<in> s"
     and "y \<in> s"
     and "0 \<le> u"
     and "0 \<le> v"
     and "u + v = 1"
   shows "f (u *\<^sub>R x + v *\<^sub>R y) \<le> max (f x) (f y)"
 proof -
   let ?m = "max (f x) (f y)"
   have "u * f x + v * f y \<le> u * max (f x) (f y) + v * max (f x) (f y)"
     using assms(4,5) by (auto simp: mult_left_mono add_mono)
   also have "\<dots> = max (f x) (f y)"
     using assms(6) by (simp add: distrib_right [symmetric])
   finally show ?thesis
     using assms unfolding convex_on_def by fastforce
 qed
 
 lemma convex_on_dist [intro]:
   fixes s :: "'a::real_normed_vector set"
   shows "convex_on s (\<lambda>x. dist a x)"
 proof (auto simp: convex_on_def dist_norm)
   fix x y
   assume "x \<in> s" "y \<in> s"
   fix u v :: real
   assume "0 \<le> u"
   assume "0 \<le> v"
   assume "u + v = 1"
   have "a = u *\<^sub>R a + v *\<^sub>R a"
     unfolding scaleR_left_distrib[symmetric] and \<open>u + v = 1\<close> by simp
   then have *: "a - (u *\<^sub>R x + v *\<^sub>R y) = (u *\<^sub>R (a - x)) + (v *\<^sub>R (a - y))"
     by (auto simp: algebra_simps)
   show "norm (a - (u *\<^sub>R x + v *\<^sub>R y)) \<le> u * norm (a - x) + v * norm (a - y)"
     unfolding * using norm_triangle_ineq[of "u *\<^sub>R (a - x)" "v *\<^sub>R (a - y)"]
     using \<open>0 \<le> u\<close> \<open>0 \<le> v\<close> by auto
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Arithmetic operations on sets preserve convexity\<close>
 
 lemma convex_linear_image:
   assumes "linear f"
     and "convex s"
   shows "convex (f ` s)"
 proof -
   interpret f: linear f by fact
   from \<open>convex s\<close> show "convex (f ` s)"
     by (simp add: convex_def f.scaleR [symmetric] f.add [symmetric])
 qed
 
 lemma convex_linear_vimage:
   assumes "linear f"
     and "convex s"
   shows "convex (f -` s)"
 proof -
   interpret f: linear f by fact
   from \<open>convex s\<close> show "convex (f -` s)"
     by (simp add: convex_def f.add f.scaleR)
 qed
 
 lemma convex_scaling:
   assumes "convex s"
   shows "convex ((\<lambda>x. c *\<^sub>R x) ` s)"
 proof -
   have "linear (\<lambda>x. c *\<^sub>R x)"
     by (simp add: linearI scaleR_add_right)
   then show ?thesis
     using \<open>convex s\<close> by (rule convex_linear_image)
 qed
 
 lemma convex_scaled:
   assumes "convex S"
   shows "convex ((\<lambda>x. x *\<^sub>R c) ` S)"
 proof -
   have "linear (\<lambda>x. x *\<^sub>R c)"
     by (simp add: linearI scaleR_add_left)
   then show ?thesis
     using \<open>convex S\<close> by (rule convex_linear_image)
 qed
 
 lemma convex_negations:
   assumes "convex S"
   shows "convex ((\<lambda>x. - x) ` S)"
 proof -
   have "linear (\<lambda>x. - x)"
     by (simp add: linearI)
   then show ?thesis
     using \<open>convex S\<close> by (rule convex_linear_image)
 qed
 
 lemma convex_sums:
   assumes "convex S"
     and "convex T"
   shows "convex (\<Union>x\<in> S. \<Union>y \<in> T. {x + y})"
 proof -
   have "linear (\<lambda>(x, y). x + y)"
     by (auto intro: linearI simp: scaleR_add_right)
   with assms have "convex ((\<lambda>(x, y). x + y) ` (S \<times> T))"
     by (intro convex_linear_image convex_Times)
   also have "((\<lambda>(x, y). x + y) ` (S \<times> T)) = (\<Union>x\<in> S. \<Union>y \<in> T. {x + y})"
     by auto
   finally show ?thesis .
 qed
 
 lemma convex_differences:
   assumes "convex S" "convex T"
   shows "convex (\<Union>x\<in> S. \<Union>y \<in> T. {x - y})"
 proof -
   have "{x - y| x y. x \<in> S \<and> y \<in> T} = {x + y |x y. x \<in> S \<and> y \<in> uminus ` T}"
     by (auto simp: diff_conv_add_uminus simp del: add_uminus_conv_diff)
   then show ?thesis
     using convex_sums[OF assms(1) convex_negations[OF assms(2)]] by auto
 qed
 
 lemma convex_translation:
   "convex ((+) a ` S)" if "convex S"
 proof -
   have "(\<Union> x\<in> {a}. \<Union>y \<in> S. {x + y}) = (+) a ` S"
     by auto
   then show ?thesis
     using convex_sums [OF convex_singleton [of a] that] by auto
 qed
 
 lemma convex_translation_subtract:
   "convex ((\<lambda>b. b - a) ` S)" if "convex S"
   using convex_translation [of S "- a"] that by (simp cong: image_cong_simp)
 
 lemma convex_affinity:
   assumes "convex S"
   shows "convex ((\<lambda>x. a + c *\<^sub>R x) ` S)"
 proof -
   have "(\<lambda>x. a + c *\<^sub>R x) ` S = (+) a ` (*\<^sub>R) c ` S"
     by auto
   then show ?thesis
     using convex_translation[OF convex_scaling[OF assms], of a c] by auto
 qed
 
 lemma pos_is_convex: "convex {0 :: real <..}"
   unfolding convex_alt
 proof safe
   fix y x \<mu> :: real
   assume *: "y > 0" "x > 0" "\<mu> \<ge> 0" "\<mu> \<le> 1"
   {
     assume "\<mu> = 0"
     then have "\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y = y"
       by simp
     then have "\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y > 0"
       using * by simp
   }
   moreover
   {
     assume "\<mu> = 1"
     then have "\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y > 0"
       using * by simp
   }
   moreover
   {
     assume "\<mu> \<noteq> 1" "\<mu> \<noteq> 0"
     then have "\<mu> > 0" "(1 - \<mu>) > 0"
       using * by auto
     then have "\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y > 0"
       using * by (auto simp: add_pos_pos)
   }
   ultimately show "(1 - \<mu>) *\<^sub>R y + \<mu> *\<^sub>R x > 0"
     by fastforce
 qed
 
 lemma convex_on_sum:
   fixes a :: "'a \<Rightarrow> real"
     and y :: "'a \<Rightarrow> 'b::real_vector"
     and f :: "'b \<Rightarrow> real"
   assumes "finite s" "s \<noteq> {}"
     and "convex_on C f"
     and "convex C"
     and "(\<Sum> i \<in> s. a i) = 1"
     and "\<And>i. i \<in> s \<Longrightarrow> a i \<ge> 0"
     and "\<And>i. i \<in> s \<Longrightarrow> y i \<in> C"
   shows "f (\<Sum> i \<in> s. a i *\<^sub>R y i) \<le> (\<Sum> i \<in> s. a i * f (y i))"
   using assms
 proof (induct s arbitrary: a rule: finite_ne_induct)
   case (singleton i)
   then have ai: "a i = 1"
     by auto
   then show ?case
     by auto
 next
   case (insert i s)
   then have "convex_on C f"
     by simp
   from this[unfolded convex_on_def, rule_format]
   have conv: "\<And>x y \<mu>. x \<in> C \<Longrightarrow> y \<in> C \<Longrightarrow> 0 \<le> \<mu> \<Longrightarrow> \<mu> \<le> 1 \<Longrightarrow>
       f (\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y) \<le> \<mu> * f x + (1 - \<mu>) * f y"
     by simp
   show ?case
   proof (cases "a i = 1")
     case True
     then have "(\<Sum> j \<in> s. a j) = 0"
       using insert by auto
     then have "\<And>j. j \<in> s \<Longrightarrow> a j = 0"
       using insert by (fastforce simp: sum_nonneg_eq_0_iff)
     then show ?thesis
       using insert by auto
   next
     case False
     from insert have yai: "y i \<in> C" "a i \<ge> 0"
       by auto
     have fis: "finite (insert i s)"
       using insert by auto
     then have ai1: "a i \<le> 1"
       using sum_nonneg_leq_bound[of "insert i s" a] insert by simp
     then have "a i < 1"
       using False by auto
     then have i0: "1 - a i > 0"
       by auto
     let ?a = "\<lambda>j. a j / (1 - a i)"
     have a_nonneg: "?a j \<ge> 0" if "j \<in> s" for j
       using i0 insert that by fastforce
     have "(\<Sum> j \<in> insert i s. a j) = 1"
       using insert by auto
     then have "(\<Sum> j \<in> s. a j) = 1 - a i"
       using sum.insert insert by fastforce
     then have "(\<Sum> j \<in> s. a j) / (1 - a i) = 1"
       using i0 by auto
     then have a1: "(\<Sum> j \<in> s. ?a j) = 1"
       unfolding sum_divide_distrib by simp
     have "convex C" using insert by auto
     then have asum: "(\<Sum> j \<in> s. ?a j *\<^sub>R y j) \<in> C"
       using insert convex_sum [OF \<open>finite s\<close> \<open>convex C\<close> a1 a_nonneg] by auto
     have asum_le: "f (\<Sum> j \<in> s. ?a j *\<^sub>R y j) \<le> (\<Sum> j \<in> s. ?a j * f (y j))"
       using a_nonneg a1 insert by blast
     have "f (\<Sum> j \<in> insert i s. a j *\<^sub>R y j) = f ((\<Sum> j \<in> s. a j *\<^sub>R y j) + a i *\<^sub>R y i)"
       using sum.insert[of s i "\<lambda> j. a j *\<^sub>R y j", OF \<open>finite s\<close> \<open>i \<notin> s\<close>] insert
       by (auto simp only: add.commute)
     also have "\<dots> = f (((1 - a i) * inverse (1 - a i)) *\<^sub>R (\<Sum> j \<in> s. a j *\<^sub>R y j) + a i *\<^sub>R y i)"
       using i0 by auto
     also have "\<dots> = f ((1 - a i) *\<^sub>R (\<Sum> j \<in> s. (a j * inverse (1 - a i)) *\<^sub>R y j) + a i *\<^sub>R y i)"
       using scaleR_right.sum[of "inverse (1 - a i)" "\<lambda> j. a j *\<^sub>R y j" s, symmetric]
       by (auto simp: algebra_simps)
     also have "\<dots> = f ((1 - a i) *\<^sub>R (\<Sum> j \<in> s. ?a j *\<^sub>R y j) + a i *\<^sub>R y i)"
       by (auto simp: divide_inverse)
     also have "\<dots> \<le> (1 - a i) *\<^sub>R f ((\<Sum> j \<in> s. ?a j *\<^sub>R y j)) + a i * f (y i)"
       using conv[of "y i" "(\<Sum> j \<in> s. ?a j *\<^sub>R y j)" "a i", OF yai(1) asum yai(2) ai1]
       by (auto simp: add.commute)
     also have "\<dots> \<le> (1 - a i) * (\<Sum> j \<in> s. ?a j * f (y j)) + a i * f (y i)"
       using add_right_mono [OF mult_left_mono [of _ _ "1 - a i",
             OF asum_le less_imp_le[OF i0]], of "a i * f (y i)"]
       by simp
     also have "\<dots> = (\<Sum> j \<in> s. (1 - a i) * ?a j * f (y j)) + a i * f (y i)"
       unfolding sum_distrib_left[of "1 - a i" "\<lambda> j. ?a j * f (y j)"]
       using i0 by auto
     also have "\<dots> = (\<Sum> j \<in> s. a j * f (y j)) + a i * f (y i)"
       using i0 by auto
     also have "\<dots> = (\<Sum> j \<in> insert i s. a j * f (y j))"
       using insert by auto
     finally show ?thesis
       by simp
   qed
 qed
 
 lemma convex_on_alt:
   fixes C :: "'a::real_vector set"
   assumes "convex C"
   shows "convex_on C f \<longleftrightarrow>
     (\<forall>x \<in> C. \<forall> y \<in> C. \<forall> \<mu> :: real. \<mu> \<ge> 0 \<and> \<mu> \<le> 1 \<longrightarrow>
       f (\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y) \<le> \<mu> * f x + (1 - \<mu>) * f y)"
 proof safe
   fix x y
   fix \<mu> :: real
   assume *: "convex_on C f" "x \<in> C" "y \<in> C" "0 \<le> \<mu>" "\<mu> \<le> 1"
   from this[unfolded convex_on_def, rule_format]
   have "0 \<le> u \<Longrightarrow> 0 \<le> v \<Longrightarrow> u + v = 1 \<Longrightarrow> f (u *\<^sub>R x + v *\<^sub>R y) \<le> u * f x + v * f y" for u v
     by auto
   from this [of "\<mu>" "1 - \<mu>", simplified] *
   show "f (\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y) \<le> \<mu> * f x + (1 - \<mu>) * f y"
     by auto
 next
   assume *: "\<forall>x\<in>C. \<forall>y\<in>C. \<forall>\<mu>. 0 \<le> \<mu> \<and> \<mu> \<le> 1 \<longrightarrow>
     f (\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y) \<le> \<mu> * f x + (1 - \<mu>) * f y"
   {
     fix x y
     fix u v :: real
     assume **: "x \<in> C" "y \<in> C" "u \<ge> 0" "v \<ge> 0" "u + v = 1"
     then have[simp]: "1 - u = v" by auto
     from *[rule_format, of x y u]
     have "f (u *\<^sub>R x + v *\<^sub>R y) \<le> u * f x + v * f y"
       using ** by auto
   }
   then show "convex_on C f"
     unfolding convex_on_def by auto
 qed
 
 lemma convex_on_diff:
   fixes f :: "real \<Rightarrow> real"
   assumes f: "convex_on I f"
     and I: "x \<in> I" "y \<in> I"
     and t: "x < t" "t < y"
   shows "(f x - f t) / (x - t) \<le> (f x - f y) / (x - y)"
     and "(f x - f y) / (x - y) \<le> (f t - f y) / (t - y)"
 proof -
   define a where "a \<equiv> (t - y) / (x - y)"
   with t have "0 \<le> a" "0 \<le> 1 - a"
     by (auto simp: field_simps)
   with f \<open>x \<in> I\<close> \<open>y \<in> I\<close> have cvx: "f (a * x + (1 - a) * y) \<le> a * f x + (1 - a) * f y"
     by (auto simp: convex_on_def)
   have "a * x + (1 - a) * y = a * (x - y) + y"
     by (simp add: field_simps)
   also have "\<dots> = t"
     unfolding a_def using \<open>x < t\<close> \<open>t < y\<close> by simp
   finally have "f t \<le> a * f x + (1 - a) * f y"
     using cvx by simp
   also have "\<dots> = a * (f x - f y) + f y"
     by (simp add: field_simps)
   finally have "f t - f y \<le> a * (f x - f y)"
     by simp
   with t show "(f x - f t) / (x - t) \<le> (f x - f y) / (x - y)"
     by (simp add: le_divide_eq divide_le_eq field_simps a_def)
   with t show "(f x - f y) / (x - y) \<le> (f t - f y) / (t - y)"
     by (simp add: le_divide_eq divide_le_eq field_simps)
 qed
 
 lemma pos_convex_function:
   fixes f :: "real \<Rightarrow> real"
   assumes "convex C"
     and leq: "\<And>x y. x \<in> C \<Longrightarrow> y \<in> C \<Longrightarrow> f' x * (y - x) \<le> f y - f x"
   shows "convex_on C f"
   unfolding convex_on_alt[OF assms(1)]
   using assms
 proof safe
   fix x y \<mu> :: real
   let ?x = "\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y"
   assume *: "convex C" "x \<in> C" "y \<in> C" "\<mu> \<ge> 0" "\<mu> \<le> 1"
   then have "1 - \<mu> \<ge> 0" by auto
   then have xpos: "?x \<in> C"
     using * unfolding convex_alt by fastforce
   have geq: "\<mu> * (f x - f ?x) + (1 - \<mu>) * (f y - f ?x) \<ge>
       \<mu> * f' ?x * (x - ?x) + (1 - \<mu>) * f' ?x * (y - ?x)"
     using add_mono [OF mult_left_mono [OF leq [OF xpos *(2)] \<open>\<mu> \<ge> 0\<close>]
         mult_left_mono [OF leq [OF xpos *(3)] \<open>1 - \<mu> \<ge> 0\<close>]]
     by auto
   then have "\<mu> * f x + (1 - \<mu>) * f y - f ?x \<ge> 0"
     by (auto simp: field_simps)
   then show "f (\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y) \<le> \<mu> * f x + (1 - \<mu>) * f y"
     using convex_on_alt by auto
 qed
 
 lemma atMostAtLeast_subset_convex:
   fixes C :: "real set"
   assumes "convex C"
     and "x \<in> C" "y \<in> C" "x < y"
   shows "{x .. y} \<subseteq> C"
 proof safe
   fix z assume z: "z \<in> {x .. y}"
   have less: "z \<in> C" if *: "x < z" "z < y"
   proof -
     let ?\<mu> = "(y - z) / (y - x)"
     have "0 \<le> ?\<mu>" "?\<mu> \<le> 1"
       using assms * by (auto simp: field_simps)
     then have comb: "?\<mu> * x + (1 - ?\<mu>) * y \<in> C"
       using assms iffD1[OF convex_alt, rule_format, of C y x ?\<mu>]
       by (simp add: algebra_simps)
     have "?\<mu> * x + (1 - ?\<mu>) * y = (y - z) * x / (y - x) + (1 - (y - z) / (y - x)) * y"
       by (auto simp: field_simps)
     also have "\<dots> = ((y - z) * x + (y - x - (y - z)) * y) / (y - x)"
       using assms by (simp only: add_divide_distrib) (auto simp: field_simps)
     also have "\<dots> = z"
       using assms by (auto simp: field_simps)
     finally show ?thesis
       using comb by auto
   qed
   show "z \<in> C"
     using z less assms by (auto simp: le_less)
 qed
 
 lemma f''_imp_f':
   fixes f :: "real \<Rightarrow> real"
   assumes "convex C"
     and f': "\<And>x. x \<in> C \<Longrightarrow> DERIV f x :> (f' x)"
     and f'': "\<And>x. x \<in> C \<Longrightarrow> DERIV f' x :> (f'' x)"
     and pos: "\<And>x. x \<in> C \<Longrightarrow> f'' x \<ge> 0"
     and x: "x \<in> C"
     and y: "y \<in> C"
   shows "f' x * (y - x) \<le> f y - f x"
   using assms
 proof -
   have less_imp: "f y - f x \<ge> f' x * (y - x)" "f' y * (x - y) \<le> f x - f y"
     if *: "x \<in> C" "y \<in> C" "y > x" for x y :: real
   proof -
     from * have ge: "y - x > 0" "y - x \<ge> 0"
       by auto
     from * have le: "x - y < 0" "x - y \<le> 0"
       by auto
     then obtain z1 where z1: "z1 > x" "z1 < y" "f y - f x = (y - x) * f' z1"
       using subsetD[OF atMostAtLeast_subset_convex[OF \<open>convex C\<close> \<open>x \<in> C\<close> \<open>y \<in> C\<close> \<open>x < y\<close>],
           THEN f', THEN MVT2[OF \<open>x < y\<close>, rule_format, unfolded atLeastAtMost_iff[symmetric]]]
       by auto
     then have "z1 \<in> C"
       using atMostAtLeast_subset_convex \<open>convex C\<close> \<open>x \<in> C\<close> \<open>y \<in> C\<close> \<open>x < y\<close>
       by fastforce
     from z1 have z1': "f x - f y = (x - y) * f' z1"
       by (simp add: field_simps)
     obtain z2 where z2: "z2 > x" "z2 < z1" "f' z1 - f' x = (z1 - x) * f'' z2"
       using subsetD[OF atMostAtLeast_subset_convex[OF \<open>convex C\<close> \<open>x \<in> C\<close> \<open>z1 \<in> C\<close> \<open>x < z1\<close>],
           THEN f'', THEN MVT2[OF \<open>x < z1\<close>, rule_format, unfolded atLeastAtMost_iff[symmetric]]] z1
       by auto
     obtain z3 where z3: "z3 > z1" "z3 < y" "f' y - f' z1 = (y - z1) * f'' z3"
       using subsetD[OF atMostAtLeast_subset_convex[OF \<open>convex C\<close> \<open>z1 \<in> C\<close> \<open>y \<in> C\<close> \<open>z1 < y\<close>],
           THEN f'', THEN MVT2[OF \<open>z1 < y\<close>, rule_format, unfolded atLeastAtMost_iff[symmetric]]] z1
       by auto
     have "f' y - (f x - f y) / (x - y) = f' y - f' z1"
       using * z1' by auto
     also have "\<dots> = (y - z1) * f'' z3"
       using z3 by auto
     finally have cool': "f' y - (f x - f y) / (x - y) = (y - z1) * f'' z3"
       by simp
     have A': "y - z1 \<ge> 0"
       using z1 by auto
     have "z3 \<in> C"
       using z3 * atMostAtLeast_subset_convex \<open>convex C\<close> \<open>x \<in> C\<close> \<open>z1 \<in> C\<close> \<open>x < z1\<close>
       by fastforce
     then have B': "f'' z3 \<ge> 0"
       using assms by auto
     from A' B' have "(y - z1) * f'' z3 \<ge> 0"
       by auto
     from cool' this have "f' y - (f x - f y) / (x - y) \<ge> 0"
       by auto
     from mult_right_mono_neg[OF this le(2)]
     have "f' y * (x - y) - (f x - f y) / (x - y) * (x - y) \<le> 0 * (x - y)"
       by (simp add: algebra_simps)
     then have "f' y * (x - y) - (f x - f y) \<le> 0"
       using le by auto
     then have res: "f' y * (x - y) \<le> f x - f y"
       by auto
     have "(f y - f x) / (y - x) - f' x = f' z1 - f' x"
       using * z1 by auto
     also have "\<dots> = (z1 - x) * f'' z2"
       using z2 by auto
     finally have cool: "(f y - f x) / (y - x) - f' x = (z1 - x) * f'' z2"
       by simp
     have A: "z1 - x \<ge> 0"
       using z1 by auto
     have "z2 \<in> C"
       using z2 z1 * atMostAtLeast_subset_convex \<open>convex C\<close> \<open>z1 \<in> C\<close> \<open>y \<in> C\<close> \<open>z1 < y\<close>
       by fastforce
     then have B: "f'' z2 \<ge> 0"
       using assms by auto
     from A B have "(z1 - x) * f'' z2 \<ge> 0"
       by auto
     with cool have "(f y - f x) / (y - x) - f' x \<ge> 0"
       by auto
     from mult_right_mono[OF this ge(2)]
     have "(f y - f x) / (y - x) * (y - x) - f' x * (y - x) \<ge> 0 * (y - x)"
       by (simp add: algebra_simps)
     then have "f y - f x - f' x * (y - x) \<ge> 0"
       using ge by auto
     then show "f y - f x \<ge> f' x * (y - x)" "f' y * (x - y) \<le> f x - f y"
       using res by auto
   qed
   show ?thesis
   proof (cases "x = y")
     case True
     with x y show ?thesis by auto
   next
     case False
     with less_imp x y show ?thesis
       by (auto simp: neq_iff)
   qed
 qed
 
 lemma f''_ge0_imp_convex:
   fixes f :: "real \<Rightarrow> real"
   assumes conv: "convex C"
     and f': "\<And>x. x \<in> C \<Longrightarrow> DERIV f x :> (f' x)"
     and f'': "\<And>x. x \<in> C \<Longrightarrow> DERIV f' x :> (f'' x)"
     and pos: "\<And>x. x \<in> C \<Longrightarrow> f'' x \<ge> 0"
   shows "convex_on C f"
   using f''_imp_f'[OF conv f' f'' pos] assms pos_convex_function
   by fastforce
 
 lemma minus_log_convex:
   fixes b :: real
   assumes "b > 1"
   shows "convex_on {0 <..} (\<lambda> x. - log b x)"
 proof -
   have "\<And>z. z > 0 \<Longrightarrow> DERIV (log b) z :> 1 / (ln b * z)"
     using DERIV_log by auto
   then have f': "\<And>z. z > 0 \<Longrightarrow> DERIV (\<lambda> z. - log b z) z :> - 1 / (ln b * z)"
     by (auto simp: DERIV_minus)
   have "\<And>z::real. z > 0 \<Longrightarrow> DERIV inverse z :> - (inverse z ^ Suc (Suc 0))"
     using less_imp_neq[THEN not_sym, THEN DERIV_inverse] by auto
   from this[THEN DERIV_cmult, of _ "- 1 / ln b"]
   have "\<And>z::real. z > 0 \<Longrightarrow>
     DERIV (\<lambda> z. (- 1 / ln b) * inverse z) z :> (- 1 / ln b) * (- (inverse z ^ Suc (Suc 0)))"
     by auto
   then have f''0: "\<And>z::real. z > 0 \<Longrightarrow>
     DERIV (\<lambda> z. - 1 / (ln b * z)) z :> 1 / (ln b * z * z)"
     unfolding inverse_eq_divide by (auto simp: mult.assoc)
   have f''_ge0: "\<And>z::real. z > 0 \<Longrightarrow> 1 / (ln b * z * z) \<ge> 0"
     using \<open>b > 1\<close> by (auto intro!: less_imp_le)
   from f''_ge0_imp_convex[OF pos_is_convex, unfolded greaterThan_iff, OF f' f''0 f''_ge0]
   show ?thesis
     by auto
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Convexity of real functions\<close>
 
 lemma convex_on_realI:
   assumes "connected A"
     and "\<And>x. x \<in> A \<Longrightarrow> (f has_real_derivative f' x) (at x)"
     and "\<And>x y. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<le> y \<Longrightarrow> f' x \<le> f' y"
   shows "convex_on A f"
 proof (rule convex_on_linorderI)
   fix t x y :: real
   assume t: "t > 0" "t < 1"
   assume xy: "x \<in> A" "y \<in> A" "x < y"
   define z where "z = (1 - t) * x + t * y"
   with \<open>connected A\<close> and xy have ivl: "{x..y} \<subseteq> A"
     using connected_contains_Icc by blast
 
   from xy t have xz: "z > x"
     by (simp add: z_def algebra_simps)
   have "y - z = (1 - t) * (y - x)"
     by (simp add: z_def algebra_simps)
   also from xy t have "\<dots> > 0"
     by (intro mult_pos_pos) simp_all
   finally have yz: "z < y"
     by simp
 
   from assms xz yz ivl t have "\<exists>\<xi>. \<xi> > x \<and> \<xi> < z \<and> f z - f x = (z - x) * f' \<xi>"
     by (intro MVT2) (auto intro!: assms(2))
   then obtain \<xi> where \<xi>: "\<xi> > x" "\<xi> < z" "f' \<xi> = (f z - f x) / (z - x)"
     by auto
   from assms xz yz ivl t have "\<exists>\<eta>. \<eta> > z \<and> \<eta> < y \<and> f y - f z = (y - z) * f' \<eta>"
     by (intro MVT2) (auto intro!: assms(2))
   then obtain \<eta> where \<eta>: "\<eta> > z" "\<eta> < y" "f' \<eta> = (f y - f z) / (y - z)"
     by auto
 
   from \<eta>(3) have "(f y - f z) / (y - z) = f' \<eta>" ..
   also from \<xi> \<eta> ivl have "\<xi> \<in> A" "\<eta> \<in> A"
     by auto
   with \<xi> \<eta> have "f' \<eta> \<ge> f' \<xi>"
     by (intro assms(3)) auto
   also from \<xi>(3) have "f' \<xi> = (f z - f x) / (z - x)" .
   finally have "(f y - f z) * (z - x) \<ge> (f z - f x) * (y - z)"
     using xz yz by (simp add: field_simps)
   also have "z - x = t * (y - x)"
     by (simp add: z_def algebra_simps)
   also have "y - z = (1 - t) * (y - x)"
     by (simp add: z_def algebra_simps)
   finally have "(f y - f z) * t \<ge> (f z - f x) * (1 - t)"
     using xy by simp
   then show "(1 - t) * f x + t * f y \<ge> f ((1 - t) *\<^sub>R x + t *\<^sub>R y)"
     by (simp add: z_def algebra_simps)
 qed
 
 lemma convex_on_inverse:
   assumes "A \<subseteq> {0<..}"
   shows "convex_on A (inverse :: real \<Rightarrow> real)"
 proof (rule convex_on_subset[OF _ assms], intro convex_on_realI[of _ _ "\<lambda>x. -inverse (x^2)"])
   fix u v :: real
   assume "u \<in> {0<..}" "v \<in> {0<..}" "u \<le> v"
   with assms show "-inverse (u^2) \<le> -inverse (v^2)"
     by (intro le_imp_neg_le le_imp_inverse_le power_mono) (simp_all)
 qed (insert assms, auto intro!: derivative_eq_intros simp: field_split_simps power2_eq_square)
 
 lemma convex_onD_Icc':
   assumes "convex_on {x..y} f" "c \<in> {x..y}"
   defines "d \<equiv> y - x"
   shows "f c \<le> (f y - f x) / d * (c - x) + f x"
 proof (cases x y rule: linorder_cases)
   case less
   then have d: "d > 0"
     by (simp add: d_def)
   from assms(2) less have A: "0 \<le> (c - x) / d" "(c - x) / d \<le> 1"
     by (simp_all add: d_def field_split_simps)
   have "f c = f (x + (c - x) * 1)"
     by simp
   also from less have "1 = ((y - x) / d)"
     by (simp add: d_def)
   also from d have "x + (c - x) * \<dots> = (1 - (c - x) / d) *\<^sub>R x + ((c - x) / d) *\<^sub>R y"
     by (simp add: field_simps)
   also have "f \<dots> \<le> (1 - (c - x) / d) * f x + (c - x) / d * f y"
     using assms less by (intro convex_onD_Icc) simp_all
   also from d have "\<dots> = (f y - f x) / d * (c - x) + f x"
     by (simp add: field_simps)
   finally show ?thesis .
 qed (insert assms(2), simp_all)
 
 lemma convex_onD_Icc'':
   assumes "convex_on {x..y} f" "c \<in> {x..y}"
   defines "d \<equiv> y - x"
   shows "f c \<le> (f x - f y) / d * (y - c) + f y"
 proof (cases x y rule: linorder_cases)
   case less
   then have d: "d > 0"
     by (simp add: d_def)
   from assms(2) less have A: "0 \<le> (y - c) / d" "(y - c) / d \<le> 1"
     by (simp_all add: d_def field_split_simps)
   have "f c = f (y - (y - c) * 1)"
     by simp
   also from less have "1 = ((y - x) / d)"
     by (simp add: d_def)
   also from d have "y - (y - c) * \<dots> = (1 - (1 - (y - c) / d)) *\<^sub>R x + (1 - (y - c) / d) *\<^sub>R y"
     by (simp add: field_simps)
   also have "f \<dots> \<le> (1 - (1 - (y - c) / d)) * f x + (1 - (y - c) / d) * f y"
     using assms less by (intro convex_onD_Icc) (simp_all add: field_simps)
   also from d have "\<dots> = (f x - f y) / d * (y - c) + f y"
     by (simp add: field_simps)
   finally show ?thesis .
 qed (insert assms(2), simp_all)
 
 lemma convex_translation_eq [simp]:
   "convex ((+) a ` s) \<longleftrightarrow> convex s"
   by (metis convex_translation translation_galois)
 
 lemma convex_translation_subtract_eq [simp]:
   "convex ((\<lambda>b. b - a) ` s) \<longleftrightarrow> convex s"
   using convex_translation_eq [of "- a"] by (simp cong: image_cong_simp)
 
 lemma convex_linear_image_eq [simp]:
     fixes f :: "'a::real_vector \<Rightarrow> 'b::real_vector"
     shows "\<lbrakk>linear f; inj f\<rbrakk> \<Longrightarrow> convex (f ` s) \<longleftrightarrow> convex s"
     by (metis (no_types) convex_linear_image convex_linear_vimage inj_vimage_image_eq)
 
 lemma fst_linear: "linear fst"
   unfolding linear_iff by (simp add: algebra_simps)
 
 lemma snd_linear: "linear snd"
   unfolding linear_iff by (simp add: algebra_simps)
 
 lemma fst_snd_linear: "linear (\<lambda>(x,y). x + y)"
   unfolding linear_iff by (simp add: algebra_simps)
 
 lemma vector_choose_size:
   assumes "0 \<le> c"
   obtains x :: "'a::{real_normed_vector, perfect_space}" where "norm x = c"
 proof -
   obtain a::'a where "a \<noteq> 0"
     using UNIV_not_singleton UNIV_eq_I set_zero singletonI by fastforce
   then show ?thesis
     by (rule_tac x="scaleR (c / norm a) a" in that) (simp add: assms)
 qed
 
 lemma vector_choose_dist:
   assumes "0 \<le> c"
   obtains y :: "'a::{real_normed_vector, perfect_space}" where "dist x y = c"
 by (metis add_diff_cancel_left' assms dist_commute dist_norm vector_choose_size)
 
 lemma sum_delta_notmem:
   assumes "x \<notin> s"
   shows "sum (\<lambda>y. if (y = x) then P x else Q y) s = sum Q s"
     and "sum (\<lambda>y. if (x = y) then P x else Q y) s = sum Q s"
     and "sum (\<lambda>y. if (y = x) then P y else Q y) s = sum Q s"
     and "sum (\<lambda>y. if (x = y) then P y else Q y) s = sum Q s"
   apply (rule_tac [!] sum.cong)
   using assms
   apply auto
   done
 
 lemma sum_delta'':
   fixes s::"'a::real_vector set"
   assumes "finite s"
   shows "(\<Sum>x\<in>s. (if y = x then f x else 0) *\<^sub>R x) = (if y\<in>s then (f y) *\<^sub>R y else 0)"
 proof -
   have *: "\<And>x y. (if y = x then f x else (0::real)) *\<^sub>R x = (if x=y then (f x) *\<^sub>R x else 0)"
     by auto
   show ?thesis
     unfolding * using sum.delta[OF assms, of y "\<lambda>x. f x *\<^sub>R x"] by auto
 qed
 
 lemma if_smult: "(if P then x else (y::real)) *\<^sub>R v = (if P then x *\<^sub>R v else y *\<^sub>R v)"
   by (fact if_distrib)
 
 lemma dist_triangle_eq:
   fixes x y z :: "'a::real_inner"
   shows "dist x z = dist x y + dist y z \<longleftrightarrow>
     norm (x - y) *\<^sub>R (y - z) = norm (y - z) *\<^sub>R (x - y)"
 proof -
   have *: "x - y + (y - z) = x - z" by auto
   show ?thesis unfolding dist_norm norm_triangle_eq[of "x - y" "y - z", unfolded *]
     by (auto simp:norm_minus_commute)
 qed
 
 
 subsection \<open>Affine set and affine hull\<close>
 
 definition\<^marker>\<open>tag important\<close> affine :: "'a::real_vector set \<Rightarrow> bool"
   where "affine s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> s)"
 
 lemma affine_alt: "affine s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u::real. (1 - u) *\<^sub>R x + u *\<^sub>R y \<in> s)"
   unfolding affine_def by (metis eq_diff_eq')
 
 lemma affine_empty [iff]: "affine {}"
   unfolding affine_def by auto
 
 lemma affine_sing [iff]: "affine {x}"
   unfolding affine_alt by (auto simp: scaleR_left_distrib [symmetric])
 
 lemma affine_UNIV [iff]: "affine UNIV"
   unfolding affine_def by auto
 
 lemma affine_Inter [intro]: "(\<And>s. s\<in>f \<Longrightarrow> affine s) \<Longrightarrow> affine (\<Inter>f)"
   unfolding affine_def by auto
 
 lemma affine_Int[intro]: "affine s \<Longrightarrow> affine t \<Longrightarrow> affine (s \<inter> t)"
   unfolding affine_def by auto
 
 lemma affine_scaling: "affine s \<Longrightarrow> affine (image (\<lambda>x. c *\<^sub>R x) s)"
   apply (clarsimp simp add: affine_def)
   apply (rule_tac x="u *\<^sub>R x + v *\<^sub>R y" in image_eqI)
   apply (auto simp: algebra_simps)
   done
 
 lemma affine_affine_hull [simp]: "affine(affine hull s)"
   unfolding hull_def
   using affine_Inter[of "{t. affine t \<and> s \<subseteq> t}"] by auto
 
 lemma affine_hull_eq[simp]: "(affine hull s = s) \<longleftrightarrow> affine s"
   by (metis affine_affine_hull hull_same)
 
 lemma affine_hyperplane: "affine {x. a \<bullet> x = b}"
   by (simp add: affine_def algebra_simps) (metis distrib_right mult.left_neutral)
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Some explicit formulations\<close>
 
 text "Formalized by Lars Schewe."
 
 lemma affine:
   fixes V::"'a::real_vector set"
   shows "affine V \<longleftrightarrow>
          (\<forall>S u. finite S \<and> S \<noteq> {} \<and> S \<subseteq> V \<and> sum u S = 1 \<longrightarrow> (\<Sum>x\<in>S. u x *\<^sub>R x) \<in> V)"
 proof -
   have "u *\<^sub>R x + v *\<^sub>R y \<in> V" if "x \<in> V" "y \<in> V" "u + v = (1::real)"
     and *: "\<And>S u. \<lbrakk>finite S; S \<noteq> {}; S \<subseteq> V; sum u S = 1\<rbrakk> \<Longrightarrow> (\<Sum>x\<in>S. u x *\<^sub>R x) \<in> V" for x y u v
   proof (cases "x = y")
     case True
     then show ?thesis
       using that by (metis scaleR_add_left scaleR_one)
   next
     case False
     then show ?thesis
       using that *[of "{x,y}" "\<lambda>w. if w = x then u else v"] by auto
   qed
   moreover have "(\<Sum>x\<in>S. u x *\<^sub>R x) \<in> V"
                 if *: "\<And>x y u v. \<lbrakk>x\<in>V; y\<in>V; u + v = 1\<rbrakk> \<Longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> V"
                   and "finite S" "S \<noteq> {}" "S \<subseteq> V" "sum u S = 1" for S u
   proof -
     define n where "n = card S"
     consider "card S = 0" | "card S = 1" | "card S = 2" | "card S > 2" by linarith
     then show "(\<Sum>x\<in>S. u x *\<^sub>R x) \<in> V"
     proof cases
       assume "card S = 1"
       then obtain a where "S={a}"
         by (auto simp: card_Suc_eq)
       then show ?thesis
         using that by simp
     next
       assume "card S = 2"
       then obtain a b where "S = {a, b}"
         by (metis Suc_1 card_1_singletonE card_Suc_eq)
       then show ?thesis
         using *[of a b] that
         by (auto simp: sum_clauses(2))
     next
       assume "card S > 2"
       then show ?thesis using that n_def
       proof (induct n arbitrary: u S)
         case 0
         then show ?case by auto
       next
         case (Suc n u S)
         have "sum u S = card S" if "\<not> (\<exists>x\<in>S. u x \<noteq> 1)"
           using that unfolding card_eq_sum by auto
         with Suc.prems obtain x where "x \<in> S" and x: "u x \<noteq> 1" by force
         have c: "card (S - {x}) = card S - 1"
           by (simp add: Suc.prems(3) \<open>x \<in> S\<close>)
         have "sum u (S - {x}) = 1 - u x"
           by (simp add: Suc.prems sum_diff1 \<open>x \<in> S\<close>)
         with x have eq1: "inverse (1 - u x) * sum u (S - {x}) = 1"
           by auto
         have inV: "(\<Sum>y\<in>S - {x}. (inverse (1 - u x) * u y) *\<^sub>R y) \<in> V"
         proof (cases "card (S - {x}) > 2")
           case True
           then have S: "S - {x} \<noteq> {}" "card (S - {x}) = n"
             using Suc.prems c by force+
           show ?thesis
           proof (rule Suc.hyps)
             show "(\<Sum>a\<in>S - {x}. inverse (1 - u x) * u a) = 1"
               by (auto simp: eq1 sum_distrib_left[symmetric])
           qed (use S Suc.prems True in auto)
         next
           case False
           then have "card (S - {x}) = Suc (Suc 0)"
             using Suc.prems c by auto
           then obtain a b where ab: "(S - {x}) = {a, b}" "a\<noteq>b"
             unfolding card_Suc_eq by auto
           then show ?thesis
             using eq1 \<open>S \<subseteq> V\<close>
             by (auto simp: sum_distrib_left distrib_left intro!: Suc.prems(2)[of a b])
         qed
         have "u x + (1 - u x) = 1 \<Longrightarrow>
           u x *\<^sub>R x + (1 - u x) *\<^sub>R ((\<Sum>y\<in>S - {x}. u y *\<^sub>R y) /\<^sub>R (1 - u x)) \<in> V"
           by (rule Suc.prems) (use \<open>x \<in> S\<close> Suc.prems inV in \<open>auto simp: scaleR_right.sum\<close>)
         moreover have "(\<Sum>a\<in>S. u a *\<^sub>R a) = u x *\<^sub>R x + (\<Sum>a\<in>S - {x}. u a *\<^sub>R a)"
           by (meson Suc.prems(3) sum.remove \<open>x \<in> S\<close>)
         ultimately show "(\<Sum>x\<in>S. u x *\<^sub>R x) \<in> V"
           by (simp add: x)
       qed
     qed (use \<open>S\<noteq>{}\<close> \<open>finite S\<close> in auto)
   qed
   ultimately show ?thesis
     unfolding affine_def by meson
 qed
 
 
 lemma affine_hull_explicit:
   "affine hull p = {y. \<exists>S u. finite S \<and> S \<noteq> {} \<and> S \<subseteq> p \<and> sum u S = 1 \<and> sum (\<lambda>v. u v *\<^sub>R v) S = y}"
   (is "_ = ?rhs")
 proof (rule hull_unique)
   show "p \<subseteq> ?rhs"
   proof (intro subsetI CollectI exI conjI)
     show "\<And>x. sum (\<lambda>z. 1) {x} = 1"
       by auto
   qed auto
   show "?rhs \<subseteq> T" if "p \<subseteq> T" "affine T" for T
     using that unfolding affine by blast
   show "affine ?rhs"
     unfolding affine_def
   proof clarify
     fix u v :: real and sx ux sy uy
     assume uv: "u + v = 1"
       and x: "finite sx" "sx \<noteq> {}" "sx \<subseteq> p" "sum ux sx = (1::real)"
       and y: "finite sy" "sy \<noteq> {}" "sy \<subseteq> p" "sum uy sy = (1::real)" 
     have **: "(sx \<union> sy) \<inter> sx = sx" "(sx \<union> sy) \<inter> sy = sy"
       by auto
     show "\<exists>S w. finite S \<and> S \<noteq> {} \<and> S \<subseteq> p \<and>
         sum w S = 1 \<and> (\<Sum>v\<in>S. w v *\<^sub>R v) = u *\<^sub>R (\<Sum>v\<in>sx. ux v *\<^sub>R v) + v *\<^sub>R (\<Sum>v\<in>sy. uy v *\<^sub>R v)"
     proof (intro exI conjI)
       show "finite (sx \<union> sy)"
         using x y by auto
       show "sum (\<lambda>i. (if i\<in>sx then u * ux i else 0) + (if i\<in>sy then v * uy i else 0)) (sx \<union> sy) = 1"
         using x y uv
         by (simp add: sum_Un sum.distrib sum.inter_restrict[symmetric] sum_distrib_left [symmetric] **)
       have "(\<Sum>i\<in>sx \<union> sy. ((if i \<in> sx then u * ux i else 0) + (if i \<in> sy then v * uy i else 0)) *\<^sub>R i)
           = (\<Sum>i\<in>sx. (u * ux i) *\<^sub>R i) + (\<Sum>i\<in>sy. (v * uy i) *\<^sub>R i)"
         using x y
         unfolding scaleR_left_distrib scaleR_zero_left if_smult
         by (simp add: sum_Un sum.distrib sum.inter_restrict[symmetric]  **)
       also have "\<dots> = u *\<^sub>R (\<Sum>v\<in>sx. ux v *\<^sub>R v) + v *\<^sub>R (\<Sum>v\<in>sy. uy v *\<^sub>R v)"
         unfolding scaleR_scaleR[symmetric] scaleR_right.sum [symmetric] by blast
       finally show "(\<Sum>i\<in>sx \<union> sy. ((if i \<in> sx then u * ux i else 0) + (if i \<in> sy then v * uy i else 0)) *\<^sub>R i) 
                   = u *\<^sub>R (\<Sum>v\<in>sx. ux v *\<^sub>R v) + v *\<^sub>R (\<Sum>v\<in>sy. uy v *\<^sub>R v)" .
     qed (use x y in auto)
   qed
 qed
 
 lemma affine_hull_finite:
   assumes "finite S"
   shows "affine hull S = {y. \<exists>u. sum u S = 1 \<and> sum (\<lambda>v. u v *\<^sub>R v) S = y}"
 proof -
   have *: "\<exists>h. sum h S = 1 \<and> (\<Sum>v\<in>S. h v *\<^sub>R v) = x" 
     if "F \<subseteq> S" "finite F" "F \<noteq> {}" and sum: "sum u F = 1" and x: "(\<Sum>v\<in>F. u v *\<^sub>R v) = x" for x F u
   proof -
     have "S \<inter> F = F"
       using that by auto
     show ?thesis
     proof (intro exI conjI)
       show "(\<Sum>x\<in>S. if x \<in> F then u x else 0) = 1"
         by (metis (mono_tags, lifting) \<open>S \<inter> F = F\<close> assms sum.inter_restrict sum)
       show "(\<Sum>v\<in>S. (if v \<in> F then u v else 0) *\<^sub>R v) = x"
         by (simp add: if_smult cong: if_cong) (metis (no_types) \<open>S \<inter> F = F\<close> assms sum.inter_restrict x)
     qed
   qed
   show ?thesis
     unfolding affine_hull_explicit using assms
     by (fastforce dest: *)
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Stepping theorems and hence small special cases\<close>
 
 lemma affine_hull_empty[simp]: "affine hull {} = {}"
   by simp
 
 lemma affine_hull_finite_step:
   fixes y :: "'a::real_vector"
   shows "finite S \<Longrightarrow>
       (\<exists>u. sum u (insert a S) = w \<and> sum (\<lambda>x. u x *\<^sub>R x) (insert a S) = y) \<longleftrightarrow>
       (\<exists>v u. sum u S = w - v \<and> sum (\<lambda>x. u x *\<^sub>R x) S = y - v *\<^sub>R a)" (is "_ \<Longrightarrow> ?lhs = ?rhs")
 proof -
   assume fin: "finite S"
   show "?lhs = ?rhs"
   proof
     assume ?lhs
     then obtain u where u: "sum u (insert a S) = w \<and> (\<Sum>x\<in>insert a S. u x *\<^sub>R x) = y"
       by auto
     show ?rhs
     proof (cases "a \<in> S")
       case True
       then show ?thesis
         using u by (simp add: insert_absorb) (metis diff_zero real_vector.scale_zero_left)
     next
       case False
       show ?thesis
         by (rule exI [where x="u a"]) (use u fin False in auto)
     qed
   next
     assume ?rhs
     then obtain v u where vu: "sum u S = w - v"  "(\<Sum>x\<in>S. u x *\<^sub>R x) = y - v *\<^sub>R a"
       by auto
     have *: "\<And>x M. (if x = a then v else M) *\<^sub>R x = (if x = a then v *\<^sub>R x else M *\<^sub>R x)"
       by auto
     show ?lhs
     proof (cases "a \<in> S")
       case True
       show ?thesis
         by (rule exI [where x="\<lambda>x. (if x=a then v else 0) + u x"])
            (simp add: True scaleR_left_distrib sum.distrib sum_clauses fin vu * cong: if_cong)
     next
       case False
       then show ?thesis
         apply (rule_tac x="\<lambda>x. if x=a then v else u x" in exI) 
         apply (simp add: vu sum_clauses(2)[OF fin] *)
         by (simp add: sum_delta_notmem(3) vu)
     qed
   qed
 qed
 
 lemma affine_hull_2:
   fixes a b :: "'a::real_vector"
   shows "affine hull {a,b} = {u *\<^sub>R a + v *\<^sub>R b| u v. (u + v = 1)}"
   (is "?lhs = ?rhs")
 proof -
   have *:
     "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::real)"
     "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::'a)" by auto
   have "?lhs = {y. \<exists>u. sum u {a, b} = 1 \<and> (\<Sum>v\<in>{a, b}. u v *\<^sub>R v) = y}"
     using affine_hull_finite[of "{a,b}"] by auto
   also have "\<dots> = {y. \<exists>v u. u b = 1 - v \<and> u b *\<^sub>R b = y - v *\<^sub>R a}"
     by (simp add: affine_hull_finite_step[of "{b}" a])
   also have "\<dots> = ?rhs" unfolding * by auto
   finally show ?thesis by auto
 qed
 
 lemma affine_hull_3:
   fixes a b c :: "'a::real_vector"
   shows "affine hull {a,b,c} = { u *\<^sub>R a + v *\<^sub>R b + w *\<^sub>R c| u v w. u + v + w = 1}"
 proof -
   have *:
     "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::real)"
     "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::'a)" by auto
   show ?thesis
     apply (simp add: affine_hull_finite affine_hull_finite_step)
     unfolding *
     apply safe
      apply (metis add.assoc)
     apply (rule_tac x=u in exI, force)
     done
 qed
 
 lemma mem_affine:
   assumes "affine S" "x \<in> S" "y \<in> S" "u + v = 1"
   shows "u *\<^sub>R x + v *\<^sub>R y \<in> S"
   using assms affine_def[of S] by auto
 
 lemma mem_affine_3:
   assumes "affine S" "x \<in> S" "y \<in> S" "z \<in> S" "u + v + w = 1"
   shows "u *\<^sub>R x + v *\<^sub>R y + w *\<^sub>R z \<in> S"
 proof -
   have "u *\<^sub>R x + v *\<^sub>R y + w *\<^sub>R z \<in> affine hull {x, y, z}"
     using affine_hull_3[of x y z] assms by auto
   moreover
   have "affine hull {x, y, z} \<subseteq> affine hull S"
     using hull_mono[of "{x, y, z}" "S"] assms by auto
   moreover
   have "affine hull S = S"
     using assms affine_hull_eq[of S] by auto
   ultimately show ?thesis by auto
 qed
 
 lemma mem_affine_3_minus:
   assumes "affine S" "x \<in> S" "y \<in> S" "z \<in> S"
   shows "x + v *\<^sub>R (y-z) \<in> S"
   using mem_affine_3[of S x y z 1 v "-v"] assms
   by (simp add: algebra_simps)
 
 corollary mem_affine_3_minus2:
     "\<lbrakk>affine S; x \<in> S; y \<in> S; z \<in> S\<rbrakk> \<Longrightarrow> x - v *\<^sub>R (y-z) \<in> S"
   by (metis add_uminus_conv_diff mem_affine_3_minus real_vector.scale_minus_left)
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Some relations between affine hull and subspaces\<close>
 
 lemma affine_hull_insert_subset_span:
   "affine hull (insert a S) \<subseteq> {a + v| v . v \<in> span {x - a | x . x \<in> S}}"
 proof -
   have "\<exists>v T u. x = a + v \<and> (finite T \<and> T \<subseteq> {x - a |x. x \<in> S} \<and> (\<Sum>v\<in>T. u v *\<^sub>R v) = v)"
     if "finite F" "F \<noteq> {}" "F \<subseteq> insert a S" "sum u F = 1" "(\<Sum>v\<in>F. u v *\<^sub>R v) = x"
     for x F u
   proof -
     have *: "(\<lambda>x. x - a) ` (F - {a}) \<subseteq> {x - a |x. x \<in> S}"
       using that by auto
     show ?thesis
     proof (intro exI conjI)
       show "finite ((\<lambda>x. x - a) ` (F - {a}))"
         by (simp add: that(1))
       show "(\<Sum>v\<in>(\<lambda>x. x - a) ` (F - {a}). u(v+a) *\<^sub>R v) = x-a"
         by (simp add: sum.reindex[unfolded inj_on_def] algebra_simps
             sum_subtractf scaleR_left.sum[symmetric] sum_diff1 that)
     qed (use \<open>F \<subseteq> insert a S\<close> in auto)
   qed
   then show ?thesis
     unfolding affine_hull_explicit span_explicit by blast
 qed
 
 lemma affine_hull_insert_span:
   assumes "a \<notin> S"
   shows "affine hull (insert a S) = {a + v | v . v \<in> span {x - a | x.  x \<in> S}}"
 proof -
   have *: "\<exists>G u. finite G \<and> G \<noteq> {} \<and> G \<subseteq> insert a S \<and> sum u G = 1 \<and> (\<Sum>v\<in>G. u v *\<^sub>R v) = y"
     if "v \<in> span {x - a |x. x \<in> S}" "y = a + v" for y v
   proof -
     from that
     obtain T u where u: "finite T" "T \<subseteq> {x - a |x. x \<in> S}" "a + (\<Sum>v\<in>T. u v *\<^sub>R v) = y"
       unfolding span_explicit by auto
     define F where "F = (\<lambda>x. x + a) ` T"
     have F: "finite F" "F \<subseteq> S" "(\<Sum>v\<in>F. u (v - a) *\<^sub>R (v - a)) = y - a"
       unfolding F_def using u by (auto simp: sum.reindex[unfolded inj_on_def])
     have *: "F \<inter> {a} = {}" "F \<inter> - {a} = F"
       using F assms by auto
     show "\<exists>G u. finite G \<and> G \<noteq> {} \<and> G \<subseteq> insert a S \<and> sum u G = 1 \<and> (\<Sum>v\<in>G. u v *\<^sub>R v) = y"
       apply (rule_tac x = "insert a F" in exI)
       apply (rule_tac x = "\<lambda>x. if x=a then 1 - sum (\<lambda>x. u (x - a)) F else u (x - a)" in exI)
       using assms F
       apply (auto simp:  sum_clauses sum.If_cases if_smult sum_subtractf scaleR_left.sum algebra_simps *)
       done
   qed
   show ?thesis
     by (intro subset_antisym affine_hull_insert_subset_span) (auto simp: affine_hull_explicit dest!: *)
 qed
 
 lemma affine_hull_span:
   assumes "a \<in> S"
   shows "affine hull S = {a + v | v. v \<in> span {x - a | x. x \<in> S - {a}}}"
   using affine_hull_insert_span[of a "S - {a}", unfolded insert_Diff[OF assms]] by auto
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Parallel affine sets\<close>
 
 definition affine_parallel :: "'a::real_vector set \<Rightarrow> 'a::real_vector set \<Rightarrow> bool"
   where "affine_parallel S T \<longleftrightarrow> (\<exists>a. T = (\<lambda>x. a + x) ` S)"
 
 lemma affine_parallel_expl_aux:
   fixes S T :: "'a::real_vector set"
   assumes "\<And>x. x \<in> S \<longleftrightarrow> a + x \<in> T"
   shows "T = (\<lambda>x. a + x) ` S"
 proof -
   have "x \<in> ((\<lambda>x. a + x) ` S)" if "x \<in> T" for x
     using that
     by (simp add: image_iff) (metis add.commute diff_add_cancel assms)
   moreover have "T \<ge> (\<lambda>x. a + x) ` S"
     using assms by auto
   ultimately show ?thesis by auto
 qed
 
 lemma affine_parallel_expl: "affine_parallel S T \<longleftrightarrow> (\<exists>a. \<forall>x. x \<in> S \<longleftrightarrow> a + x \<in> T)"
   by (auto simp add: affine_parallel_def)
     (use affine_parallel_expl_aux [of S _ T] in blast)
 
 lemma affine_parallel_reflex: "affine_parallel S S"
   unfolding affine_parallel_def
   using image_add_0 by blast
 
 lemma affine_parallel_commut:
   assumes "affine_parallel A B"
   shows "affine_parallel B A"
 proof -
   from assms obtain a where B: "B = (\<lambda>x. a + x) ` A"
     unfolding affine_parallel_def by auto
   have [simp]: "(\<lambda>x. x - a) = plus (- a)" by (simp add: fun_eq_iff)
   from B show ?thesis
     using translation_galois [of B a A]
     unfolding affine_parallel_def by blast
 qed
 
 lemma affine_parallel_assoc:
   assumes "affine_parallel A B"
     and "affine_parallel B C"
   shows "affine_parallel A C"
 proof -
   from assms obtain ab where "B = (\<lambda>x. ab + x) ` A"
     unfolding affine_parallel_def by auto
   moreover
   from assms obtain bc where "C = (\<lambda>x. bc + x) ` B"
     unfolding affine_parallel_def by auto
   ultimately show ?thesis
     using translation_assoc[of bc ab A] unfolding affine_parallel_def by auto
 qed
 
 lemma affine_translation_aux:
   fixes a :: "'a::real_vector"
   assumes "affine ((\<lambda>x. a + x) ` S)"
   shows "affine S"
 proof -
   {
     fix x y u v
     assume xy: "x \<in> S" "y \<in> S" "(u :: real) + v = 1"
     then have "(a + x) \<in> ((\<lambda>x. a + x) ` S)" "(a + y) \<in> ((\<lambda>x. a + x) ` S)"
       by auto
     then have h1: "u *\<^sub>R  (a + x) + v *\<^sub>R (a + y) \<in> (\<lambda>x. a + x) ` S"
       using xy assms unfolding affine_def by auto
     have "u *\<^sub>R (a + x) + v *\<^sub>R (a + y) = (u + v) *\<^sub>R a + (u *\<^sub>R x + v *\<^sub>R y)"
       by (simp add: algebra_simps)
     also have "\<dots> = a + (u *\<^sub>R x + v *\<^sub>R y)"
       using \<open>u + v = 1\<close> by auto
     ultimately have "a + (u *\<^sub>R x + v *\<^sub>R y) \<in> (\<lambda>x. a + x) ` S"
       using h1 by auto
     then have "u *\<^sub>R x + v *\<^sub>R y \<in> S" by auto
   }
   then show ?thesis unfolding affine_def by auto
 qed
 
 lemma affine_translation:
   "affine S \<longleftrightarrow> affine ((+) a ` S)" for a :: "'a::real_vector"
 proof
   show "affine ((+) a ` S)" if "affine S"
     using that translation_assoc [of "- a" a S]
     by (auto intro: affine_translation_aux [of "- a" "((+) a ` S)"])
   show "affine S" if "affine ((+) a ` S)"
     using that by (rule affine_translation_aux)
 qed
 
 lemma parallel_is_affine:
   fixes S T :: "'a::real_vector set"
   assumes "affine S" "affine_parallel S T"
   shows "affine T"
 proof -
   from assms obtain a where "T = (\<lambda>x. a + x) ` S"
     unfolding affine_parallel_def by auto
   then show ?thesis
     using affine_translation assms by auto
 qed
 
 lemma subspace_imp_affine: "subspace s \<Longrightarrow> affine s"
   unfolding subspace_def affine_def by auto
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Subspace parallel to an affine set\<close>
 
 lemma subspace_affine: "subspace S \<longleftrightarrow> affine S \<and> 0 \<in> S"
 proof -
   have h0: "subspace S \<Longrightarrow> affine S \<and> 0 \<in> S"
     using subspace_imp_affine[of S] subspace_0 by auto
   {
     assume assm: "affine S \<and> 0 \<in> S"
     {
       fix c :: real
       fix x
       assume x: "x \<in> S"
       have "c *\<^sub>R x = (1-c) *\<^sub>R 0 + c *\<^sub>R x" by auto
       moreover
       have "(1 - c) *\<^sub>R 0 + c *\<^sub>R x \<in> S"
         using affine_alt[of S] assm x by auto
       ultimately have "c *\<^sub>R x \<in> S" by auto
     }
     then have h1: "\<forall>c. \<forall>x \<in> S. c *\<^sub>R x \<in> S" by auto
 
     {
       fix x y
       assume xy: "x \<in> S" "y \<in> S"
       define u where "u = (1 :: real)/2"
       have "(1/2) *\<^sub>R (x+y) = (1/2) *\<^sub>R (x+y)"
         by auto
       moreover
       have "(1/2) *\<^sub>R (x+y)=(1/2) *\<^sub>R x + (1-(1/2)) *\<^sub>R y"
         by (simp add: algebra_simps)
       moreover
       have "(1 - u) *\<^sub>R x + u *\<^sub>R y \<in> S"
         using affine_alt[of S] assm xy by auto
       ultimately
       have "(1/2) *\<^sub>R (x+y) \<in> S"
         using u_def by auto
       moreover
       have "x + y = 2 *\<^sub>R ((1/2) *\<^sub>R (x+y))"
         by auto
       ultimately
       have "x + y \<in> S"
         using h1[rule_format, of "(1/2) *\<^sub>R (x+y)" "2"] by auto
     }
     then have "\<forall>x \<in> S. \<forall>y \<in> S. x + y \<in> S"
       by auto
     then have "subspace S"
       using h1 assm unfolding subspace_def by auto
   }
   then show ?thesis using h0 by metis
 qed
 
 lemma affine_diffs_subspace:
   assumes "affine S" "a \<in> S"
   shows "subspace ((\<lambda>x. (-a)+x) ` S)"
 proof -
   have [simp]: "(\<lambda>x. x - a) = plus (- a)" by (simp add: fun_eq_iff)
   have "affine ((\<lambda>x. (-a)+x) ` S)"
     using affine_translation assms by blast
   moreover have "0 \<in> ((\<lambda>x. (-a)+x) ` S)"
     using assms exI[of "(\<lambda>x. x\<in>S \<and> -a+x = 0)" a] by auto
   ultimately show ?thesis using subspace_affine by auto
 qed
 
 lemma affine_diffs_subspace_subtract:
   "subspace ((\<lambda>x. x - a) ` S)" if "affine S" "a \<in> S"
   using that affine_diffs_subspace [of _ a] by simp
 
 lemma parallel_subspace_explicit:
   assumes "affine S"
     and "a \<in> S"
   assumes "L \<equiv> {y. \<exists>x \<in> S. (-a) + x = y}"
   shows "subspace L \<and> affine_parallel S L"
 proof -
   from assms have "L = plus (- a) ` S" by auto
   then have par: "affine_parallel S L"
     unfolding affine_parallel_def ..
   then have "affine L" using assms parallel_is_affine by auto
   moreover have "0 \<in> L"
     using assms by auto
   ultimately show ?thesis
     using subspace_affine par by auto
 qed
 
 lemma parallel_subspace_aux:
   assumes "subspace A"
     and "subspace B"
     and "affine_parallel A B"
   shows "A \<supseteq> B"
 proof -
   from assms obtain a where a: "\<forall>x. x \<in> A \<longleftrightarrow> a + x \<in> B"
     using affine_parallel_expl[of A B] by auto
   then have "-a \<in> A"
     using assms subspace_0[of B] by auto
   then have "a \<in> A"
     using assms subspace_neg[of A "-a"] by auto
   then show ?thesis
     using assms a unfolding subspace_def by auto
 qed
 
 lemma parallel_subspace:
   assumes "subspace A"
     and "subspace B"
     and "affine_parallel A B"
   shows "A = B"
 proof
   show "A \<supseteq> B"
     using assms parallel_subspace_aux by auto
   show "A \<subseteq> B"
     using assms parallel_subspace_aux[of B A] affine_parallel_commut by auto
 qed
 
 lemma affine_parallel_subspace:
   assumes "affine S" "S \<noteq> {}"
   shows "\<exists>!L. subspace L \<and> affine_parallel S L"
 proof -
   have ex: "\<exists>L. subspace L \<and> affine_parallel S L"
     using assms parallel_subspace_explicit by auto
   {
     fix L1 L2
     assume ass: "subspace L1 \<and> affine_parallel S L1" "subspace L2 \<and> affine_parallel S L2"
     then have "affine_parallel L1 L2"
       using affine_parallel_commut[of S L1] affine_parallel_assoc[of L1 S L2] by auto
     then have "L1 = L2"
       using ass parallel_subspace by auto
   }
   then show ?thesis using ex by auto
 qed
 
 
 subsection \<open>Cones\<close>
 
 definition\<^marker>\<open>tag important\<close> cone :: "'a::real_vector set \<Rightarrow> bool"
   where "cone s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>c\<ge>0. c *\<^sub>R x \<in> s)"
 
 lemma cone_empty[intro, simp]: "cone {}"
   unfolding cone_def by auto
 
 lemma cone_univ[intro, simp]: "cone UNIV"
   unfolding cone_def by auto
 
 lemma cone_Inter[intro]: "\<forall>s\<in>f. cone s \<Longrightarrow> cone (\<Inter>f)"
   unfolding cone_def by auto
 
 lemma subspace_imp_cone: "subspace S \<Longrightarrow> cone S"
   by (simp add: cone_def subspace_scale)
 
 
 subsubsection \<open>Conic hull\<close>
 
 lemma cone_cone_hull: "cone (cone hull s)"
   unfolding hull_def by auto
 
 lemma cone_hull_eq: "cone hull s = s \<longleftrightarrow> cone s"
   apply (rule hull_eq)
   using cone_Inter
   unfolding subset_eq
   apply auto
   done
 
 lemma mem_cone:
   assumes "cone S" "x \<in> S" "c \<ge> 0"
   shows "c *\<^sub>R x \<in> S"
   using assms cone_def[of S] by auto
 
 lemma cone_contains_0:
   assumes "cone S"
   shows "S \<noteq> {} \<longleftrightarrow> 0 \<in> S"
 proof -
   {
     assume "S \<noteq> {}"
     then obtain a where "a \<in> S" by auto
     then have "0 \<in> S"
       using assms mem_cone[of S a 0] by auto
   }
   then show ?thesis by auto
 qed
 
 lemma cone_0: "cone {0}"
   unfolding cone_def by auto
 
 lemma cone_Union[intro]: "(\<forall>s\<in>f. cone s) \<longrightarrow> cone (\<Union>f)"
   unfolding cone_def by blast
 
 lemma cone_iff:
   assumes "S \<noteq> {}"
   shows "cone S \<longleftrightarrow> 0 \<in> S \<and> (\<forall>c. c > 0 \<longrightarrow> ((*\<^sub>R) c) ` S = S)"
 proof -
   {
     assume "cone S"
     {
       fix c :: real
       assume "c > 0"
       {
         fix x
         assume "x \<in> S"
         then have "x \<in> ((*\<^sub>R) c) ` S"
           unfolding image_def
           using \<open>cone S\<close> \<open>c>0\<close> mem_cone[of S x "1/c"]
             exI[of "(\<lambda>t. t \<in> S \<and> x = c *\<^sub>R t)" "(1 / c) *\<^sub>R x"]
           by auto
       }
       moreover
       {
         fix x
         assume "x \<in> ((*\<^sub>R) c) ` S"
         then have "x \<in> S"
           using \<open>cone S\<close> \<open>c > 0\<close>
           unfolding cone_def image_def \<open>c > 0\<close> by auto
       }
       ultimately have "((*\<^sub>R) c) ` S = S" by blast
     }
     then have "0 \<in> S \<and> (\<forall>c. c > 0 \<longrightarrow> ((*\<^sub>R) c) ` S = S)"
       using \<open>cone S\<close> cone_contains_0[of S] assms by auto
   }
   moreover
   {
     assume a: "0 \<in> S \<and> (\<forall>c. c > 0 \<longrightarrow> ((*\<^sub>R) c) ` S = S)"
     {
       fix x
       assume "x \<in> S"
       fix c1 :: real
       assume "c1 \<ge> 0"
       then have "c1 = 0 \<or> c1 > 0" by auto
       then have "c1 *\<^sub>R x \<in> S" using a \<open>x \<in> S\<close> by auto
     }
     then have "cone S" unfolding cone_def by auto
   }
   ultimately show ?thesis by blast
 qed
 
 lemma cone_hull_empty: "cone hull {} = {}"
   by (metis cone_empty cone_hull_eq)
 
 lemma cone_hull_empty_iff: "S = {} \<longleftrightarrow> cone hull S = {}"
   by (metis bot_least cone_hull_empty hull_subset xtrans(5))
 
 lemma cone_hull_contains_0: "S \<noteq> {} \<longleftrightarrow> 0 \<in> cone hull S"
   using cone_cone_hull[of S] cone_contains_0[of "cone hull S"] cone_hull_empty_iff[of S]
   by auto
 
 lemma mem_cone_hull:
   assumes "x \<in> S" "c \<ge> 0"
   shows "c *\<^sub>R x \<in> cone hull S"
   by (metis assms cone_cone_hull hull_inc mem_cone)
 
 proposition cone_hull_expl: "cone hull S = {c *\<^sub>R x | c x. c \<ge> 0 \<and> x \<in> S}"
   (is "?lhs = ?rhs")
 proof -
   {
     fix x
     assume "x \<in> ?rhs"
     then obtain cx :: real and xx where x: "x = cx *\<^sub>R xx" "cx \<ge> 0" "xx \<in> S"
       by auto
     fix c :: real
     assume c: "c \<ge> 0"
     then have "c *\<^sub>R x = (c * cx) *\<^sub>R xx"
       using x by (simp add: algebra_simps)
     moreover
     have "c * cx \<ge> 0" using c x by auto
     ultimately
     have "c *\<^sub>R x \<in> ?rhs" using x by auto
   }
   then have "cone ?rhs"
     unfolding cone_def by auto
   then have "?rhs \<in> Collect cone"
     unfolding mem_Collect_eq by auto
   {
     fix x
     assume "x \<in> S"
     then have "1 *\<^sub>R x \<in> ?rhs"
       apply auto
       apply (rule_tac x = 1 in exI, auto)
       done
     then have "x \<in> ?rhs" by auto
   }
   then have "S \<subseteq> ?rhs" by auto
   then have "?lhs \<subseteq> ?rhs"
     using \<open>?rhs \<in> Collect cone\<close> hull_minimal[of S "?rhs" "cone"] by auto
   moreover
   {
     fix x
     assume "x \<in> ?rhs"
     then obtain cx :: real and xx where x: "x = cx *\<^sub>R xx" "cx \<ge> 0" "xx \<in> S"
       by auto
     then have "xx \<in> cone hull S"
       using hull_subset[of S] by auto
     then have "x \<in> ?lhs"
       using x cone_cone_hull[of S] cone_def[of "cone hull S"] by auto
   }
   ultimately show ?thesis by auto
 qed
 
 
-subsection \<open>Affine dependence and consequential theorems\<close>
+subsection \<open>Affine Dependence\<close>
 
 text "Formalized by Lars Schewe."
 
 definition\<^marker>\<open>tag important\<close> affine_dependent :: "'a::real_vector set \<Rightarrow> bool"
   where "affine_dependent s \<longleftrightarrow> (\<exists>x\<in>s. x \<in> affine hull (s - {x}))"
 
 lemma affine_dependent_subset:
    "\<lbrakk>affine_dependent s; s \<subseteq> t\<rbrakk> \<Longrightarrow> affine_dependent t"
 apply (simp add: affine_dependent_def Bex_def)
 apply (blast dest: hull_mono [OF Diff_mono [OF _ subset_refl]])
 done
 
 lemma affine_independent_subset:
   shows "\<lbrakk>\<not> affine_dependent t; s \<subseteq> t\<rbrakk> \<Longrightarrow> \<not> affine_dependent s"
 by (metis affine_dependent_subset)
 
 lemma affine_independent_Diff:
    "\<not> affine_dependent s \<Longrightarrow> \<not> affine_dependent(s - t)"
 by (meson Diff_subset affine_dependent_subset)
 
 proposition affine_dependent_explicit:
   "affine_dependent p \<longleftrightarrow>
     (\<exists>S u. finite S \<and> S \<subseteq> p \<and> sum u S = 0 \<and> (\<exists>v\<in>S. u v \<noteq> 0) \<and> sum (\<lambda>v. u v *\<^sub>R v) S = 0)"
 proof -
   have "\<exists>S u. finite S \<and> S \<subseteq> p \<and> sum u S = 0 \<and> (\<exists>v\<in>S. u v \<noteq> 0) \<and> (\<Sum>w\<in>S. u w *\<^sub>R w) = 0"
     if "(\<Sum>w\<in>S. u w *\<^sub>R w) = x" "x \<in> p" "finite S" "S \<noteq> {}" "S \<subseteq> p - {x}" "sum u S = 1" for x S u
   proof (intro exI conjI)
     have "x \<notin> S" 
       using that by auto
     then show "(\<Sum>v \<in> insert x S. if v = x then - 1 else u v) = 0"
       using that by (simp add: sum_delta_notmem)
     show "(\<Sum>w \<in> insert x S. (if w = x then - 1 else u w) *\<^sub>R w) = 0"
       using that \<open>x \<notin> S\<close> by (simp add: if_smult sum_delta_notmem cong: if_cong)
   qed (use that in auto)
   moreover have "\<exists>x\<in>p. \<exists>S u. finite S \<and> S \<noteq> {} \<and> S \<subseteq> p - {x} \<and> sum u S = 1 \<and> (\<Sum>v\<in>S. u v *\<^sub>R v) = x"
     if "(\<Sum>v\<in>S. u v *\<^sub>R v) = 0" "finite S" "S \<subseteq> p" "sum u S = 0" "v \<in> S" "u v \<noteq> 0" for S u v
   proof (intro bexI exI conjI)
     have "S \<noteq> {v}"
       using that by auto
     then show "S - {v} \<noteq> {}"
       using that by auto
     show "(\<Sum>x \<in> S - {v}. - (1 / u v) * u x) = 1"
       unfolding sum_distrib_left[symmetric] sum_diff1[OF \<open>finite S\<close>] by (simp add: that)
     show "(\<Sum>x\<in>S - {v}. (- (1 / u v) * u x) *\<^sub>R x) = v"
       unfolding sum_distrib_left [symmetric] scaleR_scaleR[symmetric]
                 scaleR_right.sum [symmetric] sum_diff1[OF \<open>finite S\<close>] 
       using that by auto
     show "S - {v} \<subseteq> p - {v}"
       using that by auto
   qed (use that in auto)
   ultimately show ?thesis
     unfolding affine_dependent_def affine_hull_explicit by auto
 qed
 
 lemma affine_dependent_explicit_finite:
   fixes S :: "'a::real_vector set"
   assumes "finite S"
   shows "affine_dependent S \<longleftrightarrow>
     (\<exists>u. sum u S = 0 \<and> (\<exists>v\<in>S. u v \<noteq> 0) \<and> sum (\<lambda>v. u v *\<^sub>R v) S = 0)"
   (is "?lhs = ?rhs")
 proof
   have *: "\<And>vt u v. (if vt then u v else 0) *\<^sub>R v = (if vt then (u v) *\<^sub>R v else 0::'a)"
     by auto
   assume ?lhs
   then obtain t u v where
     "finite t" "t \<subseteq> S" "sum u t = 0" "v\<in>t" "u v \<noteq> 0"  "(\<Sum>v\<in>t. u v *\<^sub>R v) = 0"
     unfolding affine_dependent_explicit by auto
   then show ?rhs
     apply (rule_tac x="\<lambda>x. if x\<in>t then u x else 0" in exI)
     apply (auto simp: * sum.inter_restrict[OF assms, symmetric] Int_absorb1[OF \<open>t\<subseteq>S\<close>])
     done
 next
   assume ?rhs
   then obtain u v where "sum u S = 0"  "v\<in>S" "u v \<noteq> 0" "(\<Sum>v\<in>S. u v *\<^sub>R v) = 0"
     by auto
   then show ?lhs unfolding affine_dependent_explicit
     using assms by auto
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Connectedness of convex sets\<close>
 
 lemma connectedD:
   "connected S \<Longrightarrow> open A \<Longrightarrow> open B \<Longrightarrow> S \<subseteq> A \<union> B \<Longrightarrow> A \<inter> B \<inter> S = {} \<Longrightarrow> A \<inter> S = {} \<or> B \<inter> S = {}"
   by (rule Topological_Spaces.topological_space_class.connectedD)
 
 lemma convex_connected:
   fixes S :: "'a::real_normed_vector set"
   assumes "convex S"
   shows "connected S"
 proof (rule connectedI)
   fix A B
   assume "open A" "open B" "A \<inter> B \<inter> S = {}" "S \<subseteq> A \<union> B"
   moreover
   assume "A \<inter> S \<noteq> {}" "B \<inter> S \<noteq> {}"
   then obtain a b where a: "a \<in> A" "a \<in> S" and b: "b \<in> B" "b \<in> S" by auto
   define f where [abs_def]: "f u = u *\<^sub>R a + (1 - u) *\<^sub>R b" for u
   then have "continuous_on {0 .. 1} f"
     by (auto intro!: continuous_intros)
   then have "connected (f ` {0 .. 1})"
     by (auto intro!: connected_continuous_image)
   note connectedD[OF this, of A B]
   moreover have "a \<in> A \<inter> f ` {0 .. 1}"
     using a by (auto intro!: image_eqI[of _ _ 1] simp: f_def)
   moreover have "b \<in> B \<inter> f ` {0 .. 1}"
     using b by (auto intro!: image_eqI[of _ _ 0] simp: f_def)
   moreover have "f ` {0 .. 1} \<subseteq> S"
     using \<open>convex S\<close> a b unfolding convex_def f_def by auto
   ultimately show False by auto
 qed
 
 corollary connected_UNIV[intro]: "connected (UNIV :: 'a::real_normed_vector set)"
   by (simp add: convex_connected)
 
 lemma convex_prod:
   assumes "\<And>i. i \<in> Basis \<Longrightarrow> convex {x. P i x}"
   shows "convex {x. \<forall>i\<in>Basis. P i (x\<bullet>i)}"
   using assms unfolding convex_def
   by (auto simp: inner_add_left)
 
 lemma convex_positive_orthant: "convex {x::'a::euclidean_space. (\<forall>i\<in>Basis. 0 \<le> x\<bullet>i)}"
   by (rule convex_prod) (simp add: atLeast_def[symmetric] convex_real_interval)
 
 subsection \<open>Convex hull\<close>
 
 lemma convex_convex_hull [iff]: "convex (convex hull s)"
   unfolding hull_def
   using convex_Inter[of "{t. convex t \<and> s \<subseteq> t}"]
   by auto
 
 lemma convex_hull_subset:
     "s \<subseteq> convex hull t \<Longrightarrow> convex hull s \<subseteq> convex hull t"
   by (simp add: convex_convex_hull subset_hull)
 
 lemma convex_hull_eq: "convex hull s = s \<longleftrightarrow> convex s"
   by (metis convex_convex_hull hull_same)
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Convex hull is "preserved" by a linear function\<close>
 
 lemma convex_hull_linear_image:
   assumes f: "linear f"
   shows "f ` (convex hull s) = convex hull (f ` s)"
 proof
   show "convex hull (f ` s) \<subseteq> f ` (convex hull s)"
     by (intro hull_minimal image_mono hull_subset convex_linear_image assms convex_convex_hull)
   show "f ` (convex hull s) \<subseteq> convex hull (f ` s)"
   proof (unfold image_subset_iff_subset_vimage, rule hull_minimal)
     show "s \<subseteq> f -` (convex hull (f ` s))"
       by (fast intro: hull_inc)
     show "convex (f -` (convex hull (f ` s)))"
       by (intro convex_linear_vimage [OF f] convex_convex_hull)
   qed
 qed
 
 lemma in_convex_hull_linear_image:
   assumes "linear f"
     and "x \<in> convex hull s"
   shows "f x \<in> convex hull (f ` s)"
   using convex_hull_linear_image[OF assms(1)] assms(2) by auto
 
 lemma convex_hull_Times:
   "convex hull (s \<times> t) = (convex hull s) \<times> (convex hull t)"
 proof
   show "convex hull (s \<times> t) \<subseteq> (convex hull s) \<times> (convex hull t)"
     by (intro hull_minimal Sigma_mono hull_subset convex_Times convex_convex_hull)
   have "(x, y) \<in> convex hull (s \<times> t)" if x: "x \<in> convex hull s" and y: "y \<in> convex hull t" for x y
   proof (rule hull_induct [OF x], rule hull_induct [OF y])
     fix x y assume "x \<in> s" and "y \<in> t"
     then show "(x, y) \<in> convex hull (s \<times> t)"
       by (simp add: hull_inc)
   next
     fix x let ?S = "((\<lambda>y. (0, y)) -` (\<lambda>p. (- x, 0) + p) ` (convex hull s \<times> t))"
     have "convex ?S"
       by (intro convex_linear_vimage convex_translation convex_convex_hull,
         simp add: linear_iff)
     also have "?S = {y. (x, y) \<in> convex hull (s \<times> t)}"
       by (auto simp: image_def Bex_def)
     finally show "convex {y. (x, y) \<in> convex hull (s \<times> t)}" .
   next
     show "convex {x. (x, y) \<in> convex hull s \<times> t}"
     proof -
       fix y let ?S = "((\<lambda>x. (x, 0)) -` (\<lambda>p. (0, - y) + p) ` (convex hull s \<times> t))"
       have "convex ?S"
       by (intro convex_linear_vimage convex_translation convex_convex_hull,
         simp add: linear_iff)
       also have "?S = {x. (x, y) \<in> convex hull (s \<times> t)}"
         by (auto simp: image_def Bex_def)
       finally show "convex {x. (x, y) \<in> convex hull (s \<times> t)}" .
     qed
   qed
   then show "(convex hull s) \<times> (convex hull t) \<subseteq> convex hull (s \<times> t)"
     unfolding subset_eq split_paired_Ball_Sigma by blast
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Stepping theorems for convex hulls of finite sets\<close>
 
 lemma convex_hull_empty[simp]: "convex hull {} = {}"
   by (rule hull_unique) auto
 
 lemma convex_hull_singleton[simp]: "convex hull {a} = {a}"
   by (rule hull_unique) auto
 
 lemma convex_hull_insert:
   fixes S :: "'a::real_vector set"
   assumes "S \<noteq> {}"
   shows "convex hull (insert a S) =
          {x. \<exists>u\<ge>0. \<exists>v\<ge>0. \<exists>b. (u + v = 1) \<and> b \<in> (convex hull S) \<and> (x = u *\<^sub>R a + v *\<^sub>R b)}"
   (is "_ = ?hull")
 proof (intro equalityI hull_minimal subsetI)
   fix x
   assume "x \<in> insert a S"
   then have "\<exists>u\<ge>0. \<exists>v\<ge>0. u + v = 1 \<and> (\<exists>b. b \<in> convex hull S \<and> x = u *\<^sub>R a + v *\<^sub>R b)"
   unfolding insert_iff
   proof
     assume "x = a"
     then show ?thesis
       by (rule_tac x=1 in exI) (use assms hull_subset in fastforce)
   next
     assume "x \<in> S"
     with hull_subset[of S convex] show ?thesis
       by force
   qed
   then show "x \<in> ?hull"
     by simp
 next
   fix x
   assume "x \<in> ?hull"
   then obtain u v b where obt: "u\<ge>0" "v\<ge>0" "u + v = 1" "b \<in> convex hull S" "x = u *\<^sub>R a + v *\<^sub>R b"
     by auto
   have "a \<in> convex hull insert a S" "b \<in> convex hull insert a S"
     using hull_mono[of S "insert a S" convex] hull_mono[of "{a}" "insert a S" convex] and obt(4)
     by auto
   then show "x \<in> convex hull insert a S"
     unfolding obt(5) using obt(1-3)
     by (rule convexD [OF convex_convex_hull])
 next
   show "convex ?hull"
   proof (rule convexI)
     fix x y u v
     assume as: "(0::real) \<le> u" "0 \<le> v" "u + v = 1" and x: "x \<in> ?hull" and y: "y \<in> ?hull"
     from x obtain u1 v1 b1 where
       obt1: "u1\<ge>0" "v1\<ge>0" "u1 + v1 = 1" "b1 \<in> convex hull S" and xeq: "x = u1 *\<^sub>R a + v1 *\<^sub>R b1"
       by auto
     from y obtain u2 v2 b2 where
       obt2: "u2\<ge>0" "v2\<ge>0" "u2 + v2 = 1" "b2 \<in> convex hull S" and yeq: "y = u2 *\<^sub>R a + v2 *\<^sub>R b2"
       by auto
     have *: "\<And>(x::'a) s1 s2. x - s1 *\<^sub>R x - s2 *\<^sub>R x = ((1::real) - (s1 + s2)) *\<^sub>R x"
       by (auto simp: algebra_simps)
     have "\<exists>b \<in> convex hull S. u *\<^sub>R x + v *\<^sub>R y =
       (u * u1) *\<^sub>R a + (v * u2) *\<^sub>R a + (b - (u * u1) *\<^sub>R b - (v * u2) *\<^sub>R b)"
     proof (cases "u * v1 + v * v2 = 0")
       case True
       have *: "\<And>(x::'a) s1 s2. x - s1 *\<^sub>R x - s2 *\<^sub>R x = ((1::real) - (s1 + s2)) *\<^sub>R x"
         by (auto simp: algebra_simps)
       have eq0: "u * v1 = 0" "v * v2 = 0"
         using True mult_nonneg_nonneg[OF \<open>u\<ge>0\<close> \<open>v1\<ge>0\<close>] mult_nonneg_nonneg[OF \<open>v\<ge>0\<close> \<open>v2\<ge>0\<close>]
         by arith+
       then have "u * u1 + v * u2 = 1"
         using as(3) obt1(3) obt2(3) by auto
       then show ?thesis
         using "*" eq0 as obt1(4) xeq yeq by auto
     next
       case False
       have "1 - (u * u1 + v * u2) = (u + v) - (u * u1 + v * u2)"
         using as(3) obt1(3) obt2(3) by (auto simp: field_simps)
       also have "\<dots> = u * (v1 + u1 - u1) + v * (v2 + u2 - u2)"
         using as(3) obt1(3) obt2(3) by (auto simp: field_simps)
       also have "\<dots> = u * v1 + v * v2"
         by simp
       finally have **:"1 - (u * u1 + v * u2) = u * v1 + v * v2" by auto
       let ?b = "((u * v1) / (u * v1 + v * v2)) *\<^sub>R b1 + ((v * v2) / (u * v1 + v * v2)) *\<^sub>R b2"
       have zeroes: "0 \<le> u * v1 + v * v2" "0 \<le> u * v1" "0 \<le> u * v1 + v * v2" "0 \<le> v * v2"
         using as(1,2) obt1(1,2) obt2(1,2) by auto
       show ?thesis
       proof
         show "u *\<^sub>R x + v *\<^sub>R y = (u * u1) *\<^sub>R a + (v * u2) *\<^sub>R a + (?b - (u * u1) *\<^sub>R ?b - (v * u2) *\<^sub>R ?b)"
           unfolding xeq yeq * **
           using False by (auto simp: scaleR_left_distrib scaleR_right_distrib)
         show "?b \<in> convex hull S"
           using False zeroes obt1(4) obt2(4)
           by (auto simp: convexD [OF convex_convex_hull] scaleR_left_distrib scaleR_right_distrib  add_divide_distrib[symmetric]  zero_le_divide_iff)
       qed
     qed
     then obtain b where b: "b \<in> convex hull S" 
        "u *\<^sub>R x + v *\<^sub>R y = (u * u1) *\<^sub>R a + (v * u2) *\<^sub>R a + (b - (u * u1) *\<^sub>R b - (v * u2) *\<^sub>R b)" ..
 
     have u1: "u1 \<le> 1"
       unfolding obt1(3)[symmetric] and not_le using obt1(2) by auto
     have u2: "u2 \<le> 1"
       unfolding obt2(3)[symmetric] and not_le using obt2(2) by auto
     have "u1 * u + u2 * v \<le> max u1 u2 * u + max u1 u2 * v"
     proof (rule add_mono)
       show "u1 * u \<le> max u1 u2 * u" "u2 * v \<le> max u1 u2 * v"
         by (simp_all add: as mult_right_mono)
     qed
     also have "\<dots> \<le> 1"
       unfolding distrib_left[symmetric] and as(3) using u1 u2 by auto
     finally have le1: "u1 * u + u2 * v \<le> 1" .    
     show "u *\<^sub>R x + v *\<^sub>R y \<in> ?hull"
     proof (intro CollectI exI conjI)
       show "0 \<le> u * u1 + v * u2"
         by (simp add: as(1) as(2) obt1(1) obt2(1))
       show "0 \<le> 1 - u * u1 - v * u2"
         by (simp add: le1 diff_diff_add mult.commute)
     qed (use b in \<open>auto simp: algebra_simps\<close>)
   qed
 qed
 
 lemma convex_hull_insert_alt:
    "convex hull (insert a S) =
      (if S = {} then {a}
       else {(1 - u) *\<^sub>R a + u *\<^sub>R x |x u. 0 \<le> u \<and> u \<le> 1 \<and> x \<in> convex hull S})"
   apply (auto simp: convex_hull_insert)
   using diff_eq_eq apply fastforce
   by (metis add.group_left_neutral add_le_imp_le_diff diff_add_cancel)
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Explicit expression for convex hull\<close>
 
 proposition convex_hull_indexed:
   fixes S :: "'a::real_vector set"
   shows "convex hull S =
     {y. \<exists>k u x. (\<forall>i\<in>{1::nat .. k}. 0 \<le> u i \<and> x i \<in> S) \<and>
                 (sum u {1..k} = 1) \<and> (\<Sum>i = 1..k. u i *\<^sub>R x i) = y}"
     (is "?xyz = ?hull")
 proof (rule hull_unique [OF _ convexI])
   show "S \<subseteq> ?hull" 
     by (clarsimp, rule_tac x=1 in exI, rule_tac x="\<lambda>x. 1" in exI, auto)
 next
   fix T
   assume "S \<subseteq> T" "convex T"
   then show "?hull \<subseteq> T"
     by (blast intro: convex_sum)
 next
   fix x y u v
   assume uv: "0 \<le> u" "0 \<le> v" "u + v = (1::real)"
   assume xy: "x \<in> ?hull" "y \<in> ?hull"
   from xy obtain k1 u1 x1 where
     x [rule_format]: "\<forall>i\<in>{1::nat..k1}. 0\<le>u1 i \<and> x1 i \<in> S" 
                       "sum u1 {Suc 0..k1} = 1" "(\<Sum>i = Suc 0..k1. u1 i *\<^sub>R x1 i) = x"
     by auto
   from xy obtain k2 u2 x2 where
     y [rule_format]: "\<forall>i\<in>{1::nat..k2}. 0\<le>u2 i \<and> x2 i \<in> S" 
                      "sum u2 {Suc 0..k2} = 1" "(\<Sum>i = Suc 0..k2. u2 i *\<^sub>R x2 i) = y"
     by auto
   have *: "\<And>P (x::'a) y s t i. (if P i then s else t) *\<^sub>R (if P i then x else y) = (if P i then s *\<^sub>R x else t *\<^sub>R y)"
           "{1..k1 + k2} \<inter> {1..k1} = {1..k1}" "{1..k1 + k2} \<inter> - {1..k1} = (\<lambda>i. i + k1) ` {1..k2}"
     by auto
   have inj: "inj_on (\<lambda>i. i + k1) {1..k2}"
     unfolding inj_on_def by auto
   let ?uu = "\<lambda>i. if i \<in> {1..k1} then u * u1 i else v * u2 (i - k1)"
   let ?xx = "\<lambda>i. if i \<in> {1..k1} then x1 i else x2 (i - k1)"
   show "u *\<^sub>R x + v *\<^sub>R y \<in> ?hull"
   proof (intro CollectI exI conjI ballI)
     show "0 \<le> ?uu i" "?xx i \<in> S" if "i \<in> {1..k1+k2}" for i
       using that by (auto simp add: le_diff_conv uv(1) x(1) uv(2) y(1))
     show "(\<Sum>i = 1..k1 + k2. ?uu i) = 1"  "(\<Sum>i = 1..k1 + k2. ?uu i *\<^sub>R ?xx i) = u *\<^sub>R x + v *\<^sub>R y"
       unfolding * sum.If_cases[OF finite_atLeastAtMost[of 1 "k1 + k2"]]
         sum.reindex[OF inj] Collect_mem_eq o_def
       unfolding scaleR_scaleR[symmetric] scaleR_right.sum [symmetric] sum_distrib_left[symmetric]
       by (simp_all add: sum_distrib_left[symmetric]  x(2,3) y(2,3) uv(3))
   qed 
 qed
 
 lemma convex_hull_finite:
   fixes S :: "'a::real_vector set"
   assumes "finite S"
   shows "convex hull S = {y. \<exists>u. (\<forall>x\<in>S. 0 \<le> u x) \<and> sum u S = 1 \<and> sum (\<lambda>x. u x *\<^sub>R x) S = y}"
   (is "?HULL = _")
 proof (rule hull_unique [OF _ convexI]; clarify)
   fix x
   assume "x \<in> S"
   then show "\<exists>u. (\<forall>x\<in>S. 0 \<le> u x) \<and> sum u S = 1 \<and> (\<Sum>x\<in>S. u x *\<^sub>R x) = x"
     by (rule_tac x="\<lambda>y. if x=y then 1 else 0" in exI) (auto simp: sum.delta'[OF assms] sum_delta''[OF assms])
 next
   fix u v :: real
   assume uv: "0 \<le> u" "0 \<le> v" "u + v = 1"
   fix ux assume ux [rule_format]: "\<forall>x\<in>S. 0 \<le> ux x" "sum ux S = (1::real)"
   fix uy assume uy [rule_format]: "\<forall>x\<in>S. 0 \<le> uy x" "sum uy S = (1::real)"
   have "0 \<le> u * ux x + v * uy x" if "x\<in>S" for x
     by (simp add: that uv ux(1) uy(1))
   moreover
   have "(\<Sum>x\<in>S. u * ux x + v * uy x) = 1"
     unfolding sum.distrib and sum_distrib_left[symmetric] ux(2) uy(2)
     using uv(3) by auto
   moreover
   have "(\<Sum>x\<in>S. (u * ux x + v * uy x) *\<^sub>R x) = u *\<^sub>R (\<Sum>x\<in>S. ux x *\<^sub>R x) + v *\<^sub>R (\<Sum>x\<in>S. uy x *\<^sub>R x)"
     unfolding scaleR_left_distrib sum.distrib scaleR_scaleR[symmetric] scaleR_right.sum [symmetric]
     by auto
   ultimately
   show "\<exists>uc. (\<forall>x\<in>S. 0 \<le> uc x) \<and> sum uc S = 1 \<and>
              (\<Sum>x\<in>S. uc x *\<^sub>R x) = u *\<^sub>R (\<Sum>x\<in>S. ux x *\<^sub>R x) + v *\<^sub>R (\<Sum>x\<in>S. uy x *\<^sub>R x)"
     by (rule_tac x="\<lambda>x. u * ux x + v * uy x" in exI, auto)
 qed (use assms in \<open>auto simp: convex_explicit\<close>)
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Another formulation\<close>
 
 text "Formalized by Lars Schewe."
 
 lemma convex_hull_explicit:
   fixes p :: "'a::real_vector set"
   shows "convex hull p =
     {y. \<exists>S u. finite S \<and> S \<subseteq> p \<and> (\<forall>x\<in>S. 0 \<le> u x) \<and> sum u S = 1 \<and> sum (\<lambda>v. u v *\<^sub>R v) S = y}"
   (is "?lhs = ?rhs")
 proof -
   {
     fix x
     assume "x\<in>?lhs"
     then obtain k u y where
         obt: "\<forall>i\<in>{1::nat..k}. 0 \<le> u i \<and> y i \<in> p" "sum u {1..k} = 1" "(\<Sum>i = 1..k. u i *\<^sub>R y i) = x"
       unfolding convex_hull_indexed by auto
 
     have fin: "finite {1..k}" by auto
     have fin': "\<And>v. finite {i \<in> {1..k}. y i = v}" by auto
     {
       fix j
       assume "j\<in>{1..k}"
       then have "y j \<in> p" "0 \<le> sum u {i. Suc 0 \<le> i \<and> i \<le> k \<and> y i = y j}"
         using obt(1)[THEN bspec[where x=j]] and obt(2)
         apply simp
         apply (rule sum_nonneg)
         using obt(1)
         apply auto
         done
     }
     moreover
     have "(\<Sum>v\<in>y ` {1..k}. sum u {i \<in> {1..k}. y i = v}) = 1"
       unfolding sum.image_gen[OF fin, symmetric] using obt(2) by auto
     moreover have "(\<Sum>v\<in>y ` {1..k}. sum u {i \<in> {1..k}. y i = v} *\<^sub>R v) = x"
       using sum.image_gen[OF fin, of "\<lambda>i. u i *\<^sub>R y i" y, symmetric]
       unfolding scaleR_left.sum using obt(3) by auto
     ultimately
     have "\<exists>S u. finite S \<and> S \<subseteq> p \<and> (\<forall>x\<in>S. 0 \<le> u x) \<and> sum u S = 1 \<and> (\<Sum>v\<in>S. u v *\<^sub>R v) = x"
       apply (rule_tac x="y ` {1..k}" in exI)
       apply (rule_tac x="\<lambda>v. sum u {i\<in>{1..k}. y i = v}" in exI, auto)
       done
     then have "x\<in>?rhs" by auto
   }
   moreover
   {
     fix y
     assume "y\<in>?rhs"
     then obtain S u where
       obt: "finite S" "S \<subseteq> p" "\<forall>x\<in>S. 0 \<le> u x" "sum u S = 1" "(\<Sum>v\<in>S. u v *\<^sub>R v) = y"
       by auto
 
     obtain f where f: "inj_on f {1..card S}" "f ` {1..card S} = S"
       using ex_bij_betw_nat_finite_1[OF obt(1)] unfolding bij_betw_def by auto
 
     {
       fix i :: nat
       assume "i\<in>{1..card S}"
       then have "f i \<in> S"
         using f(2) by blast
       then have "0 \<le> u (f i)" "f i \<in> p" using obt(2,3) by auto
     }
     moreover have *: "finite {1..card S}" by auto
     {
       fix y
       assume "y\<in>S"
       then obtain i where "i\<in>{1..card S}" "f i = y"
         using f using image_iff[of y f "{1..card S}"]
         by auto
       then have "{x. Suc 0 \<le> x \<and> x \<le> card S \<and> f x = y} = {i}"
         apply auto
         using f(1)[unfolded inj_on_def]
         by (metis One_nat_def atLeastAtMost_iff)
       then have "card {x. Suc 0 \<le> x \<and> x \<le> card S \<and> f x = y} = 1" by auto
       then have "(\<Sum>x\<in>{x \<in> {1..card S}. f x = y}. u (f x)) = u y"
           "(\<Sum>x\<in>{x \<in> {1..card S}. f x = y}. u (f x) *\<^sub>R f x) = u y *\<^sub>R y"
         by (auto simp: sum_constant_scaleR)
     }
     then have "(\<Sum>x = 1..card S. u (f x)) = 1" "(\<Sum>i = 1..card S. u (f i) *\<^sub>R f i) = y"
       unfolding sum.image_gen[OF *(1), of "\<lambda>x. u (f x) *\<^sub>R f x" f]
         and sum.image_gen[OF *(1), of "\<lambda>x. u (f x)" f]
       unfolding f
       using sum.cong [of S S "\<lambda>y. (\<Sum>x\<in>{x \<in> {1..card S}. f x = y}. u (f x) *\<^sub>R f x)" "\<lambda>v. u v *\<^sub>R v"]
       using sum.cong [of S S "\<lambda>y. (\<Sum>x\<in>{x \<in> {1..card S}. f x = y}. u (f x))" u]
       unfolding obt(4,5)
       by auto
     ultimately
     have "\<exists>k u x. (\<forall>i\<in>{1..k}. 0 \<le> u i \<and> x i \<in> p) \<and> sum u {1..k} = 1 \<and>
         (\<Sum>i::nat = 1..k. u i *\<^sub>R x i) = y"
       apply (rule_tac x="card S" in exI)
       apply (rule_tac x="u \<circ> f" in exI)
       apply (rule_tac x=f in exI, fastforce)
       done
     then have "y \<in> ?lhs"
       unfolding convex_hull_indexed by auto
   }
   ultimately show ?thesis
     unfolding set_eq_iff by blast
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>A stepping theorem for that expansion\<close>
 
 lemma convex_hull_finite_step:
   fixes S :: "'a::real_vector set"
   assumes "finite S"
   shows
     "(\<exists>u. (\<forall>x\<in>insert a S. 0 \<le> u x) \<and> sum u (insert a S) = w \<and> sum (\<lambda>x. u x *\<^sub>R x) (insert a S) = y)
       \<longleftrightarrow> (\<exists>v\<ge>0. \<exists>u. (\<forall>x\<in>S. 0 \<le> u x) \<and> sum u S = w - v \<and> sum (\<lambda>x. u x *\<^sub>R x) S = y - v *\<^sub>R a)"
   (is "?lhs = ?rhs")
 proof (rule, case_tac[!] "a\<in>S")
   assume "a \<in> S"
   then have *: "insert a S = S" by auto
   assume ?lhs
   then show ?rhs
     unfolding *  by (rule_tac x=0 in exI, auto)
 next
   assume ?lhs
   then obtain u where
       u: "\<forall>x\<in>insert a S. 0 \<le> u x" "sum u (insert a S) = w" "(\<Sum>x\<in>insert a S. u x *\<^sub>R x) = y"
     by auto
   assume "a \<notin> S"
   then show ?rhs
     apply (rule_tac x="u a" in exI)
     using u(1)[THEN bspec[where x=a]]
     apply simp
     apply (rule_tac x=u in exI)
     using u[unfolded sum_clauses(2)[OF assms]] and \<open>a\<notin>S\<close>
     apply auto
     done
 next
   assume "a \<in> S"
   then have *: "insert a S = S" by auto
   have fin: "finite (insert a S)" using assms by auto
   assume ?rhs
   then obtain v u where uv: "v\<ge>0" "\<forall>x\<in>S. 0 \<le> u x" "sum u S = w - v" "(\<Sum>x\<in>S. u x *\<^sub>R x) = y - v *\<^sub>R a"
     by auto
   show ?lhs
     apply (rule_tac x = "\<lambda>x. (if a = x then v else 0) + u x" in exI)
     unfolding scaleR_left_distrib and sum.distrib and sum_delta''[OF fin] and sum.delta'[OF fin]
     unfolding sum_clauses(2)[OF assms]
     using uv and uv(2)[THEN bspec[where x=a]] and \<open>a\<in>S\<close>
     apply auto
     done
 next
   assume ?rhs
   then obtain v u where uv: "v\<ge>0" "\<forall>x\<in>S. 0 \<le> u x" "sum u S = w - v" "(\<Sum>x\<in>S. u x *\<^sub>R x) = y - v *\<^sub>R a"
     by auto
   moreover assume "a \<notin> S"
   moreover
   have "(\<Sum>x\<in>S. if a = x then v else u x) = sum u S"  "(\<Sum>x\<in>S. (if a = x then v else u x) *\<^sub>R x) = (\<Sum>x\<in>S. u x *\<^sub>R x)"
     using \<open>a \<notin> S\<close>
     by (auto simp: intro!: sum.cong)
   ultimately show ?lhs
     by (rule_tac x="\<lambda>x. if a = x then v else u x" in exI) (auto simp: sum_clauses(2)[OF assms])
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Hence some special cases\<close>
 
 lemma convex_hull_2:
   "convex hull {a,b} = {u *\<^sub>R a + v *\<^sub>R b | u v. 0 \<le> u \<and> 0 \<le> v \<and> u + v = 1}"
 proof -
   have *: "\<And>u. (\<forall>x\<in>{a, b}. 0 \<le> u x) \<longleftrightarrow> 0 \<le> u a \<and> 0 \<le> u b"
     by auto
   have **: "finite {b}" by auto
   show ?thesis
     apply (simp add: convex_hull_finite)
     unfolding convex_hull_finite_step[OF **, of a 1, unfolded * conj_assoc]
     apply auto
     apply (rule_tac x=v in exI)
     apply (rule_tac x="1 - v" in exI, simp)
     apply (rule_tac x=u in exI, simp)
     apply (rule_tac x="\<lambda>x. v" in exI, simp)
     done
 qed
 
 lemma convex_hull_2_alt: "convex hull {a,b} = {a + u *\<^sub>R (b - a) | u.  0 \<le> u \<and> u \<le> 1}"
   unfolding convex_hull_2
 proof (rule Collect_cong)
   have *: "\<And>x y ::real. x + y = 1 \<longleftrightarrow> x = 1 - y"
     by auto
   fix x
   show "(\<exists>v u. x = v *\<^sub>R a + u *\<^sub>R b \<and> 0 \<le> v \<and> 0 \<le> u \<and> v + u = 1) \<longleftrightarrow>
     (\<exists>u. x = a + u *\<^sub>R (b - a) \<and> 0 \<le> u \<and> u \<le> 1)"
     unfolding *
     apply auto
     apply (rule_tac[!] x=u in exI)
     apply (auto simp: algebra_simps)
     done
 qed
 
 lemma convex_hull_3:
   "convex hull {a,b,c} = { u *\<^sub>R a + v *\<^sub>R b + w *\<^sub>R c | u v w. 0 \<le> u \<and> 0 \<le> v \<and> 0 \<le> w \<and> u + v + w = 1}"
 proof -
   have fin: "finite {a,b,c}" "finite {b,c}" "finite {c}"
     by auto
   have *: "\<And>x y z ::real. x + y + z = 1 \<longleftrightarrow> x = 1 - y - z"
     by (auto simp: field_simps)
   show ?thesis
     unfolding convex_hull_finite[OF fin(1)] and convex_hull_finite_step[OF fin(2)] and *
     unfolding convex_hull_finite_step[OF fin(3)]
     apply (rule Collect_cong, simp)
     apply auto
     apply (rule_tac x=va in exI)
     apply (rule_tac x="u c" in exI, simp)
     apply (rule_tac x="1 - v - w" in exI, simp)
     apply (rule_tac x=v in exI, simp)
     apply (rule_tac x="\<lambda>x. w" in exI, simp)
     done
 qed
 
 lemma convex_hull_3_alt:
   "convex hull {a,b,c} = {a + u *\<^sub>R (b - a) + v *\<^sub>R (c - a) | u v.  0 \<le> u \<and> 0 \<le> v \<and> u + v \<le> 1}"
 proof -
   have *: "\<And>x y z ::real. x + y + z = 1 \<longleftrightarrow> x = 1 - y - z"
     by auto
   show ?thesis
     unfolding convex_hull_3
     apply (auto simp: *)
     apply (rule_tac x=v in exI)
     apply (rule_tac x=w in exI)
     apply (simp add: algebra_simps)
     apply (rule_tac x=u in exI)
     apply (rule_tac x=v in exI)
     apply (simp add: algebra_simps)
     done
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Relations among closure notions and corresponding hulls\<close>
 
 lemma affine_imp_convex: "affine s \<Longrightarrow> convex s"
   unfolding affine_def convex_def by auto
 
 lemma convex_affine_hull [simp]: "convex (affine hull S)"
   by (simp add: affine_imp_convex)
 
 lemma subspace_imp_convex: "subspace s \<Longrightarrow> convex s"
   using subspace_imp_affine affine_imp_convex by auto
 
 lemma affine_hull_subset_span: "(affine hull s) \<subseteq> (span s)"
   by (metis hull_minimal span_superset subspace_imp_affine subspace_span)
 
 lemma convex_hull_subset_span: "(convex hull s) \<subseteq> (span s)"
   by (metis hull_minimal span_superset subspace_imp_convex subspace_span)
 
 lemma convex_hull_subset_affine_hull: "(convex hull s) \<subseteq> (affine hull s)"
   by (metis affine_affine_hull affine_imp_convex hull_minimal hull_subset)
 
 lemma affine_dependent_imp_dependent: "affine_dependent s \<Longrightarrow> dependent s"
   unfolding affine_dependent_def dependent_def
   using affine_hull_subset_span by auto
 
 lemma dependent_imp_affine_dependent:
   assumes "dependent {x - a| x . x \<in> s}"
     and "a \<notin> s"
   shows "affine_dependent (insert a s)"
 proof -
   from assms(1)[unfolded dependent_explicit] obtain S u v
     where obt: "finite S" "S \<subseteq> {x - a |x. x \<in> s}" "v\<in>S" "u v  \<noteq> 0" "(\<Sum>v\<in>S. u v *\<^sub>R v) = 0"
     by auto
   define t where "t = (\<lambda>x. x + a) ` S"
 
   have inj: "inj_on (\<lambda>x. x + a) S"
     unfolding inj_on_def by auto
   have "0 \<notin> S"
     using obt(2) assms(2) unfolding subset_eq by auto
   have fin: "finite t" and "t \<subseteq> s"
     unfolding t_def using obt(1,2) by auto
   then have "finite (insert a t)" and "insert a t \<subseteq> insert a s"
     by auto
   moreover have *: "\<And>P Q. (\<Sum>x\<in>t. (if x = a then P x else Q x)) = (\<Sum>x\<in>t. Q x)"
     apply (rule sum.cong)
     using \<open>a\<notin>s\<close> \<open>t\<subseteq>s\<close>
     apply auto
     done
   have "(\<Sum>x\<in>insert a t. if x = a then - (\<Sum>x\<in>t. u (x - a)) else u (x - a)) = 0"
     unfolding sum_clauses(2)[OF fin] * using \<open>a\<notin>s\<close> \<open>t\<subseteq>s\<close> by auto
   moreover have "\<exists>v\<in>insert a t. (if v = a then - (\<Sum>x\<in>t. u (x - a)) else u (v - a)) \<noteq> 0"
     using obt(3,4) \<open>0\<notin>S\<close>
     by (rule_tac x="v + a" in bexI) (auto simp: t_def)
   moreover have *: "\<And>P Q. (\<Sum>x\<in>t. (if x = a then P x else Q x) *\<^sub>R x) = (\<Sum>x\<in>t. Q x *\<^sub>R x)"
     using \<open>a\<notin>s\<close> \<open>t\<subseteq>s\<close> by (auto intro!: sum.cong)
   have "(\<Sum>x\<in>t. u (x - a)) *\<^sub>R a = (\<Sum>v\<in>t. u (v - a) *\<^sub>R v)"
     unfolding scaleR_left.sum
     unfolding t_def and sum.reindex[OF inj] and o_def
     using obt(5)
     by (auto simp: sum.distrib scaleR_right_distrib)
   then have "(\<Sum>v\<in>insert a t. (if v = a then - (\<Sum>x\<in>t. u (x - a)) else u (v - a)) *\<^sub>R v) = 0"
     unfolding sum_clauses(2)[OF fin]
     using \<open>a\<notin>s\<close> \<open>t\<subseteq>s\<close>
     by (auto simp: *)
   ultimately show ?thesis
     unfolding affine_dependent_explicit
     apply (rule_tac x="insert a t" in exI, auto)
     done
 qed
 
 lemma convex_cone:
   "convex s \<and> cone s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. (x + y) \<in> s) \<and> (\<forall>x\<in>s. \<forall>c\<ge>0. (c *\<^sub>R x) \<in> s)"
   (is "?lhs = ?rhs")
 proof -
   {
     fix x y
     assume "x\<in>s" "y\<in>s" and ?lhs
     then have "2 *\<^sub>R x \<in>s" "2 *\<^sub>R y \<in> s"
       unfolding cone_def by auto
     then have "x + y \<in> s"
       using \<open>?lhs\<close>[unfolded convex_def, THEN conjunct1]
       apply (erule_tac x="2*\<^sub>R x" in ballE)
       apply (erule_tac x="2*\<^sub>R y" in ballE)
       apply (erule_tac x="1/2" in allE, simp)
       apply (erule_tac x="1/2" in allE, auto)
       done
   }
   then show ?thesis
     unfolding convex_def cone_def by blast
 qed
 
 lemma affine_dependent_biggerset:
   fixes s :: "'a::euclidean_space set"
   assumes "finite s" "card s \<ge> DIM('a) + 2"
   shows "affine_dependent s"
 proof -
   have "s \<noteq> {}" using assms by auto
   then obtain a where "a\<in>s" by auto
   have *: "{x - a |x. x \<in> s - {a}} = (\<lambda>x. x - a) ` (s - {a})"
     by auto
   have "card {x - a |x. x \<in> s - {a}} = card (s - {a})"
     unfolding * by (simp add: card_image inj_on_def)
   also have "\<dots> > DIM('a)" using assms(2)
     unfolding card_Diff_singleton[OF assms(1) \<open>a\<in>s\<close>] by auto
   finally show ?thesis
     apply (subst insert_Diff[OF \<open>a\<in>s\<close>, symmetric])
     apply (rule dependent_imp_affine_dependent)
     apply (rule dependent_biggerset, auto)
     done
 qed
 
 lemma affine_dependent_biggerset_general:
   assumes "finite (S :: 'a::euclidean_space set)"
     and "card S \<ge> dim S + 2"
   shows "affine_dependent S"
 proof -
   from assms(2) have "S \<noteq> {}" by auto
   then obtain a where "a\<in>S" by auto
   have *: "{x - a |x. x \<in> S - {a}} = (\<lambda>x. x - a) ` (S - {a})"
     by auto
   have **: "card {x - a |x. x \<in> S - {a}} = card (S - {a})"
     by (metis (no_types, lifting) "*" card_image diff_add_cancel inj_on_def)
   have "dim {x - a |x. x \<in> S - {a}} \<le> dim S"
     using \<open>a\<in>S\<close> by (auto simp: span_base span_diff intro: subset_le_dim)
   also have "\<dots> < dim S + 1" by auto
   also have "\<dots> \<le> card (S - {a})"
     using assms
     using card_Diff_singleton[OF assms(1) \<open>a\<in>S\<close>]
     by auto
   finally show ?thesis
     apply (subst insert_Diff[OF \<open>a\<in>S\<close>, symmetric])
     apply (rule dependent_imp_affine_dependent)
     apply (rule dependent_biggerset_general)
     unfolding **
     apply auto
     done
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Some Properties of Affine Dependent Sets\<close>
 
 lemma affine_independent_0 [simp]: "\<not> affine_dependent {}"
   by (simp add: affine_dependent_def)
 
 lemma affine_independent_1 [simp]: "\<not> affine_dependent {a}"
   by (simp add: affine_dependent_def)
 
 lemma affine_independent_2 [simp]: "\<not> affine_dependent {a,b}"
   by (simp add: affine_dependent_def insert_Diff_if hull_same)
 
 lemma affine_hull_translation: "affine hull ((\<lambda>x. a + x) `  S) = (\<lambda>x. a + x) ` (affine hull S)"
 proof -
   have "affine ((\<lambda>x. a + x) ` (affine hull S))"
     using affine_translation affine_affine_hull by blast
   moreover have "(\<lambda>x. a + x) `  S \<subseteq> (\<lambda>x. a + x) ` (affine hull S)"
     using hull_subset[of S] by auto
   ultimately have h1: "affine hull ((\<lambda>x. a + x) `  S) \<subseteq> (\<lambda>x. a + x) ` (affine hull S)"
     by (metis hull_minimal)
   have "affine((\<lambda>x. -a + x) ` (affine hull ((\<lambda>x. a + x) `  S)))"
     using affine_translation affine_affine_hull by blast
   moreover have "(\<lambda>x. -a + x) ` (\<lambda>x. a + x) `  S \<subseteq> (\<lambda>x. -a + x) ` (affine hull ((\<lambda>x. a + x) `  S))"
     using hull_subset[of "(\<lambda>x. a + x) `  S"] by auto
   moreover have "S = (\<lambda>x. -a + x) ` (\<lambda>x. a + x) `  S"
     using translation_assoc[of "-a" a] by auto
   ultimately have "(\<lambda>x. -a + x) ` (affine hull ((\<lambda>x. a + x) `  S)) >= (affine hull S)"
     by (metis hull_minimal)
   then have "affine hull ((\<lambda>x. a + x) ` S) >= (\<lambda>x. a + x) ` (affine hull S)"
     by auto
   then show ?thesis using h1 by auto
 qed
 
 lemma affine_dependent_translation:
   assumes "affine_dependent S"
   shows "affine_dependent ((\<lambda>x. a + x) ` S)"
 proof -
   obtain x where x: "x \<in> S \<and> x \<in> affine hull (S - {x})"
     using assms affine_dependent_def by auto
   have "(+) a ` (S - {x}) = (+) a ` S - {a + x}"
     by auto
   then have "a + x \<in> affine hull ((\<lambda>x. a + x) ` S - {a + x})"
     using affine_hull_translation[of a "S - {x}"] x by auto
   moreover have "a + x \<in> (\<lambda>x. a + x) ` S"
     using x by auto
   ultimately show ?thesis
     unfolding affine_dependent_def by auto
 qed
 
 lemma affine_dependent_translation_eq:
   "affine_dependent S \<longleftrightarrow> affine_dependent ((\<lambda>x. a + x) ` S)"
 proof -
   {
     assume "affine_dependent ((\<lambda>x. a + x) ` S)"
     then have "affine_dependent S"
       using affine_dependent_translation[of "((\<lambda>x. a + x) ` S)" "-a"] translation_assoc[of "-a" a]
       by auto
   }
   then show ?thesis
     using affine_dependent_translation by auto
 qed
 
 lemma affine_hull_0_dependent:
   assumes "0 \<in> affine hull S"
   shows "dependent S"
 proof -
   obtain s u where s_u: "finite s \<and> s \<noteq> {} \<and> s \<subseteq> S \<and> sum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = 0"
     using assms affine_hull_explicit[of S] by auto
   then have "\<exists>v\<in>s. u v \<noteq> 0" by auto
   then have "finite s \<and> s \<subseteq> S \<and> (\<exists>v\<in>s. u v \<noteq> 0 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = 0)"
     using s_u by auto
   then show ?thesis
     unfolding dependent_explicit[of S] by auto
 qed
 
 lemma affine_dependent_imp_dependent2:
   assumes "affine_dependent (insert 0 S)"
   shows "dependent S"
 proof -
   obtain x where x: "x \<in> insert 0 S \<and> x \<in> affine hull (insert 0 S - {x})"
     using affine_dependent_def[of "(insert 0 S)"] assms by blast
   then have "x \<in> span (insert 0 S - {x})"
     using affine_hull_subset_span by auto
   moreover have "span (insert 0 S - {x}) = span (S - {x})"
     using insert_Diff_if[of "0" S "{x}"] span_insert_0[of "S-{x}"] by auto
   ultimately have "x \<in> span (S - {x})" by auto
   then have "x \<noteq> 0 \<Longrightarrow> dependent S"
     using x dependent_def by auto
   moreover
   {
     assume "x = 0"
     then have "0 \<in> affine hull S"
       using x hull_mono[of "S - {0}" S] by auto
     then have "dependent S"
       using affine_hull_0_dependent by auto
   }
   ultimately show ?thesis by auto
 qed
 
 lemma affine_dependent_iff_dependent:
   assumes "a \<notin> S"
   shows "affine_dependent (insert a S) \<longleftrightarrow> dependent ((\<lambda>x. -a + x) ` S)"
 proof -
   have "((+) (- a) ` S) = {x - a| x . x \<in> S}" by auto
   then show ?thesis
     using affine_dependent_translation_eq[of "(insert a S)" "-a"]
       affine_dependent_imp_dependent2 assms
       dependent_imp_affine_dependent[of a S]
     by (auto simp del: uminus_add_conv_diff)
 qed
 
 lemma affine_dependent_iff_dependent2:
   assumes "a \<in> S"
   shows "affine_dependent S \<longleftrightarrow> dependent ((\<lambda>x. -a + x) ` (S-{a}))"
 proof -
   have "insert a (S - {a}) = S"
     using assms by auto
   then show ?thesis
     using assms affine_dependent_iff_dependent[of a "S-{a}"] by auto
 qed
 
 lemma affine_hull_insert_span_gen:
   "affine hull (insert a s) = (\<lambda>x. a + x) ` span ((\<lambda>x. - a + x) ` s)"
 proof -
   have h1: "{x - a |x. x \<in> s} = ((\<lambda>x. -a+x) ` s)"
     by auto
   {
     assume "a \<notin> s"
     then have ?thesis
       using affine_hull_insert_span[of a s] h1 by auto
   }
   moreover
   {
     assume a1: "a \<in> s"
     have "\<exists>x. x \<in> s \<and> -a+x=0"
       apply (rule exI[of _ a])
       using a1
       apply auto
       done
     then have "insert 0 ((\<lambda>x. -a+x) ` (s - {a})) = (\<lambda>x. -a+x) ` s"
       by auto
     then have "span ((\<lambda>x. -a+x) ` (s - {a}))=span ((\<lambda>x. -a+x) ` s)"
       using span_insert_0[of "(+) (- a) ` (s - {a})"] by (auto simp del: uminus_add_conv_diff)
     moreover have "{x - a |x. x \<in> (s - {a})} = ((\<lambda>x. -a+x) ` (s - {a}))"
       by auto
     moreover have "insert a (s - {a}) = insert a s"
       by auto
     ultimately have ?thesis
       using affine_hull_insert_span[of "a" "s-{a}"] by auto
   }
   ultimately show ?thesis by auto
 qed
 
 lemma affine_hull_span2:
   assumes "a \<in> s"
   shows "affine hull s = (\<lambda>x. a+x) ` span ((\<lambda>x. -a+x) ` (s-{a}))"
   using affine_hull_insert_span_gen[of a "s - {a}", unfolded insert_Diff[OF assms]]
   by auto
 
 lemma affine_hull_span_gen:
   assumes "a \<in> affine hull s"
   shows "affine hull s = (\<lambda>x. a+x) ` span ((\<lambda>x. -a+x) ` s)"
 proof -
   have "affine hull (insert a s) = affine hull s"
     using hull_redundant[of a affine s] assms by auto
   then show ?thesis
     using affine_hull_insert_span_gen[of a "s"] by auto
 qed
 
 lemma affine_hull_span_0:
   assumes "0 \<in> affine hull S"
   shows "affine hull S = span S"
   using affine_hull_span_gen[of "0" S] assms by auto
 
 lemma extend_to_affine_basis_nonempty:
   fixes S V :: "'n::euclidean_space set"
   assumes "\<not> affine_dependent S" "S \<subseteq> V" "S \<noteq> {}"
   shows "\<exists>T. \<not> affine_dependent T \<and> S \<subseteq> T \<and> T \<subseteq> V \<and> affine hull T = affine hull V"
 proof -
   obtain a where a: "a \<in> S"
     using assms by auto
   then have h0: "independent  ((\<lambda>x. -a + x) ` (S-{a}))"
     using affine_dependent_iff_dependent2 assms by auto
   obtain B where B:
     "(\<lambda>x. -a+x) ` (S - {a}) \<subseteq> B \<and> B \<subseteq> (\<lambda>x. -a+x) ` V \<and> independent B \<and> (\<lambda>x. -a+x) ` V \<subseteq> span B"
     using assms
     by (blast intro: maximal_independent_subset_extend[OF _ h0, of "(\<lambda>x. -a + x) ` V"])
   define T where "T = (\<lambda>x. a+x) ` insert 0 B"
   then have "T = insert a ((\<lambda>x. a+x) ` B)"
     by auto
   then have "affine hull T = (\<lambda>x. a+x) ` span B"
     using affine_hull_insert_span_gen[of a "((\<lambda>x. a+x) ` B)"] translation_assoc[of "-a" a B]
     by auto
   then have "V \<subseteq> affine hull T"
     using B assms translation_inverse_subset[of a V "span B"]
     by auto
   moreover have "T \<subseteq> V"
     using T_def B a assms by auto
   ultimately have "affine hull T = affine hull V"
     by (metis Int_absorb1 Int_absorb2 hull_hull hull_mono)
   moreover have "S \<subseteq> T"
     using T_def B translation_inverse_subset[of a "S-{a}" B]
     by auto
   moreover have "\<not> affine_dependent T"
     using T_def affine_dependent_translation_eq[of "insert 0 B"]
       affine_dependent_imp_dependent2 B
     by auto
   ultimately show ?thesis using \<open>T \<subseteq> V\<close> by auto
 qed
 
 lemma affine_basis_exists:
   fixes V :: "'n::euclidean_space set"
   shows "\<exists>B. B \<subseteq> V \<and> \<not> affine_dependent B \<and> affine hull V = affine hull B"
 proof (cases "V = {}")
   case True
   then show ?thesis
     using affine_independent_0 by auto
 next
   case False
   then obtain x where "x \<in> V" by auto
   then show ?thesis
     using affine_dependent_def[of "{x}"] extend_to_affine_basis_nonempty[of "{x}" V]
     by auto
 qed
 
 proposition extend_to_affine_basis:
   fixes S V :: "'n::euclidean_space set"
   assumes "\<not> affine_dependent S" "S \<subseteq> V"
   obtains T where "\<not> affine_dependent T" "S \<subseteq> T" "T \<subseteq> V" "affine hull T = affine hull V"
 proof (cases "S = {}")
   case True then show ?thesis
     using affine_basis_exists by (metis empty_subsetI that)
 next
   case False
   then show ?thesis by (metis assms extend_to_affine_basis_nonempty that)
 qed
 
 subsection \<open>Affine Dimension of a Set\<close>
 
 definition\<^marker>\<open>tag important\<close> aff_dim :: "('a::euclidean_space) set \<Rightarrow> int"
   where "aff_dim V =
   (SOME d :: int.
     \<exists>B. affine hull B = affine hull V \<and> \<not> affine_dependent B \<and> of_nat (card B) = d + 1)"
 
 lemma aff_dim_basis_exists:
   fixes V :: "('n::euclidean_space) set"
   shows "\<exists>B. affine hull B = affine hull V \<and> \<not> affine_dependent B \<and> of_nat (card B) = aff_dim V + 1"
 proof -
   obtain B where "\<not> affine_dependent B \<and> affine hull B = affine hull V"
     using affine_basis_exists[of V] by auto
   then show ?thesis
     unfolding aff_dim_def
       some_eq_ex[of "\<lambda>d. \<exists>B. affine hull B = affine hull V \<and> \<not> affine_dependent B \<and> of_nat (card B) = d + 1"]
     apply auto
     apply (rule exI[of _ "int (card B) - (1 :: int)"])
     apply (rule exI[of _ "B"], auto)
     done
 qed
 
 lemma affine_hull_nonempty: "S \<noteq> {} \<longleftrightarrow> affine hull S \<noteq> {}"
 proof -
   have "S = {} \<Longrightarrow> affine hull S = {}"
     using affine_hull_empty by auto
   moreover have "affine hull S = {} \<Longrightarrow> S = {}"
     unfolding hull_def by auto
   ultimately show ?thesis by blast
 qed
 
 lemma aff_dim_parallel_subspace_aux:
   fixes B :: "'n::euclidean_space set"
   assumes "\<not> affine_dependent B" "a \<in> B"
   shows "finite B \<and> ((card B) - 1 = dim (span ((\<lambda>x. -a+x) ` (B-{a}))))"
 proof -
   have "independent ((\<lambda>x. -a + x) ` (B-{a}))"
     using affine_dependent_iff_dependent2 assms by auto
   then have fin: "dim (span ((\<lambda>x. -a+x) ` (B-{a}))) = card ((\<lambda>x. -a + x) ` (B-{a}))"
     "finite ((\<lambda>x. -a + x) ` (B - {a}))"
     using indep_card_eq_dim_span[of "(\<lambda>x. -a+x) ` (B-{a})"] by auto
   show ?thesis
   proof (cases "(\<lambda>x. -a + x) ` (B - {a}) = {}")
     case True
     have "B = insert a ((\<lambda>x. a + x) ` (\<lambda>x. -a + x) ` (B - {a}))"
       using translation_assoc[of "a" "-a" "(B - {a})"] assms by auto
     then have "B = {a}" using True by auto
     then show ?thesis using assms fin by auto
   next
     case False
     then have "card ((\<lambda>x. -a + x) ` (B - {a})) > 0"
       using fin by auto
     moreover have h1: "card ((\<lambda>x. -a + x) ` (B-{a})) = card (B-{a})"
       by (rule card_image) (use translate_inj_on in blast)
     ultimately have "card (B-{a}) > 0" by auto
     then have *: "finite (B - {a})"
       using card_gt_0_iff[of "(B - {a})"] by auto
     then have "card (B - {a}) = card B - 1"
       using card_Diff_singleton assms by auto
     with * show ?thesis using fin h1 by auto
   qed
 qed
 
 lemma aff_dim_parallel_subspace:
   fixes V L :: "'n::euclidean_space set"
   assumes "V \<noteq> {}"
     and "subspace L"
     and "affine_parallel (affine hull V) L"
   shows "aff_dim V = int (dim L)"
 proof -
   obtain B where
     B: "affine hull B = affine hull V \<and> \<not> affine_dependent B \<and> int (card B) = aff_dim V + 1"
     using aff_dim_basis_exists by auto
   then have "B \<noteq> {}"
     using assms B affine_hull_nonempty[of V] affine_hull_nonempty[of B]
     by auto
   then obtain a where a: "a \<in> B" by auto
   define Lb where "Lb = span ((\<lambda>x. -a+x) ` (B-{a}))"
   moreover have "affine_parallel (affine hull B) Lb"
     using Lb_def B assms affine_hull_span2[of a B] a
       affine_parallel_commut[of "Lb" "(affine hull B)"]
     unfolding affine_parallel_def
     by auto
   moreover have "subspace Lb"
     using Lb_def subspace_span by auto
   moreover have "affine hull B \<noteq> {}"
     using assms B affine_hull_nonempty[of V] by auto
   ultimately have "L = Lb"
     using assms affine_parallel_subspace[of "affine hull B"] affine_affine_hull[of B] B
     by auto
   then have "dim L = dim Lb"
     by auto
   moreover have "card B - 1 = dim Lb" and "finite B"
     using Lb_def aff_dim_parallel_subspace_aux a B by auto
   ultimately show ?thesis
     using B \<open>B \<noteq> {}\<close> card_gt_0_iff[of B] by auto
 qed
 
 lemma aff_independent_finite:
   fixes B :: "'n::euclidean_space set"
   assumes "\<not> affine_dependent B"
   shows "finite B"
 proof -
   {
     assume "B \<noteq> {}"
     then obtain a where "a \<in> B" by auto
     then have ?thesis
       using aff_dim_parallel_subspace_aux assms by auto
   }
   then show ?thesis by auto
 qed
 
 lemmas independent_finite = independent_imp_finite
 
 lemma span_substd_basis:
   assumes d: "d \<subseteq> Basis"
   shows "span d = {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0}"
   (is "_ = ?B")
 proof -
   have "d \<subseteq> ?B"
     using d by (auto simp: inner_Basis)
   moreover have s: "subspace ?B"
     using subspace_substandard[of "\<lambda>i. i \<notin> d"] .
   ultimately have "span d \<subseteq> ?B"
     using span_mono[of d "?B"] span_eq_iff[of "?B"] by blast
   moreover have *: "card d \<le> dim (span d)"
     using independent_card_le_dim[of d "span d"] independent_substdbasis[OF assms]
       span_superset[of d]
     by auto
   moreover from * have "dim ?B \<le> dim (span d)"
     using dim_substandard[OF assms] by auto
   ultimately show ?thesis
     using s subspace_dim_equal[of "span d" "?B"] subspace_span[of d] by auto
 qed
 
 lemma basis_to_substdbasis_subspace_isomorphism:
   fixes B :: "'a::euclidean_space set"
   assumes "independent B"
   shows "\<exists>f d::'a set. card d = card B \<and> linear f \<and> f ` B = d \<and>
     f ` span B = {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = 0} \<and> inj_on f (span B) \<and> d \<subseteq> Basis"
 proof -
   have B: "card B = dim B"
     using dim_unique[of B B "card B"] assms span_superset[of B] by auto
   have "dim B \<le> card (Basis :: 'a set)"
     using dim_subset_UNIV[of B] by simp
   from ex_card[OF this] obtain d :: "'a set" where d: "d \<subseteq> Basis" and t: "card d = dim B"
     by auto
   let ?t = "{x::'a::euclidean_space. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0}"
   have "\<exists>f. linear f \<and> f ` B = d \<and> f ` span B = ?t \<and> inj_on f (span B)"
   proof (intro basis_to_basis_subspace_isomorphism subspace_span subspace_substandard span_superset)
     show "d \<subseteq> {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = 0}"
       using d inner_not_same_Basis by blast
   qed (auto simp: span_substd_basis independent_substdbasis dim_substandard d t B assms)
   with t \<open>card B = dim B\<close> d show ?thesis by auto
 qed
 
 lemma aff_dim_empty:
   fixes S :: "'n::euclidean_space set"
   shows "S = {} \<longleftrightarrow> aff_dim S = -1"
 proof -
   obtain B where *: "affine hull B = affine hull S"
     and "\<not> affine_dependent B"
     and "int (card B) = aff_dim S + 1"
     using aff_dim_basis_exists by auto
   moreover
   from * have "S = {} \<longleftrightarrow> B = {}"
     using affine_hull_nonempty[of B] affine_hull_nonempty[of S] by auto
   ultimately show ?thesis
     using aff_independent_finite[of B] card_gt_0_iff[of B] by auto
 qed
 
 lemma aff_dim_empty_eq [simp]: "aff_dim ({}::'a::euclidean_space set) = -1"
   by (simp add: aff_dim_empty [symmetric])
 
 lemma aff_dim_affine_hull [simp]: "aff_dim (affine hull S) = aff_dim S"
   unfolding aff_dim_def using hull_hull[of _ S] by auto
 
 lemma aff_dim_affine_hull2:
   assumes "affine hull S = affine hull T"
   shows "aff_dim S = aff_dim T"
   unfolding aff_dim_def using assms by auto
 
 lemma aff_dim_unique:
   fixes B V :: "'n::euclidean_space set"
   assumes "affine hull B = affine hull V \<and> \<not> affine_dependent B"
   shows "of_nat (card B) = aff_dim V + 1"
 proof (cases "B = {}")
   case True
   then have "V = {}"
     using affine_hull_nonempty[of V] affine_hull_nonempty[of B] assms
     by auto
   then have "aff_dim V = (-1::int)"
     using aff_dim_empty by auto
   then show ?thesis
     using \<open>B = {}\<close> by auto
 next
   case False
   then obtain a where a: "a \<in> B" by auto
   define Lb where "Lb = span ((\<lambda>x. -a+x) ` (B-{a}))"
   have "affine_parallel (affine hull B) Lb"
     using Lb_def affine_hull_span2[of a B] a
       affine_parallel_commut[of "Lb" "(affine hull B)"]
     unfolding affine_parallel_def by auto
   moreover have "subspace Lb"
     using Lb_def subspace_span by auto
   ultimately have "aff_dim B = int(dim Lb)"
     using aff_dim_parallel_subspace[of B Lb] \<open>B \<noteq> {}\<close> by auto
   moreover have "(card B) - 1 = dim Lb" "finite B"
     using Lb_def aff_dim_parallel_subspace_aux a assms by auto
   ultimately have "of_nat (card B) = aff_dim B + 1"
     using \<open>B \<noteq> {}\<close> card_gt_0_iff[of B] by auto
   then show ?thesis
     using aff_dim_affine_hull2 assms by auto
 qed
 
 lemma aff_dim_affine_independent:
   fixes B :: "'n::euclidean_space set"
   assumes "\<not> affine_dependent B"
   shows "of_nat (card B) = aff_dim B + 1"
   using aff_dim_unique[of B B] assms by auto
 
 lemma affine_independent_iff_card:
     fixes s :: "'a::euclidean_space set"
     shows "\<not> affine_dependent s \<longleftrightarrow> finite s \<and> aff_dim s = int(card s) - 1"
   apply (rule iffI)
   apply (simp add: aff_dim_affine_independent aff_independent_finite)
   by (metis affine_basis_exists [of s] aff_dim_unique card_subset_eq diff_add_cancel of_nat_eq_iff)
 
 lemma aff_dim_sing [simp]:
   fixes a :: "'n::euclidean_space"
   shows "aff_dim {a} = 0"
   using aff_dim_affine_independent[of "{a}"] affine_independent_1 by auto
 
 lemma aff_dim_2 [simp]: "aff_dim {a,b} = (if a = b then 0 else 1)"
 proof (clarsimp)
   assume "a \<noteq> b"
   then have "aff_dim{a,b} = card{a,b} - 1"
     using affine_independent_2 [of a b] aff_dim_affine_independent by fastforce
   also have "\<dots> = 1"
     using \<open>a \<noteq> b\<close> by simp
   finally show "aff_dim {a, b} = 1" .
 qed
 
 lemma aff_dim_inner_basis_exists:
   fixes V :: "('n::euclidean_space) set"
   shows "\<exists>B. B \<subseteq> V \<and> affine hull B = affine hull V \<and>
     \<not> affine_dependent B \<and> of_nat (card B) = aff_dim V + 1"
 proof -
   obtain B where B: "\<not> affine_dependent B" "B \<subseteq> V" "affine hull B = affine hull V"
     using affine_basis_exists[of V] by auto
   then have "of_nat(card B) = aff_dim V+1" using aff_dim_unique by auto
   with B show ?thesis by auto
 qed
 
 lemma aff_dim_le_card:
   fixes V :: "'n::euclidean_space set"
   assumes "finite V"
   shows "aff_dim V \<le> of_nat (card V) - 1"
 proof -
   obtain B where B: "B \<subseteq> V" "of_nat (card B) = aff_dim V + 1"
     using aff_dim_inner_basis_exists[of V] by auto
   then have "card B \<le> card V"
     using assms card_mono by auto
   with B show ?thesis by auto
 qed
 
 lemma aff_dim_parallel_eq:
   fixes S T :: "'n::euclidean_space set"
   assumes "affine_parallel (affine hull S) (affine hull T)"
   shows "aff_dim S = aff_dim T"
 proof -
   {
     assume "T \<noteq> {}" "S \<noteq> {}"
     then obtain L where L: "subspace L \<and> affine_parallel (affine hull T) L"
       using affine_parallel_subspace[of "affine hull T"]
         affine_affine_hull[of T] affine_hull_nonempty
       by auto
     then have "aff_dim T = int (dim L)"
       using aff_dim_parallel_subspace \<open>T \<noteq> {}\<close> by auto
     moreover have *: "subspace L \<and> affine_parallel (affine hull S) L"
        using L affine_parallel_assoc[of "affine hull S" "affine hull T" L] assms by auto
     moreover from * have "aff_dim S = int (dim L)"
       using aff_dim_parallel_subspace \<open>S \<noteq> {}\<close> by auto
     ultimately have ?thesis by auto
   }
   moreover
   {
     assume "S = {}"
     then have "S = {}" and "T = {}"
       using assms affine_hull_nonempty
       unfolding affine_parallel_def
       by auto
     then have ?thesis using aff_dim_empty by auto
   }
   moreover
   {
     assume "T = {}"
     then have "S = {}" and "T = {}"
       using assms affine_hull_nonempty
       unfolding affine_parallel_def
       by auto
     then have ?thesis
       using aff_dim_empty by auto
   }
   ultimately show ?thesis by blast
 qed
 
 lemma aff_dim_translation_eq:
   "aff_dim ((+) a ` S) = aff_dim S" for a :: "'n::euclidean_space"
 proof -
   have "affine_parallel (affine hull S) (affine hull ((\<lambda>x. a + x) ` S))"
     unfolding affine_parallel_def
     apply (rule exI[of _ "a"])
     using affine_hull_translation[of a S]
     apply auto
     done
   then show ?thesis
     using aff_dim_parallel_eq[of S "(\<lambda>x. a + x) ` S"] by auto
 qed
 
 lemma aff_dim_translation_eq_subtract:
   "aff_dim ((\<lambda>x. x - a) ` S) = aff_dim S" for a :: "'n::euclidean_space"
   using aff_dim_translation_eq [of "- a"] by (simp cong: image_cong_simp)
 
 lemma aff_dim_affine:
   fixes S L :: "'n::euclidean_space set"
   assumes "S \<noteq> {}"
     and "affine S"
     and "subspace L"
     and "affine_parallel S L"
   shows "aff_dim S = int (dim L)"
 proof -
   have *: "affine hull S = S"
     using assms affine_hull_eq[of S] by auto
   then have "affine_parallel (affine hull S) L"
     using assms by (simp add: *)
   then show ?thesis
     using assms aff_dim_parallel_subspace[of S L] by blast
 qed
 
 lemma dim_affine_hull:
   fixes S :: "'n::euclidean_space set"
   shows "dim (affine hull S) = dim S"
 proof -
   have "dim (affine hull S) \<ge> dim S"
     using dim_subset by auto
   moreover have "dim (span S) \<ge> dim (affine hull S)"
     using dim_subset affine_hull_subset_span by blast
   moreover have "dim (span S) = dim S"
     using dim_span by auto
   ultimately show ?thesis by auto
 qed
 
 lemma aff_dim_subspace:
   fixes S :: "'n::euclidean_space set"
   assumes "subspace S"
   shows "aff_dim S = int (dim S)"
 proof (cases "S={}")
   case True with assms show ?thesis
     by (simp add: subspace_affine)
 next
   case False
   with aff_dim_affine[of S S] assms subspace_imp_affine[of S] affine_parallel_reflex[of S] subspace_affine
   show ?thesis by auto
 qed
 
 lemma aff_dim_zero:
   fixes S :: "'n::euclidean_space set"
   assumes "0 \<in> affine hull S"
   shows "aff_dim S = int (dim S)"
 proof -
   have "subspace (affine hull S)"
     using subspace_affine[of "affine hull S"] affine_affine_hull assms
     by auto
   then have "aff_dim (affine hull S) = int (dim (affine hull S))"
     using assms aff_dim_subspace[of "affine hull S"] by auto
   then show ?thesis
     using aff_dim_affine_hull[of S] dim_affine_hull[of S]
     by auto
 qed
 
 lemma aff_dim_eq_dim:
   "aff_dim S = int (dim ((+) (- a) ` S))" if "a \<in> affine hull S"
     for S :: "'n::euclidean_space set"
 proof -
   have "0 \<in> affine hull (+) (- a) ` S"
     unfolding affine_hull_translation
     using that by (simp add: ac_simps)
   with aff_dim_zero show ?thesis
     by (metis aff_dim_translation_eq)
 qed
 
 lemma aff_dim_eq_dim_subtract:
   "aff_dim S = int (dim ((\<lambda>x. x - a) ` S))" if "a \<in> affine hull S"
     for S :: "'n::euclidean_space set"
   using aff_dim_eq_dim [of a] that by (simp cong: image_cong_simp)
 
 lemma aff_dim_UNIV [simp]: "aff_dim (UNIV :: 'n::euclidean_space set) = int(DIM('n))"
   using aff_dim_subspace[of "(UNIV :: 'n::euclidean_space set)"]
     dim_UNIV[where 'a="'n::euclidean_space"]
   by auto
 
 lemma aff_dim_geq:
   fixes V :: "'n::euclidean_space set"
   shows "aff_dim V \<ge> -1"
 proof -
   obtain B where "affine hull B = affine hull V"
     and "\<not> affine_dependent B"
     and "int (card B) = aff_dim V + 1"
     using aff_dim_basis_exists by auto
   then show ?thesis by auto
 qed
 
 lemma aff_dim_negative_iff [simp]:
   fixes S :: "'n::euclidean_space set"
   shows "aff_dim S < 0 \<longleftrightarrow>S = {}"
 by (metis aff_dim_empty aff_dim_geq diff_0 eq_iff zle_diff1_eq)
 
 lemma aff_lowdim_subset_hyperplane:
   fixes S :: "'a::euclidean_space set"
   assumes "aff_dim S < DIM('a)"
   obtains a b where "a \<noteq> 0" "S \<subseteq> {x. a \<bullet> x = b}"
 proof (cases "S={}")
   case True
   moreover
   have "(SOME b. b \<in> Basis) \<noteq> 0"
     by (metis norm_some_Basis norm_zero zero_neq_one)
   ultimately show ?thesis
     using that by blast
 next
   case False
   then obtain c S' where "c \<notin> S'" "S = insert c S'"
     by (meson equals0I mk_disjoint_insert)
   have "dim ((+) (-c) ` S) < DIM('a)"
     by (metis \<open>S = insert c S'\<close> aff_dim_eq_dim assms hull_inc insertI1 of_nat_less_imp_less)
   then obtain a where "a \<noteq> 0" "span ((+) (-c) ` S) \<subseteq> {x. a \<bullet> x = 0}"
     using lowdim_subset_hyperplane by blast
   moreover
   have "a \<bullet> w = a \<bullet> c" if "span ((+) (- c) ` S) \<subseteq> {x. a \<bullet> x = 0}" "w \<in> S" for w
   proof -
     have "w-c \<in> span ((+) (- c) ` S)"
       by (simp add: span_base \<open>w \<in> S\<close>)
     with that have "w-c \<in> {x. a \<bullet> x = 0}"
       by blast
     then show ?thesis
       by (auto simp: algebra_simps)
   qed
   ultimately have "S \<subseteq> {x. a \<bullet> x = a \<bullet> c}"
     by blast
   then show ?thesis
     by (rule that[OF \<open>a \<noteq> 0\<close>])
 qed
 
 lemma affine_independent_card_dim_diffs:
   fixes S :: "'a :: euclidean_space set"
   assumes "\<not> affine_dependent S" "a \<in> S"
     shows "card S = dim {x - a|x. x \<in> S} + 1"
 proof -
   have 1: "{b - a|b. b \<in> (S - {a})} \<subseteq> {x - a|x. x \<in> S}" by auto
   have 2: "x - a \<in> span {b - a |b. b \<in> S - {a}}" if "x \<in> S" for x
   proof (cases "x = a")
     case True then show ?thesis by (simp add: span_clauses)
   next
     case False then show ?thesis
       using assms by (blast intro: span_base that)
   qed
   have "\<not> affine_dependent (insert a S)"
     by (simp add: assms insert_absorb)
   then have 3: "independent {b - a |b. b \<in> S - {a}}"
       using dependent_imp_affine_dependent by fastforce
   have "{b - a |b. b \<in> S - {a}} = (\<lambda>b. b-a) ` (S - {a})"
     by blast
   then have "card {b - a |b. b \<in> S - {a}} = card ((\<lambda>b. b-a) ` (S - {a}))"
     by simp
   also have "\<dots> = card (S - {a})"
     by (metis (no_types, lifting) card_image diff_add_cancel inj_onI)
   also have "\<dots> = card S - 1"
     by (simp add: aff_independent_finite assms)
   finally have 4: "card {b - a |b. b \<in> S - {a}} = card S - 1" .
   have "finite S"
     by (meson assms aff_independent_finite)
   with \<open>a \<in> S\<close> have "card S \<noteq> 0" by auto
   moreover have "dim {x - a |x. x \<in> S} = card S - 1"
     using 2 by (blast intro: dim_unique [OF 1 _ 3 4])
   ultimately show ?thesis
     by auto
 qed
 
 lemma independent_card_le_aff_dim:
   fixes B :: "'n::euclidean_space set"
   assumes "B \<subseteq> V"
   assumes "\<not> affine_dependent B"
   shows "int (card B) \<le> aff_dim V + 1"
 proof -
   obtain T where T: "\<not> affine_dependent T \<and> B \<subseteq> T \<and> T \<subseteq> V \<and> affine hull T = affine hull V"
     by (metis assms extend_to_affine_basis[of B V])
   then have "of_nat (card T) = aff_dim V + 1"
     using aff_dim_unique by auto
   then show ?thesis
     using T card_mono[of T B] aff_independent_finite[of T] by auto
 qed
 
 lemma aff_dim_subset:
   fixes S T :: "'n::euclidean_space set"
   assumes "S \<subseteq> T"
   shows "aff_dim S \<le> aff_dim T"
 proof -
   obtain B where B: "\<not> affine_dependent B" "B \<subseteq> S" "affine hull B = affine hull S"
     "of_nat (card B) = aff_dim S + 1"
     using aff_dim_inner_basis_exists[of S] by auto
   then have "int (card B) \<le> aff_dim T + 1"
     using assms independent_card_le_aff_dim[of B T] by auto
   with B show ?thesis by auto
 qed
 
 lemma aff_dim_le_DIM:
   fixes S :: "'n::euclidean_space set"
   shows "aff_dim S \<le> int (DIM('n))"
 proof -
   have "aff_dim (UNIV :: 'n::euclidean_space set) = int(DIM('n))"
     using aff_dim_UNIV by auto
   then show "aff_dim (S:: 'n::euclidean_space set) \<le> int(DIM('n))"
     using aff_dim_subset[of S "(UNIV :: ('n::euclidean_space) set)"] subset_UNIV by auto
 qed
 
 lemma affine_dim_equal:
   fixes S :: "'n::euclidean_space set"
   assumes "affine S" "affine T" "S \<noteq> {}" "S \<subseteq> T" "aff_dim S = aff_dim T"
   shows "S = T"
 proof -
   obtain a where "a \<in> S" using assms by auto
   then have "a \<in> T" using assms by auto
   define LS where "LS = {y. \<exists>x \<in> S. (-a) + x = y}"
   then have ls: "subspace LS" "affine_parallel S LS"
     using assms parallel_subspace_explicit[of S a LS] \<open>a \<in> S\<close> by auto
   then have h1: "int(dim LS) = aff_dim S"
     using assms aff_dim_affine[of S LS] by auto
   have "T \<noteq> {}" using assms by auto
   define LT where "LT = {y. \<exists>x \<in> T. (-a) + x = y}"
   then have lt: "subspace LT \<and> affine_parallel T LT"
     using assms parallel_subspace_explicit[of T a LT] \<open>a \<in> T\<close> by auto
   then have "int(dim LT) = aff_dim T"
     using assms aff_dim_affine[of T LT] \<open>T \<noteq> {}\<close> by auto
   then have "dim LS = dim LT"
     using h1 assms by auto
   moreover have "LS \<le> LT"
     using LS_def LT_def assms by auto
   ultimately have "LS = LT"
     using subspace_dim_equal[of LS LT] ls lt by auto
   moreover have "S = {x. \<exists>y \<in> LS. a+y=x}"
     using LS_def by auto
   moreover have "T = {x. \<exists>y \<in> LT. a+y=x}"
     using LT_def by auto
   ultimately show ?thesis by auto
 qed
 
 lemma aff_dim_eq_0:
   fixes S :: "'a::euclidean_space set"
   shows "aff_dim S = 0 \<longleftrightarrow> (\<exists>a. S = {a})"
 proof (cases "S = {}")
   case True
   then show ?thesis
     by auto
 next
   case False
   then obtain a where "a \<in> S" by auto
   show ?thesis
   proof safe
     assume 0: "aff_dim S = 0"
     have "\<not> {a,b} \<subseteq> S" if "b \<noteq> a" for b
       by (metis "0" aff_dim_2 aff_dim_subset not_one_le_zero that)
     then show "\<exists>a. S = {a}"
       using \<open>a \<in> S\<close> by blast
   qed auto
 qed
 
 lemma affine_hull_UNIV:
   fixes S :: "'n::euclidean_space set"
   assumes "aff_dim S = int(DIM('n))"
   shows "affine hull S = (UNIV :: ('n::euclidean_space) set)"
 proof -
   have "S \<noteq> {}"
     using assms aff_dim_empty[of S] by auto
   have h0: "S \<subseteq> affine hull S"
     using hull_subset[of S _] by auto
   have h1: "aff_dim (UNIV :: ('n::euclidean_space) set) = aff_dim S"
     using aff_dim_UNIV assms by auto
   then have h2: "aff_dim (affine hull S) \<le> aff_dim (UNIV :: ('n::euclidean_space) set)"
     using aff_dim_le_DIM[of "affine hull S"] assms h0 by auto
   have h3: "aff_dim S \<le> aff_dim (affine hull S)"
     using h0 aff_dim_subset[of S "affine hull S"] assms by auto
   then have h4: "aff_dim (affine hull S) = aff_dim (UNIV :: ('n::euclidean_space) set)"
     using h0 h1 h2 by auto
   then show ?thesis
     using affine_dim_equal[of "affine hull S" "(UNIV :: ('n::euclidean_space) set)"]
       affine_affine_hull[of S] affine_UNIV assms h4 h0 \<open>S \<noteq> {}\<close>
     by auto
 qed
 
 lemma disjoint_affine_hull:
   fixes s :: "'n::euclidean_space set"
   assumes "\<not> affine_dependent s" "t \<subseteq> s" "u \<subseteq> s" "t \<inter> u = {}"
     shows "(affine hull t) \<inter> (affine hull u) = {}"
 proof -
   have "finite s" using assms by (simp add: aff_independent_finite)
   then have "finite t" "finite u" using assms finite_subset by blast+
   { fix y
     assume yt: "y \<in> affine hull t" and yu: "y \<in> affine hull u"
     then obtain a b
            where a1 [simp]: "sum a t = 1" and [simp]: "sum (\<lambda>v. a v *\<^sub>R v) t = y"
              and [simp]: "sum b u = 1" "sum (\<lambda>v. b v *\<^sub>R v) u = y"
       by (auto simp: affine_hull_finite \<open>finite t\<close> \<open>finite u\<close>)
     define c where "c x = (if x \<in> t then a x else if x \<in> u then -(b x) else 0)" for x
     have [simp]: "s \<inter> t = t" "s \<inter> - t \<inter> u = u" using assms by auto
     have "sum c s = 0"
       by (simp add: c_def comm_monoid_add_class.sum.If_cases \<open>finite s\<close> sum_negf)
     moreover have "\<not> (\<forall>v\<in>s. c v = 0)"
       by (metis (no_types) IntD1 \<open>s \<inter> t = t\<close> a1 c_def sum.neutral zero_neq_one)
     moreover have "(\<Sum>v\<in>s. c v *\<^sub>R v) = 0"
       by (simp add: c_def if_smult sum_negf
              comm_monoid_add_class.sum.If_cases \<open>finite s\<close>)
     ultimately have False
       using assms \<open>finite s\<close> by (auto simp: affine_dependent_explicit)
   }
   then show ?thesis by blast
 qed
 
 lemma aff_dim_convex_hull:
   fixes S :: "'n::euclidean_space set"
   shows "aff_dim (convex hull S) = aff_dim S"
   using aff_dim_affine_hull[of S] convex_hull_subset_affine_hull[of S]
     hull_subset[of S "convex"] aff_dim_subset[of S "convex hull S"]
     aff_dim_subset[of "convex hull S" "affine hull S"]
   by auto
 
 subsection \<open>Caratheodory's theorem\<close>
 
 lemma convex_hull_caratheodory_aff_dim:
   fixes p :: "('a::euclidean_space) set"
   shows "convex hull p =
     {y. \<exists>s u. finite s \<and> s \<subseteq> p \<and> card s \<le> aff_dim p + 1 \<and>
       (\<forall>x\<in>s. 0 \<le> u x) \<and> sum u s = 1 \<and> sum (\<lambda>v. u v *\<^sub>R v) s = y}"
   unfolding convex_hull_explicit set_eq_iff mem_Collect_eq
 proof (intro allI iffI)
   fix y
   let ?P = "\<lambda>n. \<exists>s u. finite s \<and> card s = n \<and> s \<subseteq> p \<and> (\<forall>x\<in>s. 0 \<le> u x) \<and>
     sum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y"
   assume "\<exists>s u. finite s \<and> s \<subseteq> p \<and> (\<forall>x\<in>s. 0 \<le> u x) \<and> sum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y"
   then obtain N where "?P N" by auto
   then have "\<exists>n\<le>N. (\<forall>k<n. \<not> ?P k) \<and> ?P n"
     apply (rule_tac ex_least_nat_le, auto)
     done
   then obtain n where "?P n" and smallest: "\<forall>k<n. \<not> ?P k"
     by blast
   then obtain s u where obt: "finite s" "card s = n" "s\<subseteq>p" "\<forall>x\<in>s. 0 \<le> u x"
     "sum u s = 1"  "(\<Sum>v\<in>s. u v *\<^sub>R v) = y" by auto
 
   have "card s \<le> aff_dim p + 1"
   proof (rule ccontr, simp only: not_le)
     assume "aff_dim p + 1 < card s"
     then have "affine_dependent s"
       using affine_dependent_biggerset[OF obt(1)] independent_card_le_aff_dim not_less obt(3)
       by blast
     then obtain w v where wv: "sum w s = 0" "v\<in>s" "w v \<noteq> 0" "(\<Sum>v\<in>s. w v *\<^sub>R v) = 0"
       using affine_dependent_explicit_finite[OF obt(1)] by auto
     define i where "i = (\<lambda>v. (u v) / (- w v)) ` {v\<in>s. w v < 0}"
     define t where "t = Min i"
     have "\<exists>x\<in>s. w x < 0"
     proof (rule ccontr, simp add: not_less)
       assume as:"\<forall>x\<in>s. 0 \<le> w x"
       then have "sum w (s - {v}) \<ge> 0"
         apply (rule_tac sum_nonneg, auto)
         done
       then have "sum w s > 0"
         unfolding sum.remove[OF obt(1) \<open>v\<in>s\<close>]
         using as[THEN bspec[where x=v]]  \<open>v\<in>s\<close>  \<open>w v \<noteq> 0\<close> by auto
       then show False using wv(1) by auto
     qed
     then have "i \<noteq> {}" unfolding i_def by auto
     then have "t \<ge> 0"
       using Min_ge_iff[of i 0 ] and obt(1)
       unfolding t_def i_def
       using obt(4)[unfolded le_less]
       by (auto simp: divide_le_0_iff)
     have t: "\<forall>v\<in>s. u v + t * w v \<ge> 0"
     proof
       fix v
       assume "v \<in> s"
       then have v: "0 \<le> u v"
         using obt(4)[THEN bspec[where x=v]] by auto
       show "0 \<le> u v + t * w v"
       proof (cases "w v < 0")
         case False
         thus ?thesis using v \<open>t\<ge>0\<close> by auto
       next
         case True
         then have "t \<le> u v / (- w v)"
           using \<open>v\<in>s\<close> unfolding t_def i_def
           apply (rule_tac Min_le)
           using obt(1) apply auto
           done
         then show ?thesis
           unfolding real_0_le_add_iff
           using pos_le_divide_eq[OF True[unfolded neg_0_less_iff_less[symmetric]]]
           by auto
       qed
     qed
     obtain a where "a \<in> s" and "t = (\<lambda>v. (u v) / (- w v)) a" and "w a < 0"
       using Min_in[OF _ \<open>i\<noteq>{}\<close>] and obt(1) unfolding i_def t_def by auto
     then have a: "a \<in> s" "u a + t * w a = 0" by auto
     have *: "\<And>f. sum f (s - {a}) = sum f s - ((f a)::'b::ab_group_add)"
       unfolding sum.remove[OF obt(1) \<open>a\<in>s\<close>] by auto
     have "(\<Sum>v\<in>s. u v + t * w v) = 1"
       unfolding sum.distrib wv(1) sum_distrib_left[symmetric] obt(5) by auto
     moreover have "(\<Sum>v\<in>s. u v *\<^sub>R v + (t * w v) *\<^sub>R v) - (u a *\<^sub>R a + (t * w a) *\<^sub>R a) = y"
       unfolding sum.distrib obt(6) scaleR_scaleR[symmetric] scaleR_right.sum [symmetric] wv(4)
       using a(2) [THEN eq_neg_iff_add_eq_0 [THEN iffD2]] by simp
     ultimately have "?P (n - 1)"
       apply (rule_tac x="(s - {a})" in exI)
       apply (rule_tac x="\<lambda>v. u v + t * w v" in exI)
       using obt(1-3) and t and a
       apply (auto simp: * scaleR_left_distrib)
       done
     then show False
       using smallest[THEN spec[where x="n - 1"]] by auto
   qed
   then show "\<exists>s u. finite s \<and> s \<subseteq> p \<and> card s \<le> aff_dim p + 1 \<and>
       (\<forall>x\<in>s. 0 \<le> u x) \<and> sum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y"
     using obt by auto
 qed auto
 
 lemma caratheodory_aff_dim:
   fixes p :: "('a::euclidean_space) set"
   shows "convex hull p = {x. \<exists>s. finite s \<and> s \<subseteq> p \<and> card s \<le> aff_dim p + 1 \<and> x \<in> convex hull s}"
         (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     apply (subst convex_hull_caratheodory_aff_dim, clarify)
     apply (rule_tac x=s in exI)
     apply (simp add: hull_subset convex_explicit [THEN iffD1, OF convex_convex_hull])
     done
 next
   show "?rhs \<subseteq> ?lhs"
     using hull_mono by blast
 qed
 
 lemma convex_hull_caratheodory:
   fixes p :: "('a::euclidean_space) set"
   shows "convex hull p =
             {y. \<exists>s u. finite s \<and> s \<subseteq> p \<and> card s \<le> DIM('a) + 1 \<and>
               (\<forall>x\<in>s. 0 \<le> u x) \<and> sum u s = 1 \<and> sum (\<lambda>v. u v *\<^sub>R v) s = y}"
         (is "?lhs = ?rhs")
 proof (intro set_eqI iffI)
   fix x
   assume "x \<in> ?lhs" then show "x \<in> ?rhs"
     apply (simp only: convex_hull_caratheodory_aff_dim Set.mem_Collect_eq)
     apply (erule ex_forward)+
     using aff_dim_le_DIM [of p]
     apply simp
     done
 next
   fix x
   assume "x \<in> ?rhs" then show "x \<in> ?lhs"
     by (auto simp: convex_hull_explicit)
 qed
 
 theorem caratheodory:
   "convex hull p =
     {x::'a::euclidean_space. \<exists>s. finite s \<and> s \<subseteq> p \<and>
       card s \<le> DIM('a) + 1 \<and> x \<in> convex hull s}"
 proof safe
   fix x
   assume "x \<in> convex hull p"
   then obtain s u where "finite s" "s \<subseteq> p" "card s \<le> DIM('a) + 1"
     "\<forall>x\<in>s. 0 \<le> u x" "sum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = x"
     unfolding convex_hull_caratheodory by auto
   then show "\<exists>s. finite s \<and> s \<subseteq> p \<and> card s \<le> DIM('a) + 1 \<and> x \<in> convex hull s"
     apply (rule_tac x=s in exI)
     using hull_subset[of s convex]
     using convex_convex_hull[simplified convex_explicit, of s,
       THEN spec[where x=s], THEN spec[where x=u]]
     apply auto
     done
 next
   fix x s
   assume  "finite s" "s \<subseteq> p" "card s \<le> DIM('a) + 1" "x \<in> convex hull s"
   then show "x \<in> convex hull p"
     using hull_mono[OF \<open>s\<subseteq>p\<close>] by auto
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Some Properties of subset of standard basis\<close>
 
 lemma affine_hull_substd_basis:
   assumes "d \<subseteq> Basis"
   shows "affine hull (insert 0 d) = {x::'a::euclidean_space. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0}"
   (is "affine hull (insert 0 ?A) = ?B")
 proof -
   have *: "\<And>A. (+) (0::'a) ` A = A" "\<And>A. (+) (- (0::'a)) ` A = A"
     by auto
   show ?thesis
     unfolding affine_hull_insert_span_gen span_substd_basis[OF assms,symmetric] * ..
 qed
 
 lemma affine_hull_convex_hull [simp]: "affine hull (convex hull S) = affine hull S"
   by (metis Int_absorb1 Int_absorb2 convex_hull_subset_affine_hull hull_hull hull_mono hull_subset)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Moving and scaling convex hulls\<close>
 
 lemma convex_hull_set_plus:
   "convex hull (S + T) = convex hull S + convex hull T"
   unfolding set_plus_image
   apply (subst convex_hull_linear_image [symmetric])
   apply (simp add: linear_iff scaleR_right_distrib)
   apply (simp add: convex_hull_Times)
   done
 
 lemma translation_eq_singleton_plus: "(\<lambda>x. a + x) ` T = {a} + T"
   unfolding set_plus_def by auto
 
 lemma convex_hull_translation:
   "convex hull ((\<lambda>x. a + x) ` S) = (\<lambda>x. a + x) ` (convex hull S)"
   unfolding translation_eq_singleton_plus
   by (simp only: convex_hull_set_plus convex_hull_singleton)
 
 lemma convex_hull_scaling:
   "convex hull ((\<lambda>x. c *\<^sub>R x) ` S) = (\<lambda>x. c *\<^sub>R x) ` (convex hull S)"
   using linear_scaleR by (rule convex_hull_linear_image [symmetric])
 
 lemma convex_hull_affinity:
   "convex hull ((\<lambda>x. a + c *\<^sub>R x) ` S) = (\<lambda>x. a + c *\<^sub>R x) ` (convex hull S)"
   by(simp only: image_image[symmetric] convex_hull_scaling convex_hull_translation)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Convexity of cone hulls\<close>
 
 lemma convex_cone_hull:
   assumes "convex S"
   shows "convex (cone hull S)"
 proof (rule convexI)
   fix x y
   assume xy: "x \<in> cone hull S" "y \<in> cone hull S"
   then have "S \<noteq> {}"
     using cone_hull_empty_iff[of S] by auto
   fix u v :: real
   assume uv: "u \<ge> 0" "v \<ge> 0" "u + v = 1"
   then have *: "u *\<^sub>R x \<in> cone hull S" "v *\<^sub>R y \<in> cone hull S"
     using cone_cone_hull[of S] xy cone_def[of "cone hull S"] by auto
   from * obtain cx :: real and xx where x: "u *\<^sub>R x = cx *\<^sub>R xx" "cx \<ge> 0" "xx \<in> S"
     using cone_hull_expl[of S] by auto
   from * obtain cy :: real and yy where y: "v *\<^sub>R y = cy *\<^sub>R yy" "cy \<ge> 0" "yy \<in> S"
     using cone_hull_expl[of S] by auto
   {
     assume "cx + cy \<le> 0"
     then have "u *\<^sub>R x = 0" and "v *\<^sub>R y = 0"
       using x y by auto
     then have "u *\<^sub>R x + v *\<^sub>R y = 0"
       by auto
     then have "u *\<^sub>R x + v *\<^sub>R y \<in> cone hull S"
       using cone_hull_contains_0[of S] \<open>S \<noteq> {}\<close> by auto
   }
   moreover
   {
     assume "cx + cy > 0"
     then have "(cx / (cx + cy)) *\<^sub>R xx + (cy / (cx + cy)) *\<^sub>R yy \<in> S"
       using assms mem_convex_alt[of S xx yy cx cy] x y by auto
     then have "cx *\<^sub>R xx + cy *\<^sub>R yy \<in> cone hull S"
       using mem_cone_hull[of "(cx/(cx+cy)) *\<^sub>R xx + (cy/(cx+cy)) *\<^sub>R yy" S "cx+cy"] \<open>cx+cy>0\<close>
       by (auto simp: scaleR_right_distrib)
     then have "u *\<^sub>R x + v *\<^sub>R y \<in> cone hull S"
       using x y by auto
   }
   moreover have "cx + cy \<le> 0 \<or> cx + cy > 0" by auto
   ultimately show "u *\<^sub>R x + v *\<^sub>R y \<in> cone hull S" by blast
 qed
 
 lemma cone_convex_hull:
   assumes "cone S"
   shows "cone (convex hull S)"
 proof (cases "S = {}")
   case True
   then show ?thesis by auto
 next
   case False
   then have *: "0 \<in> S \<and> (\<forall>c. c > 0 \<longrightarrow> (*\<^sub>R) c ` S = S)"
     using cone_iff[of S] assms by auto
   {
     fix c :: real
     assume "c > 0"
     then have "(*\<^sub>R) c ` (convex hull S) = convex hull ((*\<^sub>R) c ` S)"
       using convex_hull_scaling[of _ S] by auto
     also have "\<dots> = convex hull S"
       using * \<open>c > 0\<close> by auto
     finally have "(*\<^sub>R) c ` (convex hull S) = convex hull S"
       by auto
   }
   then have "0 \<in> convex hull S" "\<And>c. c > 0 \<Longrightarrow> ((*\<^sub>R) c ` (convex hull S)) = (convex hull S)"
     using * hull_subset[of S convex] by auto
   then show ?thesis
     using \<open>S \<noteq> {}\<close> cone_iff[of "convex hull S"] by auto
 qed
 
 subsection \<open>Radon's theorem\<close>
 
 text "Formalized by Lars Schewe."
 
 lemma Radon_ex_lemma:
   assumes "finite c" "affine_dependent c"
   shows "\<exists>u. sum u c = 0 \<and> (\<exists>v\<in>c. u v \<noteq> 0) \<and> sum (\<lambda>v. u v *\<^sub>R v) c = 0"
 proof -
   from assms(2)[unfolded affine_dependent_explicit]
   obtain s u where
       "finite s" "s \<subseteq> c" "sum u s = 0" "\<exists>v\<in>s. u v \<noteq> 0" "(\<Sum>v\<in>s. u v *\<^sub>R v) = 0"
     by blast
   then show ?thesis
     apply (rule_tac x="\<lambda>v. if v\<in>s then u v else 0" in exI)
     unfolding if_smult scaleR_zero_left and sum.inter_restrict[OF assms(1), symmetric]
     apply (auto simp: Int_absorb1)
     done
 qed
 
 lemma Radon_s_lemma:
   assumes "finite s"
     and "sum f s = (0::real)"
   shows "sum f {x\<in>s. 0 < f x} = - sum f {x\<in>s. f x < 0}"
 proof -
   have *: "\<And>x. (if f x < 0 then f x else 0) + (if 0 < f x then f x else 0) = f x"
     by auto
   show ?thesis
     unfolding add_eq_0_iff[symmetric] and sum.inter_filter[OF assms(1)]
       and sum.distrib[symmetric] and *
     using assms(2)
     by assumption
 qed
 
 lemma Radon_v_lemma:
   assumes "finite s"
     and "sum f s = 0"
     and "\<forall>x. g x = (0::real) \<longrightarrow> f x = (0::'a::euclidean_space)"
   shows "(sum f {x\<in>s. 0 < g x}) = - sum f {x\<in>s. g x < 0}"
 proof -
   have *: "\<And>x. (if 0 < g x then f x else 0) + (if g x < 0 then f x else 0) = f x"
     using assms(3) by auto
   show ?thesis
     unfolding eq_neg_iff_add_eq_0 and sum.inter_filter[OF assms(1)]
       and sum.distrib[symmetric] and *
     using assms(2)
     apply assumption
     done
 qed
 
 lemma Radon_partition:
   assumes "finite c" "affine_dependent c"
   shows "\<exists>m p. m \<inter> p = {} \<and> m \<union> p = c \<and> (convex hull m) \<inter> (convex hull p) \<noteq> {}"
 proof -
   obtain u v where uv: "sum u c = 0" "v\<in>c" "u v \<noteq> 0"  "(\<Sum>v\<in>c. u v *\<^sub>R v) = 0"
     using Radon_ex_lemma[OF assms] by auto
   have fin: "finite {x \<in> c. 0 < u x}" "finite {x \<in> c. 0 > u x}"
     using assms(1) by auto
   define z  where "z = inverse (sum u {x\<in>c. u x > 0}) *\<^sub>R sum (\<lambda>x. u x *\<^sub>R x) {x\<in>c. u x > 0}"
   have "sum u {x \<in> c. 0 < u x} \<noteq> 0"
   proof (cases "u v \<ge> 0")
     case False
     then have "u v < 0" by auto
     then show ?thesis
     proof (cases "\<exists>w\<in>{x \<in> c. 0 < u x}. u w > 0")
       case True
       then show ?thesis
         using sum_nonneg_eq_0_iff[of _ u, OF fin(1)] by auto
     next
       case False
       then have "sum u c \<le> sum (\<lambda>x. if x=v then u v else 0) c"
         apply (rule_tac sum_mono, auto)
         done
       then show ?thesis
         unfolding sum.delta[OF assms(1)] using uv(2) and \<open>u v < 0\<close> and uv(1) by auto
     qed
   qed (insert sum_nonneg_eq_0_iff[of _ u, OF fin(1)] uv(2-3), auto)
 
   then have *: "sum u {x\<in>c. u x > 0} > 0"
     unfolding less_le
     apply (rule_tac conjI)
     apply (rule_tac sum_nonneg, auto)
     done
   moreover have "sum u ({x \<in> c. 0 < u x} \<union> {x \<in> c. u x < 0}) = sum u c"
     "(\<Sum>x\<in>{x \<in> c. 0 < u x} \<union> {x \<in> c. u x < 0}. u x *\<^sub>R x) = (\<Sum>x\<in>c. u x *\<^sub>R x)"
     using assms(1)
     apply (rule_tac[!] sum.mono_neutral_left, auto)
     done
   then have "sum u {x \<in> c. 0 < u x} = - sum u {x \<in> c. 0 > u x}"
     "(\<Sum>x\<in>{x \<in> c. 0 < u x}. u x *\<^sub>R x) = - (\<Sum>x\<in>{x \<in> c. 0 > u x}. u x *\<^sub>R x)"
     unfolding eq_neg_iff_add_eq_0
     using uv(1,4)
     by (auto simp: sum.union_inter_neutral[OF fin, symmetric])
   moreover have "\<forall>x\<in>{v \<in> c. u v < 0}. 0 \<le> inverse (sum u {x \<in> c. 0 < u x}) * - u x"
     apply rule
     apply (rule mult_nonneg_nonneg)
     using *
     apply auto
     done
   ultimately have "z \<in> convex hull {v \<in> c. u v \<le> 0}"
     unfolding convex_hull_explicit mem_Collect_eq
     apply (rule_tac x="{v \<in> c. u v < 0}" in exI)
     apply (rule_tac x="\<lambda>y. inverse (sum u {x\<in>c. u x > 0}) * - u y" in exI)
     using assms(1) unfolding scaleR_scaleR[symmetric] scaleR_right.sum [symmetric] and z_def
     apply (auto simp: sum_negf sum_distrib_left[symmetric])
     done
   moreover have "\<forall>x\<in>{v \<in> c. 0 < u v}. 0 \<le> inverse (sum u {x \<in> c. 0 < u x}) * u x"
     apply rule
     apply (rule mult_nonneg_nonneg)
     using *
     apply auto
     done
   then have "z \<in> convex hull {v \<in> c. u v > 0}"
     unfolding convex_hull_explicit mem_Collect_eq
     apply (rule_tac x="{v \<in> c. 0 < u v}" in exI)
     apply (rule_tac x="\<lambda>y. inverse (sum u {x\<in>c. u x > 0}) * u y" in exI)
     using assms(1)
     unfolding scaleR_scaleR[symmetric] scaleR_right.sum [symmetric] and z_def
     using *
     apply (auto simp: sum_negf sum_distrib_left[symmetric])
     done
   ultimately show ?thesis
     apply (rule_tac x="{v\<in>c. u v \<le> 0}" in exI)
     apply (rule_tac x="{v\<in>c. u v > 0}" in exI, auto)
     done
 qed
 
 theorem Radon:
   assumes "affine_dependent c"
   obtains m p where "m \<subseteq> c" "p \<subseteq> c" "m \<inter> p = {}" "(convex hull m) \<inter> (convex hull p) \<noteq> {}"
 proof -
   from assms[unfolded affine_dependent_explicit]
   obtain s u where
       "finite s" "s \<subseteq> c" "sum u s = 0" "\<exists>v\<in>s. u v \<noteq> 0" "(\<Sum>v\<in>s. u v *\<^sub>R v) = 0"
     by blast
   then have *: "finite s" "affine_dependent s" and s: "s \<subseteq> c"
     unfolding affine_dependent_explicit by auto
   from Radon_partition[OF *]
   obtain m p where "m \<inter> p = {}" "m \<union> p = s" "convex hull m \<inter> convex hull p \<noteq> {}"
     by blast
   then show ?thesis
     apply (rule_tac that[of p m])
     using s
     apply auto
     done
 qed
 
 
 subsection \<open>Helly's theorem\<close>
 
 lemma Helly_induct:
   fixes f :: "'a::euclidean_space set set"
   assumes "card f = n"
     and "n \<ge> DIM('a) + 1"
     and "\<forall>s\<in>f. convex s" "\<forall>t\<subseteq>f. card t = DIM('a) + 1 \<longrightarrow> \<Inter>t \<noteq> {}"
   shows "\<Inter>f \<noteq> {}"
   using assms
 proof (induction n arbitrary: f)
   case 0
   then show ?case by auto
 next
   case (Suc n)
   have "finite f"
     using \<open>card f = Suc n\<close> by (auto intro: card_ge_0_finite)
   show "\<Inter>f \<noteq> {}"
   proof (cases "n = DIM('a)")
     case True
     then show ?thesis
       by (simp add: Suc.prems(1) Suc.prems(4))
   next
     case False
     have "\<Inter>(f - {s}) \<noteq> {}" if "s \<in> f" for s
     proof (rule Suc.IH[rule_format])
       show "card (f - {s}) = n"
         by (simp add: Suc.prems(1) \<open>finite f\<close> that)
       show "DIM('a) + 1 \<le> n"
         using False Suc.prems(2) by linarith
       show "\<And>t. \<lbrakk>t \<subseteq> f - {s}; card t = DIM('a) + 1\<rbrakk> \<Longrightarrow> \<Inter>t \<noteq> {}"
         by (simp add: Suc.prems(4) subset_Diff_insert)
     qed (use Suc in auto)
     then have "\<forall>s\<in>f. \<exists>x. x \<in> \<Inter>(f - {s})"
       by blast
     then obtain X where X: "\<And>s. s\<in>f \<Longrightarrow> X s \<in> \<Inter>(f - {s})"
       by metis
     show ?thesis
     proof (cases "inj_on X f")
       case False
       then obtain s t where "s\<noteq>t" and st: "s\<in>f" "t\<in>f" "X s = X t"
         unfolding inj_on_def by auto
       then have *: "\<Inter>f = \<Inter>(f - {s}) \<inter> \<Inter>(f - {t})" by auto
       show ?thesis
         by (metis "*" X disjoint_iff_not_equal st)
     next
       case True
       then obtain m p where mp: "m \<inter> p = {}" "m \<union> p = X ` f" "convex hull m \<inter> convex hull p \<noteq> {}"
         using Radon_partition[of "X ` f"] and affine_dependent_biggerset[of "X ` f"]
         unfolding card_image[OF True] and \<open>card f = Suc n\<close>
         using Suc(3) \<open>finite f\<close> and False
         by auto
       have "m \<subseteq> X ` f" "p \<subseteq> X ` f"
         using mp(2) by auto
       then obtain g h where gh:"m = X ` g" "p = X ` h" "g \<subseteq> f" "h \<subseteq> f"
         unfolding subset_image_iff by auto
       then have "f \<union> (g \<union> h) = f" by auto
       then have f: "f = g \<union> h"
         using inj_on_Un_image_eq_iff[of X f "g \<union> h"] and True
         unfolding mp(2)[unfolded image_Un[symmetric] gh]
         by auto
       have *: "g \<inter> h = {}"
         using mp(1)
         unfolding gh
         using inj_on_image_Int[OF True gh(3,4)]
         by auto
       have "convex hull (X ` h) \<subseteq> \<Inter>g" "convex hull (X ` g) \<subseteq> \<Inter>h"
         by (rule hull_minimal; use X * f in \<open>auto simp: Suc.prems(3) convex_Inter\<close>)+
       then show ?thesis
         unfolding f using mp(3)[unfolded gh] by blast
     qed
   qed 
 qed
 
 theorem Helly:
   fixes f :: "'a::euclidean_space set set"
   assumes "card f \<ge> DIM('a) + 1" "\<forall>s\<in>f. convex s"
     and "\<And>t. \<lbrakk>t\<subseteq>f; card t = DIM('a) + 1\<rbrakk> \<Longrightarrow> \<Inter>t \<noteq> {}"
   shows "\<Inter>f \<noteq> {}"
   apply (rule Helly_induct)
   using assms
   apply auto
   done
 
 subsection \<open>Epigraphs of convex functions\<close>
 
 definition\<^marker>\<open>tag important\<close> "epigraph S (f :: _ \<Rightarrow> real) = {xy. fst xy \<in> S \<and> f (fst xy) \<le> snd xy}"
 
 lemma mem_epigraph: "(x, y) \<in> epigraph S f \<longleftrightarrow> x \<in> S \<and> f x \<le> y"
   unfolding epigraph_def by auto
 
 lemma convex_epigraph: "convex (epigraph S f) \<longleftrightarrow> convex_on S f \<and> convex S"
 proof safe
   assume L: "convex (epigraph S f)"
   then show "convex_on S f"
     by (auto simp: convex_def convex_on_def epigraph_def)
   show "convex S"
     using L
     apply (clarsimp simp: convex_def convex_on_def epigraph_def)
     apply (erule_tac x=x in allE)
     apply (erule_tac x="f x" in allE, safe)
     apply (erule_tac x=y in allE)
     apply (erule_tac x="f y" in allE)
     apply (auto simp: )
     done
 next
   assume "convex_on S f" "convex S"
   then show "convex (epigraph S f)"
     unfolding convex_def convex_on_def epigraph_def
     apply safe
      apply (rule_tac [2] y="u * f a + v * f aa" in order_trans)
       apply (auto intro!:mult_left_mono add_mono)
     done
 qed
 
 lemma convex_epigraphI: "convex_on S f \<Longrightarrow> convex S \<Longrightarrow> convex (epigraph S f)"
   unfolding convex_epigraph by auto
 
 lemma convex_epigraph_convex: "convex S \<Longrightarrow> convex_on S f \<longleftrightarrow> convex(epigraph S f)"
   by (simp add: convex_epigraph)
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Use this to derive general bound property of convex function\<close>
 
 lemma convex_on:
   assumes "convex S"
   shows "convex_on S f \<longleftrightarrow>
     (\<forall>k u x. (\<forall>i\<in>{1..k::nat}. 0 \<le> u i \<and> x i \<in> S) \<and> sum u {1..k} = 1 \<longrightarrow>
       f (sum (\<lambda>i. u i *\<^sub>R x i) {1..k}) \<le> sum (\<lambda>i. u i * f(x i)) {1..k})"
 
   unfolding convex_epigraph_convex[OF assms] convex epigraph_def Ball_def mem_Collect_eq
   unfolding fst_sum snd_sum fst_scaleR snd_scaleR
   apply safe
     apply (drule_tac x=k in spec)
     apply (drule_tac x=u in spec)
     apply (drule_tac x="\<lambda>i. (x i, f (x i))" in spec)
     apply simp
   using assms[unfolded convex] apply simp
   apply (rule_tac y="\<Sum>i = 1..k. u i * f (fst (x i))" in order_trans, force)
    apply (rule sum_mono)
    apply (erule_tac x=i in allE)
   unfolding real_scaleR_def
    apply (rule mult_left_mono)
   using assms[unfolded convex] apply auto
   done
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>A bound within a convex hull\<close>
 
 lemma convex_on_convex_hull_bound:
   assumes "convex_on (convex hull s) f"
     and "\<forall>x\<in>s. f x \<le> b"
   shows "\<forall>x\<in> convex hull s. f x \<le> b"
 proof
   fix x
   assume "x \<in> convex hull s"
   then obtain k u v where
     obt: "\<forall>i\<in>{1..k::nat}. 0 \<le> u i \<and> v i \<in> s" "sum u {1..k} = 1" "(\<Sum>i = 1..k. u i *\<^sub>R v i) = x"
     unfolding convex_hull_indexed mem_Collect_eq by auto
   have "(\<Sum>i = 1..k. u i * f (v i)) \<le> b"
     using sum_mono[of "{1..k}" "\<lambda>i. u i * f (v i)" "\<lambda>i. u i * b"]
     unfolding sum_distrib_right[symmetric] obt(2) mult_1
     apply (drule_tac meta_mp)
     apply (rule mult_left_mono)
     using assms(2) obt(1)
     apply auto
     done
   then show "f x \<le> b"
     using assms(1)[unfolded convex_on[OF convex_convex_hull], rule_format, of k u v]
     unfolding obt(2-3)
     using obt(1) and hull_subset[unfolded subset_eq, rule_format, of _ s]
     by auto
 qed
 
 lemma inner_sum_Basis[simp]: "i \<in> Basis \<Longrightarrow> (\<Sum>Basis) \<bullet> i = 1"
   by (simp add: inner_sum_left sum.If_cases inner_Basis)
 
 lemma convex_set_plus:
   assumes "convex S" and "convex T" shows "convex (S + T)"
 proof -
   have "convex (\<Union>x\<in> S. \<Union>y \<in> T. {x + y})"
     using assms by (rule convex_sums)
   moreover have "(\<Union>x\<in> S. \<Union>y \<in> T. {x + y}) = S + T"
     unfolding set_plus_def by auto
   finally show "convex (S + T)" .
 qed
 
 lemma convex_set_sum:
   assumes "\<And>i. i \<in> A \<Longrightarrow> convex (B i)"
   shows "convex (\<Sum>i\<in>A. B i)"
 proof (cases "finite A")
   case True then show ?thesis using assms
     by induct (auto simp: convex_set_plus)
 qed auto
 
 lemma finite_set_sum:
   assumes "finite A" and "\<forall>i\<in>A. finite (B i)" shows "finite (\<Sum>i\<in>A. B i)"
   using assms by (induct set: finite, simp, simp add: finite_set_plus)
 
 lemma box_eq_set_sum_Basis:
   shows "{x. \<forall>i\<in>Basis. x\<bullet>i \<in> B i} = (\<Sum>i\<in>Basis. image (\<lambda>x. x *\<^sub>R i) (B i))"
   apply (subst set_sum_alt [OF finite_Basis], safe)
   apply (fast intro: euclidean_representation [symmetric])
   apply (subst inner_sum_left)
 apply (rename_tac f)
   apply (subgoal_tac "(\<Sum>x\<in>Basis. f x \<bullet> i) = f i \<bullet> i")
   apply (drule (1) bspec)
   apply clarsimp
   apply (frule sum.remove [OF finite_Basis])
   apply (erule trans, simp)
   apply (rule sum.neutral, clarsimp)
   apply (frule_tac x=i in bspec, assumption)
   apply (drule_tac x=x in bspec, assumption, clarsimp)
   apply (cut_tac u=x and v=i in inner_Basis, assumption+)
   apply (rule ccontr, simp)
   done
 
 lemma convex_hull_set_sum:
   "convex hull (\<Sum>i\<in>A. B i) = (\<Sum>i\<in>A. convex hull (B i))"
 proof (cases "finite A")
   assume "finite A" then show ?thesis
     by (induct set: finite, simp, simp add: convex_hull_set_plus)
 qed simp
 
 
 end
\ No newline at end of file
diff --git a/src/HOL/Analysis/Determinants.thy b/src/HOL/Analysis/Determinants.thy
--- a/src/HOL/Analysis/Determinants.thy
+++ b/src/HOL/Analysis/Determinants.thy
@@ -1,1123 +1,1123 @@
 (*  Title:      HOL/Analysis/Determinants.thy
     Author:     Amine Chaieb, University of Cambridge; proofs reworked by LCP
 *)
 
-section \<open>Traces, Determinant of square matrices and some properties\<close>
+section \<open>Traces and Determinants of Square Matrices\<close>
 
 theory Determinants
 imports
   Cartesian_Space
   "HOL-Library.Permutations"
 begin
 
 subsection  \<open>Trace\<close>
 
 definition\<^marker>\<open>tag important\<close>  trace :: "'a::semiring_1^'n^'n \<Rightarrow> 'a"
   where "trace A = sum (\<lambda>i. ((A$i)$i)) (UNIV::'n set)"
 
 lemma  trace_0: "trace (mat 0) = 0"
   by (simp add: trace_def mat_def)
 
 lemma  trace_I: "trace (mat 1 :: 'a::semiring_1^'n^'n) = of_nat(CARD('n))"
   by (simp add: trace_def mat_def)
 
 lemma  trace_add: "trace ((A::'a::comm_semiring_1^'n^'n) + B) = trace A + trace B"
   by (simp add: trace_def sum.distrib)
 
 lemma  trace_sub: "trace ((A::'a::comm_ring_1^'n^'n) - B) = trace A - trace B"
   by (simp add: trace_def sum_subtractf)
 
 lemma  trace_mul_sym: "trace ((A::'a::comm_semiring_1^'n^'m) ** B) = trace (B**A)"
   apply (simp add: trace_def matrix_matrix_mult_def)
   apply (subst sum.swap)
   apply (simp add: mult.commute)
   done
 
 subsubsection\<^marker>\<open>tag important\<close>  \<open>Definition of determinant\<close>
 
 definition\<^marker>\<open>tag important\<close>  det:: "'a::comm_ring_1^'n^'n \<Rightarrow> 'a" where
   "det A =
     sum (\<lambda>p. of_int (sign p) * prod (\<lambda>i. A$i$p i) (UNIV :: 'n set))
       {p. p permutes (UNIV :: 'n set)}"
 
 text \<open>Basic determinant properties\<close>
 
 lemma  det_transpose [simp]: "det (transpose A) = det (A::'a::comm_ring_1 ^'n^'n)"
 proof -
   let ?di = "\<lambda>A i j. A$i$j"
   let ?U = "(UNIV :: 'n set)"
   have fU: "finite ?U" by simp
   {
     fix p
     assume p: "p \<in> {p. p permutes ?U}"
     from p have pU: "p permutes ?U"
       by blast
     have sth: "sign (inv p) = sign p"
       by (metis sign_inverse fU p mem_Collect_eq permutation_permutes)
     from permutes_inj[OF pU]
     have pi: "inj_on p ?U"
       by (blast intro: subset_inj_on)
     from permutes_image[OF pU]
     have "prod (\<lambda>i. ?di (transpose A) i (inv p i)) ?U =
       prod (\<lambda>i. ?di (transpose A) i (inv p i)) (p ` ?U)"
       by simp
     also have "\<dots> = prod ((\<lambda>i. ?di (transpose A) i (inv p i)) \<circ> p) ?U"
       unfolding prod.reindex[OF pi] ..
     also have "\<dots> = prod (\<lambda>i. ?di A i (p i)) ?U"
     proof -
       have "((\<lambda>i. ?di (transpose A) i (inv p i)) \<circ> p) i = ?di A i (p i)" if "i \<in> ?U" for i
         using that permutes_inv_o[OF pU] permutes_in_image[OF pU]
         unfolding transpose_def by (simp add: fun_eq_iff)
       then show "prod ((\<lambda>i. ?di (transpose A) i (inv p i)) \<circ> p) ?U = prod (\<lambda>i. ?di A i (p i)) ?U"
         by (auto intro: prod.cong)
     qed
     finally have "of_int (sign (inv p)) * (prod (\<lambda>i. ?di (transpose A) i (inv p i)) ?U) =
       of_int (sign p) * (prod (\<lambda>i. ?di A i (p i)) ?U)"
       using sth by simp
   }
   then show ?thesis
     unfolding det_def
     by (subst sum_permutations_inverse) (blast intro: sum.cong)
 qed
 
 lemma  det_lowerdiagonal:
   fixes A :: "'a::comm_ring_1^('n::{finite,wellorder})^('n::{finite,wellorder})"
   assumes ld: "\<And>i j. i < j \<Longrightarrow> A$i$j = 0"
   shows "det A = prod (\<lambda>i. A$i$i) (UNIV:: 'n set)"
 proof -
   let ?U = "UNIV:: 'n set"
   let ?PU = "{p. p permutes ?U}"
   let ?pp = "\<lambda>p. of_int (sign p) * prod (\<lambda>i. A$i$p i) (UNIV :: 'n set)"
   have fU: "finite ?U"
     by simp
   have id0: "{id} \<subseteq> ?PU"
     by (auto simp: permutes_id)
   have p0: "\<forall>p \<in> ?PU - {id}. ?pp p = 0"
   proof
     fix p
     assume "p \<in> ?PU - {id}"
     then obtain i where i: "p i > i"
       by clarify (meson leI permutes_natset_le)
     from ld[OF i] have "\<exists>i \<in> ?U. A$i$p i = 0"
       by blast
     with prod_zero[OF fU] show "?pp p = 0"
       by force
   qed
   from sum.mono_neutral_cong_left[OF finite_permutations[OF fU] id0 p0] show ?thesis
     unfolding det_def by (simp add: sign_id)
 qed
 
 lemma  det_upperdiagonal:
   fixes A :: "'a::comm_ring_1^'n::{finite,wellorder}^'n::{finite,wellorder}"
   assumes ld: "\<And>i j. i > j \<Longrightarrow> A$i$j = 0"
   shows "det A = prod (\<lambda>i. A$i$i) (UNIV:: 'n set)"
 proof -
   let ?U = "UNIV:: 'n set"
   let ?PU = "{p. p permutes ?U}"
   let ?pp = "(\<lambda>p. of_int (sign p) * prod (\<lambda>i. A$i$p i) (UNIV :: 'n set))"
   have fU: "finite ?U"
     by simp
   have id0: "{id} \<subseteq> ?PU"
     by (auto simp: permutes_id)
   have p0: "\<forall>p \<in> ?PU -{id}. ?pp p = 0"
   proof
     fix p
     assume p: "p \<in> ?PU - {id}"
     then obtain i where i: "p i < i"
       by clarify (meson leI permutes_natset_ge)
     from ld[OF i] have "\<exists>i \<in> ?U. A$i$p i = 0"
       by blast
     with prod_zero[OF fU]  show "?pp p = 0"
       by force
   qed
   from sum.mono_neutral_cong_left[OF finite_permutations[OF fU] id0 p0] show ?thesis
     unfolding det_def by (simp add: sign_id)
 qed
 
 proposition  det_diagonal:
   fixes A :: "'a::comm_ring_1^'n^'n"
   assumes ld: "\<And>i j. i \<noteq> j \<Longrightarrow> A$i$j = 0"
   shows "det A = prod (\<lambda>i. A$i$i) (UNIV::'n set)"
 proof -
   let ?U = "UNIV:: 'n set"
   let ?PU = "{p. p permutes ?U}"
   let ?pp = "\<lambda>p. of_int (sign p) * prod (\<lambda>i. A$i$p i) (UNIV :: 'n set)"
   have fU: "finite ?U" by simp
   from finite_permutations[OF fU] have fPU: "finite ?PU" .
   have id0: "{id} \<subseteq> ?PU"
     by (auto simp: permutes_id)
   have p0: "\<forall>p \<in> ?PU - {id}. ?pp p = 0"
   proof
     fix p
     assume p: "p \<in> ?PU - {id}"
     then obtain i where i: "p i \<noteq> i"
       by fastforce
     with ld have "\<exists>i \<in> ?U. A$i$p i = 0"
       by (metis UNIV_I)
     with prod_zero [OF fU] show "?pp p = 0"
       by force
   qed
   from sum.mono_neutral_cong_left[OF fPU id0 p0] show ?thesis
     unfolding det_def by (simp add: sign_id)
 qed
 
 lemma  det_I [simp]: "det (mat 1 :: 'a::comm_ring_1^'n^'n) = 1"
   by (simp add: det_diagonal mat_def)
 
 lemma  det_0 [simp]: "det (mat 0 :: 'a::comm_ring_1^'n^'n) = 0"
   by (simp add: det_def prod_zero power_0_left)
 
 lemma  det_permute_rows:
   fixes A :: "'a::comm_ring_1^'n^'n"
   assumes p: "p permutes (UNIV :: 'n::finite set)"
   shows "det (\<chi> i. A$p i :: 'a^'n^'n) = of_int (sign p) * det A"
 proof -
   let ?U = "UNIV :: 'n set"
   let ?PU = "{p. p permutes ?U}"
   have *: "(\<Sum>q\<in>?PU. of_int (sign (q \<circ> p)) * (\<Prod>i\<in>?U. A $ p i $ (q \<circ> p) i)) =
            (\<Sum>n\<in>?PU. of_int (sign p) * of_int (sign n) * (\<Prod>i\<in>?U. A $ i $ n i))"
   proof (rule sum.cong)
     fix q
     assume qPU: "q \<in> ?PU"
     have fU: "finite ?U"
       by simp
     from qPU have q: "q permutes ?U"
       by blast
     have "prod (\<lambda>i. A$p i$ (q \<circ> p) i) ?U = prod ((\<lambda>i. A$p i$(q \<circ> p) i) \<circ> inv p) ?U"
       by (simp only: prod.permute[OF permutes_inv[OF p], symmetric])
     also have "\<dots> = prod (\<lambda>i. A $ (p \<circ> inv p) i $ (q \<circ> (p \<circ> inv p)) i) ?U"
       by (simp only: o_def)
     also have "\<dots> = prod (\<lambda>i. A$i$q i) ?U"
       by (simp only: o_def permutes_inverses[OF p])
     finally have thp: "prod (\<lambda>i. A$p i$ (q \<circ> p) i) ?U = prod (\<lambda>i. A$i$q i) ?U"
       by blast
     from p q have pp: "permutation p" and qp: "permutation q"
       by (metis fU permutation_permutes)+
     show "of_int (sign (q \<circ> p)) * prod (\<lambda>i. A$ p i$ (q \<circ> p) i) ?U =
           of_int (sign p) * of_int (sign q) * prod (\<lambda>i. A$i$q i) ?U"
       by (simp only: thp sign_compose[OF qp pp] mult.commute of_int_mult)
   qed auto
   show ?thesis
     apply (simp add: det_def sum_distrib_left mult.assoc[symmetric])
     apply (subst sum_permutations_compose_right[OF p])
     apply (rule *)
     done
 qed
 
 lemma  det_permute_columns:
   fixes A :: "'a::comm_ring_1^'n^'n"
   assumes p: "p permutes (UNIV :: 'n set)"
   shows "det(\<chi> i j. A$i$ p j :: 'a^'n^'n) = of_int (sign p) * det A"
 proof -
   let ?Ap = "\<chi> i j. A$i$ p j :: 'a^'n^'n"
   let ?At = "transpose A"
   have "of_int (sign p) * det A = det (transpose (\<chi> i. transpose A $ p i))"
     unfolding det_permute_rows[OF p, of ?At] det_transpose ..
   moreover
   have "?Ap = transpose (\<chi> i. transpose A $ p i)"
     by (simp add: transpose_def vec_eq_iff)
   ultimately show ?thesis
     by simp
 qed
 
 lemma  det_identical_columns:
   fixes A :: "'a::comm_ring_1^'n^'n"
   assumes jk: "j \<noteq> k"
     and r: "column j A = column k A"
   shows "det A = 0"
 proof -
   let ?U="UNIV::'n set"
   let ?t_jk="Fun.swap j k id"
   let ?PU="{p. p permutes ?U}"
   let ?S1="{p. p\<in>?PU \<and> evenperm p}"
   let ?S2="{(?t_jk \<circ> p) |p. p \<in>?S1}"
   let ?f="\<lambda>p. of_int (sign p) * (\<Prod>i\<in>UNIV. A $ i $ p i)"
   let ?g="\<lambda>p. ?t_jk \<circ> p"
   have g_S1: "?S2 = ?g` ?S1" by auto
   have inj_g: "inj_on ?g ?S1"
   proof (unfold inj_on_def, auto)
     fix x y assume x: "x permutes ?U" and even_x: "evenperm x"
       and y: "y permutes ?U" and even_y: "evenperm y" and eq: "?t_jk \<circ> x = ?t_jk \<circ> y"
     show "x = y" by (metis (hide_lams, no_types) comp_assoc eq id_comp swap_id_idempotent)
   qed
   have tjk_permutes: "?t_jk permutes ?U" unfolding permutes_def swap_id_eq by (auto,metis)
   have tjk_eq: "\<forall>i l. A $ i $ ?t_jk l  =  A $ i $ l"
     using r jk
     unfolding column_def vec_eq_iff swap_id_eq by fastforce
   have sign_tjk: "sign ?t_jk = -1" using sign_swap_id[of j k] jk by auto
   {fix x
     assume x: "x\<in> ?S1"
     have "sign (?t_jk \<circ> x) = sign (?t_jk) * sign x"
       by (metis (lifting) finite_class.finite_UNIV mem_Collect_eq
           permutation_permutes permutation_swap_id sign_compose x)
     also have "\<dots> = - sign x" using sign_tjk by simp
     also have "\<dots> \<noteq> sign x" unfolding sign_def by simp
     finally have "sign (?t_jk \<circ> x) \<noteq> sign x" and "(?t_jk \<circ> x) \<in> ?S2"
       using x by force+
   }
   hence disjoint: "?S1 \<inter> ?S2 = {}"
     by (force simp: sign_def)
   have PU_decomposition: "?PU = ?S1 \<union> ?S2"
   proof (auto)
     fix x
     assume x: "x permutes ?U" and "\<forall>p. p permutes ?U \<longrightarrow> x = Fun.swap j k id \<circ> p \<longrightarrow> \<not> evenperm p"
     then obtain p where p: "p permutes UNIV" and x_eq: "x = Fun.swap j k id \<circ> p"
       and odd_p: "\<not> evenperm p"
       by (metis (mono_tags) id_o o_assoc permutes_compose swap_id_idempotent tjk_permutes)
     thus "evenperm x"
       by (meson evenperm_comp evenperm_swap finite_class.finite_UNIV
           jk permutation_permutes permutation_swap_id)
   next
     fix p assume p: "p permutes ?U"
     show "Fun.swap j k id \<circ> p permutes UNIV" by (metis p permutes_compose tjk_permutes)
   qed
   have "sum ?f ?S2 = sum ((\<lambda>p. of_int (sign p) * (\<Prod>i\<in>UNIV. A $ i $ p i))
   \<circ> (\<circ>) (Fun.swap j k id)) {p \<in> {p. p permutes UNIV}. evenperm p}"
     unfolding g_S1 by (rule sum.reindex[OF inj_g])
   also have "\<dots> = sum (\<lambda>p. of_int (sign (?t_jk \<circ> p)) * (\<Prod>i\<in>UNIV. A $ i $ p i)) ?S1"
     unfolding o_def by (rule sum.cong, auto simp: tjk_eq)
   also have "\<dots> = sum (\<lambda>p. - ?f p) ?S1"
   proof (rule sum.cong, auto)
     fix x assume x: "x permutes ?U"
       and even_x: "evenperm x"
     hence perm_x: "permutation x" and perm_tjk: "permutation ?t_jk"
       using permutation_permutes[of x] permutation_permutes[of ?t_jk] permutation_swap_id
       by (metis finite_code)+
     have "(sign (?t_jk \<circ> x)) = - (sign x)"
       unfolding sign_compose[OF perm_tjk perm_x] sign_tjk by auto
     thus "of_int (sign (?t_jk \<circ> x)) * (\<Prod>i\<in>UNIV. A $ i $ x i)
       = - (of_int (sign x) * (\<Prod>i\<in>UNIV. A $ i $ x i))"
       by auto
   qed
   also have "\<dots>= - sum ?f ?S1" unfolding sum_negf ..
   finally have *: "sum ?f ?S2 = - sum ?f ?S1" .
   have "det A = (\<Sum>p | p permutes UNIV. of_int (sign p) * (\<Prod>i\<in>UNIV. A $ i $ p i))"
     unfolding det_def ..
   also have "\<dots>= sum ?f ?S1 + sum ?f ?S2"
     by (subst PU_decomposition, rule sum.union_disjoint[OF _ _ disjoint], auto)
   also have "\<dots>= sum ?f ?S1 - sum ?f ?S1 " unfolding * by auto
   also have "\<dots>= 0" by simp
   finally show "det A = 0" by simp
 qed
 
 lemma  det_identical_rows:
   fixes A :: "'a::comm_ring_1^'n^'n"
   assumes ij: "i \<noteq> j" and r: "row i A = row j A"
   shows "det A = 0"
   by (metis column_transpose det_identical_columns det_transpose ij r)
 
 lemma  det_zero_row:
   fixes A :: "'a::{idom, ring_char_0}^'n^'n" and F :: "'b::{field}^'m^'m"
   shows "row i A = 0 \<Longrightarrow> det A = 0" and "row j F = 0 \<Longrightarrow> det F = 0"
   by (force simp: row_def det_def vec_eq_iff sign_nz intro!: sum.neutral)+
 
 lemma  det_zero_column:
   fixes A :: "'a::{idom, ring_char_0}^'n^'n" and F :: "'b::{field}^'m^'m"
   shows "column i A = 0 \<Longrightarrow> det A = 0" and "column j F = 0 \<Longrightarrow> det F = 0"
   unfolding atomize_conj atomize_imp
   by (metis det_transpose det_zero_row row_transpose)
 
 lemma  det_row_add:
   fixes a b c :: "'n::finite \<Rightarrow> _ ^ 'n"
   shows "det((\<chi> i. if i = k then a i + b i else c i)::'a::comm_ring_1^'n^'n) =
     det((\<chi> i. if i = k then a i else c i)::'a::comm_ring_1^'n^'n) +
     det((\<chi> i. if i = k then b i else c i)::'a::comm_ring_1^'n^'n)"
   unfolding det_def vec_lambda_beta sum.distrib[symmetric]
 proof (rule sum.cong)
   let ?U = "UNIV :: 'n set"
   let ?pU = "{p. p permutes ?U}"
   let ?f = "(\<lambda>i. if i = k then a i + b i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
   let ?g = "(\<lambda> i. if i = k then a i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
   let ?h = "(\<lambda> i. if i = k then b i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
   fix p
   assume p: "p \<in> ?pU"
   let ?Uk = "?U - {k}"
   from p have pU: "p permutes ?U"
     by blast
   have kU: "?U = insert k ?Uk"
     by blast
   have eq: "prod (\<lambda>i. ?f i $ p i) ?Uk = prod (\<lambda>i. ?g i $ p i) ?Uk"
            "prod (\<lambda>i. ?f i $ p i) ?Uk = prod (\<lambda>i. ?h i $ p i) ?Uk"
     by auto
   have Uk: "finite ?Uk" "k \<notin> ?Uk"
     by auto
   have "prod (\<lambda>i. ?f i $ p i) ?U = prod (\<lambda>i. ?f i $ p i) (insert k ?Uk)"
     unfolding kU[symmetric] ..
   also have "\<dots> = ?f k $ p k * prod (\<lambda>i. ?f i $ p i) ?Uk"
     by (rule prod.insert) auto
   also have "\<dots> = (a k $ p k * prod (\<lambda>i. ?f i $ p i) ?Uk) + (b k$ p k * prod (\<lambda>i. ?f i $ p i) ?Uk)"
     by (simp add: field_simps)
   also have "\<dots> = (a k $ p k * prod (\<lambda>i. ?g i $ p i) ?Uk) + (b k$ p k * prod (\<lambda>i. ?h i $ p i) ?Uk)"
     by (metis eq)
   also have "\<dots> = prod (\<lambda>i. ?g i $ p i) (insert k ?Uk) + prod (\<lambda>i. ?h i $ p i) (insert k ?Uk)"
     unfolding  prod.insert[OF Uk] by simp
   finally have "prod (\<lambda>i. ?f i $ p i) ?U = prod (\<lambda>i. ?g i $ p i) ?U + prod (\<lambda>i. ?h i $ p i) ?U"
     unfolding kU[symmetric] .
   then show "of_int (sign p) * prod (\<lambda>i. ?f i $ p i) ?U =
     of_int (sign p) * prod (\<lambda>i. ?g i $ p i) ?U + of_int (sign p) * prod (\<lambda>i. ?h i $ p i) ?U"
     by (simp add: field_simps)
 qed auto
 
 lemma  det_row_mul:
   fixes a b :: "'n::finite \<Rightarrow> _ ^ 'n"
   shows "det((\<chi> i. if i = k then c *s a i else b i)::'a::comm_ring_1^'n^'n) =
     c * det((\<chi> i. if i = k then a i else b i)::'a::comm_ring_1^'n^'n)"
   unfolding det_def vec_lambda_beta sum_distrib_left
 proof (rule sum.cong)
   let ?U = "UNIV :: 'n set"
   let ?pU = "{p. p permutes ?U}"
   let ?f = "(\<lambda>i. if i = k then c*s a i else b i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
   let ?g = "(\<lambda> i. if i = k then a i else b i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
   fix p
   assume p: "p \<in> ?pU"
   let ?Uk = "?U - {k}"
   from p have pU: "p permutes ?U"
     by blast
   have kU: "?U = insert k ?Uk"
     by blast
   have eq: "prod (\<lambda>i. ?f i $ p i) ?Uk = prod (\<lambda>i. ?g i $ p i) ?Uk"
     by auto
   have Uk: "finite ?Uk" "k \<notin> ?Uk"
     by auto
   have "prod (\<lambda>i. ?f i $ p i) ?U = prod (\<lambda>i. ?f i $ p i) (insert k ?Uk)"
     unfolding kU[symmetric] ..
   also have "\<dots> = ?f k $ p k  * prod (\<lambda>i. ?f i $ p i) ?Uk"
     by (rule prod.insert) auto
   also have "\<dots> = (c*s a k) $ p k * prod (\<lambda>i. ?f i $ p i) ?Uk"
     by (simp add: field_simps)
   also have "\<dots> = c* (a k $ p k * prod (\<lambda>i. ?g i $ p i) ?Uk)"
     unfolding eq by (simp add: ac_simps)
   also have "\<dots> = c* (prod (\<lambda>i. ?g i $ p i) (insert k ?Uk))"
     unfolding prod.insert[OF Uk] by simp
   finally have "prod (\<lambda>i. ?f i $ p i) ?U = c* (prod (\<lambda>i. ?g i $ p i) ?U)"
     unfolding kU[symmetric] .
   then show "of_int (sign p) * prod (\<lambda>i. ?f i $ p i) ?U = c * (of_int (sign p) * prod (\<lambda>i. ?g i $ p i) ?U)"
     by (simp add: field_simps)
 qed auto
 
 lemma  det_row_0:
   fixes b :: "'n::finite \<Rightarrow> _ ^ 'n"
   shows "det((\<chi> i. if i = k then 0 else b i)::'a::comm_ring_1^'n^'n) = 0"
   using det_row_mul[of k 0 "\<lambda>i. 1" b]
   apply simp
   apply (simp only: vector_smult_lzero)
   done
 
 lemma  det_row_operation:
   fixes A :: "'a::{comm_ring_1}^'n^'n"
   assumes ij: "i \<noteq> j"
   shows "det (\<chi> k. if k = i then row i A + c *s row j A else row k A) = det A"
 proof -
   let ?Z = "(\<chi> k. if k = i then row j A else row k A) :: 'a ^'n^'n"
   have th: "row i ?Z = row j ?Z" by (vector row_def)
   have th2: "((\<chi> k. if k = i then row i A else row k A) :: 'a^'n^'n) = A"
     by (vector row_def)
   show ?thesis
     unfolding det_row_add [of i] det_row_mul[of i] det_identical_rows[OF ij th] th2
     by simp
 qed
 
 lemma  det_row_span:
   fixes A :: "'a::{field}^'n^'n"
   assumes x: "x \<in> vec.span {row j A |j. j \<noteq> i}"
   shows "det (\<chi> k. if k = i then row i A + x else row k A) = det A"
   using x
 proof (induction rule: vec.span_induct_alt)
   case base
   have "(if k = i then row i A + 0 else row k A) = row k A" for k
     by simp
   then show ?case
     by (simp add: row_def)
 next
   case (step c z y)
   then obtain j where j: "z = row j A" "i \<noteq> j"
     by blast
   let ?w = "row i A + y"
   have th0: "row i A + (c*s z + y) = ?w + c*s z"
     by vector
   let ?d = "\<lambda>x. det (\<chi> k. if k = i then x else row k A)"
   have thz: "?d z = 0"
     apply (rule det_identical_rows[OF j(2)])
     using j
     apply (vector row_def)
     done
   have "?d (row i A + (c*s z + y)) = ?d (?w + c*s z)"
     unfolding th0 ..
   then have "?d (row i A + (c*s z + y)) = det A"
     unfolding thz step.IH det_row_mul[of i] det_row_add[of i] by simp
   then show ?case
     unfolding scalar_mult_eq_scaleR .
 qed
 
 lemma  matrix_id [simp]: "det (matrix id) = 1"
   by (simp add: matrix_id_mat_1)
 
 proposition  det_matrix_scaleR [simp]: "det (matrix (((*\<^sub>R) r)) :: real^'n^'n) = r ^ CARD('n::finite)"
   apply (subst det_diagonal)
    apply (auto simp: matrix_def mat_def)
   apply (simp add: cart_eq_inner_axis inner_axis_axis)
   done
 
 text \<open>
   May as well do this, though it's a bit unsatisfactory since it ignores
   exact duplicates by considering the rows/columns as a set.
 \<close>
 
 lemma  det_dependent_rows:
   fixes A:: "'a::{field}^'n^'n"
   assumes d: "vec.dependent (rows A)"
   shows "det A = 0"
 proof -
   let ?U = "UNIV :: 'n set"
   from d obtain i where i: "row i A \<in> vec.span (rows A - {row i A})"
     unfolding vec.dependent_def rows_def by blast
   show ?thesis
   proof (cases "\<forall>i j. i \<noteq> j \<longrightarrow> row i A \<noteq> row j A")
     case True
     with i have "vec.span (rows A - {row i A}) \<subseteq> vec.span {row j A |j. j \<noteq> i}"
       by (auto simp: rows_def intro!: vec.span_mono)
     then have "- row i A \<in> vec.span {row j A|j. j \<noteq> i}"
       by (meson i subsetCE vec.span_neg)
     from det_row_span[OF this]
     have "det A = det (\<chi> k. if k = i then 0 *s 1 else row k A)"
       unfolding right_minus vector_smult_lzero ..
     with det_row_mul[of i 0 "\<lambda>i. 1"]
     show ?thesis by simp
   next
     case False
     then obtain j k where jk: "j \<noteq> k" "row j A = row k A"
       by auto
     from det_identical_rows[OF jk] show ?thesis .
   qed
 qed
 
 lemma  det_dependent_columns:
   assumes d: "vec.dependent (columns (A::real^'n^'n))"
   shows "det A = 0"
   by (metis d det_dependent_rows rows_transpose det_transpose)
 
 text \<open>Multilinearity and the multiplication formula\<close>
 
 lemma  Cart_lambda_cong: "(\<And>x. f x = g x) \<Longrightarrow> (vec_lambda f::'a^'n) = (vec_lambda g :: 'a^'n)"
   by auto
 
 lemma  det_linear_row_sum:
   assumes fS: "finite S"
   shows "det ((\<chi> i. if i = k then sum (a i) S else c i)::'a::comm_ring_1^'n^'n) =
     sum (\<lambda>j. det ((\<chi> i. if i = k then a  i j else c i)::'a^'n^'n)) S"
   using fS  by (induct rule: finite_induct; simp add: det_row_0 det_row_add cong: if_cong)
 
 lemma  finite_bounded_functions:
   assumes fS: "finite S"
   shows "finite {f. (\<forall>i \<in> {1.. (k::nat)}. f i \<in> S) \<and> (\<forall>i. i \<notin> {1 .. k} \<longrightarrow> f i = i)}"
 proof (induct k)
   case 0
   have *: "{f. \<forall>i. f i = i} = {id}"
     by auto
   show ?case
     by (auto simp: *)
 next
   case (Suc k)
   let ?f = "\<lambda>(y::nat,g) i. if i = Suc k then y else g i"
   let ?S = "?f ` (S \<times> {f. (\<forall>i\<in>{1..k}. f i \<in> S) \<and> (\<forall>i. i \<notin> {1..k} \<longrightarrow> f i = i)})"
   have "?S = {f. (\<forall>i\<in>{1.. Suc k}. f i \<in> S) \<and> (\<forall>i. i \<notin> {1.. Suc k} \<longrightarrow> f i = i)}"
     apply (auto simp: image_iff)
     apply (rename_tac f)
     apply (rule_tac x="f (Suc k)" in bexI)
     apply (rule_tac x = "\<lambda>i. if i = Suc k then i else f i" in exI, auto)
     done
   with finite_imageI[OF finite_cartesian_product[OF fS Suc.hyps(1)], of ?f]
   show ?case
     by metis
 qed
 
 
 lemma  det_linear_rows_sum_lemma:
   assumes fS: "finite S"
     and fT: "finite T"
   shows "det ((\<chi> i. if i \<in> T then sum (a i) S else c i):: 'a::comm_ring_1^'n^'n) =
     sum (\<lambda>f. det((\<chi> i. if i \<in> T then a i (f i) else c i)::'a^'n^'n))
       {f. (\<forall>i \<in> T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = i)}"
   using fT
 proof (induct T arbitrary: a c set: finite)
   case empty
   have th0: "\<And>x y. (\<chi> i. if i \<in> {} then x i else y i) = (\<chi> i. y i)"
     by vector
   from empty.prems show ?case
     unfolding th0 by (simp add: eq_id_iff)
 next
   case (insert z T a c)
   let ?F = "\<lambda>T. {f. (\<forall>i \<in> T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = i)}"
   let ?h = "\<lambda>(y,g) i. if i = z then y else g i"
   let ?k = "\<lambda>h. (h(z),(\<lambda>i. if i = z then i else h i))"
   let ?s = "\<lambda> k a c f. det((\<chi> i. if i \<in> T then a i (f i) else c i)::'a^'n^'n)"
   let ?c = "\<lambda>j i. if i = z then a i j else c i"
   have thif: "\<And>a b c d. (if a \<or> b then c else d) = (if a then c else if b then c else d)"
     by simp
   have thif2: "\<And>a b c d e. (if a then b else if c then d else e) =
      (if c then (if a then b else d) else (if a then b else e))"
     by simp
   from \<open>z \<notin> T\<close> have nz: "\<And>i. i \<in> T \<Longrightarrow> i \<noteq> z"
     by auto
   have "det (\<chi> i. if i \<in> insert z T then sum (a i) S else c i) =
     det (\<chi> i. if i = z then sum (a i) S else if i \<in> T then sum (a i) S else c i)"
     unfolding insert_iff thif ..
   also have "\<dots> = (\<Sum>j\<in>S. det (\<chi> i. if i \<in> T then sum (a i) S else if i = z then a i j else c i))"
     unfolding det_linear_row_sum[OF fS]
     by (subst thif2) (simp add: nz cong: if_cong)
   finally have tha:
     "det (\<chi> i. if i \<in> insert z T then sum (a i) S else c i) =
      (\<Sum>(j, f)\<in>S \<times> ?F T. det (\<chi> i. if i \<in> T then a i (f i)
                                 else if i = z then a i j
                                 else c i))"
     unfolding insert.hyps unfolding sum.cartesian_product by blast
   show ?case unfolding tha
     using \<open>z \<notin> T\<close>
     by (intro sum.reindex_bij_witness[where i="?k" and j="?h"])
        (auto intro!: cong[OF refl[of det]] simp: vec_eq_iff)
 qed
 
 lemma  det_linear_rows_sum:
   fixes S :: "'n::finite set"
   assumes fS: "finite S"
   shows "det (\<chi> i. sum (a i) S) =
     sum (\<lambda>f. det (\<chi> i. a i (f i) :: 'a::comm_ring_1 ^ 'n^'n)) {f. \<forall>i. f i \<in> S}"
 proof -
   have th0: "\<And>x y. ((\<chi> i. if i \<in> (UNIV:: 'n set) then x i else y i) :: 'a^'n^'n) = (\<chi> i. x i)"
     by vector
   from det_linear_rows_sum_lemma[OF fS, of "UNIV :: 'n set" a, unfolded th0, OF finite]
   show ?thesis by simp
 qed
 
 lemma  matrix_mul_sum_alt:
   fixes A B :: "'a::comm_ring_1^'n^'n"
   shows "A ** B = (\<chi> i. sum (\<lambda>k. A$i$k *s B $ k) (UNIV :: 'n set))"
   by (vector matrix_matrix_mult_def sum_component)
 
 lemma  det_rows_mul:
   "det((\<chi> i. c i *s a i)::'a::comm_ring_1^'n^'n) =
     prod (\<lambda>i. c i) (UNIV:: 'n set) * det((\<chi> i. a i)::'a^'n^'n)"
 proof (simp add: det_def sum_distrib_left cong add: prod.cong, rule sum.cong)
   let ?U = "UNIV :: 'n set"
   let ?PU = "{p. p permutes ?U}"
   fix p
   assume pU: "p \<in> ?PU"
   let ?s = "of_int (sign p)"
   from pU have p: "p permutes ?U"
     by blast
   have "prod (\<lambda>i. c i * a i $ p i) ?U = prod c ?U * prod (\<lambda>i. a i $ p i) ?U"
     unfolding prod.distrib ..
   then show "?s * (\<Prod>xa\<in>?U. c xa * a xa $ p xa) =
     prod c ?U * (?s* (\<Prod>xa\<in>?U. a xa $ p xa))"
     by (simp add: field_simps)
 qed rule
 
 proposition  det_mul:
   fixes A B :: "'a::comm_ring_1^'n^'n"
   shows "det (A ** B) = det A * det B"
 proof -
   let ?U = "UNIV :: 'n set"
   let ?F = "{f. (\<forall>i \<in> ?U. f i \<in> ?U) \<and> (\<forall>i. i \<notin> ?U \<longrightarrow> f i = i)}"
   let ?PU = "{p. p permutes ?U}"
   have "p \<in> ?F" if "p permutes ?U" for p
     by simp
   then have PUF: "?PU \<subseteq> ?F" by blast
   {
     fix f
     assume fPU: "f \<in> ?F - ?PU"
     have fUU: "f ` ?U \<subseteq> ?U"
       using fPU by auto
     from fPU have f: "\<forall>i \<in> ?U. f i \<in> ?U" "\<forall>i. i \<notin> ?U \<longrightarrow> f i = i" "\<not>(\<forall>y. \<exists>!x. f x = y)"
       unfolding permutes_def by auto
 
     let ?A = "(\<chi> i. A$i$f i *s B$f i) :: 'a^'n^'n"
     let ?B = "(\<chi> i. B$f i) :: 'a^'n^'n"
     {
       assume fni: "\<not> inj_on f ?U"
       then obtain i j where ij: "f i = f j" "i \<noteq> j"
         unfolding inj_on_def by blast
       then have "row i ?B = row j ?B"
         by (vector row_def)
       with det_identical_rows[OF ij(2)]
       have "det (\<chi> i. A$i$f i *s B$f i) = 0"
         unfolding det_rows_mul by force
     }
     moreover
     {
       assume fi: "inj_on f ?U"
       from f fi have fith: "\<And>i j. f i = f j \<Longrightarrow> i = j"
         unfolding inj_on_def by metis
       note fs = fi[unfolded surjective_iff_injective_gen[OF finite finite refl fUU, symmetric]]
       have "\<exists>!x. f x = y" for y
         using fith fs by blast
       with f(3) have "det (\<chi> i. A$i$f i *s B$f i) = 0"
         by blast
     }
     ultimately have "det (\<chi> i. A$i$f i *s B$f i) = 0"
       by blast
   }
   then have zth: "\<forall> f\<in> ?F - ?PU. det (\<chi> i. A$i$f i *s B$f i) = 0"
     by simp
   {
     fix p
     assume pU: "p \<in> ?PU"
     from pU have p: "p permutes ?U"
       by blast
     let ?s = "\<lambda>p. of_int (sign p)"
     let ?f = "\<lambda>q. ?s p * (\<Prod>i\<in> ?U. A $ i $ p i) * (?s q * (\<Prod>i\<in> ?U. B $ i $ q i))"
     have "(sum (\<lambda>q. ?s q *
         (\<Prod>i\<in> ?U. (\<chi> i. A $ i $ p i *s B $ p i :: 'a^'n^'n) $ i $ q i)) ?PU) =
       (sum (\<lambda>q. ?s p * (\<Prod>i\<in> ?U. A $ i $ p i) * (?s q * (\<Prod>i\<in> ?U. B $ i $ q i))) ?PU)"
       unfolding sum_permutations_compose_right[OF permutes_inv[OF p], of ?f]
     proof (rule sum.cong)
       fix q
       assume qU: "q \<in> ?PU"
       then have q: "q permutes ?U"
         by blast
       from p q have pp: "permutation p" and pq: "permutation q"
         unfolding permutation_permutes by auto
       have th00: "of_int (sign p) * of_int (sign p) = (1::'a)"
         "\<And>a. of_int (sign p) * (of_int (sign p) * a) = a"
         unfolding mult.assoc[symmetric]
         unfolding of_int_mult[symmetric]
         by (simp_all add: sign_idempotent)
       have ths: "?s q = ?s p * ?s (q \<circ> inv p)"
         using pp pq permutation_inverse[OF pp] sign_inverse[OF pp]
         by (simp add: th00 ac_simps sign_idempotent sign_compose)
       have th001: "prod (\<lambda>i. B$i$ q (inv p i)) ?U = prod ((\<lambda>i. B$i$ q (inv p i)) \<circ> p) ?U"
         by (rule prod.permute[OF p])
       have thp: "prod (\<lambda>i. (\<chi> i. A$i$p i *s B$p i :: 'a^'n^'n) $i $ q i) ?U =
         prod (\<lambda>i. A$i$p i) ?U * prod (\<lambda>i. B$i$ q (inv p i)) ?U"
         unfolding th001 prod.distrib[symmetric] o_def permutes_inverses[OF p]
         apply (rule prod.cong[OF refl])
         using permutes_in_image[OF q]
         apply vector
         done
       show "?s q * prod (\<lambda>i. (((\<chi> i. A$i$p i *s B$p i) :: 'a^'n^'n)$i$q i)) ?U =
         ?s p * (prod (\<lambda>i. A$i$p i) ?U) * (?s (q \<circ> inv p) * prod (\<lambda>i. B$i$(q \<circ> inv p) i) ?U)"
         using ths thp pp pq permutation_inverse[OF pp] sign_inverse[OF pp]
         by (simp add: sign_nz th00 field_simps sign_idempotent sign_compose)
     qed rule
   }
   then have th2: "sum (\<lambda>f. det (\<chi> i. A$i$f i *s B$f i)) ?PU = det A * det B"
     unfolding det_def sum_product
     by (rule sum.cong [OF refl])
   have "det (A**B) = sum (\<lambda>f.  det (\<chi> i. A $ i $ f i *s B $ f i)) ?F"
     unfolding matrix_mul_sum_alt det_linear_rows_sum[OF finite]
     by simp
   also have "\<dots> = sum (\<lambda>f. det (\<chi> i. A$i$f i *s B$f i)) ?PU"
     using sum.mono_neutral_cong_left[OF finite PUF zth, symmetric]
     unfolding det_rows_mul by auto
   finally show ?thesis unfolding th2 .
 qed
 
 
 subsection \<open>Relation to invertibility\<close>
 
 proposition  invertible_det_nz:
   fixes A::"'a::{field}^'n^'n"
   shows "invertible A \<longleftrightarrow> det A \<noteq> 0"
 proof (cases "invertible A")
   case True
   then obtain B :: "'a^'n^'n" where B: "A ** B = mat 1"
     unfolding invertible_right_inverse by blast
   then have "det (A ** B) = det (mat 1 :: 'a^'n^'n)"
     by simp
   then show ?thesis
     by (metis True det_I det_mul mult_zero_left one_neq_zero)
 next
   case False
   let ?U = "UNIV :: 'n set"
   have fU: "finite ?U"
     by simp
   from False obtain c i where c: "sum (\<lambda>i. c i *s row i A) ?U = 0" and iU: "i \<in> ?U" and ci: "c i \<noteq> 0"
     unfolding invertible_right_inverse matrix_right_invertible_independent_rows
     by blast
   have thr0: "- row i A = sum (\<lambda>j. (1/ c i) *s (c j *s row j A)) (?U - {i})"
     unfolding sum_cmul  using c ci
     by (auto simp: sum.remove[OF fU iU] eq_vector_fraction_iff add_eq_0_iff)
   have thr: "- row i A \<in> vec.span {row j A| j. j \<noteq> i}"
     unfolding thr0 by (auto intro: vec.span_base vec.span_scale vec.span_sum)
   let ?B = "(\<chi> k. if k = i then 0 else row k A) :: 'a^'n^'n"
   have thrb: "row i ?B = 0" using iU by (vector row_def)
   have "det A = 0"
     unfolding det_row_span[OF thr, symmetric] right_minus
     unfolding det_zero_row(2)[OF thrb] ..
   then show ?thesis
     by (simp add: False)
 qed
 
 
 lemma  det_nz_iff_inj_gen:
   fixes f :: "'a::field^'n \<Rightarrow> 'a::field^'n"
   assumes "Vector_Spaces.linear (*s) (*s) f"
   shows "det (matrix f) \<noteq> 0 \<longleftrightarrow> inj f"
 proof
   assume "det (matrix f) \<noteq> 0"
   then show "inj f"
     using assms invertible_det_nz inj_matrix_vector_mult by force
 next
   assume "inj f"
   show "det (matrix f) \<noteq> 0"
     using vec.linear_injective_left_inverse [OF assms \<open>inj f\<close>]
     by (metis assms invertible_det_nz invertible_left_inverse matrix_compose_gen matrix_id_mat_1)
 qed
 
 lemma  det_nz_iff_inj:
   fixes f :: "real^'n \<Rightarrow> real^'n"
   assumes "linear f"
   shows "det (matrix f) \<noteq> 0 \<longleftrightarrow> inj f"
   using det_nz_iff_inj_gen[of f] assms
   unfolding linear_matrix_vector_mul_eq .
 
 lemma  det_eq_0_rank:
   fixes A :: "real^'n^'n"
   shows "det A = 0 \<longleftrightarrow> rank A < CARD('n)"
   using invertible_det_nz [of A]
   by (auto simp: matrix_left_invertible_injective invertible_left_inverse less_rank_noninjective)
 
 subsubsection\<^marker>\<open>tag important\<close>  \<open>Invertibility of matrices and corresponding linear functions\<close>
 
 lemma  matrix_left_invertible_gen:
   fixes f :: "'a::field^'m \<Rightarrow> 'a::field^'n"
   assumes "Vector_Spaces.linear (*s) (*s) f"
   shows "((\<exists>B. B ** matrix f = mat 1) \<longleftrightarrow> (\<exists>g. Vector_Spaces.linear (*s) (*s) g \<and> g \<circ> f = id))"
 proof safe
   fix B
   assume 1: "B ** matrix f = mat 1"
   show "\<exists>g. Vector_Spaces.linear (*s) (*s) g \<and> g \<circ> f = id"
   proof (intro exI conjI)
     show "Vector_Spaces.linear (*s) (*s) (\<lambda>y. B *v y)"
       by simp
     show "((*v) B) \<circ> f = id"
       unfolding o_def
       by (metis assms 1 eq_id_iff matrix_vector_mul(1) matrix_vector_mul_assoc matrix_vector_mul_lid)
   qed
 next
   fix g
   assume "Vector_Spaces.linear (*s) (*s) g" "g \<circ> f = id"
   then have "matrix g ** matrix f = mat 1"
     by (metis assms matrix_compose_gen matrix_id_mat_1)
   then show "\<exists>B. B ** matrix f = mat 1" ..
 qed
 
 lemma  matrix_left_invertible:
   "linear f \<Longrightarrow> ((\<exists>B. B ** matrix f = mat 1) \<longleftrightarrow> (\<exists>g. linear g \<and> g \<circ> f = id))" for f::"real^'m \<Rightarrow> real^'n"
   using matrix_left_invertible_gen[of f]
   by (auto simp: linear_matrix_vector_mul_eq)
 
 lemma  matrix_right_invertible_gen:
   fixes f :: "'a::field^'m \<Rightarrow> 'a^'n"
   assumes "Vector_Spaces.linear (*s) (*s) f"
   shows "((\<exists>B. matrix f ** B = mat 1) \<longleftrightarrow> (\<exists>g. Vector_Spaces.linear (*s) (*s) g \<and> f \<circ> g = id))"
 proof safe
   fix B
   assume 1: "matrix f ** B = mat 1"
   show "\<exists>g. Vector_Spaces.linear (*s) (*s) g \<and> f \<circ> g = id"
   proof (intro exI conjI)
     show "Vector_Spaces.linear (*s) (*s) ((*v) B)"
       by simp
     show "f \<circ> (*v) B = id"
       using 1 assms comp_apply eq_id_iff vec.linear_id matrix_id_mat_1 matrix_vector_mul_assoc matrix_works
       by (metis (no_types, hide_lams))
   qed
 next
   fix g
   assume "Vector_Spaces.linear (*s) (*s) g" and "f \<circ> g = id"
   then have "matrix f ** matrix g = mat 1"
     by (metis assms matrix_compose_gen matrix_id_mat_1)
   then show "\<exists>B. matrix f ** B = mat 1" ..
 qed
 
 lemma  matrix_right_invertible:
   "linear f \<Longrightarrow> ((\<exists>B. matrix f ** B = mat 1) \<longleftrightarrow> (\<exists>g. linear g \<and> f \<circ> g = id))" for f::"real^'m \<Rightarrow> real^'n"
   using matrix_right_invertible_gen[of f]
   by (auto simp: linear_matrix_vector_mul_eq)
 
 lemma  matrix_invertible_gen:
   fixes f :: "'a::field^'m \<Rightarrow> 'a::field^'n"
   assumes "Vector_Spaces.linear (*s) (*s) f"
   shows  "invertible (matrix f) \<longleftrightarrow> (\<exists>g. Vector_Spaces.linear (*s) (*s) g \<and> f \<circ> g = id \<and> g \<circ> f = id)"
     (is "?lhs = ?rhs")
 proof
   assume ?lhs then show ?rhs
     by (metis assms invertible_def left_right_inverse_eq matrix_left_invertible_gen matrix_right_invertible_gen)
 next
   assume ?rhs then show ?lhs
     by (metis assms invertible_def matrix_compose_gen matrix_id_mat_1)
 qed
 
 lemma  matrix_invertible:
   "linear f \<Longrightarrow> invertible (matrix f) \<longleftrightarrow> (\<exists>g. linear g \<and> f \<circ> g = id \<and> g \<circ> f = id)"
   for f::"real^'m \<Rightarrow> real^'n"
   using matrix_invertible_gen[of f]
   by (auto simp: linear_matrix_vector_mul_eq)
 
 lemma  invertible_eq_bij:
   fixes m :: "'a::field^'m^'n"
   shows "invertible m \<longleftrightarrow> bij ((*v) m)"
   using matrix_invertible_gen[OF matrix_vector_mul_linear_gen, of m, simplified matrix_of_matrix_vector_mul]
   by (metis bij_betw_def left_right_inverse_eq matrix_vector_mul_linear_gen o_bij
       vec.linear_injective_left_inverse vec.linear_surjective_right_inverse)
 
 
 subsection \<open>Cramer's rule\<close>
 
 lemma  cramer_lemma_transpose:
   fixes A:: "'a::{field}^'n^'n"
     and x :: "'a::{field}^'n"
   shows "det ((\<chi> i. if i = k then sum (\<lambda>i. x$i *s row i A) (UNIV::'n set)
                              else row i A)::'a::{field}^'n^'n) = x$k * det A"
   (is "?lhs = ?rhs")
 proof -
   let ?U = "UNIV :: 'n set"
   let ?Uk = "?U - {k}"
   have U: "?U = insert k ?Uk"
     by blast
   have kUk: "k \<notin> ?Uk"
     by simp
   have th00: "\<And>k s. x$k *s row k A + s = (x$k - 1) *s row k A + row k A + s"
     by (vector field_simps)
   have th001: "\<And>f k . (\<lambda>x. if x = k then f k else f x) = f"
     by auto
   have "(\<chi> i. row i A) = A" by (vector row_def)
   then have thd1: "det (\<chi> i. row i A) = det A"
     by simp
   have thd0: "det (\<chi> i. if i = k then row k A + (\<Sum>i \<in> ?Uk. x $ i *s row i A) else row i A) = det A"
     by (force intro: det_row_span vec.span_sum vec.span_scale vec.span_base)
   show "?lhs = x$k * det A"
     apply (subst U)
     unfolding sum.insert[OF finite kUk]
     apply (subst th00)
     unfolding add.assoc
     apply (subst det_row_add)
     unfolding thd0
     unfolding det_row_mul
     unfolding th001[of k "\<lambda>i. row i A"]
     unfolding thd1
     apply (simp add: field_simps)
     done
 qed
 
 proposition  cramer_lemma:
   fixes A :: "'a::{field}^'n^'n"
   shows "det((\<chi> i j. if j = k then (A *v x)$i else A$i$j):: 'a::{field}^'n^'n) = x$k * det A"
 proof -
   let ?U = "UNIV :: 'n set"
   have *: "\<And>c. sum (\<lambda>i. c i *s row i (transpose A)) ?U = sum (\<lambda>i. c i *s column i A) ?U"
     by (auto intro: sum.cong)
   show ?thesis
     unfolding matrix_mult_sum
     unfolding cramer_lemma_transpose[of k x "transpose A", unfolded det_transpose, symmetric]
     unfolding *[of "\<lambda>i. x$i"]
     apply (subst det_transpose[symmetric])
     apply (rule cong[OF refl[of det]])
     apply (vector transpose_def column_def row_def)
     done
 qed
 
 proposition  cramer:
   fixes A ::"'a::{field}^'n^'n"
   assumes d0: "det A \<noteq> 0"
   shows "A *v x = b \<longleftrightarrow> x = (\<chi> k. det(\<chi> i j. if j=k then b$i else A$i$j) / det A)"
 proof -
   from d0 obtain B where B: "A ** B = mat 1" "B ** A = mat 1"
     unfolding invertible_det_nz[symmetric] invertible_def
     by blast
   have "(A ** B) *v b = b"
     by (simp add: B)
   then have "A *v (B *v b) = b"
     by (simp add: matrix_vector_mul_assoc)
   then have xe: "\<exists>x. A *v x = b"
     by blast
   {
     fix x
     assume x: "A *v x = b"
     have "x = (\<chi> k. det(\<chi> i j. if j=k then b$i else A$i$j) / det A)"
       unfolding x[symmetric]
       using d0 by (simp add: vec_eq_iff cramer_lemma field_simps)
   }
   with xe show ?thesis
     by auto
 qed
 
 lemma  det_1: "det (A::'a::comm_ring_1^1^1) = A$1$1"
   by (simp add: det_def sign_id)
 
 lemma  det_2: "det (A::'a::comm_ring_1^2^2) = A$1$1 * A$2$2 - A$1$2 * A$2$1"
 proof -
   have f12: "finite {2::2}" "1 \<notin> {2::2}" by auto
   show ?thesis
     unfolding det_def UNIV_2
     unfolding sum_over_permutations_insert[OF f12]
     unfolding permutes_sing
     by (simp add: sign_swap_id sign_id swap_id_eq)
 qed
 
 lemma  det_3:
   "det (A::'a::comm_ring_1^3^3) =
     A$1$1 * A$2$2 * A$3$3 +
     A$1$2 * A$2$3 * A$3$1 +
     A$1$3 * A$2$1 * A$3$2 -
     A$1$1 * A$2$3 * A$3$2 -
     A$1$2 * A$2$1 * A$3$3 -
     A$1$3 * A$2$2 * A$3$1"
 proof -
   have f123: "finite {2::3, 3}" "1 \<notin> {2::3, 3}"
     by auto
   have f23: "finite {3::3}" "2 \<notin> {3::3}"
     by auto
 
   show ?thesis
     unfolding det_def UNIV_3
     unfolding sum_over_permutations_insert[OF f123]
     unfolding sum_over_permutations_insert[OF f23]
     unfolding permutes_sing
     by (simp add: sign_swap_id permutation_swap_id sign_compose sign_id swap_id_eq)
 qed
 
 proposition  det_orthogonal_matrix:
   fixes Q:: "'a::linordered_idom^'n^'n"
   assumes oQ: "orthogonal_matrix Q"
   shows "det Q = 1 \<or> det Q = - 1"
 proof -
   have "Q ** transpose Q = mat 1"
     by (metis oQ orthogonal_matrix_def)
   then have "det (Q ** transpose Q) = det (mat 1:: 'a^'n^'n)"
     by simp
   then have "det Q * det Q = 1"
     by (simp add: det_mul)
   then show ?thesis
     by (simp add: square_eq_1_iff)
 qed
 
 proposition  orthogonal_transformation_det [simp]:
   fixes f :: "real^'n \<Rightarrow> real^'n"
   shows "orthogonal_transformation f \<Longrightarrow> \<bar>det (matrix f)\<bar> = 1"
   using det_orthogonal_matrix orthogonal_transformation_matrix by fastforce
 
 subsection  \<open>Rotation, reflection, rotoinversion\<close>
 
 definition\<^marker>\<open>tag important\<close>  "rotation_matrix Q \<longleftrightarrow> orthogonal_matrix Q \<and> det Q = 1"
 definition\<^marker>\<open>tag important\<close>  "rotoinversion_matrix Q \<longleftrightarrow> orthogonal_matrix Q \<and> det Q = - 1"
 
 lemma  orthogonal_rotation_or_rotoinversion:
   fixes Q :: "'a::linordered_idom^'n^'n"
   shows " orthogonal_matrix Q \<longleftrightarrow> rotation_matrix Q \<or> rotoinversion_matrix Q"
   by (metis rotoinversion_matrix_def rotation_matrix_def det_orthogonal_matrix)
 
 text\<open> Slightly stronger results giving rotation, but only in two or more dimensions\<close>
 
 lemma  rotation_matrix_exists_basis:
   fixes a :: "real^'n"
   assumes 2: "2 \<le> CARD('n)" and "norm a = 1"
   obtains A where "rotation_matrix A" "A *v (axis k 1) = a"
 proof -
   obtain A where "orthogonal_matrix A" and A: "A *v (axis k 1) = a"
     using orthogonal_matrix_exists_basis assms by metis
   with orthogonal_rotation_or_rotoinversion
   consider "rotation_matrix A" | "rotoinversion_matrix A"
     by metis
   then show thesis
   proof cases
     assume "rotation_matrix A"
     then show ?thesis
       using \<open>A *v axis k 1 = a\<close> that by auto
   next
     from ex_card[OF 2] obtain h i::'n where "h \<noteq> i"
       by (auto simp add: eval_nat_numeral card_Suc_eq)
     then obtain j where "j \<noteq> k"
       by (metis (full_types))
     let ?TA = "transpose A"
     let ?A = "\<chi> i. if i = j then - 1 *\<^sub>R (?TA $ i) else ?TA $i"
     assume "rotoinversion_matrix A"
     then have [simp]: "det A = -1"
       by (simp add: rotoinversion_matrix_def)
     show ?thesis
     proof
       have [simp]: "row i (\<chi> i. if i = j then - 1 *\<^sub>R ?TA $ i else ?TA $ i) = (if i = j then - row i ?TA else row i ?TA)" for i
         by (auto simp: row_def)
       have "orthogonal_matrix ?A"
         unfolding orthogonal_matrix_orthonormal_rows
         using \<open>orthogonal_matrix A\<close> by (auto simp: orthogonal_matrix_orthonormal_columns orthogonal_clauses)
       then show "rotation_matrix (transpose ?A)"
         unfolding rotation_matrix_def
         by (simp add: det_row_mul[of j _ "\<lambda>i. ?TA $ i", unfolded scalar_mult_eq_scaleR])
       show "transpose ?A *v axis k 1 = a"
         using \<open>j \<noteq> k\<close> A by (simp add: matrix_vector_column axis_def scalar_mult_eq_scaleR if_distrib [of "\<lambda>z. z *\<^sub>R c" for c] cong: if_cong)
     qed
   qed
 qed
 
 lemma  rotation_exists_1:
   fixes a :: "real^'n"
   assumes "2 \<le> CARD('n)" "norm a = 1" "norm b = 1"
   obtains f where "orthogonal_transformation f" "det(matrix f) = 1" "f a = b"
 proof -
   obtain k::'n where True
     by simp
   obtain A B where AB: "rotation_matrix A" "rotation_matrix B"
                and eq: "A *v (axis k 1) = a" "B *v (axis k 1) = b"
     using rotation_matrix_exists_basis assms by metis
   let ?f = "\<lambda>x. (B ** transpose A) *v x"
   show thesis
   proof
     show "orthogonal_transformation ?f"
       using AB orthogonal_matrix_mul orthogonal_transformation_matrix rotation_matrix_def matrix_vector_mul_linear by force
     show "det (matrix ?f) = 1"
       using AB by (auto simp: det_mul rotation_matrix_def)
     show "?f a = b"
       using AB unfolding orthogonal_matrix_def rotation_matrix_def
       by (metis eq matrix_mul_rid matrix_vector_mul_assoc)
   qed
 qed
 
 lemma  rotation_exists:
   fixes a :: "real^'n"
   assumes 2: "2 \<le> CARD('n)" and eq: "norm a = norm b"
   obtains f where "orthogonal_transformation f" "det(matrix f) = 1" "f a = b"
 proof (cases "a = 0 \<or> b = 0")
   case True
   with assms have "a = 0" "b = 0"
     by auto
   then show ?thesis
     by (metis eq_id_iff matrix_id orthogonal_transformation_id that)
 next
   case False
   then obtain f where f: "orthogonal_transformation f" "det (matrix f) = 1"
     and f': "f (a /\<^sub>R norm a) = b /\<^sub>R norm b"
     using rotation_exists_1 [of "a /\<^sub>R norm a" "b /\<^sub>R norm b", OF 2] by auto
   then interpret linear f by (simp add: orthogonal_transformation)
   have "f a = b"
     using f' False
     by (simp add: eq scale)
   with f show thesis ..
 qed
 
 lemma  rotation_rightward_line:
   fixes a :: "real^'n"
   obtains f where "orthogonal_transformation f" "2 \<le> CARD('n) \<Longrightarrow> det(matrix f) = 1"
                   "f(norm a *\<^sub>R axis k 1) = a"
 proof (cases "CARD('n) = 1")
   case True
   obtain f where "orthogonal_transformation f" "f (norm a *\<^sub>R axis k (1::real)) = a"
   proof (rule orthogonal_transformation_exists)
     show "norm (norm a *\<^sub>R axis k (1::real)) = norm a"
       by simp
   qed auto
   then show thesis
     using True that by auto
 next
   case False
   obtain f where "orthogonal_transformation f" "det(matrix f) = 1" "f (norm a *\<^sub>R axis k 1) = a"
   proof (rule rotation_exists)
     show "2 \<le> CARD('n)"
       using False one_le_card_finite [where 'a='n] by linarith
     show "norm (norm a *\<^sub>R axis k (1::real)) = norm a"
       by simp
   qed auto
   then show thesis
     using that by blast
 qed
 
 end
diff --git a/src/HOL/Analysis/Elementary_Topology.thy b/src/HOL/Analysis/Elementary_Topology.thy
--- a/src/HOL/Analysis/Elementary_Topology.thy
+++ b/src/HOL/Analysis/Elementary_Topology.thy
@@ -1,2755 +1,2666 @@
 (*  Author:     L C Paulson, University of Cambridge
     Author:     Amine Chaieb, University of Cambridge
     Author:     Robert Himmelmann, TU Muenchen
     Author:     Brian Huffman, Portland State University
 *)
 
 chapter \<open>Topology\<close>
 
 theory Elementary_Topology
 imports
   "HOL-Library.Set_Idioms"
   "HOL-Library.Disjoint_Sets"
   Product_Vector
 begin
 
 
 section \<open>Elementary Topology\<close>
 
 subsection \<open>TODO: move?\<close>
 
 lemma open_subopen: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> S)"
   using openI by auto
 
 
-subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Archimedean properties and useful consequences\<close>
-
-text\<open>Bernoulli's inequality\<close>
-proposition Bernoulli_inequality:
-  fixes x :: real
-  assumes "-1 \<le> x"
-    shows "1 + n * x \<le> (1 + x) ^ n"
-proof (induct n)
-  case 0
-  then show ?case by simp
-next
-  case (Suc n)
-  have "1 + Suc n * x \<le> 1 + (Suc n)*x + n * x^2"
-    by (simp add: algebra_simps)
-  also have "... = (1 + x) * (1 + n*x)"
-    by (auto simp: power2_eq_square algebra_simps  of_nat_Suc)
-  also have "... \<le> (1 + x) ^ Suc n"
-    using Suc.hyps assms mult_left_mono by fastforce
-  finally show ?case .
-qed
-
-corollary Bernoulli_inequality_even:
-  fixes x :: real
-  assumes "even n"
-    shows "1 + n * x \<le> (1 + x) ^ n"
-proof (cases "-1 \<le> x \<or> n=0")
-  case True
-  then show ?thesis
-    by (auto simp: Bernoulli_inequality)
-next
-  case False
-  then have "real n \<ge> 1"
-    by simp
-  with False have "n * x \<le> -1"
-    by (metis linear minus_zero mult.commute mult.left_neutral mult_left_mono_neg neg_le_iff_le order_trans zero_le_one)
-  then have "1 + n * x \<le> 0"
-    by auto
-  also have "... \<le> (1 + x) ^ n"
-    using assms
-    using zero_le_even_power by blast
-  finally show ?thesis .
-qed
-
-corollary real_arch_pow:
-  fixes x :: real
-  assumes x: "1 < x"
-  shows "\<exists>n. y < x^n"
-proof -
-  from x have x0: "x - 1 > 0"
-    by arith
-  from reals_Archimedean3[OF x0, rule_format, of y]
-  obtain n :: nat where n: "y < real n * (x - 1)" by metis
-  from x0 have x00: "x- 1 \<ge> -1" by arith
-  from Bernoulli_inequality[OF x00, of n] n
-  have "y < x^n" by auto
-  then show ?thesis by metis
-qed
-
-corollary real_arch_pow_inv:
-  fixes x y :: real
-  assumes y: "y > 0"
-    and x1: "x < 1"
-  shows "\<exists>n. x^n < y"
-proof (cases "x > 0")
-  case True
-  with x1 have ix: "1 < 1/x" by (simp add: field_simps)
-  from real_arch_pow[OF ix, of "1/y"]
-  obtain n where n: "1/y < (1/x)^n" by blast
-  then show ?thesis using y \<open>x > 0\<close>
-    by (auto simp add: field_simps)
-next
-  case False
-  with y x1 show ?thesis
-    by (metis less_le_trans not_less power_one_right)
-qed
-
-lemma forall_pos_mono:
-  "(\<And>d e::real. d < e \<Longrightarrow> P d \<Longrightarrow> P e) \<Longrightarrow>
-    (\<And>n::nat. n \<noteq> 0 \<Longrightarrow> P (inverse (real n))) \<Longrightarrow> (\<And>e. 0 < e \<Longrightarrow> P e)"
-  by (metis real_arch_inverse)
-
-lemma forall_pos_mono_1:
-  "(\<And>d e::real. d < e \<Longrightarrow> P d \<Longrightarrow> P e) \<Longrightarrow>
-    (\<And>n. P (inverse (real (Suc n)))) \<Longrightarrow> 0 < e \<Longrightarrow> P e"
-  apply (rule forall_pos_mono)
-  apply auto
-  apply (metis Suc_pred of_nat_Suc)
-  done
-
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Affine transformations of intervals\<close>
 
 lemma real_affinity_le: "0 < m \<Longrightarrow> m * x + c \<le> y \<longleftrightarrow> x \<le> inverse m * y + - (c / m)"
   for m :: "'a::linordered_field"
   by (simp add: field_simps)
 
 lemma real_le_affinity: "0 < m \<Longrightarrow> y \<le> m * x + c \<longleftrightarrow> inverse m * y + - (c / m) \<le> x"
   for m :: "'a::linordered_field"
   by (simp add: field_simps)
 
 lemma real_affinity_lt: "0 < m \<Longrightarrow> m * x + c < y \<longleftrightarrow> x < inverse m * y + - (c / m)"
   for m :: "'a::linordered_field"
   by (simp add: field_simps)
 
 lemma real_lt_affinity: "0 < m \<Longrightarrow> y < m * x + c \<longleftrightarrow> inverse m * y + - (c / m) < x"
   for m :: "'a::linordered_field"
   by (simp add: field_simps)
 
 lemma real_affinity_eq: "m \<noteq> 0 \<Longrightarrow> m * x + c = y \<longleftrightarrow> x = inverse m * y + - (c / m)"
   for m :: "'a::linordered_field"
   by (simp add: field_simps)
 
 lemma real_eq_affinity: "m \<noteq> 0 \<Longrightarrow> y = m * x + c  \<longleftrightarrow> inverse m * y + - (c / m) = x"
   for m :: "'a::linordered_field"
   by (simp add: field_simps)
 
 
 
 subsection \<open>Topological Basis\<close>
 
 context topological_space
 begin
 
 definition\<^marker>\<open>tag important\<close> "topological_basis B \<longleftrightarrow>
   (\<forall>b\<in>B. open b) \<and> (\<forall>x. open x \<longrightarrow> (\<exists>B'. B' \<subseteq> B \<and> \<Union>B' = x))"
 
 lemma topological_basis:
   "topological_basis B \<longleftrightarrow> (\<forall>x. open x \<longleftrightarrow> (\<exists>B'. B' \<subseteq> B \<and> \<Union>B' = x))"
   unfolding topological_basis_def
   apply safe
      apply fastforce
     apply fastforce
    apply (erule_tac x=x in allE, simp)
    apply (rule_tac x="{x}" in exI, auto)
   done
 
 lemma topological_basis_iff:
   assumes "\<And>B'. B' \<in> B \<Longrightarrow> open B'"
   shows "topological_basis B \<longleftrightarrow> (\<forall>O'. open O' \<longrightarrow> (\<forall>x\<in>O'. \<exists>B'\<in>B. x \<in> B' \<and> B' \<subseteq> O'))"
     (is "_ \<longleftrightarrow> ?rhs")
 proof safe
   fix O' and x::'a
   assume H: "topological_basis B" "open O'" "x \<in> O'"
   then have "(\<exists>B'\<subseteq>B. \<Union>B' = O')" by (simp add: topological_basis_def)
   then obtain B' where "B' \<subseteq> B" "O' = \<Union>B'" by auto
   then show "\<exists>B'\<in>B. x \<in> B' \<and> B' \<subseteq> O'" using H by auto
 next
   assume H: ?rhs
   show "topological_basis B"
     using assms unfolding topological_basis_def
   proof safe
     fix O' :: "'a set"
     assume "open O'"
     with H obtain f where "\<forall>x\<in>O'. f x \<in> B \<and> x \<in> f x \<and> f x \<subseteq> O'"
       by (force intro: bchoice simp: Bex_def)
     then show "\<exists>B'\<subseteq>B. \<Union>B' = O'"
       by (auto intro: exI[where x="{f x |x. x \<in> O'}"])
   qed
 qed
 
 lemma topological_basisI:
   assumes "\<And>B'. B' \<in> B \<Longrightarrow> open B'"
     and "\<And>O' x. open O' \<Longrightarrow> x \<in> O' \<Longrightarrow> \<exists>B'\<in>B. x \<in> B' \<and> B' \<subseteq> O'"
   shows "topological_basis B"
   using assms by (subst topological_basis_iff) auto
 
 lemma topological_basisE:
   fixes O'
   assumes "topological_basis B"
     and "open O'"
     and "x \<in> O'"
   obtains B' where "B' \<in> B" "x \<in> B'" "B' \<subseteq> O'"
 proof atomize_elim
   from assms have "\<And>B'. B'\<in>B \<Longrightarrow> open B'"
     by (simp add: topological_basis_def)
   with topological_basis_iff assms
   show  "\<exists>B'. B' \<in> B \<and> x \<in> B' \<and> B' \<subseteq> O'"
     using assms by (simp add: Bex_def)
 qed
 
 lemma topological_basis_open:
   assumes "topological_basis B"
     and "X \<in> B"
   shows "open X"
   using assms by (simp add: topological_basis_def)
 
 lemma topological_basis_imp_subbasis:
   assumes B: "topological_basis B"
   shows "open = generate_topology B"
 proof (intro ext iffI)
   fix S :: "'a set"
   assume "open S"
   with B obtain B' where "B' \<subseteq> B" "S = \<Union>B'"
     unfolding topological_basis_def by blast
   then show "generate_topology B S"
     by (auto intro: generate_topology.intros dest: topological_basis_open)
 next
   fix S :: "'a set"
   assume "generate_topology B S"
   then show "open S"
     by induct (auto dest: topological_basis_open[OF B])
 qed
 
 lemma basis_dense:
   fixes B :: "'a set set"
     and f :: "'a set \<Rightarrow> 'a"
   assumes "topological_basis B"
     and choosefrom_basis: "\<And>B'. B' \<noteq> {} \<Longrightarrow> f B' \<in> B'"
   shows "\<forall>X. open X \<longrightarrow> X \<noteq> {} \<longrightarrow> (\<exists>B' \<in> B. f B' \<in> X)"
 proof (intro allI impI)
   fix X :: "'a set"
   assume "open X" and "X \<noteq> {}"
   from topological_basisE[OF \<open>topological_basis B\<close> \<open>open X\<close> choosefrom_basis[OF \<open>X \<noteq> {}\<close>]]
   obtain B' where "B' \<in> B" "f X \<in> B'" "B' \<subseteq> X" .
   then show "\<exists>B'\<in>B. f B' \<in> X"
     by (auto intro!: choosefrom_basis)
 qed
 
 end
 
 lemma topological_basis_prod:
   assumes A: "topological_basis A"
     and B: "topological_basis B"
   shows "topological_basis ((\<lambda>(a, b). a \<times> b) ` (A \<times> B))"
   unfolding topological_basis_def
 proof (safe, simp_all del: ex_simps add: subset_image_iff ex_simps(1)[symmetric])
   fix S :: "('a \<times> 'b) set"
   assume "open S"
   then show "\<exists>X\<subseteq>A \<times> B. (\<Union>(a,b)\<in>X. a \<times> b) = S"
   proof (safe intro!: exI[of _ "{x\<in>A \<times> B. fst x \<times> snd x \<subseteq> S}"])
     fix x y
     assume "(x, y) \<in> S"
     from open_prod_elim[OF \<open>open S\<close> this]
     obtain a b where a: "open a""x \<in> a" and b: "open b" "y \<in> b" and "a \<times> b \<subseteq> S"
       by (metis mem_Sigma_iff)
     moreover
     from A a obtain A0 where "A0 \<in> A" "x \<in> A0" "A0 \<subseteq> a"
       by (rule topological_basisE)
     moreover
     from B b obtain B0 where "B0 \<in> B" "y \<in> B0" "B0 \<subseteq> b"
       by (rule topological_basisE)
     ultimately show "(x, y) \<in> (\<Union>(a, b)\<in>{X \<in> A \<times> B. fst X \<times> snd X \<subseteq> S}. a \<times> b)"
       by (intro UN_I[of "(A0, B0)"]) auto
   qed auto
 qed (metis A B topological_basis_open open_Times)
 
 
 subsection \<open>Countable Basis\<close>
 
 locale\<^marker>\<open>tag important\<close> countable_basis = topological_space p for p::"'a set \<Rightarrow> bool" +
   fixes B :: "'a set set"
   assumes is_basis: "topological_basis B"
     and countable_basis: "countable B"
 begin
 
 lemma open_countable_basis_ex:
   assumes "p X"
   shows "\<exists>B' \<subseteq> B. X = \<Union>B'"
   using assms countable_basis is_basis
   unfolding topological_basis_def by blast
 
 lemma open_countable_basisE:
   assumes "p X"
   obtains B' where "B' \<subseteq> B" "X = \<Union>B'"
   using assms open_countable_basis_ex
   by atomize_elim simp
 
 lemma countable_dense_exists:
   "\<exists>D::'a set. countable D \<and> (\<forall>X. p X \<longrightarrow> X \<noteq> {} \<longrightarrow> (\<exists>d \<in> D. d \<in> X))"
 proof -
   let ?f = "(\<lambda>B'. SOME x. x \<in> B')"
   have "countable (?f ` B)" using countable_basis by simp
   with basis_dense[OF is_basis, of ?f] show ?thesis
     by (intro exI[where x="?f ` B"]) (metis (mono_tags) all_not_in_conv imageI someI)
 qed
 
 lemma countable_dense_setE:
   obtains D :: "'a set"
   where "countable D" "\<And>X. p X \<Longrightarrow> X \<noteq> {} \<Longrightarrow> \<exists>d \<in> D. d \<in> X"
   using countable_dense_exists by blast
 
 end
 
 lemma countable_basis_openI: "countable_basis open B"
   if "countable B" "topological_basis B"
   using that
   by unfold_locales
     (simp_all add: topological_basis topological_space.topological_basis topological_space_axioms)
 
 lemma (in first_countable_topology) first_countable_basisE:
   fixes x :: 'a
   obtains \<A> where "countable \<A>" "\<And>A. A \<in> \<A> \<Longrightarrow> x \<in> A" "\<And>A. A \<in> \<A> \<Longrightarrow> open A"
     "\<And>S. open S \<Longrightarrow> x \<in> S \<Longrightarrow> (\<exists>A\<in>\<A>. A \<subseteq> S)"
 proof -
   obtain \<A> where \<A>: "(\<forall>i::nat. x \<in> \<A> i \<and> open (\<A> i))" "(\<forall>S. open S \<and> x \<in> S \<longrightarrow> (\<exists>i. \<A> i \<subseteq> S))"
     using first_countable_basis[of x] by metis
   show thesis
   proof 
     show "countable (range \<A>)"
       by simp
   qed (use \<A> in auto)
 qed
 
 lemma (in first_countable_topology) first_countable_basis_Int_stableE:
   obtains \<A> where "countable \<A>" "\<And>A. A \<in> \<A> \<Longrightarrow> x \<in> A" "\<And>A. A \<in> \<A> \<Longrightarrow> open A"
     "\<And>S. open S \<Longrightarrow> x \<in> S \<Longrightarrow> (\<exists>A\<in>\<A>. A \<subseteq> S)"
     "\<And>A B. A \<in> \<A> \<Longrightarrow> B \<in> \<A> \<Longrightarrow> A \<inter> B \<in> \<A>"
 proof atomize_elim
   obtain \<B> where \<B>:
     "countable \<B>"
     "\<And>B. B \<in> \<B> \<Longrightarrow> x \<in> B"
     "\<And>B. B \<in> \<B> \<Longrightarrow> open B"
     "\<And>S. open S \<Longrightarrow> x \<in> S \<Longrightarrow> \<exists>B\<in>\<B>. B \<subseteq> S"
     by (rule first_countable_basisE) blast
   define \<A> where [abs_def]:
     "\<A> = (\<lambda>N. \<Inter>((\<lambda>n. from_nat_into \<B> n) ` N)) ` (Collect finite::nat set set)"
   then show "\<exists>\<A>. countable \<A> \<and> (\<forall>A. A \<in> \<A> \<longrightarrow> x \<in> A) \<and> (\<forall>A. A \<in> \<A> \<longrightarrow> open A) \<and>
         (\<forall>S. open S \<longrightarrow> x \<in> S \<longrightarrow> (\<exists>A\<in>\<A>. A \<subseteq> S)) \<and> (\<forall>A B. A \<in> \<A> \<longrightarrow> B \<in> \<A> \<longrightarrow> A \<inter> B \<in> \<A>)"
   proof (safe intro!: exI[where x=\<A>])
     show "countable \<A>"
       unfolding \<A>_def by (intro countable_image countable_Collect_finite)
     fix A
     assume "A \<in> \<A>"
     then show "x \<in> A" "open A"
       using \<B>(4)[OF open_UNIV] by (auto simp: \<A>_def intro: \<B> from_nat_into)
   next
     let ?int = "\<lambda>N. \<Inter>(from_nat_into \<B> ` N)"
     fix A B
     assume "A \<in> \<A>" "B \<in> \<A>"
     then obtain N M where "A = ?int N" "B = ?int M" "finite (N \<union> M)"
       by (auto simp: \<A>_def)
     then show "A \<inter> B \<in> \<A>"
       by (auto simp: \<A>_def intro!: image_eqI[where x="N \<union> M"])
   next
     fix S
     assume "open S" "x \<in> S"
     then obtain a where a: "a\<in>\<B>" "a \<subseteq> S" using \<B> by blast
     then show "\<exists>a\<in>\<A>. a \<subseteq> S" using a \<B>
       by (intro bexI[where x=a]) (auto simp: \<A>_def intro: image_eqI[where x="{to_nat_on \<B> a}"])
   qed
 qed
 
 lemma (in topological_space) first_countableI:
   assumes "countable \<A>"
     and 1: "\<And>A. A \<in> \<A> \<Longrightarrow> x \<in> A" "\<And>A. A \<in> \<A> \<Longrightarrow> open A"
     and 2: "\<And>S. open S \<Longrightarrow> x \<in> S \<Longrightarrow> \<exists>A\<in>\<A>. A \<subseteq> S"
   shows "\<exists>\<A>::nat \<Rightarrow> 'a set. (\<forall>i. x \<in> \<A> i \<and> open (\<A> i)) \<and> (\<forall>S. open S \<and> x \<in> S \<longrightarrow> (\<exists>i. \<A> i \<subseteq> S))"
 proof (safe intro!: exI[of _ "from_nat_into \<A>"])
   fix i
   have "\<A> \<noteq> {}" using 2[of UNIV] by auto
   show "x \<in> from_nat_into \<A> i" "open (from_nat_into \<A> i)"
     using range_from_nat_into_subset[OF \<open>\<A> \<noteq> {}\<close>] 1 by auto
 next
   fix S
   assume "open S" "x\<in>S" from 2[OF this]
   show "\<exists>i. from_nat_into \<A> i \<subseteq> S"
     using subset_range_from_nat_into[OF \<open>countable \<A>\<close>] by auto
 qed
 
 instance prod :: (first_countable_topology, first_countable_topology) first_countable_topology
 proof
   fix x :: "'a \<times> 'b"
   obtain \<A> where \<A>:
       "countable \<A>"
       "\<And>a. a \<in> \<A> \<Longrightarrow> fst x \<in> a"
       "\<And>a. a \<in> \<A> \<Longrightarrow> open a"
       "\<And>S. open S \<Longrightarrow> fst x \<in> S \<Longrightarrow> \<exists>a\<in>\<A>. a \<subseteq> S"
     by (rule first_countable_basisE[of "fst x"]) blast
   obtain B where B:
       "countable B"
       "\<And>a. a \<in> B \<Longrightarrow> snd x \<in> a"
       "\<And>a. a \<in> B \<Longrightarrow> open a"
       "\<And>S. open S \<Longrightarrow> snd x \<in> S \<Longrightarrow> \<exists>a\<in>B. a \<subseteq> S"
     by (rule first_countable_basisE[of "snd x"]) blast
   show "\<exists>\<A>::nat \<Rightarrow> ('a \<times> 'b) set.
     (\<forall>i. x \<in> \<A> i \<and> open (\<A> i)) \<and> (\<forall>S. open S \<and> x \<in> S \<longrightarrow> (\<exists>i. \<A> i \<subseteq> S))"
   proof (rule first_countableI[of "(\<lambda>(a, b). a \<times> b) ` (\<A> \<times> B)"], safe)
     fix a b
     assume x: "a \<in> \<A>" "b \<in> B"
     show "x \<in> a \<times> b" 
       by (simp add: \<A>(2) B(2) mem_Times_iff x)
     show "open (a \<times> b)"
       by (simp add: \<A>(3) B(3) open_Times x)
   next
     fix S
     assume "open S" "x \<in> S"
     then obtain a' b' where a'b': "open a'" "open b'" "x \<in> a' \<times> b'" "a' \<times> b' \<subseteq> S"
       by (rule open_prod_elim)
     moreover
     from a'b' \<A>(4)[of a'] B(4)[of b']
     obtain a b where "a \<in> \<A>" "a \<subseteq> a'" "b \<in> B" "b \<subseteq> b'"
       by auto
     ultimately
     show "\<exists>a\<in>(\<lambda>(a, b). a \<times> b) ` (\<A> \<times> B). a \<subseteq> S"
       by (auto intro!: bexI[of _ "a \<times> b"] bexI[of _ a] bexI[of _ b])
   qed (simp add: \<A> B)
 qed
 
 class second_countable_topology = topological_space +
   assumes ex_countable_subbasis:
     "\<exists>B::'a set set. countable B \<and> open = generate_topology B"
 begin
 
 lemma ex_countable_basis: "\<exists>B::'a set set. countable B \<and> topological_basis B"
 proof -
   from ex_countable_subbasis obtain B where B: "countable B" "open = generate_topology B"
     by blast
   let ?B = "Inter ` {b. finite b \<and> b \<subseteq> B }"
 
   show ?thesis
   proof (intro exI conjI)
     show "countable ?B"
       by (intro countable_image countable_Collect_finite_subset B)
     {
       fix S
       assume "open S"
       then have "\<exists>B'\<subseteq>{b. finite b \<and> b \<subseteq> B}. (\<Union>b\<in>B'. \<Inter>b) = S"
         unfolding B
       proof induct
         case UNIV
         show ?case by (intro exI[of _ "{{}}"]) simp
       next
         case (Int a b)
         then obtain x y where x: "a = \<Union>(Inter ` x)" "\<And>i. i \<in> x \<Longrightarrow> finite i \<and> i \<subseteq> B"
           and y: "b = \<Union>(Inter ` y)" "\<And>i. i \<in> y \<Longrightarrow> finite i \<and> i \<subseteq> B"
           by blast
         show ?case
           unfolding x y Int_UN_distrib2
           by (intro exI[of _ "{i \<union> j| i j.  i \<in> x \<and> j \<in> y}"]) (auto dest: x(2) y(2))
       next
         case (UN K)
         then have "\<forall>k\<in>K. \<exists>B'\<subseteq>{b. finite b \<and> b \<subseteq> B}. \<Union> (Inter ` B') = k" by auto
         then obtain k where
             "\<forall>ka\<in>K. k ka \<subseteq> {b. finite b \<and> b \<subseteq> B} \<and> \<Union>(Inter ` (k ka)) = ka"
           unfolding bchoice_iff ..
         then show "\<exists>B'\<subseteq>{b. finite b \<and> b \<subseteq> B}. \<Union> (Inter ` B') = \<Union>K"
           by (intro exI[of _ "\<Union>(k ` K)"]) auto
       next
         case (Basis S)
         then show ?case
           by (intro exI[of _ "{{S}}"]) auto
       qed
       then have "(\<exists>B'\<subseteq>Inter ` {b. finite b \<and> b \<subseteq> B}. \<Union>B' = S)"
         unfolding subset_image_iff by blast }
     then show "topological_basis ?B"
       unfolding topological_basis_def
       by (safe intro!: open_Inter)
          (simp_all add: B generate_topology.Basis subset_eq)
   qed
 qed
 
 
 end
 
 lemma univ_second_countable:
   obtains \<B> :: "'a::second_countable_topology set set"
   where "countable \<B>" "\<And>C. C \<in> \<B> \<Longrightarrow> open C"
        "\<And>S. open S \<Longrightarrow> \<exists>U. U \<subseteq> \<B> \<and> S = \<Union>U"
 by (metis ex_countable_basis topological_basis_def)
 
 proposition Lindelof:
   fixes \<F> :: "'a::second_countable_topology set set"
   assumes \<F>: "\<And>S. S \<in> \<F> \<Longrightarrow> open S"
   obtains \<F>' where "\<F>' \<subseteq> \<F>" "countable \<F>'" "\<Union>\<F>' = \<Union>\<F>"
 proof -
   obtain \<B> :: "'a set set"
     where "countable \<B>" "\<And>C. C \<in> \<B> \<Longrightarrow> open C"
       and \<B>: "\<And>S. open S \<Longrightarrow> \<exists>U. U \<subseteq> \<B> \<and> S = \<Union>U"
     using univ_second_countable by blast
   define \<D> where "\<D> \<equiv> {S. S \<in> \<B> \<and> (\<exists>U. U \<in> \<F> \<and> S \<subseteq> U)}"
   have "countable \<D>"
     apply (rule countable_subset [OF _ \<open>countable \<B>\<close>])
     apply (force simp: \<D>_def)
     done
   have "\<And>S. \<exists>U. S \<in> \<D> \<longrightarrow> U \<in> \<F> \<and> S \<subseteq> U"
     by (simp add: \<D>_def)
   then obtain G where G: "\<And>S. S \<in> \<D> \<longrightarrow> G S \<in> \<F> \<and> S \<subseteq> G S"
     by metis
   have "\<Union>\<F> \<subseteq> \<Union>\<D>"
     unfolding \<D>_def by (blast dest: \<F> \<B>)
   moreover have "\<Union>\<D> \<subseteq> \<Union>\<F>"
     using \<D>_def by blast
   ultimately have eq1: "\<Union>\<F> = \<Union>\<D>" ..
   have eq2: "\<Union>\<D> = \<Union> (G ` \<D>)"
     using G eq1 by auto
   show ?thesis
     apply (rule_tac \<F>' = "G ` \<D>" in that)
     using G \<open>countable \<D>\<close>
     by (auto simp: eq1 eq2)
 qed
 
 lemma countable_disjoint_open_subsets:
   fixes \<F> :: "'a::second_countable_topology set set"
   assumes "\<And>S. S \<in> \<F> \<Longrightarrow> open S" and pw: "pairwise disjnt \<F>"
     shows "countable \<F>"
 proof -
   obtain \<F>' where "\<F>' \<subseteq> \<F>" "countable \<F>'" "\<Union>\<F>' = \<Union>\<F>"
     by (meson assms Lindelof)
   with pw have "\<F> \<subseteq> insert {} \<F>'"
     by (fastforce simp add: pairwise_def disjnt_iff)
   then show ?thesis
     by (simp add: \<open>countable \<F>'\<close> countable_subset)
 qed
 
 sublocale second_countable_topology <
   countable_basis "open" "SOME B. countable B \<and> topological_basis B"
   using someI_ex[OF ex_countable_basis]
   by unfold_locales safe
 
 
 instance prod :: (second_countable_topology, second_countable_topology) second_countable_topology
 proof
   obtain A :: "'a set set" where "countable A" "topological_basis A"
     using ex_countable_basis by auto
   moreover
   obtain B :: "'b set set" where "countable B" "topological_basis B"
     using ex_countable_basis by auto
   ultimately show "\<exists>B::('a \<times> 'b) set set. countable B \<and> open = generate_topology B"
     by (auto intro!: exI[of _ "(\<lambda>(a, b). a \<times> b) ` (A \<times> B)"] topological_basis_prod
       topological_basis_imp_subbasis)
 qed
 
 instance second_countable_topology \<subseteq> first_countable_topology
 proof
   fix x :: 'a
   define B :: "'a set set" where "B = (SOME B. countable B \<and> topological_basis B)"
   then have B: "countable B" "topological_basis B"
     using countable_basis is_basis
     by (auto simp: countable_basis is_basis)
   then show "\<exists>A::nat \<Rightarrow> 'a set.
     (\<forall>i. x \<in> A i \<and> open (A i)) \<and> (\<forall>S. open S \<and> x \<in> S \<longrightarrow> (\<exists>i. A i \<subseteq> S))"
     by (intro first_countableI[of "{b\<in>B. x \<in> b}"])
        (fastforce simp: topological_space_class.topological_basis_def)+
 qed
 
 instance nat :: second_countable_topology
 proof
   show "\<exists>B::nat set set. countable B \<and> open = generate_topology B"
     by (intro exI[of _ "range lessThan \<union> range greaterThan"]) (auto simp: open_nat_def)
 qed
 
 lemma countable_separating_set_linorder1:
   shows "\<exists>B::('a::{linorder_topology, second_countable_topology} set). countable B \<and> (\<forall>x y. x < y \<longrightarrow> (\<exists>b \<in> B. x < b \<and> b \<le> y))"
 proof -
   obtain A::"'a set set" where "countable A" "topological_basis A" using ex_countable_basis by auto
   define B1 where "B1 = {(LEAST x. x \<in> U)| U. U \<in> A}"
   then have "countable B1" using \<open>countable A\<close> by (simp add: Setcompr_eq_image)
   define B2 where "B2 = {(SOME x. x \<in> U)| U. U \<in> A}"
   then have "countable B2" using \<open>countable A\<close> by (simp add: Setcompr_eq_image)
   have "\<exists>b \<in> B1 \<union> B2. x < b \<and> b \<le> y" if "x < y" for x y
   proof (cases)
     assume "\<exists>z. x < z \<and> z < y"
     then obtain z where z: "x < z \<and> z < y" by auto
     define U where "U = {x<..<y}"
     then have "open U" by simp
     moreover have "z \<in> U" using z U_def by simp
     ultimately obtain V where "V \<in> A" "z \<in> V" "V \<subseteq> U" using topological_basisE[OF \<open>topological_basis A\<close>] by auto
     define w where "w = (SOME x. x \<in> V)"
     then have "w \<in> V" using \<open>z \<in> V\<close> by (metis someI2)
     then have "x < w \<and> w \<le> y" using \<open>w \<in> V\<close> \<open>V \<subseteq> U\<close> U_def by fastforce
     moreover have "w \<in> B1 \<union> B2" using w_def B2_def \<open>V \<in> A\<close> by auto
     ultimately show ?thesis by auto
   next
     assume "\<not>(\<exists>z. x < z \<and> z < y)"
     then have *: "\<And>z. z > x \<Longrightarrow> z \<ge> y" by auto
     define U where "U = {x<..}"
     then have "open U" by simp
     moreover have "y \<in> U" using \<open>x < y\<close> U_def by simp
     ultimately obtain "V" where "V \<in> A" "y \<in> V" "V \<subseteq> U" using topological_basisE[OF \<open>topological_basis A\<close>] by auto
     have "U = {y..}" unfolding U_def using * \<open>x < y\<close> by auto
     then have "V \<subseteq> {y..}" using \<open>V \<subseteq> U\<close> by simp
     then have "(LEAST w. w \<in> V) = y" using \<open>y \<in> V\<close> by (meson Least_equality atLeast_iff subsetCE)
     then have "y \<in> B1 \<union> B2" using \<open>V \<in> A\<close> B1_def by auto
     moreover have "x < y \<and> y \<le> y" using \<open>x < y\<close> by simp
     ultimately show ?thesis by auto
   qed
   moreover have "countable (B1 \<union> B2)" using \<open>countable B1\<close> \<open>countable B2\<close> by simp
   ultimately show ?thesis by auto
 qed
 
 lemma countable_separating_set_linorder2:
   shows "\<exists>B::('a::{linorder_topology, second_countable_topology} set). countable B \<and> (\<forall>x y. x < y \<longrightarrow> (\<exists>b \<in> B. x \<le> b \<and> b < y))"
 proof -
   obtain A::"'a set set" where "countable A" "topological_basis A" using ex_countable_basis by auto
   define B1 where "B1 = {(GREATEST x. x \<in> U) | U. U \<in> A}"
   then have "countable B1" using \<open>countable A\<close> by (simp add: Setcompr_eq_image)
   define B2 where "B2 = {(SOME x. x \<in> U)| U. U \<in> A}"
   then have "countable B2" using \<open>countable A\<close> by (simp add: Setcompr_eq_image)
   have "\<exists>b \<in> B1 \<union> B2. x \<le> b \<and> b < y" if "x < y" for x y
   proof (cases)
     assume "\<exists>z. x < z \<and> z < y"
     then obtain z where z: "x < z \<and> z < y" by auto
     define U where "U = {x<..<y}"
     then have "open U" by simp
     moreover have "z \<in> U" using z U_def by simp
     ultimately obtain "V" where "V \<in> A" "z \<in> V" "V \<subseteq> U" using topological_basisE[OF \<open>topological_basis A\<close>] by auto
     define w where "w = (SOME x. x \<in> V)"
     then have "w \<in> V" using \<open>z \<in> V\<close> by (metis someI2)
     then have "x \<le> w \<and> w < y" using \<open>w \<in> V\<close> \<open>V \<subseteq> U\<close> U_def by fastforce
     moreover have "w \<in> B1 \<union> B2" using w_def B2_def \<open>V \<in> A\<close> by auto
     ultimately show ?thesis by auto
   next
     assume "\<not>(\<exists>z. x < z \<and> z < y)"
     then have *: "\<And>z. z < y \<Longrightarrow> z \<le> x" using leI by blast
     define U where "U = {..<y}"
     then have "open U" by simp
     moreover have "x \<in> U" using \<open>x < y\<close> U_def by simp
     ultimately obtain "V" where "V \<in> A" "x \<in> V" "V \<subseteq> U" using topological_basisE[OF \<open>topological_basis A\<close>] by auto
     have "U = {..x}" unfolding U_def using * \<open>x < y\<close> by auto
     then have "V \<subseteq> {..x}" using \<open>V \<subseteq> U\<close> by simp
     then have "(GREATEST x. x \<in> V) = x" using \<open>x \<in> V\<close> by (meson Greatest_equality atMost_iff subsetCE)
     then have "x \<in> B1 \<union> B2" using \<open>V \<in> A\<close> B1_def by auto
     moreover have "x \<le> x \<and> x < y" using \<open>x < y\<close> by simp
     ultimately show ?thesis by auto
   qed
   moreover have "countable (B1 \<union> B2)" using \<open>countable B1\<close> \<open>countable B2\<close> by simp
   ultimately show ?thesis by auto
 qed
 
 lemma countable_separating_set_dense_linorder:
   shows "\<exists>B::('a::{linorder_topology, dense_linorder, second_countable_topology} set). countable B \<and> (\<forall>x y. x < y \<longrightarrow> (\<exists>b \<in> B. x < b \<and> b < y))"
 proof -
   obtain B::"'a set" where B: "countable B" "\<And>x y. x < y \<Longrightarrow> (\<exists>b \<in> B. x < b \<and> b \<le> y)"
     using countable_separating_set_linorder1 by auto
   have "\<exists>b \<in> B. x < b \<and> b < y" if "x < y" for x y
   proof -
     obtain z where "x < z" "z < y" using \<open>x < y\<close> dense by blast
     then obtain b where "b \<in> B" "x < b \<and> b \<le> z" using B(2) by auto
     then have "x < b \<and> b < y" using \<open>z < y\<close> by auto
     then show ?thesis using \<open>b \<in> B\<close> by auto
   qed
   then show ?thesis using B(1) by auto
 qed
 
 
 subsection \<open>Polish spaces\<close>
 
 text \<open>Textbooks define Polish spaces as completely metrizable.
   We assume the topology to be complete for a given metric.\<close>
 
 class polish_space = complete_space + second_countable_topology
 
 
 subsection \<open>Limit Points\<close>
 
 definition\<^marker>\<open>tag important\<close> (in topological_space) islimpt:: "'a \<Rightarrow> 'a set \<Rightarrow> bool"  (infixr "islimpt" 60)
   where "x islimpt S \<longleftrightarrow> (\<forall>T. x\<in>T \<longrightarrow> open T \<longrightarrow> (\<exists>y\<in>S. y\<in>T \<and> y\<noteq>x))"
 
 lemma islimptI:
   assumes "\<And>T. x \<in> T \<Longrightarrow> open T \<Longrightarrow> \<exists>y\<in>S. y \<in> T \<and> y \<noteq> x"
   shows "x islimpt S"
   using assms unfolding islimpt_def by auto
 
 lemma islimptE:
   assumes "x islimpt S" and "x \<in> T" and "open T"
   obtains y where "y \<in> S" and "y \<in> T" and "y \<noteq> x"
   using assms unfolding islimpt_def by auto
 
 lemma islimpt_iff_eventually: "x islimpt S \<longleftrightarrow> \<not> eventually (\<lambda>y. y \<notin> S) (at x)"
   unfolding islimpt_def eventually_at_topological by auto
 
 lemma islimpt_subset: "x islimpt S \<Longrightarrow> S \<subseteq> T \<Longrightarrow> x islimpt T"
   unfolding islimpt_def by fast
 
 lemma islimpt_UNIV_iff: "x islimpt UNIV \<longleftrightarrow> \<not> open {x}"
   unfolding islimpt_def by (safe, fast, case_tac "T = {x}", fast, fast)
 
 lemma islimpt_punctured: "x islimpt S = x islimpt (S-{x})"
   unfolding islimpt_def by blast
 
 text \<open>A perfect space has no isolated points.\<close>
 
 lemma islimpt_UNIV [simp, intro]: "x islimpt UNIV"
   for x :: "'a::perfect_space"
   unfolding islimpt_UNIV_iff by (rule not_open_singleton)
 
 lemma closed_limpt: "closed S \<longleftrightarrow> (\<forall>x. x islimpt S \<longrightarrow> x \<in> S)"
   unfolding closed_def
   apply (subst open_subopen)
   apply (simp add: islimpt_def subset_eq)
   apply (metis ComplE ComplI)
   done
 
 lemma islimpt_EMPTY[simp]: "\<not> x islimpt {}"
   by (auto simp: islimpt_def)
 
 lemma islimpt_Un: "x islimpt (S \<union> T) \<longleftrightarrow> x islimpt S \<or> x islimpt T"
   by (simp add: islimpt_iff_eventually eventually_conj_iff)
 
 
 lemma islimpt_insert:
   fixes x :: "'a::t1_space"
   shows "x islimpt (insert a s) \<longleftrightarrow> x islimpt s"
 proof
   assume *: "x islimpt (insert a s)"
   show "x islimpt s"
   proof (rule islimptI)
     fix t
     assume t: "x \<in> t" "open t"
     show "\<exists>y\<in>s. y \<in> t \<and> y \<noteq> x"
     proof (cases "x = a")
       case True
       obtain y where "y \<in> insert a s" "y \<in> t" "y \<noteq> x"
         using * t by (rule islimptE)
       with \<open>x = a\<close> show ?thesis by auto
     next
       case False
       with t have t': "x \<in> t - {a}" "open (t - {a})"
         by (simp_all add: open_Diff)
       obtain y where "y \<in> insert a s" "y \<in> t - {a}" "y \<noteq> x"
         using * t' by (rule islimptE)
       then show ?thesis by auto
     qed
   qed
 next
   assume "x islimpt s"
   then show "x islimpt (insert a s)"
     by (rule islimpt_subset) auto
 qed
 
 lemma islimpt_finite:
   fixes x :: "'a::t1_space"
   shows "finite s \<Longrightarrow> \<not> x islimpt s"
   by (induct set: finite) (simp_all add: islimpt_insert)
 
 lemma islimpt_Un_finite:
   fixes x :: "'a::t1_space"
   shows "finite s \<Longrightarrow> x islimpt (s \<union> t) \<longleftrightarrow> x islimpt t"
   by (simp add: islimpt_Un islimpt_finite)
 
 lemma islimpt_eq_acc_point:
   fixes l :: "'a :: t1_space"
   shows "l islimpt S \<longleftrightarrow> (\<forall>U. l\<in>U \<longrightarrow> open U \<longrightarrow> infinite (U \<inter> S))"
 proof (safe intro!: islimptI)
   fix U
   assume "l islimpt S" "l \<in> U" "open U" "finite (U \<inter> S)"
   then have "l islimpt S" "l \<in> (U - (U \<inter> S - {l}))" "open (U - (U \<inter> S - {l}))"
     by (auto intro: finite_imp_closed)
   then show False
     by (rule islimptE) auto
 next
   fix T
   assume *: "\<forall>U. l\<in>U \<longrightarrow> open U \<longrightarrow> infinite (U \<inter> S)" "l \<in> T" "open T"
   then have "infinite (T \<inter> S - {l})"
     by auto
   then have "\<exists>x. x \<in> (T \<inter> S - {l})"
     unfolding ex_in_conv by (intro notI) simp
   then show "\<exists>y\<in>S. y \<in> T \<and> y \<noteq> l"
     by auto
 qed
 
 lemma acc_point_range_imp_convergent_subsequence:
   fixes l :: "'a :: first_countable_topology"
   assumes l: "\<forall>U. l\<in>U \<longrightarrow> open U \<longrightarrow> infinite (U \<inter> range f)"
   shows "\<exists>r::nat\<Rightarrow>nat. strict_mono r \<and> (f \<circ> r) \<longlonglongrightarrow> l"
 proof -
   from countable_basis_at_decseq[of l]
   obtain A where A:
       "\<And>i. open (A i)"
       "\<And>i. l \<in> A i"
       "\<And>S. open S \<Longrightarrow> l \<in> S \<Longrightarrow> eventually (\<lambda>i. A i \<subseteq> S) sequentially"
     by blast
   define s where "s n i = (SOME j. i < j \<and> f j \<in> A (Suc n))" for n i
   {
     fix n i
     have "infinite (A (Suc n) \<inter> range f - f`{.. i})"
       using l A by auto
     then have "\<exists>x. x \<in> A (Suc n) \<inter> range f - f`{.. i}"
       unfolding ex_in_conv by (intro notI) simp
     then have "\<exists>j. f j \<in> A (Suc n) \<and> j \<notin> {.. i}"
       by auto
     then have "\<exists>a. i < a \<and> f a \<in> A (Suc n)"
       by (auto simp: not_le)
     then have "i < s n i" "f (s n i) \<in> A (Suc n)"
       unfolding s_def by (auto intro: someI2_ex)
   }
   note s = this
   define r where "r = rec_nat (s 0 0) s"
   have "strict_mono r"
     by (auto simp: r_def s strict_mono_Suc_iff)
   moreover
   have "(\<lambda>n. f (r n)) \<longlonglongrightarrow> l"
   proof (rule topological_tendstoI)
     fix S
     assume "open S" "l \<in> S"
     with A(3) have "eventually (\<lambda>i. A i \<subseteq> S) sequentially"
       by auto
     moreover
     {
       fix i
       assume "Suc 0 \<le> i"
       then have "f (r i) \<in> A i"
         by (cases i) (simp_all add: r_def s)
     }
     then have "eventually (\<lambda>i. f (r i) \<in> A i) sequentially"
       by (auto simp: eventually_sequentially)
     ultimately show "eventually (\<lambda>i. f (r i) \<in> S) sequentially"
       by eventually_elim auto
   qed
   ultimately show "\<exists>r::nat\<Rightarrow>nat. strict_mono r \<and> (f \<circ> r) \<longlonglongrightarrow> l"
     by (auto simp: convergent_def comp_def)
 qed
 
 lemma islimpt_range_imp_convergent_subsequence:
   fixes l :: "'a :: {t1_space, first_countable_topology}"
   assumes l: "l islimpt (range f)"
   shows "\<exists>r::nat\<Rightarrow>nat. strict_mono r \<and> (f \<circ> r) \<longlonglongrightarrow> l"
   using l unfolding islimpt_eq_acc_point
   by (rule acc_point_range_imp_convergent_subsequence)
 
 lemma sequence_unique_limpt:
   fixes f :: "nat \<Rightarrow> 'a::t2_space"
   assumes "(f \<longlongrightarrow> l) sequentially"
     and "l' islimpt (range f)"
   shows "l' = l"
 proof (rule ccontr)
   assume "l' \<noteq> l"
   obtain s t where "open s" "open t" "l' \<in> s" "l \<in> t" "s \<inter> t = {}"
     using hausdorff [OF \<open>l' \<noteq> l\<close>] by auto
   have "eventually (\<lambda>n. f n \<in> t) sequentially"
     using assms(1) \<open>open t\<close> \<open>l \<in> t\<close> by (rule topological_tendstoD)
   then obtain N where "\<forall>n\<ge>N. f n \<in> t"
     unfolding eventually_sequentially by auto
 
   have "UNIV = {..<N} \<union> {N..}"
     by auto
   then have "l' islimpt (f ` ({..<N} \<union> {N..}))"
     using assms(2) by simp
   then have "l' islimpt (f ` {..<N} \<union> f ` {N..})"
     by (simp add: image_Un)
   then have "l' islimpt (f ` {N..})"
     by (simp add: islimpt_Un_finite)
   then obtain y where "y \<in> f ` {N..}" "y \<in> s" "y \<noteq> l'"
     using \<open>l' \<in> s\<close> \<open>open s\<close> by (rule islimptE)
   then obtain n where "N \<le> n" "f n \<in> s" "f n \<noteq> l'"
     by auto
   with \<open>\<forall>n\<ge>N. f n \<in> t\<close> have "f n \<in> s \<inter> t"
     by simp
   with \<open>s \<inter> t = {}\<close> show False
     by simp
 qed
 
 
 subsection \<open>Interior of a Set\<close>
 
 definition\<^marker>\<open>tag important\<close> interior :: "('a::topological_space) set \<Rightarrow> 'a set" where
 "interior S = \<Union>{T. open T \<and> T \<subseteq> S}"
 
 lemma interiorI [intro?]:
   assumes "open T" and "x \<in> T" and "T \<subseteq> S"
   shows "x \<in> interior S"
   using assms unfolding interior_def by fast
 
 lemma interiorE [elim?]:
   assumes "x \<in> interior S"
   obtains T where "open T" and "x \<in> T" and "T \<subseteq> S"
   using assms unfolding interior_def by fast
 
 lemma open_interior [simp, intro]: "open (interior S)"
   by (simp add: interior_def open_Union)
 
 lemma interior_subset: "interior S \<subseteq> S"
   by (auto simp: interior_def)
 
 lemma interior_maximal: "T \<subseteq> S \<Longrightarrow> open T \<Longrightarrow> T \<subseteq> interior S"
   by (auto simp: interior_def)
 
 lemma interior_open: "open S \<Longrightarrow> interior S = S"
   by (intro equalityI interior_subset interior_maximal subset_refl)
 
 lemma interior_eq: "interior S = S \<longleftrightarrow> open S"
   by (metis open_interior interior_open)
 
 lemma open_subset_interior: "open S \<Longrightarrow> S \<subseteq> interior T \<longleftrightarrow> S \<subseteq> T"
   by (metis interior_maximal interior_subset subset_trans)
 
 lemma interior_empty [simp]: "interior {} = {}"
   using open_empty by (rule interior_open)
 
 lemma interior_UNIV [simp]: "interior UNIV = UNIV"
   using open_UNIV by (rule interior_open)
 
 lemma interior_interior [simp]: "interior (interior S) = interior S"
   using open_interior by (rule interior_open)
 
 lemma interior_mono: "S \<subseteq> T \<Longrightarrow> interior S \<subseteq> interior T"
   by (auto simp: interior_def)
 
 lemma interior_unique:
   assumes "T \<subseteq> S" and "open T"
   assumes "\<And>T'. T' \<subseteq> S \<Longrightarrow> open T' \<Longrightarrow> T' \<subseteq> T"
   shows "interior S = T"
   by (intro equalityI assms interior_subset open_interior interior_maximal)
 
 lemma interior_singleton [simp]: "interior {a} = {}"
   for a :: "'a::perfect_space"
   apply (rule interior_unique, simp_all)
   using not_open_singleton subset_singletonD
   apply fastforce
   done
 
 lemma interior_Int [simp]: "interior (S \<inter> T) = interior S \<inter> interior T"
   by (intro equalityI Int_mono Int_greatest interior_mono Int_lower1
     Int_lower2 interior_maximal interior_subset open_Int open_interior)
 
 lemma eventually_nhds_in_nhd: "x \<in> interior s \<Longrightarrow> eventually (\<lambda>y. y \<in> s) (nhds x)"
   using interior_subset[of s] by (subst eventually_nhds) blast
 
 lemma interior_limit_point [intro]:
   fixes x :: "'a::perfect_space"
   assumes x: "x \<in> interior S"
   shows "x islimpt S"
   using x islimpt_UNIV [of x]
   unfolding interior_def islimpt_def
   apply (clarsimp, rename_tac T T')
   apply (drule_tac x="T \<inter> T'" in spec)
   apply (auto simp: open_Int)
   done
 
 lemma interior_closed_Un_empty_interior:
   assumes cS: "closed S"
     and iT: "interior T = {}"
   shows "interior (S \<union> T) = interior S"
 proof
   show "interior S \<subseteq> interior (S \<union> T)"
     by (rule interior_mono) (rule Un_upper1)
   show "interior (S \<union> T) \<subseteq> interior S"
   proof
     fix x
     assume "x \<in> interior (S \<union> T)"
     then obtain R where "open R" "x \<in> R" "R \<subseteq> S \<union> T" ..
     show "x \<in> interior S"
     proof (rule ccontr)
       assume "x \<notin> interior S"
       with \<open>x \<in> R\<close> \<open>open R\<close> obtain y where "y \<in> R - S"
         unfolding interior_def by fast
       from \<open>open R\<close> \<open>closed S\<close> have "open (R - S)"
         by (rule open_Diff)
       from \<open>R \<subseteq> S \<union> T\<close> have "R - S \<subseteq> T"
         by fast
       from \<open>y \<in> R - S\<close> \<open>open (R - S)\<close> \<open>R - S \<subseteq> T\<close> \<open>interior T = {}\<close> show False
         unfolding interior_def by fast
     qed
   qed
 qed
 
 lemma interior_Times: "interior (A \<times> B) = interior A \<times> interior B"
 proof (rule interior_unique)
   show "interior A \<times> interior B \<subseteq> A \<times> B"
     by (intro Sigma_mono interior_subset)
   show "open (interior A \<times> interior B)"
     by (intro open_Times open_interior)
   fix T
   assume "T \<subseteq> A \<times> B" and "open T"
   then show "T \<subseteq> interior A \<times> interior B"
   proof safe
     fix x y
     assume "(x, y) \<in> T"
     then obtain C D where "open C" "open D" "C \<times> D \<subseteq> T" "x \<in> C" "y \<in> D"
       using \<open>open T\<close> unfolding open_prod_def by fast
     then have "open C" "open D" "C \<subseteq> A" "D \<subseteq> B" "x \<in> C" "y \<in> D"
       using \<open>T \<subseteq> A \<times> B\<close> by auto
     then show "x \<in> interior A" and "y \<in> interior B"
       by (auto intro: interiorI)
   qed
 qed
 
 lemma interior_Ici:
   fixes x :: "'a :: {dense_linorder,linorder_topology}"
   assumes "b < x"
   shows "interior {x ..} = {x <..}"
 proof (rule interior_unique)
   fix T
   assume "T \<subseteq> {x ..}" "open T"
   moreover have "x \<notin> T"
   proof
     assume "x \<in> T"
     obtain y where "y < x" "{y <.. x} \<subseteq> T"
       using open_left[OF \<open>open T\<close> \<open>x \<in> T\<close> \<open>b < x\<close>] by auto
     with dense[OF \<open>y < x\<close>] obtain z where "z \<in> T" "z < x"
       by (auto simp: subset_eq Ball_def)
     with \<open>T \<subseteq> {x ..}\<close> show False by auto
   qed
   ultimately show "T \<subseteq> {x <..}"
     by (auto simp: subset_eq less_le)
 qed auto
 
 lemma interior_Iic:
   fixes x :: "'a ::{dense_linorder,linorder_topology}"
   assumes "x < b"
   shows "interior {.. x} = {..< x}"
 proof (rule interior_unique)
   fix T
   assume "T \<subseteq> {.. x}" "open T"
   moreover have "x \<notin> T"
   proof
     assume "x \<in> T"
     obtain y where "x < y" "{x ..< y} \<subseteq> T"
       using open_right[OF \<open>open T\<close> \<open>x \<in> T\<close> \<open>x < b\<close>] by auto
     with dense[OF \<open>x < y\<close>] obtain z where "z \<in> T" "x < z"
       by (auto simp: subset_eq Ball_def less_le)
     with \<open>T \<subseteq> {.. x}\<close> show False by auto
   qed
   ultimately show "T \<subseteq> {..< x}"
     by (auto simp: subset_eq less_le)
 qed auto
 
 lemma countable_disjoint_nonempty_interior_subsets:
   fixes \<F> :: "'a::second_countable_topology set set"
   assumes pw: "pairwise disjnt \<F>" and int: "\<And>S. \<lbrakk>S \<in> \<F>; interior S = {}\<rbrakk> \<Longrightarrow> S = {}"
   shows "countable \<F>"
 proof (rule countable_image_inj_on)
   have "disjoint (interior ` \<F>)"
     using pw by (simp add: disjoint_image_subset interior_subset)
   then show "countable (interior ` \<F>)"
     by (auto intro: countable_disjoint_open_subsets)
   show "inj_on interior \<F>"
     using pw apply (clarsimp simp: inj_on_def pairwise_def)
     apply (metis disjnt_def disjnt_subset1 inf.orderE int interior_subset)
     done
 qed
 
 subsection \<open>Closure of a Set\<close>
 
 definition\<^marker>\<open>tag important\<close> closure :: "('a::topological_space) set \<Rightarrow> 'a set" where
 "closure S = S \<union> {x . x islimpt S}"
 
 lemma interior_closure: "interior S = - (closure (- S))"
   by (auto simp: interior_def closure_def islimpt_def)
 
 lemma closure_interior: "closure S = - interior (- S)"
   by (simp add: interior_closure)
 
 lemma closed_closure[simp, intro]: "closed (closure S)"
   by (simp add: closure_interior closed_Compl)
 
 lemma closure_subset: "S \<subseteq> closure S"
   by (simp add: closure_def)
 
 lemma closure_hull: "closure S = closed hull S"
   by (auto simp: hull_def closure_interior interior_def)
 
 lemma closure_eq: "closure S = S \<longleftrightarrow> closed S"
   unfolding closure_hull using closed_Inter by (rule hull_eq)
 
 lemma closure_closed [simp]: "closed S \<Longrightarrow> closure S = S"
   by (simp only: closure_eq)
 
 lemma closure_closure [simp]: "closure (closure S) = closure S"
   unfolding closure_hull by (rule hull_hull)
 
 lemma closure_mono: "S \<subseteq> T \<Longrightarrow> closure S \<subseteq> closure T"
   unfolding closure_hull by (rule hull_mono)
 
 lemma closure_minimal: "S \<subseteq> T \<Longrightarrow> closed T \<Longrightarrow> closure S \<subseteq> T"
   unfolding closure_hull by (rule hull_minimal)
 
 lemma closure_unique:
   assumes "S \<subseteq> T"
     and "closed T"
     and "\<And>T'. S \<subseteq> T' \<Longrightarrow> closed T' \<Longrightarrow> T \<subseteq> T'"
   shows "closure S = T"
   using assms unfolding closure_hull by (rule hull_unique)
 
 lemma closure_empty [simp]: "closure {} = {}"
   using closed_empty by (rule closure_closed)
 
 lemma closure_UNIV [simp]: "closure UNIV = UNIV"
   using closed_UNIV by (rule closure_closed)
 
 lemma closure_Un [simp]: "closure (S \<union> T) = closure S \<union> closure T"
   by (simp add: closure_interior)
 
 lemma closure_eq_empty [iff]: "closure S = {} \<longleftrightarrow> S = {}"
   using closure_empty closure_subset[of S] by blast
 
 lemma closure_subset_eq: "closure S \<subseteq> S \<longleftrightarrow> closed S"
   using closure_eq[of S] closure_subset[of S] by simp
 
 lemma open_Int_closure_eq_empty: "open S \<Longrightarrow> (S \<inter> closure T) = {} \<longleftrightarrow> S \<inter> T = {}"
   using open_subset_interior[of S "- T"]
   using interior_subset[of "- T"]
   by (auto simp: closure_interior)
 
 lemma open_Int_closure_subset: "open S \<Longrightarrow> S \<inter> closure T \<subseteq> closure (S \<inter> T)"
 proof
   fix x
   assume *: "open S" "x \<in> S \<inter> closure T"
   have "x islimpt (S \<inter> T)" if **: "x islimpt T"
   proof (rule islimptI)
     fix A
     assume "x \<in> A" "open A"
     with * have "x \<in> A \<inter> S" "open (A \<inter> S)"
       by (simp_all add: open_Int)
     with ** obtain y where "y \<in> T" "y \<in> A \<inter> S" "y \<noteq> x"
       by (rule islimptE)
     then have "y \<in> S \<inter> T" "y \<in> A \<and> y \<noteq> x"
       by simp_all
     then show "\<exists>y\<in>(S \<inter> T). y \<in> A \<and> y \<noteq> x" ..
   qed
   with * show "x \<in> closure (S \<inter> T)"
     unfolding closure_def by blast
 qed
 
 lemma closure_complement: "closure (- S) = - interior S"
   by (simp add: closure_interior)
 
 lemma interior_complement: "interior (- S) = - closure S"
   by (simp add: closure_interior)
 
 lemma interior_diff: "interior(S - T) = interior S - closure T"
   by (simp add: Diff_eq interior_complement)
 
 lemma closure_Times: "closure (A \<times> B) = closure A \<times> closure B"
 proof (rule closure_unique)
   show "A \<times> B \<subseteq> closure A \<times> closure B"
     by (intro Sigma_mono closure_subset)
   show "closed (closure A \<times> closure B)"
     by (intro closed_Times closed_closure)
   fix T
   assume "A \<times> B \<subseteq> T" and "closed T"
   then show "closure A \<times> closure B \<subseteq> T"
     apply (simp add: closed_def open_prod_def, clarify)
     apply (rule ccontr)
     apply (drule_tac x="(a, b)" in bspec, simp, clarify, rename_tac C D)
     apply (simp add: closure_interior interior_def)
     apply (drule_tac x=C in spec)
     apply (drule_tac x=D in spec, auto)
     done
 qed
 
 lemma islimpt_in_closure: "(x islimpt S) = (x\<in>closure(S-{x}))"
   unfolding closure_def using islimpt_punctured by blast
 
 lemma connected_imp_connected_closure: "connected S \<Longrightarrow> connected (closure S)"
   by (rule connectedI) (meson closure_subset open_Int open_Int_closure_eq_empty subset_trans connectedD)
 
 lemma bdd_below_closure:
   fixes A :: "real set"
   assumes "bdd_below A"
   shows "bdd_below (closure A)"
 proof -
   from assms obtain m where "\<And>x. x \<in> A \<Longrightarrow> m \<le> x"
     by (auto simp: bdd_below_def)
   then have "A \<subseteq> {m..}" by auto
   then have "closure A \<subseteq> {m..}"
     using closed_real_atLeast by (rule closure_minimal)
   then show ?thesis
     by (auto simp: bdd_below_def)
 qed
 
 
 subsection \<open>Frontier (also known as boundary)\<close>
 
 definition\<^marker>\<open>tag important\<close> frontier :: "('a::topological_space) set \<Rightarrow> 'a set" where
 "frontier S = closure S - interior S"
 
 lemma frontier_closed [iff]: "closed (frontier S)"
   by (simp add: frontier_def closed_Diff)
 
 lemma frontier_closures: "frontier S = closure S \<inter> closure (- S)"
   by (auto simp: frontier_def interior_closure)
 
 lemma frontier_Int: "frontier(S \<inter> T) = closure(S \<inter> T) \<inter> (frontier S \<union> frontier T)"
 proof -
   have "closure (S \<inter> T) \<subseteq> closure S" "closure (S \<inter> T) \<subseteq> closure T"
     by (simp_all add: closure_mono)
   then show ?thesis
     by (auto simp: frontier_closures)
 qed
 
 lemma frontier_Int_subset: "frontier(S \<inter> T) \<subseteq> frontier S \<union> frontier T"
   by (auto simp: frontier_Int)
 
 lemma frontier_Int_closed:
   assumes "closed S" "closed T"
   shows "frontier(S \<inter> T) = (frontier S \<inter> T) \<union> (S \<inter> frontier T)"
 proof -
   have "closure (S \<inter> T) = T \<inter> S"
     using assms by (simp add: Int_commute closed_Int)
   moreover have "T \<inter> (closure S \<inter> closure (- S)) = frontier S \<inter> T"
     by (simp add: Int_commute frontier_closures)
   ultimately show ?thesis
     by (simp add: Int_Un_distrib Int_assoc Int_left_commute assms frontier_closures)
 qed
 
 lemma frontier_subset_closed: "closed S \<Longrightarrow> frontier S \<subseteq> S"
   by (metis frontier_def closure_closed Diff_subset)
 
 lemma frontier_empty [simp]: "frontier {} = {}"
   by (simp add: frontier_def)
 
 lemma frontier_subset_eq: "frontier S \<subseteq> S \<longleftrightarrow> closed S"
 proof -
   {
     assume "frontier S \<subseteq> S"
     then have "closure S \<subseteq> S"
       using interior_subset unfolding frontier_def by auto
     then have "closed S"
       using closure_subset_eq by auto
   }
   then show ?thesis using frontier_subset_closed[of S] ..
 qed
 
 lemma frontier_complement [simp]: "frontier (- S) = frontier S"
   by (auto simp: frontier_def closure_complement interior_complement)
 
 lemma frontier_Un_subset: "frontier(S \<union> T) \<subseteq> frontier S \<union> frontier T"
   by (metis compl_sup frontier_Int_subset frontier_complement)
 
 lemma frontier_disjoint_eq: "frontier S \<inter> S = {} \<longleftrightarrow> open S"
   using frontier_complement frontier_subset_eq[of "- S"]
   unfolding open_closed by auto
 
 lemma frontier_UNIV [simp]: "frontier UNIV = {}"
   using frontier_complement frontier_empty by fastforce
 
 lemma frontier_interiors: "frontier s = - interior(s) - interior(-s)"
   by (simp add: Int_commute frontier_def interior_closure)
 
 lemma frontier_interior_subset: "frontier(interior S) \<subseteq> frontier S"
   by (simp add: Diff_mono frontier_interiors interior_mono interior_subset)
 
 lemma closure_Un_frontier: "closure S = S \<union> frontier S"
 proof -
   have "S \<union> interior S = S"
     using interior_subset by auto
   then show ?thesis
     using closure_subset by (auto simp: frontier_def)
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Filters and the ``eventually true'' quantifier\<close>
 
 text \<open>Identify Trivial limits, where we can't approach arbitrarily closely.\<close>
 
 lemma trivial_limit_within: "trivial_limit (at a within S) \<longleftrightarrow> \<not> a islimpt S"
 proof
   assume "trivial_limit (at a within S)"
   then show "\<not> a islimpt S"
     unfolding trivial_limit_def
     unfolding eventually_at_topological
     unfolding islimpt_def
     apply (clarsimp simp add: set_eq_iff)
     apply (rename_tac T, rule_tac x=T in exI)
     apply (clarsimp, drule_tac x=y in bspec, simp_all)
     done
 next
   assume "\<not> a islimpt S"
   then show "trivial_limit (at a within S)"
     unfolding trivial_limit_def eventually_at_topological islimpt_def
     by metis
 qed
 
 lemma trivial_limit_at_iff: "trivial_limit (at a) \<longleftrightarrow> \<not> a islimpt UNIV"
   using trivial_limit_within [of a UNIV] by simp
 
 lemma trivial_limit_at: "\<not> trivial_limit (at a)"
   for a :: "'a::perfect_space"
   by (rule at_neq_bot)
 
 lemma not_trivial_limit_within: "\<not> trivial_limit (at x within S) = (x \<in> closure (S - {x}))"
   using islimpt_in_closure by (metis trivial_limit_within)
 
 lemma not_in_closure_trivial_limitI:
   "x \<notin> closure s \<Longrightarrow> trivial_limit (at x within s)"
   using not_trivial_limit_within[of x s]
   by safe (metis Diff_empty Diff_insert0 closure_subset contra_subsetD)
 
 lemma filterlim_at_within_closure_implies_filterlim: "filterlim f l (at x within s)"
   if "x \<in> closure s \<Longrightarrow> filterlim f l (at x within s)"
   by (metis bot.extremum filterlim_filtercomap filterlim_mono not_in_closure_trivial_limitI that)
 
 lemma at_within_eq_bot_iff: "at c within A = bot \<longleftrightarrow> c \<notin> closure (A - {c})"
   using not_trivial_limit_within[of c A] by blast
 
 text \<open>Some property holds "sufficiently close" to the limit point.\<close>
 
 lemma trivial_limit_eventually: "trivial_limit net \<Longrightarrow> eventually P net"
   by simp
 
 lemma trivial_limit_eq: "trivial_limit net \<longleftrightarrow> (\<forall>P. eventually P net)"
   by (simp add: filter_eq_iff)
 
 lemma Lim_topological:
   "(f \<longlongrightarrow> l) net \<longleftrightarrow>
     trivial_limit net \<or> (\<forall>S. open S \<longrightarrow> l \<in> S \<longrightarrow> eventually (\<lambda>x. f x \<in> S) net)"
   unfolding tendsto_def trivial_limit_eq by auto
 
 lemma eventually_within_Un:
   "eventually P (at x within (s \<union> t)) \<longleftrightarrow>
     eventually P (at x within s) \<and> eventually P (at x within t)"
   unfolding eventually_at_filter
   by (auto elim!: eventually_rev_mp)
 
 lemma Lim_within_union:
  "(f \<longlongrightarrow> l) (at x within (s \<union> t)) \<longleftrightarrow>
   (f \<longlongrightarrow> l) (at x within s) \<and> (f \<longlongrightarrow> l) (at x within t)"
   unfolding tendsto_def
   by (auto simp: eventually_within_Un)
 
 
 subsection \<open>Limits\<close>
 
 text \<open>The expected monotonicity property.\<close>
 
 lemma Lim_Un:
   assumes "(f \<longlongrightarrow> l) (at x within S)" "(f \<longlongrightarrow> l) (at x within T)"
   shows "(f \<longlongrightarrow> l) (at x within (S \<union> T))"
   using assms unfolding at_within_union by (rule filterlim_sup)
 
 lemma Lim_Un_univ:
   "(f \<longlongrightarrow> l) (at x within S) \<Longrightarrow> (f \<longlongrightarrow> l) (at x within T) \<Longrightarrow>
     S \<union> T = UNIV \<Longrightarrow> (f \<longlongrightarrow> l) (at x)"
   by (metis Lim_Un)
 
 text \<open>Interrelations between restricted and unrestricted limits.\<close>
 
 lemma Lim_at_imp_Lim_at_within: "(f \<longlongrightarrow> l) (at x) \<Longrightarrow> (f \<longlongrightarrow> l) (at x within S)"
   by (metis order_refl filterlim_mono subset_UNIV at_le)
 
 lemma eventually_within_interior:
   assumes "x \<in> interior S"
   shows "eventually P (at x within S) \<longleftrightarrow> eventually P (at x)"
   (is "?lhs = ?rhs")
 proof
   from assms obtain T where T: "open T" "x \<in> T" "T \<subseteq> S" ..
   {
     assume ?lhs
     then obtain A where "open A" and "x \<in> A" and "\<forall>y\<in>A. y \<noteq> x \<longrightarrow> y \<in> S \<longrightarrow> P y"
       by (auto simp: eventually_at_topological)
     with T have "open (A \<inter> T)" and "x \<in> A \<inter> T" and "\<forall>y \<in> A \<inter> T. y \<noteq> x \<longrightarrow> P y"
       by auto
     then show ?rhs
       by (auto simp: eventually_at_topological)
   next
     assume ?rhs
     then show ?lhs
       by (auto elim: eventually_mono simp: eventually_at_filter)
   }
 qed
 
 lemma at_within_interior: "x \<in> interior S \<Longrightarrow> at x within S = at x"
   unfolding filter_eq_iff by (intro allI eventually_within_interior)
 
 lemma Lim_within_LIMSEQ:
   fixes a :: "'a::first_countable_topology"
   assumes "\<forall>S. (\<forall>n. S n \<noteq> a \<and> S n \<in> T) \<and> S \<longlonglongrightarrow> a \<longrightarrow> (\<lambda>n. X (S n)) \<longlonglongrightarrow> L"
   shows "(X \<longlongrightarrow> L) (at a within T)"
   using assms unfolding tendsto_def [where l=L]
   by (simp add: sequentially_imp_eventually_within)
 
 lemma Lim_right_bound:
   fixes f :: "'a :: {linorder_topology, conditionally_complete_linorder, no_top} \<Rightarrow>
     'b::{linorder_topology, conditionally_complete_linorder}"
   assumes mono: "\<And>a b. a \<in> I \<Longrightarrow> b \<in> I \<Longrightarrow> x < a \<Longrightarrow> a \<le> b \<Longrightarrow> f a \<le> f b"
     and bnd: "\<And>a. a \<in> I \<Longrightarrow> x < a \<Longrightarrow> K \<le> f a"
   shows "(f \<longlongrightarrow> Inf (f ` ({x<..} \<inter> I))) (at x within ({x<..} \<inter> I))"
 proof (cases "{x<..} \<inter> I = {}")
   case True
   then show ?thesis by simp
 next
   case False
   show ?thesis
   proof (rule order_tendstoI)
     fix a
     assume a: "a < Inf (f ` ({x<..} \<inter> I))"
     {
       fix y
       assume "y \<in> {x<..} \<inter> I"
       with False bnd have "Inf (f ` ({x<..} \<inter> I)) \<le> f y"
         by (auto intro!: cInf_lower bdd_belowI2)
       with a have "a < f y"
         by (blast intro: less_le_trans)
     }
     then show "eventually (\<lambda>x. a < f x) (at x within ({x<..} \<inter> I))"
       by (auto simp: eventually_at_filter intro: exI[of _ 1] zero_less_one)
   next
     fix a
     assume "Inf (f ` ({x<..} \<inter> I)) < a"
     from cInf_lessD[OF _ this] False obtain y where y: "x < y" "y \<in> I" "f y < a"
       by auto
     then have "eventually (\<lambda>x. x \<in> I \<longrightarrow> f x < a) (at_right x)"
       unfolding eventually_at_right[OF \<open>x < y\<close>] by (metis less_imp_le le_less_trans mono)
     then show "eventually (\<lambda>x. f x < a) (at x within ({x<..} \<inter> I))"
       unfolding eventually_at_filter by eventually_elim simp
   qed
 qed
 
 (*could prove directly from islimpt_sequential_inj, but only for metric spaces*)
 lemma islimpt_sequential:
   fixes x :: "'a::first_countable_topology"
   shows "x islimpt S \<longleftrightarrow> (\<exists>f. (\<forall>n::nat. f n \<in> S - {x}) \<and> (f \<longlongrightarrow> x) sequentially)"
     (is "?lhs = ?rhs")
 proof
   assume ?lhs
   from countable_basis_at_decseq[of x] obtain A where A:
       "\<And>i. open (A i)"
       "\<And>i. x \<in> A i"
       "\<And>S. open S \<Longrightarrow> x \<in> S \<Longrightarrow> eventually (\<lambda>i. A i \<subseteq> S) sequentially"
     by blast
   define f where "f n = (SOME y. y \<in> S \<and> y \<in> A n \<and> x \<noteq> y)" for n
   {
     fix n
     from \<open>?lhs\<close> have "\<exists>y. y \<in> S \<and> y \<in> A n \<and> x \<noteq> y"
       unfolding islimpt_def using A(1,2)[of n] by auto
     then have "f n \<in> S \<and> f n \<in> A n \<and> x \<noteq> f n"
       unfolding f_def by (rule someI_ex)
     then have "f n \<in> S" "f n \<in> A n" "x \<noteq> f n" by auto
   }
   then have "\<forall>n. f n \<in> S - {x}" by auto
   moreover have "(\<lambda>n. f n) \<longlonglongrightarrow> x"
   proof (rule topological_tendstoI)
     fix S
     assume "open S" "x \<in> S"
     from A(3)[OF this] \<open>\<And>n. f n \<in> A n\<close>
     show "eventually (\<lambda>x. f x \<in> S) sequentially"
       by (auto elim!: eventually_mono)
   qed
   ultimately show ?rhs by fast
 next
   assume ?rhs
   then obtain f :: "nat \<Rightarrow> 'a" where f: "\<And>n. f n \<in> S - {x}" and lim: "f \<longlonglongrightarrow> x"
     by auto
   show ?lhs
     unfolding islimpt_def
   proof safe
     fix T
     assume "open T" "x \<in> T"
     from lim[THEN topological_tendstoD, OF this] f
     show "\<exists>y\<in>S. y \<in> T \<and> y \<noteq> x"
       unfolding eventually_sequentially by auto
   qed
 qed
 
 text\<open>These are special for limits out of the same topological space.\<close>
 
 lemma Lim_within_id: "(id \<longlongrightarrow> a) (at a within s)"
   unfolding id_def by (rule tendsto_ident_at)
 
 lemma Lim_at_id: "(id \<longlongrightarrow> a) (at a)"
   unfolding id_def by (rule tendsto_ident_at)
 
 text\<open>It's also sometimes useful to extract the limit point from the filter.\<close>
 
 abbreviation netlimit :: "'a::t2_space filter \<Rightarrow> 'a"
   where "netlimit F \<equiv> Lim F (\<lambda>x. x)"
 
 lemma netlimit_at [simp]:
   fixes a :: "'a::{perfect_space,t2_space}"
   shows "netlimit (at a) = a"
   using Lim_ident_at [of a UNIV] by simp
 
 lemma lim_within_interior:
   "x \<in> interior S \<Longrightarrow> (f \<longlongrightarrow> l) (at x within S) \<longleftrightarrow> (f \<longlongrightarrow> l) (at x)"
   by (metis at_within_interior)
 
 lemma netlimit_within_interior:
   fixes x :: "'a::{t2_space,perfect_space}"
   assumes "x \<in> interior S"
   shows "netlimit (at x within S) = x"
   using assms by (metis at_within_interior netlimit_at)
 
 text\<open>Useful lemmas on closure and set of possible sequential limits.\<close>
 
 lemma closure_sequential:
   fixes l :: "'a::first_countable_topology"
   shows "l \<in> closure S \<longleftrightarrow> (\<exists>x. (\<forall>n. x n \<in> S) \<and> (x \<longlongrightarrow> l) sequentially)"
   (is "?lhs = ?rhs")
 proof
   assume "?lhs"
   moreover
   {
     assume "l \<in> S"
     then have "?rhs" using tendsto_const[of l sequentially] by auto
   }
   moreover
   {
     assume "l islimpt S"
     then have "?rhs" unfolding islimpt_sequential by auto
   }
   ultimately show "?rhs"
     unfolding closure_def by auto
 next
   assume "?rhs"
   then show "?lhs" unfolding closure_def islimpt_sequential by auto
 qed
 
 lemma closed_sequential_limits:
   fixes S :: "'a::first_countable_topology set"
   shows "closed S \<longleftrightarrow> (\<forall>x l. (\<forall>n. x n \<in> S) \<and> (x \<longlongrightarrow> l) sequentially \<longrightarrow> l \<in> S)"
 by (metis closure_sequential closure_subset_eq subset_iff)
 
 lemma tendsto_If_within_closures:
   assumes f: "x \<in> s \<union> (closure s \<inter> closure t) \<Longrightarrow>
       (f \<longlongrightarrow> l x) (at x within s \<union> (closure s \<inter> closure t))"
   assumes g: "x \<in> t \<union> (closure s \<inter> closure t) \<Longrightarrow>
       (g \<longlongrightarrow> l x) (at x within t \<union> (closure s \<inter> closure t))"
   assumes "x \<in> s \<union> t"
   shows "((\<lambda>x. if x \<in> s then f x else g x) \<longlongrightarrow> l x) (at x within s \<union> t)"
 proof -
   have *: "(s \<union> t) \<inter> {x. x \<in> s} = s" "(s \<union> t) \<inter> {x. x \<notin> s} = t - s"
     by auto
   have "(f \<longlongrightarrow> l x) (at x within s)"
     by (rule filterlim_at_within_closure_implies_filterlim)
        (use \<open>x \<in> _\<close> in \<open>auto simp: inf_commute closure_def intro: tendsto_within_subset[OF f]\<close>)
   moreover
   have "(g \<longlongrightarrow> l x) (at x within t - s)"
     by (rule filterlim_at_within_closure_implies_filterlim)
       (use \<open>x \<in> _\<close> in
         \<open>auto intro!: tendsto_within_subset[OF g] simp: closure_def intro: islimpt_subset\<close>)
   ultimately show ?thesis
     by (intro filterlim_at_within_If) (simp_all only: *)
 qed
 
 
 subsection \<open>Compactness\<close>
 
 lemma brouwer_compactness_lemma:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::real_normed_vector"
   assumes "compact s"
     and "continuous_on s f"
     and "\<not> (\<exists>x\<in>s. f x = 0)"
   obtains d where "0 < d" and "\<forall>x\<in>s. d \<le> norm (f x)"
 proof (cases "s = {}")
   case True
   show thesis
     by (rule that [of 1]) (auto simp: True)
 next
   case False
   have "continuous_on s (norm \<circ> f)"
     by (rule continuous_intros continuous_on_norm assms(2))+
   with False obtain x where x: "x \<in> s" "\<forall>y\<in>s. (norm \<circ> f) x \<le> (norm \<circ> f) y"
     using continuous_attains_inf[OF assms(1), of "norm \<circ> f"]
     unfolding o_def
     by auto
   have "(norm \<circ> f) x > 0"
     using assms(3) and x(1)
     by auto
   then show ?thesis
     by (rule that) (insert x(2), auto simp: o_def)
 qed
 
 subsubsection \<open>Bolzano-Weierstrass property\<close>
 
 proposition Heine_Borel_imp_Bolzano_Weierstrass:
   assumes "compact s"
     and "infinite t"
     and "t \<subseteq> s"
   shows "\<exists>x \<in> s. x islimpt t"
 proof (rule ccontr)
   assume "\<not> (\<exists>x \<in> s. x islimpt t)"
   then obtain f where f: "\<forall>x\<in>s. x \<in> f x \<and> open (f x) \<and> (\<forall>y\<in>t. y \<in> f x \<longrightarrow> y = x)"
     unfolding islimpt_def
     using bchoice[of s "\<lambda> x T. x \<in> T \<and> open T \<and> (\<forall>y\<in>t. y \<in> T \<longrightarrow> y = x)"]
     by auto
   obtain g where g: "g \<subseteq> {t. \<exists>x. x \<in> s \<and> t = f x}" "finite g" "s \<subseteq> \<Union>g"
     using assms(1)[unfolded compact_eq_Heine_Borel, THEN spec[where x="{t. \<exists>x. x\<in>s \<and> t = f x}"]]
     using f by auto
   from g(1,3) have g':"\<forall>x\<in>g. \<exists>xa \<in> s. x = f xa"
     by auto
   {
     fix x y
     assume "x \<in> t" "y \<in> t" "f x = f y"
     then have "x \<in> f x"  "y \<in> f x \<longrightarrow> y = x"
       using f[THEN bspec[where x=x]] and \<open>t \<subseteq> s\<close> by auto
     then have "x = y"
       using \<open>f x = f y\<close> and f[THEN bspec[where x=y]] and \<open>y \<in> t\<close> and \<open>t \<subseteq> s\<close>
       by auto
   }
   then have "inj_on f t"
     unfolding inj_on_def by simp
   then have "infinite (f ` t)"
     using assms(2) using finite_imageD by auto
   moreover
   {
     fix x
     assume "x \<in> t" "f x \<notin> g"
     from g(3) assms(3) \<open>x \<in> t\<close> obtain h where "h \<in> g" and "x \<in> h"
       by auto
     then obtain y where "y \<in> s" "h = f y"
       using g'[THEN bspec[where x=h]] by auto
     then have "y = x"
       using f[THEN bspec[where x=y]] and \<open>x\<in>t\<close> and \<open>x\<in>h\<close>[unfolded \<open>h = f y\<close>]
       by auto
     then have False
       using \<open>f x \<notin> g\<close> \<open>h \<in> g\<close> unfolding \<open>h = f y\<close>
       by auto
   }
   then have "f ` t \<subseteq> g" by auto
   ultimately show False
     using g(2) using finite_subset by auto
 qed
 
 lemma sequence_infinite_lemma:
   fixes f :: "nat \<Rightarrow> 'a::t1_space"
   assumes "\<forall>n. f n \<noteq> l"
     and "(f \<longlongrightarrow> l) sequentially"
   shows "infinite (range f)"
 proof
   assume "finite (range f)"
   then have "closed (range f)"
     by (rule finite_imp_closed)
   then have "open (- range f)"
     by (rule open_Compl)
   from assms(1) have "l \<in> - range f"
     by auto
   from assms(2) have "eventually (\<lambda>n. f n \<in> - range f) sequentially"
     using \<open>open (- range f)\<close> \<open>l \<in> - range f\<close>
     by (rule topological_tendstoD)
   then show False
     unfolding eventually_sequentially
     by auto
 qed
 
 lemma Bolzano_Weierstrass_imp_closed:
   fixes s :: "'a::{first_countable_topology,t2_space} set"
   assumes "\<forall>t. infinite t \<and> t \<subseteq> s --> (\<exists>x \<in> s. x islimpt t)"
   shows "closed s"
 proof -
   {
     fix x l
     assume as: "\<forall>n::nat. x n \<in> s" "(x \<longlongrightarrow> l) sequentially"
     then have "l \<in> s"
     proof (cases "\<forall>n. x n \<noteq> l")
       case False
       then show "l\<in>s" using as(1) by auto
     next
       case True note cas = this
       with as(2) have "infinite (range x)"
         using sequence_infinite_lemma[of x l] by auto
       then obtain l' where "l'\<in>s" "l' islimpt (range x)"
         using assms[THEN spec[where x="range x"]] as(1) by auto
       then show "l\<in>s" using sequence_unique_limpt[of x l l']
         using as cas by auto
     qed
   }
   then show ?thesis
     unfolding closed_sequential_limits by fast
 qed
 
 lemma closure_insert:
   fixes x :: "'a::t1_space"
   shows "closure (insert x s) = insert x (closure s)"
   apply (rule closure_unique)
   apply (rule insert_mono [OF closure_subset])
   apply (rule closed_insert [OF closed_closure])
   apply (simp add: closure_minimal)
   done
 
 
 text\<open>In particular, some common special cases.\<close>
 
 lemma compact_Un [intro]:
   assumes "compact s"
     and "compact t"
   shows " compact (s \<union> t)"
 proof (rule compactI)
   fix f
   assume *: "Ball f open" "s \<union> t \<subseteq> \<Union>f"
   from * \<open>compact s\<close> obtain s' where "s' \<subseteq> f \<and> finite s' \<and> s \<subseteq> \<Union>s'"
     unfolding compact_eq_Heine_Borel by (auto elim!: allE[of _ f])
   moreover
   from * \<open>compact t\<close> obtain t' where "t' \<subseteq> f \<and> finite t' \<and> t \<subseteq> \<Union>t'"
     unfolding compact_eq_Heine_Borel by (auto elim!: allE[of _ f])
   ultimately show "\<exists>f'\<subseteq>f. finite f' \<and> s \<union> t \<subseteq> \<Union>f'"
     by (auto intro!: exI[of _ "s' \<union> t'"])
 qed
 
 lemma compact_Union [intro]: "finite S \<Longrightarrow> (\<And>T. T \<in> S \<Longrightarrow> compact T) \<Longrightarrow> compact (\<Union>S)"
   by (induct set: finite) auto
 
 lemma compact_UN [intro]:
   "finite A \<Longrightarrow> (\<And>x. x \<in> A \<Longrightarrow> compact (B x)) \<Longrightarrow> compact (\<Union>x\<in>A. B x)"
   by (rule compact_Union) auto
 
 lemma closed_Int_compact [intro]:
   assumes "closed s"
     and "compact t"
   shows "compact (s \<inter> t)"
   using compact_Int_closed [of t s] assms
   by (simp add: Int_commute)
 
 lemma compact_Int [intro]:
   fixes s t :: "'a :: t2_space set"
   assumes "compact s"
     and "compact t"
   shows "compact (s \<inter> t)"
   using assms by (intro compact_Int_closed compact_imp_closed)
 
 lemma compact_sing [simp]: "compact {a}"
   unfolding compact_eq_Heine_Borel by auto
 
 lemma compact_insert [simp]:
   assumes "compact s"
   shows "compact (insert x s)"
 proof -
   have "compact ({x} \<union> s)"
     using compact_sing assms by (rule compact_Un)
   then show ?thesis by simp
 qed
 
 lemma finite_imp_compact: "finite s \<Longrightarrow> compact s"
   by (induct set: finite) simp_all
 
 lemma open_delete:
   fixes s :: "'a::t1_space set"
   shows "open s \<Longrightarrow> open (s - {x})"
   by (simp add: open_Diff)
 
 
 text\<open>Compactness expressed with filters\<close>
 
 lemma closure_iff_nhds_not_empty:
   "x \<in> closure X \<longleftrightarrow> (\<forall>A. \<forall>S\<subseteq>A. open S \<longrightarrow> x \<in> S \<longrightarrow> X \<inter> A \<noteq> {})"
 proof safe
   assume x: "x \<in> closure X"
   fix S A
   assume "open S" "x \<in> S" "X \<inter> A = {}" "S \<subseteq> A"
   then have "x \<notin> closure (-S)"
     by (auto simp: closure_complement subset_eq[symmetric] intro: interiorI)
   with x have "x \<in> closure X - closure (-S)"
     by auto
   also have "\<dots> \<subseteq> closure (X \<inter> S)"
     using \<open>open S\<close> open_Int_closure_subset[of S X] by (simp add: closed_Compl ac_simps)
   finally have "X \<inter> S \<noteq> {}" by auto
   then show False using \<open>X \<inter> A = {}\<close> \<open>S \<subseteq> A\<close> by auto
 next
   assume "\<forall>A S. S \<subseteq> A \<longrightarrow> open S \<longrightarrow> x \<in> S \<longrightarrow> X \<inter> A \<noteq> {}"
   from this[THEN spec, of "- X", THEN spec, of "- closure X"]
   show "x \<in> closure X"
     by (simp add: closure_subset open_Compl)
 qed
 
 lemma compact_filter:
   "compact U \<longleftrightarrow> (\<forall>F. F \<noteq> bot \<longrightarrow> eventually (\<lambda>x. x \<in> U) F \<longrightarrow> (\<exists>x\<in>U. inf (nhds x) F \<noteq> bot))"
 proof (intro allI iffI impI compact_fip[THEN iffD2] notI)
   fix F
   assume "compact U"
   assume F: "F \<noteq> bot" "eventually (\<lambda>x. x \<in> U) F"
   then have "U \<noteq> {}"
     by (auto simp: eventually_False)
 
   define Z where "Z = closure ` {A. eventually (\<lambda>x. x \<in> A) F}"
   then have "\<forall>z\<in>Z. closed z"
     by auto
   moreover
   have ev_Z: "\<And>z. z \<in> Z \<Longrightarrow> eventually (\<lambda>x. x \<in> z) F"
     unfolding Z_def by (auto elim: eventually_mono intro: subsetD[OF closure_subset])
   have "(\<forall>B \<subseteq> Z. finite B \<longrightarrow> U \<inter> \<Inter>B \<noteq> {})"
   proof (intro allI impI)
     fix B assume "finite B" "B \<subseteq> Z"
     with \<open>finite B\<close> ev_Z F(2) have "eventually (\<lambda>x. x \<in> U \<inter> (\<Inter>B)) F"
       by (auto simp: eventually_ball_finite_distrib eventually_conj_iff)
     with F show "U \<inter> \<Inter>B \<noteq> {}"
       by (intro notI) (simp add: eventually_False)
   qed
   ultimately have "U \<inter> \<Inter>Z \<noteq> {}"
     using \<open>compact U\<close> unfolding compact_fip by blast
   then obtain x where "x \<in> U" and x: "\<And>z. z \<in> Z \<Longrightarrow> x \<in> z"
     by auto
 
   have "\<And>P. eventually P (inf (nhds x) F) \<Longrightarrow> P \<noteq> bot"
     unfolding eventually_inf eventually_nhds
   proof safe
     fix P Q R S
     assume "eventually R F" "open S" "x \<in> S"
     with open_Int_closure_eq_empty[of S "{x. R x}"] x[of "closure {x. R x}"]
     have "S \<inter> {x. R x} \<noteq> {}" by (auto simp: Z_def)
     moreover assume "Ball S Q" "\<forall>x. Q x \<and> R x \<longrightarrow> bot x"
     ultimately show False by (auto simp: set_eq_iff)
   qed
   with \<open>x \<in> U\<close> show "\<exists>x\<in>U. inf (nhds x) F \<noteq> bot"
     by (metis eventually_bot)
 next
   fix A
   assume A: "\<forall>a\<in>A. closed a" "\<forall>B\<subseteq>A. finite B \<longrightarrow> U \<inter> \<Inter>B \<noteq> {}" "U \<inter> \<Inter>A = {}"
   define F where "F = (INF a\<in>insert U A. principal a)"
   have "F \<noteq> bot"
     unfolding F_def
   proof (rule INF_filter_not_bot)
     fix X
     assume X: "X \<subseteq> insert U A" "finite X"
     with A(2)[THEN spec, of "X - {U}"] have "U \<inter> \<Inter>(X - {U}) \<noteq> {}"
       by auto
     with X show "(INF a\<in>X. principal a) \<noteq> bot"
       by (auto simp: INF_principal_finite principal_eq_bot_iff)
   qed
   moreover
   have "F \<le> principal U"
     unfolding F_def by auto
   then have "eventually (\<lambda>x. x \<in> U) F"
     by (auto simp: le_filter_def eventually_principal)
   moreover
   assume "\<forall>F. F \<noteq> bot \<longrightarrow> eventually (\<lambda>x. x \<in> U) F \<longrightarrow> (\<exists>x\<in>U. inf (nhds x) F \<noteq> bot)"
   ultimately obtain x where "x \<in> U" and x: "inf (nhds x) F \<noteq> bot"
     by auto
 
   { fix V assume "V \<in> A"
     then have "F \<le> principal V"
       unfolding F_def by (intro INF_lower2[of V]) auto
     then have V: "eventually (\<lambda>x. x \<in> V) F"
       by (auto simp: le_filter_def eventually_principal)
     have "x \<in> closure V"
       unfolding closure_iff_nhds_not_empty
     proof (intro impI allI)
       fix S A
       assume "open S" "x \<in> S" "S \<subseteq> A"
       then have "eventually (\<lambda>x. x \<in> A) (nhds x)"
         by (auto simp: eventually_nhds)
       with V have "eventually (\<lambda>x. x \<in> V \<inter> A) (inf (nhds x) F)"
         by (auto simp: eventually_inf)
       with x show "V \<inter> A \<noteq> {}"
         by (auto simp del: Int_iff simp add: trivial_limit_def)
     qed
     then have "x \<in> V"
       using \<open>V \<in> A\<close> A(1) by simp
   }
   with \<open>x\<in>U\<close> have "x \<in> U \<inter> \<Inter>A" by auto
   with \<open>U \<inter> \<Inter>A = {}\<close> show False by auto
 qed
 
 definition\<^marker>\<open>tag important\<close> countably_compact :: "('a::topological_space) set \<Rightarrow> bool" where
 "countably_compact U \<longleftrightarrow>
   (\<forall>A. countable A \<longrightarrow> (\<forall>a\<in>A. open a) \<longrightarrow> U \<subseteq> \<Union>A
      \<longrightarrow> (\<exists>T\<subseteq>A. finite T \<and> U \<subseteq> \<Union>T))"
 
 lemma countably_compactE:
   assumes "countably_compact s" and "\<forall>t\<in>C. open t" and "s \<subseteq> \<Union>C" "countable C"
   obtains C' where "C' \<subseteq> C" and "finite C'" and "s \<subseteq> \<Union>C'"
   using assms unfolding countably_compact_def by metis
 
 lemma countably_compactI:
   assumes "\<And>C. \<forall>t\<in>C. open t \<Longrightarrow> s \<subseteq> \<Union>C \<Longrightarrow> countable C \<Longrightarrow> (\<exists>C'\<subseteq>C. finite C' \<and> s \<subseteq> \<Union>C')"
   shows "countably_compact s"
   using assms unfolding countably_compact_def by metis
 
 lemma compact_imp_countably_compact: "compact U \<Longrightarrow> countably_compact U"
   by (auto simp: compact_eq_Heine_Borel countably_compact_def)
 
 lemma countably_compact_imp_compact:
   assumes "countably_compact U"
     and ccover: "countable B" "\<forall>b\<in>B. open b"
     and basis: "\<And>T x. open T \<Longrightarrow> x \<in> T \<Longrightarrow> x \<in> U \<Longrightarrow> \<exists>b\<in>B. x \<in> b \<and> b \<inter> U \<subseteq> T"
   shows "compact U"
   using \<open>countably_compact U\<close>
   unfolding compact_eq_Heine_Borel countably_compact_def
 proof safe
   fix A
   assume A: "\<forall>a\<in>A. open a" "U \<subseteq> \<Union>A"
   assume *: "\<forall>A. countable A \<longrightarrow> (\<forall>a\<in>A. open a) \<longrightarrow> U \<subseteq> \<Union>A \<longrightarrow> (\<exists>T\<subseteq>A. finite T \<and> U \<subseteq> \<Union>T)"
   moreover define C where "C = {b\<in>B. \<exists>a\<in>A. b \<inter> U \<subseteq> a}"
   ultimately have "countable C" "\<forall>a\<in>C. open a"
     unfolding C_def using ccover by auto
   moreover
   have "\<Union>A \<inter> U \<subseteq> \<Union>C"
   proof safe
     fix x a
     assume "x \<in> U" "x \<in> a" "a \<in> A"
     with basis[of a x] A obtain b where "b \<in> B" "x \<in> b" "b \<inter> U \<subseteq> a"
       by blast
     with \<open>a \<in> A\<close> show "x \<in> \<Union>C"
       unfolding C_def by auto
   qed
   then have "U \<subseteq> \<Union>C" using \<open>U \<subseteq> \<Union>A\<close> by auto
   ultimately obtain T where T: "T\<subseteq>C" "finite T" "U \<subseteq> \<Union>T"
     using * by metis
   then have "\<forall>t\<in>T. \<exists>a\<in>A. t \<inter> U \<subseteq> a"
     by (auto simp: C_def)
   then obtain f where "\<forall>t\<in>T. f t \<in> A \<and> t \<inter> U \<subseteq> f t"
     unfolding bchoice_iff Bex_def ..
   with T show "\<exists>T\<subseteq>A. finite T \<and> U \<subseteq> \<Union>T"
     unfolding C_def by (intro exI[of _ "f`T"]) fastforce
 qed
 
 proposition countably_compact_imp_compact_second_countable:
   "countably_compact U \<Longrightarrow> compact (U :: 'a :: second_countable_topology set)"
 proof (rule countably_compact_imp_compact)
   fix T and x :: 'a
   assume "open T" "x \<in> T"
   from topological_basisE[OF is_basis this] obtain b where
     "b \<in> (SOME B. countable B \<and> topological_basis B)" "x \<in> b" "b \<subseteq> T" .
   then show "\<exists>b\<in>SOME B. countable B \<and> topological_basis B. x \<in> b \<and> b \<inter> U \<subseteq> T"
     by blast
 qed (insert countable_basis topological_basis_open[OF is_basis], auto)
 
 lemma countably_compact_eq_compact:
   "countably_compact U \<longleftrightarrow> compact (U :: 'a :: second_countable_topology set)"
   using countably_compact_imp_compact_second_countable compact_imp_countably_compact by blast
 
 subsubsection\<open>Sequential compactness\<close>
 
 definition\<^marker>\<open>tag important\<close> seq_compact :: "'a::topological_space set \<Rightarrow> bool" where
 "seq_compact S \<longleftrightarrow>
   (\<forall>f. (\<forall>n. f n \<in> S)
     \<longrightarrow> (\<exists>l\<in>S. \<exists>r::nat\<Rightarrow>nat. strict_mono r \<and> ((f \<circ> r) \<longlongrightarrow> l) sequentially))"
 
 lemma seq_compactI:
   assumes "\<And>f. \<forall>n. f n \<in> S \<Longrightarrow> \<exists>l\<in>S. \<exists>r::nat\<Rightarrow>nat. strict_mono r \<and> ((f \<circ> r) \<longlongrightarrow> l) sequentially"
   shows "seq_compact S"
   unfolding seq_compact_def using assms by fast
 
 lemma seq_compactE:
   assumes "seq_compact S" "\<forall>n. f n \<in> S"
   obtains l r where "l \<in> S" "strict_mono (r :: nat \<Rightarrow> nat)" "((f \<circ> r) \<longlongrightarrow> l) sequentially"
   using assms unfolding seq_compact_def by fast
 
 lemma closed_sequentially: (* TODO: move upwards *)
   assumes "closed s" and "\<forall>n. f n \<in> s" and "f \<longlonglongrightarrow> l"
   shows "l \<in> s"
 proof (rule ccontr)
   assume "l \<notin> s"
   with \<open>closed s\<close> and \<open>f \<longlonglongrightarrow> l\<close> have "eventually (\<lambda>n. f n \<in> - s) sequentially"
     by (fast intro: topological_tendstoD)
   with \<open>\<forall>n. f n \<in> s\<close> show "False"
     by simp
 qed
 
 lemma seq_compact_Int_closed:
   assumes "seq_compact s" and "closed t"
   shows "seq_compact (s \<inter> t)"
 proof (rule seq_compactI)
   fix f assume "\<forall>n::nat. f n \<in> s \<inter> t"
   hence "\<forall>n. f n \<in> s" and "\<forall>n. f n \<in> t"
     by simp_all
   from \<open>seq_compact s\<close> and \<open>\<forall>n. f n \<in> s\<close>
   obtain l r where "l \<in> s" and r: "strict_mono r" and l: "(f \<circ> r) \<longlonglongrightarrow> l"
     by (rule seq_compactE)
   from \<open>\<forall>n. f n \<in> t\<close> have "\<forall>n. (f \<circ> r) n \<in> t"
     by simp
   from \<open>closed t\<close> and this and l have "l \<in> t"
     by (rule closed_sequentially)
   with \<open>l \<in> s\<close> and r and l show "\<exists>l\<in>s \<inter> t. \<exists>r. strict_mono r \<and> (f \<circ> r) \<longlonglongrightarrow> l"
     by fast
 qed
 
 lemma seq_compact_closed_subset:
   assumes "closed s" and "s \<subseteq> t" and "seq_compact t"
   shows "seq_compact s"
   using assms seq_compact_Int_closed [of t s] by (simp add: Int_absorb1)
 
 lemma seq_compact_imp_countably_compact:
   fixes U :: "'a :: first_countable_topology set"
   assumes "seq_compact U"
   shows "countably_compact U"
 proof (safe intro!: countably_compactI)
   fix A
   assume A: "\<forall>a\<in>A. open a" "U \<subseteq> \<Union>A" "countable A"
   have subseq: "\<And>X. range X \<subseteq> U \<Longrightarrow> \<exists>r x. x \<in> U \<and> strict_mono (r :: nat \<Rightarrow> nat) \<and> (X \<circ> r) \<longlonglongrightarrow> x"
     using \<open>seq_compact U\<close> by (fastforce simp: seq_compact_def subset_eq)
   show "\<exists>T\<subseteq>A. finite T \<and> U \<subseteq> \<Union>T"
   proof cases
     assume "finite A"
     with A show ?thesis by auto
   next
     assume "infinite A"
     then have "A \<noteq> {}" by auto
     show ?thesis
     proof (rule ccontr)
       assume "\<not> (\<exists>T\<subseteq>A. finite T \<and> U \<subseteq> \<Union>T)"
       then have "\<forall>T. \<exists>x. T \<subseteq> A \<and> finite T \<longrightarrow> (x \<in> U - \<Union>T)"
         by auto
       then obtain X' where T: "\<And>T. T \<subseteq> A \<Longrightarrow> finite T \<Longrightarrow> X' T \<in> U - \<Union>T"
         by metis
       define X where "X n = X' (from_nat_into A ` {.. n})" for n
       have X: "\<And>n. X n \<in> U - (\<Union>i\<le>n. from_nat_into A i)"
         using \<open>A \<noteq> {}\<close> unfolding X_def by (intro T) (auto intro: from_nat_into)
       then have "range X \<subseteq> U"
         by auto
       with subseq[of X] obtain r x where "x \<in> U" and r: "strict_mono r" "(X \<circ> r) \<longlonglongrightarrow> x"
         by auto
       from \<open>x\<in>U\<close> \<open>U \<subseteq> \<Union>A\<close> from_nat_into_surj[OF \<open>countable A\<close>]
       obtain n where "x \<in> from_nat_into A n" by auto
       with r(2) A(1) from_nat_into[OF \<open>A \<noteq> {}\<close>, of n]
       have "eventually (\<lambda>i. X (r i) \<in> from_nat_into A n) sequentially"
         unfolding tendsto_def by (auto simp: comp_def)
       then obtain N where "\<And>i. N \<le> i \<Longrightarrow> X (r i) \<in> from_nat_into A n"
         by (auto simp: eventually_sequentially)
       moreover from X have "\<And>i. n \<le> r i \<Longrightarrow> X (r i) \<notin> from_nat_into A n"
         by auto
       moreover from \<open>strict_mono r\<close>[THEN seq_suble, of "max n N"] have "\<exists>i. n \<le> r i \<and> N \<le> i"
         by (auto intro!: exI[of _ "max n N"])
       ultimately show False
         by auto
     qed
   qed
 qed
 
 lemma compact_imp_seq_compact:
   fixes U :: "'a :: first_countable_topology set"
   assumes "compact U"
   shows "seq_compact U"
   unfolding seq_compact_def
 proof safe
   fix X :: "nat \<Rightarrow> 'a"
   assume "\<forall>n. X n \<in> U"
   then have "eventually (\<lambda>x. x \<in> U) (filtermap X sequentially)"
     by (auto simp: eventually_filtermap)
   moreover
   have "filtermap X sequentially \<noteq> bot"
     by (simp add: trivial_limit_def eventually_filtermap)
   ultimately
   obtain x where "x \<in> U" and x: "inf (nhds x) (filtermap X sequentially) \<noteq> bot" (is "?F \<noteq> _")
     using \<open>compact U\<close> by (auto simp: compact_filter)
 
   from countable_basis_at_decseq[of x]
   obtain A where A:
       "\<And>i. open (A i)"
       "\<And>i. x \<in> A i"
       "\<And>S. open S \<Longrightarrow> x \<in> S \<Longrightarrow> eventually (\<lambda>i. A i \<subseteq> S) sequentially"
     by blast
   define s where "s n i = (SOME j. i < j \<and> X j \<in> A (Suc n))" for n i
   {
     fix n i
     have "\<exists>a. i < a \<and> X a \<in> A (Suc n)"
     proof (rule ccontr)
       assume "\<not> (\<exists>a>i. X a \<in> A (Suc n))"
       then have "\<And>a. Suc i \<le> a \<Longrightarrow> X a \<notin> A (Suc n)"
         by auto
       then have "eventually (\<lambda>x. x \<notin> A (Suc n)) (filtermap X sequentially)"
         by (auto simp: eventually_filtermap eventually_sequentially)
       moreover have "eventually (\<lambda>x. x \<in> A (Suc n)) (nhds x)"
         using A(1,2)[of "Suc n"] by (auto simp: eventually_nhds)
       ultimately have "eventually (\<lambda>x. False) ?F"
         by (auto simp: eventually_inf)
       with x show False
         by (simp add: eventually_False)
     qed
     then have "i < s n i" "X (s n i) \<in> A (Suc n)"
       unfolding s_def by (auto intro: someI2_ex)
   }
   note s = this
   define r where "r = rec_nat (s 0 0) s"
   have "strict_mono r"
     by (auto simp: r_def s strict_mono_Suc_iff)
   moreover
   have "(\<lambda>n. X (r n)) \<longlonglongrightarrow> x"
   proof (rule topological_tendstoI)
     fix S
     assume "open S" "x \<in> S"
     with A(3) have "eventually (\<lambda>i. A i \<subseteq> S) sequentially"
       by auto
     moreover
     {
       fix i
       assume "Suc 0 \<le> i"
       then have "X (r i) \<in> A i"
         by (cases i) (simp_all add: r_def s)
     }
     then have "eventually (\<lambda>i. X (r i) \<in> A i) sequentially"
       by (auto simp: eventually_sequentially)
     ultimately show "eventually (\<lambda>i. X (r i) \<in> S) sequentially"
       by eventually_elim auto
   qed
   ultimately show "\<exists>x \<in> U. \<exists>r. strict_mono r \<and> (X \<circ> r) \<longlonglongrightarrow> x"
     using \<open>x \<in> U\<close> by (auto simp: convergent_def comp_def)
 qed
 
 lemma countably_compact_imp_acc_point:
   assumes "countably_compact s"
     and "countable t"
     and "infinite t"
     and "t \<subseteq> s"
   shows "\<exists>x\<in>s. \<forall>U. x\<in>U \<and> open U \<longrightarrow> infinite (U \<inter> t)"
 proof (rule ccontr)
   define C where "C = (\<lambda>F. interior (F \<union> (- t))) ` {F. finite F \<and> F \<subseteq> t }"
   note \<open>countably_compact s\<close>
   moreover have "\<forall>t\<in>C. open t"
     by (auto simp: C_def)
   moreover
   assume "\<not> (\<exists>x\<in>s. \<forall>U. x\<in>U \<and> open U \<longrightarrow> infinite (U \<inter> t))"
   then have s: "\<And>x. x \<in> s \<Longrightarrow> \<exists>U. x\<in>U \<and> open U \<and> finite (U \<inter> t)" by metis
   have "s \<subseteq> \<Union>C"
     using \<open>t \<subseteq> s\<close>
     unfolding C_def
     apply (safe dest!: s)
     apply (rule_tac a="U \<inter> t" in UN_I)
     apply (auto intro!: interiorI simp add: finite_subset)
     done
   moreover
   from \<open>countable t\<close> have "countable C"
     unfolding C_def by (auto intro: countable_Collect_finite_subset)
   ultimately
   obtain D where "D \<subseteq> C" "finite D" "s \<subseteq> \<Union>D"
     by (rule countably_compactE)
   then obtain E where E: "E \<subseteq> {F. finite F \<and> F \<subseteq> t }" "finite E"
     and s: "s \<subseteq> (\<Union>F\<in>E. interior (F \<union> (- t)))"
     by (metis (lifting) finite_subset_image C_def)
   from s \<open>t \<subseteq> s\<close> have "t \<subseteq> \<Union>E"
     using interior_subset by blast
   moreover have "finite (\<Union>E)"
     using E by auto
   ultimately show False using \<open>infinite t\<close>
     by (auto simp: finite_subset)
 qed
 
 lemma countable_acc_point_imp_seq_compact:
   fixes s :: "'a::first_countable_topology set"
   assumes "\<forall>t. infinite t \<and> countable t \<and> t \<subseteq> s \<longrightarrow>
     (\<exists>x\<in>s. \<forall>U. x\<in>U \<and> open U \<longrightarrow> infinite (U \<inter> t))"
   shows "seq_compact s"
 proof -
   {
     fix f :: "nat \<Rightarrow> 'a"
     assume f: "\<forall>n. f n \<in> s"
     have "\<exists>l\<in>s. \<exists>r. strict_mono r \<and> ((f \<circ> r) \<longlongrightarrow> l) sequentially"
     proof (cases "finite (range f)")
       case True
       obtain l where "infinite {n. f n = f l}"
         using pigeonhole_infinite[OF _ True] by auto
       then obtain r :: "nat \<Rightarrow> nat" where "strict_mono  r" and fr: "\<forall>n. f (r n) = f l"
         using infinite_enumerate by blast
       then have "strict_mono r \<and> (f \<circ> r) \<longlonglongrightarrow> f l"
         by (simp add: fr o_def)
       with f show "\<exists>l\<in>s. \<exists>r. strict_mono  r \<and> (f \<circ> r) \<longlonglongrightarrow> l"
         by auto
     next
       case False
       with f assms have "\<exists>x\<in>s. \<forall>U. x\<in>U \<and> open U \<longrightarrow> infinite (U \<inter> range f)"
         by auto
       then obtain l where "l \<in> s" "\<forall>U. l\<in>U \<and> open U \<longrightarrow> infinite (U \<inter> range f)" ..
       from this(2) have "\<exists>r. strict_mono r \<and> ((f \<circ> r) \<longlongrightarrow> l) sequentially"
         using acc_point_range_imp_convergent_subsequence[of l f] by auto
       with \<open>l \<in> s\<close> show "\<exists>l\<in>s. \<exists>r. strict_mono r \<and> ((f \<circ> r) \<longlongrightarrow> l) sequentially" ..
     qed
   }
   then show ?thesis
     unfolding seq_compact_def by auto
 qed
 
 lemma seq_compact_eq_countably_compact:
   fixes U :: "'a :: first_countable_topology set"
   shows "seq_compact U \<longleftrightarrow> countably_compact U"
   using
     countable_acc_point_imp_seq_compact
     countably_compact_imp_acc_point
     seq_compact_imp_countably_compact
   by metis
 
 lemma seq_compact_eq_acc_point:
   fixes s :: "'a :: first_countable_topology set"
   shows "seq_compact s \<longleftrightarrow>
     (\<forall>t. infinite t \<and> countable t \<and> t \<subseteq> s --> (\<exists>x\<in>s. \<forall>U. x\<in>U \<and> open U \<longrightarrow> infinite (U \<inter> t)))"
   using
     countable_acc_point_imp_seq_compact[of s]
     countably_compact_imp_acc_point[of s]
     seq_compact_imp_countably_compact[of s]
   by metis
 
 lemma seq_compact_eq_compact:
   fixes U :: "'a :: second_countable_topology set"
   shows "seq_compact U \<longleftrightarrow> compact U"
   using seq_compact_eq_countably_compact countably_compact_eq_compact by blast
 
 proposition Bolzano_Weierstrass_imp_seq_compact:
   fixes s :: "'a::{t1_space, first_countable_topology} set"
   shows "\<forall>t. infinite t \<and> t \<subseteq> s \<longrightarrow> (\<exists>x \<in> s. x islimpt t) \<Longrightarrow> seq_compact s"
   by (rule countable_acc_point_imp_seq_compact) (metis islimpt_eq_acc_point)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Cartesian products\<close>
 
 lemma seq_compact_Times: "seq_compact s \<Longrightarrow> seq_compact t \<Longrightarrow> seq_compact (s \<times> t)"
   unfolding seq_compact_def
   apply clarify
   apply (drule_tac x="fst \<circ> f" in spec)
   apply (drule mp, simp add: mem_Times_iff)
   apply (clarify, rename_tac l1 r1)
   apply (drule_tac x="snd \<circ> f \<circ> r1" in spec)
   apply (drule mp, simp add: mem_Times_iff)
   apply (clarify, rename_tac l2 r2)
   apply (rule_tac x="(l1, l2)" in rev_bexI, simp)
   apply (rule_tac x="r1 \<circ> r2" in exI)
   apply (rule conjI, simp add: strict_mono_def)
   apply (drule_tac f=r2 in LIMSEQ_subseq_LIMSEQ, assumption)
   apply (drule (1) tendsto_Pair) back
   apply (simp add: o_def)
   done
 
 lemma compact_Times:
   assumes "compact s" "compact t"
   shows "compact (s \<times> t)"
 proof (rule compactI)
   fix C
   assume C: "\<forall>t\<in>C. open t" "s \<times> t \<subseteq> \<Union>C"
   have "\<forall>x\<in>s. \<exists>a. open a \<and> x \<in> a \<and> (\<exists>d\<subseteq>C. finite d \<and> a \<times> t \<subseteq> \<Union>d)"
   proof
     fix x
     assume "x \<in> s"
     have "\<forall>y\<in>t. \<exists>a b c. c \<in> C \<and> open a \<and> open b \<and> x \<in> a \<and> y \<in> b \<and> a \<times> b \<subseteq> c" (is "\<forall>y\<in>t. ?P y")
     proof
       fix y
       assume "y \<in> t"
       with \<open>x \<in> s\<close> C obtain c where "c \<in> C" "(x, y) \<in> c" "open c" by auto
       then show "?P y" by (auto elim!: open_prod_elim)
     qed
     then obtain a b c where b: "\<And>y. y \<in> t \<Longrightarrow> open (b y)"
       and c: "\<And>y. y \<in> t \<Longrightarrow> c y \<in> C \<and> open (a y) \<and> open (b y) \<and> x \<in> a y \<and> y \<in> b y \<and> a y \<times> b y \<subseteq> c y"
       by metis
     then have "\<forall>y\<in>t. open (b y)" "t \<subseteq> (\<Union>y\<in>t. b y)" by auto
     with compactE_image[OF \<open>compact t\<close>] obtain D where D: "D \<subseteq> t" "finite D" "t \<subseteq> (\<Union>y\<in>D. b y)"
       by metis
     moreover from D c have "(\<Inter>y\<in>D. a y) \<times> t \<subseteq> (\<Union>y\<in>D. c y)"
       by (fastforce simp: subset_eq)
     ultimately show "\<exists>a. open a \<and> x \<in> a \<and> (\<exists>d\<subseteq>C. finite d \<and> a \<times> t \<subseteq> \<Union>d)"
       using c by (intro exI[of _ "c`D"] exI[of _ "\<Inter>(a`D)"] conjI) (auto intro!: open_INT)
   qed
   then obtain a d where a: "\<And>x. x\<in>s \<Longrightarrow> open (a x)" "s \<subseteq> (\<Union>x\<in>s. a x)"
     and d: "\<And>x. x \<in> s \<Longrightarrow> d x \<subseteq> C \<and> finite (d x) \<and> a x \<times> t \<subseteq> \<Union>(d x)"
     unfolding subset_eq UN_iff by metis
   moreover
   from compactE_image[OF \<open>compact s\<close> a]
   obtain e where e: "e \<subseteq> s" "finite e" and s: "s \<subseteq> (\<Union>x\<in>e. a x)"
     by auto
   moreover
   {
     from s have "s \<times> t \<subseteq> (\<Union>x\<in>e. a x \<times> t)"
       by auto
     also have "\<dots> \<subseteq> (\<Union>x\<in>e. \<Union>(d x))"
       using d \<open>e \<subseteq> s\<close> by (intro UN_mono) auto
     finally have "s \<times> t \<subseteq> (\<Union>x\<in>e. \<Union>(d x))" .
   }
   ultimately show "\<exists>C'\<subseteq>C. finite C' \<and> s \<times> t \<subseteq> \<Union>C'"
     by (intro exI[of _ "(\<Union>x\<in>e. d x)"]) (auto simp: subset_eq)
 qed
 
 
 lemma tube_lemma:
   assumes "compact K"
   assumes "open W"
   assumes "{x0} \<times> K \<subseteq> W"
   shows "\<exists>X0. x0 \<in> X0 \<and> open X0 \<and> X0 \<times> K \<subseteq> W"
 proof -
   {
     fix y assume "y \<in> K"
     then have "(x0, y) \<in> W" using assms by auto
     with \<open>open W\<close>
     have "\<exists>X0 Y. open X0 \<and> open Y \<and> x0 \<in> X0 \<and> y \<in> Y \<and> X0 \<times> Y \<subseteq> W"
       by (rule open_prod_elim) blast
   }
   then obtain X0 Y where
     *: "\<forall>y \<in> K. open (X0 y) \<and> open (Y y) \<and> x0 \<in> X0 y \<and> y \<in> Y y \<and> X0 y \<times> Y y \<subseteq> W"
     by metis
   from * have "\<forall>t\<in>Y ` K. open t" "K \<subseteq> \<Union>(Y ` K)" by auto
   with \<open>compact K\<close> obtain CC where CC: "CC \<subseteq> Y ` K" "finite CC" "K \<subseteq> \<Union>CC"
     by (meson compactE)
   then obtain c where c: "\<And>C. C \<in> CC \<Longrightarrow> c C \<in> K \<and> C = Y (c C)"
     by (force intro!: choice)
   with * CC show ?thesis
     by (force intro!: exI[where x="\<Inter>C\<in>CC. X0 (c C)"]) (* SLOW *)
 qed
 
 lemma continuous_on_prod_compactE:
   fixes fx::"'a::topological_space \<times> 'b::topological_space \<Rightarrow> 'c::metric_space"
     and e::real
   assumes cont_fx: "continuous_on (U \<times> C) fx"
   assumes "compact C"
   assumes [intro]: "x0 \<in> U"
   notes [continuous_intros] = continuous_on_compose2[OF cont_fx]
   assumes "e > 0"
   obtains X0 where "x0 \<in> X0" "open X0"
     "\<forall>x\<in>X0 \<inter> U. \<forall>t \<in> C. dist (fx (x, t)) (fx (x0, t)) \<le> e"
 proof -
   define psi where "psi = (\<lambda>(x, t). dist (fx (x, t)) (fx (x0, t)))"
   define W0 where "W0 = {(x, t) \<in> U \<times> C. psi (x, t) < e}"
   have W0_eq: "W0 = psi -` {..<e} \<inter> U \<times> C"
     by (auto simp: vimage_def W0_def)
   have "open {..<e}" by simp
   have "continuous_on (U \<times> C) psi"
     by (auto intro!: continuous_intros simp: psi_def split_beta')
   from this[unfolded continuous_on_open_invariant, rule_format, OF \<open>open {..<e}\<close>]
   obtain W where W: "open W" "W \<inter> U \<times> C = W0 \<inter> U \<times> C"
     unfolding W0_eq by blast
   have "{x0} \<times> C \<subseteq> W \<inter> U \<times> C"
     unfolding W
     by (auto simp: W0_def psi_def \<open>0 < e\<close>)
   then have "{x0} \<times> C \<subseteq> W" by blast
   from tube_lemma[OF \<open>compact C\<close> \<open>open W\<close> this]
   obtain X0 where X0: "x0 \<in> X0" "open X0" "X0 \<times> C \<subseteq> W"
     by blast
 
   have "\<forall>x\<in>X0 \<inter> U. \<forall>t \<in> C. dist (fx (x, t)) (fx (x0, t)) \<le> e"
   proof safe
     fix x assume x: "x \<in> X0" "x \<in> U"
     fix t assume t: "t \<in> C"
     have "dist (fx (x, t)) (fx (x0, t)) = psi (x, t)"
       by (auto simp: psi_def)
     also
     {
       have "(x, t) \<in> X0 \<times> C"
         using t x
         by auto
       also note \<open>\<dots> \<subseteq> W\<close>
       finally have "(x, t) \<in> W" .
       with t x have "(x, t) \<in> W \<inter> U \<times> C"
         by blast
       also note \<open>W \<inter> U \<times> C = W0 \<inter> U \<times> C\<close>
       finally  have "psi (x, t) < e"
         by (auto simp: W0_def)
     }
     finally show "dist (fx (x, t)) (fx (x0, t)) \<le> e" by simp
   qed
   from X0(1,2) this show ?thesis ..
 qed
 
 
 subsection \<open>Continuity\<close>
 
 lemma continuous_at_imp_continuous_within:
   "continuous (at x) f \<Longrightarrow> continuous (at x within s) f"
   unfolding continuous_within continuous_at using Lim_at_imp_Lim_at_within by auto
 
 lemma Lim_trivial_limit: "trivial_limit net \<Longrightarrow> (f \<longlongrightarrow> l) net"
   by simp
 
 lemmas continuous_on = continuous_on_def \<comment> \<open>legacy theorem name\<close>
 
 lemma continuous_within_subset:
   "continuous (at x within s) f \<Longrightarrow> t \<subseteq> s \<Longrightarrow> continuous (at x within t) f"
   unfolding continuous_within by(metis tendsto_within_subset)
 
 lemma continuous_on_interior:
   "continuous_on s f \<Longrightarrow> x \<in> interior s \<Longrightarrow> continuous (at x) f"
   by (metis continuous_on_eq_continuous_at continuous_on_subset interiorE)
 
 lemma continuous_on_eq:
   "\<lbrakk>continuous_on s f; \<And>x. x \<in> s \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> continuous_on s g"
   unfolding continuous_on_def tendsto_def eventually_at_topological
   by simp
 
 text \<open>Characterization of various kinds of continuity in terms of sequences.\<close>
 
 lemma continuous_within_sequentiallyI:
   fixes f :: "'a::{first_countable_topology, t2_space} \<Rightarrow> 'b::topological_space"
   assumes "\<And>u::nat \<Rightarrow> 'a. u \<longlonglongrightarrow> a \<Longrightarrow> (\<forall>n. u n \<in> s) \<Longrightarrow> (\<lambda>n. f (u n)) \<longlonglongrightarrow> f a"
   shows "continuous (at a within s) f"
   using assms unfolding continuous_within tendsto_def[where l = "f a"]
   by (auto intro!: sequentially_imp_eventually_within)
 
 lemma continuous_within_tendsto_compose:
   fixes f::"'a::t2_space \<Rightarrow> 'b::topological_space"
   assumes "continuous (at a within s) f"
           "eventually (\<lambda>n. x n \<in> s) F"
           "(x \<longlongrightarrow> a) F "
   shows "((\<lambda>n. f (x n)) \<longlongrightarrow> f a) F"
 proof -
   have *: "filterlim x (inf (nhds a) (principal s)) F"
     using assms(2) assms(3) unfolding at_within_def filterlim_inf by (auto simp: filterlim_principal eventually_mono)
   show ?thesis
     by (auto simp: assms(1) continuous_within[symmetric] tendsto_at_within_iff_tendsto_nhds[symmetric] intro!: filterlim_compose[OF _ *])
 qed
 
 lemma continuous_within_tendsto_compose':
   fixes f::"'a::t2_space \<Rightarrow> 'b::topological_space"
   assumes "continuous (at a within s) f"
     "\<And>n. x n \<in> s"
     "(x \<longlongrightarrow> a) F "
   shows "((\<lambda>n. f (x n)) \<longlongrightarrow> f a) F"
   by (auto intro!: continuous_within_tendsto_compose[OF assms(1)] simp add: assms)
 
 lemma continuous_within_sequentially:
   fixes f :: "'a::{first_countable_topology, t2_space} \<Rightarrow> 'b::topological_space"
   shows "continuous (at a within s) f \<longleftrightarrow>
     (\<forall>x. (\<forall>n::nat. x n \<in> s) \<and> (x \<longlongrightarrow> a) sequentially
          \<longrightarrow> ((f \<circ> x) \<longlongrightarrow> f a) sequentially)"
   using continuous_within_tendsto_compose'[of a s f _ sequentially]
     continuous_within_sequentiallyI[of a s f]
   by (auto simp: o_def)
 
 lemma continuous_at_sequentiallyI:
   fixes f :: "'a::{first_countable_topology, t2_space} \<Rightarrow> 'b::topological_space"
   assumes "\<And>u. u \<longlonglongrightarrow> a \<Longrightarrow> (\<lambda>n. f (u n)) \<longlonglongrightarrow> f a"
   shows "continuous (at a) f"
   using continuous_within_sequentiallyI[of a UNIV f] assms by auto
 
 lemma continuous_at_sequentially:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::topological_space"
   shows "continuous (at a) f \<longleftrightarrow>
     (\<forall>x. (x \<longlongrightarrow> a) sequentially --> ((f \<circ> x) \<longlongrightarrow> f a) sequentially)"
   using continuous_within_sequentially[of a UNIV f] by simp
 
 lemma continuous_on_sequentiallyI:
   fixes f :: "'a::{first_countable_topology, t2_space} \<Rightarrow> 'b::topological_space"
   assumes "\<And>u a. (\<forall>n. u n \<in> s) \<Longrightarrow> a \<in> s \<Longrightarrow> u \<longlonglongrightarrow> a \<Longrightarrow> (\<lambda>n. f (u n)) \<longlonglongrightarrow> f a"
   shows "continuous_on s f"
   using assms unfolding continuous_on_eq_continuous_within
   using continuous_within_sequentiallyI[of _ s f] by auto
 
 lemma continuous_on_sequentially:
   fixes f :: "'a::{first_countable_topology, t2_space} \<Rightarrow> 'b::topological_space"
   shows "continuous_on s f \<longleftrightarrow>
     (\<forall>x. \<forall>a \<in> s. (\<forall>n. x(n) \<in> s) \<and> (x \<longlongrightarrow> a) sequentially
       --> ((f \<circ> x) \<longlongrightarrow> f a) sequentially)"
     (is "?lhs = ?rhs")
 proof
   assume ?rhs
   then show ?lhs
     using continuous_within_sequentially[of _ s f]
     unfolding continuous_on_eq_continuous_within
     by auto
 next
   assume ?lhs
   then show ?rhs
     unfolding continuous_on_eq_continuous_within
     using continuous_within_sequentially[of _ s f]
     by auto
 qed
 
 text \<open>Continuity in terms of open preimages.\<close>
 
 lemma continuous_at_open:
   "continuous (at x) f \<longleftrightarrow> (\<forall>t. open t \<and> f x \<in> t --> (\<exists>s. open s \<and> x \<in> s \<and> (\<forall>x' \<in> s. (f x') \<in> t)))"
   unfolding continuous_within_topological [of x UNIV f]
   unfolding imp_conjL
   by (intro all_cong imp_cong ex_cong conj_cong refl) auto
 
 lemma continuous_imp_tendsto:
   assumes "continuous (at x0) f"
     and "x \<longlonglongrightarrow> x0"
   shows "(f \<circ> x) \<longlonglongrightarrow> (f x0)"
 proof (rule topological_tendstoI)
   fix S
   assume "open S" "f x0 \<in> S"
   then obtain T where T_def: "open T" "x0 \<in> T" "\<forall>x\<in>T. f x \<in> S"
      using assms continuous_at_open by metis
   then have "eventually (\<lambda>n. x n \<in> T) sequentially"
     using assms T_def by (auto simp: tendsto_def)
   then show "eventually (\<lambda>n. (f \<circ> x) n \<in> S) sequentially"
     using T_def by (auto elim!: eventually_mono)
 qed
 
 subsection \<open>Homeomorphisms\<close>
 
 definition\<^marker>\<open>tag important\<close> "homeomorphism s t f g \<longleftrightarrow>
   (\<forall>x\<in>s. (g(f x) = x)) \<and> (f ` s = t) \<and> continuous_on s f \<and>
   (\<forall>y\<in>t. (f(g y) = y)) \<and> (g ` t = s) \<and> continuous_on t g"
 
 lemma homeomorphismI [intro?]:
   assumes "continuous_on S f" "continuous_on T g"
           "f ` S \<subseteq> T" "g ` T \<subseteq> S" "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x" "\<And>y. y \<in> T \<Longrightarrow> f(g y) = y"
     shows "homeomorphism S T f g"
   using assms by (force simp: homeomorphism_def)
 
 lemma homeomorphism_translation:
   fixes a :: "'a :: real_normed_vector"
   shows "homeomorphism ((+) a ` S) S ((+) (- a)) ((+) a)"
 unfolding homeomorphism_def by (auto simp: algebra_simps continuous_intros)
 
 lemma homeomorphism_ident: "homeomorphism T T (\<lambda>a. a) (\<lambda>a. a)"
   by (rule homeomorphismI) auto
 
 lemma homeomorphism_compose:
   assumes "homeomorphism S T f g" "homeomorphism T U h k"
     shows "homeomorphism S U (h o f) (g o k)"
   using assms
   unfolding homeomorphism_def
   by (intro conjI ballI continuous_on_compose) (auto simp: image_iff)
 
 lemma homeomorphism_cong:
   "homeomorphism X' Y' f' g'"
     if "homeomorphism X Y f g" "X' = X" "Y' = Y" "\<And>x. x \<in> X \<Longrightarrow> f' x = f x" "\<And>y. y \<in> Y \<Longrightarrow> g' y = g y"
   using that by (auto simp add: homeomorphism_def)
 
 lemma homeomorphism_empty [simp]:
   "homeomorphism {} {} f g"
   unfolding homeomorphism_def by auto
 
 lemma homeomorphism_symD: "homeomorphism S t f g \<Longrightarrow> homeomorphism t S g f"
   by (simp add: homeomorphism_def)
 
 lemma homeomorphism_sym: "homeomorphism S t f g = homeomorphism t S g f"
   by (force simp: homeomorphism_def)
 
 definition\<^marker>\<open>tag important\<close> homeomorphic :: "'a::topological_space set \<Rightarrow> 'b::topological_space set \<Rightarrow> bool"
     (infixr "homeomorphic" 60)
   where "s homeomorphic t \<equiv> (\<exists>f g. homeomorphism s t f g)"
 
 lemma homeomorphic_empty [iff]:
      "S homeomorphic {} \<longleftrightarrow> S = {}" "{} homeomorphic S \<longleftrightarrow> S = {}"
   by (auto simp: homeomorphic_def homeomorphism_def)
 
 lemma homeomorphic_refl: "s homeomorphic s"
   unfolding homeomorphic_def homeomorphism_def
   using continuous_on_id
   apply (rule_tac x = "(\<lambda>x. x)" in exI)
   apply (rule_tac x = "(\<lambda>x. x)" in exI)
   apply blast
   done
 
 lemma homeomorphic_sym: "s homeomorphic t \<longleftrightarrow> t homeomorphic s"
   unfolding homeomorphic_def homeomorphism_def
   by blast
 
 lemma homeomorphic_trans [trans]:
   assumes "S homeomorphic T"
       and "T homeomorphic U"
     shows "S homeomorphic U"
   using assms
   unfolding homeomorphic_def
 by (metis homeomorphism_compose)
 
 lemma homeomorphic_minimal:
   "s homeomorphic t \<longleftrightarrow>
     (\<exists>f g. (\<forall>x\<in>s. f(x) \<in> t \<and> (g(f(x)) = x)) \<and>
            (\<forall>y\<in>t. g(y) \<in> s \<and> (f(g(y)) = y)) \<and>
            continuous_on s f \<and> continuous_on t g)"
    (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (fastforce simp: homeomorphic_def homeomorphism_def)
 next
   assume ?rhs
   then show ?lhs
     apply clarify
     unfolding homeomorphic_def homeomorphism_def
     by (metis equalityI image_subset_iff subsetI)
  qed
 
 lemma homeomorphicI [intro?]:
    "\<lbrakk>f ` S = T; g ` T = S;
      continuous_on S f; continuous_on T g;
      \<And>x. x \<in> S \<Longrightarrow> g(f(x)) = x;
      \<And>y. y \<in> T \<Longrightarrow> f(g(y)) = y\<rbrakk> \<Longrightarrow> S homeomorphic T"
 unfolding homeomorphic_def homeomorphism_def by metis
 
 lemma homeomorphism_of_subsets:
    "\<lbrakk>homeomorphism S T f g; S' \<subseteq> S; T'' \<subseteq> T; f ` S' = T'\<rbrakk>
     \<Longrightarrow> homeomorphism S' T' f g"
 apply (auto simp: homeomorphism_def elim!: continuous_on_subset)
 by (metis subsetD imageI)
 
 lemma homeomorphism_apply1: "\<lbrakk>homeomorphism S T f g; x \<in> S\<rbrakk> \<Longrightarrow> g(f x) = x"
   by (simp add: homeomorphism_def)
 
 lemma homeomorphism_apply2: "\<lbrakk>homeomorphism S T f g; x \<in> T\<rbrakk> \<Longrightarrow> f(g x) = x"
   by (simp add: homeomorphism_def)
 
 lemma homeomorphism_image1: "homeomorphism S T f g \<Longrightarrow> f ` S = T"
   by (simp add: homeomorphism_def)
 
 lemma homeomorphism_image2: "homeomorphism S T f g \<Longrightarrow> g ` T = S"
   by (simp add: homeomorphism_def)
 
 lemma homeomorphism_cont1: "homeomorphism S T f g \<Longrightarrow> continuous_on S f"
   by (simp add: homeomorphism_def)
 
 lemma homeomorphism_cont2: "homeomorphism S T f g \<Longrightarrow> continuous_on T g"
   by (simp add: homeomorphism_def)
 
 lemma continuous_on_no_limpt:
    "(\<And>x. \<not> x islimpt S) \<Longrightarrow> continuous_on S f"
   unfolding continuous_on_def
   by (metis UNIV_I empty_iff eventually_at_topological islimptE open_UNIV tendsto_def trivial_limit_within)
 
 lemma continuous_on_finite:
   fixes S :: "'a::t1_space set"
   shows "finite S \<Longrightarrow> continuous_on S f"
 by (metis continuous_on_no_limpt islimpt_finite)
 
 lemma homeomorphic_finite:
   fixes S :: "'a::t1_space set" and T :: "'b::t1_space set"
   assumes "finite T"
   shows "S homeomorphic T \<longleftrightarrow> finite S \<and> finite T \<and> card S = card T" (is "?lhs = ?rhs")
 proof
   assume "S homeomorphic T"
   with assms show ?rhs
     apply (auto simp: homeomorphic_def homeomorphism_def)
      apply (metis finite_imageI)
     by (metis card_image_le finite_imageI le_antisym)
 next
   assume R: ?rhs
   with finite_same_card_bij obtain h where "bij_betw h S T"
     by auto
   with R show ?lhs
     apply (auto simp: homeomorphic_def homeomorphism_def continuous_on_finite)
     apply (rule_tac x=h in exI)
     apply (rule_tac x="inv_into S h" in exI)
     apply (auto simp:  bij_betw_inv_into_left bij_betw_inv_into_right bij_betw_imp_surj_on inv_into_into bij_betwE)
     apply (metis bij_betw_def bij_betw_inv_into)
     done
 qed
 
 text \<open>Relatively weak hypotheses if a set is compact.\<close>
 
 lemma homeomorphism_compact:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::t2_space"
   assumes "compact s" "continuous_on s f"  "f ` s = t"  "inj_on f s"
   shows "\<exists>g. homeomorphism s t f g"
 proof -
   define g where "g x = (SOME y. y\<in>s \<and> f y = x)" for x
   have g: "\<forall>x\<in>s. g (f x) = x"
     using assms(3) assms(4)[unfolded inj_on_def] unfolding g_def by auto
   {
     fix y
     assume "y \<in> t"
     then obtain x where x:"f x = y" "x\<in>s"
       using assms(3) by auto
     then have "g (f x) = x" using g by auto
     then have "f (g y) = y" unfolding x(1)[symmetric] by auto
   }
   then have g':"\<forall>x\<in>t. f (g x) = x" by auto
   moreover
   {
     fix x
     have "x\<in>s \<Longrightarrow> x \<in> g ` t"
       using g[THEN bspec[where x=x]]
       unfolding image_iff
       using assms(3)
       by (auto intro!: bexI[where x="f x"])
     moreover
     {
       assume "x\<in>g ` t"
       then obtain y where y:"y\<in>t" "g y = x" by auto
       then obtain x' where x':"x'\<in>s" "f x' = y"
         using assms(3) by auto
       then have "x \<in> s"
         unfolding g_def
         using someI2[of "\<lambda>b. b\<in>s \<and> f b = y" x' "\<lambda>x. x\<in>s"]
         unfolding y(2)[symmetric] and g_def
         by auto
     }
     ultimately have "x\<in>s \<longleftrightarrow> x \<in> g ` t" ..
   }
   then have "g ` t = s" by auto
   ultimately show ?thesis
     unfolding homeomorphism_def homeomorphic_def
     apply (rule_tac x=g in exI)
     using g and assms(3) and continuous_on_inv[OF assms(2,1), of g, unfolded assms(3)] and assms(2)
     apply auto
     done
 qed
 
 lemma homeomorphic_compact:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::t2_space"
   shows "compact s \<Longrightarrow> continuous_on s f \<Longrightarrow> (f ` s = t) \<Longrightarrow> inj_on f s \<Longrightarrow> s homeomorphic t"
   unfolding homeomorphic_def by (metis homeomorphism_compact)
 
 text\<open>Preservation of topological properties.\<close>
 
 lemma homeomorphic_compactness: "s homeomorphic t \<Longrightarrow> (compact s \<longleftrightarrow> compact t)"
   unfolding homeomorphic_def homeomorphism_def
   by (metis compact_continuous_image)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>On Linorder Topologies\<close>
 
 lemma islimpt_greaterThanLessThan1:
   fixes a b::"'a::{linorder_topology, dense_order}"
   assumes "a < b"
   shows  "a islimpt {a<..<b}"
 proof (rule islimptI)
   fix T
   assume "open T" "a \<in> T"
   from open_right[OF this \<open>a < b\<close>]
   obtain c where c: "a < c" "{a..<c} \<subseteq> T" by auto
   with assms dense[of a "min c b"]
   show "\<exists>y\<in>{a<..<b}. y \<in> T \<and> y \<noteq> a"
     by (metis atLeastLessThan_iff greaterThanLessThan_iff min_less_iff_conj
       not_le order.strict_implies_order subset_eq)
 qed
 
 lemma islimpt_greaterThanLessThan2:
   fixes a b::"'a::{linorder_topology, dense_order}"
   assumes "a < b"
   shows  "b islimpt {a<..<b}"
 proof (rule islimptI)
   fix T
   assume "open T" "b \<in> T"
   from open_left[OF this \<open>a < b\<close>]
   obtain c where c: "c < b" "{c<..b} \<subseteq> T" by auto
   with assms dense[of "max a c" b]
   show "\<exists>y\<in>{a<..<b}. y \<in> T \<and> y \<noteq> b"
     by (metis greaterThanAtMost_iff greaterThanLessThan_iff max_less_iff_conj
       not_le order.strict_implies_order subset_eq)
 qed
 
 lemma closure_greaterThanLessThan[simp]:
   fixes a b::"'a::{linorder_topology, dense_order}"
   shows "a < b \<Longrightarrow> closure {a <..< b} = {a .. b}" (is "_ \<Longrightarrow> ?l = ?r")
 proof
   have "?l \<subseteq> closure ?r"
     by (rule closure_mono) auto
   thus "closure {a<..<b} \<subseteq> {a..b}" by simp
 qed (auto simp: closure_def order.order_iff_strict islimpt_greaterThanLessThan1
   islimpt_greaterThanLessThan2)
 
 lemma closure_greaterThan[simp]:
   fixes a b::"'a::{no_top, linorder_topology, dense_order}"
   shows "closure {a<..} = {a..}"
 proof -
   from gt_ex obtain b where "a < b" by auto
   hence "{a<..} = {a<..<b} \<union> {b..}" by auto
   also have "closure \<dots> = {a..}" using \<open>a < b\<close> unfolding closure_Un
     by auto
   finally show ?thesis .
 qed
 
 lemma closure_lessThan[simp]:
   fixes b::"'a::{no_bot, linorder_topology, dense_order}"
   shows "closure {..<b} = {..b}"
 proof -
   from lt_ex obtain a where "a < b" by auto
   hence "{..<b} = {a<..<b} \<union> {..a}" by auto
   also have "closure \<dots> = {..b}" using \<open>a < b\<close> unfolding closure_Un
     by auto
   finally show ?thesis .
 qed
 
 lemma closure_atLeastLessThan[simp]:
   fixes a b::"'a::{linorder_topology, dense_order}"
   assumes "a < b"
   shows "closure {a ..< b} = {a .. b}"
 proof -
   from assms have "{a ..< b} = {a} \<union> {a <..< b}" by auto
   also have "closure \<dots> = {a .. b}" unfolding closure_Un
     by (auto simp: assms less_imp_le)
   finally show ?thesis .
 qed
 
 lemma closure_greaterThanAtMost[simp]:
   fixes a b::"'a::{linorder_topology, dense_order}"
   assumes "a < b"
   shows "closure {a <.. b} = {a .. b}"
 proof -
   from assms have "{a <.. b} = {b} \<union> {a <..< b}" by auto
   also have "closure \<dots> = {a .. b}" unfolding closure_Un
     by (auto simp: assms less_imp_le)
   finally show ?thesis .
 qed
 
 end
\ No newline at end of file
diff --git a/src/HOL/Analysis/Finite_Cartesian_Product.thy b/src/HOL/Analysis/Finite_Cartesian_Product.thy
--- a/src/HOL/Analysis/Finite_Cartesian_Product.thy
+++ b/src/HOL/Analysis/Finite_Cartesian_Product.thy
@@ -1,1286 +1,1285 @@
 (*  Title:      HOL/Analysis/Finite_Cartesian_Product.thy
     Author:     Amine Chaieb, University of Cambridge
 *)
 
 section \<open>Definition of Finite Cartesian Product Type\<close>
 
 theory Finite_Cartesian_Product
 imports
   Euclidean_Space
   L2_Norm
   "HOL-Library.Numeral_Type"
   "HOL-Library.Countable_Set"
   "HOL-Library.FuncSet"
 begin
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Finite Cartesian products, with indexing and lambdas\<close>
 
 typedef ('a, 'b) vec = "UNIV :: ('b::finite \<Rightarrow> 'a) set"
   morphisms vec_nth vec_lambda ..
 
 declare vec_lambda_inject [simplified, simp]
 
 bundle vec_syntax begin
 notation
   vec_nth (infixl "$" 90) and
   vec_lambda (binder "\<chi>" 10)
 end
 
 bundle no_vec_syntax begin
 no_notation
   vec_nth (infixl "$" 90) and
   vec_lambda (binder "\<chi>" 10)
 end
 
 unbundle vec_syntax
 
 text \<open>
   Concrete syntax for \<open>('a, 'b) vec\<close>:
     \<^item> \<open>'a^'b\<close> becomes \<open>('a, 'b::finite) vec\<close>
     \<^item> \<open>'a^'b::_\<close> becomes \<open>('a, 'b) vec\<close> without extra sort-constraint
 \<close>
 syntax "_vec_type" :: "type \<Rightarrow> type \<Rightarrow> type" (infixl "^" 15)
 parse_translation \<open>
   let
     fun vec t u = Syntax.const \<^type_syntax>\<open>vec\<close> $ t $ u;
     fun finite_vec_tr [t, u] =
       (case Term_Position.strip_positions u of
         v as Free (x, _) =>
           if Lexicon.is_tid x then
             vec t (Syntax.const \<^syntax_const>\<open>_ofsort\<close> $ v $
               Syntax.const \<^class_syntax>\<open>finite\<close>)
           else vec t u
       | _ => vec t u)
   in
     [(\<^syntax_const>\<open>_vec_type\<close>, K finite_vec_tr)]
   end
 \<close>
 
 lemma vec_eq_iff: "(x = y) \<longleftrightarrow> (\<forall>i. x$i = y$i)"
   by (simp add: vec_nth_inject [symmetric] fun_eq_iff)
 
 lemma vec_lambda_beta [simp]: "vec_lambda g $ i = g i"
   by (simp add: vec_lambda_inverse)
 
 lemma vec_lambda_unique: "(\<forall>i. f$i = g i) \<longleftrightarrow> vec_lambda g = f"
   by (auto simp add: vec_eq_iff)
 
 lemma vec_lambda_eta [simp]: "(\<chi> i. (g$i)) = g"
   by (simp add: vec_eq_iff)
 
 subsection \<open>Cardinality of vectors\<close>
 
 instance vec :: (finite, finite) finite
 proof
   show "finite (UNIV :: ('a, 'b) vec set)"
   proof (subst bij_betw_finite)
     show "bij_betw vec_nth UNIV (Pi (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set))"
       by (intro bij_betwI[of _ _ _ vec_lambda]) (auto simp: vec_eq_iff)
     have "finite (PiE (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set))"
       by (intro finite_PiE) auto
     also have "(PiE (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set)) = Pi UNIV (\<lambda>_. UNIV)"
       by auto
     finally show "finite \<dots>" .
   qed
 qed
 
 lemma countable_PiE:
   "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> countable (F i)) \<Longrightarrow> countable (Pi\<^sub>E I F)"
   by (induct I arbitrary: F rule: finite_induct) (auto simp: PiE_insert_eq)
 
 instance vec :: (countable, finite) countable
 proof
   have "countable (UNIV :: ('a, 'b) vec set)"
   proof (rule countableI_bij2)
     show "bij_betw vec_nth UNIV (Pi (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set))"
       by (intro bij_betwI[of _ _ _ vec_lambda]) (auto simp: vec_eq_iff)
     have "countable (PiE (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set))"
       by (intro countable_PiE) auto
     also have "(PiE (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set)) = Pi UNIV (\<lambda>_. UNIV)"
       by auto
     finally show "countable \<dots>" .
   qed
   thus "\<exists>t::('a, 'b) vec \<Rightarrow> nat. inj t"
     by (auto elim!: countableE)
 qed
 
 lemma infinite_UNIV_vec:
   assumes "infinite (UNIV :: 'a set)"
   shows   "infinite (UNIV :: ('a^'b) set)"
 proof (subst bij_betw_finite)
   show "bij_betw vec_nth UNIV (Pi (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set))"
     by (intro bij_betwI[of _ _ _ vec_lambda]) (auto simp: vec_eq_iff)
   have "infinite (PiE (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set))" (is "infinite ?A")
   proof
     assume "finite ?A"
     hence "finite ((\<lambda>f. f undefined) ` ?A)"
       by (rule finite_imageI)
     also have "(\<lambda>f. f undefined) ` ?A = UNIV"
       by auto
     finally show False 
       using \<open>infinite (UNIV :: 'a set)\<close> by contradiction
   qed
   also have "?A = Pi UNIV (\<lambda>_. UNIV)" 
     by auto
   finally show "infinite (Pi (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set))" .
 qed
 
 proposition CARD_vec [simp]:
   "CARD('a^'b) = CARD('a) ^ CARD('b)"
 proof (cases "finite (UNIV :: 'a set)")
   case True
   show ?thesis
   proof (subst bij_betw_same_card)
     show "bij_betw vec_nth UNIV (Pi (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set))"
       by (intro bij_betwI[of _ _ _ vec_lambda]) (auto simp: vec_eq_iff)
     have "CARD('a) ^ CARD('b) = card (PiE (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set))"
       (is "_ = card ?A")
-      by (subst card_PiE) (auto simp: prod_constant)
-    
+      by (subst card_PiE) (auto)
     also have "?A = Pi UNIV (\<lambda>_. UNIV)" 
       by auto
     finally show "card \<dots> = CARD('a) ^ CARD('b)" ..
   qed
 qed (simp_all add: infinite_UNIV_vec)
 
 lemma countable_vector:
   fixes B:: "'n::finite \<Rightarrow> 'a set"
   assumes "\<And>i. countable (B i)"
   shows "countable {V. \<forall>i::'n::finite. V $ i \<in> B i}"
 proof -
   have "f \<in> ($) ` {V. \<forall>i. V $ i \<in> B i}" if "f \<in> Pi\<^sub>E UNIV B" for f
   proof -
     have "\<exists>W. (\<forall>i. W $ i \<in> B i) \<and> ($) W = f"
       by (metis that PiE_iff UNIV_I vec_lambda_inverse)
     then show "f \<in> ($) ` {v. \<forall>i. v $ i \<in> B i}"
       by blast
   qed
   then have "Pi\<^sub>E UNIV B = vec_nth ` {V. \<forall>i::'n. V $ i \<in> B i}"
     by blast
   then have "countable (vec_nth ` {V. \<forall>i. V $ i \<in> B i})"
     by (metis finite_class.finite_UNIV countable_PiE assms)
   then have "countable (vec_lambda ` vec_nth ` {V. \<forall>i. V $ i \<in> B i})"
     by auto
   then show ?thesis
     by (simp add: image_comp o_def vec_nth_inverse)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Group operations and class instances\<close>
 
 instantiation vec :: (zero, finite) zero
 begin
   definition "0 \<equiv> (\<chi> i. 0)"
   instance ..
 end
 
 instantiation vec :: (plus, finite) plus
 begin
   definition "(+) \<equiv> (\<lambda> x y. (\<chi> i. x$i + y$i))"
   instance ..
 end
 
 instantiation vec :: (minus, finite) minus
 begin
   definition "(-) \<equiv> (\<lambda> x y. (\<chi> i. x$i - y$i))"
   instance ..
 end
 
 instantiation vec :: (uminus, finite) uminus
 begin
   definition "uminus \<equiv> (\<lambda> x. (\<chi> i. - (x$i)))"
   instance ..
 end
 
 lemma zero_index [simp]: "0 $ i = 0"
   unfolding zero_vec_def by simp
 
 lemma vector_add_component [simp]: "(x + y)$i = x$i + y$i"
   unfolding plus_vec_def by simp
 
 lemma vector_minus_component [simp]: "(x - y)$i = x$i - y$i"
   unfolding minus_vec_def by simp
 
 lemma vector_uminus_component [simp]: "(- x)$i = - (x$i)"
   unfolding uminus_vec_def by simp
 
 instance vec :: (semigroup_add, finite) semigroup_add
   by standard (simp add: vec_eq_iff add.assoc)
 
 instance vec :: (ab_semigroup_add, finite) ab_semigroup_add
   by standard (simp add: vec_eq_iff add.commute)
 
 instance vec :: (monoid_add, finite) monoid_add
   by standard (simp_all add: vec_eq_iff)
 
 instance vec :: (comm_monoid_add, finite) comm_monoid_add
   by standard (simp add: vec_eq_iff)
 
 instance vec :: (cancel_semigroup_add, finite) cancel_semigroup_add
   by standard (simp_all add: vec_eq_iff)
 
 instance vec :: (cancel_ab_semigroup_add, finite) cancel_ab_semigroup_add
   by standard (simp_all add: vec_eq_iff diff_diff_eq)
 
 instance vec :: (cancel_comm_monoid_add, finite) cancel_comm_monoid_add ..
 
 instance vec :: (group_add, finite) group_add
   by standard (simp_all add: vec_eq_iff)
 
 instance vec :: (ab_group_add, finite) ab_group_add
   by standard (simp_all add: vec_eq_iff)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Basic componentwise operations on vectors\<close>
 
 instantiation vec :: (times, finite) times
 begin
 
 definition "(*) \<equiv> (\<lambda> x y.  (\<chi> i. (x$i) * (y$i)))"
 instance ..
 
 end
 
 instantiation vec :: (one, finite) one
 begin
 
 definition "1 \<equiv> (\<chi> i. 1)"
 instance ..
 
 end
 
 instantiation vec :: (ord, finite) ord
 begin
 
 definition "x \<le> y \<longleftrightarrow> (\<forall>i. x$i \<le> y$i)"
 definition "x < (y::'a^'b) \<longleftrightarrow> x \<le> y \<and> \<not> y \<le> x"
 instance ..
 
 end
 
 text\<open>The ordering on one-dimensional vectors is linear.\<close>
 
 instance vec:: (order, finite) order
   by standard (auto simp: less_eq_vec_def less_vec_def vec_eq_iff
       intro: order.trans order.antisym order.strict_implies_order)
 
 instance vec :: (linorder, CARD_1) linorder
 proof
   obtain a :: 'b where all: "\<And>P. (\<forall>i. P i) \<longleftrightarrow> P a"
   proof -
     have "CARD ('b) = 1" by (rule CARD_1)
     then obtain b :: 'b where "UNIV = {b}" by (auto iff: card_Suc_eq)
     then have "\<And>P. (\<forall>i\<in>UNIV. P i) \<longleftrightarrow> P b" by auto
     then show thesis by (auto intro: that)
   qed
   fix x y :: "'a^'b::CARD_1"
   note [simp] = less_eq_vec_def less_vec_def all vec_eq_iff field_simps
   show "x \<le> y \<or> y \<le> x" by auto
 qed
 
 text\<open>Constant Vectors\<close>
 
 definition "vec x = (\<chi> i. x)"
 
 text\<open>Also the scalar-vector multiplication.\<close>
 
 definition vector_scalar_mult:: "'a::times \<Rightarrow> 'a ^ 'n \<Rightarrow> 'a ^ 'n" (infixl "*s" 70)
   where "c *s x = (\<chi> i. c * (x$i))"
 
 text \<open>scalar product\<close>
 
 definition scalar_product :: "'a :: semiring_1 ^ 'n \<Rightarrow> 'a ^ 'n \<Rightarrow> 'a" where
   "scalar_product v w = (\<Sum> i \<in> UNIV. v $ i * w $ i)"
 
 
 subsection \<open>Real vector space\<close>
 
 instantiation\<^marker>\<open>tag unimportant\<close> vec :: (real_vector, finite) real_vector
 begin
 
 definition\<^marker>\<open>tag important\<close> "scaleR \<equiv> (\<lambda> r x. (\<chi> i. scaleR r (x$i)))"
 
 lemma vector_scaleR_component [simp]: "(scaleR r x)$i = scaleR r (x$i)"
   unfolding scaleR_vec_def by simp
 
 instance\<^marker>\<open>tag unimportant\<close>
   by standard (simp_all add: vec_eq_iff scaleR_left_distrib scaleR_right_distrib)
 
 end
 
 
 subsection \<open>Topological space\<close>
 
 instantiation\<^marker>\<open>tag unimportant\<close> vec :: (topological_space, finite) topological_space
 begin
 
 definition\<^marker>\<open>tag important\<close> [code del]:
   "open (S :: ('a ^ 'b) set) \<longleftrightarrow>
     (\<forall>x\<in>S. \<exists>A. (\<forall>i. open (A i) \<and> x$i \<in> A i) \<and>
       (\<forall>y. (\<forall>i. y$i \<in> A i) \<longrightarrow> y \<in> S))"
 
 instance\<^marker>\<open>tag unimportant\<close> proof
   show "open (UNIV :: ('a ^ 'b) set)"
     unfolding open_vec_def by auto
 next
   fix S T :: "('a ^ 'b) set"
   assume "open S" "open T" thus "open (S \<inter> T)"
     unfolding open_vec_def
     apply clarify
     apply (drule (1) bspec)+
     apply (clarify, rename_tac Sa Ta)
     apply (rule_tac x="\<lambda>i. Sa i \<inter> Ta i" in exI)
     apply (simp add: open_Int)
     done
 next
   fix K :: "('a ^ 'b) set set"
   assume "\<forall>S\<in>K. open S" thus "open (\<Union>K)"
     unfolding open_vec_def
     apply clarify
     apply (drule (1) bspec)
     apply (drule (1) bspec)
     apply clarify
     apply (rule_tac x=A in exI)
     apply fast
     done
 qed
 
 end
 
 lemma open_vector_box: "\<forall>i. open (S i) \<Longrightarrow> open {x. \<forall>i. x $ i \<in> S i}"
   unfolding open_vec_def by auto
 
 lemma open_vimage_vec_nth: "open S \<Longrightarrow> open ((\<lambda>x. x $ i) -` S)"
   unfolding open_vec_def
   apply clarify
   apply (rule_tac x="\<lambda>k. if k = i then S else UNIV" in exI, simp)
   done
 
 lemma closed_vimage_vec_nth: "closed S \<Longrightarrow> closed ((\<lambda>x. x $ i) -` S)"
   unfolding closed_open vimage_Compl [symmetric]
   by (rule open_vimage_vec_nth)
 
 lemma closed_vector_box: "\<forall>i. closed (S i) \<Longrightarrow> closed {x. \<forall>i. x $ i \<in> S i}"
 proof -
   have "{x. \<forall>i. x $ i \<in> S i} = (\<Inter>i. (\<lambda>x. x $ i) -` S i)" by auto
   thus "\<forall>i. closed (S i) \<Longrightarrow> closed {x. \<forall>i. x $ i \<in> S i}"
     by (simp add: closed_INT closed_vimage_vec_nth)
 qed
 
 lemma tendsto_vec_nth [tendsto_intros]:
   assumes "((\<lambda>x. f x) \<longlongrightarrow> a) net"
   shows "((\<lambda>x. f x $ i) \<longlongrightarrow> a $ i) net"
 proof (rule topological_tendstoI)
   fix S assume "open S" "a $ i \<in> S"
   then have "open ((\<lambda>y. y $ i) -` S)" "a \<in> ((\<lambda>y. y $ i) -` S)"
     by (simp_all add: open_vimage_vec_nth)
   with assms have "eventually (\<lambda>x. f x \<in> (\<lambda>y. y $ i) -` S) net"
     by (rule topological_tendstoD)
   then show "eventually (\<lambda>x. f x $ i \<in> S) net"
     by simp
 qed
 
 lemma isCont_vec_nth [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. f x $ i) a"
   unfolding isCont_def by (rule tendsto_vec_nth)
 
 lemma vec_tendstoI:
   assumes "\<And>i. ((\<lambda>x. f x $ i) \<longlongrightarrow> a $ i) net"
   shows "((\<lambda>x. f x) \<longlongrightarrow> a) net"
 proof (rule topological_tendstoI)
   fix S assume "open S" and "a \<in> S"
   then obtain A where A: "\<And>i. open (A i)" "\<And>i. a $ i \<in> A i"
     and S: "\<And>y. \<forall>i. y $ i \<in> A i \<Longrightarrow> y \<in> S"
     unfolding open_vec_def by metis
   have "\<And>i. eventually (\<lambda>x. f x $ i \<in> A i) net"
     using assms A by (rule topological_tendstoD)
   hence "eventually (\<lambda>x. \<forall>i. f x $ i \<in> A i) net"
     by (rule eventually_all_finite)
   thus "eventually (\<lambda>x. f x \<in> S) net"
     by (rule eventually_mono, simp add: S)
 qed
 
 lemma tendsto_vec_lambda [tendsto_intros]:
   assumes "\<And>i. ((\<lambda>x. f x i) \<longlongrightarrow> a i) net"
   shows "((\<lambda>x. \<chi> i. f x i) \<longlongrightarrow> (\<chi> i. a i)) net"
   using assms by (simp add: vec_tendstoI)
 
 lemma open_image_vec_nth: assumes "open S" shows "open ((\<lambda>x. x $ i) ` S)"
 proof (rule openI)
   fix a assume "a \<in> (\<lambda>x. x $ i) ` S"
   then obtain z where "a = z $ i" and "z \<in> S" ..
   then obtain A where A: "\<forall>i. open (A i) \<and> z $ i \<in> A i"
     and S: "\<forall>y. (\<forall>i. y $ i \<in> A i) \<longrightarrow> y \<in> S"
     using \<open>open S\<close> unfolding open_vec_def by auto
   hence "A i \<subseteq> (\<lambda>x. x $ i) ` S"
     by (clarsimp, rule_tac x="\<chi> j. if j = i then x else z $ j" in image_eqI,
       simp_all)
   hence "open (A i) \<and> a \<in> A i \<and> A i \<subseteq> (\<lambda>x. x $ i) ` S"
     using A \<open>a = z $ i\<close> by simp
   then show "\<exists>T. open T \<and> a \<in> T \<and> T \<subseteq> (\<lambda>x. x $ i) ` S" by - (rule exI)
 qed
 
 instance\<^marker>\<open>tag unimportant\<close> vec :: (perfect_space, finite) perfect_space
 proof
   fix x :: "'a ^ 'b" show "\<not> open {x}"
   proof
     assume "open {x}"
     hence "\<forall>i. open ((\<lambda>x. x $ i) ` {x})" by (fast intro: open_image_vec_nth)
     hence "\<forall>i. open {x $ i}" by simp
     thus "False" by (simp add: not_open_singleton)
   qed
 qed
 
 
 subsection \<open>Metric space\<close>
 (* TODO: Product of uniform spaces and compatibility with metric_spaces! *)
 
 instantiation\<^marker>\<open>tag unimportant\<close> vec :: (metric_space, finite) dist
 begin
 
 definition\<^marker>\<open>tag important\<close>
   "dist x y = L2_set (\<lambda>i. dist (x$i) (y$i)) UNIV"
 
 instance ..
 end
 
 instantiation\<^marker>\<open>tag unimportant\<close> vec :: (metric_space, finite) uniformity_dist
 begin
 
 definition\<^marker>\<open>tag important\<close> [code del]:
   "(uniformity :: (('a^'b::_) \<times> ('a^'b::_)) filter) =
     (INF e\<in>{0 <..}. principal {(x, y). dist x y < e})"
 
 instance\<^marker>\<open>tag unimportant\<close>
   by standard (rule uniformity_vec_def)
 end
 
 declare uniformity_Abort[where 'a="'a :: metric_space ^ 'b :: finite", code]
 
 instantiation\<^marker>\<open>tag unimportant\<close> vec :: (metric_space, finite) metric_space
 begin
 
 proposition dist_vec_nth_le: "dist (x $ i) (y $ i) \<le> dist x y"
   unfolding dist_vec_def by (rule member_le_L2_set) simp_all
 
 instance proof
   fix x y :: "'a ^ 'b"
   show "dist x y = 0 \<longleftrightarrow> x = y"
     unfolding dist_vec_def
     by (simp add: L2_set_eq_0_iff vec_eq_iff)
 next
   fix x y z :: "'a ^ 'b"
   show "dist x y \<le> dist x z + dist y z"
     unfolding dist_vec_def
     apply (rule order_trans [OF _ L2_set_triangle_ineq])
     apply (simp add: L2_set_mono dist_triangle2)
     done
 next
   fix S :: "('a ^ 'b) set"
   have *: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> S)"
   proof
     assume "open S" show "\<forall>x\<in>S. \<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> S"
     proof
       fix x assume "x \<in> S"
       obtain A where A: "\<forall>i. open (A i)" "\<forall>i. x $ i \<in> A i"
         and S: "\<forall>y. (\<forall>i. y $ i \<in> A i) \<longrightarrow> y \<in> S"
         using \<open>open S\<close> and \<open>x \<in> S\<close> unfolding open_vec_def by metis
       have "\<forall>i\<in>UNIV. \<exists>r>0. \<forall>y. dist y (x $ i) < r \<longrightarrow> y \<in> A i"
         using A unfolding open_dist by simp
       hence "\<exists>r. \<forall>i\<in>UNIV. 0 < r i \<and> (\<forall>y. dist y (x $ i) < r i \<longrightarrow> y \<in> A i)"
         by (rule finite_set_choice [OF finite])
       then obtain r where r1: "\<forall>i. 0 < r i"
         and r2: "\<forall>i y. dist y (x $ i) < r i \<longrightarrow> y \<in> A i" by fast
       have "0 < Min (range r) \<and> (\<forall>y. dist y x < Min (range r) \<longrightarrow> y \<in> S)"
         by (simp add: r1 r2 S le_less_trans [OF dist_vec_nth_le])
       thus "\<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> S" ..
     qed
   next
     assume *: "\<forall>x\<in>S. \<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> S" show "open S"
     proof (unfold open_vec_def, rule)
       fix x assume "x \<in> S"
       then obtain e where "0 < e" and S: "\<forall>y. dist y x < e \<longrightarrow> y \<in> S"
         using * by fast
       define r where [abs_def]: "r i = e / sqrt (of_nat CARD('b))" for i :: 'b
       from \<open>0 < e\<close> have r: "\<forall>i. 0 < r i"
         unfolding r_def by simp_all
       from \<open>0 < e\<close> have e: "e = L2_set r UNIV"
         unfolding r_def by (simp add: L2_set_constant)
       define A where "A i = {y. dist (x $ i) y < r i}" for i
       have "\<forall>i. open (A i) \<and> x $ i \<in> A i"
         unfolding A_def by (simp add: open_ball r)
       moreover have "\<forall>y. (\<forall>i. y $ i \<in> A i) \<longrightarrow> y \<in> S"
         by (simp add: A_def S dist_vec_def e L2_set_strict_mono dist_commute)
       ultimately show "\<exists>A. (\<forall>i. open (A i) \<and> x $ i \<in> A i) \<and>
         (\<forall>y. (\<forall>i. y $ i \<in> A i) \<longrightarrow> y \<in> S)" by metis
     qed
   qed
   show "open S = (\<forall>x\<in>S. \<forall>\<^sub>F (x', y) in uniformity. x' = x \<longrightarrow> y \<in> S)"
     unfolding * eventually_uniformity_metric
     by (simp del: split_paired_All add: dist_vec_def dist_commute)
 qed
 
 end
 
 lemma Cauchy_vec_nth:
   "Cauchy (\<lambda>n. X n) \<Longrightarrow> Cauchy (\<lambda>n. X n $ i)"
   unfolding Cauchy_def by (fast intro: le_less_trans [OF dist_vec_nth_le])
 
 lemma vec_CauchyI:
   fixes X :: "nat \<Rightarrow> 'a::metric_space ^ 'n"
   assumes X: "\<And>i. Cauchy (\<lambda>n. X n $ i)"
   shows "Cauchy (\<lambda>n. X n)"
 proof (rule metric_CauchyI)
   fix r :: real assume "0 < r"
   hence "0 < r / of_nat CARD('n)" (is "0 < ?s") by simp
   define N where "N i = (LEAST N. \<forall>m\<ge>N. \<forall>n\<ge>N. dist (X m $ i) (X n $ i) < ?s)" for i
   define M where "M = Max (range N)"
   have "\<And>i. \<exists>N. \<forall>m\<ge>N. \<forall>n\<ge>N. dist (X m $ i) (X n $ i) < ?s"
     using X \<open>0 < ?s\<close> by (rule metric_CauchyD)
   hence "\<And>i. \<forall>m\<ge>N i. \<forall>n\<ge>N i. dist (X m $ i) (X n $ i) < ?s"
     unfolding N_def by (rule LeastI_ex)
   hence M: "\<And>i. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m $ i) (X n $ i) < ?s"
     unfolding M_def by simp
   {
     fix m n :: nat
     assume "M \<le> m" "M \<le> n"
     have "dist (X m) (X n) = L2_set (\<lambda>i. dist (X m $ i) (X n $ i)) UNIV"
       unfolding dist_vec_def ..
     also have "\<dots> \<le> sum (\<lambda>i. dist (X m $ i) (X n $ i)) UNIV"
       by (rule L2_set_le_sum [OF zero_le_dist])
     also have "\<dots> < sum (\<lambda>i::'n. ?s) UNIV"
       by (rule sum_strict_mono, simp_all add: M \<open>M \<le> m\<close> \<open>M \<le> n\<close>)
     also have "\<dots> = r"
       by simp
     finally have "dist (X m) (X n) < r" .
   }
   hence "\<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < r"
     by simp
   then show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < r" ..
 qed
 
 instance\<^marker>\<open>tag unimportant\<close> vec :: (complete_space, finite) complete_space
 proof
   fix X :: "nat \<Rightarrow> 'a ^ 'b" assume "Cauchy X"
   have "\<And>i. (\<lambda>n. X n $ i) \<longlonglongrightarrow> lim (\<lambda>n. X n $ i)"
     using Cauchy_vec_nth [OF \<open>Cauchy X\<close>]
     by (simp add: Cauchy_convergent_iff convergent_LIMSEQ_iff)
   hence "X \<longlonglongrightarrow> vec_lambda (\<lambda>i. lim (\<lambda>n. X n $ i))"
     by (simp add: vec_tendstoI)
   then show "convergent X"
     by (rule convergentI)
 qed
 
 
 subsection \<open>Normed vector space\<close>
 
 instantiation\<^marker>\<open>tag unimportant\<close> vec :: (real_normed_vector, finite) real_normed_vector
 begin
 
 definition\<^marker>\<open>tag important\<close> "norm x = L2_set (\<lambda>i. norm (x$i)) UNIV"
 
 definition\<^marker>\<open>tag important\<close> "sgn (x::'a^'b) = scaleR (inverse (norm x)) x"
 
 instance\<^marker>\<open>tag unimportant\<close> proof
   fix a :: real and x y :: "'a ^ 'b"
   show "norm x = 0 \<longleftrightarrow> x = 0"
     unfolding norm_vec_def
     by (simp add: L2_set_eq_0_iff vec_eq_iff)
   show "norm (x + y) \<le> norm x + norm y"
     unfolding norm_vec_def
     apply (rule order_trans [OF _ L2_set_triangle_ineq])
     apply (simp add: L2_set_mono norm_triangle_ineq)
     done
   show "norm (scaleR a x) = \<bar>a\<bar> * norm x"
     unfolding norm_vec_def
     by (simp add: L2_set_right_distrib)
   show "sgn x = scaleR (inverse (norm x)) x"
     by (rule sgn_vec_def)
   show "dist x y = norm (x - y)"
     unfolding dist_vec_def norm_vec_def
     by (simp add: dist_norm)
 qed
 
 end
 
 lemma norm_nth_le: "norm (x $ i) \<le> norm x"
 unfolding norm_vec_def
 by (rule member_le_L2_set) simp_all
 
 lemma norm_le_componentwise_cart:
   fixes x :: "'a::real_normed_vector^'n"
   assumes "\<And>i. norm(x$i) \<le> norm(y$i)"
   shows "norm x \<le> norm y"
   unfolding norm_vec_def
   by (rule L2_set_mono) (auto simp: assms)
 
 lemma component_le_norm_cart: "\<bar>x$i\<bar> \<le> norm x"
   apply (simp add: norm_vec_def)
   apply (rule member_le_L2_set, simp_all)
   done
 
 lemma norm_bound_component_le_cart: "norm x \<le> e ==> \<bar>x$i\<bar> \<le> e"
   by (metis component_le_norm_cart order_trans)
 
 lemma norm_bound_component_lt_cart: "norm x < e ==> \<bar>x$i\<bar> < e"
   by (metis component_le_norm_cart le_less_trans)
 
 lemma norm_le_l1_cart: "norm x \<le> sum(\<lambda>i. \<bar>x$i\<bar>) UNIV"
   by (simp add: norm_vec_def L2_set_le_sum)
 
 lemma bounded_linear_vec_nth[intro]: "bounded_linear (\<lambda>x. x $ i)"
 apply standard
 apply (rule vector_add_component)
 apply (rule vector_scaleR_component)
 apply (rule_tac x="1" in exI, simp add: norm_nth_le)
 done
 
 instance vec :: (banach, finite) banach ..
 
 
 subsection \<open>Inner product space\<close>
 
 instantiation\<^marker>\<open>tag unimportant\<close> vec :: (real_inner, finite) real_inner
 begin
 
 definition\<^marker>\<open>tag important\<close> "inner x y = sum (\<lambda>i. inner (x$i) (y$i)) UNIV"
 
 instance\<^marker>\<open>tag unimportant\<close> proof
   fix r :: real and x y z :: "'a ^ 'b"
   show "inner x y = inner y x"
     unfolding inner_vec_def
     by (simp add: inner_commute)
   show "inner (x + y) z = inner x z + inner y z"
     unfolding inner_vec_def
     by (simp add: inner_add_left sum.distrib)
   show "inner (scaleR r x) y = r * inner x y"
     unfolding inner_vec_def
     by (simp add: sum_distrib_left)
   show "0 \<le> inner x x"
     unfolding inner_vec_def
     by (simp add: sum_nonneg)
   show "inner x x = 0 \<longleftrightarrow> x = 0"
     unfolding inner_vec_def
     by (simp add: vec_eq_iff sum_nonneg_eq_0_iff)
   show "norm x = sqrt (inner x x)"
     unfolding inner_vec_def norm_vec_def L2_set_def
     by (simp add: power2_norm_eq_inner)
 qed
 
 end
 
 
 subsection \<open>Euclidean space\<close>
 
 text \<open>Vectors pointing along a single axis.\<close>
 
 definition\<^marker>\<open>tag important\<close> "axis k x = (\<chi> i. if i = k then x else 0)"
 
 lemma axis_nth [simp]: "axis i x $ i = x"
   unfolding axis_def by simp
 
 lemma axis_eq_axis: "axis i x = axis j y \<longleftrightarrow> x = y \<and> i = j \<or> x = 0 \<and> y = 0"
   unfolding axis_def vec_eq_iff by auto
 
 lemma inner_axis_axis:
   "inner (axis i x) (axis j y) = (if i = j then inner x y else 0)"
   unfolding inner_vec_def
   apply (cases "i = j")
   apply clarsimp
   apply (subst sum.remove [of _ j], simp_all)
   apply (rule sum.neutral, simp add: axis_def)
   apply (rule sum.neutral, simp add: axis_def)
   done
 
 lemma inner_axis: "inner x (axis i y) = inner (x $ i) y"
   by (simp add: inner_vec_def axis_def sum.remove [where x=i])
 
 lemma inner_axis': "inner(axis i y) x = inner y (x $ i)"
   by (simp add: inner_axis inner_commute)
 
 instantiation\<^marker>\<open>tag unimportant\<close> vec :: (euclidean_space, finite) euclidean_space
 begin
 
 definition\<^marker>\<open>tag important\<close> "Basis = (\<Union>i. \<Union>u\<in>Basis. {axis i u})"
 
 instance\<^marker>\<open>tag unimportant\<close> proof
   show "(Basis :: ('a ^ 'b) set) \<noteq> {}"
     unfolding Basis_vec_def by simp
 next
   show "finite (Basis :: ('a ^ 'b) set)"
     unfolding Basis_vec_def by simp
 next
   fix u v :: "'a ^ 'b"
   assume "u \<in> Basis" and "v \<in> Basis"
   thus "inner u v = (if u = v then 1 else 0)"
     unfolding Basis_vec_def
     by (auto simp add: inner_axis_axis axis_eq_axis inner_Basis)
 next
   fix x :: "'a ^ 'b"
   show "(\<forall>u\<in>Basis. inner x u = 0) \<longleftrightarrow> x = 0"
     unfolding Basis_vec_def
     by (simp add: inner_axis euclidean_all_zero_iff vec_eq_iff)
 qed
 
 proposition DIM_cart [simp]: "DIM('a^'b) = CARD('b) * DIM('a)"
 proof -
   have "card (\<Union>i::'b. \<Union>u::'a\<in>Basis. {axis i u}) = (\<Sum>i::'b\<in>UNIV. card (\<Union>u::'a\<in>Basis. {axis i u}))"
     by (rule card_UN_disjoint) (auto simp: axis_eq_axis) 
   also have "... = CARD('b) * DIM('a)"
     by (subst card_UN_disjoint) (auto simp: axis_eq_axis)
   finally show ?thesis
     by (simp add: Basis_vec_def)
 qed
 
 end
 
 lemma norm_axis_1 [simp]: "norm (axis m (1::real)) = 1"
   by (simp add: inner_axis' norm_eq_1)
 
 lemma sum_norm_allsubsets_bound_cart:
   fixes f:: "'a \<Rightarrow> real ^'n"
   assumes fP: "finite P" and fPs: "\<And>Q. Q \<subseteq> P \<Longrightarrow> norm (sum f Q) \<le> e"
   shows "sum (\<lambda>x. norm (f x)) P \<le> 2 * real CARD('n) *  e"
   using sum_norm_allsubsets_bound[OF assms]
   by simp
 
 lemma cart_eq_inner_axis: "a $ i = inner a (axis i 1)"
   by (simp add: inner_axis)
 
 lemma axis_eq_0_iff [simp]:
   shows "axis m x = 0 \<longleftrightarrow> x = 0"
   by (simp add: axis_def vec_eq_iff)
 
 lemma axis_in_Basis_iff [simp]: "axis i a \<in> Basis \<longleftrightarrow> a \<in> Basis"
   by (auto simp: Basis_vec_def axis_eq_axis)
 
 text\<open>Mapping each basis element to the corresponding finite index\<close>
 definition axis_index :: "('a::comm_ring_1)^'n \<Rightarrow> 'n" where "axis_index v \<equiv> SOME i. v = axis i 1"
 
 lemma axis_inverse:
   fixes v :: "real^'n"
   assumes "v \<in> Basis"
   shows "\<exists>i. v = axis i 1"
 proof -
   have "v \<in> (\<Union>n. \<Union>r\<in>Basis. {axis n r})"
     using assms Basis_vec_def by blast
   then show ?thesis
     by (force simp add: vec_eq_iff)
 qed
 
 lemma axis_index:
   fixes v :: "real^'n"
   assumes "v \<in> Basis"
   shows "v = axis (axis_index v) 1"
   by (metis (mono_tags) assms axis_inverse axis_index_def someI_ex)
 
 lemma axis_index_axis [simp]:
   fixes UU :: "real^'n"
   shows "(axis_index (axis u 1 :: real^'n)) = (u::'n)"
   by (simp add: axis_eq_axis axis_index_def)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>A naive proof procedure to lift really trivial arithmetic stuff from the basis of the vector space\<close>
 
 lemma sum_cong_aux:
   "(\<And>x. x \<in> A \<Longrightarrow> f x = g x) \<Longrightarrow> sum f A = sum g A"
   by (auto intro: sum.cong)
 
 hide_fact (open) sum_cong_aux
 
 method_setup vector = \<open>
 let
   val ss1 =
     simpset_of (put_simpset HOL_basic_ss \<^context>
       addsimps [@{thm sum.distrib} RS sym,
       @{thm sum_subtractf} RS sym, @{thm sum_distrib_left},
       @{thm sum_distrib_right}, @{thm sum_negf} RS sym])
   val ss2 =
     simpset_of (\<^context> addsimps
              [@{thm plus_vec_def}, @{thm times_vec_def},
               @{thm minus_vec_def}, @{thm uminus_vec_def},
               @{thm one_vec_def}, @{thm zero_vec_def}, @{thm vec_def},
               @{thm scaleR_vec_def},
               @{thm vec_lambda_beta}, @{thm vector_scalar_mult_def}])
   fun vector_arith_tac ctxt ths =
     simp_tac (put_simpset ss1 ctxt)
     THEN' (fn i => resolve_tac ctxt @{thms Finite_Cartesian_Product.sum_cong_aux} i
          ORELSE resolve_tac ctxt @{thms sum.neutral} i
          ORELSE simp_tac (put_simpset HOL_basic_ss ctxt addsimps [@{thm vec_eq_iff}]) i)
     (* THEN' TRY o clarify_tac HOL_cs  THEN' (TRY o rtac @{thm iffI}) *)
     THEN' asm_full_simp_tac (put_simpset ss2 ctxt addsimps ths)
 in
   Attrib.thms >> (fn ths => fn ctxt => SIMPLE_METHOD' (vector_arith_tac ctxt ths))
 end
 \<close> "lift trivial vector statements to real arith statements"
 
 lemma vec_0[simp]: "vec 0 = 0" by vector
 lemma vec_1[simp]: "vec 1 = 1" by vector
 
 lemma vec_inj[simp]: "vec x = vec y \<longleftrightarrow> x = y" by vector
 
 lemma vec_in_image_vec: "vec x \<in> (vec ` S) \<longleftrightarrow> x \<in> S" by auto
 
 lemma vec_add: "vec(x + y) = vec x + vec y"  by vector
 lemma vec_sub: "vec(x - y) = vec x - vec y" by vector
 lemma vec_cmul: "vec(c * x) = c *s vec x " by vector
 lemma vec_neg: "vec(- x) = - vec x " by vector
 
 lemma vec_scaleR: "vec(c * x) = c *\<^sub>R vec x"
   by vector
 
 lemma vec_sum:
   assumes "finite S"
   shows "vec(sum f S) = sum (vec \<circ> f) S"
   using assms
 proof induct
   case empty
   then show ?case by simp
 next
   case insert
   then show ?case by (auto simp add: vec_add)
 qed
 
 text\<open>Obvious "component-pushing".\<close>
 
 lemma vec_component [simp]: "vec x $ i = x"
   by vector
 
 lemma vector_mult_component [simp]: "(x * y)$i = x$i * y$i"
   by vector
 
 lemma vector_smult_component [simp]: "(c *s y)$i = c * (y$i)"
   by vector
 
 lemma cond_component: "(if b then x else y)$i = (if b then x$i else y$i)" by vector
 
 lemmas\<^marker>\<open>tag unimportant\<close> vector_component =
   vec_component vector_add_component vector_mult_component
   vector_smult_component vector_minus_component vector_uminus_component
   vector_scaleR_component cond_component
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Some frequently useful arithmetic lemmas over vectors\<close>
 
 instance vec :: (semigroup_mult, finite) semigroup_mult
   by standard (vector mult.assoc)
 
 instance vec :: (monoid_mult, finite) monoid_mult
   by standard vector+
 
 instance vec :: (ab_semigroup_mult, finite) ab_semigroup_mult
   by standard (vector mult.commute)
 
 instance vec :: (comm_monoid_mult, finite) comm_monoid_mult
   by standard vector
 
 instance vec :: (semiring, finite) semiring
   by standard (vector field_simps)+
 
 instance vec :: (semiring_0, finite) semiring_0
   by standard (vector field_simps)+
 instance vec :: (semiring_1, finite) semiring_1
   by standard vector
 instance vec :: (comm_semiring, finite) comm_semiring
   by standard (vector field_simps)+
 
 instance vec :: (comm_semiring_0, finite) comm_semiring_0 ..
 instance vec :: (semiring_0_cancel, finite) semiring_0_cancel ..
 instance vec :: (comm_semiring_0_cancel, finite) comm_semiring_0_cancel ..
 instance vec :: (ring, finite) ring ..
 instance vec :: (semiring_1_cancel, finite) semiring_1_cancel ..
 instance vec :: (comm_semiring_1, finite) comm_semiring_1 ..
 
 instance vec :: (ring_1, finite) ring_1 ..
 
 instance vec :: (real_algebra, finite) real_algebra
   by standard (simp_all add: vec_eq_iff)
 
 instance vec :: (real_algebra_1, finite) real_algebra_1 ..
 
 lemma of_nat_index: "(of_nat n :: 'a::semiring_1 ^'n)$i = of_nat n"
 proof (induct n)
   case 0
   then show ?case by vector
 next
   case Suc
   then show ?case by vector
 qed
 
 lemma one_index [simp]: "(1 :: 'a :: one ^ 'n) $ i = 1"
   by vector
 
 lemma neg_one_index [simp]: "(- 1 :: 'a :: {one, uminus} ^ 'n) $ i = - 1"
   by vector
 
 instance vec :: (semiring_char_0, finite) semiring_char_0
 proof
   fix m n :: nat
   show "inj (of_nat :: nat \<Rightarrow> 'a ^ 'b)"
     by (auto intro!: injI simp add: vec_eq_iff of_nat_index)
 qed
 
 instance vec :: (numeral, finite) numeral ..
 instance vec :: (semiring_numeral, finite) semiring_numeral ..
 
 lemma numeral_index [simp]: "numeral w $ i = numeral w"
   by (induct w) (simp_all only: numeral.simps vector_add_component one_index)
 
 lemma neg_numeral_index [simp]: "- numeral w $ i = - numeral w"
   by (simp only: vector_uminus_component numeral_index)
 
 instance vec :: (comm_ring_1, finite) comm_ring_1 ..
 instance vec :: (ring_char_0, finite) ring_char_0 ..
 
 lemma vector_smult_assoc: "a *s (b *s x) = ((a::'a::semigroup_mult) * b) *s x"
   by (vector mult.assoc)
 lemma vector_sadd_rdistrib: "((a::'a::semiring) + b) *s x = a *s x + b *s x"
   by (vector field_simps)
 lemma vector_add_ldistrib: "(c::'a::semiring) *s (x + y) = c *s x + c *s y"
   by (vector field_simps)
 lemma vector_smult_lzero[simp]: "(0::'a::mult_zero) *s x = 0" by vector
 lemma vector_smult_lid[simp]: "(1::'a::monoid_mult) *s x = x" by vector
 lemma vector_ssub_ldistrib: "(c::'a::ring) *s (x - y) = c *s x - c *s y"
   by (vector field_simps)
 lemma vector_smult_rneg: "(c::'a::ring) *s -x = -(c *s x)" by vector
 lemma vector_smult_lneg: "- (c::'a::ring) *s x = -(c *s x)" by vector
 lemma vector_sneg_minus1: "-x = (-1::'a::ring_1) *s x" by vector
 lemma vector_smult_rzero[simp]: "c *s 0 = (0::'a::mult_zero ^ 'n)" by vector
 lemma vector_sub_rdistrib: "((a::'a::ring) - b) *s x = a *s x - b *s x"
   by (vector field_simps)
 
 lemma vec_eq[simp]: "(vec m = vec n) \<longleftrightarrow> (m = n)"
   by (simp add: vec_eq_iff)
 
 lemma Vector_Spaces_linear_vec [simp]: "Vector_Spaces.linear (*) vector_scalar_mult vec"
   by unfold_locales (vector algebra_simps)+
 
 lemma vector_mul_eq_0[simp]: "(a *s x = 0) \<longleftrightarrow> a = (0::'a::idom) \<or> x = 0"
   by vector
 
 lemma vector_mul_lcancel[simp]: "a *s x = a *s y \<longleftrightarrow> a = (0::'a::field) \<or> x = y"
   by (metis eq_iff_diff_eq_0 vector_mul_eq_0 vector_ssub_ldistrib)
 
 lemma vector_mul_rcancel[simp]: "a *s x = b *s x \<longleftrightarrow> (a::'a::field) = b \<or> x = 0"
   by (metis eq_iff_diff_eq_0 vector_mul_eq_0 vector_sub_rdistrib)
 
 lemma scalar_mult_eq_scaleR [abs_def]: "c *s x = c *\<^sub>R x"
   unfolding scaleR_vec_def vector_scalar_mult_def by simp
 
 lemma dist_mul[simp]: "dist (c *s x) (c *s y) = \<bar>c\<bar> * dist x y"
   unfolding dist_norm scalar_mult_eq_scaleR
   unfolding scaleR_right_diff_distrib[symmetric] by simp
 
 lemma sum_component [simp]:
   fixes f:: " 'a \<Rightarrow> ('b::comm_monoid_add) ^'n"
   shows "(sum f S)$i = sum (\<lambda>x. (f x)$i) S"
 proof (cases "finite S")
   case True
   then show ?thesis by induct simp_all
 next
   case False
   then show ?thesis by simp
 qed
 
 lemma sum_eq: "sum f S = (\<chi> i. sum (\<lambda>x. (f x)$i ) S)"
   by (simp add: vec_eq_iff)
 
 lemma sum_cmul:
   fixes f:: "'c \<Rightarrow> ('a::semiring_1)^'n"
   shows "sum (\<lambda>x. c *s f x) S = c *s sum f S"
   by (simp add: vec_eq_iff sum_distrib_left)
 
 lemma linear_vec [simp]: "linear vec"
   using Vector_Spaces_linear_vec
   apply (auto )
   by unfold_locales (vector algebra_simps)+
 
 subsection \<open>Matrix operations\<close>
 
 text\<open>Matrix notation. NB: an MxN matrix is of type \<^typ>\<open>'a^'n^'m\<close>, not \<^typ>\<open>'a^'m^'n\<close>\<close>
 
 definition\<^marker>\<open>tag important\<close> map_matrix::"('a \<Rightarrow> 'b) \<Rightarrow> (('a, 'i::finite)vec, 'j::finite) vec \<Rightarrow> (('b, 'i)vec, 'j) vec" where
   "map_matrix f x = (\<chi> i j. f (x $ i $ j))"
 
 lemma nth_map_matrix[simp]: "map_matrix f x $ i $ j = f (x $ i $ j)"
   by (simp add: map_matrix_def)
 
 definition\<^marker>\<open>tag important\<close> matrix_matrix_mult :: "('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'p^'n \<Rightarrow> 'a ^ 'p ^'m"
     (infixl "**" 70)
   where "m ** m' == (\<chi> i j. sum (\<lambda>k. ((m$i)$k) * ((m'$k)$j)) (UNIV :: 'n set)) ::'a ^ 'p ^'m"
 
 definition\<^marker>\<open>tag important\<close> matrix_vector_mult :: "('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'n \<Rightarrow> 'a ^ 'm"
     (infixl "*v" 70)
   where "m *v x \<equiv> (\<chi> i. sum (\<lambda>j. ((m$i)$j) * (x$j)) (UNIV ::'n set)) :: 'a^'m"
 
 definition\<^marker>\<open>tag important\<close> vector_matrix_mult :: "'a ^ 'm \<Rightarrow> ('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'n "
     (infixl "v*" 70)
   where "v v* m == (\<chi> j. sum (\<lambda>i. ((m$i)$j) * (v$i)) (UNIV :: 'm set)) :: 'a^'n"
 
 definition\<^marker>\<open>tag unimportant\<close> "(mat::'a::zero => 'a ^'n^'n) k = (\<chi> i j. if i = j then k else 0)"
 definition\<^marker>\<open>tag unimportant\<close> transpose where
   "(transpose::'a^'n^'m \<Rightarrow> 'a^'m^'n) A = (\<chi> i j. ((A$j)$i))"
 definition\<^marker>\<open>tag unimportant\<close> "(row::'m => 'a ^'n^'m \<Rightarrow> 'a ^'n) i A = (\<chi> j. ((A$i)$j))"
 definition\<^marker>\<open>tag unimportant\<close> "(column::'n =>'a^'n^'m =>'a^'m) j A = (\<chi> i. ((A$i)$j))"
 definition\<^marker>\<open>tag unimportant\<close> "rows(A::'a^'n^'m) = { row i A | i. i \<in> (UNIV :: 'm set)}"
 definition\<^marker>\<open>tag unimportant\<close> "columns(A::'a^'n^'m) = { column i A | i. i \<in> (UNIV :: 'n set)}"
 
 lemma times0_left [simp]: "(0::'a::semiring_1^'n^'m) ** (A::'a ^'p^'n) = 0" 
   by (simp add: matrix_matrix_mult_def zero_vec_def)
 
 lemma times0_right [simp]: "(A::'a::semiring_1^'n^'m) ** (0::'a ^'p^'n) = 0" 
   by (simp add: matrix_matrix_mult_def zero_vec_def)
 
 lemma mat_0[simp]: "mat 0 = 0" by (vector mat_def)
 lemma matrix_add_ldistrib: "(A ** (B + C)) = (A ** B) + (A ** C)"
   by (vector matrix_matrix_mult_def sum.distrib[symmetric] field_simps)
 
 lemma matrix_mul_lid [simp]:
   fixes A :: "'a::semiring_1 ^ 'm ^ 'n"
   shows "mat 1 ** A = A"
   apply (simp add: matrix_matrix_mult_def mat_def)
   apply vector
   apply (auto simp only: if_distrib if_distribR sum.delta'[OF finite]
     mult_1_left mult_zero_left if_True UNIV_I)
   done
 
 lemma matrix_mul_rid [simp]:
   fixes A :: "'a::semiring_1 ^ 'm ^ 'n"
   shows "A ** mat 1 = A"
   apply (simp add: matrix_matrix_mult_def mat_def)
   apply vector
   apply (auto simp only: if_distrib if_distribR sum.delta[OF finite]
     mult_1_right mult_zero_right if_True UNIV_I cong: if_cong)
   done
 
 proposition matrix_mul_assoc: "A ** (B ** C) = (A ** B) ** C"
   apply (vector matrix_matrix_mult_def sum_distrib_left sum_distrib_right mult.assoc)
   apply (subst sum.swap)
   apply simp
   done
 
 proposition matrix_vector_mul_assoc: "A *v (B *v x) = (A ** B) *v x"
   apply (vector matrix_matrix_mult_def matrix_vector_mult_def
     sum_distrib_left sum_distrib_right mult.assoc)
   apply (subst sum.swap)
   apply simp
   done
 
 proposition scalar_matrix_assoc:
   fixes A :: "('a::real_algebra_1)^'m^'n"
   shows "k *\<^sub>R (A ** B) = (k *\<^sub>R A) ** B"
   by (simp add: matrix_matrix_mult_def sum_distrib_left mult_ac vec_eq_iff scaleR_sum_right)
 
 proposition matrix_scalar_ac:
   fixes A :: "('a::real_algebra_1)^'m^'n"
   shows "A ** (k *\<^sub>R B) = k *\<^sub>R A ** B"
   by (simp add: matrix_matrix_mult_def sum_distrib_left mult_ac vec_eq_iff)
 
 lemma matrix_vector_mul_lid [simp]: "mat 1 *v x = (x::'a::semiring_1 ^ 'n)"
   apply (vector matrix_vector_mult_def mat_def)
-  apply (simp add: if_distrib if_distribR sum.delta' cong del: if_weak_cong)
+  apply (simp add: if_distrib if_distribR cong del: if_weak_cong)
   done
 
 lemma matrix_transpose_mul:
     "transpose(A ** B) = transpose B ** transpose (A::'a::comm_semiring_1^_^_)"
   by (simp add: matrix_matrix_mult_def transpose_def vec_eq_iff mult.commute)
 
 lemma matrix_mult_transpose_dot_column:
   shows "transpose A ** A = (\<chi> i j. inner (column i A) (column j A))"
   by (simp add: matrix_matrix_mult_def vec_eq_iff transpose_def column_def inner_vec_def)
 
 lemma matrix_mult_transpose_dot_row:
   shows "A ** transpose A = (\<chi> i j. inner (row i A) (row j A))"
   by (simp add: matrix_matrix_mult_def vec_eq_iff transpose_def row_def inner_vec_def)
 
 lemma matrix_eq:
   fixes A B :: "'a::semiring_1 ^ 'n ^ 'm"
   shows "A = B \<longleftrightarrow>  (\<forall>x. A *v x = B *v x)" (is "?lhs \<longleftrightarrow> ?rhs")
   apply auto
   apply (subst vec_eq_iff)
   apply clarify
   apply (clarsimp simp add: matrix_vector_mult_def if_distrib if_distribR vec_eq_iff cong del: if_weak_cong)
   apply (erule_tac x="axis ia 1" in allE)
   apply (erule_tac x="i" in allE)
   apply (auto simp add: if_distrib if_distribR axis_def
     sum.delta[OF finite] cong del: if_weak_cong)
   done
 
 lemma matrix_vector_mul_component: "(A *v x)$k = inner (A$k) x"
   by (simp add: matrix_vector_mult_def inner_vec_def)
 
 lemma dot_lmul_matrix: "inner ((x::real ^_) v* A) y = inner x (A *v y)"
   apply (simp add: inner_vec_def matrix_vector_mult_def vector_matrix_mult_def sum_distrib_right sum_distrib_left ac_simps)
   apply (subst sum.swap)
   apply simp
   done
 
 lemma transpose_mat [simp]: "transpose (mat n) = mat n"
   by (vector transpose_def mat_def)
 
 lemma transpose_transpose [simp]: "transpose(transpose A) = A"
   by (vector transpose_def)
 
 lemma row_transpose [simp]: "row i (transpose A) = column i A"
   by (simp add: row_def column_def transpose_def vec_eq_iff)
 
 lemma column_transpose [simp]: "column i (transpose A) = row i A"
   by (simp add: row_def column_def transpose_def vec_eq_iff)
 
 lemma rows_transpose [simp]: "rows(transpose A) = columns A"
   by (auto simp add: rows_def columns_def intro: set_eqI)
 
 lemma columns_transpose [simp]: "columns(transpose A) = rows A"
   by (metis transpose_transpose rows_transpose)
 
 lemma transpose_scalar: "transpose (k *\<^sub>R A) = k *\<^sub>R transpose A"
   unfolding transpose_def
   by (simp add: vec_eq_iff)
 
 lemma transpose_iff [iff]: "transpose A = transpose B \<longleftrightarrow> A = B"
   by (metis transpose_transpose)
 
 lemma matrix_mult_sum:
   "(A::'a::comm_semiring_1^'n^'m) *v x = sum (\<lambda>i. (x$i) *s column i A) (UNIV:: 'n set)"
   by (simp add: matrix_vector_mult_def vec_eq_iff column_def mult.commute)
 
 lemma vector_componentwise:
   "(x::'a::ring_1^'n) = (\<chi> j. \<Sum>i\<in>UNIV. (x$i) * (axis i 1 :: 'a^'n) $ j)"
   by (simp add: axis_def if_distrib sum.If_cases vec_eq_iff)
 
 lemma basis_expansion: "sum (\<lambda>i. (x$i) *s axis i 1) UNIV = (x::('a::ring_1) ^'n)"
   by (auto simp add: axis_def vec_eq_iff if_distrib sum.If_cases cong del: if_weak_cong)
 
 
 text\<open>Correspondence between matrices and linear operators.\<close>
 
 definition\<^marker>\<open>tag important\<close> matrix :: "('a::{plus,times, one, zero}^'m \<Rightarrow> 'a ^ 'n) \<Rightarrow> 'a^'m^'n"
   where "matrix f = (\<chi> i j. (f(axis j 1))$i)"
 
 lemma matrix_id_mat_1: "matrix id = mat 1"
   by (simp add: mat_def matrix_def axis_def)
 
 lemma matrix_scaleR: "(matrix ((*\<^sub>R) r)) = mat r"
   by (simp add: mat_def matrix_def axis_def if_distrib cong: if_cong)
 
 lemma matrix_vector_mul_linear[intro, simp]: "linear (\<lambda>x. A *v (x::'a::real_algebra_1 ^ _))"
   by (simp add: linear_iff matrix_vector_mult_def vec_eq_iff field_simps sum_distrib_left
       sum.distrib scaleR_right.sum)
 
 lemma vector_matrix_left_distrib [algebra_simps]:
   shows "(x + y) v* A = x v* A + y v* A"
   unfolding vector_matrix_mult_def
   by (simp add: algebra_simps sum.distrib vec_eq_iff)
 
 lemma matrix_vector_right_distrib [algebra_simps]:
   "A *v (x + y) = A *v x + A *v y"
   by (vector matrix_vector_mult_def sum.distrib distrib_left)
 
 lemma matrix_vector_mult_diff_distrib [algebra_simps]:
   fixes A :: "'a::ring_1^'n^'m"
   shows "A *v (x - y) = A *v x - A *v y"
   by (vector matrix_vector_mult_def sum_subtractf right_diff_distrib)
 
 lemma matrix_vector_mult_scaleR[algebra_simps]:
   fixes A :: "real^'n^'m"
   shows "A *v (c *\<^sub>R x) = c *\<^sub>R (A *v x)"
   using linear_iff matrix_vector_mul_linear by blast
 
 lemma matrix_vector_mult_0_right [simp]: "A *v 0 = 0"
   by (simp add: matrix_vector_mult_def vec_eq_iff)
 
 lemma matrix_vector_mult_0 [simp]: "0 *v w = 0"
   by (simp add: matrix_vector_mult_def vec_eq_iff)
 
 lemma matrix_vector_mult_add_rdistrib [algebra_simps]:
   "(A + B) *v x = (A *v x) + (B *v x)"
   by (vector matrix_vector_mult_def sum.distrib distrib_right)
 
 lemma matrix_vector_mult_diff_rdistrib [algebra_simps]:
   fixes A :: "'a :: ring_1^'n^'m"
   shows "(A - B) *v x = (A *v x) - (B *v x)"
   by (vector matrix_vector_mult_def sum_subtractf left_diff_distrib)
 
 lemma matrix_vector_column:
   "(A::'a::comm_semiring_1^'n^_) *v x = sum (\<lambda>i. (x$i) *s ((transpose A)$i)) (UNIV:: 'n set)"
   by (simp add: matrix_vector_mult_def transpose_def vec_eq_iff mult.commute)
 
 subsection\<open>Inverse matrices  (not necessarily square)\<close>
 
 definition\<^marker>\<open>tag important\<close>
   "invertible(A::'a::semiring_1^'n^'m) \<longleftrightarrow> (\<exists>A'::'a^'m^'n. A ** A' = mat 1 \<and> A' ** A = mat 1)"
 
 definition\<^marker>\<open>tag important\<close>
   "matrix_inv(A:: 'a::semiring_1^'n^'m) =
     (SOME A'::'a^'m^'n. A ** A' = mat 1 \<and> A' ** A = mat 1)"
 
 lemma inj_matrix_vector_mult:
   fixes A::"'a::field^'n^'m"
   assumes "invertible A"
   shows "inj ((*v) A)"
   by (metis assms inj_on_inverseI invertible_def matrix_vector_mul_assoc matrix_vector_mul_lid)
 
 lemma scalar_invertible:
   fixes A :: "('a::real_algebra_1)^'m^'n"
   assumes "k \<noteq> 0" and "invertible A"
   shows "invertible (k *\<^sub>R A)"
 proof -
   obtain A' where "A ** A' = mat 1" and "A' ** A = mat 1"
     using assms unfolding invertible_def by auto
   with \<open>k \<noteq> 0\<close>
   have "(k *\<^sub>R A) ** ((1/k) *\<^sub>R A') = mat 1" "((1/k) *\<^sub>R A') ** (k *\<^sub>R A) = mat 1"
     by (simp_all add: assms matrix_scalar_ac)
   thus "invertible (k *\<^sub>R A)"
     unfolding invertible_def by auto
 qed
 
 proposition scalar_invertible_iff:
   fixes A :: "('a::real_algebra_1)^'m^'n"
   assumes "k \<noteq> 0" and "invertible A"
   shows "invertible (k *\<^sub>R A) \<longleftrightarrow> k \<noteq> 0 \<and> invertible A"
   by (simp add: assms scalar_invertible)
 
 lemma vector_transpose_matrix [simp]: "x v* transpose A = A *v x"
   unfolding transpose_def vector_matrix_mult_def matrix_vector_mult_def
   by simp
 
 lemma transpose_matrix_vector [simp]: "transpose A *v x = x v* A"
   unfolding transpose_def vector_matrix_mult_def matrix_vector_mult_def
   by simp
 
 lemma vector_scalar_commute:
   fixes A :: "'a::{field}^'m^'n"
   shows "A *v (c *s x) = c *s (A *v x)"
   by (simp add: vector_scalar_mult_def matrix_vector_mult_def mult_ac sum_distrib_left)
 
 lemma scalar_vector_matrix_assoc:
   fixes k :: "'a::{field}" and x :: "'a::{field}^'n" and A :: "'a^'m^'n"
   shows "(k *s x) v* A = k *s (x v* A)"
   by (metis transpose_matrix_vector vector_scalar_commute)
  
 lemma vector_matrix_mult_0 [simp]: "0 v* A = 0"
   unfolding vector_matrix_mult_def by (simp add: zero_vec_def)
 
 lemma vector_matrix_mult_0_right [simp]: "x v* 0 = 0"
   unfolding vector_matrix_mult_def by (simp add: zero_vec_def)
 
 lemma vector_matrix_mul_rid [simp]:
   fixes v :: "('a::semiring_1)^'n"
   shows "v v* mat 1 = v"
   by (metis matrix_vector_mul_lid transpose_mat vector_transpose_matrix)
 
 lemma scaleR_vector_matrix_assoc:
   fixes k :: real and x :: "real^'n" and A :: "real^'m^'n"
   shows "(k *\<^sub>R x) v* A = k *\<^sub>R (x v* A)"
   by (metis matrix_vector_mult_scaleR transpose_matrix_vector)
 
 proposition vector_scaleR_matrix_ac:
   fixes k :: real and x :: "real^'n" and A :: "real^'m^'n"
   shows "x v* (k *\<^sub>R A) = k *\<^sub>R (x v* A)"
 proof -
   have "x v* (k *\<^sub>R A) = (k *\<^sub>R x) v* A"
     unfolding vector_matrix_mult_def
     by (simp add: algebra_simps)
   with scaleR_vector_matrix_assoc
   show "x v* (k *\<^sub>R A) = k *\<^sub>R (x v* A)"
     by auto
 qed
 
 end
diff --git a/src/HOL/Analysis/Linear_Algebra.thy b/src/HOL/Analysis/Linear_Algebra.thy
--- a/src/HOL/Analysis/Linear_Algebra.thy
+++ b/src/HOL/Analysis/Linear_Algebra.thy
@@ -1,1972 +1,1879 @@
 (*  Title:      HOL/Analysis/Linear_Algebra.thy
     Author:     Amine Chaieb, University of Cambridge
 *)
 
 section \<open>Elementary Linear Algebra on Euclidean Spaces\<close>
 
 theory Linear_Algebra
 imports
   Euclidean_Space
   "HOL-Library.Infinite_Set"
 begin
 
 lemma linear_simps:
   assumes "bounded_linear f"
   shows
     "f (a + b) = f a + f b"
     "f (a - b) = f a - f b"
     "f 0 = 0"
     "f (- a) = - f a"
     "f (s *\<^sub>R v) = s *\<^sub>R (f v)"
 proof -
   interpret f: bounded_linear f by fact
   show "f (a + b) = f a + f b" by (rule f.add)
   show "f (a - b) = f a - f b" by (rule f.diff)
   show "f 0 = 0" by (rule f.zero)
   show "f (- a) = - f a" by (rule f.neg)
   show "f (s *\<^sub>R v) = s *\<^sub>R (f v)" by (rule f.scale)
 qed
 
 lemma finite_Atleast_Atmost_nat[simp]: "finite {f x |x. x \<in> (UNIV::'a::finite set)}"
   using finite finite_image_set by blast
 
 lemma substdbasis_expansion_unique:
   includes inner_syntax
   assumes d: "d \<subseteq> Basis"
   shows "(\<Sum>i\<in>d. f i *\<^sub>R i) = (x::'a::euclidean_space) \<longleftrightarrow>
     (\<forall>i\<in>Basis. (i \<in> d \<longrightarrow> f i = x \<bullet> i) \<and> (i \<notin> d \<longrightarrow> x \<bullet> i = 0))"
 proof -
   have *: "\<And>x a b P. x * (if P then a else b) = (if P then x * a else x * b)"
     by auto
   have **: "finite d"
     by (auto intro: finite_subset[OF assms])
   have ***: "\<And>i. i \<in> Basis \<Longrightarrow> (\<Sum>i\<in>d. f i *\<^sub>R i) \<bullet> i = (\<Sum>x\<in>d. if x = i then f x else 0)"
     using d
     by (auto intro!: sum.cong simp: inner_Basis inner_sum_left)
   show ?thesis
     unfolding euclidean_eq_iff[where 'a='a] by (auto simp: sum.delta[OF **] ***)
 qed
 
 lemma independent_substdbasis: "d \<subseteq> Basis \<Longrightarrow> independent d"
   by (rule independent_mono[OF independent_Basis])
 
 lemma subset_translation_eq [simp]:
     fixes a :: "'a::real_vector" shows "(+) a ` s \<subseteq> (+) a ` t \<longleftrightarrow> s \<subseteq> t"
   by auto
 
 lemma translate_inj_on:
   fixes A :: "'a::ab_group_add set"
   shows "inj_on (\<lambda>x. a + x) A"
   unfolding inj_on_def by auto
 
 lemma translation_assoc:
   fixes a b :: "'a::ab_group_add"
   shows "(\<lambda>x. b + x) ` ((\<lambda>x. a + x) ` S) = (\<lambda>x. (a + b) + x) ` S"
   by auto
 
 lemma translation_invert:
   fixes a :: "'a::ab_group_add"
   assumes "(\<lambda>x. a + x) ` A = (\<lambda>x. a + x) ` B"
   shows "A = B"
 proof -
   have "(\<lambda>x. -a + x) ` ((\<lambda>x. a + x) ` A) = (\<lambda>x. - a + x) ` ((\<lambda>x. a + x) ` B)"
     using assms by auto
   then show ?thesis
     using translation_assoc[of "-a" a A] translation_assoc[of "-a" a B] by auto
 qed
 
 lemma translation_galois:
   fixes a :: "'a::ab_group_add"
   shows "T = ((\<lambda>x. a + x) ` S) \<longleftrightarrow> S = ((\<lambda>x. (- a) + x) ` T)"
   using translation_assoc[of "-a" a S]
   apply auto
   using translation_assoc[of a "-a" T]
   apply auto
   done
 
 lemma translation_inverse_subset:
   assumes "((\<lambda>x. - a + x) ` V) \<le> (S :: 'n::ab_group_add set)"
   shows "V \<le> ((\<lambda>x. a + x) ` S)"
 proof -
   {
     fix x
     assume "x \<in> V"
     then have "x-a \<in> S" using assms by auto
     then have "x \<in> {a + v |v. v \<in> S}"
       apply auto
       apply (rule exI[of _ "x-a"], simp)
       done
     then have "x \<in> ((\<lambda>x. a+x) ` S)" by auto
   }
   then show ?thesis by auto
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>More interesting properties of the norm\<close>
 
 unbundle inner_syntax
 
 text\<open>Equality of vectors in terms of \<^term>\<open>(\<bullet>)\<close> products.\<close>
 
 lemma linear_componentwise:
   fixes f:: "'a::euclidean_space \<Rightarrow> 'b::real_inner"
   assumes lf: "linear f"
   shows "(f x) \<bullet> j = (\<Sum>i\<in>Basis. (x\<bullet>i) * (f i\<bullet>j))" (is "?lhs = ?rhs")
 proof -
   interpret linear f by fact
   have "?rhs = (\<Sum>i\<in>Basis. (x\<bullet>i) *\<^sub>R (f i))\<bullet>j"
     by (simp add: inner_sum_left)
   then show ?thesis
     by (simp add: euclidean_representation sum[symmetric] scale[symmetric])
 qed
 
 lemma vector_eq: "x = y \<longleftrightarrow> x \<bullet> x = x \<bullet> y \<and> y \<bullet> y = x \<bullet> x"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   then show ?rhs by simp
 next
   assume ?rhs
   then have "x \<bullet> x - x \<bullet> y = 0 \<and> x \<bullet> y - y \<bullet> y = 0"
     by simp
   then have "x \<bullet> (x - y) = 0 \<and> y \<bullet> (x - y) = 0"
     by (simp add: inner_diff inner_commute)
   then have "(x - y) \<bullet> (x - y) = 0"
     by (simp add: field_simps inner_diff inner_commute)
   then show "x = y" by simp
 qed
 
 lemma norm_triangle_half_r:
   "norm (y - x1) < e / 2 \<Longrightarrow> norm (y - x2) < e / 2 \<Longrightarrow> norm (x1 - x2) < e"
   using dist_triangle_half_r unfolding dist_norm[symmetric] by auto
 
 lemma norm_triangle_half_l:
   assumes "norm (x - y) < e / 2"
     and "norm (x' - y) < e / 2"
   shows "norm (x - x') < e"
   using dist_triangle_half_l[OF assms[unfolded dist_norm[symmetric]]]
   unfolding dist_norm[symmetric] .
 
 lemma abs_triangle_half_r:
   fixes y :: "'a::linordered_field"
   shows "abs (y - x1) < e / 2 \<Longrightarrow> abs (y - x2) < e / 2 \<Longrightarrow> abs (x1 - x2) < e"
   by linarith
 
 lemma abs_triangle_half_l:
   fixes y :: "'a::linordered_field"
   assumes "abs (x - y) < e / 2"
     and "abs (x' - y) < e / 2"
   shows "abs (x - x') < e"
   using assms by linarith
 
 lemma sum_clauses:
   shows "sum f {} = 0"
     and "finite S \<Longrightarrow> sum f (insert x S) = (if x \<in> S then sum f S else f x + sum f S)"
   by (auto simp add: insert_absorb)
 
 lemma vector_eq_ldot: "(\<forall>x. x \<bullet> y = x \<bullet> z) \<longleftrightarrow> y = z"
 proof
   assume "\<forall>x. x \<bullet> y = x \<bullet> z"
   then have "\<forall>x. x \<bullet> (y - z) = 0"
     by (simp add: inner_diff)
   then have "(y - z) \<bullet> (y - z) = 0" ..
   then show "y = z" by simp
 qed simp
 
 lemma vector_eq_rdot: "(\<forall>z. x \<bullet> z = y \<bullet> z) \<longleftrightarrow> x = y"
 proof
   assume "\<forall>z. x \<bullet> z = y \<bullet> z"
   then have "\<forall>z. (x - y) \<bullet> z = 0"
     by (simp add: inner_diff)
   then have "(x - y) \<bullet> (x - y) = 0" ..
   then show "x = y" by simp
 qed simp
 
 subsection \<open>Substandard Basis\<close>
 
 lemma ex_card:
   assumes "n \<le> card A"
   shows "\<exists>S\<subseteq>A. card S = n"
 proof (cases "finite A")
   case True
   from ex_bij_betw_nat_finite[OF this] obtain f where f: "bij_betw f {0..<card A} A" ..
   moreover from f \<open>n \<le> card A\<close> have "{..< n} \<subseteq> {..< card A}" "inj_on f {..< n}"
     by (auto simp: bij_betw_def intro: subset_inj_on)
   ultimately have "f ` {..< n} \<subseteq> A" "card (f ` {..< n}) = n"
     by (auto simp: bij_betw_def card_image)
   then show ?thesis by blast
 next
   case False
   with \<open>n \<le> card A\<close> show ?thesis by force
 qed
 
 lemma subspace_substandard: "subspace {x::'a::euclidean_space. (\<forall>i\<in>Basis. P i \<longrightarrow> x\<bullet>i = 0)}"
   by (auto simp: subspace_def inner_add_left)
 
 lemma dim_substandard:
   assumes d: "d \<subseteq> Basis"
   shows "dim {x::'a::euclidean_space. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0} = card d" (is "dim ?A = _")
 proof (rule dim_unique)
   from d show "d \<subseteq> ?A"
     by (auto simp: inner_Basis)
   from d show "independent d"
     by (rule independent_mono [OF independent_Basis])
   have "x \<in> span d" if "\<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = 0" for x
   proof -
     have "finite d"
       by (rule finite_subset [OF d finite_Basis])
     then have "(\<Sum>i\<in>d. (x \<bullet> i) *\<^sub>R i) \<in> span d"
       by (simp add: span_sum span_clauses)
     also have "(\<Sum>i\<in>d. (x \<bullet> i) *\<^sub>R i) = (\<Sum>i\<in>Basis. (x \<bullet> i) *\<^sub>R i)"
       by (rule sum.mono_neutral_cong_left [OF finite_Basis d]) (auto simp: that)
     finally show "x \<in> span d"
       by (simp only: euclidean_representation)
   qed
   then show "?A \<subseteq> span d" by auto
 qed simp
 
 
 subsection \<open>Orthogonality\<close>
 
 definition\<^marker>\<open>tag important\<close> (in real_inner) "orthogonal x y \<longleftrightarrow> x \<bullet> y = 0"
 
 context real_inner
 begin
 
 lemma orthogonal_self: "orthogonal x x \<longleftrightarrow> x = 0"
   by (simp add: orthogonal_def)
 
 lemma orthogonal_clauses:
   "orthogonal a 0"
   "orthogonal a x \<Longrightarrow> orthogonal a (c *\<^sub>R x)"
   "orthogonal a x \<Longrightarrow> orthogonal a (- x)"
   "orthogonal a x \<Longrightarrow> orthogonal a y \<Longrightarrow> orthogonal a (x + y)"
   "orthogonal a x \<Longrightarrow> orthogonal a y \<Longrightarrow> orthogonal a (x - y)"
   "orthogonal 0 a"
   "orthogonal x a \<Longrightarrow> orthogonal (c *\<^sub>R x) a"
   "orthogonal x a \<Longrightarrow> orthogonal (- x) a"
   "orthogonal x a \<Longrightarrow> orthogonal y a \<Longrightarrow> orthogonal (x + y) a"
   "orthogonal x a \<Longrightarrow> orthogonal y a \<Longrightarrow> orthogonal (x - y) a"
   unfolding orthogonal_def inner_add inner_diff by auto
 
 end
 
 lemma orthogonal_commute: "orthogonal x y \<longleftrightarrow> orthogonal y x"
   by (simp add: orthogonal_def inner_commute)
 
 lemma orthogonal_scaleR [simp]: "c \<noteq> 0 \<Longrightarrow> orthogonal (c *\<^sub>R x) = orthogonal x"
   by (rule ext) (simp add: orthogonal_def)
 
 lemma pairwise_ortho_scaleR:
     "pairwise (\<lambda>i j. orthogonal (f i) (g j)) B
     \<Longrightarrow> pairwise (\<lambda>i j. orthogonal (a i *\<^sub>R f i) (a j *\<^sub>R g j)) B"
   by (auto simp: pairwise_def orthogonal_clauses)
 
 lemma orthogonal_rvsum:
     "\<lbrakk>finite s; \<And>y. y \<in> s \<Longrightarrow> orthogonal x (f y)\<rbrakk> \<Longrightarrow> orthogonal x (sum f s)"
   by (induction s rule: finite_induct) (auto simp: orthogonal_clauses)
 
 lemma orthogonal_lvsum:
     "\<lbrakk>finite s; \<And>x. x \<in> s \<Longrightarrow> orthogonal (f x) y\<rbrakk> \<Longrightarrow> orthogonal (sum f s) y"
   by (induction s rule: finite_induct) (auto simp: orthogonal_clauses)
 
 lemma norm_add_Pythagorean:
   assumes "orthogonal a b"
     shows "norm(a + b) ^ 2 = norm a ^ 2 + norm b ^ 2"
 proof -
   from assms have "(a - (0 - b)) \<bullet> (a - (0 - b)) = a \<bullet> a - (0 - b \<bullet> b)"
     by (simp add: algebra_simps orthogonal_def inner_commute)
   then show ?thesis
     by (simp add: power2_norm_eq_inner)
 qed
 
 lemma norm_sum_Pythagorean:
   assumes "finite I" "pairwise (\<lambda>i j. orthogonal (f i) (f j)) I"
     shows "(norm (sum f I))\<^sup>2 = (\<Sum>i\<in>I. (norm (f i))\<^sup>2)"
 using assms
 proof (induction I rule: finite_induct)
   case empty then show ?case by simp
 next
   case (insert x I)
   then have "orthogonal (f x) (sum f I)"
     by (metis pairwise_insert orthogonal_rvsum)
   with insert show ?case
     by (simp add: pairwise_insert norm_add_Pythagorean)
 qed
 
 
 subsection  \<open>Orthogonality of a transformation\<close>
 
 definition\<^marker>\<open>tag important\<close>  "orthogonal_transformation f \<longleftrightarrow> linear f \<and> (\<forall>v w. f v \<bullet> f w = v \<bullet> w)"
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation:
   "orthogonal_transformation f \<longleftrightarrow> linear f \<and> (\<forall>v. norm (f v) = norm v)"
   unfolding orthogonal_transformation_def
   apply auto
   apply (erule_tac x=v in allE)+
   apply (simp add: norm_eq_sqrt_inner)
   apply (simp add: dot_norm linear_add[symmetric])
   done
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_id [simp]: "orthogonal_transformation (\<lambda>x. x)"
   by (simp add: linear_iff orthogonal_transformation_def)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_orthogonal_transformation:
     "orthogonal_transformation f \<Longrightarrow> orthogonal (f x) (f y) \<longleftrightarrow> orthogonal x y"
   by (simp add: orthogonal_def orthogonal_transformation_def)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_compose:
    "\<lbrakk>orthogonal_transformation f; orthogonal_transformation g\<rbrakk> \<Longrightarrow> orthogonal_transformation(f \<circ> g)"
   by (auto simp: orthogonal_transformation_def linear_compose)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_neg:
   "orthogonal_transformation(\<lambda>x. -(f x)) \<longleftrightarrow> orthogonal_transformation f"
   by (auto simp: orthogonal_transformation_def dest: linear_compose_neg)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_scaleR: "orthogonal_transformation f \<Longrightarrow> f (c *\<^sub>R v) = c *\<^sub>R f v"
   by (simp add: linear_iff orthogonal_transformation_def)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_linear:
    "orthogonal_transformation f \<Longrightarrow> linear f"
   by (simp add: orthogonal_transformation_def)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_inj:
   "orthogonal_transformation f \<Longrightarrow> inj f"
   unfolding orthogonal_transformation_def inj_on_def
   by (metis vector_eq)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_surj:
   "orthogonal_transformation f \<Longrightarrow> surj f"
   for f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
   by (simp add: linear_injective_imp_surjective orthogonal_transformation_inj orthogonal_transformation_linear)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_bij:
   "orthogonal_transformation f \<Longrightarrow> bij f"
   for f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
   by (simp add: bij_def orthogonal_transformation_inj orthogonal_transformation_surj)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_inv:
   "orthogonal_transformation f \<Longrightarrow> orthogonal_transformation (inv f)"
   for f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
   by (metis (no_types, hide_lams) bijection.inv_right bijection_def inj_linear_imp_inv_linear orthogonal_transformation orthogonal_transformation_bij orthogonal_transformation_inj)
 
 lemma\<^marker>\<open>tag unimportant\<close>  orthogonal_transformation_norm:
   "orthogonal_transformation f \<Longrightarrow> norm (f x) = norm x"
   by (metis orthogonal_transformation)
 
 
 subsection \<open>Bilinear functions\<close>
 
 definition\<^marker>\<open>tag important\<close>
 bilinear :: "('a::real_vector \<Rightarrow> 'b::real_vector \<Rightarrow> 'c::real_vector) \<Rightarrow> bool" where
 "bilinear f \<longleftrightarrow> (\<forall>x. linear (\<lambda>y. f x y)) \<and> (\<forall>y. linear (\<lambda>x. f x y))"
 
 lemma bilinear_ladd: "bilinear h \<Longrightarrow> h (x + y) z = h x z + h y z"
   by (simp add: bilinear_def linear_iff)
 
 lemma bilinear_radd: "bilinear h \<Longrightarrow> h x (y + z) = h x y + h x z"
   by (simp add: bilinear_def linear_iff)
 
 lemma bilinear_times:
   fixes c::"'a::real_algebra" shows "bilinear (\<lambda>x y::'a. x*y)"
   by (auto simp: bilinear_def distrib_left distrib_right intro!: linearI)
 
 lemma bilinear_lmul: "bilinear h \<Longrightarrow> h (c *\<^sub>R x) y = c *\<^sub>R h x y"
   by (simp add: bilinear_def linear_iff)
 
 lemma bilinear_rmul: "bilinear h \<Longrightarrow> h x (c *\<^sub>R y) = c *\<^sub>R h x y"
   by (simp add: bilinear_def linear_iff)
 
 lemma bilinear_lneg: "bilinear h \<Longrightarrow> h (- x) y = - h x y"
   by (drule bilinear_lmul [of _ "- 1"]) simp
 
 lemma bilinear_rneg: "bilinear h \<Longrightarrow> h x (- y) = - h x y"
   by (drule bilinear_rmul [of _ _ "- 1"]) simp
 
 lemma (in ab_group_add) eq_add_iff: "x = x + y \<longleftrightarrow> y = 0"
   using add_left_imp_eq[of x y 0] by auto
 
 lemma bilinear_lzero:
   assumes "bilinear h"
   shows "h 0 x = 0"
   using bilinear_ladd [OF assms, of 0 0 x] by (simp add: eq_add_iff field_simps)
 
 lemma bilinear_rzero:
   assumes "bilinear h"
   shows "h x 0 = 0"
   using bilinear_radd [OF assms, of x 0 0 ] by (simp add: eq_add_iff field_simps)
 
 lemma bilinear_lsub: "bilinear h \<Longrightarrow> h (x - y) z = h x z - h y z"
   using bilinear_ladd [of h x "- y"] by (simp add: bilinear_lneg)
 
 lemma bilinear_rsub: "bilinear h \<Longrightarrow> h z (x - y) = h z x - h z y"
   using bilinear_radd [of h _ x "- y"] by (simp add: bilinear_rneg)
 
 lemma bilinear_sum:
   assumes "bilinear h"
   shows "h (sum f S) (sum g T) = sum (\<lambda>(i,j). h (f i) (g j)) (S \<times> T) "
 proof -
   interpret l: linear "\<lambda>x. h x y" for y using assms by (simp add: bilinear_def)
   interpret r: linear "\<lambda>y. h x y" for x using assms by (simp add: bilinear_def)
   have "h (sum f S) (sum g T) = sum (\<lambda>x. h (f x) (sum g T)) S"
     by (simp add: l.sum)
   also have "\<dots> = sum (\<lambda>x. sum (\<lambda>y. h (f x) (g y)) T) S"
     by (rule sum.cong) (simp_all add: r.sum)
   finally show ?thesis
     unfolding sum.cartesian_product .
 qed
 
 
 subsection \<open>Adjoints\<close>
 
 definition\<^marker>\<open>tag important\<close> adjoint :: "(('a::real_inner) \<Rightarrow> ('b::real_inner)) \<Rightarrow> 'b \<Rightarrow> 'a" where
 "adjoint f = (SOME f'. \<forall>x y. f x \<bullet> y = x \<bullet> f' y)"
 
 lemma adjoint_unique:
   assumes "\<forall>x y. inner (f x) y = inner x (g y)"
   shows "adjoint f = g"
   unfolding adjoint_def
 proof (rule some_equality)
   show "\<forall>x y. inner (f x) y = inner x (g y)"
     by (rule assms)
 next
   fix h
   assume "\<forall>x y. inner (f x) y = inner x (h y)"
   then have "\<forall>x y. inner x (g y) = inner x (h y)"
     using assms by simp
   then have "\<forall>x y. inner x (g y - h y) = 0"
     by (simp add: inner_diff_right)
   then have "\<forall>y. inner (g y - h y) (g y - h y) = 0"
     by simp
   then have "\<forall>y. h y = g y"
     by simp
   then show "h = g" by (simp add: ext)
 qed
 
 text \<open>TODO: The following lemmas about adjoints should hold for any
   Hilbert space (i.e. complete inner product space).
   (see \<^url>\<open>https://en.wikipedia.org/wiki/Hermitian_adjoint\<close>)
 \<close>
 
 lemma adjoint_works:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   assumes lf: "linear f"
   shows "x \<bullet> adjoint f y = f x \<bullet> y"
 proof -
   interpret linear f by fact
   have "\<forall>y. \<exists>w. \<forall>x. f x \<bullet> y = x \<bullet> w"
   proof (intro allI exI)
     fix y :: "'m" and x
     let ?w = "(\<Sum>i\<in>Basis. (f i \<bullet> y) *\<^sub>R i) :: 'n"
     have "f x \<bullet> y = f (\<Sum>i\<in>Basis. (x \<bullet> i) *\<^sub>R i) \<bullet> y"
       by (simp add: euclidean_representation)
     also have "\<dots> = (\<Sum>i\<in>Basis. (x \<bullet> i) *\<^sub>R f i) \<bullet> y"
       by (simp add: sum scale)
     finally show "f x \<bullet> y = x \<bullet> ?w"
       by (simp add: inner_sum_left inner_sum_right mult.commute)
   qed
   then show ?thesis
     unfolding adjoint_def choice_iff
     by (intro someI2_ex[where Q="\<lambda>f'. x \<bullet> f' y = f x \<bullet> y"]) auto
 qed
 
 lemma adjoint_clauses:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   assumes lf: "linear f"
   shows "x \<bullet> adjoint f y = f x \<bullet> y"
     and "adjoint f y \<bullet> x = y \<bullet> f x"
   by (simp_all add: adjoint_works[OF lf] inner_commute)
 
 lemma adjoint_linear:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   assumes lf: "linear f"
   shows "linear (adjoint f)"
   by (simp add: lf linear_iff euclidean_eq_iff[where 'a='n] euclidean_eq_iff[where 'a='m]
     adjoint_clauses[OF lf] inner_distrib)
 
 lemma adjoint_adjoint:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   assumes lf: "linear f"
   shows "adjoint (adjoint f) = f"
   by (rule adjoint_unique, simp add: adjoint_clauses [OF lf])
 
 
-subsection \<open>Archimedean properties and useful consequences\<close>
-
-text\<open>Bernoulli's inequality\<close>
-proposition Bernoulli_inequality:
-  fixes x :: real
-  assumes "-1 \<le> x"
-    shows "1 + n * x \<le> (1 + x) ^ n"
-proof (induct n)
-  case 0
-  then show ?case by simp
-next
-  case (Suc n)
-  have "1 + Suc n * x \<le> 1 + (Suc n)*x + n * x^2"
-    by (simp add: algebra_simps)
-  also have "... = (1 + x) * (1 + n*x)"
-    by (auto simp: power2_eq_square algebra_simps  of_nat_Suc)
-  also have "... \<le> (1 + x) ^ Suc n"
-    using Suc.hyps assms mult_left_mono by fastforce
-  finally show ?case .
-qed
-
-corollary Bernoulli_inequality_even:
-  fixes x :: real
-  assumes "even n"
-    shows "1 + n * x \<le> (1 + x) ^ n"
-proof (cases "-1 \<le> x \<or> n=0")
-  case True
-  then show ?thesis
-    by (auto simp: Bernoulli_inequality)
-next
-  case False
-  then have "real n \<ge> 1"
-    by simp
-  with False have "n * x \<le> -1"
-    by (metis linear minus_zero mult.commute mult.left_neutral mult_left_mono_neg neg_le_iff_le order_trans zero_le_one)
-  then have "1 + n * x \<le> 0"
-    by auto
-  also have "... \<le> (1 + x) ^ n"
-    using assms
-    using zero_le_even_power by blast
-  finally show ?thesis .
-qed
-
-corollary real_arch_pow:
-  fixes x :: real
-  assumes x: "1 < x"
-  shows "\<exists>n. y < x^n"
-proof -
-  from x have x0: "x - 1 > 0"
-    by arith
-  from reals_Archimedean3[OF x0, rule_format, of y]
-  obtain n :: nat where n: "y < real n * (x - 1)" by metis
-  from x0 have x00: "x- 1 \<ge> -1" by arith
-  from Bernoulli_inequality[OF x00, of n] n
-  have "y < x^n" by auto
-  then show ?thesis by metis
-qed
-
-corollary real_arch_pow_inv:
-  fixes x y :: real
-  assumes y: "y > 0"
-    and x1: "x < 1"
-  shows "\<exists>n. x^n < y"
-proof (cases "x > 0")
-  case True
-  with x1 have ix: "1 < 1/x" by (simp add: field_simps)
-  from real_arch_pow[OF ix, of "1/y"]
-  obtain n where n: "1/y < (1/x)^n" by blast
-  then show ?thesis using y \<open>x > 0\<close>
-    by (auto simp add: field_simps)
-next
-  case False
-  with y x1 show ?thesis
-    by (metis less_le_trans not_less power_one_right)
-qed
-
-lemma forall_pos_mono:
-  "(\<And>d e::real. d < e \<Longrightarrow> P d \<Longrightarrow> P e) \<Longrightarrow>
-    (\<And>n::nat. n \<noteq> 0 \<Longrightarrow> P (inverse (real n))) \<Longrightarrow> (\<And>e. 0 < e \<Longrightarrow> P e)"
-  by (metis real_arch_inverse)
-
-lemma forall_pos_mono_1:
-  "(\<And>d e::real. d < e \<Longrightarrow> P d \<Longrightarrow> P e) \<Longrightarrow>
-    (\<And>n. P (inverse (real (Suc n)))) \<Longrightarrow> 0 < e \<Longrightarrow> P e"
-  apply (rule forall_pos_mono)
-  apply auto
-  apply (metis Suc_pred of_nat_Suc)
-  done
-
-
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Euclidean Spaces as Typeclass\<close>
 
 lemma independent_Basis: "independent Basis"
   by (rule independent_Basis)
 
 lemma span_Basis [simp]: "span Basis = UNIV"
   by (rule span_Basis)
 
 lemma in_span_Basis: "x \<in> span Basis"
   unfolding span_Basis ..
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Linearity and Bilinearity continued\<close>
 
 lemma linear_bounded:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes lf: "linear f"
   shows "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
 proof
   interpret linear f by fact
   let ?B = "\<Sum>b\<in>Basis. norm (f b)"
   show "\<forall>x. norm (f x) \<le> ?B * norm x"
   proof
     fix x :: 'a
     let ?g = "\<lambda>b. (x \<bullet> b) *\<^sub>R f b"
     have "norm (f x) = norm (f (\<Sum>b\<in>Basis. (x \<bullet> b) *\<^sub>R b))"
       unfolding euclidean_representation ..
     also have "\<dots> = norm (sum ?g Basis)"
       by (simp add: sum scale)
     finally have th0: "norm (f x) = norm (sum ?g Basis)" .
     have th: "norm (?g i) \<le> norm (f i) * norm x" if "i \<in> Basis" for i
     proof -
       from Basis_le_norm[OF that, of x]
       show "norm (?g i) \<le> norm (f i) * norm x"
         unfolding norm_scaleR  by (metis mult.commute mult_left_mono norm_ge_zero)
     qed
     from sum_norm_le[of _ ?g, OF th]
     show "norm (f x) \<le> ?B * norm x"
       unfolding th0 sum_distrib_right by metis
   qed
 qed
 
 lemma linear_conv_bounded_linear:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   shows "linear f \<longleftrightarrow> bounded_linear f"
 proof
   assume "linear f"
   then interpret f: linear f .
   show "bounded_linear f"
   proof
     have "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
       using \<open>linear f\<close> by (rule linear_bounded)
     then show "\<exists>K. \<forall>x. norm (f x) \<le> norm x * K"
       by (simp add: mult.commute)
   qed
 next
   assume "bounded_linear f"
   then interpret f: bounded_linear f .
   show "linear f" ..
 qed
 
 lemmas linear_linear = linear_conv_bounded_linear[symmetric]
 
 lemma inj_linear_imp_inv_bounded_linear:
   fixes f::"'a::euclidean_space \<Rightarrow> 'a"
   shows "\<lbrakk>bounded_linear f; inj f\<rbrakk> \<Longrightarrow> bounded_linear (inv f)"
   by (simp add: inj_linear_imp_inv_linear linear_linear)
 
 lemma linear_bounded_pos:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes lf: "linear f"
  obtains B where "B > 0" "\<And>x. norm (f x) \<le> B * norm x"
 proof -
   have "\<exists>B > 0. \<forall>x. norm (f x) \<le> norm x * B"
     using lf unfolding linear_conv_bounded_linear
     by (rule bounded_linear.pos_bounded)
   with that show ?thesis
     by (auto simp: mult.commute)
 qed
 
 lemma linear_invertible_bounded_below_pos:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "linear g" "g \<circ> f = id"
   obtains B where "B > 0" "\<And>x. B * norm x \<le> norm(f x)"
 proof -
   obtain B where "B > 0" and B: "\<And>x. norm (g x) \<le> B * norm x"
     using linear_bounded_pos [OF \<open>linear g\<close>] by blast
   show thesis
   proof
     show "0 < 1/B"
       by (simp add: \<open>B > 0\<close>)
     show "1/B * norm x \<le> norm (f x)" for x
     proof -
       have "1/B * norm x = 1/B * norm (g (f x))"
         using assms by (simp add: pointfree_idE)
       also have "\<dots> \<le> norm (f x)"
         using B [of "f x"] by (simp add: \<open>B > 0\<close> mult.commute pos_divide_le_eq)
       finally show ?thesis .
     qed
   qed
 qed
 
 lemma linear_inj_bounded_below_pos:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "inj f"
   obtains B where "B > 0" "\<And>x. B * norm x \<le> norm(f x)"
   using linear_injective_left_inverse [OF assms]
     linear_invertible_bounded_below_pos assms by blast
 
 lemma bounded_linearI':
   fixes f ::"'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes "\<And>x y. f (x + y) = f x + f y"
     and "\<And>c x. f (c *\<^sub>R x) = c *\<^sub>R f x"
   shows "bounded_linear f"
   using assms linearI linear_conv_bounded_linear by blast
 
 lemma bilinear_bounded:
   fixes h :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space \<Rightarrow> 'k::real_normed_vector"
   assumes bh: "bilinear h"
   shows "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
 proof (clarify intro!: exI[of _ "\<Sum>i\<in>Basis. \<Sum>j\<in>Basis. norm (h i j)"])
   fix x :: 'm
   fix y :: 'n
   have "norm (h x y) = norm (h (sum (\<lambda>i. (x \<bullet> i) *\<^sub>R i) Basis) (sum (\<lambda>i. (y \<bullet> i) *\<^sub>R i) Basis))"
     by (simp add: euclidean_representation)
   also have "\<dots> = norm (sum (\<lambda> (i,j). h ((x \<bullet> i) *\<^sub>R i) ((y \<bullet> j) *\<^sub>R j)) (Basis \<times> Basis))"
     unfolding bilinear_sum[OF bh] ..
   finally have th: "norm (h x y) = \<dots>" .
   have "\<And>i j. \<lbrakk>i \<in> Basis; j \<in> Basis\<rbrakk>
            \<Longrightarrow> \<bar>x \<bullet> i\<bar> * (\<bar>y \<bullet> j\<bar> * norm (h i j)) \<le> norm x * (norm y * norm (h i j))"
     by (auto simp add: zero_le_mult_iff Basis_le_norm mult_mono)
   then show "norm (h x y) \<le> (\<Sum>i\<in>Basis. \<Sum>j\<in>Basis. norm (h i j)) * norm x * norm y"
     unfolding sum_distrib_right th sum.cartesian_product
     by (clarsimp simp add: bilinear_rmul[OF bh] bilinear_lmul[OF bh]
       field_simps simp del: scaleR_scaleR intro!: sum_norm_le)
 qed
 
 lemma bilinear_conv_bounded_bilinear:
   fixes h :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::real_normed_vector"
   shows "bilinear h \<longleftrightarrow> bounded_bilinear h"
 proof
   assume "bilinear h"
   show "bounded_bilinear h"
   proof
     fix x y z
     show "h (x + y) z = h x z + h y z"
       using \<open>bilinear h\<close> unfolding bilinear_def linear_iff by simp
   next
     fix x y z
     show "h x (y + z) = h x y + h x z"
       using \<open>bilinear h\<close> unfolding bilinear_def linear_iff by simp
   next
     show "h (scaleR r x) y = scaleR r (h x y)" "h x (scaleR r y) = scaleR r (h x y)" for r x y
       using \<open>bilinear h\<close> unfolding bilinear_def linear_iff
       by simp_all
   next
     have "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
       using \<open>bilinear h\<close> by (rule bilinear_bounded)
     then show "\<exists>K. \<forall>x y. norm (h x y) \<le> norm x * norm y * K"
       by (simp add: ac_simps)
   qed
 next
   assume "bounded_bilinear h"
   then interpret h: bounded_bilinear h .
   show "bilinear h"
     unfolding bilinear_def linear_conv_bounded_linear
     using h.bounded_linear_left h.bounded_linear_right by simp
 qed
 
 lemma bilinear_bounded_pos:
   fixes h :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::real_normed_vector"
   assumes bh: "bilinear h"
   shows "\<exists>B > 0. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
 proof -
   have "\<exists>B > 0. \<forall>x y. norm (h x y) \<le> norm x * norm y * B"
     using bh [unfolded bilinear_conv_bounded_bilinear]
     by (rule bounded_bilinear.pos_bounded)
   then show ?thesis
     by (simp only: ac_simps)
 qed
 
 lemma bounded_linear_imp_has_derivative: "bounded_linear f \<Longrightarrow> (f has_derivative f) net"
   by (auto simp add: has_derivative_def linear_diff linear_linear linear_def
       dest: bounded_linear.linear)
 
 lemma linear_imp_has_derivative:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   shows "linear f \<Longrightarrow> (f has_derivative f) net"
   by (simp add: bounded_linear_imp_has_derivative linear_conv_bounded_linear)
 
 lemma bounded_linear_imp_differentiable: "bounded_linear f \<Longrightarrow> f differentiable net"
   using bounded_linear_imp_has_derivative differentiable_def by blast
 
 lemma linear_imp_differentiable:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   shows "linear f \<Longrightarrow> f differentiable net"
   by (metis linear_imp_has_derivative differentiable_def)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>We continue\<close>
 
 lemma independent_bound:
   fixes S :: "'a::euclidean_space set"
   shows "independent S \<Longrightarrow> finite S \<and> card S \<le> DIM('a)"
   by (metis dim_subset_UNIV finiteI_independent dim_span_eq_card_independent)
 
 lemmas independent_imp_finite = finiteI_independent
 
 corollary
   fixes S :: "'a::euclidean_space set"
   assumes "independent S"
   shows independent_card_le:"card S \<le> DIM('a)"
   using assms independent_bound by auto
 
 lemma dependent_biggerset:
   fixes S :: "'a::euclidean_space set"
   shows "(finite S \<Longrightarrow> card S > DIM('a)) \<Longrightarrow> dependent S"
   by (metis independent_bound not_less)
 
 text \<open>Picking an orthogonal replacement for a spanning set.\<close>
 
 lemma vector_sub_project_orthogonal:
   fixes b x :: "'a::euclidean_space"
   shows "b \<bullet> (x - ((b \<bullet> x) / (b \<bullet> b)) *\<^sub>R b) = 0"
   unfolding inner_simps by auto
 
 lemma pairwise_orthogonal_insert:
   assumes "pairwise orthogonal S"
     and "\<And>y. y \<in> S \<Longrightarrow> orthogonal x y"
   shows "pairwise orthogonal (insert x S)"
   using assms unfolding pairwise_def
   by (auto simp add: orthogonal_commute)
 
 lemma basis_orthogonal:
   fixes B :: "'a::real_inner set"
   assumes fB: "finite B"
   shows "\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C"
   (is " \<exists>C. ?P B C")
   using fB
 proof (induct rule: finite_induct)
   case empty
   then show ?case
     apply (rule exI[where x="{}"])
     apply (auto simp add: pairwise_def)
     done
 next
   case (insert a B)
   note fB = \<open>finite B\<close> and aB = \<open>a \<notin> B\<close>
   from \<open>\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C\<close>
   obtain C where C: "finite C" "card C \<le> card B"
     "span C = span B" "pairwise orthogonal C" by blast
   let ?a = "a - sum (\<lambda>x. (x \<bullet> a / (x \<bullet> x)) *\<^sub>R x) C"
   let ?C = "insert ?a C"
   from C(1) have fC: "finite ?C"
     by simp
   from fB aB C(1,2) have cC: "card ?C \<le> card (insert a B)"
     by (simp add: card_insert_if)
   {
     fix x k
     have th0: "\<And>(a::'a) b c. a - (b - c) = c + (a - b)"
       by (simp add: field_simps)
     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"
       apply (simp only: scaleR_right_diff_distrib th0)
       apply (rule span_add_eq)
       apply (rule span_scale)
       apply (rule span_sum)
       apply (rule span_scale)
       apply (rule span_base)
       apply assumption
       done
   }
   then have SC: "span ?C = span (insert a B)"
     unfolding set_eq_iff span_breakdown_eq C(3)[symmetric] by auto
   {
     fix y
     assume yC: "y \<in> C"
     then have Cy: "C = insert y (C - {y})"
       by blast
     have fth: "finite (C - {y})"
       using C by simp
     have "orthogonal ?a y"
       unfolding orthogonal_def
       unfolding inner_diff inner_sum_left right_minus_eq
       unfolding sum.remove [OF \<open>finite C\<close> \<open>y \<in> C\<close>]
       apply (clarsimp simp add: inner_commute[of y a])
       apply (rule sum.neutral)
       apply clarsimp
       apply (rule C(4)[unfolded pairwise_def orthogonal_def, rule_format])
       using \<open>y \<in> C\<close> by auto
   }
   with \<open>pairwise orthogonal C\<close> have CPO: "pairwise orthogonal ?C"
     by (rule pairwise_orthogonal_insert)
   from fC cC SC CPO have "?P (insert a B) ?C"
     by blast
   then show ?case by blast
 qed
 
 lemma orthogonal_basis_exists:
   fixes V :: "('a::euclidean_space) set"
   shows "\<exists>B. independent B \<and> B \<subseteq> span V \<and> V \<subseteq> span B \<and>
   (card B = dim V) \<and> pairwise orthogonal B"
 proof -
   from basis_exists[of V] obtain B where
     B: "B \<subseteq> V" "independent B" "V \<subseteq> span B" "card B = dim V"
     by force
   from B have fB: "finite B" "card B = dim V"
     using independent_bound by auto
   from basis_orthogonal[OF fB(1)] obtain C where
     C: "finite C" "card C \<le> card B" "span C = span B" "pairwise orthogonal C"
     by blast
   from C B have CSV: "C \<subseteq> span V"
     by (metis span_superset span_mono subset_trans)
   from span_mono[OF B(3)] C have SVC: "span V \<subseteq> span C"
     by (simp add: span_span)
   from card_le_dim_spanning[OF CSV SVC C(1)] C(2,3) fB
   have iC: "independent C"
-    by (simp add: dim_span)
+    by (simp)
   from C fB have "card C \<le> dim V"
     by simp
   moreover have "dim V \<le> card C"
     using span_card_ge_dim[OF CSV SVC C(1)]
     by simp
   ultimately have CdV: "card C = dim V"
     using C(1) by simp
   from C B CSV CdV iC show ?thesis
     by auto
 qed
 
 text \<open>Low-dimensional subset is in a hyperplane (weak orthogonal complement).\<close>
 
 lemma span_not_univ_orthogonal:
   fixes S :: "'a::euclidean_space set"
   assumes sU: "span S \<noteq> UNIV"
   shows "\<exists>a::'a. a \<noteq> 0 \<and> (\<forall>x \<in> span S. a \<bullet> x = 0)"
 proof -
   from sU obtain a where a: "a \<notin> span S"
     by blast
   from orthogonal_basis_exists obtain B where
     B: "independent B" "B \<subseteq> span S" "S \<subseteq> span B"
     "card B = dim S" "pairwise orthogonal B"
     by blast
   from B have fB: "finite B" "card B = dim S"
     using independent_bound by auto
   from span_mono[OF B(2)] span_mono[OF B(3)]
   have sSB: "span S = span B"
     by (simp add: span_span)
   let ?a = "a - sum (\<lambda>b. (a \<bullet> b / (b \<bullet> b)) *\<^sub>R b) B"
   have "sum (\<lambda>b. (a \<bullet> b / (b \<bullet> b)) *\<^sub>R b) B \<in> span S"
     unfolding sSB
     apply (rule span_sum)
     apply (rule span_scale)
     apply (rule span_base)
     apply assumption
     done
   with a have a0:"?a  \<noteq> 0"
     by auto
   have "?a \<bullet> x = 0" if "x\<in>span B" for x
   proof (rule span_induct [OF that])
     show "subspace {x. ?a \<bullet> x = 0}"
       by (auto simp add: subspace_def inner_add)
   next
     {
       fix x
       assume x: "x \<in> B"
       from x have B': "B = insert x (B - {x})"
         by blast
       have fth: "finite (B - {x})"
         using fB by simp
       have "?a \<bullet> x = 0"
         apply (subst B')
         using fB fth
         unfolding sum_clauses(2)[OF fth]
         apply simp unfolding inner_simps
         apply (clarsimp simp add: inner_add inner_sum_left)
         apply (rule sum.neutral, rule ballI)
         apply (simp only: inner_commute)
         apply (auto simp add: x field_simps
           intro: B(5)[unfolded pairwise_def orthogonal_def, rule_format])
         done
     }
     then show "?a \<bullet> x = 0" if "x \<in> B" for x
       using that by blast
     qed
   with a0 show ?thesis
     unfolding sSB by (auto intro: exI[where x="?a"])
 qed
 
 lemma span_not_univ_subset_hyperplane:
   fixes S :: "'a::euclidean_space set"
   assumes SU: "span S \<noteq> UNIV"
   shows "\<exists> a. a \<noteq>0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
   using span_not_univ_orthogonal[OF SU] by auto
 
 lemma lowdim_subset_hyperplane:
   fixes S :: "'a::euclidean_space set"
   assumes d: "dim S < DIM('a)"
   shows "\<exists>a::'a. a \<noteq> 0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
 proof -
   {
     assume "span S = UNIV"
     then have "dim (span S) = dim (UNIV :: ('a) set)"
       by simp
     then have "dim S = DIM('a)"
       by (metis Euclidean_Space.dim_UNIV dim_span)
     with d have False by arith
   }
   then have th: "span S \<noteq> UNIV"
     by blast
   from span_not_univ_subset_hyperplane[OF th] show ?thesis .
 qed
 
 lemma linear_eq_stdbasis:
   fixes f :: "'a::euclidean_space \<Rightarrow> _"
   assumes lf: "linear f"
     and lg: "linear g"
     and fg: "\<And>b. b \<in> Basis \<Longrightarrow> f b = g b"
   shows "f = g"
   using linear_eq_on_span[OF lf lg, of Basis] fg
   by auto
 
 
 text \<open>Similar results for bilinear functions.\<close>
 
 lemma bilinear_eq:
   assumes bf: "bilinear f"
     and bg: "bilinear g"
     and SB: "S \<subseteq> span B"
     and TC: "T \<subseteq> span C"
     and "x\<in>S" "y\<in>T"
     and fg: "\<And>x y. \<lbrakk>x \<in> B; y\<in> C\<rbrakk> \<Longrightarrow> f x y = g x y"
   shows "f x y = g x y"
 proof -
   let ?P = "{x. \<forall>y\<in> span C. f x y = g x y}"
   from bf bg have sp: "subspace ?P"
     unfolding bilinear_def linear_iff subspace_def bf bg
     by (auto simp add: span_zero bilinear_lzero[OF bf] bilinear_lzero[OF bg]
         span_add Ball_def
       intro: bilinear_ladd[OF bf])
   have sfg: "\<And>x. x \<in> B \<Longrightarrow> subspace {a. f x a = g x a}"
     apply (auto simp add: subspace_def)
     using bf bg unfolding bilinear_def linear_iff
       apply (auto simp add: span_zero bilinear_rzero[OF bf] bilinear_rzero[OF bg]
         span_add Ball_def
       intro: bilinear_ladd[OF bf])
     done
   have "\<forall>y\<in> span C. f x y = g x y" if "x \<in> span B" for x
     apply (rule span_induct [OF that sp])
     using fg sfg span_induct by blast
   then show ?thesis
     using SB TC assms by auto
 qed
 
 lemma bilinear_eq_stdbasis:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> _"
   assumes bf: "bilinear f"
     and bg: "bilinear g"
     and fg: "\<And>i j. i \<in> Basis \<Longrightarrow> j \<in> Basis \<Longrightarrow> f i j = g i j"
   shows "f = g"
   using bilinear_eq[OF bf bg equalityD2[OF span_Basis] equalityD2[OF span_Basis]] fg by blast
 
 
 subsection \<open>Infinity norm\<close>
 
 definition\<^marker>\<open>tag important\<close> "infnorm (x::'a::euclidean_space) = Sup {\<bar>x \<bullet> b\<bar> |b. b \<in> Basis}"
 
 lemma infnorm_set_image:
   fixes x :: "'a::euclidean_space"
   shows "{\<bar>x \<bullet> i\<bar> |i. i \<in> Basis} = (\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis"
   by blast
 
 lemma infnorm_Max:
   fixes x :: "'a::euclidean_space"
   shows "infnorm x = Max ((\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis)"
   by (simp add: infnorm_def infnorm_set_image cSup_eq_Max)
 
 lemma infnorm_set_lemma:
   fixes x :: "'a::euclidean_space"
   shows "finite {\<bar>x \<bullet> i\<bar> |i. i \<in> Basis}"
     and "{\<bar>x \<bullet> i\<bar> |i. i \<in> Basis} \<noteq> {}"
   unfolding infnorm_set_image
   by auto
 
 lemma infnorm_pos_le:
   fixes x :: "'a::euclidean_space"
   shows "0 \<le> infnorm x"
   by (simp add: infnorm_Max Max_ge_iff ex_in_conv)
 
 lemma infnorm_triangle:
   fixes x :: "'a::euclidean_space"
   shows "infnorm (x + y) \<le> infnorm x + infnorm y"
 proof -
   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"
     by simp
   show ?thesis
     by (auto simp: infnorm_Max inner_add_left intro!: *)
 qed
 
 lemma infnorm_eq_0:
   fixes x :: "'a::euclidean_space"
   shows "infnorm x = 0 \<longleftrightarrow> x = 0"
 proof -
   have "infnorm x \<le> 0 \<longleftrightarrow> x = 0"
     unfolding infnorm_Max by (simp add: euclidean_all_zero_iff)
   then show ?thesis
     using infnorm_pos_le[of x] by simp
 qed
 
 lemma infnorm_0: "infnorm 0 = 0"
   by (simp add: infnorm_eq_0)
 
 lemma infnorm_neg: "infnorm (- x) = infnorm x"
   unfolding infnorm_def by simp
 
 lemma infnorm_sub: "infnorm (x - y) = infnorm (y - x)"
   by (metis infnorm_neg minus_diff_eq)
 
 lemma absdiff_infnorm: "\<bar>infnorm x - infnorm y\<bar> \<le> infnorm (x - y)"
 proof -
   have *: "\<And>(nx::real) n ny. nx \<le> n + ny \<Longrightarrow> ny \<le> n + nx \<Longrightarrow> \<bar>nx - ny\<bar> \<le> n"
     by arith
   show ?thesis
   proof (rule *)
     from infnorm_triangle[of "x - y" " y"] infnorm_triangle[of "x - y" "-x"]
     show "infnorm x \<le> infnorm (x - y) + infnorm y" "infnorm y \<le> infnorm (x - y) + infnorm x"
       by (simp_all add: field_simps infnorm_neg)
   qed
 qed
 
 lemma real_abs_infnorm: "\<bar>infnorm x\<bar> = infnorm x"
   using infnorm_pos_le[of x] by arith
 
 lemma Basis_le_infnorm:
   fixes x :: "'a::euclidean_space"
   shows "b \<in> Basis \<Longrightarrow> \<bar>x \<bullet> b\<bar> \<le> infnorm x"
   by (simp add: infnorm_Max)
 
 lemma infnorm_mul: "infnorm (a *\<^sub>R x) = \<bar>a\<bar> * infnorm x"
   unfolding infnorm_Max
 proof (safe intro!: Max_eqI)
   let ?B = "(\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis"
   { fix b :: 'a
     assume "b \<in> Basis"
     then show "\<bar>a *\<^sub>R x \<bullet> b\<bar> \<le> \<bar>a\<bar> * Max ?B"
       by (simp add: abs_mult mult_left_mono)
   next
     from Max_in[of ?B] obtain b where "b \<in> Basis" "Max ?B = \<bar>x \<bullet> b\<bar>"
       by (auto simp del: Max_in)
     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"
       by (intro image_eqI[where x=b]) (auto simp: abs_mult)
   }
 qed simp
 
 lemma infnorm_mul_lemma: "infnorm (a *\<^sub>R x) \<le> \<bar>a\<bar> * infnorm x"
   unfolding infnorm_mul ..
 
 lemma infnorm_pos_lt: "infnorm x > 0 \<longleftrightarrow> x \<noteq> 0"
   using infnorm_pos_le[of x] infnorm_eq_0[of x] by arith
 
 text \<open>Prove that it differs only up to a bound from Euclidean norm.\<close>
 
 lemma infnorm_le_norm: "infnorm x \<le> norm x"
   by (simp add: Basis_le_norm infnorm_Max)
 
 lemma norm_le_infnorm:
   fixes x :: "'a::euclidean_space"
   shows "norm x \<le> sqrt DIM('a) * infnorm x"
   unfolding norm_eq_sqrt_inner id_def 
 proof (rule real_le_lsqrt[OF inner_ge_zero])
   show "sqrt DIM('a) * infnorm x \<ge> 0"
     by (simp add: zero_le_mult_iff infnorm_pos_le)
   have "x \<bullet> x \<le> (\<Sum>b\<in>Basis. x \<bullet> b * (x \<bullet> b))"
     by (metis euclidean_inner order_refl)
   also have "... \<le> DIM('a) * \<bar>infnorm x\<bar>\<^sup>2"
     by (rule sum_bounded_above) (metis Basis_le_infnorm abs_le_square_iff power2_eq_square real_abs_infnorm)
   also have "... \<le> (sqrt DIM('a) * infnorm x)\<^sup>2"
     by (simp add: power_mult_distrib)
   finally show "x \<bullet> x \<le> (sqrt DIM('a) * infnorm x)\<^sup>2" .
 qed
 
 lemma tendsto_infnorm [tendsto_intros]:
   assumes "(f \<longlongrightarrow> a) F"
   shows "((\<lambda>x. infnorm (f x)) \<longlongrightarrow> infnorm a) F"
 proof (rule tendsto_compose [OF LIM_I assms])
   fix r :: real
   assume "r > 0"
   then show "\<exists>s>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < s \<longrightarrow> norm (infnorm x - infnorm a) < r"
     by (metis real_norm_def le_less_trans absdiff_infnorm infnorm_le_norm)
 qed
 
 text \<open>Equality in Cauchy-Schwarz and triangle inequalities.\<close>
 
 lemma norm_cauchy_schwarz_eq: "x \<bullet> y = norm x * norm y \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof (cases "x=0")
   case True
   then show ?thesis 
     by auto
 next
   case False
   from inner_eq_zero_iff[of "norm y *\<^sub>R x - norm x *\<^sub>R y"]
   have "?rhs \<longleftrightarrow>
       (norm y * (norm y * norm x * norm x - norm x * (x \<bullet> y)) -
         norm x * (norm y * (y \<bullet> x) - norm x * norm y * norm y) =  0)"
     using False unfolding inner_simps
     by (auto simp add: power2_norm_eq_inner[symmetric] power2_eq_square inner_commute field_simps)
   also have "\<dots> \<longleftrightarrow> (2 * norm x * norm y * (norm x * norm y - x \<bullet> y) = 0)" 
     using False  by (simp add: field_simps inner_commute)
   also have "\<dots> \<longleftrightarrow> ?lhs" 
     using False by auto
   finally show ?thesis by metis
 qed
 
 lemma norm_cauchy_schwarz_abs_eq:
   "\<bar>x \<bullet> y\<bar> = norm x * norm y \<longleftrightarrow>
     norm x *\<^sub>R y = norm y *\<^sub>R x \<or> norm x *\<^sub>R y = - norm y *\<^sub>R x"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof -
   have th: "\<And>(x::real) a. a \<ge> 0 \<Longrightarrow> \<bar>x\<bar> = a \<longleftrightarrow> x = a \<or> x = - a"
     by arith
   have "?rhs \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x \<or> norm (- x) *\<^sub>R y = norm y *\<^sub>R (- x)"
     by simp
   also have "\<dots> \<longleftrightarrow> (x \<bullet> y = norm x * norm y \<or> (- x) \<bullet> y = norm x * norm y)"
     unfolding norm_cauchy_schwarz_eq[symmetric]
     unfolding norm_minus_cancel norm_scaleR ..
   also have "\<dots> \<longleftrightarrow> ?lhs"
     unfolding th[OF mult_nonneg_nonneg, OF norm_ge_zero[of x] norm_ge_zero[of y]] inner_simps
     by auto
   finally show ?thesis ..
 qed
 
 lemma norm_triangle_eq:
   fixes x y :: "'a::real_inner"
   shows "norm (x + y) = norm x + norm y \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
 proof (cases "x = 0 \<or> y = 0")
   case True
   then show ?thesis 
     by force
 next
   case False
   then have n: "norm x > 0" "norm y > 0"
     by auto
   have "norm (x + y) = norm x + norm y \<longleftrightarrow> (norm (x + y))\<^sup>2 = (norm x + norm y)\<^sup>2"
     by simp
   also have "\<dots> \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
     unfolding norm_cauchy_schwarz_eq[symmetric]
     unfolding power2_norm_eq_inner inner_simps
     by (simp add: power2_norm_eq_inner[symmetric] power2_eq_square inner_commute field_simps)
   finally show ?thesis .
 qed
 
 
 subsection \<open>Collinearity\<close>
 
 definition\<^marker>\<open>tag important\<close> collinear :: "'a::real_vector set \<Rightarrow> bool"
   where "collinear S \<longleftrightarrow> (\<exists>u. \<forall>x \<in> S. \<forall> y \<in> S. \<exists>c. x - y = c *\<^sub>R u)"
 
 lemma collinear_alt:
      "collinear S \<longleftrightarrow> (\<exists>u v. \<forall>x \<in> S. \<exists>c. x = u + c *\<^sub>R v)" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     unfolding collinear_def by (metis Groups.add_ac(2) diff_add_cancel)
 next
   assume ?rhs
   then obtain u v where *: "\<And>x. x \<in> S \<Longrightarrow> \<exists>c. x = u + c *\<^sub>R v"
     by (auto simp: )
   have "\<exists>c. x - y = c *\<^sub>R v" if "x \<in> S" "y \<in> S" for x y
         by (metis *[OF \<open>x \<in> S\<close>] *[OF \<open>y \<in> S\<close>] scaleR_left.diff add_diff_cancel_left)
   then show ?lhs
     using collinear_def by blast
 qed
 
 lemma collinear:
   fixes S :: "'a::{perfect_space,real_vector} set"
   shows "collinear S \<longleftrightarrow> (\<exists>u. u \<noteq> 0 \<and> (\<forall>x \<in> S. \<forall> y \<in> S. \<exists>c. x - y = c *\<^sub>R u))"
 proof -
   have "\<exists>v. v \<noteq> 0 \<and> (\<forall>x\<in>S. \<forall>y\<in>S. \<exists>c. x - y = c *\<^sub>R v)"
     if "\<forall>x\<in>S. \<forall>y\<in>S. \<exists>c. x - y = c *\<^sub>R u" "u=0" for u
   proof -
     have "\<forall>x\<in>S. \<forall>y\<in>S. x = y"
       using that by auto
     moreover
     obtain v::'a where "v \<noteq> 0"
       using UNIV_not_singleton [of 0] by auto
     ultimately have "\<forall>x\<in>S. \<forall>y\<in>S. \<exists>c. x - y = c *\<^sub>R v"
       by auto
     then show ?thesis
       using \<open>v \<noteq> 0\<close> by blast
   qed
   then show ?thesis
     apply (clarsimp simp: collinear_def)
     by (metis scaleR_zero_right vector_fraction_eq_iff)
 qed
 
 lemma collinear_subset: "\<lbrakk>collinear T; S \<subseteq> T\<rbrakk> \<Longrightarrow> collinear S"
   by (meson collinear_def subsetCE)
 
 lemma collinear_empty [iff]: "collinear {}"
   by (simp add: collinear_def)
 
 lemma collinear_sing [iff]: "collinear {x}"
   by (simp add: collinear_def)
 
 lemma collinear_2 [iff]: "collinear {x, y}"
   apply (simp add: collinear_def)
   apply (rule exI[where x="x - y"])
   by (metis minus_diff_eq scaleR_left.minus scaleR_one)
 
 lemma collinear_lemma: "collinear {0, x, y} \<longleftrightarrow> x = 0 \<or> y = 0 \<or> (\<exists>c. y = c *\<^sub>R x)"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof (cases "x = 0 \<or> y = 0")
   case True
   then show ?thesis
     by (auto simp: insert_commute)
 next
   case False
   show ?thesis 
   proof
     assume h: "?lhs"
     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"
       unfolding collinear_def by blast
     from u[rule_format, of x 0] u[rule_format, of y 0]
     obtain cx and cy where
       cx: "x = cx *\<^sub>R u" and cy: "y = cy *\<^sub>R u"
       by auto
     from cx cy False have cx0: "cx \<noteq> 0" and cy0: "cy \<noteq> 0" by auto
     let ?d = "cy / cx"
     from cx cy cx0 have "y = ?d *\<^sub>R x"
       by simp
     then show ?rhs using False by blast
   next
     assume h: "?rhs"
     then obtain c where c: "y = c *\<^sub>R x"
       using False by blast
     show ?lhs
       unfolding collinear_def c
       apply (rule exI[where x=x])
       apply auto
           apply (rule exI[where x="- 1"], simp)
          apply (rule exI[where x= "-c"], simp)
         apply (rule exI[where x=1], simp)
        apply (rule exI[where x="1 - c"], simp add: scaleR_left_diff_distrib)
       apply (rule exI[where x="c - 1"], simp add: scaleR_left_diff_distrib)
       done
   qed
 qed
 
 lemma norm_cauchy_schwarz_equal: "\<bar>x \<bullet> y\<bar> = norm x * norm y \<longleftrightarrow> collinear {0, x, y}"
 proof (cases "x=0")
   case True
   then show ?thesis
     by (auto simp: insert_commute)
 next
   case False
   then have nnz: "norm x \<noteq> 0"
     by auto
   show ?thesis
   proof
     assume "\<bar>x \<bullet> y\<bar> = norm x * norm y"
     then show "collinear {0, x, y}"
       unfolding norm_cauchy_schwarz_abs_eq collinear_lemma 
       by (meson eq_vector_fraction_iff nnz)
   next
     assume "collinear {0, x, y}"
     with False show "\<bar>x \<bullet> y\<bar> = norm x * norm y"
       unfolding norm_cauchy_schwarz_abs_eq collinear_lemma  by (auto simp: abs_if)
   qed
 qed
 
 
 subsection\<open>Properties of special hyperplanes\<close>
 
 lemma subspace_hyperplane: "subspace {x. a \<bullet> x = 0}"
   by (simp add: subspace_def inner_right_distrib)
 
 lemma subspace_hyperplane2: "subspace {x. x \<bullet> a = 0}"
   by (simp add: inner_commute inner_right_distrib subspace_def)
 
 lemma special_hyperplane_span:
   fixes S :: "'n::euclidean_space set"
   assumes "k \<in> Basis"
   shows "{x. k \<bullet> x = 0} = span (Basis - {k})"
 proof -
   have *: "x \<in> span (Basis - {k})" if "k \<bullet> x = 0" for x
   proof -
     have "x = (\<Sum>b\<in>Basis. (x \<bullet> b) *\<^sub>R b)"
       by (simp add: euclidean_representation)
     also have "... = (\<Sum>b \<in> Basis - {k}. (x \<bullet> b) *\<^sub>R b)"
       by (auto simp: sum.remove [of _ k] inner_commute assms that)
     finally have "x = (\<Sum>b\<in>Basis - {k}. (x \<bullet> b) *\<^sub>R b)" .
     then show ?thesis
       by (simp add: span_finite)
   qed
   show ?thesis
     apply (rule span_subspace [symmetric])
     using assms
     apply (auto simp: inner_not_same_Basis intro: * subspace_hyperplane)
     done
 qed
 
 lemma dim_special_hyperplane:
   fixes k :: "'n::euclidean_space"
   shows "k \<in> Basis \<Longrightarrow> dim {x. k \<bullet> x = 0} = DIM('n) - 1"
 apply (simp add: special_hyperplane_span)
 apply (rule dim_unique [OF subset_refl])
 apply (auto simp: independent_substdbasis)
 apply (metis member_remove remove_def span_base)
 done
 
 proposition dim_hyperplane:
   fixes a :: "'a::euclidean_space"
   assumes "a \<noteq> 0"
     shows "dim {x. a \<bullet> x = 0} = DIM('a) - 1"
 proof -
   have span0: "span {x. a \<bullet> x = 0} = {x. a \<bullet> x = 0}"
     by (rule span_unique) (auto simp: subspace_hyperplane)
   then obtain B where "independent B"
               and Bsub: "B \<subseteq> {x. a \<bullet> x = 0}"
               and subspB: "{x. a \<bullet> x = 0} \<subseteq> span B"
               and card0: "(card B = dim {x. a \<bullet> x = 0})"
               and ortho: "pairwise orthogonal B"
     using orthogonal_basis_exists by metis
   with assms have "a \<notin> span B"
     by (metis (mono_tags, lifting) span_eq inner_eq_zero_iff mem_Collect_eq span0)
   then have ind: "independent (insert a B)"
     by (simp add: \<open>independent B\<close> independent_insert)
   have "finite B"
     using \<open>independent B\<close> independent_bound by blast
   have "UNIV \<subseteq> span (insert a B)"
   proof fix y::'a
     obtain r z where z: "y = r *\<^sub>R a + z" "a \<bullet> z = 0"
       apply (rule_tac r="(a \<bullet> y) / (a \<bullet> a)" and z = "y - ((a \<bullet> y) / (a \<bullet> a)) *\<^sub>R a" in that)
       using assms
       by (auto simp: algebra_simps)
     show "y \<in> span (insert a B)"
       by (metis (mono_tags, lifting) z Bsub span_eq_iff
          add_diff_cancel_left' mem_Collect_eq span0 span_breakdown_eq span_subspace subspB)
   qed
   then have dima: "DIM('a) = dim(insert a B)"
     by (metis independent_Basis span_Basis dim_eq_card top.extremum_uniqueI)
   then show ?thesis
     by (metis (mono_tags, lifting) Bsub Diff_insert_absorb \<open>a \<notin> span B\<close> ind card0
         card_Diff_singleton dim_span indep_card_eq_dim_span insertI1 subsetCE
         subspB)
 qed
 
 lemma lowdim_eq_hyperplane:
   fixes S :: "'a::euclidean_space set"
   assumes "dim S = DIM('a) - 1"
   obtains a where "a \<noteq> 0" and "span S = {x. a \<bullet> x = 0}"
 proof -
   have dimS: "dim S < DIM('a)"
     by (simp add: assms)
   then obtain b where b: "b \<noteq> 0" "span S \<subseteq> {a. b \<bullet> a = 0}"
     using lowdim_subset_hyperplane [of S] by fastforce
   show ?thesis
     apply (rule that[OF b(1)])
     apply (rule subspace_dim_equal)
-    by (auto simp: assms b dim_hyperplane dim_span subspace_hyperplane
-        subspace_span)
+    by (auto simp: assms b dim_hyperplane subspace_hyperplane)
 qed
 
 lemma dim_eq_hyperplane:
   fixes S :: "'n::euclidean_space set"
   shows "dim S = DIM('n) - 1 \<longleftrightarrow> (\<exists>a. a \<noteq> 0 \<and> span S = {x. a \<bullet> x = 0})"
 by (metis One_nat_def dim_hyperplane dim_span lowdim_eq_hyperplane)
 
 
-subsection\<open> Orthogonal bases, Gram-Schmidt process, and related theorems\<close>
+subsection\<open> Orthogonal bases and Gram-Schmidt process\<close>
 
 lemma pairwise_orthogonal_independent:
   assumes "pairwise orthogonal S" and "0 \<notin> S"
     shows "independent S"
 proof -
   have 0: "\<And>x y. \<lbrakk>x \<noteq> y; x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> x \<bullet> y = 0"
     using assms by (simp add: pairwise_def orthogonal_def)
   have "False" if "a \<in> S" and a: "a \<in> span (S - {a})" for a
   proof -
     obtain T U where "T \<subseteq> S - {a}" "a = (\<Sum>v\<in>T. U v *\<^sub>R v)"
       using a by (force simp: span_explicit)
     then have "a \<bullet> a = a \<bullet> (\<Sum>v\<in>T. U v *\<^sub>R v)"
       by simp
     also have "... = 0"
       apply (simp add: inner_sum_right)
       apply (rule comm_monoid_add_class.sum.neutral)
       by (metis "0" DiffE \<open>T \<subseteq> S - {a}\<close> mult_not_zero singletonI subsetCE \<open>a \<in> S\<close>)
     finally show ?thesis
       using \<open>0 \<notin> S\<close> \<open>a \<in> S\<close> by auto
   qed
   then show ?thesis
     by (force simp: dependent_def)
 qed
 
 lemma pairwise_orthogonal_imp_finite:
   fixes S :: "'a::euclidean_space set"
   assumes "pairwise orthogonal S"
     shows "finite S"
 proof -
   have "independent (S - {0})"
     apply (rule pairwise_orthogonal_independent)
      apply (metis Diff_iff assms pairwise_def)
     by blast
   then show ?thesis
     by (meson independent_imp_finite infinite_remove)
 qed
 
 lemma subspace_orthogonal_to_vector: "subspace {y. orthogonal x y}"
   by (simp add: subspace_def orthogonal_clauses)
 
 lemma subspace_orthogonal_to_vectors: "subspace {y. \<forall>x \<in> S. orthogonal x y}"
   by (simp add: subspace_def orthogonal_clauses)
 
 lemma orthogonal_to_span:
   assumes a: "a \<in> span S" and x: "\<And>y. y \<in> S \<Longrightarrow> orthogonal x y"
     shows "orthogonal x a"
   by (metis a orthogonal_clauses(1,2,4)
       span_induct_alt x)
 
 proposition Gram_Schmidt_step:
   fixes S :: "'a::euclidean_space set"
   assumes S: "pairwise orthogonal S" and x: "x \<in> span S"
     shows "orthogonal x (a - (\<Sum>b\<in>S. (b \<bullet> a / (b \<bullet> b)) *\<^sub>R b))"
 proof -
   have "finite S"
     by (simp add: S pairwise_orthogonal_imp_finite)
   have "orthogonal (a - (\<Sum>b\<in>S. (b \<bullet> a / (b \<bullet> b)) *\<^sub>R b)) x"
        if "x \<in> S" for x
   proof -
     have "a \<bullet> x = (\<Sum>y\<in>S. if y = x then y \<bullet> a else 0)"
-      by (simp add: \<open>finite S\<close> inner_commute sum.delta that)
+      by (simp add: \<open>finite S\<close> inner_commute that)
     also have "... =  (\<Sum>b\<in>S. b \<bullet> a * (b \<bullet> x) / (b \<bullet> b))"
       apply (rule sum.cong [OF refl], simp)
       by (meson S orthogonal_def pairwise_def that)
    finally show ?thesis
      by (simp add: orthogonal_def algebra_simps inner_sum_left)
   qed
   then show ?thesis
     using orthogonal_to_span orthogonal_commute x by blast
 qed
 
 
 lemma orthogonal_extension_aux:
   fixes S :: "'a::euclidean_space set"
   assumes "finite T" "finite S" "pairwise orthogonal S"
     shows "\<exists>U. pairwise orthogonal (S \<union> U) \<and> span (S \<union> U) = span (S \<union> T)"
 using assms
 proof (induction arbitrary: S)
   case empty then show ?case
     by simp (metis sup_bot_right)
 next
   case (insert a T)
   have 0: "\<And>x y. \<lbrakk>x \<noteq> y; x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> x \<bullet> y = 0"
     using insert by (simp add: pairwise_def orthogonal_def)
   define a' where "a' = a - (\<Sum>b\<in>S. (b \<bullet> a / (b \<bullet> b)) *\<^sub>R b)"
   obtain U where orthU: "pairwise orthogonal (S \<union> insert a' U)"
              and spanU: "span (insert a' S \<union> U) = span (insert a' S \<union> T)"
     by (rule exE [OF insert.IH [of "insert a' S"]])
       (auto simp: Gram_Schmidt_step a'_def insert.prems orthogonal_commute
         pairwise_orthogonal_insert span_clauses)
   have orthS: "\<And>x. x \<in> S \<Longrightarrow> a' \<bullet> x = 0"
     apply (simp add: a'_def)
     using Gram_Schmidt_step [OF \<open>pairwise orthogonal S\<close>]
     apply (force simp: orthogonal_def inner_commute span_superset [THEN subsetD])
     done
   have "span (S \<union> insert a' U) = span (insert a' (S \<union> T))"
     using spanU by simp
   also have "... = span (insert a (S \<union> T))"
     apply (rule eq_span_insert_eq)
     apply (simp add: a'_def span_neg span_sum span_base span_mul)
     done
   also have "... = span (S \<union> insert a T)"
     by simp
   finally show ?case
     by (rule_tac x="insert a' U" in exI) (use orthU in auto)
 qed
 
 
 proposition orthogonal_extension:
   fixes S :: "'a::euclidean_space set"
   assumes S: "pairwise orthogonal S"
   obtains U where "pairwise orthogonal (S \<union> U)" "span (S \<union> U) = span (S \<union> T)"
 proof -
   obtain B where "finite B" "span B = span T"
     using basis_subspace_exists [of "span T"] subspace_span by metis
   with orthogonal_extension_aux [of B S]
   obtain U where "pairwise orthogonal (S \<union> U)" "span (S \<union> U) = span (S \<union> B)"
     using assms pairwise_orthogonal_imp_finite by auto
   with \<open>span B = span T\<close> show ?thesis
     by (rule_tac U=U in that) (auto simp: span_Un)
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> orthogonal_extension_strong:
   fixes S :: "'a::euclidean_space set"
   assumes S: "pairwise orthogonal S"
   obtains U where "U \<inter> (insert 0 S) = {}" "pairwise orthogonal (S \<union> U)"
                   "span (S \<union> U) = span (S \<union> T)"
 proof -
   obtain U where "pairwise orthogonal (S \<union> U)" "span (S \<union> U) = span (S \<union> T)"
     using orthogonal_extension assms by blast
   then show ?thesis
     apply (rule_tac U = "U - (insert 0 S)" in that)
       apply blast
      apply (force simp: pairwise_def)
     apply (metis Un_Diff_cancel Un_insert_left span_redundant span_zero)
     done
 qed
 
 subsection\<open>Decomposing a vector into parts in orthogonal subspaces\<close>
 
 text\<open>existence of orthonormal basis for a subspace.\<close>
 
 lemma orthogonal_spanningset_subspace:
   fixes S :: "'a :: euclidean_space set"
   assumes "subspace S"
   obtains B where "B \<subseteq> S" "pairwise orthogonal B" "span B = S"
 proof -
   obtain B where "B \<subseteq> S" "independent B" "S \<subseteq> span B" "card B = dim S"
     using basis_exists by blast
   with orthogonal_extension [of "{}" B]
   show ?thesis
     by (metis Un_empty_left assms pairwise_empty span_superset span_subspace that)
 qed
 
 lemma orthogonal_basis_subspace:
   fixes S :: "'a :: euclidean_space set"
   assumes "subspace S"
   obtains B where "0 \<notin> B" "B \<subseteq> S" "pairwise orthogonal B" "independent B"
                   "card B = dim S" "span B = S"
 proof -
   obtain B where "B \<subseteq> S" "pairwise orthogonal B" "span B = S"
     using assms orthogonal_spanningset_subspace by blast
   then show ?thesis
     apply (rule_tac B = "B - {0}" in that)
     apply (auto simp: indep_card_eq_dim_span pairwise_subset pairwise_orthogonal_independent elim: pairwise_subset)
     done
 qed
 
 proposition orthonormal_basis_subspace:
   fixes S :: "'a :: euclidean_space set"
   assumes "subspace S"
   obtains B where "B \<subseteq> S" "pairwise orthogonal B"
               and "\<And>x. x \<in> B \<Longrightarrow> norm x = 1"
               and "independent B" "card B = dim S" "span B = S"
 proof -
   obtain B where "0 \<notin> B" "B \<subseteq> S"
              and orth: "pairwise orthogonal B"
              and "independent B" "card B = dim S" "span B = S"
     by (blast intro: orthogonal_basis_subspace [OF assms])
   have 1: "(\<lambda>x. x /\<^sub>R norm x) ` B \<subseteq> S"
     using \<open>span B = S\<close> span_superset span_mul by fastforce
   have 2: "pairwise orthogonal ((\<lambda>x. x /\<^sub>R norm x) ` B)"
     using orth by (force simp: pairwise_def orthogonal_clauses)
   have 3: "\<And>x. x \<in> (\<lambda>x. x /\<^sub>R norm x) ` B \<Longrightarrow> norm x = 1"
     by (metis (no_types, lifting) \<open>0 \<notin> B\<close> image_iff norm_sgn sgn_div_norm)
   have 4: "independent ((\<lambda>x. x /\<^sub>R norm x) ` B)"
     by (metis "2" "3" norm_zero pairwise_orthogonal_independent zero_neq_one)
   have "inj_on (\<lambda>x. x /\<^sub>R norm x) B"
   proof
     fix x y
     assume "x \<in> B" "y \<in> B" "x /\<^sub>R norm x = y /\<^sub>R norm y"
     moreover have "\<And>i. i \<in> B \<Longrightarrow> norm (i /\<^sub>R norm i) = 1"
       using 3 by blast
     ultimately show "x = y"
       by (metis norm_eq_1 orth orthogonal_clauses(7) orthogonal_commute orthogonal_def pairwise_def zero_neq_one)
   qed
   then have 5: "card ((\<lambda>x. x /\<^sub>R norm x) ` B) = dim S"
     by (metis \<open>card B = dim S\<close> card_image)
   have 6: "span ((\<lambda>x. x /\<^sub>R norm x) ` B) = S"
     by (metis "1" "4" "5" assms card_eq_dim independent_imp_finite span_subspace)
   show ?thesis
     by (rule that [OF 1 2 3 4 5 6])
 qed
 
 
 proposition\<^marker>\<open>tag unimportant\<close> orthogonal_to_subspace_exists_gen:
   fixes S :: "'a :: euclidean_space set"
   assumes "span S \<subset> span T"
   obtains x where "x \<noteq> 0" "x \<in> span T" "\<And>y. y \<in> span S \<Longrightarrow> orthogonal x y"
 proof -
   obtain B where "B \<subseteq> span S" and orthB: "pairwise orthogonal B"
              and "\<And>x. x \<in> B \<Longrightarrow> norm x = 1"
              and "independent B" "card B = dim S" "span B = span S"
-    by (rule orthonormal_basis_subspace [of "span S", OF subspace_span])
-      (auto simp: dim_span)
+    by (rule orthonormal_basis_subspace [of "span S", OF subspace_span]) (auto)
   with assms obtain u where spanBT: "span B \<subseteq> span T" and "u \<notin> span B" "u \<in> span T"
     by auto
   obtain C where orthBC: "pairwise orthogonal (B \<union> C)" and spanBC: "span (B \<union> C) = span (B \<union> {u})"
     by (blast intro: orthogonal_extension [OF orthB])
   show thesis
   proof (cases "C \<subseteq> insert 0 B")
     case True
     then have "C \<subseteq> span B"
       using span_eq
       by (metis span_insert_0 subset_trans)
     moreover have "u \<in> span (B \<union> C)"
       using \<open>span (B \<union> C) = span (B \<union> {u})\<close> span_superset by force
     ultimately show ?thesis
       using True \<open>u \<notin> span B\<close>
       by (metis Un_insert_left span_insert_0 sup.orderE)
   next
     case False
     then obtain x where "x \<in> C" "x \<noteq> 0" "x \<notin> B"
       by blast
     then have "x \<in> span T"
       by (metis (no_types, lifting) Un_insert_right Un_upper2 \<open>u \<in> span T\<close> spanBT spanBC
           \<open>u \<in> span T\<close> insert_subset span_superset span_mono
           span_span subsetCE subset_trans sup_bot.comm_neutral)
     moreover have "orthogonal x y" if "y \<in> span B" for y
       using that
     proof (rule span_induct)
       show "subspace {a. orthogonal x a}"
         by (simp add: subspace_orthogonal_to_vector)
       show "\<And>b. b \<in> B \<Longrightarrow> orthogonal x b"
         by (metis Un_iff \<open>x \<in> C\<close> \<open>x \<notin> B\<close> orthBC pairwise_def)
     qed
     ultimately show ?thesis
       using \<open>x \<noteq> 0\<close> that \<open>span B = span S\<close> by auto
   qed
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> orthogonal_to_subspace_exists:
   fixes S :: "'a :: euclidean_space set"
   assumes "dim S < DIM('a)"
   obtains x where "x \<noteq> 0" "\<And>y. y \<in> span S \<Longrightarrow> orthogonal x y"
 proof -
-have "span S \<subset> UNIV"
+  have "span S \<subset> UNIV"
   by (metis (mono_tags) UNIV_I assms inner_eq_zero_iff less_le lowdim_subset_hyperplane
       mem_Collect_eq top.extremum_strict top.not_eq_extremum)
   with orthogonal_to_subspace_exists_gen [of S UNIV] that show ?thesis
-    by (auto simp: span_UNIV)
+    by (auto)
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> orthogonal_to_vector_exists:
   fixes x :: "'a :: euclidean_space"
   assumes "2 \<le> DIM('a)"
   obtains y where "y \<noteq> 0" "orthogonal x y"
 proof -
   have "dim {x} < DIM('a)"
     using assms by auto
   then show thesis
     by (rule orthogonal_to_subspace_exists) (simp add: orthogonal_commute span_base that)
 qed
 
 proposition\<^marker>\<open>tag unimportant\<close> orthogonal_subspace_decomp_exists:
   fixes S :: "'a :: euclidean_space set"
   obtains y z
   where "y \<in> span S"
     and "\<And>w. w \<in> span S \<Longrightarrow> orthogonal z w"
     and "x = y + z"
 proof -
   obtain T where "0 \<notin> T" "T \<subseteq> span S" "pairwise orthogonal T" "independent T"
     "card T = dim (span S)" "span T = span S"
     using orthogonal_basis_subspace subspace_span by blast
   let ?a = "\<Sum>b\<in>T. (b \<bullet> x / (b \<bullet> b)) *\<^sub>R b"
   have orth: "orthogonal (x - ?a) w" if "w \<in> span S" for w
     by (simp add: Gram_Schmidt_step \<open>pairwise orthogonal T\<close> \<open>span T = span S\<close>
         orthogonal_commute that)
   show ?thesis
     apply (rule_tac y = "?a" and z = "x - ?a" in that)
       apply (meson \<open>T \<subseteq> span S\<close> span_scale span_sum subsetCE)
      apply (fact orth, simp)
     done
 qed
 
 lemma orthogonal_subspace_decomp_unique:
   fixes S :: "'a :: euclidean_space set"
   assumes "x + y = x' + y'"
       and ST: "x \<in> span S" "x' \<in> span S" "y \<in> span T" "y' \<in> span T"
       and orth: "\<And>a b. \<lbrakk>a \<in> S; b \<in> T\<rbrakk> \<Longrightarrow> orthogonal a b"
   shows "x = x' \<and> y = y'"
 proof -
   have "x + y - y' = x'"
     by (simp add: assms)
   moreover have "\<And>a b. \<lbrakk>a \<in> span S; b \<in> span T\<rbrakk> \<Longrightarrow> orthogonal a b"
     by (meson orth orthogonal_commute orthogonal_to_span)
   ultimately have "0 = x' - x"
     by (metis (full_types) add_diff_cancel_left' ST diff_right_commute orthogonal_clauses(10) orthogonal_clauses(5) orthogonal_self)
   with assms show ?thesis by auto
 qed
 
 lemma vector_in_orthogonal_spanningset:
   fixes a :: "'a::euclidean_space"
   obtains S where "a \<in> S" "pairwise orthogonal S" "span S = UNIV"
   by (metis UNIV_I Un_iff empty_iff insert_subset orthogonal_extension pairwise_def
       pairwise_orthogonal_insert span_UNIV subsetI subset_antisym)
 
 lemma vector_in_orthogonal_basis:
   fixes a :: "'a::euclidean_space"
   assumes "a \<noteq> 0"
   obtains S where "a \<in> S" "0 \<notin> S" "pairwise orthogonal S" "independent S" "finite S"
                   "span S = UNIV" "card S = DIM('a)"
 proof -
   obtain S where S: "a \<in> S" "pairwise orthogonal S" "span S = UNIV"
     using vector_in_orthogonal_spanningset .
   show thesis
   proof
     show "pairwise orthogonal (S - {0})"
       using pairwise_mono S(2) by blast
     show "independent (S - {0})"
       by (simp add: \<open>pairwise orthogonal (S - {0})\<close> pairwise_orthogonal_independent)
     show "finite (S - {0})"
       using \<open>independent (S - {0})\<close> independent_imp_finite by blast
     show "card (S - {0}) = DIM('a)"
       using span_delete_0 [of S] S
-      by (simp add: \<open>independent (S - {0})\<close> indep_card_eq_dim_span dim_UNIV)
+      by (simp add: \<open>independent (S - {0})\<close> indep_card_eq_dim_span)
   qed (use S \<open>a \<noteq> 0\<close> in auto)
 qed
 
 lemma vector_in_orthonormal_basis:
   fixes a :: "'a::euclidean_space"
   assumes "norm a = 1"
   obtains S where "a \<in> S" "pairwise orthogonal S" "\<And>x. x \<in> S \<Longrightarrow> norm x = 1"
     "independent S" "card S = DIM('a)" "span S = UNIV"
 proof -
   have "a \<noteq> 0"
     using assms by auto
   then obtain S where "a \<in> S" "0 \<notin> S" "finite S"
           and S: "pairwise orthogonal S" "independent S" "span S = UNIV" "card S = DIM('a)"
     by (metis vector_in_orthogonal_basis)
   let ?S = "(\<lambda>x. x /\<^sub>R norm x) ` S"
   show thesis
   proof
     show "a \<in> ?S"
       using \<open>a \<in> S\<close> assms image_iff by fastforce
   next
     show "pairwise orthogonal ?S"
       using \<open>pairwise orthogonal S\<close> by (auto simp: pairwise_def orthogonal_def)
     show "\<And>x. x \<in> (\<lambda>x. x /\<^sub>R norm x) ` S \<Longrightarrow> norm x = 1"
       using \<open>0 \<notin> S\<close> by (auto simp: field_split_simps)
     then show "independent ?S"
       by (metis \<open>pairwise orthogonal ((\<lambda>x. x /\<^sub>R norm x) ` S)\<close> norm_zero pairwise_orthogonal_independent zero_neq_one)
     have "inj_on (\<lambda>x. x /\<^sub>R norm x) S"
       unfolding inj_on_def
       by (metis (full_types) S(1) \<open>0 \<notin> S\<close> inverse_nonzero_iff_nonzero norm_eq_zero orthogonal_scaleR orthogonal_self pairwise_def)
     then show "card ?S = DIM('a)"
       by (simp add: card_image S)
     show "span ?S = UNIV"
       by (metis (no_types) \<open>0 \<notin> S\<close> \<open>finite S\<close> \<open>span S = UNIV\<close>
           field_class.field_inverse_zero inverse_inverse_eq less_irrefl span_image_scale
           zero_less_norm_iff)
   qed
 qed
 
 proposition dim_orthogonal_sum:
   fixes A :: "'a::euclidean_space set"
   assumes "\<And>x y. \<lbrakk>x \<in> A; y \<in> B\<rbrakk> \<Longrightarrow> x \<bullet> y = 0"
     shows "dim(A \<union> B) = dim A + dim B"
 proof -
   have 1: "\<And>x y. \<lbrakk>x \<in> span A; y \<in> B\<rbrakk> \<Longrightarrow> x \<bullet> y = 0"
     by (erule span_induct [OF _ subspace_hyperplane2]; simp add: assms)
   have "\<And>x y. \<lbrakk>x \<in> span A; y \<in> span B\<rbrakk> \<Longrightarrow> x \<bullet> y = 0"
     using 1 by (simp add: span_induct [OF _ subspace_hyperplane])
   then have 0: "\<And>x y. \<lbrakk>x \<in> span A; y \<in> span B\<rbrakk> \<Longrightarrow> x \<bullet> y = 0"
     by simp
   have "dim(A \<union> B) = dim (span (A \<union> B))"
-    by (simp add: dim_span)
+    by (simp)
   also have "span (A \<union> B) = ((\<lambda>(a, b). a + b) ` (span A \<times> span B))"
     by (auto simp add: span_Un image_def)
   also have "dim \<dots> = dim {x + y |x y. x \<in> span A \<and> y \<in> span B}"
     by (auto intro!: arg_cong [where f=dim])
   also have "... = dim {x + y |x y. x \<in> span A \<and> y \<in> span B} + dim(span A \<inter> span B)"
     by (auto simp: dest: 0)
   also have "... = dim (span A) + dim (span B)"
-    by (rule dim_sums_Int) (auto simp: subspace_span)
+    by (rule dim_sums_Int) (auto)
   also have "... = dim A + dim B"
-    by (simp add: dim_span)
+    by (simp)
   finally show ?thesis .
 qed
 
 lemma dim_subspace_orthogonal_to_vectors:
   fixes A :: "'a::euclidean_space set"
   assumes "subspace A" "subspace B" "A \<subseteq> B"
     shows "dim {y \<in> B. \<forall>x \<in> A. orthogonal x y} + dim A = dim B"
 proof -
   have "dim (span ({y \<in> B. \<forall>x\<in>A. orthogonal x y} \<union> A)) = dim (span B)"
   proof (rule arg_cong [where f=dim, OF subset_antisym])
     show "span ({y \<in> B. \<forall>x\<in>A. orthogonal x y} \<union> A) \<subseteq> span B"
       by (simp add: \<open>A \<subseteq> B\<close> Collect_restrict span_mono)
   next
     have *: "x \<in> span ({y \<in> B. \<forall>x\<in>A. orthogonal x y} \<union> A)"
          if "x \<in> B" for x
     proof -
       obtain y z where "x = y + z" "y \<in> span A" and orth: "\<And>w. w \<in> span A \<Longrightarrow> orthogonal z w"
         using orthogonal_subspace_decomp_exists [of A x] that by auto
       have "y \<in> span B"
         using \<open>y \<in> span A\<close> assms(3) span_mono by blast
       then have "z \<in> {a \<in> B. \<forall>x. x \<in> A \<longrightarrow> orthogonal x a}"
         apply simp
         using \<open>x = y + z\<close> assms(1) assms(2) orth orthogonal_commute span_add_eq
           span_eq_iff that by blast
       then have z: "z \<in> span {y \<in> B. \<forall>x\<in>A. orthogonal x y}"
         by (meson span_superset subset_iff)
       then show ?thesis
         apply (auto simp: span_Un image_def  \<open>x = y + z\<close> \<open>y \<in> span A\<close>)
         using \<open>y \<in> span A\<close> add.commute by blast
     qed
     show "span B \<subseteq> span ({y \<in> B. \<forall>x\<in>A. orthogonal x y} \<union> A)"
-      by (rule span_minimal)
-        (auto intro: * span_minimal simp: subspace_span)
+      by (rule span_minimal) (auto intro: * span_minimal)
   qed
   then show ?thesis
     by (metis (no_types, lifting) dim_orthogonal_sum dim_span mem_Collect_eq
         orthogonal_commute orthogonal_def)
 qed
 
 subsection\<open>Linear functions are (uniformly) continuous on any set\<close>
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Topological properties of linear functions\<close>
 
 lemma linear_lim_0:
   assumes "bounded_linear f"
   shows "(f \<longlongrightarrow> 0) (at (0))"
 proof -
   interpret f: bounded_linear f by fact
   have "(f \<longlongrightarrow> f 0) (at 0)"
     using tendsto_ident_at by (rule f.tendsto)
   then show ?thesis unfolding f.zero .
 qed
 
 lemma linear_continuous_at:
   assumes "bounded_linear f"
   shows "continuous (at a) f"
   unfolding continuous_at using assms
   apply (rule bounded_linear.tendsto)
   apply (rule tendsto_ident_at)
   done
 
 lemma linear_continuous_within:
   "bounded_linear f \<Longrightarrow> continuous (at x within s) f"
   using continuous_at_imp_continuous_at_within linear_continuous_at by blast
 
 lemma linear_continuous_on:
   "bounded_linear f \<Longrightarrow> continuous_on s f"
   using continuous_at_imp_continuous_on[of s f] using linear_continuous_at[of f] by auto
 
 lemma Lim_linear:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space" and h :: "'b \<Rightarrow> 'c::real_normed_vector"
   assumes "(f \<longlongrightarrow> l) F" "linear h"
   shows "((\<lambda>x. h(f x)) \<longlongrightarrow> h l) F"
 proof -
   obtain B where B: "B > 0" "\<And>x. norm (h x) \<le> B * norm x"
     using linear_bounded_pos [OF \<open>linear h\<close>] by blast
   show ?thesis
     unfolding tendsto_iff
   proof (intro allI impI)
     show "\<forall>\<^sub>F x in F. dist (h (f x)) (h l) < e" if "e > 0" for e
     proof -
       have "\<forall>\<^sub>F x in F. dist (f x) l < e/B"
         by (simp add: \<open>0 < B\<close> assms(1) tendstoD that)
       then show ?thesis
         unfolding dist_norm
       proof (rule eventually_mono)
         show "norm (h (f x) - h l) < e" if "norm (f x - l) < e / B" for x
           using that B
           apply (simp add: field_split_simps)
-          by (metis \<open>linear h\<close> le_less_trans linear_diff mult.commute)
+          by (metis \<open>linear h\<close> le_less_trans linear_diff)
       qed
     qed
   qed
 qed
 
 lemma linear_continuous_compose:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space" and g :: "'b \<Rightarrow> 'c::real_normed_vector"
   assumes "continuous F f" "linear g"
   shows "continuous F (\<lambda>x. g(f x))"
   using assms unfolding continuous_def by (rule Lim_linear)
 
 lemma linear_continuous_on_compose:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space" and g :: "'b \<Rightarrow> 'c::real_normed_vector"
   assumes "continuous_on S f" "linear g"
   shows "continuous_on S (\<lambda>x. g(f x))"
   using assms by (simp add: continuous_on_eq_continuous_within linear_continuous_compose)
 
 text\<open>Also bilinear functions, in composition form\<close>
 
 lemma bilinear_continuous_compose:
   fixes h :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::real_normed_vector"
   assumes "continuous F f" "continuous F g" "bilinear h"
   shows "continuous F (\<lambda>x. h (f x) (g x))"
   using assms bilinear_conv_bounded_bilinear bounded_bilinear.continuous by blast
 
 lemma bilinear_continuous_on_compose:
   fixes h :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::real_normed_vector"
     and f :: "'d::t2_space \<Rightarrow> 'a"
   assumes "continuous_on S f" "continuous_on S g" "bilinear h"
   shows "continuous_on S (\<lambda>x. h (f x) (g x))"
   using assms by (simp add: continuous_on_eq_continuous_within bilinear_continuous_compose)
 
 
 end
diff --git a/src/HOL/Real.thy b/src/HOL/Real.thy
--- a/src/HOL/Real.thy
+++ b/src/HOL/Real.thy
@@ -1,1656 +1,1746 @@
 (*  Title:      HOL/Real.thy
     Author:     Jacques D. Fleuriot, University of Edinburgh, 1998
     Author:     Larry Paulson, University of Cambridge
     Author:     Jeremy Avigad, Carnegie Mellon University
     Author:     Florian Zuleger, Johannes Hoelzl, and Simon Funke, TU Muenchen
     Conversion to Isar and new proofs by Lawrence C Paulson, 2003/4
     Construction of Cauchy Reals by Brian Huffman, 2010
 *)
 
 section \<open>Development of the Reals using Cauchy Sequences\<close>
 
 theory Real
 imports Rat
 begin
 
 text \<open>
   This theory contains a formalization of the real numbers as equivalence
   classes of Cauchy sequences of rationals. See
   \<^file>\<open>~~/src/HOL/ex/Dedekind_Real.thy\<close> for an alternative construction using
   Dedekind cuts.
 \<close>
 
 
 subsection \<open>Preliminary lemmas\<close>
 
 text\<open>Useful in convergence arguments\<close>
 lemma inverse_of_nat_le:
   fixes n::nat shows "\<lbrakk>n \<le> m; n\<noteq>0\<rbrakk> \<Longrightarrow> 1 / of_nat m \<le> (1::'a::linordered_field) / of_nat n"
   by (simp add: frac_le)
 
 lemma add_diff_add: "(a + c) - (b + d) = (a - b) + (c - d)"
   for a b c d :: "'a::ab_group_add"
   by simp
 
 lemma minus_diff_minus: "- a - - b = - (a - b)"
   for a b :: "'a::ab_group_add"
   by simp
 
 lemma mult_diff_mult: "(x * y - a * b) = x * (y - b) + (x - a) * b"
   for x y a b :: "'a::ring"
   by (simp add: algebra_simps)
 
 lemma inverse_diff_inverse:
   fixes a b :: "'a::division_ring"
   assumes "a \<noteq> 0" and "b \<noteq> 0"
   shows "inverse a - inverse b = - (inverse a * (a - b) * inverse b)"
   using assms by (simp add: algebra_simps)
 
 lemma obtain_pos_sum:
   fixes r :: rat assumes r: "0 < r"
   obtains s t where "0 < s" and "0 < t" and "r = s + t"
 proof
   from r show "0 < r/2" by simp
   from r show "0 < r/2" by simp
   show "r = r/2 + r/2" by simp
 qed
 
 
 subsection \<open>Sequences that converge to zero\<close>
 
 definition vanishes :: "(nat \<Rightarrow> rat) \<Rightarrow> bool"
   where "vanishes X \<longleftrightarrow> (\<forall>r>0. \<exists>k. \<forall>n\<ge>k. \<bar>X n\<bar> < r)"
 
 lemma vanishesI: "(\<And>r. 0 < r \<Longrightarrow> \<exists>k. \<forall>n\<ge>k. \<bar>X n\<bar> < r) \<Longrightarrow> vanishes X"
   unfolding vanishes_def by simp
 
 lemma vanishesD: "vanishes X \<Longrightarrow> 0 < r \<Longrightarrow> \<exists>k. \<forall>n\<ge>k. \<bar>X n\<bar> < r"
   unfolding vanishes_def by simp
 
 lemma vanishes_const [simp]: "vanishes (\<lambda>n. c) \<longleftrightarrow> c = 0"
 proof (cases "c = 0")
   case True
   then show ?thesis
     by (simp add: vanishesI)    
 next
   case False
   then show ?thesis
     unfolding vanishes_def
     using zero_less_abs_iff by blast
 qed
 
 lemma vanishes_minus: "vanishes X \<Longrightarrow> vanishes (\<lambda>n. - X n)"
   unfolding vanishes_def by simp
 
 lemma vanishes_add:
   assumes X: "vanishes X"
     and Y: "vanishes Y"
   shows "vanishes (\<lambda>n. X n + Y n)"
 proof (rule vanishesI)
   fix r :: rat
   assume "0 < r"
   then obtain s t where s: "0 < s" and t: "0 < t" and r: "r = s + t"
     by (rule obtain_pos_sum)
   obtain i where i: "\<forall>n\<ge>i. \<bar>X n\<bar> < s"
     using vanishesD [OF X s] ..
   obtain j where j: "\<forall>n\<ge>j. \<bar>Y n\<bar> < t"
     using vanishesD [OF Y t] ..
   have "\<forall>n\<ge>max i j. \<bar>X n + Y n\<bar> < r"
   proof clarsimp
     fix n
     assume n: "i \<le> n" "j \<le> n"
     have "\<bar>X n + Y n\<bar> \<le> \<bar>X n\<bar> + \<bar>Y n\<bar>"
       by (rule abs_triangle_ineq)
     also have "\<dots> < s + t"
       by (simp add: add_strict_mono i j n)
     finally show "\<bar>X n + Y n\<bar> < r"
       by (simp only: r)
   qed
   then show "\<exists>k. \<forall>n\<ge>k. \<bar>X n + Y n\<bar> < r" ..
 qed
 
 lemma vanishes_diff:
   assumes "vanishes X" "vanishes Y"
   shows "vanishes (\<lambda>n. X n - Y n)"
   unfolding diff_conv_add_uminus by (intro vanishes_add vanishes_minus assms)
 
 lemma vanishes_mult_bounded:
   assumes X: "\<exists>a>0. \<forall>n. \<bar>X n\<bar> < a"
   assumes Y: "vanishes (\<lambda>n. Y n)"
   shows "vanishes (\<lambda>n. X n * Y n)"
 proof (rule vanishesI)
   fix r :: rat
   assume r: "0 < r"
   obtain a where a: "0 < a" "\<forall>n. \<bar>X n\<bar> < a"
     using X by blast
   obtain b where b: "0 < b" "r = a * b"
   proof
     show "0 < r / a" using r a by simp
     show "r = a * (r / a)" using a by simp
   qed
   obtain k where k: "\<forall>n\<ge>k. \<bar>Y n\<bar> < b"
     using vanishesD [OF Y b(1)] ..
   have "\<forall>n\<ge>k. \<bar>X n * Y n\<bar> < r"
     by (simp add: b(2) abs_mult mult_strict_mono' a k)
   then show "\<exists>k. \<forall>n\<ge>k. \<bar>X n * Y n\<bar> < r" ..
 qed
 
 
 subsection \<open>Cauchy sequences\<close>
 
 definition cauchy :: "(nat \<Rightarrow> rat) \<Rightarrow> bool"
   where "cauchy X \<longleftrightarrow> (\<forall>r>0. \<exists>k. \<forall>m\<ge>k. \<forall>n\<ge>k. \<bar>X m - X n\<bar> < r)"
 
 lemma cauchyI: "(\<And>r. 0 < r \<Longrightarrow> \<exists>k. \<forall>m\<ge>k. \<forall>n\<ge>k. \<bar>X m - X n\<bar> < r) \<Longrightarrow> cauchy X"
   unfolding cauchy_def by simp
 
 lemma cauchyD: "cauchy X \<Longrightarrow> 0 < r \<Longrightarrow> \<exists>k. \<forall>m\<ge>k. \<forall>n\<ge>k. \<bar>X m - X n\<bar> < r"
   unfolding cauchy_def by simp
 
 lemma cauchy_const [simp]: "cauchy (\<lambda>n. x)"
   unfolding cauchy_def by simp
 
 lemma cauchy_add [simp]:
   assumes X: "cauchy X" and Y: "cauchy Y"
   shows "cauchy (\<lambda>n. X n + Y n)"
 proof (rule cauchyI)
   fix r :: rat
   assume "0 < r"
   then obtain s t where s: "0 < s" and t: "0 < t" and r: "r = s + t"
     by (rule obtain_pos_sum)
   obtain i where i: "\<forall>m\<ge>i. \<forall>n\<ge>i. \<bar>X m - X n\<bar> < s"
     using cauchyD [OF X s] ..
   obtain j where j: "\<forall>m\<ge>j. \<forall>n\<ge>j. \<bar>Y m - Y n\<bar> < t"
     using cauchyD [OF Y t] ..
   have "\<forall>m\<ge>max i j. \<forall>n\<ge>max i j. \<bar>(X m + Y m) - (X n + Y n)\<bar> < r"
   proof clarsimp
     fix m n
     assume *: "i \<le> m" "j \<le> m" "i \<le> n" "j \<le> n"
     have "\<bar>(X m + Y m) - (X n + Y n)\<bar> \<le> \<bar>X m - X n\<bar> + \<bar>Y m - Y n\<bar>"
       unfolding add_diff_add by (rule abs_triangle_ineq)
     also have "\<dots> < s + t"
       by (rule add_strict_mono) (simp_all add: i j *)
     finally show "\<bar>(X m + Y m) - (X n + Y n)\<bar> < r" by (simp only: r)
   qed
   then show "\<exists>k. \<forall>m\<ge>k. \<forall>n\<ge>k. \<bar>(X m + Y m) - (X n + Y n)\<bar> < r" ..
 qed
 
 lemma cauchy_minus [simp]:
   assumes X: "cauchy X"
   shows "cauchy (\<lambda>n. - X n)"
   using assms unfolding cauchy_def
   unfolding minus_diff_minus abs_minus_cancel .
 
 lemma cauchy_diff [simp]:
   assumes "cauchy X" "cauchy Y"
   shows "cauchy (\<lambda>n. X n - Y n)"
   using assms unfolding diff_conv_add_uminus by (simp del: add_uminus_conv_diff)
 
 lemma cauchy_imp_bounded:
   assumes "cauchy X"
   shows "\<exists>b>0. \<forall>n. \<bar>X n\<bar> < b"
 proof -
   obtain k where k: "\<forall>m\<ge>k. \<forall>n\<ge>k. \<bar>X m - X n\<bar> < 1"
     using cauchyD [OF assms zero_less_one] ..
   show "\<exists>b>0. \<forall>n. \<bar>X n\<bar> < b"
   proof (intro exI conjI allI)
     have "0 \<le> \<bar>X 0\<bar>" by simp
     also have "\<bar>X 0\<bar> \<le> Max (abs ` X ` {..k})" by simp
     finally have "0 \<le> Max (abs ` X ` {..k})" .
     then show "0 < Max (abs ` X ` {..k}) + 1" by simp
   next
     fix n :: nat
     show "\<bar>X n\<bar> < Max (abs ` X ` {..k}) + 1"
     proof (rule linorder_le_cases)
       assume "n \<le> k"
       then have "\<bar>X n\<bar> \<le> Max (abs ` X ` {..k})" by simp
       then show "\<bar>X n\<bar> < Max (abs ` X ` {..k}) + 1" by simp
     next
       assume "k \<le> n"
       have "\<bar>X n\<bar> = \<bar>X k + (X n - X k)\<bar>" by simp
       also have "\<bar>X k + (X n - X k)\<bar> \<le> \<bar>X k\<bar> + \<bar>X n - X k\<bar>"
         by (rule abs_triangle_ineq)
       also have "\<dots> < Max (abs ` X ` {..k}) + 1"
         by (rule add_le_less_mono) (simp_all add: k \<open>k \<le> n\<close>)
       finally show "\<bar>X n\<bar> < Max (abs ` X ` {..k}) + 1" .
     qed
   qed
 qed
 
 lemma cauchy_mult [simp]:
   assumes X: "cauchy X" and Y: "cauchy Y"
   shows "cauchy (\<lambda>n. X n * Y n)"
 proof (rule cauchyI)
   fix r :: rat assume "0 < r"
   then obtain u v where u: "0 < u" and v: "0 < v" and "r = u + v"
     by (rule obtain_pos_sum)
   obtain a where a: "0 < a" "\<forall>n. \<bar>X n\<bar> < a"
     using cauchy_imp_bounded [OF X] by blast
   obtain b where b: "0 < b" "\<forall>n. \<bar>Y n\<bar> < b"
     using cauchy_imp_bounded [OF Y] by blast
   obtain s t where s: "0 < s" and t: "0 < t" and r: "r = a * t + s * b"
   proof
     show "0 < v/b" using v b(1) by simp
     show "0 < u/a" using u a(1) by simp
     show "r = a * (u/a) + (v/b) * b"
       using a(1) b(1) \<open>r = u + v\<close> by simp
   qed
   obtain i where i: "\<forall>m\<ge>i. \<forall>n\<ge>i. \<bar>X m - X n\<bar> < s"
     using cauchyD [OF X s] ..
   obtain j where j: "\<forall>m\<ge>j. \<forall>n\<ge>j. \<bar>Y m - Y n\<bar> < t"
     using cauchyD [OF Y t] ..
   have "\<forall>m\<ge>max i j. \<forall>n\<ge>max i j. \<bar>X m * Y m - X n * Y n\<bar> < r"
   proof clarsimp
     fix m n
     assume *: "i \<le> m" "j \<le> m" "i \<le> n" "j \<le> n"
     have "\<bar>X m * Y m - X n * Y n\<bar> = \<bar>X m * (Y m - Y n) + (X m - X n) * Y n\<bar>"
       unfolding mult_diff_mult ..
     also have "\<dots> \<le> \<bar>X m * (Y m - Y n)\<bar> + \<bar>(X m - X n) * Y n\<bar>"
       by (rule abs_triangle_ineq)
     also have "\<dots> = \<bar>X m\<bar> * \<bar>Y m - Y n\<bar> + \<bar>X m - X n\<bar> * \<bar>Y n\<bar>"
       unfolding abs_mult ..
     also have "\<dots> < a * t + s * b"
       by (simp_all add: add_strict_mono mult_strict_mono' a b i j *)
     finally show "\<bar>X m * Y m - X n * Y n\<bar> < r"
       by (simp only: r)
   qed
   then show "\<exists>k. \<forall>m\<ge>k. \<forall>n\<ge>k. \<bar>X m * Y m - X n * Y n\<bar> < r" ..
 qed
 
 lemma cauchy_not_vanishes_cases:
   assumes X: "cauchy X"
   assumes nz: "\<not> vanishes X"
   shows "\<exists>b>0. \<exists>k. (\<forall>n\<ge>k. b < - X n) \<or> (\<forall>n\<ge>k. b < X n)"
 proof -
   obtain r where "0 < r" and r: "\<forall>k. \<exists>n\<ge>k. r \<le> \<bar>X n\<bar>"
     using nz unfolding vanishes_def by (auto simp add: not_less)
   obtain s t where s: "0 < s" and t: "0 < t" and "r = s + t"
     using \<open>0 < r\<close> by (rule obtain_pos_sum)
   obtain i where i: "\<forall>m\<ge>i. \<forall>n\<ge>i. \<bar>X m - X n\<bar> < s"
     using cauchyD [OF X s] ..
   obtain k where "i \<le> k" and "r \<le> \<bar>X k\<bar>"
     using r by blast
   have k: "\<forall>n\<ge>k. \<bar>X n - X k\<bar> < s"
     using i \<open>i \<le> k\<close> by auto
   have "X k \<le> - r \<or> r \<le> X k"
     using \<open>r \<le> \<bar>X k\<bar>\<close> by auto
   then have "(\<forall>n\<ge>k. t < - X n) \<or> (\<forall>n\<ge>k. t < X n)"
     unfolding \<open>r = s + t\<close> using k by auto
   then have "\<exists>k. (\<forall>n\<ge>k. t < - X n) \<or> (\<forall>n\<ge>k. t < X n)" ..
   then show "\<exists>t>0. \<exists>k. (\<forall>n\<ge>k. t < - X n) \<or> (\<forall>n\<ge>k. t < X n)"
     using t by auto
 qed
 
 lemma cauchy_not_vanishes:
   assumes X: "cauchy X"
     and nz: "\<not> vanishes X"
   shows "\<exists>b>0. \<exists>k. \<forall>n\<ge>k. b < \<bar>X n\<bar>"
   using cauchy_not_vanishes_cases [OF assms]
   by (elim ex_forward conj_forward asm_rl) auto
 
 lemma cauchy_inverse [simp]:
   assumes X: "cauchy X"
     and nz: "\<not> vanishes X"
   shows "cauchy (\<lambda>n. inverse (X n))"
 proof (rule cauchyI)
   fix r :: rat
   assume "0 < r"
   obtain b i where b: "0 < b" and i: "\<forall>n\<ge>i. b < \<bar>X n\<bar>"
     using cauchy_not_vanishes [OF X nz] by blast
   from b i have nz: "\<forall>n\<ge>i. X n \<noteq> 0" by auto
   obtain s where s: "0 < s" and r: "r = inverse b * s * inverse b"
   proof
     show "0 < b * r * b" by (simp add: \<open>0 < r\<close> b)
     show "r = inverse b * (b * r * b) * inverse b"
       using b by simp
   qed
   obtain j where j: "\<forall>m\<ge>j. \<forall>n\<ge>j. \<bar>X m - X n\<bar> < s"
     using cauchyD [OF X s] ..
   have "\<forall>m\<ge>max i j. \<forall>n\<ge>max i j. \<bar>inverse (X m) - inverse (X n)\<bar> < r"
   proof clarsimp
     fix m n
     assume *: "i \<le> m" "j \<le> m" "i \<le> n" "j \<le> n"
     have "\<bar>inverse (X m) - inverse (X n)\<bar> = inverse \<bar>X m\<bar> * \<bar>X m - X n\<bar> * inverse \<bar>X n\<bar>"
       by (simp add: inverse_diff_inverse nz * abs_mult)
     also have "\<dots> < inverse b * s * inverse b"
       by (simp add: mult_strict_mono less_imp_inverse_less i j b * s)
     finally show "\<bar>inverse (X m) - inverse (X n)\<bar> < r" by (simp only: r)
   qed
   then show "\<exists>k. \<forall>m\<ge>k. \<forall>n\<ge>k. \<bar>inverse (X m) - inverse (X n)\<bar> < r" ..
 qed
 
 lemma vanishes_diff_inverse:
   assumes X: "cauchy X" "\<not> vanishes X"
     and Y: "cauchy Y" "\<not> vanishes Y"
     and XY: "vanishes (\<lambda>n. X n - Y n)"
   shows "vanishes (\<lambda>n. inverse (X n) - inverse (Y n))"
 proof (rule vanishesI)
   fix r :: rat
   assume r: "0 < r"
   obtain a i where a: "0 < a" and i: "\<forall>n\<ge>i. a < \<bar>X n\<bar>"
     using cauchy_not_vanishes [OF X] by blast
   obtain b j where b: "0 < b" and j: "\<forall>n\<ge>j. b < \<bar>Y n\<bar>"
     using cauchy_not_vanishes [OF Y] by blast
   obtain s where s: "0 < s" and "inverse a * s * inverse b = r"
   proof
     show "0 < a * r * b"
       using a r b by simp
     show "inverse a * (a * r * b) * inverse b = r"
       using a r b by simp
   qed
   obtain k where k: "\<forall>n\<ge>k. \<bar>X n - Y n\<bar> < s"
     using vanishesD [OF XY s] ..
   have "\<forall>n\<ge>max (max i j) k. \<bar>inverse (X n) - inverse (Y n)\<bar> < r"
   proof clarsimp
     fix n
     assume n: "i \<le> n" "j \<le> n" "k \<le> n"
     with i j a b have "X n \<noteq> 0" and "Y n \<noteq> 0"
       by auto
     then have "\<bar>inverse (X n) - inverse (Y n)\<bar> = inverse \<bar>X n\<bar> * \<bar>X n - Y n\<bar> * inverse \<bar>Y n\<bar>"
       by (simp add: inverse_diff_inverse abs_mult)
     also have "\<dots> < inverse a * s * inverse b"
       by (intro mult_strict_mono' less_imp_inverse_less) (simp_all add: a b i j k n)
     also note \<open>inverse a * s * inverse b = r\<close>
     finally show "\<bar>inverse (X n) - inverse (Y n)\<bar> < r" .
   qed
   then show "\<exists>k. \<forall>n\<ge>k. \<bar>inverse (X n) - inverse (Y n)\<bar> < r" ..
 qed
 
 
 subsection \<open>Equivalence relation on Cauchy sequences\<close>
 
 definition realrel :: "(nat \<Rightarrow> rat) \<Rightarrow> (nat \<Rightarrow> rat) \<Rightarrow> bool"
   where "realrel = (\<lambda>X Y. cauchy X \<and> cauchy Y \<and> vanishes (\<lambda>n. X n - Y n))"
 
 lemma realrelI [intro?]: "cauchy X \<Longrightarrow> cauchy Y \<Longrightarrow> vanishes (\<lambda>n. X n - Y n) \<Longrightarrow> realrel X Y"
   by (simp add: realrel_def)
 
 lemma realrel_refl: "cauchy X \<Longrightarrow> realrel X X"
   by (simp add: realrel_def)
 
 lemma symp_realrel: "symp realrel"
   by (simp add: abs_minus_commute realrel_def symp_def vanishes_def)
 
 lemma transp_realrel: "transp realrel"
   unfolding realrel_def
   by (rule transpI) (force simp add: dest: vanishes_add)
 
 lemma part_equivp_realrel: "part_equivp realrel"
   by (blast intro: part_equivpI symp_realrel transp_realrel realrel_refl cauchy_const)
 
 
 subsection \<open>The field of real numbers\<close>
 
 quotient_type real = "nat \<Rightarrow> rat" / partial: realrel
   morphisms rep_real Real
   by (rule part_equivp_realrel)
 
 lemma cr_real_eq: "pcr_real = (\<lambda>x y. cauchy x \<and> Real x = y)"
   unfolding real.pcr_cr_eq cr_real_def realrel_def by auto
 
 lemma Real_induct [induct type: real]: (* TODO: generate automatically *)
   assumes "\<And>X. cauchy X \<Longrightarrow> P (Real X)"
   shows "P x"
 proof (induct x)
   case (1 X)
   then have "cauchy X" by (simp add: realrel_def)
   then show "P (Real X)" by (rule assms)
 qed
 
 lemma eq_Real: "cauchy X \<Longrightarrow> cauchy Y \<Longrightarrow> Real X = Real Y \<longleftrightarrow> vanishes (\<lambda>n. X n - Y n)"
   using real.rel_eq_transfer
   unfolding real.pcr_cr_eq cr_real_def rel_fun_def realrel_def by simp
 
 lemma Domainp_pcr_real [transfer_domain_rule]: "Domainp pcr_real = cauchy"
   by (simp add: real.domain_eq realrel_def)
 
 instantiation real :: field
 begin
 
 lift_definition zero_real :: "real" is "\<lambda>n. 0"
   by (simp add: realrel_refl)
 
 lift_definition one_real :: "real" is "\<lambda>n. 1"
   by (simp add: realrel_refl)
 
 lift_definition plus_real :: "real \<Rightarrow> real \<Rightarrow> real" is "\<lambda>X Y n. X n + Y n"
   unfolding realrel_def add_diff_add
   by (simp only: cauchy_add vanishes_add simp_thms)
 
 lift_definition uminus_real :: "real \<Rightarrow> real" is "\<lambda>X n. - X n"
   unfolding realrel_def minus_diff_minus
   by (simp only: cauchy_minus vanishes_minus simp_thms)
 
 lift_definition times_real :: "real \<Rightarrow> real \<Rightarrow> real" is "\<lambda>X Y n. X n * Y n"
 proof -
   fix f1 f2 f3 f4
   have "\<lbrakk>cauchy f1; cauchy f4; vanishes (\<lambda>n. f1 n - f2 n); vanishes (\<lambda>n. f3 n - f4 n)\<rbrakk>
        \<Longrightarrow> vanishes (\<lambda>n. f1 n * (f3 n - f4 n) + f4 n * (f1 n - f2 n))"
     by (simp add: vanishes_add vanishes_mult_bounded cauchy_imp_bounded)
   then show "\<lbrakk>realrel f1 f2; realrel f3 f4\<rbrakk> \<Longrightarrow> realrel (\<lambda>n. f1 n * f3 n) (\<lambda>n. f2 n * f4 n)"
     by (simp add: mult.commute realrel_def mult_diff_mult)
 qed
 
 lift_definition inverse_real :: "real \<Rightarrow> real"
   is "\<lambda>X. if vanishes X then (\<lambda>n. 0) else (\<lambda>n. inverse (X n))"
 proof -
   fix X Y
   assume "realrel X Y"
   then have X: "cauchy X" and Y: "cauchy Y" and XY: "vanishes (\<lambda>n. X n - Y n)"
     by (simp_all add: realrel_def)
   have "vanishes X \<longleftrightarrow> vanishes Y"
   proof
     assume "vanishes X"
     from vanishes_diff [OF this XY] show "vanishes Y"
       by simp
   next
     assume "vanishes Y"
     from vanishes_add [OF this XY] show "vanishes X"
       by simp
   qed
   then show "?thesis X Y"
     by (simp add: vanishes_diff_inverse X Y XY realrel_def)
 qed
 
 definition "x - y = x + - y" for x y :: real
 
 definition "x div y = x * inverse y" for x y :: real
 
 lemma add_Real: "cauchy X \<Longrightarrow> cauchy Y \<Longrightarrow> Real X + Real Y = Real (\<lambda>n. X n + Y n)"
   using plus_real.transfer by (simp add: cr_real_eq rel_fun_def)
 
 lemma minus_Real: "cauchy X \<Longrightarrow> - Real X = Real (\<lambda>n. - X n)"
   using uminus_real.transfer by (simp add: cr_real_eq rel_fun_def)
 
 lemma diff_Real: "cauchy X \<Longrightarrow> cauchy Y \<Longrightarrow> Real X - Real Y = Real (\<lambda>n. X n - Y n)"
   by (simp add: minus_Real add_Real minus_real_def)
 
 lemma mult_Real: "cauchy X \<Longrightarrow> cauchy Y \<Longrightarrow> Real X * Real Y = Real (\<lambda>n. X n * Y n)"
   using times_real.transfer by (simp add: cr_real_eq rel_fun_def)
 
 lemma inverse_Real:
   "cauchy X \<Longrightarrow> inverse (Real X) = (if vanishes X then 0 else Real (\<lambda>n. inverse (X n)))"
   using inverse_real.transfer zero_real.transfer
   unfolding cr_real_eq rel_fun_def by (simp split: if_split_asm, metis)
 
 instance
 proof
   fix a b c :: real
   show "a + b = b + a"
     by transfer (simp add: ac_simps realrel_def)
   show "(a + b) + c = a + (b + c)"
     by transfer (simp add: ac_simps realrel_def)
   show "0 + a = a"
     by transfer (simp add: realrel_def)
   show "- a + a = 0"
     by transfer (simp add: realrel_def)
   show "a - b = a + - b"
     by (rule minus_real_def)
   show "(a * b) * c = a * (b * c)"
     by transfer (simp add: ac_simps realrel_def)
   show "a * b = b * a"
     by transfer (simp add: ac_simps realrel_def)
   show "1 * a = a"
     by transfer (simp add: ac_simps realrel_def)
   show "(a + b) * c = a * c + b * c"
     by transfer (simp add: distrib_right realrel_def)
   show "(0::real) \<noteq> (1::real)"
     by transfer (simp add: realrel_def)
   have "vanishes (\<lambda>n. inverse (X n) * X n - 1)" if X: "cauchy X" "\<not> vanishes X" for X
   proof (rule vanishesI)
     fix r::rat
     assume "0 < r"
     obtain b k where "b>0" "\<forall>n\<ge>k. b < \<bar>X n\<bar>"
       using X cauchy_not_vanishes by blast
     then show "\<exists>k. \<forall>n\<ge>k. \<bar>inverse (X n) * X n - 1\<bar> < r" 
       using \<open>0 < r\<close> by force
   qed
   then show "a \<noteq> 0 \<Longrightarrow> inverse a * a = 1"
     by transfer (simp add: realrel_def)
   show "a div b = a * inverse b"
     by (rule divide_real_def)
   show "inverse (0::real) = 0"
     by transfer (simp add: realrel_def)
 qed
 
 end
 
 
 subsection \<open>Positive reals\<close>
 
 lift_definition positive :: "real \<Rightarrow> bool"
   is "\<lambda>X. \<exists>r>0. \<exists>k. \<forall>n\<ge>k. r < X n"
 proof -
   have 1: "\<exists>r>0. \<exists>k. \<forall>n\<ge>k. r < Y n"
     if *: "realrel X Y" and **: "\<exists>r>0. \<exists>k. \<forall>n\<ge>k. r < X n" for X Y
   proof -
     from * have XY: "vanishes (\<lambda>n. X n - Y n)"
       by (simp_all add: realrel_def)
     from ** obtain r i where "0 < r" and i: "\<forall>n\<ge>i. r < X n"
       by blast
     obtain s t where s: "0 < s" and t: "0 < t" and r: "r = s + t"
       using \<open>0 < r\<close> by (rule obtain_pos_sum)
     obtain j where j: "\<forall>n\<ge>j. \<bar>X n - Y n\<bar> < s"
       using vanishesD [OF XY s] ..
     have "\<forall>n\<ge>max i j. t < Y n"
     proof clarsimp
       fix n
       assume n: "i \<le> n" "j \<le> n"
       have "\<bar>X n - Y n\<bar> < s" and "r < X n"
         using i j n by simp_all
       then show "t < Y n" by (simp add: r)
     qed
     then show ?thesis using t by blast
   qed
   fix X Y assume "realrel X Y"
   then have "realrel X Y" and "realrel Y X"
     using symp_realrel by (auto simp: symp_def)
   then show "?thesis X Y"
     by (safe elim!: 1)
 qed
 
 lemma positive_Real: "cauchy X \<Longrightarrow> positive (Real X) \<longleftrightarrow> (\<exists>r>0. \<exists>k. \<forall>n\<ge>k. r < X n)"
   using positive.transfer by (simp add: cr_real_eq rel_fun_def)
 
 lemma positive_zero: "\<not> positive 0"
   by transfer auto
 
 lemma positive_add: 
   assumes "positive x" "positive y" shows "positive (x + y)"
 proof -
   have *: "\<lbrakk>\<forall>n\<ge>i. a < x n; \<forall>n\<ge>j. b < y n; 0 < a; 0 < b; n \<ge> max i j\<rbrakk>
        \<Longrightarrow> a+b < x n + y n" for x y and a b::rat and i j n::nat
     by (simp add: add_strict_mono)
   show ?thesis
     using assms
     by transfer (blast intro: * pos_add_strict)
 qed
 
 lemma positive_mult: 
   assumes "positive x" "positive y" shows "positive (x * y)"
 proof -
   have *: "\<lbrakk>\<forall>n\<ge>i. a < x n; \<forall>n\<ge>j. b < y n; 0 < a; 0 < b; n \<ge> max i j\<rbrakk>
        \<Longrightarrow> a*b < x n * y n" for x y and a b::rat and i j n::nat
     by (simp add: mult_strict_mono')
   show ?thesis
     using assms
     by transfer (blast intro: *  mult_pos_pos)
 qed
 
 lemma positive_minus: "\<not> positive x \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> positive (- x)"
   apply transfer
   apply (simp add: realrel_def)
   apply (blast dest: cauchy_not_vanishes_cases)
   done
 
 instantiation real :: linordered_field
 begin
 
 definition "x < y \<longleftrightarrow> positive (y - x)"
 
 definition "x \<le> y \<longleftrightarrow> x < y \<or> x = y" for x y :: real
 
 definition "\<bar>a\<bar> = (if a < 0 then - a else a)" for a :: real
 
 definition "sgn a = (if a = 0 then 0 else if 0 < a then 1 else - 1)" for a :: real
 
 instance
 proof
   fix a b c :: real
   show "\<bar>a\<bar> = (if a < 0 then - a else a)"
     by (rule abs_real_def)
   show "a < b \<longleftrightarrow> a \<le> b \<and> \<not> b \<le> a"
        "a \<le> b \<Longrightarrow> b \<le> c \<Longrightarrow> a \<le> c"  "a \<le> a" 
        "a \<le> b \<Longrightarrow> b \<le> a \<Longrightarrow> a = b"
        "a \<le> b \<Longrightarrow> c + a \<le> c + b"
     unfolding less_eq_real_def less_real_def
     by (force simp add: positive_zero dest: positive_add)+
   show "sgn a = (if a = 0 then 0 else if 0 < a then 1 else - 1)"
     by (rule sgn_real_def)
   show "a \<le> b \<or> b \<le> a"
     by (auto dest!: positive_minus simp: less_eq_real_def less_real_def)
   show "a < b \<Longrightarrow> 0 < c \<Longrightarrow> c * a < c * b"
     unfolding less_real_def
     by (force simp add: algebra_simps dest: positive_mult)
 qed
 
 end
 
 instantiation real :: distrib_lattice
 begin
 
 definition "(inf :: real \<Rightarrow> real \<Rightarrow> real) = min"
 
 definition "(sup :: real \<Rightarrow> real \<Rightarrow> real) = max"
 
 instance
   by standard (auto simp add: inf_real_def sup_real_def max_min_distrib2)
 
 end
 
 lemma of_nat_Real: "of_nat x = Real (\<lambda>n. of_nat x)"
   by (induct x) (simp_all add: zero_real_def one_real_def add_Real)
 
 lemma of_int_Real: "of_int x = Real (\<lambda>n. of_int x)"
   by (cases x rule: int_diff_cases) (simp add: of_nat_Real diff_Real)
 
 lemma of_rat_Real: "of_rat x = Real (\<lambda>n. x)"
 proof (induct x)
   case (Fract a b)
   then show ?case 
   apply (simp add: Fract_of_int_quotient of_rat_divide)
   apply (simp add: of_int_Real divide_inverse inverse_Real mult_Real)
   done
 qed
 
 instance real :: archimedean_field
 proof
   show "\<exists>z. x \<le> of_int z" for x :: real
   proof (induct x)
     case (1 X)
     then obtain b where "0 < b" and b: "\<And>n. \<bar>X n\<bar> < b"
       by (blast dest: cauchy_imp_bounded)
     then have "Real X < of_int (\<lceil>b\<rceil> + 1)"
       using 1
       apply (simp add: of_int_Real less_real_def diff_Real positive_Real)
       apply (rule_tac x=1 in exI)
       apply (simp add: algebra_simps)
       by (metis abs_ge_self le_less_trans le_of_int_ceiling less_le)
     then show ?case
       using less_eq_real_def by blast 
   qed
 qed
 
 instantiation real :: floor_ceiling
 begin
 
 definition [code del]: "\<lfloor>x::real\<rfloor> = (THE z. of_int z \<le> x \<and> x < of_int (z + 1))"
 
 instance
 proof
   show "of_int \<lfloor>x\<rfloor> \<le> x \<and> x < of_int (\<lfloor>x\<rfloor> + 1)" for x :: real
     unfolding floor_real_def using floor_exists1 by (rule theI')
 qed
 
 end
 
 
 subsection \<open>Completeness\<close>
 
 lemma not_positive_Real: 
   assumes "cauchy X" shows "\<not> positive (Real X) \<longleftrightarrow> (\<forall>r>0. \<exists>k. \<forall>n\<ge>k. X n \<le> r)" (is "?lhs = ?rhs")
   unfolding positive_Real [OF assms]
 proof (intro iffI allI notI impI)
   show "\<exists>k. \<forall>n\<ge>k. X n \<le> r" if r: "\<not> (\<exists>r>0. \<exists>k. \<forall>n\<ge>k. r < X n)" and "0 < r" for r
   proof -
     obtain s t where "s > 0" "t > 0" "r = s+t"
       using \<open>r > 0\<close> obtain_pos_sum by blast
     obtain k where k: "\<And>m n. \<lbrakk>m\<ge>k; n\<ge>k\<rbrakk> \<Longrightarrow> \<bar>X m - X n\<bar> < t"
       using cauchyD [OF assms \<open>t > 0\<close>] by blast
     obtain n where "n \<ge> k" "X n \<le> s"
       by (meson r \<open>0 < s\<close> not_less)
     then have "X l \<le> r" if "l \<ge> n" for l
       using k [OF \<open>n \<ge> k\<close>, of l] that \<open>r = s+t\<close> by linarith
     then show ?thesis
       by blast
     qed
 qed (meson le_cases not_le)
 
 lemma le_Real:
   assumes "cauchy X" "cauchy Y"
   shows "Real X \<le> Real Y = (\<forall>r>0. \<exists>k. \<forall>n\<ge>k. X n \<le> Y n + r)"
   unfolding not_less [symmetric, where 'a=real] less_real_def
   apply (simp add: diff_Real not_positive_Real assms)
   apply (simp add: diff_le_eq ac_simps)
   done
 
 lemma le_RealI:
   assumes Y: "cauchy Y"
   shows "\<forall>n. x \<le> of_rat (Y n) \<Longrightarrow> x \<le> Real Y"
 proof (induct x)
   fix X
   assume X: "cauchy X" and "\<forall>n. Real X \<le> of_rat (Y n)"
   then have le: "\<And>m r. 0 < r \<Longrightarrow> \<exists>k. \<forall>n\<ge>k. X n \<le> Y m + r"
     by (simp add: of_rat_Real le_Real)
   then have "\<exists>k. \<forall>n\<ge>k. X n \<le> Y n + r" if "0 < r" for r :: rat
   proof -
     from that obtain s t where s: "0 < s" and t: "0 < t" and r: "r = s + t"
       by (rule obtain_pos_sum)
     obtain i where i: "\<forall>m\<ge>i. \<forall>n\<ge>i. \<bar>Y m - Y n\<bar> < s"
       using cauchyD [OF Y s] ..
     obtain j where j: "\<forall>n\<ge>j. X n \<le> Y i + t"
       using le [OF t] ..
     have "\<forall>n\<ge>max i j. X n \<le> Y n + r"
     proof clarsimp
       fix n
       assume n: "i \<le> n" "j \<le> n"
       have "X n \<le> Y i + t"
         using n j by simp
       moreover have "\<bar>Y i - Y n\<bar> < s"
         using n i by simp
       ultimately show "X n \<le> Y n + r"
         unfolding r by simp
     qed
     then show ?thesis ..
   qed
   then show "Real X \<le> Real Y"
     by (simp add: of_rat_Real le_Real X Y)
 qed
 
 lemma Real_leI:
   assumes X: "cauchy X"
   assumes le: "\<forall>n. of_rat (X n) \<le> y"
   shows "Real X \<le> y"
 proof -
   have "- y \<le> - Real X"
     by (simp add: minus_Real X le_RealI of_rat_minus le)
   then show ?thesis by simp
 qed
 
 lemma less_RealD:
   assumes "cauchy Y"
   shows "x < Real Y \<Longrightarrow> \<exists>n. x < of_rat (Y n)"
   apply (erule contrapos_pp)
   apply (simp add: not_less)
   apply (erule Real_leI [OF assms])
   done
 
 lemma of_nat_less_two_power [simp]: "of_nat n < (2::'a::linordered_idom) ^ n"
   apply (induct n)
    apply simp
   apply (metis add_le_less_mono mult_2 of_nat_Suc one_le_numeral one_le_power power_Suc)
   done
 
 lemma complete_real:
   fixes S :: "real set"
   assumes "\<exists>x. x \<in> S" and "\<exists>z. \<forall>x\<in>S. x \<le> z"
   shows "\<exists>y. (\<forall>x\<in>S. x \<le> y) \<and> (\<forall>z. (\<forall>x\<in>S. x \<le> z) \<longrightarrow> y \<le> z)"
 proof -
   obtain x where x: "x \<in> S" using assms(1) ..
   obtain z where z: "\<forall>x\<in>S. x \<le> z" using assms(2) ..
 
   define P where "P x \<longleftrightarrow> (\<forall>y\<in>S. y \<le> of_rat x)" for x
   obtain a where a: "\<not> P a"
   proof
     have "of_int \<lfloor>x - 1\<rfloor> \<le> x - 1" by (rule of_int_floor_le)
     also have "x - 1 < x" by simp
     finally have "of_int \<lfloor>x - 1\<rfloor> < x" .
     then have "\<not> x \<le> of_int \<lfloor>x - 1\<rfloor>" by (simp only: not_le)
     then show "\<not> P (of_int \<lfloor>x - 1\<rfloor>)"
       unfolding P_def of_rat_of_int_eq using x by blast
   qed
   obtain b where b: "P b"
   proof
     show "P (of_int \<lceil>z\<rceil>)"
     unfolding P_def of_rat_of_int_eq
     proof
       fix y assume "y \<in> S"
       then have "y \<le> z" using z by simp
       also have "z \<le> of_int \<lceil>z\<rceil>" by (rule le_of_int_ceiling)
       finally show "y \<le> of_int \<lceil>z\<rceil>" .
     qed
   qed
 
   define avg where "avg x y = x/2 + y/2" for x y :: rat
   define bisect where "bisect = (\<lambda>(x, y). if P (avg x y) then (x, avg x y) else (avg x y, y))"
   define A where "A n = fst ((bisect ^^ n) (a, b))" for n
   define B where "B n = snd ((bisect ^^ n) (a, b))" for n
   define C where "C n = avg (A n) (B n)" for n
   have A_0 [simp]: "A 0 = a" unfolding A_def by simp
   have B_0 [simp]: "B 0 = b" unfolding B_def by simp
   have A_Suc [simp]: "\<And>n. A (Suc n) = (if P (C n) then A n else C n)"
     unfolding A_def B_def C_def bisect_def split_def by simp
   have B_Suc [simp]: "\<And>n. B (Suc n) = (if P (C n) then C n else B n)"
     unfolding A_def B_def C_def bisect_def split_def by simp
 
   have width: "B n - A n = (b - a) / 2^n" for n
   proof (induct n)
     case (Suc n)
     then show ?case
       by (simp add: C_def eq_divide_eq avg_def algebra_simps)
   qed simp
   have twos: "\<exists>n. y / 2 ^ n < r" if "0 < r" for y r :: rat
   proof -
     obtain n where "y / r < rat_of_nat n"
       using \<open>0 < r\<close> reals_Archimedean2 by blast
     then have "\<exists>n. y < r * 2 ^ n"
       by (metis divide_less_eq less_trans mult.commute of_nat_less_two_power that)
     then show ?thesis
       by (simp add: field_split_simps)
   qed
   have PA: "\<not> P (A n)" for n
     by (induct n) (simp_all add: a)
   have PB: "P (B n)" for n
     by (induct n) (simp_all add: b)
   have ab: "a < b"
     using a b unfolding P_def
     by (meson leI less_le_trans of_rat_less)
   have AB: "A n < B n" for n
     by (induct n) (simp_all add: ab C_def avg_def)
   have  "A i \<le> A j \<and>  B j \<le> B i" if "i < j" for i j
     using that
   proof (induction rule: less_Suc_induct)
     case (1 i)
     then show ?case
       apply (clarsimp simp add: C_def avg_def add_divide_distrib [symmetric])
       apply (rule AB [THEN less_imp_le])
       done  
   qed simp
   then have A_mono: "A i \<le> A j" and B_mono: "B j \<le> B i" if "i \<le> j" for i j
     by (metis eq_refl le_neq_implies_less that)+
   have cauchy_lemma: "cauchy X" if *: "\<And>n i. i\<ge>n \<Longrightarrow> A n \<le> X i \<and> X i \<le> B n" for X
   proof (rule cauchyI)
     fix r::rat
     assume "0 < r"
     then obtain k where k: "(b - a) / 2 ^ k < r"
       using twos by blast
     have "\<bar>X m - X n\<bar> < r" if "m\<ge>k" "n\<ge>k" for m n
     proof -
       have "\<bar>X m - X n\<bar> \<le> B k - A k"
         by (simp add: * abs_rat_def diff_mono that)
       also have "... < r"
         by (simp add: k width)
       finally show ?thesis .
     qed
     then show "\<exists>k. \<forall>m\<ge>k. \<forall>n\<ge>k. \<bar>X m - X n\<bar> < r"
       by blast 
   qed
   have "cauchy A"
     by (rule cauchy_lemma) (meson AB A_mono B_mono dual_order.strict_implies_order less_le_trans)
   have "cauchy B"
     by (rule cauchy_lemma) (meson AB A_mono B_mono dual_order.strict_implies_order le_less_trans)
   have "\<forall>x\<in>S. x \<le> Real B"
   proof
     fix x
     assume "x \<in> S"
     then show "x \<le> Real B"
       using PB [unfolded P_def] \<open>cauchy B\<close>
       by (simp add: le_RealI)
   qed
   moreover have "\<forall>z. (\<forall>x\<in>S. x \<le> z) \<longrightarrow> Real A \<le> z"
     by (meson PA Real_leI P_def \<open>cauchy A\<close> le_cases order.trans)
   moreover have "vanishes (\<lambda>n. (b - a) / 2 ^ n)"
   proof (rule vanishesI)
     fix r :: rat
     assume "0 < r"
     then obtain k where k: "\<bar>b - a\<bar> / 2 ^ k < r"
       using twos by blast
     have "\<forall>n\<ge>k. \<bar>(b - a) / 2 ^ n\<bar> < r"
     proof clarify
       fix n
       assume n: "k \<le> n"
       have "\<bar>(b - a) / 2 ^ n\<bar> = \<bar>b - a\<bar> / 2 ^ n"
         by simp
       also have "\<dots> \<le> \<bar>b - a\<bar> / 2 ^ k"
         using n by (simp add: divide_left_mono)
       also note k
       finally show "\<bar>(b - a) / 2 ^ n\<bar> < r" .
     qed
     then show "\<exists>k. \<forall>n\<ge>k. \<bar>(b - a) / 2 ^ n\<bar> < r" ..
   qed
   then have "Real B = Real A"
     by (simp add: eq_Real \<open>cauchy A\<close> \<open>cauchy B\<close> width)
   ultimately show "\<exists>y. (\<forall>x\<in>S. x \<le> y) \<and> (\<forall>z. (\<forall>x\<in>S. x \<le> z) \<longrightarrow> y \<le> z)"
     by force
 qed
 
 instantiation real :: linear_continuum
 begin
 
 subsection \<open>Supremum of a set of reals\<close>
 
 definition "Sup X = (LEAST z::real. \<forall>x\<in>X. x \<le> z)"
 definition "Inf X = - Sup (uminus ` X)" for X :: "real set"
 
 instance
 proof
   show Sup_upper: "x \<le> Sup X"
     if "x \<in> X" "bdd_above X"
     for x :: real and X :: "real set"
   proof -
     from that obtain s where s: "\<forall>y\<in>X. y \<le> s" "\<And>z. \<forall>y\<in>X. y \<le> z \<Longrightarrow> s \<le> z"
       using complete_real[of X] unfolding bdd_above_def by blast
     then show ?thesis
       unfolding Sup_real_def by (rule LeastI2_order) (auto simp: that)
   qed
   show Sup_least: "Sup X \<le> z"
     if "X \<noteq> {}" and z: "\<And>x. x \<in> X \<Longrightarrow> x \<le> z"
     for z :: real and X :: "real set"
   proof -
     from that obtain s where s: "\<forall>y\<in>X. y \<le> s" "\<And>z. \<forall>y\<in>X. y \<le> z \<Longrightarrow> s \<le> z"
       using complete_real [of X] by blast
     then have "Sup X = s"
       unfolding Sup_real_def by (best intro: Least_equality)
     also from s z have "\<dots> \<le> z"
       by blast
     finally show ?thesis .
   qed
   show "Inf X \<le> x" if "x \<in> X" "bdd_below X"
     for x :: real and X :: "real set"
     using Sup_upper [of "-x" "uminus ` X"] by (auto simp: Inf_real_def that)
   show "z \<le> Inf X" if "X \<noteq> {}" "\<And>x. x \<in> X \<Longrightarrow> z \<le> x"
     for z :: real and X :: "real set"
     using Sup_least [of "uminus ` X" "- z"] by (force simp: Inf_real_def that)
   show "\<exists>a b::real. a \<noteq> b"
     using zero_neq_one by blast
 qed
 
 end
 
 
 subsection \<open>Hiding implementation details\<close>
 
 hide_const (open) vanishes cauchy positive Real
 
 declare Real_induct [induct del]
 declare Abs_real_induct [induct del]
 declare Abs_real_cases [cases del]
 
 lifting_update real.lifting
 lifting_forget real.lifting
 
 
 subsection \<open>More Lemmas\<close>
 
 text \<open>BH: These lemmas should not be necessary; they should be
   covered by existing simp rules and simplification procedures.\<close>
 
 lemma real_mult_less_iff1 [simp]: "0 < z \<Longrightarrow> x * z < y * z \<longleftrightarrow> x < y"
   for x y z :: real
   by simp (* solved by linordered_ring_less_cancel_factor simproc *)
 
 lemma real_mult_le_cancel_iff1 [simp]: "0 < z \<Longrightarrow> x * z \<le> y * z \<longleftrightarrow> x \<le> y"
   for x y z :: real
   by simp (* solved by linordered_ring_le_cancel_factor simproc *)
 
 lemma real_mult_le_cancel_iff2 [simp]: "0 < z \<Longrightarrow> z * x \<le> z * y \<longleftrightarrow> x \<le> y"
   for x y z :: real
   by simp (* solved by linordered_ring_le_cancel_factor simproc *)
 
 
 subsection \<open>Embedding numbers into the Reals\<close>
 
 abbreviation real_of_nat :: "nat \<Rightarrow> real"
   where "real_of_nat \<equiv> of_nat"
 
 abbreviation real :: "nat \<Rightarrow> real"
   where "real \<equiv> of_nat"
 
 abbreviation real_of_int :: "int \<Rightarrow> real"
   where "real_of_int \<equiv> of_int"
 
 abbreviation real_of_rat :: "rat \<Rightarrow> real"
   where "real_of_rat \<equiv> of_rat"
 
 declare [[coercion_enabled]]
 
 declare [[coercion "of_nat :: nat \<Rightarrow> int"]]
 declare [[coercion "of_nat :: nat \<Rightarrow> real"]]
 declare [[coercion "of_int :: int \<Rightarrow> real"]]
 
 (* We do not add rat to the coerced types, this has often unpleasant side effects when writing
 inverse (Suc n) which sometimes gets two coercions: of_rat (inverse (of_nat (Suc n))) *)
 
 declare [[coercion_map map]]
 declare [[coercion_map "\<lambda>f g h x. g (h (f x))"]]
 declare [[coercion_map "\<lambda>f g (x,y). (f x, g y)"]]
 
 declare of_int_eq_0_iff [algebra, presburger]
 declare of_int_eq_1_iff [algebra, presburger]
 declare of_int_eq_iff [algebra, presburger]
 declare of_int_less_0_iff [algebra, presburger]
 declare of_int_less_1_iff [algebra, presburger]
 declare of_int_less_iff [algebra, presburger]
 declare of_int_le_0_iff [algebra, presburger]
 declare of_int_le_1_iff [algebra, presburger]
 declare of_int_le_iff [algebra, presburger]
 declare of_int_0_less_iff [algebra, presburger]
 declare of_int_0_le_iff [algebra, presburger]
 declare of_int_1_less_iff [algebra, presburger]
 declare of_int_1_le_iff [algebra, presburger]
 
 lemma int_less_real_le: "n < m \<longleftrightarrow> real_of_int n + 1 \<le> real_of_int m"
 proof -
   have "(0::real) \<le> 1"
     by (metis less_eq_real_def zero_less_one)
   then show ?thesis
     by (metis floor_of_int less_floor_iff)
 qed
 
 lemma int_le_real_less: "n \<le> m \<longleftrightarrow> real_of_int n < real_of_int m + 1"
   by (meson int_less_real_le not_le)
 
 lemma real_of_int_div_aux:
   "(real_of_int x) / (real_of_int d) =
     real_of_int (x div d) + (real_of_int (x mod d)) / (real_of_int d)"
 proof -
   have "x = (x div d) * d + x mod d"
     by auto
   then have "real_of_int x = real_of_int (x div d) * real_of_int d + real_of_int(x mod d)"
     by (metis of_int_add of_int_mult)
   then have "real_of_int x / real_of_int d = \<dots> / real_of_int d"
     by simp
   then show ?thesis
     by (auto simp add: add_divide_distrib algebra_simps)
 qed
 
 lemma real_of_int_div:
   "d dvd n \<Longrightarrow> real_of_int (n div d) = real_of_int n / real_of_int d" for d n :: int
   by (simp add: real_of_int_div_aux)
 
 lemma real_of_int_div2: "0 \<le> real_of_int n / real_of_int x - real_of_int (n div x)"
 proof (cases "x = 0")
   case False
   then show ?thesis
     by (metis diff_ge_0_iff_ge floor_divide_of_int_eq of_int_floor_le)
 qed simp
 
 lemma real_of_int_div3: "real_of_int n / real_of_int x - real_of_int (n div x) \<le> 1"
   apply (simp add: algebra_simps)
   by (metis add.commute floor_correct floor_divide_of_int_eq less_eq_real_def of_int_1 of_int_add)
 
 lemma real_of_int_div4: "real_of_int (n div x) \<le> real_of_int n / real_of_int x"
   using real_of_int_div2 [of n x] by simp
 
 
 subsection \<open>Embedding the Naturals into the Reals\<close>
 
 lemma real_of_card: "real (card A) = sum (\<lambda>x. 1) A"
   by simp
 
 lemma nat_less_real_le: "n < m \<longleftrightarrow> real n + 1 \<le> real m"
   by (metis discrete of_nat_1 of_nat_add of_nat_le_iff)
 
 lemma nat_le_real_less: "n \<le> m \<longleftrightarrow> real n < real m + 1"
   for m n :: nat
   by (meson nat_less_real_le not_le)
 
 lemma real_of_nat_div_aux: "real x / real d = real (x div d) + real (x mod d) / real d"
 proof -
   have "x = (x div d) * d + x mod d"
     by auto
   then have "real x = real (x div d) * real d + real(x mod d)"
     by (metis of_nat_add of_nat_mult)
   then have "real x / real d = \<dots> / real d"
     by simp
   then show ?thesis
     by (auto simp add: add_divide_distrib algebra_simps)
 qed
 
 lemma real_of_nat_div: "d dvd n \<Longrightarrow> real(n div d) = real n / real d"
   by (subst real_of_nat_div_aux) (auto simp add: dvd_eq_mod_eq_0 [symmetric])
 
 lemma real_of_nat_div2: "0 \<le> real n / real x - real (n div x)" for n x :: nat
   apply (simp add: algebra_simps)
   by (metis floor_divide_of_nat_eq of_int_floor_le of_int_of_nat_eq)
 
 lemma real_of_nat_div3: "real n / real x - real (n div x) \<le> 1" for n x :: nat
 proof (cases "x = 0")
   case False
   then show ?thesis
     by (metis of_int_of_nat_eq real_of_int_div3 zdiv_int)
 qed auto
 
 lemma real_of_nat_div4: "real (n div x) \<le> real n / real x" for n x :: nat
   using real_of_nat_div2 [of n x] by simp
 
 
 subsection \<open>The Archimedean Property of the Reals\<close>
 
 lemma real_arch_inverse: "0 < e \<longleftrightarrow> (\<exists>n::nat. n \<noteq> 0 \<and> 0 < inverse (real n) \<and> inverse (real n) < e)"
   using reals_Archimedean[of e] less_trans[of 0 "1 / real n" e for n::nat]
   by (auto simp add: field_simps cong: conj_cong simp del: of_nat_Suc)
 
 lemma reals_Archimedean3: "0 < x \<Longrightarrow> \<forall>y. \<exists>n. y < real n * x"
   by (auto intro: ex_less_of_nat_mult)
 
 lemma real_archimedian_rdiv_eq_0:
   assumes x0: "x \<ge> 0"
     and c: "c \<ge> 0"
     and xc: "\<And>m::nat. m > 0 \<Longrightarrow> real m * x \<le> c"
   shows "x = 0"
   by (metis reals_Archimedean3 dual_order.order_iff_strict le0 le_less_trans not_le x0 xc)
 
 
 subsection \<open>Rationals\<close>
 
 lemma Rats_abs_iff[simp]:
   "\<bar>(x::real)\<bar> \<in> \<rat> \<longleftrightarrow> x \<in> \<rat>"
 by(simp add: abs_real_def split: if_splits)
 
 lemma Rats_eq_int_div_int: "\<rat> = {real_of_int i / real_of_int j | i j. j \<noteq> 0}"  (is "_ = ?S")
 proof
   show "\<rat> \<subseteq> ?S"
   proof
     fix x :: real
     assume "x \<in> \<rat>"
     then obtain r where "x = of_rat r"
       unfolding Rats_def ..
     have "of_rat r \<in> ?S"
       by (cases r) (auto simp add: of_rat_rat)
     then show "x \<in> ?S"
       using \<open>x = of_rat r\<close> by simp
   qed
 next
   show "?S \<subseteq> \<rat>"
   proof (auto simp: Rats_def)
     fix i j :: int
     assume "j \<noteq> 0"
     then have "real_of_int i / real_of_int j = of_rat (Fract i j)"
       by (simp add: of_rat_rat)
     then show "real_of_int i / real_of_int j \<in> range of_rat"
       by blast
   qed
 qed
 
 lemma Rats_eq_int_div_nat: "\<rat> = { real_of_int i / real n | i n. n \<noteq> 0}"
 proof (auto simp: Rats_eq_int_div_int)
   fix i j :: int
   assume "j \<noteq> 0"
   show "\<exists>(i'::int) (n::nat). real_of_int i / real_of_int j = real_of_int i' / real n \<and> 0 < n"
   proof (cases "j > 0")
     case True
     then have "real_of_int i / real_of_int j = real_of_int i / real (nat j) \<and> 0 < nat j"
       by simp
     then show ?thesis by blast
   next
     case False
     with \<open>j \<noteq> 0\<close>
     have "real_of_int i / real_of_int j = real_of_int (- i) / real (nat (- j)) \<and> 0 < nat (- j)"
       by simp
     then show ?thesis by blast
   qed
 next
   fix i :: int and n :: nat
   assume "0 < n"
   then have "real_of_int i / real n = real_of_int i / real_of_int(int n) \<and> int n \<noteq> 0"
     by simp
   then show "\<exists>i' j. real_of_int i / real n = real_of_int i' / real_of_int j \<and> j \<noteq> 0"
     by blast
 qed
 
 lemma Rats_abs_nat_div_natE:
   assumes "x \<in> \<rat>"
   obtains m n :: nat where "n \<noteq> 0" and "\<bar>x\<bar> = real m / real n" and "coprime m n"
 proof -
   from \<open>x \<in> \<rat>\<close> obtain i :: int and n :: nat where "n \<noteq> 0" and "x = real_of_int i / real n"
     by (auto simp add: Rats_eq_int_div_nat)
   then have "\<bar>x\<bar> = real (nat \<bar>i\<bar>) / real n" by simp
   then obtain m :: nat where x_rat: "\<bar>x\<bar> = real m / real n" by blast
   let ?gcd = "gcd m n"
   from \<open>n \<noteq> 0\<close> have gcd: "?gcd \<noteq> 0" by simp
   let ?k = "m div ?gcd"
   let ?l = "n div ?gcd"
   let ?gcd' = "gcd ?k ?l"
   have "?gcd dvd m" ..
   then have gcd_k: "?gcd * ?k = m"
     by (rule dvd_mult_div_cancel)
   have "?gcd dvd n" ..
   then have gcd_l: "?gcd * ?l = n"
     by (rule dvd_mult_div_cancel)
   from \<open>n \<noteq> 0\<close> and gcd_l have "?gcd * ?l \<noteq> 0" by simp
   then have "?l \<noteq> 0" by (blast dest!: mult_not_zero)
   moreover
   have "\<bar>x\<bar> = real ?k / real ?l"
   proof -
     from gcd have "real ?k / real ?l = real (?gcd * ?k) / real (?gcd * ?l)"
       by (simp add: real_of_nat_div)
     also from gcd_k and gcd_l have "\<dots> = real m / real n" by simp
     also from x_rat have "\<dots> = \<bar>x\<bar>" ..
     finally show ?thesis ..
   qed
   moreover
   have "?gcd' = 1"
   proof -
     have "?gcd * ?gcd' = gcd (?gcd * ?k) (?gcd * ?l)"
       by (rule gcd_mult_distrib_nat)
     with gcd_k gcd_l have "?gcd * ?gcd' = ?gcd" by simp
     with gcd show ?thesis by auto
   qed
   then have "coprime ?k ?l"
     by (simp only: coprime_iff_gcd_eq_1)
   ultimately show ?thesis ..
 qed
 
 
 subsection \<open>Density of the Rational Reals in the Reals\<close>
 
 text \<open>
   This density proof is due to Stefan Richter and was ported by TN.  The
   original source is \<^emph>\<open>Real Analysis\<close> by H.L. Royden.
   It employs the Archimedean property of the reals.\<close>
 
 lemma Rats_dense_in_real:
   fixes x :: real
   assumes "x < y"
   shows "\<exists>r\<in>\<rat>. x < r \<and> r < y"
 proof -
   from \<open>x < y\<close> have "0 < y - x" by simp
   with reals_Archimedean obtain q :: nat where q: "inverse (real q) < y - x" and "0 < q"
     by blast
   define p where "p = \<lceil>y * real q\<rceil> - 1"
   define r where "r = of_int p / real q"
   from q have "x < y - inverse (real q)"
     by simp
   also from \<open>0 < q\<close> have "y - inverse (real q) \<le> r"
     by (simp add: r_def p_def le_divide_eq left_diff_distrib)
   finally have "x < r" .
   moreover from \<open>0 < q\<close> have "r < y"
     by (simp add: r_def p_def divide_less_eq diff_less_eq less_ceiling_iff [symmetric])
   moreover have "r \<in> \<rat>"
     by (simp add: r_def)
   ultimately show ?thesis by blast
 qed
 
 lemma of_rat_dense:
   fixes x y :: real
   assumes "x < y"
   shows "\<exists>q :: rat. x < of_rat q \<and> of_rat q < y"
   using Rats_dense_in_real [OF \<open>x < y\<close>]
   by (auto elim: Rats_cases)
 
 
 subsection \<open>Numerals and Arithmetic\<close>
 
 declaration \<open>
   K (Lin_Arith.add_inj_const (\<^const_name>\<open>of_nat\<close>, \<^typ>\<open>nat \<Rightarrow> real\<close>)
   #> Lin_Arith.add_inj_const (\<^const_name>\<open>of_int\<close>, \<^typ>\<open>int \<Rightarrow> real\<close>))
 \<close>
 
 
 subsection \<open>Simprules combining \<open>x + y\<close> and \<open>0\<close>\<close> (* FIXME ARE THEY NEEDED? *)
 
 lemma real_add_minus_iff [simp]: "x + - a = 0 \<longleftrightarrow> x = a"
   for x a :: real
   by arith
 
 lemma real_add_less_0_iff: "x + y < 0 \<longleftrightarrow> y < - x"
   for x y :: real
   by auto
 
 lemma real_0_less_add_iff: "0 < x + y \<longleftrightarrow> - x < y"
   for x y :: real
   by auto
 
 lemma real_add_le_0_iff: "x + y \<le> 0 \<longleftrightarrow> y \<le> - x"
   for x y :: real
   by auto
 
 lemma real_0_le_add_iff: "0 \<le> x + y \<longleftrightarrow> - x \<le> y"
   for x y :: real
   by auto
 
 
 subsection \<open>Lemmas about powers\<close>
 
 lemma two_realpow_ge_one: "(1::real) \<le> 2 ^ n"
   by simp
 
 (* FIXME: declare this [simp] for all types, or not at all *)
 declare sum_squares_eq_zero_iff [simp] sum_power2_eq_zero_iff [simp]
 
 lemma real_minus_mult_self_le [simp]: "- (u * u) \<le> x * x"
   for u x :: real
   by (rule order_trans [where y = 0]) auto
 
 lemma realpow_square_minus_le [simp]: "- u\<^sup>2 \<le> x\<^sup>2"
   for u x :: real
   by (auto simp add: power2_eq_square)
 
 
 subsection \<open>Density of the Reals\<close>
 
 lemma field_lbound_gt_zero: "0 < d1 \<Longrightarrow> 0 < d2 \<Longrightarrow> \<exists>e. 0 < e \<and> e < d1 \<and> e < d2"
   for d1 d2 :: "'a::linordered_field"
   by (rule exI [where x = "min d1 d2 / 2"]) (simp add: min_def)
 
 lemma field_less_half_sum: "x < y \<Longrightarrow> x < (x + y) / 2"
   for x y :: "'a::linordered_field"
   by auto
 
 lemma field_sum_of_halves: "x / 2 + x / 2 = x"
   for x :: "'a::linordered_field"
   by simp
 
 
+subsection \<open>Archimedean properties and useful consequences\<close>
+
+text\<open>Bernoulli's inequality\<close>
+proposition Bernoulli_inequality:
+  fixes x :: real
+  assumes "-1 \<le> x"
+    shows "1 + n * x \<le> (1 + x) ^ n"
+proof (induct n)
+  case 0
+  then show ?case by simp
+next
+  case (Suc n)
+  have "1 + Suc n * x \<le> 1 + (Suc n)*x + n * x^2"
+    by (simp add: algebra_simps)
+  also have "... = (1 + x) * (1 + n*x)"
+    by (auto simp: power2_eq_square algebra_simps)
+  also have "... \<le> (1 + x) ^ Suc n"
+    using Suc.hyps assms mult_left_mono by fastforce
+  finally show ?case .
+qed
+
+corollary Bernoulli_inequality_even:
+  fixes x :: real
+  assumes "even n"
+    shows "1 + n * x \<le> (1 + x) ^ n"
+proof (cases "-1 \<le> x \<or> n=0")
+  case True
+  then show ?thesis
+    by (auto simp: Bernoulli_inequality)
+next
+  case False
+  then have "real n \<ge> 1"
+    by simp
+  with False have "n * x \<le> -1"
+    by (metis linear minus_zero mult.commute mult.left_neutral mult_left_mono_neg neg_le_iff_le order_trans zero_le_one)
+  then have "1 + n * x \<le> 0"
+    by auto
+  also have "... \<le> (1 + x) ^ n"
+    using assms
+    using zero_le_even_power by blast
+  finally show ?thesis .
+qed
+
+corollary real_arch_pow:
+  fixes x :: real
+  assumes x: "1 < x"
+  shows "\<exists>n. y < x^n"
+proof -
+  from x have x0: "x - 1 > 0"
+    by arith
+  from reals_Archimedean3[OF x0, rule_format, of y]
+  obtain n :: nat where n: "y < real n * (x - 1)" by metis
+  from x0 have x00: "x- 1 \<ge> -1" by arith
+  from Bernoulli_inequality[OF x00, of n] n
+  have "y < x^n" by auto
+  then show ?thesis by metis
+qed
+
+corollary real_arch_pow_inv:
+  fixes x y :: real
+  assumes y: "y > 0"
+    and x1: "x < 1"
+  shows "\<exists>n. x^n < y"
+proof (cases "x > 0")
+  case True
+  with x1 have ix: "1 < 1/x" by (simp add: field_simps)
+  from real_arch_pow[OF ix, of "1/y"]
+  obtain n where n: "1/y < (1/x)^n" by blast
+  then show ?thesis using y \<open>x > 0\<close>
+    by (auto simp add: field_simps)
+next
+  case False
+  with y x1 show ?thesis
+    by (metis less_le_trans not_less power_one_right)
+qed
+
+lemma forall_pos_mono:
+  "(\<And>d e::real. d < e \<Longrightarrow> P d \<Longrightarrow> P e) \<Longrightarrow>
+    (\<And>n::nat. n \<noteq> 0 \<Longrightarrow> P (inverse (real n))) \<Longrightarrow> (\<And>e. 0 < e \<Longrightarrow> P e)"
+  by (metis real_arch_inverse)
+
+lemma forall_pos_mono_1:
+  "(\<And>d e::real. d < e \<Longrightarrow> P d \<Longrightarrow> P e) \<Longrightarrow>
+    (\<And>n. P (inverse (real (Suc n)))) \<Longrightarrow> 0 < e \<Longrightarrow> P e"
+  apply (rule forall_pos_mono)
+  apply auto
+  apply (metis Suc_pred of_nat_Suc)
+  done
+
+
 subsection \<open>Floor and Ceiling Functions from the Reals to the Integers\<close>
 
 (* FIXME: theorems for negative numerals. Many duplicates, e.g. from Archimedean_Field.thy. *)
 
 lemma real_of_nat_less_numeral_iff [simp]: "real n < numeral w \<longleftrightarrow> n < numeral w"
   for n :: nat
   by (metis of_nat_less_iff of_nat_numeral)
 
 lemma numeral_less_real_of_nat_iff [simp]: "numeral w < real n \<longleftrightarrow> numeral w < n"
   for n :: nat
   by (metis of_nat_less_iff of_nat_numeral)
 
 lemma numeral_le_real_of_nat_iff [simp]: "numeral n \<le> real m \<longleftrightarrow> numeral n \<le> m"
   for m :: nat
   by (metis not_le real_of_nat_less_numeral_iff)
 
 lemma of_int_floor_cancel [simp]: "of_int \<lfloor>x\<rfloor> = x \<longleftrightarrow> (\<exists>n::int. x = of_int n)"
   by (metis floor_of_int)
 
 lemma floor_eq: "real_of_int n < x \<Longrightarrow> x < real_of_int n + 1 \<Longrightarrow> \<lfloor>x\<rfloor> = n"
   by linarith
 
 lemma floor_eq2: "real_of_int n \<le> x \<Longrightarrow> x < real_of_int n + 1 \<Longrightarrow> \<lfloor>x\<rfloor> = n"
   by (fact floor_unique)
 
 lemma floor_eq3: "real n < x \<Longrightarrow> x < real (Suc n) \<Longrightarrow> nat \<lfloor>x\<rfloor> = n"
   by linarith
 
 lemma floor_eq4: "real n \<le> x \<Longrightarrow> x < real (Suc n) \<Longrightarrow> nat \<lfloor>x\<rfloor> = n"
   by linarith
 
 lemma real_of_int_floor_ge_diff_one [simp]: "r - 1 \<le> real_of_int \<lfloor>r\<rfloor>"
   by linarith
 
 lemma real_of_int_floor_gt_diff_one [simp]: "r - 1 < real_of_int \<lfloor>r\<rfloor>"
   by linarith
 
 lemma real_of_int_floor_add_one_ge [simp]: "r \<le> real_of_int \<lfloor>r\<rfloor> + 1"
   by linarith
 
 lemma real_of_int_floor_add_one_gt [simp]: "r < real_of_int \<lfloor>r\<rfloor> + 1"
   by linarith
 
 lemma floor_divide_real_eq_div:
   assumes "0 \<le> b"
   shows "\<lfloor>a / real_of_int b\<rfloor> = \<lfloor>a\<rfloor> div b"
 proof (cases "b = 0")
   case True
   then show ?thesis by simp
 next
   case False
   with assms have b: "b > 0" by simp
   have "j = i div b"
     if "real_of_int i \<le> a" "a < 1 + real_of_int i"
       "real_of_int j * real_of_int b \<le> a" "a < real_of_int b + real_of_int j * real_of_int b"
     for i j :: int
   proof -
     from that have "i < b + j * b"
       by (metis le_less_trans of_int_add of_int_less_iff of_int_mult)
     moreover have "j * b < 1 + i"
     proof -
       have "real_of_int (j * b) < real_of_int i + 1"
         using \<open>a < 1 + real_of_int i\<close> \<open>real_of_int j * real_of_int b \<le> a\<close> by force
       then show "j * b < 1 + i" by linarith
     qed
     ultimately have "(j - i div b) * b \<le> i mod b" "i mod b < ((j - i div b) + 1) * b"
       by (auto simp: field_simps)
     then have "(j - i div b) * b < 1 * b" "0 * b < ((j - i div b) + 1) * b"
       using pos_mod_bound [OF b, of i] pos_mod_sign [OF b, of i]
       by linarith+
     then show ?thesis using b unfolding mult_less_cancel_right by auto
   qed
   with b show ?thesis by (auto split: floor_split simp: field_simps)
 qed
 
 lemma floor_one_divide_eq_div_numeral [simp]:
   "\<lfloor>1 / numeral b::real\<rfloor> = 1 div numeral b"
 by (metis floor_divide_of_int_eq of_int_1 of_int_numeral)
 
 lemma floor_minus_one_divide_eq_div_numeral [simp]:
   "\<lfloor>- (1 / numeral b)::real\<rfloor> = - 1 div numeral b"
 by (metis (mono_tags, hide_lams) div_minus_right minus_divide_right
     floor_divide_of_int_eq of_int_neg_numeral of_int_1)
 
 lemma floor_divide_eq_div_numeral [simp]:
   "\<lfloor>numeral a / numeral b::real\<rfloor> = numeral a div numeral b"
 by (metis floor_divide_of_int_eq of_int_numeral)
 
 lemma floor_minus_divide_eq_div_numeral [simp]:
   "\<lfloor>- (numeral a / numeral b)::real\<rfloor> = - numeral a div numeral b"
 by (metis divide_minus_left floor_divide_of_int_eq of_int_neg_numeral of_int_numeral)
 
 lemma of_int_ceiling_cancel [simp]: "of_int \<lceil>x\<rceil> = x \<longleftrightarrow> (\<exists>n::int. x = of_int n)"
   using ceiling_of_int by metis
 
 lemma ceiling_eq: "of_int n < x \<Longrightarrow> x \<le> of_int n + 1 \<Longrightarrow> \<lceil>x\<rceil> = n + 1"
   by (simp add: ceiling_unique)
 
 lemma of_int_ceiling_diff_one_le [simp]: "of_int \<lceil>r\<rceil> - 1 \<le> r"
   by linarith
 
 lemma of_int_ceiling_le_add_one [simp]: "of_int \<lceil>r\<rceil> \<le> r + 1"
   by linarith
 
 lemma ceiling_le: "x \<le> of_int a \<Longrightarrow> \<lceil>x\<rceil> \<le> a"
   by (simp add: ceiling_le_iff)
 
 lemma ceiling_divide_eq_div: "\<lceil>of_int a / of_int b\<rceil> = - (- a div b)"
   by (metis ceiling_def floor_divide_of_int_eq minus_divide_left of_int_minus)
 
 lemma ceiling_divide_eq_div_numeral [simp]:
   "\<lceil>numeral a / numeral b :: real\<rceil> = - (- numeral a div numeral b)"
   using ceiling_divide_eq_div[of "numeral a" "numeral b"] by simp
 
 lemma ceiling_minus_divide_eq_div_numeral [simp]:
   "\<lceil>- (numeral a / numeral b :: real)\<rceil> = - (numeral a div numeral b)"
   using ceiling_divide_eq_div[of "- numeral a" "numeral b"] by simp
 
 text \<open>
   The following lemmas are remnants of the erstwhile functions natfloor
   and natceiling.
 \<close>
 
 lemma nat_floor_neg: "x \<le> 0 \<Longrightarrow> nat \<lfloor>x\<rfloor> = 0"
   for x :: real
   by linarith
 
 lemma le_nat_floor: "real x \<le> a \<Longrightarrow> x \<le> nat \<lfloor>a\<rfloor>"
   by linarith
 
 lemma le_mult_nat_floor: "nat \<lfloor>a\<rfloor> * nat \<lfloor>b\<rfloor> \<le> nat \<lfloor>a * b\<rfloor>"
   by (cases "0 \<le> a \<and> 0 \<le> b")
      (auto simp add: nat_mult_distrib[symmetric] nat_mono le_mult_floor)
 
 lemma nat_ceiling_le_eq [simp]: "nat \<lceil>x\<rceil> \<le> a \<longleftrightarrow> x \<le> real a"
   by linarith
 
 lemma real_nat_ceiling_ge: "x \<le> real (nat \<lceil>x\<rceil>)"
   by linarith
 
 lemma Rats_no_top_le: "\<exists>q \<in> \<rat>. x \<le> q"
   for x :: real
   by (auto intro!: bexI[of _ "of_nat (nat \<lceil>x\<rceil>)"]) linarith
 
 lemma Rats_no_bot_less: "\<exists>q \<in> \<rat>. q < x" for x :: real
   by (auto intro!: bexI[of _ "of_int (\<lfloor>x\<rfloor> - 1)"]) linarith
 
 
 subsection \<open>Exponentiation with floor\<close>
 
 lemma floor_power:
   assumes "x = of_int \<lfloor>x\<rfloor>"
   shows "\<lfloor>x ^ n\<rfloor> = \<lfloor>x\<rfloor> ^ n"
 proof -
   have "x ^ n = of_int (\<lfloor>x\<rfloor> ^ n)"
     using assms by (induct n arbitrary: x) simp_all
   then show ?thesis by (metis floor_of_int)
 qed
 
 lemma floor_numeral_power [simp]: "\<lfloor>numeral x ^ n\<rfloor> = numeral x ^ n"
   by (metis floor_of_int of_int_numeral of_int_power)
 
 lemma ceiling_numeral_power [simp]: "\<lceil>numeral x ^ n\<rceil> = numeral x ^ n"
   by (metis ceiling_of_int of_int_numeral of_int_power)
 
 
 subsection \<open>Implementation of rational real numbers\<close>
 
 text \<open>Formal constructor\<close>
 
 definition Ratreal :: "rat \<Rightarrow> real"
   where [code_abbrev, simp]: "Ratreal = real_of_rat"
 
 code_datatype Ratreal
 
 
 text \<open>Quasi-Numerals\<close>
 
 lemma [code_abbrev]:
   "real_of_rat (numeral k) = numeral k"
   "real_of_rat (- numeral k) = - numeral k"
   "real_of_rat (rat_of_int a) = real_of_int a"
   by simp_all
 
 lemma [code_post]:
   "real_of_rat 0 = 0"
   "real_of_rat 1 = 1"
   "real_of_rat (- 1) = - 1"
   "real_of_rat (1 / numeral k) = 1 / numeral k"
   "real_of_rat (numeral k / numeral l) = numeral k / numeral l"
   "real_of_rat (- (1 / numeral k)) = - (1 / numeral k)"
   "real_of_rat (- (numeral k / numeral l)) = - (numeral k / numeral l)"
   by (simp_all add: of_rat_divide of_rat_minus)
 
 text \<open>Operations\<close>
 
 lemma zero_real_code [code]: "0 = Ratreal 0"
   by simp
 
 lemma one_real_code [code]: "1 = Ratreal 1"
   by simp
 
 instantiation real :: equal
 begin
 
 definition "HOL.equal x y \<longleftrightarrow> x - y = 0" for x :: real
 
 instance by standard (simp add: equal_real_def)
 
 lemma real_equal_code [code]: "HOL.equal (Ratreal x) (Ratreal y) \<longleftrightarrow> HOL.equal x y"
   by (simp add: equal_real_def equal)
 
 lemma [code nbe]: "HOL.equal x x \<longleftrightarrow> True"
   for x :: real
   by (rule equal_refl)
 
 end
 
 lemma real_less_eq_code [code]: "Ratreal x \<le> Ratreal y \<longleftrightarrow> x \<le> y"
   by (simp add: of_rat_less_eq)
 
 lemma real_less_code [code]: "Ratreal x < Ratreal y \<longleftrightarrow> x < y"
   by (simp add: of_rat_less)
 
 lemma real_plus_code [code]: "Ratreal x + Ratreal y = Ratreal (x + y)"
   by (simp add: of_rat_add)
 
 lemma real_times_code [code]: "Ratreal x * Ratreal y = Ratreal (x * y)"
   by (simp add: of_rat_mult)
 
 lemma real_uminus_code [code]: "- Ratreal x = Ratreal (- x)"
   by (simp add: of_rat_minus)
 
 lemma real_minus_code [code]: "Ratreal x - Ratreal y = Ratreal (x - y)"
   by (simp add: of_rat_diff)
 
 lemma real_inverse_code [code]: "inverse (Ratreal x) = Ratreal (inverse x)"
   by (simp add: of_rat_inverse)
 
 lemma real_divide_code [code]: "Ratreal x / Ratreal y = Ratreal (x / y)"
   by (simp add: of_rat_divide)
 
 lemma real_floor_code [code]: "\<lfloor>Ratreal x\<rfloor> = \<lfloor>x\<rfloor>"
   by (metis Ratreal_def floor_le_iff floor_unique le_floor_iff
       of_int_floor_le of_rat_of_int_eq real_less_eq_code)
 
 
 text \<open>Quickcheck\<close>
 
 definition (in term_syntax)
   valterm_ratreal :: "rat \<times> (unit \<Rightarrow> Code_Evaluation.term) \<Rightarrow> real \<times> (unit \<Rightarrow> Code_Evaluation.term)"
   where [code_unfold]: "valterm_ratreal k = Code_Evaluation.valtermify Ratreal {\<cdot>} k"
 
 notation fcomp (infixl "\<circ>>" 60)
 notation scomp (infixl "\<circ>\<rightarrow>" 60)
 
 instantiation real :: random
 begin
 
 definition
   "Quickcheck_Random.random i = Quickcheck_Random.random i \<circ>\<rightarrow> (\<lambda>r. Pair (valterm_ratreal r))"
 
 instance ..
 
 end
 
 no_notation fcomp (infixl "\<circ>>" 60)
 no_notation scomp (infixl "\<circ>\<rightarrow>" 60)
 
 instantiation real :: exhaustive
 begin
 
 definition
   "exhaustive_real f d = Quickcheck_Exhaustive.exhaustive (\<lambda>r. f (Ratreal r)) d"
 
 instance ..
 
 end
 
 instantiation real :: full_exhaustive
 begin
 
 definition
   "full_exhaustive_real f d = Quickcheck_Exhaustive.full_exhaustive (\<lambda>r. f (valterm_ratreal r)) d"
 
 instance ..
 
 end
 
 instantiation real :: narrowing
 begin
 
 definition
   "narrowing_real = Quickcheck_Narrowing.apply (Quickcheck_Narrowing.cons Ratreal) narrowing"
 
 instance ..
 
 end
 
 
 subsection \<open>Setup for Nitpick\<close>
 
 declaration \<open>
   Nitpick_HOL.register_frac_type \<^type_name>\<open>real\<close>
     [(\<^const_name>\<open>zero_real_inst.zero_real\<close>, \<^const_name>\<open>Nitpick.zero_frac\<close>),
      (\<^const_name>\<open>one_real_inst.one_real\<close>, \<^const_name>\<open>Nitpick.one_frac\<close>),
      (\<^const_name>\<open>plus_real_inst.plus_real\<close>, \<^const_name>\<open>Nitpick.plus_frac\<close>),
      (\<^const_name>\<open>times_real_inst.times_real\<close>, \<^const_name>\<open>Nitpick.times_frac\<close>),
      (\<^const_name>\<open>uminus_real_inst.uminus_real\<close>, \<^const_name>\<open>Nitpick.uminus_frac\<close>),
      (\<^const_name>\<open>inverse_real_inst.inverse_real\<close>, \<^const_name>\<open>Nitpick.inverse_frac\<close>),
      (\<^const_name>\<open>ord_real_inst.less_real\<close>, \<^const_name>\<open>Nitpick.less_frac\<close>),
      (\<^const_name>\<open>ord_real_inst.less_eq_real\<close>, \<^const_name>\<open>Nitpick.less_eq_frac\<close>)]
 \<close>
 
 lemmas [nitpick_unfold] = inverse_real_inst.inverse_real one_real_inst.one_real
   ord_real_inst.less_real ord_real_inst.less_eq_real plus_real_inst.plus_real
   times_real_inst.times_real uminus_real_inst.uminus_real
   zero_real_inst.zero_real
 
 
 subsection \<open>Setup for SMT\<close>
 
 ML_file \<open>Tools/SMT/smt_real.ML\<close>
 ML_file \<open>Tools/SMT/z3_real.ML\<close>
 
 lemma [z3_rule]:
   "0 + x = x"
   "x + 0 = x"
   "0 * x = 0"
   "1 * x = x"
   "-x = -1 * x"
   "x + y = y + x"
   for x y :: real
   by auto
 
 
 subsection \<open>Setup for Argo\<close>
 
 ML_file \<open>Tools/Argo/argo_real.ML\<close>
 
 end