diff --git a/thys/Complex_Bounded_Operators/Cblinfun_Code.thy b/thys/Complex_Bounded_Operators/Cblinfun_Code.thy
--- a/thys/Complex_Bounded_Operators/Cblinfun_Code.thy
+++ b/thys/Complex_Bounded_Operators/Cblinfun_Code.thy
@@ -1,666 +1,670 @@
 section \<open>\<open>Cblinfun_Code\<close> -- Support for code generation\<close>
 
 text \<open>This theory provides support for code generation involving on complex vector spaces and
   bounded operators (e.g., types \<open>cblinfun\<close> and \<open>ell2\<close>).
   To fully support code generation, in addition to importing this theory,
   one need to activate support for code generation (import theory \<open>Jordan_Normal_Form.Matrix_Impl\<close>)
   and for real and complex numbers (import theory \<open>Real_Impl.Real_Impl\<close> for support of reals of the 
   form \<open>a + b * sqrt c\<close> or \<open>Algebraic_Numbers.Real_Factorization\<close> (much slower) for support of algebraic reals;
   support of complex numbers comes "for free").
 
   The builtin support for real and complex numbers (in \<open>Complex_Main\<close>) is not sufficient because it
   does not support the computation of square-roots which are used in the setup below.
 
   It is also recommended to import \<open>HOL-Library.Code_Target_Numeral\<close> for faster support of nats 
   and integers.\<close>
 
 theory Cblinfun_Code
   imports
     Cblinfun_Matrix Containers.Set_Impl Jordan_Normal_Form.Matrix_Kernel
 begin
 
 no_notation "Lattice.meet" (infixl "\<sqinter>\<index>" 70)
 no_notation "Lattice.join" (infixl "\<squnion>\<index>" 65)
 hide_const (open) Coset.kernel
 hide_const (open) Matrix_Kernel.kernel
 hide_const (open) Order.bottom Order.top
 
 unbundle lattice_syntax
 unbundle jnf_notation
 unbundle cblinfun_notation
 
 
 
 subsection \<open>Code equations for cblinfun operators\<close>
 
 text \<open>In this subsection, we define the code for all operations involving only 
   operators (no combinations of operators/vectors/subspaces)\<close>
 
 
 text \<open>The following lemma registers cblinfun as an abstract datatype with 
   constructor \<^const>\<open>cblinfun_of_mat\<close>.
   That means that in generated code, all cblinfun operators will be represented
   as \<^term>\<open>cblinfun_of_mat X\<close> where X is a matrix.
   In code equations for operations involving operators (e.g., +), we
   can then write the equation directly in terms of matrices
   by writing, e.g., \<^term>\<open>mat_of_cblinfun (A+B)\<close> in the lhs,
   and in the rhs we define the matrix that corresponds to the sum of A,B.
   In the rhs, we can access the matrices corresponding to A,B by
   writing \<^term>\<open>mat_of_cblinfun B\<close>.
   (See, e.g., lemma @{thm [source] mat_of_cblinfun_plus}.)
 
   See \<^cite>\<open>"code-generation-tutorial"\<close> for more information on 
   @{theory_text \<open>[code abstype]\<close>}.\<close>
 
 declare mat_of_cblinfun_inverse [code abstype]
 
 declare mat_of_cblinfun_plus[code]
   \<comment> \<open>Code equation for addition of cblinfuns\<close>
 
 declare mat_of_cblinfun_id[code]
   \<comment> \<open>Code equation for computing the identity operator\<close>
 
 declare mat_of_cblinfun_1[code]
   \<comment> \<open>Code equation for computing the one-dimensional identity\<close>
 
 declare mat_of_cblinfun_zero[code]
   \<comment> \<open>Code equation for computing the zero operator\<close>
 
 
 declare mat_of_cblinfun_uminus[code]
   \<comment> \<open>Code equation for computing the unary minus on cblinfun's\<close>
 
 
 declare mat_of_cblinfun_minus[code]
   \<comment> \<open>Code equation for computing the difference of cblinfun's\<close>
 
 
 declare mat_of_cblinfun_classical_operator[code]
   \<comment> \<open>Code equation for computing the "classical operator"\<close>
 
+declare mat_of_cblinfun_explicit_cblinfun[code]
+  \<comment> \<open>Code equation for computing the \<^const>\<open>explicit_cblinfun\<close>\<close>
+
 declare mat_of_cblinfun_compose[code]
   \<comment> \<open>Code equation for computing the composition/product of cblinfun's\<close>
 
 declare mat_of_cblinfun_scaleC[code]
   \<comment> \<open>Code equation for multiplication with complex scalar\<close>
 
 declare mat_of_cblinfun_scaleR[code]
   \<comment> \<open>Code equation for multiplication with real scalar\<close>
 
 declare mat_of_cblinfun_adj[code]
   \<comment> \<open>Code equation for computing the adj\<close>
 
 text \<open>This instantiation defines a code equation for equality tests for cblinfun.\<close>
 instantiation cblinfun :: (onb_enum,onb_enum) equal begin
 definition [code]: "equal_cblinfun M N \<longleftrightarrow> mat_of_cblinfun M = mat_of_cblinfun N" 
   for M N :: "'a \<Rightarrow>\<^sub>C\<^sub>L 'b"
 instance 
   apply intro_classes
   unfolding equal_cblinfun_def 
   using mat_of_cblinfun_inj injD by fastforce
 end
 
 subsection \<open>Vectors\<close>
 
 text \<open>In this section, we define code for operations on vectors. As with operators above,
   we do this by using an isomorphism between finite vectors
   (i.e., types T of sort \<open>complex_vector\<close>) and the type \<^typ>\<open>complex vec\<close> from
   \<^session>\<open>Jordan_Normal_Form\<close>. We have developed such an isomorphism in 
   theory \<open>Cblinfun_Matrix\<close> for 
   any type T of sort \<open>onb_enum\<close> (i.e., any type with a finite canonical orthonormal basis)
   as was done above for bounded operators.
   Unfortunately, we cannot declare code equations for a type class, 
   code equations must be related to a specific type constructor.
   So we give code definition only for vectors of type \<^typ>\<open>'a ell2\<close> (where \<^typ>\<open>'a\<close>
   must be of sort \<open>enum\<close> to make make sure that \<^typ>\<open>'a ell2\<close> is finite dimensional).
   
   The isomorphism between \<^typ>\<open>'a ell2\<close> is given by the constants \<open>ell2_of_vec\<close>
   and \<open>vec_of_ell2\<close> which are copies of the more general \<^const>\<open>basis_enum_of_vec\<close>
   and \<^const>\<open>vec_of_basis_enum\<close> but with a more restricted type to be usable in our code equations.
 \<close>
 
 definition ell2_of_vec :: "complex vec \<Rightarrow> 'a::enum ell2" where "ell2_of_vec = basis_enum_of_vec"
 definition vec_of_ell2 :: "'a::enum ell2 \<Rightarrow> complex vec" where "vec_of_ell2 = vec_of_basis_enum"
 
 text \<open>The following theorem registers the isomorphism \<open>ell2_of_vec\<close>/\<open>vec_of_ell2\<close>
   for code generation. From now on,
   code for operations on \<^typ>\<open>_ ell2\<close> can be expressed by declarations such
   as \<^term>\<open>vec_of_ell2 (f a b) = g (vec_of_ell2 a) (vec_of_ell2 b)\<close>
   if the operation f on \<^typ>\<open>_ ell2\<close> corresponds to the operation g on
   \<^typ>\<open>complex vec\<close>.\<close>
 
 lemma vec_of_ell2_inverse [code abstype]:
   "ell2_of_vec (vec_of_ell2 B) = B" 
   unfolding ell2_of_vec_def vec_of_ell2_def
   by (rule vec_of_basis_enum_inverse)
 
 text \<open>This instantiation defines a code equation for equality tests for ell2.\<close>
 instantiation ell2 :: (enum) equal begin
 definition [code]: "equal_ell2 M N \<longleftrightarrow> vec_of_ell2 M = vec_of_ell2 N" 
   for M N :: "'a::enum ell2"
 instance 
   apply intro_classes
   unfolding equal_ell2_def
   by (metis vec_of_ell2_inverse)
 end
 
 lemma vec_of_ell2_carrier_vec[simp]: \<open>vec_of_ell2 v \<in> carrier_vec CARD('a)\<close> for v :: \<open>'a::enum ell2\<close>
+  using vec_of_basis_enum_carrier_vec[of v]
+  apply (simp only: canonical_basis_length canonical_basis_length_ell2)
   by (simp add: vec_of_ell2_def)
 
 lemma vec_of_ell2_zero[code]:
   \<comment> \<open>Code equation for computing the zero vector\<close>
   "vec_of_ell2 (0::'a::enum ell2) = zero_vec (CARD('a))"
   by (simp add: vec_of_ell2_def vec_of_basis_enum_zero)
 
 lemma vec_of_ell2_ket[code]:
   \<comment> \<open>Code equation for computing a standard basis vector\<close>
   "vec_of_ell2 (ket i) = unit_vec (CARD('a)) (enum_idx i)" 
   for i::"'a::enum"
   using vec_of_ell2_def vec_of_basis_enum_ket by metis
 
 lemma vec_of_ell2_scaleC[code]: 
   \<comment> \<open>Code equation for multiplying a vector with a complex scalar\<close>
   "vec_of_ell2 (scaleC a \<psi>) = smult_vec a (vec_of_ell2 \<psi>)"
   for \<psi> :: "'a::enum ell2"
   by (simp add: vec_of_ell2_def vec_of_basis_enum_scaleC)
 
 lemma vec_of_ell2_scaleR[code]: 
   \<comment> \<open>Code equation for multiplying a vector with a real scalar\<close>
   "vec_of_ell2 (scaleR a \<psi>) = smult_vec (complex_of_real a) (vec_of_ell2 \<psi>)"
   for \<psi> :: "'a::enum ell2"
   by (simp add: vec_of_ell2_def vec_of_basis_enum_scaleR)
 
 lemma ell2_of_vec_plus[code]:
   \<comment> \<open>Code equation for adding vectors\<close>
   "vec_of_ell2 (x + y) =  (vec_of_ell2 x) + (vec_of_ell2 y)" for x y :: "'a::enum ell2"
   by (simp add: vec_of_ell2_def vec_of_basis_enum_add) 
 
 lemma ell2_of_vec_minus[code]:
   \<comment> \<open>Code equation for subtracting vectors\<close>
   "vec_of_ell2 (x - y) =  (vec_of_ell2 x) - (vec_of_ell2 y)" for x y :: "'a::enum ell2"
   by (simp add: vec_of_ell2_def vec_of_basis_enum_minus)
 
 lemma ell2_of_vec_uminus[code]:
   \<comment> \<open>Code equation for negating a vector\<close>
   "vec_of_ell2 (- y) =  - (vec_of_ell2 y)" for y :: "'a::enum ell2"
   by (simp add: vec_of_ell2_def vec_of_basis_enum_uminus)
 
 lemma cinner_ell2_code [code]: "cinner \<psi> \<phi> = cscalar_prod (vec_of_ell2 \<phi>) (vec_of_ell2 \<psi>)"
   \<comment> \<open>Code equation for the inner product of vectors\<close>
   by (simp add: cscalar_prod_vec_of_basis_enum vec_of_ell2_def)
 
 lemma norm_ell2_code [code]: 
   \<comment> \<open>Code equation for the norm of a vector\<close>
   "norm \<psi> = norm_vec (vec_of_ell2 \<psi>)"
-  by (simp add: norm_ell2_vec_of_basis_enum vec_of_ell2_def)
+  by (simp add: norm_vec_of_basis_enum vec_of_ell2_def)
 
 lemma times_ell2_code[code]: 
   \<comment> \<open>Code equation for the product in the algebra of one-dimensional vectors\<close>
   fixes \<psi> \<phi> :: "'a::{CARD_1,enum} ell2"
   shows "vec_of_ell2 (\<psi> * \<phi>)
    = vec_of_list [vec_index (vec_of_ell2 \<psi>) 0 * vec_index (vec_of_ell2 \<phi>) 0]"
   by (simp add: vec_of_ell2_def vec_of_basis_enum_times)
 
 lemma divide_ell2_code[code]: 
   \<comment> \<open>Code equation for the product in the algebra of one-dimensional vectors\<close>
   fixes \<psi> \<phi> :: "'a::{CARD_1,enum} ell2"
   shows "vec_of_ell2 (\<psi> / \<phi>)
    = vec_of_list [vec_index (vec_of_ell2 \<psi>) 0 / vec_index (vec_of_ell2 \<phi>) 0]"
   by (simp add: vec_of_ell2_def vec_of_basis_enum_divide)
 
 lemma inverse_ell2_code[code]: 
   \<comment> \<open>Code equation for the product in the algebra of one-dimensional vectors\<close>
   fixes \<psi> :: "'a::{CARD_1,enum} ell2"
   shows "vec_of_ell2 (inverse \<psi>)
    = vec_of_list [inverse (vec_index (vec_of_ell2 \<psi>) 0)]"
   by (simp add: vec_of_ell2_def vec_of_basis_enum_to_inverse)
 
 lemma one_ell2_code[code]: 
   \<comment> \<open>Code equation for the unit in the algebra of one-dimensional vectors\<close>
   "vec_of_ell2 (1 :: 'a::{CARD_1,enum} ell2) = vec_of_list [1]"
   by (simp add: vec_of_ell2_def vec_of_basis_enum_1) 
 
 subsection \<open>Vector/Matrix\<close>
 
 text \<open>We proceed to give code equations for operations involving both
   operators (cblinfun) and vectors. As explained above, we have to restrict
   the equations to vectors of type \<^typ>\<open>'a ell2\<close> even though the theory is available
   for any type of class \<^class>\<open>onb_enum\<close>. As a consequence, we run into an
   additional technicality now. For example, to define a code equation for applying
   an operator to a vector, we might try to give the following lemma:
 
 \<^theory_text>\<open>lemma cblinfun_apply_ell2[code]:
   "vec_of_ell2 (M *\<^sub>V x) = (mult_mat_vec (mat_of_cblinfun M) (vec_of_ell2 x))"
   by (simp add: mat_of_cblinfun_cblinfun_apply vec_of_ell2_def)\<close>
 
   Unfortunately, this does not work, Isabelle produces the warning 
   "Projection as head in equation", most likely due to the fact that
   the type of \<^term>\<open>(*\<^sub>V)\<close> in the equation is less general than the type of 
   \<^term>\<open>(*\<^sub>V)\<close> (it is restricted to @{type ell2}). We overcome this problem
   by defining a constant \<open>cblinfun_apply_ell2\<close> which is equal to \<^term>\<open>(*\<^sub>V)\<close>
   but has a more restricted type. We then instruct the code generation 
   to replace occurrences of \<^term>\<open>(*\<^sub>V)\<close> by \<open>cblinfun_apply_ell2\<close> (where possible),
   and we add code generation for \<open>cblinfun_apply_ell2\<close> instead of \<^term>\<open>(*\<^sub>V)\<close>.
 \<close>
 
 definition cblinfun_apply_ell2 :: "'a ell2 \<Rightarrow>\<^sub>C\<^sub>L 'b ell2 \<Rightarrow> 'a ell2 \<Rightarrow> 'b ell2" 
   where [code del, code_abbrev]: "cblinfun_apply_ell2 = (*\<^sub>V)"
     \<comment> \<open>@{attribute code_abbrev} instructs the code generation to replace the
      rhs \<^term>\<open>(*\<^sub>V)\<close> by the lhs \<^term>\<open>cblinfun_apply_ell2\<close> before starting 
      the actual code generation.\<close>
 
 lemma cblinfun_apply_ell2[code]:
   \<comment> \<open>Code equation for \<^term>\<open>cblinfun_apply_ell2\<close>, i.e., for applying an operator
      to an \<^type>\<open>ell2\<close> vector\<close>
   "vec_of_ell2 (cblinfun_apply_ell2 M x) = (mult_mat_vec (mat_of_cblinfun M) (vec_of_ell2 x))"
   by (simp add: cblinfun_apply_ell2_def mat_of_cblinfun_cblinfun_apply vec_of_ell2_def)
 
 text \<open>For the constant \<^term>\<open>vector_to_cblinfun\<close> (canonical isomorphism from
   vectors to operators), we have the same problem and define a constant
   \<open>vector_to_cblinfun_code\<close> with more restricted type\<close>
 
 definition vector_to_cblinfun_code :: "'a ell2 \<Rightarrow> 'b::one_dim \<Rightarrow>\<^sub>C\<^sub>L 'a ell2" where
   [code del,code_abbrev]: "vector_to_cblinfun_code = vector_to_cblinfun"
   \<comment> \<open>@{attribute code_abbrev} instructs the code generation to replace the
      rhs \<^term>\<open>vector_to_cblinfun\<close> by the lhs \<^term>\<open>vector_to_cblinfun_code\<close>
      before starting the actual code generation.\<close>
 
 lemma vector_to_cblinfun_code[code]: 
   \<comment> \<open>Code equation for translating a vector into an operation (single-column matrix)\<close>
   "mat_of_cblinfun (vector_to_cblinfun_code \<psi>) = mat_of_cols (CARD('a)) [vec_of_ell2 \<psi>]"
   for \<psi>::"'a::enum ell2"
   by (simp add: mat_of_cblinfun_vector_to_cblinfun  vec_of_ell2_def vector_to_cblinfun_code_def)
 
 definition butterfly_code :: \<open>'a ell2 \<Rightarrow> 'b ell2 \<Rightarrow> 'b ell2 \<Rightarrow>\<^sub>C\<^sub>L 'a ell2\<close> 
   where [code del, code_abbrev]: \<open>butterfly_code = butterfly\<close> 
 lemma butterfly_code[code]: \<open>mat_of_cblinfun (butterfly_code s t)
    = mat_of_cols (CARD('a)) [vec_of_ell2 s] * mat_of_rows (CARD('b)) [map_vec cnj (vec_of_ell2 t)]\<close>
   for s :: \<open>'a::enum ell2\<close> and t :: \<open>'b::enum ell2\<close>
   by (simp add: butterfly_code_def butterfly_def vector_to_cblinfun_code mat_of_cblinfun_compose
       mat_of_cblinfun_adj mat_adjoint_def map_map_vec_cols
       flip: vector_to_cblinfun_code_def map_vec_conjugate[abs_def])
 
 subsection \<open>Subspaces\<close>
 
 text \<open>In this section, we define code equations for handling subspaces, i.e.,
 values of type \<^typ>\<open>'a ccsubspace\<close>. We choose to computationally represent
 a subspace by a list of vectors that span the subspace. That is,
 if \<^term>\<open>vecs\<close> are vectors (type \<^typ>\<open>complex vec\<close>), \<open>SPAN vecs\<close> is defined to be their
 span. Then the code generation can simply represent all subspaces in this form, and 
 we need to define the operations on subspaces in terms of list of vectors 
 (e.g., the closed union of two subspaces would be computed as the concatenation 
 of the two lists, to give one of the simplest examples).
 
 To support this, \<open>SPAN\<close> is declared as a "\<open>code_datatype\<close>".
 (Not as an abstract datatype like \<^term>\<open>cblinfun_of_mat\<close>/\<^term>\<open>mat_of_cblinfun\<close>
 because that would require \<open>SPAN\<close> to be injective.)
 
 Then all code equations for different operations need to be formulated as
 functions of values of the form \<open>SPAN x\<close>. (E.g., \<open>SPAN x + SPAN y = SPAN (\<dots>)\<close>.)\<close>
 
 definition [code del]: "SPAN x = (let n = length (canonical_basis :: 'a::onb_enum list) in
     ccspan (basis_enum_of_vec ` Set.filter (\<lambda>v. dim_vec v = n) (set x)) :: 'a ccsubspace)"
   \<comment> \<open>The SPAN of vectors x, as a \<^type>\<open>ccsubspace\<close>.
       We filter out vectors of the wrong dimension because \<open>SPAN\<close> needs to have
       well-defined behavior even in cases that would not actually occur in an execution.\<close>
 code_datatype SPAN
 
 text \<open>We first declare code equations for \<^term>\<open>Proj\<close>, i.e., for
 turning a subspace into a projector. This means, we would need a code equation
 of the form \<open>mat_of_cblinfun (Proj (SPAN S)) = \<dots>\<close>. However, this equation is
 not accepted by the code generation for reasons we do not understand. But
 if we define an auxiliary constant \<open>mat_of_cblinfun_Proj_code\<close> that stands for 
 \<open>mat_of_cblinfun (Proj _)\<close>, define a code equation for \<open>mat_of_cblinfun_Proj_code\<close>,
 and then define a code equation for \<open>mat_of_cblinfun (Proj S)\<close> in terms of 
 \<open>mat_of_cblinfun_Proj_code\<close>, Isabelle accepts the code equations.\<close>
 
 definition "mat_of_cblinfun_Proj_code S = mat_of_cblinfun (Proj S)"
 declare mat_of_cblinfun_Proj_code_def[symmetric, code]
 
 lemma mat_of_cblinfun_Proj_code_code[code]: 
   \<comment> \<open>Code equation for computing a projector onto a set S of vectors.
      We first make the vectors S into an orthonormal basis using
      the Gram-Schmidt procedure and then compute the projector
      as the sum of the "butterflies" \<open>x * x*\<close> of the vectors \<open>x\<in>S\<close>
-     (done by \<^term>\<open>mk_projector_orthog\<close>).\<close>
+     (done by \<^term>\<open>mk_projector\<close>).\<close>
   "mat_of_cblinfun_Proj_code (SPAN S :: 'a::onb_enum ccsubspace) = 
-    (let d = length (canonical_basis :: 'a list) in mk_projector_orthog d 
-              (gram_schmidt0 d (filter (\<lambda>v. dim_vec v = d) S)))"
+    (let d = length (canonical_basis :: 'a list) in mk_projector d (filter (\<lambda>v. dim_vec v = d) S))"
 proof -
   have *: "map_option vec_of_basis_enum (if dim_vec x = length (canonical_basis :: 'a list) then Some (basis_enum_of_vec x :: 'a) else None)
       = (if dim_vec x = length (canonical_basis :: 'a list) then Some x else None)" for x
     by auto
   show ?thesis
     unfolding SPAN_def mat_of_cblinfun_Proj_code_def
     using mat_of_cblinfun_Proj_ccspan[where S = 
         "map basis_enum_of_vec (filter (\<lambda>v. dim_vec v = (length (canonical_basis :: 'a list))) S) :: 'a list"]
     apply (simp only: Let_def map_filter_map_filter filter_set image_set map_map_filter o_def)
     unfolding *
     by (simp add: map_filter_map_filter[symmetric])
 qed
 
 lemma top_ccsubspace_code[code]: 
   \<comment> \<open>Code equation for \<^term>\<open>top\<close>, the subspace containing everything.
       Top is represented as the span of the standard basis vectors.\<close>
   "(top::'a ccsubspace) =
       (let n = length (canonical_basis :: 'a::onb_enum list) in SPAN (unit_vecs n))"
   unfolding SPAN_def
   apply (simp only: index_unit_vec Let_def map_filter_map_filter filter_set image_set map_map_filter 
       map_filter_map o_def unit_vecs_def)
   apply (simp add: basis_enum_of_vec_unit_vec)
   apply (subst nth_image)
   by auto
 
 lemma bot_as_span[code]: 
   \<comment> \<open>Code equation for \<^term>\<open>bot\<close>, the subspace containing everything.
       Top is represented as the span of the standard basis vectors.\<close>
   "(bot::'a::onb_enum ccsubspace) = SPAN []"
   unfolding SPAN_def by (auto simp: Set.filter_def)
 
 
 lemma sup_spans[code]:
   \<comment> \<open>Code equation for the join (lub) of two subspaces (union of the generating lists)\<close>
   "SPAN A \<squnion> SPAN B = SPAN (A @ B)"
   unfolding SPAN_def 
   by (auto simp: ccspan_union image_Un filter_Un Let_def)
 
 text \<open>We do not need an equation for \<^term>\<open>(+)\<close> because \<^term>\<open>(+)\<close>
 is defined in terms of \<^term>\<open>(\<squnion>)\<close> (for \<^type>\<open>ccsubspace\<close>), thus the code generation automatically
 computes \<^term>\<open>(+)\<close> in terms of the code for \<^term>\<open>(\<squnion>)\<close>\<close>
 
 definition [code del,code_abbrev]: "Span_code (S::'a::enum ell2 set) = (ccspan S)"
   \<comment> \<open>A copy of \<^term>\<open>ccspan\<close> with restricted type. For analogous reasons as
      \<^term>\<open>cblinfun_apply_ell2\<close>, see there for explanations\<close>
 
 lemma span_Set_Monad[code]: "Span_code (Set_Monad l) = (SPAN (map vec_of_ell2 l))"
   \<comment> \<open>Code equation for the span of a finite set. (\<^term>\<open>Set_Monad\<close> is a datatype
      constructor that represents sets as lists in the computation.)\<close>
   apply (simp add: Span_code_def SPAN_def Let_def)
   apply (subst Set_filter_unchanged)
    apply (auto simp add: vec_of_ell2_def)[1]
   by (metis (no_types, lifting) ell2_of_vec_def image_image map_idI set_map vec_of_ell2_inverse)
 
 text \<open>This instantiation defines a code equation for equality tests for \<^type>\<open>ccsubspace\<close>.
       The actual code for equality tests is given below (lemma \<open>equal_ccsubspace_code\<close>).\<close>
 instantiation ccsubspace :: (onb_enum) equal begin
 definition [code del]: "equal_ccsubspace (A::'a ccsubspace) B = (A=B)"
 instance apply intro_classes unfolding equal_ccsubspace_def by simp
 end
 
 lemma leq_ccsubspace_code[code]:
   \<comment> \<open>Code equation for deciding inclusion of one space in another.
      Uses the constant \<^term>\<open>is_subspace_of_vec_list\<close> which implements the actual
      computation by checking for each generator of A whether it is in the
      span of B (by orthogonal projection onto an orthonormal basis of B
      which is computed using Gram-Schmidt).\<close>
   "SPAN A \<le> (SPAN B :: 'a::onb_enum ccsubspace)
       \<longleftrightarrow> (let d = length (canonical_basis :: 'a list) in
           is_subspace_of_vec_list d
           (filter (\<lambda>v. dim_vec v = d) A)
           (filter (\<lambda>v. dim_vec v = d) B))"
 proof -
   define d A' B' where "d = length (canonical_basis :: 'a list)"
     and "A' = filter (\<lambda>v. dim_vec v = d) A"
     and "B' = filter (\<lambda>v. dim_vec v = d) B"
 
   show ?thesis
     unfolding SPAN_def d_def[symmetric] filter_set Let_def
       A'_def[symmetric] B'_def[symmetric] image_set
     apply (subst ccspan_leq_using_vec)
     unfolding d_def[symmetric] map_map o_def
     apply (subst map_cong[where xs=A', OF refl])
      apply (rule basis_enum_of_vec_inverse)
      apply (simp add: A'_def d_def)
     apply (subst map_cong[where xs=B', OF refl])
      apply (rule basis_enum_of_vec_inverse)
     by (simp_all add: B'_def d_def)
 qed
 
 lemma equal_ccsubspace_code[code]:
   \<comment> \<open>Code equation for equality test. By checking mutual inclusion
       (for which we have code by the preceding code equation).\<close>
   "HOL.equal (A::_ ccsubspace) B = (A\<le>B \<and> B\<le>A)"
   unfolding equal_ccsubspace_def by auto
 
-lemma apply_cblinfun_code[code]:
+lemma cblinfun_image_code[code]:
   \<comment> \<open>Code equation for applying an operator \<^term>\<open>A\<close> to a subspace. 
       Simply by multiplying each generator with \<^term>\<open>A\<close>\<close>
   "A *\<^sub>S SPAN S = (let d = length (canonical_basis :: 'a list) in
          SPAN (map (mult_mat_vec (mat_of_cblinfun A))
                (filter (\<lambda>v. dim_vec v = d) S)))"
   for A::"'a::onb_enum \<Rightarrow>\<^sub>C\<^sub>L'b::onb_enum"
 proof -
   define dA dB S'
     where "dA = length (canonical_basis :: 'a list)"
       and "dB = length (canonical_basis :: 'b list)"
       and "S' = filter (\<lambda>v. dim_vec v = dA) S"
 
   have "cblinfun_image A (SPAN S) = A *\<^sub>S ccspan (set (map basis_enum_of_vec S'))"
     unfolding SPAN_def dA_def[symmetric] Let_def S'_def filter_set
     by simp
   also have "\<dots> = ccspan ((\<lambda>x. basis_enum_of_vec 
             (mat_of_cblinfun A *\<^sub>v vec_of_basis_enum (basis_enum_of_vec x :: 'a))) ` set S')"
-    apply (subst cblinfun_apply_ccspan_using_vec)
+    apply (subst cblinfun_image_ccspan_using_vec)
     by (simp add: image_image)
   also have "\<dots> = ccspan ((\<lambda>x. basis_enum_of_vec (mat_of_cblinfun A *\<^sub>v x)) ` set S')"
     apply (subst image_cong[OF refl])
      apply (subst basis_enum_of_vec_inverse)
     by (auto simp add: S'_def dA_def)
   also have "\<dots> = SPAN (map (mult_mat_vec (mat_of_cblinfun A)) S')"
     unfolding SPAN_def dB_def[symmetric] Let_def filter_set 
     apply (subst filter_True)
     by (simp_all add: dB_def mat_of_cblinfun_def image_image)
 
   finally show ?thesis
     unfolding dA_def[symmetric] S'_def[symmetric] Let_def
     by simp
 qed
 
 definition [code del, code_abbrev]: "range_cblinfun_code A = A *\<^sub>S top"
   \<comment> \<open>A new constant for the special case of applying an operator to the subspace \<^term>\<open>top\<close>
   (i.e., for computing the range of the operator). We do this to be able to give
   more specialized code for this specific situation. (The generic code for
   \<^term>\<open>(*\<^sub>S)\<close> would work but is less efficient because it involves repeated matrix 
   multiplications. @{attribute code_abbrev} makes sure occurrences of \<^term>\<open>A *\<^sub>S top\<close>
   are replaced before starting the actual code generation.\<close>
 
 lemma range_cblinfun_code[code]: 
   \<comment> \<open>Code equation for computing the range of an operator \<^term>\<open>A\<close>.
       Returns the columns of the matrix representation of \<^term>\<open>A\<close>.\<close>
   fixes A :: "'a::onb_enum \<Rightarrow>\<^sub>C\<^sub>L 'b::onb_enum"
   shows "range_cblinfun_code A = SPAN (cols (mat_of_cblinfun A))"
 proof -
   define dA dB
     where "dA = length (canonical_basis :: 'a list)"
       and "dB = length (canonical_basis :: 'b list)"
   have carrier_A: "mat_of_cblinfun A \<in> carrier_mat dB dA"
     unfolding mat_of_cblinfun_def dA_def dB_def by simp
 
   have "range_cblinfun_code A = A *\<^sub>S SPAN (unit_vecs dA)"
     unfolding range_cblinfun_code_def
     by (metis dA_def top_ccsubspace_code)
   also have "\<dots> = SPAN (map (\<lambda>i. mat_of_cblinfun A *\<^sub>v unit_vec dA i) [0..<dA])"
-    unfolding apply_cblinfun_code dA_def[symmetric] Let_def
+    unfolding cblinfun_image_code dA_def[symmetric] Let_def
     apply (subst filter_True)
      apply (meson carrier_vecD subset_code(1) unit_vecs_carrier)
     by (simp add: unit_vecs_def o_def)
   also have "\<dots> = SPAN (map (\<lambda>x. mat_of_cblinfun A *\<^sub>v col (1\<^sub>m dA) x) [0..<dA])"
     apply (subst map_cong[OF refl])
     by auto
   also have "\<dots> = SPAN (map (col (mat_of_cblinfun A * 1\<^sub>m dA)) [0..<dA])"
     apply (subst map_cong[OF refl])
      apply (subst col_mult2[symmetric])
         apply (rule carrier_A)
     by auto
   also have "\<dots> = SPAN (cols (mat_of_cblinfun A))"
     unfolding cols_def dA_def[symmetric]
     apply (subst right_mult_one_mat[OF carrier_A])
     using carrier_A by blast
   finally show ?thesis
     by -
 qed
 
 
 lemma uminus_Span_code[code]: "- X = range_cblinfun_code (id_cblinfun - Proj X)"
   \<comment> \<open>Code equation for the orthogonal complement of a subspace \<^term>\<open>X\<close>. 
       Computed as the range of one minus the projector on \<^term>\<open>X\<close>\<close>
   unfolding range_cblinfun_code_def
   by (metis Proj_ortho_compl Proj_range)
 
 lemma kernel_code[code]: 
   \<comment> \<open>Computes the kernel of an operator \<^term>\<open>A\<close>.
       This is implemented using the existing functions 
       for transforming a matrix into row echelon form (\<^term>\<open>gauss_jordan_single\<close>)
       and for computing a basis of the kernel of such a matrix
       (\<^term>\<open>find_base_vectors\<close>)\<close>
   "kernel A = SPAN (find_base_vectors (gauss_jordan_single (mat_of_cblinfun A)))" 
   for A::"('a::onb_enum,'b::onb_enum) cblinfun"
 proof -
   define dA dB Am Ag base
     where "dA = length (canonical_basis :: 'a list)"
       and "dB = length (canonical_basis :: 'b list)"
       and "Am = mat_of_cblinfun A"
       and "Ag = gauss_jordan_single Am"
       and "base = find_base_vectors Ag"
 
   interpret complex_vec_space dA.
 
   have Am_carrier: "Am \<in> carrier_mat dB dA"
     unfolding Am_def mat_of_cblinfun_def dA_def dB_def by simp
 
   have row_echelon: "row_echelon_form Ag"
     unfolding Ag_def
     using Am_carrier refl by (rule gauss_jordan_single)
 
   have Ag_carrier: "Ag \<in> carrier_mat dB dA"
     unfolding Ag_def
     using Am_carrier refl by (rule gauss_jordan_single(2))
 
   have base_carrier: "set base \<subseteq> carrier_vec dA"
     unfolding base_def
     using find_base_vectors(1)[OF row_echelon Ag_carrier]
     using Ag_carrier mat_kernel_def by blast
 
   interpret k: kernel dB dA Ag
     apply standard using Ag_carrier by simp
 
   have basis_base: "kernel.basis dA Ag (set base)"
     using row_echelon Ag_carrier unfolding base_def
     by (rule find_base_vectors(3))
 
 
   have "space_as_set (SPAN base)
        = space_as_set (ccspan (basis_enum_of_vec ` set base :: 'a set))"
     unfolding SPAN_def dA_def[symmetric] Let_def filter_set
     apply (subst filter_True)
     using base_carrier by auto
 
   also have "\<dots> = cspan (basis_enum_of_vec ` set base)"
     apply transfer apply (subst closure_finite_cspan)
     by simp_all
 
   also have "\<dots> = basis_enum_of_vec ` span (set base)"
     apply (subst basis_enum_of_vec_span)
     using base_carrier dA_def by auto
 
   also have "\<dots> = basis_enum_of_vec ` mat_kernel Ag"
     using basis_base k.Ker.basis_def k.span_same by auto
 
   also have "\<dots> = basis_enum_of_vec ` {v \<in> carrier_vec dA. Ag *\<^sub>v v = 0\<^sub>v dB}"
     apply (rule arg_cong[where f="\<lambda>x. basis_enum_of_vec ` x"])
     unfolding mat_kernel_def using Ag_carrier
     by simp
 
   also have "\<dots> = basis_enum_of_vec ` {v \<in> carrier_vec dA. Am *\<^sub>v v = 0\<^sub>v dB}"
     using gauss_jordan_single(1)[OF Am_carrier Ag_def[symmetric]]
     by auto
 
   also have "\<dots> = {w. A *\<^sub>V w = 0}"
   proof -
     have "basis_enum_of_vec ` {v \<in> carrier_vec dA. Am *\<^sub>v v = 0\<^sub>v dB}
         = basis_enum_of_vec ` {v \<in> carrier_vec dA. A *\<^sub>V basis_enum_of_vec v = 0}"
       apply (rule arg_cong[where f="\<lambda>t. basis_enum_of_vec ` t"])
       apply (rule Collect_cong)
       apply (simp add: Am_def)
       by (metis Am_carrier Am_def carrier_matD(2) carrier_vecD dB_def mat_carrier 
           mat_of_cblinfun_def mat_of_cblinfun_cblinfun_apply vec_of_basis_enum_inverse 
           basis_enum_of_vec_inverse vec_of_basis_enum_zero)
     also have "\<dots> = {w \<in> basis_enum_of_vec ` carrier_vec dA. A *\<^sub>V w = 0}"
       apply (subst Compr_image_eq[symmetric])
       by simp
     also have "\<dots> = {w. A *\<^sub>V w = 0}"
       apply auto
       by (metis (no_types, lifting) Am_carrier Am_def carrier_matD(2) carrier_vec_dim_vec dim_vec_of_basis_enum' image_iff mat_carrier mat_of_cblinfun_def vec_of_basis_enum_inverse)
     finally show ?thesis
       by -
   qed
 
   also have "\<dots> = space_as_set (kernel A)"
     apply transfer by auto
 
   finally have "SPAN base = kernel A"
     by (simp add: space_as_set_inject)
   then show ?thesis
     by (simp add: base_def Ag_def Am_def)
 qed
 
 lemma inf_ccsubspace_code[code]: 
   \<comment> \<open>Code equation for intersection of subspaces.
      Reduced to orthogonal complement and sum of subspaces
      for which we already have code equations.\<close>
   "(A::'a::onb_enum ccsubspace) \<sqinter> B = - (- A \<squnion> - B)"
   by (subst ortho_involution[symmetric], subst compl_inf, simp)
 
 lemma Sup_ccsubspace_code[code]:
   \<comment> \<open>Supremum (sum) of a set of subspaces. Implemented
      by repeated pairwise sum.\<close>
   "Sup (Set_Monad l :: 'a::onb_enum ccsubspace set) = fold sup l bot"
   unfolding Set_Monad_def
   by (simp add: Sup_set_fold)
 
 
 lemma Inf_ccsubspace_code[code]: 
   \<comment> \<open>Infimum (intersection) of a set of subspaces. 
       Implemented by the orthogonal complement of the supremum.\<close>
   "Inf (Set_Monad l :: 'a::onb_enum ccsubspace set)
   = - Sup (Set_Monad (map uminus l))"
   unfolding Set_Monad_def
   apply (induction l)
   by auto
 
 subsection \<open>Miscellanea\<close>
 
 text \<open>This is a hack to circumvent a bug in the code generation. The automatically
   generated code for the class \<^class>\<open>uniformity\<close> has a type that is different from
   what the generated code later assumes, leading to compilation errors (in ML at least)
   in any expression involving \<^typ>\<open>_ ell2\<close> (even if the constant \<^const>\<open>uniformity\<close> is
   not actually used).
   
   The fragment below circumvents this by forcing Isabelle to use the right type.
   (The logically useless fragment "\<open>let x = ((=)::'a\<Rightarrow>_\<Rightarrow>_)\<close>" achieves this.)\<close>
 lemma uniformity_ell2_code[code]: "(uniformity :: ('a ell2 * _) filter) = Filter.abstract_filter (%_.
     Code.abort STR ''no uniformity'' (%_. 
     let x = ((=)::'a\<Rightarrow>_\<Rightarrow>_) in uniformity))"
   by simp
 
 text \<open>Code equation for \<^term>\<open>UNIV\<close>. 
   It is now implemented via type class \<^class>\<open>enum\<close> 
   (which provides a list of all values).\<close>
 declare [[code drop: UNIV]]
 declare enum_class.UNIV_enum[code]
 
 text \<open>Setup for code generation involving sets of \<^type>\<open>ell2\<close>/\<^type>\<open>ccsubspace\<close>.
   This configures to use lists for representing sets in code.\<close>
 derive (eq) ceq ccsubspace
 derive (no) ccompare ccsubspace
 derive (monad) set_impl ccsubspace
 derive (eq) ceq ell2
 derive (no) ccompare ell2
 derive (monad) set_impl ell2
 
 
 unbundle no_lattice_syntax
 unbundle no_jnf_notation
 unbundle no_cblinfun_notation
 
 end
diff --git a/thys/Complex_Bounded_Operators/Cblinfun_Code_Examples.thy b/thys/Complex_Bounded_Operators/Cblinfun_Code_Examples.thy
--- a/thys/Complex_Bounded_Operators/Cblinfun_Code_Examples.thy
+++ b/thys/Complex_Bounded_Operators/Cblinfun_Code_Examples.thy
@@ -1,120 +1,122 @@
 section \<open>\<open>Cblinfun_Code_Examples\<close> -- Examples and test cases for code generation\<close>
 
 theory Cblinfun_Code_Examples
   imports
     "Complex_Bounded_Operators.Extra_Pretty_Code_Examples"
     Jordan_Normal_Form.Matrix_Impl
     "HOL-Library.Code_Target_Numeral"
     Cblinfun_Code
 begin
 
 hide_const (open) Order.bottom Order.top
 no_notation Lattice.join (infixl "\<squnion>\<index>" 65)
 no_notation Lattice.meet (infixl "\<sqinter>\<index>" 70)
 
 unbundle lattice_syntax
 unbundle cblinfun_notation
 
 section \<open>Examples\<close>
 
 subsection \<open>Operators\<close>
 
 value "id_cblinfun :: bool ell2 \<Rightarrow>\<^sub>C\<^sub>L bool ell2"
 
 value "1 :: unit ell2 \<Rightarrow>\<^sub>C\<^sub>L unit ell2"
 
 value "id_cblinfun + id_cblinfun :: bool ell2 \<Rightarrow>\<^sub>C\<^sub>L bool ell2"
 
 value "0 :: (bool ell2 \<Rightarrow>\<^sub>C\<^sub>L Enum.finite_3 ell2)"
 
 value "- id_cblinfun :: bool ell2 \<Rightarrow>\<^sub>C\<^sub>L bool ell2"
 
 value "id_cblinfun - id_cblinfun :: bool ell2 \<Rightarrow>\<^sub>C\<^sub>L bool ell2"
 
 value "classical_operator (\<lambda>b. Some (\<not> b))"
 
+value \<open>explicit_cblinfun (\<lambda>x y :: bool. of_bool (x \<and> y))\<close>
+
 value "id_cblinfun = (0 :: bool ell2 \<Rightarrow>\<^sub>C\<^sub>L bool ell2)"
 
 value "2 *\<^sub>R id_cblinfun :: bool ell2 \<Rightarrow>\<^sub>C\<^sub>L bool ell2"
 
 value "imaginary_unit *\<^sub>C id_cblinfun :: bool ell2 \<Rightarrow>\<^sub>C\<^sub>L bool ell2"
 
 value "id_cblinfun o\<^sub>C\<^sub>L 0 :: bool ell2 \<Rightarrow>\<^sub>C\<^sub>L bool ell2"
 
 value "id_cblinfun* :: bool ell2 \<Rightarrow>\<^sub>C\<^sub>L bool ell2"
 
 subsection \<open>Vectors\<close>
 
 value "0 :: bool ell2"
 
 value "1 :: unit ell2"
 
 value "ket False"
 
 value "2 *\<^sub>C ket False"
 
 value "2 *\<^sub>R ket False"
 
 value "ket True + ket False"
 
 value "ket True - ket True"
 
 value "ket True = ket True"
 
 value "- ket True"
 
 value "cinner (ket True) (ket True)"
 
 value "norm (ket True)"
 
 value "ket () * ket ()"
 
 value "1 :: unit ell2"
 
 value "(1::unit ell2) * (1::unit ell2)"
 
 subsection \<open>Vector/Matrix\<close>
 
 value "id_cblinfun *\<^sub>V ket True"
 
 value \<open>vector_to_cblinfun (ket True) :: unit ell2 \<Rightarrow>\<^sub>C\<^sub>L _\<close>
 
 subsection \<open>Subspaces\<close>
 
 value "ccspan {ket False}"
 
 value "Proj (ccspan {ket False})"
 
 value "top :: bool ell2 ccsubspace"
 
 value "bot :: bool ell2 ccsubspace"
 
 value "0 :: bool ell2 ccsubspace"
 
 value "ccspan {ket False} \<squnion> ccspan {ket True}"
 
 value "ccspan {ket False} + ccspan {ket True}"
 
 value "ccspan {ket False} \<sqinter> ccspan {ket True}"
 
 value "id_cblinfun *\<^sub>S ccspan {ket False}"
 
 value "id_cblinfun *\<^sub>S (top :: bool ell2 ccsubspace)" (* Special case, using range_cblinfun_code for efficiency *)
 
 value "- ccspan {ket False}"
 
 value "ccspan {ket False, ket True} = top"
 
 value "ccspan {ket False} \<le> ccspan {ket True}"
 
 value "cblinfun_image id_cblinfun (ccspan {ket True})"
 
 value "kernel id_cblinfun :: bool ell2 ccsubspace"
 
 value "eigenspace 1 id_cblinfun :: bool ell2 ccsubspace"
 
 value "Inf {ccspan {ket False}, top}"
 
 value "Sup {ccspan {ket False}, top}"
 
 end
diff --git a/thys/Complex_Bounded_Operators/Cblinfun_Matrix.thy b/thys/Complex_Bounded_Operators/Cblinfun_Matrix.thy
--- a/thys/Complex_Bounded_Operators/Cblinfun_Matrix.thy
+++ b/thys/Complex_Bounded_Operators/Cblinfun_Matrix.thy
@@ -1,1554 +1,1552 @@
 section \<open>\<open>Cblinfun_Matrix\<close> -- Matrix representation of bounded operators\<close>
 
 theory Cblinfun_Matrix
   imports
     Complex_L2
 
     "Jordan_Normal_Form.Gram_Schmidt"
     "HOL-Analysis.Starlike"
     "Complex_Bounded_Operators.Extra_Jordan_Normal_Form"
 begin
 
 hide_const (open) Order.bottom Order.top
 hide_type (open) Finite_Cartesian_Product.vec
 hide_const (open) Finite_Cartesian_Product.mat
 hide_fact (open) Finite_Cartesian_Product.mat_def
 hide_const (open) Finite_Cartesian_Product.vec
 hide_fact (open) Finite_Cartesian_Product.vec_def
 hide_const (open) Finite_Cartesian_Product.row
 hide_fact (open) Finite_Cartesian_Product.row_def
 no_notation Finite_Cartesian_Product.vec_nth (infixl "$" 90)
 
 unbundle jnf_notation
 unbundle cblinfun_notation
 
 subsection \<open>Isomorphism between vectors\<close>
 
 text \<open>We define the canonical isomorphism between vectors in some complex vector space
   \<^typ>\<open>'a::basis_enum\<close> and the complex \<^term>\<open>n\<close>-dimensional vectors 
   (where \<^term>\<open>n\<close> is the dimension of \<^typ>\<open>'a\<close>).
   This is possible if \<^typ>\<open>'a\<close>, \<^typ>\<open>'b\<close> are of class \<^class>\<open>basis_enum\<close>
   since that class fixes a finite canonical basis. Vector are represented using
   the \<^typ>\<open>complex vec\<close> type from \<^session>\<open>Jordan_Normal_Form\<close>.
   (The isomorphism will be called \<^term>\<open>vec_of_onb_basis\<close> below.)\<close>
 
 definition vec_of_basis_enum :: \<open>'a::basis_enum \<Rightarrow> complex vec\<close> where
   \<comment> \<open>Maps \<^term>\<open>v\<close> to a \<^typ>\<open>'a vec\<close> represented in basis \<^const>\<open>canonical_basis\<close>\<close>
   \<open>vec_of_basis_enum v = vec_of_list (map (crepresentation (set canonical_basis) v) canonical_basis)\<close>
 
 lemma dim_vec_of_basis_enum'[simp]:
   \<open>dim_vec (vec_of_basis_enum (v::'a)) = length (canonical_basis::'a::basis_enum list)\<close>
   unfolding vec_of_basis_enum_def
   by simp
 
 definition basis_enum_of_vec :: \<open>complex vec \<Rightarrow> 'a::basis_enum\<close> where
   \<open>basis_enum_of_vec v =
     (if dim_vec v = length (canonical_basis :: 'a list)
-     then sum_list (map2 (*\<^sub>C) (list_of_vec v) (canonical_basis::'a list))
+     then sum_list (map2 (*\<^sub>C) (list_of_vec v) (canonical_basis :: 'a list))
      else 0)\<close>
 
 lemma vec_of_basis_enum_inverse[simp]:
-  fixes w::"'a::basis_enum"
-  shows  "basis_enum_of_vec (vec_of_basis_enum w) = w"
+  fixes \<psi> :: "'a::basis_enum"
+  shows  "basis_enum_of_vec (vec_of_basis_enum \<psi>) = \<psi>"
   unfolding vec_of_basis_enum_def basis_enum_of_vec_def
   unfolding list_vec zip_map1 zip_same_conv_map map_map
   apply (simp add: o_def)
   apply (subst sum.distinct_set_conv_list[symmetric], simp)
   apply (rule complex_vector.sum_representation_eq)
   using  is_generator_set by auto
 
 lemma basis_enum_of_vec_inverse[simp]:
-  fixes v::"complex vec"
+  fixes v :: "complex vec"
   defines "n \<equiv> length (canonical_basis :: 'a::basis_enum list)"
   assumes f1: "dim_vec v = n"
   shows "vec_of_basis_enum ((basis_enum_of_vec v)::'a) = v"
 proof (rule eq_vecI)
   show \<open>dim_vec (vec_of_basis_enum (basis_enum_of_vec v :: 'a)) = dim_vec v\<close>
     by (auto simp: vec_of_basis_enum_def f1 n_def)
 next
   fix j assume j_v: \<open>j < dim_vec v\<close>
   define w where "w = list_of_vec v"
   define basis where "basis = (canonical_basis::'a list)"
   have [simp]: "length w = n" "length basis = n" \<open>dim_vec v = n\<close> \<open>length (canonical_basis::'a list) = n\<close>
     \<open>j < n\<close>
     using j_v by (auto simp: f1 basis_def w_def n_def)
   have [simp]: \<open>cindependent (set basis)\<close> \<open>cspan (set basis) = UNIV\<close>
     by (auto simp: basis_def is_cindependent_set is_generator_set)
 
   have \<open>vec_of_basis_enum ((basis_enum_of_vec v)::'a) $ j
        = map (crepresentation (set basis) (sum_list (map2 (*\<^sub>C) w basis))) basis ! j\<close>
     by (auto simp: vec_of_list_index vec_of_basis_enum_def basis_enum_of_vec_def simp flip: w_def basis_def)
   also have \<open>\<dots> = crepresentation (set basis) (sum_list (map2 (*\<^sub>C) w basis)) (basis!j)\<close>
     by simp
   also have \<open>\<dots> = crepresentation (set basis) (\<Sum>i<n. (w!i) *\<^sub>C (basis!i)) (basis!j)\<close>
     by (auto simp: sum_list_sum_nth atLeast0LessThan)
   also have \<open>\<dots> = (\<Sum>i<n. (w!i) *\<^sub>C crepresentation (set basis) (basis!i) (basis!j))\<close>
     by (auto simp: complex_vector.representation_sum complex_vector.representation_scale)
   also have \<open>\<dots> = w!j\<close>
     apply (subst sum_single[where i=j])
       apply (auto simp: complex_vector.representation_basis)
     using \<open>j < n\<close> \<open>length basis = n\<close> basis_def distinct_canonical_basis nth_eq_iff_index_eq by blast
   also have \<open>\<dots> = v $ j\<close>
     by (simp add: w_def)
   finally show \<open>vec_of_basis_enum (basis_enum_of_vec v :: 'a) $ j = v $ j\<close>
     by -
 qed
 
 lemma basis_enum_eq_vec_of_basis_enumI:
   fixes a b :: "_::basis_enum"
   assumes "vec_of_basis_enum a = vec_of_basis_enum b"
   shows "a = b"
   by (metis assms vec_of_basis_enum_inverse)
 
-lemma vec_of_basis_enum_carrier_vec[simp]: \<open>vec_of_basis_enum v \<in> carrier_vec CARD('a)\<close> for v :: \<open>'a::enum ell2\<close>
+lemma vec_of_basis_enum_carrier_vec[simp]: \<open>vec_of_basis_enum v \<in> carrier_vec (canonical_basis_length TYPE('a))\<close> for v :: \<open>'a::basis_enum\<close>
   apply (simp only: dim_vec_of_basis_enum' carrier_vec_def vec_of_basis_enum_def)
-  by simp
+  by (simp add: canonical_basis_length)
+
+lemma vec_of_basis_enum_inj: "inj vec_of_basis_enum"
+  by (simp add: basis_enum_eq_vec_of_basis_enumI injI)
+
+lemma basis_enum_of_vec_inj: "inj_on (basis_enum_of_vec :: complex vec \<Rightarrow> 'a)
+      (carrier_vec (length (canonical_basis :: 'a::{basis_enum,complex_normed_vector} list)))"
+  by (metis basis_enum_of_vec_inverse carrier_dim_vec inj_on_inverseI)
 
 subsection \<open>Operations on vectors\<close>
 
 lemma basis_enum_of_vec_add:
   assumes [simp]: \<open>dim_vec v1 = length (canonical_basis :: 'a::basis_enum list)\<close>
     \<open>dim_vec v2 = length (canonical_basis :: 'a list)\<close>
   shows \<open>((basis_enum_of_vec (v1 + v2)) :: 'a) = basis_enum_of_vec v1 + basis_enum_of_vec v2\<close>
 proof -
   have \<open>length (list_of_vec v1) = length (list_of_vec v2)\<close> and \<open>length (list_of_vec v2) = length (canonical_basis :: 'a list)\<close>
     by simp_all
   then have \<open>sum_list (map2 (*\<^sub>C) (map2 (+) (list_of_vec v1) (list_of_vec v2)) (canonical_basis::'a list))
     = sum_list (map2 (*\<^sub>C) (list_of_vec v1) canonical_basis) + sum_list (map2 (*\<^sub>C) (list_of_vec v2) canonical_basis)\<close>
     apply (induction rule: list_induct3)
     by (auto simp: scaleC_add_left)
   then show ?thesis
     using assms by (auto simp: basis_enum_of_vec_def list_of_vec_plus)
 qed
 
 lemma basis_enum_of_vec_mult:
   assumes [simp]: \<open>dim_vec v = length (canonical_basis :: 'a::basis_enum list)\<close>
   shows \<open>((basis_enum_of_vec (c \<cdot>\<^sub>v v)) :: 'a) =  c *\<^sub>C basis_enum_of_vec v\<close>
 proof -
   have *: \<open>monoid_add_hom ((*\<^sub>C) c :: 'a \<Rightarrow> _)\<close>
     by (simp add: monoid_add_hom_def plus_hom.intro scaleC_add_right semigroup_add_hom.intro zero_hom.intro)
   show ?thesis
     apply (auto simp: basis_enum_of_vec_def list_of_vec_mult map_zip_map
         monoid_add_hom.hom_sum_list[OF *])
     by (metis case_prod_unfold comp_apply scaleC_scaleC)
 qed
 
 lemma vec_of_basis_enum_add:
-  "vec_of_basis_enum (b1 + b2) = vec_of_basis_enum b1 + vec_of_basis_enum b2"
+  \<open>vec_of_basis_enum (a + b) = vec_of_basis_enum a + vec_of_basis_enum b\<close>
   by (auto simp: vec_of_basis_enum_def complex_vector.representation_add)
 
 lemma vec_of_basis_enum_scaleC:
   "vec_of_basis_enum (c *\<^sub>C b) = c \<cdot>\<^sub>v (vec_of_basis_enum b)"
   by (auto simp: vec_of_basis_enum_def complex_vector.representation_scale)
 
 lemma vec_of_basis_enum_scaleR:
   "vec_of_basis_enum (r *\<^sub>R b) = complex_of_real r \<cdot>\<^sub>v (vec_of_basis_enum b)"
   by (simp add: scaleR_scaleC vec_of_basis_enum_scaleC)
 
 lemma vec_of_basis_enum_uminus:
   "vec_of_basis_enum (- b2) = - vec_of_basis_enum b2"
   unfolding scaleC_minus1_left[symmetric, of b2]
   unfolding scaleC_minus1_left_vec[symmetric]
   by (rule vec_of_basis_enum_scaleC)
 
 lemma vec_of_basis_enum_minus:
   "vec_of_basis_enum (b1 - b2) = vec_of_basis_enum b1 - vec_of_basis_enum b2"
   by (metis (mono_tags, opaque_lifting) carrier_vec_dim_vec diff_conv_add_uminus diff_zero index_add_vec(2) minus_add_uminus_vec vec_of_basis_enum_add vec_of_basis_enum_uminus)
 
 lemma cinner_basis_enum_of_vec:
   defines "n \<equiv> length (canonical_basis :: 'a::onb_enum list)"
   assumes [simp]: "dim_vec x = n" "dim_vec y = n"
   shows  "(basis_enum_of_vec x :: 'a) \<bullet>\<^sub>C basis_enum_of_vec y = y \<bullet>c x"
 proof -
   have \<open>(basis_enum_of_vec x :: 'a) \<bullet>\<^sub>C basis_enum_of_vec y
     = (\<Sum>i<n. x$i *\<^sub>C canonical_basis ! i :: 'a) \<bullet>\<^sub>C (\<Sum>i<n. y$i *\<^sub>C canonical_basis ! i)\<close>
     by (auto simp: basis_enum_of_vec_def sum_list_sum_nth atLeast0LessThan simp flip: n_def)
   also have \<open>\<dots> = (\<Sum>i<n. \<Sum>j<n. cnj (x$i) *\<^sub>C y$j *\<^sub>C ((canonical_basis ! i :: 'a) \<bullet>\<^sub>C (canonical_basis ! j)))\<close>
     apply (subst cinner_sum_left)
     apply (subst cinner_sum_right)
     by (auto simp: mult_ac)
   also have \<open>\<dots> = (\<Sum>i<n. \<Sum>j<n. cnj (x$i) *\<^sub>C y$j *\<^sub>C (if i=j then 1 else 0))\<close>
     apply (rule sum.cong[OF refl])
     apply (rule sum.cong[OF refl])
     by (auto simp: cinner_canonical_basis n_def)
   also have \<open>\<dots> = (\<Sum>i<n. cnj (x$i) *\<^sub>C y$i)\<close>
     apply (rule sum.cong[OF refl])
     apply (subst sum_single)
     by auto
   also have \<open>\<dots> = y \<bullet>c x\<close>
     by (smt (z3) assms(2) complex_scaleC_def conjugate_complex_def dim_vec_conjugate lessThan_atLeast0 lessThan_iff mult.commute scalar_prod_def sum.cong vec_index_conjugate)
   finally show ?thesis
     by -
 qed
 
 lemma cscalar_prod_vec_of_basis_enum: "cscalar_prod (vec_of_basis_enum \<phi>) (vec_of_basis_enum \<psi>) = cinner \<psi> \<phi>"
   for \<psi> :: "'a::onb_enum"
   apply (subst cinner_basis_enum_of_vec[symmetric, where 'a='a])
   by simp_all
 
 definition \<open>norm_vec \<psi> = sqrt (\<Sum> i \<in> {0 ..< dim_vec \<psi>}. let z = vec_index \<psi> i in (Re z)\<^sup>2 + (Im z)\<^sup>2)\<close>
 
-lemma norm_ell2_vec_of_basis_enum: \<open>norm \<psi> = norm_vec (vec_of_basis_enum \<psi>)\<close> for \<psi> :: "'a::onb_enum"
+lemma norm_vec_of_basis_enum: \<open>norm \<psi> = norm_vec (vec_of_basis_enum \<psi>)\<close> for \<psi> :: "'a::onb_enum"
 proof -
   have "norm \<psi> = sqrt (cmod (\<Sum>i = 0..<dim_vec (vec_of_basis_enum \<psi>).
             vec_of_basis_enum \<psi> $ i * conjugate (vec_of_basis_enum \<psi>) $ i))"
     unfolding norm_eq_sqrt_cinner[where 'a='a] cscalar_prod_vec_of_basis_enum[symmetric] scalar_prod_def dim_vec_conjugate
     by rule
   also have "\<dots> = sqrt (cmod (\<Sum>x = 0..<dim_vec (vec_of_basis_enum \<psi>).
                     let z = vec_of_basis_enum \<psi> $ x in (Re z)\<^sup>2 + (Im z)\<^sup>2))"
     apply (subst sum.cong, rule refl)
      apply (subst vec_index_conjugate)
     by (auto simp: Let_def complex_mult_cnj)
   also have "\<dots> = norm_vec (vec_of_basis_enum \<psi>)"
     unfolding Let_def norm_of_real norm_vec_def
     apply (subst abs_of_nonneg)
      apply (rule sum_nonneg)
     by auto
   finally show ?thesis
     by -
 qed
 
 lemma basis_enum_of_vec_unit_vec:
   defines "basis \<equiv> (canonical_basis::'a::basis_enum list)"
     and "n \<equiv> length (canonical_basis :: 'a list)"
   assumes a3: "i < n"
   shows "basis_enum_of_vec (unit_vec n i) = basis!i"
 proof-
   define L::"complex list" where "L = list_of_vec (unit_vec n i)"
   define I::"nat list" where "I = [0..<n]"
   have "length L = n"
     by (simp add: L_def)
   moreover have "length basis = n"
     by (simp add: basis_def n_def)
   ultimately have "map2 (*\<^sub>C) L basis = map (\<lambda>j. L!j *\<^sub>C basis!j) I"
     by (simp add: I_def list_eq_iff_nth_eq)
   hence "sum_list (map2 (*\<^sub>C) L basis) = sum_list (map (\<lambda>j. L!j *\<^sub>C basis!j) I)"
     by simp
   also have "\<dots> = sum (\<lambda>j. L!j *\<^sub>C basis!j) {0..n-1}"
   proof-
     have "set I = {0..n-1}"
       using I_def a3 by auto
     thus ?thesis
       using Groups_List.sum_code[where xs = I and g = "(\<lambda>j. L!j *\<^sub>C basis!j)"]
       by (simp add: I_def)
   qed
   also have "\<dots> = sum (\<lambda>j. (list_of_vec (unit_vec n i))!j *\<^sub>C basis!j) {0..n-1}"
     unfolding L_def by blast
   finally have "sum_list (map2 (*\<^sub>C) (list_of_vec (unit_vec n i)) basis)
        = sum (\<lambda>j. (list_of_vec (unit_vec n i))!j *\<^sub>C basis!j) {0..n-1}"
     using L_def by blast
   also have "\<dots> = basis ! i"
   proof-
     have "(\<Sum>j = 0..n - 1. list_of_vec (unit_vec n i) ! j *\<^sub>C basis ! j) =
           (\<Sum>j \<in> {0..n - 1}. list_of_vec (unit_vec n i) ! j *\<^sub>C basis ! j)"
       by simp
     also have "\<dots> = list_of_vec (unit_vec n i) ! i *\<^sub>C basis ! i
                + (\<Sum>j \<in> {0..n - 1}-{i}. list_of_vec (unit_vec n i) ! j *\<^sub>C basis ! j)"
     proof-
       define a where "a j = list_of_vec (unit_vec n i) ! j *\<^sub>C basis ! j" for j
       define S where "S = {0..n - 1}"
       have "finite S"
         by (simp add: S_def)
       hence "(\<Sum>j \<in> insert i S. a j) = a i + (\<Sum>j\<in>S-{i}. a j)"
         using Groups_Big.comm_monoid_add_class.sum.insert_remove
         by auto
       moreover have "S-{i} = {0..n-1}-{i}"
         unfolding S_def
         by blast
       moreover have "insert i S = {0..n-1}"
         using S_def Suc_diff_1 a3 atLeastAtMost_iff diff_is_0_eq' le_SucE le_numeral_extra(4)
           less_imp_le not_gr_zero
         by fastforce
       ultimately show ?thesis
         using \<open>a \<equiv> \<lambda>j. list_of_vec (unit_vec n i) ! j *\<^sub>C basis ! j\<close>
         by simp
     qed
     also have "\<dots> = list_of_vec (unit_vec n i) ! i *\<^sub>C basis ! i"
     proof-
       have "j \<in> {0..n - 1}-{i} \<Longrightarrow> list_of_vec (unit_vec n i) ! j = 0"
         for j
         using a3 atMost_atLeast0 atMost_iff diff_Suc_less index_unit_vec(1) le_less_trans
           list_of_vec_index member_remove zero_le by fastforce
       hence "j \<in> {0..n - 1}-{i} \<Longrightarrow> list_of_vec (unit_vec n i) ! j *\<^sub>C basis ! j = 0"
         for j
         by auto
       hence "(\<Sum>j \<in> {0..n - 1}-{i}. list_of_vec (unit_vec n i) ! j *\<^sub>C basis ! j) = 0"
         by (simp add: \<open>\<And>j. j \<in> {0..n - 1} - {i} \<Longrightarrow> list_of_vec (unit_vec n i) ! j *\<^sub>C basis ! j = 0\<close>)
       thus ?thesis by simp
     qed
     also have "\<dots> = basis ! i"
       by (simp add: a3)
     finally show ?thesis
       using \<open>(\<Sum>j = 0..n - 1. list_of_vec (unit_vec n i) ! j *\<^sub>C basis ! j)
              = list_of_vec (unit_vec n i) ! i *\<^sub>C basis ! i + (\<Sum>j\<in>{0..n - 1} - {i}. list_of_vec (unit_vec n i) ! j *\<^sub>C basis ! j)\<close>
         \<open>list_of_vec (unit_vec n i) ! i *\<^sub>C basis ! i + (\<Sum>j\<in>{0..n - 1} - {i}. list_of_vec (unit_vec n i) ! j *\<^sub>C basis ! j)
            = list_of_vec (unit_vec n i) ! i *\<^sub>C basis ! i\<close>
         \<open>list_of_vec (unit_vec n i) ! i *\<^sub>C basis ! i = basis ! i\<close>
       by auto
   qed
   finally have "sum_list (map2 (*\<^sub>C) (list_of_vec (unit_vec n i)) basis)
       = basis ! i"
     by (simp add: assms)
   hence "sum_list (map2 scaleC (list_of_vec (unit_vec n i)) (canonical_basis::'a list))
       = (canonical_basis::'a list) ! i"
     by (simp add: assms)
   thus ?thesis
     unfolding basis_enum_of_vec_def
     by (simp add: assms)
 qed
 
 lemma vec_of_basis_enum_ket:
   "vec_of_basis_enum (ket i) = unit_vec (CARD('a)) (enum_idx i)"
   for i::"'a::enum"
 proof-
   have "dim_vec (vec_of_basis_enum (ket i))
       = dim_vec (unit_vec (CARD('a)) (enum_idx i))"
   proof-
     have "dim_vec (unit_vec (CARD('a)) (enum_idx i))
       = CARD('a)"
       by simp
     moreover have "dim_vec (vec_of_basis_enum (ket i)) = CARD('a)"
       unfolding vec_of_basis_enum_def vec_of_basis_enum_def by auto
     ultimately show ?thesis by simp
   qed
   moreover have "vec_of_basis_enum (ket i) $ j =
     (unit_vec (CARD('a)) (enum_idx i)) $ j"
     if "j < dim_vec (vec_of_basis_enum (ket i))"
     for j
   proof-
     have j_bound: "j < length (canonical_basis::'a ell2 list)"
       by (metis dim_vec_of_basis_enum' that)
     have y1: "cindependent (set (canonical_basis::'a ell2 list))"
       using is_cindependent_set by blast
     have y2: "canonical_basis ! j \<in> set (canonical_basis::'a ell2 list)"
       using j_bound by auto
     have p1: "enum_class.enum ! enum_idx i = i"
       using enum_idx_correct by blast
     moreover have p2: "(canonical_basis::'a ell2 list) ! t  = ket ((enum_class.enum::'a list) ! t)"
       if "t < length (enum_class.enum::'a list)"
       for t
       unfolding canonical_basis_ell2_def
       using that by auto
     moreover have p3: "enum_idx i < length (enum_class.enum::'a list)"
     proof-
       have "set (enum_class.enum::'a list) = UNIV"
         using UNIV_enum by blast
       hence "i \<in> set (enum_class.enum::'a list)"
         by blast
       thus ?thesis
         unfolding enum_idx_def
         by (metis index_of_bound length_greater_0_conv length_pos_if_in_set)
     qed
     ultimately have p4: "(canonical_basis::'a ell2 list) ! (enum_idx i)  = ket i"
       by auto
     have "enum_idx i < length (enum_class.enum::'a list)"
       using p3
       by auto
     moreover have "length (enum_class.enum::'a list) = dim_vec (vec_of_basis_enum (ket i))"
       unfolding vec_of_basis_enum_def canonical_basis_ell2_def
       using dim_vec_of_basis_enum'[where v = "ket i"]
       unfolding canonical_basis_ell2_def by simp
     ultimately have enum_i_dim_vec: "enum_idx i < dim_vec (unit_vec (CARD('a)) (enum_idx i))"
       using \<open>dim_vec (vec_of_basis_enum (ket i)) = dim_vec (unit_vec (CARD('a)) (enum_idx i))\<close> by auto
     hence r1: "(unit_vec (CARD('a)) (enum_idx i)) $ j
         = (if enum_idx i = j then 1 else 0)"
       using \<open>dim_vec (vec_of_basis_enum (ket i)) = dim_vec (unit_vec (CARD('a)) (enum_idx i))\<close> that by auto
     moreover have "vec_of_basis_enum (ket i) $ j = (if enum_idx i = j then 1 else 0)"
     proof(cases "enum_idx i = j")
       case True
       have "crepresentation (set (canonical_basis::'a ell2 list))
           ((canonical_basis::'a ell2 list) ! j) ((canonical_basis::'a ell2 list) ! j) = 1"
         using y1 y2 complex_vector.representation_basis[where
             basis = "set (canonical_basis::'a ell2 list)"
             and b = "(canonical_basis::'a ell2 list) ! j"]
         by smt
 
       hence "vec_of_basis_enum ((canonical_basis::'a ell2 list) ! j) $ j = 1"
         unfolding vec_of_basis_enum_def
         by (metis j_bound nth_map vec_of_list_index)
       hence "vec_of_basis_enum ((canonical_basis::'a ell2 list) ! (enum_idx i))
             $ enum_idx i = 1"
         using True by simp
       hence "vec_of_basis_enum (ket i) $ enum_idx i = 1"
         using p4
         by simp
       thus ?thesis using True unfolding vec_of_basis_enum_def by auto
     next
       case False
       have "crepresentation (set (canonical_basis::'a ell2 list))
           ((canonical_basis::'a ell2 list) ! (enum_idx i)) ((canonical_basis::'a ell2 list) ! j) = 0"
         using y1 y2 complex_vector.representation_basis[where
             basis = "set (canonical_basis::'a ell2 list)"
             and b = "(canonical_basis::'a ell2 list) ! j"]
         by (metis (mono_tags, opaque_lifting) False enum_i_dim_vec basis_enum_of_vec_inverse
             basis_enum_of_vec_unit_vec canonical_basis_length_ell2 index_unit_vec(3) j_bound
             list_of_vec_index list_vec nth_map r1 vec_of_basis_enum_def)
       hence "vec_of_basis_enum ((canonical_basis::'a ell2 list) ! (enum_idx i)) $ j = 0"
         unfolding vec_of_basis_enum_def by (smt j_bound nth_map vec_of_list_index)
       hence "vec_of_basis_enum ((canonical_basis::'a ell2 list) ! (enum_idx i)) $ j = 0"
         by auto
       hence "vec_of_basis_enum (ket i) $ j = 0"
         using p4
         by simp
       thus ?thesis using False unfolding vec_of_basis_enum_def by simp
     qed
     ultimately show ?thesis by auto
   qed
   ultimately show ?thesis
     using Matrix.eq_vecI
     by auto
 qed
 
 lemma vec_of_basis_enum_zero:
   defines "nA \<equiv> length (canonical_basis :: 'a::basis_enum list)"
   shows "vec_of_basis_enum (0::'a) = 0\<^sub>v nA"
   by (metis assms carrier_vecI dim_vec_of_basis_enum' minus_cancel_vec right_minus_eq vec_of_basis_enum_minus)
 
 lemma (in complex_vec_space) vec_of_basis_enum_cspan:
   fixes X :: "'a::basis_enum set"
   assumes "length (canonical_basis :: 'a list) = n"
   shows "vec_of_basis_enum ` cspan X = span (vec_of_basis_enum ` X)"
 proof -
   have carrier: "vec_of_basis_enum ` X \<subseteq> carrier_vec n"
     by (metis assms carrier_vecI dim_vec_of_basis_enum' image_subsetI)
   have lincomb_sum: "lincomb c A = vec_of_basis_enum (\<Sum>b\<in>B. c' b *\<^sub>C b)"
     if B_def: "B = basis_enum_of_vec ` A" and \<open>finite A\<close>
       and AX: "A \<subseteq> vec_of_basis_enum ` X" and c'_def: "\<And>b. c' b = c (vec_of_basis_enum b)"
     for c c' A and B::"'a set"
     unfolding B_def using \<open>finite A\<close> AX
   proof induction
     case empty
     then show ?case
       by (simp add: assms vec_of_basis_enum_zero)
   next
     case (insert x F)
     then have IH: "lincomb c F = vec_of_basis_enum (\<Sum>b\<in>basis_enum_of_vec ` F. c' b *\<^sub>C b)"
       (is "_ = ?sum")
       by simp
     have xx: "vec_of_basis_enum (basis_enum_of_vec x :: 'a) = x"
       apply (rule basis_enum_of_vec_inverse)
       using assms carrier carrier_vecD insert.prems by auto
     have "lincomb c (insert x F) = c x \<cdot>\<^sub>v x + lincomb c F"
       apply (rule lincomb_insert2)
       using insert.hyps insert.prems carrier by auto
     also have "c x \<cdot>\<^sub>v x = vec_of_basis_enum (c' (basis_enum_of_vec x) *\<^sub>C (basis_enum_of_vec x :: 'a))"
       by (simp add: xx vec_of_basis_enum_scaleC c'_def)
     also note IH
     also have
       "vec_of_basis_enum (c' (basis_enum_of_vec x) *\<^sub>C (basis_enum_of_vec x :: 'a)) + ?sum
           = vec_of_basis_enum (\<Sum>b\<in>basis_enum_of_vec ` insert x F. c' b *\<^sub>C b)"
       apply simp apply (rule sym)
       apply (subst sum.insert)
       using \<open>finite F\<close> \<open>x \<notin> F\<close> dim_vec_of_basis_enum' insert.prems
         vec_of_basis_enum_add c'_def by auto
     finally show ?case
       by -
   qed
 
   show ?thesis
   proof auto
     fix x assume "x \<in> local.span (vec_of_basis_enum ` X)"
     then obtain c A where xA: "x = lincomb c A" and "finite A" and AX: "A \<subseteq> vec_of_basis_enum ` X"
       unfolding span_def by auto
     define B::"'a set" and c' where "B = basis_enum_of_vec ` A"
       and "c' b = c (vec_of_basis_enum b)" for b::'a
     note xA
     also have "lincomb c A = vec_of_basis_enum (\<Sum>b\<in>B. c' b *\<^sub>C b)"
       using B_def \<open>finite A\<close> AX c'_def by (rule lincomb_sum)
     also have "\<dots> \<in> vec_of_basis_enum ` cspan X"
       unfolding complex_vector.span_explicit
       apply (rule imageI) apply (rule CollectI)
       apply (rule exI) apply (rule exI)
       using \<open>finite A\<close> AX by (auto simp: B_def)
     finally show "x \<in> vec_of_basis_enum ` cspan X"
       by -
   next
     fix x assume "x \<in> cspan X"
     then obtain c' B where x: "x = (\<Sum>b\<in>B. c' b *\<^sub>C b)" and "finite B" and BX: "B \<subseteq> X"
       unfolding complex_vector.span_explicit by auto
     define A and c where "A = vec_of_basis_enum ` B"
       and "c b = c' (basis_enum_of_vec b)" for b
     have "vec_of_basis_enum x = vec_of_basis_enum (\<Sum>b\<in>B. c' b *\<^sub>C b)"
       using x by simp
     also have "\<dots> = lincomb c A"
       apply (rule lincomb_sum[symmetric])
       unfolding A_def c_def using BX \<open>finite B\<close>
       by (auto simp: image_image)
     also have "\<dots> \<in> span (vec_of_basis_enum ` X)"
       unfolding span_def apply (rule CollectI)
       apply (rule exI, rule exI)
       unfolding A_def using \<open>finite B\<close> BX by auto
     finally show "vec_of_basis_enum x \<in> local.span (vec_of_basis_enum ` X)"
       by -
   qed
 qed
 
 lemma (in complex_vec_space) basis_enum_of_vec_span:
   assumes "length (canonical_basis :: 'a list) = n"
   assumes "Y \<subseteq> carrier_vec n"
   shows "basis_enum_of_vec ` local.span Y = cspan (basis_enum_of_vec ` Y :: 'a::basis_enum set)"
 proof -
   define X::"'a set" where "X = basis_enum_of_vec ` Y"
   then have "cspan (basis_enum_of_vec ` Y :: 'a set) = basis_enum_of_vec ` vec_of_basis_enum ` cspan X"
     by (simp add: image_image)
   also have "\<dots> = basis_enum_of_vec ` local.span (vec_of_basis_enum ` X)"
     apply (subst vec_of_basis_enum_cspan)
     using assms by simp_all
   also have "vec_of_basis_enum ` X = Y"
     unfolding X_def image_image
     apply (rule image_cong[where g=id and M=Y and N=Y, simplified])
     using assms(1) assms(2) by auto
   finally show ?thesis
     by simp
 qed
 
 lemma vec_of_basis_enum_canonical_basis:
   assumes "i < length (canonical_basis :: 'a list)"
   shows "vec_of_basis_enum (canonical_basis!i :: 'a)
        = unit_vec (length (canonical_basis :: 'a::basis_enum list)) i"
   by (metis assms basis_enum_of_vec_inverse basis_enum_of_vec_unit_vec index_unit_vec(3))
 
 lemma vec_of_basis_enum_times:
   fixes \<psi> \<phi> :: "'a::one_dim"
   shows "vec_of_basis_enum (\<psi> * \<phi>)
    = vec_of_list [vec_index (vec_of_basis_enum \<psi>) 0 * vec_index (vec_of_basis_enum \<phi>) 0]"
 proof -
   have [simp]: \<open>crepresentation {1} x 1 = one_dim_iso x\<close> for x :: 'a
     apply (subst one_dim_scaleC_1[where x=x, symmetric])
     apply (subst complex_vector.representation_scale)
     by (auto simp add: complex_vector.span_base complex_vector.representation_basis)
   show ?thesis
     apply (rule eq_vecI)
     by (auto simp: vec_of_basis_enum_def)
 qed
 
 lemma vec_of_basis_enum_to_inverse:
   fixes \<psi> :: "'a::one_dim"
   shows "vec_of_basis_enum (inverse \<psi>) = vec_of_list [inverse (vec_index (vec_of_basis_enum \<psi>) 0)]"
 proof -
   have [simp]: \<open>crepresentation {1} x 1 = one_dim_iso x\<close> for x :: 'a
     apply (subst one_dim_scaleC_1[where x=x, symmetric])
     apply (subst complex_vector.representation_scale)
     by (auto simp add: complex_vector.span_base complex_vector.representation_basis)
   show ?thesis
     apply (rule eq_vecI)
      apply (auto simp: vec_of_basis_enum_def)
     by (metis complex_vector.scale_cancel_right one_dim_inverse one_dim_scaleC_1 zero_neq_one)
 qed
 
 lemma vec_of_basis_enum_divide:
   fixes \<psi> \<phi> :: "'a::one_dim"
   shows "vec_of_basis_enum (\<psi> / \<phi>)
    = vec_of_list [vec_index (vec_of_basis_enum \<psi>) 0 / vec_index (vec_of_basis_enum \<phi>) 0]"
   by (simp add: divide_inverse vec_of_basis_enum_to_inverse vec_of_basis_enum_times)
 
 lemma vec_of_basis_enum_1: "vec_of_basis_enum (1 :: 'a::one_dim) = vec_of_list [1]"
 proof -
   have [simp]: \<open>crepresentation {1} x 1 = one_dim_iso x\<close> for x :: 'a
     apply (subst one_dim_scaleC_1[where x=x, symmetric])
     apply (subst complex_vector.representation_scale)
     by (auto simp add: complex_vector.span_base complex_vector.representation_basis)
   show ?thesis
     apply (rule eq_vecI)
     by (auto simp: vec_of_basis_enum_def)
 qed
 
 lemma vec_of_basis_enum_ell2_component:
   fixes \<psi> :: \<open>'a::enum ell2\<close>
   assumes [simp]: \<open>i < CARD('a)\<close>
   shows \<open>vec_of_basis_enum \<psi> $ i = Rep_ell2 \<psi> (Enum.enum ! i)\<close>
 proof -
   let ?i = \<open>Enum.enum ! i\<close>
   have \<open>Rep_ell2 \<psi> (Enum.enum ! i) = ket ?i \<bullet>\<^sub>C \<psi>\<close>
     by (simp add: cinner_ket_left)
   also have \<open>\<dots> = vec_of_basis_enum \<psi> \<bullet>c vec_of_basis_enum (ket ?i :: 'a ell2)\<close>
     by (rule cscalar_prod_vec_of_basis_enum[symmetric])
   also have \<open>\<dots> = vec_of_basis_enum \<psi> \<bullet>c unit_vec (CARD('a)) i\<close>
     by (simp add: vec_of_basis_enum_ket enum_idx_enum)
   also have \<open>\<dots> = vec_of_basis_enum \<psi> \<bullet> unit_vec (CARD('a)) i\<close>
     by (smt (verit, best) assms carrier_vecI conjugate_conjugate_sprod conjugate_id conjugate_vec_sprod_comm dim_vec_conjugate eq_vecI index_unit_vec(3) scalar_prod_left_unit vec_index_conjugate)
   also have \<open>\<dots> = vec_of_basis_enum \<psi> $ i\<close>
     by simp
   finally show ?thesis
     by simp
 qed
 
 
 lemma corthogonal_vec_of_basis_enum:
   fixes S :: "'a::onb_enum list"
   shows "corthogonal (map vec_of_basis_enum S) \<longleftrightarrow> is_ortho_set (set S) \<and> distinct S"
 proof auto
   assume assm: \<open>corthogonal (map vec_of_basis_enum S)\<close>
   then show \<open>is_ortho_set (set S)\<close>
     by (smt (verit, ccfv_SIG) cinner_eq_zero_iff corthogonal_def cscalar_prod_vec_of_basis_enum in_set_conv_nth is_ortho_set_def length_map nth_map)
   show \<open>distinct S\<close>
     using assm corthogonal_distinct distinct_map by blast
 next
   assume \<open>is_ortho_set (set S)\<close> and \<open>distinct S\<close>
   then show \<open>corthogonal (map vec_of_basis_enum S)\<close>
     by (smt (verit, ccfv_threshold) cinner_eq_zero_iff corthogonalI cscalar_prod_vec_of_basis_enum is_ortho_set_def length_map length_map nth_eq_iff_index_eq nth_map nth_map nth_mem nth_mem)
 qed
 
 subsection \<open>Isomorphism between bounded linear functions and matrices\<close>
 
 
 text \<open>We define the canonical isomorphism between \<^typ>\<open>'a::basis_enum \<Rightarrow>\<^sub>C\<^sub>L'b::basis_enum\<close>
   and the complex \<^term>\<open>n*m\<close>-matrices (where n,m are the dimensions of \<^typ>\<open>'a\<close>, \<^typ>\<open>'b\<close>,
   respectively). This is possible if \<^typ>\<open>'a\<close>, \<^typ>\<open>'b\<close> are of class \<^class>\<open>basis_enum\<close>
   since that class fixes a finite canonical basis. Matrices are represented using
   the \<^typ>\<open>complex mat\<close> type from \<^session>\<open>Jordan_Normal_Form\<close>.
   (The isomorphism will be called \<^term>\<open>mat_of_cblinfun\<close> below.)\<close>
 
 definition mat_of_cblinfun :: \<open>'a::{basis_enum,complex_normed_vector} \<Rightarrow>\<^sub>C\<^sub>L'b::{basis_enum,complex_normed_vector} \<Rightarrow> complex mat\<close> where
   \<open>mat_of_cblinfun f =
     mat (length (canonical_basis :: 'b list)) (length (canonical_basis :: 'a list)) (
     \<lambda> (i, j). crepresentation (set (canonical_basis::'b list)) (f *\<^sub>V ((canonical_basis::'a list)!j)) ((canonical_basis::'b list)!i))\<close>
   for f
 
 lift_definition cblinfun_of_mat :: \<open>complex mat \<Rightarrow> 'a::{basis_enum,complex_normed_vector} \<Rightarrow>\<^sub>C\<^sub>L'b::{basis_enum,complex_normed_vector}\<close> is
-  \<open>\<lambda>M. \<lambda>v. (if M\<in>carrier_mat (length (canonical_basis :: 'b list)) (length (canonical_basis :: 'a list))
-           then basis_enum_of_vec (M *\<^sub>v vec_of_basis_enum v)
-           else 0)\<close>
-proof
+  \<open>\<lambda>M. if M\<in>carrier_mat (length (canonical_basis :: 'b list)) (length (canonical_basis :: 'a list))
+           then \<lambda>v. basis_enum_of_vec (M *\<^sub>v vec_of_basis_enum v)
+           else (\<lambda>v. 0)\<close>
+proof (intro bounded_clinear_finite_dim clinearI)
   fix M :: "complex mat"
   define m where "m = length (canonical_basis :: 'b list)"
   define n where "n = length (canonical_basis :: 'a list)"
   define f::"complex mat \<Rightarrow> 'a \<Rightarrow> 'b"
-    where "f M v = (if M\<in>carrier_mat m n
-        then basis_enum_of_vec (M *\<^sub>v vec_of_basis_enum (v::'a))
-        else (0::'b))"
-    for M::"complex mat" and v::'a
+    where "f M = (if M\<in>carrier_mat m n
+        then \<lambda>v. basis_enum_of_vec (M *\<^sub>v vec_of_basis_enum (v::'a))
+        else (\<lambda>v. 0))"
+    for M::"complex mat"
 
   show add: \<open>f M (b1 + b2) = f M b1 + f M b2\<close> for b1 b2
     apply (auto simp: f_def)
     by (metis (mono_tags, lifting) carrier_matD(1) carrier_vec_dim_vec dim_mult_mat_vec dim_vec_of_basis_enum' m_def mult_add_distrib_mat_vec n_def basis_enum_of_vec_add vec_of_basis_enum_add)
 
   show scale: \<open>f M (c *\<^sub>C b) = c *\<^sub>C f M b\<close> for c b
     apply (auto simp: f_def)
     by (metis carrier_matD(1) carrier_vec_dim_vec dim_mult_mat_vec dim_vec_of_basis_enum' m_def mult_mat_vec n_def basis_enum_of_vec_mult vec_of_basis_enum_scaleC)
-
-  from add scale have \<open>clinear (f M)\<close>
-    by (simp add: clinear_iff)
-
-  show \<open>\<exists>K. \<forall>b. norm (f M b) \<le> norm b * K\<close>
-  proof (cases "M\<in>carrier_mat m n")
-    case True
-    have f_def': "f M v = basis_enum_of_vec (M *\<^sub>v (vec_of_basis_enum v))" for v
-      using True f_def
-        m_def n_def by auto
-    have M_carrier_mat:
-      "M \<in> carrier_mat m n"
-      by (simp add: True)
-    have "bounded_clinear (f M)"
-      apply (rule bounded_clinear_finite_dim) using \<open>clinear (f M)\<close> by auto
-    thus ?thesis
-      by (simp add: bounded_clinear.bounded)
-  next
-    case False
-    thus ?thesis
-      unfolding f_def m_def n_def
-      by (metis (full_types) order_refl mult_eq_0_iff norm_eq_zero)
-  qed
 qed
 
 lemma cblinfun_of_mat_invalid: 
   assumes \<open>M \<notin> carrier_mat (canonical_basis_length TYPE('b::{basis_enum,complex_normed_vector})) (canonical_basis_length TYPE('a::{basis_enum,complex_normed_vector}))\<close>
   shows \<open>(cblinfun_of_mat M :: 'a \<Rightarrow>\<^sub>C\<^sub>L 'b) = 0\<close>
   apply (transfer fixing: M)
   using assms by (simp add: canonical_basis_length)
 
-lemma mat_of_cblinfun_ell2_carrier[simp]: \<open>mat_of_cblinfun (a::'a::enum ell2 \<Rightarrow>\<^sub>C\<^sub>L 'b::enum ell2) \<in> carrier_mat CARD('b) CARD('a)\<close>
-  by (simp add: mat_of_cblinfun_def)
+lemma dim_row_mat_of_cblinfun[simp]: \<open>dim_row (mat_of_cblinfun (a::'a::{basis_enum,complex_normed_vector} \<Rightarrow>\<^sub>C\<^sub>L 'b::{basis_enum,complex_normed_vector})) = canonical_basis_length TYPE('b)\<close>
+  by (simp add: mat_of_cblinfun_def canonical_basis_length)
 
-lemma dim_row_mat_of_cblinfun[simp]: \<open>dim_row (mat_of_cblinfun (a::'a::enum ell2 \<Rightarrow>\<^sub>C\<^sub>L 'b::enum ell2)) = CARD('b)\<close>
-  by (simp add: mat_of_cblinfun_def)
+lemma dim_col_mat_of_cblinfun[simp]: \<open>dim_col (mat_of_cblinfun (a::'a::{basis_enum,complex_normed_vector} \<Rightarrow>\<^sub>C\<^sub>L 'b::{basis_enum,complex_normed_vector})) = canonical_basis_length TYPE('a)\<close>
+  by (simp add: mat_of_cblinfun_def canonical_basis_length)
 
-lemma dim_col_mat_of_cblinfun[simp]: \<open>dim_col (mat_of_cblinfun (a::'a::enum ell2 \<Rightarrow>\<^sub>C\<^sub>L 'b::enum ell2)) = CARD('a)\<close>
-  by (simp add: mat_of_cblinfun_def)
+lemma mat_of_cblinfun_ell2_carrier[simp]: \<open>mat_of_cblinfun (a::'a::{basis_enum,complex_normed_vector} \<Rightarrow>\<^sub>C\<^sub>L 'b::{basis_enum,complex_normed_vector}) \<in> carrier_mat (canonical_basis_length TYPE('b)) (canonical_basis_length TYPE('a))\<close>
+  by (auto intro!: carrier_matI)
+
+lemma basis_enum_of_vec_cblinfun_apply:
+  fixes M :: "complex mat"
+  defines "nA \<equiv> length (canonical_basis :: 'a::{basis_enum,complex_normed_vector} list)"
+    and "nB \<equiv> length (canonical_basis :: 'b::{basis_enum,complex_normed_vector} list)"
+  assumes "M \<in> carrier_mat nB nA" and "dim_vec x = nA"
+  shows "basis_enum_of_vec (M *\<^sub>v x) = (cblinfun_of_mat M :: 'a \<Rightarrow>\<^sub>C\<^sub>L 'b) *\<^sub>V basis_enum_of_vec x"
+  by (metis assms basis_enum_of_vec_inverse cblinfun_of_mat.rep_eq)
 
 lemma mat_of_cblinfun_cblinfun_apply:
-  "vec_of_basis_enum (F *\<^sub>V u) = mat_of_cblinfun F *\<^sub>v vec_of_basis_enum u"
-  for F::"'a::{basis_enum,complex_normed_vector}  \<Rightarrow>\<^sub>C\<^sub>L 'b::{basis_enum,complex_normed_vector}" and u::'a
+  \<open>vec_of_basis_enum (F *\<^sub>V u) = mat_of_cblinfun F *\<^sub>v vec_of_basis_enum u\<close>
+  for F::"'a::{basis_enum,complex_normed_vector} \<Rightarrow>\<^sub>C\<^sub>L 'b::{basis_enum,complex_normed_vector}" and u::'a
 proof (rule eq_vecI)
   show \<open>dim_vec (vec_of_basis_enum (F *\<^sub>V u)) = dim_vec (mat_of_cblinfun F *\<^sub>v vec_of_basis_enum u)\<close>
     by (simp add: dim_vec_of_basis_enum' mat_of_cblinfun_def)
 next
   fix i
   define BasisA where "BasisA = (canonical_basis::'a list)"
   define BasisB where "BasisB = (canonical_basis::'b list)"
   define nA where "nA = length (canonical_basis :: 'a list)"
   define nB where "nB = length (canonical_basis :: 'b list)"
   assume \<open>i < dim_vec (mat_of_cblinfun F *\<^sub>v vec_of_basis_enum u)\<close>
   then have [simp]: \<open>i < nB\<close>
     by (simp add: mat_of_cblinfun_def nB_def)
   define v where \<open>v = BasisB ! i\<close>
 
-  have [simp]: \<open>dim_row (mat_of_cblinfun F) = nB\<close>
+  have dim_row_F[simp]: \<open>dim_row (mat_of_cblinfun F) = nB\<close>
     by (simp add: mat_of_cblinfun_def nB_def)
   have [simp]: \<open>length BasisB = nB\<close>
     by (simp add: nB_def BasisB_def)
   have [simp]: \<open>length BasisA = nA\<close>
     using BasisA_def nA_def by auto
   have [simp]: \<open>cindependent (set BasisA)\<close>
     using BasisA_def is_cindependent_set by auto
   have [simp]: \<open>cindependent (set BasisB)\<close>
     using BasisB_def is_cindependent_set by blast
   have [simp]: \<open>cspan (set BasisB) = UNIV\<close>
     by (simp add: BasisB_def is_generator_set)
   have [simp]: \<open>cspan (set BasisA) = UNIV\<close>
     by (simp add: BasisA_def is_generator_set)
 
   have \<open>(mat_of_cblinfun F *\<^sub>v vec_of_basis_enum u) $ i =
           (\<Sum>j = 0..<nA. row (mat_of_cblinfun F) i $ j * crepresentation (set BasisA) u (vec_of_list BasisA $ j))\<close>
-    by (auto simp: vec_of_basis_enum_def scalar_prod_def simp flip: BasisA_def)
+    using dim_row_F by (auto simp: mult_mat_vec_def vec_of_basis_enum_def scalar_prod_def simp flip: BasisA_def)
   also have \<open>\<dots> = (\<Sum>j = 0..<nA. crepresentation (set BasisB) (F *\<^sub>V BasisA ! j) v
                                  * crepresentation (set BasisA) u (BasisA ! j))\<close>
     apply (rule sum.cong[OF refl])
     by (auto simp: vec_of_list_index mat_of_cblinfun_def scalar_prod_def v_def simp flip: BasisA_def BasisB_def)
   also have \<open>\<dots> = crepresentation (set BasisB) (F *\<^sub>V u) v\<close> (is \<open>(\<Sum>j=_..<_. ?lhs v j) = _\<close>)
   proof (rule complex_vector.representation_eqI[symmetric, THEN fun_cong])
     show \<open>cindependent (set BasisB)\<close> \<open>F *\<^sub>V u \<in> cspan (set BasisB)\<close>
       by simp_all
     show only_basis: \<open>(\<Sum>j = 0..<nA. ?lhs b j) \<noteq> 0 \<Longrightarrow> b \<in> set BasisB\<close> for b
       by (metis (mono_tags, lifting) complex_vector.representation_ne_zero mult_not_zero sum.not_neutral_contains_not_neutral)
     then show \<open>finite {b. (\<Sum>j = 0..<nA. ?lhs b j) \<noteq> 0}\<close>
       by (smt (z3) List.finite_set finite_subset mem_Collect_eq subsetI)
     have \<open>(\<Sum>b | (\<Sum>j = 0..<nA. ?lhs b j) \<noteq> 0. (\<Sum>j = 0..<nA. ?lhs b j) *\<^sub>C b) =
             (\<Sum>b\<in>set BasisB. (\<Sum>j = 0..<nA. ?lhs b j) *\<^sub>C b)\<close>
       apply (rule sum.mono_neutral_left)
       using only_basis by auto
     also have \<open>\<dots> = (\<Sum>b\<in>set BasisB. (\<Sum>a\<in>set BasisA. crepresentation (set BasisB) (F *\<^sub>V a) b * crepresentation (set BasisA) u a) *\<^sub>C b)\<close>
       apply (subst sum.reindex_bij_betw[where h=\<open>nth BasisA\<close> and T=\<open>set BasisA\<close>])
        apply (metis BasisA_def \<open>length BasisA = nA\<close> atLeast0LessThan bij_betw_nth distinct_canonical_basis)
       by simp
     also have \<open>\<dots> = (\<Sum>a\<in>set BasisA. crepresentation (set BasisA) u a *\<^sub>C (\<Sum>b\<in>set BasisB. crepresentation (set BasisB) (F *\<^sub>V a) b *\<^sub>C b))\<close>
       apply (simp add: scaleC_sum_left scaleC_sum_right)
       apply (subst sum.swap)
       by (metis (no_types, lifting) mult.commute sum.cong)
     also have \<open>\<dots> = (\<Sum>a\<in>set BasisA. crepresentation (set BasisA) u a *\<^sub>C (F *\<^sub>V a))\<close>
       apply (subst complex_vector.sum_representation_eq)
       by auto
     also have \<open>\<dots> = F *\<^sub>V (\<Sum>a\<in>set BasisA. crepresentation (set BasisA) u a *\<^sub>C a)\<close>
       by (simp flip: cblinfun.scaleC_right cblinfun.sum_right)
     also have \<open>\<dots> = F *\<^sub>V u\<close>
       apply (subst complex_vector.sum_representation_eq)
       by auto
     finally show \<open>(\<Sum>b | (\<Sum>j = 0..<nA. ?lhs b j) \<noteq> 0. (\<Sum>j = 0..<nA. ?lhs b j) *\<^sub>C b) = F *\<^sub>V u\<close>
       by auto
   qed
   also have \<open>crepresentation (set BasisB) (F *\<^sub>V u) v = vec_of_basis_enum (F *\<^sub>V u) $ i\<close>
     by (auto simp: vec_of_list_index vec_of_basis_enum_def v_def simp flip: BasisB_def)
   finally show \<open>vec_of_basis_enum (F *\<^sub>V u) $ i = (mat_of_cblinfun F *\<^sub>v vec_of_basis_enum u) $ i\<close>
     by simp
 qed
 
-lemma basis_enum_of_vec_cblinfun_apply:
-  fixes M :: "complex mat"
-  defines "nA \<equiv> length (canonical_basis :: 'a::{basis_enum,complex_normed_vector} list)"
-    and "nB \<equiv> length (canonical_basis :: 'b::{basis_enum,complex_normed_vector} list)"
-  assumes "M \<in> carrier_mat nB nA" and "dim_vec x = nA"
-  shows "basis_enum_of_vec (M *\<^sub>v x) = (cblinfun_of_mat M :: 'a \<Rightarrow>\<^sub>C\<^sub>L 'b) *\<^sub>V basis_enum_of_vec x"
-  by (metis assms basis_enum_of_vec_inverse cblinfun_of_mat.rep_eq)
-
 lemma mat_of_cblinfun_inverse:
   "cblinfun_of_mat (mat_of_cblinfun B) = B"
   for B::"'a::{basis_enum,complex_normed_vector}  \<Rightarrow>\<^sub>C\<^sub>L 'b::{basis_enum,complex_normed_vector}"
 proof (rule cblinfun_eqI)
   fix x :: 'a define y where \<open>y = vec_of_basis_enum x\<close>
   then have \<open>cblinfun_of_mat (mat_of_cblinfun B) *\<^sub>V x = ((cblinfun_of_mat (mat_of_cblinfun B) :: 'a\<Rightarrow>\<^sub>C\<^sub>L'b) *\<^sub>V basis_enum_of_vec y)\<close>
     by simp
   also have \<open>\<dots> = basis_enum_of_vec (mat_of_cblinfun B *\<^sub>v vec_of_basis_enum (basis_enum_of_vec y :: 'a))\<close>
     apply (transfer fixing: B)
     by (simp add: mat_of_cblinfun_def)
   also have \<open>\<dots> = basis_enum_of_vec (vec_of_basis_enum (B *\<^sub>V x))\<close>
     by (simp add: mat_of_cblinfun_cblinfun_apply y_def)
   also have \<open>\<dots> = B *\<^sub>V x\<close>
     by simp
   finally show \<open>cblinfun_of_mat (mat_of_cblinfun B) *\<^sub>V x = B *\<^sub>V x\<close>
     by -
 qed
 
 lemma mat_of_cblinfun_inj: "inj mat_of_cblinfun"
   by (metis inj_on_def mat_of_cblinfun_inverse)
 
 lemma cblinfun_of_mat_inverse:
   fixes M::"complex mat"
   defines "nA \<equiv> length (canonical_basis :: 'a::{basis_enum,complex_normed_vector} list)"
     and "nB \<equiv> length (canonical_basis :: 'b::{basis_enum,complex_normed_vector} list)"
   assumes "M \<in> carrier_mat nB nA"
   shows "mat_of_cblinfun (cblinfun_of_mat M :: 'a \<Rightarrow>\<^sub>C\<^sub>L 'b) = M"
   by (smt (verit) assms(3) basis_enum_of_vec_inverse carrier_matD(1) carrier_vecD cblinfun_of_mat.rep_eq dim_mult_mat_vec eq_mat_on_vecI mat_carrier mat_of_cblinfun_def mat_of_cblinfun_cblinfun_apply nA_def nB_def)
 
 lemma cblinfun_of_mat_inj: "inj_on (cblinfun_of_mat::complex mat \<Rightarrow> 'a \<Rightarrow>\<^sub>C\<^sub>L 'b)
       (carrier_mat (length (canonical_basis :: 'b::{basis_enum,complex_normed_vector} list))
                    (length (canonical_basis :: 'a::{basis_enum,complex_normed_vector} list)))"
   using cblinfun_of_mat_inverse
   by (metis inj_onI)
 
 lemma cblinfun_eq_mat_of_cblinfunI:
   assumes "mat_of_cblinfun a = mat_of_cblinfun b"
   shows "a = b"
   by (metis assms mat_of_cblinfun_inverse)
 
 subsection \<open>Operations on matrices\<close>
 
 lemma cblinfun_of_mat_plus:
   defines "nA \<equiv> length (canonical_basis :: 'a::{basis_enum,complex_normed_vector} list)"
     and "nB \<equiv> length (canonical_basis :: 'b::{basis_enum,complex_normed_vector} list)"
   assumes [simp,intro]: "M \<in> carrier_mat nB nA" and [simp,intro]: "N \<in> carrier_mat nB nA"
   shows "(cblinfun_of_mat (M + N) :: 'a \<Rightarrow>\<^sub>C\<^sub>L 'b) = ((cblinfun_of_mat M + cblinfun_of_mat N))"
 proof -
   have [simp]: \<open>vec_of_basis_enum (v :: 'a) \<in> carrier_vec nA\<close> for v
     by (auto simp add: carrier_dim_vec dim_vec_of_basis_enum' nA_def)
   have [simp]: \<open>dim_row M = nB\<close> \<open>dim_row N = nB\<close>
     using carrier_matD(1) by auto
   show ?thesis
     apply (transfer fixing: M N)
     by (auto intro!: ext simp add: add_mult_distrib_mat_vec nA_def[symmetric] nB_def[symmetric]
         add_mult_distrib_mat_vec[where nr=nB and nc=nA] basis_enum_of_vec_add)
 qed
 
 lemma mat_of_cblinfun_zero:
   "mat_of_cblinfun (0 :: ('a::{basis_enum,complex_normed_vector}  \<Rightarrow>\<^sub>C\<^sub>L 'b::{basis_enum,complex_normed_vector}))
   = 0\<^sub>m (length (canonical_basis :: 'b list)) (length (canonical_basis :: 'a list))"
   unfolding mat_of_cblinfun_def
   by (auto simp: complex_vector.representation_zero)
 
 lemma mat_of_cblinfun_plus:
   "mat_of_cblinfun (F + G) = mat_of_cblinfun F + mat_of_cblinfun G"
   for F G::"'a::{basis_enum,complex_normed_vector} \<Rightarrow>\<^sub>C\<^sub>L'b::{basis_enum,complex_normed_vector}"
   by (auto simp add: mat_of_cblinfun_def cblinfun.add_left complex_vector.representation_add)
 
 lemma mat_of_cblinfun_id:
   "mat_of_cblinfun (id_cblinfun :: ('a::{basis_enum,complex_normed_vector} \<Rightarrow>\<^sub>C\<^sub>L'a)) = 1\<^sub>m (length (canonical_basis :: 'a list))"
   apply (rule eq_matI)
   by (auto simp: mat_of_cblinfun_def complex_vector.representation_basis is_cindependent_set nth_eq_iff_index_eq)
 
 lemma mat_of_cblinfun_1:
   "mat_of_cblinfun (1 :: ('a::one_dim \<Rightarrow>\<^sub>C\<^sub>L'b::one_dim)) = 1\<^sub>m 1"
   apply (rule eq_matI)
   by (auto simp: mat_of_cblinfun_def complex_vector.representation_basis nth_eq_iff_index_eq)
 
 lemma mat_of_cblinfun_uminus:
   "mat_of_cblinfun (- M) = - mat_of_cblinfun M"
   for M::"'a::{basis_enum,complex_normed_vector} \<Rightarrow>\<^sub>C\<^sub>L'b::{basis_enum,complex_normed_vector}"
 proof-
   define nA where "nA = length (canonical_basis :: 'a list)"
   define nB where "nB = length (canonical_basis :: 'b list)"
   have M1: "mat_of_cblinfun M \<in> carrier_mat nB nA"
     unfolding nB_def nA_def
     by (metis add.right_neutral add_carrier_mat mat_of_cblinfun_plus mat_of_cblinfun_zero nA_def
         nB_def zero_carrier_mat)
   have M2: "mat_of_cblinfun (-M) \<in> carrier_mat nB nA"
     by (metis add_carrier_mat mat_of_cblinfun_plus mat_of_cblinfun_zero diff_0 nA_def nB_def
         uminus_add_conv_diff zero_carrier_mat)
   have "mat_of_cblinfun (M - M) =  0\<^sub>m nB nA"
     unfolding nA_def nB_def
     by (simp add: mat_of_cblinfun_zero)
   moreover have "mat_of_cblinfun (M - M) = mat_of_cblinfun M + mat_of_cblinfun (- M)"
     by (metis mat_of_cblinfun_plus pth_2)
   ultimately have "mat_of_cblinfun M + mat_of_cblinfun (- M) = 0\<^sub>m nB nA"
     by simp
   thus ?thesis
     using M1 M2
     by (smt add_uminus_minus_mat assoc_add_mat comm_add_mat left_add_zero_mat minus_r_inv_mat
         uminus_carrier_mat)
 qed
 
 lemma mat_of_cblinfun_minus:
   "mat_of_cblinfun (M - N) = mat_of_cblinfun M - mat_of_cblinfun N"
   for M::"'a::{basis_enum,complex_normed_vector} \<Rightarrow>\<^sub>C\<^sub>L 'b::{basis_enum,complex_normed_vector}" and N::"'a \<Rightarrow>\<^sub>C\<^sub>L'b"
   by (smt (z3) add_uminus_minus_mat mat_of_cblinfun_uminus mat_carrier mat_of_cblinfun_def mat_of_cblinfun_plus pth_2)
 
 lemma cblinfun_of_mat_uminus:
   defines "nA \<equiv> length (canonical_basis :: 'a::{basis_enum,complex_normed_vector} list)"
     and "nB \<equiv> length (canonical_basis :: 'b::{basis_enum,complex_normed_vector} list)"
   assumes "M \<in> carrier_mat nB nA"
   shows "(cblinfun_of_mat (-M) :: 'a \<Rightarrow>\<^sub>C\<^sub>L 'b) = - cblinfun_of_mat M"
   by (smt assms add.group_axioms add.right_neutral add_minus_cancel add_uminus_minus_mat
       cblinfun_of_mat_plus group.inverse_inverse mat_of_cblinfun_inverse mat_of_cblinfun_zero
       minus_r_inv_mat uminus_carrier_mat)
 
 lemma cblinfun_of_mat_minus:
   fixes M::"complex mat"
   defines "nA \<equiv> length (canonical_basis :: 'a::{basis_enum,complex_normed_vector} list)"
     and "nB \<equiv> length (canonical_basis :: 'b::{basis_enum,complex_normed_vector} list)"
   assumes "M \<in> carrier_mat nB nA" and "N \<in> carrier_mat nB nA"
   shows "(cblinfun_of_mat (M - N) :: 'a \<Rightarrow>\<^sub>C\<^sub>L 'b) = cblinfun_of_mat M - cblinfun_of_mat N"
   by (metis assms add_uminus_minus_mat cblinfun_of_mat_plus cblinfun_of_mat_uminus pth_2 uminus_carrier_mat)
 
 lemma cblinfun_of_mat_times:
   fixes M N ::"complex mat"
   defines "nA \<equiv> length (canonical_basis :: 'a::{basis_enum,complex_normed_vector} list)"
     and "nB \<equiv> length (canonical_basis :: 'b::{basis_enum,complex_normed_vector} list)"
     and "nC \<equiv> length (canonical_basis :: 'c::{basis_enum,complex_normed_vector} list)"
   assumes a1: "M \<in> carrier_mat nC nB" and a2: "N \<in> carrier_mat nB nA"
   shows  "cblinfun_of_mat (M * N) = ((cblinfun_of_mat M)::'b \<Rightarrow>\<^sub>C\<^sub>L'c) o\<^sub>C\<^sub>L ((cblinfun_of_mat N)::'a \<Rightarrow>\<^sub>C\<^sub>L'b)"
 proof -
   have b1: "((cblinfun_of_mat M)::'b \<Rightarrow>\<^sub>C\<^sub>L'c) v = basis_enum_of_vec (M *\<^sub>v vec_of_basis_enum v)"
     for v
     by (metis assms(4) cblinfun_of_mat.rep_eq nB_def nC_def)
   have b2: "((cblinfun_of_mat N)::'a \<Rightarrow>\<^sub>C\<^sub>L'b) v = basis_enum_of_vec (N *\<^sub>v vec_of_basis_enum v)"
     for v
     by (metis assms(5) cblinfun_of_mat.rep_eq nA_def nB_def)
   have b3: "((cblinfun_of_mat (M * N))::'a \<Rightarrow>\<^sub>C\<^sub>L'c) v
        = basis_enum_of_vec ((M * N) *\<^sub>v vec_of_basis_enum v)"
     for v
     by (metis assms(4) assms(5) cblinfun_of_mat.rep_eq mult_carrier_mat nA_def nC_def)
   have "(basis_enum_of_vec ((M * N) *\<^sub>v vec_of_basis_enum v)::'c)
       = (basis_enum_of_vec (M *\<^sub>v ( vec_of_basis_enum ( (basis_enum_of_vec (N *\<^sub>v vec_of_basis_enum v))::'b ))))"
     for v::'a
   proof-
     have c1: "vec_of_basis_enum (basis_enum_of_vec x :: 'b) = x"
       if "dim_vec x = nB"
       for x::"complex vec"
       using that unfolding nB_def
       by simp
     have c2: "vec_of_basis_enum v \<in> carrier_vec nA"
       by (metis (mono_tags, opaque_lifting) add.commute carrier_vec_dim_vec index_add_vec(2)
           index_zero_vec(2) nA_def vec_of_basis_enum_add basis_enum_of_vec_inverse)
     have "(M * N) *\<^sub>v vec_of_basis_enum v = M *\<^sub>v (N *\<^sub>v vec_of_basis_enum v)"
       using Matrix.assoc_mult_mat_vec a1 a2 c2 by blast
     hence "(basis_enum_of_vec ((M * N) *\<^sub>v vec_of_basis_enum v)::'c)
         = (basis_enum_of_vec (M *\<^sub>v (N *\<^sub>v vec_of_basis_enum v))::'c)"
       by simp
     also have "\<dots> =
       (basis_enum_of_vec (M *\<^sub>v ( vec_of_basis_enum ( (basis_enum_of_vec (N *\<^sub>v vec_of_basis_enum v))::'b ))))"
       using c1 a2 by auto
     finally show ?thesis by simp
   qed
   thus ?thesis using b1 b2 b3
     by (simp add: cblinfun_eqI scaleC_cblinfun.rep_eq)
 qed
 
 lemma cblinfun_of_mat_adjoint:
   defines "nA \<equiv> length (canonical_basis :: 'a::onb_enum list)"
     and "nB \<equiv> length (canonical_basis :: 'b::onb_enum list)"
   fixes M:: "complex mat"
   assumes "M \<in> carrier_mat nB nA"
   shows "((cblinfun_of_mat (mat_adjoint M)) :: 'b \<Rightarrow>\<^sub>C\<^sub>L 'a) = (cblinfun_of_mat M)*"
 proof (rule adjoint_eqI)
   show "(cblinfun_of_mat (mat_adjoint M) *\<^sub>V x) \<bullet>\<^sub>C y = x \<bullet>\<^sub>C (cblinfun_of_mat M *\<^sub>V y)"
     for x::'b and y::'a
   proof-
     define u where "u = vec_of_basis_enum x"
     define v where "v = vec_of_basis_enum y"
     have c1: "vec_of_basis_enum ((cblinfun_of_mat (mat_adjoint M) *\<^sub>V x)::'a) = (mat_adjoint M) *\<^sub>v u"
       unfolding u_def
       by (metis (mono_tags, lifting) assms(3) cblinfun_of_mat_inverse map_carrier_mat mat_adjoint_def' mat_of_cblinfun_cblinfun_apply nA_def nB_def transpose_carrier_mat)
     have c2: "(vec_of_basis_enum ((cblinfun_of_mat M *\<^sub>V y)::'b))
         = M *\<^sub>v v"
       by (metis assms(3) cblinfun_of_mat_inverse mat_of_cblinfun_cblinfun_apply nA_def nB_def v_def)
     have c3: "dim_vec v = nA"
       unfolding v_def nA_def vec_of_basis_enum_def
       by (simp add:)
     have c4: "dim_vec u = nB"
       unfolding u_def nB_def vec_of_basis_enum_def
       by (simp add:)
     have "v \<bullet>c ((mat_adjoint M) *\<^sub>v u) = (M *\<^sub>v v) \<bullet>c u"
       using c3 c4 cscalar_prod_adjoint assms(3) by blast
     hence "v \<bullet>c (vec_of_basis_enum ((cblinfun_of_mat (mat_adjoint M) *\<^sub>V x)::'a))
         = (vec_of_basis_enum ((cblinfun_of_mat M *\<^sub>V y)::'b)) \<bullet>c u"
       using c1 c2 by simp
     thus "(cblinfun_of_mat (mat_adjoint M) *\<^sub>V x) \<bullet>\<^sub>C y = x \<bullet>\<^sub>C (cblinfun_of_mat M *\<^sub>V y)"
       unfolding u_def v_def
       by (simp add: cscalar_prod_vec_of_basis_enum)
   qed
 qed
 
+lemma mat_of_cblinfun_compose:
+  "mat_of_cblinfun (F o\<^sub>C\<^sub>L G) = mat_of_cblinfun F * mat_of_cblinfun G"
+  for F::"'b::{basis_enum,complex_normed_vector} \<Rightarrow>\<^sub>C\<^sub>L 'c::{basis_enum,complex_normed_vector}"
+    and G::"'a::{basis_enum,complex_normed_vector}  \<Rightarrow>\<^sub>C\<^sub>L 'b"
+  by (smt (verit, del_insts) cblinfun_of_mat_inverse mat_carrier mat_of_cblinfun_def mat_of_cblinfun_inverse cblinfun_of_mat_times mult_carrier_mat)
+
+lemma mat_of_cblinfun_scaleC:
+  "mat_of_cblinfun ((a::complex) *\<^sub>C F) = a \<cdot>\<^sub>m (mat_of_cblinfun F)"
+  for F :: "'a::{basis_enum,complex_normed_vector} \<Rightarrow>\<^sub>C\<^sub>L 'b::{basis_enum,complex_normed_vector}"
+  by (auto simp add: complex_vector.representation_scale mat_of_cblinfun_def)
+
+lemma mat_of_cblinfun_scaleR:
+  "mat_of_cblinfun ((a::real) *\<^sub>R F) = (complex_of_real a) \<cdot>\<^sub>m (mat_of_cblinfun F)"
+  unfolding scaleR_scaleC by (rule mat_of_cblinfun_scaleC)
+
+lemma mat_of_cblinfun_adj:
+  "mat_of_cblinfun (F*) = mat_adjoint (mat_of_cblinfun F)"
+  for F :: "'a::onb_enum \<Rightarrow>\<^sub>C\<^sub>L 'b::onb_enum"
+  by (metis (no_types, lifting) cblinfun_of_mat_inverse map_carrier_mat mat_adjoint_def' mat_carrier cblinfun_of_mat_adjoint mat_of_cblinfun_def mat_of_cblinfun_inverse transpose_carrier_mat)
+
+lemma mat_of_cblinfun_vector_to_cblinfun:
+  "mat_of_cblinfun (vector_to_cblinfun \<psi>)
+       = mat_of_cols (length (canonical_basis :: 'a list)) [vec_of_basis_enum \<psi>]"
+  for \<psi>::"'a::{basis_enum,complex_normed_vector}"
+  by (auto simp: mat_of_cols_Cons_index_0 mat_of_cblinfun_def vec_of_basis_enum_def vec_of_list_index)
+
+lemma mat_of_cblinfun_proj:
+  fixes a::"'a::onb_enum"
+  defines   "d \<equiv> length (canonical_basis :: 'a list)"
+    and "norm2 \<equiv> (vec_of_basis_enum a) \<bullet>c (vec_of_basis_enum a)"
+  shows  "mat_of_cblinfun (proj a) =
+      1 / norm2 \<cdot>\<^sub>m (mat_of_cols d [vec_of_basis_enum a]
+                 * mat_of_rows d [conjugate (vec_of_basis_enum a)])" (is \<open>_ = ?rhs\<close>)
+proof (cases "a = 0")
+  case False
+  have norm2: \<open>norm2 = (norm a)\<^sup>2\<close>
+    by (simp add: cscalar_prod_vec_of_basis_enum norm2_def cdot_square_norm[symmetric, simplified])
+  have [simp]: \<open>vec_of_basis_enum a \<in> carrier_vec d\<close>
+    by (simp add: carrier_vecI d_def)
+
+  have \<open>mat_of_cblinfun (proj a) = mat_of_cblinfun (proj (a /\<^sub>R norm a))\<close>
+    by (metis (mono_tags, opaque_lifting) ccspan_singleton_scaleC complex_vector.scale_eq_0_iff
+        nonzero_imp_inverse_nonzero norm_eq_zero scaleR_scaleC scale_left_imp_eq)
+  also have \<open>\<dots> = mat_of_cblinfun (selfbutter (a /\<^sub>R norm a))\<close>
+    apply (subst butterfly_eq_proj)
+    by (auto simp add: False)
+  also have \<open>\<dots> = 1/norm2 \<cdot>\<^sub>m mat_of_cblinfun (selfbutter a)\<close>
+    apply (simp add: mat_of_cblinfun_scaleC norm2)
+    by (simp add: inverse_eq_divide power2_eq_square)
+  also have \<open>\<dots> = 1 / norm2 \<cdot>\<^sub>m (mat_of_cblinfun (vector_to_cblinfun a :: complex \<Rightarrow>\<^sub>C\<^sub>L 'a) * mat_adjoint (mat_of_cblinfun (vector_to_cblinfun a :: complex \<Rightarrow>\<^sub>C\<^sub>L 'a)))\<close>
+    by (simp add: butterfly_def mat_of_cblinfun_compose mat_of_cblinfun_adj)
+  also have \<open>\<dots> = ?rhs\<close>
+    by (simp add: mat_of_cblinfun_vector_to_cblinfun mat_adjoint_def flip: d_def)
+  finally show ?thesis
+    by -
+next
+  case True
+  show ?thesis
+    apply (rule eq_matI)
+    by (auto simp: True mat_of_cblinfun_zero vec_of_basis_enum_zero scalar_prod_def  mat_of_rows_index
+        simp flip: d_def)
+qed
+
+lemma mat_of_cblinfun_ell2_component:
+  fixes a :: \<open>'a::enum ell2 \<Rightarrow>\<^sub>C\<^sub>L 'b::enum ell2\<close>
+  assumes [simp]: \<open>i < CARD('b)\<close> \<open>j < CARD('a)\<close>
+  shows \<open>mat_of_cblinfun a $$ (i,j) = Rep_ell2 (a *\<^sub>V ket (Enum.enum ! j)) (Enum.enum ! i)\<close>
+proof -
+  let ?i = \<open>Enum.enum ! i\<close> and ?j = \<open>Enum.enum ! j\<close> and ?aj = \<open>a *\<^sub>V ket (Enum.enum ! j)\<close>
+  have \<open>Rep_ell2 ?aj (Enum.enum ! i) = vec_of_basis_enum ?aj $ i\<close>
+    by (rule vec_of_basis_enum_ell2_component[symmetric], simp)
+  also have \<open>\<dots> = (mat_of_cblinfun a *\<^sub>v vec_of_basis_enum (ket (enum_class.enum ! j) :: 'a ell2)) $ i\<close>
+    by (simp add: mat_of_cblinfun_cblinfun_apply)
+  also have \<open>\<dots> = (mat_of_cblinfun a *\<^sub>v unit_vec CARD('a) j) $ i\<close>
+    by (simp add: vec_of_basis_enum_ket enum_idx_enum)
+  also have \<open>\<dots> = mat_of_cblinfun a $$ (i, j)\<close>
+    apply (subst mat_entry_explicit[where m=\<open>CARD('b)\<close>])
+    by (auto intro!: simp: canonical_basis_length)
+  finally show ?thesis
+    by auto
+qed
+
+lemma cblinfun_of_mat_mat:
+  shows \<open>cblinfun_of_mat (mat (CARD('b)) (CARD('a)) f) = explicit_cblinfun (\<lambda>(r::'b::enum) (c::'a::enum). f (enum_idx r, enum_idx c))\<close>
+  apply (intro equal_ket basis_enum_eq_vec_of_basis_enumI)
+  by (auto intro!: eq_vecI simp: enum_idx_correct enum_idx_enum vec_of_basis_enum_ket
+      mat_of_cblinfun_ell2_component canonical_basis_length cblinfun_of_mat_inverse index_row
+      mat_of_cblinfun_cblinfun_apply)
+
+lemma mat_of_cblinfun_explicit_cblinfun:
+  fixes f :: \<open>'a::enum \<Rightarrow> 'b::enum \<Rightarrow> complex\<close>
+  shows \<open>mat_of_cblinfun (explicit_cblinfun f) = mat (CARD('a)) (CARD('b)) (\<lambda>(r,c). f (Enum.enum!r) (Enum.enum!c))\<close>
+  by (auto intro!: cblinfun_of_mat_inj[where 'a=\<open>'b ell2\<close> and 'b=\<open>'a ell2\<close>, THEN inj_onD]
+      simp: cblinfun_of_mat_mat canonical_basis_length enum_idx_correct mat_of_cblinfun_inverse)
+
 lemma mat_of_cblinfun_classical_operator:
   fixes f::"'a::enum \<Rightarrow> 'b::enum option"
   shows "mat_of_cblinfun (classical_operator f) = mat (CARD('b)) (CARD('a))
            (\<lambda>(r,c). if f (Enum.enum!c) = Some (Enum.enum!r) then 1 else 0)"
 proof -
   define nA where "nA = CARD('a)"
   define nB where "nB = CARD('b)"
   define BasisA where "BasisA = (canonical_basis::'a ell2 list)"
   define BasisB where "BasisB = (canonical_basis::'b ell2 list)"
   have "mat_of_cblinfun (classical_operator f) \<in> carrier_mat nB nA"
-    unfolding nA_def nB_def by simp
+    by (auto simp: canonical_basis_length nA_def nB_def)
   moreover have "nA = CARD ('a)"
     unfolding nA_def
     by (simp add:)
   moreover have "nB = CARD ('b)"
     unfolding nB_def
     by (simp add:)
   ultimately have "mat_of_cblinfun (classical_operator f) \<in> carrier_mat (CARD('b)) (CARD('a))"
     unfolding nA_def nB_def
     by simp
   moreover have "(mat_of_cblinfun (classical_operator f))$$(r,c)
   = (mat (CARD('b)) (CARD('a))
     (\<lambda>(r,c). if f (Enum.enum!c) = Some (Enum.enum!r) then 1 else 0))$$(r,c)"
     if a1: "r < CARD('b)" and a2: "c < CARD('a)"
     for r c
   proof-
     have "CARD('a) = length (enum_class.enum::'a list)"
       using card_UNIV_length_enum[where 'a = 'a] .
     hence x1: "BasisA!c = ket ((Enum.enum::'a list)!c)"
       unfolding BasisA_def using a2 canonical_basis_ell2_def
         nth_map[where n = c and xs = "Enum.enum::'a list" and f = ket] by metis
     have cardb: "CARD('b) = length (enum_class.enum::'b list)"
       using card_UNIV_length_enum[where 'a = 'b] .
     hence x2: "BasisB!r = ket ((Enum.enum::'b list)!r)"
       unfolding BasisB_def using a1 canonical_basis_ell2_def
         nth_map[where n = r and xs = "Enum.enum::'b list" and f = ket] by metis
     have "inj (map (ket::'b \<Rightarrow>_))"
       by (meson injI ket_injective list.inj_map)
     hence "length (Enum.enum::'b list) = length (map (ket::'b \<Rightarrow>_) (Enum.enum::'b list))"
       by simp
     hence lengthBasisB: "CARD('b) = length BasisB"
       unfolding BasisB_def canonical_basis_ell2_def using cardb
       by smt
     have v1: "(mat_of_cblinfun (classical_operator f))$$(r,c) = 0"
       if c1: "f (Enum.enum!c) = None"
     proof-
       have "(classical_operator f) *\<^sub>V ket (Enum.enum!c)
           = (case f (Enum.enum!c) of None \<Rightarrow> 0 | Some i \<Rightarrow> ket i)"
         using classical_operator_ket_finite .
       also have "\<dots> = 0"
         using c1 by simp
       finally have "(classical_operator f) *\<^sub>V ket (Enum.enum!c) = 0" .
       hence *: "(classical_operator f) *\<^sub>V BasisA!c = 0"
         using x1 by simp
       hence "is_orthogonal (BasisB!r) (classical_operator f *\<^sub>V BasisA!c)"
         by simp
       thus ?thesis
         unfolding mat_of_cblinfun_def BasisA_def BasisB_def
         by (smt (verit, del_insts) BasisA_def * a1 a2 canonical_basis_length_ell2 complex_vector.representation_zero index_mat(1) old.prod.case)
     qed
     have v2: "(mat_of_cblinfun (classical_operator f))$$(r,c) = 0"
       if c1: "f (Enum.enum!c) = Some (Enum.enum!r')" and c2: "r\<noteq>r'"
         and c3: "r' < CARD('b)"
       for r'
     proof-
       have x3: "BasisB!r' = ket ((Enum.enum::'b list)!r')"
         unfolding BasisB_def using cardb c3 canonical_basis_ell2_def
           nth_map[where n = r' and xs = "Enum.enum::'b list" and f = ket]
         by smt
       have "distinct BasisB"
         unfolding BasisB_def
         by simp
       moreover have "r < length BasisB"
         using a1 lengthBasisB by simp
       moreover have "r' < length BasisB"
         using c3 lengthBasisB by simp
       ultimately have h1: "BasisB!r \<noteq> BasisB!r'"
         using nth_eq_iff_index_eq[where xs = BasisB and i = r and j = r'] c2
         by blast
       have "(classical_operator f) *\<^sub>V ket (Enum.enum!c)
           = (case f (Enum.enum!c) of None \<Rightarrow> 0 | Some i \<Rightarrow> ket i)"
         using classical_operator_ket_finite .
       also have "\<dots> = ket (Enum.enum!r')"
         using c1 by simp
       finally have "(classical_operator f) *\<^sub>V ket (Enum.enum!c) = ket (Enum.enum!r')" .
       hence *: "(classical_operator f) *\<^sub>V BasisA!c = BasisB!r'"
         using x1 x3 by simp
       moreover have "is_orthogonal (BasisB!r) (BasisB!r')"
         using h1
         using BasisB_def \<open>r < length BasisB\<close> \<open>r' < length BasisB\<close> is_ortho_set_def is_orthonormal nth_mem
         by metis
       ultimately have "is_orthogonal (BasisB!r) (classical_operator f *\<^sub>V BasisA!c)"
         by simp
       thus ?thesis
         unfolding mat_of_cblinfun_def BasisA_def BasisB_def
         by (smt (z3) BasisA_def BasisB_def * \<open>r < length BasisB\<close> \<open>r' < length BasisB\<close> a2 canonical_basis_length_ell2 case_prod_conv complex_vector.representation_basis h1 index_mat(1) is_cindependent_set nth_mem)
     qed
     have "(mat_of_cblinfun (classical_operator f))$$(r,c) = 0"
       if b1: "f (Enum.enum!c) \<noteq> Some (Enum.enum!r)"
     proof (cases "f (Enum.enum!c) = None")
       case True thus ?thesis using v1 by blast
     next
       case False
       hence "\<exists>R. f (Enum.enum!c) = Some R"
         apply (induction "f (Enum.enum!c)")
          apply simp
         by simp
       then obtain R where R0: "f (Enum.enum!c) = Some R"
         by blast
       have "R \<in> set (Enum.enum::'b list)"
         using UNIV_enum by blast
       hence "\<exists>r'. R = (Enum.enum::'b list)!r' \<and> r' < length (Enum.enum::'b list)"
         by (metis in_set_conv_nth)
       then obtain r' where u1: "R = (Enum.enum::'b list)!r'"
         and u2: "r' < length (Enum.enum::'b list)"
         by blast
       have R1: "f (Enum.enum!c) = Some (Enum.enum!r')"
         using R0 u1 by blast
       have "Some ((Enum.enum::'b list)!r') \<noteq> Some ((Enum.enum::'b list)!r)"
       proof(rule classical)
         assume "\<not>(Some ((Enum.enum::'b list)!r') \<noteq> Some ((Enum.enum::'b list)!r))"
         hence "Some ((Enum.enum::'b list)!r') = Some ((Enum.enum::'b list)!r)"
           by blast
         hence "f (Enum.enum!c) = Some ((Enum.enum::'b list)!r)"
           using R1 by auto
         thus ?thesis
           using b1 by blast
       qed
       hence "((Enum.enum::'b list)!r') \<noteq> ((Enum.enum::'b list)!r)"
         by simp
       hence "r' \<noteq> r"
         by blast
       moreover have "r' < CARD('b)"
         using u2 cardb by simp
       ultimately show ?thesis using R1 v2[where r' = r'] by blast
     qed
     moreover have "(mat_of_cblinfun (classical_operator f))$$(r,c) = 1"
       if b1: "f (Enum.enum!c) = Some (Enum.enum!r)"
     proof-
       have "CARD('b) = length (enum_class.enum::'b list)"
         using card_UNIV_length_enum[where 'a = 'b].
       hence "length (map (ket::'b\<Rightarrow>_) enum_class.enum) = CARD('b)"
         by simp
       hence w0: "map (ket::'b\<Rightarrow>_) enum_class.enum ! r = ket (enum_class.enum ! r)"
         by (simp add: a1)
       have "CARD('a) = length (enum_class.enum::'a list)"
         using card_UNIV_length_enum[where 'a = 'a].
       hence "length (map (ket::'a\<Rightarrow>_) enum_class.enum) = CARD('a)"
         by simp
       hence "map (ket::'a\<Rightarrow>_) enum_class.enum ! c = ket (enum_class.enum ! c)"
         by (simp add: a2)
       hence "(classical_operator f) *\<^sub>V (BasisA!c) = (classical_operator f) *\<^sub>V (ket (Enum.enum!c))"
         unfolding BasisA_def canonical_basis_ell2_def by simp
       also have "... = (case f (enum_class.enum ! c) of None \<Rightarrow> 0 | Some x \<Rightarrow> ket x)"
         by (rule classical_operator_ket_finite)
       also have "\<dots> = BasisB!r"
         using w0 b1 by (simp add: BasisB_def canonical_basis_ell2_def)
       finally have w1: "(classical_operator f) *\<^sub>V (BasisA!c) = BasisB!r"
         by simp
       have "(mat_of_cblinfun (classical_operator f))$$(r,c)
         = (BasisB!r) \<bullet>\<^sub>C (classical_operator f *\<^sub>V (BasisA!c))"
         unfolding BasisB_def BasisA_def mat_of_cblinfun_def
         using \<open>nA = CARD('a)\<close> \<open>nB = CARD('b)\<close> a1 a2 nA_def nB_def apply auto
         by (metis BasisA_def BasisB_def canonical_basis_length_ell2 cinner_canonical_basis complex_vector.representation_basis is_cindependent_set nth_mem w1)
       also have "\<dots> = (BasisB!r) \<bullet>\<^sub>C (BasisB!r)"
         using w1 by simp
       also have "\<dots> = 1"
         unfolding BasisB_def
         using \<open>nB = CARD('b)\<close> a1 nB_def
         by (simp add: cinner_canonical_basis)
       finally show ?thesis by blast
     qed
     ultimately show ?thesis
       by (simp add: a1 a2)
   qed
   ultimately show ?thesis
     apply (rule_tac eq_matI) by auto
 qed
 
-lemma mat_of_cblinfun_compose:
-  "mat_of_cblinfun (F o\<^sub>C\<^sub>L G) = mat_of_cblinfun F * mat_of_cblinfun G"
-  for F::"'b::{basis_enum,complex_normed_vector} \<Rightarrow>\<^sub>C\<^sub>L 'c::{basis_enum,complex_normed_vector}"
-    and G::"'a::{basis_enum,complex_normed_vector}  \<Rightarrow>\<^sub>C\<^sub>L 'b"
-  by (smt (verit, del_insts) cblinfun_of_mat_inverse mat_carrier mat_of_cblinfun_def mat_of_cblinfun_inverse cblinfun_of_mat_times mult_carrier_mat)
-
-lemma mat_of_cblinfun_scaleC:
-  "mat_of_cblinfun ((a::complex) *\<^sub>C F) = a \<cdot>\<^sub>m (mat_of_cblinfun F)"
-  for F :: "'a::{basis_enum,complex_normed_vector} \<Rightarrow>\<^sub>C\<^sub>L 'b::{basis_enum,complex_normed_vector}"
-  by (auto simp add: complex_vector.representation_scale mat_of_cblinfun_def)
-
-lemma mat_of_cblinfun_scaleR:
-  "mat_of_cblinfun ((a::real) *\<^sub>R F) = (complex_of_real a) \<cdot>\<^sub>m (mat_of_cblinfun F)"
-  unfolding scaleR_scaleC by (rule mat_of_cblinfun_scaleC)
-
-lemma mat_of_cblinfun_adj:
-  "mat_of_cblinfun (F*) = mat_adjoint (mat_of_cblinfun F)"
-  for F :: "'a::onb_enum \<Rightarrow>\<^sub>C\<^sub>L 'b::onb_enum"
-  by (metis (no_types, lifting) cblinfun_of_mat_inverse map_carrier_mat mat_adjoint_def' mat_carrier cblinfun_of_mat_adjoint mat_of_cblinfun_def mat_of_cblinfun_inverse transpose_carrier_mat)
-
-lemma mat_of_cblinfun_vector_to_cblinfun:
-  "mat_of_cblinfun (vector_to_cblinfun \<psi>)
-       = mat_of_cols (length (canonical_basis :: 'a list)) [vec_of_basis_enum \<psi>]"
-  for \<psi>::"'a::{basis_enum,complex_normed_vector}"
-  by (auto simp: mat_of_cols_Cons_index_0 mat_of_cblinfun_def vec_of_basis_enum_def vec_of_list_index)
-
-lemma mat_of_cblinfun_proj:
-  fixes a::"'a::onb_enum"
-  defines   "d \<equiv> length (canonical_basis :: 'a list)"
-    and "norm2 \<equiv> (vec_of_basis_enum a) \<bullet>c (vec_of_basis_enum a)"
-  shows  "mat_of_cblinfun (proj a) =
-      1 / norm2 \<cdot>\<^sub>m (mat_of_cols d [vec_of_basis_enum a]
-                 * mat_of_rows d [conjugate (vec_of_basis_enum a)])" (is \<open>_ = ?rhs\<close>)
-proof (cases "a = 0")
-  case False
-  have norm2: \<open>norm2 = (norm a)\<^sup>2\<close>
-    by (simp add: cscalar_prod_vec_of_basis_enum norm2_def cdot_square_norm[symmetric, simplified])
-  have [simp]: \<open>vec_of_basis_enum a \<in> carrier_vec d\<close>
-    by (simp add: carrier_vecI d_def)
-
-  have \<open>mat_of_cblinfun (proj a) = mat_of_cblinfun (proj (a /\<^sub>R norm a))\<close>
-    by (metis (mono_tags, opaque_lifting) ccspan_singleton_scaleC complex_vector.scale_eq_0_iff
-        nonzero_imp_inverse_nonzero norm_eq_zero scaleR_scaleC scale_left_imp_eq)
-  also have \<open>\<dots> = mat_of_cblinfun (selfbutter (a /\<^sub>R norm a))\<close>
-    apply (subst butterfly_eq_proj)
-    by (auto simp add: False)
-  also have \<open>\<dots> = 1/norm2 \<cdot>\<^sub>m mat_of_cblinfun (selfbutter a)\<close>
-    apply (simp add: mat_of_cblinfun_scaleC norm2)
-    by (simp add: inverse_eq_divide power2_eq_square)
-  also have \<open>\<dots> = 1 / norm2 \<cdot>\<^sub>m (mat_of_cblinfun (vector_to_cblinfun a :: complex \<Rightarrow>\<^sub>C\<^sub>L 'a) * mat_adjoint (mat_of_cblinfun (vector_to_cblinfun a :: complex \<Rightarrow>\<^sub>C\<^sub>L 'a)))\<close>
-    by (simp add: butterfly_def mat_of_cblinfun_compose mat_of_cblinfun_adj)
-  also have \<open>\<dots> = ?rhs\<close>
-    by (simp add: mat_of_cblinfun_vector_to_cblinfun mat_adjoint_def flip: d_def)
-  finally show ?thesis
-    by -
-next
-  case True
-  show ?thesis
-    apply (rule eq_matI)
-    by (auto simp: True mat_of_cblinfun_zero vec_of_basis_enum_zero scalar_prod_def  mat_of_rows_index
-        simp flip: d_def)
-qed
-
-lemma mat_of_cblinfun_ell2_component:
-  fixes a :: \<open>'a::enum ell2 \<Rightarrow>\<^sub>C\<^sub>L 'b::enum ell2\<close>
-  assumes [simp]: \<open>i < CARD('b)\<close> \<open>j < CARD('a)\<close>
-  shows \<open>mat_of_cblinfun a $$ (i,j) = Rep_ell2 (a *\<^sub>V ket (Enum.enum ! j)) (Enum.enum ! i)\<close>
-proof -
-  let ?i = \<open>Enum.enum ! i\<close> and ?j = \<open>Enum.enum ! j\<close> and ?aj = \<open>a *\<^sub>V ket (Enum.enum ! j)\<close>
-  have \<open>Rep_ell2 ?aj (Enum.enum ! i) = vec_of_basis_enum ?aj $ i\<close>
-    by (rule vec_of_basis_enum_ell2_component[symmetric], simp)
-  also have \<open>\<dots> = (mat_of_cblinfun a *\<^sub>v vec_of_basis_enum (ket (enum_class.enum ! j) :: 'a ell2)) $ i\<close>
-    by (simp add: mat_of_cblinfun_cblinfun_apply)
-  also have \<open>\<dots> = (mat_of_cblinfun a *\<^sub>v unit_vec CARD('a) j) $ i\<close>
-    by (simp add: vec_of_basis_enum_ket enum_idx_enum)
-  also have \<open>\<dots> = mat_of_cblinfun a $$ (i, j)\<close>
-    apply (subst mat_entry_explicit[where m=\<open>CARD('b)\<close>])
-    by auto
-  finally show ?thesis
-    by auto
-qed
 
 lemma mat_of_cblinfun_sandwich:
   fixes a :: "(_::onb_enum, _::onb_enum) cblinfun"
   shows \<open>mat_of_cblinfun (sandwich a *\<^sub>V b) = (let a' = mat_of_cblinfun a in a' * mat_of_cblinfun b * mat_adjoint a')\<close>
   by (simp add: mat_of_cblinfun_compose sandwich_apply Let_def mat_of_cblinfun_adj)
 
 subsection \<open>Operations on subspaces\<close>
 
 lemma ccspan_gram_schmidt0_invariant:
   defines "basis_enum \<equiv> (basis_enum_of_vec :: _ \<Rightarrow> 'a::{basis_enum,complex_normed_vector})"
   defines "n \<equiv> length (canonical_basis :: 'a list)"
   assumes "set ws \<subseteq> carrier_vec n"
   shows "ccspan (set (map basis_enum (gram_schmidt0 n ws))) = ccspan (set (map basis_enum ws))"
 proof (transfer fixing: n ws basis_enum)
   interpret complex_vec_space.
   define gs where "gs = gram_schmidt0 n ws"
   have "closure (cspan (set (map basis_enum gs)))
      = cspan (set (map basis_enum gs))"
     apply (rule closure_finite_cspan)
     by simp
   also have "\<dots> = cspan (basis_enum ` set gs)"
     by simp
   also have "\<dots> = basis_enum ` span (set gs)"
     unfolding basis_enum_def
     apply (rule basis_enum_of_vec_span[symmetric])
     using n_def apply simp
     by (simp add: assms(3) cof_vec_space.gram_schmidt0_result(1) gs_def)
   also have "\<dots> = basis_enum ` span (set ws)"
     unfolding gs_def
     apply (subst gram_schmidt0_result(4)[where ws=ws, symmetric])
     using assms by auto
   also have "\<dots> = cspan (basis_enum ` set ws)"
     unfolding basis_enum_def
     apply (rule basis_enum_of_vec_span)
     using n_def apply simp
     by (simp add: assms(3))
   also have "\<dots> = cspan (set (map basis_enum ws))"
     by simp
   also have "\<dots> = closure (cspan (set (map basis_enum ws)))"
     apply (rule closure_finite_cspan[symmetric])
     by simp
   finally show "closure (cspan (set (map basis_enum gs)))
               = closure (cspan (set (map basis_enum ws)))".
 qed
 
 definition "is_subspace_of_vec_list n vs ws =
   (let ws' = gram_schmidt0 n ws in
      \<forall>v\<in>set vs. adjuster n v ws' = - v)"
 
 lemma ccspan_leq_using_vec:
-  fixes A B :: "'a::{basis_enum,complex_normed_vector} list"
-  shows "(ccspan (set A) \<le> ccspan (set B)) \<longleftrightarrow>
+  fixes A B :: \<open>'a::{basis_enum,complex_normed_vector} list\<close>
+  shows \<open>(ccspan (set A) \<le> ccspan (set B)) \<longleftrightarrow>
     is_subspace_of_vec_list (length (canonical_basis :: 'a list))
-      (map vec_of_basis_enum A) (map vec_of_basis_enum B)"
+      (map vec_of_basis_enum A) (map vec_of_basis_enum B)\<close>
 proof -
   define d Av Bv Bo
     where "d = length (canonical_basis :: 'a list)"
       and "Av = map vec_of_basis_enum A"
       and "Bv = map vec_of_basis_enum B"
       and "Bo = gram_schmidt0 d Bv"
   interpret complex_vec_space d.
 
   have Av_carrier: "set Av \<subseteq> carrier_vec d"
     unfolding Av_def apply auto
     by (simp add: carrier_vecI d_def dim_vec_of_basis_enum')
   have Bv_carrier: "set Bv \<subseteq> carrier_vec d"
     unfolding Bv_def apply auto
     by (simp add: carrier_vecI d_def dim_vec_of_basis_enum')
   have Bo_carrier: "set Bo \<subseteq> carrier_vec d"
     apply (simp add: Bo_def)
     using Bv_carrier by (rule gram_schmidt0_result(1))
   have orth_Bo: "corthogonal Bo"
     apply (simp add: Bo_def)
     using Bv_carrier by (rule gram_schmidt0_result(3))
   have distinct_Bo: "distinct Bo"
     apply (simp add: Bo_def)
     using Bv_carrier by (rule gram_schmidt0_result(2))
 
   have "ccspan (set A) \<le> ccspan (set B) \<longleftrightarrow> cspan (set A) \<subseteq> cspan (set B)"
     apply (transfer fixing: A B)
     apply (subst closure_finite_cspan, simp)
     by (subst closure_finite_cspan, simp_all)
   also have "\<dots> \<longleftrightarrow> span (set Av) \<subseteq> span (set Bv)"
     apply (simp add: Av_def Bv_def)
     apply (subst vec_of_basis_enum_cspan[symmetric], simp add: d_def)
     apply (subst vec_of_basis_enum_cspan[symmetric], simp add: d_def)
     by (metis inj_image_subset_iff inj_on_def vec_of_basis_enum_inverse)
   also have "\<dots> \<longleftrightarrow> span (set Av) \<subseteq> span (set Bo)"
     unfolding Bo_def Av_def Bv_def
     apply (subst gram_schmidt0_result(4)[symmetric])
     by (simp_all add: carrier_dim_vec d_def dim_vec_of_basis_enum' image_subset_iff)
   also have "\<dots> \<longleftrightarrow> (\<forall>v\<in>set Av. adjuster d v Bo = - v)"
   proof (intro iffI ballI)
     fix v assume "v \<in> set Av" and "span (set Av) \<subseteq> span (set Bo)"
     then have "v \<in> span (set Bo)"
       using Av_carrier span_mem by auto
     have "adjuster d v Bo + v = 0\<^sub>v d"
       apply (rule adjuster_already_in_span)
       using Av_carrier \<open>v \<in> set Av\<close> Bo_carrier orth_Bo
         \<open>v \<in> span (set Bo)\<close> by simp_all
     then show "adjuster d v Bo = - v"
       using Av_carrier Bo_carrier \<open>v \<in> set Av\<close>
       by (metis (no_types, lifting) add.inv_equality adjuster_carrier' local.vec_neg subsetD)
   next
     fix v
     assume adj_minusv: "\<forall>v\<in>set Av. adjuster d v Bo = - v"
     have *: "adjuster d v Bo \<in> span (set Bo)" if "v \<in> set Av" for v
       apply (rule adjuster_in_span)
       using Bo_carrier that Av_carrier distinct_Bo by auto
     have "v \<in> span (set Bo)" if "v \<in> set Av" for v
       using *[OF that] adj_minusv[rule_format, OF that]
       apply auto
       by (metis (no_types, lifting) Av_carrier Bo_carrier adjust_nonzero distinct_Bo subsetD that uminus_l_inv_vec)
     then show "span (set Av) \<subseteq> span (set Bo)"
       apply auto
       by (meson Bo_carrier in_mono span_subsetI subsetI)
   qed
   also have "\<dots> = is_subspace_of_vec_list d Av Bv"
     by (simp add: is_subspace_of_vec_list_def d_def Bo_def)
   finally show "ccspan (set A) \<le> ccspan (set B) \<longleftrightarrow> is_subspace_of_vec_list d Av Bv"
     by simp
 qed
 
-lemma cblinfun_apply_ccspan_using_vec:
+lemma cblinfun_image_ccspan_using_vec:
   "A *\<^sub>S ccspan (set S) = ccspan (basis_enum_of_vec ` set (map ((*\<^sub>v) (mat_of_cblinfun A)) (map vec_of_basis_enum S)))"
   apply (auto simp: cblinfun_image_ccspan image_image)
   by (metis mat_of_cblinfun_cblinfun_apply vec_of_basis_enum_inverse)
 
 text \<open>\<^term>\<open>mk_projector_orthog d L\<close> takes a list L of d-dimensional vectors
 and returns the projector onto the span of L. (Assuming that all vectors in L are
 orthogonal and nonzero.)\<close>
 fun mk_projector_orthog :: "nat \<Rightarrow> complex vec list \<Rightarrow> complex mat" where
   "mk_projector_orthog d [] = zero_mat d d"
 | "mk_projector_orthog d [v] = (let norm2 = cscalar_prod v v in
                                 smult_mat (1/norm2) (mat_of_cols d [v] * mat_of_rows d [conjugate v]))"
 | "mk_projector_orthog d (v#vs) = (let norm2 = cscalar_prod v v in
                                    smult_mat (1/norm2) (mat_of_cols d [v] * mat_of_rows d [conjugate v])
                                         + mk_projector_orthog d vs)"
 
 lemma mk_projector_orthog_correct:
   fixes S :: "'a::onb_enum list"
   defines "d \<equiv> length (canonical_basis :: 'a list)"
   assumes ortho: "is_ortho_set (set S)" and distinct: "distinct S"
   shows "mk_projector_orthog d (map vec_of_basis_enum S)
        = mat_of_cblinfun (Proj (ccspan (set S)))"
 proof -
   define Snorm where "Snorm = map (\<lambda>s. s /\<^sub>R norm s) S"
 
   have "distinct Snorm"
   proof (insert ortho distinct, unfold Snorm_def, induction S)
     case Nil
     show ?case by simp
   next
     case (Cons s S)
     then have "is_ortho_set (set S)" and "distinct S"
       unfolding is_ortho_set_def by auto
     note IH = Cons.IH[OF this]
     have "s /\<^sub>R norm s \<notin> (\<lambda>s. s /\<^sub>R norm s) ` set S"
     proof auto
       fix s' assume "s' \<in> set S" and same: "s /\<^sub>R norm s = s' /\<^sub>R norm s'"
       with Cons.prems have "s \<noteq> s'" by auto
       have "s \<noteq> 0"
         by (metis Cons.prems(1) is_ortho_set_def list.set_intros(1))
       then have "0 \<noteq> (s /\<^sub>R norm s) \<bullet>\<^sub>C (s /\<^sub>R norm s)"
         by simp
       also have \<open>(s /\<^sub>R norm s) \<bullet>\<^sub>C (s /\<^sub>R norm s) = (s /\<^sub>R norm s) \<bullet>\<^sub>C (s' /\<^sub>R norm s')\<close>
         by (simp add: same)
       also have \<open>(s /\<^sub>R norm s) \<bullet>\<^sub>C (s' /\<^sub>R norm s') = (s \<bullet>\<^sub>C s') / (norm s * norm s')\<close>
         by (simp add: scaleR_scaleC divide_inverse_commute)
       also from \<open>s' \<in> set S\<close> \<open>s \<noteq> s'\<close> have "\<dots> = 0"
         using Cons.prems unfolding is_ortho_set_def by simp
       finally show False
         by simp
     qed
     then show ?case
       using IH by simp
   qed
 
   have norm_Snorm: "norm s = 1" if "s \<in> set Snorm" for s
     using that ortho unfolding Snorm_def is_ortho_set_def apply auto
     by (metis left_inverse norm_eq_zero)
 
   have ortho_Snorm: "is_ortho_set (set Snorm)"
     unfolding is_ortho_set_def
   proof (intro conjI ballI impI)
     fix x y
     show "0 \<notin> set Snorm"
       using norm_Snorm[of 0] by auto
     assume "x \<in> set Snorm" and "y \<in> set Snorm" and "x \<noteq> y"
     from \<open>x \<in> set Snorm\<close>
     obtain x' where x: "x = x' /\<^sub>R norm x'" and x': "x' \<in> set S"
       unfolding Snorm_def by auto
     from \<open>y \<in> set Snorm\<close>
     obtain y' where y: "y = y' /\<^sub>R norm y'" and y': "y' \<in> set S"
       unfolding Snorm_def by auto
     from \<open>x \<noteq> y\<close> x y have \<open>x' \<noteq> y'\<close> by auto
     with x' y' ortho have "cinner x' y' = 0"
       unfolding is_ortho_set_def by auto
     then show "cinner x y = 0"
       unfolding x y scaleR_scaleC by auto
   qed
 
   have inj_butter: "inj_on selfbutter (set Snorm)"
   proof (rule inj_onI)
     fix x y
     assume "x \<in> set Snorm" and "y \<in> set Snorm"
     assume "selfbutter x = selfbutter y"
     then obtain c where xcy: "x = c *\<^sub>C y" and "cmod c = 1"
       using inj_selfbutter_upto_phase by auto
     have "0 \<noteq> cmod (cinner x x)"
       using \<open>x \<in> set Snorm\<close> norm_Snorm
       by force
     also have "cmod (cinner x x) = cmod (c * (x \<bullet>\<^sub>C y))"
       apply (subst (2) xcy) by simp
     also have "\<dots> = cmod (x \<bullet>\<^sub>C y)"
       using \<open>cmod c = 1\<close> by (simp add: norm_mult)
     finally have "(x \<bullet>\<^sub>C y) \<noteq> 0"
       by simp
     then show "x = y"
       using ortho_Snorm \<open>x \<in> set Snorm\<close> \<open>y \<in> set Snorm\<close>
       unfolding is_ortho_set_def by auto
   qed
 
   from \<open>distinct Snorm\<close> inj_butter
   have distinct': "distinct (map selfbutter Snorm)"
     unfolding distinct_map by simp
 
   have Span_Snorm: "ccspan (set Snorm) = ccspan (set S)"
     apply (transfer fixing: Snorm S)
     apply (simp add: scaleR_scaleC Snorm_def)
     apply (subst complex_vector.span_image_scale)
     using is_ortho_set_def ortho by fastforce+
 
   have "mk_projector_orthog d (map vec_of_basis_enum S)
       = mat_of_cblinfun (sum_list (map selfbutter Snorm))"
     unfolding Snorm_def
   proof (induction S)
     case Nil
     show ?case
       by (simp add: d_def mat_of_cblinfun_zero)
   next
     case (Cons a S)
     define sumS where "sumS = sum_list (map selfbutter (map (\<lambda>s. s /\<^sub>R norm s) S))"
     with Cons have IH: "mk_projector_orthog d (map vec_of_basis_enum S)
                   = mat_of_cblinfun sumS"
       by simp
 
     define factor where "factor = inverse ((complex_of_real (norm a))\<^sup>2)"
     have factor': "factor = 1 / (vec_of_basis_enum a \<bullet>c vec_of_basis_enum a)"
       unfolding factor_def cscalar_prod_vec_of_basis_enum
       by (simp add: inverse_eq_divide power2_norm_eq_cinner)
 
     have "mk_projector_orthog d (map vec_of_basis_enum (a # S))
           = factor \<cdot>\<^sub>m (mat_of_cols d [vec_of_basis_enum a]
                     * mat_of_rows d [conjugate (vec_of_basis_enum a)])
             + mat_of_cblinfun sumS"
       apply (cases S)
        apply (auto simp add: factor' sumS_def d_def mat_of_cblinfun_zero)[1]
       by (auto simp add: IH[symmetric] factor' d_def)
 
     also have "\<dots> = factor \<cdot>\<^sub>m (mat_of_cols d [vec_of_basis_enum a] *
          mat_adjoint (mat_of_cols d [vec_of_basis_enum a])) + mat_of_cblinfun sumS"
       apply (rule arg_cong[where f="\<lambda>x. _ \<cdot>\<^sub>m (_ * x) + _"])
       apply (rule mat_eq_iff[THEN iffD2])
       apply (auto simp add: mat_adjoint_def)
       apply (subst mat_of_rows_index) apply auto
       apply (subst mat_of_rows_index) apply auto
       apply (subst mat_of_cols_index) apply auto
       by (simp add: assms(1) dim_vec_of_basis_enum')
     also have "\<dots> = mat_of_cblinfun (selfbutter (a /\<^sub>R norm a)) + mat_of_cblinfun sumS"
       apply (simp add: butterfly_scaleR_left butterfly_scaleR_right power_inverse mat_of_cblinfun_scaleR factor_def)
       apply (simp add: butterfly_def mat_of_cblinfun_compose
           mat_of_cblinfun_adj mat_of_cblinfun_vector_to_cblinfun d_def)
       by (simp add: mat_of_cblinfun_compose mat_of_cblinfun_adj mat_of_cblinfun_vector_to_cblinfun mat_of_cblinfun_scaleC power2_eq_square)
     finally show ?case
       by (simp add: mat_of_cblinfun_plus sumS_def)
   qed
   also have "\<dots> = mat_of_cblinfun (\<Sum>s\<in>set Snorm. selfbutter s)"
     by (metis distinct' distinct_map sum.distinct_set_conv_list)
   also have "\<dots> = mat_of_cblinfun (\<Sum>s\<in>set Snorm. proj s)"
     apply (rule arg_cong[where f="mat_of_cblinfun"])
     apply (rule sum.cong[OF refl])
     apply (rule butterfly_eq_proj)
     using norm_Snorm by simp
   also have "\<dots> = mat_of_cblinfun (Proj (ccspan (set Snorm)))"
     apply (rule arg_cong[where f=mat_of_cblinfun])
     using ortho_Snorm \<open>distinct Snorm\<close> apply (induction Snorm)
      apply auto
     apply (subst Proj_orthog_ccspan_insert[where Y=\<open>set _\<close>])
     by (auto simp: is_ortho_set_def)
   also have "\<dots> = mat_of_cblinfun (Proj (ccspan (set S)))"
     unfolding Span_Snorm by simp
   finally show ?thesis
     by -
 qed
 
+definition \<open>mk_projector d vs = mk_projector_orthog d (gram_schmidt0 d vs)\<close>
+
 lemma mat_of_cblinfun_Proj_ccspan:
-  fixes S :: "'a::onb_enum list"
-  shows "mat_of_cblinfun (Proj (ccspan (set S))) =
-    (let d = length (canonical_basis :: 'a list) in
-      mk_projector_orthog d (gram_schmidt0 d (map vec_of_basis_enum S)))"
+  fixes S :: \<open>'a::onb_enum list\<close>
+  shows \<open>mat_of_cblinfun (Proj (ccspan (set S))) = mk_projector (length (canonical_basis :: 'a list)) (map vec_of_basis_enum S)\<close>
 proof-
   define d gs
     where "d = length (canonical_basis :: 'a list)"
       and "gs = gram_schmidt0 d (map vec_of_basis_enum S)"
   interpret complex_vec_space d.
   have gs_dim: "x \<in> set gs \<Longrightarrow> dim_vec x = d" for x
     by (smt carrier_vecD carrier_vec_dim_vec d_def dim_vec_of_basis_enum' ex_map_conv gram_schmidt0_result(1) gs_def subset_code(1))
   have ortho_gs: "is_ortho_set (set (map basis_enum_of_vec gs :: 'a list))"
     apply (subst corthogonal_vec_of_basis_enum[THEN iffD1], auto)
     by (smt carrier_dim_vec cof_vec_space.gram_schmidt0_result(1) d_def dim_vec_of_basis_enum' gram_schmidt0_result(3) gs_def imageE map_idI map_map o_apply set_map subset_code(1) basis_enum_of_vec_inverse)
   have distinct_gs: "distinct (map basis_enum_of_vec gs :: 'a list)"
     by (metis (mono_tags, opaque_lifting) carrier_vec_dim_vec cof_vec_space.gram_schmidt0_result(2) d_def dim_vec_of_basis_enum' distinct_map gs_def gs_dim image_iff inj_on_inverseI set_map subsetI basis_enum_of_vec_inverse)
 
   have "mk_projector_orthog d gs
       = mk_projector_orthog d (map vec_of_basis_enum (map basis_enum_of_vec gs :: 'a list))"
     apply simp
     apply (subst map_cong[where ys=gs and g=id], simp)
     using gs_dim by (auto intro!: vec_of_basis_enum_inverse simp: d_def)
   also have "\<dots> = mat_of_cblinfun (Proj (ccspan (set (map basis_enum_of_vec gs :: 'a list))))"
     unfolding d_def
     apply (subst mk_projector_orthog_correct)
     using ortho_gs distinct_gs by auto
   also have "\<dots> = mat_of_cblinfun (Proj (ccspan (set S)))"
     apply (rule arg_cong[where f="\<lambda>x. mat_of_cblinfun (Proj x)"])
     unfolding gs_def d_def
     apply (subst ccspan_gram_schmidt0_invariant)
     by (auto simp add: carrier_vecI dim_vec_of_basis_enum')
   finally show ?thesis
-    unfolding d_def gs_def by auto
+    by (simp add: d_def gs_def mk_projector_def)
 qed
 
 unbundle no_jnf_notation
 unbundle no_cblinfun_notation
 
 end
diff --git a/thys/Complex_Bounded_Operators/Complex_Bounded_Linear_Function.thy b/thys/Complex_Bounded_Operators/Complex_Bounded_Linear_Function.thy
--- a/thys/Complex_Bounded_Operators/Complex_Bounded_Linear_Function.thy
+++ b/thys/Complex_Bounded_Operators/Complex_Bounded_Linear_Function.thy
@@ -1,5062 +1,5053 @@
 section \<open>\<open>Complex_Bounded_Linear_Function\<close> -- Complex bounded linear functions (bounded operators)\<close>
 
 (*
 Authors:
 
   Dominique Unruh, University of Tartu, unruh@ut.ee
   Jose Manuel Rodriguez Caballero, University of Tartu, jose.manuel.rodriguez.caballero@ut.ee
 
 *)
 
 theory Complex_Bounded_Linear_Function
   imports
     "HOL-Types_To_Sets.Types_To_Sets"
     Banach_Steinhaus.Banach_Steinhaus
     Complex_Inner_Product
     One_Dimensional_Spaces
     Complex_Bounded_Linear_Function0
     "HOL-Library.Function_Algebras"
 begin
 
 unbundle lattice_syntax
 
 subsection \<open>Misc basic facts and declarations\<close>
 
 notation cblinfun_apply (infixr "*\<^sub>V" 70)
 
 lemma id_cblinfun_apply[simp]: "id_cblinfun *\<^sub>V \<psi> = \<psi>"
   by simp
 
 lemma apply_id_cblinfun[simp]: \<open>(*\<^sub>V) id_cblinfun = id\<close>
   by auto
 
 lemma isCont_cblinfun_apply[simp]: "isCont ((*\<^sub>V) A) \<psi>"
   by transfer (simp add: clinear_continuous_at)
 
 declare cblinfun.scaleC_left[simp]
 
 lemma cblinfun_apply_clinear[simp]: \<open>clinear (cblinfun_apply A)\<close>
   using bounded_clinear.axioms(1) cblinfun_apply by blast
 
 lemma cblinfun_cinner_eqI:
   fixes A B :: \<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'a\<close>
   assumes \<open>\<And>\<psi>. cinner \<psi> (A *\<^sub>V \<psi>) = cinner \<psi> (B *\<^sub>V \<psi>)\<close>
   shows \<open>A = B\<close>
 proof -
   define C where \<open>C = A - B\<close>
   have C0[simp]: \<open>cinner \<psi> (C \<psi>) = 0\<close> for \<psi>
     by (simp add: C_def assms cblinfun.diff_left cinner_diff_right)
   { fix f g \<alpha>
     have \<open>0 = cinner (f + \<alpha> *\<^sub>C g) (C *\<^sub>V (f + \<alpha> *\<^sub>C g))\<close>
       by (simp add: cinner_diff_right minus_cblinfun.rep_eq)
     also have \<open>\<dots> = \<alpha> *\<^sub>C cinner f (C g) + cnj \<alpha> *\<^sub>C cinner g (C f)\<close>
       by (smt (z3) C0 add.commute add.right_neutral cblinfun.add_right cblinfun.scaleC_right cblinfun_cinner_right.rep_eq cinner_add_left cinner_scaleC_left complex_scaleC_def)
     finally have \<open>\<alpha> *\<^sub>C cinner f (C g) = - cnj \<alpha> *\<^sub>C cinner g (C f)\<close>
       by (simp add: eq_neg_iff_add_eq_0)
   }
   then have \<open>cinner f (C g) = 0\<close> for f g
     by (metis complex_cnj_i complex_cnj_one complex_vector.scale_cancel_right complex_vector.scale_left_imp_eq equation_minus_iff i_squared mult_eq_0_iff one_neq_neg_one)
   then have \<open>C g = 0\<close> for g
     using cinner_eq_zero_iff by blast
   then have \<open>C = 0\<close>
     by (simp add: cblinfun_eqI)
   then show \<open>A = B\<close>
     using C_def by auto
 qed
 
 lemma id_cblinfun_not_0[simp]: \<open>(id_cblinfun :: 'a::{complex_normed_vector, not_singleton} \<Rightarrow>\<^sub>C\<^sub>L _) \<noteq> 0\<close>
   by (metis (full_types) Extra_General.UNIV_not_singleton cblinfun.zero_left cblinfun_id_cblinfun_apply ex_norm1 norm_zero one_neq_zero)
 
 lemma cblinfun_norm_geqI:
   assumes \<open>norm (f *\<^sub>V x) / norm x \<ge> K\<close>
   shows \<open>norm f \<ge> K\<close>
   using assms by transfer (smt (z3) bounded_clinear.bounded_linear le_onorm)
 
 (* This lemma is proven in Complex_Bounded_Linear_Function0 but we add the [simp]
    only here because we try to keep Complex_Bounded_Linear_Function0 as close to
    Bounded_Linear_Function as possible. *)
 declare scaleC_conv_of_complex[simp]
 
 lemma cblinfun_eq_0_on_span:
   fixes S::\<open>'a::complex_normed_vector set\<close>
   assumes "x \<in> cspan S"
     and "\<And>s. s\<in>S \<Longrightarrow> F *\<^sub>V s = 0"
   shows \<open>F *\<^sub>V x = 0\<close>
   using bounded_clinear.axioms(1) cblinfun_apply assms complex_vector.linear_eq_0_on_span
   by blast
 
 lemma cblinfun_eq_on_span:
   fixes S::\<open>'a::complex_normed_vector set\<close>
   assumes "x \<in> cspan S"
     and "\<And>s. s\<in>S \<Longrightarrow> F *\<^sub>V s = G *\<^sub>V s"
   shows \<open>F *\<^sub>V x = G *\<^sub>V x\<close>
   using bounded_clinear.axioms(1) cblinfun_apply assms complex_vector.linear_eq_on_span
   by blast
 
 lemma cblinfun_eq_0_on_UNIV_span:
   fixes basis::\<open>'a::complex_normed_vector set\<close>
   assumes "cspan basis = UNIV"
     and "\<And>s. s\<in>basis \<Longrightarrow> F *\<^sub>V s = 0"
   shows \<open>F = 0\<close>
   by (metis cblinfun_eq_0_on_span UNIV_I assms cblinfun.zero_left cblinfun_eqI)
 
 lemma cblinfun_eq_on_UNIV_span:
   fixes basis::"'a::complex_normed_vector set" and \<phi>::"'a \<Rightarrow> 'b::complex_normed_vector"
   assumes "cspan basis = UNIV"
     and "\<And>s. s\<in>basis \<Longrightarrow> F *\<^sub>V s = G *\<^sub>V s"
   shows \<open>F = G\<close>
   by (metis (no_types) assms cblinfun_eqI cblinfun_eq_on_span iso_tuple_UNIV_I)
 
 lemma cblinfun_eq_on_canonical_basis:
   fixes f g::"'a::{basis_enum,complex_normed_vector} \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_normed_vector"
   defines "basis == set (canonical_basis::'a list)"
   assumes "\<And>u. u \<in> basis \<Longrightarrow> f *\<^sub>V u = g *\<^sub>V u"
   shows  "f = g"
   using assms cblinfun_eq_on_UNIV_span is_generator_set by blast
 
 lemma cblinfun_eq_0_on_canonical_basis:
   fixes f ::"'a::{basis_enum,complex_normed_vector} \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_normed_vector"
   defines "basis == set (canonical_basis::'a list)"
   assumes "\<And>u. u \<in> basis \<Longrightarrow> f *\<^sub>V u = 0"
   shows  "f = 0"
   by (simp add: assms cblinfun_eq_on_canonical_basis)
 
 lemma cinner_canonical_basis_eq_0:
   defines "basisA == set (canonical_basis::'a::onb_enum list)"
     and   "basisB == set (canonical_basis::'b::onb_enum list)"
   assumes "\<And>u v. u\<in>basisA \<Longrightarrow> v\<in>basisB \<Longrightarrow> is_orthogonal v (F *\<^sub>V u)"
   shows "F = 0"
 proof-
   have "F *\<^sub>V u = 0"
     if "u\<in>basisA" for u
   proof-
     have "\<And>v. v\<in>basisB \<Longrightarrow> is_orthogonal v (F *\<^sub>V u)"
       by (simp add: assms(3) that)
     moreover have "(\<And>v. v\<in>basisB \<Longrightarrow> is_orthogonal v x) \<Longrightarrow> x = 0"
       for x
     proof-
       assume r1: "\<And>v. v\<in>basisB \<Longrightarrow> is_orthogonal v x"
       have "is_orthogonal v x" for v
       proof-
         have "cspan basisB = UNIV"
           using basisB_def is_generator_set  by auto
         hence "v \<in> cspan basisB"
           by (smt iso_tuple_UNIV_I)
         hence "\<exists>t s. v = (\<Sum>a\<in>t. s a *\<^sub>C a) \<and> finite t \<and> t \<subseteq> basisB"
           using complex_vector.span_explicit
           by (smt mem_Collect_eq)
         then obtain t s where b1: "v = (\<Sum>a\<in>t. s a *\<^sub>C a)" and b2: "finite t" and b3: "t \<subseteq> basisB"
           by blast
         have "v \<bullet>\<^sub>C x = (\<Sum>a\<in>t. s a *\<^sub>C a) \<bullet>\<^sub>C x"
           by (simp add: b1)
         also have "\<dots> = (\<Sum>a\<in>t. (s a *\<^sub>C a) \<bullet>\<^sub>C x)"
           using cinner_sum_left by blast
         also have "\<dots> = (\<Sum>a\<in>t. cnj (s a) * (a \<bullet>\<^sub>C x))"
           by auto
         also have "\<dots> = 0"
           using b3 r1 subsetD by force
         finally show ?thesis by simp
       qed
       thus ?thesis
         by (simp add: \<open>\<And>v. (v \<bullet>\<^sub>C x) = 0\<close> cinner_extensionality)
     qed
     ultimately show ?thesis by simp
   qed
   thus ?thesis
     using basisA_def cblinfun_eq_0_on_canonical_basis by auto
 qed
 
 lemma cinner_canonical_basis_eq:
   defines "basisA == set (canonical_basis::'a::onb_enum list)"
     and   "basisB == set (canonical_basis::'b::onb_enum list)"
   assumes "\<And>u v. u\<in>basisA \<Longrightarrow> v\<in>basisB \<Longrightarrow> v \<bullet>\<^sub>C (F *\<^sub>V u) = v \<bullet>\<^sub>C (G *\<^sub>V u)"
   shows "F = G"
 proof-
   define H where "H = F - G"
   have "\<And>u v. u\<in>basisA \<Longrightarrow> v\<in>basisB \<Longrightarrow> is_orthogonal v (H *\<^sub>V u)"
     unfolding H_def
     by (simp add: assms(3) cinner_diff_right minus_cblinfun.rep_eq)
   hence "H = 0"
     by (simp add: basisA_def basisB_def cinner_canonical_basis_eq_0)
   thus ?thesis unfolding H_def by simp
 qed
 
 lemma cinner_canonical_basis_eq':
   defines "basisA == set (canonical_basis::'a::onb_enum list)"
     and   "basisB == set (canonical_basis::'b::onb_enum list)"
   assumes "\<And>u v. u\<in>basisA \<Longrightarrow> v\<in>basisB \<Longrightarrow> (F *\<^sub>V u) \<bullet>\<^sub>C v = (G *\<^sub>V u) \<bullet>\<^sub>C v"
   shows "F = G"
   using cinner_canonical_basis_eq assms
   by (metis cinner_commute')
 
 lemma not_not_singleton_cblinfun_zero: 
   \<open>x = 0\<close> if \<open>\<not> class.not_singleton TYPE('a)\<close> for x :: \<open>'a::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_normed_vector\<close>
   apply (rule cblinfun_eqI)
   apply (subst not_not_singleton_zero[OF that])
   by simp
 
 lemma cblinfun_norm_approx_witness:
   fixes A :: \<open>'a::{not_singleton,complex_normed_vector} \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_normed_vector\<close>
   assumes \<open>\<epsilon> > 0\<close>
   shows \<open>\<exists>\<psi>. norm (A *\<^sub>V \<psi>) \<ge> norm A - \<epsilon> \<and> norm \<psi> = 1\<close>
 proof (transfer fixing: \<epsilon>)
   fix A :: \<open>'a \<Rightarrow> 'b\<close> assume [simp]: \<open>bounded_clinear A\<close>
   have \<open>\<exists>y\<in>{norm (A x) |x. norm x = 1}. y > \<Squnion> {norm (A x) |x. norm x = 1} - \<epsilon>\<close>
     apply (rule Sup_real_close)
     using assms by (auto simp: ex_norm1 bounded_clinear.bounded_linear bdd_above_norm_f)
   also have \<open>\<Squnion> {norm (A x) |x. norm x = 1} = onorm A\<close>
     by (simp add: bounded_clinear.bounded_linear onorm_sphere)
   finally
   show \<open>\<exists>\<psi>. onorm A - \<epsilon> \<le> norm (A \<psi>) \<and> norm \<psi> = 1\<close>
     by force
 qed
 
 lemma cblinfun_norm_approx_witness_mult:
   fixes A :: \<open>'a::{not_singleton,complex_normed_vector} \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_normed_vector\<close>
   assumes \<open>\<epsilon> < 1\<close>
   shows \<open>\<exists>\<psi>. norm (A *\<^sub>V \<psi>) \<ge> norm A * \<epsilon> \<and> norm \<psi> = 1\<close>
 proof (cases \<open>norm A = 0\<close>)
   case True
   then show ?thesis
     by auto (simp add: ex_norm1)
 next
   case False
   then have \<open>(1 - \<epsilon>) * norm A > 0\<close>
     using assms by fastforce
   then obtain \<psi> where geq: \<open>norm (A *\<^sub>V \<psi>) \<ge> norm A - ((1 - \<epsilon>) * norm A)\<close> and \<open>norm \<psi> = 1\<close>
     using cblinfun_norm_approx_witness by blast
   have \<open>norm A * \<epsilon> = norm A - (1 - \<epsilon>) * norm A\<close>
     by (simp add: mult.commute right_diff_distrib')
   also have \<open>\<dots> \<le> norm (A *\<^sub>V \<psi>)\<close>
     by (rule geq)
   finally show ?thesis
     using \<open>norm \<psi> = 1\<close> by auto
 qed
 
 
 lemma cblinfun_norm_approx_witness':
   fixes A :: \<open>'a::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_normed_vector\<close>
   assumes \<open>\<epsilon> > 0\<close>
   shows \<open>\<exists>\<psi>. norm (A *\<^sub>V \<psi>) / norm \<psi> \<ge> norm A - \<epsilon>\<close>
 proof (cases \<open>class.not_singleton TYPE('a)\<close>)
   case True
   obtain \<psi> where \<open>norm (A *\<^sub>V \<psi>) \<ge> norm A - \<epsilon>\<close> and \<open>norm \<psi> = 1\<close>
     apply atomize_elim
     using complex_normed_vector_axioms True assms
     by (rule cblinfun_norm_approx_witness[internalize_sort' 'a])
   then have \<open>norm (A *\<^sub>V \<psi>) / norm \<psi> \<ge> norm A - \<epsilon>\<close>
     by simp
   then show ?thesis 
     by auto
 next
   case False
   show ?thesis
     apply (subst not_not_singleton_cblinfun_zero[OF False])
      apply simp
     apply (subst not_not_singleton_cblinfun_zero[OF False])
     using \<open>\<epsilon> > 0\<close> by simp
 qed
 
 lemma cblinfun_to_CARD_1_0[simp]: \<open>(A :: _ \<Rightarrow>\<^sub>C\<^sub>L _::CARD_1) = 0\<close>
   by (simp add: cblinfun_eqI)
 
 lemma cblinfun_from_CARD_1_0[simp]: \<open>(A :: _::CARD_1 \<Rightarrow>\<^sub>C\<^sub>L _) = 0\<close>
   using cblinfun_eq_on_UNIV_span by force
 
 
 lemma cblinfun_cspan_UNIV:
   fixes basis :: \<open>('a::{complex_normed_vector,cfinite_dim} \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_normed_vector) set\<close>
     and basisA :: \<open>'a set\<close> and basisB :: \<open>'b set\<close>
   assumes \<open>cspan basisA = UNIV\<close> and \<open>cspan basisB = UNIV\<close>
   assumes basis: \<open>\<And>a b. a\<in>basisA \<Longrightarrow> b\<in>basisB \<Longrightarrow> \<exists>F\<in>basis. \<forall>a'\<in>basisA. F *\<^sub>V a' = (if a'=a then b else 0)\<close>
   shows \<open>cspan basis = UNIV\<close>
 proof -
   obtain basisA' where \<open>basisA' \<subseteq> basisA\<close> and \<open>cindependent basisA'\<close> and \<open>cspan basisA' = UNIV\<close>
     by (metis assms(1) complex_vector.maximal_independent_subset complex_vector.span_eq top_greatest)
   then have [simp]: \<open>finite basisA'\<close>
     by (simp add: cindependent_cfinite_dim_finite)
   have basis': \<open>\<And>a b. a\<in>basisA' \<Longrightarrow> b\<in>basisB \<Longrightarrow> \<exists>F\<in>basis. \<forall>a'\<in>basisA'. F *\<^sub>V a' = (if a'=a then b else 0)\<close>
     using basis \<open>basisA' \<subseteq> basisA\<close> by fastforce
 
   obtain F where F: \<open>F a b \<in> basis \<and> F a b *\<^sub>V a' = (if a'=a then b else 0)\<close>
     if \<open>a\<in>basisA'\<close> \<open>b\<in>basisB\<close> \<open>a'\<in>basisA'\<close> for a b a'
     apply atomize_elim apply (intro choice allI)
     using basis' by metis
   then have F_apply: \<open>F a b *\<^sub>V a' = (if a'=a then b else 0)\<close>
     if \<open>a\<in>basisA'\<close> \<open>b\<in>basisB\<close> \<open>a'\<in>basisA'\<close> for a b a'
     using that by auto
   have F_basis: \<open>F a b \<in> basis\<close>
     if \<open>a\<in>basisA'\<close> \<open>b\<in>basisB\<close> for a b
     using that F by auto
   have b_span: \<open>\<exists>G\<in>cspan {F a b|b. b\<in>basisB}. \<forall>a'\<in>basisA'. G *\<^sub>V a' = (if a'=a then b else 0)\<close> if \<open>a\<in>basisA'\<close> for a b
   proof -
     from \<open>cspan basisB = UNIV\<close>
     obtain r t where \<open>finite t\<close> and \<open>t \<subseteq> basisB\<close> and b_lincom: \<open>b = (\<Sum>a\<in>t. r a *\<^sub>C a)\<close>
       unfolding complex_vector.span_alt by atomize_elim blast
     define G where \<open>G = (\<Sum>i\<in>t. r i *\<^sub>C F a i)\<close>
     have \<open>G \<in> cspan {F a b|b. b\<in>basisB}\<close>
       using \<open>finite t\<close> \<open>t \<subseteq> basisB\<close> unfolding G_def
       by (smt (verit) complex_vector.span_scale complex_vector.span_sum complex_vector.span_superset mem_Collect_eq subsetD)
     moreover have \<open>G *\<^sub>V a' = (if a'=a then b else 0)\<close> if \<open>a'\<in>basisA'\<close> for a'
       using \<open>t \<subseteq> basisB\<close> \<open>a\<in>basisA'\<close> \<open>a'\<in>basisA'\<close>
       by (auto simp: b_lincom G_def cblinfun.sum_left F_apply intro!: sum.neutral sum.cong)
     ultimately show ?thesis
       by blast
   qed
 
   have a_span: \<open>cspan (\<Union>a\<in>basisA'. cspan {F a b|b. b\<in>basisB}) = UNIV\<close>
   proof (intro equalityI subset_UNIV subsetI, rename_tac H)
     fix H
     obtain G where G: \<open>G a b \<in> cspan {F a b|b. b\<in>basisB} \<and> G a b *\<^sub>V a' = (if a'=a then b else 0)\<close> 
       if \<open>a\<in>basisA'\<close> and \<open>a'\<in>basisA'\<close> for a b a'
       apply atomize_elim apply (intro choice allI)
       using b_span by blast
     then have G_cspan: \<open>G a b \<in> cspan {F a b|b. b\<in>basisB}\<close> if \<open>a\<in>basisA'\<close> for a b
       using that by auto
     from G have G: \<open>G a b *\<^sub>V a' = (if a'=a then b else 0)\<close> if \<open>a\<in>basisA'\<close> and \<open>a'\<in>basisA'\<close> for a b a'
       using that by auto
     define H' where \<open>H' = (\<Sum>a\<in>basisA'. G a (H *\<^sub>V a))\<close>
     have \<open>H' \<in> cspan (\<Union>a\<in>basisA'. cspan {F a b|b. b\<in>basisB})\<close>
       unfolding H'_def using G_cspan
       by (smt (verit, del_insts) UN_iff complex_vector.span_clauses(1) complex_vector.span_sum)
     moreover have \<open>H' = H\<close>
       using \<open>cspan basisA' = UNIV\<close> 
       by (auto simp: H'_def cblinfun_eq_on_UNIV_span cblinfun.sum_left G)
     ultimately show \<open>H \<in> cspan (\<Union>a\<in>basisA'. cspan {F a b |b. b \<in> basisB})\<close>
       by simp
   qed
 
   moreover have \<open>cspan basis \<supseteq> cspan (\<Union>a\<in>basisA'. cspan {F a b|b. b\<in>basisB})\<close>
     by (smt (verit) F_basis UN_subset_iff complex_vector.span_base complex_vector.span_minimal complex_vector.subspace_span mem_Collect_eq subsetI)
 
   ultimately show \<open>cspan basis = UNIV\<close>
     by auto
 qed
 
 
 instance cblinfun :: (\<open>{cfinite_dim,complex_normed_vector}\<close>, \<open>{cfinite_dim,complex_normed_vector}\<close>) cfinite_dim
 proof intro_classes
   obtain basisA :: \<open>'a set\<close> where [simp]: \<open>cspan basisA = UNIV\<close> \<open>cindependent basisA\<close> \<open>finite basisA\<close>
     using finite_basis by blast
   obtain basisB :: \<open>'b set\<close> where [simp]: \<open>cspan basisB = UNIV\<close> \<open>cindependent basisB\<close> \<open>finite basisB\<close>
     using finite_basis by blast
   define f where \<open>f a b = cconstruct basisA (\<lambda>x. if x=a then b else 0)\<close> for a :: 'a and b :: 'b
   have f_a: \<open>f a b a = b\<close> if \<open>a : basisA\<close> for a b
     by (simp add: complex_vector.construct_basis f_def that)
   have f_not_a: \<open>f a b c = 0\<close> if \<open>a : basisA\<close> and \<open>c : basisA\<close> and \<open>a \<noteq> c\<close>for a b c
     using that by (simp add: complex_vector.construct_basis f_def)
   define F where \<open>F a b = CBlinfun (f a b)\<close> for a b
   have \<open>clinear (f a b)\<close> for a b
     by (auto intro: complex_vector.linear_construct simp: f_def)
   then have \<open>bounded_clinear (f a b)\<close> for a b
     by auto
   then have F_apply: \<open>cblinfun_apply (F a b) = f a b\<close> for a b
     by (simp add: F_def bounded_clinear_CBlinfun_apply)
   define basis where \<open>basis = {F a b| a b. a\<in>basisA \<and> b\<in>basisB}\<close>
   have "\<And>a b. \<lbrakk>a \<in> basisA; b \<in> basisB\<rbrakk> \<Longrightarrow> \<exists>F\<in>basis. \<forall>a'\<in>basisA. F *\<^sub>V a' = (if a' = a then b else 0)"
     by (smt (verit, del_insts) F_apply basis_def f_a f_not_a mem_Collect_eq)
   then have \<open>cspan basis = UNIV\<close>
     by (metis \<open>cspan basisA = UNIV\<close> \<open>cspan basisB = UNIV\<close> cblinfun_cspan_UNIV)
 
   moreover have \<open>finite basis\<close>
     unfolding basis_def by (auto intro: finite_image_set2) 
   ultimately show \<open>\<exists>S :: ('a \<Rightarrow>\<^sub>C\<^sub>L 'b) set. finite S \<and> cspan S = UNIV\<close>
     by auto
 qed
 
 lemma norm_cblinfun_bound_dense:
   assumes \<open>0 \<le> b\<close>
   assumes S: \<open>closure S = UNIV\<close>
   assumes bound: \<open>\<And>x. x\<in>S \<Longrightarrow> norm (cblinfun_apply f x) \<le> b * norm x\<close>
   shows \<open>norm f \<le> b\<close>
 proof -
   have 1: \<open>continuous_on UNIV (\<lambda>a. norm (f *\<^sub>V a))\<close>
     by (simp add: continuous_on_eq_continuous_within)
   have 2: \<open>continuous_on UNIV (\<lambda>a. b * norm a)\<close>
     using continuous_on_mult_left continuous_on_norm_id by blast
   have \<open>norm (cblinfun_apply f x) \<le> b * norm x\<close> for x
     by (metis (mono_tags, lifting) UNIV_I S bound 1 2 on_closure_leI)
   then show \<open>norm f \<le> b\<close>
     using \<open>0 \<le> b\<close> norm_cblinfun_bound by blast
 qed
 
 lemma infsum_cblinfun_apply:
   assumes \<open>g summable_on S\<close>
   shows \<open>infsum (\<lambda>x. A *\<^sub>V g x) S = A *\<^sub>V (infsum g S)\<close>
   using infsum_bounded_linear[unfolded o_def] assms cblinfun.real.bounded_linear_right by blast
 
 lemma has_sum_cblinfun_apply:
   assumes \<open>(g has_sum x) S\<close>
   shows \<open>((\<lambda>x. A *\<^sub>V g x) has_sum (A *\<^sub>V x)) S\<close>
   using assms has_sum_bounded_linear[unfolded o_def] using cblinfun.real.bounded_linear_right by blast
 
 lemma abs_summable_on_cblinfun_apply:
   assumes \<open>g abs_summable_on S\<close>
   shows \<open>(\<lambda>x. A *\<^sub>V g x) abs_summable_on S\<close>
   using bounded_clinear.bounded_linear[OF cblinfun.bounded_clinear_right] assms
   by (rule abs_summable_on_bounded_linear[unfolded o_def])
 
 lemma summable_on_cblinfun_apply:
   assumes \<open>g summable_on S\<close>
   shows \<open>(\<lambda>x. A *\<^sub>V g x) summable_on S\<close>
   using bounded_clinear.bounded_linear[OF cblinfun.bounded_clinear_right] assms
   by (rule summable_on_bounded_linear[unfolded o_def])
 
 lemma summable_on_cblinfun_apply_left:
   assumes \<open>A summable_on S\<close>
   shows \<open>(\<lambda>x. A x *\<^sub>V g) summable_on S\<close>
   using bounded_clinear.bounded_linear[OF cblinfun.bounded_clinear_left] assms
   by (rule summable_on_bounded_linear[unfolded o_def])
 
 lemma abs_summable_on_cblinfun_apply_left:
   assumes \<open>A abs_summable_on S\<close>
   shows \<open>(\<lambda>x. A x *\<^sub>V g) abs_summable_on S\<close>
   using bounded_clinear.bounded_linear[OF cblinfun.bounded_clinear_left] assms
   by (rule abs_summable_on_bounded_linear[unfolded o_def])
 lemma infsum_cblinfun_apply_left:
   assumes \<open>A summable_on S\<close>
   shows \<open>infsum (\<lambda>x. A x *\<^sub>V g) S = (infsum A S) *\<^sub>V g\<close>
   apply (rule infsum_bounded_linear[unfolded o_def, of \<open>\<lambda>A. cblinfun_apply A g\<close>])
   using assms 
   by (auto simp add: bounded_clinear.bounded_linear bounded_cbilinear_cblinfun_apply)
 lemma has_sum_cblinfun_apply_left:
   assumes \<open>(A has_sum x) S\<close>
   shows \<open>((\<lambda>x. A x *\<^sub>V g) has_sum (x *\<^sub>V g)) S\<close>
   apply (rule has_sum_bounded_linear[unfolded o_def, of \<open>\<lambda>A. cblinfun_apply A g\<close>])
   using assms by (auto simp add: bounded_clinear.bounded_linear cblinfun.bounded_clinear_left)
 
 text \<open>The next eight lemmas logically belong in \<^theory>\<open>Complex_Bounded_Operators.Complex_Inner_Product\<close>
   but the proofs use facts from this theory.\<close>
 lemma has_sum_cinner_left:
   assumes \<open>(f has_sum x) I\<close>
   shows \<open>((\<lambda>i. cinner a (f i)) has_sum cinner a x) I\<close>
   by (metis assms cblinfun_cinner_right.rep_eq has_sum_cblinfun_apply)
 
 lemma summable_on_cinner_left:
   assumes \<open>f summable_on I\<close>
   shows \<open>(\<lambda>i. cinner a (f i)) summable_on I\<close>
   by (metis assms has_sum_cinner_left summable_on_def)
 
 lemma infsum_cinner_left:
   assumes \<open>\<phi> summable_on I\<close>
   shows \<open>cinner \<psi> (\<Sum>\<^sub>\<infinity>i\<in>I. \<phi> i) = (\<Sum>\<^sub>\<infinity>i\<in>I. cinner \<psi> (\<phi> i))\<close>
   by (metis assms has_sum_cinner_left has_sum_infsum infsumI)
 
 lemma has_sum_cinner_right:
   assumes \<open>(f has_sum x) I\<close>
   shows \<open>((\<lambda>i. f i \<bullet>\<^sub>C a) has_sum (x \<bullet>\<^sub>C a)) I\<close>
   using assms has_sum_bounded_linear[unfolded o_def] bounded_antilinear.bounded_linear 
     bounded_antilinear_cinner_left by blast
 
 
 lemma summable_on_cinner_right:
   assumes \<open>f summable_on I\<close>
   shows \<open>(\<lambda>i. f i \<bullet>\<^sub>C a) summable_on I\<close>
   by (metis assms has_sum_cinner_right summable_on_def)
 
 lemma infsum_cinner_right:
   assumes \<open>\<phi> summable_on I\<close>
   shows \<open>(\<Sum>\<^sub>\<infinity>i\<in>I. \<phi> i) \<bullet>\<^sub>C \<psi> = (\<Sum>\<^sub>\<infinity>i\<in>I. \<phi> i \<bullet>\<^sub>C \<psi>)\<close>
   by (metis assms has_sum_cinner_right has_sum_infsum infsumI)
 
 lemma Cauchy_cinner_product_summable:
   assumes asum: \<open>a summable_on UNIV\<close>
   assumes bsum: \<open>b summable_on UNIV\<close>
   assumes \<open>finite X\<close> \<open>finite Y\<close>
   assumes pos: \<open>\<And>x y. x \<notin> X \<Longrightarrow> y \<notin> Y \<Longrightarrow> cinner (a x) (b y) \<ge> 0\<close>
   shows absum: \<open>(\<lambda>(x, y). cinner (a x) (b y)) summable_on UNIV\<close>
 proof -
   have \<open>(\<Sum>(x,y)\<in>F. norm (cinner (a x) (b y))) \<le> norm (cinner (infsum a (-X)) (infsum b (-Y))) + norm (infsum a (-X)) + norm (infsum b (-Y)) + 1\<close> 
     if \<open>finite F\<close> and \<open>F \<subseteq> (-X)\<times>(-Y)\<close> for F
   proof -
     from asum \<open>finite X\<close>
     have \<open>a summable_on (-X)\<close>
       by (simp add: Compl_eq_Diff_UNIV summable_on_cofin_subset)
     then obtain MA where \<open>finite MA\<close> and \<open>MA \<subseteq> -X\<close>
       and MA: \<open>G \<supseteq> MA \<Longrightarrow> G \<subseteq> -X \<Longrightarrow> finite G \<Longrightarrow> norm (sum a G - infsum a (-X)) \<le> 1\<close> for G
       apply (simp add: summable_iff_has_sum_infsum has_sum_metric dist_norm)
       by (meson less_eq_real_def zero_less_one)
     
     from bsum \<open>finite Y\<close>
     have \<open>b summable_on (-Y)\<close>
       by (simp add: Compl_eq_Diff_UNIV summable_on_cofin_subset)
     then obtain MB where \<open>finite MB\<close> and \<open>MB \<subseteq> -Y\<close>
       and MB: \<open>G \<supseteq> MB \<Longrightarrow> G \<subseteq> -Y \<Longrightarrow> finite G \<Longrightarrow> norm (sum b G - infsum b (-Y)) \<le> 1\<close> for G
       apply (simp add: summable_iff_has_sum_infsum has_sum_metric dist_norm)
       by (meson less_eq_real_def zero_less_one)
 
     define F1 F2 where \<open>F1 = fst ` F \<union> MA\<close> and \<open>F2 = snd ` F \<union> MB\<close>
     define t1 t2 where \<open>t1 = sum a F1 - infsum a (-X)\<close> and \<open>t2 = sum b F2 - infsum b (-Y)\<close>
   
     have [simp]: \<open>finite F1\<close> \<open>finite F2\<close>
       using F1_def F2_def \<open>finite MA\<close> \<open>finite MB\<close> that by auto
     have [simp]: \<open>F1 \<subseteq> -X\<close> \<open>F2 \<subseteq> -Y\<close>
       using \<open>F \<subseteq> (-X)\<times>(-Y)\<close> \<open>MA \<subseteq> -X\<close> \<open>MB \<subseteq> -Y\<close>
       by (auto simp: F1_def F2_def)
     from MA[OF _ \<open>F1 \<subseteq> -X\<close> \<open>finite F1\<close>] have \<open>norm t1 \<le> 1\<close> 
       by (auto simp: t1_def F1_def)
     from MB[OF _ \<open>F2 \<subseteq> -Y\<close> \<open>finite F2\<close>] have \<open>norm t2 \<le> 1\<close> 
       by (auto simp: t2_def F2_def)
     have [simp]: \<open>F \<subseteq> F1 \<times> F2\<close>
       by (force simp: F1_def F2_def image_def)
     have \<open>(\<Sum>(x,y)\<in>F. norm (cinner (a x) (b y))) \<le> (\<Sum>(x,y)\<in>F1\<times>F2. norm (cinner (a x) (b y)))\<close>
       by (intro sum_mono2) auto
     also have "... = (\<Sum>x\<in>F1 \<times> F2. norm (a (fst x) \<bullet>\<^sub>C b (snd x)))"
       by (auto  simp: case_prod_beta)
     also have "... =  norm (\<Sum>x\<in>F1 \<times> F2. a (fst x) \<bullet>\<^sub>C b (snd x))"
     proof -
       have "(\<Sum>x\<in>F1 \<times> F2. \<bar>a (fst x) \<bullet>\<^sub>C b (snd x)\<bar>) = \<bar>\<Sum>x\<in>F1 \<times> F2. a (fst x) \<bullet>\<^sub>C b (snd x)\<bar>"
         by (smt (verit, best) pos sum.cong sum_nonneg ComplD SigmaE \<open>F1 \<subseteq> - X\<close> \<open>F2 \<subseteq> - Y\<close> abs_pos prod.sel subset_iff)
       then show ?thesis
         by (smt (verit) abs_complex_def norm_ge_zero norm_of_real o_def of_real_sum sum.cong sum_norm_le)
     qed
     also from pos have \<open>\<dots> = norm (\<Sum>(x,y)\<in>F1\<times>F2. cinner (a x) (b y))\<close>
       by (auto simp: case_prod_beta)
     also have \<open>\<dots> = norm (cinner (sum a F1) (sum b F2))\<close>
       by (simp add: sum.cartesian_product sum_cinner)
     also have \<open>\<dots> = norm (cinner (infsum a (-X) + t1) (infsum b (-Y) + t2))\<close>
       by (simp add: t1_def t2_def)
     also have \<open>\<dots> \<le> norm (cinner (infsum a (-X)) (infsum b (-Y))) + norm (infsum a (-X)) * norm t2 + norm t1 * norm (infsum b (-Y)) + norm t1 * norm t2\<close>
       apply (simp add: cinner_add_right cinner_add_left)
       by (smt (verit, del_insts) complex_inner_class.Cauchy_Schwarz_ineq2 norm_triangle_ineq)
     also from \<open>norm t1 \<le> 1\<close> \<open>norm t2 \<le> 1\<close>
     have \<open>\<dots> \<le> norm (cinner (infsum a (-X)) (infsum b (-Y))) + norm (infsum a (-X)) + norm (infsum b (-Y)) + 1\<close>
       by (auto intro!: add_mono mult_left_le mult_left_le_one_le mult_le_one)
     finally show ?thesis
       by -
   qed
 
   then have \<open>(\<lambda>(x, y). cinner (a x) (b y)) abs_summable_on (-X)\<times>(-Y)\<close>
     apply (rule_tac nonneg_bdd_above_summable_on)
     by (auto intro!: bdd_aboveI2 simp: case_prod_unfold)
   then have 1: \<open>(\<lambda>(x, y). cinner (a x) (b y)) summable_on (-X)\<times>(-Y)\<close>
     using abs_summable_summable by blast
 
   from bsum
   have \<open>(\<lambda>y. b y) summable_on (-Y)\<close>
     by (simp add: Compl_eq_Diff_UNIV assms(4) summable_on_cofin_subset)
   then have \<open>(\<lambda>y. cinner (a x) (b y)) summable_on (-Y)\<close> for x
     using summable_on_cinner_left by blast
   with \<open>finite X\<close> have 2: \<open>(\<lambda>(x, y). cinner (a x) (b y)) summable_on X\<times>(-Y)\<close>
     by (force intro: summable_on_product_finite_left)
 
   from asum
   have \<open>(\<lambda>x. a x) summable_on (-X)\<close>
     by (simp add: Compl_eq_Diff_UNIV assms(3) summable_on_cofin_subset)
   then have \<open>(\<lambda>x. cinner (a x) (b y)) summable_on (-X)\<close> for y
     using summable_on_cinner_right by blast
   with \<open>finite Y\<close> have 3: \<open>(\<lambda>(x, y). cinner (a x) (b y)) summable_on (-X)\<times>Y\<close>
     by (force intro: summable_on_product_finite_right)
 
   have 4: \<open>(\<lambda>(x, y). cinner (a x) (b y)) summable_on X\<times>Y\<close>
     by (simp add: \<open>finite X\<close> \<open>finite Y\<close>)
 
   have \<section>: "UNIV = ((-X) \<times> -Y) \<union> (X \<times> -Y) \<union> ((-X) \<times> Y) \<union> (X \<times> Y)"
     by auto
   show ?thesis
     using 1 2 3 4 by (force simp: \<section> intro!: summable_on_Un_disjoint) 
 qed
 
 
 text \<open>A variant of @{thm [source] Series.Cauchy_product_sums} with \<^term>\<open>(*)\<close> replaced by \<^term>\<open>cinner\<close>.
    Differently from @{thm [source] Series.Cauchy_product_sums}, we do not require absolute summability
    of \<^term>\<open>a\<close> and \<^term>\<open>b\<close> individually but only unconditional summability of \<^term>\<open>a\<close>, \<^term>\<open>b\<close>, and their product.
    While on, e.g., reals, unconditional summability is equivalent to absolute summability, in
    general unconditional summability is a weaker requirement.
 
   Logically belong in \<^theory>\<open>Complex_Bounded_Operators.Complex_Inner_Product\<close>
   but the proof uses facts from this theory.\<close>
 lemma 
   fixes a b :: "nat \<Rightarrow> 'a::complex_inner"
   assumes asum: \<open>a summable_on UNIV\<close>
   assumes bsum: \<open>b summable_on UNIV\<close>
   assumes absum: \<open>(\<lambda>(x, y). cinner (a x) (b y)) summable_on UNIV\<close>
     (* \<comment> \<open>See @{thm [source] Cauchy_cinner_product_summable} or @{thm [source] Cauchy_cinner_product_summable'} for a way to rewrite this premise.\<close> *)
   shows Cauchy_cinner_product_infsum: \<open>(\<Sum>\<^sub>\<infinity>k. \<Sum>i\<le>k. cinner (a i) (b (k - i))) = cinner (\<Sum>\<^sub>\<infinity>k. a k) (\<Sum>\<^sub>\<infinity>k. b k)\<close>
     and Cauchy_cinner_product_infsum_exists: \<open>(\<lambda>k. \<Sum>i\<le>k. cinner (a i) (b (k - i))) summable_on UNIV\<close>
 proof -
   have img: \<open>(\<lambda>(k::nat, i). (i, k - i)) ` {(k, i). i \<le> k} = UNIV\<close>
     apply (auto simp: image_def)
     by (metis add.commute add_diff_cancel_right' diff_le_self)
   have inj: \<open>inj_on (\<lambda>(k::nat, i). (i, k - i)) {(k, i). i \<le> k}\<close>
     by (smt (verit, del_insts) Pair_inject case_prodE case_prod_conv eq_diff_iff inj_onI mem_Collect_eq)
   have sigma: \<open>(SIGMA k:UNIV. {i. i \<le> k}) = {(k, i). i \<le> k}\<close>
     by auto
 
   from absum
   have \<section>: \<open>(\<lambda>(x, y). cinner (a y) (b (x - y))) summable_on {(k, i). i \<le> k}\<close>
     by (rule Cauchy_cinner_product_summable'[THEN iffD1])
   then have \<open>(\<lambda>k. \<Sum>\<^sub>\<infinity>i|i\<le>k. cinner (a i) (b (k-i))) summable_on UNIV\<close>
     by (metis (mono_tags, lifting) sigma summable_on_Sigma_banach summable_on_cong)
   then show \<open>(\<lambda>k. \<Sum>i\<le>k. cinner (a i) (b (k - i))) summable_on UNIV\<close>
     by (metis (mono_tags, lifting) atMost_def finite_Collect_le_nat infsum_finite summable_on_cong)
 
   have \<open>cinner (\<Sum>\<^sub>\<infinity>k. a k) (\<Sum>\<^sub>\<infinity>k. b k) = (\<Sum>\<^sub>\<infinity>k. \<Sum>\<^sub>\<infinity>l. cinner (a k) (b l))\<close>
     by (smt (verit, best) asum bsum infsum_cinner_left infsum_cinner_right infsum_cong)
   also have \<open>\<dots> = (\<Sum>\<^sub>\<infinity>(k,l). cinner (a k) (b l))\<close>
     by (smt (verit) UNIV_Times_UNIV infsum_Sigma'_banach infsum_cong local.absum)
   also have \<open>\<dots> = (\<Sum>\<^sub>\<infinity>(k, l)\<in>(\<lambda>(k, i). (i, k - i)) ` {(k, i). i \<le> k}. cinner (a k) (b l))\<close>
     by (simp only: img)
   also have \<open>\<dots> = infsum ((\<lambda>(k, l). a k \<bullet>\<^sub>C b l) \<circ> (\<lambda>(k, i). (i, k - i))) {(k, i). i \<le> k}\<close>
     using inj by (rule infsum_reindex)
   also have \<open>\<dots> = (\<Sum>\<^sub>\<infinity>(k,i)|i\<le>k. a i \<bullet>\<^sub>C b (k-i))\<close>
     by (simp add: o_def case_prod_unfold)
   also have \<open>\<dots> = (\<Sum>\<^sub>\<infinity>k. \<Sum>\<^sub>\<infinity>i|i\<le>k. a i \<bullet>\<^sub>C b (k-i))\<close>
     by (metis (no_types) \<section> infsum_Sigma'_banach sigma)
   also have \<open>\<dots> = (\<Sum>\<^sub>\<infinity>k. \<Sum>i\<le>k. a i \<bullet>\<^sub>C b (k-i))\<close>
     by (simp add: atMost_def)
   finally show \<open>(\<Sum>\<^sub>\<infinity>k. \<Sum>i\<le>k. a i \<bullet>\<^sub>C b (k - i)) = (\<Sum>\<^sub>\<infinity>k. a k) \<bullet>\<^sub>C (\<Sum>\<^sub>\<infinity>k. b k)\<close>
     by simp
 qed
 
 
 lemma CBlinfun_plus: 
   assumes [simp]: \<open>bounded_clinear f\<close> \<open>bounded_clinear g\<close>
   shows \<open>CBlinfun (f + g) = CBlinfun f + CBlinfun g\<close>
   by (auto intro!: cblinfun_eqI simp: plus_fun_def bounded_clinear_add CBlinfun_inverse cblinfun.add_left)
 
 lemma CBlinfun_scaleC:
   assumes \<open>bounded_clinear f\<close>
   shows \<open>CBlinfun (\<lambda>y. c *\<^sub>C f y) = c *\<^sub>C CBlinfun f\<close>
   by (simp add: assms eq_onp_same_args scaleC_cblinfun.abs_eq)
 
 
 lemma cinner_sup_norm_cblinfun:
   fixes A :: \<open>'a::{complex_normed_vector,not_singleton} \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_inner\<close>
   shows \<open>norm A = (SUP (\<psi>,\<phi>). cmod (cinner \<psi> (A *\<^sub>V \<phi>)) / (norm \<psi> * norm \<phi>))\<close>
   apply transfer
   apply (rule cinner_sup_onorm)
   by (simp add: bounded_clinear.bounded_linear)
 
 
 lemma norm_cblinfun_Sup: \<open>norm A = (SUP \<psi>. norm (A *\<^sub>V \<psi>) / norm \<psi>)\<close>
   by (simp add: norm_cblinfun.rep_eq onorm_def)
 
 lemma cblinfun_eq_on:
   fixes A B :: "'a::cbanach \<Rightarrow>\<^sub>C\<^sub>L'b::complex_normed_vector"
   assumes "\<And>x. x \<in> G \<Longrightarrow> A *\<^sub>V x = B *\<^sub>V x" and \<open>t \<in> closure (cspan G)\<close>
   shows "A *\<^sub>V t = B *\<^sub>V t"
   using assms
   apply transfer
   using bounded_clinear_eq_on_closure by blast
 
 lemma cblinfun_eq_gen_eqI:
   fixes A B :: "'a::cbanach \<Rightarrow>\<^sub>C\<^sub>L'b::complex_normed_vector"
   assumes "\<And>x. x \<in> G \<Longrightarrow> A *\<^sub>V x = B *\<^sub>V x" and \<open>ccspan G = \<top>\<close>
   shows "A = B"
   by (metis assms cblinfun_eqI cblinfun_eq_on ccspan.rep_eq iso_tuple_UNIV_I top_ccsubspace.rep_eq)
 
 declare cnj_bounded_antilinear[bounded_antilinear]
 
 lemma Cblinfun_comp_bounded_cbilinear: \<open>bounded_clinear (CBlinfun o p)\<close> if \<open>bounded_cbilinear p\<close>
   by (metis bounded_cbilinear.bounded_clinear_prod_right bounded_cbilinear.prod_right_def comp_id map_fun_def that)
 
 lemma Cblinfun_comp_bounded_sesquilinear: \<open>bounded_antilinear (CBlinfun o p)\<close> if \<open>bounded_sesquilinear p\<close>
   by (metis (mono_tags, opaque_lifting) bounded_clinear_CBlinfun_apply bounded_sesquilinear.bounded_clinear_right comp_apply that transfer_bounded_sesquilinear_bounded_antilinearI)
 
 subsection \<open>Relationship to real bounded operators (\<^typ>\<open>_ \<Rightarrow>\<^sub>L _\<close>)\<close>
 
 instantiation blinfun :: (real_normed_vector, complex_normed_vector) "complex_normed_vector"
 begin
 lift_definition scaleC_blinfun :: \<open>complex \<Rightarrow>
  ('a::real_normed_vector, 'b::complex_normed_vector) blinfun \<Rightarrow>
  ('a, 'b) blinfun\<close>
   is \<open>\<lambda> c::complex. \<lambda> f::'a\<Rightarrow>'b. (\<lambda> x. c *\<^sub>C (f x) )\<close>
 proof
   fix c::complex and f :: \<open>'a\<Rightarrow>'b\<close> and b1::'a and b2::'a
   assume \<open>bounded_linear f\<close>
   show \<open>c *\<^sub>C f (b1 + b2) = c *\<^sub>C f b1 + c *\<^sub>C f b2\<close>
     by (simp add: \<open>bounded_linear f\<close> linear_simps scaleC_add_right)
 
   fix c::complex and f :: \<open>'a\<Rightarrow>'b\<close> and b::'a and r::real
   assume \<open>bounded_linear f\<close>
   show \<open>c *\<^sub>C f (r *\<^sub>R b) = r *\<^sub>R (c *\<^sub>C f b)\<close>
     by (simp add: \<open>bounded_linear f\<close> linear_simps(5) scaleR_scaleC)
 
   fix c::complex and f :: \<open>'a\<Rightarrow>'b\<close>
   assume \<open>bounded_linear f\<close>
 
   have \<open>\<exists> K. \<forall> x. norm (f x) \<le> norm x * K\<close>
     using \<open>bounded_linear f\<close>
     by (simp add: bounded_linear.bounded)
   then obtain K where \<open>\<forall> x. norm (f x) \<le> norm x * K\<close>
     by blast
   have \<open>cmod c \<ge> 0\<close>
     by simp
   hence \<open>\<forall> x. (cmod c) * norm (f x) \<le> (cmod c) * norm x * K\<close>
     using  \<open>\<forall> x. norm (f x) \<le> norm x * K\<close>
     by (metis ordered_comm_semiring_class.comm_mult_left_mono vector_space_over_itself.scale_scale)
   moreover have \<open>norm (c *\<^sub>C f x) = (cmod c) * norm (f x)\<close>
     for x
     by simp
   ultimately show \<open>\<exists>K. \<forall>x. norm (c *\<^sub>C f x) \<le> norm x * K\<close>
     by (metis ab_semigroup_mult_class.mult_ac(1) mult.commute)
 qed
 
 instance
 proof
   have "r *\<^sub>R x = complex_of_real r *\<^sub>C x"
     for x :: "('a, 'b) blinfun" and r
     by transfer (simp add: scaleR_scaleC)
   thus "((*\<^sub>R) r::'a \<Rightarrow>\<^sub>L 'b \<Rightarrow> _) = (*\<^sub>C) (complex_of_real r)" for r
     by auto
   show "a *\<^sub>C (x + y) = a *\<^sub>C x + a *\<^sub>C y"
     for a :: complex and x y :: "'a \<Rightarrow>\<^sub>L 'b"
     by transfer (simp add: scaleC_add_right)
 
   show "(a + b) *\<^sub>C x = a *\<^sub>C x + b *\<^sub>C x"
     for a b :: complex and x :: "'a \<Rightarrow>\<^sub>L 'b"
     by transfer (simp add: scaleC_add_left)
 
   show "a *\<^sub>C b *\<^sub>C x = (a * b) *\<^sub>C x"
     for a b :: complex and x :: "'a \<Rightarrow>\<^sub>L 'b"
     by transfer simp
 
   have \<open>1 *\<^sub>C f x = f x\<close>
     for f :: \<open>'a\<Rightarrow>'b\<close> and x
     by auto
   thus "1 *\<^sub>C x = x"
     for x :: "'a \<Rightarrow>\<^sub>L 'b"
     by (simp add: scaleC_blinfun.rep_eq blinfun_eqI)
 
   have \<open>onorm (\<lambda>x. a *\<^sub>C f x) = cmod a * onorm f\<close>
     if \<open>bounded_linear f\<close>
     for f :: \<open>'a \<Rightarrow> 'b\<close> and a :: complex
   proof-
     have \<open>cmod a \<ge> 0\<close>
       by simp
     have \<open>\<exists> K::real. \<forall> x. (\<bar> ereal ((norm (f x)) / (norm x)) \<bar>) \<le> K\<close>
       using \<open>bounded_linear f\<close> le_onorm by fastforce
     then obtain K::real where \<open>\<forall> x. (\<bar> ereal ((norm (f x)) / (norm x)) \<bar>) \<le> K\<close>
       by blast
     hence  \<open>\<forall> x. (cmod a) *(\<bar> ereal ((norm (f x)) / (norm x)) \<bar>) \<le> (cmod a) * K\<close>
       using \<open>cmod a \<ge> 0\<close>
       by (metis abs_ereal.simps(1) abs_ereal_pos   abs_pos ereal_mult_left_mono  times_ereal.simps(1))
     hence  \<open>\<forall> x.  (\<bar> ereal ((cmod a) * (norm (f x)) / (norm x)) \<bar>) \<le> (cmod a) * K\<close>
       by simp
     hence \<open>bdd_above {ereal (cmod a * (norm (f x)) / (norm x)) | x. True}\<close>
       by simp
     moreover have \<open>{ereal (cmod a * (norm (f x)) / (norm x)) | x. True} \<noteq> {}\<close>
       by auto
     ultimately have p1: \<open>(SUP x. \<bar>ereal (cmod a * (norm (f x)) / (norm x))\<bar>) \<le> cmod a * K\<close>
       using \<open>\<forall> x. \<bar> ereal (cmod a * (norm (f x)) / (norm x)) \<bar> \<le> cmod a * K\<close>
         Sup_least mem_Collect_eq
       by (simp add: SUP_le_iff)
     have  p2: \<open>\<And>i. i \<in> UNIV \<Longrightarrow> 0 \<le> ereal (cmod a * norm (f i) / norm i)\<close>
       by simp
     hence \<open>\<bar>SUP x. ereal (cmod a * (norm (f x)) / (norm x))\<bar>
               \<le> (SUP x. \<bar>ereal (cmod a * (norm (f x)) / (norm x))\<bar>)\<close>
       using  \<open>bdd_above {ereal (cmod a * (norm (f x)) / (norm x)) | x. True}\<close>
         \<open>{ereal (cmod a * (norm (f x)) / (norm x)) | x. True} \<noteq> {}\<close>
       by (metis (mono_tags, lifting) SUP_upper2 Sup.SUP_cong UNIV_I
           p2 abs_ereal_ge0 ereal_le_real)
     hence \<open>\<bar>SUP x. ereal (cmod a * (norm (f x)) / (norm x))\<bar> \<le> cmod a * K\<close>
       using  \<open>(SUP x. \<bar>ereal (cmod a * (norm (f x)) / (norm x))\<bar>) \<le> cmod a * K\<close>
       by simp
     hence \<open>\<bar> ( SUP i\<in>UNIV::'a set. ereal ((\<lambda> x. (cmod a) * (norm (f x)) / norm x) i)) \<bar> \<noteq> \<infinity>\<close>
       by auto
     hence w2: \<open>( SUP i\<in>UNIV::'a set. ereal ((\<lambda> x. cmod a * (norm (f x)) / norm x) i))
              = ereal ( Sup ((\<lambda> x. cmod a * (norm (f x)) / norm x) ` (UNIV::'a set) ))\<close>
       by (simp add: ereal_SUP)
     have \<open>(UNIV::('a set)) \<noteq> {}\<close>
       by simp
     moreover have \<open>\<And> i. i \<in> (UNIV::('a set)) \<Longrightarrow> (\<lambda> x. (norm (f x)) / norm x :: ereal) i \<ge> 0\<close>
       by simp
     moreover have \<open>cmod a \<ge> 0\<close>
       by simp
     ultimately have \<open>(SUP i\<in>(UNIV::('a set)). ((cmod a)::ereal) * (\<lambda> x. (norm (f x)) / norm x :: ereal) i )
         = ((cmod a)::ereal) * ( SUP i\<in>(UNIV::('a set)). (\<lambda> x. (norm (f x)) / norm x :: ereal) i )\<close>
       by (simp add: Sup_ereal_mult_left')
     hence \<open>(SUP x. ((cmod a)::ereal) * ( (norm (f x)) / norm x :: ereal) )
         = ((cmod a)::ereal) * ( SUP x. ( (norm (f x)) / norm x :: ereal) )\<close>
       by simp
     hence z1: \<open>real_of_ereal ( (SUP x. ((cmod a)::ereal) * ( (norm (f x)) / norm x :: ereal) ) )
         = real_of_ereal ( ((cmod a)::ereal) * ( SUP x. ( (norm (f x)) / norm x :: ereal) ) )\<close>
       by simp
     have z2: \<open>real_of_ereal (SUP x. ((cmod a)::ereal) * ( (norm (f x)) / norm x :: ereal) )
                   = (SUP x. cmod a * (norm (f x) / norm x))\<close>
       using w2
       by auto
     have \<open>real_of_ereal ( ((cmod a)::ereal) * ( SUP x. ( (norm (f x)) / norm x :: ereal) ) )
                 =  (cmod a) * real_of_ereal ( SUP x. ( (norm (f x)) / norm x :: ereal) )\<close>
       by simp
     moreover have \<open>real_of_ereal ( SUP x. ( (norm (f x)) / norm x :: ereal) )
                   = ( SUP x. ((norm (f x)) / norm x) )\<close>
     proof-
       have \<open>\<bar> ( SUP i\<in>UNIV::'a set. ereal ((\<lambda> x. (norm (f x)) / norm x) i)) \<bar> \<noteq> \<infinity>\<close>
       proof-
         have \<open>\<exists> K::real. \<forall> x. (\<bar> ereal ((norm (f x)) / (norm x)) \<bar>) \<le> K\<close>
           using \<open>bounded_linear f\<close> le_onorm by fastforce
         then obtain K::real where \<open>\<forall> x. (\<bar> ereal ((norm (f x)) / (norm x)) \<bar>) \<le> K\<close>
           by blast
         hence \<open>bdd_above {ereal ((norm (f x)) / (norm x)) | x. True}\<close>
           by simp
         moreover have \<open>{ereal ((norm (f x)) / (norm x)) | x. True} \<noteq> {}\<close>
           by auto
         ultimately have \<open>(SUP x. \<bar>ereal ((norm (f x)) / (norm x))\<bar>) \<le> K\<close>
           using \<open>\<forall> x. \<bar> ereal ((norm (f x)) / (norm x)) \<bar> \<le> K\<close>
             Sup_least mem_Collect_eq
           by (simp add: SUP_le_iff)
         hence \<open>\<bar>SUP x. ereal ((norm (f x)) / (norm x))\<bar>
               \<le> (SUP x. \<bar>ereal ((norm (f x)) / (norm x))\<bar>)\<close>
           using  \<open>bdd_above {ereal ((norm (f x)) / (norm x)) | x. True}\<close>
             \<open>{ereal ((norm (f x)) / (norm x)) | x. True} \<noteq> {}\<close>
           by (metis (mono_tags, lifting) SUP_upper2 Sup.SUP_cong UNIV_I \<open>\<And>i. i \<in> UNIV \<Longrightarrow> 0 \<le> ereal (norm (f i) / norm i)\<close> abs_ereal_ge0 ereal_le_real)
         hence \<open>\<bar>SUP x. ereal ((norm (f x)) / (norm x))\<bar> \<le> K\<close>
           using  \<open>(SUP x. \<bar>ereal ((norm (f x)) / (norm x))\<bar>) \<le> K\<close>
           by simp
         thus ?thesis
           by auto
       qed
       hence \<open> ( SUP i\<in>UNIV::'a set. ereal ((\<lambda> x. (norm (f x)) / norm x) i))
              = ereal ( Sup ((\<lambda> x. (norm (f x)) / norm x) ` (UNIV::'a set) ))\<close>
         by (simp add: ereal_SUP)
       thus ?thesis
         by simp
     qed
     have z3: \<open>real_of_ereal ( ((cmod a)::ereal) * ( SUP x. ( (norm (f x)) / norm x :: ereal) ) )
                 = cmod a * (SUP x. norm (f x) / norm x)\<close>
       by (simp add: \<open>real_of_ereal (SUP x. ereal (norm (f x) / norm x)) = (SUP x. norm (f x) / norm x)\<close>)
     hence w1: \<open>(SUP x. cmod a * (norm (f x) / norm x)) =
           cmod a * (SUP x. norm (f x) / norm x)\<close>
       using z1 z2 by linarith
     have v1: \<open>onorm (\<lambda>x. a *\<^sub>C f x) = (SUP x. norm (a *\<^sub>C f x) / norm x)\<close>
       by (simp add: onorm_def)
     have v2: \<open>(SUP x. norm (a *\<^sub>C f x) / norm x) = (SUP x. ((cmod a) * norm (f x)) / norm x)\<close>
       by simp
     have v3: \<open>(SUP x. ((cmod a) * norm (f x)) / norm x) =  (SUP x. (cmod a) * ((norm (f x)) / norm x))\<close>
       by simp
     have v4: \<open>(SUP x. (cmod a) * ((norm (f x)) / norm x)) = (cmod a) *  (SUP x. ((norm (f x)) / norm x))\<close>
       using w1
       by blast
     show \<open>onorm (\<lambda>x. a *\<^sub>C f x) = cmod a * onorm f\<close>
       using v1 v2 v3 v4
       by (metis (mono_tags, lifting) onorm_def)
   qed
   thus \<open>norm (a *\<^sub>C x) = cmod a * norm x\<close>
     for a::complex and x::\<open>('a, 'b) blinfun\<close>
     by transfer blast
 qed
 end
 
 (* We do not have clinear_blinfun_compose_right *)
 lemma clinear_blinfun_compose_left: \<open>clinear (\<lambda>x. blinfun_compose x y)\<close>
   by (auto intro!: clinearI simp: blinfun_eqI scaleC_blinfun.rep_eq bounded_bilinear.add_left
                                   bounded_bilinear_blinfun_compose)
 
 instance blinfun :: (real_normed_vector, cbanach) cbanach..
 
 lemma blinfun_compose_assoc: "(A o\<^sub>L B) o\<^sub>L C = A o\<^sub>L (B  o\<^sub>L C)"
   by (simp add: blinfun_eqI)
 
 lift_definition blinfun_of_cblinfun::\<open>'a::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_normed_vector
   \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'b\<close> is "id"
   by transfer (simp add: bounded_clinear.bounded_linear)
 
 lift_definition blinfun_cblinfun_eq ::
   \<open>'a \<Rightarrow>\<^sub>L 'b \<Rightarrow> 'a::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_normed_vector \<Rightarrow> bool\<close> is "(=)" .
 
 lemma blinfun_cblinfun_eq_bi_unique[transfer_rule]: \<open>bi_unique blinfun_cblinfun_eq\<close>
   unfolding bi_unique_def by transfer auto
 
 lemma blinfun_cblinfun_eq_right_total[transfer_rule]: \<open>right_total blinfun_cblinfun_eq\<close>
   unfolding right_total_def by transfer (simp add: bounded_clinear.bounded_linear)
 
 named_theorems cblinfun_blinfun_transfer
 
 lemma cblinfun_blinfun_transfer_0[cblinfun_blinfun_transfer]:
   "blinfun_cblinfun_eq (0::(_,_) blinfun) (0::(_,_) cblinfun)"
   by transfer simp
 
 lemma cblinfun_blinfun_transfer_plus[cblinfun_blinfun_transfer]:
   includes lifting_syntax
   shows "(blinfun_cblinfun_eq ===> blinfun_cblinfun_eq ===> blinfun_cblinfun_eq) (+) (+)"
   unfolding rel_fun_def by transfer auto
 
 lemma cblinfun_blinfun_transfer_minus[cblinfun_blinfun_transfer]:
   includes lifting_syntax
   shows "(blinfun_cblinfun_eq ===> blinfun_cblinfun_eq ===> blinfun_cblinfun_eq) (-) (-)"
   unfolding rel_fun_def by transfer auto
 
 lemma cblinfun_blinfun_transfer_uminus[cblinfun_blinfun_transfer]:
   includes lifting_syntax
   shows "(blinfun_cblinfun_eq ===> blinfun_cblinfun_eq) (uminus) (uminus)"
   unfolding rel_fun_def by transfer auto
 
 definition "real_complex_eq r c \<longleftrightarrow> complex_of_real r = c"
 
 lemma bi_unique_real_complex_eq[transfer_rule]: \<open>bi_unique real_complex_eq\<close>
   unfolding real_complex_eq_def bi_unique_def by auto
 
 lemma left_total_real_complex_eq[transfer_rule]: \<open>left_total real_complex_eq\<close>
   unfolding real_complex_eq_def left_total_def by auto
 
 lemma cblinfun_blinfun_transfer_scaleC[cblinfun_blinfun_transfer]:
   includes lifting_syntax
   shows "(real_complex_eq ===> blinfun_cblinfun_eq ===> blinfun_cblinfun_eq) (scaleR) (scaleC)"
   unfolding rel_fun_def by transfer (simp add: real_complex_eq_def scaleR_scaleC)
 
 lemma cblinfun_blinfun_transfer_CBlinfun[cblinfun_blinfun_transfer]:
   includes lifting_syntax
   shows "(eq_onp bounded_clinear ===> blinfun_cblinfun_eq) Blinfun CBlinfun"
   unfolding rel_fun_def blinfun_cblinfun_eq.rep_eq eq_onp_def
   by (auto simp: CBlinfun_inverse Blinfun_inverse bounded_clinear.bounded_linear)
 
 lemma cblinfun_blinfun_transfer_norm[cblinfun_blinfun_transfer]:
   includes lifting_syntax
   shows "(blinfun_cblinfun_eq ===> (=)) norm norm"
   unfolding rel_fun_def by transfer auto
 
 lemma cblinfun_blinfun_transfer_dist[cblinfun_blinfun_transfer]:
   includes lifting_syntax
   shows "(blinfun_cblinfun_eq ===> blinfun_cblinfun_eq ===> (=)) dist dist"
   unfolding rel_fun_def dist_norm by transfer auto
 
 lemma cblinfun_blinfun_transfer_sgn[cblinfun_blinfun_transfer]:
   includes lifting_syntax
   shows "(blinfun_cblinfun_eq ===> blinfun_cblinfun_eq) sgn sgn"
   unfolding rel_fun_def sgn_blinfun_def sgn_cblinfun_def by transfer (auto simp: scaleR_scaleC)
 
 lemma cblinfun_blinfun_transfer_Cauchy[cblinfun_blinfun_transfer]:
   includes lifting_syntax
   shows "(((=) ===> blinfun_cblinfun_eq) ===> (=)) Cauchy Cauchy"
 proof -
   note cblinfun_blinfun_transfer[transfer_rule]
   show ?thesis
     unfolding Cauchy_def
     by transfer_prover
 qed
 
 lemma cblinfun_blinfun_transfer_tendsto[cblinfun_blinfun_transfer]:
   includes lifting_syntax
   shows "(((=) ===> blinfun_cblinfun_eq) ===> blinfun_cblinfun_eq ===> (=) ===> (=)) tendsto tendsto"
 proof -
   note cblinfun_blinfun_transfer[transfer_rule]
   show ?thesis
     unfolding tendsto_iff
     by transfer_prover
 qed
 
 lemma cblinfun_blinfun_transfer_compose[cblinfun_blinfun_transfer]:
   includes lifting_syntax
   shows "(blinfun_cblinfun_eq ===> blinfun_cblinfun_eq ===> blinfun_cblinfun_eq) (o\<^sub>L) (o\<^sub>C\<^sub>L)"
   unfolding rel_fun_def by transfer auto
 
 lemma cblinfun_blinfun_transfer_apply[cblinfun_blinfun_transfer]:
   includes lifting_syntax
   shows "(blinfun_cblinfun_eq ===> (=) ===> (=)) blinfun_apply cblinfun_apply"
   unfolding rel_fun_def by transfer auto
 
 lemma blinfun_of_cblinfun_inj:
   \<open>blinfun_of_cblinfun f = blinfun_of_cblinfun g \<Longrightarrow> f = g\<close>
   by (metis cblinfun_apply_inject blinfun_of_cblinfun.rep_eq)
 
 lemma blinfun_of_cblinfun_inv:
   assumes "\<And>c. \<And>x. f *\<^sub>v (c *\<^sub>C x) = c *\<^sub>C (f *\<^sub>v x)"
   shows "\<exists>g. blinfun_of_cblinfun g = f"
   using assms
 proof transfer
   show "\<exists>g\<in>Collect bounded_clinear. id g = f"
     if "bounded_linear f"
       and "\<And>c x. f (c *\<^sub>C x) = c *\<^sub>C f x"
     for f :: "'a \<Rightarrow> 'b"
     using that bounded_linear_bounded_clinear by auto
 qed
 
 lemma blinfun_of_cblinfun_zero:
   \<open>blinfun_of_cblinfun 0 = 0\<close>
   by transfer simp
 
 lemma blinfun_of_cblinfun_uminus:
   \<open>blinfun_of_cblinfun (- f) = - (blinfun_of_cblinfun f)\<close>
   by transfer auto
 
 lemma blinfun_of_cblinfun_minus:
   \<open>blinfun_of_cblinfun (f - g) = blinfun_of_cblinfun f - blinfun_of_cblinfun g\<close>
   by transfer auto
 
 lemma blinfun_of_cblinfun_scaleC:
   \<open>blinfun_of_cblinfun (c *\<^sub>C f) = c *\<^sub>C (blinfun_of_cblinfun f)\<close>
   by transfer auto
 
 lemma blinfun_of_cblinfun_scaleR:
   \<open>blinfun_of_cblinfun (c *\<^sub>R f) = c *\<^sub>R (blinfun_of_cblinfun f)\<close>
   by transfer auto
 
 lemma blinfun_of_cblinfun_norm:
   fixes f::\<open>'a::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_normed_vector\<close>
   shows \<open>norm f = norm (blinfun_of_cblinfun f)\<close>
   by transfer auto
 
 lemma blinfun_of_cblinfun_cblinfun_compose:
   fixes f::\<open>'b::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'c::complex_normed_vector\<close>
     and g::\<open>'a::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'b\<close>
   shows \<open>blinfun_of_cblinfun (f  o\<^sub>C\<^sub>L g) = (blinfun_of_cblinfun f) o\<^sub>L (blinfun_of_cblinfun g)\<close>
   by transfer auto
 
 subsection \<open>Composition\<close>
 
 lemma cblinfun_compose_assoc:
   shows "(A o\<^sub>C\<^sub>L B) o\<^sub>C\<^sub>L C = A o\<^sub>C\<^sub>L (B o\<^sub>C\<^sub>L C)"
   by (metis (no_types, lifting) cblinfun_apply_inject fun.map_comp cblinfun_compose.rep_eq)
 
 lemma cblinfun_compose_zero_right[simp]: "U o\<^sub>C\<^sub>L 0 = 0"
   using bounded_cbilinear.zero_right bounded_cbilinear_cblinfun_compose by blast
 
 lemma cblinfun_compose_zero_left[simp]: "0 o\<^sub>C\<^sub>L U = 0"
   using bounded_cbilinear.zero_left bounded_cbilinear_cblinfun_compose by blast
 
 lemma cblinfun_compose_scaleC_left[simp]:
   fixes A::"'b::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'c::complex_normed_vector"
     and B::"'a::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'b"
   shows \<open>(a *\<^sub>C A) o\<^sub>C\<^sub>L B = a *\<^sub>C (A o\<^sub>C\<^sub>L B)\<close>
   by (simp add: bounded_cbilinear.scaleC_left bounded_cbilinear_cblinfun_compose)
 
 lemma cblinfun_compose_scaleR_left[simp]:
   fixes A::"'b::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'c::complex_normed_vector"
     and B::"'a::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'b"
   shows \<open>(a *\<^sub>R A) o\<^sub>C\<^sub>L B = a *\<^sub>R (A o\<^sub>C\<^sub>L B)\<close>
   by (simp add: scaleR_scaleC)
 
 lemma cblinfun_compose_scaleC_right[simp]:
   fixes A::"'b::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'c::complex_normed_vector"
     and B::"'a::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'b"
   shows \<open>A o\<^sub>C\<^sub>L (a *\<^sub>C B) = a *\<^sub>C (A o\<^sub>C\<^sub>L B)\<close>
   by transfer (auto intro!: ext bounded_clinear.clinear complex_vector.linear_scale)
 
 lemma cblinfun_compose_scaleR_right[simp]:
   fixes A::"'b::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'c::complex_normed_vector"
     and B::"'a::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'b"
   shows \<open>A o\<^sub>C\<^sub>L (a *\<^sub>R B) = a *\<^sub>R (A o\<^sub>C\<^sub>L B)\<close>
   by (simp add: scaleR_scaleC)
 
 lemma cblinfun_compose_id_right[simp]:
   shows "U o\<^sub>C\<^sub>L id_cblinfun = U"
   by transfer auto
 
 lemma cblinfun_compose_id_left[simp]:
   shows "id_cblinfun o\<^sub>C\<^sub>L U  = U"
   by transfer auto
 
 lemma cblinfun_compose_add_left: \<open>(a + b) o\<^sub>C\<^sub>L c = (a o\<^sub>C\<^sub>L c) + (b o\<^sub>C\<^sub>L c)\<close>
   by (simp add: bounded_cbilinear.add_left bounded_cbilinear_cblinfun_compose)
 
 lemma cblinfun_compose_add_right: \<open>a o\<^sub>C\<^sub>L (b + c) = (a o\<^sub>C\<^sub>L b) + (a o\<^sub>C\<^sub>L c)\<close>
   by (simp add: bounded_cbilinear.add_right bounded_cbilinear_cblinfun_compose)
 
 lemma cbilinear_cblinfun_compose[simp]: "cbilinear cblinfun_compose"
   by (auto intro!: clinearI simp add: cbilinear_def bounded_cbilinear.add_left bounded_cbilinear.add_right bounded_cbilinear_cblinfun_compose)
 
 lemma cblinfun_compose_sum_left: \<open>(\<Sum>i\<in>S. g i) o\<^sub>C\<^sub>L x = (\<Sum>i\<in>S. g i o\<^sub>C\<^sub>L x)\<close>
   by (induction S rule:infinite_finite_induct) (auto simp: cblinfun_compose_add_left)
 
 lemma cblinfun_compose_sum_right: \<open>x o\<^sub>C\<^sub>L (\<Sum>i\<in>S. g i) = (\<Sum>i\<in>S. x o\<^sub>C\<^sub>L g i)\<close>
   by (induction S rule:infinite_finite_induct) (auto simp: cblinfun_compose_add_right)
 
 lemma cblinfun_compose_minus_right: \<open>a o\<^sub>C\<^sub>L (b - c) = (a o\<^sub>C\<^sub>L b) - (a o\<^sub>C\<^sub>L c)\<close>
   by (simp add: bounded_cbilinear.diff_right bounded_cbilinear_cblinfun_compose)
 lemma cblinfun_compose_minus_left: \<open>(a - b) o\<^sub>C\<^sub>L c = (a o\<^sub>C\<^sub>L c) - (b o\<^sub>C\<^sub>L c)\<close>
   by (simp add: bounded_cbilinear.diff_left bounded_cbilinear_cblinfun_compose)
 
 
 lemma simp_a_oCL_b: \<open>a o\<^sub>C\<^sub>L b = c \<Longrightarrow> a o\<^sub>C\<^sub>L (b o\<^sub>C\<^sub>L d) = c o\<^sub>C\<^sub>L d\<close>
   \<comment> \<open>A convenience lemma to transform simplification rules of the form \<^term>\<open>a o\<^sub>C\<^sub>L b = c\<close>.
      E.g., \<open>simp_a_oCL_b[OF isometryD, simp]\<close> declares a simp-rule for simplifying \<^term>\<open>adj x o\<^sub>C\<^sub>L (x o\<^sub>C\<^sub>L y) = id_cblinfun o\<^sub>C\<^sub>L y\<close>.\<close>
   by (auto simp: cblinfun_compose_assoc)
 
 lemma simp_a_oCL_b': \<open>a o\<^sub>C\<^sub>L b = c \<Longrightarrow> a *\<^sub>V (b *\<^sub>V d) = c *\<^sub>V d\<close>
   \<comment> \<open>A convenience lemma to transform simplification rules of the form \<^term>\<open>a o\<^sub>C\<^sub>L b = c\<close>.
      E.g., \<open>simp_a_oCL_b'[OF isometryD, simp]\<close> declares a simp-rule for simplifying \<^term>\<open>adj x *\<^sub>V x *\<^sub>V y = id_cblinfun *\<^sub>V y\<close>.\<close>
   by auto
 
 lemma cblinfun_compose_uminus_left: \<open>(- a) o\<^sub>C\<^sub>L b = - (a o\<^sub>C\<^sub>L b)\<close>
   by (simp add: bounded_cbilinear.minus_left bounded_cbilinear_cblinfun_compose)
 
 lemma cblinfun_compose_uminus_right: \<open>a o\<^sub>C\<^sub>L (- b) = - (a o\<^sub>C\<^sub>L b)\<close>
   by (simp add: bounded_cbilinear.minus_right bounded_cbilinear_cblinfun_compose)
 
 lemma bounded_clinear_cblinfun_compose_left: \<open>bounded_clinear (\<lambda>x. x o\<^sub>C\<^sub>L y)\<close>
   by (simp add: bounded_cbilinear.bounded_clinear_left bounded_cbilinear_cblinfun_compose)
 lemma bounded_clinear_cblinfun_compose_right: \<open>bounded_clinear (\<lambda>y. x o\<^sub>C\<^sub>L y)\<close>
   by (simp add: bounded_cbilinear.bounded_clinear_right bounded_cbilinear_cblinfun_compose)
 lemma clinear_cblinfun_compose_left: \<open>clinear (\<lambda>x. x o\<^sub>C\<^sub>L y)\<close>
   by (simp add: bounded_cbilinear.bounded_clinear_left bounded_cbilinear_cblinfun_compose bounded_clinear.clinear)
 lemma clinear_cblinfun_compose_right: \<open>clinear (\<lambda>y. x o\<^sub>C\<^sub>L y)\<close>
   by (simp add: bounded_clinear.clinear bounded_clinear_cblinfun_compose_right)
 
 lemma additive_cblinfun_compose_left[simp]: \<open>Modules.additive (\<lambda>x. x o\<^sub>C\<^sub>L a)\<close>
   by (simp add: Modules.additive_def cblinfun_compose_add_left)
 lemma additive_cblinfun_compose_right[simp]: \<open>Modules.additive (\<lambda>x. a o\<^sub>C\<^sub>L x)\<close>
   by (simp add: Modules.additive_def cblinfun_compose_add_right)
 lemma isCont_cblinfun_compose_left: \<open>isCont (\<lambda>x. x o\<^sub>C\<^sub>L a) y\<close>
   apply (rule clinear_continuous_at)
   by (rule bounded_clinear_cblinfun_compose_left)
 lemma isCont_cblinfun_compose_right: \<open>isCont (\<lambda>x. a o\<^sub>C\<^sub>L x) y\<close>
   apply (rule clinear_continuous_at)
   by (rule bounded_clinear_cblinfun_compose_right)
 
 lemma cspan_compose_closed:
   assumes \<open>\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> a o\<^sub>C\<^sub>L b \<in> A\<close>
   assumes \<open>a \<in> cspan A\<close> and \<open>b \<in> cspan A\<close>
   shows \<open>a o\<^sub>C\<^sub>L b \<in> cspan A\<close>
 proof -
   from \<open>a \<in> cspan A\<close>
   obtain F f where \<open>finite F\<close> and \<open>F \<subseteq> A\<close> and a_def: \<open>a = (\<Sum>x\<in>F. f x *\<^sub>C x)\<close>
     by (smt (verit, del_insts) complex_vector.span_explicit mem_Collect_eq)
   from \<open>b \<in> cspan A\<close>
   obtain G g where \<open>finite G\<close> and \<open>G \<subseteq> A\<close> and b_def: \<open>b = (\<Sum>x\<in>G. g x *\<^sub>C x)\<close>
     by (smt (verit, del_insts) complex_vector.span_explicit mem_Collect_eq)
   have \<open>a o\<^sub>C\<^sub>L b = (\<Sum>(x,y)\<in>F\<times>G. (f x *\<^sub>C x) o\<^sub>C\<^sub>L (g y *\<^sub>C y))\<close>
     apply (simp add: a_def b_def cblinfun_compose_sum_left)
     by (auto intro!: sum.cong simp add: cblinfun_compose_sum_right scaleC_sum_right sum.cartesian_product case_prod_beta)
   also have \<open>\<dots> = (\<Sum>(x,y)\<in>F\<times>G. (f x * g y) *\<^sub>C (x o\<^sub>C\<^sub>L y))\<close>
     by (metis (no_types, opaque_lifting) cblinfun_compose_scaleC_left cblinfun_compose_scaleC_right scaleC_scaleC)
   also have \<open>\<dots> \<in> cspan A\<close>
     using assms \<open>G \<subseteq> A\<close> \<open>F \<subseteq> A\<close>
     apply (auto intro!: complex_vector.span_sum complex_vector.span_scale 
         simp: complex_vector.span_clauses)
     using complex_vector.span_clauses(1) by blast
   finally show ?thesis
     by -
 qed
 
 subsection \<open>Adjoint\<close>
 
 lift_definition
   adj :: "'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_inner \<Rightarrow> 'b \<Rightarrow>\<^sub>C\<^sub>L 'a" ("_*" [99] 100)
   is cadjoint by (fact cadjoint_bounded_clinear)
 
 lemma id_cblinfun_adjoint[simp]: "id_cblinfun* = id_cblinfun"
   by (metis adj.rep_eq apply_id_cblinfun cadjoint_id cblinfun_apply_inject)
 
 lemma double_adj[simp]: "(A*)* = A"
   apply transfer using double_cadjoint by blast
 
 lemma adj_cblinfun_compose[simp]:
   fixes B::\<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'b::chilbert_space\<close>
     and A::\<open>'b \<Rightarrow>\<^sub>C\<^sub>L 'c::complex_inner\<close>
   shows "(A o\<^sub>C\<^sub>L B)* =  (B*) o\<^sub>C\<^sub>L (A*)"
 proof transfer
   fix  A :: \<open>'b \<Rightarrow> 'c\<close> and B :: \<open>'a \<Rightarrow> 'b\<close>
   assume \<open>bounded_clinear A\<close> and \<open>bounded_clinear B\<close>
   hence \<open>bounded_clinear (A \<circ> B)\<close>
     by (simp add: comp_bounded_clinear)
   have \<open>((A \<circ> B) u \<bullet>\<^sub>C v) = (u \<bullet>\<^sub>C (B\<^sup>\<dagger> \<circ> A\<^sup>\<dagger>) v)\<close>
     for u v
     by (metis (no_types, lifting) cadjoint_univ_prop \<open>bounded_clinear A\<close> \<open>bounded_clinear B\<close> cinner_commute' comp_def)
   thus \<open>(A \<circ> B)\<^sup>\<dagger> = B\<^sup>\<dagger> \<circ> A\<^sup>\<dagger>\<close>
     using \<open>bounded_clinear (A \<circ> B)\<close>
     by (metis cadjoint_eqI cinner_commute')
 qed
 
 lemma scaleC_adj[simp]: "(a *\<^sub>C A)* = (cnj a) *\<^sub>C (A*)"
   by transfer (simp add: bounded_clinear.bounded_linear bounded_clinear_def complex_vector.linear_scale scaleC_cadjoint)
 
 lemma scaleR_adj[simp]: "(a *\<^sub>R A)* = a *\<^sub>R (A*)"
   by (simp add: scaleR_scaleC)
 
 lemma adj_plus: \<open>(A + B)* = (A*) + (B*)\<close>
 proof transfer
   fix A B::\<open>'b \<Rightarrow> 'a\<close>
   assume a1: \<open>bounded_clinear A\<close> and a2: \<open>bounded_clinear B\<close>
   define F where \<open>F = (\<lambda>x. (A\<^sup>\<dagger>) x + (B\<^sup>\<dagger>) x)\<close>
   define G where \<open>G = (\<lambda>x. A x + B x)\<close>
   have \<open>bounded_clinear G\<close>
     unfolding G_def
     by (simp add: a1 a2 bounded_clinear_add)
   moreover have \<open>(F u \<bullet>\<^sub>C v) = (u \<bullet>\<^sub>C G v)\<close> for u v
     unfolding F_def G_def
     using cadjoint_univ_prop a1 a2 cinner_add_left
     by (simp add: cadjoint_univ_prop cinner_add_left cinner_add_right)
   ultimately have \<open>F = G\<^sup>\<dagger> \<close>
     using cadjoint_eqI by blast
   thus \<open>(\<lambda>x. A x + B x)\<^sup>\<dagger> = (\<lambda>x. (A\<^sup>\<dagger>) x + (B\<^sup>\<dagger>) x)\<close>
     unfolding F_def G_def
     by auto
 qed
 
 lemma cinner_adj_left:
   fixes G :: "'b::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'a::complex_inner"
   shows \<open>(G* *\<^sub>V x) \<bullet>\<^sub>C y = x \<bullet>\<^sub>C (G *\<^sub>V y)\<close>
   apply transfer using cadjoint_univ_prop by blast
 
 lemma cinner_adj_right:
   fixes G :: "'b::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'a::complex_inner"
   shows \<open>x \<bullet>\<^sub>C (G* *\<^sub>V y) = (G *\<^sub>V x) \<bullet>\<^sub>C y\<close>
   apply transfer using cadjoint_univ_prop' by blast
 
 lemma adj_0[simp]: \<open>0* = 0\<close>
   by (metis add_cancel_right_left adj_plus)
 
 lemma norm_adj[simp]: \<open>norm (A*) = norm A\<close>
   for A :: \<open>'b::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'c::complex_inner\<close>
 proof (cases \<open>(\<exists>x y :: 'b. x \<noteq> y) \<and> (\<exists>x y :: 'c. x \<noteq> y)\<close>)
   case True
   then have c1: \<open>class.not_singleton TYPE('b)\<close>
     by intro_classes simp
   from True have c2: \<open>class.not_singleton TYPE('c)\<close>
     by intro_classes simp
   have normA: \<open>norm A = (SUP (\<psi>, \<phi>). cmod (\<psi> \<bullet>\<^sub>C (A *\<^sub>V \<phi>)) / (norm \<psi> * norm \<phi>))\<close>
     apply (rule cinner_sup_norm_cblinfun[internalize_sort \<open>'a::{complex_normed_vector,not_singleton}\<close>])
      apply (rule complex_normed_vector_axioms)
     by (rule c1)
   have normAadj: \<open>norm (A*) = (SUP (\<psi>, \<phi>). cmod (\<psi> \<bullet>\<^sub>C (A* *\<^sub>V \<phi>)) / (norm \<psi> * norm \<phi>))\<close>
     apply (rule cinner_sup_norm_cblinfun[internalize_sort \<open>'a::{complex_normed_vector,not_singleton}\<close>])
      apply (rule complex_normed_vector_axioms)
     by (rule c2)
 
   have \<open>norm (A*) = (SUP (\<psi>, \<phi>). cmod (\<phi> \<bullet>\<^sub>C (A *\<^sub>V \<psi>)) / (norm \<psi> * norm \<phi>))\<close>
     unfolding normAadj
     apply (subst cinner_adj_right)
     apply (subst cinner_commute)
     apply (subst complex_mod_cnj)
     by rule
   also have \<open>\<dots> = Sup ((\<lambda>(\<psi>, \<phi>). cmod (\<phi> \<bullet>\<^sub>C (A *\<^sub>V \<psi>)) / (norm \<psi> * norm \<phi>)) ` prod.swap ` UNIV)\<close>
     by auto
   also have \<open>\<dots> = (SUP (\<phi>, \<psi>). cmod (\<phi> \<bullet>\<^sub>C (A *\<^sub>V \<psi>)) / (norm \<psi> * norm \<phi>))\<close>
     apply (subst image_image)
     by auto
   also have \<open>\<dots> = norm A\<close>
     unfolding normA
     by (simp add: mult.commute)
   finally show ?thesis
     by -
 next
   case False
   then consider (b) \<open>\<And>x::'b. x = 0\<close> | (c) \<open>\<And>x::'c. x = 0\<close>
     by auto
   then have \<open>A = 0\<close>
     apply (cases; transfer)
      apply (metis (full_types) bounded_clinear_def complex_vector.linear_0)
     by auto
   then show \<open>norm (A*) = norm A\<close>
     by simp
 qed
 
 
 lemma antilinear_adj[simp]: \<open>antilinear adj\<close>
   by (simp add: adj_plus antilinearI)
 
 lemma bounded_antilinear_adj[bounded_antilinear, simp]: \<open>bounded_antilinear adj\<close>
   by (auto intro!: antilinearI exI[of _ 1] simp: bounded_antilinear_def bounded_antilinear_axioms_def adj_plus)
 
 lemma adjoint_eqI:
   fixes G:: \<open>'b::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'a::complex_inner\<close>
     and F:: \<open>'a \<Rightarrow>\<^sub>C\<^sub>L 'b\<close>
   assumes \<open>\<And>x y. ((cblinfun_apply F) x \<bullet>\<^sub>C y) = (x \<bullet>\<^sub>C (cblinfun_apply G) y)\<close>
   shows \<open>F = G*\<close>
   using assms apply transfer using cadjoint_eqI by auto
 
 lemma adj_uminus: \<open>(-A)* = - (A*)\<close>
   by (metis scaleR_adj scaleR_minus1_left scaleR_minus1_left)
 
 lemma cinner_real_hermiteanI:
   \<comment> \<open>Prop. II.2.12 in \<^cite>\<open>conway2013course\<close>\<close>
   assumes \<open>\<And>\<psi>. \<psi> \<bullet>\<^sub>C (A *\<^sub>V \<psi>) \<in> \<real>\<close>
   shows \<open>A* = A\<close>
 proof -
   { fix g h :: 'a
     {
       fix \<alpha> :: complex
       have \<open>cinner h (A h) + cnj \<alpha> *\<^sub>C cinner g (A h) + \<alpha> *\<^sub>C cinner h (A g) + (abs \<alpha>)\<^sup>2 * cinner g (A g)
         = cinner (h + \<alpha> *\<^sub>C g) (A *\<^sub>V (h + \<alpha> *\<^sub>C g))\<close> (is \<open>?sum4 = _\<close>)
         apply (auto simp: cinner_add_right cinner_add_left cblinfun.add_right cblinfun.scaleC_right ring_class.ring_distribs)
         by (metis cnj_x_x mult.commute)
       also have \<open>\<dots> \<in> \<real>\<close>
         using assms by auto
       finally have \<open>?sum4 = cnj ?sum4\<close>
         using Reals_cnj_iff by fastforce
       then have \<open>cnj \<alpha> *\<^sub>C cinner g (A h) + \<alpha> *\<^sub>C cinner h (A g)
             = \<alpha> *\<^sub>C cinner (A h) g + cnj \<alpha> *\<^sub>C cinner (A g) h\<close>
         using Reals_cnj_iff abs_complex_real assms by force
       also have \<open>\<dots> = \<alpha> *\<^sub>C cinner h (A* *\<^sub>V g) + cnj \<alpha> *\<^sub>C cinner g (A* *\<^sub>V h)\<close>
         by (simp add: cinner_adj_right)
       finally have \<open>cnj \<alpha> *\<^sub>C cinner g (A h) + \<alpha> *\<^sub>C cinner h (A g) = \<alpha> *\<^sub>C cinner h (A* *\<^sub>V g) + cnj \<alpha> *\<^sub>C cinner g (A* *\<^sub>V h)\<close>
         by -
     }
     from this[where \<alpha>2=1] this[where \<alpha>2=\<i>]
     have 1: \<open>cinner g (A h) + cinner h (A g) = cinner h (A* *\<^sub>V g) + cinner g (A* *\<^sub>V h)\<close>
       and i: \<open>- \<i> * cinner g (A h) + \<i> *\<^sub>C cinner h (A g) =  \<i> *\<^sub>C cinner h (A* *\<^sub>V g) - \<i> *\<^sub>C cinner g (A* *\<^sub>V h)\<close>
       by auto
     from arg_cong2[OF 1 arg_cong[OF i, where f=\<open>(*) (-\<i>)\<close>], where f=plus]
     have \<open>cinner h (A g) = cinner h (A* *\<^sub>V g)\<close>
       by (auto simp: ring_class.ring_distribs)
   }
   then show "A* = A"
     apply (rule_tac sym)
     by (simp add: adjoint_eqI cinner_adj_right)
 qed
 
 
 lemma norm_AAadj[simp]: \<open>norm (A o\<^sub>C\<^sub>L A*) = (norm A)\<^sup>2\<close> for A :: \<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'b::{complex_inner}\<close>
 proof (cases \<open>class.not_singleton TYPE('b)\<close>)
   case True
   then have [simp]: \<open>class.not_singleton TYPE('b)\<close>
     by -
   have 1: \<open>(norm A)\<^sup>2 * \<epsilon> \<le> norm (A o\<^sub>C\<^sub>L A*)\<close> if \<open>\<epsilon> < 1\<close> and \<open>\<epsilon> \<ge> 0\<close> for \<epsilon>
   proof -
     obtain \<psi> where \<psi>: \<open>norm ((A*) *\<^sub>V \<psi>) \<ge> norm (A*) * sqrt \<epsilon>\<close> and [simp]: \<open>norm \<psi> = 1\<close>
       apply atomize_elim
       apply (rule cblinfun_norm_approx_witness_mult[internalize_sort' 'a])
       using \<open>\<epsilon> < 1\<close> by (auto intro: complex_normed_vector_class.complex_normed_vector_axioms)
     have \<open>complex_of_real ((norm A)\<^sup>2 * \<epsilon>) = (norm (A*) * sqrt \<epsilon>)\<^sup>2\<close>
       by (simp add: ordered_field_class.sign_simps(23) that(2))
     also have \<open>\<dots> \<le> (norm ((A* *\<^sub>V \<psi>)))\<^sup>2\<close>
       by (meson \<psi> complex_of_real_mono mult_nonneg_nonneg norm_ge_zero power_mono real_sqrt_ge_zero \<open>\<epsilon> \<ge> 0\<close>)
     also have \<open>\<dots> \<le> cinner (A* *\<^sub>V \<psi>) (A* *\<^sub>V \<psi>)\<close>
       by (auto simp flip: power2_norm_eq_cinner)
     also have \<section>: \<open>\<dots> = cinner \<psi> ((A o\<^sub>C\<^sub>L A*) *\<^sub>V \<psi>)\<close>
       by (auto simp: cinner_adj_left)
     also have \<open>\<dots> \<le> norm (A o\<^sub>C\<^sub>L A*)\<close>
       using \<open>norm \<psi> = 1\<close>
       by (smt (verit) Re_complex_of_real \<section> cdot_square_norm cinner_ge_zero cmod_Re complex_inner_class.Cauchy_Schwarz_ineq2 complex_of_real_mono mult_cancel_left1 mult_cancel_right1 norm_cblinfun)
     finally show ?thesis
       by (auto simp: less_eq_complex_def)
   qed
   then have 1: \<open>(norm A)\<^sup>2 \<le> norm (A o\<^sub>C\<^sub>L A*)\<close>
     by (metis field_le_mult_one_interval less_eq_real_def ordered_field_class.sign_simps(5))
 
   have 2: \<open>norm (A o\<^sub>C\<^sub>L A*) \<le> (norm A)\<^sup>2\<close>
   proof (rule norm_cblinfun_bound)
     show \<open>0 \<le> (norm A)\<^sup>2\<close> by simp
     fix \<psi>
     have \<open>norm ((A o\<^sub>C\<^sub>L A*) *\<^sub>V \<psi>) = norm (A *\<^sub>V A* *\<^sub>V \<psi>)\<close>
       by auto
     also have \<open>\<dots> \<le> norm A * norm (A* *\<^sub>V \<psi>)\<close>
       by (simp add: norm_cblinfun)
     also have \<open>\<dots> \<le> norm A * norm (A*) * norm \<psi>\<close>
       by (metis mult.assoc norm_cblinfun norm_imp_pos_and_ge ordered_comm_semiring_class.comm_mult_left_mono)
     also have \<open>\<dots> = (norm A)\<^sup>2 * norm \<psi>\<close>
       by (simp add: power2_eq_square)
     finally show \<open>norm ((A o\<^sub>C\<^sub>L A*) *\<^sub>V \<psi>) \<le> (norm A)\<^sup>2 * norm \<psi>\<close>
       by -
   qed
 
   from 1 2 show ?thesis by simp
 next
   case False
   then have [simp]: \<open>class.CARD_1 TYPE('b)\<close>
     by (rule not_singleton_vs_CARD_1)
   have \<open>A = 0\<close>
     apply (rule cblinfun_to_CARD_1_0[internalize_sort' 'b])
     by (auto intro: complex_normed_vector_class.complex_normed_vector_axioms)
   then show ?thesis
     by auto
 qed
 
 lemma sum_adj: \<open>(sum a F)* = sum (\<lambda>i. (a i)*) F\<close>
   by (induction rule:infinite_finite_induct) (auto simp add: adj_plus)
 
 lemma has_sum_adj:
   assumes \<open>(f has_sum x) I\<close>
   shows \<open>((\<lambda>x. adj (f x)) has_sum adj x) I\<close>
 
   apply (rule has_sum_comm_additive[where f=adj, unfolded o_def])
   apply (simp add: antilinear.axioms(1))
   apply (metis (no_types, lifting) LIM_eq adj_plus adj_uminus norm_adj uminus_add_conv_diff)
   by (simp add: assms)
 
 lemma adj_minus: \<open>(A - B)* = (A*) - (B*)\<close>
   by (metis add_implies_diff adj_plus diff_add_cancel)
 
 lemma cinner_hermitian_real: \<open>x \<bullet>\<^sub>C (A *\<^sub>V x) \<in> \<real>\<close> if \<open>A* = A\<close>
   by (metis Reals_cnj_iff cinner_adj_right cinner_commute' that)
 
 lemma adj_inject: \<open>adj a = adj b \<longleftrightarrow> a = b\<close>
   by (metis (no_types, opaque_lifting) adj_minus eq_iff_diff_eq_0 norm_adj norm_eq_zero)
 
 lemma norm_AadjA[simp]: \<open>norm (A* o\<^sub>C\<^sub>L A) = (norm A)\<^sup>2\<close> for A :: \<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'b::chilbert_space\<close>
   by (metis double_adj norm_AAadj norm_adj)
 
 lemma cspan_adj_closed:
   assumes \<open>\<And>a. a \<in> A \<Longrightarrow> a* \<in> A\<close>
   assumes \<open>a \<in> cspan A\<close>
   shows \<open>a* \<in> cspan A\<close>
 proof -
   from \<open>a \<in> cspan A\<close>
   obtain F f where \<open>finite F\<close> and \<open>F \<subseteq> A\<close> and \<open>a = (\<Sum>x\<in>F. f x *\<^sub>C x)\<close>
     by (smt (verit, del_insts) complex_vector.span_explicit mem_Collect_eq)
   then have \<open>a* = (\<Sum>x\<in>F. cnj (f x) *\<^sub>C x*)\<close>
     by (auto simp: sum_adj)
   also have \<open>\<dots> \<in> cspan A\<close>
     using assms \<open>F \<subseteq> A\<close>
     by (auto intro!: complex_vector.span_sum complex_vector.span_scale simp: complex_vector.span_clauses)
   finally show ?thesis
     by -
 qed
 
 subsection \<open>Powers of operators\<close>
 
 lift_definition cblinfun_power :: \<open>'a::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'a \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow>\<^sub>C\<^sub>L 'a\<close> is
   \<open>\<lambda>(a::'a\<Rightarrow>'a) n. a ^^ n\<close>
   apply (rename_tac f n, induct_tac n, auto simp: Nat.funpow_code_def)
   by (simp add: bounded_clinear_compose)
 
 lemma cblinfun_power_0[simp]: \<open>cblinfun_power A 0 = id_cblinfun\<close> 
   by transfer auto
 
 lemma cblinfun_power_Suc': \<open>cblinfun_power A (Suc n) = A o\<^sub>C\<^sub>L cblinfun_power A n\<close> 
   by transfer auto
 
 lemma cblinfun_power_Suc: \<open>cblinfun_power A (Suc n) = cblinfun_power A n o\<^sub>C\<^sub>L A\<close>
   apply (induction n)
   by (auto simp: cblinfun_power_Suc' simp flip:  cblinfun_compose_assoc)
 
 lemma cblinfun_power_compose[simp]: \<open>cblinfun_power A n o\<^sub>C\<^sub>L cblinfun_power A m = cblinfun_power A (n+m)\<close>
   apply (induction n)
   by (auto simp: cblinfun_power_Suc' cblinfun_compose_assoc)
 
 lemma cblinfun_power_scaleC: \<open>cblinfun_power (c *\<^sub>C a) n = c^n *\<^sub>C cblinfun_power a n\<close>
   apply (induction n)
   by (auto simp: cblinfun_power_Suc)
 
 lemma cblinfun_power_scaleR: \<open>cblinfun_power (c *\<^sub>R a) n = c^n *\<^sub>R cblinfun_power a n\<close>
   apply (induction n)
   by (auto simp: cblinfun_power_Suc)
 
 lemma cblinfun_power_uminus: \<open>cblinfun_power (-a) n = (-1)^n *\<^sub>R cblinfun_power a n\<close>
   apply (subst asm_rl[of \<open>-a = (-1) *\<^sub>R a\<close>])
    by simp (rule cblinfun_power_scaleR)
 
 lemma cblinfun_power_adj: \<open>(cblinfun_power S n)* = cblinfun_power (S*) n\<close>
   apply (induction n)
    apply simp
   apply (subst cblinfun_power_Suc)
   apply (subst cblinfun_power_Suc')
   by auto
 
 subsection \<open>Unitaries / isometries\<close>
 
 
 definition isometry::\<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_inner \<Rightarrow> bool\<close> where
   \<open>isometry U \<longleftrightarrow> U* o\<^sub>C\<^sub>L U = id_cblinfun\<close>
 
 definition unitary::\<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_inner \<Rightarrow> bool\<close> where
   \<open>unitary U \<longleftrightarrow> (U* o\<^sub>C\<^sub>L U  = id_cblinfun) \<and> (U o\<^sub>C\<^sub>L U* = id_cblinfun)\<close>
 
 lemma unitaryI: \<open>unitary a\<close> if \<open>a* o\<^sub>C\<^sub>L a = id_cblinfun\<close> and \<open>a o\<^sub>C\<^sub>L a* = id_cblinfun\<close>
   unfolding unitary_def using that by simp
 
 lemma unitary_twosided_isometry: "unitary U \<longleftrightarrow> isometry U \<and> isometry (U*)"
   unfolding unitary_def isometry_def by simp
 
 lemma isometryD[simp]: "isometry U \<Longrightarrow> U* o\<^sub>C\<^sub>L U = id_cblinfun"
   unfolding isometry_def by simp
 
 (* Not [simp] because isometryD[simp] + unitary_isometry[simp] already have the same effect *)
 lemma unitaryD1: "unitary U \<Longrightarrow> U* o\<^sub>C\<^sub>L U = id_cblinfun"
   unfolding unitary_def by simp
 
 lemma unitaryD2[simp]: "unitary U \<Longrightarrow> U o\<^sub>C\<^sub>L U* = id_cblinfun"
   unfolding unitary_def by simp
 
 lemma unitary_isometry[simp]: "unitary U \<Longrightarrow> isometry U"
   unfolding unitary_def isometry_def by simp
 
 lemma unitary_adj[simp]: "unitary (U*) = unitary U"
   unfolding unitary_def by auto
 
 lemma isometry_cblinfun_compose[simp]:
   assumes "isometry A" and "isometry B"
   shows "isometry (A o\<^sub>C\<^sub>L B)"
 proof-
   have "B* o\<^sub>C\<^sub>L A* o\<^sub>C\<^sub>L (A o\<^sub>C\<^sub>L B) = id_cblinfun" if "A* o\<^sub>C\<^sub>L A = id_cblinfun" and "B* o\<^sub>C\<^sub>L B = id_cblinfun"
     using that
     by (smt (verit, del_insts) adjoint_eqI cblinfun_apply_cblinfun_compose cblinfun_id_cblinfun_apply)
   thus ?thesis
     using assms unfolding isometry_def by simp
 qed
 
 lemma unitary_cblinfun_compose[simp]: "unitary (A o\<^sub>C\<^sub>L B)"
   if "unitary A" and "unitary B"
   using that
   by (smt (z3) adj_cblinfun_compose cblinfun_compose_assoc cblinfun_compose_id_right double_adj isometryD isometry_cblinfun_compose unitary_def unitary_isometry)
 
 lemma unitary_surj:
   assumes "unitary U"
   shows "surj (cblinfun_apply U)"
   apply (rule surjI[where f=\<open>cblinfun_apply (U*)\<close>])
   using assms unfolding unitary_def apply transfer
   using comp_eq_dest_lhs by force
 
 lemma unitary_id[simp]: "unitary id_cblinfun"
   by (simp add: unitary_def)
 
 lemma orthogonal_on_basis_is_isometry:
   assumes spanB: \<open>ccspan B = \<top>\<close>
   assumes orthoU: \<open>\<And>b c. b\<in>B \<Longrightarrow> c\<in>B \<Longrightarrow> cinner (U *\<^sub>V b) (U *\<^sub>V c) = cinner b c\<close>
   shows \<open>isometry U\<close>
 proof -
   have [simp]: \<open>b \<in> closure (cspan B)\<close> for b
     using spanB by transfer simp
   have *: \<open>cinner (U* *\<^sub>V U *\<^sub>V \<psi>) \<phi> = cinner \<psi> \<phi>\<close> if \<open>\<psi>\<in>B\<close> and \<open>\<phi>\<in>B\<close> for \<psi> \<phi>
     by (simp add: cinner_adj_left orthoU that(1) that(2))
   have *: \<open>cinner (U* *\<^sub>V U *\<^sub>V \<psi>) \<phi> = cinner \<psi> \<phi>\<close> if \<open>\<psi>\<in>B\<close> for \<psi> \<phi>
     apply (rule bounded_clinear_eq_on_closure[where t=\<phi> and G=B])
     using bounded_clinear_cinner_right *[OF that]
     by auto
   have \<open>U* *\<^sub>V U *\<^sub>V \<phi> = \<phi>\<close> if \<open>\<phi>\<in>B\<close> for \<phi>
     apply (rule cinner_extensionality)
     apply (subst cinner_eq_flip)
     by (simp add: * that)
   then have \<open>U* o\<^sub>C\<^sub>L U = id_cblinfun\<close>
     by (metis cblinfun_apply_cblinfun_compose cblinfun_eq_gen_eqI cblinfun_id_cblinfun_apply spanB)
   then show \<open>isometry U\<close>
     using isometry_def by blast
 qed
 
 lemma isometry_preserves_norm: \<open>isometry U \<Longrightarrow> norm (U *\<^sub>V \<psi>) = norm \<psi>\<close>
   by (metis (no_types, lifting) cblinfun_apply_cblinfun_compose cblinfun_id_cblinfun_apply cinner_adj_right cnorm_eq isometryD)
 
 lemma norm_isometry_compose: 
   assumes \<open>isometry U\<close>
   shows \<open>norm (U o\<^sub>C\<^sub>L A) = norm A\<close>
 proof -
   have *: \<open>norm (U *\<^sub>V A *\<^sub>V \<psi>) = norm (A *\<^sub>V \<psi>)\<close> for \<psi>
     by (smt (verit, ccfv_threshold) assms cblinfun_apply_cblinfun_compose cinner_adj_right cnorm_eq id_cblinfun_apply isometryD)
 
   have \<open>norm (U o\<^sub>C\<^sub>L A) = (SUP \<psi>. norm (U *\<^sub>V A *\<^sub>V \<psi>) / norm \<psi>)\<close>
     unfolding norm_cblinfun_Sup by auto
   also have \<open>\<dots> = (SUP \<psi>. norm (A *\<^sub>V \<psi>) / norm \<psi>)\<close>
     using * by auto
   also have \<open>\<dots> = norm A\<close>
     unfolding norm_cblinfun_Sup by auto
   finally show ?thesis
     by simp
 qed
 
 lemma norm_isometry:
   fixes U :: \<open>'a::{chilbert_space,not_singleton} \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_inner\<close>
   assumes \<open>isometry U\<close>
   shows \<open>norm U = 1\<close>
   apply (subst asm_rl[of \<open>U = U o\<^sub>C\<^sub>L id_cblinfun\<close>], simp)
   apply (subst norm_isometry_compose, simp add: assms)
   by simp
 
 lemma norm_preserving_isometry: \<open>isometry U\<close> if \<open>\<And>\<psi>. norm (U *\<^sub>V \<psi>) = norm \<psi>\<close>
   by (smt (verit, ccfv_SIG) cblinfun_cinner_eqI cblinfun_id_cblinfun_apply cinner_adj_right cnorm_eq isometry_def simp_a_oCL_b' that)
 
 lemma norm_isometry_compose': \<open>norm (A o\<^sub>C\<^sub>L U) = norm A\<close> if \<open>isometry (U*)\<close>
   by (smt (verit) cblinfun_compose_assoc cblinfun_compose_id_right double_adj isometryD mult_cancel_left2 norm_AadjA norm_cblinfun_compose norm_isometry_compose norm_zero power2_eq_square right_diff_distrib that zero_less_norm_iff)
 
 lemma unitary_nonzero[simp]: \<open>\<not> unitary (0 :: 'a::{chilbert_space, not_singleton} \<Rightarrow>\<^sub>C\<^sub>L _)\<close>
   by (simp add: unitary_def)
 
 lemma isometry_inj:
   assumes \<open>isometry U\<close>
   shows \<open>inj_on U X\<close>
   apply (rule inj_on_inverseI[where g=\<open>U*\<close>])
   using assms by (simp flip: cblinfun_apply_cblinfun_compose)
 
 lemma unitary_inj:
   assumes \<open>unitary U\<close>
   shows \<open>inj_on U X\<close>
   apply (rule isometry_inj)
   using assms by simp
 
 lemma unitary_adj_inv: \<open>unitary U \<Longrightarrow> cblinfun_apply (U*) = inv (cblinfun_apply U)\<close>
   apply (rule inj_imp_inv_eq[symmetric])
    apply (simp add: unitary_inj)
   unfolding unitary_def
   by (simp flip: cblinfun_apply_cblinfun_compose)
 
 lemma isometry_cinner_both_sides:
   assumes \<open>isometry U\<close>
   shows \<open>cinner (U x) (U y) = cinner x y\<close>
   using assms by (simp add: flip: cinner_adj_right cblinfun_apply_cblinfun_compose)
 
 lemma isometry_image_is_ortho_set:
   assumes \<open>is_ortho_set A\<close>
   assumes \<open>isometry U\<close>
   shows \<open>is_ortho_set (U ` A)\<close>
   using assms apply (auto simp add: is_ortho_set_def isometry_cinner_both_sides)
   by (metis cinner_eq_zero_iff isometry_cinner_both_sides)
 
 subsection \<open>Product spaces\<close>
 
 lift_definition cblinfun_left :: \<open>'a::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L ('a\<times>'b::complex_normed_vector)\<close> is \<open>(\<lambda>x. (x,0))\<close>
   by (auto intro!: bounded_clinearI[where K=1])
 lift_definition cblinfun_right :: \<open>'b::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L ('a::complex_normed_vector\<times>'b)\<close> is \<open>(\<lambda>x. (0,x))\<close>
   by (auto intro!: bounded_clinearI[where K=1])
 
 lemma isometry_cblinfun_left[simp]: \<open>isometry cblinfun_left\<close>
   apply (rule orthogonal_on_basis_is_isometry[of some_chilbert_basis])
    apply simp
   by transfer simp
 
 lemma isometry_cblinfun_right[simp]: \<open>isometry cblinfun_right\<close>
   apply (rule orthogonal_on_basis_is_isometry[of some_chilbert_basis])
    apply simp
   by transfer simp
 
 lemma cblinfun_left_right_ortho[simp]: \<open>cblinfun_left* o\<^sub>C\<^sub>L cblinfun_right = 0\<close>
 proof -
   have \<open>x \<bullet>\<^sub>C ((cblinfun_left* o\<^sub>C\<^sub>L cblinfun_right) *\<^sub>V y) = 0\<close> for x :: 'b and y :: 'a
     apply (simp add: cinner_adj_right)
     by transfer auto
   then show ?thesis
     by (metis cblinfun.zero_left cblinfun_eqI cinner_eq_zero_iff)
 qed
 
 lemma cblinfun_right_left_ortho[simp]: \<open>cblinfun_right* o\<^sub>C\<^sub>L cblinfun_left = 0\<close>
 proof -
   have \<open>x \<bullet>\<^sub>C ((cblinfun_right* o\<^sub>C\<^sub>L cblinfun_left) *\<^sub>V y) = 0\<close> for x :: 'b and y :: 'a
     apply (simp add: cinner_adj_right)
     by transfer auto
   then show ?thesis
     by (metis cblinfun.zero_left cblinfun_eqI cinner_eq_zero_iff)
 qed
 
 lemma cblinfun_left_apply[simp]: \<open>cblinfun_left *\<^sub>V \<psi> = (\<psi>,0)\<close>
   by transfer simp
 
 lemma cblinfun_left_adj_apply[simp]: \<open>cblinfun_left* *\<^sub>V \<psi> = fst \<psi>\<close>
   apply (cases \<psi>)
   by (auto intro!: cinner_extensionality[of \<open>_ *\<^sub>V _\<close>] simp: cinner_adj_right)
 
 lemma cblinfun_right_apply[simp]: \<open>cblinfun_right *\<^sub>V \<psi> = (0,\<psi>)\<close>
   by transfer simp
 
 lemma cblinfun_right_adj_apply[simp]: \<open>cblinfun_right* *\<^sub>V \<psi> = snd \<psi>\<close>
   apply (cases \<psi>)
   by (auto intro!: cinner_extensionality[of \<open>_ *\<^sub>V _\<close>] simp: cinner_adj_right)
 
 lift_definition ccsubspace_Times :: \<open>'a::complex_normed_vector ccsubspace \<Rightarrow> 'b::complex_normed_vector ccsubspace \<Rightarrow> ('a\<times>'b) ccsubspace\<close> is
   Product_Type.Times
 proof -
   fix S :: \<open>'a set\<close> and T :: \<open>'b set\<close>
   assume [simp]: \<open>closed_csubspace S\<close> \<open>closed_csubspace T\<close>
   have \<open>csubspace (S \<times> T)\<close>
     by (simp add: complex_vector.subspace_Times)
   moreover have \<open>closed (S \<times> T)\<close>
     by (simp add: closed_Times closed_csubspace.closed)
   ultimately show \<open>closed_csubspace (S \<times> T)\<close>
     by (rule closed_csubspace.intro)
 qed
 
 
 lemma ccspan_Times: \<open>ccspan (S \<times> T) = ccsubspace_Times (ccspan S) (ccspan T)\<close> if \<open>0 \<in> S\<close> and \<open>0 \<in> T\<close>
 proof (transfer fixing: S T)
   from that have \<open>closure (cspan (S \<times> T)) = closure (cspan S \<times> cspan T)\<close>
     by (simp add: cspan_Times)
   also have \<open>\<dots> = closure (cspan S) \<times> closure (cspan T)\<close>
     using closure_Times by blast
   finally   show \<open>closure (cspan (S \<times> T)) = closure (cspan S) \<times> closure (cspan T)\<close>
     by -
 qed
 
 lemma ccspan_Times_sing1: \<open>ccspan ({0::'a::complex_normed_vector} \<times> B) = ccsubspace_Times 0 (ccspan B)\<close>
 proof (transfer fixing: B)
   have \<open>closure (cspan ({0::'a} \<times> B)) = closure ({0} \<times> cspan B)\<close>
     by (simp add: complex_vector.span_Times_sing1)
   also have \<open>\<dots> = closure {0} \<times> closure (cspan B)\<close>
     using closure_Times by blast
   also have \<open>\<dots> = {0} \<times> closure (cspan B)\<close>
     by simp
   finally show \<open>closure (cspan ({0::'a} \<times> B)) = {0} \<times> closure (cspan B)\<close>
     by -
 qed
 
 lemma ccspan_Times_sing2: \<open>ccspan (B \<times> {0::'a::complex_normed_vector}) = ccsubspace_Times (ccspan B) 0\<close>
 proof (transfer fixing: B)
   have \<open>closure (cspan (B \<times> {0::'a})) = closure (cspan B \<times> {0})\<close>
     by (simp add: complex_vector.span_Times_sing2)
   also have \<open>\<dots> = closure (cspan B) \<times> closure {0}\<close>
     using closure_Times by blast
   also have \<open>\<dots> = closure (cspan B) \<times> {0}\<close>
     by simp
   finally show \<open>closure (cspan (B \<times> {0::'a})) = closure (cspan B) \<times> {0}\<close>
     by -
 qed
 
 lemma ccsubspace_Times_sup: \<open>sup (ccsubspace_Times A B) (ccsubspace_Times C D) = ccsubspace_Times (sup A C) (sup B D)\<close>
 proof transfer
   fix A C :: \<open>'a set\<close> and B D :: \<open>'b set\<close>
   have \<open>A \<times> B +\<^sub>M C \<times> D = closure ((A \<times> B) + (C \<times> D))\<close>
     using closed_sum_def by blast
   also have \<open>\<dots> = closure ((A + C) \<times> (B + D))\<close>
     by (simp add: set_Times_plus_distrib)
   also have \<open>\<dots> = closure (A + C) \<times> closure (B + D)\<close>
     by (simp add: closure_Times)
   also have \<open>\<dots> = (A +\<^sub>M C) \<times> (B +\<^sub>M D)\<close>
     by (simp add: closed_sum_def)
   finally show \<open>A \<times> B +\<^sub>M C \<times> D = (A +\<^sub>M C) \<times> (B +\<^sub>M D)\<close>
     by -
 qed
 
 lemma ccsubspace_Times_top_top[simp]: \<open>ccsubspace_Times top top = top\<close>
   by transfer simp
 
+lemma is_ortho_set_prod:
+  assumes \<open>is_ortho_set B\<close> \<open>is_ortho_set B'\<close>
+  shows \<open>is_ortho_set ((B \<times> {0}) \<union> ({0} \<times> B'))\<close>
+  using assms unfolding is_ortho_set_def
+  apply (auto simp: is_onb_def is_ortho_set_def zero_prod_def)
+  by (meson is_onb_def is_ortho_set_def)+
+
+lemma ccsubspace_Times_ccspan:
+  assumes \<open>ccspan B = S\<close> and \<open>ccspan B' = S'\<close>
+  shows \<open>ccspan ((B \<times> {0}) \<union> ({0} \<times> B')) = ccsubspace_Times S S'\<close>
+  by (smt (z3) Diff_eq_empty_iff Sigma_cong assms(1) assms(2) ccspan.rep_eq ccspan_0 ccspan_Times_sing1 ccspan_Times_sing2 ccspan_of_empty ccspan_remove_0 ccspan_superset ccspan_union ccsubspace_Times_sup complex_vector.span_insert_0 space_as_set_bot sup_bot_left sup_bot_right)
+
 lemma is_onb_prod:
   assumes \<open>is_onb B\<close> \<open>is_onb B'\<close>
   shows \<open>is_onb ((B \<times> {0}) \<union> ({0} \<times> B'))\<close>
-proof -
-  from assms
-  have 1: \<open>is_ortho_set ((B \<times> {0}) \<union> ({0} \<times> B'))\<close>
-    unfolding is_ortho_set_def
-    apply (auto simp: is_onb_def is_ortho_set_def zero_prod_def)
-    by (meson is_onb_def is_ortho_set_def)+
-
-  have 2: \<open>(l, r) \<in> B \<times> {0} \<Longrightarrow> norm (l, r) = 1\<close> for l :: 'a and r :: 'b
-    using \<open>is_onb B\<close> is_onb_def by auto
-
-  have 3: \<open>(l, r) \<in> {0} \<times> B' \<Longrightarrow> norm (l, r) = 1\<close> for l :: 'a and r :: 'b
-    using \<open>is_onb B'\<close> is_onb_def by auto
-
-  have [simp]: \<open>ccspan B = top\<close> \<open>ccspan B' = top\<close>
-    using assms is_onb_def by auto
-
-  have 4: \<open>ccspan ((B \<times> {0}) \<union> ({0} \<times> B')) = top\<close>
-    by (auto simp: ccspan_Times_sing1 ccspan_Times_sing2 ccsubspace_Times_sup simp flip: ccspan_union)
-
-  from 1 2 3 4
-  show \<open>is_onb ((B \<times> {0}) \<union> ({0} \<times> B'))\<close>
-    by (auto simp add: is_onb_def)
-qed
+  using assms by (auto intro!: is_ortho_set_prod simp add: is_onb_def ccsubspace_Times_ccspan)
 
 subsection \<open>Images\<close>
 
 text \<open>The following definition defines the image of a closed subspace \<^term>\<open>S\<close> under a bounded operator \<^term>\<open>A\<close>.
 We do not define that image as the image of \<^term>\<open>A\<close> seen as a function (\<^term>\<open>A ` S\<close>) but as the topological closure of that image.
 This is because \<^term>\<open>A ` S\<close> might in general not be closed.
 
 For example, if $e_i$ ($i\in\mathbb N$) form an orthonormal basis, and $A$ maps $e_i$ to $e_i/i$, 
 then all $e_i$ are in \<^term>\<open>A ` S\<close>, so the closure of \<^term>\<open>A ` S\<close> is the whole space.
 However, $\sum_i e_i/i$ is not in \<^term>\<open>A ` S\<close> because its preimage would have to be $\sum_i e_i$ which does not converge.
 So \<^term>\<open>A ` S\<close> does not contain the whole space, hence it is not closed.\<close>
 
 lift_definition cblinfun_image :: \<open>'a::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_normed_vector
 \<Rightarrow> 'a ccsubspace \<Rightarrow> 'b ccsubspace\<close>  (infixr "*\<^sub>S" 70)
   is "\<lambda>A S. closure (A ` S)"
   using  bounded_clinear_def closed_closure  closed_csubspace.intro
   by (simp add: bounded_clinear_def complex_vector.linear_subspace_image closure_is_closed_csubspace)
 
 lemma cblinfun_image_mono:
   assumes a1: "S \<le> T"
   shows "A *\<^sub>S S \<le> A *\<^sub>S T"
   using a1
   by (simp add: cblinfun_image.rep_eq closure_mono image_mono less_eq_ccsubspace.rep_eq)
 
 lemma cblinfun_image_0[simp]:
   shows "U *\<^sub>S 0 = 0"
   thm zero_ccsubspace_def
   by transfer (simp add: bounded_clinear_def complex_vector.linear_0)
 
 lemma cblinfun_image_bot[simp]: "U *\<^sub>S bot = bot"
   using cblinfun_image_0 by auto
 
 lemma cblinfun_image_sup[simp]:
   fixes A B :: \<open>'a::chilbert_space ccsubspace\<close> and U :: "'a \<Rightarrow>\<^sub>C\<^sub>L'b::chilbert_space"
   shows \<open>U *\<^sub>S (sup A B) = sup (U *\<^sub>S A) (U *\<^sub>S B)\<close>
   apply transfer using bounded_clinear.bounded_linear closure_image_closed_sum by blast
 
 lemma scaleC_cblinfun_image[simp]:
   fixes A :: \<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'b :: chilbert_space\<close>
     and S :: \<open>'a ccsubspace\<close> and \<alpha> :: complex
   shows \<open>(\<alpha> *\<^sub>C A) *\<^sub>S S  = \<alpha> *\<^sub>C (A *\<^sub>S S)\<close>
 proof-
   have \<open>closure ( ( ((*\<^sub>C) \<alpha>) \<circ> (cblinfun_apply A) ) ` space_as_set S) =
    ((*\<^sub>C) \<alpha>) ` (closure (cblinfun_apply A ` space_as_set S))\<close>
     by (metis closure_scaleC image_comp)
   hence \<open>(closure (cblinfun_apply (\<alpha> *\<^sub>C A) ` space_as_set S)) =
    ((*\<^sub>C) \<alpha>) ` (closure (cblinfun_apply A ` space_as_set S))\<close>
     by (metis (mono_tags, lifting) comp_apply image_cong scaleC_cblinfun.rep_eq)
   hence \<open>Abs_ccsubspace (closure (cblinfun_apply (\<alpha> *\<^sub>C A) ` space_as_set S)) =
             \<alpha> *\<^sub>C Abs_ccsubspace (closure (cblinfun_apply A ` space_as_set S))\<close>
     by (metis space_as_set_inverse cblinfun_image.rep_eq scaleC_ccsubspace.rep_eq)
   have x1: "Abs_ccsubspace (closure ((*\<^sub>V) (\<alpha> *\<^sub>C A) ` space_as_set S)) =
             \<alpha> *\<^sub>C Abs_ccsubspace (closure ((*\<^sub>V) A ` space_as_set S))"
     using \<open>Abs_ccsubspace (closure (cblinfun_apply (\<alpha> *\<^sub>C A) ` space_as_set S)) =
             \<alpha> *\<^sub>C Abs_ccsubspace (closure (cblinfun_apply A ` space_as_set S))\<close>
     by blast
   show ?thesis
     unfolding cblinfun_image_def using x1 by force
 qed
 
 lemma cblinfun_image_id[simp]:
   "id_cblinfun *\<^sub>S \<psi> = \<psi>"
   by transfer (simp add: closed_csubspace.closed)
 
 lemma cblinfun_compose_image:
   \<open>(A o\<^sub>C\<^sub>L B) *\<^sub>S S =  A *\<^sub>S (B *\<^sub>S S)\<close>
   apply transfer unfolding image_comp[symmetric]
   apply (rule closure_bounded_linear_image_subset_eq[symmetric])
   by (simp add: bounded_clinear.bounded_linear)
 
 lemmas cblinfun_assoc_left = cblinfun_compose_assoc[symmetric] cblinfun_compose_image[symmetric]
   add.assoc[where ?'a="'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'b::chilbert_space", symmetric]
 lemmas cblinfun_assoc_right = cblinfun_compose_assoc cblinfun_compose_image
   add.assoc[where ?'a="'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'b::chilbert_space"]
 
 lemma cblinfun_image_INF_leq[simp]:
   fixes U :: "'b::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'c::cbanach"
     and V :: "'a \<Rightarrow> 'b ccsubspace"
   shows \<open>U *\<^sub>S (INF i\<in>X. V i) \<le> (INF i\<in>X. U *\<^sub>S (V i))\<close>
   apply transfer
   by (simp add: INT_greatest Inter_lower closure_mono image_mono)
 
 lemma isometry_cblinfun_image_inf_distrib':
   fixes U::\<open>'a::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'b::cbanach\<close> and B C::"'a ccsubspace"
   shows "U *\<^sub>S (inf B C) \<le> inf (U *\<^sub>S B) (U *\<^sub>S C)"
 proof -
   define V where \<open>V b = (if b then B else C)\<close> for b
   have \<open>U *\<^sub>S (INF i. V i) \<le> (INF i. U *\<^sub>S (V i))\<close>
     by auto
   then show ?thesis
     unfolding V_def
     by (metis (mono_tags, lifting) INF_UNIV_bool_expand)
 qed
 
 lemma cblinfun_image_eq:
   fixes S :: "'a::cbanach ccsubspace"
     and A B :: "'a::cbanach \<Rightarrow>\<^sub>C\<^sub>L'b::cbanach"
   assumes "\<And>x. x \<in> G \<Longrightarrow> A *\<^sub>V x = B *\<^sub>V x" and "ccspan G \<ge> S"
   shows "A *\<^sub>S S = B *\<^sub>S S"
 proof (use assms in transfer)
   fix G :: "'a set" and A :: "'a \<Rightarrow> 'b" and B :: "'a \<Rightarrow> 'b" and S :: "'a set"
   assume a1: "bounded_clinear A"
   assume a2: "bounded_clinear B"
   assume a3: "\<And>x. x \<in> G \<Longrightarrow> A x = B x"
   assume a4: "S \<subseteq> closure (cspan G)"
 
   have "A ` closure S = B ` closure S"
     by (smt (verit, best) UnCI a1 a2 a3 a4 bounded_clinear_eq_on_closure closure_Un closure_closure image_cong sup.absorb_iff1)
   then show "closure (A ` S) = closure (B ` S)"
     by (metis bounded_clinear.bounded_linear a1 a2 closure_bounded_linear_image_subset_eq)
 qed
 
 lemma cblinfun_fixes_range:
   assumes "A o\<^sub>C\<^sub>L B = B" and "\<psi> \<in> space_as_set (B *\<^sub>S top)"
   shows "A *\<^sub>V \<psi> = \<psi>"
 proof-
   define rangeB rangeB' where "rangeB = space_as_set (B *\<^sub>S top)"
     and "rangeB' = range (cblinfun_apply B)"
   from assms have "\<psi> \<in> closure rangeB'"
     by (simp add: cblinfun_image.rep_eq rangeB'_def top_ccsubspace.rep_eq)
 
   then obtain \<psi>i where \<psi>i_lim: "\<psi>i \<longlonglongrightarrow> \<psi>" and \<psi>i_B: "\<psi>i i \<in> rangeB'" for i
     using closure_sequential by blast
   have A_invariant: "A *\<^sub>V \<psi>i i = \<psi>i i"
     for i
   proof-
     from \<psi>i_B obtain \<phi> where \<phi>: "\<psi>i i = B *\<^sub>V \<phi>"
       using rangeB'_def by blast
     hence "A *\<^sub>V \<psi>i i = (A o\<^sub>C\<^sub>L B) *\<^sub>V \<phi>"
       by (simp add: cblinfun_compose.rep_eq)
     also have "\<dots> = B *\<^sub>V \<phi>"
       by (simp add: assms)
     also have "\<dots> = \<psi>i i"
       by (simp add: \<phi>)
     finally show ?thesis.
   qed
   from \<psi>i_lim have "(\<lambda>i. A *\<^sub>V (\<psi>i i)) \<longlonglongrightarrow> A *\<^sub>V \<psi>"
     by (rule isCont_tendsto_compose[rotated], simp)
   with A_invariant have "(\<lambda>i. \<psi>i i) \<longlonglongrightarrow> A *\<^sub>V \<psi>"
     by auto
   with \<psi>i_lim show "A *\<^sub>V \<psi> = \<psi>"
     using LIMSEQ_unique by blast
 qed
 
 lemma zero_cblinfun_image[simp]: "0 *\<^sub>S S = (0::_ ccsubspace)"
   by transfer (simp add: complex_vector.subspace_0 image_constant[where x=0])
 
 lemma cblinfun_image_INF_eq_general:
   fixes V :: "'a \<Rightarrow> 'b::chilbert_space ccsubspace"
     and U :: "'b \<Rightarrow>\<^sub>C\<^sub>L'c::chilbert_space"
     and Uinv :: "'c \<Rightarrow>\<^sub>C\<^sub>L'b"
   assumes UinvUUinv: "Uinv o\<^sub>C\<^sub>L U o\<^sub>C\<^sub>L Uinv = Uinv" and UUinvU: "U o\<^sub>C\<^sub>L Uinv o\<^sub>C\<^sub>L U = U"
     \<comment> \<open>Meaning: \<^term>\<open>Uinv\<close> is a Pseudoinverse of \<^term>\<open>U\<close>\<close>
     and V: "\<And>i. V i \<le> Uinv *\<^sub>S top"
     and \<open>X \<noteq> {}\<close>
   shows "U *\<^sub>S (INF i\<in>X. V i) = (INF i\<in>X. U *\<^sub>S V i)"
 proof (rule antisym)
   show "U *\<^sub>S (INF i\<in>X. V i) \<le> (INF i\<in>X. U *\<^sub>S V i)"
     by (rule cblinfun_image_INF_leq)
 next
   define rangeU rangeUinv where "rangeU = U *\<^sub>S top" and "rangeUinv = Uinv *\<^sub>S top"
   define INFUV INFV where INFUV_def: "INFUV = (INF i\<in>X. U *\<^sub>S V i)" and INFV_def: "INFV = (INF i\<in>X. V i)"
   from assms have "V i \<le> rangeUinv"
     for i
     unfolding rangeUinv_def by simp
   moreover have "(Uinv o\<^sub>C\<^sub>L U) *\<^sub>V \<psi> = \<psi>" if "\<psi> \<in> space_as_set rangeUinv"
     for \<psi>
     using UinvUUinv cblinfun_fixes_range rangeUinv_def that by fastforce
   ultimately have "(Uinv o\<^sub>C\<^sub>L U) *\<^sub>V \<psi> = \<psi>" if "\<psi> \<in> space_as_set (V i)"
     for \<psi> i
     using less_eq_ccsubspace.rep_eq that by blast
   hence d1: "(Uinv o\<^sub>C\<^sub>L U) *\<^sub>S (V i) = (V i)" for i
   proof (transfer fixing: i)
     fix V :: "'a \<Rightarrow> 'b set"
       and Uinv :: "'c \<Rightarrow> 'b"
       and U :: "'b \<Rightarrow> 'c"
     assume "pred_fun \<top> closed_csubspace V"
       and "bounded_clinear Uinv"
       and "bounded_clinear U"
       and "\<And>\<psi> i. \<psi> \<in> V i \<Longrightarrow> (Uinv \<circ> U) \<psi> = \<psi>"
     then show "closure ((Uinv \<circ> U) ` V i) = V i"
     proof auto
       fix x
       from \<open>pred_fun \<top> closed_csubspace V\<close>
       show "x \<in> V i"
         if "x \<in> closure (V i)" 
         using that apply simp
         by (metis orthogonal_complement_of_closure closed_csubspace.subspace double_orthogonal_complement_id closure_is_closed_csubspace)
       with \<open>pred_fun \<top> closed_csubspace V\<close>
       show "x \<in> closure (V i)"
         if "x \<in> V i"
         using that
         using setdist_eq_0_sing_1 setdist_sing_in_set
         by blast
     qed
   qed
   have "U *\<^sub>S V i \<le> rangeU" for i
     by (simp add: cblinfun_image_mono rangeU_def)
   hence "INFUV \<le> rangeU"
     unfolding INFUV_def using \<open>X \<noteq> {}\<close>
     by (metis INF_eq_const INF_lower2)
   moreover have "(U o\<^sub>C\<^sub>L Uinv) *\<^sub>V \<psi> = \<psi>" if "\<psi> \<in> space_as_set rangeU" for \<psi>
     using UUinvU cblinfun_fixes_range rangeU_def that by fastforce
   ultimately have x: "(U o\<^sub>C\<^sub>L Uinv) *\<^sub>V \<psi> = \<psi>" if "\<psi> \<in> space_as_set INFUV" for \<psi>
     by (simp add: in_mono less_eq_ccsubspace.rep_eq that)
 
   have "closure ((U \<circ> Uinv) ` INFUV) = INFUV"
     if "closed_csubspace INFUV"
       and "bounded_clinear U"
       and "bounded_clinear Uinv"
       and "\<And>\<psi>. \<psi> \<in> INFUV \<Longrightarrow> (U \<circ> Uinv) \<psi> = \<psi>"
     for INFUV :: "'c set"
     using that
   proof auto
     fix x
     show "x \<in> INFUV" if "x \<in> closure INFUV"
       using that \<open>closed_csubspace INFUV\<close>
       by (metis orthogonal_complement_of_closure closed_csubspace.subspace double_orthogonal_complement_id closure_is_closed_csubspace)
     show "x \<in> closure INFUV"
       if "x \<in> INFUV"
       using that \<open>closed_csubspace INFUV\<close>
       using setdist_eq_0_sing_1 setdist_sing_in_set
       by (simp add: closed_csubspace.closed)
   qed
   hence "(U o\<^sub>C\<^sub>L Uinv) *\<^sub>S INFUV = INFUV"
     by (metis (mono_tags, opaque_lifting) x cblinfun_image.rep_eq cblinfun_image_id id_cblinfun_apply image_cong
         space_as_set_inject)
   hence "INFUV = U *\<^sub>S Uinv *\<^sub>S INFUV"
     by (simp add: cblinfun_compose_image)
   also have "\<dots> \<le> U *\<^sub>S (INF i\<in>X. Uinv *\<^sub>S U *\<^sub>S V i)"
     unfolding INFUV_def
     by (metis cblinfun_image_mono cblinfun_image_INF_leq)
   also have "\<dots> = U *\<^sub>S INFV"
     using d1
     by (metis (no_types, lifting) INFV_def cblinfun_assoc_left(2) image_cong)
   finally show "INFUV \<le> U *\<^sub>S INFV".
 qed
 
 lemma unitary_range[simp]:
   assumes "unitary U"
   shows "U *\<^sub>S top = top"
   using assms unfolding unitary_def by transfer (metis closure_UNIV comp_apply surj_def)
 
 lemma range_adjoint_isometry:
   assumes "isometry U"
   shows "U* *\<^sub>S top = top"
 proof-
   from assms have "top = U* *\<^sub>S U *\<^sub>S top"
     by (simp add: cblinfun_assoc_left(2))
   also have "\<dots> \<le> U* *\<^sub>S top"
     by (simp add: cblinfun_image_mono)
   finally show ?thesis
     using top.extremum_unique by blast
 qed
 
 lemma cblinfun_image_INF_eq[simp]:
   fixes V :: "'a \<Rightarrow> 'b::chilbert_space ccsubspace"
     and U :: "'b \<Rightarrow>\<^sub>C\<^sub>L 'c::chilbert_space"
   assumes \<open>isometry U\<close> \<open>X \<noteq> {}\<close>
   shows "U *\<^sub>S (INF i\<in>X. V i) = (INF i\<in>X. U *\<^sub>S V i)"
 proof -
   from \<open>isometry U\<close> have "U* o\<^sub>C\<^sub>L U o\<^sub>C\<^sub>L U* = U*"
     unfolding isometry_def by simp
   moreover from \<open>isometry U\<close> have "U o\<^sub>C\<^sub>L U* o\<^sub>C\<^sub>L U = U"
     unfolding isometry_def
     by (simp add: cblinfun_compose_assoc)
   moreover have "V i \<le> U* *\<^sub>S top" for i
     by (simp add: range_adjoint_isometry assms)
   ultimately show ?thesis
     using \<open>X \<noteq> {}\<close> by (rule cblinfun_image_INF_eq_general)
 qed
 
 lemma isometry_cblinfun_image_inf_distrib[simp]:
   fixes U::\<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'b::chilbert_space\<close>
     and X Y::"'a ccsubspace"
   assumes "isometry U"
   shows "U *\<^sub>S (inf X Y) = inf (U *\<^sub>S X) (U *\<^sub>S Y)"
   using cblinfun_image_INF_eq[where V="\<lambda>b. if b then X else Y" and U=U and X=UNIV]
   unfolding INF_UNIV_bool_expand
   using assms by auto
 
 lemma cblinfun_image_ccspan:
   shows "A *\<^sub>S ccspan G = ccspan ((*\<^sub>V) A ` G)"
   by transfer (simp add: bounded_clinear.bounded_linear bounded_clinear_def closure_bounded_linear_image_subset_eq complex_vector.linear_span_image)
 
 lemma cblinfun_apply_in_image[simp]: "A *\<^sub>V \<psi> \<in> space_as_set (A *\<^sub>S \<top>)"
   by (metis cblinfun_image.rep_eq closure_subset in_mono range_eqI top_ccsubspace.rep_eq)
 
 
 lemma cblinfun_plus_image_distr:
   \<open>(A + B) *\<^sub>S S \<le> A *\<^sub>S S \<squnion> B *\<^sub>S S\<close>
   by transfer (smt (verit, ccfv_threshold) closed_closure closed_sum_def closure_minimal closure_subset image_subset_iff set_plus_intro subset_eq)
 
 lemma cblinfun_sum_image_distr:
   \<open>(\<Sum>i\<in>I. A i) *\<^sub>S S \<le> (SUP i\<in>I. A i *\<^sub>S S)\<close>
 proof (cases \<open>finite I\<close>)
   case True
   then show ?thesis
   proof induction
     case empty
     then show ?case
       by auto
   next
     case (insert x F)
     then show ?case
       by auto (smt (z3) cblinfun_plus_image_distr inf_sup_aci(6) le_iff_sup)
   qed
 next
   case False
   then show ?thesis
     by auto
 qed
 
 lemma space_as_set_image_commute:
   assumes UV: \<open>U o\<^sub>C\<^sub>L V = id_cblinfun\<close> and VU: \<open>V o\<^sub>C\<^sub>L U = id_cblinfun\<close>
     (* I think only one of them is needed, can the lemma be strengthened? *)
   shows \<open>(*\<^sub>V) U ` space_as_set T = space_as_set (U *\<^sub>S T)\<close>
 proof -
   have \<open>space_as_set (U *\<^sub>S T) = U ` V ` space_as_set (U *\<^sub>S T)\<close>
     by (simp add: image_image UV flip: cblinfun_apply_cblinfun_compose)
   also have \<open>\<dots> \<subseteq> U ` space_as_set (V *\<^sub>S U *\<^sub>S T)\<close>
     by (metis cblinfun_image.rep_eq closure_subset image_mono)
   also have \<open>\<dots> = U ` space_as_set T\<close>
     by (simp add: VU cblinfun_assoc_left(2))
   finally have 1: \<open>space_as_set (U *\<^sub>S T) \<subseteq> U ` space_as_set T\<close>
     by -
   have 2: \<open>U ` space_as_set T \<subseteq> space_as_set (U *\<^sub>S T)\<close>
     by (simp add: cblinfun_image.rep_eq closure_subset)
   from 1 2 show ?thesis
     by simp
 qed
 
 lemma right_total_rel_ccsubspace:
   fixes R :: \<open>'a::complex_normed_vector \<Rightarrow> 'b::complex_normed_vector \<Rightarrow> bool\<close>
   assumes UV: \<open>U o\<^sub>C\<^sub>L V = id_cblinfun\<close>
   assumes VU: \<open>V o\<^sub>C\<^sub>L U = id_cblinfun\<close>
   assumes R_def: \<open>\<And>x y. R x y \<longleftrightarrow> x = U *\<^sub>V y\<close>
   shows \<open>right_total (rel_ccsubspace R)\<close>
 proof (rule right_totalI)
   fix T :: \<open>'b ccsubspace\<close>
   show \<open>\<exists>S. rel_ccsubspace R S T\<close>
     apply (rule exI[of _ \<open>U *\<^sub>S T\<close>])
     using UV VU by (auto simp add: rel_ccsubspace_def R_def rel_set_def simp flip: space_as_set_image_commute)
 qed
 
 lemma left_total_rel_ccsubspace:
   fixes R :: \<open>'a::complex_normed_vector \<Rightarrow> 'b::complex_normed_vector \<Rightarrow> bool\<close>
   assumes UV: \<open>U o\<^sub>C\<^sub>L V = id_cblinfun\<close>
   assumes VU: \<open>V o\<^sub>C\<^sub>L U = id_cblinfun\<close>
   assumes R_def: \<open>\<And>x y. R x y \<longleftrightarrow> y = U *\<^sub>V x\<close>
   shows \<open>left_total (rel_ccsubspace R)\<close>
 proof -
   have \<open>right_total (rel_ccsubspace (conversep R))\<close>
     apply (rule right_total_rel_ccsubspace)
     using assms by auto
   then show ?thesis
     by (auto intro!: right_total_conversep[THEN iffD1] simp: converse_rel_ccsubspace)
 qed
 
 lemma cblinfun_image_bot_zero[simp]: \<open>A *\<^sub>S top = bot \<longleftrightarrow> A = 0\<close>
   by (metis Complex_Bounded_Linear_Function.zero_cblinfun_image bot_ccsubspace.rep_eq cblinfun_apply_in_image cblinfun_eqI empty_iff insert_iff zero_ccsubspace_def)
 
 lemma surj_isometry_is_unitary:
   \<comment> \<open>This lemma is a bit stronger than its name suggests:
       We actually only require that the image of U is dense.
 
       The converse is @{thm [source] unitary_surj}\<close>
   fixes U :: \<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'b::chilbert_space\<close>
   assumes \<open>isometry U\<close>
   assumes \<open>U *\<^sub>S \<top> = \<top>\<close>
   shows \<open>unitary U\<close>
   by (metis UNIV_I assms(1) assms(2) cblinfun_assoc_left(1) cblinfun_compose_id_right cblinfun_eqI cblinfun_fixes_range id_cblinfun_apply isometry_def space_as_set_top unitary_def)
 
 lemma cblinfun_apply_in_image': "A *\<^sub>V \<psi> \<in> space_as_set (A *\<^sub>S S)" if \<open>\<psi> \<in> space_as_set S\<close>
   by (metis cblinfun_image.rep_eq closure_subset image_subset_iff that)
 
 lemma cblinfun_image_ccspan_leqI:
   assumes \<open>\<And>v. v \<in> M \<Longrightarrow> A *\<^sub>V v \<in> space_as_set T\<close>
   shows \<open>A *\<^sub>S ccspan M \<le> T\<close>
   by (simp add: assms cblinfun_image_ccspan ccspan_leqI image_subsetI)
 
 
 lemma cblinfun_same_on_image: \<open>A \<psi> = B \<psi>\<close> if eq: \<open>A o\<^sub>C\<^sub>L C = B o\<^sub>C\<^sub>L C\<close> and mem: \<open>\<psi> \<in> space_as_set (C *\<^sub>S \<top>)\<close>
 proof -
   have \<open>A \<psi> = B \<psi>\<close> if \<open>\<psi> \<in> range C\<close> for \<psi>
     by (metis (no_types, lifting) eq cblinfun_apply_cblinfun_compose image_iff that)
   moreover have \<open>\<psi> \<in> closure (range C)\<close>
     by (metis cblinfun_image.rep_eq mem top_ccsubspace.rep_eq)
   ultimately show ?thesis
     apply (rule on_closure_eqI)
     by (auto simp: continuous_on_eq_continuous_at)
 qed
 
 lemma lift_cblinfun_comp:
 \<comment> \<open>Utility lemma to lift a lemma of the form \<^term>\<open>a o\<^sub>C\<^sub>L b = c\<close>
    to become a more general rewrite rule.\<close>
   assumes \<open>a o\<^sub>C\<^sub>L b = c\<close>
   shows \<open>a o\<^sub>C\<^sub>L b = c\<close>
     and \<open>a o\<^sub>C\<^sub>L (b o\<^sub>C\<^sub>L d) = c o\<^sub>C\<^sub>L d\<close>
     and \<open>a *\<^sub>S (b *\<^sub>S S) = c *\<^sub>S S\<close>
     and \<open>a *\<^sub>V (b *\<^sub>V x) = c *\<^sub>V x\<close>
      apply (fact assms)
     apply (simp add: assms cblinfun_assoc_left(1))
   using assms cblinfun_assoc_left(2) apply force
   using assms by force
 
 lemma cblinfun_image_def2: \<open>A *\<^sub>S S = ccspan ((*\<^sub>V) A ` space_as_set S)\<close>
   apply (simp add: flip: cblinfun_image_ccspan)
   by (metis ccspan_leqI ccspan_superset less_eq_ccsubspace.rep_eq order_class.order_eq_iff)
 
 lemma unitary_image_onb:
   \<comment> \<open>Logically belongs in an earlier section but the proof uses results from this section.\<close>
   assumes \<open>is_onb A\<close>
   assumes \<open>unitary U\<close>
   shows \<open>is_onb (U ` A)\<close>
   using assms
   by (auto simp add: is_onb_def isometry_image_is_ortho_set isometry_preserves_norm
       simp flip: cblinfun_image_ccspan)
 
 subsection \<open>Sandwiches\<close>
 
 lift_definition sandwich :: \<open>('a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_inner) \<Rightarrow> (('a \<Rightarrow>\<^sub>C\<^sub>L 'a) \<Rightarrow>\<^sub>C\<^sub>L ('b \<Rightarrow>\<^sub>C\<^sub>L 'b))\<close> is
   \<open>\<lambda>(A::'a\<Rightarrow>\<^sub>C\<^sub>L'b) B. A o\<^sub>C\<^sub>L B o\<^sub>C\<^sub>L A*\<close>
 proof
   fix A :: \<open>'a \<Rightarrow>\<^sub>C\<^sub>L 'b\<close> and B B1 B2 :: \<open>'a \<Rightarrow>\<^sub>C\<^sub>L 'a\<close> and c :: complex
   show \<open>A o\<^sub>C\<^sub>L (B1 + B2) o\<^sub>C\<^sub>L A* = (A o\<^sub>C\<^sub>L B1 o\<^sub>C\<^sub>L A*) + (A o\<^sub>C\<^sub>L B2 o\<^sub>C\<^sub>L A*)\<close>
     by (simp add: cblinfun_compose_add_left cblinfun_compose_add_right)
   show \<open>A o\<^sub>C\<^sub>L (c *\<^sub>C B) o\<^sub>C\<^sub>L A* = c *\<^sub>C (A o\<^sub>C\<^sub>L B o\<^sub>C\<^sub>L A*)\<close>
     by auto
   show \<open>\<exists>K. \<forall>B. norm (A o\<^sub>C\<^sub>L B o\<^sub>C\<^sub>L A*) \<le> norm B * K\<close>
   proof (rule exI[of _ \<open>norm A * norm (A*)\<close>], rule allI)
     fix B
     have \<open>norm (A o\<^sub>C\<^sub>L B o\<^sub>C\<^sub>L A*) \<le> norm (A o\<^sub>C\<^sub>L B) * norm (A*)\<close>
       using norm_cblinfun_compose by blast
     also have \<open>\<dots> \<le> (norm A * norm B) * norm (A*)\<close>
       by (simp add: mult_right_mono norm_cblinfun_compose)
     finally show \<open>norm (A o\<^sub>C\<^sub>L B o\<^sub>C\<^sub>L A*) \<le> norm B * (norm A * norm (A*))\<close>
       by (simp add: mult.assoc vector_space_over_itself.scale_left_commute)
   qed
 qed
 
 lemma sandwich_0[simp]: \<open>sandwich 0 = 0\<close>
   by (simp add: cblinfun_eqI sandwich.rep_eq)
 
 lemma sandwich_apply: \<open>sandwich A *\<^sub>V B = A o\<^sub>C\<^sub>L B o\<^sub>C\<^sub>L A*\<close>
   apply (transfer fixing: A B) by auto
 
 lemma sandwich_arg_compose:
   assumes \<open>isometry U\<close>
   shows \<open>sandwich U x o\<^sub>C\<^sub>L sandwich U y = sandwich U (x o\<^sub>C\<^sub>L y)\<close>
   apply (simp add: sandwich_apply)
   by (metis (no_types, lifting) lift_cblinfun_comp(2) assms cblinfun_compose_id_right isometryD)
 
 lemma norm_sandwich: \<open>norm (sandwich A) = (norm A)\<^sup>2\<close> for A :: \<open>'a::{chilbert_space} \<Rightarrow>\<^sub>C\<^sub>L 'b::{complex_inner}\<close>
 proof -
   have main: \<open>norm (sandwich A) = (norm A)\<^sup>2\<close> for A :: \<open>'c::{chilbert_space,not_singleton} \<Rightarrow>\<^sub>C\<^sub>L 'd::{complex_inner}\<close>
   proof (rule norm_cblinfun_eqI)
     show \<open>(norm A)\<^sup>2 \<le> norm (sandwich A *\<^sub>V id_cblinfun) / norm (id_cblinfun :: 'c \<Rightarrow>\<^sub>C\<^sub>L _)\<close>
       apply (auto simp: sandwich_apply)
       by -
     fix B
     have \<open>norm (sandwich A *\<^sub>V B) \<le> norm (A o\<^sub>C\<^sub>L B) * norm (A*)\<close>
       using norm_cblinfun_compose by (auto simp: sandwich_apply simp del: norm_adj)
     also have \<open>\<dots> \<le> (norm A * norm B) * norm (A*)\<close>
       by (simp add: mult_right_mono norm_cblinfun_compose)
     also have \<open>\<dots> \<le> (norm A)\<^sup>2 * norm B\<close>
       by (simp add: power2_eq_square mult.assoc vector_space_over_itself.scale_left_commute)
     finally show \<open>norm (sandwich A *\<^sub>V B) \<le> (norm A)\<^sup>2 * norm B\<close>
       by -
     show \<open>0 \<le> (norm A)\<^sup>2\<close>
       by auto
   qed
 
   show ?thesis
   proof (cases \<open>class.not_singleton TYPE('a)\<close>)
     case True
     show ?thesis
       apply (rule main[internalize_sort' 'c2])
        apply standard[1]
       using True by simp
   next
     case False
     have \<open>A = 0\<close>
       apply (rule cblinfun_from_CARD_1_0[internalize_sort' 'a])
        apply (rule not_singleton_vs_CARD_1)
        apply (rule False)
       by standard
     then show ?thesis
       by simp
   qed
 qed
 
 lemma sandwich_apply_adj: \<open>sandwich A (B*) = (sandwich A B)*\<close>
   by (simp add: cblinfun_assoc_left(1) sandwich_apply)
 
 lemma sandwich_id[simp]: "sandwich id_cblinfun = id_cblinfun"
   apply (rule cblinfun_eqI)
   by (auto simp: sandwich_apply)
 
-lemma sandwich_compose: \<open>sandwich A o\<^sub>C\<^sub>L sandwich B = sandwich (A o\<^sub>C\<^sub>L B)\<close>
+lemma sandwich_compose: \<open>sandwich (A o\<^sub>C\<^sub>L B) = sandwich A o\<^sub>C\<^sub>L sandwich B\<close>
   by (auto intro!: cblinfun_eqI simp: sandwich_apply)
 
 lemma inj_sandwich_isometry: \<open>inj (sandwich U)\<close> if [simp]: \<open>isometry U\<close> for U :: \<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'b::chilbert_space\<close>
   apply (rule inj_on_inverseI[where g=\<open>(*\<^sub>V) (sandwich (U*))\<close>])
-  by (auto simp: sandwich_compose simp flip: cblinfun_apply_cblinfun_compose)
+  by (auto simp flip: cblinfun_apply_cblinfun_compose sandwich_compose)
 
 lemma sandwich_isometry_id: \<open>isometry (U*) \<Longrightarrow> sandwich U id_cblinfun = id_cblinfun\<close>
   by (simp add: sandwich_apply isometry_def)
 
 
 subsection \<open>Projectors\<close>
 
 lift_definition Proj :: "('a::chilbert_space) ccsubspace \<Rightarrow> 'a \<Rightarrow>\<^sub>C\<^sub>L'a"
   is \<open>projection\<close>
   by (rule projection_bounded_clinear)
 
 lemma Proj_range[simp]: "Proj S *\<^sub>S top = S"
 proof transfer
   fix S :: \<open>'a set\<close> assume \<open>closed_csubspace S\<close>
   then have "closure (range (projection S)) \<subseteq> S"
     by (metis closed_csubspace.closed closed_csubspace.subspace closure_closed complex_vector.subspace_0 csubspace_is_convex dual_order.eq_iff insert_absorb insert_not_empty projection_image)
   moreover have "S \<subseteq> closure (range (projection S))"
     using \<open>closed_csubspace S\<close>
     by (metis closed_csubspace_def closure_subset csubspace_is_convex equals0D projection_image subset_iff)
   ultimately show \<open>closure (range (projection S)) = S\<close>
     by auto
 qed
 
 lemma adj_Proj: \<open>(Proj M)* = Proj M\<close>
   by transfer (simp add: projection_cadjoint)
 
 lemma Proj_idempotent[simp]: \<open>Proj M o\<^sub>C\<^sub>L Proj M = Proj M\<close>
 proof -
   have u1: \<open>(cblinfun_apply (Proj M)) = projection (space_as_set M)\<close>
     by transfer blast
   have \<open>closed_csubspace (space_as_set M)\<close>
     using space_as_set by auto
   hence u2: \<open>(projection (space_as_set M))\<circ>(projection (space_as_set M))
                 = (projection (space_as_set M))\<close>
     using projection_idem by fastforce
   have \<open>(cblinfun_apply (Proj M)) \<circ> (cblinfun_apply (Proj M)) = cblinfun_apply (Proj M)\<close>
     using u1 u2
     by simp
   hence \<open>cblinfun_apply ((Proj M) o\<^sub>C\<^sub>L (Proj M)) = cblinfun_apply (Proj M)\<close>
     by (simp add: cblinfun_compose.rep_eq)
   thus ?thesis using cblinfun_apply_inject
     by auto
 qed
 
 lift_definition is_Proj :: \<open>'a::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'a \<Rightarrow> bool\<close> is
   \<open>\<lambda>P. \<exists>M. is_projection_on P M\<close> .
 
 lemma is_Proj_id[simp]: \<open>is_Proj id_cblinfun\<close>
   apply transfer
   by (auto intro!: exI[of _ UNIV] simp: is_projection_on_def is_arg_min_def)
 
 lemma Proj_top[simp]: \<open>Proj \<top> = id_cblinfun\<close>
   by (metis Proj_idempotent Proj_range cblinfun_eqI cblinfun_fixes_range id_cblinfun_apply iso_tuple_UNIV_I space_as_set_top)
 
 lemma Proj_on_own_range':
   fixes P :: \<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L'a\<close>
   assumes \<open>P o\<^sub>C\<^sub>L P = P\<close> and \<open>P = P*\<close>
   shows \<open>Proj (P *\<^sub>S top) = P\<close>
 proof -
   define M where "M = P *\<^sub>S top"
   have v3: "x \<in> (\<lambda>x. x - P *\<^sub>V x) -` {0}"
     if "x \<in> range (cblinfun_apply P)"
     for x :: 'a
   proof-
     have v3_1: \<open>cblinfun_apply P \<circ> cblinfun_apply P = cblinfun_apply P\<close>
       by (metis \<open>P o\<^sub>C\<^sub>L P = P\<close> cblinfun_compose.rep_eq)
     have \<open>\<exists>t. P *\<^sub>V t = x\<close>
       using that by blast
     then obtain t where t_def: \<open>P *\<^sub>V t = x\<close>
       by blast
     hence \<open>x - P *\<^sub>V x = x - P *\<^sub>V (P *\<^sub>V t)\<close>
       by simp
     also have \<open>\<dots> = x - (P *\<^sub>V t)\<close>
       using v3_1
       by (metis comp_apply)
     also have \<open>\<dots> = 0\<close>
       by (simp add: t_def)
     finally have \<open>x - P *\<^sub>V x = 0\<close>
       by blast
     thus ?thesis
       by simp
   qed
 
   have v1: "range (cblinfun_apply P) \<subseteq> (\<lambda>x. x - cblinfun_apply P x) -` {0}"
     using v3
     by blast
 
   have "x \<in> range (cblinfun_apply P)"
     if "x \<in> (\<lambda>x. x - P *\<^sub>V x) -` {0}"
     for x :: 'a
   proof-
     have x1:\<open>x - P *\<^sub>V x = 0\<close>
       using that by blast
     have \<open>x = P *\<^sub>V x\<close>
       by (simp add: x1 eq_iff_diff_eq_0)
     thus ?thesis
       by blast
   qed
   hence v2: "(\<lambda>x. x - cblinfun_apply P x) -` {0} \<subseteq> range (cblinfun_apply P)"
     by blast
   have i1: \<open>range (cblinfun_apply P) = (\<lambda> x. x - cblinfun_apply P x) -` {0}\<close>
     using v1 v2
     by (simp add: v1 dual_order.antisym)
   have p1: \<open>closed {(0::'a)}\<close>
     by simp
   have p2: \<open>continuous (at x) (\<lambda> x. x - P *\<^sub>V x)\<close>
     for x
   proof-
     have \<open>cblinfun_apply (id_cblinfun - P) = (\<lambda> x. x - P *\<^sub>V x)\<close>
       by (simp add: id_cblinfun.rep_eq minus_cblinfun.rep_eq)
     hence \<open>bounded_clinear (cblinfun_apply (id_cblinfun - P))\<close>
       using cblinfun_apply
       by blast
     hence \<open>continuous (at x) (cblinfun_apply (id_cblinfun - P))\<close>
       by (simp add: clinear_continuous_at)
     thus ?thesis
       using \<open>cblinfun_apply (id_cblinfun - P) = (\<lambda> x. x - P *\<^sub>V x)\<close>
       by simp
   qed
 
   have i2: \<open>closed ( (\<lambda> x. x - P *\<^sub>V x) -` {0} )\<close>
     using p1 p2
     by (rule Abstract_Topology.continuous_closed_vimage)
 
   have \<open>closed (range (cblinfun_apply P))\<close>
     using i1 i2
     by simp
   have u2: \<open>cblinfun_apply P x \<in> space_as_set M\<close>
     for x
     by (simp add: M_def \<open>closed (range ((*\<^sub>V) P))\<close> cblinfun_image.rep_eq top_ccsubspace.rep_eq)
 
   have xy: \<open>is_orthogonal (x - P *\<^sub>V x) y\<close>
     if y1: \<open>y \<in> space_as_set M\<close>
     for x y
   proof-
     have \<open>\<exists>t. y = P *\<^sub>V t\<close>
       using y1
       by (simp add:  M_def \<open>closed (range ((*\<^sub>V) P))\<close> cblinfun_image.rep_eq image_iff
           top_ccsubspace.rep_eq)
     then obtain t where t_def: \<open>y = P *\<^sub>V t\<close>
       by blast
     have \<open>(x - P *\<^sub>V x) \<bullet>\<^sub>C y = (x - P *\<^sub>V x) \<bullet>\<^sub>C (P *\<^sub>V t)\<close>
       by (simp add: t_def)
     also have \<open>\<dots> = (P *\<^sub>V (x - P *\<^sub>V x)) \<bullet>\<^sub>C t\<close>
       by (metis \<open>P = P*\<close> cinner_adj_left)
     also have \<open>\<dots> = (P *\<^sub>V x - P *\<^sub>V (P *\<^sub>V x)) \<bullet>\<^sub>C t\<close>
       by (simp add: cblinfun.diff_right)
     also have \<open>\<dots> = (P *\<^sub>V x - P *\<^sub>V x) \<bullet>\<^sub>C t\<close>
       by (metis assms(1) comp_apply cblinfun_compose.rep_eq)
     also have \<open>\<dots> = (0 \<bullet>\<^sub>C t)\<close>
       by simp
     also have \<open>\<dots> = 0\<close>
       by simp
     finally show ?thesis by blast
   qed
   hence u1: \<open>x - P *\<^sub>V x \<in> orthogonal_complement (space_as_set M)\<close>
     for x
     by (simp add: orthogonal_complementI)
   have "closed_csubspace (space_as_set M)"
     using space_as_set by auto
   hence f1: "(Proj M) *\<^sub>V a = P *\<^sub>V a" for a
     by (simp add: Proj.rep_eq projection_eqI u1 u2)
   have "(+) ((P - Proj M) *\<^sub>V a) = id" for a
     using f1
     by (auto intro!: ext simp add: minus_cblinfun.rep_eq)
   hence "b - b = cblinfun_apply (P - Proj M) a"
     for a b
     by (metis (no_types) add_diff_cancel_right' id_apply)
   hence "cblinfun_apply (id_cblinfun - (P - Proj M)) a = a"
     for a
     by (simp add: minus_cblinfun.rep_eq)
   thus ?thesis
     using u1 u2 cblinfun_apply_inject diff_diff_eq2 diff_eq_diff_eq eq_id_iff id_cblinfun.rep_eq
     by (metis (no_types, opaque_lifting) M_def)
 qed
 
 lemma Proj_range_closed:
   assumes "is_Proj P"
   shows "closed (range (cblinfun_apply P))"
   apply (rule is_projection_on_closed[where f=\<open>cblinfun_apply P\<close>])
   using assms is_Proj.rep_eq is_projection_on_image by auto
 
 lemma Proj_is_Proj[simp]:
   fixes M::\<open>'a::chilbert_space ccsubspace\<close>
   shows \<open>is_Proj (Proj M)\<close>
 proof-
   have u1: "closed_csubspace (space_as_set M)"
     using space_as_set by blast
   have v1: "h - Proj M *\<^sub>V h
          \<in> orthogonal_complement (space_as_set M)" for h
     by (simp add: Proj.rep_eq orthogonal_complementI projection_orthogonal u1)
   have v2: "Proj M *\<^sub>V h \<in> space_as_set M" for h
     by (metis Proj.rep_eq mem_Collect_eq orthog_proj_exists projection_eqI space_as_set)
   have u2: "is_projection_on ((*\<^sub>V) (Proj M)) (space_as_set M)"
     unfolding is_projection_on_def
     by (simp add: smallest_dist_is_ortho u1 v1 v2)
   show ?thesis
     using u1 u2 is_Proj.rep_eq by blast
 qed
 
 lemma is_Proj_algebraic:
   fixes P::\<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'a\<close>
   shows \<open>is_Proj P \<longleftrightarrow> P o\<^sub>C\<^sub>L P = P \<and> P = P*\<close>
 proof
   have "P o\<^sub>C\<^sub>L P = P"
     if "is_Proj P"
     using that apply transfer
     using is_projection_on_idem
     by fastforce
   moreover have "P = P*"
     if "is_Proj P"
     using that Proj_range_closed[OF that] is_projection_on_cadjoint[where \<pi>=P and M=\<open>range P\<close>]
     by transfer (metis bounded_clinear.axioms(1) closed_csubspace_UNIV closed_csubspace_def complex_vector.linear_subspace_image is_projection_on_image)
   ultimately show "P o\<^sub>C\<^sub>L P = P \<and> P = P*"
     if "is_Proj P"
     using that
     by blast
   show "is_Proj P"
     if "P o\<^sub>C\<^sub>L P = P \<and> P = P*"
     using that Proj_on_own_range' Proj_is_Proj by metis
 qed
 
 lemma Proj_on_own_range:
   fixes P :: \<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L'a\<close>
   assumes \<open>is_Proj P\<close>
   shows \<open>Proj (P *\<^sub>S top) = P\<close>
   using Proj_on_own_range' assms is_Proj_algebraic by blast
 
 lemma Proj_image_leq: "(Proj S) *\<^sub>S A \<le> S"
   by (metis Proj_range inf_top_left le_inf_iff isometry_cblinfun_image_inf_distrib')
 
 lemma Proj_sandwich:
   fixes A::"'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'b::chilbert_space"
   assumes "isometry A"
   shows "sandwich A *\<^sub>V Proj S = Proj (A *\<^sub>S S)"
 proof -
   define P where \<open>P = A o\<^sub>C\<^sub>L Proj S o\<^sub>C\<^sub>L (A*)\<close>
   have \<open>P o\<^sub>C\<^sub>L P = P\<close>
     using assms
     unfolding P_def isometry_def
     by (metis (no_types, lifting) Proj_idempotent cblinfun_assoc_left(1) cblinfun_compose_id_left)
   moreover have \<open>P = P*\<close>
     unfolding P_def
     by (metis adj_Proj adj_cblinfun_compose cblinfun_assoc_left(1) double_adj)
   ultimately have
     \<open>\<exists>M. P = Proj M \<and> space_as_set M = range (cblinfun_apply (A o\<^sub>C\<^sub>L (Proj S) o\<^sub>C\<^sub>L (A*)))\<close>
     using P_def Proj_on_own_range'
     by (metis Proj_is_Proj Proj_range_closed cblinfun_image.rep_eq closure_closed top_ccsubspace.rep_eq)
   then obtain M where \<open>P = Proj M\<close>
     and \<open>space_as_set M = range (cblinfun_apply (A o\<^sub>C\<^sub>L (Proj S) o\<^sub>C\<^sub>L (A*)))\<close>
     by blast
 
   have f1: "A o\<^sub>C\<^sub>L Proj S = P o\<^sub>C\<^sub>L A"
     by (simp add: P_def assms cblinfun_compose_assoc)
   hence "P o\<^sub>C\<^sub>L A o\<^sub>C\<^sub>L A* = P"
     using P_def by presburger
   hence "(P o\<^sub>C\<^sub>L A) *\<^sub>S (c \<squnion> A* *\<^sub>S d) = P *\<^sub>S (A *\<^sub>S c \<squnion> d)"
     for c d
 
     by (simp add: cblinfun_assoc_left(2))
   hence "P *\<^sub>S (A *\<^sub>S \<top> \<squnion> c) = (P o\<^sub>C\<^sub>L A) *\<^sub>S \<top>"
     for c
     by (metis sup_top_left)
   hence \<open>M = A *\<^sub>S S\<close>
     using f1
     by (metis \<open>P = Proj M\<close> cblinfun_assoc_left(2) Proj_range sup_top_right)
   thus ?thesis
     using \<open>P = Proj M\<close>
     unfolding P_def sandwich_apply by blast
 qed
 
 lemma Proj_orthog_ccspan_union:
   assumes "\<And>x y. x \<in> X \<Longrightarrow> y \<in> Y \<Longrightarrow> is_orthogonal x y"
   shows \<open>Proj (ccspan (X \<union> Y)) = Proj (ccspan X) + Proj (ccspan Y)\<close>
 proof -
   have \<open>x \<in> cspan X \<Longrightarrow> y \<in> cspan Y \<Longrightarrow> is_orthogonal x y\<close> for x y
     apply (rule is_orthogonal_closure_cspan[where X=X and Y=Y])
     using closure_subset assms by auto
   then have \<open>x \<in> closure (cspan X) \<Longrightarrow> y \<in> closure (cspan Y) \<Longrightarrow> is_orthogonal x y\<close> for x y
     by (metis orthogonal_complementI orthogonal_complement_of_closure orthogonal_complement_orthoI')
   then show ?thesis
     apply (transfer fixing: X Y)
     apply (subst projection_plus[symmetric])
     by auto
 qed
 
 abbreviation proj :: "'a::chilbert_space \<Rightarrow> 'a \<Rightarrow>\<^sub>C\<^sub>L 'a" where "proj \<psi> \<equiv> Proj (ccspan {\<psi>})"
 
 lemma proj_0[simp]: \<open>proj 0 = 0\<close>
   by transfer auto
 
 lemma ccsubspace_supI_via_Proj:
   fixes A B C::"'a::chilbert_space ccsubspace"
   assumes a1: \<open>Proj (- C) *\<^sub>S A \<le> B\<close>
   shows  "A \<le> B \<squnion> C"
 proof-
   have x2: \<open>x \<in> space_as_set B\<close>
     if "x \<in>  closure ( (projection (orthogonal_complement (space_as_set C))) ` space_as_set A)" for x
     using that
     by (metis Proj.rep_eq cblinfun_image.rep_eq assms less_eq_ccsubspace.rep_eq subsetD
         uminus_ccsubspace.rep_eq)
   have q1: \<open>x \<in> closure {\<psi> + \<phi> |\<psi> \<phi>. \<psi> \<in> space_as_set B \<and> \<phi> \<in> space_as_set C}\<close>
     if \<open>x \<in> space_as_set A\<close>
     for x
   proof-
     have p1: \<open>closed_csubspace (space_as_set C)\<close>
       using space_as_set by auto
     hence \<open>x = (projection (space_as_set C)) x
        + (projection (orthogonal_complement (space_as_set C))) x\<close>
       by simp
     hence \<open>x = (projection (orthogonal_complement (space_as_set C))) x
               + (projection (space_as_set C)) x\<close>
       by (metis ordered_field_class.sign_simps(2))
     moreover have \<open>(projection (orthogonal_complement (space_as_set C))) x \<in> space_as_set B\<close>
       using x2
       by (meson closure_subset image_subset_iff that)
     moreover have \<open>(projection (space_as_set C)) x \<in> space_as_set C\<close>
       by (metis mem_Collect_eq orthog_proj_exists projection_eqI space_as_set)
     ultimately show ?thesis
       using closure_subset by force
   qed
   have x1: \<open>x \<in> (space_as_set B +\<^sub>M space_as_set C)\<close>
     if "x \<in> space_as_set A" for x
   proof -
     have f1: "x \<in> closure {a + b |a b. a \<in> space_as_set B \<and> b \<in> space_as_set C}"
       by (simp add: q1 that)
     have "{a + b |a b. a \<in> space_as_set B \<and> b \<in> space_as_set C} = {a. \<exists>p. p \<in> space_as_set B
       \<and> (\<exists>q. q \<in> space_as_set C \<and> a = p + q)}"
       by blast
     hence "x \<in> closure {a. \<exists>b\<in>space_as_set B. \<exists>c\<in>space_as_set C. a = b + c}"
       using f1 by (simp add: Bex_def_raw)
     thus ?thesis
       using that
       unfolding closed_sum_def set_plus_def
       by blast
   qed
 
   hence \<open>x \<in> space_as_set (Abs_ccsubspace (space_as_set B +\<^sub>M space_as_set C))\<close>
     if "x \<in> space_as_set A" for x
     using that
     by (metis space_as_set_inverse sup_ccsubspace.rep_eq)
   thus ?thesis
     by (simp add: x1 less_eq_ccsubspace.rep_eq subset_eq sup_ccsubspace.rep_eq)
 qed
 
 lemma is_Proj_idempotent:
   assumes "is_Proj P"
   shows "P o\<^sub>C\<^sub>L P = P"
   using assms apply transfer
   using is_projection_on_fixes_image is_projection_on_in_image by fastforce
 
 lemma is_proj_selfadj:
   assumes "is_Proj P"
   shows "P* = P"
   using assms
   unfolding is_Proj_def
   by (metis is_Proj_algebraic is_Proj_def)
 
 lemma is_Proj_I:
   assumes "P o\<^sub>C\<^sub>L P = P" and "P* = P"
   shows "is_Proj P"
   using assms is_Proj_algebraic by metis
 
 lemma is_Proj_0[simp]: "is_Proj 0"
   apply transfer apply (rule exI[of _ 0])
   by (simp add: is_projection_on_zero)
 
 lemma is_Proj_complement[simp]:
   fixes P :: \<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'a\<close>
   assumes a1: "is_Proj P"
   shows "is_Proj (id_cblinfun - P)"
   by (smt (z3) add_diff_cancel_left add_diff_cancel_left' adj_cblinfun_compose adj_plus assms bounded_cbilinear.add_left bounded_cbilinear_cblinfun_compose diff_add_cancel id_cblinfun_adjoint is_Proj_algebraic cblinfun_compose_id_left)
 
 lemma Proj_bot[simp]: "Proj bot = 0"
   by (metis zero_cblinfun_image Proj_on_own_range' is_Proj_0 is_Proj_algebraic
       zero_ccsubspace_def)
 
 lemma Proj_ortho_compl:
   "Proj (- X) = id_cblinfun - Proj X"
   by (transfer, auto)
 
 lemma Proj_inj:
   assumes "Proj X = Proj Y"
   shows "X = Y"
   by (metis assms Proj_range)
 
 lemma norm_Proj_leq1: \<open>norm (Proj M) \<le> 1\<close> for M :: \<open>'a :: chilbert_space ccsubspace\<close>
   by transfer (metis (no_types, opaque_lifting) mult.left_neutral onorm_bound projection_reduces_norm zero_less_one_class.zero_le_one)
 
 lemma Proj_orthog_ccspan_insert:
   assumes "\<And>y. y \<in> Y \<Longrightarrow> is_orthogonal x y"
   shows \<open>Proj (ccspan (insert x Y)) = proj x + Proj (ccspan Y)\<close>
   apply (subst asm_rl[of \<open>insert x Y = {x} \<union> Y\<close>], simp)
   apply (rule Proj_orthog_ccspan_union)
   using assms by auto
 
 lemma Proj_fixes_image: \<open>Proj S *\<^sub>V \<psi> = \<psi>\<close> if \<open>\<psi> \<in> space_as_set S\<close>
   by (metis Proj_idempotent Proj_range that cblinfun_fixes_range)
 
 lemma norm_is_Proj: \<open>norm P \<le> 1\<close> if \<open>is_Proj P\<close> for P :: \<open>'a :: chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'a\<close>
   by (metis Proj_on_own_range norm_Proj_leq1 that)
 
 lemma Proj_sup: \<open>orthogonal_spaces S T \<Longrightarrow> Proj (sup S T) = Proj S + Proj T\<close>
   unfolding orthogonal_spaces_def
   by transfer (simp add: projection_plus)
 
 lemma Proj_sum_spaces:
   assumes \<open>finite X\<close>
   assumes \<open>\<And>x y. x\<in>X \<Longrightarrow> y\<in>X \<Longrightarrow> x\<noteq>y \<Longrightarrow> orthogonal_spaces (J x) (J y)\<close>
   shows \<open>Proj (\<Sum>x\<in>X. J x) = (\<Sum>x\<in>X. Proj (J x))\<close>
   using assms
 proof induction
   case empty
   show ?case 
     by auto
 next
   case (insert x F)
   have \<open>Proj (sum J (insert x F)) = Proj (J x \<squnion> sum J F)\<close>
     by (simp add: insert)
   also have \<open>\<dots> = Proj (J x) + Proj (sum J F)\<close>
     apply (rule Proj_sup)
     apply (rule orthogonal_sum)
     using insert by auto
   also have \<open>\<dots> = (\<Sum>x\<in>insert x F. Proj (J x))\<close>
     by (simp add: insert.IH insert.hyps(1) insert.hyps(2) insert.prems)
   finally show ?case
     by -
 qed
 
 lemma is_Proj_reduces_norm:
   fixes P :: \<open>'a::complex_inner \<Rightarrow>\<^sub>C\<^sub>L 'a\<close>
   assumes \<open>is_Proj P\<close>
   shows \<open>norm (P *\<^sub>V \<psi>) \<le> norm \<psi>\<close>
   apply (rule is_projection_on_reduces_norm[where M=\<open>range P\<close>])
   using assms is_Proj.rep_eq is_projection_on_image by blast (simp add: Proj_range_closed assms closed_csubspace.intro)
 
 lemma norm_Proj_apply: \<open>norm (Proj T *\<^sub>V \<psi>) = norm \<psi> \<longleftrightarrow> \<psi> \<in> space_as_set T\<close>
 proof (rule iffI)
   show \<open>norm (Proj T *\<^sub>V \<psi>) = norm \<psi>\<close> if \<open>\<psi> \<in> space_as_set T\<close>
     by (simp add: Proj_fixes_image that)
   assume assm: \<open>norm (Proj T *\<^sub>V \<psi>) = norm \<psi>\<close>
   have \<psi>_decomp: \<open>\<psi> = Proj T \<psi> + Proj (-T) \<psi>\<close>
     by (simp add: Proj_ortho_compl cblinfun.real.diff_left)
   have \<open>(norm (Proj (-T) \<psi>))\<^sup>2 = (norm (Proj T \<psi>))\<^sup>2 + (norm (Proj (-T) \<psi>))\<^sup>2 - (norm (Proj T \<psi>))\<^sup>2\<close>
     by auto
   also have \<open>\<dots> = (norm (Proj T \<psi> + Proj (-T) \<psi>))\<^sup>2 - (norm (Proj T \<psi>))\<^sup>2\<close>
     apply (subst pythagorean_theorem)
      apply (metis (no_types, lifting) Proj_idempotent \<psi>_decomp add_cancel_right_left adj_Proj cblinfun.real.add_right cblinfun_apply_cblinfun_compose cinner_adj_left cinner_zero_left)
     by simp
   also with \<psi>_decomp have \<open>\<dots> = (norm \<psi>)\<^sup>2 - (norm (Proj T \<psi>))\<^sup>2\<close>
     by metis
   also with assm have \<open>\<dots> = 0\<close>
     by simp
   finally have \<open>norm (Proj (-T) \<psi>) = 0\<close>
     by auto
   with \<psi>_decomp have \<open>\<psi> = Proj T \<psi>\<close>
     by auto
   then show \<open>\<psi> \<in> space_as_set T\<close>
     by (metis Proj_range cblinfun_apply_in_image)
 qed
 
 lemma norm_Proj_apply_1: \<open>norm \<psi> = 1 \<Longrightarrow> norm (Proj T *\<^sub>V \<psi>) = 1 \<longleftrightarrow> \<psi> \<in> space_as_set T\<close>
   using norm_Proj_apply by metis
 
 lemma norm_is_Proj_nonzero: \<open>norm P = 1\<close> if \<open>is_Proj P\<close> and \<open>P \<noteq> 0\<close> for P :: \<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'a\<close>
 proof (rule antisym)
   show \<open>norm P \<le> 1\<close>
     by (simp add: norm_is_Proj that(1))
   from \<open>P \<noteq> 0\<close>
   have \<open>range P \<noteq> 0\<close>
     by (metis cblinfun_eq_0_on_UNIV_span complex_vector.span_UNIV rangeI set_zero singletonD)
   then obtain \<psi> where \<open>\<psi> \<in> range P\<close> and \<open>\<psi> \<noteq> 0\<close>
     by force
   then have \<open>P \<psi> = \<psi>\<close>
     using is_Proj.rep_eq is_projection_on_fixes_image is_projection_on_image that(1) by blast
   then show \<open>norm P \<ge> 1\<close>
     apply (rule_tac cblinfun_norm_geqI[of _ _ \<psi>])
     using \<open>\<psi> \<noteq> 0\<close> by simp
 qed
 
 
 lemma Proj_compose_cancelI:
   assumes \<open>A *\<^sub>S \<top> \<le> S\<close>
   shows \<open>Proj S o\<^sub>C\<^sub>L A = A\<close>
   apply (rule cblinfun_eqI)
 proof -
   fix x
   have \<open>(Proj S o\<^sub>C\<^sub>L A) *\<^sub>V x = Proj S *\<^sub>V (A *\<^sub>V x)\<close>
   by simp
   also have \<open>\<dots> = A *\<^sub>V x\<close>
     apply (rule Proj_fixes_image)
     using assms cblinfun_apply_in_image less_eq_ccsubspace.rep_eq by blast
   finally show \<open>(Proj S o\<^sub>C\<^sub>L A) *\<^sub>V x = A *\<^sub>V x\<close>
     by -
 qed
 
 lemma space_as_setI_via_Proj:
   assumes \<open>Proj M *\<^sub>V x = x\<close>
   shows \<open>x \<in> space_as_set M\<close>
   using assms norm_Proj_apply by fastforce
 
 lemma unitary_image_ortho_compl: 
   \<comment> \<open>Logically, this lemma belongs in an earlier section but its proof uses projectors.\<close>
   fixes U :: \<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'b::chilbert_space\<close>
   assumes [simp]: \<open>unitary U\<close>
   shows \<open>U *\<^sub>S (- A) = - (U *\<^sub>S A)\<close>
 proof -
   have \<open>Proj (U *\<^sub>S (- A)) = sandwich U (Proj (- A))\<close>
     by (simp add: Proj_sandwich)
   also have \<open>\<dots> = sandwich U (id_cblinfun - Proj A)\<close>
     by (simp add: Proj_ortho_compl)
   also have \<open>\<dots> = id_cblinfun - sandwich U (Proj A)\<close>
     by (metis assms cblinfun.diff_right sandwich_isometry_id unitary_twosided_isometry)
   also have \<open>\<dots> = id_cblinfun - Proj (U *\<^sub>S A)\<close>
     by (simp add: Proj_sandwich)
   also have \<open>\<dots> = Proj (- (U *\<^sub>S A))\<close>
     by (simp add: Proj_ortho_compl)
   finally show ?thesis
     by (simp add: Proj_inj)
 qed
 
 
 lemma Proj_on_image [simp]: \<open>Proj S *\<^sub>S S = S\<close>
   by (metis Proj_idempotent Proj_range cblinfun_compose_image)
 
 subsection \<open>Kernel / eigenspaces\<close>
 
-lift_definition kernel :: "'a::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L'b::complex_normed_vector
+lift_definition kernel :: "'a::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_normed_vector
    \<Rightarrow> 'a ccsubspace"
-  is "\<lambda> f. f -` {0}"
+  is "\<lambda>f. f -` {0}"
   by (metis kernel_is_closed_csubspace)
 
 definition eigenspace :: "complex \<Rightarrow> 'a::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L'a \<Rightarrow> 'a ccsubspace" where
   "eigenspace a A = kernel (A - a *\<^sub>C id_cblinfun)"
 
 lemma kernel_scaleC[simp]: "a\<noteq>0 \<Longrightarrow> kernel (a *\<^sub>C A) = kernel A"
   for a :: complex and A :: "(_,_) cblinfun"
   apply transfer
   using complex_vector.scale_eq_0_iff by blast
 
 lemma kernel_0[simp]: "kernel 0 = top"
   by transfer auto
 
 lemma kernel_id[simp]: "kernel id_cblinfun = 0"
   by transfer simp
 
 lemma eigenspace_scaleC[simp]:
   assumes a1: "a \<noteq> 0"
   shows "eigenspace b (a *\<^sub>C A) = eigenspace (b/a) A"
 proof -
   have "b *\<^sub>C (id_cblinfun::('a, _) cblinfun) = a *\<^sub>C (b / a) *\<^sub>C id_cblinfun"
     using a1
     by (metis ceq_vector_fraction_iff)
   hence "kernel (a *\<^sub>C A - b *\<^sub>C id_cblinfun) = kernel (A - (b / a) *\<^sub>C id_cblinfun)"
     using a1 by (metis (no_types) complex_vector.scale_right_diff_distrib kernel_scaleC)
   thus ?thesis
     unfolding eigenspace_def
     by blast
 qed
 
 lemma eigenspace_memberD:
   assumes "x \<in> space_as_set (eigenspace e A)"
   shows "A *\<^sub>V x = e *\<^sub>C x"
   using assms unfolding eigenspace_def by transfer auto
 
 lemma kernel_memberD:
   assumes "x \<in> space_as_set (kernel A)"
   shows "A *\<^sub>V x = 0"
   using assms by transfer auto
 
 lemma eigenspace_memberI:
   assumes "A *\<^sub>V x = e *\<^sub>C x"
   shows "x \<in> space_as_set (eigenspace e A)"
   using assms unfolding eigenspace_def by transfer auto
 
 lemma kernel_memberI:
   assumes "A *\<^sub>V x = 0"
   shows "x \<in> space_as_set (kernel A)"
   using assms by transfer auto
 
 lemma kernel_Proj[simp]: \<open>kernel (Proj S) = - S\<close>
   apply transfer
   apply auto
   apply (metis diff_0_right is_projection_on_iff_orthog projection_is_projection_on')
   by (simp add: complex_vector.subspace_0 projection_eqI)
 
 lemma orthogonal_projectors_orthogonal_spaces:
   \<comment> \<open>Logically belongs in section "Projectors".\<close>
   fixes S T :: \<open>'a::chilbert_space ccsubspace\<close>
   shows \<open>orthogonal_spaces S T \<longleftrightarrow> Proj S o\<^sub>C\<^sub>L Proj T = 0\<close>
 proof (intro ballI iffI)
   assume \<open>Proj S o\<^sub>C\<^sub>L Proj T = 0\<close> 
   then have \<open>is_orthogonal x y\<close> if \<open>x \<in> space_as_set S\<close> \<open>y \<in> space_as_set T\<close> for x y
     by (metis (no_types, opaque_lifting) Proj_fixes_image adj_Proj cblinfun.zero_left cblinfun_apply_cblinfun_compose cinner_adj_right cinner_zero_right that(1) that(2))
   then show \<open>orthogonal_spaces S T\<close>
     by (simp add: orthogonal_spaces_def)
 next 
   assume \<open>orthogonal_spaces S T\<close>
   then have \<open>S \<le> - T\<close>
     by (simp add: orthogonal_spaces_leq_compl)
   then show \<open>Proj S o\<^sub>C\<^sub>L Proj T = 0\<close>
     by (metis (no_types, opaque_lifting) Proj_range adj_Proj adj_cblinfun_compose basic_trans_rules(31) cblinfun.zero_left cblinfun_apply_cblinfun_compose cblinfun_apply_in_image cblinfun_eqI kernel_Proj kernel_memberD less_eq_ccsubspace.rep_eq)
 qed
 
 
 lemma cblinfun_compose_Proj_kernel[simp]: \<open>a o\<^sub>C\<^sub>L Proj (kernel a) = 0\<close>
   apply (rule cblinfun_eqI)
   by simp (metis Proj_range cblinfun_apply_in_image kernel_memberD)
 
 lemma kernel_compl_adj_range:
   shows \<open>kernel a = - (a* *\<^sub>S top)\<close>
 proof (rule ccsubspace_eqI)
   fix x
   have \<open>x \<in> space_as_set (kernel a) \<longleftrightarrow> a x = 0\<close>
     by transfer simp
   also have \<open>a x = 0 \<longleftrightarrow> (\<forall>y. is_orthogonal y (a x))\<close>
     by (metis cinner_gt_zero_iff cinner_zero_right)
   also have \<open>\<dots> \<longleftrightarrow> (\<forall>y. is_orthogonal (a* *\<^sub>V y) x)\<close>
     by (simp add: cinner_adj_left)
   also have \<open>\<dots> \<longleftrightarrow> x \<in> space_as_set (- (a* *\<^sub>S top))\<close>
     by transfer (metis (mono_tags, opaque_lifting) UNIV_I image_iff is_orthogonal_sym orthogonal_complementI orthogonal_complement_of_closure orthogonal_complement_orthoI')
   finally show \<open>x \<in> space_as_set (kernel a) \<longleftrightarrow> x \<in> space_as_set (- (a* *\<^sub>S top))\<close>
     by -
 qed
 
 lemma kernel_apply_self: \<open>A *\<^sub>S kernel A = 0\<close>
 proof transfer
   fix A :: \<open>'b \<Rightarrow> 'a\<close>
   assume \<open>bounded_clinear A\<close>
   then have \<open>A 0 = 0\<close>
     by (simp add: bounded_clinear_def complex_vector.linear_0)
   then have \<open>A ` A -` {0} = {0}\<close>
     by fastforce
   then show \<open>closure (A ` A -` {0}) = {0}\<close>
     by auto
 qed
 
 lemma leq_kernel_iff: 
   shows \<open>A \<le> kernel B \<longleftrightarrow> B *\<^sub>S A = 0\<close>
 proof (rule iffI)
   assume \<open>A \<le> kernel B\<close>
   then have \<open>B *\<^sub>S A \<le> B *\<^sub>S kernel B\<close>
     by (simp add: cblinfun_image_mono)
   also have \<open>\<dots> = 0\<close>
     by (simp add: kernel_apply_self)
   finally show \<open>B *\<^sub>S A = 0\<close>
     by (simp add: bot.extremum_unique)
 next
   assume \<open>B *\<^sub>S A = 0\<close>
   then show \<open>A \<le> kernel B\<close>
     apply transfer
     by (metis closure_subset image_subset_iff_subset_vimage)
 qed
 
 lemma cblinfun_image_kernel:
   assumes \<open>C *\<^sub>S A *\<^sub>S kernel B \<le> kernel B\<close>
   assumes \<open>A o\<^sub>C\<^sub>L C = id_cblinfun\<close>
   shows \<open>A *\<^sub>S kernel B = kernel (B o\<^sub>C\<^sub>L C)\<close>
 proof (rule antisym)
   show \<open>A *\<^sub>S kernel B \<le> kernel (B o\<^sub>C\<^sub>L C)\<close>
     using assms(1) by (simp add: leq_kernel_iff cblinfun_compose_image)
   show \<open>kernel (B o\<^sub>C\<^sub>L C) \<le> A *\<^sub>S kernel B\<close>
   proof (insert assms(2), transfer, intro subsetI)
     fix A :: \<open>'a \<Rightarrow> 'b\<close> and B :: \<open>'a \<Rightarrow> 'c\<close> and C :: \<open>'b \<Rightarrow> 'a\<close> and x
     assume \<open>x \<in> (B \<circ> C) -` {0}\<close>
     then have BCx: \<open>B (C x) = 0\<close>
       by simp
     assume \<open>A \<circ> C = (\<lambda>x. x)\<close>
     then have \<open>x = A (C x)\<close>
       apply (simp add: o_def)
       by metis
     then show \<open>x \<in> closure (A ` B -` {0})\<close>
       using \<open>B (C x) = 0\<close> closure_subset by fastforce
   qed
 qed
 
 lemma cblinfun_image_kernel_unitary:
   assumes \<open>unitary U\<close>
   shows \<open>U *\<^sub>S kernel B = kernel (B o\<^sub>C\<^sub>L U*)\<close>
   apply (rule cblinfun_image_kernel)
   using assms by (auto simp flip: cblinfun_compose_image)
 
 lemma kernel_cblinfun_compose:
   assumes \<open>kernel B = 0\<close>
   shows \<open>kernel A = kernel (B o\<^sub>C\<^sub>L A)\<close>
   using assms apply transfer by auto
 
 
 lemma eigenspace_0[simp]: \<open>eigenspace 0 A = kernel A\<close>
   by (simp add: eigenspace_def)
 
 lemma kernel_isometry: \<open>kernel U = 0\<close> if \<open>isometry U\<close>
   by (simp add: kernel_compl_adj_range range_adjoint_isometry that)
 
 lemma cblinfun_image_eigenspace_isometry:
   assumes [simp]: \<open>isometry A\<close> and \<open>c \<noteq> 0\<close>
   shows \<open>A *\<^sub>S eigenspace c B = eigenspace c (sandwich A B)\<close>
 proof (rule antisym)
   show \<open>A *\<^sub>S eigenspace c B \<le> eigenspace c (sandwich A B)\<close>
   proof (unfold cblinfun_image_def2, rule ccspan_leqI, rule subsetI)
     fix x assume \<open>x \<in> (*\<^sub>V) A ` space_as_set (eigenspace c B)\<close>
     then obtain y where x_def: \<open>x = A y\<close> and \<open>y \<in> space_as_set (eigenspace c B)\<close>
       by auto
     then have \<open>B y = c *\<^sub>C y\<close>
       by (simp add: eigenspace_memberD)
     then have \<open>sandwich A B x = c *\<^sub>C x\<close>
       apply (simp add: sandwich_apply x_def cblinfun_compose_assoc 
           flip: cblinfun_apply_cblinfun_compose)
       by (simp add: cblinfun.scaleC_right)
     then show \<open>x \<in> space_as_set (eigenspace c (sandwich A B))\<close>
       by (simp add: eigenspace_memberI)
   qed
   show \<open>eigenspace c (sandwich A *\<^sub>V B) \<le> A *\<^sub>S eigenspace c B\<close>
   proof (rule ccsubspace_leI_unit)
     fix x
     assume \<open>x \<in> space_as_set (eigenspace c (sandwich A B))\<close>
     then have *: \<open>sandwich A B x = c *\<^sub>C x\<close>
       by (simp add: eigenspace_memberD)
     then have \<open>c *\<^sub>C x \<in> range A\<close>
       apply (simp add: sandwich_apply)
       by (metis rangeI)
     then have \<open>(inverse c * c) *\<^sub>C x \<in> range A\<close>
       apply (simp flip: scaleC_scaleC)
       by (metis (no_types, lifting) cblinfun.scaleC_right rangeE rangeI)
     with \<open>c \<noteq> 0\<close> have \<open>x \<in> range A\<close>
       by simp
     then obtain y where x_def: \<open>x = A y\<close>
       by auto
     have \<open>B *\<^sub>V y = A* *\<^sub>V sandwich A B x\<close>
       apply (simp add: sandwich_apply x_def)
       by (metis assms cblinfun_apply_cblinfun_compose id_cblinfun.rep_eq isometryD)
     also have \<open>\<dots> = c *\<^sub>C y\<close>
       apply (simp add: * cblinfun.scaleC_right)
       apply (simp add: x_def)
       by (metis assms(1) cblinfun_apply_cblinfun_compose id_cblinfun_apply isometry_def)
     finally have \<open>y \<in> space_as_set (eigenspace c B)\<close>
       by (simp add: eigenspace_memberI)
     then show \<open>x \<in> space_as_set (A *\<^sub>S eigenspace c B) \<close>
       by (simp add: x_def cblinfun_apply_in_image')
   qed
 qed
 
 lemma cblinfun_image_eigenspace_unitary:
   assumes [simp]: \<open>unitary A\<close>
   shows \<open>A *\<^sub>S eigenspace c B = eigenspace c (sandwich A B)\<close>
   apply (cases \<open>c = 0\<close>)
    apply (simp add: sandwich_apply cblinfun_image_kernel_unitary kernel_isometry cblinfun_compose_assoc
     flip: kernel_cblinfun_compose)
   by (simp add: cblinfun_image_eigenspace_isometry)
 
 lemma kernel_member_iff: \<open>x \<in> space_as_set (kernel A) \<longleftrightarrow> A *\<^sub>V x = 0\<close>
   using kernel_memberD kernel_memberI by blast
 
 lemma kernel_square[simp]: \<open>kernel (A* o\<^sub>C\<^sub>L A) = kernel A\<close>
 proof (intro ccsubspace_eqI iffI)
   fix x
   assume \<open>x \<in> space_as_set (kernel A)\<close>
   then show \<open>x \<in> space_as_set (kernel (A* o\<^sub>C\<^sub>L A))\<close>
     by (simp add: kernel.rep_eq)
 next
   fix x
   assume \<open>x \<in> space_as_set (kernel (A* o\<^sub>C\<^sub>L A))\<close>
   then have \<open>A* *\<^sub>V A *\<^sub>V x = 0\<close>
     by (simp add: kernel.rep_eq)
   then have \<open>(A *\<^sub>V x) \<bullet>\<^sub>C (A *\<^sub>V x) = 0\<close>
     by (metis cinner_adj_right cinner_zero_right)
   then have \<open>A *\<^sub>V x = 0\<close>
     by auto
   then show \<open>x \<in> space_as_set (kernel A)\<close>
     by (simp add: kernel.rep_eq)
 qed
 
 subsection \<open>Partial isometries\<close>
 
 definition partial_isometry where
   \<open>partial_isometry A \<longleftrightarrow> (\<forall>h \<in> space_as_set (- kernel A). norm (A h) = norm h)\<close>
 
 lemma partial_isometryI: 
   assumes \<open>\<And>h. h \<in> space_as_set (- kernel A) \<Longrightarrow> norm (A h) = norm h\<close>
   shows \<open>partial_isometry A\<close>
   using assms partial_isometry_def by blast
 
 lemma
   fixes A :: \<open>'a :: chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'b :: complex_normed_vector\<close>
   assumes iso: \<open>\<And>\<psi>. \<psi> \<in> space_as_set V \<Longrightarrow> norm (A *\<^sub>V \<psi>) = norm \<psi>\<close>
   assumes zero: \<open>\<And>\<psi>. \<psi> \<in> space_as_set (- V) \<Longrightarrow> A *\<^sub>V \<psi> = 0\<close>
   shows partial_isometryI': \<open>partial_isometry A\<close>
     and partial_isometry_initial: \<open>kernel A = - V\<close>
 proof -
   from zero
   have \<open>- V \<le> kernel A\<close>
     by (simp add: kernel_memberI less_eq_ccsubspace.rep_eq subsetI)
   moreover have \<open>kernel A \<le> -V\<close>
     by (smt (verit, ccfv_threshold) Proj_ortho_compl Proj_range assms(1) cblinfun.diff_left cblinfun.diff_right cblinfun_apply_in_image cblinfun_id_cblinfun_apply ccsubspace_leI kernel_Proj kernel_memberD kernel_memberI norm_eq_zero ortho_involution subsetI zero)
   ultimately show kerA: \<open>kernel A = -V\<close>
     by simp
 
   show \<open>partial_isometry A\<close>
     apply (rule partial_isometryI)
     by (simp add: kerA iso)
 qed
 
 lemma Proj_partial_isometry[simp]: \<open>partial_isometry (Proj S)\<close>
   apply (rule partial_isometryI)
   by (simp add: Proj_fixes_image)
 
 lemma is_Proj_partial_isometry: \<open>is_Proj P \<Longrightarrow> partial_isometry P\<close> for P :: \<open>_ :: chilbert_space \<Rightarrow>\<^sub>C\<^sub>L _\<close>
   by (metis Proj_on_own_range Proj_partial_isometry)
 
 lemma isometry_partial_isometry: \<open>isometry P \<Longrightarrow> partial_isometry P\<close>
   by (simp add: isometry_preserves_norm partial_isometry_def)
 
 lemma unitary_partial_isometry: \<open>unitary P \<Longrightarrow> partial_isometry P\<close>
   using isometry_partial_isometry unitary_isometry by blast
 
 lemma norm_partial_isometry:
   fixes A :: \<open>'a :: chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_normed_vector\<close>
   assumes \<open>partial_isometry A\<close> and \<open>A \<noteq> 0\<close>
   shows \<open>norm A = 1\<close> 
 proof -
   from \<open>A \<noteq> 0\<close>
   have \<open>- (kernel A) \<noteq> 0\<close>
     by (metis cblinfun_eqI diff_zero id_cblinfun_apply kernel_id kernel_memberD ortho_involution orthog_proj_exists orthogonal_complement_closed_subspace uminus_ccsubspace.rep_eq zero_cblinfun.rep_eq)
   then obtain h where \<open>h \<in> space_as_set (- kernel A)\<close> and \<open>h \<noteq> 0\<close>
     by (metis cblinfun_id_cblinfun_apply ccsubspace_eqI closed_csubspace.subspace complex_vector.subspace_0 kernel_id kernel_memberD kernel_memberI orthogonal_complement_closed_subspace uminus_ccsubspace.rep_eq)
   with \<open>partial_isometry A\<close>
   have \<open>norm (A h) = norm h\<close>
     using partial_isometry_def by blast
   then have \<open>norm A \<ge> 1\<close>
     by (smt (verit) \<open>h \<noteq> 0\<close> mult_cancel_right1 mult_left_le_one_le norm_cblinfun norm_eq_zero norm_ge_zero)
 
   have \<open>norm A \<le> 1\<close>
   proof (rule norm_cblinfun_bound)
     show \<open>0 \<le> (1::real)\<close>
       by simp
     fix \<psi> :: 'a
     define g h where \<open>g = Proj (kernel A) \<psi>\<close> and \<open>h = Proj (- kernel A) \<psi>\<close>
     have \<open>A g = 0\<close>
       by (metis Proj_range cblinfun_apply_in_image g_def kernel_memberD)
     moreover from \<open>partial_isometry A\<close>
     have \<open>norm (A h) = norm h\<close>
       by (metis Proj_range cblinfun_apply_in_image h_def partial_isometry_def)
     ultimately have \<open>norm (A \<psi>) = norm h\<close>
       by (simp add: Proj_ortho_compl cblinfun.diff_left cblinfun.diff_right g_def h_def)
     also have \<open>norm h \<le> norm \<psi>\<close>
       by (smt (verit, del_insts) h_def mult_left_le_one_le norm_Proj_leq1 norm_cblinfun norm_ge_zero)
     finally show \<open>norm (A *\<^sub>V \<psi>) \<le> 1 * norm \<psi>\<close>
       by simp
   qed
 
   from \<open>norm A \<le> 1\<close> and \<open>norm A \<ge> 1\<close>
   show \<open>norm A = 1\<close>
     by auto
 qed
 
 lemma partial_isometry_adj_a_o_a:
   assumes \<open>partial_isometry a\<close>
   shows \<open>a* o\<^sub>C\<^sub>L a = Proj (- kernel a)\<close>
 proof (rule cblinfun_cinner_eqI)
   define P where \<open>P = Proj (- kernel a)\<close>
   have aP: \<open>a o\<^sub>C\<^sub>L P = a\<close>
     by (auto intro!: simp: cblinfun_compose_minus_right P_def Proj_ortho_compl)
   have is_Proj_P[simp]: \<open>is_Proj P\<close>
     by (simp add: P_def)
 
   fix \<psi> :: 'a
   have \<open>\<psi> \<bullet>\<^sub>C ((a* o\<^sub>C\<^sub>L a) *\<^sub>V \<psi>) = a \<psi> \<bullet>\<^sub>C a \<psi>\<close>
     by (simp add: cinner_adj_right)
   also have \<open>\<dots> = a (P \<psi>) \<bullet>\<^sub>C a (P \<psi>)\<close>
     by (metis aP cblinfun_apply_cblinfun_compose)
   also have \<open>\<dots> = P \<psi> \<bullet>\<^sub>C P \<psi>\<close>
     by (metis P_def Proj_range assms cblinfun_apply_in_image cdot_square_norm partial_isometry_def)
   also have \<open>\<dots> = \<psi> \<bullet>\<^sub>C P \<psi>\<close>
     by (simp flip: cinner_adj_right add: is_proj_selfadj is_Proj_idempotent[THEN simp_a_oCL_b'])
   finally show \<open>\<psi> \<bullet>\<^sub>C ((a* o\<^sub>C\<^sub>L a) *\<^sub>V \<psi>) = \<psi> \<bullet>\<^sub>C P \<psi>\<close>
     by -
 qed
 
 lemma partial_isometry_square_proj: \<open>is_Proj (a* o\<^sub>C\<^sub>L a)\<close> if \<open>partial_isometry a\<close>
   by (simp add: partial_isometry_adj_a_o_a that)
 
 lemma partial_isometry_adj[simp]: \<open>partial_isometry (a*)\<close> if \<open>partial_isometry a\<close>
   for a :: \<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'b::chilbert_space\<close>
 proof -
   have ran_ker: \<open>a *\<^sub>S top = - kernel (a*)\<close>
     by (simp add: kernel_compl_adj_range)
 
   have \<open>norm (a* *\<^sub>V h) = norm h\<close> if \<open>h \<in> range a\<close> for h
   proof -
     from that obtain x where h: \<open>h = a x\<close>
       by auto
     have \<open>norm (a* *\<^sub>V h) = norm (a* *\<^sub>V a *\<^sub>V x)\<close>
       by (simp add: h)
     also have \<open>\<dots> = norm (Proj (- kernel a) *\<^sub>V x)\<close>
       by (simp add: \<open>partial_isometry a\<close> partial_isometry_adj_a_o_a simp_a_oCL_b')
     also have \<open>\<dots> = norm (a *\<^sub>V Proj (- kernel a) *\<^sub>V x)\<close>
       by (metis Proj_range \<open>partial_isometry a\<close> cblinfun_apply_in_image partial_isometry_def)
     also have \<open>\<dots> = norm (a *\<^sub>V x)\<close>
       by (smt (verit, best) Proj_idempotent \<open>partial_isometry a\<close> adj_Proj cblinfun_apply_cblinfun_compose cinner_adj_right cnorm_eq partial_isometry_adj_a_o_a)
     also have \<open>\<dots> = norm h\<close>
       using h by auto
     finally show ?thesis
       by -
   qed
 
   then have norm_pres: \<open>norm (a* *\<^sub>V h) = norm h\<close> if \<open>h \<in> closure (range a)\<close> for h
     using that apply (rule on_closure_eqI)
       by assumption (intro continuous_intros)+
 
   show ?thesis
     apply (rule partial_isometryI)
     by (auto simp: cblinfun_image.rep_eq norm_pres simp flip: ran_ker)
 qed
 
 subsection \<open>Isomorphisms and inverses\<close>
 
 definition iso_cblinfun :: \<open>('a::complex_normed_vector, 'b::complex_normed_vector) cblinfun \<Rightarrow> bool\<close> where
   \<open>iso_cblinfun A = (\<exists> B. A o\<^sub>C\<^sub>L B = id_cblinfun \<and> B o\<^sub>C\<^sub>L A = id_cblinfun)\<close>
 
 definition \<open>invertible_cblinfun A \<longleftrightarrow> (\<exists>B. B o\<^sub>C\<^sub>L A = id_cblinfun)\<close>
 
 definition cblinfun_inv :: \<open>('a::complex_normed_vector, 'b::complex_normed_vector) cblinfun \<Rightarrow> ('b,'a) cblinfun\<close> where
-  \<open>cblinfun_inv A = (SOME B. B o\<^sub>C\<^sub>L A = id_cblinfun)\<close>
+  \<open>cblinfun_inv A = (if invertible_cblinfun A then SOME B. B o\<^sub>C\<^sub>L A = id_cblinfun else 0)\<close>
 
 lemma cblinfun_inv_left:
   assumes \<open>invertible_cblinfun A\<close>
   shows \<open>cblinfun_inv A o\<^sub>C\<^sub>L A = id_cblinfun\<close>
-  unfolding cblinfun_inv_def apply (rule someI_ex)
+  apply (simp add: assms cblinfun_inv_def)
+  apply (rule someI_ex)
   using assms by (simp add: invertible_cblinfun_def)
 
 lemma inv_cblinfun_invertible:  \<open>iso_cblinfun A \<Longrightarrow> invertible_cblinfun A\<close>
   by (auto simp: iso_cblinfun_def invertible_cblinfun_def)
 
 lemma cblinfun_inv_right:
   assumes \<open>iso_cblinfun A\<close>
   shows \<open>A o\<^sub>C\<^sub>L cblinfun_inv A = id_cblinfun\<close>
 proof -
   from assms
   obtain B where AB: \<open>A o\<^sub>C\<^sub>L B = id_cblinfun\<close> and BA: \<open>B o\<^sub>C\<^sub>L A = id_cblinfun\<close>
     using iso_cblinfun_def by blast
   from BA have \<open>cblinfun_inv A o\<^sub>C\<^sub>L A = id_cblinfun\<close>
-    by (metis (mono_tags, lifting) cblinfun_inv_def someI_ex)
+    by (simp add: assms cblinfun_inv_left inv_cblinfun_invertible)
   with AB BA have \<open>cblinfun_inv A = B\<close>
     by (metis cblinfun_assoc_left(1) cblinfun_compose_id_right)
   with AB show \<open>A o\<^sub>C\<^sub>L cblinfun_inv A = id_cblinfun\<close>
     by auto
 qed
 
 lemma cblinfun_inv_uniq:
   assumes "A o\<^sub>C\<^sub>L B = id_cblinfun" and "B o\<^sub>C\<^sub>L A = id_cblinfun"
   shows "cblinfun_inv A = B"
   using assms by (metis inv_cblinfun_invertible cblinfun_compose_assoc cblinfun_compose_id_right cblinfun_inv_left iso_cblinfun_def)
 
 lemma iso_cblinfun_unitary: \<open>unitary A \<Longrightarrow> iso_cblinfun A\<close>
   using iso_cblinfun_def unitary_def by blast
 
 lemma invertible_cblinfun_isometry: \<open>isometry A \<Longrightarrow> invertible_cblinfun A\<close>
   using invertible_cblinfun_def isometryD by blast
 
 lemma summable_cblinfun_apply_invertible:
   assumes \<open>invertible_cblinfun A\<close>
   shows \<open>(\<lambda>x. A *\<^sub>V g x) summable_on S \<longleftrightarrow> g summable_on S\<close>
 proof (rule iffI)
   assume \<open>g summable_on S\<close>
   then show \<open>(\<lambda>x. A *\<^sub>V g x) summable_on S\<close>
     by (rule summable_on_cblinfun_apply)
 next
   assume \<open>(\<lambda>x. A *\<^sub>V g x) summable_on S\<close>
   then have \<open>(\<lambda>x. cblinfun_inv A *\<^sub>V A *\<^sub>V g x) summable_on S\<close>
     by (rule summable_on_cblinfun_apply)
   then show \<open>g summable_on S\<close>
     by (simp add: cblinfun_inv_left assms flip: cblinfun_apply_cblinfun_compose)
 qed
 
 lemma infsum_cblinfun_apply_invertible:
   assumes \<open>invertible_cblinfun A\<close>
-  shows \<open>infsum (\<lambda>x. A *\<^sub>V g x) S = A *\<^sub>V (infsum g S)\<close>
+  shows \<open>(\<Sum>\<^sub>\<infinity>x\<in>S. A *\<^sub>V g x) = A *\<^sub>V (\<Sum>\<^sub>\<infinity>x\<in>S. g x)\<close>
 proof (cases \<open>g summable_on S\<close>)
   case True
   then show ?thesis
     by (rule infsum_cblinfun_apply)
 next
   case False
   then have \<open>\<not> (\<lambda>x. A *\<^sub>V g x) summable_on S\<close>
   using assms by (simp add: summable_cblinfun_apply_invertible)
   with False show ?thesis 
     by (simp add: infsum_not_exists)
 qed
 
 subsection \<open>One-dimensional spaces\<close>
 
 
 instantiation cblinfun :: (one_dim, one_dim) complex_inner begin
 text \<open>Once we have a theory for the trace, we could instead define the Hilbert-Schmidt inner product
   and relax the \<^class>\<open>one_dim\<close>-sort constraint to (\<^class>\<open>cfinite_dim\<close>,\<^class>\<open>complex_normed_vector\<close>) or similar\<close>
 definition "cinner_cblinfun (A::'a \<Rightarrow>\<^sub>C\<^sub>L 'b) (B::'a \<Rightarrow>\<^sub>C\<^sub>L 'b)
              = cnj (one_dim_iso (A *\<^sub>V 1)) * one_dim_iso (B *\<^sub>V 1)"
 instance
 proof intro_classes
   fix A B C :: "'a \<Rightarrow>\<^sub>C\<^sub>L 'b"
     and c c' :: complex
   show "(A \<bullet>\<^sub>C B) = cnj (B \<bullet>\<^sub>C A)"
     unfolding cinner_cblinfun_def by auto
   show "(A + B) \<bullet>\<^sub>C C = (A \<bullet>\<^sub>C C) + (B \<bullet>\<^sub>C C)"
     by (simp add: cinner_cblinfun_def algebra_simps plus_cblinfun.rep_eq)
   show "(c *\<^sub>C A \<bullet>\<^sub>C B) = cnj c * (A \<bullet>\<^sub>C B)"
     by (simp add: cblinfun.scaleC_left cinner_cblinfun_def)
   show "0 \<le> (A \<bullet>\<^sub>C A)"
     unfolding cinner_cblinfun_def by auto
   have "bounded_clinear A \<Longrightarrow> A 1 = 0 \<Longrightarrow> A = (\<lambda>_. 0)"
     for A::"'a \<Rightarrow> 'b"
   proof (rule one_dim_clinear_eqI [where x = 1] , auto)
     show "clinear A"
       if "bounded_clinear A"
         and "A 1 = 0"
       for A :: "'a \<Rightarrow> 'b"
       using that
       by (simp add: bounded_clinear.clinear)
     show "clinear ((\<lambda>_. 0)::'a \<Rightarrow> 'b)"
       if "bounded_clinear A"
         and "A 1 = 0"
       for A :: "'a \<Rightarrow> 'b"
       using that
       by (simp add: complex_vector.module_hom_zero)
   qed
   hence "A *\<^sub>V 1 = 0 \<Longrightarrow> A = 0"
     by transfer
   hence "one_dim_iso (A *\<^sub>V 1) = 0 \<Longrightarrow> A = 0"
     by (metis one_dim_iso_of_zero one_dim_iso_inj)
   thus "((A \<bullet>\<^sub>C A) = 0) = (A = 0)"
     by (auto simp: cinner_cblinfun_def)
 
   show "norm A = sqrt (cmod (A \<bullet>\<^sub>C A))"
     unfolding cinner_cblinfun_def
     by transfer (simp add: norm_mult abs_complex_def one_dim_onorm' cnj_x_x power2_eq_square bounded_clinear.clinear)
 qed
 end
 
 instantiation cblinfun :: (one_dim, one_dim) one_dim begin
 lift_definition one_cblinfun :: "'a \<Rightarrow>\<^sub>C\<^sub>L 'b" is "one_dim_iso"
   by (rule bounded_clinear_one_dim_iso)
 lift_definition times_cblinfun :: "'a \<Rightarrow>\<^sub>C\<^sub>L 'b \<Rightarrow> 'a \<Rightarrow>\<^sub>C\<^sub>L 'b \<Rightarrow> 'a \<Rightarrow>\<^sub>C\<^sub>L 'b"
   is "\<lambda>f g. f o one_dim_iso o g"
   by (simp add: comp_bounded_clinear)
 lift_definition inverse_cblinfun :: "'a \<Rightarrow>\<^sub>C\<^sub>L 'b \<Rightarrow> 'a \<Rightarrow>\<^sub>C\<^sub>L 'b" is
   "\<lambda>f. ((*) (one_dim_iso (inverse (f 1)))) o one_dim_iso"
   by (auto intro!: comp_bounded_clinear bounded_clinear_mult_right)
 definition divide_cblinfun :: "'a \<Rightarrow>\<^sub>C\<^sub>L 'b \<Rightarrow> 'a \<Rightarrow>\<^sub>C\<^sub>L 'b \<Rightarrow> 'a \<Rightarrow>\<^sub>C\<^sub>L 'b" where
   "divide_cblinfun A B = A * inverse B"
 definition "canonical_basis_cblinfun = [1 :: 'a \<Rightarrow>\<^sub>C\<^sub>L 'b]"
 definition \<open>canonical_basis_length_cblinfun (_ :: ('a \<Rightarrow>\<^sub>C\<^sub>L 'b) itself) = (1::nat)\<close>
 instance
 proof intro_classes
   let ?basis = "canonical_basis :: ('a \<Rightarrow>\<^sub>C\<^sub>L 'b) list"
   fix A B C :: "'a \<Rightarrow>\<^sub>C\<^sub>L 'b"
     and c c' :: complex
   show "distinct ?basis"
     unfolding canonical_basis_cblinfun_def by simp
   have "(1::'a \<Rightarrow>\<^sub>C\<^sub>L 'b) \<noteq> (0::'a \<Rightarrow>\<^sub>C\<^sub>L 'b)"
     by (metis cblinfun.zero_left one_cblinfun.rep_eq one_dim_iso_of_one zero_neq_one)
   thus "cindependent (set ?basis)"
     unfolding canonical_basis_cblinfun_def by simp
 
   have "A \<in> cspan (set ?basis)" for A
   proof -
     define c :: complex where "c = one_dim_iso (A *\<^sub>V 1)"
     have "A x = one_dim_iso (A 1) *\<^sub>C one_dim_iso x" for x
       by (smt (z3) cblinfun.scaleC_right complex_vector.scale_left_commute one_dim_iso_idem one_dim_scaleC_1)
     hence "A = one_dim_iso (A *\<^sub>V 1) *\<^sub>C 1"
       by transfer metis
     thus "A \<in> cspan (set ?basis)"
       unfolding canonical_basis_cblinfun_def
       by (smt complex_vector.span_base complex_vector.span_scale list.set_intros(1))
   qed
   thus "cspan (set ?basis) = UNIV" by auto
 
   have "A = (1::'a \<Rightarrow>\<^sub>C\<^sub>L 'b) \<Longrightarrow>
     norm (1::'a \<Rightarrow>\<^sub>C\<^sub>L 'b) = (1::real)"
     by transfer simp
   thus "A \<in> set ?basis \<Longrightarrow> norm A = 1"
     unfolding canonical_basis_cblinfun_def
     by simp
 
   show "?basis = [1]"
     unfolding canonical_basis_cblinfun_def by simp
   show "c *\<^sub>C 1 * c' *\<^sub>C 1 = (c * c') *\<^sub>C (1::'a\<Rightarrow>\<^sub>C\<^sub>L'b)"
     by transfer auto
   have "(1::'a \<Rightarrow>\<^sub>C\<^sub>L 'b) = (0::'a \<Rightarrow>\<^sub>C\<^sub>L 'b) \<Longrightarrow> False"
     by (metis cblinfun.zero_left one_cblinfun.rep_eq one_dim_iso_of_zero' zero_neq_neg_one)
   thus "is_ortho_set (set ?basis)"
     unfolding is_ortho_set_def canonical_basis_cblinfun_def by auto
   show "A div B = A * inverse B"
     by (simp add: divide_cblinfun_def)
   show "inverse (c *\<^sub>C 1) = (1::'a\<Rightarrow>\<^sub>C\<^sub>L'b) /\<^sub>C c"
     by transfer (simp add: o_def one_dim_inverse)
   show \<open>canonical_basis_length TYPE('a \<Rightarrow>\<^sub>C\<^sub>L 'b) = length (canonical_basis :: ('a \<Rightarrow>\<^sub>C\<^sub>L 'b) list)\<close>
     by (simp add: canonical_basis_length_cblinfun_def canonical_basis_cblinfun_def)
 qed
 end
 
 lemma id_cblinfun_eq_1[simp]: \<open>id_cblinfun = 1\<close>
   by transfer auto
 
 lemma one_dim_apply_is_times[simp]:
   fixes A :: "'a::one_dim \<Rightarrow>\<^sub>C\<^sub>L 'a" and B :: "'a \<Rightarrow>\<^sub>C\<^sub>L 'a"
   shows "A o\<^sub>C\<^sub>L B = A * B"
   by transfer simp
 
 lemma one_comp_one_cblinfun[simp]: "1 o\<^sub>C\<^sub>L 1 = 1"
   apply transfer unfolding o_def by simp
 
 lemma one_cblinfun_adj[simp]: "1* = 1"
   by transfer simp
 
 lemma scaleC_1_apply[simp]: \<open>(x *\<^sub>C 1) *\<^sub>V y = x *\<^sub>C y\<close>
   by (metis cblinfun.scaleC_left cblinfun_id_cblinfun_apply id_cblinfun_eq_1)
 
 lemma cblinfun_apply_1_left[simp]: \<open>1 *\<^sub>V y = y\<close>
   by (metis cblinfun_id_cblinfun_apply id_cblinfun_eq_1)
 
 lemma of_complex_cblinfun_apply[simp]: \<open>of_complex x *\<^sub>V y = one_dim_iso (x *\<^sub>C y)\<close>
   by (metis of_complex_def cblinfun.scaleC_right one_cblinfun.rep_eq scaleC_cblinfun.rep_eq)
 
 lemma cblinfun_compose_1_left[simp]: \<open>1 o\<^sub>C\<^sub>L x = x\<close>
   by transfer auto
 
 lemma cblinfun_compose_1_right[simp]: \<open>x o\<^sub>C\<^sub>L 1 = x\<close>
   by transfer auto
 
 lemma one_dim_iso_id_cblinfun: \<open>one_dim_iso id_cblinfun = id_cblinfun\<close>
   by simp
 
 lemma one_dim_iso_id_cblinfun_eq_1: \<open>one_dim_iso id_cblinfun = 1\<close>
   by simp
 
 lemma one_dim_iso_comp_distr[simp]: \<open>one_dim_iso (a o\<^sub>C\<^sub>L b) = one_dim_iso a o\<^sub>C\<^sub>L one_dim_iso b\<close>
   by (smt (z3) cblinfun_compose_scaleC_left cblinfun_compose_scaleC_right one_cinner_a_scaleC_one one_comp_one_cblinfun one_dim_iso_of_one one_dim_iso_scaleC)
 
 lemma one_dim_iso_comp_distr_times[simp]: \<open>one_dim_iso (a o\<^sub>C\<^sub>L b) = one_dim_iso a * one_dim_iso b\<close>
   by (smt (verit, del_insts) mult.left_neutral mult_scaleC_left one_cinner_a_scaleC_one one_comp_one_cblinfun one_dim_iso_of_one one_dim_iso_scaleC cblinfun_compose_scaleC_right cblinfun_compose_scaleC_left)
 
 lemma one_dim_iso_adjoint[simp]: \<open>one_dim_iso (A*) = (one_dim_iso A)*\<close>
   by (smt (z3) one_cblinfun_adj one_cinner_a_scaleC_one one_dim_iso_of_one one_dim_iso_scaleC scaleC_adj)
 
 lemma one_dim_iso_adjoint_complex[simp]: \<open>one_dim_iso (A*) = cnj (one_dim_iso A)\<close>
   by (metis (mono_tags, lifting) one_cblinfun_adj one_dim_iso_idem one_dim_scaleC_1 scaleC_adj)
 
 lemma one_dim_cblinfun_compose_commute: \<open>a o\<^sub>C\<^sub>L b = b o\<^sub>C\<^sub>L a\<close> for a b :: \<open>('a::one_dim,'a) cblinfun\<close>
   by (simp add: one_dim_iso_inj)
 
 lemma one_cblinfun_apply_one[simp]: \<open>1 *\<^sub>V 1 = 1\<close>
   by (simp add: one_cblinfun.rep_eq)
 
 lemma is_onb_one_dim[simp]: \<open>norm x = 1 \<Longrightarrow> is_onb {x}\<close> for x :: \<open>_ :: one_dim\<close>
   by (auto simp: is_onb_def intro!: ccspan_one_dim)
 
 lemma one_dim_iso_cblinfun_comp: \<open>one_dim_iso (a o\<^sub>C\<^sub>L b) = of_complex (cinner (a* *\<^sub>V 1) (b *\<^sub>V 1))\<close>
   for a :: \<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'b::one_dim\<close> and b :: \<open>'c::one_dim \<Rightarrow>\<^sub>C\<^sub>L 'a\<close>
   by (simp add: cinner_adj_left cinner_cblinfun_def one_dim_iso_def)
 
 lemma one_dim_iso_cblinfun_apply[simp]: \<open>one_dim_iso \<psi> *\<^sub>V \<phi> = one_dim_iso (one_dim_iso \<psi> *\<^sub>C \<phi>)\<close>
   by (smt (verit) cblinfun.scaleC_left one_cblinfun.rep_eq one_dim_iso_of_one one_dim_iso_scaleC one_dim_scaleC_1)
 
 subsection \<open>Loewner order\<close>
 
 lift_definition heterogenous_cblinfun_id :: \<open>'a::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_normed_vector\<close>
   is \<open>if bounded_clinear (heterogenous_identity :: 'a::complex_normed_vector \<Rightarrow> 'b::complex_normed_vector) then heterogenous_identity else (\<lambda>_. 0)\<close>
   by auto
 
 lemma heterogenous_cblinfun_id_def'[simp]: "heterogenous_cblinfun_id = id_cblinfun"
   by transfer auto
 
 definition "heterogenous_same_type_cblinfun (x::'a::chilbert_space itself) (y::'b::chilbert_space itself) \<longleftrightarrow>
   unitary (heterogenous_cblinfun_id :: 'a \<Rightarrow>\<^sub>C\<^sub>L 'b) \<and> unitary (heterogenous_cblinfun_id :: 'b \<Rightarrow>\<^sub>C\<^sub>L 'a)"
 
 lemma heterogenous_same_type_cblinfun[simp]: \<open>heterogenous_same_type_cblinfun (x::'a::chilbert_space itself) (y::'a::chilbert_space itself)\<close>
   unfolding heterogenous_same_type_cblinfun_def by auto
 
 instantiation cblinfun :: (chilbert_space, chilbert_space) ord begin
-definition less_eq_cblinfun_def_heterogenous: \<open>A \<le> B =
+definition less_eq_cblinfun_def_heterogenous: \<open>A \<le> B \<longleftrightarrow>
   (if heterogenous_same_type_cblinfun TYPE('a) TYPE('b) then
     \<forall>\<psi>::'b. cinner \<psi> ((B-A) *\<^sub>V heterogenous_cblinfun_id *\<^sub>V \<psi>) \<ge> 0 else (A=B))\<close>
 definition \<open>(A :: 'a \<Rightarrow>\<^sub>C\<^sub>L 'b) < B \<longleftrightarrow> A \<le> B \<and> \<not> B \<le> A\<close>
 instance..
 end
 
 lemma less_eq_cblinfun_def: \<open>A \<le> B \<longleftrightarrow>
     (\<forall>\<psi>. cinner \<psi> (A *\<^sub>V \<psi>) \<le> cinner \<psi> (B *\<^sub>V \<psi>))\<close>
   unfolding less_eq_cblinfun_def_heterogenous
   by (auto simp del: less_eq_complex_def simp: cblinfun.diff_left cinner_diff_right)
 
 instantiation cblinfun :: (chilbert_space, chilbert_space) ordered_complex_vector begin
 instance
 proof intro_classes
   fix x y z :: \<open>'a \<Rightarrow>\<^sub>C\<^sub>L 'b\<close>
   fix a b :: complex
 
   define pos where \<open>pos X \<longleftrightarrow> (\<forall>\<psi>. cinner \<psi> (X *\<^sub>V \<psi>) \<ge> 0)\<close> for X :: \<open>'b \<Rightarrow>\<^sub>C\<^sub>L 'b\<close>
   consider (unitary) \<open>heterogenous_same_type_cblinfun TYPE('a) TYPE('b)\<close>
       \<open>\<And>A B :: 'a \<Rightarrow>\<^sub>C\<^sub>L 'b. A \<le> B = pos ((B-A) o\<^sub>C\<^sub>L (heterogenous_cblinfun_id :: 'b\<Rightarrow>\<^sub>C\<^sub>L'a))\<close>
     | (trivial) \<open>\<And>A B :: 'a \<Rightarrow>\<^sub>C\<^sub>L 'b. A \<le> B \<longleftrightarrow> A = B\<close>
     by atomize_elim (auto simp: pos_def less_eq_cblinfun_def_heterogenous)
   note cases = this
 
   have [simp]: \<open>pos 0\<close>
     unfolding pos_def by auto
 
   have pos_nondeg: \<open>X = 0\<close> if \<open>pos X\<close> and \<open>pos (-X)\<close> for X
     apply (rule cblinfun_cinner_eqI, simp)
     using that by (metis (no_types, lifting) cblinfun.minus_left cinner_minus_right dual_order.antisym equation_minus_iff neg_le_0_iff_le pos_def)
 
   have pos_add: \<open>pos (X+Y)\<close> if \<open>pos X\<close> and \<open>pos Y\<close> for X Y
     by (smt (z3) pos_def cblinfun.diff_left cinner_minus_right cinner_simps(3) diff_ge_0_iff_ge diff_minus_eq_add neg_le_0_iff_le order_trans that(1) that(2) uminus_cblinfun.rep_eq)
 
   have pos_scaleC: \<open>pos (a *\<^sub>C X)\<close> if \<open>a\<ge>0\<close> and \<open>pos X\<close> for X a
     using that unfolding pos_def by (auto simp: cblinfun.scaleC_left)
 
   let ?id = \<open>heterogenous_cblinfun_id :: 'b \<Rightarrow>\<^sub>C\<^sub>L 'a\<close>
 
   show \<open>x \<le> x\<close>
     apply (cases rule:cases) by auto
   show \<open>(x < y) \<longleftrightarrow> (x \<le> y \<and> \<not> y \<le> x)\<close>
     unfolding less_cblinfun_def by simp
   show \<open>x \<le> z\<close> if \<open>x \<le> y\<close> and \<open>y \<le> z\<close>
   proof (cases rule:cases)
     case unitary
     define a b :: \<open>'b \<Rightarrow>\<^sub>C\<^sub>L 'b\<close> where \<open>a = (y-x) o\<^sub>C\<^sub>L heterogenous_cblinfun_id\<close>
       and \<open>b = (z-y) o\<^sub>C\<^sub>L heterogenous_cblinfun_id\<close>
     with unitary that have \<open>pos a\<close> and \<open>pos b\<close>
       by auto
     then have \<open>pos (a + b)\<close>
       by (rule pos_add)
     moreover have \<open>a + b = (z - x) o\<^sub>C\<^sub>L heterogenous_cblinfun_id\<close>
       unfolding a_def b_def
       by (metis (no_types, lifting) bounded_cbilinear.add_left bounded_cbilinear_cblinfun_compose diff_add_cancel ordered_field_class.sign_simps(2) ordered_field_class.sign_simps(8))
     ultimately show ?thesis
       using unitary by auto
   next
     case trivial
     with that show ?thesis by auto
   qed
   show \<open>x = y\<close> if \<open>x \<le> y\<close> and \<open>y \<le> x\<close>
   proof (cases rule:cases)
     case unitary
     then have \<open>unitary ?id\<close>
       by (auto simp: heterogenous_same_type_cblinfun_def)
     define a b :: \<open>'b \<Rightarrow>\<^sub>C\<^sub>L 'b\<close> where \<open>a = (y-x) o\<^sub>C\<^sub>L ?id\<close>
       and \<open>b = (x-y) o\<^sub>C\<^sub>L ?id\<close>
     with unitary that have \<open>pos a\<close> and \<open>pos b\<close>
       by auto
     then have \<open>a = 0\<close>
       apply (rule_tac pos_nondeg)
        apply (auto simp: a_def b_def)
       by (smt (verit, best) add.commute bounded_cbilinear.add_left bounded_cbilinear_cblinfun_compose cblinfun_compose_zero_left diff_0 diff_add_cancel group_cancel.rule0 group_cancel.sub1)
     then show ?thesis
       unfolding a_def using \<open>unitary ?id\<close>
       by (metis cblinfun_compose_assoc cblinfun_compose_id_right cblinfun_compose_zero_left eq_iff_diff_eq_0 unitaryD2)
   next
     case trivial
     with that show ?thesis by simp
   qed
   show \<open>x + y \<le> x + z\<close> if \<open>y \<le> z\<close>
   proof (cases rule:cases)
     case unitary
     with that show ?thesis
       by auto
   next
     case trivial
     with that show ?thesis
       by auto
   qed
 
   show \<open>a *\<^sub>C x \<le> a *\<^sub>C y\<close> if \<open>x \<le> y\<close> and \<open>0 \<le> a\<close>
   proof (cases rule:cases)
     case unitary
     with that pos_scaleC show ?thesis
       by (metis cblinfun_compose_scaleC_left complex_vector.scale_right_diff_distrib)
   next
     case trivial
     with that show ?thesis
       by auto
   qed
 
   show \<open>a *\<^sub>C x \<le> b *\<^sub>C x\<close> if \<open>a \<le> b\<close> and \<open>0 \<le> x\<close>
   proof (cases rule:cases)
     case unitary
     with that show ?thesis
       by (auto intro!: pos_scaleC simp flip: scaleC_diff_left)
   next
     case trivial
     with that show ?thesis
       by auto
   qed
 qed
 end
 
 
 
 lemma positive_id_cblinfun[simp]: "id_cblinfun \<ge> 0"
   unfolding less_eq_cblinfun_def using cinner_ge_zero by auto
 
 lemma positive_hermitianI: \<open>A* = A\<close> if \<open>A \<ge> 0\<close>
   apply (rule cinner_real_hermiteanI)
   using that by (auto simp: complex_is_real_iff_compare0 less_eq_cblinfun_def)
 
 lemma cblinfun_leI:
   assumes \<open>\<And>x. norm x = 1 \<Longrightarrow> x \<bullet>\<^sub>C (A *\<^sub>V x) \<le> x \<bullet>\<^sub>C (B *\<^sub>V x)\<close>
   shows \<open>A \<le> B\<close>
 proof (unfold less_eq_cblinfun_def, intro allI, case_tac \<open>\<psi> = 0\<close>)
   fix \<psi> :: 'a assume \<open>\<psi> = 0\<close>
   then show \<open>\<psi> \<bullet>\<^sub>C (A *\<^sub>V \<psi>) \<le> \<psi> \<bullet>\<^sub>C (B *\<^sub>V \<psi>)\<close>
     by simp
 next
   fix \<psi> :: 'a assume \<open>\<psi> \<noteq> 0\<close>
   define \<phi> where \<open>\<phi> = \<psi> /\<^sub>R norm \<psi>\<close>
   have \<open>\<phi> \<bullet>\<^sub>C (A *\<^sub>V \<phi>) \<le> \<phi> \<bullet>\<^sub>C (B *\<^sub>V \<phi>)\<close>
     apply (rule assms)
     unfolding \<phi>_def
     by (simp add: \<open>\<psi> \<noteq> 0\<close>)
   with \<open>\<psi> \<noteq> 0\<close> show \<open>\<psi> \<bullet>\<^sub>C (A *\<^sub>V \<psi>) \<le> \<psi> \<bullet>\<^sub>C (B *\<^sub>V \<psi>)\<close>
     unfolding \<phi>_def
     by (smt (verit) cinner_adj_left cinner_scaleR_left cinner_simps(6) complex_of_real_nn_iff mult_cancel_right1 mult_left_mono norm_eq_zero norm_ge_zero of_real_1 right_inverse scaleR_scaleC scaleR_scaleR)
 qed
 
 lemma positive_cblinfunI: \<open>A \<ge> 0\<close> if \<open>\<And>x. norm x = 1 \<Longrightarrow> cinner x (A *\<^sub>V x) \<ge> 0\<close>
   apply (rule cblinfun_leI)
   using that by simp
 
 lemma less_eq_scaled_id_norm: 
   assumes \<open>norm A \<le> c\<close> and \<open>A = A*\<close>
   shows \<open>A \<le> complex_of_real c *\<^sub>C id_cblinfun\<close>
 proof -
   have \<open>x \<bullet>\<^sub>C (A *\<^sub>V x) \<le> complex_of_real c\<close> if \<open>norm x = 1\<close> for x
   proof -
     have \<open>norm (x \<bullet>\<^sub>C (A *\<^sub>V x)) \<le> norm (A *\<^sub>V x)\<close>
       by (metis complex_inner_class.Cauchy_Schwarz_ineq2 mult_cancel_right1 that)
     also have \<open>\<dots> \<le> norm A\<close>
       by (metis more_arith_simps(6) norm_cblinfun that)
     also have \<open>\<dots> \<le> c\<close>
       by (rule assms)
     finally have \<open>norm (x \<bullet>\<^sub>C (A *\<^sub>V x)) \<le> c\<close>
       by -
     moreover have \<open>x \<bullet>\<^sub>C (A *\<^sub>V x) \<in> \<real>\<close>
       by (metis assms(2) cinner_hermitian_real)
     ultimately show ?thesis
       by (metis cnorm_le_square complex_of_real_cmod complex_of_real_mono complex_of_real_nn_iff dual_order.trans reals_zero_comparable)
   qed
   then show ?thesis
     by (smt (verit) cblinfun.scaleC_left cblinfun_id_cblinfun_apply cblinfun_leI cinner_scaleC_right cnorm_eq_1 mult_cancel_left2)
 qed
 
 (* Note: this does not require B to be a square operator *)
 lemma positive_cblinfun_squareI: \<open>A = B* o\<^sub>C\<^sub>L B \<Longrightarrow> A \<ge> 0\<close>
   apply (rule positive_cblinfunI)
   by (metis cblinfun_apply_cblinfun_compose cinner_adj_right cinner_ge_zero)
 
 lemma one_dim_loewner_order: \<open>A \<ge> B \<longleftrightarrow> one_dim_iso A \<ge> (one_dim_iso B :: complex)\<close> for A B :: \<open>'a \<Rightarrow>\<^sub>C\<^sub>L 'a::{chilbert_space, one_dim}\<close>
 proof -
   have A: \<open>A = one_dim_iso A *\<^sub>C id_cblinfun\<close>
     by simp
   have B: \<open>B = one_dim_iso B *\<^sub>C id_cblinfun\<close>
     by simp
   have \<open>A \<ge> B \<longleftrightarrow> (\<forall>\<psi>. cinner \<psi> (A \<psi>) \<ge> cinner \<psi> (B \<psi>))\<close>
     by (simp add: less_eq_cblinfun_def)
   also have \<open>\<dots> \<longleftrightarrow> (\<forall>\<psi>::'a. one_dim_iso B * (\<psi> \<bullet>\<^sub>C \<psi>) \<le> one_dim_iso A * (\<psi> \<bullet>\<^sub>C \<psi>))\<close>
     apply (subst A, subst B)
     by (metis (no_types, opaque_lifting) cinner_scaleC_right id_cblinfun_apply scaleC_cblinfun.rep_eq)
   also have \<open>\<dots> \<longleftrightarrow> one_dim_iso A \<ge> (one_dim_iso B :: complex)\<close>
     by (auto intro!: mult_right_mono elim!: allE[where x=1])
   finally show ?thesis
     by -
 qed
 
 lemma one_dim_positive: \<open>A \<ge> 0 \<longleftrightarrow> one_dim_iso A \<ge> (0::complex)\<close> for A :: \<open>'a \<Rightarrow>\<^sub>C\<^sub>L 'a::{chilbert_space, one_dim}\<close>
   using one_dim_loewner_order[where B=0] by auto
 
 lemma op_square_nondegenerate: \<open>a = 0\<close> if \<open>a* o\<^sub>C\<^sub>L a = 0\<close>
 proof (rule cblinfun_eq_0_on_UNIV_span[where basis=UNIV]; simp)
   fix s
   from that have \<open>s \<bullet>\<^sub>C ((a* o\<^sub>C\<^sub>L a) *\<^sub>V s) = 0\<close>
     by simp
   then have \<open>(a *\<^sub>V s) \<bullet>\<^sub>C (a *\<^sub>V s) = 0\<close>
     by (simp add: cinner_adj_right)
   then show \<open>a *\<^sub>V s = 0\<close>
     by simp
 qed
 
 lemma comparable_hermitean:
   assumes \<open>a \<le> b\<close>
   assumes \<open>a* = a\<close>
   shows \<open>b* = b\<close>
   by (smt (verit, best) assms(1) assms(2) cinner_hermitian_real cinner_real_hermiteanI comparable complex_is_real_iff_compare0 less_eq_cblinfun_def)
 
 lemma comparable_hermitean':
   assumes \<open>a \<le> b\<close>
   assumes \<open>b* = b\<close>
   shows \<open>a* = a\<close>
   by (smt (verit, best) assms(1) assms(2) cinner_hermitian_real cinner_real_hermiteanI comparable complex_is_real_iff_compare0 less_eq_cblinfun_def)
 
 lemma Proj_mono: \<open>Proj S \<le> Proj T \<longleftrightarrow> S \<le> T\<close>
 proof (rule iffI)
   assume \<open>S \<le> T\<close>
   define D where \<open>D = Proj T - Proj S\<close>
   from \<open>S \<le> T\<close> have TS_S[simp]: \<open>Proj T o\<^sub>C\<^sub>L Proj S = Proj S\<close>
     by (smt (verit, ccfv_threshold) Proj_idempotent Proj_range cblinfun_apply_cblinfun_compose cblinfun_apply_in_image cblinfun_eqI cblinfun_fixes_range less_eq_ccsubspace.rep_eq subset_iff)
   then have ST_S[simp]: \<open>Proj S o\<^sub>C\<^sub>L Proj T = Proj S\<close>
     by (metis adj_Proj adj_cblinfun_compose)
   have \<open>D* o\<^sub>C\<^sub>L D = D\<close>
     by (simp add: D_def cblinfun_compose_minus_left cblinfun_compose_minus_right adj_minus adj_Proj)
   then have \<open>D \<ge> 0\<close>
     by (metis positive_cblinfun_squareI)
   then show \<open>Proj S \<le> Proj T\<close>
     by (simp add: D_def)
 next
   assume PS_PT: \<open>Proj S \<le> Proj T\<close>
   show \<open>S \<le> T\<close>
   proof (rule ccsubspace_leI_unit)
     fix \<psi> assume \<open>\<psi> \<in> space_as_set S\<close> and [simp]: \<open>norm \<psi> = 1\<close>
     then have \<open>1 = norm (Proj S *\<^sub>V \<psi>)\<close>
       by (simp add: Proj_fixes_image)
     also from PS_PT have \<open>\<dots> \<le> norm (Proj T *\<^sub>V \<psi>)\<close>
       by (metis (no_types, lifting) Proj_idempotent adj_Proj cblinfun_apply_cblinfun_compose cinner_adj_left cnorm_le less_eq_cblinfun_def)
     also have \<open>\<dots> \<le> 1\<close>
       by (metis Proj_is_Proj \<open>norm \<psi> = 1\<close> is_Proj_reduces_norm)
     ultimately have \<open>norm (Proj T *\<^sub>V \<psi>) = 1\<close>
       by auto
     then show \<open>\<psi> \<in> space_as_set T\<close>
       by (simp add: norm_Proj_apply_1)
   qed
 qed
 
 subsection \<open>Embedding vectors to operators\<close>
 
 lift_definition vector_to_cblinfun :: \<open>'a::complex_normed_vector \<Rightarrow> 'b::one_dim \<Rightarrow>\<^sub>C\<^sub>L 'a\<close> is
   \<open>\<lambda>\<psi> \<phi>. one_dim_iso \<phi> *\<^sub>C \<psi>\<close>
   by (simp add: bounded_clinear_scaleC_const)
 
 lemma vector_to_cblinfun_cblinfun_compose[simp]:
   "A  o\<^sub>C\<^sub>L (vector_to_cblinfun \<psi>) = vector_to_cblinfun (A *\<^sub>V \<psi>)"
   apply transfer
   unfolding comp_def bounded_clinear_def clinear_def Vector_Spaces.linear_def
     module_hom_def module_hom_axioms_def
   by simp
 
 lemma vector_to_cblinfun_add: \<open>vector_to_cblinfun (x + y) = vector_to_cblinfun x + vector_to_cblinfun y\<close>
   by transfer (simp add: scaleC_add_right)
 
 lemma norm_vector_to_cblinfun[simp]: "norm (vector_to_cblinfun x) = norm x"
 proof transfer
   have "bounded_clinear (one_dim_iso::'a \<Rightarrow> complex)"
     by simp
   moreover have "onorm (one_dim_iso::'a \<Rightarrow> complex) * norm x = norm x"
     for x :: 'b
     by simp
   ultimately show "onorm (\<lambda>\<phi>. one_dim_iso (\<phi>::'a) *\<^sub>C x) = norm x"
     for x :: 'b
     by (subst onorm_scaleC_left)
 qed
 
 lemma bounded_clinear_vector_to_cblinfun[bounded_clinear]: "bounded_clinear vector_to_cblinfun"
   apply (rule bounded_clinearI[where K=1])
     apply (transfer, simp add: scaleC_add_right)
    apply (transfer, simp add: mult.commute)
   by simp
 
 lemma vector_to_cblinfun_scaleC[simp]:
   "vector_to_cblinfun (a *\<^sub>C \<psi>) = a *\<^sub>C vector_to_cblinfun \<psi>" for a::complex
   by (intro clinear.scaleC bounded_clinear.clinear bounded_clinear_vector_to_cblinfun)
 
 lemma vector_to_cblinfun_apply_one_dim[simp]:
   shows "vector_to_cblinfun \<phi> *\<^sub>V \<gamma> = one_dim_iso \<gamma> *\<^sub>C \<phi>"
   by transfer (rule refl)
 
 lemma vector_to_cblinfun_one_dim_iso[simp]: \<open>vector_to_cblinfun = one_dim_iso\<close>
   by (auto intro!: ext cblinfun_eqI)
 
 lemma vector_to_cblinfun_adj_apply[simp]:
   shows "vector_to_cblinfun \<psi>* *\<^sub>V \<phi> = of_complex (cinner \<psi> \<phi>)"
   by (simp add: cinner_adj_right one_dim_iso_def one_dim_iso_inj)
 
 lemma vector_to_cblinfun_comp_one[simp]:
   "(vector_to_cblinfun s :: 'a::one_dim \<Rightarrow>\<^sub>C\<^sub>L _) o\<^sub>C\<^sub>L 1
      = (vector_to_cblinfun s :: 'b::one_dim \<Rightarrow>\<^sub>C\<^sub>L _)"
   apply (transfer fixing: s)
   by fastforce
 
 lemma vector_to_cblinfun_0[simp]: "vector_to_cblinfun 0 = 0"
   by (metis cblinfun.zero_left cblinfun_compose_zero_left vector_to_cblinfun_cblinfun_compose)
 
 lemma image_vector_to_cblinfun[simp]: "vector_to_cblinfun x *\<^sub>S \<top> = ccspan {x}"
   \<comment> \<open>Not that the general case \<^term>\<open>vector_to_cblinfun x *\<^sub>S S\<close> can be handled by using
       that \<open>S = \<top>\<close> or \<open>S = \<bottom>\<close> by @{thm [source] one_dim_ccsubspace_all_or_nothing}\<close>
 proof transfer
   show "closure (range (\<lambda>\<phi>::'b. one_dim_iso \<phi> *\<^sub>C x)) = closure (cspan {x})"
     for x :: 'a
   proof (rule arg_cong [where f = closure])
     have "k *\<^sub>C x \<in> range (\<lambda>\<phi>. one_dim_iso \<phi> *\<^sub>C x)" for k
       by (smt (z3) id_apply one_dim_iso_id one_dim_iso_idem range_eqI)
     thus "range (\<lambda>\<phi>. one_dim_iso (\<phi>::'b) *\<^sub>C x) = cspan {x}"
       unfolding complex_vector.span_singleton
       by auto
   qed
 qed
 
 lemma vector_to_cblinfun_adj_comp_vector_to_cblinfun[simp]:
   shows "vector_to_cblinfun \<psi>* o\<^sub>C\<^sub>L vector_to_cblinfun \<phi> = cinner \<psi> \<phi> *\<^sub>C id_cblinfun"
 proof -
   have "one_dim_iso \<gamma> *\<^sub>C one_dim_iso (of_complex (\<psi> \<bullet>\<^sub>C \<phi>)) =
     (\<psi> \<bullet>\<^sub>C \<phi>) *\<^sub>C one_dim_iso \<gamma>"
     for \<gamma> :: "'c::one_dim"
     by (metis complex_vector.scale_left_commute of_complex_def one_dim_iso_of_one one_dim_iso_scaleC one_dim_scaleC_1)
   hence "one_dim_iso ((vector_to_cblinfun \<psi>* o\<^sub>C\<^sub>L vector_to_cblinfun \<phi>) *\<^sub>V \<gamma>)
       = one_dim_iso ((cinner \<psi> \<phi> *\<^sub>C id_cblinfun) *\<^sub>V \<gamma>)"
     for \<gamma> :: "'c::one_dim"
     by simp
   hence "((vector_to_cblinfun \<psi>* o\<^sub>C\<^sub>L vector_to_cblinfun \<phi>) *\<^sub>V \<gamma>) = ((cinner \<psi> \<phi> *\<^sub>C id_cblinfun) *\<^sub>V \<gamma>)"
     for \<gamma> :: "'c::one_dim"
     by (rule one_dim_iso_inj)
   thus ?thesis
     using cblinfun_eqI[where x = "vector_to_cblinfun \<psi>* o\<^sub>C\<^sub>L vector_to_cblinfun \<phi>"
         and y = "(\<psi> \<bullet>\<^sub>C \<phi>) *\<^sub>C id_cblinfun"]
     by auto
 qed
 
 lemma isometry_vector_to_cblinfun[simp]:
   assumes "norm x = 1"
   shows "isometry (vector_to_cblinfun x)"
   using assms cnorm_eq_1 isometry_def by force
 
 lemma image_vector_to_cblinfun_adj: 
   assumes \<open>\<psi> \<notin> space_as_set (- S)\<close>
   shows \<open>(vector_to_cblinfun \<psi>)* *\<^sub>S S = \<top>\<close>
 proof -
   from assms obtain \<phi> where \<open>\<phi> \<in> space_as_set S\<close> and \<open>\<not> is_orthogonal \<psi> \<phi>\<close>
     by (metis orthogonal_complementI uminus_ccsubspace.rep_eq)
   have \<open>((vector_to_cblinfun \<psi>)* *\<^sub>S S :: 'b ccsubspace) \<ge> (vector_to_cblinfun \<psi>)* *\<^sub>S ccspan {\<phi>}\<close> (is \<open>_ \<ge> \<dots>\<close>)
     by (simp add: \<open>\<phi> \<in> space_as_set S\<close> cblinfun_image_mono ccspan_leqI)
   also have \<open>\<dots> = ccspan {(vector_to_cblinfun \<psi>)* *\<^sub>V \<phi>}\<close>
     by (auto simp: cblinfun_image_ccspan)
   also have \<open>\<dots> = ccspan {of_complex (\<psi> \<bullet>\<^sub>C \<phi>)}\<close>
     by auto
   also have \<open>\<dots> > \<bottom>\<close>
     by (simp add: \<open>\<psi> \<bullet>\<^sub>C \<phi> \<noteq> 0\<close> flip: bot.not_eq_extremum )
   finally(dual_order.strict_trans1) show ?thesis
     using one_dim_ccsubspace_all_or_nothing bot.not_eq_extremum by auto
 qed
 
 
 lemma image_vector_to_cblinfun_adj': 
   assumes \<open>\<psi> \<noteq> 0\<close>
   shows \<open>(vector_to_cblinfun \<psi>)* *\<^sub>S \<top> = \<top>\<close>
   apply (rule image_vector_to_cblinfun_adj)
   using assms by simp
 
 subsection \<open>Rank-1 operators / butterflies\<close>
 
 definition rank1 where \<open>rank1 A \<longleftrightarrow> (\<exists>\<psi>\<noteq>0. A *\<^sub>S \<top> = ccspan {\<psi>})\<close>
 
 definition "butterfly (s::'a::complex_normed_vector) (t::'b::chilbert_space)
    = vector_to_cblinfun s o\<^sub>C\<^sub>L (vector_to_cblinfun t :: complex \<Rightarrow>\<^sub>C\<^sub>L _)*"
 
 abbreviation "selfbutter s \<equiv> butterfly s s"
 
 lemma butterfly_add_left: \<open>butterfly (a + a') b = butterfly a b + butterfly a' b\<close>
   by (simp add: butterfly_def vector_to_cblinfun_add cbilinear_add_left bounded_cbilinear.add_left bounded_cbilinear_cblinfun_compose)
 
 lemma butterfly_add_right: \<open>butterfly a (b + b') = butterfly a b + butterfly a b'\<close>
   by (simp add: butterfly_def adj_plus vector_to_cblinfun_add cblinfun_compose_add_right)
 
 lemma butterfly_def_one_dim: "butterfly s t = (vector_to_cblinfun s :: 'c::one_dim \<Rightarrow>\<^sub>C\<^sub>L _)
                                           o\<^sub>C\<^sub>L (vector_to_cblinfun t :: 'c \<Rightarrow>\<^sub>C\<^sub>L _)*"
   (is "_ = ?rhs") for s :: "'a::complex_normed_vector" and t :: "'b::chilbert_space"
 proof -
   let ?isoAC = "1 :: 'c \<Rightarrow>\<^sub>C\<^sub>L complex"
   let ?isoCA = "1 :: complex \<Rightarrow>\<^sub>C\<^sub>L 'c"
   let ?vector = "vector_to_cblinfun :: _ \<Rightarrow> ('c \<Rightarrow>\<^sub>C\<^sub>L _)"
 
   have "butterfly s t =
     (?vector s o\<^sub>C\<^sub>L ?isoCA) o\<^sub>C\<^sub>L (?vector t o\<^sub>C\<^sub>L ?isoCA)*"
     unfolding butterfly_def vector_to_cblinfun_comp_one by simp
   also have "\<dots> = ?vector s o\<^sub>C\<^sub>L (?isoCA o\<^sub>C\<^sub>L ?isoCA*) o\<^sub>C\<^sub>L (?vector t)*"
     by (metis (no_types, lifting) cblinfun_compose_assoc adj_cblinfun_compose)
   also have "\<dots> = ?rhs"
     by simp
   finally show ?thesis
     by simp
 qed
 
 lemma butterfly_comp_cblinfun: "butterfly \<psi> \<phi> o\<^sub>C\<^sub>L a = butterfly \<psi> (a* *\<^sub>V \<phi>)"
   unfolding butterfly_def
   by (simp add: cblinfun_compose_assoc flip: vector_to_cblinfun_cblinfun_compose)
 
 lemma cblinfun_comp_butterfly: "a o\<^sub>C\<^sub>L butterfly \<psi> \<phi> = butterfly (a *\<^sub>V \<psi>) \<phi>"
   unfolding butterfly_def
   by (simp add: cblinfun_compose_assoc flip: vector_to_cblinfun_cblinfun_compose)
 
 lemma butterfly_apply[simp]: "butterfly \<psi> \<psi>' *\<^sub>V \<phi> = (\<psi>' \<bullet>\<^sub>C \<phi>) *\<^sub>C \<psi>"
   by (simp add: butterfly_def scaleC_cblinfun.rep_eq)
 
 lemma butterfly_scaleC_left[simp]: "butterfly (c *\<^sub>C \<psi>) \<phi> = c *\<^sub>C butterfly \<psi> \<phi>"
   unfolding butterfly_def vector_to_cblinfun_scaleC scaleC_adj
   by (simp add: cnj_x_x)
 
 lemma butterfly_scaleC_right[simp]: "butterfly \<psi> (c *\<^sub>C \<phi>) = cnj c *\<^sub>C butterfly \<psi> \<phi>"
   unfolding butterfly_def vector_to_cblinfun_scaleC scaleC_adj
   by (simp add: cnj_x_x)
 
 lemma butterfly_scaleR_left[simp]: "butterfly (r *\<^sub>R \<psi>) \<phi> = r *\<^sub>C butterfly \<psi> \<phi>"
   by (simp add: scaleR_scaleC)
 
 lemma butterfly_scaleR_right[simp]: "butterfly \<psi> (r *\<^sub>R \<phi>) = r *\<^sub>C butterfly \<psi> \<phi>"
   by (simp add: butterfly_scaleC_right scaleR_scaleC)
 
 lemma butterfly_adjoint[simp]: "(butterfly \<psi> \<phi>)* = butterfly \<phi> \<psi>"
   unfolding butterfly_def by auto
 
 lemma butterfly_comp_butterfly[simp]: "butterfly \<psi>1 \<psi>2 o\<^sub>C\<^sub>L butterfly \<psi>3 \<psi>4 = (\<psi>2 \<bullet>\<^sub>C \<psi>3) *\<^sub>C butterfly \<psi>1 \<psi>4"
   by (simp add: butterfly_comp_cblinfun)
 
 lemma butterfly_0_left[simp]: "butterfly 0 a = 0"
   by (simp add: butterfly_def)
 
 lemma butterfly_0_right[simp]: "butterfly a 0 = 0"
   by (simp add: butterfly_def)
 
 lemma butterfly_is_rank1:
   assumes \<open>\<phi> \<noteq> 0\<close>
   shows \<open>butterfly \<psi> \<phi> *\<^sub>S \<top> = ccspan {\<psi>}\<close>
   using assms by (simp add: butterfly_def cblinfun_compose_image image_vector_to_cblinfun_adj')
 
 
 lemma rank1_is_butterfly:
   assumes \<open>A *\<^sub>S \<top> = ccspan {\<psi>::_::chilbert_space}\<close>
   shows \<open>\<exists>\<phi>. A = butterfly \<psi> \<phi>\<close>
 proof (rule exI[of _ \<open>A* *\<^sub>V (\<psi> /\<^sub>R (norm \<psi>)\<^sup>2)\<close>], rule cblinfun_eqI)
   fix \<gamma> :: 'b
   from assms have \<open>A *\<^sub>V \<gamma> \<in> space_as_set (ccspan {\<psi>})\<close>
     by (simp flip: assms)
   then obtain c where c: \<open>A *\<^sub>V \<gamma> = c *\<^sub>C \<psi>\<close>
     apply atomize_elim
     apply (auto simp: ccspan.rep_eq)
     by (metis complex_vector.span_breakdown_eq complex_vector.span_empty eq_iff_diff_eq_0 singletonD)
   have \<open>A *\<^sub>V \<gamma> = butterfly \<psi> (\<psi> /\<^sub>R (norm \<psi>)\<^sup>2) *\<^sub>V (A *\<^sub>V \<gamma>)\<close>
     apply (auto simp: c simp flip: scaleC_scaleC)
     by (metis cinner_eq_zero_iff divideC_field_simps(1) power2_norm_eq_cinner scaleC_left_commute scaleC_zero_right)
   also have \<open>\<dots> = (butterfly \<psi> (\<psi> /\<^sub>R (norm \<psi>)\<^sup>2) o\<^sub>C\<^sub>L A) *\<^sub>V \<gamma>\<close>
     by simp
   also have \<open>\<dots> = butterfly \<psi> (A* *\<^sub>V (\<psi> /\<^sub>R (norm \<psi>)\<^sup>2)) *\<^sub>V \<gamma>\<close>
     by (simp add: cinner_adj_left)
   finally show \<open>A *\<^sub>V \<gamma> = \<dots>\<close>
     by -
 qed
 
 lemma zero_not_rank1[simp]: \<open>\<not> rank1 0\<close>
   unfolding rank1_def
   by auto (metis ccspan_superset insert_not_empty singleton_insert_inj_eq space_as_set_bot subset_singletonD)
 
 lemma rank1_iff_butterfly: \<open>rank1 A \<longleftrightarrow> (\<exists>\<psi> \<phi>. A = butterfly \<psi> \<phi>) \<and> A \<noteq> 0\<close>
   for A :: \<open>_::complex_inner \<Rightarrow>\<^sub>C\<^sub>L _::chilbert_space\<close>
 proof (rule iffI)
   assume \<open>rank1 A\<close>
   then obtain \<psi> where \<open>A *\<^sub>S \<top> = ccspan {\<psi>}\<close>
     using rank1_def by auto
   then have \<open>\<exists>\<phi>. A = butterfly \<psi> \<phi>\<close>
     by (rule rank1_is_butterfly)
   moreover from \<open>rank1 A\<close> have \<open>A \<noteq> 0\<close>
     by auto
   ultimately show \<open>(\<exists>\<psi> \<phi>. A = butterfly \<psi> \<phi>) \<and> A \<noteq> 0\<close>
     by auto
 next
   assume asm: \<open>(\<exists>\<psi> \<phi>. A = butterfly \<psi> \<phi>) \<and> A \<noteq> 0\<close>
   then obtain \<psi> \<phi> where A: \<open>A = butterfly \<psi> \<phi>\<close>
     by auto
   from asm have \<open>A \<noteq> 0\<close>
     by simp
   with A have \<open>\<psi> \<noteq> 0\<close> and \<open>\<phi> \<noteq> 0\<close>
     by auto
   then have \<open>butterfly \<psi> \<phi> *\<^sub>S \<top> = ccspan {\<psi>}\<close>
     by (rule_tac butterfly_is_rank1)
   with A \<open>\<psi> \<noteq> 0\<close> show \<open>rank1 A\<close>
     by (auto intro!: exI[of _ \<psi>] simp: rank1_def)
 qed
 
 lemma butterfly_if_rank1: \<open>(\<exists>\<psi> \<phi>. A = butterfly \<psi> \<phi>) \<longleftrightarrow> rank1 A \<or> A = 0\<close>
   for A :: \<open>_::complex_inner \<Rightarrow>\<^sub>C\<^sub>L _::chilbert_space\<close>
   by (metis butterfly_0_left rank1_iff_butterfly)
 
 lemma norm_butterfly: "norm (butterfly \<psi> \<phi>) = norm \<psi> * norm \<phi>"
 proof (cases "\<phi>=0")
   case True
   then show ?thesis by simp
 next
   case False
   show ?thesis
     unfolding norm_cblinfun.rep_eq
     thm onormI[OF _ False]
   proof (rule onormI[OF _ False])
     fix x
 
     have "cmod (\<phi> \<bullet>\<^sub>C x) * norm \<psi> \<le> norm \<psi> * norm \<phi> * norm x"
       by (metis ab_semigroup_mult_class.mult_ac(1) complex_inner_class.Cauchy_Schwarz_ineq2 mult.commute mult_left_mono norm_ge_zero)
     thus "norm (butterfly \<psi> \<phi> *\<^sub>V x) \<le> norm \<psi> * norm \<phi> * norm x"
       by (simp add: power2_eq_square)
 
     show "norm (butterfly \<psi> \<phi> *\<^sub>V \<phi>) = norm \<psi> * norm \<phi> * norm \<phi>"
       by (smt (z3) ab_semigroup_mult_class.mult_ac(1) butterfly_apply mult.commute norm_eq_sqrt_cinner norm_ge_zero norm_scaleC power2_eq_square real_sqrt_abs real_sqrt_eq_iff)
   qed
 qed
 
 lemma bounded_sesquilinear_butterfly[bounded_sesquilinear]: \<open>bounded_sesquilinear (\<lambda>(b::'b::chilbert_space) (a::'a::chilbert_space). butterfly a b)\<close>
 proof standard
   fix a a' :: 'a and b b' :: 'b and r :: complex
   show \<open>butterfly (a + a') b = butterfly a b + butterfly a' b\<close>
     by (rule butterfly_add_left)
   show \<open>butterfly a (b + b') = butterfly a b + butterfly a b'\<close>
     by (rule butterfly_add_right)
   show \<open>butterfly (r *\<^sub>C a) b = r *\<^sub>C butterfly a b\<close>
     by simp
   show \<open>butterfly a (r *\<^sub>C b) = cnj r *\<^sub>C butterfly a b\<close>
     by simp
   show \<open>\<exists>K. \<forall>b a. norm (butterfly a b) \<le> norm b * norm a * K \<close>
     apply (rule exI[of _ 1])
     by (simp add: norm_butterfly)
 qed
 
 lemma inj_selfbutter_upto_phase:
   assumes "selfbutter x = selfbutter y"
   shows "\<exists>c. cmod c = 1 \<and> x = c *\<^sub>C y"
 proof (cases "x = 0")
   case True
   from assms have "y = 0"
     using norm_butterfly
     by (metis True butterfly_0_left divisors_zero norm_eq_zero)
   with True show ?thesis
     using norm_one by fastforce
 next
   case False
   define c where "c = (y \<bullet>\<^sub>C x) / (x \<bullet>\<^sub>C x)"
   have "(x \<bullet>\<^sub>C x) *\<^sub>C x = selfbutter x *\<^sub>V x"
     by (simp add: butterfly_apply)
   also have "\<dots> = selfbutter y *\<^sub>V x"
     using assms by simp
   also have "\<dots> = (y \<bullet>\<^sub>C x) *\<^sub>C y"
     by (simp add: butterfly_apply)
   finally have xcy: "x = c *\<^sub>C y"
     by (simp add: c_def ceq_vector_fraction_iff)
   have "cmod c * norm x = cmod c * norm y"
     using assms norm_butterfly
     by (smt (verit, ccfv_SIG) \<open>(x \<bullet>\<^sub>C x) *\<^sub>C x = selfbutter x *\<^sub>V x\<close> \<open>selfbutter y *\<^sub>V x = (y \<bullet>\<^sub>C x) *\<^sub>C y\<close> cinner_scaleC_right complex_vector.scale_left_commute complex_vector.scale_right_imp_eq mult_cancel_left norm_eq_sqrt_cinner norm_eq_zero scaleC_scaleC xcy)
   also have "cmod c * norm y = norm (c *\<^sub>C y)"
     by simp
   also have "\<dots> = norm x"
     unfolding xcy[symmetric] by simp
   finally have c: "cmod c = 1"
     by (simp add: False)
   from c xcy show ?thesis
     by auto
 qed
 
 lemma butterfly_eq_proj:
   assumes "norm x = 1"
   shows "selfbutter x = proj x"
 proof -
   define B and \<phi> :: "complex \<Rightarrow>\<^sub>C\<^sub>L 'a"
     where "B = selfbutter x" and "\<phi> = vector_to_cblinfun x"
   then have B: "B = \<phi> o\<^sub>C\<^sub>L \<phi>*"
     unfolding butterfly_def by simp
   have \<phi>adj\<phi>: "\<phi>* o\<^sub>C\<^sub>L \<phi> = id_cblinfun"
     using \<phi>_def assms isometry_def isometry_vector_to_cblinfun by blast
   have "B o\<^sub>C\<^sub>L B = \<phi> o\<^sub>C\<^sub>L (\<phi>* o\<^sub>C\<^sub>L \<phi>) o\<^sub>C\<^sub>L \<phi>*"
     by (simp add: B cblinfun_assoc_left(1))
   also have "\<dots> = B"
     unfolding \<phi>adj\<phi> by (simp add: B)
   finally have idem: "B o\<^sub>C\<^sub>L B = B".
   have herm: "B = B*"
     unfolding B by simp
   from idem herm have BProj: "B = Proj (B *\<^sub>S top)"
     by (rule Proj_on_own_range'[symmetric])
   have "B *\<^sub>S top = ccspan {x}"
     by (simp add: B \<phi>_def assms cblinfun_compose_image range_adjoint_isometry)
   with BProj show "B = proj x"
     by simp
 qed
 
 lemma butterfly_sgn_eq_proj:
   shows "selfbutter (sgn x) = proj x"
 proof (cases \<open>x = 0\<close>)
   case True
   then show ?thesis
     by simp
 next
   case False
   then have \<open>selfbutter (sgn x) = proj (sgn x)\<close>
     by (simp add: butterfly_eq_proj norm_sgn)
   also have \<open>ccspan {sgn x} = ccspan {x}\<close>
     by (metis ccspan_singleton_scaleC scaleC_eq_0_iff scaleR_scaleC sgn_div_norm sgn_zero_iff)
   finally show ?thesis
     by -
 qed
 
 lemma butterfly_is_Proj:
   \<open>norm x = 1 \<Longrightarrow> is_Proj (selfbutter x)\<close>
   by (subst butterfly_eq_proj, simp_all)
 
 lemma cspan_butterfly_UNIV:
   assumes \<open>cspan basisA = UNIV\<close>
   assumes \<open>cspan basisB = UNIV\<close>
   assumes \<open>is_ortho_set basisB\<close>
   assumes \<open>\<And>b. b \<in> basisB \<Longrightarrow> norm b = 1\<close>
   shows \<open>cspan {butterfly a b| (a::'a::{complex_normed_vector}) (b::'b::{chilbert_space,cfinite_dim}). a \<in> basisA \<and> b \<in> basisB} = UNIV\<close>
 proof -
   have F: \<open>\<exists>F\<in>{butterfly a b |a b. a \<in> basisA \<and> b \<in> basisB}. \<forall>b'\<in>basisB. F *\<^sub>V b' = (if b' = b then a else 0)\<close>
     if \<open>a \<in> basisA\<close> and \<open>b \<in> basisB\<close> for a b
     apply (rule bexI[where x=\<open>butterfly a b\<close>])
     using assms that by (auto simp: is_ortho_set_def cnorm_eq_1)
   show ?thesis
     apply (rule cblinfun_cspan_UNIV[where basisA=basisB and basisB=basisA])
     using assms apply auto[2]
     using F by (smt (verit, ccfv_SIG) image_iff)
 qed
 
 lemma cindependent_butterfly:
   fixes basisA :: \<open>'a::chilbert_space set\<close> and basisB :: \<open>'b::chilbert_space set\<close>
   assumes \<open>is_ortho_set basisA\<close> \<open>is_ortho_set basisB\<close>
   assumes normA: \<open>\<And>a. a\<in>basisA \<Longrightarrow> norm a = 1\<close> and normB: \<open>\<And>b. b\<in>basisB \<Longrightarrow> norm b = 1\<close>
   shows \<open>cindependent {butterfly a b| a b. a\<in>basisA \<and> b\<in>basisB}\<close>
 proof (unfold complex_vector.independent_explicit_module, intro allI impI, rename_tac T f g)
   fix T :: \<open>('b \<Rightarrow>\<^sub>C\<^sub>L 'a) set\<close> and f :: \<open>'b \<Rightarrow>\<^sub>C\<^sub>L 'a \<Rightarrow> complex\<close> and g :: \<open>'b \<Rightarrow>\<^sub>C\<^sub>L 'a\<close>
   assume \<open>finite T\<close>
   assume T_subset: \<open>T \<subseteq> {butterfly a b |a b. a \<in> basisA \<and> b \<in> basisB}\<close>
   define lin where \<open>lin = (\<Sum>g\<in>T. f g *\<^sub>C g)\<close>
   assume \<open>lin = 0\<close>
   assume \<open>g \<in> T\<close>
   (* To show: f g = 0 *)
   then obtain a b where g: \<open>g = butterfly a b\<close> and [simp]: \<open>a \<in> basisA\<close> \<open>b \<in> basisB\<close>
     using T_subset by auto
 
   have *: "(vector_to_cblinfun a)* *\<^sub>V f g *\<^sub>C g *\<^sub>V b = 0"
     if \<open>g \<in> T - {butterfly a b}\<close> for g
   proof -
     from that
     obtain a' b' where g: \<open>g = butterfly a' b'\<close> and [simp]: \<open>a' \<in> basisA\<close> \<open>b' \<in> basisB\<close>
       using T_subset by auto
     from that have \<open>g \<noteq> butterfly a b\<close> by auto
     with g consider (a) \<open>a\<noteq>a'\<close> | (b) \<open>b\<noteq>b'\<close>
       by auto
     then show \<open>(vector_to_cblinfun a)* *\<^sub>V f g *\<^sub>C g *\<^sub>V b = 0\<close>
     proof cases
       case a
       then show ?thesis
         using  \<open>is_ortho_set basisA\<close> unfolding g
         by (auto simp: is_ortho_set_def butterfly_def scaleC_cblinfun.rep_eq)
     next
       case b
       then show ?thesis
         using  \<open>is_ortho_set basisB\<close> unfolding g
         by (auto simp: is_ortho_set_def butterfly_def scaleC_cblinfun.rep_eq)
     qed
   qed
 
   have \<open>0 = (vector_to_cblinfun a)* *\<^sub>V lin *\<^sub>V b\<close>
     using \<open>lin = 0\<close> by auto
   also have \<open>\<dots> = (\<Sum>g\<in>T. (vector_to_cblinfun a)* *\<^sub>V (f g *\<^sub>C g) *\<^sub>V b)\<close>
     unfolding lin_def
     apply (rule complex_vector.linear_sum)
     by (smt (z3) cblinfun.scaleC_left cblinfun.scaleC_right cblinfun.add_right clinearI plus_cblinfun.rep_eq)
   also have \<open>\<dots> = (\<Sum>g\<in>{butterfly a b}. (vector_to_cblinfun a)* *\<^sub>V (f g *\<^sub>C g) *\<^sub>V b)\<close>
     apply (rule sum.mono_neutral_right)
     using \<open>finite T\<close> * \<open>g \<in> T\<close> g by auto
   also have \<open>\<dots> = (vector_to_cblinfun a)* *\<^sub>V (f g *\<^sub>C g) *\<^sub>V b\<close>
     by (simp add: g)
   also have \<open>\<dots> = f g\<close>
     unfolding g
     using normA normB by (auto simp: butterfly_def scaleC_cblinfun.rep_eq cnorm_eq_1)
   finally show \<open>f g = 0\<close>
     by simp
 qed
 
 lemma clinear_eq_butterflyI:
   fixes F G :: \<open>('a::{chilbert_space,cfinite_dim} \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_inner) \<Rightarrow> 'c::complex_vector\<close>
   assumes "clinear F" and "clinear G"
   assumes \<open>cspan basisA = UNIV\<close> \<open>cspan basisB = UNIV\<close>
   assumes \<open>is_ortho_set basisA\<close> \<open>is_ortho_set basisB\<close>
   assumes "\<And>a b. a\<in>basisA \<Longrightarrow> b\<in>basisB \<Longrightarrow> F (butterfly a b) = G (butterfly a b)"
   assumes \<open>\<And>b. b\<in>basisB \<Longrightarrow> norm b = 1\<close>
   shows "F = G"
   apply (rule complex_vector.linear_eq_on_span[where f=F, THEN ext, rotated 3])
      apply (subst cspan_butterfly_UNIV)
   using assms by auto
 
 lemma sum_butterfly_is_Proj:
   assumes \<open>is_ortho_set E\<close>
   assumes \<open>\<And>e. e\<in>E \<Longrightarrow> norm e = 1\<close>
   shows \<open>is_Proj (\<Sum>e\<in>E. butterfly e e)\<close>
 proof (cases \<open>finite E\<close>)
   case True
   show ?thesis
   proof (rule is_Proj_I)
     show \<open>(\<Sum>e\<in>E. butterfly e e)* = (\<Sum>e\<in>E. butterfly e e)\<close>
       by (simp add: sum_adj)
     have ortho: \<open>f \<noteq> e \<Longrightarrow> e \<in> E \<Longrightarrow> f \<in> E \<Longrightarrow> is_orthogonal f e\<close> for f e
       by (meson assms(1) is_ortho_set_def)
     have unit: \<open>e \<bullet>\<^sub>C e = 1\<close> if \<open>e \<in> E\<close> for e
       using assms(2) cnorm_eq_1 that by blast
     have *: \<open>(\<Sum>f\<in>E. (f \<bullet>\<^sub>C e) *\<^sub>C butterfly f e) = butterfly e e\<close> if \<open>e \<in> E\<close> for e
       apply (subst sum_single[where i=e])
       by (auto intro!: simp: that ortho unit True)
     show \<open>(\<Sum>e\<in>E. butterfly e e) o\<^sub>C\<^sub>L (\<Sum>e\<in>E. butterfly e e) = (\<Sum>e\<in>E. butterfly e e)\<close>
       by (auto simp: * cblinfun_compose_sum_right cblinfun_compose_sum_left)
   qed
 next
   case False
   then show ?thesis
     by simp
 qed
 
 lemma rank1_compose_left: \<open>rank1 (a o\<^sub>C\<^sub>L b)\<close> if \<open>rank1 b\<close> and \<open>a o\<^sub>C\<^sub>L b \<noteq> 0\<close>
 proof -
   from \<open>rank1 b\<close>
   obtain \<psi> where \<open>b *\<^sub>S \<top> = ccspan {\<psi>}\<close>
     using rank1_def by blast
   then have *: \<open>(a o\<^sub>C\<^sub>L b) *\<^sub>S \<top> = ccspan {a \<psi>}\<close>
     by (metis cblinfun_assoc_left(2) cblinfun_image_ccspan image_empty image_insert)
   with \<open>a o\<^sub>C\<^sub>L b \<noteq> 0\<close> have \<open>a \<psi> \<noteq> 0\<close>
     by auto
   with * show \<open>rank1 (a o\<^sub>C\<^sub>L b)\<close>
     using rank1_def by blast
 qed
 
 lemma rank1_compose_right: \<open>rank1 (a o\<^sub>C\<^sub>L b)\<close> if \<open>rank1 a\<close> and \<open>a o\<^sub>C\<^sub>L b \<noteq> 0\<close>
 proof -
   from \<open>rank1 a\<close>
   obtain \<psi> where \<open>a *\<^sub>S \<top> = ccspan {\<psi>}\<close> and \<open>\<psi> \<noteq> 0\<close>
     using rank1_def by blast
   then have *: \<open>(a o\<^sub>C\<^sub>L b) *\<^sub>S \<top> \<le> ccspan {\<psi>}\<close>
     by (metis cblinfun_assoc_left(2) cblinfun_image_mono top_greatest)
   from \<open>a o\<^sub>C\<^sub>L b \<noteq> 0\<close> obtain \<phi> where \<phi>_ab: \<open>\<phi> \<in> space_as_set ((a o\<^sub>C\<^sub>L b) *\<^sub>S \<top>)\<close> and \<open>\<phi> \<noteq> 0\<close>
     by (metis cblinfun.real.zero_left cblinfun_apply_in_image cblinfun_eqI)
   with * have \<open>\<phi> \<in> space_as_set (ccspan {\<psi>})\<close>
     using less_eq_ccsubspace.rep_eq by blast
   with \<open>\<phi> \<noteq> 0\<close> obtain c where \<open>\<phi> = c *\<^sub>C \<psi>\<close> and \<open>c \<noteq> 0\<close>
     apply (simp add: ccspan.rep_eq)
     by (auto simp add: complex_vector.span_singleton)
   with \<phi>_ab have \<open>(a o\<^sub>C\<^sub>L b) *\<^sub>S \<top> \<ge> ccspan {\<psi>}\<close>
     by (metis ccspan_leqI ccspan_singleton_scaleC empty_subsetI insert_subset)
   with * have \<open>(a o\<^sub>C\<^sub>L b) *\<^sub>S \<top> = ccspan {\<psi>}\<close>
     by fastforce
   with \<open>\<psi> \<noteq> 0\<close> show \<open>rank1 (a o\<^sub>C\<^sub>L b)\<close>
     using rank1_def by blast
 qed
 
 lemma rank1_scaleC: \<open>rank1 (c *\<^sub>C a)\<close> if \<open>rank1 a\<close> and \<open>c \<noteq> 0\<close>
   using rank1_compose_left[OF \<open>rank1 a\<close>, where a=\<open>c *\<^sub>C id_cblinfun\<close>]
   using that by force
 
 lemma rank1_uminus: \<open>rank1 (-a)\<close> if \<open>rank1 a\<close>
   using that rank1_scaleC[where c=\<open>-1\<close> and a=a] by simp
 
 lemma rank1_uminus_iff[simp]: \<open>rank1 (-a) \<longleftrightarrow> rank1 a\<close>
   using rank1_uminus by force
 
 lemma rank1_adj: \<open>rank1 (a*)\<close> if \<open>rank1 a\<close>
   for a :: \<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'b::chilbert_space\<close>
   by (metis adj_0 butterfly_adjoint rank1_iff_butterfly that)
 
 lemma rank1_adj_iff[simp]: \<open>rank1 (a*) \<longleftrightarrow> rank1 a\<close>
   for a :: \<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'b::chilbert_space\<close>
   by (metis double_adj rank1_adj)
 
 lemma butterflies_sum_id_finite: \<open>id_cblinfun = (\<Sum>x\<in>B. selfbutter x)\<close> if \<open>is_onb B\<close> for B :: \<open>'a :: {cfinite_dim, chilbert_space} set\<close>
 proof (rule cblinfun_eq_gen_eqI)
   from \<open>is_onb B\<close> show \<open>ccspan B = \<top>\<close>
     by (simp add: is_onb_def)
   from \<open>is_onb B\<close> have \<open>cindependent B\<close>
     by (simp add: is_onb_def is_ortho_set_cindependent)
   then have [simp]: \<open>finite B\<close>
     using cindependent_cfinite_dim_finite by blast
   from \<open>is_onb B\<close>
   have 1: \<open>j \<noteq> b \<Longrightarrow> j \<in> B \<Longrightarrow> is_orthogonal j b\<close> if \<open>b \<in> B\<close> for j b
     using that by (auto simp add: is_onb_def is_ortho_set_def)
   from \<open>is_onb B\<close>
   have 2: \<open>b \<bullet>\<^sub>C b = 1\<close> if \<open>b \<in> B\<close> for b
     using that by (simp add: is_onb_def cnorm_eq_1)
   fix b assume \<open>b \<in> B\<close>
   then show \<open>id_cblinfun *\<^sub>V b = (\<Sum>x\<in>B. selfbutter x) *\<^sub>V b\<close>
     using 1 2 by (simp add: cblinfun.sum_left sum_single[where i=b])
 qed
 
 lemma butterfly_sum_left: \<open>butterfly (\<Sum>i\<in>M. \<psi> i) \<phi> = (\<Sum>i\<in>M. butterfly (\<psi> i) \<phi>)\<close>
   apply (induction M rule:infinite_finite_induct)
   by (auto simp add: butterfly_add_left)
 
 lemma butterfly_sum_right: \<open>butterfly \<psi> (\<Sum>i\<in>M. \<phi> i) = (\<Sum>i\<in>M. butterfly \<psi> (\<phi> i))\<close>
   apply (induction M rule:infinite_finite_induct)
   by (auto simp add: butterfly_add_right)
 
 subsection \<open>Banach-Steinhaus\<close>
 
 theorem cbanach_steinhaus:
   fixes F :: \<open>'c \<Rightarrow> 'a::cbanach \<Rightarrow>\<^sub>C\<^sub>L 'b::complex_normed_vector\<close>
   assumes \<open>\<And>x. \<exists>M. \<forall>n.  norm ((F n) *\<^sub>V x) \<le> M\<close>
   shows  \<open>\<exists>M. \<forall> n. norm (F n) \<le> M\<close>
   using cblinfun_blinfun_transfer[transfer_rule]
   apply fail? (* Clears "current facts" *)
 proof (use assms in transfer)
   fix F :: \<open>'c \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'b\<close> assume \<open>(\<And>x. \<exists>M. \<forall>n. norm (F n *\<^sub>v x) \<le> M)\<close>
   hence \<open>\<And>x. bounded (range (\<lambda>n. blinfun_apply (F n) x))\<close>
     by (metis (no_types, lifting) boundedI rangeE)
   hence \<open>bounded (range F)\<close>
     by (simp add: banach_steinhaus)
   thus  \<open>\<exists>M. \<forall>n. norm (F n) \<le> M\<close>
     by (simp add: bounded_iff)
 qed
 
 subsection \<open>Riesz-representation theorem\<close>
 
-theorem riesz_frechet_representation_cblinfun_existence:
+theorem riesz_representation_cblinfun_existence:
   \<comment> \<open>Theorem 3.4 in \<^cite>\<open>conway2013course\<close>\<close>
   fixes f::\<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L complex\<close>
   shows \<open>\<exists>t. \<forall>x.  f *\<^sub>V x = (t \<bullet>\<^sub>C x)\<close>
-  by transfer (rule riesz_frechet_representation_existence)
-
-lemma riesz_frechet_representation_cblinfun_unique:
+  by transfer (rule riesz_representation_existence)
+
+lemma riesz_representation_cblinfun_unique:
   \<comment> \<open>Theorem 3.4 in \<^cite>\<open>conway2013course\<close>\<close>
   fixes f::\<open>'a::complex_inner \<Rightarrow>\<^sub>C\<^sub>L complex\<close>
   assumes \<open>\<And>x. f *\<^sub>V x = (t \<bullet>\<^sub>C x)\<close>
   assumes \<open>\<And>x. f *\<^sub>V x = (u \<bullet>\<^sub>C x)\<close>
   shows \<open>t = u\<close>
-  using assms by (rule riesz_frechet_representation_unique)
-
-theorem riesz_frechet_representation_cblinfun_norm:
+  using assms by (rule riesz_representation_unique)
+
+theorem riesz_representation_cblinfun_norm:
   includes notation_norm
   fixes f::\<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L complex\<close>
   assumes \<open>\<And>x.  f *\<^sub>V x = (t \<bullet>\<^sub>C x)\<close>
   shows \<open>\<parallel>f\<parallel> = \<parallel>t\<parallel>\<close>
   using assms
 proof transfer
   fix f::\<open>'a \<Rightarrow> complex\<close> and t
   assume \<open>bounded_clinear f\<close> and \<open>\<And>x. f x = (t \<bullet>\<^sub>C x)\<close>
   from  \<open>\<And>x. f x = (t \<bullet>\<^sub>C x)\<close>
   have \<open>(norm (f x)) / (norm x) \<le> norm t\<close>
     for x
   proof(cases \<open>norm x = 0\<close>)
     case True
     thus ?thesis by simp
   next
     case False
     have \<open>norm (f x) = norm ((t \<bullet>\<^sub>C x))\<close>
       using \<open>\<And>x. f x = (t \<bullet>\<^sub>C x)\<close> by simp
     also have \<open>norm (t \<bullet>\<^sub>C x) \<le> norm t * norm x\<close>
       by (simp add: complex_inner_class.Cauchy_Schwarz_ineq2)
     finally have \<open>norm (f x) \<le> norm t * norm x\<close>
       by blast
     thus ?thesis
       by (metis False linordered_field_class.divide_right_mono nonzero_mult_div_cancel_right norm_ge_zero)
   qed
   moreover have \<open>(norm (f t)) / (norm t) = norm t\<close>
   proof(cases \<open>norm t = 0\<close>)
     case True
     thus ?thesis
       by simp
   next
     case False
     have \<open>f t = (t \<bullet>\<^sub>C t)\<close>
       using \<open>\<And>x. f x = (t \<bullet>\<^sub>C x)\<close> by blast
     also have \<open>\<dots> = (norm t)^2\<close>
       by (meson cnorm_eq_square)
     also have \<open>\<dots> = (norm t)*(norm t)\<close>
       by (simp add: power2_eq_square)
     finally have \<open>f t = (norm t)*(norm t)\<close>
       by blast
     thus ?thesis
       by (metis False Re_complex_of_real \<open>\<And>x. f x = cinner t x\<close> cinner_ge_zero complex_of_real_cmod nonzero_divide_eq_eq)
   qed
   ultimately have \<open>Sup {(norm (f x)) / (norm x)| x. True} = norm t\<close>
     by (smt cSup_eq_maximum mem_Collect_eq)
   moreover have \<open>Sup {(norm (f x)) / (norm x)| x. True} = (SUP x. (norm (f x)) / (norm x))\<close>
     by (simp add: full_SetCompr_eq)
   ultimately show \<open>onorm f = norm t\<close>
     by (simp add: onorm_def)
 qed
 
 definition the_riesz_rep :: \<open>('a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L complex) \<Rightarrow> 'a\<close> where
   \<open>the_riesz_rep f = (SOME t. \<forall>x. f *\<^sub>V x = t \<bullet>\<^sub>C x)\<close>
 
 lemma the_riesz_rep[simp]: \<open>the_riesz_rep f \<bullet>\<^sub>C x = f *\<^sub>V x\<close>
   unfolding the_riesz_rep_def
   apply (rule someI2_ex)
-  by (simp_all add: riesz_frechet_representation_cblinfun_existence)
+  by (simp_all add: riesz_representation_cblinfun_existence)
 
 lemma the_riesz_rep_unique:
   assumes \<open>\<And>x. f *\<^sub>V x = t \<bullet>\<^sub>C x\<close>
   shows \<open>t = the_riesz_rep f\<close>
-  using assms riesz_frechet_representation_cblinfun_unique the_riesz_rep by metis
+  using assms riesz_representation_cblinfun_unique the_riesz_rep by metis
 
 lemma the_riesz_rep_scaleC: \<open>the_riesz_rep (c *\<^sub>C f) = cnj c *\<^sub>C the_riesz_rep f\<close>
   apply (rule the_riesz_rep_unique[symmetric])
   by auto
 
 lemma the_riesz_rep_add: \<open>the_riesz_rep (f + g) = the_riesz_rep f + the_riesz_rep g\<close>
   apply (rule the_riesz_rep_unique[symmetric])
   by (auto simp: cinner_add_left cblinfun.add_left)
 
 lemma the_riesz_rep_norm[simp]: \<open>norm (the_riesz_rep f) = norm f\<close>
-  apply (rule riesz_frechet_representation_cblinfun_norm[symmetric])
+  apply (rule riesz_representation_cblinfun_norm[symmetric])
   by simp
 
 lemma bounded_antilinear_the_riesz_rep[bounded_antilinear]: \<open>bounded_antilinear the_riesz_rep\<close>
   by (metis (no_types, opaque_lifting) bounded_antilinear_intro dual_order.refl mult.commute mult_1 the_riesz_rep_add the_riesz_rep_norm the_riesz_rep_scaleC)
 
 lift_definition the_riesz_rep_sesqui :: \<open>('a::complex_normed_vector \<Rightarrow> 'b::chilbert_space \<Rightarrow> complex) \<Rightarrow> ('a \<Rightarrow>\<^sub>C\<^sub>L 'b)\<close> is
   \<open>\<lambda>p. if bounded_sesquilinear p then the_riesz_rep o CBlinfun o p else 0\<close>
   by (metis (mono_tags, lifting) Cblinfun_comp_bounded_sesquilinear bounded_antilinear_o_bounded_antilinear' bounded_antilinear_the_riesz_rep bounded_clinear_0 fun.map_comp)
 
 lemma the_riesz_rep_sesqui_apply:
   assumes \<open>bounded_sesquilinear p\<close>
   shows \<open>(the_riesz_rep_sesqui p *\<^sub>V x) \<bullet>\<^sub>C y = p x y\<close>
   apply (transfer fixing: p x y)
   by (auto simp add: CBlinfun_inverse bounded_sesquilinear_apply_bounded_clinear assms)
 
 subsection \<open>Bidual\<close>
 
 lift_definition bidual_embedding :: \<open>'a::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L (('a \<Rightarrow>\<^sub>C\<^sub>L complex) \<Rightarrow>\<^sub>C\<^sub>L complex)\<close>
   is \<open>\<lambda>x f. f *\<^sub>V x\<close>
   by (simp add: cblinfun.flip)
 
 lemma bidual_embedding_apply[simp]: \<open>(bidual_embedding *\<^sub>V x) *\<^sub>V f = f *\<^sub>V x\<close>
   by (transfer fixing: x f, simp)
 
 lemma bidual_embedding_isometric[simp]: \<open>norm (bidual_embedding *\<^sub>V x) = norm x\<close> for x :: \<open>'a::complex_inner\<close>
 proof -
   define f :: \<open>'a \<Rightarrow>\<^sub>C\<^sub>L complex\<close> where \<open>f = CBlinfun (\<lambda>y. cinner x y)\<close>
   then have [simp]: \<open>f *\<^sub>V y = cinner x y\<close> for y
     by (simp add: bounded_clinear_CBlinfun_apply bounded_clinear_cinner_right)
   then have [simp]: \<open>norm f = norm x\<close>
     apply (auto intro!: norm_cblinfun_eqI[where x=x] simp: power2_norm_eq_cinner[symmetric])
      apply (smt (verit, best) norm_eq_sqrt_cinner norm_ge_zero power2_norm_eq_cinner real_div_sqrt)
     using Cauchy_Schwarz_ineq2 by blast
   show ?thesis
     apply (auto intro!: norm_cblinfun_eqI[where x=f])
      apply (metis norm_eq_sqrt_cinner norm_imp_pos_and_ge real_div_sqrt)
     by (metis norm_cblinfun ordered_field_class.sign_simps(33))
 qed
 
 lemma norm_bidual_embedding[simp]: \<open>norm (bidual_embedding :: 'a::{complex_inner, not_singleton} \<Rightarrow>\<^sub>C\<^sub>L _) = 1\<close>
 proof -
   obtain x :: 'a where [simp]: \<open>norm x = 1\<close>
     by (meson UNIV_not_singleton ex_norm1)
   show ?thesis
     by (auto intro!: norm_cblinfun_eqI[where x=x])
 qed
 
 lemma isometry_bidual_embedding[simp]: \<open>isometry bidual_embedding\<close>
   by (simp add: norm_preserving_isometry)
 
 lemma bidual_embedding_surj[simp]: \<open>surj (bidual_embedding :: 'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L _)\<close>
 proof -
   have \<open>\<exists>y''. \<forall>f. (bidual_embedding *\<^sub>V y'') *\<^sub>V f = y *\<^sub>V f\<close>
     for y :: \<open>('a \<Rightarrow>\<^sub>C\<^sub>L complex) \<Rightarrow>\<^sub>C\<^sub>L complex\<close>
   proof -
     define y' where \<open>y' = CBlinfun (\<lambda>z. cnj (y (cblinfun_cinner_right z)))\<close>
     have y'_apply: \<open>y' z = cnj (y (cblinfun_cinner_right z))\<close> for z
       unfolding y'_def
       apply (subst CBlinfun_inverse)
       by (auto intro!: bounded_linear_intros)
     obtain y'' where \<open>y' z = y'' \<bullet>\<^sub>C z\<close> for z
-      using riesz_frechet_representation_cblinfun_existence by blast
+      using riesz_representation_cblinfun_existence by blast
     then have y'': \<open>z \<bullet>\<^sub>C y'' = cnj (y' z)\<close> for z
       by auto
     have \<open>(bidual_embedding *\<^sub>V y'') *\<^sub>V f = y *\<^sub>V f\<close> for f :: \<open>'a \<Rightarrow>\<^sub>C\<^sub>L complex\<close>
     proof -
       obtain f' where f': \<open>f z = f' \<bullet>\<^sub>C z\<close> for z
-        using riesz_frechet_representation_cblinfun_existence by blast
+        using riesz_representation_cblinfun_existence by blast
       then have f'2: \<open>f = cblinfun_cinner_right f'\<close>
         using cblinfun_apply_inject by force
       show ?thesis
         by (auto simp add: f' f'2 y'' y'_apply)
     qed
     then show ?thesis
       by blast
   qed
   then show ?thesis
     by (metis cblinfun_eqI surj_def)
 qed
 
 subsection \<open>Extension of complex bounded operators\<close>
 
 definition cblinfun_extension where
   "cblinfun_extension S \<phi> = (SOME B. \<forall>x\<in>S. B *\<^sub>V x = \<phi> x)"
 
 definition cblinfun_extension_exists where
   "cblinfun_extension_exists S \<phi> = (\<exists>B. \<forall>x\<in>S. B *\<^sub>V x = \<phi> x)"
 
 lemma cblinfun_extension_existsI:
   assumes "\<And>x. x\<in>S \<Longrightarrow> B *\<^sub>V x = \<phi> x"
   shows "cblinfun_extension_exists S \<phi>"
   using assms cblinfun_extension_exists_def by blast
 
 lemma cblinfun_extension_exists_finite_dim:
   fixes \<phi>::"'a::{complex_normed_vector,cfinite_dim} \<Rightarrow> 'b::complex_normed_vector"
   assumes "cindependent S"
     and "cspan S = UNIV"
   shows "cblinfun_extension_exists S \<phi>"
 proof-
   define f::"'a \<Rightarrow> 'b"
     where "f = complex_vector.construct S \<phi>"
   have "clinear f"
     by (simp add: complex_vector.linear_construct assms linear_construct f_def)
   have "bounded_clinear f"
     using \<open>clinear f\<close> assms by auto
   then obtain B::"'a \<Rightarrow>\<^sub>C\<^sub>L 'b"
     where "B *\<^sub>V x = f x" for x
     using cblinfun_apply_cases by blast
   have "B *\<^sub>V x = \<phi> x"
     if c1: "x\<in>S"
     for x
   proof-
     have "B *\<^sub>V x = f x"
       by (simp add: \<open>\<And>x. B *\<^sub>V x = f x\<close>)
     also have "\<dots> = \<phi> x"
       using assms complex_vector.construct_basis f_def that
       by (simp add: complex_vector.construct_basis)
     finally show?thesis by blast
   qed
   thus ?thesis
     unfolding cblinfun_extension_exists_def
     by blast
 qed
 
 lemma cblinfun_extension_apply:
   assumes "cblinfun_extension_exists S f"
     and "v \<in> S"
   shows "(cblinfun_extension S f) *\<^sub>V v = f v"
   by (smt assms cblinfun_extension_def cblinfun_extension_exists_def tfl_some)
 
 lemma
   fixes f :: \<open>'a::complex_normed_vector \<Rightarrow> 'b::cbanach\<close>
   assumes \<open>csubspace S\<close>
   assumes \<open>closure S = UNIV\<close>
   assumes f_add: \<open>\<And>x y. x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> f (x + y) = f x + f y\<close>
   assumes f_scale: \<open>\<And>c x y. x \<in> S \<Longrightarrow> f (c *\<^sub>C x) = c *\<^sub>C f x\<close>
   assumes bounded: \<open>\<And>x. x \<in> S \<Longrightarrow> norm (f x) \<le> B * norm x\<close>
   shows cblinfun_extension_exists_bounded_dense: \<open>cblinfun_extension_exists S f\<close>
     and cblinfun_extension_norm_bounded_dense: \<open>B \<ge> 0 \<Longrightarrow> norm (cblinfun_extension S f) \<le> B\<close>
 proof -
   define B' where \<open>B' = (if B\<le>0 then 1 else B)\<close>
   then have bounded': \<open>\<And>x. x \<in> S \<Longrightarrow> norm (f x) \<le> B' * norm x\<close>
     using bounded by (metis mult_1 mult_le_0_iff norm_ge_zero order_trans)
   have \<open>B' > 0\<close>
     by (simp add: B'_def)
 
   have \<open>\<exists>xi. (xi \<longlonglongrightarrow> x) \<and> (\<forall>i. xi i \<in> S)\<close> for x
     using assms(2) closure_sequential by blast
   then obtain seq :: \<open>'a \<Rightarrow> nat \<Rightarrow> 'a\<close> where seq_lim: \<open>seq x \<longlonglongrightarrow> x\<close> and seq_S: \<open>seq x i \<in> S\<close> for x i
     apply (atomize_elim, subst all_conj_distrib[symmetric])
     apply (rule choice)
     by auto
   define g where \<open>g x = lim (\<lambda>i. f (seq x i))\<close> for x
   have \<open>Cauchy (\<lambda>i. f (seq x i))\<close> for x
   proof (rule CauchyI)
     fix e :: real assume \<open>e > 0\<close>
     have \<open>Cauchy (seq x)\<close>
       using LIMSEQ_imp_Cauchy seq_lim by blast
     then obtain M where less_eB: \<open>norm (seq x m - seq x n) < e/B'\<close> if \<open>n \<ge> M\<close> and \<open>m \<ge> M\<close> for n m
       by atomize_elim (meson CauchyD \<open>0 < B'\<close> \<open>0 < e\<close> linordered_field_class.divide_pos_pos)
     have \<open>norm (f (seq x m) - f (seq x n)) < e\<close> if \<open>n \<ge> M\<close> and \<open>m \<ge> M\<close> for n m
     proof -
       have \<open>norm (f (seq x m) - f (seq x n)) = norm (f (seq x m - seq x n))\<close>
         using f_add f_scale seq_S
         by (metis add_diff_cancel assms(1) complex_vector.subspace_diff diff_add_cancel)
       also have \<open>\<dots> \<le> B' * norm (seq x m - seq x n)\<close>
         apply (rule bounded')
         by (simp add: assms(1) complex_vector.subspace_diff seq_S)
       also from less_eB have \<open>\<dots> < B' * (e/B')\<close>
         by (meson \<open>0 < B'\<close> linordered_semiring_strict_class.mult_strict_left_mono that)
       also have \<open>\<dots> \<le> e\<close>
         using \<open>0 < B'\<close> by auto
       finally show ?thesis
         by -
     qed
     then show \<open>\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. norm (f (seq x m) - f (seq x n)) < e\<close>
       by auto
   qed
   then have f_seq_lim: \<open>(\<lambda>i. f (seq x i)) \<longlonglongrightarrow> g x\<close> for x
     by (simp add: Cauchy_convergent_iff convergent_LIMSEQ_iff g_def)
   have f_xi_lim: \<open>(\<lambda>i. f (xi i)) \<longlonglongrightarrow> g x\<close> if \<open>xi \<longlonglongrightarrow> x\<close> and \<open>\<And>i. xi i \<in> S\<close> for xi x
   proof -
     from seq_lim that
     have \<open>(\<lambda>i. B' * norm (xi i - seq x i)) \<longlonglongrightarrow> 0\<close>
       by (metis (no_types) \<open>0 < B'\<close> cancel_comm_monoid_add_class.diff_cancel norm_not_less_zero norm_zero tendsto_diff tendsto_norm_zero_iff tendsto_zero_mult_left_iff)
     then have \<open>(\<lambda>i. f (xi i + (-1) *\<^sub>C seq x i)) \<longlonglongrightarrow> 0\<close>
       apply (rule Lim_null_comparison[rotated])
       using bounded' by (simp add: assms(1) complex_vector.subspace_diff seq_S that(2))
     then have \<open>(\<lambda>i. f (xi i) - f (seq x i)) \<longlonglongrightarrow> 0\<close>
       apply (subst (asm) f_add)
         apply (auto simp: that \<open>csubspace S\<close> complex_vector.subspace_neg seq_S)[2]
       apply (subst (asm) f_scale)
       by (auto simp: that \<open>csubspace S\<close> complex_vector.subspace_neg seq_S)
     then show \<open>(\<lambda>i. f (xi i)) \<longlonglongrightarrow> g x\<close>
       using Lim_transform f_seq_lim by fastforce
   qed
   have g_add: \<open>g (x + y) = g x + g y\<close> for x y
   proof -
     obtain xi :: \<open>nat \<Rightarrow> 'a\<close> where \<open>xi \<longlonglongrightarrow> x\<close> and \<open>xi i \<in> S\<close> for i
       using seq_S seq_lim by auto
     obtain yi :: \<open>nat \<Rightarrow> 'a\<close> where \<open>yi \<longlonglongrightarrow> y\<close> and \<open>yi i \<in> S\<close> for i
       using seq_S seq_lim by auto
     have \<open>(\<lambda>i. xi i + yi i) \<longlonglongrightarrow> x + y\<close>
       using \<open>xi \<longlonglongrightarrow> x\<close> \<open>yi \<longlonglongrightarrow> y\<close> tendsto_add by blast
     then have lim1: \<open>(\<lambda>i. f (xi i + yi i)) \<longlonglongrightarrow> g (x + y)\<close>
       by (simp add: \<open>\<And>i. xi i \<in> S\<close> \<open>\<And>i. yi i \<in> S\<close> assms(1) complex_vector.subspace_add f_xi_lim)
     have \<open>(\<lambda>i. f (xi i + yi i)) = (\<lambda>i. f (xi i) + f (yi i))\<close>
       by (simp add: \<open>\<And>i. xi i \<in> S\<close> \<open>\<And>i. yi i \<in> S\<close> f_add)
     also have \<open>\<dots> \<longlonglongrightarrow> g x + g y\<close>
       by (simp add: \<open>\<And>i. xi i \<in> S\<close> \<open>\<And>i. yi i \<in> S\<close> \<open>xi \<longlonglongrightarrow> x\<close> \<open>yi \<longlonglongrightarrow> y\<close> f_xi_lim tendsto_add)
     finally show ?thesis
       using lim1 LIMSEQ_unique by blast
   qed
   have g_scale: \<open>g (c *\<^sub>C x) = c *\<^sub>C g x\<close> for c x
   proof -
     obtain xi :: \<open>nat \<Rightarrow> 'a\<close> where \<open>xi \<longlonglongrightarrow> x\<close> and \<open>xi i \<in> S\<close> for i
       using seq_S seq_lim by auto
     have \<open>(\<lambda>i. c *\<^sub>C xi i) \<longlonglongrightarrow> c *\<^sub>C x\<close>
       using \<open>xi \<longlonglongrightarrow> x\<close> bounded_clinear_scaleC_right clinear_continuous_at isCont_tendsto_compose by blast
     then have lim1: \<open>(\<lambda>i. f (c *\<^sub>C xi i)) \<longlonglongrightarrow> g (c *\<^sub>C x)\<close>
       by (simp add: \<open>\<And>i. xi i \<in> S\<close> assms(1) complex_vector.subspace_scale f_xi_lim)
     have \<open>(\<lambda>i. f (c *\<^sub>C xi i)) = (\<lambda>i. c *\<^sub>C f (xi i))\<close>
       by (simp add: \<open>\<And>i. xi i \<in> S\<close> f_scale)
     also have \<open>\<dots> \<longlonglongrightarrow> c *\<^sub>C g x\<close>
       using \<open>\<And>i. xi i \<in> S\<close> \<open>xi \<longlonglongrightarrow> x\<close> bounded_clinear_scaleC_right clinear_continuous_at f_xi_lim isCont_tendsto_compose by blast
     finally show ?thesis
       using lim1 LIMSEQ_unique by blast
   qed
 
   have [simp]: \<open>f x = g x\<close> if \<open>x \<in> S\<close> for x
   proof -
     have \<open>(\<lambda>_. x) \<longlonglongrightarrow> x\<close>
       by auto
     then have \<open>(\<lambda>_. f x) \<longlonglongrightarrow> g x\<close>
       using that by (rule f_xi_lim)
     then show \<open>f x = g x\<close>
       by (simp add: LIMSEQ_const_iff)
   qed
 
   have g_bounded: \<open>norm (g x) \<le> B' * norm x\<close> for x
   proof -
     obtain xi :: \<open>nat \<Rightarrow> 'a\<close> where \<open>xi \<longlonglongrightarrow> x\<close> and \<open>xi i \<in> S\<close> for i
       using seq_S seq_lim by auto
     then have \<open>(\<lambda>i. f (xi i)) \<longlonglongrightarrow> g x\<close>
       using f_xi_lim by presburger
     then have \<open>(\<lambda>i. norm (f (xi i))) \<longlonglongrightarrow> norm (g x)\<close>
       by (metis tendsto_norm)
     moreover have \<open>(\<lambda>i. B' * norm (xi i)) \<longlonglongrightarrow> B' * norm x\<close>
       by (simp add: \<open>xi \<longlonglongrightarrow> x\<close> tendsto_mult_left tendsto_norm)
     ultimately show \<open>norm (g x) \<le> B' * norm x\<close>
       apply (rule lim_mono[rotated])
       using bounded' using \<open>xi _ \<in> S\<close> by blast
   qed
 
   have \<open>bounded_clinear g\<close>
     using g_add g_scale apply (rule bounded_clinearI[where K=B'])
     using g_bounded by (simp add: ordered_field_class.sign_simps(5))
   then have [simp]: \<open>CBlinfun g *\<^sub>V x = g x\<close> for x
     by (subst CBlinfun_inverse, auto)
 
   show \<open>cblinfun_extension_exists S f\<close>
     apply (rule cblinfun_extension_existsI[where B=\<open>CBlinfun g\<close>])
     by auto
 
   then have \<open>cblinfun_extension S f *\<^sub>V \<psi> = CBlinfun g *\<^sub>V \<psi>\<close> if \<open>\<psi> \<in> S\<close> for \<psi>
     by (simp add: cblinfun_extension_apply that)
 
   then have ext_is_g: \<open>(*\<^sub>V) (cblinfun_extension S f) = g\<close>
     apply (rule_tac ext)
     apply (rule on_closure_eqI[where S=S])
     using  \<open>closure S = UNIV\<close> \<open>bounded_clinear g\<close>
     by (auto simp add: continuous_at_imp_continuous_on clinear_continuous_within)
 
   show \<open>norm (cblinfun_extension S f) \<le> B\<close> if \<open>B \<ge> 0\<close>
   proof (cases \<open>B > 0\<close>)
     case True
     then have \<open>B = B'\<close>
       unfolding B'_def
       by auto
     moreover have *: \<open>norm (cblinfun_extension S f) \<le> B'\<close>
       by (metis ext_is_g \<open>0 < B'\<close> g_bounded norm_cblinfun_bound order_le_less)
     ultimately show ?thesis
       by simp
   next
     case False
     with bounded have \<open>f x = 0\<close> if \<open>x \<in> S\<close> for x
       by (smt (verit) mult_nonpos_nonneg norm_ge_zero norm_le_zero_iff that)
     then have \<open>g x = (\<lambda>_. 0) x\<close> if \<open>x \<in> S\<close> for x
       using that by simp
     then have \<open>g x = 0\<close> for x
       apply (rule on_closure_eqI[where S=S])
       using \<open>closure S = UNIV\<close> \<open>bounded_clinear g\<close>
       by (auto simp add: continuous_at_imp_continuous_on clinear_continuous_within)
     with ext_is_g have \<open>cblinfun_extension S f = 0\<close>
       by (simp add: cblinfun_eqI)
     then show ?thesis
       using that by simp
   qed
 qed
 
 lemma cblinfun_extension_cong:
   assumes \<open>cspan A = cspan B\<close>
   assumes \<open>B \<subseteq> A\<close>
   assumes fg: \<open>\<And>x. x\<in>B \<Longrightarrow> f x = g x\<close>
   assumes \<open>cblinfun_extension_exists A f\<close>
   shows \<open>cblinfun_extension A f = cblinfun_extension B g\<close>
 proof -
   from \<open>cblinfun_extension_exists A f\<close> fg \<open>B \<subseteq> A\<close>
   have \<open>cblinfun_extension_exists B g\<close>
     by (metis assms(2) cblinfun_extension_exists_def subset_eq)
 
   have \<open>(\<forall>x\<in>A. C *\<^sub>V x = f x) \<longleftrightarrow> (\<forall>x\<in>B. C *\<^sub>V x = f x)\<close> for C
     by (smt (verit, ccfv_SIG) assms(1) assms(2) assms(4) cblinfun_eq_on_span cblinfun_extension_exists_def complex_vector.span_eq subset_iff)
   also from fg have \<open>\<dots> C \<longleftrightarrow> (\<forall>x\<in>B. C *\<^sub>V x = g x)\<close> for C
     by auto
   finally show \<open>cblinfun_extension A f = cblinfun_extension B g\<close>
     unfolding cblinfun_extension_def
     by auto
 qed
 
 lemma
   fixes f :: \<open>'a::complex_inner \<Rightarrow> 'b::chilbert_space\<close> and S 
   assumes \<open>is_ortho_set S\<close> and \<open>closure (cspan S) = UNIV\<close>
   assumes ortho_f: \<open>\<And>x y. x\<in>S \<Longrightarrow> y\<in>S \<Longrightarrow> x\<noteq>y \<Longrightarrow> is_orthogonal (f x) (f y)\<close>
   assumes bounded: \<open>\<And>x. x \<in> S \<Longrightarrow> norm (f x) \<le> B * norm x\<close>
   shows cblinfun_extension_exists_ortho: \<open>cblinfun_extension_exists S f\<close>
     and cblinfun_extension_exists_ortho_norm: \<open>B \<ge> 0 \<Longrightarrow> norm (cblinfun_extension S f) \<le> B\<close>
 proof -
   define g where \<open>g = cconstruct S f\<close>
   have \<open>cindependent S\<close>
     using assms(1) is_ortho_set_cindependent by blast
   have g_f: \<open>g x = f x\<close> if \<open>x\<in>S\<close> for x
     unfolding g_def using \<open>cindependent S\<close> that by (rule complex_vector.construct_basis)
   have [simp]: \<open>clinear g\<close>
     unfolding g_def using \<open>cindependent S\<close> by (rule complex_vector.linear_construct)
   then have g_add: \<open>g (x + y) = g x + g y\<close> if \<open>x \<in> cspan S\<close> and \<open>y \<in> cspan S\<close> for x y
     using clinear_iff by blast
   from \<open>clinear g\<close> have g_scale: \<open>g (c *\<^sub>C x) = c *\<^sub>C g x\<close> if \<open>x \<in> cspan S\<close> for x c
     by (simp add: complex_vector.linear_scale)
   moreover have g_bounded: \<open>norm (g x) \<le> abs B * norm x\<close> if \<open>x \<in> cspan S\<close> for x
   proof -
     from that obtain t r where x_sum: \<open>x = (\<Sum>a\<in>t. r a *\<^sub>C a)\<close> and \<open>finite t\<close> and \<open>t \<subseteq> S\<close>
       unfolding complex_vector.span_explicit by auto
     have \<open>(norm (g x))\<^sup>2 = (norm (\<Sum>a\<in>t. r a *\<^sub>C g a))\<^sup>2\<close>
       by (simp add: x_sum complex_vector.linear_sum clinear.scaleC)
     also have \<open>\<dots> = (norm (\<Sum>a\<in>t. r a *\<^sub>C f a))\<^sup>2\<close>
       by (smt (verit) \<open>t \<subseteq> S\<close> g_f in_mono sum.cong)
     also have \<open>\<dots> = (\<Sum>a\<in>t. (norm (r a *\<^sub>C f a))\<^sup>2)\<close>
       using _ \<open>finite t\<close> apply (rule pythagorean_theorem_sum)
       using \<open>t \<subseteq> S\<close> ortho_f in_mono by fastforce
     also have \<open>\<dots> = (\<Sum>a\<in>t. (cmod (r a) * norm (f a))\<^sup>2)\<close>
       by simp
     also have \<open>\<dots> \<le> (\<Sum>a\<in>t. (cmod (r a) * B * norm a)\<^sup>2)\<close>
       apply (rule sum_mono)
       by (metis \<open>t \<subseteq> S\<close> assms(4) in_mono mult_left_mono mult_nonneg_nonneg norm_ge_zero power_mono vector_space_over_itself.scale_scale)
     also have \<open>\<dots> = B\<^sup>2 * (\<Sum>a\<in>t. (norm (r a *\<^sub>C a))\<^sup>2)\<close>
       by (simp add: sum_distrib_left mult.commute vector_space_over_itself.scale_left_commute flip: power_mult_distrib)
     also have \<open>\<dots> = B\<^sup>2 * (norm (\<Sum>a\<in>t. (r a *\<^sub>C a)))\<^sup>2\<close>
       apply (subst pythagorean_theorem_sum)
       using \<open>finite t\<close> by auto (meson \<open>t \<subseteq> S\<close> assms(1) is_ortho_set_def subsetD)
     also have \<open>\<dots> = (abs B * norm x)\<^sup>2\<close>
       by (simp add: power_mult_distrib x_sum)
     finally show \<open>norm (g x) \<le> abs B * norm x\<close>
       by auto
   qed
   
   from g_add g_scale g_bounded
   have extg_exists: \<open>cblinfun_extension_exists (cspan S) g\<close>
     apply (rule_tac cblinfun_extension_exists_bounded_dense[where B=\<open>abs B\<close>])
     using \<open>closure (cspan S) = UNIV\<close> by auto
 
   then show \<open>cblinfun_extension_exists S f\<close>
     by (metis (mono_tags, opaque_lifting) g_f cblinfun_extension_apply cblinfun_extension_existsI complex_vector.span_base)
 
   have norm_extg: \<open>norm (cblinfun_extension (cspan S) g) \<le> B\<close> if \<open>B \<ge> 0\<close>
     apply (rule cblinfun_extension_norm_bounded_dense)
     using g_add g_scale g_bounded \<open>closure (cspan S) = UNIV\<close> that by auto
 
   have extg_extf: \<open>cblinfun_extension (cspan S) g = cblinfun_extension S f\<close>
     apply (rule cblinfun_extension_cong)
     by (auto simp add: complex_vector.span_base g_f extg_exists)
 
   from norm_extg extg_extf
   show \<open>norm (cblinfun_extension S f) \<le> B\<close> if \<open>B \<ge> 0\<close>
     using that by simp
 qed
 
 
 lemma cblinfun_extension_exists_proj:
   fixes f :: \<open>'a::complex_normed_vector \<Rightarrow> 'b::cbanach\<close>
   assumes \<open>csubspace S\<close>
   assumes ex_P: \<open>\<exists>P :: 'a \<Rightarrow>\<^sub>C\<^sub>L 'a. is_Proj P \<and> range P = closure S\<close>
   assumes f_add: \<open>\<And>x y. x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> f (x + y) = f x + f y\<close>
   assumes f_scale: \<open>\<And>c x y. x \<in> S \<Longrightarrow> f (c *\<^sub>C x) = c *\<^sub>C f x\<close>
   assumes bounded: \<open>\<And>x. x \<in> S \<Longrightarrow> norm (f x) \<le> B * norm x\<close>
   shows \<open>cblinfun_extension_exists S f\<close>
     \<comment> \<open>We cannot give a statement about the norm. While there is an extension with norm \<^term>\<open>B\<close>,
         there is no guarantee that \<^term>\<open>cblinfun_extension S f\<close> returns that specific extension since
         the extension is only determined on \<^term>\<open>ccspan S\<close>.\<close>
 proof (cases \<open>B \<ge> 0\<close>)
   case True
   note True[simp]
   obtain P :: \<open>'a \<Rightarrow>\<^sub>C\<^sub>L 'a\<close> where P_proj: \<open>is_Proj P\<close> and P_im: \<open>range P = closure S\<close>
     using ex_P by blast 
   define f' S' where \<open>f' \<psi> = f (P \<psi>)\<close> and \<open>S' = S + space_as_set (kernel P)\<close> for \<psi>
   have PS': \<open>P *\<^sub>V x \<in> S\<close> if \<open>x \<in> S'\<close> for x
   proof -
     obtain x1 x2 where x12: \<open>x = x1 + x2\<close> and x1: \<open>x1 \<in> S\<close> and x2: \<open>x2 \<in> space_as_set (kernel P)\<close>
       using that  S'_def \<open>x \<in> S'\<close> set_plus_elim by blast
     have \<open>P *\<^sub>V x = P *\<^sub>V x1\<close>
       using x2 by (simp add: x12 cblinfun.add_right kernel_memberD)
     also have \<open>\<dots> = x1\<close>
       by (metis (no_types, opaque_lifting) P_im P_proj cblinfun_apply_cblinfun_compose closure_insert image_iff insertI1 insert_absorb is_Proj_idempotent x1)
     also have \<open>\<dots> \<in> S\<close>
       by (fact x1)
     finally show ?thesis
       by -
   qed
   have SS': \<open>S \<subseteq> S'\<close>
     by (metis S'_def ordered_field_class.sign_simps(2) set_zero_plus2 zero_space_as_set)
 
   have \<open>csubspace S'\<close>
     by (simp add: S'_def assms(1) csubspace_set_plus)
   moreover have \<open>closure S' = UNIV\<close>
   proof auto
     fix \<psi>
     have \<open>\<psi> = P \<psi> + (id - P) \<psi>\<close>
       by simp
     also have \<open>\<dots> \<in> closure S + space_as_set (kernel P)\<close>
       by (smt (verit) P_im P_proj calculation cblinfun.real.add_right eq_add_iff is_Proj_idempotent kernel_memberI rangeI set_plus_intro simp_a_oCL_b')
     also have \<open>\<dots> \<subseteq> closure (closure S + space_as_set (kernel P))\<close>
       using closure_subset by blast
     also have \<open>\<dots> = closure (S + space_as_set (kernel P))\<close>
       using closed_sum_closure_left closed_sum_def by blast
     also have \<open>\<dots> = closure S'\<close>
       using S'_def by fastforce
     finally show \<open>\<psi> \<in> closure S'\<close>
       by -
   qed
 
   moreover have \<open>f' (x + y) = f' x + f' y\<close> if \<open>x \<in> S'\<close> and \<open>y \<in> S'\<close> for x y
     using that by (auto simp: f'_def cblinfun.add_right f_add PS')
   moreover have \<open>f' (c *\<^sub>C x) = c *\<^sub>C f' x\<close> if \<open>x \<in> S'\<close> for c x
     using that by (auto simp: f'_def cblinfun.scaleC_right f_scale PS')
   moreover 
   have \<open>norm (f' x) \<le> (B * norm P) * norm x\<close> if \<open>x \<in> S'\<close> for x
   proof -
     have \<open>norm (f' x) \<le> B* norm (P x)\<close>
       by (auto simp: f'_def PS' bounded that)
     also have \<open>\<dots> \<le> B * norm P * norm x\<close>
       by (simp add: mult.assoc mult_left_mono norm_cblinfun)
     finally show ?thesis
       by auto
   qed
 
   ultimately have F_ex: \<open>cblinfun_extension_exists S' f'\<close>
     by (rule cblinfun_extension_exists_bounded_dense)
   define F where \<open>F = cblinfun_extension S' f'\<close>
   have \<open>F \<psi> = f \<psi>\<close> if \<open>\<psi> \<in> S\<close> for \<psi>
   proof -
     from F_ex that SS' have \<open>F \<psi> = f' \<psi>\<close>
       by (auto simp add: F_def cblinfun_extension_apply)
     also have \<open>\<dots> = f (P *\<^sub>V \<psi>)\<close>
       by (simp add: f'_def)
     also have \<open>\<dots> = f \<psi>\<close>
       using P_proj P_im
       apply (transfer fixing: \<psi> S f)
       by (metis closure_subset in_mono is_projection_on_fixes_image is_projection_on_image that)
     finally show ?thesis
       by -
   qed
   then show \<open>cblinfun_extension_exists S f\<close>
     using cblinfun_extension_exists_def by blast
 next
   case False
   then have \<open>S \<subseteq> {0}\<close>
     using bounded by auto (meson norm_ge_zero norm_le_zero_iff order_trans zero_le_mult_iff)
   then show \<open>cblinfun_extension_exists S f\<close>
     apply (rule_tac cblinfun_extension_existsI[where B=0])
     apply auto
     using bounded by fastforce
 qed
 
 lemma cblinfun_extension_exists_hilbert:
   fixes f :: \<open>'a::chilbert_space \<Rightarrow> 'b::cbanach\<close>
   assumes \<open>csubspace S\<close>
   assumes f_add: \<open>\<And>x y. x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> f (x + y) = f x + f y\<close>
   assumes f_scale: \<open>\<And>c x y. x \<in> S \<Longrightarrow> f (c *\<^sub>C x) = c *\<^sub>C f x\<close>
   assumes bounded: \<open>\<And>x. x \<in> S \<Longrightarrow> norm (f x) \<le> B * norm x\<close>
   shows \<open>cblinfun_extension_exists S f\<close>
     \<comment> \<open>We cannot give a statement about the norm. While there is an extension with norm \<^term>\<open>B\<close>,
         there is no guarantee that \<^term>\<open>cblinfun_extension S f\<close> returns that specific extension since
         the extension is only determined on \<^term>\<open>ccspan S\<close>.\<close>
 proof -
   have \<open>\<exists>P. is_Proj P \<and> range ((*\<^sub>V) P) = closure S\<close>
     apply (rule exI[of _ \<open>Proj (ccspan S)\<close>])
     apply (rule conjI)
      by simp (metis Proj_is_Proj Proj_range Proj_range_closed assms(1) cblinfun_image.rep_eq ccspan.rep_eq closure_closed complex_vector.span_eq_iff space_as_set_top)
 
   from assms(1) this assms(2-4)
   show ?thesis
     by (rule cblinfun_extension_exists_proj)
 qed
 
 lemma cblinfun_extension_exists_restrict:
   assumes \<open>B \<subseteq> A\<close>
   assumes \<open>\<And>x. x\<in>B \<Longrightarrow> f x = g x\<close>
   assumes \<open>cblinfun_extension_exists A f\<close>
   shows \<open>cblinfun_extension_exists B g\<close>
   by (metis assms cblinfun_extension_exists_def subset_eq)
 
 subsection \<open>Bijections between different ONBs\<close>
 
 text \<open>Some of the theorems here logically belong into \<^theory>\<open>Complex_Bounded_Operators.Complex_Inner_Product\<close>
   but the proof uses some concepts from the present theory.\<close>
 
 lemma all_ortho_bases_same_card:
   \<comment> \<open>Follows \<^cite>\<open>conway2013course\<close>, Proposition 4.14\<close>
   fixes E F :: \<open>'a::chilbert_space set\<close>
   assumes \<open>is_ortho_set E\<close> \<open>is_ortho_set F\<close> \<open>ccspan E = \<top>\<close> \<open>ccspan F = \<top>\<close>
   shows \<open>\<exists>f. bij_betw f E F\<close>
 proof -
   have \<open>|F| \<le>o |E|\<close> if \<open>infinite E\<close> and
     \<open>is_ortho_set E\<close> \<open>is_ortho_set F\<close> \<open>ccspan E = top\<close> \<open>ccspan F = top\<close> for E F :: \<open>'a set\<close>
   proof -
     define F' where \<open>F' e = {f\<in>F. \<not> is_orthogonal f e}\<close> for e
     have \<open>\<exists>e\<in>E. cinner f e \<noteq> 0\<close> if \<open>f \<in> F\<close> for f
     proof (rule ccontr, simp)
       assume \<open>\<forall>e\<in>E. is_orthogonal f e\<close>
       then have \<open>f \<in> orthogonal_complement E\<close>
         by (simp add: orthogonal_complementI)
       also have \<open>\<dots> = orthogonal_complement (closure (cspan E))\<close>
         using orthogonal_complement_of_closure orthogonal_complement_of_cspan by blast
       also have \<open>\<dots> = space_as_set (- ccspan E)\<close>
         by transfer simp
       also have \<open>\<dots> = space_as_set (- top)\<close>
         by (simp add: \<open>ccspan E = top\<close>)
       also have \<open>\<dots> = {0}\<close>
         by (auto simp add: top_ccsubspace.rep_eq uminus_ccsubspace.rep_eq)
       finally have \<open>f = 0\<close>
         by simp
       with \<open>f \<in> F\<close> \<open>is_ortho_set F\<close> show False
         by (simp add: is_onb_def is_ortho_set_def)
     qed
     then have F'_union: \<open>F = (\<Union>e\<in>E. F' e)\<close>
       unfolding F'_def by auto
     have \<open>countable (F' e)\<close> for e
     proof -
       have \<open>(\<Sum>f\<in>M. (cmod (cinner (sgn f) e))\<^sup>2) \<le> (norm e)\<^sup>2\<close> if \<open>finite M\<close> and \<open>M \<subseteq> F\<close> for M
       proof -
         have [simp]: \<open>is_ortho_set M\<close>
           using \<open>is_ortho_set F\<close> is_ortho_set_antimono that(2) by blast
         have [simp]: \<open>norm (sgn f) = 1\<close> if \<open>f \<in> M\<close> for f
           by (metis \<open>is_ortho_set M\<close> is_ortho_set_def norm_sgn that)
         have \<open>(\<Sum>f\<in>M. (cmod (cinner (sgn f) e))\<^sup>2) = (\<Sum>f\<in>M. (norm ((cinner (sgn f) e) *\<^sub>C sgn f))\<^sup>2)\<close>
           apply (rule sum.cong[OF refl])
           by simp
         also have \<open>\<dots> = (norm (\<Sum>f\<in>M. ((cinner (sgn f) e) *\<^sub>C sgn f)))\<^sup>2\<close>
           apply (rule pythagorean_theorem_sum[symmetric])
           using that by auto (meson \<open>is_ortho_set M\<close> is_ortho_set_def)
         also have \<open>\<dots> = (norm (\<Sum>f\<in>M. proj f e))\<^sup>2\<close>
           by (metis butterfly_apply butterfly_sgn_eq_proj)
         also have \<open>\<dots> = (norm (Proj (ccspan M) e))\<^sup>2\<close>
           apply (rule arg_cong[where f=\<open>\<lambda>x. (norm x)\<^sup>2\<close>])
           using \<open>finite M\<close> \<open>is_ortho_set M\<close> apply induction
            by simp (smt (verit, ccfv_threshold) Proj_orthog_ccspan_insert insertCI is_ortho_set_def plus_cblinfun.rep_eq sum.insert)
         also have \<open>\<dots> \<le> (norm (Proj (ccspan M)) * norm e)\<^sup>2\<close>
           by (auto simp: norm_cblinfun intro!: power_mono)
         also have \<open>\<dots> \<le> (norm e)\<^sup>2\<close>
           apply (rule power_mono)
            apply (metis norm_Proj_leq1 mult_left_le_one_le norm_ge_zero)
           by simp
         finally show ?thesis
           by -
       qed
       then have \<open>(\<lambda>f. (cmod (cinner (sgn f) e))\<^sup>2) abs_summable_on F\<close>
         apply (intro nonneg_bdd_above_summable_on bdd_aboveI)
         by auto
       then have \<open>countable {f \<in> F. (cmod (sgn f \<bullet>\<^sub>C e))\<^sup>2 \<noteq> 0}\<close>
         by (rule abs_summable_countable)
       then have \<open>countable {f \<in> F. \<not> is_orthogonal (sgn f) e}\<close>
         by force
       then have \<open>countable {f \<in> F. \<not> is_orthogonal f e}\<close>
         by force
       then show ?thesis
         unfolding F'_def by simp
     qed
     then have F'_leq: \<open>|F' e| \<le>o natLeq\<close> for e
       using countable_leq_natLeq by auto
 
     from F'_union have \<open>|F| \<le>o |Sigma E F'|\<close> (is \<open>_ \<le>o \<dots>\<close>)
       using card_of_UNION_Sigma by blast
     also have \<open>\<dots> \<le>o |E \<times> (UNIV::nat set)|\<close> (is \<open>_ \<le>o \<dots>\<close>)
       apply (rule card_of_Sigma_mono1)
       using F'_leq
       using card_of_nat ordIso_symmetric ordLeq_ordIso_trans by blast
     also have \<open>\<dots> =o |E| *c natLeq\<close> (is \<open>ordIso2 _ \<dots>\<close>)
       by (metis Field_card_of Field_natLeq card_of_ordIso_subst cprod_def)
     also have \<open>\<dots> =o |E|\<close>
       apply (rule card_prod_omega)
       using that by (simp add: cinfinite_def)
     finally show \<open>|F| \<le>o |E|\<close>
       by -
   qed
   then have infinite: \<open>|E| =o |F|\<close> if \<open>infinite E\<close> and \<open>infinite F\<close>
     by (simp add: assms ordIso_iff_ordLeq that(1) that(2))
 
   have \<open>|E| =o |F|\<close> if \<open>finite E\<close> and \<open>is_ortho_set E\<close> \<open>is_ortho_set F\<close> \<open>ccspan E = top\<close> \<open>ccspan F = top\<close>
     for E F :: \<open>'a set\<close>
   proof -
     have \<open>card E = card F\<close>
       using that 
       by (metis bij_betw_same_card ccspan.rep_eq closure_finite_cspan complex_vector.bij_if_span_eq_span_bases 
           complex_vector.independent_span_bound is_ortho_set_cindependent top_ccsubspace.rep_eq top_greatest)
     with \<open>finite E\<close> have \<open>finite F\<close>
       by (metis ccspan.rep_eq closure_finite_cspan complex_vector.independent_span_bound is_ortho_set_cindependent that(3) that(4) top_ccsubspace.rep_eq top_greatest)
     with \<open>card E = card F\<close> that show ?thesis
       apply (rule_tac finite_card_of_iff_card[THEN iffD2])
       by auto
   qed
 
   with infinite assms have \<open>|E| =o |F|\<close>
     by (meson ordIso_symmetric)
 
   then show ?thesis
     by (simp add: card_of_ordIso)
 qed
 
 lemma all_onbs_same_card:
   fixes E F :: \<open>'a::chilbert_space set\<close>
   assumes \<open>is_onb E\<close> \<open>is_onb F\<close>
   shows \<open>\<exists>f. bij_betw f E F\<close>
   apply (rule all_ortho_bases_same_card)
   using assms by (auto simp: is_onb_def)
 
 definition bij_between_bases where \<open>bij_between_bases E F = (SOME f. bij_betw f E F)\<close> for E F :: \<open>'a::chilbert_space set\<close>
 
 lemma bij_between_bases_bij:
   fixes E F :: \<open>'a::chilbert_space set\<close>
   assumes \<open>is_onb E\<close> \<open>is_onb F\<close>
   shows \<open>bij_betw (bij_between_bases E F) E F\<close>
   using all_onbs_same_card
   by (metis assms(1) assms(2) bij_between_bases_def someI)
 
 definition unitary_between where \<open>unitary_between E F = cblinfun_extension E (bij_between_bases E F)\<close>
 
 lemma unitary_between_apply:
   fixes E F :: \<open>'a::chilbert_space set\<close>
   assumes \<open>is_onb E\<close> \<open>is_onb F\<close> \<open>e \<in> E\<close>
   shows \<open>unitary_between E F *\<^sub>V e = bij_between_bases E F e\<close>
 proof -
   from \<open>is_onb E\<close> \<open>is_onb F\<close>
   have EF: \<open>bij_between_bases E F e \<in> F\<close> if \<open>e \<in> E\<close> for e
     by (meson bij_betwE bij_between_bases_bij that)
   have ortho: \<open>is_orthogonal (bij_between_bases E F x) (bij_between_bases E F y)\<close> if \<open>x \<noteq> y\<close> and \<open>x \<in> E\<close> and \<open>y \<in> E\<close> for x y
     by (smt (verit, del_insts) assms(1) assms(2) bij_betw_iff_bijections bij_between_bases_bij is_onb_def is_ortho_set_def that(1) that(2) that(3))
   have spanE: \<open>closure (cspan E) = UNIV\<close>
     by (metis assms(1) ccspan.rep_eq is_onb_def top_ccsubspace.rep_eq)
   show ?thesis
     unfolding unitary_between_def
     apply (rule cblinfun_extension_apply)
      apply (rule cblinfun_extension_exists_ortho[where B=1])
     using assms EF ortho spanE
     by (auto simp: is_onb_def)
 qed
 
 lemma unitary_between_unitary:
   fixes E F :: \<open>'a::chilbert_space set\<close>
   assumes \<open>is_onb E\<close> \<open>is_onb F\<close>
   shows \<open>unitary (unitary_between E F)\<close>
 proof -
   have \<open>(unitary_between E F *\<^sub>V b) \<bullet>\<^sub>C (unitary_between E F *\<^sub>V c) = b \<bullet>\<^sub>C c\<close> if \<open>b \<in> E\<close> and \<open>c \<in> E\<close> for b c
   proof (cases \<open>b = c\<close>)
     case True
     from \<open>is_onb E\<close> that have 1: \<open>b \<bullet>\<^sub>C b = 1\<close>
       using cnorm_eq_1 is_onb_def by blast
     from that have \<open>unitary_between E F *\<^sub>V b \<in> F\<close>
       by (metis assms(1) assms(2) bij_betw_apply bij_between_bases_bij unitary_between_apply)
     with \<open>is_onb F\<close> have 2: \<open>(unitary_between E F *\<^sub>V b) \<bullet>\<^sub>C (unitary_between E F *\<^sub>V b) = 1\<close>
       by (simp add: cnorm_eq_1 is_onb_def)
     from 1 2 True show ?thesis
       by simp
   next
     case False
     from \<open>is_onb E\<close> that have 1: \<open>b \<bullet>\<^sub>C c = 0\<close>
       by (simp add: False is_onb_def is_ortho_set_def)
     from that have inF: \<open>unitary_between E F *\<^sub>V b \<in> F\<close> \<open>unitary_between E F *\<^sub>V c \<in> F\<close>
       by (metis assms(1) assms(2) bij_betw_apply bij_between_bases_bij unitary_between_apply)+
     have neq: \<open>unitary_between E F *\<^sub>V b \<noteq> unitary_between E F *\<^sub>V c\<close>
       by (metis (no_types, lifting) False assms(1) assms(2) bij_betw_iff_bijections bij_between_bases_bij that(1) that(2) unitary_between_apply)
     from inF neq \<open>is_onb F\<close> have 2: \<open>(unitary_between E F *\<^sub>V b) \<bullet>\<^sub>C (unitary_between E F *\<^sub>V c) = 0\<close>
       by (simp add: is_onb_def is_ortho_set_def)
     from 1 2 show ?thesis
       by simp
   qed
   then have iso: \<open>isometry (unitary_between E F)\<close>
     apply (rule_tac orthogonal_on_basis_is_isometry[where B=E])
     using assms(1) is_onb_def by auto
   have \<open>unitary_between E F *\<^sub>S top = unitary_between E F *\<^sub>S ccspan E\<close>
     by (metis assms(1) is_onb_def)
   also have \<open>\<dots> \<ge> ccspan (unitary_between E F ` E)\<close> (is \<open>_ \<ge> \<dots>\<close>)
     by (simp add: cblinfun_image_ccspan)
   also have \<open>\<dots> = ccspan (bij_between_bases E F ` E)\<close>
     by (metis assms(1) assms(2) image_cong unitary_between_apply)
   also have \<open>\<dots> = ccspan F\<close>
     by (metis assms(1) assms(2) bij_betw_imp_surj_on bij_between_bases_bij)
   also have \<open>\<dots> = top\<close>
     using assms(2) is_onb_def by blast
   finally have surj: \<open>unitary_between E F *\<^sub>S top = top\<close>
     by (simp add: top.extremum_unique)
   from iso surj show ?thesis
     by (rule surj_isometry_is_unitary)
 qed
 
 
 subsection \<open>Notation\<close>
 
 bundle cblinfun_notation begin
 notation cblinfun_compose (infixl "o\<^sub>C\<^sub>L" 67)
 notation cblinfun_apply (infixr "*\<^sub>V" 70)
 notation cblinfun_image (infixr "*\<^sub>S" 70)
 notation adj ("_*" [99] 100)
 type_notation cblinfun ("(_ \<Rightarrow>\<^sub>C\<^sub>L /_)" [22, 21] 21)
 end
 
 bundle no_cblinfun_notation begin
 no_notation cblinfun_compose (infixl "o\<^sub>C\<^sub>L" 67)
 no_notation cblinfun_apply (infixr "*\<^sub>V" 70)
 no_notation cblinfun_image (infixr "*\<^sub>S" 70)
 no_notation adj ("_*" [99] 100)
 no_type_notation cblinfun ("(_ \<Rightarrow>\<^sub>C\<^sub>L /_)" [22, 21] 21)
 end
 
 unbundle no_cblinfun_notation
 unbundle no_lattice_syntax
 
 end
diff --git a/thys/Complex_Bounded_Operators/Complex_Inner_Product.thy b/thys/Complex_Bounded_Operators/Complex_Inner_Product.thy
--- a/thys/Complex_Bounded_Operators/Complex_Inner_Product.thy
+++ b/thys/Complex_Bounded_Operators/Complex_Inner_Product.thy
@@ -1,2588 +1,2588 @@
 (*
 Authors:
 
   Dominique Unruh, University of Tartu, unruh@ut.ee
   Jose Manuel Rodriguez Caballero, University of Tartu, jose.manuel.rodriguez.caballero@ut.ee
 
 *)
 
 section \<open>\<open>Complex_Inner_Product\<close> -- Complex Inner Product Spaces\<close>
 
 theory Complex_Inner_Product
   imports
     Complex_Inner_Product0
 begin
 
 subsection \<open>Complex inner product spaces\<close>
 
 unbundle cinner_syntax
 
 lemma cinner_real: "cinner x x \<in> \<real>"
   by (simp add: cdot_square_norm)
 
 lemmas cinner_commute' [simp] = cinner_commute[symmetric]
 
 lemma (in complex_inner) cinner_eq_flip: \<open>(cinner x y = cinner z w) \<longleftrightarrow> (cinner y x = cinner w z)\<close>
   by (metis cinner_commute)
 
 lemma Im_cinner_x_x[simp]: "Im (x \<bullet>\<^sub>C x) = 0"
   using comp_Im_same[OF cinner_ge_zero] by simp
 
 
 lemma of_complex_inner_1' [simp]:
   "cinner (1 :: 'a :: {complex_inner, complex_normed_algebra_1}) (of_complex x) = x"
   by (metis cinner_commute complex_cnj_cnj of_complex_inner_1)
 
 
 class chilbert_space = complex_inner + complete_space
 begin
 subclass cbanach by standard
 end
 
 instantiation complex :: "chilbert_space" begin
 instance ..
 end
 
 subsection \<open>Misc facts\<close>
 
 lemma cinner_scaleR_left [simp]: "cinner (scaleR r x) y = of_real r * (cinner x y)"
   by (simp add: scaleR_scaleC)
 
 lemma cinner_scaleR_right [simp]: "cinner x (scaleR r y) = of_real r * (cinner x y)"
   by (simp add: scaleR_scaleC)
 
 text \<open>This is a useful rule for establishing the equality of vectors\<close>
 lemma cinner_extensionality:
   assumes \<open>\<And>\<gamma>. \<gamma> \<bullet>\<^sub>C \<psi> = \<gamma> \<bullet>\<^sub>C \<phi>\<close>
   shows \<open>\<psi> = \<phi>\<close>
   by (metis assms cinner_eq_zero_iff cinner_simps(3) right_minus_eq)
 
 lemma polar_identity:
   includes notation_norm
   shows \<open>\<parallel>x + y\<parallel>^2 = \<parallel>x\<parallel>^2 + \<parallel>y\<parallel>^2 + 2 * Re (x \<bullet>\<^sub>C y)\<close>
     \<comment> \<open>Shown in the proof of Corollary 1.5 in \<^cite>\<open>conway2013course\<close>\<close>
 proof -
   have \<open>(x \<bullet>\<^sub>C y) + (y \<bullet>\<^sub>C x) = (x \<bullet>\<^sub>C y) + cnj (x \<bullet>\<^sub>C y)\<close>
     by simp
   hence \<open>(x \<bullet>\<^sub>C y) + (y \<bullet>\<^sub>C x) = 2 * Re (x \<bullet>\<^sub>C y) \<close>
     using complex_add_cnj by presburger
   have \<open>\<parallel>x + y\<parallel>^2 = (x+y) \<bullet>\<^sub>C (x+y)\<close>
     by (simp add: cdot_square_norm)
   hence \<open>\<parallel>x + y\<parallel>^2 = (x \<bullet>\<^sub>C x) + (x \<bullet>\<^sub>C y) + (y \<bullet>\<^sub>C x) + (y \<bullet>\<^sub>C y)\<close>
     by (simp add: cinner_add_left cinner_add_right)
   thus ?thesis using  \<open>(x \<bullet>\<^sub>C y) + (y \<bullet>\<^sub>C x) = 2 * Re (x \<bullet>\<^sub>C y)\<close>
     by (smt (verit, ccfv_SIG) Re_complex_of_real plus_complex.simps(1) power2_norm_eq_cinner')
 qed
 
 lemma polar_identity_minus:
   includes notation_norm
   shows \<open>\<parallel>x - y\<parallel>^2 = \<parallel>x\<parallel>^2 + \<parallel>y\<parallel>^2 - 2 * Re (x \<bullet>\<^sub>C y)\<close>
 proof-
   have \<open>\<parallel>x + (-y)\<parallel>^2 = \<parallel>x\<parallel>^2 + \<parallel>-y\<parallel>^2 + 2 * Re (x \<bullet>\<^sub>C -y)\<close>
     using polar_identity by blast
   hence \<open>\<parallel>x - y\<parallel>^2 = \<parallel>x\<parallel>^2 + \<parallel>y\<parallel>^2 - 2*Re (x \<bullet>\<^sub>C y)\<close>
     by simp
   thus ?thesis
     by blast
 qed
 
 proposition parallelogram_law:
   includes notation_norm
   fixes x y :: "'a::complex_inner"
   shows \<open>\<parallel>x+y\<parallel>^2 + \<parallel>x-y\<parallel>^2 = 2*( \<parallel>x\<parallel>^2 + \<parallel>y\<parallel>^2 )\<close>
     \<comment> \<open>Shown in the proof of Theorem 2.3 in \<^cite>\<open>conway2013course\<close>\<close>
   by (simp add: polar_identity_minus polar_identity)
 
 
 theorem pythagorean_theorem:
   includes notation_norm
   shows \<open>(x \<bullet>\<^sub>C y) = 0 \<Longrightarrow> \<parallel> x + y \<parallel>^2 = \<parallel> x \<parallel>^2 + \<parallel> y \<parallel>^2\<close>
     \<comment> \<open>Shown in the proof of Theorem 2.2 in \<^cite>\<open>conway2013course\<close>\<close>
   by (simp add: polar_identity)
 
 lemma pythagorean_theorem_sum:
   assumes q1: "\<And>a a'. a \<in> t \<Longrightarrow> a' \<in> t \<Longrightarrow> a \<noteq> a' \<Longrightarrow> f a \<bullet>\<^sub>C f a' = 0"
     and q2: "finite t"
   shows "(norm  (\<Sum>a\<in>t. f a))^2 = (\<Sum>a\<in>t.(norm (f a))^2)"
 proof (insert q1, use q2 in induction)
   case empty
   show ?case
     by auto
 next
   case (insert x F)
   have r1: "f x \<bullet>\<^sub>C f a = 0"
     if "a \<in> F"
     for a
     using that insert.hyps(2) insert.prems by auto
   have "sum f F = (\<Sum>a\<in>F. f a)"
     by simp
   hence s4: "f x \<bullet>\<^sub>C sum f F = f x \<bullet>\<^sub>C (\<Sum>a\<in>F. f a)"
     by simp
   also have s3: "\<dots> = (\<Sum>a\<in>F. f x \<bullet>\<^sub>C f a)"
     using cinner_sum_right by auto
   also have s2: "\<dots> = (\<Sum>a\<in>F. 0)"
     using r1
     by simp
   also have s1: "\<dots> = 0"
     by simp
   finally have xF_ortho: "f x \<bullet>\<^sub>C sum f F = 0"
     using s2 s3 by auto
   have "(norm (sum f (insert x F)))\<^sup>2 = (norm (f x + sum f F))\<^sup>2"
     by (simp add: insert.hyps(1) insert.hyps(2))
   also have "\<dots> = (norm (f x))\<^sup>2 + (norm (sum f F))\<^sup>2"
     using xF_ortho by (rule pythagorean_theorem)
   also have "\<dots> = (norm (f x))\<^sup>2 + (\<Sum>a\<in>F.(norm (f a))^2)"
     apply (subst insert.IH) using insert.prems by auto
   also have "\<dots> = (\<Sum>a\<in>insert x F.(norm (f a))^2)"
     by (simp add: insert.hyps(1) insert.hyps(2))
   finally show ?case
     by simp
 qed
 
 
 lemma Cauchy_cinner_Cauchy:
   fixes x y :: \<open>nat \<Rightarrow> 'a::complex_inner\<close>
   assumes a1: \<open>Cauchy x\<close> and a2: \<open>Cauchy y\<close>
   shows \<open>Cauchy (\<lambda> n. x n \<bullet>\<^sub>C y n)\<close>
 proof-
   have \<open>bounded (range x)\<close>
     using a1
     by (simp add: Elementary_Metric_Spaces.cauchy_imp_bounded)
   hence b1: \<open>\<exists>M. \<forall>n. norm (x n) < M\<close>
     by (meson bounded_pos_less rangeI)
   have \<open>bounded (range y)\<close>
     using a2
     by (simp add: Elementary_Metric_Spaces.cauchy_imp_bounded)
   hence b2: \<open>\<exists> M. \<forall> n. norm (y n) < M\<close>
     by (meson bounded_pos_less rangeI)
   have \<open>\<exists>M. \<forall>n. norm (x n) < M \<and> norm (y n) < M\<close>
     using b1 b2
     by (metis dual_order.strict_trans linorder_neqE_linordered_idom)
   then obtain M where M1: \<open>\<And>n. norm (x n) < M\<close> and M2: \<open>\<And>n. norm (y n) < M\<close>
     by blast
   have M3: \<open>M > 0\<close>
     by (smt M2 norm_not_less_zero)
   have \<open>\<exists>N. \<forall>n \<ge> N. \<forall>m \<ge> N. norm ( (\<lambda> i. x i \<bullet>\<^sub>C y i) n -  (\<lambda> i. x i \<bullet>\<^sub>C y i) m ) < e\<close>
     if "e > 0" for e
   proof-
     have \<open>e / (2*M) > 0\<close>
       using M3
       by (simp add: that)
     hence \<open>\<exists>N. \<forall>n\<ge>N. \<forall>m\<ge>N. norm (x n - x m) < e / (2*M)\<close>
       using a1
       by (simp add: Cauchy_iff)
     then obtain N1 where N1_def: \<open>\<And>n m. n\<ge>N1 \<Longrightarrow> m\<ge>N1 \<Longrightarrow> norm (x n - x m) < e / (2*M)\<close>
       by blast
     have x1: \<open>\<exists>N. \<forall> n\<ge>N. \<forall> m\<ge>N. norm (y n - y m) < e / (2*M)\<close>
       using a2 \<open>e / (2*M) > 0\<close>
       by (simp add: Cauchy_iff)
     obtain N2 where N2_def: \<open>\<And>n m.  n\<ge>N2 \<Longrightarrow> m\<ge>N2 \<Longrightarrow> norm (y n - y m) < e / (2*M)\<close>
       using x1
       by blast
     define N where N_def: \<open>N = N1 + N2\<close>
     hence \<open>N \<ge> N1\<close>
       by auto
     have \<open>N \<ge> N2\<close>
       using N_def
       by auto
     have \<open>norm (x n \<bullet>\<^sub>C y n - x m \<bullet>\<^sub>C y m) < e\<close>
       if \<open>n \<ge> N\<close> and \<open>m \<ge> N\<close>
       for n m
     proof -
       have \<open>x n \<bullet>\<^sub>C y n - x m \<bullet>\<^sub>C y m = (x n \<bullet>\<^sub>C y n - x m \<bullet>\<^sub>C y n) + (x m \<bullet>\<^sub>C y n - x m \<bullet>\<^sub>C y m)\<close>
         by simp
       hence y1: \<open>norm (x n \<bullet>\<^sub>C y n - x m \<bullet>\<^sub>C y m) \<le> norm (x n \<bullet>\<^sub>C y n - x m \<bullet>\<^sub>C y n)
            + norm (x m \<bullet>\<^sub>C y n - x m \<bullet>\<^sub>C y m)\<close>
         by (metis norm_triangle_ineq)
 
       have \<open>x n \<bullet>\<^sub>C y n - x m \<bullet>\<^sub>C y n = (x n - x m) \<bullet>\<^sub>C y n\<close>
         by (simp add: cinner_diff_left)
       hence \<open>norm (x n \<bullet>\<^sub>C y n - x m \<bullet>\<^sub>C y n) = norm ((x n - x m) \<bullet>\<^sub>C y n)\<close>
         by simp
       moreover have \<open>norm ((x n - x m) \<bullet>\<^sub>C y n) \<le> norm (x n - x m) * norm (y n)\<close>
         using complex_inner_class.Cauchy_Schwarz_ineq2 by blast
       moreover have \<open>norm (y n) < M\<close>
         by (simp add: M2)
       moreover have \<open>norm (x n - x m) < e/(2*M)\<close>
         using \<open>N \<le> m\<close> \<open>N \<le> n\<close> \<open>N1 \<le> N\<close> N1_def by auto
       ultimately have \<open>norm ((x n \<bullet>\<^sub>C y n) - (x m \<bullet>\<^sub>C y n)) < (e/(2*M)) * M\<close>
         by (smt linordered_semiring_strict_class.mult_strict_mono norm_ge_zero)
       moreover have \<open> (e/(2*M)) * M = e/2\<close>
         using \<open>M > 0\<close> by simp
       ultimately have  \<open>norm ((x n \<bullet>\<^sub>C y n) - (x m \<bullet>\<^sub>C y n)) < e/2\<close>
         by simp
       hence y2: \<open>norm (x n \<bullet>\<^sub>C y n - x m \<bullet>\<^sub>C y n) < e/2\<close>
         by blast
       have \<open>x m \<bullet>\<^sub>C y n - x m \<bullet>\<^sub>C y m = x m \<bullet>\<^sub>C (y n - y m)\<close>
         by (simp add: cinner_diff_right)
       hence \<open>norm ((x m \<bullet>\<^sub>C y n) - (x m \<bullet>\<^sub>C y m)) = norm (x m \<bullet>\<^sub>C (y n - y m))\<close>
         by simp
       moreover have \<open>norm (x m \<bullet>\<^sub>C (y n - y m)) \<le> norm (x m) * norm (y n - y m)\<close>
         by (meson complex_inner_class.Cauchy_Schwarz_ineq2)
       moreover have \<open>norm (x m) < M\<close>
         by (simp add: M1)
       moreover have \<open>norm (y n - y m) < e/(2*M)\<close>
         using \<open>N \<le> m\<close> \<open>N \<le> n\<close> \<open>N2 \<le> N\<close> N2_def by auto
       ultimately have \<open>norm ((x m \<bullet>\<^sub>C y n) - (x m \<bullet>\<^sub>C y m)) < M * (e/(2*M))\<close>
         by (smt linordered_semiring_strict_class.mult_strict_mono norm_ge_zero)
       moreover have \<open>M * (e/(2*M)) = e/2\<close>
         using \<open>M > 0\<close> by simp
       ultimately have  \<open>norm ((x m \<bullet>\<^sub>C y n) - (x m \<bullet>\<^sub>C y m)) < e/2\<close>
         by simp
       hence y3: \<open>norm ((x m \<bullet>\<^sub>C y n) - (x m \<bullet>\<^sub>C y m)) < e/2\<close>
         by blast
       show \<open>norm ( (x n \<bullet>\<^sub>C y n) - (x m \<bullet>\<^sub>C y m) ) < e\<close>
         using y1 y2 y3 by simp
     qed
     thus ?thesis by blast
   qed
   thus ?thesis
     by (simp add: CauchyI)
 qed
 
 
 lemma cinner_sup_norm: \<open>norm \<psi> = (SUP \<phi>. cmod (cinner \<phi> \<psi>) / norm \<phi>)\<close>
 proof (rule sym, rule cSup_eq_maximum)
   have \<open>norm \<psi> = cmod (cinner \<psi> \<psi>) / norm \<psi>\<close>
     by (metis norm_eq_sqrt_cinner norm_ge_zero real_div_sqrt)
   then show \<open>norm \<psi> \<in> range (\<lambda>\<phi>. cmod (cinner \<phi> \<psi>) / norm \<phi>)\<close>
     by blast
 next
   fix n assume \<open>n \<in> range (\<lambda>\<phi>. cmod (cinner \<phi> \<psi>) / norm \<phi>)\<close>
   then obtain \<phi> where n\<phi>: \<open>n = cmod (cinner \<phi> \<psi>) / norm \<phi>\<close>
     by auto
   show \<open>n \<le> norm \<psi>\<close>
     unfolding n\<phi>
     by (simp add: complex_inner_class.Cauchy_Schwarz_ineq2 divide_le_eq ordered_field_class.sign_simps(33))
 qed
 
 lemma cinner_sup_onorm:
   fixes A :: \<open>'a::{real_normed_vector,not_singleton} \<Rightarrow> 'b::complex_inner\<close>
   assumes \<open>bounded_linear A\<close>
   shows \<open>onorm A = (SUP (\<psi>,\<phi>). cmod (cinner \<psi> (A \<phi>)) / (norm \<psi> * norm \<phi>))\<close>
 proof (unfold onorm_def, rule cSup_eq_cSup)
   show \<open>bdd_above (range (\<lambda>x. norm (A x) / norm x))\<close>
     by (meson assms bdd_aboveI2 le_onorm)
 next
   fix a
   assume \<open>a \<in> range (\<lambda>\<phi>. norm (A \<phi>) / norm \<phi>)\<close>
   then obtain \<phi> where \<open>a = norm (A \<phi>) / norm \<phi>\<close>
     by auto
   then have \<open>a \<le> cmod (cinner (A \<phi>) (A \<phi>)) / (norm (A \<phi>) * norm \<phi>)\<close>
     apply auto
     by (smt (verit) divide_divide_eq_left norm_eq_sqrt_cinner norm_imp_pos_and_ge real_div_sqrt)
   then show \<open>\<exists>b\<in>range (\<lambda>(\<psi>, \<phi>). cmod (cinner \<psi> (A \<phi>)) / (norm \<psi> * norm \<phi>)). a \<le> b\<close>
     by force
 next
   fix b
   assume \<open>b \<in> range (\<lambda>(\<psi>, \<phi>). cmod (cinner \<psi> (A \<phi>)) / (norm \<psi> * norm \<phi>))\<close>
   then obtain \<psi> \<phi> where b: \<open>b = cmod (cinner \<psi> (A \<phi>)) / (norm \<psi> * norm \<phi>)\<close>
     by auto
   then have \<open>b \<le> norm (A \<phi>) / norm \<phi>\<close>
     apply auto
     by (smt (verit, ccfv_threshold) complex_inner_class.Cauchy_Schwarz_ineq2 division_ring_divide_zero linordered_field_class.divide_right_mono mult_cancel_left1 nonzero_mult_divide_mult_cancel_left2 norm_imp_pos_and_ge ordered_field_class.sign_simps(33) zero_le_divide_iff)
   then show \<open>\<exists>a\<in>range (\<lambda>x. norm (A x) / norm x). b \<le> a\<close>
     by auto
 qed
 
 
 lemma sum_cinner:
   fixes f :: "'a \<Rightarrow> 'b::complex_inner"
   shows "cinner (sum f A) (sum g B) = (\<Sum>i\<in>A. \<Sum>j\<in>B. cinner (f i) (g j))"
   by (simp add: cinner_sum_right cinner_sum_left) (rule sum.swap)
 
 lemma Cauchy_cinner_product_summable':
   fixes a b :: "nat \<Rightarrow> 'a::complex_inner"
   shows \<open>(\<lambda>(x, y). cinner (a x) (b y)) summable_on UNIV \<longleftrightarrow> (\<lambda>(x, y). cinner (a y) (b (x - y))) summable_on {(k, i). i \<le> k}\<close>
 proof -
   have img: \<open>(\<lambda>(k::nat, i). (i, k - i)) ` {(k, i). i \<le> k} = UNIV\<close>
     apply (auto simp: image_def)
     by (metis add.commute add_diff_cancel_right' diff_le_self)
   have inj: \<open>inj_on (\<lambda>(k::nat, i). (i, k - i)) {(k, i). i \<le> k}\<close>
     by (smt (verit, del_insts) Pair_inject case_prodE case_prod_conv eq_diff_iff inj_onI mem_Collect_eq)
 
   have \<open>(\<lambda>(x, y). cinner (a x) (b y)) summable_on UNIV \<longleftrightarrow> (\<lambda>(k, l). cinner (a k) (b l)) summable_on (\<lambda>(k, i). (i, k - i)) ` {(k, i). i \<le> k}\<close>
     by (simp only: img)
   also have \<open>\<dots> \<longleftrightarrow> ((\<lambda>(k, l). cinner (a k) (b l)) \<circ> (\<lambda>(k, i). (i, k - i))) summable_on {(k, i). i \<le> k}\<close>
     using inj by (rule summable_on_reindex)
   also have \<open>\<dots> \<longleftrightarrow> (\<lambda>(x, y). cinner (a y) (b (x - y))) summable_on {(k, i). i \<le> k}\<close>
     by (simp add: o_def case_prod_unfold)
   finally show ?thesis
     by -
 qed
 
 instantiation prod :: (complex_inner, complex_inner) complex_inner
 begin
 
 definition cinner_prod_def:
   "cinner x y = cinner (fst x) (fst y) + cinner (snd x) (snd y)"
 
 instance
 proof
   fix r :: complex
   fix x y z :: "'a::complex_inner \<times> 'b::complex_inner"
   show "cinner x y = cnj (cinner y x)"
     unfolding cinner_prod_def
     by simp
   show "cinner (x + y) z = cinner x z + cinner y z"
     unfolding cinner_prod_def
     by (simp add: cinner_add_left)
   show "cinner (scaleC r x) y = cnj r * cinner x y"
     unfolding cinner_prod_def
     by (simp add: distrib_left)
   show "0 \<le> cinner x x"
     unfolding cinner_prod_def
     by (intro add_nonneg_nonneg cinner_ge_zero)
   show "cinner x x = 0 \<longleftrightarrow> x = 0"
     unfolding cinner_prod_def prod_eq_iff
     by (metis antisym cinner_eq_zero_iff cinner_ge_zero fst_zero le_add_same_cancel2 snd_zero verit_sum_simplify)
   show "norm x = sqrt (cmod (cinner x x))"
     unfolding norm_prod_def cinner_prod_def
     by (metis (no_types, lifting) Re_complex_of_real add_nonneg_nonneg cinner_ge_zero complex_of_real_cmod plus_complex.simps(1) power2_norm_eq_cinner')
 qed
 
 end
 
 lemma sgn_cinner[simp]: \<open>sgn \<psi> \<bullet>\<^sub>C \<psi> = norm \<psi>\<close>
   apply (cases \<open>\<psi> = 0\<close>)
    apply (auto simp: sgn_div_norm)
   by (smt (verit, ccfv_SIG) cinner_scaleR_left cinner_scaleR_right cnorm_eq cnorm_eq_1 complex_of_real_cmod complex_of_real_nn_iff left_inverse mult.right_neutral mult_scaleR_right norm_eq_zero norm_not_less_zero norm_one of_real_def of_real_eq_iff)
 
 instance prod :: (chilbert_space, chilbert_space) chilbert_space..
 
 subsection \<open>Orthogonality\<close>
 
 definition "orthogonal_complement S = {x| x. \<forall>y\<in>S. cinner x y = 0}"
 
 lemma orthogonal_complement_orthoI:
   \<open>x \<in> orthogonal_complement M \<Longrightarrow> y \<in> M \<Longrightarrow> x \<bullet>\<^sub>C y = 0\<close>
   unfolding orthogonal_complement_def by auto
 
 lemma orthogonal_complement_orthoI':
   \<open>x \<in> M \<Longrightarrow> y \<in> orthogonal_complement M \<Longrightarrow> x \<bullet>\<^sub>C y = 0\<close>
   by (metis cinner_commute' complex_cnj_zero orthogonal_complement_orthoI)
 
 lemma orthogonal_complementI:
   \<open>(\<And>x. x \<in> M \<Longrightarrow> y \<bullet>\<^sub>C x = 0) \<Longrightarrow> y \<in> orthogonal_complement M\<close>
   unfolding orthogonal_complement_def
   by simp
 
 abbreviation is_orthogonal::\<open>'a::complex_inner \<Rightarrow> 'a \<Rightarrow> bool\<close>  where
   \<open>is_orthogonal x y \<equiv> x \<bullet>\<^sub>C y = 0\<close>
 
 bundle orthogonal_notation begin
 notation is_orthogonal (infixl "\<bottom>" 69)
 end
 
 bundle no_orthogonal_notation begin
 no_notation is_orthogonal (infixl "\<bottom>" 69)
 end
 
 
 lemma is_orthogonal_sym: "is_orthogonal \<psi> \<phi> = is_orthogonal \<phi> \<psi>"
   by (metis cinner_commute' complex_cnj_zero)
 
 lemma is_orthogonal_sgn_right[simp]: \<open>is_orthogonal e (sgn f) \<longleftrightarrow> is_orthogonal e f\<close>
 proof (cases \<open>f = 0\<close>)
   case True
   then show ?thesis
     by simp
 next
   case False
   have \<open>cinner e (sgn f) = cinner e f / norm f\<close>
     by (simp add: sgn_div_norm divide_inverse scaleR_scaleC)
   moreover have \<open>norm f \<noteq> 0\<close>
     by (simp add: False)
   ultimately show ?thesis
     by force
 qed
 
 lemma is_orthogonal_sgn_left[simp]: \<open>is_orthogonal (sgn e) f \<longleftrightarrow> is_orthogonal e f\<close>
   by (simp add: is_orthogonal_sym)
 
 lemma orthogonal_complement_closed_subspace[simp]:
   "closed_csubspace (orthogonal_complement A)"
   for A :: \<open>('a::complex_inner) set\<close>
 proof (intro closed_csubspace.intro complex_vector.subspaceI)
   fix x y and c
   show \<open>0 \<in> orthogonal_complement A\<close>
     by (rule orthogonal_complementI, simp)
   show \<open>x + y \<in> orthogonal_complement A\<close>
     if \<open>x \<in> orthogonal_complement A\<close> and \<open>y \<in> orthogonal_complement A\<close>
     using that by (auto intro!: orthogonal_complementI dest!: orthogonal_complement_orthoI
         simp add: cinner_add_left)
   show \<open>c *\<^sub>C x \<in> orthogonal_complement A\<close> if \<open>x \<in> orthogonal_complement A\<close>
     using that by (auto intro!: orthogonal_complementI dest!: orthogonal_complement_orthoI)
 
   show "closed (orthogonal_complement A)"
   proof (auto simp add: closed_sequential_limits, rename_tac an a)
     fix an a
     assume ortho: \<open>\<forall>n::nat. an n \<in> orthogonal_complement A\<close>
     assume lim: \<open>an \<longlonglongrightarrow> a\<close>
 
     have \<open>\<forall> y \<in> A. \<forall> n. is_orthogonal y (an n)\<close>
       using orthogonal_complement_orthoI'
       by (simp add: orthogonal_complement_orthoI' ortho)
     moreover have \<open>isCont (\<lambda> x. y \<bullet>\<^sub>C x) a\<close> for y
       using bounded_clinear_cinner_right clinear_continuous_at
       by (simp add: clinear_continuous_at bounded_clinear_cinner_right)
     ultimately have \<open>(\<lambda> n. (\<lambda> v. y \<bullet>\<^sub>C v) (an n)) \<longlonglongrightarrow> (\<lambda> v. y \<bullet>\<^sub>C v) a\<close> for y
       using isCont_tendsto_compose
       by (simp add: isCont_tendsto_compose lim)
     hence  \<open>\<forall> y\<in>A. (\<lambda> n. y \<bullet>\<^sub>C an n) \<longlonglongrightarrow>  y \<bullet>\<^sub>C a\<close>
       by simp
     hence  \<open>\<forall> y\<in>A. (\<lambda> n. 0) \<longlonglongrightarrow>  y \<bullet>\<^sub>C a\<close>
       using \<open>\<forall> y \<in> A. \<forall> n. is_orthogonal y (an n)\<close>
       by fastforce
     hence  \<open>\<forall> y \<in> A. is_orthogonal y a\<close>
       using limI by fastforce
     then show \<open>a \<in> orthogonal_complement A\<close>
       by (simp add: orthogonal_complementI is_orthogonal_sym)
   qed
 qed
 
 lemma orthogonal_complement_zero_intersection:
   assumes "0\<in>M"
   shows \<open>M \<inter> (orthogonal_complement M) = {0}\<close>
 proof -
   have "x=0" if "x\<in>M" and "x\<in>orthogonal_complement M" for x
   proof -
     from that have "is_orthogonal x x"
       unfolding orthogonal_complement_def by auto
     thus "x=0"
       by auto
   qed
   with assms show ?thesis
     unfolding orthogonal_complement_def by auto
 qed
 
 lemma is_orthogonal_closure_cspan:
   assumes "\<And>x y. x \<in> X \<Longrightarrow> y \<in> Y \<Longrightarrow> is_orthogonal x y"
   assumes \<open>x \<in> closure (cspan X)\<close> \<open>y \<in> closure (cspan Y)\<close>
   shows "is_orthogonal x y"
 proof -
   have *: \<open>cinner x y = 0\<close> if \<open>y \<in> Y\<close> for y
     using bounded_antilinear_cinner_left apply (rule bounded_antilinear_eq_on[where G=X])
     using assms that by auto
   show \<open>cinner x y = 0\<close>
     using bounded_clinear_cinner_right apply (rule bounded_clinear_eq_on_closure[where G=Y])
     using * assms by auto
 qed
 
 
 instantiation ccsubspace :: (complex_inner) "uminus"
 begin
 lift_definition uminus_ccsubspace::\<open>'a ccsubspace  \<Rightarrow> 'a ccsubspace\<close>
   is \<open>orthogonal_complement\<close>
   by simp
 
 instance ..
 end
 
 lemma orthocomplement_top[simp]: \<open>- top = (bot :: 'a::complex_inner ccsubspace)\<close>
   \<comment> \<open>For \<^typ>\<open>'a\<close> of sort \<^class>\<open>chilbert_space\<close>, this is covered by @{thm [source] orthocomplemented_lattice_class.compl_top_eq} already.
       But here we give it a wider sort.\<close>
   apply transfer
   by (metis Int_UNIV_left UNIV_I orthogonal_complement_zero_intersection)
 
 instantiation ccsubspace :: (complex_inner) minus begin
 lift_definition minus_ccsubspace :: "'a ccsubspace \<Rightarrow> 'a ccsubspace \<Rightarrow> 'a ccsubspace"
   is "\<lambda>A B. A \<inter> (orthogonal_complement B)"
   by simp
 instance..
 end
 
 definition is_ortho_set :: "'a::complex_inner set \<Rightarrow> bool" where
   \<comment> \<open>Orthogonal set\<close>
   \<open>is_ortho_set S \<longleftrightarrow> (\<forall>x\<in>S. \<forall>y\<in>S. x \<noteq> y \<longrightarrow> (x \<bullet>\<^sub>C y) = 0) \<and> 0 \<notin> S\<close>
 
 definition is_onb where \<open>is_onb E \<longleftrightarrow> is_ortho_set E \<and> (\<forall>b\<in>E. norm b = 1) \<and> ccspan E = top\<close>
 
 lemma is_ortho_set_empty[simp]: "is_ortho_set {}"
   unfolding is_ortho_set_def by auto
 
 lemma is_ortho_set_antimono: \<open>A \<subseteq> B \<Longrightarrow> is_ortho_set B \<Longrightarrow> is_ortho_set A\<close>
   unfolding is_ortho_set_def by auto
 
 lemma orthogonal_complement_of_closure:
   fixes A ::"('a::complex_inner) set"
   shows "orthogonal_complement A = orthogonal_complement (closure A)"
 proof-
   have s1: \<open>is_orthogonal y x\<close>
     if a1: "x \<in> (orthogonal_complement A)"
       and a2: \<open>y \<in> closure A\<close>
     for x y
   proof-
     have \<open>\<forall> y \<in> A. is_orthogonal y x\<close>
       by (simp add: a1 orthogonal_complement_orthoI')
     then obtain yy where \<open>\<forall> n. yy n \<in> A\<close> and \<open>yy \<longlonglongrightarrow> y\<close>
       using a2 closure_sequential by blast
     have \<open>isCont (\<lambda> t. t \<bullet>\<^sub>C x) y\<close>
       by simp
     hence \<open>(\<lambda> n. yy n \<bullet>\<^sub>C x) \<longlonglongrightarrow> y \<bullet>\<^sub>C x\<close>
       using \<open>yy \<longlonglongrightarrow> y\<close> isCont_tendsto_compose
       by fastforce
     hence \<open>(\<lambda> n. 0) \<longlonglongrightarrow> y \<bullet>\<^sub>C x\<close>
       using \<open>\<forall> y \<in> A. is_orthogonal y x\<close>  \<open>\<forall> n. yy n \<in> A\<close> by simp
     thus ?thesis
       using limI by force
   qed
   hence "x \<in> orthogonal_complement (closure A)"
     if a1: "x \<in> (orthogonal_complement A)"
     for x
     using that
     by (meson orthogonal_complementI is_orthogonal_sym)
   moreover have \<open>x \<in> (orthogonal_complement A)\<close>
     if "x \<in> (orthogonal_complement (closure A))"
     for x
     using that
     by (meson closure_subset orthogonal_complement_orthoI orthogonal_complementI subset_eq)
   ultimately show ?thesis by blast
 qed
 
 
 lemma is_orthogonal_closure:
   assumes \<open>\<And>s. s \<in> S \<Longrightarrow> is_orthogonal a  s\<close>
   assumes \<open>x \<in> closure S\<close>
   shows \<open>is_orthogonal a x\<close>
   by (metis assms(1) assms(2) orthogonal_complementI orthogonal_complement_of_closure orthogonal_complement_orthoI)
 
 
 lemma is_orthogonal_cspan:
   assumes a1: "\<And>s. s \<in> S \<Longrightarrow> is_orthogonal a s" and a3: "x \<in> cspan S"
   shows "is_orthogonal a x"
 proof-
   have "\<exists>t r. finite t \<and> t \<subseteq> S \<and> (\<Sum>a\<in>t. r a *\<^sub>C a) = x"
     using complex_vector.span_explicit
     by (smt a3 mem_Collect_eq)
   then obtain t r where b1: "finite t" and b2: "t \<subseteq> S" and b3: "(\<Sum>a\<in>t. r a *\<^sub>C a) = x"
     by blast
   have x1: "is_orthogonal a i"
     if "i\<in>t" for i
     using b2 a1 that by blast
   have  "a \<bullet>\<^sub>C x = a \<bullet>\<^sub>C (\<Sum>i\<in>t. r i *\<^sub>C i)"
     by (simp add: b3)
   also have  "\<dots> = (\<Sum>i\<in>t. r i *\<^sub>C (a \<bullet>\<^sub>C i))"
     by (simp add: cinner_sum_right)
   also have  "\<dots> = 0"
     using x1 by simp
   finally show ?thesis.
 qed
 
 lemma ccspan_leq_ortho_ccspan:
   assumes "\<And>s t. s\<in>S \<Longrightarrow> t\<in>T \<Longrightarrow> is_orthogonal s t"
   shows "ccspan S \<le> - (ccspan T)"
   using assms apply transfer
   by (smt (verit, ccfv_threshold) is_orthogonal_closure is_orthogonal_cspan is_orthogonal_sym orthogonal_complementI subsetI)
 
 lemma double_orthogonal_complement_increasing[simp]:
   shows "M \<subseteq> orthogonal_complement (orthogonal_complement M)"
 proof (rule subsetI)
   fix x assume s1: "x \<in> M"
   have \<open>\<forall> y \<in> (orthogonal_complement M). is_orthogonal x y\<close>
     using s1 orthogonal_complement_orthoI' by auto
   hence \<open>x \<in> orthogonal_complement (orthogonal_complement M)\<close>
     by (simp add: orthogonal_complement_def)
   then show "x \<in> orthogonal_complement (orthogonal_complement M)"
     by blast
 qed
 
 
 lemma orthonormal_basis_of_cspan:
   fixes S::"'a::complex_inner set"
   assumes "finite S"
   shows "\<exists>A. is_ortho_set A \<and> (\<forall>x\<in>A. norm x = 1) \<and> cspan A = cspan S \<and> finite A"
 proof (use assms in induction)
   case empty
   show ?case
     apply (rule exI[of _ "{}"])
     by auto
 next
   case (insert s S)
   from insert.IH
   obtain A where orthoA: "is_ortho_set A" and normA: "\<And>x. x\<in>A \<Longrightarrow> norm x = 1" and spanA: "cspan A = cspan S" and finiteA: "finite A"
     by auto
   show ?case
   proof (cases \<open>s \<in> cspan S\<close>)
     case True
     then have \<open>cspan (insert s S) = cspan S\<close>
       by (simp add: complex_vector.span_redundant)
     with orthoA normA spanA finiteA
     show ?thesis
       by auto
   next
     case False
     obtain a where a_ortho: \<open>\<And>x. x\<in>A \<Longrightarrow> is_orthogonal x a\<close> and sa_span: \<open>s - a \<in> cspan A\<close>
     proof (atomize_elim, use \<open>finite A\<close> \<open>is_ortho_set A\<close> in induction)
       case empty
       then show ?case
         by auto
     next
       case (insert x A)
       then obtain a where orthoA: \<open>\<And>x. x \<in> A \<Longrightarrow> is_orthogonal x a\<close> and sa: \<open>s - a \<in> cspan A\<close>
         by (meson is_ortho_set_antimono subset_insertI)
       define a' where \<open>a' = a - cinner x a *\<^sub>C inverse (cinner x x) *\<^sub>C x\<close>
       have \<open>is_orthogonal x a'\<close>
         unfolding a'_def cinner_diff_right cinner_scaleC_right
         apply (cases \<open>cinner x x = 0\<close>)
         by auto
       have orthoA: \<open>is_orthogonal y a'\<close> if \<open>y \<in> A\<close> for y
         unfolding a'_def cinner_diff_right cinner_scaleC_right
         apply auto by (metis insert.prems insertCI is_ortho_set_def mult_not_zero orthoA that)
       have \<open>s - a' \<in> cspan (insert x A)\<close>
         unfolding a'_def apply auto
         by (metis (no_types, lifting) complex_vector.span_breakdown_eq diff_add_cancel diff_diff_add sa)
       with \<open>is_orthogonal x a'\<close> orthoA
       show ?case
         apply (rule_tac exI[of _ a'])
         by auto
     qed
 
     from False sa_span
     have \<open>a \<noteq> 0\<close>
       unfolding spanA by auto
     define a' where \<open>a' = inverse (norm a) *\<^sub>C a\<close>
     with \<open>a \<noteq> 0\<close> have \<open>norm a' = 1\<close>
       by (simp add: norm_inverse)
     have a: \<open>a = norm a *\<^sub>C a'\<close>
       by (simp add: \<open>a \<noteq> 0\<close> a'_def)
 
     from sa_span spanA
     have a'_span: \<open>a' \<in> cspan (insert s S)\<close>
       unfolding a'_def
       by (metis complex_vector.eq_span_insert_eq complex_vector.span_scale complex_vector.span_superset in_mono insertI1)
     from sa_span
     have s_span: \<open>s \<in> cspan (insert a' A)\<close>
       apply (subst (asm) a)
       using complex_vector.span_breakdown_eq by blast
 
     from \<open>a \<noteq> 0\<close> a_ortho orthoA
     have ortho: "is_ortho_set (insert a' A)"
       unfolding is_ortho_set_def a'_def
       apply auto
       by (meson is_orthogonal_sym)
 
     have span: \<open>cspan (insert a' A) = cspan (insert s S)\<close>
       using a'_span s_span spanA apply auto
        apply (metis (full_types) complex_vector.span_breakdown_eq complex_vector.span_redundant insert_commute s_span)
       by (metis (full_types) complex_vector.span_breakdown_eq complex_vector.span_redundant insert_commute s_span)
 
     show ?thesis
       apply (rule exI[of _ \<open>insert a' A\<close>])
       by (simp add: ortho \<open>norm a' = 1\<close> normA finiteA span)
   qed
 qed
 
 lemma is_ortho_set_cindependent:
   assumes "is_ortho_set A"
   shows "cindependent A"
 proof -
   have "u v = 0"
     if b1: "finite t" and b2: "t \<subseteq> A" and b3: "(\<Sum>v\<in>t. u v *\<^sub>C v) = 0" and b4: "v \<in> t"
     for t u v
   proof -
     have "is_orthogonal v v'" if c1: "v'\<in>t-{v}" for v'
       by (metis DiffE assms b2 b4 insertI1 is_ortho_set_antimono is_ortho_set_def that)
     hence sum0: "(\<Sum>v'\<in>t-{v}. u v' * (v \<bullet>\<^sub>C v')) = 0"
       by simp
     have "v \<bullet>\<^sub>C (\<Sum>v'\<in>t. u v' *\<^sub>C v') = (\<Sum>v'\<in>t. u v' * (v \<bullet>\<^sub>C v'))"
       using b1
       by (metis (mono_tags, lifting) cinner_scaleC_right cinner_sum_right sum.cong)
     also have "\<dots> = u v * (v \<bullet>\<^sub>C v) + (\<Sum>v'\<in>t-{v}. u v' * (v \<bullet>\<^sub>C v'))"
       by (meson b1 b4 sum.remove)
     also have "\<dots> = u v * (v \<bullet>\<^sub>C v)"
       using sum0 by simp
     finally have "v \<bullet>\<^sub>C (\<Sum>v'\<in>t. u v' *\<^sub>C v') =  u v * (v \<bullet>\<^sub>C v)"
       by blast
     hence "u v * (v \<bullet>\<^sub>C v) = 0" using b3 by simp
     moreover have "(v \<bullet>\<^sub>C v) \<noteq> 0"
       using assms is_ortho_set_def b2 b4 by auto
     ultimately show "u v = 0" by simp
   qed
   thus ?thesis using complex_vector.independent_explicit_module
     by (smt cdependent_raw_def)
 qed
 
 
 lemma onb_expansion_finite:
   includes notation_norm
   fixes T::\<open>'a::{complex_inner,cfinite_dim} set\<close>
   assumes a1: \<open>cspan T = UNIV\<close> and a3: \<open>is_ortho_set T\<close>
     and a4: \<open>\<And>t. t\<in>T \<Longrightarrow> \<parallel>t\<parallel> = 1\<close>
   shows \<open>x = (\<Sum>t\<in>T. (t \<bullet>\<^sub>C x) *\<^sub>C t)\<close>
 proof -
   have \<open>finite T\<close>
     apply (rule cindependent_cfinite_dim_finite)
     by (simp add: a3 is_ortho_set_cindependent)
   have \<open>closure (complex_vector.span T)  = complex_vector.span T\<close>
     by (simp add: a1)
   have \<open>{\<Sum>a\<in>t. r a *\<^sub>C a |t r. finite t \<and> t \<subseteq> T} = {\<Sum>a\<in>T. r a *\<^sub>C a |r. True}\<close>
     apply auto
      apply (rule_tac x=\<open>\<lambda>a. if a \<in> t then r a else 0\<close> in exI)
      apply (simp add: \<open>finite T\<close> sum.mono_neutral_cong_right)
     using \<open>finite T\<close> by blast
 
   have f1: "\<forall>A. {a. \<exists>Aa f. (a::'a) = (\<Sum>a\<in>Aa. f a *\<^sub>C a) \<and> finite Aa \<and> Aa \<subseteq> A} = cspan A"
     by (simp add: complex_vector.span_explicit)
   have f2: "\<forall>a. (\<exists>f. a = (\<Sum>a\<in>T. f a *\<^sub>C a)) \<or> (\<forall>A. (\<forall>f. a \<noteq> (\<Sum>a\<in>A. f a *\<^sub>C a)) \<or> infinite A \<or> \<not> A \<subseteq> T)"
     using \<open>{\<Sum>a\<in>t. r a *\<^sub>C a |t r. finite t \<and> t \<subseteq> T} = {\<Sum>a\<in>T. r a *\<^sub>C a |r. True}\<close> by auto
   have f3: "\<forall>A a. (\<exists>Aa f. (a::'a) = (\<Sum>a\<in>Aa. f a *\<^sub>C a) \<and> finite Aa \<and> Aa \<subseteq> A) \<or> a \<notin> cspan A"
     using f1 by blast
   have "cspan T = UNIV"
     by (metis (full_types, lifting)  \<open>complex_vector.span T = UNIV\<close>)
   hence \<open>\<exists> r. x = (\<Sum> a\<in>T. r a *\<^sub>C a)\<close>
     using f3 f2 by blast
   then obtain r where \<open>x = (\<Sum> a\<in>T. r a *\<^sub>C a)\<close>
     by blast
 
   have \<open>r a = a \<bullet>\<^sub>C x\<close> if \<open>a \<in> T\<close> for a
   proof-
     have \<open>norm a = 1\<close>
       using a4
       by (simp add: \<open>a \<in> T\<close>)
     moreover have \<open>norm a = sqrt (norm (a \<bullet>\<^sub>C a))\<close>
       using norm_eq_sqrt_cinner by auto
     ultimately have \<open>sqrt (norm (a \<bullet>\<^sub>C a)) = 1\<close>
       by simp
     hence \<open>norm (a \<bullet>\<^sub>C a) = 1\<close>
       using real_sqrt_eq_1_iff by blast
     moreover have \<open>(a \<bullet>\<^sub>C a) \<in> \<real>\<close>
       by (simp add: cinner_real)
     moreover have \<open>(a \<bullet>\<^sub>C a) \<ge> 0\<close>
       using cinner_ge_zero by blast
     ultimately have w1: \<open>(a \<bullet>\<^sub>C a) = 1\<close>
       by (metis \<open>0 \<le> (a \<bullet>\<^sub>C a)\<close> \<open>cmod (a \<bullet>\<^sub>C a) = 1\<close> complex_of_real_cmod of_real_1)
 
     have \<open>r t * (a \<bullet>\<^sub>C t) = 0\<close> if \<open>t \<in> T-{a}\<close> for t
       by (metis DiffD1 DiffD2 \<open>a \<in> T\<close> a3 is_ortho_set_def mult_eq_0_iff singletonI that)
     hence s1: \<open>(\<Sum> t\<in>T-{a}. r t * (a \<bullet>\<^sub>C t)) = 0\<close>
       by (simp add: \<open>\<And>t. t \<in> T - {a} \<Longrightarrow> r t * (a \<bullet>\<^sub>C t) = 0\<close>)
     have \<open>(a \<bullet>\<^sub>C x) = a \<bullet>\<^sub>C (\<Sum> t\<in>T. r t *\<^sub>C t)\<close>
       using \<open>x = (\<Sum> a\<in>T. r a *\<^sub>C a)\<close>
       by simp
     also have \<open>\<dots> = (\<Sum> t\<in>T. a \<bullet>\<^sub>C (r t *\<^sub>C t))\<close>
       using cinner_sum_right by blast
     also have \<open>\<dots> = (\<Sum> t\<in>T. r t * (a \<bullet>\<^sub>C t))\<close>
       by simp
     also have \<open>\<dots> = r a * (a \<bullet>\<^sub>C a) + (\<Sum> t\<in>T-{a}. r t * (a \<bullet>\<^sub>C t))\<close>
       using \<open>a \<in> T\<close>
       by (meson \<open>finite T\<close> sum.remove)
     also have \<open>\<dots> = r a * (a \<bullet>\<^sub>C a)\<close>
       using s1
       by simp
     also have \<open>\<dots> = r a\<close>
       by (simp add: w1)
     finally show ?thesis by auto
   qed
   thus ?thesis
     using \<open>x = (\<Sum> a\<in>T. r a *\<^sub>C a)\<close>
     by fastforce
 qed
 
 lemma is_ortho_set_singleton[simp]: \<open>is_ortho_set {x} \<longleftrightarrow> x \<noteq> 0\<close>
   by (simp add: is_ortho_set_def)
 
 lemma orthogonal_complement_antimono[simp]:
   fixes  A B :: \<open>('a::complex_inner) set\<close>
   assumes "A \<supseteq> B"
   shows \<open>orthogonal_complement A \<subseteq> orthogonal_complement B\<close>
   by (meson assms orthogonal_complementI orthogonal_complement_orthoI' subsetD subsetI)
 
 lemma orthogonal_complement_UNIV[simp]:
   "orthogonal_complement UNIV = {0}"
   by (metis Int_UNIV_left complex_vector.subspace_UNIV complex_vector.subspace_def orthogonal_complement_zero_intersection)
 
 lemma orthogonal_complement_zero[simp]:
   "orthogonal_complement {0} = UNIV"
   unfolding orthogonal_complement_def by auto
 
 lemma mem_ortho_ccspanI:
   assumes \<open>\<And>y. y \<in> S \<Longrightarrow> is_orthogonal x y\<close>
   shows \<open>x \<in> space_as_set (- ccspan S)\<close>
 proof -
   have \<open>x \<in> space_as_set (ccspan {x})\<close>
     using ccspan_superset by blast
   also have \<open>\<dots> \<subseteq> space_as_set (- ccspan S)\<close>
     apply (simp add: flip: less_eq_ccsubspace.rep_eq)
     apply (rule ccspan_leq_ortho_ccspan)
     using assms by auto
   finally show ?thesis
     by -
 qed
 
 
 subsection \<open>Projections\<close>
 
 lemma smallest_norm_exists:
   \<comment> \<open>Theorem 2.5 in \<^cite>\<open>conway2013course\<close> (inside the proof)\<close>
   includes notation_norm
   fixes M :: \<open>'a::chilbert_space set\<close>
   assumes q1: \<open>convex M\<close> and q2: \<open>closed M\<close> and q3: \<open>M \<noteq> {}\<close>
   shows  \<open>\<exists>k. is_arg_min (\<lambda> x. \<parallel>x\<parallel>) (\<lambda> t. t \<in> M) k\<close>
 proof -
   define d where \<open>d = Inf { \<parallel>x\<parallel>^2 | x. x \<in> M }\<close>
   have w4: \<open>{ \<parallel>x\<parallel>^2 | x. x \<in> M } \<noteq> {}\<close>
     by (simp add: assms(3))
   have \<open>\<forall> x. \<parallel>x\<parallel>^2 \<ge> 0\<close>
     by simp
   hence bdd_below1: \<open>bdd_below { \<parallel>x\<parallel>^2 | x. x \<in> M }\<close>
     by fastforce
   have \<open>d \<le> \<parallel>x\<parallel>^2\<close> if a1: "x \<in> M" for x
   proof-
     have "\<forall>v. (\<exists>w. Re (v \<bullet>\<^sub>C v) = \<parallel>w\<parallel>\<^sup>2 \<and> w \<in> M) \<or> v \<notin> M"
       by (metis (no_types) power2_norm_eq_cinner')
     hence "Re (x \<bullet>\<^sub>C x) \<in> {\<parallel>v\<parallel>\<^sup>2 |v. v \<in> M}"
       using a1 by blast
     thus ?thesis
       unfolding d_def
       by (metis (lifting) bdd_below1 cInf_lower power2_norm_eq_cinner')
   qed
 
   have \<open>\<forall> \<epsilon> > 0. \<exists> t \<in> { \<parallel>x\<parallel>^2 | x. x \<in> M }.  t < d + \<epsilon>\<close>
     unfolding d_def
     using w4  bdd_below1
     by (meson cInf_lessD less_add_same_cancel1)
   hence \<open>\<forall> \<epsilon> > 0. \<exists> x \<in> M.  \<parallel>x\<parallel>^2 < d + \<epsilon>\<close>
     by auto
   hence \<open>\<forall> \<epsilon> > 0. \<exists> x \<in> M.  \<parallel>x\<parallel>^2 < d + \<epsilon>\<close>
     by (simp add: \<open>\<And>x. x \<in> M \<Longrightarrow> d \<le> \<parallel>x\<parallel>\<^sup>2\<close>)
   hence w1: \<open>\<forall> n::nat. \<exists> x \<in> M.  \<parallel>x\<parallel>^2 < d + 1/(n+1)\<close> by auto
 
   then obtain r::\<open>nat \<Rightarrow> 'a\<close> where w2: \<open>\<forall> n. r n \<in> M \<and>  \<parallel> r n \<parallel>^2 < d + 1/(n+1)\<close>
     by metis
   have w3: \<open>\<forall> n. r n \<in> M\<close>
     by (simp add: w2)
   have \<open>\<forall> n. \<parallel> r n \<parallel>^2 < d + 1/(n+1)\<close>
     by (simp add: w2)
   have w5: \<open>\<parallel> (r n) - (r m) \<parallel>^2 < 2*(1/(n+1) + 1/(m+1))\<close>
     for m n
   proof-
     have w6: \<open>\<parallel> r n \<parallel>^2 < d + 1/(n+1)\<close>
       by (metis w2  of_nat_1 of_nat_add)
     have \<open> \<parallel> r m \<parallel>^2 < d + 1/(m+1)\<close>
       by (metis w2 of_nat_1 of_nat_add)
     have \<open>(r n) \<in> M\<close>
       by (simp add: \<open>\<forall>n. r n \<in> M\<close>)
     moreover have \<open>(r m) \<in> M\<close>
       by (simp add: \<open>\<forall>n. r n \<in> M\<close>)
     ultimately have \<open>(1/2) *\<^sub>R (r n) + (1/2) *\<^sub>R (r m) \<in> M\<close>
       using \<open>convex M\<close>
       by (simp add: convexD)
     hence \<open>\<parallel> (1/2) *\<^sub>R (r n) + (1/2) *\<^sub>R (r m) \<parallel>^2 \<ge> d\<close>
       by (simp add: \<open>\<And>x. x \<in> M \<Longrightarrow> d \<le> \<parallel>x\<parallel>\<^sup>2\<close>)
     have \<open>\<parallel> (1/2) *\<^sub>R (r n) - (1/2) *\<^sub>R (r m) \<parallel>^2
               = (1/2)*( \<parallel> r n \<parallel>^2 + \<parallel> r m \<parallel>^2 ) - \<parallel> (1/2) *\<^sub>R (r n) + (1/2) *\<^sub>R (r m) \<parallel>^2\<close>
       by (smt (z3) div_by_1 field_sum_of_halves nonzero_mult_div_cancel_left parallelogram_law polar_identity power2_norm_eq_cinner' scaleR_collapse times_divide_eq_left)
     also have  \<open>...
               < (1/2)*( d + 1/(n+1) + \<parallel> r m \<parallel>^2 ) - \<parallel> (1/2) *\<^sub>R (r n) + (1/2) *\<^sub>R (r m) \<parallel>^2\<close>
       using \<open>\<parallel>r n\<parallel>\<^sup>2 < d + 1 / real (n + 1)\<close> by auto
     also have  \<open>...
               < (1/2)*( d + 1/(n+1) + d + 1/(m+1) ) - \<parallel> (1/2) *\<^sub>R (r n) + (1/2) *\<^sub>R (r m) \<parallel>^2\<close>
       using \<open>\<parallel>r m\<parallel>\<^sup>2 < d + 1 / real (m + 1)\<close> by auto
     also have  \<open>...
               \<le> (1/2)*( d + 1/(n+1) + d + 1/(m+1) ) - d\<close>
       by (simp add: \<open>d \<le> \<parallel>(1 / 2) *\<^sub>R r n + (1 / 2) *\<^sub>R r m\<parallel>\<^sup>2\<close>)
     also have  \<open>...
               \<le> (1/2)*( 1/(n+1) + 1/(m+1) + 2*d ) - d\<close>
       by simp
     also have  \<open>...
               \<le> (1/2)*( 1/(n+1) + 1/(m+1) ) + (1/2)*(2*d) - d\<close>
       by (simp add: distrib_left)
     also have  \<open>...
               \<le> (1/2)*( 1/(n+1) + 1/(m+1) ) + d - d\<close>
       by simp
     also have  \<open>...
               \<le> (1/2)*( 1/(n+1) + 1/(m+1) )\<close>
       by simp
     finally have \<open> \<parallel>(1 / 2) *\<^sub>R r n - (1 / 2) *\<^sub>R r m\<parallel>\<^sup>2 < 1 / 2 * (1 / real (n + 1) + 1 / real (m + 1)) \<close>
       by blast
     hence \<open> \<parallel>(1 / 2) *\<^sub>R (r n - r m) \<parallel>\<^sup>2 < (1 / 2) * (1 / real (n + 1) + 1 / real (m + 1)) \<close>
       by (simp add: real_vector.scale_right_diff_distrib)
     hence \<open> ((1 / 2)*\<parallel> (r n - r m) \<parallel>)\<^sup>2 < (1 / 2) * (1 / real (n + 1) + 1 / real (m + 1)) \<close>
       by simp
     hence \<open> (1 / 2)^2*(\<parallel> (r n - r m) \<parallel>)\<^sup>2 < (1 / 2) * (1 / real (n + 1) + 1 / real (m + 1)) \<close>
       by (metis power_mult_distrib)
     hence \<open> (1 / 4) *(\<parallel> (r n - r m) \<parallel>)\<^sup>2 < (1 / 2) * (1 / real (n + 1) + 1 / real (m + 1)) \<close>
       by (simp add: power_divide)
     hence \<open> \<parallel> (r n - r m) \<parallel>\<^sup>2 < 2 * (1 / real (n + 1) + 1 / real (m + 1)) \<close>
       by simp
     thus ?thesis
       by (metis of_nat_1 of_nat_add)
   qed
   hence "\<exists> N. \<forall> n m. n \<ge> N \<and> m \<ge> N \<longrightarrow> \<parallel> (r n) - (r m) \<parallel>^2 < \<epsilon>^2"
     if "\<epsilon> > 0"
     for \<epsilon>
   proof-
     obtain N::nat where \<open>1/(N + 1) < \<epsilon>^2/4\<close>
       using LIMSEQ_ignore_initial_segment[OF lim_inverse_n', where k=1]
       by (metis Suc_eq_plus1 \<open>0 < \<epsilon>\<close> nat_approx_posE zero_less_divide_iff zero_less_numeral
           zero_less_power )
     hence \<open>4/(N + 1) < \<epsilon>^2\<close>
       by simp
     have "2*(1/(n+1) + 1/(m+1)) < \<epsilon>^2"
       if f1: "n \<ge> N" and f2: "m \<ge> N"
       for m n::nat
     proof-
       have \<open>1/(n+1) \<le> 1/(N+1)\<close>
         by (simp add: f1 linordered_field_class.frac_le)
       moreover have \<open>1/(m+1) \<le> 1/(N+1)\<close>
         by (simp add: f2 linordered_field_class.frac_le)
       ultimately have  \<open>2*(1/(n+1) + 1/(m+1)) \<le> 4/(N+1)\<close>
         by simp
       thus ?thesis using \<open>4/(N + 1) < \<epsilon>^2\<close>
         by linarith
     qed
     hence "\<parallel> (r n) - (r m) \<parallel>^2 < \<epsilon>^2"
       if y1: "n \<ge> N" and y2: "m \<ge> N"
       for m n::nat
       using that
       by (smt \<open>\<And>n m. \<parallel>r n - r m\<parallel>\<^sup>2 < 2 * (1 / (real n + 1) + 1 / (real m + 1))\<close> of_nat_1 of_nat_add)
     thus ?thesis
       by blast
   qed
   hence  \<open>\<forall> \<epsilon> > 0. \<exists> N::nat. \<forall> n m::nat. n \<ge> N \<and> m \<ge> N \<longrightarrow> \<parallel> (r n) - (r m) \<parallel>^2 < \<epsilon>^2\<close>
     by blast
   hence  \<open>\<forall> \<epsilon> > 0. \<exists> N::nat. \<forall> n m::nat. n \<ge> N \<and> m \<ge> N \<longrightarrow> \<parallel> (r n) - (r m) \<parallel> < \<epsilon>\<close>
     by (meson less_eq_real_def power_less_imp_less_base)
   hence \<open>Cauchy r\<close>
     using CauchyI by fastforce
   then obtain k where \<open>r \<longlonglongrightarrow> k\<close>
     using  convergent_eq_Cauchy by auto
   have \<open>k \<in> M\<close> using \<open>closed M\<close>
     using \<open>\<forall>n. r n \<in> M\<close> \<open>r \<longlonglongrightarrow> k\<close> closed_sequentially by auto
   have  \<open>(\<lambda> n.  \<parallel> r n \<parallel>^2) \<longlonglongrightarrow>  \<parallel> k \<parallel>^2\<close>
     by (simp add: \<open>r \<longlonglongrightarrow> k\<close> tendsto_norm tendsto_power)
   moreover  have  \<open>(\<lambda> n.  \<parallel> r n \<parallel>^2) \<longlonglongrightarrow>  d\<close>
   proof-
     have \<open>\<bar>\<parallel> r n \<parallel>^2 - d\<bar> < 1/(n+1)\<close> for n :: nat
       using \<open>\<And>x. x \<in> M \<Longrightarrow> d \<le> \<parallel>x\<parallel>\<^sup>2\<close> \<open>\<forall>n. r n \<in> M \<and> \<parallel>r n\<parallel>\<^sup>2 < d + 1 / (real n + 1)\<close> of_nat_1 of_nat_add
       by smt
     moreover have \<open>(\<lambda>n. 1 / real (n + 1)) \<longlonglongrightarrow> 0\<close>
       using  LIMSEQ_ignore_initial_segment[OF lim_inverse_n', where k=1] by blast
     ultimately have \<open>(\<lambda> n. \<bar>\<parallel> r n \<parallel>^2 - d\<bar> ) \<longlonglongrightarrow> 0\<close>
       by (simp add: LIMSEQ_norm_0)
     hence \<open>(\<lambda> n. \<parallel> r n \<parallel>^2 - d ) \<longlonglongrightarrow> 0\<close>
       by (simp add: tendsto_rabs_zero_iff)
     moreover have \<open>(\<lambda> n. d ) \<longlonglongrightarrow> d\<close>
       by simp
     ultimately have \<open>(\<lambda> n. (\<parallel> r n \<parallel>^2 - d)+d ) \<longlonglongrightarrow> 0+d\<close>
       using tendsto_add by fastforce
     thus ?thesis by simp
   qed
   ultimately have \<open>d = \<parallel> k \<parallel>^2\<close>
     using LIMSEQ_unique by auto
   hence \<open>t \<in> M \<Longrightarrow> \<parallel> k \<parallel>^2 \<le> \<parallel> t \<parallel>^2\<close> for t
     using \<open>\<And>x. x \<in> M \<Longrightarrow> d \<le> \<parallel>x\<parallel>\<^sup>2\<close> by auto
   hence q1: \<open>\<exists> k. is_arg_min (\<lambda> x. \<parallel>x\<parallel>^2) (\<lambda> t. t \<in> M) k\<close>
     using \<open>k \<in> M\<close>
       is_arg_min_def \<open>d = \<parallel>k\<parallel>\<^sup>2\<close>
     by smt
   thus \<open>\<exists> k. is_arg_min (\<lambda> x. \<parallel>x\<parallel>) (\<lambda> t. t \<in> M) k\<close>
     by (smt is_arg_min_def norm_ge_zero power2_eq_square power2_le_imp_le)
 qed
 
 
 lemma smallest_norm_unique:
   \<comment> \<open>Theorem 2.5 in \<^cite>\<open>conway2013course\<close> (inside the proof)\<close>
   includes notation_norm
   fixes M :: \<open>'a::complex_inner set\<close>
   assumes q1: \<open>convex M\<close>
   assumes r: \<open>is_arg_min (\<lambda> x. \<parallel>x\<parallel>) (\<lambda> t. t \<in> M) r\<close>
   assumes s: \<open>is_arg_min (\<lambda> x. \<parallel>x\<parallel>) (\<lambda> t. t \<in> M) s\<close>
   shows \<open>r = s\<close>
 proof -
   have \<open>r \<in> M\<close>
     using \<open>is_arg_min (\<lambda>x. \<parallel>x\<parallel>) (\<lambda> t. t \<in> M) r\<close>
     by (simp add: is_arg_min_def)
   moreover have \<open>s \<in> M\<close>
     using \<open>is_arg_min (\<lambda>x. \<parallel>x\<parallel>) (\<lambda> t. t \<in> M) s\<close>
     by (simp add: is_arg_min_def)
   ultimately have \<open>((1/2) *\<^sub>R r + (1/2) *\<^sub>R s) \<in> M\<close> using \<open>convex M\<close>
     by (simp add: convexD)
   hence \<open>\<parallel>r\<parallel> \<le> \<parallel> (1/2) *\<^sub>R r + (1/2) *\<^sub>R s \<parallel>\<close>
     by (metis is_arg_min_linorder r)
   hence u2: \<open>\<parallel>r\<parallel>^2 \<le> \<parallel> (1/2) *\<^sub>R r + (1/2) *\<^sub>R s \<parallel>^2\<close>
     using norm_ge_zero power_mono by blast
 
   have \<open>\<parallel>r\<parallel> \<le> \<parallel>s\<parallel>\<close>
     using r s is_arg_min_def
     by (metis is_arg_min_linorder)
   moreover have \<open>\<parallel>s\<parallel> \<le> \<parallel>r\<parallel>\<close>
     using r s is_arg_min_def
     by (metis is_arg_min_linorder)
   ultimately have u3: \<open>\<parallel>r\<parallel> = \<parallel>s\<parallel>\<close> by simp
 
   have \<open>\<parallel> (1/2) *\<^sub>R r - (1/2) *\<^sub>R s \<parallel>^2 \<le> 0\<close>
     using u2 u3 parallelogram_law
     by (smt (verit, ccfv_SIG) polar_identity_minus power2_norm_eq_cinner' scaleR_add_right scaleR_half_double)
   hence \<open>\<parallel> (1/2) *\<^sub>R r - (1/2) *\<^sub>R s \<parallel>^2 = 0\<close>
     by simp
   hence \<open>\<parallel> (1/2) *\<^sub>R r - (1/2) *\<^sub>R s \<parallel> = 0\<close>
     by auto
   hence \<open>(1/2) *\<^sub>R r - (1/2) *\<^sub>R s = 0\<close>
     using norm_eq_zero by blast
   thus ?thesis by simp
 qed
 
 theorem smallest_dist_exists:
   \<comment> \<open>Theorem 2.5 in \<^cite>\<open>conway2013course\<close>\<close>
   fixes M::\<open>'a::chilbert_space set\<close> and h
   assumes a1: \<open>convex M\<close> and a2: \<open>closed M\<close> and a3: \<open>M \<noteq> {}\<close>
   shows  \<open>\<exists>k. is_arg_min (\<lambda> x. dist x h) (\<lambda> x. x \<in> M) k\<close>
 proof -
   have *: "is_arg_min (\<lambda>x. dist x h) (\<lambda>x. x\<in>M) (k+h) \<longleftrightarrow> is_arg_min (\<lambda>x. norm x) (\<lambda>x. x\<in>(\<lambda>x. x-h) ` M) k" for k
     unfolding dist_norm is_arg_min_def apply auto using add_implies_diff by blast
   have \<open>\<exists>k. is_arg_min (\<lambda>x. dist x h) (\<lambda>x. x\<in>M) (k+h)\<close>
     apply (subst *)
     apply (rule smallest_norm_exists)
     using assms by (auto simp: closed_translation_subtract)
   then show \<open>\<exists>k. is_arg_min (\<lambda> x. dist x h) (\<lambda> x. x \<in> M) k\<close>
     by metis
 qed
 
 theorem smallest_dist_unique:
   \<comment> \<open>Theorem 2.5 in \<^cite>\<open>conway2013course\<close>\<close>
   fixes M::\<open>'a::complex_inner set\<close> and h
   assumes a1: \<open>convex M\<close>
   assumes \<open>is_arg_min (\<lambda> x. dist x h) (\<lambda> x. x \<in> M) r\<close>
   assumes \<open>is_arg_min (\<lambda> x. dist x h) (\<lambda> x. x \<in> M) s\<close>
   shows  \<open>r = s\<close>
 proof-
   have *: "is_arg_min (\<lambda>x. dist x h) (\<lambda>x. x\<in>M) k \<longleftrightarrow> is_arg_min (\<lambda>x. norm x) (\<lambda>x. x\<in>(\<lambda>x. x-h) ` M) (k-h)" for k
     unfolding dist_norm is_arg_min_def by auto
   have \<open>r - h = s - h\<close>
     using _ assms(2,3)[unfolded *] apply (rule smallest_norm_unique)
     by (simp add: a1)
   thus \<open>r = s\<close>
     by auto
 qed
 
 
 \<comment> \<open>Theorem 2.6 in \<^cite>\<open>conway2013course\<close>\<close>
 theorem smallest_dist_is_ortho:
   fixes M::\<open>'a::complex_inner set\<close> and h k::'a
   assumes b1: \<open>closed_csubspace M\<close>
   shows  \<open>(is_arg_min (\<lambda> x. dist x h) (\<lambda> x. x \<in> M) k) \<longleftrightarrow>
           h - k \<in> orthogonal_complement M \<and> k \<in> M\<close>
 proof -
   include notation_norm
   have  \<open>csubspace M\<close>
     using \<open>closed_csubspace M\<close> unfolding closed_csubspace_def by blast
   have r1: \<open>2 * Re ((h - k) \<bullet>\<^sub>C f) \<le> \<parallel> f \<parallel>^2\<close>
     if "f \<in> M" and \<open>k \<in> M\<close> and \<open>is_arg_min (\<lambda>x. dist x h) (\<lambda> x. x \<in> M) k\<close>
     for f
   proof-
     have \<open>k + f \<in>  M\<close>
       using \<open>csubspace M\<close>
       by (simp add:complex_vector.subspace_add that)
     have "\<forall>f A a b. \<not> is_arg_min f (\<lambda> x. x \<in> A) (a::'a) \<or> (f a::real) \<le> f b \<or> b \<notin> A"
       by (metis (no_types) is_arg_min_linorder)
     hence "dist k h \<le> dist (f + k) h"
       by (metis \<open>is_arg_min (\<lambda>x. dist x h) (\<lambda> x. x \<in> M) k\<close> \<open>k + f \<in> M\<close> add.commute)
     hence \<open>dist h k \<le> dist  h (k + f)\<close>
       by (simp add: add.commute dist_commute)
     hence \<open>\<parallel> h - k \<parallel> \<le> \<parallel> h - (k + f) \<parallel>\<close>
       by (simp add: dist_norm)
     hence \<open>\<parallel> h - k \<parallel>^2 \<le> \<parallel> h - (k + f) \<parallel>^2\<close>
       by (simp add: power_mono)
     also have \<open>... \<le> \<parallel> (h - k) - f \<parallel>^2\<close>
       by (simp add: diff_diff_add)
     also have \<open>... \<le> \<parallel> (h - k) \<parallel>^2 + \<parallel> f \<parallel>^2 -  2 * Re ((h - k) \<bullet>\<^sub>C f)\<close>
       by (simp add: polar_identity_minus)
     finally have \<open>\<parallel> (h - k) \<parallel>^2 \<le> \<parallel> (h - k) \<parallel>^2 + \<parallel> f \<parallel>^2 -  2 * Re ((h - k) \<bullet>\<^sub>C f)\<close>
       by simp
     thus ?thesis by simp
   qed
 
   have q4: \<open>\<forall> c > 0.  2 * Re ((h - k) \<bullet>\<^sub>C f) \<le> c\<close>
     if  \<open>\<forall>c>0. 2 * Re ((h - k) \<bullet>\<^sub>C f) \<le> c * \<parallel>f\<parallel>\<^sup>2\<close>
     for f
   proof (cases \<open>\<parallel> f \<parallel>^2 > 0\<close>)
     case True
     hence \<open>\<forall> c > 0.  2 * Re (((h - k) \<bullet>\<^sub>C f)) \<le> (c/\<parallel> f \<parallel>^2)*\<parallel> f \<parallel>^2\<close>
       using that linordered_field_class.divide_pos_pos by blast
     thus ?thesis
       using True by auto
   next
     case False
     hence \<open>\<parallel> f \<parallel>^2 = 0\<close>
       by simp
     thus ?thesis
       by auto
   qed
   have q3: \<open>\<forall> c::real. c > 0 \<longrightarrow> 2 * Re (((h - k) \<bullet>\<^sub>C f)) \<le> 0\<close>
     if a3: \<open>\<forall>f. f \<in> M \<longrightarrow> (\<forall>c>0. 2 * Re ((h - k) \<bullet>\<^sub>C f) \<le> c * \<parallel>f\<parallel>\<^sup>2)\<close>
       and a2: "f \<in>  M"
       and a1: "is_arg_min (\<lambda> x. dist x h) (\<lambda> x. x \<in> M) k"
     for f
   proof-
     have \<open>\<forall> c > 0.  2 * Re (((h - k) \<bullet>\<^sub>C f)) \<le> c*\<parallel> f \<parallel>^2\<close>
       by (simp add: that )
     thus ?thesis
       using q4 by smt
   qed
   have w2: "h - k \<in> orthogonal_complement M \<and> k \<in> M"
     if a1: "is_arg_min (\<lambda> x. dist x h) (\<lambda> x. x \<in> M) k"
   proof-
     have  \<open>k \<in> M\<close>
       using is_arg_min_def that by fastforce
     hence \<open>\<forall> f. f \<in>  M \<longrightarrow> 2 * Re (((h - k) \<bullet>\<^sub>C f)) \<le> \<parallel> f \<parallel>^2\<close>
       using r1
       by (simp add: that)
     have \<open>\<forall> f. f \<in>  M \<longrightarrow>
                 (\<forall> c::real.  2 * Re ((h - k) \<bullet>\<^sub>C (c *\<^sub>R f)) \<le> \<parallel> c *\<^sub>R f \<parallel>^2)\<close>
       using  assms scaleR_scaleC complex_vector.subspace_def \<open>csubspace M\<close>
       by (metis \<open>\<forall>f. f \<in> M \<longrightarrow> 2 * Re ((h - k) \<bullet>\<^sub>C f) \<le> \<parallel>f\<parallel>\<^sup>2\<close>)
     hence  \<open>\<forall> f. f \<in>  M \<longrightarrow>
                 (\<forall> c::real. c * (2 * Re (((h - k) \<bullet>\<^sub>C f))) \<le> \<parallel> c *\<^sub>R f \<parallel>^2)\<close>
       by (metis Re_complex_of_real cinner_scaleC_right complex_add_cnj complex_cnj_complex_of_real
           complex_cnj_mult of_real_mult scaleR_scaleC semiring_normalization_rules(34))
     hence  \<open>\<forall> f. f \<in>  M \<longrightarrow>
                 (\<forall> c::real. c * (2 * Re (((h - k) \<bullet>\<^sub>C f))) \<le> \<bar>c\<bar>^2*\<parallel> f \<parallel>^2)\<close>
       by (simp add: power_mult_distrib)
     hence  \<open>\<forall> f. f \<in>  M \<longrightarrow>
                 (\<forall> c::real. c * (2 * Re (((h - k) \<bullet>\<^sub>C f))) \<le> c^2*\<parallel> f \<parallel>^2)\<close>
       by auto
     hence  \<open>\<forall> f. f \<in>  M \<longrightarrow>
                 (\<forall> c::real. c > 0 \<longrightarrow> c * (2 * Re (((h - k) \<bullet>\<^sub>C f))) \<le> c^2*\<parallel> f \<parallel>^2)\<close>
       by simp
     hence  \<open>\<forall> f. f \<in>  M \<longrightarrow>
                 (\<forall> c::real. c > 0 \<longrightarrow> c*(2 * Re (((h - k) \<bullet>\<^sub>C f))) \<le> c*(c*\<parallel> f \<parallel>^2))\<close>
       by (simp add: power2_eq_square)
     hence  q4: \<open>\<forall> f. f \<in>  M \<longrightarrow>
                 (\<forall> c::real. c > 0 \<longrightarrow> 2 * Re (((h - k) \<bullet>\<^sub>C f)) \<le> c*\<parallel> f \<parallel>^2)\<close>
       by simp
     have  \<open>\<forall> f. f \<in>  M \<longrightarrow>
                 (\<forall> c::real. c > 0 \<longrightarrow> 2 * Re (((h - k) \<bullet>\<^sub>C f)) \<le> 0)\<close>
       using q3
       by (simp add: q4 that)
     hence  \<open>\<forall> f. f \<in>  M \<longrightarrow>
                 (\<forall> c::real. c > 0 \<longrightarrow> (2 * Re ((h - k) \<bullet>\<^sub>C (-1 *\<^sub>R f))) \<le> 0)\<close>
       using assms scaleR_scaleC complex_vector.subspace_def
       by (metis \<open>csubspace M\<close>)
     hence  \<open>\<forall> f. f \<in>  M \<longrightarrow>
                 (\<forall> c::real. c > 0 \<longrightarrow> -(2 * Re (((h - k) \<bullet>\<^sub>C f))) \<le> 0)\<close>
       by simp
     hence  \<open>\<forall> f. f \<in>  M \<longrightarrow>
                 (\<forall> c::real. c > 0 \<longrightarrow> 2 * Re (((h - k) \<bullet>\<^sub>C f)) \<ge> 0)\<close>
       by simp
     hence \<open>\<forall> f. f \<in>  M \<longrightarrow>
                 (\<forall> c::real. c > 0 \<longrightarrow> 2 * Re (((h - k) \<bullet>\<^sub>C f)) = 0)\<close>
       using  \<open>\<forall> f. f \<in>  M \<longrightarrow>
                 (\<forall> c::real. c > 0 \<longrightarrow> (2 * Re (((h - k) \<bullet>\<^sub>C f))) \<le> 0)\<close>
       by fastforce
 
     have \<open>\<forall> f. f \<in>  M \<longrightarrow>
                  ((1::real) > 0 \<longrightarrow> 2 * Re (((h - k) \<bullet>\<^sub>C f)) = 0)\<close>
       using \<open>\<forall>f. f \<in>  M \<longrightarrow> (\<forall>c>0. 2 * Re (((h - k) \<bullet>\<^sub>C f) ) = 0)\<close> by blast
     hence \<open>\<forall> f. f \<in>  M \<longrightarrow> 2 * Re (((h - k) \<bullet>\<^sub>C f)) = 0\<close>
       by simp
     hence \<open>\<forall> f. f \<in>  M \<longrightarrow> Re (((h - k) \<bullet>\<^sub>C f)) = 0\<close>
       by simp
     have  \<open>\<forall> f. f \<in>  M \<longrightarrow> Re ((h - k) \<bullet>\<^sub>C ((Complex 0 (-1)) *\<^sub>C f)) = 0\<close>
       using assms  complex_vector.subspace_def \<open>csubspace M\<close>
       by (metis \<open>\<forall>f. f \<in> M \<longrightarrow> Re ((h - k) \<bullet>\<^sub>C f) = 0\<close>)
     hence  \<open>\<forall> f. f \<in>  M \<longrightarrow> Re ( (Complex 0 (-1))*(((h - k) \<bullet>\<^sub>C f)) ) = 0\<close>
       by simp
     hence \<open>\<forall> f. f \<in>  M \<longrightarrow> Im (((h - k) \<bullet>\<^sub>C f)) = 0\<close>
       using Complex_eq_neg_1 Re_i_times cinner_scaleC_right complex_of_real_def by auto
 
     have \<open>\<forall> f. f \<in>  M \<longrightarrow> (((h - k) \<bullet>\<^sub>C f)) = 0\<close>
       using complex_eq_iff
       by (simp add: \<open>\<forall>f. f \<in> M \<longrightarrow> Im ((h - k) \<bullet>\<^sub>C f) = 0\<close> \<open>\<forall>f. f \<in> M \<longrightarrow> Re ((h - k) \<bullet>\<^sub>C f) = 0\<close>)
     hence \<open>h - k \<in> orthogonal_complement M \<and> k \<in> M\<close>
       by (simp add: \<open>k \<in> M\<close> orthogonal_complementI)
     have  \<open>\<forall> c. c *\<^sub>R f \<in> M\<close>
       if "f \<in> M"
       for f
       using that scaleR_scaleC  \<open>csubspace M\<close> complex_vector.subspace_def
       by (simp add: complex_vector.subspace_def scaleR_scaleC)
     have \<open>((h - k) \<bullet>\<^sub>C f) = 0\<close>
       if "f \<in> M"
       for f
       using \<open>h - k \<in> orthogonal_complement M \<and> k \<in> M\<close> orthogonal_complement_orthoI that by auto
     hence \<open>h - k \<in> orthogonal_complement M\<close>
       by (simp add: orthogonal_complement_def)
     thus ?thesis
       using \<open>k \<in> M\<close> by auto
   qed
 
   have q1: \<open>dist h k \<le> dist h f \<close>
     if "f \<in> M" and  \<open>h - k \<in> orthogonal_complement M \<and> k \<in> M\<close>
     for f
   proof-
     have \<open>(h - k) \<bullet>\<^sub>C (k - f) = 0\<close>
       by (metis (no_types, lifting) that
           cinner_diff_right diff_0_right orthogonal_complement_orthoI that)
     have \<open>\<parallel> h - f \<parallel>^2 = \<parallel> (h - k) + (k - f) \<parallel>^2\<close>
       by simp
     also have \<open>... = \<parallel> h - k \<parallel>^2 + \<parallel> k - f \<parallel>^2\<close>
       using  \<open>((h - k) \<bullet>\<^sub>C (k - f)) = 0\<close> pythagorean_theorem by blast
     also have \<open>... \<ge> \<parallel> h - k \<parallel>^2\<close>
       by simp
     finally have \<open>\<parallel>h - k\<parallel>\<^sup>2 \<le> \<parallel>h - f\<parallel>\<^sup>2 \<close>
       by blast
     hence \<open>\<parallel>h - k\<parallel> \<le> \<parallel>h - f\<parallel>\<close>
       using norm_ge_zero power2_le_imp_le by blast
     thus ?thesis
       by (simp add: dist_norm)
   qed
 
   have  w1: "is_arg_min (\<lambda> x. dist x h) (\<lambda> x. x \<in> M) k"
     if "h - k \<in> orthogonal_complement M \<and> k \<in>  M"
   proof-
     have \<open>h - k \<in> orthogonal_complement M\<close>
       using that by blast
     have \<open>k \<in> M\<close> using \<open>h - k \<in> orthogonal_complement M \<and> k \<in>  M\<close>
       by blast
     thus ?thesis
       by (metis (no_types, lifting) dist_commute is_arg_min_linorder q1 that)
   qed
   show ?thesis
     using w1 w2 by blast
 qed
 
 corollary orthog_proj_exists:
   fixes M :: \<open>'a::chilbert_space set\<close>
   assumes \<open>closed_csubspace M\<close>
   shows  \<open>\<exists>k. h - k \<in> orthogonal_complement M \<and> k \<in> M\<close>
 proof -
   from  \<open>closed_csubspace M\<close>
   have \<open>M \<noteq> {}\<close>
     using closed_csubspace.subspace complex_vector.subspace_0 by blast
   have \<open>closed  M\<close>
     using  \<open>closed_csubspace M\<close>
     by (simp add: closed_csubspace.closed)
   have \<open>convex  M\<close>
     using  \<open>closed_csubspace M\<close>
     by (simp)
   have \<open>\<exists>k.  is_arg_min (\<lambda> x. dist x h) (\<lambda> x. x \<in> M) k\<close>
     by (simp add: smallest_dist_exists \<open>closed M\<close> \<open>convex M\<close> \<open>M \<noteq> {}\<close>)
   thus ?thesis
     by (simp add: assms smallest_dist_is_ortho)
 qed
 
 corollary orthog_proj_unique:
   fixes M :: \<open>'a::complex_inner set\<close>
   assumes \<open>closed_csubspace M\<close>
   assumes \<open>h - r \<in> orthogonal_complement M \<and> r \<in> M\<close>
   assumes \<open>h - s \<in> orthogonal_complement M \<and> s \<in> M\<close>
   shows  \<open>r = s\<close>
   using _ assms(2,3) unfolding smallest_dist_is_ortho[OF assms(1), symmetric]
   apply (rule smallest_dist_unique)
   using assms(1) by (simp)
 
 definition is_projection_on::\<open>('a \<Rightarrow> 'a) \<Rightarrow> ('a::metric_space) set \<Rightarrow> bool\<close> where
   \<open>is_projection_on \<pi> M \<longleftrightarrow> (\<forall>h. is_arg_min (\<lambda> x. dist x h) (\<lambda> x. x \<in> M) (\<pi> h))\<close>
 
 lemma is_projection_on_iff_orthog:
   \<open>closed_csubspace M \<Longrightarrow> is_projection_on \<pi> M \<longleftrightarrow> (\<forall>h. h - \<pi> h \<in> orthogonal_complement M \<and> \<pi> h \<in> M)\<close>
   by (simp add: is_projection_on_def smallest_dist_is_ortho)
 
 lemma is_projection_on_exists:
   fixes M :: \<open>'a::chilbert_space set\<close>
   assumes \<open>convex M\<close> and \<open>closed M\<close> and \<open>M \<noteq> {}\<close>
   shows "\<exists>\<pi>. is_projection_on \<pi> M"
   unfolding is_projection_on_def apply (rule choice)
   using smallest_dist_exists[OF assms] by auto
 
 lemma is_projection_on_unique:
   fixes M :: \<open>'a::complex_inner set\<close>
   assumes \<open>convex M\<close>
   assumes "is_projection_on \<pi>\<^sub>1 M"
   assumes "is_projection_on \<pi>\<^sub>2 M"
   shows "\<pi>\<^sub>1 = \<pi>\<^sub>2"
   using smallest_dist_unique[OF assms(1)] using assms(2,3)
   unfolding is_projection_on_def by blast
 
 definition projection :: \<open>'a::metric_space set \<Rightarrow> ('a \<Rightarrow> 'a)\<close> where
   \<open>projection M = (SOME \<pi>. is_projection_on \<pi> M)\<close>
 
 lemma projection_is_projection_on:
   fixes M :: \<open>'a::chilbert_space set\<close>
   assumes \<open>convex M\<close> and \<open>closed M\<close> and \<open>M \<noteq> {}\<close>
   shows "is_projection_on (projection M) M"
   by (metis assms(1) assms(2) assms(3) is_projection_on_exists projection_def someI)
 
 lemma projection_is_projection_on'[simp]:
   \<comment> \<open>Common special case of @{thm projection_is_projection_on}\<close>
   fixes M :: \<open>'a::chilbert_space set\<close>
   assumes \<open>closed_csubspace M\<close>
   shows "is_projection_on (projection M) M"
   apply (rule projection_is_projection_on)
     apply (auto simp add: assms closed_csubspace.closed)
   using assms closed_csubspace.subspace complex_vector.subspace_0 by blast
 
 lemma projection_orthogonal:
   fixes M :: \<open>'a::chilbert_space set\<close>
   assumes "closed_csubspace M" and \<open>m \<in> M\<close>
   shows \<open>is_orthogonal (h - projection M h) m\<close>
   by (metis assms(1) assms(2) closed_csubspace.closed closed_csubspace.subspace csubspace_is_convex empty_iff is_projection_on_iff_orthog orthogonal_complement_orthoI projection_is_projection_on)
 
 lemma is_projection_on_in_image:
   assumes "is_projection_on \<pi> M"
   shows "\<pi> h \<in> M"
   using assms
   by (simp add: is_arg_min_def is_projection_on_def)
 
 lemma is_projection_on_image:
   assumes "is_projection_on \<pi> M"
   shows "range \<pi> = M"
   using assms
   apply (auto simp: is_projection_on_in_image)
   by (smt (verit, ccfv_threshold) dist_pos_lt dist_self is_arg_min_def is_projection_on_def rangeI)
 
 lemma projection_in_image[simp]:
   fixes M :: \<open>'a::chilbert_space set\<close>
   assumes \<open>convex M\<close> and \<open>closed M\<close> and \<open>M \<noteq> {}\<close>
   shows \<open>projection M h \<in> M\<close>
   by (simp add: assms(1) assms(2) assms(3) is_projection_on_in_image projection_is_projection_on)
 
 lemma projection_image[simp]:
   fixes M :: \<open>'a::chilbert_space set\<close>
   assumes \<open>convex M\<close> and \<open>closed M\<close> and \<open>M \<noteq> {}\<close>
   shows \<open>range (projection M) = M\<close>
   by (simp add: assms(1) assms(2) assms(3) is_projection_on_image projection_is_projection_on)
 
 lemma projection_eqI':
   fixes M :: \<open>'a::complex_inner set\<close>
   assumes \<open>convex M\<close>
   assumes \<open>is_projection_on f M\<close>
   shows \<open>projection M = f\<close>
   by (metis assms(1) assms(2) is_projection_on_unique projection_def someI_ex)
 
 lemma is_projection_on_eqI:
   fixes  M :: \<open>'a::complex_inner set\<close>
   assumes a1: \<open>closed_csubspace M\<close> and a2: \<open>h - x \<in> orthogonal_complement M\<close> and a3: \<open>x \<in> M\<close>
     and a4: \<open>is_projection_on \<pi> M\<close>
   shows \<open>\<pi> h = x\<close>
   by (meson a1 a2 a3 a4 closed_csubspace.subspace csubspace_is_convex is_projection_on_def smallest_dist_is_ortho smallest_dist_unique)
 
 lemma projection_eqI:
   fixes  M :: \<open>('a::chilbert_space) set\<close>
   assumes  \<open>closed_csubspace M\<close> and \<open>h - x \<in> orthogonal_complement M\<close> and \<open>x \<in> M\<close>
   shows \<open>projection M h = x\<close>
   by (metis assms(1) assms(2) assms(3) is_projection_on_iff_orthog orthog_proj_exists projection_def is_projection_on_eqI tfl_some)
 
 lemma is_projection_on_fixes_image:
   fixes M :: \<open>'a::metric_space set\<close>
   assumes a1: "is_projection_on \<pi> M" and a3: "x \<in> M"
   shows "\<pi> x = x"
   by (metis a1 a3 dist_pos_lt dist_self is_arg_min_def is_projection_on_def)
 
 lemma projection_fixes_image:
   fixes M :: \<open>('a::chilbert_space) set\<close>
   assumes "closed_csubspace M" and "x \<in> M"
   shows "projection M x = x"
   using is_projection_on_fixes_image
     \<comment> \<open>Theorem 2.7 in \<^cite>\<open>conway2013course\<close>\<close>
   by (simp add: assms complex_vector.subspace_0 projection_eqI)
 
 lemma is_projection_on_closed:
   assumes cont_f: \<open>\<And>x. x \<in> closure M \<Longrightarrow> isCont f x\<close>
   assumes \<open>is_projection_on f M\<close>
   shows \<open>closed M\<close>
 proof -
   have \<open>x \<in> M\<close> if \<open>s \<longlonglongrightarrow> x\<close> and \<open>range s \<subseteq> M\<close> for s x
   proof -
     from \<open>is_projection_on f M\<close> \<open>range s \<subseteq> M\<close>
     have \<open>s = (f o s)\<close>
       by (simp add: comp_def is_projection_on_fixes_image range_subsetD)
     also from cont_f \<open>s \<longlonglongrightarrow> x\<close> 
     have \<open>(f o s) \<longlonglongrightarrow> f x\<close>
       apply (rule continuous_imp_tendsto)
       using \<open>s \<longlonglongrightarrow> x\<close> \<open>range s \<subseteq> M\<close>
       by (meson closure_sequential range_subsetD)
     finally have \<open>x = f x\<close>
       using \<open>s \<longlonglongrightarrow> x\<close>
       by (simp add: LIMSEQ_unique)
     then have \<open>x \<in> range f\<close>
       by simp
     with \<open>is_projection_on f M\<close> show \<open>x \<in> M\<close>
       by (simp add: is_projection_on_image)
   qed
   then show ?thesis
     by (metis closed_sequential_limits image_subset_iff)
 qed
 
 proposition is_projection_on_reduces_norm:
   includes notation_norm
   fixes M :: \<open>('a::complex_inner) set\<close>
   assumes \<open>is_projection_on \<pi> M\<close> and \<open>closed_csubspace M\<close>
   shows \<open>\<parallel> \<pi>  h \<parallel> \<le> \<parallel> h \<parallel>\<close>
 proof-
   have \<open>h - \<pi> h \<in> orthogonal_complement M\<close>
     using assms is_projection_on_iff_orthog by blast
   hence \<open>\<forall> k \<in> M. is_orthogonal (h - \<pi> h) k\<close>
     using orthogonal_complement_orthoI by blast
   also have \<open>\<pi> h \<in>  M\<close>
     using \<open>is_projection_on \<pi> M\<close>
     by (simp add: is_projection_on_in_image)
   ultimately have \<open>is_orthogonal (h - \<pi> h) (\<pi> h)\<close>
     by auto
   hence \<open>\<parallel> \<pi> h \<parallel>^2 + \<parallel> h - \<pi> h \<parallel>^2 = \<parallel> h \<parallel>^2\<close>
     using pythagorean_theorem by fastforce
   hence \<open>\<parallel>\<pi> h \<parallel>^2 \<le> \<parallel> h \<parallel>^2\<close>
     by (smt zero_le_power2)
   thus ?thesis
     using norm_ge_zero power2_le_imp_le by blast
 qed
 
 proposition projection_reduces_norm:
   includes notation_norm
   fixes M :: \<open>'a::chilbert_space set\<close>
   assumes a1: "closed_csubspace M"
   shows \<open>\<parallel> projection M h \<parallel> \<le> \<parallel> h \<parallel>\<close>
   using assms is_projection_on_iff_orthog orthog_proj_exists is_projection_on_reduces_norm projection_eqI by blast
 
 \<comment> \<open>Theorem 2.7 (version) in \<^cite>\<open>conway2013course\<close>\<close>
 theorem is_projection_on_bounded_clinear:
   fixes M :: \<open>'a::complex_inner set\<close>
   assumes a1: "is_projection_on \<pi> M" and a2: "closed_csubspace M"
   shows "bounded_clinear \<pi>"
 proof
   have b1:  \<open>csubspace (orthogonal_complement M)\<close>
     by (simp add: a2)
   have f1: "\<forall>a. a - \<pi> a \<in> orthogonal_complement M \<and> \<pi> a \<in> M"
     using a1 a2 is_projection_on_iff_orthog by blast
   hence "c *\<^sub>C x - c *\<^sub>C \<pi> x \<in> orthogonal_complement M"
     for c x
     by (metis (no_types) b1
         add_diff_cancel_right' complex_vector.subspace_def diff_add_cancel scaleC_add_right)
   thus r1: \<open>\<pi> (c *\<^sub>C x) = c *\<^sub>C (\<pi> x)\<close> for x c
     using f1 by (meson a2 a1 closed_csubspace.subspace
         complex_vector.subspace_def is_projection_on_eqI)
   show r2: \<open>\<pi> (x + y) =  (\<pi> x) + (\<pi> y)\<close>
     for x y
   proof-
     have "\<forall>A. \<not> closed_csubspace (A::'a set) \<or> csubspace A"
       by (metis closed_csubspace.subspace)
     hence "csubspace M"
       using a2 by auto
     hence \<open>\<pi> (x + y) - ( (\<pi> x) + (\<pi> y) ) \<in> M\<close>
       by (simp add: complex_vector.subspace_add complex_vector.subspace_diff f1)
     have \<open>closed_csubspace (orthogonal_complement M)\<close>
       using a2
       by simp
     have f1: "\<forall>a b. (b::'a) + (a - b) = a"
       by (metis add.commute diff_add_cancel)
     have f2: "\<forall>a b. (b::'a) - b = a - a"
       by auto
     hence f3: "\<forall>a. a - a \<in> orthogonal_complement M"
       by (simp add: complex_vector.subspace_0)
     have "\<forall>a b. (a \<in> orthogonal_complement M \<or> a + b \<notin> orthogonal_complement M)
              \<or> b \<notin> orthogonal_complement M"
       using add_diff_cancel_right' b1 complex_vector.subspace_diff
       by metis
     hence "\<forall>a b c. (a \<in> orthogonal_complement M \<or> c - (b + a) \<notin> orthogonal_complement M)
               \<or> c - b \<notin> orthogonal_complement M"
       using f1 by (metis diff_diff_add)
     hence f4: "\<forall>a b f. (f a - b \<in> orthogonal_complement M \<or> a - b \<notin> orthogonal_complement M)
               \<or> \<not> is_projection_on f M"
       using f1
       by (metis a2 is_projection_on_iff_orthog)
     have f5: "\<forall>a b c d. (d::'a) - (c + (b - a)) = d + (a - (b + c))"
       by auto
     have "x - \<pi> x \<in> orthogonal_complement M"
       using a1 a2 is_projection_on_iff_orthog by blast
     hence q1: \<open>\<pi> (x + y) - ( (\<pi> x) + (\<pi> y) ) \<in> orthogonal_complement M\<close>
       using f5 f4 f3 by (metis \<open>csubspace (orthogonal_complement M)\<close>
           \<open>is_projection_on \<pi> M\<close> add_diff_eq complex_vector.subspace_diff diff_diff_add
           diff_diff_eq2)
     hence \<open>\<pi> (x + y) - ( (\<pi> x) + (\<pi> y) ) \<in> M \<inter> (orthogonal_complement M)\<close>
       by (simp add: \<open>\<pi> (x + y) - (\<pi> x + \<pi> y) \<in> M\<close>)
     moreover have \<open>M \<inter> (orthogonal_complement M) = {0}\<close>
       by (simp add: \<open>closed_csubspace M\<close> complex_vector.subspace_0 orthogonal_complement_zero_intersection)
     ultimately have \<open>\<pi> (x + y) - ( (\<pi> x) + (\<pi> y) ) = 0\<close>
       by auto
     thus ?thesis by simp
   qed
   from is_projection_on_reduces_norm
   show t1: \<open>\<exists> K. \<forall> x. norm (\<pi> x) \<le> norm x * K\<close>
     by (metis a1 a2 mult.left_neutral ordered_field_class.sign_simps(5))
 qed
 
 theorem projection_bounded_clinear:
   fixes M :: \<open>('a::chilbert_space) set\<close>
   assumes a1: "closed_csubspace M"
   shows \<open>bounded_clinear (projection M)\<close>
     \<comment> \<open>Theorem 2.7 in \<^cite>\<open>conway2013course\<close>\<close>
   using assms is_projection_on_iff_orthog orthog_proj_exists is_projection_on_bounded_clinear projection_eqI by blast
 
 proposition is_projection_on_idem:
   fixes M :: \<open>('a::complex_inner) set\<close>
   assumes "is_projection_on \<pi> M"
   shows "\<pi> (\<pi> x) = \<pi> x"
   using is_projection_on_fixes_image is_projection_on_in_image assms by blast
 
 proposition projection_idem:
   fixes M :: "'a::chilbert_space set"
   assumes a1: "closed_csubspace M"
   shows "projection M (projection M x) = projection M x"
   by (metis assms closed_csubspace.closed closed_csubspace.subspace complex_vector.subspace_0 csubspace_is_convex equals0D projection_fixes_image projection_in_image)
 
 
 proposition is_projection_on_kernel_is_orthogonal_complement:
   fixes M :: \<open>'a::complex_inner set\<close>
   assumes a1: "is_projection_on \<pi> M" and a2: "closed_csubspace M"
   shows "\<pi> -` {0} = orthogonal_complement M"
 proof-
   have "x \<in> (\<pi> -` {0})"
     if "x \<in> orthogonal_complement M"
     for x
     by (smt (verit, ccfv_SIG) a1 a2 closed_csubspace_def complex_vector.subspace_def complex_vector.subspace_diff is_projection_on_eqI orthogonal_complement_closed_subspace that vimage_singleton_eq)
   moreover have "x \<in> orthogonal_complement M"
     if s1: "x \<in> \<pi> -` {0}" for x
     by (metis a1 a2 diff_zero is_projection_on_iff_orthog that vimage_singleton_eq)
   ultimately show ?thesis
     by blast
 qed
 
 \<comment> \<open>Theorem 2.7 in \<^cite>\<open>conway2013course\<close>\<close>
 proposition projection_kernel_is_orthogonal_complement:
   fixes M :: \<open>'a::chilbert_space set\<close>
   assumes "closed_csubspace M"
   shows "(projection M) -` {0} = (orthogonal_complement M)"
   by (metis assms closed_csubspace_def complex_vector.subspace_def csubspace_is_convex insert_absorb insert_not_empty is_projection_on_kernel_is_orthogonal_complement projection_is_projection_on)
 
 lemma is_projection_on_id_minus:
   fixes M :: \<open>'a::complex_inner set\<close>
   assumes is_proj: "is_projection_on \<pi> M"
     and cc: "closed_csubspace M"
   shows "is_projection_on (id - \<pi>) (orthogonal_complement M)"
   using is_proj apply (simp add: cc is_projection_on_iff_orthog)
   using double_orthogonal_complement_increasing by blast
 
 
 text \<open>Exercise 2 (section 2, chapter I) in  \<^cite>\<open>conway2013course\<close>\<close>
 lemma projection_on_orthogonal_complement[simp]:
   fixes M :: "'a::chilbert_space set"
   assumes a1: "closed_csubspace M"
   shows "projection (orthogonal_complement M) = id - projection M"
   apply (auto intro!: ext)
   by (smt (verit, ccfv_SIG) add_diff_cancel_left' assms closed_csubspace.closed closed_csubspace.subspace complex_vector.subspace_0 csubspace_is_convex diff_add_cancel double_orthogonal_complement_increasing insert_absorb insert_not_empty is_projection_on_iff_orthog orthogonal_complement_closed_subspace projection_eqI projection_is_projection_on subset_eq)
 
 lemma is_projection_on_zero:
   "is_projection_on (\<lambda>_. 0) {0}"
   by (simp add: is_projection_on_def is_arg_min_def)
 
 lemma projection_zero[simp]:
   "projection {0} = (\<lambda>_. 0)"
   using is_projection_on_zero
   by (metis (full_types) is_projection_on_in_image projection_def singletonD someI_ex)
 
 lemma is_projection_on_rank1:
   fixes t :: \<open>'a::complex_inner\<close>
   shows \<open>is_projection_on (\<lambda>x. ((t \<bullet>\<^sub>C x) / (t \<bullet>\<^sub>C t)) *\<^sub>C t) (cspan {t})\<close>
 proof (cases \<open>t = 0\<close>)
   case True
   then show ?thesis
     by (simp add: is_projection_on_zero)
 next
   case False
   define P where \<open>P x = ((t \<bullet>\<^sub>C x) / (t \<bullet>\<^sub>C t)) *\<^sub>C t\<close> for x
   define t' where \<open>t' = t /\<^sub>C norm t\<close>
   with False have \<open>norm t' = 1\<close>
     by (simp add: norm_inverse)
   have P_def': \<open>P x = cinner t' x *\<^sub>C t'\<close> for x
     unfolding P_def t'_def apply auto
     by (metis divide_divide_eq_left divide_inverse mult.commute power2_eq_square power2_norm_eq_cinner)
   have spant': \<open>cspan {t} = cspan {t'}\<close>
     by (simp add: False t'_def)
   have cc: \<open>closed_csubspace (cspan {t})\<close>
     by (auto intro!: finite_cspan_closed closed_csubspace.intro)
   have ortho: \<open>h - P h \<in> orthogonal_complement (cspan {t})\<close> for h
     unfolding orthogonal_complement_def P_def' spant' apply auto
     by (smt (verit, ccfv_threshold) \<open>norm t' = 1\<close> add_cancel_right_left cinner_add_right cinner_commute' cinner_scaleC_right cnorm_eq_1 complex_vector.span_breakdown_eq complex_vector.span_empty diff_add_cancel mult_cancel_left1 singletonD)
   have inspan: \<open>P h \<in> cspan {t}\<close> for h
     unfolding P_def' spant'
     by (simp add: complex_vector.span_base complex_vector.span_scale)
   show \<open>is_projection_on P (cspan {t})\<close>
     apply (subst is_projection_on_iff_orthog)
     using cc ortho inspan by auto
 qed
 
 lemma projection_rank1:
   fixes t x :: \<open>'a::complex_inner\<close>
   shows \<open>projection (cspan {t}) x = ((t \<bullet>\<^sub>C x) / (t \<bullet>\<^sub>C t)) *\<^sub>C t\<close>
   apply (rule fun_cong, rule projection_eqI', simp)
   by (rule is_projection_on_rank1)
 
 subsection \<open>More orthogonal complement\<close>
 
 text \<open>The following lemmas logically fit into the "orthogonality" section but depend on projections for their proofs.\<close>
 
 text \<open>Corollary 2.8 in \<^cite>\<open>conway2013course\<close>\<close>
 theorem double_orthogonal_complement_id[simp]:
   fixes M :: \<open>'a::chilbert_space set\<close>
   assumes a1: "closed_csubspace M"
   shows "orthogonal_complement (orthogonal_complement M) = M"
 proof-
   have b2: "x \<in> (id - projection M) -` {0}"
     if c1: "x \<in> M" for x
     by (simp add: assms projection_fixes_image that)
 
   have b3: \<open>x \<in> M\<close>
     if c1: \<open>x \<in> (id - projection M) -` {0}\<close> for x
     by (metis assms closed_csubspace.closed closed_csubspace.subspace complex_vector.subspace_0 csubspace_is_convex eq_id_iff equals0D fun_diff_def projection_in_image right_minus_eq that vimage_singleton_eq)
   have \<open>x \<in>  M \<longleftrightarrow> x \<in> (id - projection M) -` {0}\<close> for x
     using b2 b3 by blast
   hence b4: \<open>( id - (projection M) ) -` {0} =  M\<close>
     by blast
   have b1: "orthogonal_complement (orthogonal_complement M)
           = (projection (orthogonal_complement M)) -` {0}"
     by (simp add: a1 projection_kernel_is_orthogonal_complement del: projection_on_orthogonal_complement)
   also have \<open>... = ( id - (projection M) ) -` {0}\<close>
     by (simp add: a1)
   also have \<open>... = M\<close>
     by (simp add: b4)
   finally show ?thesis by blast
 qed
 
 lemma orthogonal_complement_antimono_iff[simp]:
   fixes  A B :: \<open>('a::chilbert_space) set\<close>
   assumes \<open>closed_csubspace A\<close> and  \<open>closed_csubspace B\<close>
   shows \<open>orthogonal_complement A \<subseteq> orthogonal_complement B \<longleftrightarrow> A \<supseteq> B\<close>
 proof (rule iffI)
   show \<open>orthogonal_complement A \<subseteq> orthogonal_complement B\<close> if \<open>A \<supseteq> B\<close>
     using that by auto
 
   assume \<open>orthogonal_complement A \<subseteq> orthogonal_complement B\<close>
   then have \<open>orthogonal_complement (orthogonal_complement A) \<supseteq> orthogonal_complement (orthogonal_complement B)\<close>
     by simp
   then show \<open>A \<supseteq> B\<close>
     using assms by auto
 qed
 
 lemma de_morgan_orthogonal_complement_plus:
   fixes A B::"('a::complex_inner) set"
   assumes \<open>0 \<in> A\<close> and \<open>0 \<in> B\<close>
   shows \<open>orthogonal_complement (A +\<^sub>M B) = orthogonal_complement A \<inter> orthogonal_complement B\<close>
 proof -
   have "x \<in> (orthogonal_complement A) \<inter> (orthogonal_complement B)"
     if "x \<in> orthogonal_complement (A +\<^sub>M B)" for x
   proof -
     have \<open>orthogonal_complement (A +\<^sub>M B) = orthogonal_complement (A + B)\<close>
       unfolding closed_sum_def by (subst orthogonal_complement_of_closure[symmetric], simp)
     hence \<open>x \<in> orthogonal_complement (A + B)\<close>
       using that by blast
     hence t1: \<open>\<forall>z \<in> (A + B). (z \<bullet>\<^sub>C x) = 0\<close>
       by (simp add: orthogonal_complement_orthoI')
     have \<open>A \<subseteq> A + B\<close>
       using subset_iff add.commute set_zero_plus2 \<open>0 \<in> B\<close>
       by fastforce
     hence \<open>\<forall>z \<in> A. (z \<bullet>\<^sub>C x) = 0\<close>
       using t1 by auto
     hence w1: \<open>x \<in> (orthogonal_complement A)\<close>
       by (smt mem_Collect_eq is_orthogonal_sym orthogonal_complement_def)
     have \<open>B \<subseteq> A + B\<close>
       using \<open>0 \<in> A\<close> subset_iff set_zero_plus2 by blast
     hence \<open>\<forall> z \<in> B. (z \<bullet>\<^sub>C x) = 0\<close>
       using t1 by auto
     hence \<open>x \<in> (orthogonal_complement B)\<close>
       by (smt mem_Collect_eq is_orthogonal_sym orthogonal_complement_def)
     thus ?thesis
       using w1 by auto
   qed
   moreover have "x \<in> (orthogonal_complement (A +\<^sub>M B))"
     if v1: "x \<in> (orthogonal_complement A) \<inter> (orthogonal_complement B)"
     for x
   proof-
     have \<open>x \<in> (orthogonal_complement A)\<close>
       using v1
       by blast
     hence \<open>\<forall>y\<in> A. (y \<bullet>\<^sub>C x) = 0\<close>
       by (simp add: orthogonal_complement_orthoI')
     have \<open>x \<in> (orthogonal_complement B)\<close>
       using v1
       by blast
     hence \<open>\<forall> y\<in> B. (y \<bullet>\<^sub>C x) = 0\<close>
       by (simp add: orthogonal_complement_orthoI')
     have \<open>\<forall> a\<in>A. \<forall> b\<in>B. (a+b) \<bullet>\<^sub>C x = 0\<close>
       by (simp add: \<open>\<forall>y\<in>A. y \<bullet>\<^sub>C x = 0\<close> \<open>\<forall>y\<in>B. (y \<bullet>\<^sub>C x) = 0\<close> cinner_add_left)
     hence \<open>\<forall> y \<in> (A + B). y \<bullet>\<^sub>C x = 0\<close>
       using set_plus_elim by force
     hence \<open>x \<in> (orthogonal_complement (A + B))\<close>
       by (smt mem_Collect_eq is_orthogonal_sym orthogonal_complement_def)
     moreover have \<open>(orthogonal_complement (A + B)) = (orthogonal_complement (A +\<^sub>M B))\<close>
       unfolding closed_sum_def by (subst orthogonal_complement_of_closure[symmetric], simp)
     ultimately have \<open>x \<in> (orthogonal_complement (A +\<^sub>M B))\<close>
       by blast
     thus ?thesis
       by blast
   qed
   ultimately show ?thesis by blast
 qed
 
 lemma de_morgan_orthogonal_complement_inter:
   fixes A B::"'a::chilbert_space set"
   assumes a1: \<open>closed_csubspace A\<close> and a2: \<open>closed_csubspace B\<close>
   shows  \<open>orthogonal_complement (A \<inter> B) = orthogonal_complement A +\<^sub>M orthogonal_complement B\<close>
 proof-
   have \<open>orthogonal_complement A +\<^sub>M orthogonal_complement B
     = orthogonal_complement (orthogonal_complement (orthogonal_complement A +\<^sub>M orthogonal_complement B))\<close>
     by (simp add: closed_subspace_closed_sum)
   also have \<open>\<dots> = orthogonal_complement (orthogonal_complement (orthogonal_complement A) \<inter> orthogonal_complement (orthogonal_complement B))\<close>
     by (simp add: de_morgan_orthogonal_complement_plus orthogonal_complementI)
   also have \<open>\<dots> = orthogonal_complement (A \<inter> B)\<close>
     by (simp add: a1 a2)
   finally show ?thesis
     by simp
 qed
 
 lemma orthogonal_complement_of_cspan: \<open>orthogonal_complement A = orthogonal_complement (cspan A)\<close>
   by (metis (no_types, opaque_lifting) closed_csubspace.subspace complex_vector.span_minimal complex_vector.span_superset double_orthogonal_complement_increasing orthogonal_complement_antimono orthogonal_complement_closed_subspace subset_antisym)
 
 lemma orthogonal_complement_orthogonal_complement_closure_cspan:
   \<open>orthogonal_complement (orthogonal_complement S) = closure (cspan S)\<close> for S :: \<open>'a::chilbert_space set\<close>
 proof -
   have \<open>orthogonal_complement (orthogonal_complement S) = orthogonal_complement (orthogonal_complement (closure (cspan S)))\<close>
     by (simp flip: orthogonal_complement_of_closure orthogonal_complement_of_cspan)
   also have \<open>\<dots> = closure (cspan S)\<close>
     by simp
   finally show \<open>orthogonal_complement (orthogonal_complement S) = closure (cspan S)\<close>
     by -
 qed
 
 instance ccsubspace :: (chilbert_space) complete_orthomodular_lattice
 proof
   fix X Y :: \<open>'a ccsubspace\<close>
 
   show "inf X (- X) = bot"
     apply transfer
     by (simp add: closed_csubspace_def complex_vector.subspace_0 orthogonal_complement_zero_intersection)
 
   have \<open>t \<in> M +\<^sub>M orthogonal_complement M\<close>
     if \<open>closed_csubspace M\<close> for t::'a and M
     by (metis (no_types, lifting) UNIV_I closed_csubspace.subspace complex_vector.subspace_def de_morgan_orthogonal_complement_inter double_orthogonal_complement_id orthogonal_complement_closed_subspace orthogonal_complement_zero orthogonal_complement_zero_intersection that)
   hence b1: \<open>M +\<^sub>M orthogonal_complement M = UNIV\<close>
     if \<open>closed_csubspace M\<close> for M :: \<open>'a set\<close>
     using that by blast
   show "sup X (- X) = top"
     apply transfer
     using b1 by auto
   show "- (- X) = X"
     apply transfer by simp
 
   show "- Y \<le> - X"
     if "X \<le> Y"
     using that apply transfer by simp
 
   have c1: "M +\<^sub>M orthogonal_complement M \<inter> N \<subseteq> N"
     if "closed_csubspace M" and "closed_csubspace N" and "M \<subseteq> N"
     for M N :: "'a set"
     using that
     by (simp add: closed_sum_is_sup)
 
   have c2: \<open>u \<in> M +\<^sub>M (orthogonal_complement M \<inter> N)\<close>
     if a1: "closed_csubspace M" and a2: "closed_csubspace N" and a3: "M \<subseteq> N" and x1: \<open>u \<in> N\<close>
     for M :: "'a set" and N :: "'a set"  and u
   proof -
     have d4: \<open>(projection M) u \<in> M\<close>
       by (metis a1 closed_csubspace_def csubspace_is_convex equals0D orthog_proj_exists projection_in_image)
     hence d2: \<open>(projection M) u \<in> N\<close>
       using a3 by auto
     have d1: \<open>csubspace N\<close>
       by (simp add: a2)
     have \<open>u - (projection M) u \<in> orthogonal_complement M\<close>
       by (simp add: a1 orthogonal_complementI projection_orthogonal)
     moreover have  \<open>u - (projection M) u \<in> N\<close>
       by (simp add: d1 d2 complex_vector.subspace_diff x1)
     ultimately have d3: \<open>u - (projection M) u \<in> ((orthogonal_complement M) \<inter> N)\<close>
       by simp
     hence \<open>\<exists> v \<in> ((orthogonal_complement M) \<inter> N). u = (projection M) u + v\<close>
       by (metis d3 diff_add_cancel ordered_field_class.sign_simps(2))
     then obtain v where \<open>v \<in> ((orthogonal_complement M) \<inter> N)\<close> and \<open>u = (projection M) u + v\<close>
       by blast
     hence \<open>u \<in> M + ((orthogonal_complement M) \<inter> N)\<close>
       by (metis d4 set_plus_intro)
     thus ?thesis
       unfolding closed_sum_def
       using closure_subset by blast
   qed
 
   have c3: "N \<subseteq> M +\<^sub>M ((orthogonal_complement M) \<inter> N)"
     if "closed_csubspace M" and "closed_csubspace N" and "M \<subseteq> N"
     for M N :: "'a set"
     using c2 that by auto
 
   show "sup X (inf (- X) Y) = Y"
     if "X \<le> Y"
     using that apply transfer
     using c1 c3
     by (simp add: subset_antisym)
 
   show "X - Y = inf X (- Y)"
     apply transfer by simp
 qed
 
 subsection \<open>Orthogonal spaces\<close>
 
 definition \<open>orthogonal_spaces S T \<longleftrightarrow> (\<forall>x\<in>space_as_set S. \<forall>y\<in>space_as_set T. is_orthogonal x y)\<close>
 
 lemma orthogonal_spaces_leq_compl: \<open>orthogonal_spaces S T \<longleftrightarrow> S \<le> -T\<close>
   unfolding orthogonal_spaces_def apply transfer
   by (auto simp: orthogonal_complement_def)
 
 lemma orthogonal_bot[simp]: \<open>orthogonal_spaces S bot\<close>
   by (simp add: orthogonal_spaces_def)
 
 lemma orthogonal_spaces_sym: \<open>orthogonal_spaces S T \<Longrightarrow> orthogonal_spaces T S\<close>
   unfolding orthogonal_spaces_def
   using is_orthogonal_sym by blast
 
 lemma orthogonal_sup: \<open>orthogonal_spaces S T1 \<Longrightarrow> orthogonal_spaces S T2 \<Longrightarrow> orthogonal_spaces S (sup T1 T2)\<close>
   apply (rule orthogonal_spaces_sym)
   apply (simp add: orthogonal_spaces_leq_compl)
   using orthogonal_spaces_leq_compl orthogonal_spaces_sym by blast
 
 lemma orthogonal_sum:
   assumes \<open>finite F\<close> and \<open>\<And>x. x\<in>F \<Longrightarrow> orthogonal_spaces S (T x)\<close> 
   shows \<open>orthogonal_spaces S (sum T F)\<close>
   using assms
   apply induction
   by (auto intro!: orthogonal_sup)
 
 lemma orthogonal_spaces_ccspan: \<open>(\<forall>x\<in>S. \<forall>y\<in>T. is_orthogonal x y) \<longleftrightarrow> orthogonal_spaces (ccspan S) (ccspan T)\<close>
   by (meson ccspan_leq_ortho_ccspan ccspan_superset orthogonal_spaces_def orthogonal_spaces_leq_compl subset_iff)
 
 subsection \<open>Orthonormal bases\<close>
 
 lemma ortho_basis_exists: 
   fixes S :: \<open>'a::chilbert_space set\<close>
   assumes \<open>is_ortho_set S\<close>
   shows \<open>\<exists>B. B \<supseteq> S \<and> is_ortho_set B \<and> closure (cspan B) = UNIV\<close>
 proof -
   define on where \<open>on B \<longleftrightarrow> B \<supseteq> S \<and> is_ortho_set B\<close> for B :: \<open>'a set\<close>
   have \<open>\<exists>B\<in>Collect on. \<forall>B'\<in>Collect on. B \<subseteq> B' \<longrightarrow> B' = B\<close>
   proof (rule subset_Zorn_nonempty; simp)
     show \<open>\<exists>S. on S\<close>
       apply (rule exI[of _ S])
       using assms on_def by fastforce
   next
     fix C :: \<open>'a set set\<close>
     assume \<open>C \<noteq> {}\<close>
     assume \<open>subset.chain (Collect on) C\<close>
     then have C_on: \<open>B \<in> C \<Longrightarrow> on B\<close> and C_order: \<open>B \<in> C \<Longrightarrow> B' \<in> C \<Longrightarrow> B \<subseteq> B' \<or> B' \<subseteq> B\<close> for B B'
       by (auto simp: subset.chain_def)
     have \<open>is_orthogonal x y\<close> if \<open>x\<in>\<Union>C\<close> \<open>y\<in>\<Union>C\<close> \<open>x \<noteq> y\<close> for x y
       by (smt (verit) UnionE C_order C_on on_def is_ortho_set_def subsetD that(1) that(2) that(3))
     moreover have \<open>0 \<notin> \<Union> C\<close>
       by (meson UnionE C_on is_ortho_set_def on_def)
     moreover have \<open>\<Union>C \<supseteq> S\<close>
       using C_on \<open>C \<noteq> {}\<close> on_def by blast
     ultimately show \<open>on (\<Union> C)\<close>
       unfolding on_def is_ortho_set_def by simp
   qed
   then obtain B where \<open>on B\<close> and B_max: \<open>B' \<supseteq> B \<Longrightarrow> on B' \<Longrightarrow> B=B'\<close> for B'
     by auto
   have \<open>\<psi> = 0\<close> if \<psi>ortho: \<open>\<forall>b\<in>B. is_orthogonal \<psi> b\<close> for \<psi> :: 'a
   proof (rule ccontr)
     assume \<open>\<psi> \<noteq> 0\<close>
     define \<phi> B' where \<open>\<phi> = \<psi> /\<^sub>R norm \<psi>\<close> and \<open>B' = B \<union> {\<phi>}\<close>
     have [simp]: \<open>norm \<phi> = 1\<close>
       using \<open>\<psi> \<noteq> 0\<close> by (auto simp: \<phi>_def)
     have \<phi>ortho: \<open>is_orthogonal \<phi> b\<close> if \<open>b \<in> B\<close> for b
       using \<psi>ortho that \<phi>_def  by auto
     have orthoB': \<open>is_orthogonal x y\<close> if \<open>x\<in>B'\<close> \<open>y\<in>B'\<close> \<open>x \<noteq> y\<close> for x y
       using that \<open>on B\<close> \<phi>ortho \<phi>ortho[THEN is_orthogonal_sym[THEN iffD1]]
       by (auto simp: B'_def on_def is_ortho_set_def)
     have B'0: \<open>0 \<notin> B'\<close>
       using B'_def \<open>norm \<phi> = 1\<close> \<open>on B\<close> is_ortho_set_def on_def by fastforce
     have \<open>S \<subseteq> B'\<close>
       using B'_def \<open>on B\<close> on_def by auto
     from orthoB' B'0 \<open>S \<subseteq> B'\<close> have \<open>on B'\<close>
       by (simp add: on_def is_ortho_set_def)
     with B_max have \<open>B = B'\<close>
       by (metis B'_def Un_upper1)
     then have \<open>\<phi> \<in> B\<close>
       using B'_def by blast
     then have \<open>is_orthogonal \<phi> \<phi>\<close>
       using \<phi>ortho by blast
     then show False
       using B'0 \<open>B = B'\<close> \<open>\<phi> \<in> B\<close> by fastforce
   qed 
   then have \<open>orthogonal_complement B = {0}\<close>
     by (auto simp: orthogonal_complement_def)
   then have \<open>UNIV = orthogonal_complement (orthogonal_complement B)\<close>
     by simp
   also have \<open>\<dots> = orthogonal_complement (orthogonal_complement (closure (cspan B)))\<close>
     by (metis (mono_tags, opaque_lifting) \<open>orthogonal_complement B = {0}\<close> cinner_zero_left complex_vector.span_superset empty_iff insert_iff orthogonal_complementI orthogonal_complement_antimono orthogonal_complement_of_closure subsetI subset_antisym)
   also have \<open>\<dots> = closure (cspan B)\<close>
     apply (rule double_orthogonal_complement_id)
     by simp
   finally have \<open>closure (cspan B) = UNIV\<close>
     by simp
   with \<open>on B\<close> show ?thesis
     by (auto simp: on_def)
 qed
 
 lemma orthonormal_basis_exists: 
   fixes S :: \<open>'a::chilbert_space set\<close>
   assumes \<open>is_ortho_set S\<close> and \<open>\<And>x. x\<in>S \<Longrightarrow> norm x = 1\<close>
   shows \<open>\<exists>B. B \<supseteq> S \<and> is_onb B\<close>
 proof -
   from \<open>is_ortho_set S\<close>
   obtain B where \<open>is_ortho_set B\<close> and \<open>B \<supseteq> S\<close> and \<open>closure (cspan B) = UNIV\<close>
     using ortho_basis_exists by blast
   define B' where \<open>B' = (\<lambda>x. x /\<^sub>R norm x) ` B\<close>
   have \<open>S = (\<lambda>x. x /\<^sub>R norm x) ` S\<close>
     by (simp add: assms(2))
   then have \<open>B' \<supseteq> S\<close>
     using B'_def \<open>S \<subseteq> B\<close> by blast
   moreover 
   have \<open>ccspan B' = top\<close>
     apply (transfer fixing: B')
     apply (simp add: B'_def scaleR_scaleC)
     apply (subst complex_vector.span_image_scale')
     using \<open>is_ortho_set B\<close> \<open>closure (cspan B) = UNIV\<close> is_ortho_set_def 
     by auto
   moreover have \<open>is_ortho_set B'\<close>
     using \<open>is_ortho_set B\<close> by (auto simp: B'_def is_ortho_set_def)
   moreover have \<open>\<forall>b\<in>B'. norm b = 1\<close>
     using \<open>is_ortho_set B\<close> apply (auto simp: B'_def is_ortho_set_def)
     by (metis field_class.field_inverse norm_eq_zero)
   ultimately show ?thesis
     by (auto simp: is_onb_def)
 qed
 
 
 definition some_chilbert_basis :: \<open>'a::chilbert_space set\<close> where
   \<open>some_chilbert_basis = (SOME B::'a set. is_onb B)\<close>
 
 lemma is_onb_some_chilbert_basis[simp]: \<open>is_onb (some_chilbert_basis :: 'a::chilbert_space set)\<close>
   using orthonormal_basis_exists[OF is_ortho_set_empty]
   by (auto simp add: some_chilbert_basis_def intro: someI2)
 
 lemma is_ortho_set_some_chilbert_basis[simp]: \<open>is_ortho_set some_chilbert_basis\<close>
   using is_onb_def is_onb_some_chilbert_basis by blast
 
 lemma is_normal_some_chilbert_basis: \<open>\<And>x. x \<in> some_chilbert_basis \<Longrightarrow> norm x = 1\<close>
   using is_onb_def is_onb_some_chilbert_basis by blast
 
 lemma ccspan_some_chilbert_basis[simp]: \<open>ccspan some_chilbert_basis = top\<close>
   using is_onb_def is_onb_some_chilbert_basis by blast
 
 lemma span_some_chilbert_basis[simp]: \<open>closure (cspan some_chilbert_basis) = UNIV\<close>
   by (metis ccspan.rep_eq ccspan_some_chilbert_basis top_ccsubspace.rep_eq)
 
 lemma cindependent_some_chilbert_basis[simp]: \<open>cindependent some_chilbert_basis\<close>
   using is_ortho_set_cindependent is_ortho_set_some_chilbert_basis by blast
 
 lemma finite_some_chilbert_basis[simp]: \<open>finite (some_chilbert_basis :: 'a :: {chilbert_space, cfinite_dim} set)\<close>
   apply (rule cindependent_cfinite_dim_finite)
   by simp
 
 lemma some_chilbert_basis_nonempty: \<open>(some_chilbert_basis :: 'a::{chilbert_space, not_singleton} set) \<noteq> {}\<close>
 proof (rule ccontr, simp)
   define B :: \<open>'a set\<close> where \<open>B = some_chilbert_basis\<close>
   assume [simp]: \<open>B = {}\<close>
   have \<open>UNIV = closure (cspan B)\<close>
     using B_def span_some_chilbert_basis by blast
   also have \<open>\<dots> = {0}\<close>
     by simp
   also have \<open>\<dots> \<noteq> UNIV\<close>
     using Extra_General.UNIV_not_singleton by blast
   finally show False
     by simp
 qed
 
 lemma basis_projections_reconstruct_has_sum:
   assumes \<open>is_ortho_set B\<close> and normB: \<open>\<And>b. b\<in>B \<Longrightarrow> norm b = 1\<close> and \<psi>B: \<open>\<psi> \<in> space_as_set (ccspan B)\<close>
   shows \<open>((\<lambda>b. (b \<bullet>\<^sub>C \<psi>) *\<^sub>C b) has_sum \<psi>) B\<close>
 proof (rule has_sumI_metric)
   fix e :: real assume \<open>e > 0\<close>
   define e2 where \<open>e2 = e/2\<close>
   have [simp]: \<open>e2 > 0\<close>
     by (simp add: \<open>0 < e\<close> e2_def)
   define bb where \<open>bb \<phi> b = (b \<bullet>\<^sub>C \<phi>) *\<^sub>C b\<close> for \<phi> and b :: 'a
   have linear_bb: \<open>clinear (\<lambda>\<phi>. bb \<phi> b)\<close> for b
     by (simp add: bb_def cinner_add_right clinear_iff scaleC_left.add)
   from \<psi>B obtain \<phi> where dist\<phi>\<psi>: \<open>dist \<phi> \<psi> < e2\<close> and \<phi>B: \<open>\<phi> \<in> cspan B\<close>
     apply atomize_elim apply (simp add: ccspan.rep_eq closure_approachable)
     using \<open>0 < e2\<close> by blast
   from \<phi>B obtain F where \<open>finite F\<close> and \<open>F \<subseteq> B\<close> and \<phi>F: \<open>\<phi> \<in> cspan F\<close>
     by (meson vector_finitely_spanned)
   have \<open>dist (sum (bb \<psi>) G) \<psi> < e\<close> 
     if \<open>finite G\<close> and \<open>F \<subseteq> G\<close> and \<open>G \<subseteq> B\<close> for G
   proof -
     have sum\<phi>: \<open>sum (bb \<phi>) G = \<phi>\<close>
     proof -
       from \<phi>F \<open>F \<subseteq> G\<close> have \<phi>G: \<open>\<phi> \<in> cspan G\<close>
         using complex_vector.span_mono by blast
       then obtain f where \<phi>sum: \<open>\<phi> = (\<Sum>b\<in>G. f b *\<^sub>C b)\<close>
         using complex_vector.span_finite[OF \<open>finite G\<close>] 
         by auto
       have \<open>sum (bb \<phi>) G = (\<Sum>c\<in>G. \<Sum>b\<in>G. bb (f b *\<^sub>C b) c)\<close>
         apply (simp add: \<phi>sum)
         apply (rule sum.cong, simp)
         apply (rule complex_vector.linear_sum[where f=\<open>\<lambda>x. bb x _\<close>])
         by (rule linear_bb)
       also have \<open>\<dots> = (\<Sum>(c,b)\<in>G\<times>G. bb (f b *\<^sub>C b) c)\<close>
         by (simp add: sum.cartesian_product)
       also have \<open>\<dots> = (\<Sum>b\<in>G. f b *\<^sub>C b)\<close>
         apply (rule sym)
         apply (rule sum.reindex_bij_witness_not_neutral
             [where j=\<open>\<lambda>b. (b,b)\<close> and i=fst and T'=\<open>G\<times>G - (\<lambda>b. (b,b)) ` G\<close> and S'=\<open>{}\<close>])
         using \<open>finite G\<close> apply (auto simp: bb_def)
          apply (metis (no_types, lifting) assms(1) imageI is_ortho_set_antimono is_ortho_set_def that(3))
         using normB \<open>G \<subseteq> B\<close> cnorm_eq_1 by blast
       also have \<open>\<dots> = \<phi>\<close>
         by (simp flip: \<phi>sum)
       finally show ?thesis
         by -
     qed
     have \<open>dist (sum (bb \<phi>) G) (sum (bb \<psi>) G) < e2\<close>
     proof -
       define \<gamma> where \<open>\<gamma> = \<phi> - \<psi>\<close>
       have \<open>(dist (sum (bb \<phi>) G) (sum (bb \<psi>) G))\<^sup>2 = (norm (sum (bb \<gamma>) G))\<^sup>2\<close>
         by (simp add: dist_norm \<gamma>_def complex_vector.linear_diff[OF linear_bb] sum_subtractf)
       also have \<open>\<dots> = (norm (sum (bb \<gamma>) G))\<^sup>2 + (norm (\<gamma> - sum (bb \<gamma>) G))\<^sup>2 - (norm (\<gamma> - sum (bb \<gamma>) G))\<^sup>2\<close>
         by simp
       also have \<open>\<dots> = (norm (sum (bb \<gamma>) G + (\<gamma> - sum (bb \<gamma>) G)))\<^sup>2 - (norm (\<gamma> - sum (bb \<gamma>) G))\<^sup>2\<close>
       proof -
         have \<open>(\<Sum>b\<in>G. bb \<gamma> b \<bullet>\<^sub>C bb \<gamma> c) = bb \<gamma> c \<bullet>\<^sub>C \<gamma>\<close> if \<open>c \<in> G\<close> for c
           apply (subst sum_single[where i=c])
           using that apply (auto intro!: \<open>finite G\<close> simp: bb_def)
            apply (metis \<open>G \<subseteq> B\<close> \<open>is_ortho_set B\<close> is_ortho_set_antimono is_ortho_set_def)
           using \<open>G \<subseteq> B\<close> normB cnorm_eq_1 by blast
         then have \<open>is_orthogonal (sum (bb \<gamma>) G) (\<gamma> - sum (bb \<gamma>) G)\<close>
           by (simp add: cinner_sum_left cinner_diff_right cinner_sum_right)
         then show ?thesis
           apply (rule_tac arg_cong[where f=\<open>\<lambda>x. x - _\<close>])
           by (rule pythagorean_theorem[symmetric])
       qed
       also have \<open>\<dots> = (norm \<gamma>)\<^sup>2 - (norm (\<gamma> - sum (bb \<gamma>) G))\<^sup>2\<close>
         by simp
       also have \<open>\<dots> \<le> (norm \<gamma>)\<^sup>2\<close>
         by simp
       also have \<open>\<dots> = (dist \<phi> \<psi>)\<^sup>2\<close>
         by (simp add: \<gamma>_def dist_norm)
       also have \<open>\<dots> < e2\<^sup>2\<close>
         using dist\<phi>\<psi> apply (rule power_strict_mono)
         by auto
       finally show ?thesis
         by (smt (verit) \<open>0 < e2\<close> power_mono)
     qed
     with sum\<phi> dist\<phi>\<psi> show \<open>dist (sum (bb \<psi>) G) \<psi> < e\<close>
       apply (rule_tac dist_triangle_lt[where z=\<phi>])
       by (simp add: e2_def dist_commute)
   qed
   with \<open>finite F\<close> and \<open>F \<subseteq> B\<close> 
   show \<open>\<exists>F. finite F \<and>
              F \<subseteq> B \<and> (\<forall>G. finite G \<and> F \<subseteq> G \<and> G \<subseteq> B \<longrightarrow> dist (sum (bb \<psi>) G) \<psi> < e)\<close>
     by (auto intro!: exI[of _ F])
 qed
 
 lemma basis_projections_reconstruct:
   assumes \<open>is_ortho_set B\<close> and \<open>\<And>b. b\<in>B \<Longrightarrow> norm b = 1\<close> and \<open>\<psi> \<in> space_as_set (ccspan B)\<close>
   shows \<open>(\<Sum>\<^sub>\<infinity>b\<in>B. (b \<bullet>\<^sub>C \<psi>) *\<^sub>C b) = \<psi>\<close>
   using assms basis_projections_reconstruct_has_sum infsumI by blast
 
 lemma basis_projections_reconstruct_summable:
   assumes \<open>is_ortho_set B\<close> and \<open>\<And>b. b\<in>B \<Longrightarrow> norm b = 1\<close> and \<open>\<psi> \<in> space_as_set (ccspan B)\<close>
   shows \<open>(\<lambda>b. (b \<bullet>\<^sub>C \<psi>) *\<^sub>C b) summable_on B\<close>
   by (simp add: assms basis_projections_reconstruct basis_projections_reconstruct_has_sum summable_iff_has_sum_infsum)
 
 lemma parseval_identity_has_sum:
   assumes \<open>is_ortho_set B\<close> and normB: \<open>\<And>b. b\<in>B \<Longrightarrow> norm b = 1\<close> and \<open>\<psi> \<in> space_as_set (ccspan B)\<close>
   shows \<open>((\<lambda>b. (norm (b \<bullet>\<^sub>C \<psi>))\<^sup>2) has_sum (norm \<psi>)\<^sup>2) B\<close>
 proof -
   have *: \<open>(\<lambda>v. (norm v)\<^sup>2) (\<Sum>b\<in>F. (b \<bullet>\<^sub>C \<psi>) *\<^sub>C b) = (\<Sum>b\<in>F. (norm (b \<bullet>\<^sub>C \<psi>))\<^sup>2)\<close> if \<open>finite F\<close> and \<open>F \<subseteq> B\<close> for F
     apply (subst pythagorean_theorem_sum)
     using \<open>is_ortho_set B\<close> normB that
       apply (auto intro!: sum.cong[OF refl] simp: is_ortho_set_def)
     by blast
   
   from assms have \<open>((\<lambda>b. (b \<bullet>\<^sub>C \<psi>) *\<^sub>C b) has_sum \<psi>) B\<close>
     by (simp add: basis_projections_reconstruct_has_sum)
   then have \<open>((\<lambda>F. \<Sum>b\<in>F. (b \<bullet>\<^sub>C \<psi>) *\<^sub>C b) \<longlongrightarrow> \<psi>) (finite_subsets_at_top B)\<close>
     by (simp add: has_sum_def)
   then have \<open>((\<lambda>F. (\<lambda>v. (norm v)\<^sup>2) (\<Sum>b\<in>F. (b \<bullet>\<^sub>C \<psi>) *\<^sub>C b)) \<longlongrightarrow> (norm \<psi>)\<^sup>2) (finite_subsets_at_top B)\<close>
     apply (rule isCont_tendsto_compose[rotated])
     by simp
   then have \<open>((\<lambda>F. (\<Sum>b\<in>F. (norm (b \<bullet>\<^sub>C \<psi>))\<^sup>2)) \<longlongrightarrow> (norm \<psi>)\<^sup>2) (finite_subsets_at_top B)\<close>
     apply (rule tendsto_cong[THEN iffD2, rotated])
     apply (rule eventually_finite_subsets_at_top_weakI)
     by (simp add: *)
   then show \<open>((\<lambda>b. (norm (b \<bullet>\<^sub>C \<psi>))\<^sup>2) has_sum (norm \<psi>)\<^sup>2) B\<close>
     by (simp add: has_sum_def)
 qed
 
 lemma parseval_identity_summable:
   assumes \<open>is_ortho_set B\<close> and \<open>\<And>b. b\<in>B \<Longrightarrow> norm b = 1\<close> and \<open>\<psi> \<in> space_as_set (ccspan B)\<close>
   shows \<open>(\<lambda>b. (norm (b \<bullet>\<^sub>C \<psi>))\<^sup>2) summable_on B\<close>
   using parseval_identity_has_sum[OF assms] has_sum_imp_summable by blast
 
 lemma parseval_identity:
   assumes \<open>is_ortho_set B\<close> and \<open>\<And>b. b\<in>B \<Longrightarrow> norm b = 1\<close> and \<open>\<psi> \<in> space_as_set (ccspan B)\<close>
   shows \<open>(\<Sum>\<^sub>\<infinity>b\<in>B. (norm (b \<bullet>\<^sub>C \<psi>))\<^sup>2) = (norm \<psi>)\<^sup>2\<close>
   using parseval_identity_has_sum[OF assms]
   using infsumI by blast
 
 
 subsection \<open>Riesz-representation theorem\<close>
 
 lemma orthogonal_complement_kernel_functional:
   fixes f :: \<open>'a::complex_inner \<Rightarrow> complex\<close>
   assumes \<open>bounded_clinear f\<close>
   shows \<open>\<exists>x. orthogonal_complement (f -` {0}) = cspan {x}\<close>
 proof (cases \<open>orthogonal_complement (f -` {0}) = {0}\<close>)
   case True
   then show ?thesis
     apply (rule_tac x=0 in exI) by auto
 next
   case False
   then obtain x where xortho: \<open>x \<in> orthogonal_complement (f -` {0})\<close> and xnon0: \<open>x \<noteq> 0\<close>
     using complex_vector.subspace_def by fastforce
 
   from xnon0 xortho
   have r1: \<open>f x \<noteq> 0\<close>
     by (metis cinner_eq_zero_iff orthogonal_complement_orthoI vimage_singleton_eq)
 
   have \<open>\<exists> k. y = k *\<^sub>C x\<close> if \<open>y \<in> orthogonal_complement (f -` {0})\<close> for y
   proof (cases \<open>y = 0\<close>)
     case True
     then show ?thesis by auto
   next
     case False
     with that
     have \<open>f y \<noteq> 0\<close>
       by (metis cinner_eq_zero_iff orthogonal_complement_orthoI vimage_singleton_eq)
     then obtain k where k_def: \<open>f x = k * f y\<close>
       by (metis add.inverse_inverse minus_divide_eq_eq)
     with assms have \<open>f x = f (k *\<^sub>C y)\<close>
       by (simp add: bounded_clinear.axioms(1) clinear.scaleC)
     hence \<open>f x - f (k *\<^sub>C y) = 0\<close>
       by simp
     with assms have s1: \<open>f (x - k *\<^sub>C y) = 0\<close>
       by (simp add: bounded_clinear.axioms(1) complex_vector.linear_diff)
     from that have \<open>k *\<^sub>C y \<in> orthogonal_complement (f -` {0})\<close>
       by (simp add: complex_vector.subspace_scale)
     with xortho have s2: \<open>x - (k *\<^sub>C y) \<in> orthogonal_complement (f -` {0})\<close>
       by (simp add: complex_vector.subspace_diff)
     have s3: \<open>(x - (k *\<^sub>C y)) \<in> f -` {0}\<close>
       using s1 by simp
     moreover have \<open>(f -` {0}) \<inter> (orthogonal_complement (f -` {0})) = {0}\<close>
       by (meson assms closed_csubspace_def complex_vector.subspace_def kernel_is_closed_csubspace
           orthogonal_complement_zero_intersection)
     ultimately have \<open>x - (k *\<^sub>C y) = 0\<close>
       using s2 by blast
     thus ?thesis
       by (metis ceq_vector_fraction_iff eq_iff_diff_eq_0 k_def r1 scaleC_scaleC)
   qed
   then have \<open>orthogonal_complement (f -` {0}) \<subseteq> cspan {x}\<close>
     using complex_vector.span_superset complex_vector.subspace_scale by blast
 
   moreover from xortho have \<open>orthogonal_complement (f -` {0}) \<supseteq> cspan {x}\<close>
     by (simp add: complex_vector.span_minimal)
 
   ultimately show ?thesis
     by auto
 qed
 
-lemma riesz_frechet_representation_existence:
+lemma riesz_representation_existence:
   \<comment> \<open>Theorem 3.4 in \<^cite>\<open>conway2013course\<close>\<close>
   fixes f::\<open>'a::chilbert_space \<Rightarrow> complex\<close>
   assumes a1: \<open>bounded_clinear f\<close>
   shows \<open>\<exists>t. \<forall>x.  f x = t \<bullet>\<^sub>C x\<close>
 proof(cases \<open>\<forall> x. f x = 0\<close>)
   case True
   thus ?thesis
     by (metis cinner_zero_left)
 next
   case False
   obtain t where spant: \<open>orthogonal_complement (f -` {0}) = cspan {t}\<close>
     using orthogonal_complement_kernel_functional
     using assms by blast
   have \<open>projection (orthogonal_complement (f -` {0})) x = ((t \<bullet>\<^sub>C x)/(t \<bullet>\<^sub>C t)) *\<^sub>C t\<close> for x
     apply (subst spant) by (rule projection_rank1)
   hence \<open>f (projection (orthogonal_complement (f -` {0})) x) = (((t \<bullet>\<^sub>C x))/(t \<bullet>\<^sub>C t)) * (f t)\<close> for x
     using a1 unfolding bounded_clinear_def
     by (simp add: complex_vector.linear_scale)
   hence l2: \<open>f (projection (orthogonal_complement (f -` {0})) x) = ((cnj (f t)/(t \<bullet>\<^sub>C t)) *\<^sub>C t) \<bullet>\<^sub>C x\<close> for x
     using complex_cnj_divide by force
   have \<open>f (projection (f -` {0}) x) = 0\<close> for x
     by (metis (no_types, lifting) assms bounded_clinear_def closed_csubspace.closed
         complex_vector.linear_subspace_vimage complex_vector.subspace_0 complex_vector.subspace_single_0
         csubspace_is_convex insert_absorb insert_not_empty kernel_is_closed_csubspace projection_in_image vimage_singleton_eq)
   hence "\<And>a b. f (projection (f -` {0}) a + b) = 0 + f b"
     using additive.add assms
     by (simp add: bounded_clinear_def complex_vector.linear_add)
   hence "\<And>a. 0 + f (projection (orthogonal_complement (f -` {0})) a) = f a"
     apply (simp add: assms)
     by (metis add.commute diff_add_cancel)
   hence \<open>f x = ((cnj (f t)/(t \<bullet>\<^sub>C t)) *\<^sub>C t) \<bullet>\<^sub>C x\<close> for x
     by (simp add: l2)
   thus ?thesis
     by blast
 qed
 
-lemma riesz_frechet_representation_unique:
+lemma riesz_representation_unique:
   \<comment> \<open>Theorem 3.4 in \<^cite>\<open>conway2013course\<close>\<close>
   fixes f::\<open>'a::complex_inner \<Rightarrow> complex\<close>
   assumes \<open>\<And>x. f x = (t \<bullet>\<^sub>C x)\<close>
   assumes \<open>\<And>x. f x = (u \<bullet>\<^sub>C x)\<close>
   shows \<open>t = u\<close>
   by (metis add_diff_cancel_left' assms(1) assms(2) cinner_diff_left cinner_gt_zero_iff diff_add_cancel diff_zero)
 
 subsection \<open>Adjoints\<close>
 
 definition "is_cadjoint F G \<longleftrightarrow> (\<forall>x. \<forall>y. (F x \<bullet>\<^sub>C y) = (x \<bullet>\<^sub>C G y))"
 
 lemma is_adjoint_sym:
   \<open>is_cadjoint F G \<Longrightarrow> is_cadjoint G F\<close>
   unfolding is_cadjoint_def apply auto
   by (metis cinner_commute')
 
 definition \<open>cadjoint G = (SOME F. is_cadjoint F G)\<close>
   for G :: "'b::complex_inner \<Rightarrow> 'a::complex_inner"
 
 lemma cadjoint_exists:
   fixes G :: "'b::chilbert_space \<Rightarrow> 'a::complex_inner"
   assumes [simp]: \<open>bounded_clinear G\<close>
   shows \<open>\<exists>F. is_cadjoint F G\<close>
 proof -
   include notation_norm
   have [simp]: \<open>clinear G\<close>
     using assms unfolding bounded_clinear_def by blast
   define g :: \<open>'a \<Rightarrow> 'b \<Rightarrow> complex\<close>
     where \<open>g x y = (x \<bullet>\<^sub>C G y)\<close> for x y
   have \<open>bounded_clinear (g x)\<close> for x
   proof -
     have \<open>g x (a + b) = g x a + g x b\<close> for a b
       unfolding g_def
       using additive.add cinner_add_right clinear_def
       by (simp add: cinner_add_right complex_vector.linear_add)
     moreover have  \<open>g x (k *\<^sub>C a) = k *\<^sub>C (g x a)\<close>
       for a k
       unfolding g_def
       by (simp add: complex_vector.linear_scale)
     ultimately have \<open>clinear (g x)\<close>
       by (simp add: clinearI)
     moreover
     have \<open>\<exists> M. \<forall> y. \<parallel> G y \<parallel> \<le> \<parallel> y \<parallel> * M\<close>
       using \<open>bounded_clinear G\<close>
       unfolding bounded_clinear_def bounded_clinear_axioms_def by blast
     then have \<open>\<exists>M. \<forall>y. \<parallel> g x y \<parallel> \<le> \<parallel> y \<parallel> * M\<close>
       using g_def
       by (simp add: bounded_clinear.bounded bounded_clinear_cinner_right_comp)
     ultimately show ?thesis unfolding bounded_linear_def
       using bounded_clinear.intro
       using bounded_clinear_axioms_def by blast
   qed
   hence \<open>\<forall>x. \<exists>t. \<forall>y.  g x y = (t \<bullet>\<^sub>C y)\<close>
-    using riesz_frechet_representation_existence by blast
+    using riesz_representation_existence by blast
   then obtain F where \<open>\<forall>x. \<forall>y. g x y = (F x \<bullet>\<^sub>C y)\<close>
     by metis
   then have \<open>is_cadjoint F G\<close>
     unfolding is_cadjoint_def g_def by simp
   thus ?thesis
     by auto
 qed
 
 lemma cadjoint_is_cadjoint[simp]:
   fixes G :: "'b::chilbert_space \<Rightarrow> 'a::complex_inner"
   assumes [simp]: \<open>bounded_clinear G\<close>
   shows \<open>is_cadjoint (cadjoint G) G\<close>
   by (metis assms cadjoint_def cadjoint_exists someI_ex)
 
 lemma is_cadjoint_unique:
   assumes \<open>is_cadjoint F1 G\<close>
   assumes \<open>is_cadjoint F2 G\<close>
   shows \<open>F1 = F2\<close>
-  by (metis (full_types) assms(1) assms(2) ext is_cadjoint_def riesz_frechet_representation_unique)
+  by (metis (full_types) assms(1) assms(2) ext is_cadjoint_def riesz_representation_unique)
 
 lemma cadjoint_univ_prop:
   fixes G :: "'b::chilbert_space \<Rightarrow> 'a::complex_inner"
   assumes a1: \<open>bounded_clinear G\<close>
   shows \<open>cadjoint G x \<bullet>\<^sub>C y = x \<bullet>\<^sub>C G y\<close>
   using assms cadjoint_is_cadjoint is_cadjoint_def by blast
 
 lemma cadjoint_univ_prop':
   fixes G :: "'b::chilbert_space \<Rightarrow> 'a::complex_inner"
   assumes a1: \<open>bounded_clinear G\<close>
   shows \<open>x \<bullet>\<^sub>C cadjoint G y = G x \<bullet>\<^sub>C y\<close>
   by (metis cadjoint_univ_prop assms cinner_commute')
 
 notation cadjoint ("_\<^sup>\<dagger>" [99] 100)
 
 lemma cadjoint_eqI:
   fixes G:: \<open>'b::complex_inner \<Rightarrow> 'a::complex_inner\<close>
     and F:: \<open>'a \<Rightarrow> 'b\<close>
   assumes \<open>\<And>x y. (F x \<bullet>\<^sub>C y) = (x \<bullet>\<^sub>C G y)\<close>
   shows \<open>G\<^sup>\<dagger> = F\<close>
   by (metis assms cadjoint_def is_cadjoint_def is_cadjoint_unique someI_ex)
 
 lemma cadjoint_bounded_clinear:
   fixes A :: "'a::chilbert_space \<Rightarrow> 'b::complex_inner"
   assumes a1: "bounded_clinear A"
   shows \<open>bounded_clinear (A\<^sup>\<dagger>)\<close>
 proof
   include notation_norm
   have b1: \<open>((A\<^sup>\<dagger>) x \<bullet>\<^sub>C y) = (x \<bullet>\<^sub>C A y)\<close> for x y
     using cadjoint_univ_prop a1 by auto
   have \<open>is_orthogonal ((A\<^sup>\<dagger>) (x1 + x2) - ((A\<^sup>\<dagger>) x1 + (A\<^sup>\<dagger>) x2)) y\<close> for x1 x2 y
     by (simp add: b1 cinner_diff_left cinner_add_left)
   hence b2: \<open>(A\<^sup>\<dagger>) (x1 + x2) - ((A\<^sup>\<dagger>) x1 + (A\<^sup>\<dagger>) x2) = 0\<close> for x1 x2
     using cinner_eq_zero_iff by blast
   thus z1: \<open>(A\<^sup>\<dagger>) (x1 + x2) = (A\<^sup>\<dagger>) x1 + (A\<^sup>\<dagger>) x2\<close> for x1 x2
     by (simp add: b2 eq_iff_diff_eq_0)
 
   have f1: \<open>is_orthogonal ((A\<^sup>\<dagger>) (r *\<^sub>C x) - (r *\<^sub>C (A\<^sup>\<dagger>) x )) y\<close> for r x y
     by (simp add: b1 cinner_diff_left)
   thus z2: \<open>(A\<^sup>\<dagger>) (r *\<^sub>C x) = r *\<^sub>C (A\<^sup>\<dagger>) x\<close> for r x
     using cinner_eq_zero_iff eq_iff_diff_eq_0 by blast
   have \<open>\<parallel> (A\<^sup>\<dagger>) x \<parallel>^2 = ((A\<^sup>\<dagger>) x \<bullet>\<^sub>C (A\<^sup>\<dagger>) x)\<close> for x
     by (metis cnorm_eq_square)
   moreover have \<open>\<parallel> (A\<^sup>\<dagger>) x \<parallel>^2 \<ge> 0\<close> for x
     by simp
   ultimately have \<open>\<parallel> (A\<^sup>\<dagger>) x \<parallel>^2 = \<bar> ((A\<^sup>\<dagger>) x \<bullet>\<^sub>C (A\<^sup>\<dagger>) x) \<bar>\<close> for x
     by (metis abs_pos cinner_ge_zero)
   hence \<open>\<parallel> (A\<^sup>\<dagger>) x \<parallel>^2 = \<bar> (x \<bullet>\<^sub>C A ((A\<^sup>\<dagger>) x)) \<bar>\<close> for x
     by (simp add: b1)
   moreover have  \<open>\<bar>(x \<bullet>\<^sub>C A ((A\<^sup>\<dagger>) x))\<bar> \<le> \<parallel>x\<parallel> *  \<parallel>A ((A\<^sup>\<dagger>) x)\<parallel>\<close> for x
     by (simp add: abs_complex_def complex_inner_class.Cauchy_Schwarz_ineq2 less_eq_complex_def)
   ultimately have b5: \<open>\<parallel> (A\<^sup>\<dagger>) x \<parallel>^2  \<le> \<parallel>x\<parallel> * \<parallel>A ((A\<^sup>\<dagger>) x)\<parallel>\<close> for x
     by (metis complex_of_real_mono_iff)
   have \<open>\<exists>M. M \<ge> 0 \<and> (\<forall> x. \<parallel>A ((A\<^sup>\<dagger>) x)\<parallel> \<le> M *  \<parallel>(A\<^sup>\<dagger>) x\<parallel>)\<close>
     using a1
     by (metis (mono_tags, opaque_lifting) bounded_clinear.bounded linear mult_nonneg_nonpos
         mult_zero_right norm_ge_zero order.trans semiring_normalization_rules(7))
   then obtain M where q1: \<open>M \<ge> 0\<close> and q2: \<open>\<forall> x. \<parallel>A ((A\<^sup>\<dagger>) x)\<parallel> \<le> M * \<parallel>(A\<^sup>\<dagger>) x\<parallel>\<close>
     by blast
   have \<open>\<forall> x::'b. \<parallel>x\<parallel> \<ge> 0\<close>
     by simp
   hence b6: \<open>\<parallel>x\<parallel> * \<parallel>A ((A\<^sup>\<dagger>) x)\<parallel> \<le>  \<parallel>x\<parallel> * M * \<parallel>(A\<^sup>\<dagger>) x\<parallel>\<close> for x
     using q2
     by (smt ordered_comm_semiring_class.comm_mult_left_mono vector_space_over_itself.scale_scale)
   have z3: \<open>\<parallel> (A\<^sup>\<dagger>) x \<parallel> \<le> \<parallel>x\<parallel> * M\<close> for x
   proof(cases \<open>\<parallel>(A\<^sup>\<dagger>) x\<parallel> = 0\<close>)
     case True
     thus ?thesis
       by (simp add: \<open>0 \<le> M\<close>)
   next
     case False
     have \<open>\<parallel> (A\<^sup>\<dagger>) x \<parallel>^2 \<le> \<parallel>x\<parallel> *  M *  \<parallel>(A\<^sup>\<dagger>) x\<parallel>\<close>
       by (smt b5 b6)
     thus ?thesis
       by (smt False mult_right_cancel mult_right_mono norm_ge_zero semiring_normalization_rules(29))
   qed
   thus \<open>\<exists>K. \<forall>x. \<parallel>(A\<^sup>\<dagger>) x\<parallel> \<le> \<parallel>x\<parallel> * K\<close>
     by auto
 qed
 
 proposition double_cadjoint:
   fixes U :: \<open>'a::chilbert_space \<Rightarrow> 'b::complex_inner\<close>
   assumes a1: "bounded_clinear U"
   shows "U\<^sup>\<dagger>\<^sup>\<dagger> = U"
   by (metis assms cadjoint_def cadjoint_is_cadjoint is_adjoint_sym is_cadjoint_unique someI_ex)
 
 lemma cadjoint_id[simp]: \<open>id\<^sup>\<dagger> = id\<close>
   by (simp add: cadjoint_eqI id_def)
 
 lemma scaleC_cadjoint:
   fixes A::"'a::chilbert_space \<Rightarrow> 'b::complex_inner"
   assumes "bounded_clinear A"
   shows \<open>(\<lambda>t. a *\<^sub>C A t)\<^sup>\<dagger> = (\<lambda>s. cnj a *\<^sub>C (A\<^sup>\<dagger>) s)\<close>
 proof -
   have b3: \<open>((\<lambda> s. (cnj a) *\<^sub>C ((A\<^sup>\<dagger>) s)) x \<bullet>\<^sub>C y) = (x \<bullet>\<^sub>C (\<lambda> t. a *\<^sub>C (A t)) y)\<close>
     for x y
     by (simp add: assms cadjoint_univ_prop)
 
   have "((\<lambda>t. a *\<^sub>C A t)\<^sup>\<dagger>) b = cnj a *\<^sub>C (A\<^sup>\<dagger>) b"
     for b::'b
   proof-
     have "bounded_clinear (\<lambda>t. a *\<^sub>C A t)"
       by (simp add: assms bounded_clinear_const_scaleC)
     thus ?thesis
       by (metis (no_types) cadjoint_eqI b3)
   qed
   thus ?thesis
     by blast
 qed
 
 
 lemma is_projection_on_is_cadjoint:
   fixes M :: \<open>'a::complex_inner set\<close>
   assumes a1: \<open>is_projection_on \<pi> M\<close> and a2: \<open>closed_csubspace M\<close>
   shows \<open>is_cadjoint \<pi> \<pi>\<close>
   by (smt (verit, ccfv_threshold) a1 a2 cinner_diff_left cinner_eq_flip is_cadjoint_def is_projection_on_iff_orthog orthogonal_complement_orthoI right_minus_eq)
 
 lemma is_projection_on_cadjoint:
   fixes M :: \<open>'a::complex_inner set\<close>
   assumes \<open>is_projection_on \<pi> M\<close> and \<open>closed_csubspace M\<close>
   shows \<open>\<pi>\<^sup>\<dagger> = \<pi>\<close>
   using assms is_projection_on_is_cadjoint cadjoint_eqI is_cadjoint_def by blast
 
 lemma projection_cadjoint:
   fixes M :: \<open>'a::chilbert_space set\<close>
   assumes \<open>closed_csubspace M\<close>
   shows \<open>(projection M)\<^sup>\<dagger> = projection M\<close>
   using is_projection_on_cadjoint assms
   by (metis closed_csubspace.closed closed_csubspace.subspace csubspace_is_convex empty_iff orthog_proj_exists projection_is_projection_on)
 
 
 subsection \<open>More projections\<close>
 
 text \<open>These lemmas logically belong in the "projections" section above but depend on lemmas developed later.\<close>
 
 lemma is_projection_on_plus:
   assumes "\<And>x y. x \<in> A \<Longrightarrow> y \<in> B \<Longrightarrow> is_orthogonal x y"
   assumes \<open>closed_csubspace A\<close>
   assumes \<open>closed_csubspace B\<close>
   assumes \<open>is_projection_on \<pi>A A\<close>
   assumes \<open>is_projection_on \<pi>B B\<close>
   shows \<open>is_projection_on (\<lambda>x. \<pi>A x + \<pi>B x) (A +\<^sub>M B)\<close>
 proof (rule is_projection_on_iff_orthog[THEN iffD2, rule_format])
   show clAB: \<open>closed_csubspace (A +\<^sub>M B)\<close>
     by (simp add: assms(2) assms(3) closed_subspace_closed_sum)
   fix h
   have 1: \<open>\<pi>A h + \<pi>B h \<in> A +\<^sub>M B\<close>
     by (meson clAB assms(2) assms(3) assms(4) assms(5) closed_csubspace_def closed_sum_left_subset closed_sum_right_subset complex_vector.subspace_def in_mono is_projection_on_in_image)
 
   have \<open>\<pi>A (\<pi>B h) = 0\<close>
     by (smt (verit, del_insts) assms(1) assms(2) assms(4) assms(5) cinner_eq_zero_iff is_cadjoint_def is_projection_on_in_image is_projection_on_is_cadjoint)
   then have \<open>h - (\<pi>A h + \<pi>B h) = (h - \<pi>B h) - \<pi>A (h - \<pi>B h)\<close>
     by (smt (verit) add.right_neutral add_diff_cancel_left' assms(2) assms(4) closed_csubspace.subspace complex_vector.subspace_diff diff_add_eq_diff_diff_swap diff_diff_add is_projection_on_iff_orthog orthog_proj_unique orthogonal_complement_closed_subspace)
   also have \<open>\<dots> \<in> orthogonal_complement A\<close>
     using assms(2) assms(4) is_projection_on_iff_orthog by blast
   finally have orthoA: \<open>h - (\<pi>A h + \<pi>B h) \<in> orthogonal_complement A\<close>
     by -
 
   have \<open>\<pi>B (\<pi>A h) = 0\<close>
     by (smt (verit, del_insts) assms(1) assms(3) assms(4) assms(5) cinner_eq_zero_iff is_cadjoint_def is_projection_on_in_image is_projection_on_is_cadjoint)
   then have \<open>h - (\<pi>A h + \<pi>B h) = (h - \<pi>A h) - \<pi>B (h - \<pi>A h)\<close>
     by (smt (verit) add.right_neutral add_diff_cancel assms(3) assms(5) closed_csubspace.subspace complex_vector.subspace_diff diff_add_eq_diff_diff_swap diff_diff_add is_projection_on_iff_orthog orthog_proj_unique orthogonal_complement_closed_subspace)
   also have \<open>\<dots> \<in> orthogonal_complement B\<close>
     using assms(3) assms(5) is_projection_on_iff_orthog by blast
   finally have orthoB: \<open>h - (\<pi>A h + \<pi>B h) \<in> orthogonal_complement B\<close>
     by -
 
   from orthoA orthoB
   have 2: \<open>h - (\<pi>A h + \<pi>B h) \<in> orthogonal_complement (A +\<^sub>M B)\<close>
     by (metis IntI assms(2) assms(3) closed_csubspace_def complex_vector.subspace_def de_morgan_orthogonal_complement_plus)
 
   from 1 2 show \<open>h - (\<pi>A h + \<pi>B h) \<in> orthogonal_complement (A +\<^sub>M B) \<and> \<pi>A h + \<pi>B h \<in> A +\<^sub>M B\<close>
     by simp
 qed
 
 lemma projection_plus:
   fixes A B :: "'a::chilbert_space set"
   assumes "\<And>x y. x:A \<Longrightarrow> y:B \<Longrightarrow> is_orthogonal x y"
   assumes \<open>closed_csubspace A\<close>
   assumes \<open>closed_csubspace B\<close>
   shows \<open>projection (A +\<^sub>M B) = (\<lambda>x. projection A x + projection B x)\<close>
 proof -
   have \<open>is_projection_on (\<lambda>x. projection A x + projection B x) (A +\<^sub>M B)\<close>
     apply (rule is_projection_on_plus)
     using assms by auto
   then show ?thesis
     by (meson assms(2) assms(3) closed_csubspace.subspace closed_subspace_closed_sum csubspace_is_convex projection_eqI')
 qed
 
 lemma is_projection_on_insert:
   assumes ortho: "\<And>s. s \<in> S \<Longrightarrow> is_orthogonal a s"
   assumes \<open>is_projection_on \<pi> (closure (cspan S))\<close>
   assumes \<open>is_projection_on \<pi>a (cspan {a})\<close>
   shows "is_projection_on (\<lambda>x. \<pi>a x + \<pi> x) (closure (cspan (insert a S)))"
 proof -
   from ortho
   have \<open>x \<in> cspan {a} \<Longrightarrow> y \<in> closure (cspan S) \<Longrightarrow> is_orthogonal x y\<close> for x y
     using is_orthogonal_cspan is_orthogonal_closure is_orthogonal_sym
     by (smt (verit, ccfv_threshold) empty_iff insert_iff)
   then have \<open>is_projection_on (\<lambda>x. \<pi>a x + \<pi> x) (cspan {a} +\<^sub>M closure (cspan S))\<close>
     apply (rule is_projection_on_plus)
     using assms by (auto simp add: closed_csubspace.intro)
   also have \<open>\<dots> = closure (cspan (insert a S))\<close>
     using closed_sum_cspan[where X=\<open>{a}\<close>] by simp
   finally show ?thesis
     by -
 qed
 
 lemma projection_insert:
   fixes a :: \<open>'a::chilbert_space\<close>
   assumes a1: "\<And>s. s \<in> S \<Longrightarrow> is_orthogonal a s"
   shows "projection (closure (cspan (insert a S))) u
         = projection (cspan {a}) u + projection (closure (cspan S)) u"
   using is_projection_on_insert[where S=S, OF a1]
   by (metis (no_types, lifting) closed_closure closed_csubspace.intro closure_is_csubspace complex_vector.subspace_span csubspace_is_convex finite.intros(1) finite.intros(2) finite_cspan_closed_csubspace projection_eqI' projection_is_projection_on')
 
 lemma projection_insert_finite:
   fixes S :: \<open>'a::chilbert_space set\<close>
   assumes a1: "\<And>s. s \<in> S \<Longrightarrow> is_orthogonal a s" and a2: "finite S"
   shows "projection (cspan (insert a S)) u
         = projection (cspan {a}) u + projection (cspan S) u"
   using projection_insert
   by (metis a1 a2 closure_finite_cspan finite.insertI)
 
 subsection \<open>Canonical basis (\<open>onb_enum\<close>)\<close>
 
 setup \<open>Sign.add_const_constraint (\<^const_name>\<open>is_ortho_set\<close>, SOME \<^typ>\<open>'a set \<Rightarrow> bool\<close>)\<close>
 
 class onb_enum = basis_enum + complex_inner +
   assumes is_orthonormal: "is_ortho_set (set canonical_basis)"
     and is_normal: "\<And>x. x \<in> (set canonical_basis) \<Longrightarrow> norm x = 1"
 
 setup \<open>Sign.add_const_constraint (\<^const_name>\<open>is_ortho_set\<close>, SOME \<^typ>\<open>'a::complex_inner set \<Rightarrow> bool\<close>)\<close>
 
 lemma cinner_canonical_basis:
   assumes \<open>i < length (canonical_basis :: 'a::onb_enum list)\<close>
   assumes \<open>j < length (canonical_basis :: 'a::onb_enum list)\<close>
   shows \<open>cinner (canonical_basis!i :: 'a) (canonical_basis!j) = (if i=j then 1 else 0)\<close>
   by (metis assms(1) assms(2) distinct_canonical_basis is_normal is_ortho_set_def is_orthonormal nth_eq_iff_index_eq nth_mem of_real_1 power2_norm_eq_cinner power_one)
 
 lemma canonical_basis_is_onb[simp]: \<open>is_onb (set canonical_basis :: 'a::onb_enum set)\<close>
   by (simp add: is_normal is_onb_def is_orthonormal)
 
 instance onb_enum \<subseteq> chilbert_space
 proof
   have \<open>complete (UNIV :: 'a set)\<close>
     using finite_cspan_complete[where B=\<open>set canonical_basis\<close>]
     by simp
   then show "convergent X" if "Cauchy X" for X :: "nat \<Rightarrow> 'a"
     by (simp add: complete_def convergent_def that)
 qed
 
 subsection \<open>Conjugate space\<close>
 
 instantiation conjugate_space :: (complex_inner) complex_inner begin
 lift_definition cinner_conjugate_space :: "'a conjugate_space \<Rightarrow> 'a conjugate_space \<Rightarrow> complex" is
   \<open>\<lambda>x y. cinner y x\<close>.
 instance
   apply (intro_classes; transfer)
        apply (simp_all add: )
     apply (simp add: cinner_add_right)
   using cinner_ge_zero norm_eq_sqrt_cinner by auto
 end
 
 instance conjugate_space :: (chilbert_space) chilbert_space..
 
 subsection \<open>Misc (ctd.)\<close>
 
 
 lemma separating_dense_span: 
   assumes \<open>\<And>F G :: 'a::chilbert_space \<Rightarrow> 'b::{complex_normed_vector,not_singleton}. 
            bounded_clinear F \<Longrightarrow> bounded_clinear G \<Longrightarrow> (\<forall>x\<in>S. F x = G x) \<Longrightarrow> F = G\<close>
   shows \<open>closure (cspan S) = UNIV\<close>
 proof -
   have \<open>\<psi> = 0\<close> if \<open>\<psi> \<in> orthogonal_complement S\<close> for \<psi>
   proof -
     obtain \<phi> :: 'b where \<open>\<phi> \<noteq> 0\<close>
       by fastforce
     have \<open>(\<lambda>x. cinner \<psi> x *\<^sub>C \<phi>) = (\<lambda>_. 0)\<close> 
       apply (rule assms[rule_format])
       using orthogonal_complement_orthoI that
       by (auto simp add: bounded_clinear_cinner_right bounded_clinear_scaleC_const)
     then have \<open>cinner \<psi> \<psi> = 0\<close>
       by (meson \<open>\<phi> \<noteq> 0\<close> scaleC_eq_0_iff)
     then show \<open>\<psi> = 0\<close>
       by auto
   qed
   then have \<open>orthogonal_complement (orthogonal_complement S) = UNIV\<close>
     by (metis UNIV_eq_I cinner_zero_right orthogonal_complementI)
   then show \<open>closure (cspan S) = UNIV\<close>
     by (simp add: orthogonal_complement_orthogonal_complement_closure_cspan)
 qed
 
 end
diff --git a/thys/Complex_Bounded_Operators/Complex_L2.thy b/thys/Complex_Bounded_Operators/Complex_L2.thy
--- a/thys/Complex_Bounded_Operators/Complex_L2.thy
+++ b/thys/Complex_Bounded_Operators/Complex_L2.thy
@@ -1,1751 +1,1750 @@
 section \<open>\<open>Complex_L2\<close> -- Hilbert space of square-summable functions\<close>
 
 (*
 Authors:
 
   Dominique Unruh, University of Tartu, unruh@ut.ee
   Jose Manuel Rodriguez Caballero, University of Tartu, jose.manuel.rodriguez.caballero@ut.ee
 
 *)
 
 theory Complex_L2
   imports 
     Complex_Bounded_Linear_Function
 
     "HOL-Analysis.L2_Norm"
     "HOL-Library.Rewrite"
     "HOL-Analysis.Infinite_Sum"
 begin
 
 unbundle lattice_syntax
 unbundle cblinfun_notation
 unbundle no_notation_blinfun_apply
 
 subsection \<open>l2 norm of functions\<close>
 
 definition \<open>has_ell2_norm (x::_\<Rightarrow>complex) \<longleftrightarrow> (\<lambda>i. (x i)\<^sup>2) abs_summable_on UNIV\<close>
 
 lemma has_ell2_norm_bdd_above: \<open>has_ell2_norm x \<longleftrightarrow> bdd_above (sum (\<lambda>xa. norm ((x xa)\<^sup>2)) ` Collect finite)\<close>
   by (simp add: has_ell2_norm_def abs_summable_iff_bdd_above)
 
 lemma has_ell2_norm_L2_set: "has_ell2_norm x = bdd_above (L2_set (norm o x) ` Collect finite)"
 proof (rule iffI)
   have \<open>mono sqrt\<close>
     using monoI real_sqrt_le_mono by blast
   assume \<open>has_ell2_norm x\<close>
   then have *: \<open>bdd_above (sum (\<lambda>xa. norm ((x xa)\<^sup>2)) ` Collect finite)\<close>
     by (subst (asm) has_ell2_norm_bdd_above)
   have \<open>bdd_above ((\<lambda>F. sqrt (sum (\<lambda>xa. norm ((x xa)\<^sup>2)) F)) ` Collect finite)\<close>
     using bdd_above_image_mono[OF \<open>mono sqrt\<close> *]
     by (auto simp: image_image)
   then show \<open>bdd_above (L2_set (norm o x) ` Collect finite)\<close>
     by (auto simp: L2_set_def norm_power)
 next
   define p2 where \<open>p2 x = (if x < 0 then 0 else x^2)\<close> for x :: real
   have \<open>mono p2\<close>
     by (simp add: monoI p2_def)
   have [simp]: \<open>p2 (L2_set f F) = (\<Sum>i\<in>F. (f i)\<^sup>2)\<close> for f and F :: \<open>'a set\<close>
     by (smt (verit) L2_set_def L2_set_nonneg p2_def power2_less_0 real_sqrt_pow2 sum.cong sum_nonneg)
   assume *: \<open>bdd_above (L2_set (norm o x) ` Collect finite)\<close>
   have \<open>bdd_above (p2 ` L2_set (norm o x) ` Collect finite)\<close>
     using bdd_above_image_mono[OF \<open>mono p2\<close> *]
     by auto
   then show \<open>has_ell2_norm x\<close>
     apply (simp add: image_image has_ell2_norm_def abs_summable_iff_bdd_above)
     by (simp add: norm_power)
 qed
 
 definition ell2_norm :: \<open>('a \<Rightarrow> complex) \<Rightarrow> real\<close> where \<open>ell2_norm f = sqrt (\<Sum>\<^sub>\<infinity>x. norm (f x)^2)\<close>
 
 lemma ell2_norm_SUP:
   assumes \<open>has_ell2_norm x\<close>
   shows "ell2_norm x = sqrt (SUP F\<in>{F. finite F}. sum (\<lambda>i. norm (x i)^2) F)"
   using assms apply (auto simp add: ell2_norm_def has_ell2_norm_def)
   apply (subst infsum_nonneg_is_SUPREMUM_real)
   by (auto simp: norm_power)
 
 lemma ell2_norm_L2_set: 
   assumes "has_ell2_norm x"
   shows "ell2_norm x = (SUP F\<in>{F. finite F}. L2_set (norm o x) F)"
 proof-
   have "sqrt (\<Squnion> (sum (\<lambda>i. (cmod (x i))\<^sup>2) ` Collect finite)) =
       (SUP F\<in>{F. finite F}. sqrt (\<Sum>i\<in>F. (cmod (x i))\<^sup>2))"
   proof (subst continuous_at_Sup_mono)
     show "mono sqrt"
       by (simp add: mono_def)      
     show "continuous (at_left (\<Squnion> (sum (\<lambda>i. (cmod (x i))\<^sup>2) ` Collect finite))) sqrt"
       using continuous_at_split isCont_real_sqrt by blast    
     show "sum (\<lambda>i. (cmod (x i))\<^sup>2) ` Collect finite \<noteq> {}"
       by auto      
     show "bdd_above (sum (\<lambda>i. (cmod (x i))\<^sup>2) ` Collect finite)"
       using has_ell2_norm_bdd_above[THEN iffD1, OF assms] by (auto simp: norm_power)
     show "\<Squnion> (sqrt ` sum (\<lambda>i. (cmod (x i))\<^sup>2) ` Collect finite) = (SUP F\<in>Collect finite. sqrt (\<Sum>i\<in>F. (cmod (x i))\<^sup>2))"
       by (metis image_image)      
   qed  
   thus ?thesis 
     using assms by (auto simp: ell2_norm_SUP L2_set_def)
 qed
 
 lemma has_ell2_norm_finite[simp]: "has_ell2_norm (f::'a::finite\<Rightarrow>_)"
   unfolding has_ell2_norm_def by simp
 
 lemma ell2_norm_finite: 
   "ell2_norm (f::'a::finite\<Rightarrow>complex) = sqrt (\<Sum>x\<in>UNIV. (norm (f x))^2)"
   by (simp add: ell2_norm_def)
 
 lemma ell2_norm_finite_L2_set: "ell2_norm (x::'a::finite\<Rightarrow>complex) = L2_set (norm o x) UNIV"
   by (simp add: ell2_norm_finite L2_set_def)
 
 lemma ell2_norm_square: \<open>(ell2_norm x)\<^sup>2 = (\<Sum>\<^sub>\<infinity>i. (cmod (x i))\<^sup>2)\<close>
   unfolding ell2_norm_def
   apply (subst real_sqrt_pow2)
   by (simp_all add: infsum_nonneg)
 
 lemma ell2_ket:
   fixes a
   defines \<open>f \<equiv> (\<lambda>i. of_bool (a = i))\<close>
   shows has_ell2_norm_ket: \<open>has_ell2_norm f\<close>
     and ell2_norm_ket: \<open>ell2_norm f = 1\<close>
 proof -
   have \<open>(\<lambda>x. (f x)\<^sup>2) abs_summable_on {a}\<close>
     apply (rule summable_on_finite) by simp
   then show \<open>has_ell2_norm f\<close>
     unfolding has_ell2_norm_def
     apply (rule summable_on_cong_neutral[THEN iffD1, rotated -1])
     unfolding f_def by auto
 
   have \<open>(\<Sum>\<^sub>\<infinity>x\<in>{a}. (f x)\<^sup>2) = 1\<close>
     apply (subst infsum_finite)
     by (auto simp: f_def)
   then show \<open>ell2_norm f = 1\<close>
     unfolding ell2_norm_def
     apply (subst infsum_cong_neutral[where T=\<open>{a}\<close> and g=\<open>\<lambda>x. (cmod (f x))\<^sup>2\<close>])
     by (auto simp: f_def)
 qed
 
 lemma ell2_norm_geq0: \<open>ell2_norm x \<ge> 0\<close>
   by (auto simp: ell2_norm_def intro!: infsum_nonneg)
 
 lemma ell2_norm_point_bound:
   assumes \<open>has_ell2_norm x\<close>
   shows \<open>ell2_norm x \<ge> cmod (x i)\<close>
 proof -
   have \<open>(cmod (x i))\<^sup>2 = norm ((x i)\<^sup>2)\<close>
     by (simp add: norm_power)
   also have \<open>norm ((x i)\<^sup>2) = sum (\<lambda>i. (norm ((x i)\<^sup>2))) {i}\<close>
     by auto
   also have \<open>\<dots> = infsum (\<lambda>i. (norm ((x i)\<^sup>2))) {i}\<close>
     by (rule infsum_finite[symmetric], simp)
   also have \<open>\<dots> \<le> infsum (\<lambda>i. (norm ((x i)\<^sup>2))) UNIV\<close>
     apply (rule infsum_mono_neutral)
     using assms by (auto simp: has_ell2_norm_def)
   also have \<open>\<dots> = (ell2_norm x)\<^sup>2\<close>
     by (metis (no_types, lifting) ell2_norm_def ell2_norm_geq0 infsum_cong norm_power real_sqrt_eq_iff real_sqrt_unique)
   finally show ?thesis
     using ell2_norm_geq0 power2_le_imp_le by blast
 qed
 
 lemma ell2_norm_0:
   assumes "has_ell2_norm x"
   shows "ell2_norm x = 0 \<longleftrightarrow> x = (\<lambda>_. 0)"
 proof
   assume u1: "x = (\<lambda>_. 0)"
   have u2: "(SUP x::'a set\<in>Collect finite. (0::real)) = 0"
     if "x = (\<lambda>_. 0)"
     by (metis cSUP_const empty_Collect_eq finite.emptyI)
   show "ell2_norm x = 0"
     unfolding ell2_norm_def
     using u1 u2 by auto 
 next
   assume norm0: "ell2_norm x = 0"
   show "x = (\<lambda>_. 0)"
   proof
     fix i
     have \<open>cmod (x i) \<le> ell2_norm x\<close>
       using assms by (rule ell2_norm_point_bound)
     also have \<open>\<dots> = 0\<close>
       by (fact norm0)
     finally show "x i = 0" by auto
   qed
 qed
 
 
 lemma ell2_norm_smult:
   assumes "has_ell2_norm x"
   shows "has_ell2_norm (\<lambda>i. c * x i)" and "ell2_norm (\<lambda>i. c * x i) = cmod c * ell2_norm x"
 proof -
   have L2_set_mul: "L2_set (cmod \<circ> (\<lambda>i. c * x i)) F = cmod c * L2_set (cmod \<circ> x) F" for F
   proof-
     have "L2_set (cmod \<circ> (\<lambda>i. c * x i)) F = L2_set (\<lambda>i. (cmod c * (cmod o x) i)) F"
       by (metis comp_def norm_mult)
     also have "\<dots> = cmod c * L2_set (cmod o x) F"
       by (metis norm_ge_zero L2_set_right_distrib)
     finally show ?thesis .
   qed
 
   from assms obtain M where M: "M \<ge> L2_set (cmod o x) F" if "finite F" for F
     unfolding has_ell2_norm_L2_set bdd_above_def by auto
   hence "cmod c * M \<ge> L2_set (cmod o (\<lambda>i. c * x i)) F" if "finite F" for F
     unfolding L2_set_mul
     by (simp add: ordered_comm_semiring_class.comm_mult_left_mono that) 
   thus has: "has_ell2_norm (\<lambda>i. c * x i)"
     unfolding has_ell2_norm_L2_set bdd_above_def using L2_set_mul[symmetric] by auto
   have "ell2_norm (\<lambda>i. c * x i) = (SUP F \<in> Collect finite. (L2_set (cmod \<circ> (\<lambda>i. c * x i)) F))"
     by (simp add: ell2_norm_L2_set has)
   also have "\<dots> = (SUP F \<in> Collect finite. (cmod c * L2_set (cmod \<circ> x) F))"
     using L2_set_mul by auto   
   also have "\<dots> = cmod c * ell2_norm x" 
   proof (subst ell2_norm_L2_set)
     show "has_ell2_norm x"
       by (simp add: assms)      
     show "(SUP F\<in>Collect finite. cmod c * L2_set (cmod \<circ> x) F) = cmod c * \<Squnion> (L2_set (cmod \<circ> x) ` Collect finite)"
     proof (subst continuous_at_Sup_mono [where f = "\<lambda>x. cmod c * x"])
       show "mono ((*) (cmod c))"
         by (simp add: mono_def ordered_comm_semiring_class.comm_mult_left_mono)
       show "continuous (at_left (\<Squnion> (L2_set (cmod \<circ> x) ` Collect finite))) ((*) (cmod c))"
       proof (rule continuous_mult)
         show "continuous (at_left (\<Squnion> (L2_set (cmod \<circ> x) ` Collect finite))) (\<lambda>x. cmod c)"
           by simp
         show "continuous (at_left (\<Squnion> (L2_set (cmod \<circ> x) ` Collect finite))) (\<lambda>x. x)"
           by simp
       qed    
       show "L2_set (cmod \<circ> x) ` Collect finite \<noteq> {}"
         by auto        
       show "bdd_above (L2_set (cmod \<circ> x) ` Collect finite)"
         by (meson assms has_ell2_norm_L2_set)        
       show "(SUP F\<in>Collect finite. cmod c * L2_set (cmod \<circ> x) F) = \<Squnion> ((*) (cmod c) ` L2_set (cmod \<circ> x) ` Collect finite)"
         by (metis image_image)        
     qed   
   qed     
   finally show "ell2_norm (\<lambda>i. c * x i) = cmod c * ell2_norm x".
 qed
 
 
 lemma ell2_norm_triangle:
   assumes "has_ell2_norm x" and "has_ell2_norm y"
   shows "has_ell2_norm (\<lambda>i. x i + y i)" and "ell2_norm (\<lambda>i. x i + y i) \<le> ell2_norm x + ell2_norm y"
 proof -
   have triangle: "L2_set (cmod \<circ> (\<lambda>i. x i + y i)) F \<le> L2_set (cmod \<circ> x) F + L2_set (cmod \<circ> y) F" 
     (is "?lhs\<le>?rhs") 
     if "finite F" for F
   proof -
     have "?lhs \<le> L2_set (\<lambda>i. (cmod o x) i + (cmod o y) i) F"
     proof (rule L2_set_mono)
       show "(cmod \<circ> (\<lambda>i. x i + y i)) i \<le> (cmod \<circ> x) i + (cmod \<circ> y) i"
         if "i \<in> F"
         for i :: 'a
         using that norm_triangle_ineq by auto 
       show "0 \<le> (cmod \<circ> (\<lambda>i. x i + y i)) i"
         if "i \<in> F"
         for i :: 'a
         using that
         by simp 
     qed
     also have "\<dots> \<le> ?rhs"
       by (rule L2_set_triangle_ineq)
     finally show ?thesis .
   qed
   obtain Mx My where Mx: "Mx \<ge> L2_set (cmod o x) F" and My: "My \<ge> L2_set (cmod o y) F" 
     if "finite F" for F
     using assms unfolding has_ell2_norm_L2_set bdd_above_def by auto
   hence MxMy: "Mx + My \<ge> L2_set (cmod \<circ> x) F + L2_set (cmod \<circ> y) F" if "finite F" for F
     using that by fastforce
   hence bdd_plus: "bdd_above ((\<lambda>xa. L2_set (cmod \<circ> x) xa + L2_set (cmod \<circ> y) xa) ` Collect finite)"
     unfolding bdd_above_def by auto
   from MxMy have MxMy': "Mx + My \<ge> L2_set (cmod \<circ> (\<lambda>i. x i + y i)) F" if "finite F" for F 
     using triangle that by fastforce
   thus has: "has_ell2_norm (\<lambda>i. x i + y i)"
     unfolding has_ell2_norm_L2_set bdd_above_def by auto
   have SUP_plus: "(SUP x\<in>A. f x + g x) \<le> (SUP x\<in>A. f x) + (SUP x\<in>A. g x)" 
     if notempty: "A\<noteq>{}" and bddf: "bdd_above (f`A)"and bddg: "bdd_above (g`A)"
     for f g :: "'a set \<Rightarrow> real" and A
   proof-
     have xleq: "x \<le> (SUP x\<in>A. f x) + (SUP x\<in>A. g x)" if x: "x \<in> (\<lambda>x. f x + g x) ` A" for x
     proof -
       obtain a where aA: "a:A" and ax: "x = f a + g a"
         using x by blast
       have fa: "f a \<le> (SUP x\<in>A. f x)"
         by (simp add: bddf aA cSUP_upper)
       moreover have "g a \<le> (SUP x\<in>A. g x)"
         by (simp add: bddg aA cSUP_upper)
       ultimately have "f a + g a \<le> (SUP x\<in>A. f x) + (SUP x\<in>A. g x)" by simp
       with ax show ?thesis by simp
     qed
     have "(\<lambda>x. f x + g x) ` A \<noteq> {}"
       using notempty by auto        
     moreover have "x \<le> \<Squnion> (f ` A) + \<Squnion> (g ` A)"
       if "x \<in> (\<lambda>x. f x + g x) ` A"
       for x :: real
       using that
       by (simp add: xleq) 
     ultimately show ?thesis
       by (meson bdd_above_def cSup_le_iff)      
   qed
   have a2: "bdd_above (L2_set (cmod \<circ> x) ` Collect finite)"
     by (meson assms(1) has_ell2_norm_L2_set)    
   have a3: "bdd_above (L2_set (cmod \<circ> y) ` Collect finite)"
     by (meson assms(2) has_ell2_norm_L2_set)    
   have a1: "Collect finite \<noteq> {}"
     by auto    
   have a4: "\<Squnion> (L2_set (cmod \<circ> (\<lambda>i. x i + y i)) ` Collect finite)
     \<le> (SUP xa\<in>Collect finite.
            L2_set (cmod \<circ> x) xa + L2_set (cmod \<circ> y) xa)"
     by (metis (mono_tags, lifting) a1 bdd_plus cSUP_mono mem_Collect_eq triangle)    
   have "\<forall>r. \<Squnion> (L2_set (cmod \<circ> (\<lambda>a. x a + y a)) ` Collect finite) \<le> r \<or> \<not> (SUP A\<in>Collect finite. L2_set (cmod \<circ> x) A + L2_set (cmod \<circ> y) A) \<le> r"
     using a4 by linarith
   hence "\<Squnion> (L2_set (cmod \<circ> (\<lambda>i. x i + y i)) ` Collect finite)
     \<le> \<Squnion> (L2_set (cmod \<circ> x) ` Collect finite) +
        \<Squnion> (L2_set (cmod \<circ> y) ` Collect finite)"
     by (metis (no_types) SUP_plus a1 a2 a3)
   hence "\<Squnion> (L2_set (cmod \<circ> (\<lambda>i. x i + y i)) ` Collect finite) \<le> ell2_norm x + ell2_norm y"
     by (simp add: assms(1) assms(2) ell2_norm_L2_set)
   thus "ell2_norm (\<lambda>i. x i + y i) \<le> ell2_norm x + ell2_norm y"
     by (simp add: ell2_norm_L2_set has)  
 qed
 
 lemma ell2_norm_uminus:
   assumes "has_ell2_norm x"
   shows \<open>has_ell2_norm (\<lambda>i. - x i)\<close> and \<open>ell2_norm (\<lambda>i. - x i) = ell2_norm x\<close>
   using assms by (auto simp: has_ell2_norm_def ell2_norm_def)
 
 subsection \<open>The type \<open>ell2\<close> of square-summable functions\<close>
 
 typedef 'a ell2 = \<open>{f::'a\<Rightarrow>complex. has_ell2_norm f}\<close>
   unfolding has_ell2_norm_def by (rule exI[of _ "\<lambda>_.0"], auto)
 setup_lifting type_definition_ell2
 
 instantiation ell2 :: (type)complex_vector begin
 lift_definition zero_ell2 :: "'a ell2" is "\<lambda>_. 0" by (auto simp: has_ell2_norm_def)
 lift_definition uminus_ell2 :: "'a ell2 \<Rightarrow> 'a ell2" is uminus by (simp add: has_ell2_norm_def)
 lift_definition plus_ell2 :: \<open>'a ell2 \<Rightarrow> 'a ell2 \<Rightarrow> 'a ell2\<close> is \<open>\<lambda>f g x. f x + g x\<close>
   by (rule ell2_norm_triangle) 
 lift_definition minus_ell2 :: "'a ell2 \<Rightarrow> 'a ell2 \<Rightarrow> 'a ell2" is "\<lambda>f g x. f x - g x"
   apply (subst add_uminus_conv_diff[symmetric])
   apply (rule ell2_norm_triangle)
   by (auto simp add: ell2_norm_uminus)
 lift_definition scaleR_ell2 :: "real \<Rightarrow> 'a ell2 \<Rightarrow> 'a ell2" is "\<lambda>r f x. complex_of_real r * f x"
   by (rule ell2_norm_smult)
 lift_definition scaleC_ell2 :: \<open>complex \<Rightarrow> 'a ell2 \<Rightarrow> 'a ell2\<close> is \<open>\<lambda>c f x. c * f x\<close>
   by (rule ell2_norm_smult)
 
 instance
 proof
   fix a b c :: "'a ell2"
 
   show "((*\<^sub>R) r::'a ell2 \<Rightarrow> _) = (*\<^sub>C) (complex_of_real r)" for r
     apply (rule ext) apply transfer by auto
   show "a + b + c = a + (b + c)"
     by (transfer; rule ext; simp)
   show "a + b = b + a"
     by (transfer; rule ext; simp)
   show "0 + a = a"
     by (transfer; rule ext; simp)
   show "- a + a = 0"
     by (transfer; rule ext; simp)
   show "a - b = a + - b"
     by (transfer; rule ext; simp)
   show "r *\<^sub>C (a + b) = r *\<^sub>C a + r *\<^sub>C b" for r
     apply (transfer; rule ext)
     by (simp add: vector_space_over_itself.scale_right_distrib)
   show "(r + r') *\<^sub>C a = r *\<^sub>C a + r' *\<^sub>C a" for r r'
     apply (transfer; rule ext)
     by (simp add: ring_class.ring_distribs(2)) 
   show "r *\<^sub>C r' *\<^sub>C a = (r * r') *\<^sub>C a" for r r'
     by (transfer; rule ext; simp)
   show "1 *\<^sub>C a = a"
     by (transfer; rule ext; simp)
 qed
 end
 
 instantiation ell2 :: (type)complex_normed_vector begin
 lift_definition norm_ell2 :: "'a ell2 \<Rightarrow> real" is ell2_norm .
 declare norm_ell2_def[code del]
 definition "dist x y = norm (x - y)" for x y::"'a ell2"
 definition "sgn x = x /\<^sub>R norm x" for x::"'a ell2"
 definition [code del]: "uniformity = (INF e\<in>{0<..}. principal {(x::'a ell2, y). norm (x - y) < e})"
 definition [code del]: "open U = (\<forall>x\<in>U. \<forall>\<^sub>F (x', y) in INF e\<in>{0<..}. principal {(x, y). norm (x - y) < e}. x' = x \<longrightarrow> y \<in> U)" for U :: "'a ell2 set"
 instance
 proof
   fix a b :: "'a ell2"
   show "dist a b = norm (a - b)"
     by (simp add: dist_ell2_def)    
   show "sgn a = a /\<^sub>R norm a"
     by (simp add: sgn_ell2_def)    
   show "uniformity = (INF e\<in>{0<..}. principal {(x, y). dist (x::'a ell2) y < e})"
     unfolding dist_ell2_def  uniformity_ell2_def by simp
   show "open U = (\<forall>x\<in>U. \<forall>\<^sub>F (x', y) in uniformity. (x'::'a ell2) = x \<longrightarrow> y \<in> U)" for U :: "'a ell2 set"
     unfolding uniformity_ell2_def open_ell2_def by simp_all        
   show "(norm a = 0) = (a = 0)"
     apply transfer by (fact ell2_norm_0)    
   show "norm (a + b) \<le> norm a + norm b"
     apply transfer by (fact ell2_norm_triangle)
   show "norm (r *\<^sub>R (a::'a ell2)) = \<bar>r\<bar> * norm a" for r
     and a :: "'a ell2"
     apply transfer
     by (simp add: ell2_norm_smult(2)) 
   show "norm (r *\<^sub>C a) = cmod r * norm a" for r
     apply transfer
     by (simp add: ell2_norm_smult(2)) 
 qed  
 end
 
 lemma norm_point_bound_ell2: "norm (Rep_ell2 x i) \<le> norm x"
   apply transfer
   by (simp add: ell2_norm_point_bound)
 
 lemma ell2_norm_finite_support:
   assumes \<open>finite S\<close> \<open>\<And> i. i \<notin> S \<Longrightarrow> Rep_ell2 x i = 0\<close>
   shows \<open>norm x = sqrt ((sum (\<lambda>i. (cmod (Rep_ell2 x i))\<^sup>2)) S)\<close>
 proof (insert assms(2), transfer fixing: S)
   fix x :: \<open>'a \<Rightarrow> complex\<close>
   assume zero: \<open>\<And>i. i \<notin> S \<Longrightarrow> x i = 0\<close>
   have \<open>ell2_norm x = sqrt (\<Sum>\<^sub>\<infinity>i. (cmod (x i))\<^sup>2)\<close>
     by (auto simp: ell2_norm_def)
   also have \<open>\<dots> = sqrt (\<Sum>\<^sub>\<infinity>i\<in>S. (cmod (x i))\<^sup>2)\<close>
     apply (subst infsum_cong_neutral[where g=\<open>\<lambda>i. (cmod (x i))\<^sup>2\<close> and S=UNIV and T=S])
     using zero by auto
   also have \<open>\<dots> = sqrt (\<Sum>i\<in>S. (cmod (x i))\<^sup>2)\<close>
     using \<open>finite S\<close> by simp
   finally show \<open>ell2_norm x = sqrt (\<Sum>i\<in>S. (cmod (x i))\<^sup>2)\<close>
     by -
 qed
 
 instantiation ell2 :: (type) complex_inner begin
 lift_definition cinner_ell2 :: \<open>'a ell2 \<Rightarrow> 'a ell2 \<Rightarrow> complex\<close> is 
   \<open>\<lambda>f g. \<Sum>\<^sub>\<infinity>x. (cnj (f x) * g x)\<close> .
 declare cinner_ell2_def[code del]
 
 instance
 proof standard
   fix x y z :: "'a ell2" fix c :: complex
   show "cinner x y = cnj (cinner y x)"
   proof transfer
     fix x y :: "'a\<Rightarrow>complex" assume "has_ell2_norm x" and "has_ell2_norm y"
     have "(\<Sum>\<^sub>\<infinity>i. cnj (x i) * y i) = (\<Sum>\<^sub>\<infinity>i. cnj (cnj (y i) * x i))"
       by (metis complex_cnj_cnj complex_cnj_mult mult.commute)
     also have "\<dots> = cnj (\<Sum>\<^sub>\<infinity>i. cnj (y i) * x i)"
       by (metis infsum_cnj) 
     finally show "(\<Sum>\<^sub>\<infinity>i. cnj (x i) * y i) = cnj (\<Sum>\<^sub>\<infinity>i. cnj (y i) * x i)" .
   qed
 
   show "cinner (x + y) z = cinner x z + cinner y z"
   proof transfer
     fix x y z :: "'a \<Rightarrow> complex"
     assume "has_ell2_norm x"
     hence cnj_x: "(\<lambda>i. cnj (x i) * cnj (x i)) abs_summable_on UNIV"
       by (simp del: complex_cnj_mult add: norm_mult[symmetric] complex_cnj_mult[symmetric] has_ell2_norm_def power2_eq_square)
     assume "has_ell2_norm y"
     hence cnj_y: "(\<lambda>i. cnj (y i) * cnj (y i)) abs_summable_on UNIV"
       by (simp del: complex_cnj_mult add: norm_mult[symmetric] complex_cnj_mult[symmetric] has_ell2_norm_def power2_eq_square)
     assume "has_ell2_norm z"
     hence z: "(\<lambda>i. z i * z i) abs_summable_on UNIV" 
       by (simp add: norm_mult[symmetric] has_ell2_norm_def power2_eq_square)
     have cnj_x_z:"(\<lambda>i. cnj (x i) * z i) abs_summable_on UNIV"
       using cnj_x z by (rule abs_summable_product) 
     have cnj_y_z:"(\<lambda>i. cnj (y i) * z i) abs_summable_on UNIV"
       using cnj_y z by (rule abs_summable_product) 
     show "(\<Sum>\<^sub>\<infinity>i. cnj (x i + y i) * z i) = (\<Sum>\<^sub>\<infinity>i. cnj (x i) * z i) + (\<Sum>\<^sub>\<infinity>i. cnj (y i) * z i)"
       apply (subst infsum_add [symmetric])
       using cnj_x_z cnj_y_z 
       by (auto simp add: summable_on_iff_abs_summable_on_complex distrib_left mult.commute)
   qed
 
   show "cinner (c *\<^sub>C x) y = cnj c * cinner x y"
   proof transfer
     fix x y :: "'a \<Rightarrow> complex" and c :: complex
     assume "has_ell2_norm x"
     hence cnj_x: "(\<lambda>i. cnj (x i) * cnj (x i)) abs_summable_on UNIV"
       by (simp del: complex_cnj_mult add: norm_mult[symmetric] complex_cnj_mult[symmetric] has_ell2_norm_def power2_eq_square)
     assume "has_ell2_norm y"
     hence y: "(\<lambda>i. y i * y i) abs_summable_on UNIV" 
       by (simp add: norm_mult[symmetric] has_ell2_norm_def power2_eq_square)
     have cnj_x_y:"(\<lambda>i. cnj (x i) * y i) abs_summable_on UNIV"
       using cnj_x y by (rule abs_summable_product) 
     thus "(\<Sum>\<^sub>\<infinity>i. cnj (c * x i) * y i) = cnj c * (\<Sum>\<^sub>\<infinity>i. cnj (x i) * y i)"
       by (auto simp flip: infsum_cmult_right simp add: abs_summable_summable mult.commute vector_space_over_itself.scale_left_commute)
   qed
 
   show "0 \<le> cinner x x"
   proof transfer
     fix x :: "'a \<Rightarrow> complex"
     assume "has_ell2_norm x"
     hence "(\<lambda>i. cmod (cnj (x i) * x i)) abs_summable_on UNIV"
       by (simp add: norm_mult has_ell2_norm_def power2_eq_square)
     hence "(\<lambda>i. cnj (x i) * x i) abs_summable_on UNIV"
       by auto
     hence sum: "(\<lambda>i. cnj (x i) * x i) abs_summable_on UNIV"
       unfolding has_ell2_norm_def power2_eq_square.
     have "0 = (\<Sum>\<^sub>\<infinity>i::'a. 0)" by auto
     also have "\<dots> \<le> (\<Sum>\<^sub>\<infinity>i. cnj (x i) * x i)"
       apply (rule infsum_mono_complex)
       by (auto simp add: abs_summable_summable sum)
     finally show "0 \<le> (\<Sum>\<^sub>\<infinity>i. cnj (x i) * x i)" by assumption
   qed
 
   show "(cinner x x = 0) = (x = 0)"
   proof (transfer, auto)
     fix x :: "'a \<Rightarrow> complex"
     assume "has_ell2_norm x"
     hence "(\<lambda>i::'a. cmod (cnj (x i) * x i)) abs_summable_on UNIV"
       by (smt (verit, del_insts) complex_mod_mult_cnj has_ell2_norm_def mult.commute norm_ge_zero norm_power real_norm_def summable_on_cong)
     hence cmod_x2: "(\<lambda>i. cnj (x i) * x i) abs_summable_on UNIV"
       unfolding has_ell2_norm_def power2_eq_square
       by simp
     assume eq0: "(\<Sum>\<^sub>\<infinity>i. cnj (x i) * x i) = 0"
     show "x = (\<lambda>_. 0)"
     proof (rule ccontr)
       assume "x \<noteq> (\<lambda>_. 0)"
       then obtain i where "x i \<noteq> 0" by auto
       hence "0 < cnj (x i) * x i"
         by (metis le_less cnj_x_x_geq0 complex_cnj_zero_iff vector_space_over_itself.scale_eq_0_iff)
       also have "\<dots> = (\<Sum>\<^sub>\<infinity>i\<in>{i}. cnj (x i) * x i)" by auto
       also have "\<dots> \<le> (\<Sum>\<^sub>\<infinity>i. cnj (x i) * x i)"
         apply (rule infsum_mono_neutral_complex)
         by (auto simp add: abs_summable_summable cmod_x2)
       also from eq0 have "\<dots> = 0" by assumption
       finally show False by simp
     qed
   qed
 
   show "norm x = sqrt (cmod (cinner x x))"
   proof transfer 
     fix x :: "'a \<Rightarrow> complex" 
     assume x: "has_ell2_norm x"
     have "(\<lambda>i::'a. cmod (x i) * cmod (x i)) abs_summable_on UNIV \<Longrightarrow>
     (\<lambda>i::'a. cmod (cnj (x i) * x i)) abs_summable_on UNIV"
       by (simp add: norm_mult has_ell2_norm_def power2_eq_square)
     hence sum: "(\<lambda>i. cnj (x i) * x i) abs_summable_on UNIV"
       by (metis (no_types, lifting) complex_mod_mult_cnj has_ell2_norm_def mult.commute norm_power summable_on_cong x)
     from x have "ell2_norm x = sqrt (\<Sum>\<^sub>\<infinity>i. (cmod (x i))\<^sup>2)"
       unfolding ell2_norm_def by simp
     also have "\<dots> = sqrt (\<Sum>\<^sub>\<infinity>i. cmod (cnj (x i) * x i))"
       unfolding norm_complex_def power2_eq_square by auto
     also have "\<dots> = sqrt (cmod (\<Sum>\<^sub>\<infinity>i. cnj (x i) * x i))"
       by (auto simp: infsum_cmod abs_summable_summable sum)
     finally show "ell2_norm x = sqrt (cmod (\<Sum>\<^sub>\<infinity>i. cnj (x i) * x i))" by assumption
   qed
 qed
 end
 
 instance ell2 :: (type) chilbert_space
 proof intro_classes
   fix X :: \<open>nat \<Rightarrow> 'a ell2\<close>
   define x where \<open>x n a = Rep_ell2 (X n) a\<close> for n a
   have [simp]: \<open>has_ell2_norm (x n)\<close> for n
     using Rep_ell2 x_def[abs_def] by simp
 
   assume \<open>Cauchy X\<close>
   moreover have "dist (x n a) (x m a) \<le> dist (X n) (X m)" for n m a
     by (metis Rep_ell2 x_def dist_norm ell2_norm_point_bound mem_Collect_eq minus_ell2.rep_eq norm_ell2.rep_eq)
   ultimately have \<open>Cauchy (\<lambda>n. x n a)\<close> for a
     by (meson Cauchy_def le_less_trans)
   then obtain l where x_lim: \<open>(\<lambda>n. x n a) \<longlonglongrightarrow> l a\<close> for a
     apply atomize_elim apply (rule choice)
     by (simp add: convergent_eq_Cauchy)
   define L where \<open>L = Abs_ell2 l\<close>
   define normF where \<open>normF F x = L2_set (cmod \<circ> x) F\<close> for F :: \<open>'a set\<close> and x
   have normF_triangle: \<open>normF F (\<lambda>a. x a + y a) \<le> normF F x + normF F y\<close> if \<open>finite F\<close> for F x y
   proof -
     have \<open>normF F (\<lambda>a. x a + y a) = L2_set (\<lambda>a. cmod (x a + y a)) F\<close>
       by (metis (mono_tags, lifting) L2_set_cong comp_apply normF_def)
     also have \<open>\<dots> \<le> L2_set (\<lambda>a. cmod (x a) + cmod (y a)) F\<close>
       by (meson L2_set_mono norm_ge_zero norm_triangle_ineq)
     also have \<open>\<dots> \<le> L2_set (\<lambda>a. cmod (x a)) F + L2_set (\<lambda>a. cmod (y a)) F\<close>
       by (simp add: L2_set_triangle_ineq)
     also have \<open>\<dots> \<le> normF F x + normF F y\<close>
       by (smt (verit, best) L2_set_cong normF_def comp_apply)
     finally show ?thesis
       by -
   qed
   have normF_negate: \<open>normF F (\<lambda>a. - x a) = normF F x\<close> if \<open>finite F\<close> for F x
     unfolding normF_def o_def by simp
   have normF_ell2norm: \<open>normF F x \<le> ell2_norm x\<close> if \<open>finite F\<close> and \<open>has_ell2_norm x\<close> for F x
     apply (auto intro!: cSUP_upper2[where x=F] simp: that normF_def ell2_norm_L2_set)
     by (meson has_ell2_norm_L2_set that(2))
 
   note Lim_bounded2[rotated, rule_format, trans]
 
   from \<open>Cauchy X\<close>
   obtain I where cauchyX: \<open>norm (X n - X m) \<le> \<epsilon>\<close> if \<open>\<epsilon>>0\<close> \<open>n\<ge>I \<epsilon>\<close> \<open>m\<ge>I \<epsilon>\<close> for \<epsilon> n m
     by (metis Cauchy_def dist_norm less_eq_real_def)
   have normF_xx: \<open>normF F (\<lambda>a. x n a - x m a) \<le> \<epsilon>\<close> if \<open>finite F\<close> \<open>\<epsilon>>0\<close> \<open>n\<ge>I \<epsilon>\<close> \<open>m\<ge>I \<epsilon>\<close> for \<epsilon> n m F
     apply (subst asm_rl[of \<open>(\<lambda>a. x n a - x m a) = Rep_ell2 (X n - X m)\<close>])
      apply (simp add: x_def minus_ell2.rep_eq)
     using that cauchyX by (metis Rep_ell2 mem_Collect_eq normF_ell2norm norm_ell2.rep_eq order_trans)
   have normF_xl_lim: \<open>(\<lambda>m. normF F (\<lambda>a. x m a - l a)) \<longlonglongrightarrow> 0\<close> if \<open>finite F\<close> for F
   proof -
     have \<open>(\<lambda>xa. cmod (x xa m - l m)) \<longlonglongrightarrow> 0\<close> for m
       using x_lim by (simp add: LIM_zero_iff tendsto_norm_zero)
     then have \<open>(\<lambda>m. \<Sum>i\<in>F. ((cmod \<circ> (\<lambda>a. x m a - l a)) i)\<^sup>2) \<longlonglongrightarrow> 0\<close>
       by (auto intro: tendsto_null_sum)
     then show ?thesis
       unfolding normF_def L2_set_def
       using tendsto_real_sqrt by force
   qed
   have normF_xl: \<open>normF F (\<lambda>a. x n a - l a) \<le> \<epsilon>\<close>
     if \<open>n \<ge> I \<epsilon>\<close> and \<open>\<epsilon> > 0\<close> and \<open>finite F\<close> for n \<epsilon> F
   proof -
     have \<open>normF F (\<lambda>a. x n a - l a) - \<epsilon> \<le> normF F (\<lambda>a. x n a - x m a) + normF F (\<lambda>a. x m a - l a) - \<epsilon>\<close> for m
       using normF_triangle[OF \<open>finite F\<close>, where x=\<open>(\<lambda>a. x n a - x m a)\<close> and y=\<open>(\<lambda>a. x m a - l a)\<close>]
       by auto
     also have \<open>\<dots> m \<le> normF F (\<lambda>a. x m a - l a)\<close> if \<open>m \<ge> I \<epsilon>\<close> for m
       using normF_xx[OF \<open>finite F\<close> \<open>\<epsilon>>0\<close> \<open>n \<ge> I \<epsilon>\<close> \<open>m \<ge> I \<epsilon>\<close>]
       by auto
     also have \<open>(\<lambda>m. \<dots> m) \<longlonglongrightarrow> 0\<close>
       using \<open>finite F\<close> by (rule normF_xl_lim)
     finally show ?thesis
       by auto
   qed
   have \<open>normF F l \<le> 1 + normF F (x (I 1))\<close> if [simp]: \<open>finite F\<close> for F
     using normF_xl[where F=F and \<epsilon>=1 and n=\<open>I 1\<close>]
     using normF_triangle[where F=F and x=\<open>x (I 1)\<close> and y=\<open>\<lambda>a. l a - x (I 1) a\<close>]
     using normF_negate[where F=F and x=\<open>(\<lambda>a. x (I 1) a - l a)\<close>]
     by auto
   also have \<open>\<dots> F \<le> 1 + ell2_norm (x (I 1))\<close> if \<open>finite F\<close> for F
     using normF_ell2norm that by simp
   finally have [simp]: \<open>has_ell2_norm l\<close>
     unfolding has_ell2_norm_L2_set
     by (auto intro!: bdd_aboveI simp flip: normF_def)
   then have \<open>l = Rep_ell2 L\<close>
     by (simp add: Abs_ell2_inverse L_def)
   have [simp]: \<open>has_ell2_norm (\<lambda>a. x n a - l a)\<close> for n
     apply (subst diff_conv_add_uminus)
     apply (rule ell2_norm_triangle)
     by (auto intro!: ell2_norm_uminus)
   from normF_xl have ell2norm_xl: \<open>ell2_norm (\<lambda>a. x n a - l a) \<le> \<epsilon>\<close>
     if \<open>n \<ge> I \<epsilon>\<close> and \<open>\<epsilon> > 0\<close> for n \<epsilon>
     apply (subst ell2_norm_L2_set)
     using that by (auto intro!: cSUP_least simp: normF_def)
   have \<open>norm (X n - L) \<le> \<epsilon>\<close> if \<open>n \<ge> I \<epsilon>\<close> and \<open>\<epsilon> > 0\<close> for n \<epsilon>
     using ell2norm_xl[OF that]
     by (simp add: x_def norm_ell2.rep_eq \<open>l = Rep_ell2 L\<close> minus_ell2.rep_eq)
   then have \<open>X \<longlonglongrightarrow> L\<close>
     unfolding tendsto_iff
     apply (auto simp: dist_norm eventually_sequentially)
     by (meson field_lbound_gt_zero le_less_trans)
   then show \<open>convergent X\<close>
     by (rule convergentI)
 qed
 
 lemma sum_ell2_transfer[transfer_rule]:
   includes lifting_syntax
   shows \<open>(((=) ===> pcr_ell2 (=)) ===> rel_set (=) ===> pcr_ell2 (=)) 
           (\<lambda>f X x. sum (\<lambda>y. f y x) X) sum\<close>
 proof (intro rel_funI, rename_tac f f' X X')
   fix f and f' :: \<open>'a \<Rightarrow> 'b ell2\<close> 
   assume [transfer_rule]: \<open>((=) ===> pcr_ell2 (=)) f f'\<close>
   fix X X' :: \<open>'a set\<close>
   assume \<open>rel_set (=) X X'\<close>
   then have [simp]: \<open>X' = X\<close>
     by (simp add: rel_set_eq)
   show \<open>pcr_ell2 (=) (\<lambda>x. \<Sum>y\<in>X. f y x) (sum f' X')\<close>
     unfolding \<open>X' = X\<close>
   proof (induction X rule: infinite_finite_induct)
     case (infinite X)
     show ?case
       apply (simp add: infinite)
       by transfer_prover
   next
     case empty
     show ?case
       apply (simp add: empty)
       by transfer_prover
   next
     case (insert x F)
     note [transfer_rule] = insert.IH
     show ?case
       apply (simp add: insert)
       by transfer_prover
   qed
 qed
 
 lemma clinear_Rep_ell2[simp]: \<open>clinear (\<lambda>\<psi>. Rep_ell2 \<psi> i)\<close>
   by (simp add: clinearI plus_ell2.rep_eq scaleC_ell2.rep_eq)
 
 lemma Abs_ell2_inverse_finite[simp]: \<open>Rep_ell2 (Abs_ell2 \<psi>) = \<psi>\<close> for \<psi> :: \<open>_::finite \<Rightarrow> complex\<close>
   by (simp add: Abs_ell2_inverse)
 
 
 subsection \<open>Orthogonality\<close>
 
 lemma ell2_pointwise_ortho:
   assumes \<open>\<And> i. Rep_ell2 x i = 0 \<or> Rep_ell2 y i = 0\<close>
   shows \<open>is_orthogonal x y\<close>
   using assms apply transfer
   by (simp add: infsum_0)
 
 subsection \<open>Truncated vectors\<close>
 
 lift_definition trunc_ell2:: \<open>'a set \<Rightarrow> 'a ell2 \<Rightarrow> 'a ell2\<close>
   is \<open>\<lambda> S x. (\<lambda> i. (if i \<in> S then x i else 0))\<close>
 proof (rename_tac S x)
   fix x :: \<open>'a \<Rightarrow> complex\<close> and S :: \<open>'a set\<close>
   assume \<open>has_ell2_norm x\<close>
   then have \<open>(\<lambda>i. (x i)\<^sup>2) abs_summable_on UNIV\<close>
     unfolding has_ell2_norm_def by -
   then have \<open>(\<lambda>i. (x i)\<^sup>2) abs_summable_on S\<close>
     using summable_on_subset_banach by blast
   then have \<open>(\<lambda>xa. (if xa \<in> S then x xa else 0)\<^sup>2) abs_summable_on UNIV\<close>
     apply (rule summable_on_cong_neutral[THEN iffD1, rotated -1])
     by auto
   then show \<open>has_ell2_norm (\<lambda>i. if i \<in> S then x i else 0)\<close>
     unfolding has_ell2_norm_def by -
 qed
 
 lemma trunc_ell2_empty[simp]: \<open>trunc_ell2 {} x = 0\<close>
   apply transfer by simp
 
 lemma trunc_ell2_UNIV[simp]: \<open>trunc_ell2 UNIV \<psi> = \<psi>\<close>
   apply transfer by simp
 
 lemma norm_id_minus_trunc_ell2:
   \<open>(norm (x - trunc_ell2 S x))^2 = (norm x)^2 - (norm (trunc_ell2 S x))^2\<close>
 proof-
   have \<open>Rep_ell2 (trunc_ell2 S x) i = 0 \<or> Rep_ell2 (x - trunc_ell2 S x) i = 0\<close> for i
     apply transfer
     by auto
   hence \<open>((trunc_ell2 S x) \<bullet>\<^sub>C (x - trunc_ell2 S x)) = 0\<close>
     using ell2_pointwise_ortho by blast
   hence \<open>(norm x)^2 = (norm (trunc_ell2 S x))^2 + (norm (x - trunc_ell2 S x))^2\<close>
     using pythagorean_theorem by fastforce    
   thus ?thesis by simp
 qed
 
 lemma norm_trunc_ell2_finite:
   \<open>finite S \<Longrightarrow> (norm (trunc_ell2 S x)) = sqrt ((sum (\<lambda>i. (cmod (Rep_ell2 x i))\<^sup>2)) S)\<close>
 proof-
   assume \<open>finite S\<close>
   moreover have \<open>\<And> i. i \<notin> S \<Longrightarrow> Rep_ell2 ((trunc_ell2 S x)) i = 0\<close>
     by (simp add: trunc_ell2.rep_eq)    
   ultimately have \<open>(norm (trunc_ell2 S x)) = sqrt ((sum (\<lambda>i. (cmod (Rep_ell2 ((trunc_ell2 S x)) i))\<^sup>2)) S)\<close>
     using ell2_norm_finite_support
     by blast 
   moreover have \<open>\<And> i. i \<in> S \<Longrightarrow> Rep_ell2 ((trunc_ell2 S x)) i = Rep_ell2 x i\<close>
     by (simp add: trunc_ell2.rep_eq)
   ultimately show ?thesis by simp
 qed
 
 lemma trunc_ell2_lim_at_UNIV:
   \<open>((\<lambda>S. trunc_ell2 S \<psi>) \<longlongrightarrow> \<psi>) (finite_subsets_at_top UNIV)\<close>
 proof -
   define f where \<open>f i = (cmod (Rep_ell2 \<psi> i))\<^sup>2\<close> for i
 
   have has: \<open>has_ell2_norm (Rep_ell2 \<psi>)\<close>
     using Rep_ell2 by blast
   then have summable: "f abs_summable_on UNIV"
     by (smt (verit, del_insts) f_def has_ell2_norm_def norm_ge_zero norm_power real_norm_def summable_on_cong)
 
   have \<open>norm \<psi> = (ell2_norm (Rep_ell2 \<psi>))\<close>
     apply transfer by simp
   also have \<open>\<dots> = sqrt (infsum f UNIV)\<close>
     by (simp add: ell2_norm_def f_def[symmetric])
   finally have norm\<psi>: \<open>norm \<psi> = sqrt (infsum f UNIV)\<close>
     by -
 
   have norm_trunc: \<open>norm (trunc_ell2 S \<psi>) = sqrt (sum f S)\<close> if \<open>finite S\<close> for S
     using f_def that norm_trunc_ell2_finite by fastforce
 
   have \<open>(sum f \<longlongrightarrow> infsum f UNIV) (finite_subsets_at_top UNIV)\<close>
     using f_def[abs_def] infsum_tendsto local.summable by fastforce
   then have \<open>((\<lambda>S. sqrt (sum f S)) \<longlongrightarrow> sqrt (infsum f UNIV)) (finite_subsets_at_top UNIV)\<close>
     using tendsto_real_sqrt by blast
   then have \<open>((\<lambda>S. norm (trunc_ell2 S \<psi>)) \<longlongrightarrow> norm \<psi>) (finite_subsets_at_top UNIV)\<close>
     apply (subst tendsto_cong[where g=\<open>\<lambda>S. sqrt (sum f S)\<close>])
     by (auto simp add: eventually_finite_subsets_at_top_weakI norm_trunc norm\<psi>)
   then have \<open>((\<lambda>S. (norm (trunc_ell2 S \<psi>))\<^sup>2) \<longlongrightarrow> (norm \<psi>)\<^sup>2) (finite_subsets_at_top UNIV)\<close>
     by (simp add: tendsto_power)
   then have \<open>((\<lambda>S. (norm \<psi>)\<^sup>2 - (norm (trunc_ell2 S \<psi>))\<^sup>2) \<longlongrightarrow> 0) (finite_subsets_at_top UNIV)\<close>
     apply (rule tendsto_diff[where a=\<open>(norm \<psi>)^2\<close> and b=\<open>(norm \<psi>)^2\<close>, simplified, rotated])
     by auto
   then have \<open>((\<lambda>S. (norm (\<psi> - trunc_ell2 S \<psi>))\<^sup>2) \<longlongrightarrow> 0) (finite_subsets_at_top UNIV)\<close>
     unfolding norm_id_minus_trunc_ell2 by simp
   then have \<open>((\<lambda>S. norm (\<psi> - trunc_ell2 S \<psi>)) \<longlongrightarrow> 0) (finite_subsets_at_top UNIV)\<close>
     by auto
   then have \<open>((\<lambda>S. \<psi> - trunc_ell2 S \<psi>) \<longlongrightarrow> 0) (finite_subsets_at_top UNIV)\<close>
     by (rule tendsto_norm_zero_cancel)
   then show ?thesis
     apply (rule Lim_transform2[where f=\<open>\<lambda>_. \<psi>\<close>, rotated])
     by simp
 qed
 
 lemma trunc_ell2_norm_mono: \<open>M \<subseteq> N \<Longrightarrow> norm (trunc_ell2 M \<psi>) \<le> norm (trunc_ell2 N \<psi>)\<close>
 proof (rule power2_le_imp_le[rotated], force, transfer)
   fix M N :: \<open>'a set\<close> and \<psi> :: \<open>'a \<Rightarrow> complex\<close>
   assume \<open>M \<subseteq> N\<close> and \<open>has_ell2_norm \<psi>\<close>
   have \<open>(ell2_norm (\<lambda>i. if i \<in> M then \<psi> i else 0))\<^sup>2 = (\<Sum>\<^sub>\<infinity>i\<in>M. (cmod (\<psi> i))\<^sup>2)\<close>
     unfolding ell2_norm_square
     apply (rule infsum_cong_neutral)
     by auto
   also have \<open>\<dots> \<le> (\<Sum>\<^sub>\<infinity>i\<in>N. (cmod (\<psi> i))\<^sup>2)\<close>
     apply (rule infsum_mono2)
     using \<open>has_ell2_norm \<psi>\<close> \<open>M \<subseteq> N\<close>
     by (auto simp add: ell2_norm_square has_ell2_norm_def simp flip: norm_power intro: summable_on_subset_banach)
   also have \<open>\<dots> = (ell2_norm (\<lambda>i. if i \<in> N then \<psi> i else 0))\<^sup>2\<close>
     unfolding ell2_norm_square
     apply (rule infsum_cong_neutral)
     by auto
   finally show \<open>(ell2_norm (\<lambda>i. if i \<in> M then \<psi> i else 0))\<^sup>2 \<le> (ell2_norm (\<lambda>i. if i \<in> N then \<psi> i else 0))\<^sup>2\<close>
     by -
 qed
 
 lemma trunc_ell2_reduces_norm: \<open>norm (trunc_ell2 M \<psi>) \<le> norm \<psi>\<close>
   by (metis subset_UNIV trunc_ell2_UNIV trunc_ell2_norm_mono)
 
 lemma trunc_ell2_twice[simp]: \<open>trunc_ell2 M (trunc_ell2 N \<psi>) = trunc_ell2 (M\<inter>N) \<psi>\<close>
   apply transfer by auto
 
 lemma trunc_ell2_union: \<open>trunc_ell2 (M \<union> N) \<psi> = trunc_ell2 M \<psi> + trunc_ell2 N \<psi> - trunc_ell2 (M\<inter>N) \<psi>\<close>
   apply transfer by auto
 
 lemma trunc_ell2_union_disjoint: \<open>M \<inter> N = {} \<Longrightarrow> trunc_ell2 (M \<union> N) \<psi> = trunc_ell2 M \<psi> + trunc_ell2 N \<psi>\<close>
   by (simp add: trunc_ell2_union)
 
 lemma trunc_ell2_union_Diff: \<open>M \<subseteq> N \<Longrightarrow> trunc_ell2 (N-M) \<psi> = trunc_ell2 N \<psi> - trunc_ell2 M \<psi>\<close>
   using trunc_ell2_union_disjoint[where M=\<open>N-M\<close> and N=M and \<psi>=\<psi>]
   by (simp add: Un_commute inf.commute le_iff_sup)
 
 lemma trunc_ell2_add: \<open>trunc_ell2 M (\<psi> + \<phi>) = trunc_ell2 M \<psi> + trunc_ell2 M \<phi>\<close>
   apply transfer by auto
 
 lemma trunc_ell2_scaleC: \<open>trunc_ell2 M (c *\<^sub>C \<psi>) = c *\<^sub>C trunc_ell2 M \<psi>\<close>
   apply transfer by auto
 
 lemma bounded_clinear_trunc_ell2[bounded_clinear]: \<open>bounded_clinear (trunc_ell2 M)\<close>
   by (auto intro!: bounded_clinearI[where K=1] trunc_ell2_reduces_norm
       simp: trunc_ell2_add trunc_ell2_scaleC)
 
 lemma trunc_ell2_lim: \<open>((\<lambda>S. trunc_ell2 S \<psi>) \<longlongrightarrow> trunc_ell2 M \<psi>) (finite_subsets_at_top M)\<close>
 proof -
   have \<open>((\<lambda>S. trunc_ell2 S (trunc_ell2 M \<psi>)) \<longlongrightarrow> trunc_ell2 M \<psi>) (finite_subsets_at_top UNIV)\<close>
     using trunc_ell2_lim_at_UNIV by blast
   then have \<open>((\<lambda>S. trunc_ell2 (S\<inter>M) \<psi>) \<longlongrightarrow> trunc_ell2 M \<psi>) (finite_subsets_at_top UNIV)\<close>
     by simp
   then show \<open>((\<lambda>S. trunc_ell2 S \<psi>) \<longlongrightarrow> trunc_ell2 M \<psi>) (finite_subsets_at_top M)\<close>
     unfolding filterlim_def
     apply (subst (asm) filtermap_filtermap[where g=\<open>\<lambda>S. S\<inter>M\<close>, symmetric])
     apply (subst (asm) finite_subsets_at_top_inter[where A=M and B=UNIV])
     by auto
 qed
 
 lemma trunc_ell2_lim_general:
   assumes big: \<open>\<And>G. finite G \<Longrightarrow> G \<subseteq> M \<Longrightarrow> (\<forall>\<^sub>F H in F. H \<supseteq> G)\<close>
   assumes small: \<open>\<forall>\<^sub>F H in F. H \<subseteq> M\<close>
   shows \<open>((\<lambda>S. trunc_ell2 S \<psi>) \<longlongrightarrow> trunc_ell2 M \<psi>) F\<close>
 proof (rule tendstoI)
   fix e :: real assume \<open>e > 0\<close>
   from trunc_ell2_lim[THEN tendsto_iff[THEN iffD1], rule_format, OF \<open>e > 0\<close>, where M=M and \<psi>=\<psi>]
   obtain G where \<open>finite G\<close> and \<open>G \<subseteq> M\<close> and 
     close: \<open>dist (trunc_ell2 G \<psi>) (trunc_ell2 M \<psi>) < e\<close>
     apply atomize_elim
     unfolding eventually_finite_subsets_at_top
     by blast
   from \<open>finite G\<close> \<open>G \<subseteq> M\<close> and big
   have \<open>\<forall>\<^sub>F H in F. H \<supseteq> G\<close>
     by -
   with small have \<open>\<forall>\<^sub>F H in F. H \<subseteq> M \<and> H \<supseteq> G\<close>
     by (simp add: eventually_conj_iff)
   then show \<open>\<forall>\<^sub>F H in F. dist (trunc_ell2 H \<psi>) (trunc_ell2 M \<psi>) < e\<close>
   proof (rule eventually_mono)
     fix H assume GHM: \<open>H \<subseteq> M \<and> H \<supseteq> G\<close>
     have \<open>dist (trunc_ell2 H \<psi>) (trunc_ell2 M \<psi>) = norm (trunc_ell2 (M-H) \<psi>)\<close>
       by (simp add: GHM dist_ell2_def norm_minus_commute trunc_ell2_union_Diff)
     also have \<open>\<dots> \<le> norm (trunc_ell2 (M-G) \<psi>)\<close>
       by (simp add: Diff_mono GHM trunc_ell2_norm_mono)
     also have \<open>\<dots>  = dist (trunc_ell2 G \<psi>) (trunc_ell2 M \<psi>)\<close>
       by (simp add: \<open>G \<subseteq> M\<close> dist_ell2_def norm_minus_commute trunc_ell2_union_Diff)
     also have \<open>\<dots> < e\<close>
       using close by simp
     finally show \<open>dist (trunc_ell2 H \<psi>) (trunc_ell2 M \<psi>) < e\<close>
       by -
   qed
 qed
 
 lemma norm_ell2_bound_trunc:
   assumes \<open>\<And>M. finite M \<Longrightarrow> norm (trunc_ell2 M \<psi>) \<le> B\<close>
   shows \<open>norm \<psi> \<le> B\<close>
 proof -
   note trunc_ell2_lim_at_UNIV[of \<psi>]
   then have \<open>((\<lambda>S. norm (trunc_ell2 S \<psi>)) \<longlongrightarrow> norm \<psi>) (finite_subsets_at_top UNIV)\<close>
     using tendsto_norm by auto
   then show \<open>norm \<psi> \<le> B\<close>
     apply (rule tendsto_upperbound)
     using assms apply (rule eventually_finite_subsets_at_top_weakI)
     by auto
 qed
 
 lemma trunc_ell2_uminus: \<open>trunc_ell2 (-M) \<psi> = \<psi> - trunc_ell2 M \<psi>\<close>
   by (metis Int_UNIV_left boolean_algebra_class.diff_eq subset_UNIV trunc_ell2_UNIV trunc_ell2_union_Diff)
 
 subsection \<open>Kets and bras\<close>
 
 lift_definition ket :: \<open>'a \<Rightarrow> 'a ell2\<close> is \<open>\<lambda>x y. of_bool (x=y)\<close>
   by (rule has_ell2_norm_ket)
 
 abbreviation bra :: "'a \<Rightarrow> (_,complex) cblinfun" where "bra i \<equiv> vector_to_cblinfun (ket i)*" for i
 
 instance ell2 :: (type) not_singleton
 proof standard
   have "ket undefined \<noteq> (0::'a ell2)"
   proof transfer
     show \<open>(\<lambda>y. of_bool ((undefined::'a) = y)) \<noteq> (\<lambda>_. 0)\<close>
       by (metis (mono_tags) of_bool_eq(2) zero_neq_one)
   qed   
   thus \<open>\<exists>x y::'a ell2. x \<noteq> y\<close>
     by blast    
 qed
 
 lemma cinner_ket_left: \<open>ket i \<bullet>\<^sub>C \<psi> = Rep_ell2 \<psi> i\<close>
   apply (transfer fixing: i)
   apply (subst infsum_cong_neutral[where T=\<open>{i}\<close>])
   by auto
 
 lemma cinner_ket_right: \<open>(\<psi> \<bullet>\<^sub>C ket i) = cnj (Rep_ell2 \<psi> i)\<close>
   apply (transfer fixing: i)
   apply (subst infsum_cong_neutral[where T=\<open>{i}\<close>])
   by auto
 
 (* Doesn't really belong in this subsection but uses lemmas from this subsection for its proof. *)
 lemma bounded_clinear_Rep_ell2[simp, bounded_clinear]: \<open>bounded_clinear (\<lambda>\<psi>. Rep_ell2 \<psi> x)\<close>
   apply (subst asm_rl[of \<open>(\<lambda>\<psi>. Rep_ell2 \<psi> x) = (\<lambda>\<psi>. ket x \<bullet>\<^sub>C \<psi>)\<close>])
    apply (auto simp: cinner_ket_left) 
   by (simp add: bounded_clinear_cinner_right)
 
 lemma cinner_ket_eqI:
   assumes \<open>\<And>i. ket i \<bullet>\<^sub>C \<psi> = ket i \<bullet>\<^sub>C \<phi>\<close>
   shows \<open>\<psi> = \<phi>\<close>
   by (metis Rep_ell2_inject assms cinner_ket_left ext)
 
 lemma norm_ket[simp]: "norm (ket i) = 1"
   apply transfer by (rule ell2_norm_ket)
 
 lemma cinner_ket_same[simp]:
   \<open>(ket i \<bullet>\<^sub>C ket i) = 1\<close>
 proof-
   have \<open>norm (ket i) = 1\<close>
     by simp
   hence \<open>sqrt (cmod (ket i \<bullet>\<^sub>C ket i)) = 1\<close>
     by (metis norm_eq_sqrt_cinner)
   hence \<open>cmod (ket i \<bullet>\<^sub>C ket i) = 1\<close>
     using real_sqrt_eq_1_iff by blast
   moreover have \<open>(ket i \<bullet>\<^sub>C ket i) = cmod (ket i \<bullet>\<^sub>C ket i)\<close>
   proof-
     have \<open>(ket i \<bullet>\<^sub>C ket i) \<in> \<real>\<close>
       by (simp add: cinner_real)      
     thus ?thesis 
       by (metis cinner_ge_zero complex_of_real_cmod) 
   qed
   ultimately show ?thesis by simp
 qed
 
 lemma orthogonal_ket[simp]:
   \<open>is_orthogonal (ket i) (ket j) \<longleftrightarrow> i \<noteq> j\<close>
   by (simp add: cinner_ket_left ket.rep_eq of_bool_def)
 
 lemma cinner_ket: \<open>(ket i \<bullet>\<^sub>C ket j) = of_bool (i=j)\<close>
   by (simp add: cinner_ket_left ket.rep_eq)
 
 lemma ket_injective[simp]: \<open>ket i = ket j \<longleftrightarrow> i = j\<close>
   by (metis cinner_ket one_neq_zero of_bool_def)
 
-lemma inj_ket[simp]: \<open>inj ket\<close>
+lemma inj_ket[simp]: \<open>inj_on ket M\<close>
   by (simp add: inj_on_def)
 
 lemma trunc_ell2_ket_cspan:
   \<open>trunc_ell2 S x \<in> cspan (range ket)\<close> if \<open>finite S\<close>
 proof (use that in induction)
   case empty
   then show ?case 
     by (auto intro: complex_vector.span_zero)
 next
   case (insert a F)
   from insert.hyps have \<open>trunc_ell2 (insert a F) x = trunc_ell2 F x + Rep_ell2 x a *\<^sub>C ket a\<close>
     apply (transfer fixing: F a)
     by auto
   with insert.IH
   show ?case
     by (simp add: complex_vector.span_add_eq complex_vector.span_base complex_vector.span_scale)
 qed
 
 lemma closed_cspan_range_ket[simp]:
   \<open>closure (cspan (range ket)) = UNIV\<close>
 proof (intro set_eqI iffI UNIV_I closure_approachable[THEN iffD2] allI impI)
   fix \<psi> :: \<open>'a ell2\<close>
   fix e :: real assume \<open>e > 0\<close>
   have \<open>((\<lambda>S. trunc_ell2 S \<psi>) \<longlongrightarrow> \<psi>) (finite_subsets_at_top UNIV)\<close>
     by (rule trunc_ell2_lim_at_UNIV)
   then obtain F where \<open>finite F\<close> and \<open>dist (trunc_ell2 F \<psi>) \<psi> < e\<close>
     apply (drule_tac tendstoD[OF _ \<open>e > 0\<close>])
     by (auto dest: simp: eventually_finite_subsets_at_top)
   moreover have \<open>trunc_ell2 F \<psi> \<in> cspan (range ket)\<close>
     using \<open>finite F\<close> trunc_ell2_ket_cspan by blast
   ultimately show \<open>\<exists>\<phi>\<in>cspan (range ket). dist \<phi> \<psi> < e\<close>
     by auto
 qed
 
 lemma ccspan_range_ket[simp]: "ccspan (range ket) = (top::('a ell2 ccsubspace))"
 proof-
   have \<open>closure (complex_vector.span (range ket)) = (UNIV::'a ell2 set)\<close>
     using Complex_L2.closed_cspan_range_ket by blast
   thus ?thesis
     by (simp add: ccspan.abs_eq top_ccsubspace.abs_eq)
 qed
 
 lemma cspan_range_ket_finite[simp]: "cspan (range ket :: 'a::finite ell2 set) = UNIV"
   by (metis closed_cspan_range_ket closure_finite_cspan finite_class.finite_UNIV finite_imageI)
 
 instance ell2 :: (finite) cfinite_dim
 proof
   define basis :: \<open>'a ell2 set\<close> where \<open>basis = range ket\<close>
   have \<open>finite basis\<close>
     unfolding basis_def by simp
   moreover have \<open>cspan basis = UNIV\<close>
     by (simp add: basis_def)
   ultimately show \<open>\<exists>basis::'a ell2 set. finite basis \<and> cspan basis = UNIV\<close>
     by auto
 qed
 
 instantiation ell2 :: (enum) onb_enum begin
 definition "canonical_basis_ell2 = map ket Enum.enum"
 definition \<open>canonical_basis_length_ell2 (_ :: 'a ell2 itself) = length (Enum.enum :: 'a list)\<close>
 instance
 proof
   show "distinct (canonical_basis::'a ell2 list)"
   proof-
     have \<open>finite (UNIV::'a set)\<close>
       by simp
     have \<open>distinct (enum_class.enum::'a list)\<close>
       using enum_distinct by blast
     moreover have \<open>inj_on ket (set enum_class.enum)\<close>
       by (meson inj_onI ket_injective)         
     ultimately show ?thesis
       unfolding canonical_basis_ell2_def
       using distinct_map
       by blast
   qed    
 
   show "is_ortho_set (set (canonical_basis::'a ell2 list))"
     apply (auto simp: canonical_basis_ell2_def enum_UNIV)
     by (smt (z3) norm_ket f_inv_into_f is_ortho_set_def orthogonal_ket norm_zero)
 
   show "cindependent (set (canonical_basis::'a ell2 list))"
     apply (auto simp: canonical_basis_ell2_def enum_UNIV)
     by (smt (verit, best) norm_ket f_inv_into_f is_ortho_set_def is_ortho_set_cindependent orthogonal_ket norm_zero)
 
   show "cspan (set (canonical_basis::'a ell2 list)) = UNIV"
     by (auto simp: canonical_basis_ell2_def enum_UNIV)
 
   show "norm (x::'a ell2) = 1"
     if "(x::'a ell2) \<in> set canonical_basis"
     for x :: "'a ell2"
     using that unfolding canonical_basis_ell2_def 
     by auto
 
   show \<open>canonical_basis_length TYPE('a ell2) = length (canonical_basis :: 'a ell2 list)\<close>
     by (simp add: canonical_basis_length_ell2_def canonical_basis_ell2_def)
   qed
 end
 
 lemma canonical_basis_length_ell2[code_unfold, simp]:
   "length (canonical_basis ::'a::enum ell2 list) = CARD('a)"
   unfolding canonical_basis_ell2_def apply simp
   using card_UNIV_length_enum by metis
 
 lemma ket_canonical_basis: "ket x = canonical_basis ! enum_idx x"
 proof-
   have "x = (enum_class.enum::'a list) ! enum_idx x"
     using enum_idx_correct[where i = x] by simp
   hence p1: "ket x = ket ((enum_class.enum::'a list) ! enum_idx x)"
     by simp
   have "enum_idx x < length (enum_class.enum::'a list)"
     using enum_idx_bound[where x = x] card_UNIV_length_enum
     by metis
   hence "(map ket (enum_class.enum::'a list)) ! enum_idx x 
         = ket ((enum_class.enum::'a list) ! enum_idx x)"
     by auto      
   thus ?thesis
     unfolding canonical_basis_ell2_def using p1 by auto    
 qed
 
 lemma clinear_equal_ket:
   fixes f g :: \<open>'a::finite ell2 \<Rightarrow> _\<close>
   assumes \<open>clinear f\<close>
   assumes \<open>clinear g\<close>
   assumes \<open>\<And>i. f (ket i) = g (ket i)\<close>
   shows \<open>f = g\<close>
   apply (rule ext)
   apply (rule complex_vector.linear_eq_on_span[where f=f and g=g and B=\<open>range ket\<close>])
   using assms by auto
 
 lemma equal_ket:
   fixes A B :: \<open>('a ell2, 'b::complex_normed_vector) cblinfun\<close>
   assumes \<open>\<And> x. A *\<^sub>V ket x = B *\<^sub>V ket x\<close>
   shows \<open>A = B\<close>
   apply (rule cblinfun_eq_gen_eqI[where G=\<open>range ket\<close>])
   using assms by auto
 
 lemma antilinear_equal_ket:
   fixes f g :: \<open>'a::finite ell2 \<Rightarrow> _\<close>
   assumes \<open>antilinear f\<close>
   assumes \<open>antilinear g\<close>
   assumes \<open>\<And>i. f (ket i) = g (ket i)\<close>
   shows \<open>f = g\<close>
 proof -
   have [simp]: \<open>clinear (f \<circ> from_conjugate_space)\<close>
     apply (rule antilinear_o_antilinear)
     using assms by (simp_all add: antilinear_from_conjugate_space)
   have [simp]: \<open>clinear (g \<circ> from_conjugate_space)\<close>
     apply (rule antilinear_o_antilinear)
     using assms by (simp_all add: antilinear_from_conjugate_space)
   have [simp]: \<open>cspan (to_conjugate_space ` (range ket :: 'a ell2 set)) = UNIV\<close>
     by simp
   have "f o from_conjugate_space = g o from_conjugate_space"
     apply (rule ext)
     apply (rule complex_vector.linear_eq_on_span[where f="f o from_conjugate_space" and g="g o from_conjugate_space" and B=\<open>to_conjugate_space ` range ket\<close>])
        apply (simp, simp)
     using assms(3) by (auto simp: to_conjugate_space_inverse)
   then show "f = g"
     by (smt (verit) UNIV_I from_conjugate_space_inverse surj_def surj_fun_eq to_conjugate_space_inject) 
 qed
 
 lemma cinner_ket_adjointI:
   fixes F::"'a ell2 \<Rightarrow>\<^sub>C\<^sub>L _" and G::"'b ell2 \<Rightarrow>\<^sub>C\<^sub>L_"
   assumes "\<And> i j. (F *\<^sub>V ket i) \<bullet>\<^sub>C ket j = ket i \<bullet>\<^sub>C (G *\<^sub>V ket j)"
   shows "F = G*"
 proof -
   from assms
   have \<open>(F *\<^sub>V x) \<bullet>\<^sub>C y = x \<bullet>\<^sub>C (G *\<^sub>V y)\<close> if \<open>x \<in> range ket\<close> and \<open>y \<in> range ket\<close> for x y
     using that by auto
   then have \<open>(F *\<^sub>V x) \<bullet>\<^sub>C y = x \<bullet>\<^sub>C (G *\<^sub>V y)\<close> if \<open>x \<in> range ket\<close> for x y
     apply (rule bounded_clinear_eq_on_closure[where G=\<open>range ket\<close> and t=y, rotated 2])
     using that by (auto intro!: bounded_linear_intros)
   then have \<open>(F *\<^sub>V x) \<bullet>\<^sub>C y = x \<bullet>\<^sub>C (G *\<^sub>V y)\<close> for x y
     apply (rule bounded_antilinear_eq_on[where G=\<open>range ket\<close> and t=x, rotated 2])
     by (auto intro!: bounded_linear_intros)
   then show ?thesis
     by (rule adjoint_eqI)
 qed
 
 lemma ket_nonzero[simp]: "ket i \<noteq> 0"
   using norm_ket[of i] by force
 
 lemma cindependent_ket[simp]:
   "cindependent (range (ket::'a\<Rightarrow>_))"
 proof-
   define S where "S = range (ket::'a\<Rightarrow>_)"
   have "is_ortho_set S"
     unfolding S_def is_ortho_set_def by auto
   moreover have "0 \<notin> S"
     unfolding S_def
     using ket_nonzero
     by (simp add: image_iff)
   ultimately show ?thesis
     using is_ortho_set_cindependent[where A = S] unfolding S_def 
     by blast
 qed
 
 lemma cdim_UNIV_ell2[simp]: \<open>cdim (UNIV::'a::finite ell2 set) = CARD('a)\<close>
   apply (subst cspan_range_ket_finite[symmetric])
   by (metis card_image cindependent_ket complex_vector.dim_span_eq_card_independent inj_ket)
 
 lemma is_ortho_set_ket[simp]: \<open>is_ortho_set (range ket)\<close>
   using is_ortho_set_def by fastforce
 
 lemma bounded_clinear_equal_ket:
   fixes f g :: \<open>'a ell2 \<Rightarrow> _\<close>
   assumes \<open>bounded_clinear f\<close>
   assumes \<open>bounded_clinear g\<close>
   assumes \<open>\<And>i. f (ket i) = g (ket i)\<close>
   shows \<open>f = g\<close>
   apply (rule ext)
   apply (rule bounded_clinear_eq_on_closure[of f g \<open>range ket\<close>])
   using assms by auto
 
 lemma bounded_antilinear_equal_ket:
   fixes f g :: \<open>'a ell2 \<Rightarrow> _\<close>
   assumes \<open>bounded_antilinear f\<close>
   assumes \<open>bounded_antilinear g\<close>
   assumes \<open>\<And>i. f (ket i) = g (ket i)\<close>
   shows \<open>f = g\<close>
   apply (rule ext)
   apply (rule bounded_antilinear_eq_on[of f g \<open>range ket\<close>])
   using assms by auto
 
 lemma is_onb_ket[simp]: \<open>is_onb (range ket)\<close>
   by (auto simp: is_onb_def)
 
 lemma ell2_sum_ket: \<open>\<psi> = (\<Sum>i\<in>UNIV. Rep_ell2 \<psi> i *\<^sub>C ket i)\<close> for \<psi> :: \<open>_::finite ell2\<close>
   apply transfer apply (rule ext)
   apply (subst sum_single)
   by auto
 
 lemma trunc_ell2_singleton: \<open>trunc_ell2 {x} \<psi> = Rep_ell2 \<psi> x *\<^sub>C ket x\<close>
   apply transfer by auto
 
 lemma trunc_ell2_insert: \<open>trunc_ell2 (insert x M) \<phi> = Rep_ell2 \<phi> x *\<^sub>C ket x + trunc_ell2 M \<phi>\<close>
   if \<open>x \<notin> M\<close>
   using trunc_ell2_union_disjoint[where M=\<open>{x}\<close> and N=M]
   using that by (auto simp: trunc_ell2_singleton)
 
 lemma trunc_ell2_finite_sum: \<open>trunc_ell2 M \<psi> = (\<Sum>i\<in>M. Rep_ell2 \<psi> i *\<^sub>C ket i)\<close> if \<open>finite M\<close>
   using that apply induction by (auto simp: trunc_ell2_insert)
 
 lemma is_orthogonal_trunc_ell2: \<open>is_orthogonal (trunc_ell2 M \<psi>) (trunc_ell2 N \<phi>)\<close> if \<open>M \<inter> N = {}\<close>
 proof -
   have *: \<open>cnj (if i \<in> M then a else 0) * (if i \<in> N then b else 0) = 0\<close> for a b i
     using that by auto
   show ?thesis
     apply (transfer fixing: M N)
     by (simp add: * )
 qed
 
 subsection \<open>Butterflies\<close>
 
 lemma cspan_butterfly_ket: \<open>cspan {butterfly (ket i) (ket j)| (i::'b::finite) (j::'a::finite). True} = UNIV\<close>
 proof -
   have *: \<open>{butterfly (ket i) (ket j)| (i::'b::finite) (j::'a::finite). True} = {butterfly a b |a b. a \<in> range ket \<and> b \<in> range ket}\<close>
     by auto
   show ?thesis
     apply (subst *)
     apply (rule cspan_butterfly_UNIV)
     by auto
 qed
 
 lemma cindependent_butterfly_ket: \<open>cindependent {butterfly (ket i) (ket j)| (i::'b) (j::'a). True}\<close>
 proof -
   have *: \<open>{butterfly (ket i) (ket j)| (i::'b) (j::'a). True} = {butterfly a b |a b. a \<in> range ket \<and> b \<in> range ket}\<close>
     by auto
   show ?thesis
     apply (subst *)
     apply (rule cindependent_butterfly)
     by auto
 qed
 
 lemma clinear_eq_butterfly_ketI:
   fixes F G :: \<open>('a::finite ell2 \<Rightarrow>\<^sub>C\<^sub>L 'b::finite ell2) \<Rightarrow> 'c::complex_vector\<close>
   assumes "clinear F" and "clinear G"
   assumes "\<And>i j. F (butterfly (ket i) (ket j)) = G (butterfly (ket i) (ket j))"
   shows "F = G"
   apply (rule complex_vector.linear_eq_on_span[where f=F, THEN ext, rotated 3])
      apply (subst cspan_butterfly_ket)
   using assms by auto
 
 lemma sum_butterfly_ket[simp]: \<open>(\<Sum>(i::'a::finite)\<in>UNIV. butterfly (ket i) (ket i)) = id_cblinfun\<close>
   apply (rule equal_ket)
   apply (subst complex_vector.linear_sum[where f=\<open>\<lambda>y. y *\<^sub>V ket _\<close>])
    apply (auto simp add: scaleC_cblinfun.rep_eq cblinfun.add_left clinearI butterfly_def cblinfun_compose_image cinner_ket)
   apply (subst sum.mono_neutral_cong_right[where S=\<open>{_}\<close>])
   by auto
 
 lemma ell2_decompose_has_sum: \<open>((\<lambda>x. Rep_ell2 \<phi> x *\<^sub>C ket x) has_sum \<phi>) UNIV\<close>
 proof (unfold has_sum_def)
   have *: \<open>trunc_ell2 M \<phi> = (\<Sum>x\<in>M. Rep_ell2 \<phi> x *\<^sub>C ket x)\<close> if \<open>finite M\<close> for M
     using that apply induction
     by (auto simp: trunc_ell2_insert)
   show \<open>(sum (\<lambda>x. Rep_ell2 \<phi> x *\<^sub>C ket x) \<longlongrightarrow> \<phi>) (finite_subsets_at_top UNIV)\<close>
     apply (rule Lim_transform_eventually)
      apply (rule trunc_ell2_lim_at_UNIV)
     using * by (rule eventually_finite_subsets_at_top_weakI)
 qed
 
 lemma ell2_decompose_infsum: \<open>\<phi> = (\<Sum>\<^sub>\<infinity>x. Rep_ell2 \<phi> x *\<^sub>C ket x)\<close>
   by (metis ell2_decompose_has_sum infsumI)
 
 lemma ell2_decompose_summable: \<open>(\<lambda>x. Rep_ell2 \<phi> x *\<^sub>C ket x) summable_on UNIV\<close>
   using ell2_decompose_has_sum summable_on_def by blast
 
 lemma Rep_ell2_cblinfun_apply_sum: \<open>Rep_ell2 (A *\<^sub>V \<phi>) y = (\<Sum>\<^sub>\<infinity>x. Rep_ell2 \<phi> x * Rep_ell2 (A *\<^sub>V ket x) y)\<close>
 proof -
   have 1: \<open>bounded_linear (\<lambda>z. Rep_ell2 (A *\<^sub>V z) y)\<close>
     by (auto intro!: bounded_clinear_compose[unfolded o_def, OF bounded_clinear_Rep_ell2]
         cblinfun.bounded_clinear_right bounded_clinear.bounded_linear)
   have 2: \<open>(\<lambda>x. Rep_ell2 \<phi> x *\<^sub>C ket x) summable_on UNIV\<close>
     by (simp add: ell2_decompose_summable)
   have \<open>Rep_ell2 (A *\<^sub>V \<phi>) y = Rep_ell2 (A *\<^sub>V (\<Sum>\<^sub>\<infinity>x. Rep_ell2 \<phi> x *\<^sub>C ket x)) y\<close>
     by (simp flip: ell2_decompose_infsum)
   also have \<open>\<dots> = (\<Sum>\<^sub>\<infinity>x. Rep_ell2 (A *\<^sub>V (Rep_ell2 \<phi> x *\<^sub>C ket x)) y)\<close>
     apply (subst infsum_bounded_linear[symmetric, where f=\<open>\<lambda>z. Rep_ell2 (A *\<^sub>V z) y\<close>])
     using 1 2 by (auto simp: o_def)
   also have \<open>\<dots> = (\<Sum>\<^sub>\<infinity>x. Rep_ell2 \<phi> x * Rep_ell2 (A *\<^sub>V ket x) y)\<close>
     by (simp add: cblinfun.scaleC_right scaleC_ell2.rep_eq)
   finally show ?thesis
     by -
 qed
 
 
 subsection \<open>One-dimensional spaces\<close>
 
 instantiation ell2 :: (CARD_1) one begin
 lift_definition one_ell2 :: "'a ell2" is "\<lambda>_. 1" by simp
 instance..
 end
 
 lemma ket_CARD_1_is_1: \<open>ket x = 1\<close> for x :: \<open>'a::CARD_1\<close>
   apply transfer by simp
 
 instantiation ell2 :: (CARD_1) times begin
 lift_definition times_ell2 :: "'a ell2 \<Rightarrow> 'a ell2 \<Rightarrow> 'a ell2" is "\<lambda>a b x. a x * b x"
   by simp   
 instance..
 end
 
 instantiation ell2 :: (CARD_1) divide begin
 lift_definition divide_ell2 :: "'a ell2 \<Rightarrow> 'a ell2 \<Rightarrow> 'a ell2" is "\<lambda>a b x. a x / b x"
   by simp   
 instance..
 end
 
 instantiation ell2 :: (CARD_1) inverse begin
 lift_definition inverse_ell2 :: "'a ell2 \<Rightarrow> 'a ell2" is "\<lambda>a x. inverse (a x)"
   by simp
 instance..
 end
 
 instantiation ell2 :: ("{enum,CARD_1}") one_dim begin
 text \<open>Note: enum is not needed logically, but without it this instantiation
             clashes with \<open>instantiation ell2 :: (enum) onb_enum\<close>\<close>
 instance
 proof intro_classes
   show "canonical_basis = [1::'a ell2]"
     unfolding canonical_basis_ell2_def
     apply transfer
     by (simp add: enum_CARD_1[of undefined])
   show "a *\<^sub>C 1 * b *\<^sub>C 1 = (a * b) *\<^sub>C (1::'a ell2)" for a b
     apply (transfer fixing: a b) by simp
   show "x / y = x * inverse y" for x y :: "'a ell2"
     apply transfer
     by (simp add: divide_inverse)
   show "inverse (c *\<^sub>C 1) = inverse c *\<^sub>C (1::'a ell2)" for c :: complex
     apply transfer by auto
 qed
 end
 
 subsection \<open>Explicit bounded operators\<close>
 
 definition explicit_cblinfun :: \<open>('a \<Rightarrow> 'b \<Rightarrow> complex) \<Rightarrow> ('b ell2, 'a ell2) cblinfun\<close> where
-  \<open>explicit_cblinfun m = cblinfun_extension (range ket) (\<lambda>a. Abs_ell2 (\<lambda>j. m j (inv ket a)))\<close>
+  \<open>explicit_cblinfun M = cblinfun_extension (range ket) (\<lambda>a. Abs_ell2 (\<lambda>j. M j (inv ket a)))\<close>
 
 definition explicit_cblinfun_exists :: \<open>('a \<Rightarrow> 'b \<Rightarrow> complex) \<Rightarrow> bool\<close> where
-  \<open>explicit_cblinfun_exists m \<longleftrightarrow> 
-    (\<forall>a. has_ell2_norm (\<lambda>j. m j a)) \<and> 
-      cblinfun_extension_exists (range ket) (\<lambda>a. Abs_ell2 (\<lambda>j. m j (inv ket a)))\<close>
+  \<open>explicit_cblinfun_exists M \<longleftrightarrow> 
+    (\<forall>a. has_ell2_norm (\<lambda>j. M j a)) \<and> 
+      cblinfun_extension_exists (range ket) (\<lambda>a. Abs_ell2 (\<lambda>j. M j (inv ket a)))\<close>
 
 lemma explicit_cblinfun_exists_bounded:
-  fixes B :: real
   assumes \<open>\<And>S T \<psi>. finite S \<Longrightarrow> finite T \<Longrightarrow> (\<And>a. a\<notin>T \<Longrightarrow> \<psi> a = 0) \<Longrightarrow>
-            (\<Sum>b\<in>S. (cmod (\<Sum>a\<in>T. \<psi> a *\<^sub>C m b a))\<^sup>2) \<le> B * (\<Sum>a\<in>T. (cmod (\<psi> a))\<^sup>2)\<close>
-  shows \<open>explicit_cblinfun_exists m\<close>
+            (\<Sum>b\<in>S. (cmod (\<Sum>a\<in>T. \<psi> a *\<^sub>C M b a))\<^sup>2) \<le> B * (\<Sum>a\<in>T. (cmod (\<psi> a))\<^sup>2)\<close>
+  shows \<open>explicit_cblinfun_exists M\<close>
 proof -
   define F f where \<open>F = complex_vector.construct (range ket) f\<close>
-    and \<open>f = (\<lambda>a. Abs_ell2 (\<lambda>j. m j (inv ket a)))\<close>
+    and \<open>f = (\<lambda>a. Abs_ell2 (\<lambda>j. M j (inv ket a)))\<close>
   from assms[where S=\<open>{}\<close> and T=\<open>{undefined}\<close> and \<psi>=\<open>\<lambda>x. of_bool (x=undefined)\<close>]
   have \<open>B \<ge> 0\<close>
     by auto
-  have has_norm: \<open>has_ell2_norm (\<lambda>b. m b a)\<close> for a
+  have has_norm: \<open>has_ell2_norm (\<lambda>b. M b a)\<close> for a
   proof (unfold has_ell2_norm_def, intro nonneg_bdd_above_summable_on bdd_aboveI)
-    show \<open>0 \<le> cmod ((m x a)\<^sup>2)\<close> for x
+    show \<open>0 \<le> cmod ((M x a)\<^sup>2)\<close> for x
       by simp
     fix B'
-    assume \<open>B' \<in> sum (\<lambda>x. cmod ((m x a)\<^sup>2)) ` {F. F \<subseteq> UNIV \<and> finite F}\<close>
-    then obtain S where [simp]: \<open>finite S\<close> and B'_def: \<open>B' = (\<Sum>x\<in>S. cmod ((m x a)\<^sup>2))\<close>
+    assume \<open>B' \<in> sum (\<lambda>x. cmod ((M x a)\<^sup>2)) ` {F. F \<subseteq> UNIV \<and> finite F}\<close>
+    then obtain S where [simp]: \<open>finite S\<close> and B'_def: \<open>B' = (\<Sum>x\<in>S. cmod ((M x a)\<^sup>2))\<close>
       by blast
     from assms[where S=S and T=\<open>{a}\<close> and \<psi>=\<open>\<lambda>x. of_bool (x=a)\<close>]
     show \<open>B' \<le> B\<close>
       by (simp add: norm_power B'_def)
   qed
   have \<open>clinear F\<close>
     by (auto intro!: complex_vector.linear_construct simp: F_def)
   have F_B: \<open>norm (F \<psi>) \<le> (sqrt B) * norm \<psi>\<close> if \<psi>_range_ket: \<open>\<psi> \<in> cspan (range ket)\<close> for \<psi>
   proof -
     from that
     obtain T' where \<open>finite T'\<close> and \<open>T' \<subseteq> range ket\<close> and \<psi>T': \<open>\<psi> \<in> cspan T'\<close>
       by (meson vector_finitely_spanned)
         (*   from that
     obtain T' r where \<open>finite T'\<close> and \<open>T' \<subseteq> range ket\<close> and
       \<psi>T': \<open>\<psi> = (\<Sum>v\<in>T'. r v *\<^sub>C v)\<close>
       unfolding complex_vector.span_explicit
       by blast *)
     then obtain T where T'_def: \<open>T' = ket ` T\<close>
       by (meson subset_image_iff)
     have \<open>finite T\<close>
       by (metis T'_def \<open>finite T'\<close> finite_image_iff inj_ket inj_on_subset subset_UNIV)
     have \<psi>T: \<open>\<psi> \<in> cspan (ket ` T)\<close>
       using T'_def \<psi>T' by blast
     have Rep_\<psi>: \<open>Rep_ell2 \<psi> x = 0\<close> if \<open>x \<notin> T\<close> for x
       using _ _ \<psi>T apply (rule complex_vector.linear_eq_0_on_span)
        apply auto
       by (metis ket.rep_eq that of_bool_def)
     have \<open>norm (trunc_ell2 S (F \<psi>)) \<le> sqrt B * norm \<psi>\<close> if \<open>finite S\<close> for S
     proof -
       have *: \<open>cconstruct (range ket) f \<psi> = (\<Sum>x\<in>T. Rep_ell2 \<psi> x *\<^sub>C f (ket x))\<close>
       proof (rule complex_vector.linear_eq_on[where x=\<psi> and B=\<open>ket ` T\<close>])
         show \<open>clinear (cconstruct (range ket) f)\<close>
           using F_def \<open>clinear F\<close> by blast
         show \<open>clinear (\<lambda>a. \<Sum>x\<in>T. Rep_ell2 a x *\<^sub>C f (ket x))\<close>
           by (auto intro!: clinear_compose[unfolded o_def, OF clinear_Rep_ell2] complex_vector.linear_compose_sum)
         show \<open>\<psi> \<in> cspan (ket ` T)\<close>
           by (simp add: \<psi>T)
         have \<open>f b = (\<Sum>x\<in>T. Rep_ell2 b x *\<^sub>C f (ket x))\<close> 
           if \<open>b \<in> ket ` T\<close> for b
         proof -
           define b' where \<open>b' = inv ket b\<close>
           have bb': \<open>b = ket b'\<close>
             using b'_def that by force
           show ?thesis
             apply (subst sum_single[where i=b'])
             using that by (auto simp add: \<open>finite T\<close> bb' ket.rep_eq)
         qed
         then show \<open>cconstruct (range ket) f b = (\<Sum>x\<in>T. Rep_ell2 b x *\<^sub>C f (ket x))\<close>
           if \<open>b \<in> ket ` T\<close> for b
           apply (subst complex_vector.construct_basis)
           using that by auto
       qed
       have \<open>(norm (trunc_ell2 S (F \<psi>)))\<^sup>2 = (norm (trunc_ell2 S (\<Sum>x\<in>T. Rep_ell2 \<psi> x *\<^sub>C f (ket x))))\<^sup>2\<close>
         apply (rule arg_cong[where f=\<open>\<lambda>x. (norm (trunc_ell2 _ x))\<^sup>2\<close>])
         by (simp add: F_def * )
-      also have \<open>\<dots> = (norm (trunc_ell2 S (\<Sum>x\<in>T. Rep_ell2 \<psi> x *\<^sub>C Abs_ell2 (\<lambda>b. m b x))))\<^sup>2\<close>
+      also have \<open>\<dots> = (norm (trunc_ell2 S (\<Sum>x\<in>T. Rep_ell2 \<psi> x *\<^sub>C Abs_ell2 (\<lambda>b. M b x))))\<^sup>2\<close>
         by (simp add: f_def)
-      also have \<open>\<dots> = (\<Sum>i\<in>S. (cmod (Rep_ell2 (\<Sum>x\<in>T. Rep_ell2 \<psi> x *\<^sub>C Abs_ell2 (\<lambda>b. m b x)) i))\<^sup>2)\<close>
+      also have \<open>\<dots> = (\<Sum>i\<in>S. (cmod (Rep_ell2 (\<Sum>x\<in>T. Rep_ell2 \<psi> x *\<^sub>C Abs_ell2 (\<lambda>b. M b x)) i))\<^sup>2)\<close>
         by (simp add: that norm_trunc_ell2_finite real_sqrt_pow2 sum_nonneg)
-      also have \<open>\<dots> = (\<Sum>i\<in>S. (cmod (\<Sum>x\<in>T. Rep_ell2 \<psi> x *\<^sub>C Rep_ell2 (Abs_ell2 (\<lambda>b. m b x)) i))\<^sup>2)\<close>
+      also have \<open>\<dots> = (\<Sum>i\<in>S. (cmod (\<Sum>x\<in>T. Rep_ell2 \<psi> x *\<^sub>C Rep_ell2 (Abs_ell2 (\<lambda>b. M b x)) i))\<^sup>2)\<close>
         by (simp add: complex_vector.linear_sum[OF clinear_Rep_ell2]
             clinear.scaleC[OF clinear_Rep_ell2])
-      also have \<open>\<dots> = (\<Sum>i\<in>S. (cmod (\<Sum>x\<in>T. Rep_ell2 \<psi> x *\<^sub>C m i x))\<^sup>2)\<close>
+      also have \<open>\<dots> = (\<Sum>i\<in>S. (cmod (\<Sum>x\<in>T. Rep_ell2 \<psi> x *\<^sub>C M i x))\<^sup>2)\<close>
         using has_norm by (simp add: Abs_ell2_inverse)
       also have \<open>\<dots> \<le> B * (\<Sum>x\<in>T. (cmod (Rep_ell2 \<psi> x))\<^sup>2)\<close>
         using \<open>finite S\<close> \<open>finite T\<close> Rep_\<psi> by (rule assms)
       also have \<open>\<dots> = B * ((norm (trunc_ell2 T \<psi>))\<^sup>2)\<close>
         by (simp add: \<open>finite T\<close> norm_trunc_ell2_finite sum_nonneg)
       also have \<open>\<dots> \<le> B * (norm \<psi>)\<^sup>2\<close>
         by (simp add: mult_left_mono \<open>B \<ge> 0\<close> trunc_ell2_reduces_norm)
       finally show ?thesis
         apply (rule_tac power2_le_imp_le)
         by (simp_all add: \<open>0 \<le> B\<close> power_mult_distrib)
     qed
     then show ?thesis
       by (rule norm_ell2_bound_trunc)
   qed
   then have \<open>cblinfun_extension_exists (cspan (range ket)) F\<close>
     apply (rule cblinfun_extension_exists_hilbert[rotated -1])
     by (auto intro: \<open>clinear F\<close> complex_vector.linear_add complex_vector.linear_scale)
   then have ex: \<open>cblinfun_extension_exists (range ket) f\<close>
     apply (rule cblinfun_extension_exists_restrict[rotated -1])
     by (simp_all add: F_def complex_vector.span_superset complex_vector.construct_basis)
   from ex has_norm
   show ?thesis
     using explicit_cblinfun_exists_def f_def by blast
 qed
 
-lemma explicit_cblinfun_exists_finite_dim[simp]: \<open>explicit_cblinfun_exists m\<close> for m :: "_::finite \<Rightarrow> _ :: finite \<Rightarrow> _"
+lemma explicit_cblinfun_exists_finite_dim[simp]: \<open>explicit_cblinfun_exists m\<close> for m :: "_::finite \<Rightarrow> _::finite \<Rightarrow> _"
   by (auto simp: explicit_cblinfun_exists_def cblinfun_extension_exists_finite_dim)
 
-lemma explicit_cblinfun_ket: \<open>explicit_cblinfun m *\<^sub>V ket a = Abs_ell2 (\<lambda>b. m b a)\<close> if \<open>explicit_cblinfun_exists m\<close>
+lemma explicit_cblinfun_ket: \<open>explicit_cblinfun M *\<^sub>V ket a = Abs_ell2 (\<lambda>b. M b a)\<close> if \<open>explicit_cblinfun_exists M\<close>
   using that by (auto simp: explicit_cblinfun_exists_def explicit_cblinfun_def cblinfun_extension_apply)
 
-lemma Rep_ell2_explicit_cblinfun_ket[simp]: \<open>Rep_ell2 (explicit_cblinfun m *\<^sub>V ket a) b = m b a\<close> if \<open>explicit_cblinfun_exists m\<close>
+lemma Rep_ell2_explicit_cblinfun_ket[simp]: \<open>Rep_ell2 (explicit_cblinfun M *\<^sub>V ket a) b = M b a\<close> if \<open>explicit_cblinfun_exists M\<close>
   using that apply (simp add: explicit_cblinfun_ket)
   by (simp add: Abs_ell2_inverse explicit_cblinfun_exists_def)
 
 subsection \<open>Classical operators\<close>
 
 text \<open>We call an operator mapping \<^term>\<open>ket x\<close> to \<^term>\<open>ket (\<pi> x)\<close> or \<^term>\<open>0\<close> "classical".
 (The meaning is inspired by the fact that in quantum mechanics, such operators usually correspond
 to operations with classical interpretation (such as Pauli-X, CNOT, measurement in the computational
 basis, etc.))\<close>
 
 definition classical_operator :: "('a\<Rightarrow>'b option) \<Rightarrow> 'a ell2 \<Rightarrow>\<^sub>C\<^sub>L'b ell2" where
   "classical_operator \<pi> = 
     (let f = (\<lambda>t. (case \<pi> (inv (ket::'a\<Rightarrow>_) t) 
                            of None \<Rightarrow> (0::'b ell2) 
                           | Some i \<Rightarrow> ket i))
      in
       cblinfun_extension (range (ket::'a\<Rightarrow>_)) f)"
 
 definition "classical_operator_exists \<pi> \<longleftrightarrow>
   cblinfun_extension_exists (range ket)
     (\<lambda>t. case \<pi> (inv ket t) of None \<Rightarrow> 0 | Some i \<Rightarrow> ket i)"
 
 lemma classical_operator_existsI:
   assumes "\<And>x. B *\<^sub>V (ket x) = (case \<pi> x of Some i \<Rightarrow> ket i | None \<Rightarrow> 0)"
   shows "classical_operator_exists \<pi>"
   unfolding classical_operator_exists_def
   apply (rule cblinfun_extension_existsI[of _ B])
   using assms 
   by (auto simp: inv_f_f[OF inj_ket])
 
 lemma 
   assumes "inj_map \<pi>"
   shows classical_operator_exists_inj: "classical_operator_exists \<pi>"
     and classical_operator_norm_inj: \<open>norm (classical_operator \<pi>) \<le> 1\<close>
 proof -
   have \<open>is_orthogonal (case \<pi> x of None \<Rightarrow> 0 | Some x' \<Rightarrow> ket x')
                       (case \<pi> y of None \<Rightarrow> 0 | Some y' \<Rightarrow> ket y')\<close>
     if \<open>x \<noteq> y\<close> for x y
     apply (cases \<open>\<pi> x\<close>; cases \<open>\<pi> y\<close>)
     using that assms
     by (auto simp add: inj_map_def)
   then have 1: \<open>is_orthogonal (case \<pi> (inv ket x) of None \<Rightarrow> 0 | Some x' \<Rightarrow> ket x')
                       (case \<pi> (inv ket y) of None \<Rightarrow> 0 | Some y' \<Rightarrow> ket y')\<close>
     if \<open>x \<in> range ket\<close> and \<open>y \<in> range ket\<close> and \<open>x \<noteq> y\<close> for x y
     using that by auto
 
   have \<open>norm (case \<pi> x of None \<Rightarrow> 0 | Some x \<Rightarrow> ket x) \<le> 1 * norm (ket x)\<close> for x
     apply (cases \<open>\<pi> x\<close>) by auto
   then have 2: \<open>norm (case \<pi> (inv ket x) of None \<Rightarrow> 0 | Some x \<Rightarrow> ket x) \<le> 1 * norm x\<close>
     if \<open>x \<in> range ket\<close> for x
     using that by auto
 
   show \<open>classical_operator_exists \<pi>\<close>
     unfolding classical_operator_exists_def
     using _ _ 1 2 apply (rule cblinfun_extension_exists_ortho)
     by simp_all
 
   show \<open>norm (classical_operator \<pi>) \<le> 1\<close>
     unfolding classical_operator_def Let_def
     using _ _ 1 2 apply (rule cblinfun_extension_exists_ortho_norm)
     by simp_all
 qed
 
 lemma classical_operator_exists_finite[simp]: "classical_operator_exists (\<pi> :: _::finite \<Rightarrow> _)"
   unfolding classical_operator_exists_def
   apply (rule cblinfun_extension_exists_finite_dim)
   using cindependent_ket apply blast
   using finite_class.finite_UNIV finite_imageI closed_cspan_range_ket closure_finite_cspan by blast
 
 lemma classical_operator_ket:
   assumes "classical_operator_exists \<pi>"
   shows "(classical_operator \<pi>) *\<^sub>V (ket x) = (case \<pi> x of Some i \<Rightarrow> ket i | None \<Rightarrow> 0)"
   unfolding classical_operator_def 
   using f_inv_into_f ket_injective rangeI
   by (metis assms cblinfun_extension_apply classical_operator_exists_def)
 
 lemma classical_operator_ket_finite:
   "(classical_operator \<pi>) *\<^sub>V (ket (x::'a::finite)) = (case \<pi> x of Some i \<Rightarrow> ket i | None \<Rightarrow> 0)"
   by (rule classical_operator_ket, simp)
 
 lemma classical_operator_adjoint[simp]:
   fixes \<pi> :: "'a \<Rightarrow> 'b option"
   assumes a1: "inj_map \<pi>"
   shows  "(classical_operator \<pi>)* = classical_operator (inv_map \<pi>)"
 proof-
   define F where "F = classical_operator (inv_map \<pi>)"
   define G where "G = classical_operator \<pi>"
   have "(F *\<^sub>V ket i) \<bullet>\<^sub>C ket j = ket i \<bullet>\<^sub>C (G *\<^sub>V ket j)" for i j
   proof-
     have w1: "(classical_operator (inv_map \<pi>)) *\<^sub>V (ket i)
      = (case inv_map \<pi> i of Some k \<Rightarrow> ket k | None \<Rightarrow> 0)"
       by (simp add: classical_operator_ket classical_operator_exists_inj)
     have w2: "(classical_operator \<pi>) *\<^sub>V (ket j)
      = (case \<pi> j of Some k \<Rightarrow> ket k | None \<Rightarrow> 0)"
       by (simp add: assms classical_operator_ket classical_operator_exists_inj)
     have "(F *\<^sub>V ket i) \<bullet>\<^sub>C ket j = (classical_operator (inv_map \<pi>) *\<^sub>V ket i) \<bullet>\<^sub>C ket j"
       unfolding F_def by blast
     also have "\<dots> = ((case inv_map \<pi> i of Some k \<Rightarrow> ket k | None \<Rightarrow> 0) \<bullet>\<^sub>C ket j)"
       using w1 by simp
     also have "\<dots> = (ket i \<bullet>\<^sub>C (case \<pi> j of Some k \<Rightarrow> ket k | None \<Rightarrow> 0))"
     proof(induction "inv_map \<pi> i")
       case None
       hence pi1: "None = inv_map \<pi> i".
       show ?case 
       proof (induction "\<pi> j")
         case None
         thus ?case
           using pi1 by auto
       next
         case (Some c)
         have "c \<noteq> i"
         proof(rule classical)
           assume "\<not>(c \<noteq> i)"
           hence "c = i"
             by blast
           hence "inv_map \<pi> c = inv_map \<pi> i"
             by simp
           hence "inv_map \<pi> c = None"
             by (simp add: pi1)
           moreover have "inv_map \<pi> c = Some j"
             using Some.hyps unfolding inv_map_def
             apply auto
             by (metis a1 f_inv_into_f inj_map_def option.distinct(1) rangeI)
           ultimately show ?thesis by simp
         qed
         thus ?thesis
           by (metis None.hyps Some.hyps cinner_zero_left orthogonal_ket option.simps(4) 
               option.simps(5)) 
       qed       
     next
       case (Some d)
       hence s1: "Some d = inv_map \<pi> i".
       show "(case inv_map \<pi> i of None \<Rightarrow> 0| Some a \<Rightarrow> ket a) \<bullet>\<^sub>C ket j
            = ket i \<bullet>\<^sub>C (case \<pi> j of None \<Rightarrow> 0 | Some a \<Rightarrow> ket a)" 
       proof(induction "\<pi> j")
         case None
         have "d \<noteq> j"
         proof(rule classical)
           assume "\<not>(d \<noteq> j)"
           hence "d = j"
             by blast
           hence "\<pi> d = \<pi> j"
             by simp
           hence "\<pi> d = None"
             by (simp add: None.hyps)
           moreover have "\<pi> d = Some i"
             using Some.hyps unfolding inv_map_def
             apply auto
             by (metis f_inv_into_f option.distinct(1) option.inject)
           ultimately show ?thesis 
             by simp
         qed
         thus ?case
           by (metis None.hyps Some.hyps cinner_zero_right orthogonal_ket option.case_eq_if 
               option.simps(5)) 
       next
         case (Some c)
         hence s2: "\<pi> j = Some c" by simp
         have "(ket d \<bullet>\<^sub>C ket j) = (ket i \<bullet>\<^sub>C ket c)"
         proof(cases "\<pi> j = Some i")
           case True
           hence ij: "Some j = inv_map \<pi> i"
             unfolding inv_map_def apply auto
              apply (metis a1 f_inv_into_f inj_map_def option.discI range_eqI)
             by (metis range_eqI)
           have "i = c"
             using True s2 by auto
           moreover have "j = d"
             by (metis option.inject s1 ij)
           ultimately show ?thesis
             by (simp add: cinner_ket_same) 
         next
           case False
           moreover have "\<pi> d = Some i"
             using s1 unfolding inv_map_def
             by (metis f_inv_into_f option.distinct(1) option.inject)            
           ultimately have "j \<noteq> d"
             by auto            
           moreover have "i \<noteq> c"
             using False s2 by auto            
           ultimately show ?thesis
             by (metis orthogonal_ket) 
         qed
         hence "(case Some d of None \<Rightarrow> 0 | Some a \<Rightarrow> ket a) \<bullet>\<^sub>C ket j
              = ket i \<bullet>\<^sub>C (case Some c of None \<Rightarrow> 0 | Some a \<Rightarrow> ket a)"
           by simp          
         thus "(case inv_map \<pi> i of None \<Rightarrow> 0 | Some a \<Rightarrow> ket a) \<bullet>\<^sub>C ket j
              = ket i \<bullet>\<^sub>C (case \<pi> j of None \<Rightarrow> 0 | Some a \<Rightarrow> ket a)"
           by (simp add: Some.hyps s1)          
       qed
     qed
     also have "\<dots> = ket i \<bullet>\<^sub>C (classical_operator \<pi> *\<^sub>V ket j)"
       by (simp add: w2)
     also have "\<dots> = ket i \<bullet>\<^sub>C (G *\<^sub>V ket j)"
       unfolding G_def by blast
     finally show ?thesis .
   qed
   hence "G* = F"
     using cinner_ket_adjointI
     by auto
   thus ?thesis unfolding G_def F_def .
 qed
 
 lemma
   fixes \<pi>::"'b \<Rightarrow> 'c option" and \<rho>::"'a \<Rightarrow> 'b option"
   assumes "classical_operator_exists \<pi>"
   assumes "classical_operator_exists \<rho>"
   shows classical_operator_exists_comp[simp]: "classical_operator_exists (\<pi> \<circ>\<^sub>m \<rho>)"
     and classical_operator_mult[simp]: "classical_operator \<pi> o\<^sub>C\<^sub>L classical_operator \<rho> = classical_operator (\<pi> \<circ>\<^sub>m \<rho>)"
 proof -
   define C\<pi> C\<rho> C\<pi>\<rho> where "C\<pi> = classical_operator \<pi>" and "C\<rho> = classical_operator \<rho>" 
     and "C\<pi>\<rho> = classical_operator (\<pi> \<circ>\<^sub>m \<rho>)"
   have C\<pi>x: "C\<pi> *\<^sub>V (ket x) = (case \<pi> x of Some i \<Rightarrow> ket i | None \<Rightarrow> 0)" for x
     unfolding C\<pi>_def using \<open>classical_operator_exists \<pi>\<close> by (rule classical_operator_ket)
   have C\<rho>x: "C\<rho> *\<^sub>V (ket x) = (case \<rho> x of Some i \<Rightarrow> ket i | None \<Rightarrow> 0)" for x
     unfolding C\<rho>_def using \<open>classical_operator_exists \<rho>\<close> by (rule classical_operator_ket)
   have C\<pi>\<rho>x': "(C\<pi> o\<^sub>C\<^sub>L C\<rho>) *\<^sub>V (ket x) = (case (\<pi> \<circ>\<^sub>m \<rho>) x of Some i \<Rightarrow> ket i | None \<Rightarrow> 0)" for x
     apply (simp add: scaleC_cblinfun.rep_eq C\<rho>x)
     apply (cases "\<rho> x")
     by (auto simp: C\<pi>x)
   thus \<open>classical_operator_exists (\<pi> \<circ>\<^sub>m \<rho>)\<close>
     by (rule classical_operator_existsI)
   hence "C\<pi>\<rho> *\<^sub>V (ket x) = (case (\<pi> \<circ>\<^sub>m \<rho>) x of Some i \<Rightarrow> ket i | None \<Rightarrow> 0)" for x
     unfolding C\<pi>\<rho>_def
     by (rule classical_operator_ket)
   with C\<pi>\<rho>x' have "(C\<pi> o\<^sub>C\<^sub>L C\<rho>) *\<^sub>V (ket x) = C\<pi>\<rho> *\<^sub>V (ket x)" for x
     by simp
   thus "C\<pi> o\<^sub>C\<^sub>L C\<rho> = C\<pi>\<rho>"
     by (simp add: equal_ket)
 qed
 
 lemma classical_operator_Some[simp]: "classical_operator (Some::'a\<Rightarrow>_) = id_cblinfun"
 proof-
   have "(classical_operator Some) *\<^sub>V (ket i)  = id_cblinfun *\<^sub>V (ket i)"
     for i::'a
     apply (subst classical_operator_ket)
      apply (rule classical_operator_exists_inj)
     by auto
   thus ?thesis
     using equal_ket[where A = "classical_operator (Some::'a \<Rightarrow> _ option)"
         and B = "id_cblinfun::'a ell2 \<Rightarrow>\<^sub>C\<^sub>L _"]
     by blast
 qed
 
 lemma isometry_classical_operator[simp]:
   fixes \<pi>::"'a \<Rightarrow> 'b"
   assumes a1: "inj \<pi>"
   shows "isometry (classical_operator (Some o \<pi>))"
 proof -
   have b0: "inj_map (Some \<circ> \<pi>)"
     by (simp add: a1)
   have b0': "inj_map (inv_map (Some \<circ> \<pi>))"
     by simp
   have b1: "inv_map (Some \<circ> \<pi>) \<circ>\<^sub>m (Some \<circ> \<pi>) = Some" 
     apply (rule ext) unfolding inv_map_def o_def 
     using assms unfolding inj_def inv_def by auto
   have b3: "classical_operator (inv_map (Some \<circ> \<pi>)) o\<^sub>C\<^sub>L
             classical_operator (Some \<circ> \<pi>) = classical_operator (inv_map (Some \<circ> \<pi>) \<circ>\<^sub>m (Some \<circ> \<pi>))"
     by (metis b0 b0' b1 classical_operator_Some classical_operator_exists_inj 
         classical_operator_mult)
   show ?thesis
     unfolding isometry_def
     apply (subst classical_operator_adjoint)
     using b0 by (auto simp add: b1 b3)
 qed
 
 lemma unitary_classical_operator[simp]:
   fixes \<pi>::"'a \<Rightarrow> 'b"
   assumes a1: "bij \<pi>"
   shows "unitary (classical_operator (Some o \<pi>))"
 proof (unfold unitary_def, rule conjI)
   have "inj \<pi>"
     using a1 bij_betw_imp_inj_on by auto
   hence "isometry (classical_operator (Some o \<pi>))"
     by simp
   hence "classical_operator (Some \<circ> \<pi>)* o\<^sub>C\<^sub>L classical_operator (Some \<circ> \<pi>) = id_cblinfun"
     unfolding isometry_def by simp
   thus \<open>classical_operator (Some \<circ> \<pi>)* o\<^sub>C\<^sub>L classical_operator (Some \<circ> \<pi>) = id_cblinfun\<close>
     by simp 
 next
   have "inj \<pi>"
     by (simp add: assms bij_is_inj)
   have comp: "Some \<circ> \<pi> \<circ>\<^sub>m inv_map (Some \<circ> \<pi>) = Some"
     apply (rule ext)
     unfolding inv_map_def o_def map_comp_def
     unfolding inv_def apply auto
      apply (metis \<open>inj \<pi>\<close> inv_def inv_f_f)
     using bij_def image_iff range_eqI
     by (metis a1)
   have "classical_operator (Some \<circ> \<pi>) o\<^sub>C\<^sub>L classical_operator (Some \<circ> \<pi>)*
       = classical_operator (Some \<circ> \<pi>) o\<^sub>C\<^sub>L classical_operator (inv_map (Some \<circ> \<pi>))"
     by (simp add: \<open>inj \<pi>\<close>)
   also have "\<dots> = classical_operator ((Some \<circ> \<pi>) \<circ>\<^sub>m (inv_map (Some \<circ> \<pi>)))"
     by (simp add: \<open>inj \<pi>\<close> classical_operator_exists_inj)
   also have "\<dots> = classical_operator (Some::'b\<Rightarrow>_)"
     using comp
     by simp 
   also have "\<dots> = (id_cblinfun:: 'b ell2 \<Rightarrow>\<^sub>C\<^sub>L _)"
     by simp
   finally show "classical_operator (Some \<circ> \<pi>) o\<^sub>C\<^sub>L classical_operator (Some \<circ> \<pi>)* = id_cblinfun".
 qed
 
 
 unbundle no_lattice_syntax
 unbundle no_cblinfun_notation
 
 end
diff --git a/thys/Complex_Bounded_Operators/extra/Extra_Jordan_Normal_Form.thy b/thys/Complex_Bounded_Operators/extra/Extra_Jordan_Normal_Form.thy
--- a/thys/Complex_Bounded_Operators/extra/Extra_Jordan_Normal_Form.thy
+++ b/thys/Complex_Bounded_Operators/extra/Extra_Jordan_Normal_Form.thy
@@ -1,419 +1,419 @@
 section \<open>\<open>Extra_Jordan_Normal_Form\<close> -- Additional results for \<^session>\<open>Jordan_Normal_Form\<close>\<close>
 (*
 Authors: 
   Dominique Unruh, University of Tartu, unruh@ut.ee      
   Jose Manuel Rodriguez Caballero, University of Tartu, jose.manuel.rodriguez.caballero@ut.ee
 *)                 
 
 theory Extra_Jordan_Normal_Form
   imports
     Jordan_Normal_Form.Matrix Jordan_Normal_Form.Schur_Decomposition
 begin
 
 text \<open>We define bundles to activate/deactivate the notation from \<^session>\<open>Jordan_Normal_Form\<close>.
                                                                          
 Reactivate the notation locally via "@{theory_text \<open>includes jnf_notation\<close>}" in a lemma statement.
 (Or sandwich a declaration using that notation between "@{theory_text \<open>unbundle jnf_notation ... unbundle no_jnf_notation\<close>}.)
 \<close>
 
 bundle jnf_notation begin
 notation transpose_mat ("(_\<^sup>T)" [1000])
 notation cscalar_prod (infix "\<bullet>c" 70)
 notation vec_index (infixl "$" 100)
 notation smult_vec (infixl "\<cdot>\<^sub>v" 70)
 notation scalar_prod (infix "\<bullet>" 70)
 notation index_mat (infixl "$$" 100)
 notation smult_mat (infixl "\<cdot>\<^sub>m" 70)
 notation mult_mat_vec (infixl "*\<^sub>v" 70)
 notation pow_mat (infixr "^\<^sub>m" 75)
 notation append_vec (infixr "@\<^sub>v" 65)
 notation append_rows (infixr "@\<^sub>r" 65)
 end
 
 
 bundle no_jnf_notation begin
 no_notation transpose_mat ("(_\<^sup>T)" [1000])
 no_notation cscalar_prod (infix "\<bullet>c" 70)
 no_notation vec_index (infixl "$" 100)
 no_notation smult_vec (infixl "\<cdot>\<^sub>v" 70)
 no_notation scalar_prod (infix "\<bullet>" 70)
 no_notation index_mat (infixl "$$" 100)
 no_notation smult_mat (infixl "\<cdot>\<^sub>m" 70)
 no_notation mult_mat_vec (infixl "*\<^sub>v" 70)
 no_notation pow_mat (infixr "^\<^sub>m" 75)
 no_notation append_vec (infixr "@\<^sub>v" 65)
 no_notation append_rows (infixr "@\<^sub>r" 65)
 end
 
 unbundle jnf_notation
 
 
 lemma mat_entry_explicit:
   fixes M :: "'a::field mat"
   assumes "M \<in> carrier_mat m n" and "i < m" and "j < n"
   shows   "vec_index (M *\<^sub>v unit_vec n j) i = M $$ (i,j)"
   using assms by auto
 
 
 lemma mat_adjoint_def': "mat_adjoint M = transpose_mat (map_mat conjugate M)"
   apply (rule mat_eq_iff[THEN iffD2])
   apply (auto simp: mat_adjoint_def transpose_mat_def)
   apply (subst mat_of_rows_index)
   by auto
 
 lemma mat_adjoint_swap:
   fixes M ::"complex mat"
   assumes "M \<in> carrier_mat nB nA" and "iA < dim_row M" and "iB < dim_col M"
   shows "(mat_adjoint M)$$(iB,iA) = cnj (M$$(iA,iB))"
   unfolding transpose_mat_def map_mat_def
   by (simp add: assms(2) assms(3) mat_adjoint_def')
 
 lemma cscalar_prod_adjoint:
   fixes M:: "complex mat"
   assumes "M \<in> carrier_mat nB nA" 
     and "dim_vec v = nA"
     and "dim_vec u = nB"
   shows "v \<bullet>c ((mat_adjoint M) *\<^sub>v u) = (M *\<^sub>v v) \<bullet>c u"
   unfolding mat_adjoint_def using assms(1) assms(2,3)[symmetric]
   apply (simp add: scalar_prod_def sum_distrib_left field_simps)
   by (intro sum.swap)
 
 lemma scaleC_minus1_left_vec: "-1 \<cdot>\<^sub>v v = - v" for v :: "_::ring_1 vec"
   unfolding smult_vec_def uminus_vec_def by auto
 
 lemma square_nneg_complex:
   fixes x :: complex
   assumes "x \<in> \<real>" shows "x^2 \<ge> 0"
   apply (cases x) using assms unfolding Reals_def less_eq_complex_def by auto
 
 definition "vec_is_zero n v = (\<forall>i<n. v $ i = 0)"
 
 lemma vec_is_zero: "dim_vec v = n \<Longrightarrow> vec_is_zero n v \<longleftrightarrow> v = 0\<^sub>v n"
   unfolding vec_is_zero_def apply auto
   by (metis index_zero_vec(1))
 
 fun gram_schmidt_sub0
   where "gram_schmidt_sub0 n us [] = us"
   | "gram_schmidt_sub0 n us (w # ws) =
      (let w' = adjuster n w us + w in
       if vec_is_zero n w' then gram_schmidt_sub0 n us ws
                           else gram_schmidt_sub0 n (w' # us) ws)"
 
 lemma (in cof_vec_space) adjuster_already_in_span:
   assumes "w \<in> carrier_vec n"
   assumes us_carrier: "set us \<subseteq> carrier_vec n"
   assumes "corthogonal us"
   assumes "w \<in> span (set us)"
   shows "adjuster n w us + w = 0\<^sub>v n"
 proof -
   define v U where "v = adjuster n w us + w" and "U = set us"
   have span: "v \<in> span U"
     unfolding v_def U_def
     apply (rule adjust_preserves_span[THEN iffD1])
     using assms corthogonal_distinct by simp_all
   have v_carrier: "v \<in> carrier_vec n"
     by (simp add: v_def assms corthogonal_distinct)
   have "v \<bullet>c us!i = 0" if "i < length us" for i
     unfolding v_def
     apply (rule adjust_zero)
     using that assms by simp_all
   hence "v \<bullet>c u = 0" if "u \<in> U" for u
     by (metis assms(3) U_def corthogonal_distinct distinct_Ex1 that)
   hence ortho: "u \<bullet>c v = 0" if "u \<in> U" for u
     apply (subst conjugate_zero_iff[symmetric])
     apply (subst conjugate_vec_sprod_comm)
     using that us_carrier v_carrier apply (auto simp: U_def)[2]
     apply (subst conjugate_conjugate_sprod)
     using that us_carrier v_carrier by (auto simp: U_def)
   from span obtain a where v: "lincomb a U = v"
     apply atomize_elim apply (rule finite_in_span[simplified])
     unfolding U_def using us_carrier by auto
   have "v \<bullet>c v = (\<Sum>u\<in>U. (a u \<cdot>\<^sub>v u) \<bullet>c v)"
     apply (subst v[symmetric])
     unfolding lincomb_def
     apply (subst finsum_scalar_prod_sum)
     using U_def span us_carrier by auto
   also have "\<dots> = (\<Sum>u\<in>U. a u * (u \<bullet>c v))"
     using U_def assms(1) in_mono us_carrier v_def by fastforce
   also have "\<dots> = (\<Sum>u\<in>U. a u * conjugate 0)"
     apply (rule sum.cong, simp)
     using span span_closed U_def us_carrier ortho by auto
   also have "\<dots> = 0"
     by auto
   finally have "v \<bullet>c v = 0"
     by -
   thus "v = 0\<^sub>v n"
     using U_def conjugate_square_eq_0_vec span span_closed us_carrier by blast
 qed
 
 
 lemma (in cof_vec_space) gram_schmidt_sub0_result:
   assumes "gram_schmidt_sub0 n us ws = us'"
     and "set ws \<subseteq> carrier_vec n"
     and "set us \<subseteq> carrier_vec n"
     and "distinct us"
     and "~ lin_dep (set us)"
     and "corthogonal us"
   shows "set us' \<subseteq> carrier_vec n \<and>
          distinct us' \<and>
          corthogonal us' \<and>
          span (set (us @ ws)) = span (set us')"  
   using assms
 proof (induct ws arbitrary: us us')
   case (Cons w ws)
   show ?case
   proof (cases "w \<in> span (set us)")
     case False
     let ?v = "adjuster n w us"
     have wW[simp]: "set (w#ws) \<subseteq> carrier_vec n" using Cons by simp
     hence W[simp]: "set ws \<subseteq> carrier_vec n"
       and w[simp]: "w : carrier_vec n" by auto
     have U[simp]: "set us \<subseteq> carrier_vec n" using Cons by simp
     have UW: "set (us@ws) \<subseteq> carrier_vec n" by simp
     have wU: "set (w#us) \<subseteq> carrier_vec n" by simp
     have dist_U: "distinct us" using Cons by simp
     have w_U: "w \<notin> set us" using False using span_mem by auto
     have ind_U: "~ lin_dep (set us)"
       using Cons by simp
     have ind_wU: "~ lin_dep (insert w (set us))"
       apply (subst lin_dep_iff_in_span[simplified, symmetric])
       using w_U ind_U False by auto
     thm lin_dep_iff_in_span[simplified, symmetric]
     have corth: "corthogonal us" using Cons by simp
     have "?v + w \<noteq> 0\<^sub>v n"
       by (simp add: False adjust_nonzero dist_U)
     hence "\<not> vec_is_zero n (?v + w)"
       by (simp add: vec_is_zero)
     hence U'def: "gram_schmidt_sub0 n ((?v + w)#us) ws = us'" 
       using Cons by simp
     have v: "?v : carrier_vec n" using dist_U by auto
     hence vw: "?v + w : carrier_vec n" by auto
     hence vwU: "set ((?v + w) # us) \<subseteq> carrier_vec n" by auto
     have vsU: "?v : span (set us)" 
       apply (rule adjuster_in_span[OF w])
       using Cons by simp_all
     hence vsUW: "?v : span (set (us @ ws))"
       using span_is_monotone[of "set us" "set (us@ws)"] by auto
     have wsU: "w \<notin> span (set us)"
       using lin_dep_iff_in_span[OF U ind_U w w_U] ind_wU by auto
     hence vwU: "?v + w \<notin> span (set us)" using adjust_not_in_span[OF w U dist_U] by auto
 
     have span: "?v + w \<notin> span (set us)" 
       apply (subst span_add[symmetric])
       by (simp_all add: False vsU)
     hence vwUS: "?v + w \<notin> set us" using span_mem by auto
 
     have vwU: "set ((?v + w) # us) \<subseteq> carrier_vec n" 
       using U w vw by simp
     have dist2: "distinct (((?v + w) # us))" 
       using vwUS
       by (simp add: dist_U)
 
     have orth2: "corthogonal ((adjuster n w us + w) # us)"
       using adjust_orthogonal[OF U corth w wsU].
 
     have ind_vwU: "~ lin_dep (set ((adjuster n w us + w) # us))"
       apply simp
       apply (subst lin_dep_iff_in_span[simplified, symmetric])
       by (simp_all add: ind_U vw vwUS span)
 
     have span_UwW_U': "span (set (us @ w # ws)) = span (set us')"
       using Cons(1)[OF U'def W vwU dist2 ind_vwU orth2] 
       using span_Un[OF vwU wU gram_schmidt_sub_span[OF w U dist_U] W W refl]
       by simp
 
     show ?thesis
       apply (intro conjI)
       using Cons(1)[OF U'def W vwU dist2 ind_vwU orth2] span_UwW_U' by simp_all
   next
     case True
 
     let ?v = "adjuster n w us"
     have "?v + w = 0\<^sub>v n"
       apply (rule adjuster_already_in_span)
       using True Cons by auto
     hence "vec_is_zero n (?v + w)"
       by (simp add: vec_is_zero)
     hence U'_def: "us' = gram_schmidt_sub0 n us ws"
       using Cons by simp
     have span: "span (set (us @ w # ws)) = span (set us')"
     proof -
       have wU_U: "span (set (w # us)) = span (set us)"
         apply (subst already_in_span[OF _ True, simplified])
         using Cons by auto
       have "span (set (us @ w # ws)) = span (set (w # us) \<union> set ws)"
         by simp
       also have "\<dots> = span (set us \<union> set ws)"
         apply (rule span_Un) using wU_U Cons by auto
       also have "\<dots> = local.span (set us')"
         using Cons U'_def by auto
       finally show ?thesis
         by -
     qed
     moreover have "set us' \<subseteq> carrier_vec n \<and> distinct us' \<and> corthogonal us'"
       unfolding U'_def using Cons by simp
     ultimately show ?thesis
       by auto
   qed
 qed simp
 
 text \<open>This is a variant of \<^term>\<open>Gram_Schmidt.gram_schmidt\<close> that does not require the input vectors
-  \<^term>\<open>ws\<close> to be distinct or orthogonal. (In comparison to \<^term>\<open>Gram_Schmidt.gram_schmidt\<close>,
+  \<^term>\<open>ws\<close> to be distinct or linearly independent. (In comparison to \<^term>\<open>Gram_Schmidt.gram_schmidt\<close>,
   our version also returns the result in reversed order.)\<close>
 definition "gram_schmidt0 n ws = gram_schmidt_sub0 n [] ws"
 
 lemma (in cof_vec_space) gram_schmidt0_result:
   fixes ws
   defines "us' \<equiv> gram_schmidt0 n ws"
   assumes ws: "set ws \<subseteq> carrier_vec n"
   shows "set us' \<subseteq> carrier_vec n"        (is ?thesis1)
     and "distinct us'"                    (is ?thesis2)
     and "corthogonal us'"                 (is ?thesis3)
     and "span (set ws) = span (set us')"  (is ?thesis4)
 proof -
   have carrier_empty: "set [] \<subseteq> carrier_vec n" by auto
   have distinct_empty: "distinct []" by simp
   have indep_empty: "lin_indpt (set [])"
     using basis_def subset_li_is_li unit_vecs_basis by auto
   have ortho_empty: "corthogonal []" by auto
   note gram_schmidt_sub0_result' = gram_schmidt_sub0_result
     [OF us'_def[symmetric, THEN meta_eq_to_obj_eq, unfolded gram_schmidt0_def] ws
       carrier_empty distinct_empty indep_empty ortho_empty]
   thus ?thesis1 ?thesis2 ?thesis3 ?thesis4
     by auto
 qed
 
 locale complex_vec_space = cof_vec_space n "TYPE(complex)" for n :: nat
 
 lemma gram_schmidt0_corthogonal:
   assumes a1: "corthogonal R" 
     and a2: "\<And>x. x \<in> set R \<Longrightarrow> dim_vec x = d"
   shows "gram_schmidt0 d R = rev R"
 proof -
   have "gram_schmidt_sub0 d U R = rev R @ U"
     if "corthogonal ((rev U) @ R)"
       and "\<And>x. x \<in> set U \<union> set R \<Longrightarrow> dim_vec x = d" for U
   proof (insert that, induction R arbitrary: U)
     case Nil
     show ?case 
       by auto
   next
     case (Cons a R)
     have "a \<in> set (rev U @ a # R)"
       by simp      
     moreover have uar: "corthogonal (rev U @ a # R)"
       by (simp add: Cons.prems(1))      
     ultimately have \<open>a \<noteq> 0\<^sub>v d\<close>
       unfolding corthogonal_def
       by (metis conjugate_zero_vec in_set_conv_nth scalar_prod_right_zero zero_carrier_vec)
     then have nonzero_a: "\<not> vec_is_zero d a"
       by (simp add: Cons.prems(2) vec_is_zero)
     define T where "T = rev U @ a # R"
     have "T ! length (rev U) = a"
       unfolding T_def
       by (meson nth_append_length) 
     moreover have "(T ! i \<bullet>c T ! j = 0) = (i \<noteq> j)" if "i<length T" and "j<length T" for i j
       using uar that 
       unfolding corthogonal_def T_def
       by auto
     moreover have "length (rev U) < length T"
       by (simp add: T_def)
     ultimately have "(T ! (length (rev U)) \<bullet>c T ! j = 0) = (length (rev U) \<noteq> j)" if "j<length T" for j
       using that by blast
     hence "T ! (length (rev U)) \<bullet>c T ! j = 0"
       if  "j<length T" and "j \<noteq> length (rev U)" for j
       using that by blast
     hence "a \<bullet>c T ! j = 0" if "j < length (rev U)" for j
       using \<open>T ! length (rev U) = a\<close> that(1)
         \<open>length (rev U) < length T\<close> dual_order.strict_trans by blast
     moreover have "T ! j = (rev U) ! j" if "j < length (rev U)" for j
       by (smt T_def \<open>length (rev U) < length T\<close> dual_order.strict_trans list_update_append1
           list_update_id nth_list_update_eq that)
     ultimately have "a \<bullet>c u = 0" if "u \<in> set (rev U)" for u
       by (metis in_set_conv_nth that)
     hence "a \<bullet>c u = 0" if "u \<in> set U" for u
       by (simp add: that)
     moreover have "\<And>x. x \<in> set U \<Longrightarrow> dim_vec x = d"
       by (simp add: Cons.prems(2))      
     ultimately have "adjuster d a U = 0\<^sub>v d"
     proof(induction U)
       case Nil
       then show ?case by simp
     next
       case (Cons u U)
       moreover have "0 \<cdot>\<^sub>v u + 0\<^sub>v d = 0\<^sub>v d"
       proof-
         have "dim_vec u = d"
           by (simp add: calculation(3))          
         thus ?thesis
           by auto 
       qed
       ultimately show ?case by auto
     qed
     hence adjuster_a: "adjuster d a U + a = a"
       by (simp add: Cons.prems(2) carrier_vecI)      
     have "gram_schmidt_sub0 d U (a # R) = gram_schmidt_sub0 d (a # U) R"
       by (simp add: adjuster_a nonzero_a)
     also have "\<dots> = rev (a # R) @ U"
       apply (subst Cons.IH)
       using Cons.prems by simp_all
     finally show ?case
       by -
   qed
   from this[where U="[]"] show ?thesis
     unfolding gram_schmidt0_def using assms by auto
 qed
 
 lemma adjuster_carrier': (* Like adjuster_carrier but with one assm less *)
   assumes w: "(w :: 'a::conjugatable_field vec) : carrier_vec n"
     and us: "set (us :: 'a vec list) \<subseteq> carrier_vec n"
   shows "adjuster n w us \<in> carrier_vec n"
   by (insert us, induction us, auto)
 
 lemma eq_mat_on_vecI:
   fixes M N :: \<open>'a::field mat\<close>
   assumes eq: \<open>\<And>v. v\<in>carrier_vec nA \<Longrightarrow> M *\<^sub>v v = N *\<^sub>v v\<close>
   assumes [simp]: \<open>M \<in> carrier_mat nB nA\<close> \<open>N \<in> carrier_mat nB nA\<close>
   shows \<open>M = N\<close>
 proof (rule eq_matI)
   show [simp]: \<open>dim_row M = dim_row N\<close> \<open>dim_col M = dim_col N\<close>
     using assms(2) assms(3) by blast+
   fix i j
   assume [simp]: \<open>i < dim_row N\<close> \<open>j < dim_col N\<close>
   show \<open>M $$ (i, j) = N $$ (i, j)\<close>
     thm mat_entry_explicit[where M=M]
     apply (subst mat_entry_explicit[symmetric])
     using assms apply auto[3]
     apply (subst mat_entry_explicit[symmetric])
     using assms apply auto[3]
     apply (subst eq)
      apply auto using assms(3) unit_vec_carrier by blast
 qed
 
 lemma list_of_vec_plus:
   fixes v1 v2 :: \<open>complex vec\<close>
   assumes \<open>dim_vec v1 = dim_vec v2\<close>
   shows \<open>list_of_vec (v1 + v2) = map2 (+) (list_of_vec v1) (list_of_vec v2)\<close>
 proof-
   have \<open>i < dim_vec v1 \<Longrightarrow> (list_of_vec (v1 + v2)) ! i = (map2 (+) (list_of_vec v1) (list_of_vec v2)) ! i\<close>
     for i
     by (simp add: assms)
   thus ?thesis
     by (metis assms index_add_vec(2) length_list_of_vec length_map map_fst_zip nth_equalityI) 
 qed
 
 lemma list_of_vec_mult:
   fixes v :: \<open>complex vec\<close>
   shows \<open>list_of_vec (c \<cdot>\<^sub>v v) = map ((*) c) (list_of_vec v)\<close>
   by (metis (mono_tags, lifting) index_smult_vec(1) index_smult_vec(2) length_list_of_vec length_map nth_equalityI nth_list_of_vec nth_map)
 
 lemma map_map_vec_cols: \<open>map (map_vec f) (cols m) = cols (map_mat f m)\<close>
   by (simp add: cols_def)
 
 lemma map_vec_conjugate: \<open>map_vec conjugate v = conjugate v\<close>
   by fastforce
 
 unbundle no_jnf_notation
 
 
 end
diff --git a/thys/Complex_Bounded_Operators/extra/Extra_Vector_Spaces.thy b/thys/Complex_Bounded_Operators/extra/Extra_Vector_Spaces.thy
--- a/thys/Complex_Bounded_Operators/extra/Extra_Vector_Spaces.thy
+++ b/thys/Complex_Bounded_Operators/extra/Extra_Vector_Spaces.thy
@@ -1,245 +1,239 @@
 section \<open>\<open>Extra_Vector_Spaces\<close> -- Additional facts about vector spaces\<close>
 
 theory Extra_Vector_Spaces
   imports
     "HOL-Analysis.Inner_Product"
     "HOL-Analysis.Euclidean_Space"
     "HOL-Library.Indicator_Function"
     "HOL-Analysis.Topology_Euclidean_Space"
     "HOL-Analysis.Line_Segment"
     "HOL-Analysis.Bounded_Linear_Function"
     Extra_General
 begin
 
 subsection \<open>Euclidean spaces\<close>
 
 typedef 'a euclidean_space = "UNIV :: ('a \<Rightarrow> real) set" ..
 setup_lifting type_definition_euclidean_space
 
 instantiation euclidean_space :: (type) real_vector begin
 lift_definition plus_euclidean_space ::
   "'a euclidean_space \<Rightarrow> 'a euclidean_space \<Rightarrow> 'a euclidean_space"
   is "\<lambda>f g x. f x + g x" .
 lift_definition zero_euclidean_space :: "'a euclidean_space" is "\<lambda>_. 0" .
 lift_definition uminus_euclidean_space :: 
   "'a euclidean_space \<Rightarrow> 'a euclidean_space" 
   is "\<lambda>f x. - f x" .
 lift_definition minus_euclidean_space :: 
   "'a euclidean_space \<Rightarrow> 'a euclidean_space \<Rightarrow> 'a euclidean_space" 
   is "\<lambda>f g x. f x - g x".
 lift_definition scaleR_euclidean_space :: 
   "real \<Rightarrow> 'a euclidean_space \<Rightarrow> 'a euclidean_space" 
   is "\<lambda>c f x. c * f x" .
 instance
   apply intro_classes
   by (transfer; auto intro: distrib_left distrib_right)+
 end
 
 instantiation euclidean_space :: (finite) real_inner begin
 lift_definition inner_euclidean_space :: "'a euclidean_space \<Rightarrow> 'a euclidean_space \<Rightarrow> real"
   is "\<lambda>f g. \<Sum>x\<in>UNIV. f x * g x :: real" .
 definition "norm_euclidean_space (x::'a euclidean_space) = sqrt (inner x x)"
 definition "dist_euclidean_space (x::'a euclidean_space) y = norm (x-y)"
 definition "sgn x = x /\<^sub>R norm x" for x::"'a euclidean_space"
 definition "uniformity = (INF e\<in>{0<..}. principal {(x::'a euclidean_space, y). dist x y < e})"
 definition "open U = (\<forall>x\<in>U. \<forall>\<^sub>F (x'::'a euclidean_space, y) in uniformity. x' = x \<longrightarrow> y \<in> U)"
 instance
 proof intro_classes
   fix x :: "'a euclidean_space"
     and y :: "'a euclidean_space"
     and z :: "'a euclidean_space"
   show "dist (x::'a euclidean_space) y = norm (x - y)"
     and "sgn (x::'a euclidean_space) = x /\<^sub>R norm x"
     and "uniformity = (INF e\<in>{0<..}. principal {(x, y). dist (x::'a euclidean_space) y < e})"
     and "open U = (\<forall>x\<in>U. \<forall>\<^sub>F (x', y) in uniformity. (x'::'a euclidean_space) = x \<longrightarrow> y \<in> U)"
     and "norm x = sqrt (inner x x)" for U
     unfolding dist_euclidean_space_def norm_euclidean_space_def sgn_euclidean_space_def
       uniformity_euclidean_space_def open_euclidean_space_def
     by simp_all
 
   show "inner x y = inner y x"
     apply transfer
     by (simp add: mult.commute)
   show "inner (x + y) z = inner x z + inner y z"
   proof transfer
     fix x y z::"'a \<Rightarrow> real"
     have "(\<Sum>i\<in>UNIV. (x i + y i) * z i) = (\<Sum>i\<in>UNIV. x i * z i + y i * z i)"
       by (simp add: distrib_left mult.commute)
     thus "(\<Sum>i\<in>UNIV. (x i + y i) * z i) = (\<Sum>j\<in>UNIV. x j * z j) + (\<Sum>k\<in>UNIV. y k * z k)"
       by (subst sum.distrib[symmetric])      
   qed
 
   show "inner (r *\<^sub>R x) y = r * (inner x y)" for r
   proof transfer
     fix r and x y::"'a\<Rightarrow>real"
     have "(\<Sum>i\<in>UNIV. r * x i * y i) = (\<Sum>i\<in>UNIV. r * (x i * y i))"
       by (simp add: mult.assoc)
     thus "(\<Sum>i\<in>UNIV. r * x i * y i) = r * (\<Sum>j\<in>UNIV. x j * y j)"
       by (subst sum_distrib_left)
   qed
   show "0 \<le> inner x x"
     apply transfer
     by (simp add: sum_nonneg)
   show "(inner x x = 0) = (x = 0)"
   proof (transfer, rule)
     fix f :: "'a \<Rightarrow> real"
     assume "(\<Sum>i\<in>UNIV. f i * f i) = 0"
     hence "f x * f x = 0" for x
       apply (rule_tac sum_nonneg_eq_0_iff[THEN iffD1, rule_format, where A=UNIV and x=x])
       by auto
     thus "f = (\<lambda>_. 0)"
       by auto
   qed auto
 qed
 end
 
 instantiation euclidean_space :: (finite) euclidean_space begin
 lift_definition euclidean_space_basis_vector :: "'a \<Rightarrow> 'a euclidean_space" is
   "\<lambda>x. indicator {x}" .
 definition "Basis_euclidean_space == (euclidean_space_basis_vector ` UNIV)"
 instance
 proof intro_classes
   fix u :: "'a euclidean_space"
     and v :: "'a euclidean_space"
   show "(Basis::'a euclidean_space set) \<noteq> {}"
     unfolding Basis_euclidean_space_def by simp
   show "finite (Basis::'a euclidean_space set)"
     unfolding Basis_euclidean_space_def by simp
   show "inner u v = (if u = v then 1 else 0)"
     if "u \<in> Basis" and "v \<in> Basis"
     using that unfolding Basis_euclidean_space_def
     apply transfer apply auto
     by (auto simp: indicator_def)
   show "(\<forall>v\<in>Basis. inner u v = 0) = (u = 0)"
     unfolding Basis_euclidean_space_def
     apply transfer
     by auto
 qed
 end (* euclidean_space :: (finite) euclidean_space *)
 
 subsection \<open>Misc\<close>
 
 lemma closure_bounded_linear_image_subset_eq:
   assumes f: "bounded_linear f"
   shows "closure (f ` closure S) = closure (f ` S)"
   by (meson closed_closure closure_bounded_linear_image_subset closure_minimal closure_mono closure_subset f image_mono subset_antisym)
 
 lemma not_singleton_real_normed_is_perfect_space[simp]: \<open>class.perfect_space (open :: 'a::{not_singleton,real_normed_vector} set \<Rightarrow> bool)\<close>
   apply standard
   by (metis UNIV_not_singleton clopen closed_singleton empty_not_insert)
 
 lemma infsum_bounded_linear:
   assumes \<open>bounded_linear f\<close>
   assumes \<open>g summable_on S\<close>
   shows \<open>infsum (f \<circ> g) S = f (infsum g S)\<close>
   apply (rule infsum_comm_additive)
   using assms blinfun_apply_induct blinfun.additive_right
   by (auto simp: linear_continuous_within)
 
 lemma has_sum_bounded_linear: 
   assumes \<open>bounded_linear f\<close>
   assumes \<open>(g has_sum x) S\<close>
   shows \<open>((f o g) has_sum (f x)) S\<close>
   apply (rule has_sum_comm_additive)
   using assms blinfun_apply_induct blinfun.additive_right apply auto
   using isCont_def linear_continuous_at by fastforce
 
-lemma summable_on_bounded_linear:
-  assumes \<open>bounded_linear f\<close>
-  assumes \<open>g summable_on S\<close>
-  shows \<open>(f o g) summable_on S\<close>
-  by (metis assms(1) assms(2) has_sum_bounded_linear infsum_bounded_linear summable_iff_has_sum_infsum)
-
 lemma abs_summable_on_bounded_linear:
   assumes \<open>bounded_linear f\<close>
   assumes \<open>g abs_summable_on S\<close>
   shows \<open>(f o g) abs_summable_on S\<close>
 proof -
   have bound: \<open>norm (f (g x)) \<le> onorm f * norm (g x)\<close> for x
     apply (rule onorm)
     by (simp add: assms(1))
 
   from assms(2) have \<open>(\<lambda>x. onorm f *\<^sub>R g x) abs_summable_on S\<close>
     by (auto intro!: summable_on_cmult_right)
   then have \<open>(\<lambda>x. f (g x)) abs_summable_on S\<close>
     apply (rule abs_summable_on_comparison_test)
     using bound by (auto simp: assms(1) onorm_pos_le)
   then show ?thesis
     by auto
 qed
 
 lemma norm_plus_leq_norm_prod: \<open>norm (a + b) \<le> sqrt 2 * norm (a, b)\<close>
 proof -
   have \<open>(norm (a + b))\<^sup>2 \<le> (norm a + norm b)\<^sup>2\<close>
     using norm_triangle_ineq by auto
   also have \<open>\<dots> \<le> 2 * ((norm a)\<^sup>2 + (norm b)\<^sup>2)\<close>
     by (smt (verit, best) power2_sum sum_squares_bound)
   also have \<open>\<dots> \<le> (sqrt 2 * norm (a, b))\<^sup>2\<close>
     by (auto simp: power_mult_distrib norm_prod_def simp del: power_mono_iff)
   finally show ?thesis
     by auto
 qed
 
 lemma ex_norm1:
   assumes \<open>(UNIV::'a::real_normed_vector set) \<noteq> {0}\<close>
   shows \<open>\<exists>x::'a. norm x = 1\<close>
 proof-
   have \<open>\<exists>x::'a. x \<noteq> 0\<close>
     using assms by fastforce
   then obtain x::'a where \<open>x \<noteq> 0\<close>
     by blast
   hence \<open>norm x \<noteq> 0\<close>
     by simp
   hence \<open>(norm x) / (norm x) = 1\<close>
     by simp
   moreover have \<open>(norm x) / (norm x) = norm (x /\<^sub>R (norm x))\<close>
     by simp
   ultimately have \<open>norm (x /\<^sub>R (norm x)) = 1\<close>
     by simp
   thus ?thesis
     by blast
 qed
 
 lemma bdd_above_norm_f:
   assumes "bounded_linear f"
   shows \<open>bdd_above {norm (f x) |x. norm x = 1}\<close>
 proof-
   have \<open>\<exists>M. \<forall>x. norm x = 1 \<longrightarrow> norm (f x) \<le> M\<close>
     using assms
     by (metis bounded_linear.axioms(2) bounded_linear_axioms_def)
   thus ?thesis by auto
 qed
 
 lemma any_norm_exists:
   assumes \<open>n \<ge> 0\<close>
   shows \<open>\<exists>\<psi>::'a::{real_normed_vector,not_singleton}. norm \<psi> = n\<close>
 proof -
   obtain \<psi> :: 'a where \<open>\<psi> \<noteq> 0\<close>
     using not_singleton_card
     by force
   then have \<open>norm (n *\<^sub>R sgn \<psi>) = n\<close>
     using assms by (auto simp: sgn_div_norm abs_mult)
   then show ?thesis
     by blast
 qed
 
 
 lemma abs_summable_on_scaleR_left [intro]:
   fixes c :: \<open>'a :: real_normed_vector\<close>
   assumes "c \<noteq> 0 \<Longrightarrow> f abs_summable_on A"
   shows   "(\<lambda>x. f x *\<^sub>R c) abs_summable_on A"
   apply (cases \<open>c = 0\<close>)
    apply simp
   by (auto intro!: summable_on_cmult_left assms simp flip: real_norm_def)
 
 lemma abs_summable_on_scaleR_right [intro]:
   fixes f :: \<open>'a \<Rightarrow> 'b :: real_normed_vector\<close>
   assumes "c \<noteq> 0 \<Longrightarrow> f abs_summable_on A"
   shows   "(\<lambda>x. c *\<^sub>R f x) abs_summable_on A"
   apply (cases \<open>c = 0\<close>)
    apply simp
   by (auto intro!: summable_on_cmult_right assms)
 
 
 
 end