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,2981 +1,2981 @@
 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
     Complex_Inner_Product One_Dimensional_Spaces
     Banach_Steinhaus.Banach_Steinhaus
     "HOL-Types_To_Sets.Types_To_Sets"
     Complex_Bounded_Linear_Function0
 begin
 
 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>"
   apply transfer by simp
 
 lemma isCont_cblinfun_apply[simp]: "isCont ((*\<^sub>V) A) \<psi>"
   apply transfer
   by (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 apply transfer
   by (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>
   apply (rule complex_vector.linear_eq_0_on_span[where f=F])
   using bounded_clinear.axioms(1) cblinfun_apply assms by auto
 
 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>
   apply (rule complex_vector.linear_eq_on_span[where f=F])
   using bounded_clinear.axioms(1) cblinfun_apply assms by auto
 
 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>
 proof-
   have "F - G = 0"
     apply (rule cblinfun_eq_0_on_UNIV_span[where basis=basis])
     using assms by (auto simp add: cblinfun.diff_left)
   thus ?thesis by simp
 qed
 
 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"
   apply (rule cblinfun_eq_on_UNIV_span[where basis=basis])
   using assms is_generator_set is_cindependent_set by auto
 
 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> \<langle>v, F *\<^sub>V u\<rangle> = 0"
   shows "F = 0"
 proof-
   have "F *\<^sub>V u = 0"
     if "u\<in>basisA" for u
   proof-
     have "\<And>v. v\<in>basisB \<Longrightarrow> \<langle>v, F *\<^sub>V u\<rangle> = 0"
       by (simp add: assms(3) that)
     moreover have "(\<And>v. v\<in>basisB \<Longrightarrow> \<langle>v, x\<rangle> = 0) \<Longrightarrow> x = 0"
       for x
     proof-
       assume r1: "\<And>v. v\<in>basisB \<Longrightarrow> \<langle>v, x\<rangle> = 0"
       have "\<langle>v, x\<rangle> = 0" 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 "\<langle>v, x\<rangle> = \<langle>(\<Sum>a\<in>t. s a *\<^sub>C a), x\<rangle>"
           by (simp add: b1)
         also have "\<dots> = (\<Sum>a\<in>t. \<langle>s a *\<^sub>C a, x\<rangle>)"
           using cinner_sum_left by blast
         also have "\<dots> = (\<Sum>a\<in>t. cnj (s a) * \<langle>a, x\<rangle>)"
           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. \<langle>v, x\<rangle> = 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> \<langle>v, F *\<^sub>V u\<rangle> = \<langle>v, G *\<^sub>V u\<rangle>"
   shows "F = G"
 proof-
   define H where "H = F - G"
   have "\<And>u v. u\<in>basisA \<Longrightarrow> v\<in>basisB \<Longrightarrow> \<langle>v, H *\<^sub>V u\<rangle> = 0"
     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> \<langle>F *\<^sub>V u, v\<rangle> = \<langle>G *\<^sub>V u, v\<rangle>"
   shows "F = G"
   using cinner_canonical_basis_eq assms
   by (metis cinner_commute')
 
 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: Complex_Vector_Spaces0.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
     apply auto
     by (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_to_CARD_1_0[simp]: \<open>(A :: _ \<Rightarrow>\<^sub>C\<^sub>L _::CARD_1) = 0\<close>
   apply (rule cblinfun_eqI)
   by auto
 
 lemma cblinfun_from_CARD_1_0[simp]: \<open>(A :: _::CARD_1 \<Rightarrow>\<^sub>C\<^sub>L _) = 0\<close>
   apply (rule cblinfun_eqI)
   apply (subst CARD_1_vec_0)
   by auto
 
 
 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 apply atomize_elim by 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, ccfv_threshold) complex_vector.span_base complex_vector.span_scale complex_vector.span_sum mem_Collect_eq subset_eq)
     moreover have \<open>G *\<^sub>V a' = (if a'=a then b else 0)\<close> if \<open>a'\<in>basisA'\<close> for a'
       apply (cases \<open>a'=a\<close>)
       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> apply (rule cblinfun_eq_on_UNIV_span)
       apply (auto simp: H'_def cblinfun.sum_left)
       apply (subst sum_single)
       by (auto simp: 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>
     using F_basis
     by (smt (z3) UN_subset_iff complex_vector.span_alt complex_vector.span_minimal complex_vector.subspace_span mem_Collect_eq subset_iff)
 
   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 \<open>cspan basis = UNIV\<close>
     apply (rule cblinfun_cspan_UNIV[where basisA=basisA and basisB=basisB])
       apply (auto simp: basis_def)
     by (metis F_apply f_a f_not_a)
 
   moreover have \<open>finite basis\<close>
     unfolding basis_def apply (rule finite_image_set2) by auto
 
   ultimately show \<open>\<exists>S :: ('a \<Rightarrow>\<^sub>C\<^sub>L 'b) set. finite S \<and> cspan S = UNIV\<close>
     by auto
 qed
 
 
 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
     apply transfer
     by (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"
     apply transfer
     by (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"
     apply transfer
     by (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"
     apply transfer
     by 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>
     apply transfer
     by 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)
 
 instantiation blinfun :: (real_normed_vector, cbanach) "cbanach"
 begin
 instance..
 end
 
 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"
   apply transfer by (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 apply transfer by auto
 
 lemma blinfun_cblinfun_eq_right_total[transfer_rule]: \<open>right_total blinfun_cblinfun_eq\<close>
   unfolding right_total_def apply transfer
   by (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)"
   apply transfer by 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 apply transfer by 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 apply transfer by 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 apply transfer by 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 apply transfer
   by (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 apply transfer by 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 apply transfer by 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 apply transfer
   by (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 apply transfer by auto
 
 lemma cblinfun_blinfun_transfer_apply[cblinfun_blinfun_transfer]:
   includes lifting_syntax
   shows "(blinfun_cblinfun_eq ===> (=) ===> (=)) blinfun_apply cblinfun_apply"
   unfolding rel_fun_def apply transfer by 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>
   apply transfer by simp
 
 lemma blinfun_of_cblinfun_uminus:
   \<open>blinfun_of_cblinfun (- f) = - (blinfun_of_cblinfun f)\<close>
   apply transfer
   by auto
 
 lemma blinfun_of_cblinfun_minus:
   \<open>blinfun_of_cblinfun (f - g) = blinfun_of_cblinfun f - blinfun_of_cblinfun g\<close>
   apply transfer
   by auto
 
 lemma blinfun_of_cblinfun_scaleC:
   \<open>blinfun_of_cblinfun (c *\<^sub>C f) = c *\<^sub>C (blinfun_of_cblinfun f)\<close>
   apply transfer
   by auto
 
 lemma blinfun_of_cblinfun_scaleR:
   \<open>blinfun_of_cblinfun (c *\<^sub>R f) = c *\<^sub>R (blinfun_of_cblinfun f)\<close>
   apply transfer by 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>
   apply transfer by auto
 
 subsection \<open>Composition\<close>
 
 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>
   apply transfer by auto
 
 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>
   apply transfer by (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"
   apply transfer by auto
 
 lemma cblinfun_compose_id_left[simp]:
   shows "id_cblinfun o\<^sub>C\<^sub>L U  = U"
   apply transfer by auto
 
 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 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"
   apply (rule cblinfun_eqI)
   apply (rule cblinfun_eq_on[where G=G])
   using assms apply auto
   by (metis ccspan.rep_eq iso_tuple_UNIV_I top_ccsubspace.rep_eq)
 
 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)
 
 
 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"
   apply transfer using cadjoint_id
   by (metis eq_id_iff)
 
 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>\<langle> (A \<circ> B) u, v \<rangle> = \<langle> u, (B\<^sup>\<dagger> \<circ> A\<^sup>\<dagger>) v \<rangle>\<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*)"
   apply transfer
   by (simp add: Complex_Vector_Spaces0.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>\<langle>F u,  v\<rangle> = \<langle>u, G v\<rangle>\<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_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 cinner_adj_left:
   fixes G :: "'b::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'a::complex_inner"
   shows \<open>\<langle>G* *\<^sub>V x, y\<rangle> = \<langle>x, G *\<^sub>V y\<rangle>\<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>\<langle>x, G* *\<^sub>V y\<rangle> = \<langle>G *\<^sub>V x, y\<rangle>\<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>
     apply intro_classes by simp
   from True have c2: \<open>class.not_singleton TYPE('c)\<close>
     apply intro_classes by 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>
   apply (rule antilinearI) by (auto simp add: adj_plus)
 
 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::chilbert_space\<close>
     and F:: \<open>'a \<Rightarrow>\<^sub>C\<^sub>L 'b\<close>
   assumes \<open>\<And>x y. \<langle>(cblinfun_apply F) x, y\<rangle> = \<langle>x, (cblinfun_apply G) y\<rangle>\<close>
   shows \<open>F = G*\<close>
   using assms apply transfer using cadjoint_eqI by auto
 
 lemma cinner_real_hermiteanI:
   \<comment> \<open>Prop. II.2.12 in @{cite conway2013course}\<close>
   assumes \<open>\<And>\<psi>. cinner \<psi> (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*"
     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>
       apply (rule complex_of_real_mono)
       using \<psi> apply (rule power_mono)
       using \<open>\<epsilon> \<ge> 0\<close> by auto
     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 \<open>\<dots> = cinner \<psi> (A *\<^sub>V A* *\<^sub>V \<psi>)\<close>
       by (simp add: cinner_adj_left)
     also have \<open>\<dots> = cinner \<psi> ((A o\<^sub>C\<^sub>L A*) *\<^sub>V \<psi>)\<close>
       by auto
     also have \<open>\<dots> \<le> norm (A o\<^sub>C\<^sub>L A*)\<close>
       using \<open>norm \<psi> = 1\<close>
       by (smt (verit, best) Im_complex_of_real Re_complex_of_real \<open>(A* *\<^sub>V \<psi>) \<bullet>\<^sub>C (A* *\<^sub>V \<psi>) = \<psi> \<bullet>\<^sub>C (A *\<^sub>V A* *\<^sub>V \<psi>)\<close> \<open>\<psi> \<bullet>\<^sub>C (A *\<^sub>V A* *\<^sub>V \<psi>) = \<psi> \<bullet>\<^sub>C ((A o\<^sub>C\<^sub>L A*) *\<^sub>V \<psi>)\<close> cdot_square_norm cinner_ge_zero cmod_Re complex_inner_class.Cauchy_Schwarz_ineq2 less_eq_complex_def mult_cancel_left1 mult_cancel_right1 norm_cblinfun)
     finally show ?thesis
-      by auto
+      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
 
 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 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 apply transfer by 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[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
 
 
 
 subsection \<open>Images\<close>
 
 
 (* Closure is necessary. See email 47a3bb3d-3cc3-0934-36eb-3ef0f7b70a85@ut.ee *)
 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
   apply transfer
   by (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_clinear_space (closure (cblinfun_apply (\<alpha> *\<^sub>C A) ` space_as_set S)) =
             \<alpha> *\<^sub>C Abs_clinear_space (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_clinear_space (closure ((*\<^sub>V) (\<alpha> *\<^sub>C A) ` space_as_set S)) =
             \<alpha> *\<^sub>C Abs_clinear_space (closure ((*\<^sub>V) A ` space_as_set S))"
     using \<open>Abs_clinear_space (closure (cblinfun_apply (\<alpha> *\<^sub>C A) ` space_as_set S)) =
             \<alpha> *\<^sub>C Abs_clinear_space (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>"
   apply transfer
   by (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. V i) \<le> (INF i. 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_Un closure_closure image_cong sup.absorb_iff1)
   then show "closure (A ` S) = closure (B ` S)"
     by (metis Complex_Vector_Spaces0.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)"
   apply transfer by (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"
   shows "U *\<^sub>S (INF i. V i) = (INF i. U *\<^sub>S V i)"
 proof (rule antisym)
   show "U *\<^sub>S (INF i. V i) \<le> (INF i. 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. U *\<^sub>S V i)" and INFV_def: "INFV = (INF i. 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
     show "closure ((Uinv \<circ> U) ` V i) = V i"
       if "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>"
       for V :: "'a \<Rightarrow> 'b set"
         and Uinv :: "'c \<Rightarrow> 'b"
         and U :: "'b \<Rightarrow> 'c"
         and i :: 'a
       using that proof auto
       show "x \<in> V i"
         if "\<forall>x. closed_csubspace (V x)"
           and "bounded_clinear Uinv"
           and "bounded_clinear U"
           and "\<And>\<psi> i. \<psi> \<in> V i \<Longrightarrow> Uinv (U \<psi>) = \<psi>"
           and "x \<in> closure (V i)"
         for x :: 'b
         using that
         by (metis orthogonal_complement_of_closure closed_csubspace.subspace double_orthogonal_complement_id closure_is_closed_csubspace)
       show "x \<in> closure (V i)"
         if "\<forall>x. closed_csubspace (V x)"
           and "bounded_clinear Uinv"
           and "bounded_clinear U"
           and "\<And>\<psi> i. \<psi> \<in> V i \<Longrightarrow> Uinv (U \<psi>) = \<psi>"
           and "x \<in> V i"
         for x :: 'b
         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 by (meson INF_lower UNIV_I order_trans)
   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"
       and U :: "'b \<Rightarrow> 'c"
       and Uinv :: "'c \<Rightarrow> 'b"
     using that proof auto
     show "x \<in> INFUV"
       if "closed_csubspace INFUV"
         and "bounded_clinear U"
         and "bounded_clinear Uinv"
         and "\<And>\<psi>. \<psi> \<in> INFUV \<Longrightarrow> U (Uinv \<psi>) = \<psi>"
         and "x \<in> closure INFUV"
       for x :: 'c
       using that
       by (metis orthogonal_complement_of_closure closed_csubspace.subspace double_orthogonal_complement_id closure_is_closed_csubspace)
     show "x \<in> closure INFUV"
       if "closed_csubspace INFUV"
         and "bounded_clinear U"
         and "bounded_clinear Uinv"
         and "\<And>\<psi>. \<psi> \<in> INFUV \<Longrightarrow> U (Uinv \<psi>) = \<psi>"
         and "x \<in> INFUV"
       for x :: 'c
       using that
       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. 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 apply transfer
   by (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>
   shows "U *\<^sub>S (INF i. V i) = (INF i. 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
     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]
   unfolding INF_UNIV_bool_expand
   using assms by auto
 
 lemma cblinfun_image_ccspan:
   shows "A *\<^sub>S ccspan G = ccspan ((*\<^sub>V) A ` G)"
   apply transfer
   by (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>
   apply transfer
   by (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
       apply auto by (smt (z3) cblinfun_plus_image_distr inf_sup_aci(6) le_iff_sup)
   qed
 next
   case False
   then show ?thesis
     by auto
 qed
 
 
 
 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 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)
 
 
 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>
   apply transfer by (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>
     apply transfer
     by 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::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L 'a \<Rightarrow> bool\<close> is
   \<open>\<lambda>P. \<exists>M. closed_csubspace M \<and> is_projection_on P M\<close> .
 
 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>\<langle> x - P *\<^sub>V x, y \<rangle> = 0\<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>\<langle> x - P *\<^sub>V x, y \<rangle> = \<langle> x - P *\<^sub>V x, P *\<^sub>V t \<rangle>\<close>
       by (simp add: t_def)
     also have \<open>\<dots> = \<langle> P *\<^sub>V (x - P *\<^sub>V x), t \<rangle>\<close>
       by (metis \<open>P = P*\<close> cinner_adj_left)
     also have \<open>\<dots> = \<langle> P *\<^sub>V x - P *\<^sub>V (P *\<^sub>V x), t \<rangle>\<close>
       by (simp add: cblinfun.diff_right)
     also have \<open>\<dots> = \<langle> P *\<^sub>V x - P *\<^sub>V x, t \<rangle>\<close>
       by (metis assms(1) comp_apply cblinfun_compose.rep_eq)
     also have \<open>\<dots> = \<langle> 0, t \<rangle>\<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))"
   using assms apply transfer
   using closed_csubspace.closed is_projection_on_image by blast
 
 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 apply transfer
     by (metis is_projection_on_cadjoint)
   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>
   apply transfer by auto
 
 lemma surj_isometry_is_unitary:
   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 Proj_sandwich sandwich_apply Proj_on_own_range' assms(1) assms(2) cblinfun_compose_id_right isometry_def unitary_def unitary_id unitary_range)
 
 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> sup B 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 fastforce
   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_clinear_space (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
   unfolding is_Proj_def
   using assms is_Proj_algebraic by auto
 
 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"
   by (metis add_left_cancel adj_plus bounded_cbilinear.zero_left bounded_cbilinear_cblinfun_compose group_cancel.rule0 is_Proj_I)
 
 lemma is_Proj_complement[simp]:
   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)
 
 subsection \<open>Kernel\<close>
 
 lift_definition kernel :: "'a::complex_normed_vector \<Rightarrow>\<^sub>C\<^sub>L'b::complex_normed_vector
    \<Rightarrow> 'a ccsubspace"
   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"
   apply transfer by auto
 
 lemma kernel_id[simp]: "kernel id_cblinfun = 0"
   apply transfer by 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 apply transfer by auto
 
 lemma kernel_memberD:
   assumes "x \<in> space_as_set (kernel A)"
   shows "A *\<^sub>V x = 0"
   using assms apply transfer by 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 apply transfer by auto
 
 lemma kernel_memberI:
   assumes "A *\<^sub>V x = 0"
   shows "x \<in> space_as_set (kernel A)"
   using assms apply transfer by auto
 
 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 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>
 
 lemma
   assumes \<open>iso_cblinfun A\<close>
   shows cblinfun_inv_left: \<open>cblinfun_inv A o\<^sub>C\<^sub>L A = id_cblinfun\<close>
     and cblinfun_inv_right: \<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)
   with AB BA have \<open>cblinfun_inv A = B\<close>
     by (metis cblinfun_assoc_left(1) cblinfun_compose_id_right)
   with AB BA show \<open>cblinfun_inv A o\<^sub>C\<^sub>L A = id_cblinfun\<close>
     and \<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 cblinfun_compose_assoc cblinfun_compose_id_right cblinfun_inv_left iso_cblinfun_def)
 
 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 "\<langle>A, B\<rangle> = cnj \<langle>B, A\<rangle>"
     unfolding cinner_cblinfun_def by auto
   show "\<langle>A + B, C\<rangle> = \<langle>A, C\<rangle> + \<langle>B, C\<rangle>"
     by (simp add: cinner_cblinfun_def algebra_simps plus_cblinfun.rep_eq)
   show "\<langle>c *\<^sub>C A, B\<rangle> = cnj c * \<langle>A, B\<rangle>"
     by (simp add: cblinfun.scaleC_left cinner_cblinfun_def)
   show "0 \<le> \<langle>A, A\<rangle>"
     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 "(\<langle>A, A\<rangle> = 0) = (A = 0)"
     by (auto simp: cinner_cblinfun_def)
 
   show "norm A = sqrt (cmod \<langle>A, A\<rangle>)"
     unfolding cinner_cblinfun_def
     apply transfer
     by (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]"
 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"
       apply transfer by 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)"
     apply transfer by 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)"
     apply transfer by 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"
     apply transfer by (simp add: o_def one_dim_inverse)
 qed
 end
 
 lemma id_cblinfun_eq_1[simp]: \<open>id_cblinfun = 1\<close>
   apply transfer by 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"
   apply transfer by 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"
   apply transfer by simp
 
 
 lemma scaleC_1_right[simp]: \<open>scaleC x (1::'a::one_dim) = of_complex x\<close>
   unfolding of_complex_def by simp
 
 lemma scaleC_of_complex[simp]: \<open>scaleC x (of_complex y) = of_complex (x * y)\<close>
   unfolding of_complex_def using scaleC_scaleC by blast
 
 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 = x *\<^sub>C y\<close>
   unfolding of_complex_def
   by (metis cblinfun.scaleC_left cblinfun_id_cblinfun_apply id_cblinfun_eq_1)
 
 lemma cblinfun_compose_1_left[simp]: \<open>1 o\<^sub>C\<^sub>L x = x\<close>
   apply transfer by auto
 
 lemma cblinfun_compose_1_right[simp]: \<open>x o\<^sub>C\<^sub>L 1 = x\<close>
   apply transfer by 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)
 
 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"
   apply transfer by 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 :: \<open>('a \<Rightarrow>\<^sub>C\<^sub>L 'b) \<Rightarrow> ('a \<Rightarrow>\<^sub>C\<^sub>L 'b) \<Rightarrow> bool\<close>
   where less_eq_cblinfun_def_heterogenous: \<open>less_eq_cblinfun A B =
   (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>less_cblinfun (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
   note less_eq_complex_def[simp del]
 
   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>
     apply atomize_elim by (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 del: less_eq_complex_def simp: reals_zero_comparable_iff less_eq_cblinfun_def)
 
 lemma positive_cblinfunI: \<open>A \<ge> 0\<close> if \<open>\<And>x. cinner x (A *\<^sub>V x) \<ge> 0\<close>
   unfolding less_eq_cblinfun_def using that by auto
 
 (* 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 -
   note less_eq_complex_def[simp del]
   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
 
 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_apply:
   "vector_to_cblinfun (A *\<^sub>V \<psi>) = A  o\<^sub>C\<^sub>L (vector_to_cblinfun \<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>
   apply transfer
   by (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
 proof (subst asm_rl [of "a *\<^sub>C \<psi> = (a *\<^sub>C id_cblinfun) *\<^sub>V \<psi>"])
   show "a *\<^sub>C \<psi> = a *\<^sub>C id_cblinfun *\<^sub>V \<psi>"
     by (simp add: scaleC_cblinfun.rep_eq)
   show "vector_to_cblinfun (a *\<^sub>C id_cblinfun *\<^sub>V \<psi>) = a *\<^sub>C (vector_to_cblinfun \<psi>::'a \<Rightarrow>\<^sub>C\<^sub>L 'b)"
     by (metis cblinfun_id_cblinfun_apply cblinfun_compose_scaleC_left vector_to_cblinfun_cblinfun_apply)
 qed
 
 lemma vector_to_cblinfun_apply_one_dim[simp]:
   shows "vector_to_cblinfun \<phi> *\<^sub>V \<gamma> = one_dim_iso \<gamma> *\<^sub>C \<phi>"
   apply transfer by (rule refl)
 
 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_apply)
 
 lemma image_vector_to_cblinfun[simp]: "vector_to_cblinfun x *\<^sub>S top = ccspan {x}"
 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 \<langle>\<psi>, \<phi>\<rangle>) =
     \<langle>\<psi>, \<phi>\<rangle> *\<^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 = "\<langle>\<psi>, \<phi>\<rangle> *\<^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
 
 subsection \<open>Butterflies (rank-1 projectors)\<close>
 
 definition butterfly_def: "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 vector_to_cblinfun_cblinfun_apply)
 
 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 vector_to_cblinfun_cblinfun_apply)
 
 lemma butterfly_apply[simp]: "butterfly \<psi> \<psi>' *\<^sub>V \<phi> = \<langle>\<psi>', \<phi>\<rangle> *\<^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 = \<langle>\<psi>2, \<psi>3\<rangle> *\<^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 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 \<langle>\<phi>, x\<rangle> * 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 = \<langle>y, x\<rangle> / \<langle>x, x\<rangle>"
   have "\<langle>x, x\<rangle> *\<^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> = \<langle>y, x\<rangle> *\<^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>\<langle>x, x\<rangle> *\<^sub>C x = selfbutter x *\<^sub>V x\<close> \<open>selfbutter y *\<^sub>V x = \<langle>y, x\<rangle> *\<^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_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
 
 subsection \<open>Bifunctionals\<close>
 
 lift_definition bifunctional :: \<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 bifunctional_apply[simp]: \<open>(bifunctional *\<^sub>V x) *\<^sub>V f = f *\<^sub>V x\<close>
   by (transfer fixing: x f, simp)
 
 lemma bifunctional_isometric[simp]: \<open>norm (bifunctional *\<^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_bifunctional[simp]: \<open>norm (bifunctional :: '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
 
 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 (rule TrueI)? (* Deletes 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:
   \<comment> \<open>Theorem 3.4 in @{cite conway2013course}\<close>
   fixes f::\<open>'a::chilbert_space \<Rightarrow>\<^sub>C\<^sub>L complex\<close>
   shows \<open>\<exists>t. \<forall>x.  f *\<^sub>V x = \<langle>t, x\<rangle>\<close>
   apply transfer by (rule riesz_frechet_representation_existence)
 
 lemma riesz_frechet_representation_cblinfun_unique:
   \<comment> \<open>Theorem 3.4 in @{cite conway2013course}\<close>
   fixes f::\<open>'a::complex_inner \<Rightarrow>\<^sub>C\<^sub>L complex\<close>
   assumes \<open>\<And>x. f *\<^sub>V x = \<langle>t, x\<rangle>\<close>
   assumes \<open>\<And>x. f *\<^sub>V x = \<langle>u, x\<rangle>\<close>
   shows \<open>t = u\<close>
   using assms by (rule riesz_frechet_representation_unique)
 
 theorem riesz_frechet_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 = \<langle>t, x\<rangle>\<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 = \<langle>t, x\<rangle>\<close>
   from  \<open>\<And>x. f x = \<langle>t, x\<rangle>\<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 (\<langle>t, x\<rangle>)\<close>
       using \<open>\<And>x. f x = \<langle>t, x\<rangle>\<close> by simp
     also have \<open>norm \<langle>t, x\<rangle> \<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 = \<langle>t, t\<rangle>\<close>
       using \<open>\<And>x. f x = \<langle>t, x\<rangle>\<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
 
 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_exists_bounded_dense:
   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 \<open>cblinfun_extension_exists S f\<close>
 proof -
   obtain B where bounded: \<open>\<And>x. x \<in> S \<Longrightarrow> norm (f x) \<le> B * norm x\<close> and \<open>B > 0\<close>
     using bounded by (smt (z3) mult_mono norm_ge_zero)
   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
       apply atomize_elim by (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
 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)
 
 subsection \<open>Notation\<close>
 
 bundle cblinfun_notation begin
 notation cblinfun_compose (infixl "o\<^sub>C\<^sub>L" 55)
 notation cblinfun_apply (infixr "*\<^sub>V" 70)
 notation cblinfun_image (infixr "*\<^sub>S" 70)
 notation adj ("_*" [99] 100)
 end
 
 bundle no_cblinfun_notation begin
 no_notation cblinfun_compose (infixl "o\<^sub>C\<^sub>L" 55)
 no_notation cblinfun_apply (infixr "*\<^sub>V" 70)
 no_notation cblinfun_image (infixr "*\<^sub>S" 70)
 no_notation adj ("_*" [99] 100)
 end
 
 bundle blinfun_notation begin
 notation blinfun_apply (infixr "*\<^sub>V" 70)
 end
 
 bundle no_blinfun_notation begin
 no_notation blinfun_apply (infixr "*\<^sub>V" 70)
 end
 
 unbundle no_cblinfun_notation
 
 end
diff --git a/thys/Complex_Bounded_Operators/Complex_Euclidean_Space0.thy b/thys/Complex_Bounded_Operators/Complex_Euclidean_Space0.thy
--- a/thys/Complex_Bounded_Operators/Complex_Euclidean_Space0.thy
+++ b/thys/Complex_Bounded_Operators/Complex_Euclidean_Space0.thy
@@ -1,393 +1,393 @@
 (*  Title:      HOL/Analysis/Euclidean_Space.thy
     Author:     Johannes Hölzl, TU München
     Author:     Brian Huffman, Portland State University
 *)
 
 section \<open>\<open>Complex_Euclidean_Space0\<close> -- Finite-Dimensional Inner Product Spaces\<close>
 
 theory Complex_Euclidean_Space0
   imports
     "HOL-Analysis.L2_Norm"
     "Complex_Inner_Product"
     "HOL-Analysis.Product_Vector"
     "HOL-Library.Rewrite"
 begin
 
 
 (* subsection\<^marker>\<open>tag unimportant\<close> \<open>Interlude: Some properties of real sets\<close> *)
 
 (* Complex analogue not needed *)
 (* lemma seq_mono_lemma:
   assumes "\<forall>(n::nat) \<ge> m. (d n :: real) < e n"
     and "\<forall>n \<ge> m. e n \<le> e m"
   shows "\<forall>n \<ge> m. d n < e m" *)
 
 subsection \<open>Type class of Euclidean spaces\<close>
 
 class ceuclidean_space = complex_inner +
   fixes CBasis :: "'a set"
   assumes nonempty_CBasis [simp]: "CBasis \<noteq> {}"
   assumes finite_CBasis [simp]: "finite CBasis"
   assumes cinner_CBasis:
     "\<lbrakk>u \<in> CBasis; v \<in> CBasis\<rbrakk> \<Longrightarrow> cinner u v = (if u = v then 1 else 0)"
   assumes ceuclidean_all_zero_iff:
     "(\<forall>u\<in>CBasis. cinner x u = 0) \<longleftrightarrow> (x = 0)"
 
 syntax "_type_cdimension" :: "type \<Rightarrow> nat"  ("(1CDIM/(1'(_')))")
 translations "CDIM('a)" \<rightharpoonup> "CONST card (CONST CBasis :: 'a set)"
 typed_print_translation \<open>
   [(\<^const_syntax>\<open>card\<close>,
     fn ctxt => fn _ => fn [Const (\<^const_syntax>\<open>CBasis\<close>, Type (\<^type_name>\<open>set\<close>, [T]))] =>
       Syntax.const \<^syntax_const>\<open>_type_cdimension\<close> $ Syntax_Phases.term_of_typ ctxt T)]
 \<close>
 
 lemma (in ceuclidean_space) norm_CBasis[simp]: "u \<in> CBasis \<Longrightarrow> norm u = 1"
   unfolding norm_eq_sqrt_cinner by (simp add: cinner_CBasis)
 
 lemma (in ceuclidean_space) cinner_same_CBasis[simp]: "u \<in> CBasis \<Longrightarrow> cinner u u = 1"
   by (simp add: cinner_CBasis)
 
 lemma (in ceuclidean_space) cinner_not_same_CBasis: "u \<in> CBasis \<Longrightarrow> v \<in> CBasis \<Longrightarrow> u \<noteq> v \<Longrightarrow> cinner u v = 0"
   by (simp add: cinner_CBasis)
 
 lemma (in ceuclidean_space) sgn_CBasis: "u \<in> CBasis \<Longrightarrow> sgn u = u"
   unfolding sgn_div_norm by (simp add: scaleR_one)
 
 lemma (in ceuclidean_space) CBasis_zero [simp]: "0 \<notin> CBasis"
 proof
   assume "0 \<in> CBasis" thus "False"
     using cinner_CBasis [of 0 0] by simp
 qed
 
 lemma (in ceuclidean_space) nonzero_CBasis: "u \<in> CBasis \<Longrightarrow> u \<noteq> 0"
   by clarsimp
 
 lemma (in ceuclidean_space) SOME_CBasis: "(SOME i. i \<in> CBasis) \<in> CBasis"
   by (metis ex_in_conv nonempty_CBasis someI_ex)
 
 lemma norm_some_CBasis [simp]: "norm (SOME i. i \<in> CBasis) = 1"
   by (simp add: SOME_CBasis)
 
 lemma (in ceuclidean_space) cinner_sum_left_CBasis[simp]:
   "b \<in> CBasis \<Longrightarrow> cinner (\<Sum>i\<in>CBasis. f i *\<^sub>C i) b = cnj (f b)"
   by (simp add: cinner_sum_left cinner_CBasis if_distrib comm_monoid_add_class.sum.If_cases)
 
 (* Not present in Euclidean_Space *)
 (* lemma (in ceuclidean_space) cinner_sum_right_CBasis[simp]:
     "b \<in> CBasis \<Longrightarrow> cinner b (\<Sum>i\<in>CBasis. f i *\<^sub>C i) = f b"
   by (metis (mono_tags, lifting) cinner_commute cinner_sum_left_CBasis comm_monoid_add_class.sum.cong complex_cnj_cnj) *)
 
 lemma (in ceuclidean_space) ceuclidean_eqI:
   assumes b: "\<And>b. b \<in> CBasis \<Longrightarrow> cinner x b = cinner y b" shows "x = y"
 proof -
   from b have "\<forall>b\<in>CBasis. cinner (x - y) b = 0"
     by (simp add: cinner_diff_left)
   then show "x = y"
     by (simp add: ceuclidean_all_zero_iff)
 qed
 
 lemma (in ceuclidean_space) ceuclidean_eq_iff:
   "x = y \<longleftrightarrow> (\<forall>b\<in>CBasis. cinner x b = cinner y b)"
   by (auto intro: ceuclidean_eqI)
 
 lemma (in ceuclidean_space) ceuclidean_representation_sum:
   "(\<Sum>i\<in>CBasis. f i *\<^sub>C i) = b \<longleftrightarrow> (\<forall>i\<in>CBasis. f i = cnj (cinner b i))"
   apply (subst ceuclidean_eq_iff) 
   apply simp by (metis complex_cnj_cnj cinner_commute)
 
 lemma (in ceuclidean_space) ceuclidean_representation_sum':
   "b = (\<Sum>i\<in>CBasis. f i *\<^sub>C i) \<longleftrightarrow> (\<forall>i\<in>CBasis. f i = cinner i b)"
   apply (auto simp add: ceuclidean_representation_sum[symmetric])
    apply (metis ceuclidean_representation_sum cinner_commute)
   by (metis local.ceuclidean_representation_sum local.cinner_commute)
 
 lemma (in ceuclidean_space) ceuclidean_representation: "(\<Sum>b\<in>CBasis. cinner b x *\<^sub>C b) = x"
   unfolding ceuclidean_representation_sum
   using local.cinner_commute by blast
 
 lemma (in ceuclidean_space) ceuclidean_cinner: "cinner x y = (\<Sum>b\<in>CBasis. cinner x b * cnj (cinner y b))"
   apply (subst (1 2) ceuclidean_representation [symmetric])
   apply (simp add: cinner_sum_right cinner_CBasis ac_simps)
   by (metis local.cinner_commute mult.commute)
 
 lemma (in ceuclidean_space) choice_CBasis_iff:
   fixes P :: "'a \<Rightarrow> complex \<Rightarrow> bool"
   shows "(\<forall>i\<in>CBasis. \<exists>x. P i x) \<longleftrightarrow> (\<exists>x. \<forall>i\<in>CBasis. P i (cinner x i))"
   unfolding bchoice_iff
 proof safe
   fix f assume "\<forall>i\<in>CBasis. P i (f i)"
   then show "\<exists>x. \<forall>i\<in>CBasis. P i (cinner x i)"
     by (auto intro!: exI[of _ "\<Sum>i\<in>CBasis. cnj (f i) *\<^sub>C i"])
 qed auto
 
 lemma (in ceuclidean_space) bchoice_CBasis_iff:
   fixes P :: "'a \<Rightarrow> complex \<Rightarrow> bool"
   shows "(\<forall>i\<in>CBasis. \<exists>x\<in>A. P i x) \<longleftrightarrow> (\<exists>x. \<forall>i\<in>CBasis. cinner x i \<in> A \<and> P i (cinner x i))"
   by (simp add: choice_CBasis_iff Bex_def)
 
 lemma (in ceuclidean_space) ceuclidean_representation_sum_fun:
   "(\<lambda>x. \<Sum>b\<in>CBasis. cinner b (f x) *\<^sub>C b) = f"
   apply (rule ext) 
   apply (simp add: ceuclidean_representation_sum)
   by (meson local.cinner_commute)
 
 lemma euclidean_isCont:
   assumes "\<And>b. b \<in> CBasis \<Longrightarrow> isCont (\<lambda>x. (cinner b (f x)) *\<^sub>C b) x"
   shows "isCont f x"
   apply (subst ceuclidean_representation_sum_fun [symmetric])
   apply (rule isCont_sum)
   by (blast intro: assms)
 
 lemma CDIM_positive [simp]: "0 < CDIM('a::ceuclidean_space)"
   by (simp add: card_gt_0_iff)
 
 lemma CDIM_ge_Suc0 [simp]: "Suc 0 \<le> card CBasis"
   by (meson CDIM_positive Suc_leI)
 
 
 lemma sum_cinner_CBasis_scaleC [simp]:
   fixes f :: "'a::ceuclidean_space \<Rightarrow> 'b::complex_vector"
   assumes "b \<in> CBasis" shows "(\<Sum>i\<in>CBasis. (cinner i b) *\<^sub>C f i) = f b"
   by (simp add: comm_monoid_add_class.sum.remove [OF finite_CBasis assms]
       assms cinner_not_same_CBasis comm_monoid_add_class.sum.neutral)
 
 lemma sum_cinner_CBasis_eq [simp]:
   assumes "b \<in> CBasis" shows "(\<Sum>i\<in>CBasis. (cinner i b) * f i) = f b"
   by (simp add: comm_monoid_add_class.sum.remove [OF finite_CBasis assms]
       assms cinner_not_same_CBasis comm_monoid_add_class.sum.neutral)
 
 lemma sum_if_cinner [simp]:
   assumes "i \<in> CBasis" "j \<in> CBasis"
   shows "cinner (\<Sum>k\<in>CBasis. if k = i then f i *\<^sub>C i else g k *\<^sub>C k) j = (if j=i then cnj (f j) else cnj (g j))"
 proof (cases "i=j")
   case True
   with assms show ?thesis
     by (auto simp: cinner_sum_left if_distrib [of "\<lambda>x. cinner x j"] cinner_CBasis cong: if_cong)
 next
   case False
   have "(\<Sum>k\<in>CBasis. cinner (if k = i then f i *\<^sub>C i else g k *\<^sub>C k) j) =
         (\<Sum>k\<in>CBasis. if k = j then cnj (g k) else 0)"
     apply (rule sum.cong)
     using False assms by (auto simp: cinner_CBasis)
   also have "... = cnj (g j)"
     using assms by auto
   finally show ?thesis
     using False by (auto simp: cinner_sum_left)
 qed
 
 lemma norm_le_componentwise:
   "(\<And>b. b \<in> CBasis \<Longrightarrow> cmod(cinner x b) \<le> cmod(cinner y b)) \<Longrightarrow> norm x \<le> norm y"
   apply (auto simp: cnorm_le ceuclidean_cinner [of x x] ceuclidean_cinner [of y y] power2_eq_square intro!: sum_mono)
    apply (smt (verit, best) mult.commute sum.cong)
-  by (simp add: ordered_field_class.sign_simps(33))
+  done
 
 lemma CBasis_le_norm: "b \<in> CBasis \<Longrightarrow> cmod (cinner x b) \<le> norm x"
   by (rule order_trans [OF Cauchy_Schwarz_ineq2]) simp
 
 lemma norm_bound_CBasis_le: "b \<in> CBasis \<Longrightarrow> norm x \<le> e \<Longrightarrow> cmod (inner x b) \<le> e"
   by (metis inner_commute mult.left_neutral norm_CBasis norm_of_real order_trans real_inner_class.Cauchy_Schwarz_ineq2)
 
 lemma norm_bound_CBasis_lt: "b \<in> CBasis \<Longrightarrow> norm x < e \<Longrightarrow> cmod (inner x b) < e"
   by (metis inner_commute le_less_trans mult.left_neutral norm_CBasis norm_of_real real_inner_class.Cauchy_Schwarz_ineq2)
 
 lemma cnorm_le_l1: "norm x \<le> (\<Sum>b\<in>CBasis. cmod (cinner x b))"
   apply (subst ceuclidean_representation[of x, symmetric])
   apply (rule order_trans[OF norm_sum])
   apply (auto intro!: sum_mono)
   by (metis cinner_commute complex_inner_1_left complex_inner_class.Cauchy_Schwarz_ineq2 mult.commute mult.left_neutral norm_one)
 
 (* Maybe it holds in the complex case but the proof does not adapt trivially *)
 (* lemma csum_norm_allsubsets_bound:
   fixes f :: "'a \<Rightarrow> 'n::ceuclidean_space"
   assumes fP: "finite P"
     and fPs: "\<And>Q. Q \<subseteq> P \<Longrightarrow> norm (sum f Q) \<le> e"
   shows "(\<Sum>x\<in>P. norm (f x)) \<le> 2 * real CDIM('n) * e" *)
 
 
 (* subsection\<^marker>\<open>tag unimportant\<close> \<open>Subclass relationships\<close> *)
 (* Everything is commented out, so we comment out the heading, too. *)
 
 (* If we include this, instantiation prod :: (ceuclidean_space, ceuclidean_space) ceuclidean_space below fails *)
 (* instance ceuclidean_space \<subseteq> perfect_space
 proof
   fix x :: 'a show "\<not> open {x}"
   proof
     assume "open {x}"
     then obtain e where "0 < e" and e: "\<forall>y. dist y x < e \<longrightarrow> y = x"
       unfolding open_dist by fast
     define y where "y = x + scaleR (e/2) (SOME b. b \<in> CBasis)"
     have [simp]: "(SOME b. b \<in> CBasis) \<in> CBasis"
       by (rule someI_ex) (auto simp: ex_in_conv)
     from \<open>0 < e\<close> have "y \<noteq> x"
       unfolding y_def by (auto intro!: nonzero_CBasis)
     from \<open>0 < e\<close> have "dist y x < e"
       unfolding y_def by (simp add: dist_norm)
     from \<open>y \<noteq> x\<close> and \<open>dist y x < e\<close> show "False"
       using e by simp
   qed
 qed *)
 
 subsection \<open>Class instances\<close>
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Type \<^typ>\<open>complex\<close>\<close>
 
 (* No analogue *)
 (* instantiation real :: ceuclidean_space *)
 
 instantiation complex :: ceuclidean_space
 begin
 
 definition
   [simp]: "CBasis = {1::complex}"
 
 instance
   by standard auto
 
 end
 
 lemma CDIM_complex[simp]: "CDIM(complex) = 1"
   by simp
 
 (* lemma CDIM_complex[simp]: "DIM(complex) = 2"
 lemma complex_CBasis_1 [iff]: "(1::complex) \<in> CBasis"
 lemma complex_CBasis_i [iff]: "\<i> \<in> CBasis" *)
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Type \<^typ>\<open>'a \<times> 'b\<close>\<close>
 
 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)"
 
 lemma cinner_Pair [simp]: "cinner (a, b) (c, d) = cinner a c + cinner b d"
   unfolding cinner_prod_def by simp
 
 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 cinner_Pair_0: "cinner x (0, b) = cinner (snd x) b" "cinner x (a, 0) = cinner (fst x) a"
   by (cases x, simp)+
 
 instantiation prod :: (ceuclidean_space, ceuclidean_space) ceuclidean_space
 begin
 
 definition
   "CBasis = (\<lambda>u. (u, 0)) ` CBasis \<union> (\<lambda>v. (0, v)) ` CBasis"
 
 lemma sum_CBasis_prod_eq:
   fixes f::"('a*'b)\<Rightarrow>('a*'b)"
   shows "sum f CBasis = sum (\<lambda>i. f (i, 0)) CBasis + sum (\<lambda>i. f (0, i)) CBasis"
 proof -
   have "inj_on (\<lambda>u. (u::'a, 0::'b)) CBasis" "inj_on (\<lambda>u. (0::'a, u::'b)) CBasis"
     by (auto intro!: inj_onI Pair_inject)
   thus ?thesis
     unfolding CBasis_prod_def
     by (subst sum.union_disjoint) (auto simp: CBasis_prod_def sum.reindex)
 qed
 
 instance proof
   show "(CBasis :: ('a \<times> 'b) set) \<noteq> {}"
     unfolding CBasis_prod_def by simp
 next
   show "finite (CBasis :: ('a \<times> 'b) set)"
     unfolding CBasis_prod_def by simp
 next
   fix u v :: "'a \<times> 'b"
   assume "u \<in> CBasis" and "v \<in> CBasis"
   thus "cinner u v = (if u = v then 1 else 0)"
     unfolding CBasis_prod_def cinner_prod_def
     by (auto simp add: cinner_CBasis split: if_split_asm)
 next
   fix x :: "'a \<times> 'b"
   show "(\<forall>u\<in>CBasis. cinner x u = 0) \<longleftrightarrow> x = 0"
     unfolding CBasis_prod_def ball_Un ball_simps
     by (simp add: cinner_prod_def prod_eq_iff ceuclidean_all_zero_iff)
 qed
 
 lemma CDIM_prod[simp]: "CDIM('a \<times> 'b) = CDIM('a) + CDIM('b)"
   unfolding CBasis_prod_def
   by (subst card_Un_disjoint) (auto intro!: card_image arg_cong2[where f="(+)"] inj_onI)
 
 end
 
 
 subsection \<open>Locale instances\<close>
 
 lemma finite_dimensional_vector_space_euclidean:
   "finite_dimensional_vector_space (*\<^sub>C) CBasis"
 proof unfold_locales
   show "finite (CBasis::'a set)" by (metis finite_CBasis)
   show "complex_vector.independent (CBasis::'a set)"
     unfolding complex_vector.dependent_def cdependent_raw_def[symmetric]
     apply (subst complex_vector.span_finite)
      apply simp
     apply clarify
     apply (drule_tac f="cinner a" in arg_cong)
     by (simp add: cinner_CBasis cinner_sum_right eq_commute)
   show "module.span (*\<^sub>C) CBasis = UNIV"
     unfolding complex_vector.span_finite [OF finite_CBasis] cspan_raw_def[symmetric]
     by (auto intro!: ceuclidean_representation[symmetric])
 qed
 
 interpretation ceucl: finite_dimensional_vector_space "scaleC :: complex => 'a => 'a::ceuclidean_space" "CBasis"
   rewrites "module.dependent (*\<^sub>C) = cdependent"
     and "module.representation (*\<^sub>C) = crepresentation"
     and "module.subspace (*\<^sub>C) = csubspace"
     and "module.span (*\<^sub>C) = cspan"
     and "vector_space.extend_basis (*\<^sub>C) = cextend_basis"
     and "vector_space.dim (*\<^sub>C) = cdim"
     and "Vector_Spaces.linear (*\<^sub>C) (*\<^sub>C) = clinear"
     and "Vector_Spaces.linear (*) (*\<^sub>C) = clinear"
     and "finite_dimensional_vector_space.dimension CBasis = CDIM('a)"
     (* and "dimension = CDIM('a)" *) (* This line leads to a type error. Not sure why *)
   by (auto simp add: cdependent_raw_def crepresentation_raw_def
       csubspace_raw_def cspan_raw_def cextend_basis_raw_def cdim_raw_def clinear_def
       complex_scaleC_def[abs_def]
       finite_dimensional_vector_space.dimension_def
       intro!: finite_dimensional_vector_space.dimension_def
       finite_dimensional_vector_space_euclidean)
 
 interpretation ceucl: finite_dimensional_vector_space_pair_1
   "scaleC::complex\<Rightarrow>'a::ceuclidean_space\<Rightarrow>'a" CBasis
   "scaleC::complex\<Rightarrow>'b::complex_vector \<Rightarrow> 'b"
   by unfold_locales
 
 interpretation ceucl?: finite_dimensional_vector_space_prod scaleC scaleC CBasis CBasis
   rewrites "Basis_pair = CBasis"
     and "module_prod.scale (*\<^sub>C) (*\<^sub>C) = (scaleC::_\<Rightarrow>_\<Rightarrow>('a \<times> 'b))"
 proof -
   show "finite_dimensional_vector_space_prod (*\<^sub>C) (*\<^sub>C) CBasis CBasis"
     by unfold_locales
   interpret finite_dimensional_vector_space_prod "(*\<^sub>C)" "(*\<^sub>C)" "CBasis::'a set" "CBasis::'b set"
     by fact
   show "Basis_pair = CBasis"
     unfolding Basis_pair_def CBasis_prod_def by auto
   show "module_prod.scale (*\<^sub>C) (*\<^sub>C) = scaleC"
     by (fact module_prod_scale_eq_scaleC)
 qed
 
 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,2230 +1,2230 @@
 (*
 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_Vector_Spaces
     "HOL-Analysis.Infinite_Set_Sum"
 
     Complex_Inner_Product0
 begin
 
 subsection \<open>Complex inner product spaces\<close>
 
 bundle cinner_bracket_notation begin
 notation cinner ("\<langle>_, _\<rangle>")
 end
 unbundle cinner_bracket_notation
 
 bundle no_cinner_bracket_notation begin
 no_notation cinner ("\<langle>_, _\<rangle>")
 end
 
 lemma cinner_real: "cinner x x \<in> \<real>"
   by (meson cinner_ge_zero reals_zero_comparable_iff)
 
 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 \<langle>x , x\<rangle> = 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>
 
 text \<open>This is a useful rule for establishing the equality of vectors\<close>
 lemma cinner_extensionality:
   assumes \<open>\<And>\<gamma>. \<langle>\<gamma>, \<psi>\<rangle> = \<langle>\<gamma>, \<phi>\<rangle>\<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 \<langle>x, y\<rangle>\<close>
     \<comment> \<open>Shown in the proof of Corollary 1.5 in @{cite conway2013course}\<close>
 proof -
   have \<open>\<langle>x , y\<rangle> + \<langle>y , x\<rangle> = \<langle>x , y\<rangle> + cnj \<langle>x , y\<rangle>\<close>
     by simp
   hence \<open>\<langle>x , y\<rangle> + \<langle>y , x\<rangle> = 2 * Re \<langle>x , y\<rangle> \<close>
     using complex_add_cnj by presburger
   have \<open>\<parallel>x + y\<parallel>^2 = \<langle>x+y, x+y\<rangle>\<close>
     by (simp add: cdot_square_norm)
   hence \<open>\<parallel>x + y\<parallel>^2 = \<langle>x , x\<rangle> + \<langle>x , y\<rangle> + \<langle>y , x\<rangle> + \<langle>y , y\<rangle>\<close>
     by (simp add: cinner_add_left cinner_add_right)
   thus ?thesis using  \<open>\<langle>x , y\<rangle> + \<langle>y , x\<rangle> = 2 * Re \<langle>x , y\<rangle>\<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 \<langle>x, y\<rangle>\<close>
 proof-
   have \<open>\<parallel>x + (-y)\<parallel>^2 = \<parallel>x\<parallel>^2 + \<parallel>-y\<parallel>^2 + 2 * Re \<langle>x , (-y)\<rangle>\<close>
     using polar_identity by blast
   hence \<open>\<parallel>x - y\<parallel>^2 = \<parallel>x\<parallel>^2 + \<parallel>y\<parallel>^2 - 2*Re \<langle>x , y\<rangle>\<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 conway2013course}\<close>
   by (simp add: polar_identity_minus polar_identity)
 
 
 theorem pythagorean_theorem:
   includes notation_norm
   shows \<open>\<langle>x , y\<rangle> = 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 conway2013course}\<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> \<langle>f a, f a'\<rangle> = 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: "\<langle>f x, f a\<rangle> = 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: "\<langle>f x, sum f F\<rangle> = \<langle>f x, (\<Sum>a\<in>F. f a)\<rangle>"
     by simp
   also have s3: "\<dots> = (\<Sum>a\<in>F. \<langle>f x, f a\<rangle>)"
     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: "\<langle>f x, sum f F\<rangle> = 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. \<langle> x n, y n \<rangle>)\<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. \<langle> x i, y i \<rangle>) n -  (\<lambda> i. \<langle> x i, y i \<rangle>) 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 ( \<langle> x n, y n \<rangle> - \<langle> x m, y m \<rangle> ) < e\<close>
       if \<open>n \<ge> N\<close> and \<open>m \<ge> N\<close>
       for n m
     proof -
       have \<open>\<langle> x n, y n \<rangle> - \<langle> x m, y m \<rangle> = (\<langle> x n, y n \<rangle> - \<langle> x m, y n \<rangle>) + (\<langle> x m, y n \<rangle> - \<langle> x m, y m \<rangle>)\<close>
         by simp
       hence y1: \<open>norm (\<langle> x n, y n \<rangle> - \<langle> x m, y m \<rangle>) \<le> norm (\<langle> x n, y n \<rangle> - \<langle> x m, y n \<rangle>)
            + norm (\<langle> x m, y n \<rangle> - \<langle> x m, y m \<rangle>)\<close>
         by (metis norm_triangle_ineq)
 
       have \<open>\<langle> x n, y n \<rangle> - \<langle> x m, y n \<rangle> = \<langle> x n - x m, y n \<rangle>\<close>
         by (simp add: cinner_diff_left)
       hence \<open>norm (\<langle> x n, y n \<rangle> - \<langle> x m, y n \<rangle>) = norm \<langle> x n - x m, y n \<rangle>\<close>
         by simp
       moreover have \<open>norm \<langle> x n - x m, y n \<rangle> \<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 (\<langle> x n, y n \<rangle> - \<langle> x m, y n \<rangle>) < (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 (\<langle> x n, y n \<rangle> - \<langle> x m, y n \<rangle>) < e/2\<close>
         by simp
       hence y2: \<open>norm (\<langle> x n, y n \<rangle> - \<langle> x m, y n \<rangle>) < e/2\<close>
         by blast
       have \<open>\<langle> x m, y n \<rangle> - \<langle> x m, y m \<rangle> = \<langle> x m, y n - y m \<rangle>\<close>
         by (simp add: cinner_diff_right)
       hence \<open>norm (\<langle> x m, y n \<rangle> - \<langle> x m, y m \<rangle>) = norm \<langle> x m, y n - y m \<rangle>\<close>
         by simp
       moreover have \<open>norm \<langle> x m, y n - y m \<rangle> \<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 (\<langle> x m, y n \<rangle> - \<langle> x m, y m \<rangle>) < 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 (\<langle> x m, y n \<rangle> - \<langle> x m, y m \<rangle>) < e/2\<close>
         by simp
       hence y3: \<open>norm (\<langle> x m, y n \<rangle> - \<langle> x m, y m \<rangle>) < e/2\<close>
         by blast
       show \<open>norm ( \<langle> x n, y n \<rangle> - \<langle> x m, y m \<rangle> ) < 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
 
 
 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> \<langle> x, y \<rangle> = 0\<close>
   unfolding orthogonal_complement_def by auto
 
 lemma orthogonal_complement_orthoI':
   \<open>x \<in> M \<Longrightarrow> y \<in> orthogonal_complement M \<Longrightarrow> \<langle> x, y \<rangle> = 0\<close>
   by (metis cinner_commute' complex_cnj_zero orthogonal_complement_orthoI)
 
 lemma orthogonal_complementI:
   \<open>(\<And>x. x \<in> M \<Longrightarrow> \<langle> y, x \<rangle> = 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> \<langle> x, y \<rangle> = 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 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. \<langle> y , an n \<rangle> = 0\<close>
       using orthogonal_complement_orthoI'
       by (simp add: orthogonal_complement_orthoI' ortho)
     moreover have \<open>isCont (\<lambda> x. \<langle> y , x \<rangle>) 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. \<langle> y , v \<rangle>) (an n)) \<longlonglongrightarrow> (\<lambda> v. \<langle> y , v \<rangle>) a\<close> for y
       using isCont_tendsto_compose
       by (simp add: isCont_tendsto_compose lim)
     hence  \<open>\<forall> y\<in>A. (\<lambda> n. \<langle> y , an n \<rangle>  ) \<longlonglongrightarrow>  \<langle> y , a \<rangle>\<close>
       by simp
     hence  \<open>\<forall> y\<in>A. (\<lambda> n. 0  ) \<longlonglongrightarrow>  \<langle> y , a \<rangle>\<close>
       using \<open>\<forall> y \<in> A. \<forall> n. \<langle> y , an n \<rangle> = 0\<close>
       by fastforce
     hence  \<open>\<forall> y \<in> A. \<langle> y , a \<rangle> = 0\<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 "\<langle> x, x \<rangle> = 0"
       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[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
 
 
 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
 
 
 text \<open>Orthogonal set\<close>
 definition is_ortho_set :: "'a::complex_inner set \<Rightarrow> bool" where
   \<open>is_ortho_set S = ((\<forall>x\<in>S. \<forall>y\<in>S. x \<noteq> y \<longrightarrow> \<langle>x, y\<rangle> = 0) \<and> 0 \<notin> S)\<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>\<langle> y, x \<rangle> = 0\<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. \<langle> y , x \<rangle> = 0\<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. \<langle> t , x \<rangle>) y\<close>
       by simp
     hence \<open>(\<lambda> n. \<langle> yy n , x \<rangle>) \<longlonglongrightarrow>  \<langle> y , x \<rangle>\<close>
       using \<open>yy \<longlonglongrightarrow> y\<close> isCont_tendsto_compose
       by fastforce
     hence \<open>(\<lambda> n. 0) \<longlonglongrightarrow>  \<langle> y , x \<rangle>\<close>
       using \<open>\<forall> y \<in> A. \<langle> y , x \<rangle> = 0\<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 "\<langle>a, x\<rangle> = 0"
 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: "\<langle>a, i\<rangle> = 0"
     if "i\<in>t" for i
     using b2 a1 that by blast
   have  "\<langle>a, x\<rangle> = \<langle>a, (\<Sum>i\<in>t. r i *\<^sub>C i)\<rangle>"
     by (simp add: b3)
   also have  "\<dots> = (\<Sum>i\<in>t. r i *\<^sub>C \<langle>a, i\<rangle>)"
     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). \<langle> x, y \<rangle> = 0\<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 "\<langle>v, v'\<rangle> = 0" 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' * \<langle>v, v'\<rangle>) = 0"
       by simp
     have "\<langle>v, (\<Sum>v'\<in>t. u v' *\<^sub>C v')\<rangle> = (\<Sum>v'\<in>t. u v' * \<langle>v, v'\<rangle>)"
       using b1
       by (metis (mono_tags, lifting) cinner_scaleC_right cinner_sum_right sum.cong)
     also have "\<dots> = u v * \<langle>v, v\<rangle> + (\<Sum>v'\<in>t-{v}. u v' * \<langle>v, v'\<rangle>)"
       by (meson b1 b4 sum.remove)
     also have "\<dots> = u v * \<langle>v, v\<rangle>"
       using sum0 by simp
     finally have "\<langle>v, (\<Sum>v'\<in>t. u v' *\<^sub>C v')\<rangle> =  u v * \<langle>v, v\<rangle>"
       by blast
     hence "u v * \<langle>v, v\<rangle> = 0" using b3 by simp
     moreover have "\<langle>v, v\<rangle> \<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. \<langle> t, x \<rangle> *\<^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 = \<langle>a, x\<rangle>\<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 \<langle>a, a\<rangle>)\<close>
       using norm_eq_sqrt_cinner by auto
     ultimately have \<open>sqrt (norm \<langle>a, a\<rangle>) = 1\<close>
       by simp
     hence \<open>norm \<langle>a, a\<rangle> = 1\<close>
       using real_sqrt_eq_1_iff by blast
     moreover have \<open>\<langle>a, a\<rangle> \<in> \<real>\<close>
       by (simp add: cinner_real)
     moreover have \<open>\<langle>a, a\<rangle> \<ge> 0\<close>
       using cinner_ge_zero by blast
     ultimately have w1: \<open>\<langle>a, a\<rangle> = 1\<close>
       by (metis \<open>0 \<le> \<langle>a, a\<rangle>\<close> \<open>cmod \<langle>a, a\<rangle> = 1\<close> complex_of_real_cmod of_real_1)
 
     have \<open>r t * \<langle>a, t\<rangle> = 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 * \<langle>a, t\<rangle>) = 0\<close>
       by (simp add: \<open>\<And>t. t \<in> T - {a} \<Longrightarrow> r t * \<langle>a, t\<rangle> = 0\<close>)
     have \<open>\<langle>a, x\<rangle> = \<langle>a, (\<Sum> t\<in>T. r t *\<^sub>C t)\<rangle>\<close>
       using \<open>x = (\<Sum> a\<in>T. r a *\<^sub>C a)\<close>
       by simp
     also have \<open>\<dots> = (\<Sum> t\<in>T. \<langle>a, r t *\<^sub>C t\<rangle>)\<close>
       using cinner_sum_right by blast
     also have \<open>\<dots> = (\<Sum> t\<in>T. r t * \<langle>a, t\<rangle>)\<close>
       by simp
     also have \<open>\<dots> = r a * \<langle>a, a\<rangle> + (\<Sum> t\<in>T-{a}. r t * \<langle>a, t\<rangle>)\<close>
       using \<open>a \<in> T\<close>
       by (meson \<open>finite T\<close> sum.remove)
     also have \<open>\<dots> = r a * \<langle>a, a\<rangle>\<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
 
 subsection \<open>Projections\<close>
 
 lemma smallest_norm_exists:
   \<comment> \<open>Theorem 2.5 in @{cite conway2013course} (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 (\<langle>v , v\<rangle> ) = \<parallel>w\<parallel>\<^sup>2 \<and> w \<in> M) \<or> v \<notin> M"
       by (metis (no_types) power2_norm_eq_cinner')
     hence "Re (\<langle>x , x\<rangle> ) \<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 conway2013course} (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 conway2013course}\<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 conway2013course}\<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 conway2013course}\<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 (\<langle> h - k , f \<rangle>) \<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 (\<langle> h - k , f \<rangle>)\<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 (\<langle> h - k , f \<rangle>)\<close>
       by simp
     thus ?thesis by simp
   qed
 
   have q4: \<open>\<forall> c > 0.  2 * Re (\<langle> h - k , f \<rangle>) \<le> c\<close>
     if  \<open>\<forall>c>0. 2 * Re (\<langle>h - k , f\<rangle> ) \<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 (\<langle> h - k , f \<rangle>) \<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 (\<langle> h - k , f \<rangle>) \<le> 0\<close>
     if a3: \<open>\<forall>f. f \<in> M \<longrightarrow> (\<forall>c>0. 2 * Re \<langle>h - k , f\<rangle> \<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 (\<langle> h - k , f \<rangle>) \<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 (\<langle> h - k , f \<rangle>) \<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 (\<langle> h - k , c *\<^sub>R f \<rangle>) \<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 \<langle>h - k, f\<rangle> \<le> \<parallel>f\<parallel>\<^sup>2\<close>)
     hence  \<open>\<forall> f. f \<in>  M \<longrightarrow>
                 (\<forall> c::real. c * (2 * Re (\<langle> h - k , f \<rangle>)) \<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 (\<langle> h - k , f \<rangle>)) \<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 (\<langle> h - k , f \<rangle>)) \<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 (\<langle> h - k , f \<rangle>)) \<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 (\<langle> h - k , f \<rangle>)) \<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 (\<langle> h - k , f \<rangle>) \<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 (\<langle> h - k , f \<rangle>) \<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 (\<langle> h - k , (-1) *\<^sub>R f \<rangle>)) \<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 (\<langle> h - k , f \<rangle>)) \<le> 0)\<close>
       by simp
     hence  \<open>\<forall> f. f \<in>  M \<longrightarrow>
                 (\<forall> c::real. c > 0 \<longrightarrow> 2 * Re (\<langle> h - k , f \<rangle>) \<ge> 0)\<close>
       by simp
     hence \<open>\<forall> f. f \<in>  M \<longrightarrow>
                 (\<forall> c::real. c > 0 \<longrightarrow> 2 * Re (\<langle> h - k , f \<rangle>) = 0)\<close>
       using  \<open>\<forall> f. f \<in>  M \<longrightarrow>
                 (\<forall> c::real. c > 0 \<longrightarrow> (2 * Re (\<langle> h - k , f \<rangle>)) \<le> 0)\<close>
       by fastforce
 
     have \<open>\<forall> f. f \<in>  M \<longrightarrow>
                  ((1::real) > 0 \<longrightarrow> 2 * Re (\<langle> h - k , f \<rangle>) = 0)\<close>
       using \<open>\<forall>f. f \<in>  M \<longrightarrow> (\<forall>c>0. 2 * Re (\<langle>h - k , f\<rangle> ) = 0)\<close> by blast
     hence \<open>\<forall> f. f \<in>  M \<longrightarrow> 2 * Re (\<langle> h - k , f \<rangle>) = 0\<close>
       by simp
     hence \<open>\<forall> f. f \<in>  M \<longrightarrow> Re (\<langle> h - k , f \<rangle>) = 0\<close>
       by simp
     have  \<open>\<forall> f. f \<in>  M \<longrightarrow> Re (\<langle> h - k , (Complex 0 (-1)) *\<^sub>C f \<rangle>) = 0\<close>
       using assms  complex_vector.subspace_def \<open>csubspace M\<close>
       by (metis \<open>\<forall>f. f \<in> M \<longrightarrow> Re \<langle>h - k, f\<rangle> = 0\<close>)
     hence  \<open>\<forall> f. f \<in>  M \<longrightarrow> Re ( (Complex 0 (-1))*(\<langle> h - k , f \<rangle>) ) = 0\<close>
       by simp
     hence \<open>\<forall> f. f \<in>  M \<longrightarrow> Im (\<langle> h - k , f \<rangle>) = 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> (\<langle> h - k , f \<rangle>) = 0\<close>
       using complex_eq_iff
       by (simp add: \<open>\<forall>f. f \<in> M \<longrightarrow> Im \<langle>h - k, f\<rangle> = 0\<close> \<open>\<forall>f. f \<in> M \<longrightarrow> Re \<langle>h - k, f\<rangle> = 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>\<langle> h - k , f \<rangle> = 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>\<langle> h - k,  k - f \<rangle> = 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>\<langle> h - k, k - f \<rangle> = 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 \<equiv> 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 a1: "closed_csubspace M" and a2: "x \<in> M"
   shows "(projection M) x = x"
   using is_projection_on_fixes_image
     \<comment> \<open>Theorem 2.7 in @{cite conway2013course}\<close>
   by (simp add: a1 a2 complex_vector.subspace_0 projection_eqI)
 
 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. \<langle>  h - \<pi> h , k \<rangle> = 0\<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>\<langle>  h - \<pi> h , \<pi> h \<rangle> = 0\<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 conway2013course}\<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 conway2013course}\<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 conway2013course}\<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 conway2013course}\<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. (\<langle>t , x\<rangle> / \<langle>t , t\<rangle>) *\<^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 = (\<langle>t , x\<rangle> / \<langle>t , t\<rangle>) *\<^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 = (\<langle>t , x\<rangle> / \<langle>t , t\<rangle>) *\<^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 conway2013course}\<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[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_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
   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 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 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). \<langle> z , x \<rangle> = 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. \<langle> z , x \<rangle> = 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. \<langle> z , x \<rangle> = 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. \<langle> y , x \<rangle> = 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. \<langle> y , x \<rangle> = 0\<close>
       by (simp add: orthogonal_complement_orthoI')
     have \<open>\<forall> a\<in>A. \<forall> b\<in>B. \<langle> a+b , x \<rangle> = 0\<close>
       by (simp add: \<open>\<forall>y\<in>A. \<langle>y , x\<rangle> = 0\<close> \<open>\<forall>y\<in>B. \<langle>y , x\<rangle> = 0\<close> cinner_add_left)
     hence \<open>\<forall> y \<in> (A + B). \<langle> y , x \<rangle> = 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
 
 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:
   \<comment> \<open>Theorem 3.4 in @{cite conway2013course}\<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 = \<langle>t, x\<rangle>\<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 = (\<langle>t , x\<rangle>/\<langle>t , t\<rangle>) *\<^sub>C t\<close> for x
     apply (subst spant) by (rule projection_rank1)
   hence \<open>f (projection (orthogonal_complement (f -` {0})) x) = ((\<langle>t , x\<rangle>)/(\<langle>t , t\<rangle>)) * (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) = \<langle>((cnj (f t)/\<langle>t , t\<rangle>) *\<^sub>C t) , x\<rangle>\<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 = \<langle>(cnj (f t)/\<langle>t , t\<rangle>) *\<^sub>C t, x\<rangle>\<close> for x
     by (simp add: l2)
   thus ?thesis
     by blast
 qed
 
 lemma riesz_frechet_representation_unique:
   \<comment> \<open>Theorem 3.4 in @{cite conway2013course}\<close>
   fixes f::\<open>'a::complex_inner \<Rightarrow> complex\<close>
   assumes \<open>\<And>x. f x = \<langle>t, x\<rangle>\<close>
   assumes \<open>\<And>x. f x = \<langle>u, x\<rangle>\<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. \<langle>F x, y\<rangle> = \<langle>x, G y\<rangle>)"
 
 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 = \<langle>x , G y\<rangle>\<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 = \<langle>t, y\<rangle>\<close>
     using riesz_frechet_representation_existence by blast
   then obtain F where \<open>\<forall>x. \<forall>y. g x y = \<langle>F x, y\<rangle>\<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>
 proof (rule ext)
   fix x
   {
     fix y
     have \<open>cinner (F1 x - F2 x) y = cinner (F1 x) y - cinner (F2 x) y\<close>
       by (simp add: cinner_diff_left)
     also have \<open>\<dots> = cinner x (G y) - cinner x (G y)\<close>
       by (metis assms(1) assms(2) is_cadjoint_def)
     also have \<open>\<dots> = 0\<close>
       by simp
     finally have \<open>cinner (F1 x - F2 x) y = 0\<close>
       by -
   }
   then show \<open>F1 x = F2 x\<close>
     by fastforce
 qed
 
 lemma cadjoint_univ_prop:
   fixes G :: "'b::chilbert_space \<Rightarrow> 'a::complex_inner"
   assumes a1: \<open>bounded_clinear G\<close>
   shows \<open>\<forall>x. \<forall>y. \<langle>cadjoint G x, y\<rangle> = \<langle>x, G y\<rangle>\<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>\<forall>x. \<forall>y. \<langle>x, cadjoint G y\<rangle> = \<langle>G x, y\<rangle>\<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. \<langle>F x, y\<rangle> = \<langle>x, G y\<rangle>\<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>\<langle>(A\<^sup>\<dagger>) x, y\<rangle> = \<langle>x , A y\<rangle>\<close> for x y
     using cadjoint_univ_prop a1 by auto
   have \<open>\<langle>(A\<^sup>\<dagger>) (x1 + x2) - ((A\<^sup>\<dagger>) x1 + (A\<^sup>\<dagger>) x2) , y\<rangle> = 0\<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>\<langle>(A\<^sup>\<dagger>) (r *\<^sub>C x) - (r *\<^sub>C (A\<^sup>\<dagger>) x ), y\<rangle> = 0\<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 = \<langle>(A\<^sup>\<dagger>) x, (A\<^sup>\<dagger>) x\<rangle>\<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> \<langle>(A\<^sup>\<dagger>) x, (A\<^sup>\<dagger>) x\<rangle> \<bar>\<close> for x
     by (metis abs_pos cinner_ge_zero)
   hence \<open>\<parallel> (A\<^sup>\<dagger>) x \<parallel>^2 = \<bar> \<langle>x, A ((A\<^sup>\<dagger>) x)\<rangle> \<bar>\<close> for x
     by (simp add: b1)
   moreover have  \<open>\<bar>\<langle>x , A ((A\<^sup>\<dagger>) x)\<rangle>\<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)
+    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: \<open>(id::'a::complex_inner\<Rightarrow>'a)\<^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>\<langle>(\<lambda> s. (cnj a) *\<^sub>C ((A\<^sup>\<dagger>) s)) x, y \<rangle> = \<langle>x, (\<lambda> t. a *\<^sub>C (A t)) y \<rangle>\<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>
 proof -
   have \<open>cinner (x - \<pi> x) y = 0\<close> if \<open>y\<in>M\<close> for x y
     using a1 a2 is_projection_on_iff_orthog orthogonal_complement_orthoI that by blast
   then have \<open>cinner x y = cinner (\<pi> x) y\<close> if \<open>y\<in>M\<close> for x y
     by (metis cinner_diff_left eq_iff_diff_eq_0 that)
   moreover have \<open>cinner x y = cinner x (\<pi> y)\<close> if \<open>y\<in>M\<close> for x y
     using a1 is_projection_on_fixes_image that by fastforce
   ultimately have 1: \<open>cinner (\<pi> x) y = cinner x (\<pi> y)\<close> if \<open>y\<in>M\<close> for x y
     using that by metis
 
   have \<open>cinner (\<pi> x) y = 0\<close> if \<open>y \<in> orthogonal_complement M\<close> for x y
     by (meson a1 is_projection_on_in_image orthogonal_complement_orthoI' that)
   also have \<open>0 = cinner x (\<pi> y)\<close> if \<open>y \<in> orthogonal_complement M\<close> for x y
     by (metis a1 a2 cinner_zero_right closed_csubspace.subspace complex_vector.subspace_0 diff_zero is_projection_on_eqI that)
   finally have 2: \<open>cinner (\<pi> x) y = cinner x (\<pi> y)\<close> if \<open>y \<in> orthogonal_complement M\<close> for x y
     using that by simp
 
   from 1 2
   have \<open>cinner (\<pi> x) y = cinner x (\<pi> y)\<close> for x y
     by (smt (verit, ccfv_threshold) a1 a2 cinner_commute cinner_diff_left eq_iff_diff_eq_0 is_projection_on_iff_orthog orthogonal_complement_orthoI)
   then show ?thesis
     by (simp add: is_cadjoint_def)
 qed
 
 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)
 
 instance ccsubspace :: (chilbert_space) complete_orthomodular_lattice
 proof
   show "inf x (- x) = bot"
     for x :: "'a ccsubspace"
     apply transfer
     by (simp add: closed_csubspace_def complex_vector.subspace_0 orthogonal_complement_zero_intersection)
 
   have \<open>t \<in> x +\<^sub>M orthogonal_complement x\<close>
     if a1: \<open>closed_csubspace x\<close>
     for t::'a and x
   proof-
     have e1: \<open>t = (projection x) t + (projection (orthogonal_complement x)) t\<close>
       by (simp add: that)
     have e2: \<open>(projection x) t \<in> x\<close>
       by (metis closed_csubspace.closed closed_csubspace.subspace csubspace_is_convex empty_iff orthog_proj_exists projection_in_image that)
     have e3: \<open>(projection (orthogonal_complement x)) t \<in> orthogonal_complement x\<close>
       by (metis add_diff_cancel_left' e1 orthogonal_complementI projection_orthogonal that)
     have "orthogonal_complement x \<subseteq> x +\<^sub>M orthogonal_complement x"
       by (simp add: closed_sum_right_subset complex_vector.subspace_0 that)
     thus ?thesis
       using \<open>closed_csubspace x\<close>
         \<open>projection (orthogonal_complement x) t \<in> orthogonal_complement x\<close> \<open>projection x t \<in> x\<close>
         \<open>t = projection x t + projection (orthogonal_complement x) t\<close> in_mono
         closed_sum_left_subset complex_vector.subspace_def
       by (metis closed_csubspace.subspace closed_subspace_closed_sum orthogonal_complement_closed_subspace)
   qed
   hence b1: \<open>x +\<^sub>M orthogonal_complement x = UNIV\<close>
     if a1: \<open>closed_csubspace x\<close>
     for x::\<open>'a set\<close>
     using that by blast
   show "sup x (- x) = top"
     for x :: "'a ccsubspace"
     apply transfer
     using b1 by auto
   show "- (- x) = x"
     for x :: "'a ccsubspace"
     apply transfer
     by (simp)
 
   show "- y \<le> - x"
     if "x \<le> y"
     for x :: "'a ccsubspace"
       and y :: "'a ccsubspace"
     using that apply transfer
     by simp
 
   have c1: "x +\<^sub>M orthogonal_complement x \<inter> y \<subseteq> y"
     if "closed_csubspace x"
       and "closed_csubspace y"
       and "x \<subseteq> y"
     for x :: "'a set"
       and y :: "'a set"
     using that
     by (simp add: closed_sum_is_sup)
 
   have c2: \<open>u \<in> x +\<^sub>M ((orthogonal_complement x) \<inter> y)\<close>
     if a1: "closed_csubspace x" and a2: "closed_csubspace y" and a3: "x \<subseteq> y" and x1: \<open>u \<in> y\<close>
     for x :: "'a set" and y :: "'a set"  and u
   proof-
     have d4: \<open>(projection x) u \<in> x\<close>
       by (metis a1 closed_csubspace_def csubspace_is_convex equals0D orthog_proj_exists projection_in_image)
     hence d2: \<open>(projection x) u \<in> y\<close>
       using a3 by auto
     have d1: \<open>csubspace y\<close>
       by (simp add: a2)
     have \<open>u - (projection x) u \<in> orthogonal_complement x\<close>
       by (simp add: a1 orthogonal_complementI projection_orthogonal)
     moreover have  \<open>u - (projection x) u \<in> y\<close>
       by (simp add: d1 d2 complex_vector.subspace_diff x1)
     ultimately have d3: \<open>u - (projection x) u \<in> ((orthogonal_complement x) \<inter> y)\<close>
       by simp
     hence \<open>\<exists> v \<in> ((orthogonal_complement x) \<inter> y). u = (projection x) u + v\<close>
       by (metis d3 diff_add_cancel ordered_field_class.sign_simps(2))
     then obtain v where \<open>v \<in> ((orthogonal_complement x) \<inter> y)\<close> and \<open>u = (projection x) u + v\<close>
       by blast
     hence \<open>u \<in> x + ((orthogonal_complement x) \<inter> y)\<close>
       by (metis d4 set_plus_intro)
     thus ?thesis
       unfolding closed_sum_def
       using closure_subset by blast
   qed
 
   have c3: "y \<subseteq> x +\<^sub>M ((orthogonal_complement x) \<inter> y)"
     if a1: "closed_csubspace x" and a2: "closed_csubspace y" and a3: "x \<subseteq> y"
     for x y :: "'a set"
     using c2 a1 a2 a3 by auto
 
   show "sup x (inf (- x) y) = y"
     if "x \<le> y"
     for x y :: "'a ccsubspace"
     using that apply transfer
     using c1 c3
     by (simp add: subset_antisym)
 
   show "x - y = inf x (- y)"
     for x y :: "'a ccsubspace"
     apply transfer
     by simp
 qed
 
 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:A \<Longrightarrow> y: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> \<langle>a, s\<rangle> = 0"
   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> \<langle>a, s\<rangle> = 0"
   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:
   assumes a1: "\<And>s. s \<in> S \<Longrightarrow> \<langle>a, s\<rangle> = 0" and a2: "finite (S::'a::chilbert_space set)"
   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)
 
 instance onb_enum \<subseteq> chilbert_space
 proof
   show "convergent X"
     if "Cauchy X"
     for X :: "nat \<Rightarrow> 'a"
   proof-
     have \<open>finite (set canonical_basis)\<close>
       by simp
     have \<open>Cauchy (\<lambda> n. \<langle> t, X n \<rangle>)\<close> for t
       by (simp add: bounded_clinear.Cauchy bounded_clinear_cinner_right that)
     hence \<open>convergent (\<lambda> n. \<langle> t, X n \<rangle>)\<close>
       for t
       by (simp add: Cauchy_convergent_iff)
     hence \<open>\<forall> t\<in>set canonical_basis. \<exists> L. (\<lambda> n. \<langle> t, X n \<rangle>) \<longlonglongrightarrow> L\<close>
       by (simp add: convergentD)
     hence \<open>\<exists> L. \<forall> t\<in>set canonical_basis. (\<lambda> n. \<langle> t, X n \<rangle>) \<longlonglongrightarrow> L t\<close>
       by metis
     then obtain L where \<open>\<And> t. t\<in>set canonical_basis \<Longrightarrow> (\<lambda> n. \<langle> t, X n \<rangle>) \<longlonglongrightarrow> L t\<close>
       by blast
     define l where \<open>l = (\<Sum>t\<in>set canonical_basis. L t *\<^sub>C t)\<close>
     have x1: \<open>X n = (\<Sum>t\<in>set canonical_basis. \<langle> t, X n \<rangle> *\<^sub>C t)\<close>
       for n
       using onb_expansion_finite[where T = "set canonical_basis" and x = "X n"]
         \<open>finite (set canonical_basis)\<close>
       by (smt is_generator_set is_normal is_orthonormal)
 
     have \<open>(\<lambda> n. \<langle> t, X n \<rangle> *\<^sub>C t) \<longlonglongrightarrow> L t *\<^sub>C t\<close>
       if r1: \<open>t\<in>set canonical_basis\<close>
       for t
     proof-
       have \<open>(\<lambda> n. \<langle> t, X n \<rangle>) \<longlonglongrightarrow> L t\<close>
         using r1  \<open>\<And> t. t\<in>set canonical_basis \<Longrightarrow> (\<lambda> n. \<langle> t, X n \<rangle>) \<longlonglongrightarrow> L t\<close>
         by blast
       define f where \<open>f x = x *\<^sub>C t\<close> for x
       have \<open>isCont f r\<close>
         for r
         unfolding f_def
         by (simp add: bounded_clinear_scaleC_left clinear_continuous_at)
       hence \<open>(\<lambda> n. f \<langle> t, X n \<rangle>) \<longlonglongrightarrow> f (L t)\<close>
         using \<open>(\<lambda>n. \<langle>t, X n\<rangle>) \<longlonglongrightarrow> L t\<close> isCont_tendsto_compose by blast
       hence \<open>(\<lambda> n. \<langle> t, X n \<rangle> *\<^sub>C t) \<longlonglongrightarrow> L t *\<^sub>C t\<close>
         unfolding f_def
         by simp
       thus ?thesis by blast
     qed
     hence \<open>(\<lambda> n. (\<Sum>t\<in>set canonical_basis. \<langle> t, X n \<rangle> *\<^sub>C t))
     \<longlonglongrightarrow>  (\<Sum>t\<in>set canonical_basis. L t *\<^sub>C t)\<close>
       using \<open>finite (set canonical_basis)\<close>
         tendsto_sum[where I = "set canonical_basis" and f = "\<lambda> t. \<lambda> n. \<langle>t, X n\<rangle> *\<^sub>C t"
           and a = "\<lambda> t. L t *\<^sub>C t"]
       by auto
     hence x2: \<open>(\<lambda> n. (\<Sum>t\<in>set canonical_basis. \<langle> t, X n \<rangle> *\<^sub>C t)) \<longlonglongrightarrow> l\<close>
       using l_def by blast
     have \<open>X \<longlonglongrightarrow> l\<close>
       using x1 x2 by simp
     thus ?thesis
       unfolding convergent_def by blast
   qed
 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..
 
 end
diff --git a/thys/Complex_Bounded_Operators/Complex_Inner_Product0.thy b/thys/Complex_Bounded_Operators/Complex_Inner_Product0.thy
--- a/thys/Complex_Bounded_Operators/Complex_Inner_Product0.thy
+++ b/thys/Complex_Bounded_Operators/Complex_Inner_Product0.thy
@@ -1,548 +1,548 @@
 (*  Based on HOL/Real_Vector_Spaces.thy by Brian Huffman
     Adapted to the complex case by Dominique Unruh *)
 
 section \<open>\<open>Complex_Inner_Product0\<close> -- Inner Product Spaces and Gradient Derivative\<close>
 
 theory Complex_Inner_Product0
   imports
     Complex_Main Complex_Vector_Spaces
     "HOL-Analysis.Inner_Product"
     "Complex_Bounded_Operators.Extra_Ordered_Fields"
 begin
 
 subsection \<open>Complex inner product spaces\<close>
 
 text \<open>
   Temporarily relax type constraints for \<^term>\<open>open\<close>, \<^term>\<open>uniformity\<close>,
   \<^term>\<open>dist\<close>, and \<^term>\<open>norm\<close>.
 \<close>
 
 setup \<open>Sign.add_const_constraint
   (\<^const_name>\<open>open\<close>, SOME \<^typ>\<open>'a::open set \<Rightarrow> bool\<close>)\<close>
 
 setup \<open>Sign.add_const_constraint
   (\<^const_name>\<open>dist\<close>, SOME \<^typ>\<open>'a::dist \<Rightarrow> 'a \<Rightarrow> real\<close>)\<close>
 
 setup \<open>Sign.add_const_constraint
   (\<^const_name>\<open>uniformity\<close>, SOME \<^typ>\<open>('a::uniformity \<times> 'a) filter\<close>)\<close>
 
 setup \<open>Sign.add_const_constraint
   (\<^const_name>\<open>norm\<close>, SOME \<^typ>\<open>'a::norm \<Rightarrow> real\<close>)\<close>
 
 class complex_inner = complex_vector + sgn_div_norm + dist_norm + uniformity_dist + open_uniformity +
   fixes cinner :: "'a \<Rightarrow> 'a \<Rightarrow> complex"
   assumes cinner_commute: "cinner x y = cnj (cinner y x)"
     and cinner_add_left: "cinner (x + y) z = cinner x z + cinner y z"
     and cinner_scaleC_left [simp]: "cinner (scaleC r x) y = (cnj r) * (cinner x y)"
     and cinner_ge_zero [simp]: "0 \<le> cinner x x"
     and cinner_eq_zero_iff [simp]: "cinner x x = 0 \<longleftrightarrow> x = 0"
     and norm_eq_sqrt_cinner: "norm x = sqrt (cmod (cinner x x))"
 begin
 
 lemma cinner_zero_left [simp]: "cinner 0 x = 0"
   using cinner_add_left [of 0 0 x] by simp
 
 lemma cinner_minus_left [simp]: "cinner (- x) y = - cinner x y"
   using cinner_add_left [of x "- x" y]
   by (simp add: group_add_class.add_eq_0_iff)
 
 lemma cinner_diff_left: "cinner (x - y) z = cinner x z - cinner y z"
   using cinner_add_left [of x "- y" z] by simp
 
 lemma cinner_sum_left: "cinner (\<Sum>x\<in>A. f x) y = (\<Sum>x\<in>A. cinner (f x) y)"
   by (cases "finite A", induct set: finite, simp_all add: cinner_add_left)
 
 lemma call_zero_iff [simp]: "(\<forall>u. cinner x u = 0) \<longleftrightarrow> (x = 0)"
   by auto (use cinner_eq_zero_iff in blast)
 
 text \<open>Transfer distributivity rules to right argument.\<close>
 
 lemma cinner_add_right: "cinner x (y + z) = cinner x y + cinner x z"
   using cinner_add_left [of y z x]
   by (metis complex_cnj_add local.cinner_commute)
 
 lemma cinner_scaleC_right [simp]: "cinner x (scaleC r y) = r * (cinner x y)"
   using cinner_scaleC_left [of r y x]
   by (metis complex_cnj_cnj complex_cnj_mult local.cinner_commute)
 
 lemma cinner_zero_right [simp]: "cinner x 0 = 0"
   using cinner_zero_left [of x]
   by (metis (mono_tags, opaque_lifting) complex_cnj_zero local.cinner_commute)
 
 lemma cinner_minus_right [simp]: "cinner x (- y) = - cinner x y"
   using cinner_minus_left [of y x]
   by (metis complex_cnj_minus local.cinner_commute)
 
 lemma cinner_diff_right: "cinner x (y - z) = cinner x y - cinner x z"
   using cinner_diff_left [of y z x]
   by (metis complex_cnj_diff local.cinner_commute)
 
 lemma cinner_sum_right: "cinner x (\<Sum>y\<in>A. f y) = (\<Sum>y\<in>A. cinner x (f y))"
 proof (subst cinner_commute)
   have "(\<Sum>y\<in>A. cinner (f y) x) = (\<Sum>y\<in>A. cinner (f y) x)"
     by blast
   hence "cnj (\<Sum>y\<in>A. cinner (f y) x) = cnj (\<Sum>y\<in>A. (cinner (f y) x))"
     by simp
   hence "cnj (cinner (sum f A) x) = (\<Sum>y\<in>A. cnj (cinner (f y) x))"
     by (simp add: cinner_sum_left)
   thus "cnj (cinner (sum f A) x) = (\<Sum>y\<in>A. (cinner x (f y)))"
     by (subst (2) cinner_commute)
 qed
 
 lemmas cinner_add [algebra_simps] = cinner_add_left cinner_add_right
 lemmas cinner_diff [algebra_simps]  = cinner_diff_left cinner_diff_right
 lemmas cinner_scaleC = cinner_scaleC_left cinner_scaleC_right
 
 (* text \<open>Legacy theorem names\<close>
 lemmas cinner_left_distrib = cinner_add_left
 lemmas cinner_right_distrib = cinner_add_right
 lemmas cinner_distrib = cinner_left_distrib cinner_right_distrib *)
 
 lemma cinner_gt_zero_iff [simp]: "0 < cinner x x \<longleftrightarrow> x \<noteq> 0"
   by (smt (verit) less_irrefl local.cinner_eq_zero_iff local.cinner_ge_zero order.not_eq_order_implies_strict)
 
 (* In Inner_Product, we have
   lemma power2_norm_eq_cinner: "(norm x)\<^sup>2 = cinner x x"
 The following are two ways of inserting the conversions between real and complex into this:
 *)
 
 lemma power2_norm_eq_cinner:
   shows "(complex_of_real (norm x))\<^sup>2 = (cinner x x)"
   by (smt (verit, del_insts) Im_complex_of_real Re_complex_of_real cinner_gt_zero_iff cinner_zero_right cmod_def complex_eq_0 complex_eq_iff less_complex_def local.norm_eq_sqrt_cinner of_real_power real_sqrt_abs real_sqrt_pow2_iff zero_complex.sel(1))
 
 lemma power2_norm_eq_cinner':
   shows "(norm x)\<^sup>2 = Re (cinner x x)"
   by (metis Re_complex_of_real of_real_power power2_norm_eq_cinner)
 
 text \<open>Identities involving real multiplication and division.\<close>
 
 lemma cinner_mult_left: "cinner (of_complex m * a) b = cnj m * (cinner a b)"
   by (simp add: of_complex_def)
 
 lemma cinner_mult_right: "cinner a (of_complex m * b) = m * (cinner a b)"
   by (metis complex_inner_class.cinner_scaleC_right scaleC_conv_of_complex)
 
 lemma cinner_mult_left': "cinner (a * of_complex m) b = cnj m * (cinner a b)"
   by (metis cinner_mult_left mult.right_neutral mult_scaleC_right scaleC_conv_of_complex)
 
 lemma cinner_mult_right': "cinner a (b * of_complex m) = (cinner a b) * m"
   by (simp add: complex_inner_class.cinner_scaleC_right of_complex_def)
 
 (* In Inner_Product, we have
 lemma Cauchy_Schwarz_ineq:
   "(cinner x y)\<^sup>2 \<le> cinner x x * cinner y y"
 The following are two ways of inserting the conversions between real and complex into this:
 *)
 
 lemma Cauchy_Schwarz_ineq:
   "(cinner x y) * (cinner y x) \<le> cinner x x * cinner y y"
 proof (cases)
   assume "y = 0"
   thus ?thesis by simp
 next
   assume y: "y \<noteq> 0"
   have [simp]: "cnj (cinner y y) = cinner y y" for y
     by (metis cinner_commute)
   define r where "r = cnj (cinner x y) / cinner y y"
   have "0 \<le> cinner (x - scaleC r y) (x - scaleC r y)"
     by (rule cinner_ge_zero)
   also have "\<dots> = cinner x x - r * cinner x y - cnj r * cinner y x + r * cnj r * cinner y y"
     unfolding cinner_diff_left cinner_diff_right cinner_scaleC_left cinner_scaleC_right
     by (smt (z3) cancel_comm_monoid_add_class.diff_cancel cancel_comm_monoid_add_class.diff_zero complex_cnj_divide group_add_class.diff_add_cancel local.cinner_commute local.cinner_eq_zero_iff local.cinner_scaleC_left mult.assoc mult.commute mult_eq_0_iff nonzero_eq_divide_eq r_def y)
   also have "\<dots> = cinner x x - cinner y x * cnj r"
     unfolding r_def by auto
   also have "\<dots> = cinner x x - cinner x y * cnj (cinner x y) / cinner y y"
     unfolding r_def
     by (metis complex_cnj_divide local.cinner_commute mult.commute times_divide_eq_left)
   finally have "0 \<le> cinner x x - cinner x y * cnj (cinner x y) / cinner y y" .
   hence "cinner x y * cnj (cinner x y) / cinner y y \<le> cinner x x"
     by (simp add: le_diff_eq)
   thus "cinner x y * cinner y x \<le> cinner x x * cinner y y"
     by (metis cinner_gt_zero_iff local.cinner_commute nice_ordered_field_class.pos_divide_le_eq y)
 qed
 
 
 lemma Cauchy_Schwarz_ineq2:
   shows "norm (cinner x y) \<le> norm x * norm y"
 proof (rule power2_le_imp_le)
   have "(norm (cinner x y))^2 = Re (cinner x y * cinner y x)"
     by (metis (full_types) Re_complex_of_real complex_norm_square local.cinner_commute)
   also have "\<dots> \<le> Re (cinner x x * cinner y y)"
     using Cauchy_Schwarz_ineq by (rule Re_mono)
   also have "\<dots> = Re (complex_of_real ((norm x)^2) * complex_of_real ((norm y)^2))"
     by (simp add: power2_norm_eq_cinner)
   also have "\<dots> = (norm x * norm y)\<^sup>2"
     by (simp add: power_mult_distrib)
   finally show "(cmod (cinner x y))^2 \<le> (norm x * norm y)\<^sup>2" .
   show "0 \<le> norm x * norm y"
     by (simp add: local.norm_eq_sqrt_cinner)
 qed
 
 (* The following variant does not hold in the complex case: *)
 (* lemma norm_cauchy_schwarz: "cinner x y \<le> norm x * norm y"
   using Cauchy_Schwarz_ineq2 [of x y] by auto *)
 
 subclass complex_normed_vector
 proof
   fix a :: complex and r :: real and x y :: 'a
   show "norm x = 0 \<longleftrightarrow> x = 0"
     unfolding norm_eq_sqrt_cinner by simp
   show "norm (x + y) \<le> norm x + norm y"
   proof (rule power2_le_imp_le)
     have "Re (cinner x y) \<le> cmod (cinner x y)"
       if "\<And>x. Re x \<le> cmod x" and
         "\<And>x y. x \<le> y \<Longrightarrow> complex_of_real x \<le> complex_of_real y"
       using that by simp
     hence a1: "2 * Re (cinner x y) \<le> 2 * cmod (cinner x y)"
       if "\<And>x. Re x \<le> cmod x" and
         "\<And>x y. x \<le> y \<Longrightarrow> complex_of_real x \<le> complex_of_real y"
       using that by simp
     have "cinner x y + cinner y x = complex_of_real (2 * Re (cinner x y))"
       by (metis complex_add_cnj local.cinner_commute)
     also have "\<dots> \<le> complex_of_real (2 * cmod (cinner x y))"
       using complex_Re_le_cmod complex_of_real_mono a1
       by blast
     also have "\<dots> = 2 * abs (cinner x y)"
       unfolding abs_complex_def by simp
     also have "\<dots> \<le> 2 * complex_of_real (norm x) * complex_of_real (norm y)"
-      using Cauchy_Schwarz_ineq2 unfolding abs_complex_def by auto
+      using Cauchy_Schwarz_ineq2 unfolding abs_complex_def less_eq_complex_def by auto
     finally have xyyx: "cinner x y + cinner y x \<le> complex_of_real (2 * norm x * norm y)"
       by auto
     have "complex_of_real ((norm (x + y))\<^sup>2) = cinner (x+y) (x+y)"
       by (simp add: power2_norm_eq_cinner)
     also have "\<dots> = cinner x x + cinner x y + cinner y x + cinner y y"
       by (simp add: cinner_add)
     also have "\<dots> = complex_of_real ((norm x)\<^sup>2) + complex_of_real ((norm y)\<^sup>2) + cinner x y + cinner y x"
       by (simp add: power2_norm_eq_cinner)
     also have "\<dots> \<le> complex_of_real ((norm x)\<^sup>2) + complex_of_real ((norm y)\<^sup>2) + complex_of_real (2 * norm x * norm y)"
       using xyyx by auto
     also have "\<dots> = complex_of_real ((norm x + norm y)\<^sup>2)"
       unfolding power2_sum by auto
     finally show "(norm (x + y))\<^sup>2 \<le> (norm x + norm y)\<^sup>2"
       using complex_of_real_mono_iff by blast
     show "0 \<le> norm x + norm y"
       unfolding norm_eq_sqrt_cinner by simp
   qed
   show norm_scaleC: "norm (a *\<^sub>C x) = cmod a * norm x" for a
   proof (rule power2_eq_imp_eq)
     show "(norm (a *\<^sub>C x))\<^sup>2 = (cmod a * norm x)\<^sup>2"
       by (simp_all add: norm_eq_sqrt_cinner norm_mult power2_eq_square)
     show "0 \<le> norm (a *\<^sub>C x)"
       by (simp_all add: norm_eq_sqrt_cinner)
     show "0 \<le> cmod a * norm x"
       by (simp_all add: norm_eq_sqrt_cinner)
   qed
   show "norm (r *\<^sub>R x) = \<bar>r\<bar> * norm x"
     unfolding scaleR_scaleC norm_scaleC by auto
 qed
 
 end
 
 (* Does not hold in the complex case *)
 (* lemma csquare_bound_lemma:
   fixes x :: complex
   shows "x < (1 + x) * (1 + x)" *)
 
 lemma csquare_continuous:
   fixes e :: real
   shows "e > 0 \<Longrightarrow> \<exists>d. 0 < d \<and> (\<forall>y. cmod (y - x) < d \<longrightarrow> cmod (y * y - x * x) < e)"
   using isCont_power[OF continuous_ident, of x, unfolded isCont_def LIM_eq, rule_format, of e 2]
   by (force simp add: power2_eq_square)
 
 lemma cnorm_le: "norm x \<le> norm y \<longleftrightarrow> cinner x x \<le> cinner y y"
   by (smt (verit) complex_of_real_mono_iff norm_eq_sqrt_cinner norm_ge_zero of_real_power power2_norm_eq_cinner real_sqrt_le_mono real_sqrt_pow2)
 
 lemma cnorm_lt: "norm x < norm y \<longleftrightarrow> cinner x x < cinner y y"
   by (meson cnorm_le less_le_not_le)
 
 lemma cnorm_eq: "norm x = norm y \<longleftrightarrow> cinner x x = cinner y y"
   by (metis norm_eq_sqrt_cinner power2_norm_eq_cinner)
 
 lemma cnorm_eq_1: "norm x = 1 \<longleftrightarrow> cinner x x = 1"
   by (metis cinner_ge_zero complex_of_real_cmod norm_eq_sqrt_cinner norm_one of_real_1 real_sqrt_eq_iff real_sqrt_one)
 
 lemma cinner_divide_left:
   fixes a :: "'a :: {complex_inner,complex_div_algebra}"
   shows "cinner (a / of_complex m) b = (cinner a b) / cnj m"
   by (metis cinner_mult_left' complex_cnj_inverse divide_inverse of_complex_inverse ordered_field_class.sign_simps(33))
 
 lemma cinner_divide_right:
   fixes a :: "'a :: {complex_inner,complex_div_algebra}"
   shows "cinner a (b / of_complex m) = (cinner a b) / m"
   by (metis cinner_mult_right' divide_inverse of_complex_inverse)
 
 text \<open>
   Re-enable constraints for \<^term>\<open>open\<close>, \<^term>\<open>uniformity\<close>,
   \<^term>\<open>dist\<close>, and \<^term>\<open>norm\<close>.
 \<close>
 
 setup \<open>Sign.add_const_constraint
   (\<^const_name>\<open>open\<close>, SOME \<^typ>\<open>'a::topological_space set \<Rightarrow> bool\<close>)\<close>
 
 setup \<open>Sign.add_const_constraint
   (\<^const_name>\<open>uniformity\<close>, SOME \<^typ>\<open>('a::uniform_space \<times> 'a) filter\<close>)\<close>
 
 setup \<open>Sign.add_const_constraint
   (\<^const_name>\<open>dist\<close>, SOME \<^typ>\<open>'a::metric_space \<Rightarrow> 'a \<Rightarrow> real\<close>)\<close>
 
 setup \<open>Sign.add_const_constraint
   (\<^const_name>\<open>norm\<close>, SOME \<^typ>\<open>'a::real_normed_vector \<Rightarrow> real\<close>)\<close>
 
 
 lemma bounded_sesquilinear_cinner:
   "bounded_sesquilinear (cinner::'a::complex_inner \<Rightarrow> 'a \<Rightarrow> complex)"
 proof
   fix x y z :: 'a and r :: complex
   show "cinner (x + y) z = cinner x z + cinner y z"
     by (rule cinner_add_left)
   show "cinner x (y + z) = cinner x y + cinner x z"
     by (rule cinner_add_right)
   show "cinner (scaleC r x) y = scaleC (cnj r) (cinner x y)"
     unfolding complex_scaleC_def by (rule cinner_scaleC_left)
   show "cinner x (scaleC r y) = scaleC r (cinner x y)"
     unfolding complex_scaleC_def by (rule cinner_scaleC_right)
   have "\<forall>x y::'a. norm (cinner x y) \<le> norm x * norm y * 1"
     by (simp add: complex_inner_class.Cauchy_Schwarz_ineq2)
   thus "\<exists>K. \<forall>x y::'a. norm (cinner x y) \<le> norm x * norm y * K"
     by metis
 qed
 
 lemmas tendsto_cinner [tendsto_intros] =
   bounded_bilinear.tendsto [OF bounded_sesquilinear_cinner[THEN bounded_sesquilinear.bounded_bilinear]]
 
 lemmas isCont_cinner [simp] =
   bounded_bilinear.isCont [OF bounded_sesquilinear_cinner[THEN bounded_sesquilinear.bounded_bilinear]]
 
 lemmas has_derivative_cinner [derivative_intros] =
   bounded_bilinear.FDERIV [OF bounded_sesquilinear_cinner[THEN bounded_sesquilinear.bounded_bilinear]]
 
 lemmas bounded_antilinear_cinner_left =
   bounded_sesquilinear.bounded_antilinear_left [OF bounded_sesquilinear_cinner]
 
 lemmas bounded_clinear_cinner_right =
   bounded_sesquilinear.bounded_clinear_right [OF bounded_sesquilinear_cinner]
 
 lemmas bounded_antilinear_cinner_left_comp = bounded_antilinear_cinner_left[THEN bounded_antilinear_o_bounded_clinear]
 
 lemmas bounded_clinear_cinner_right_comp = bounded_clinear_cinner_right[THEN bounded_clinear_compose]
 
 lemmas has_derivative_cinner_right [derivative_intros] =
   bounded_linear.has_derivative [OF bounded_clinear_cinner_right[THEN bounded_clinear.bounded_linear]]
 
 lemmas has_derivative_cinner_left [derivative_intros] =
   bounded_linear.has_derivative [OF bounded_antilinear_cinner_left[THEN bounded_antilinear.bounded_linear]]
 
 lemma differentiable_cinner [simp]:
   "f differentiable (at x within s) \<Longrightarrow> g differentiable at x within s \<Longrightarrow> (\<lambda>x. cinner (f x) (g x)) differentiable at x within s"
   unfolding differentiable_def by (blast intro: has_derivative_cinner)
 
 
 subsection \<open>Class instances\<close>
 
 instantiation complex :: complex_inner
 begin
 
 definition cinner_complex_def [simp]: "cinner x y = cnj x * y"
 
 instance
 proof
   fix x y z r :: complex
   show "cinner x y = cnj (cinner y x)"
     unfolding cinner_complex_def by auto
   show "cinner (x + y) z = cinner x z + cinner y z"
     unfolding cinner_complex_def
     by (simp add: ring_class.ring_distribs(2))
   show "cinner (scaleC r x) y = cnj r * cinner x y"
     unfolding cinner_complex_def complex_scaleC_def by simp
   show "0 \<le> cinner x x"
     by simp
   show "cinner x x = 0 \<longleftrightarrow> x = 0"
     unfolding cinner_complex_def by simp
   have "cmod (Complex x1 x2) = sqrt (cmod (cinner (Complex x1 x2) (Complex x1 x2)))"
     for x1 x2
     unfolding cinner_complex_def complex_cnj complex_mult complex_norm
     by (simp add: power2_eq_square)
   thus "norm x = sqrt (cmod (cinner x x))"
     by (cases x, hypsubst_thin)
 qed
 
 end
 
 lemma
   shows complex_inner_1_left[simp]: "cinner 1 x = x"
     and complex_inner_1_right[simp]: "cinner x 1 = cnj x"
   by simp_all
 
 (* No analogous to \<open>instantiation complex :: real_inner\<close> or to
 lemma complex_inner_1 [simp]: "inner 1 x = Re x"
 lemma complex_inner_1_right [simp]: "inner x 1 = Re x"
 lemma complex_inner_i_left [simp]: "inner \<i> x = Im x"
 lemma complex_inner_i_right [simp]: "inner x \<i> = Im x"
  *)
 
 lemma cdot_square_norm: "cinner x x = complex_of_real ((norm x)\<^sup>2)"
   by (metis Im_complex_of_real Re_complex_of_real cinner_ge_zero complex_eq_iff less_eq_complex_def power2_norm_eq_cinner' zero_complex.simps(2))
 
 lemma cnorm_eq_square: "norm x = a \<longleftrightarrow> 0 \<le> a \<and> cinner x x = complex_of_real (a\<^sup>2)"
   by (metis cdot_square_norm norm_ge_zero of_real_eq_iff power2_eq_iff_nonneg)
 
 lemma cnorm_le_square: "norm x \<le> a \<longleftrightarrow> 0 \<le> a \<and> cinner x x \<le> complex_of_real (a\<^sup>2)"
   by (smt (verit) cdot_square_norm complex_of_real_mono_iff norm_ge_zero power2_le_imp_le)
 
 lemma cnorm_ge_square: "norm x \<ge> a \<longleftrightarrow> a \<le> 0 \<or> cinner x x \<ge> complex_of_real (a\<^sup>2)"
   by (smt (verit, best) antisym_conv cnorm_eq_square cnorm_le_square complex_of_real_nn_iff nn_comparable zero_le_power2)
 
 lemma norm_lt_square: "norm x < a \<longleftrightarrow> 0 < a \<and> cinner x x < complex_of_real (a\<^sup>2)"
   by (meson cnorm_ge_square cnorm_le_square less_le_not_le)
 
 lemma norm_gt_square: "norm x > a \<longleftrightarrow> a < 0 \<or> cinner x x > complex_of_real (a\<^sup>2)"
   by (smt (verit, ccfv_SIG) cdot_square_norm complex_of_real_strict_mono_iff norm_ge_zero power2_eq_imp_eq power_mono)
 
 text\<open>Dot product in terms of the norm rather than conversely.\<close>
 
 lemmas cinner_simps = cinner_add_left cinner_add_right cinner_diff_right cinner_diff_left
   cinner_scaleC_left cinner_scaleC_right
 
 (* Analogue to both dot_norm and dot_norm_neg *)
 lemma cdot_norm: "cinner x y = ((norm (x+y))\<^sup>2 - (norm (x-y))\<^sup>2 - \<i> * (norm (x + \<i> *\<^sub>C y))\<^sup>2 + \<i> * (norm (x - \<i> *\<^sub>C y))\<^sup>2) / 4"
   unfolding power2_norm_eq_cinner
   by (simp add: power2_norm_eq_cinner cinner_add_left cinner_add_right
       cinner_diff_left cinner_diff_right ring_distribs)
 
 lemma of_complex_inner_1 [simp]:
   "cinner (of_complex x) (1 :: 'a :: {complex_inner, complex_normed_algebra_1}) = cnj x"
   by (metis Complex_Inner_Product0.complex_inner_1_right cinner_complex_def cinner_mult_left complex_cnj_one norm_one of_complex_def power2_norm_eq_cinner scaleC_conv_of_complex)
 
 lemma summable_of_complex_iff:
   "summable (\<lambda>x. of_complex (f x) :: 'a :: {complex_normed_algebra_1,complex_inner}) \<longleftrightarrow> summable f"
 proof
   assume *: "summable (\<lambda>x. of_complex (f x) :: 'a)"
   have "bounded_clinear (cinner (1::'a))"
     by (rule bounded_clinear_cinner_right)
   then interpret bounded_linear "\<lambda>x::'a. cinner 1 x"
     by (rule bounded_clinear.bounded_linear)
   from summable [OF *] show "summable f"
     apply (subst (asm) cinner_commute) by simp
 next
   assume sum: "summable f"
   thus "summable (\<lambda>x. of_complex (f x) :: 'a)"
     by (rule summable_of_complex)
 qed
 
 subsection \<open>Gradient derivative\<close>
 
 definition\<^marker>\<open>tag important\<close>
   cgderiv :: "['a::complex_inner \<Rightarrow> complex, 'a, 'a] \<Rightarrow> bool"
   ("(cGDERIV (_)/ (_)/ :> (_))" [1000, 1000, 60] 60)
   where
     (* Must be "cinner D" not "\<lambda>h. cinner h D", otherwise not even "cGDERIV id x :> 1" holds *)
     "cGDERIV f x :> D \<longleftrightarrow> FDERIV f x :> cinner D"
 
 lemma cgderiv_deriv [simp]: "cGDERIV f x :> D \<longleftrightarrow> DERIV f x :> cnj D"
   by (simp only: cgderiv_def has_field_derivative_def cinner_complex_def[THEN ext])
 
 lemma cGDERIV_DERIV_compose:
   assumes "cGDERIV f x :> df" and "DERIV g (f x) :> cnj dg"
   shows "cGDERIV (\<lambda>x. g (f x)) x :> scaleC dg df"
 proof (insert assms)
   show "cGDERIV (\<lambda>x. g (f x)) x :> dg *\<^sub>C df"
     if "cGDERIV f x :> df"
       and "(g has_field_derivative cnj dg) (at (f x))"
     unfolding cgderiv_def has_field_derivative_def cinner_scaleC_left complex_cnj_cnj
     using that
     by (simp add: cgderiv_def has_derivative_compose has_field_derivative_imp_has_derivative)
 
 qed
 
 (* Not specific to complex/real *)
 (* lemma has_derivative_subst: "\<lbrakk>FDERIV f x :> df; df = d\<rbrakk> \<Longrightarrow> FDERIV f x :> d" *)
 
 lemma cGDERIV_subst: "\<lbrakk>cGDERIV f x :> df; df = d\<rbrakk> \<Longrightarrow> cGDERIV f x :> d"
   by simp
 
 lemma cGDERIV_const: "cGDERIV (\<lambda>x. k) x :> 0"
   unfolding cgderiv_def cinner_zero_left[THEN ext] by (rule has_derivative_const)
 
 lemma cGDERIV_add:
   "\<lbrakk>cGDERIV f x :> df; cGDERIV g x :> dg\<rbrakk>
      \<Longrightarrow> cGDERIV (\<lambda>x. f x + g x) x :> df + dg"
   unfolding cgderiv_def cinner_add_left[THEN ext] by (rule has_derivative_add)
 
 lemma cGDERIV_minus:
   "cGDERIV f x :> df \<Longrightarrow> cGDERIV (\<lambda>x. - f x) x :> - df"
   unfolding cgderiv_def cinner_minus_left[THEN ext] by (rule has_derivative_minus)
 
 lemma cGDERIV_diff:
   "\<lbrakk>cGDERIV f x :> df; cGDERIV g x :> dg\<rbrakk>
      \<Longrightarrow> cGDERIV (\<lambda>x. f x - g x) x :> df - dg"
   unfolding cgderiv_def cinner_diff_left by (rule has_derivative_diff)
 
 lemma cGDERIV_scaleC:
   "\<lbrakk>DERIV f x :> df; cGDERIV g x :> dg\<rbrakk>
      \<Longrightarrow> cGDERIV (\<lambda>x. scaleC (f x) (g x)) x
       :> (scaleC (cnj (f x)) dg + scaleC (cnj df) (cnj (g x)))"
   unfolding cgderiv_def has_field_derivative_def cinner_add_left cinner_scaleC_left
   apply (rule has_derivative_subst)
    apply (erule (1) has_derivative_scaleC)
   by (simp add: ac_simps)
 
 lemma GDERIV_mult:
   "\<lbrakk>cGDERIV f x :> df; cGDERIV g x :> dg\<rbrakk>
      \<Longrightarrow> cGDERIV (\<lambda>x. f x * g x) x :> cnj (f x) *\<^sub>C dg + cnj (g x) *\<^sub>C df"
   unfolding cgderiv_def
   apply (rule has_derivative_subst)
    apply (erule (1) has_derivative_mult)
   apply (rule ext)
   by (simp add: cinner_add ac_simps)
 
 lemma cGDERIV_inverse:
   "\<lbrakk>cGDERIV f x :> df; f x \<noteq> 0\<rbrakk>
      \<Longrightarrow> cGDERIV (\<lambda>x. inverse (f x)) x :> - cnj ((inverse (f x))\<^sup>2) *\<^sub>C df"
   by (metis DERIV_inverse cGDERIV_DERIV_compose complex_cnj_cnj complex_cnj_minus numerals(2))
 
 (* Don't know if this holds: *)
 (* lemma cGDERIV_norm:
   assumes "x \<noteq> 0" shows "cGDERIV (\<lambda>x. norm x) x :> sgn x"
 *)
 
 
 lemma has_derivative_norm[derivative_intros]:
   fixes x :: "'a::complex_inner"
   assumes "x \<noteq> 0"
   shows "(norm has_derivative (\<lambda>h. Re (cinner (sgn x) h))) (at x)"
   thm has_derivative_norm
 proof -
   have Re_pos: "0 < Re (cinner x x)"
     using assms
     by (metis Re_strict_mono cinner_gt_zero_iff zero_complex.simps(1))
   have Re_plus_Re: "Re (cinner x y) + Re (cinner y x) = 2 * Re (cinner x y)"
     for x y :: 'a
     by (metis cinner_commute cnj.simps(1) mult_2_right semiring_normalization_rules(7))
   have norm: "norm x = sqrt (Re (cinner x x))" for x :: 'a
     apply (subst norm_eq_sqrt_cinner, subst cmod_Re)
     using cinner_ge_zero by auto
   have v2:"((\<lambda>x. sqrt (Re (cinner x x))) has_derivative
           (\<lambda>xa. (Re (cinner x xa) + Re (cinner xa x)) * (inverse (sqrt (Re (cinner x x))) / 2))) (at x)"
     by (rule derivative_eq_intros | simp add: Re_pos)+
   have v1: "((\<lambda>x. sqrt (Re (cinner x x))) has_derivative (\<lambda>y. Re (cinner x y) / sqrt (Re (cinner x x)))) (at x)"
     if "((\<lambda>x. sqrt (Re (cinner x x))) has_derivative (\<lambda>xa. Re (cinner x xa) * inverse (sqrt (Re (cinner x x))))) (at x)"
     using that apply (subst divide_real_def)
     by simp
   have \<open>(norm has_derivative (\<lambda>y. Re (cinner x y) / norm x)) (at x)\<close>
     using v2
     apply (auto simp: Re_plus_Re norm [abs_def])
     using v1 by blast
   then show ?thesis
     by (auto simp: power2_eq_square sgn_div_norm scaleR_scaleC)
 qed
 
 
 bundle cinner_syntax begin
 notation cinner (infix "\<bullet>\<^sub>C" 70)
 end
 
 bundle no_cinner_syntax begin
 no_notation cinner (infix "\<bullet>\<^sub>C" 70)
 end
 
 end
diff --git a/thys/Complex_Bounded_Operators/extra/Extra_General.thy b/thys/Complex_Bounded_Operators/extra/Extra_General.thy
--- a/thys/Complex_Bounded_Operators/extra/Extra_General.thy
+++ b/thys/Complex_Bounded_Operators/extra/Extra_General.thy
@@ -1,518 +1,518 @@
 section \<open>\<open>Extra_General\<close> -- General missing things\<close>
 
 theory Extra_General
   imports
     "HOL-Library.Cardinality"
     "HOL-Analysis.Elementary_Topology"
     Jordan_Normal_Form.Conjugate
     "HOL-Analysis.Uniform_Limit"
     "HOL-Library.Set_Algebras"
     "HOL-Types_To_Sets.Types_To_Sets"
 begin
 
 subsection \<open>Misc\<close>
 
 lemma reals_zero_comparable_iff:
   "(x::complex)\<in>\<real> \<longleftrightarrow> x \<le> 0 \<or> x \<ge> 0"
   unfolding complex_is_Real_iff less_eq_complex_def
   by auto
 
 lemma reals_zero_comparable:
   fixes x::complex
   assumes "x\<in>\<real>"
   shows "x \<le> 0 \<or> x \<ge> 0"
   using assms unfolding reals_zero_comparable_iff by assumption
 
 lemma unique_choice: "\<forall>x. \<exists>!y. Q x y \<Longrightarrow> \<exists>!f. \<forall>x. Q x (f x)"
   apply (auto intro!: choice ext) by metis
 
 lemma sum_single: 
   assumes "finite A"
   assumes "\<And>j. j \<noteq> i \<Longrightarrow> j\<in>A \<Longrightarrow> f j = 0"
   shows "sum f A = (if i\<in>A then f i else 0)"
   apply (subst sum.mono_neutral_cong_right[where S=\<open>A \<inter> {i}\<close> and h=f])
   using assms by auto
 
 lemma image_set_plus: 
   assumes \<open>linear U\<close>
   shows \<open>U ` (A + B) = U ` A + U ` B\<close>
   unfolding image_def set_plus_def
   using assms by (force simp: linear_add)
 
 consts heterogenous_identity :: \<open>'a \<Rightarrow> 'b\<close>
 overloading heterogenous_identity_id \<equiv> "heterogenous_identity :: 'a \<Rightarrow> 'a" begin
 definition heterogenous_identity_def[simp]: \<open>heterogenous_identity_id = id\<close>
 end
 
 lemma bdd_above_image_mono:
   assumes \<open>\<And>x. x\<in>S \<Longrightarrow> f x \<le> g x\<close>
   assumes \<open>bdd_above (g ` S)\<close>
   shows \<open>bdd_above (f ` S)\<close>
   by (smt (verit, ccfv_threshold) assms(1) assms(2) bdd_aboveI2 bdd_above_def order_trans rev_image_eqI)
 
 
 lemma L2_set_mono2:
   assumes a1: "finite L" and a2: "K \<le> L"
   shows "L2_set f K \<le> L2_set f L"
 proof-
   have "(\<Sum>i\<in>K. (f i)\<^sup>2) \<le> (\<Sum>i\<in>L. (f i)\<^sup>2)"
   proof (rule sum_mono2)
     show "finite L"
       using a1.
     show "K \<subseteq> L"
       using a2.
     show "0 \<le> (f b)\<^sup>2"
       if "b \<in> L - K"
       for b :: 'a
       using that
       by simp 
   qed
   hence "sqrt (\<Sum>i\<in>K. (f i)\<^sup>2) \<le> sqrt (\<Sum>i\<in>L. (f i)\<^sup>2)"
     by (rule real_sqrt_le_mono)
   thus ?thesis
     unfolding L2_set_def.
 qed
 
 lemma Sup_real_close:
   fixes e :: real
   assumes "0 < e"
     and S: "bdd_above S" "S \<noteq> {}"
   shows "\<exists>x\<in>S. Sup S - e < x"
 proof -
   have \<open>Sup (ereal ` S) \<noteq> \<infinity>\<close>
     by (metis assms(2) bdd_above_def ereal_less_eq(3) less_SUP_iff less_ereal.simps(4) not_le)
   moreover have \<open>Sup (ereal ` S) \<noteq> -\<infinity>\<close>
     by (simp add: SUP_eq_iff assms(3))
   ultimately have Sup_bdd: \<open>\<bar>Sup (ereal ` S)\<bar> \<noteq> \<infinity>\<close>
     by auto
   then have \<open>\<exists>x'\<in>ereal ` S. Sup (ereal ` S) - ereal e < x'\<close>
     apply (rule_tac Sup_ereal_close)
     using assms by auto
   then obtain x where \<open>x \<in> S\<close> and Sup_x: \<open>Sup (ereal ` S) - ereal e < ereal x\<close>
     by auto
   have \<open>Sup (ereal ` S) = ereal (Sup S)\<close>
     using Sup_bdd by (rule ereal_Sup[symmetric])
   with Sup_x have \<open>ereal (Sup S - e) < ereal x\<close>
     by auto
   then have \<open>Sup S - e < x\<close>
     by auto
   with \<open>x \<in> S\<close> show ?thesis
     by auto
 qed
 
 text \<open>Improved version of @{attribute internalize_sort}: It is not necessary to specify the sort of the type variable.\<close>
 attribute_setup internalize_sort' = \<open>let
 fun find_tvar thm v = let
   val tvars = Term.add_tvars (Thm.prop_of thm) []
   val tv = case find_first (fn (n,sort) => n=v) tvars of
               SOME tv => tv | NONE => raise THM ("Type variable " ^ string_of_indexname v ^ " not found", 0, [thm])
 in 
 TVar tv
 end
 
 fun internalize_sort_attr (tvar:indexname) =
   Thm.rule_attribute [] (fn context => fn thm =>
     (snd (Internalize_Sort.internalize_sort (Thm.ctyp_of (Context.proof_of context) (find_tvar thm tvar)) thm)));
 in
   Scan.lift Args.var >> internalize_sort_attr
 end\<close>
   "internalize a sort"
 
 subsection \<open>Not singleton\<close>
 
 class not_singleton =
   assumes not_singleton_card: "\<exists>x y. x \<noteq> y"
 
 lemma not_singleton_existence[simp]:
   \<open>\<exists> x::('a::not_singleton). x \<noteq> t\<close>
   using not_singleton_card[where ?'a = 'a] by (metis (full_types))
 
 lemma UNIV_not_singleton[simp]: "(UNIV::_::not_singleton set) \<noteq> {x}"
   using not_singleton_existence[of x] by blast
 
 lemma UNIV_not_singleton_converse: 
   assumes"\<And>x::'a. UNIV \<noteq> {x}"
   shows "\<exists>x::'a. \<exists>y. x \<noteq> y"
   using assms
   by fastforce 
 
 subclass (in card2) not_singleton
   apply standard using two_le_card
   by (meson card_2_iff' obtain_subset_with_card_n)
 
 subclass (in perfect_space) not_singleton
   apply intro_classes
   by (metis (mono_tags) Collect_cong Collect_mem_eq UNIV_I local.UNIV_not_singleton local.not_open_singleton local.open_subopen)
 
 lemma class_not_singletonI_monoid_add:
   assumes "(UNIV::'a set) \<noteq> {0}"
   shows "class.not_singleton TYPE('a::monoid_add)"
 proof intro_classes
   let ?univ = "UNIV :: 'a set"
   from assms obtain x::'a where "x \<noteq> 0"
     by auto
   thus "\<exists>x y :: 'a. x \<noteq> y"
     by auto
 qed
 
 lemma not_singleton_vs_CARD_1:
   assumes \<open>\<not> class.not_singleton TYPE('a)\<close>
   shows \<open>class.CARD_1 TYPE('a)\<close>
   using assms unfolding class.not_singleton_def class.CARD_1_def
   by (metis (full_types) One_nat_def UNIV_I card.empty card.insert empty_iff equalityI finite.intros(1) insert_iff subsetI)
 
 subsection \<open>\<^class>\<open>CARD_1\<close>\<close>
 
 context CARD_1 begin
 
 lemma everything_the_same[simp]: "(x::'a)=y"
   by (metis (full_types) UNIV_I card_1_singletonE empty_iff insert_iff local.CARD_1)
 
 lemma CARD_1_UNIV: "UNIV = {x::'a}"
   by (metis (full_types) UNIV_I card_1_singletonE local.CARD_1 singletonD)
 
 lemma CARD_1_ext: "x (a::'a) = y b \<Longrightarrow> x = y"
 proof (rule ext)
   show "x t = y t"
     if "x a = y b"
     for t :: 'a
     using that  apply (subst (asm) everything_the_same[where x=a])
     apply (subst (asm) everything_the_same[where x=b])
     by simp
 qed 
 
 end
 
 instance unit :: CARD_1
   apply standard by auto
 
 instance prod :: (CARD_1, CARD_1) CARD_1
   apply intro_classes
   by (simp add: CARD_1)
 
 instance "fun" :: (CARD_1, CARD_1) CARD_1
   apply intro_classes
   by (auto simp add: card_fun CARD_1)
 
 
 lemma enum_CARD_1: "(Enum.enum :: 'a::{CARD_1,enum} list) = [a]"
 proof -
   let ?enum = "Enum.enum :: 'a::{CARD_1,enum} list"
   have "length ?enum = 1"
     apply (subst card_UNIV_length_enum[symmetric])
     by (rule CARD_1)
   then obtain b where "?enum = [b]"
     apply atomize_elim
     apply (cases ?enum, auto)
     by (metis length_0_conv length_Cons nat.inject)
   thus "?enum = [a]"
     by (subst everything_the_same[of _ b], simp)
 qed
 
 
 
 subsection \<open>Topology\<close>
 
 lemma cauchy_filter_metricI:
   fixes F :: "'a::metric_space filter"
   assumes "\<And>e. e>0 \<Longrightarrow> \<exists>P. eventually P F \<and> (\<forall>x y. P x \<and> P y \<longrightarrow> dist x y < e)"
   shows "cauchy_filter F"
 proof (unfold cauchy_filter_def le_filter_def, auto)
   fix P :: "'a \<times> 'a \<Rightarrow> bool"
   assume "eventually P uniformity"
   then obtain e where e: "e > 0" and P: "dist x y < e \<Longrightarrow> P (x, y)" for x y
     unfolding eventually_uniformity_metric by auto
 
   obtain P' where evP': "eventually P' F" and P'_dist: "P' x \<and> P' y \<Longrightarrow> dist x y < e" for x y
     apply atomize_elim using assms e by auto
 
   from evP' P'_dist P
   show "eventually P (F \<times>\<^sub>F F)"
     unfolding eventually_uniformity_metric eventually_prod_filter eventually_filtermap by metis
 qed
 
 lemma cauchy_filter_metric_filtermapI:
   fixes F :: "'a filter" and f :: "'a\<Rightarrow>'b::metric_space"
   assumes "\<And>e. e>0 \<Longrightarrow> \<exists>P. eventually P F \<and> (\<forall>x y. P x \<and> P y \<longrightarrow> dist (f x) (f y) < e)"
   shows "cauchy_filter (filtermap f F)"
 proof (rule cauchy_filter_metricI)
   fix e :: real assume e: "e > 0"
   with assms obtain P where evP: "eventually P F" and dist: "P x \<and> P y \<Longrightarrow> dist (f x) (f y) < e" for x y
     by atomize_elim auto
   define P' where "P' y = (\<exists>x. P x \<and> y = f x)" for y
   have "eventually P' (filtermap f F)"
     unfolding eventually_filtermap P'_def 
     using evP
     by (smt eventually_mono) 
   moreover have "P' x \<and> P' y \<longrightarrow> dist x y < e" for x y
     unfolding P'_def using dist by metis
   ultimately show "\<exists>P. eventually P (filtermap f F) \<and> (\<forall>x y. P x \<and> P y \<longrightarrow> dist x y < e)"
     by auto
 qed
 
 
 lemma tendsto_add_const_iff:
   \<comment> \<open>This is a generalization of \<open>Limits.tendsto_add_const_iff\<close>, 
       the only difference is that the sort here is more general.\<close>
   "((\<lambda>x. c + f x :: 'a::topological_group_add) \<longlongrightarrow> c + d) F \<longleftrightarrow> (f \<longlongrightarrow> d) F"
   using tendsto_add[OF tendsto_const[of c], of f d]
     and tendsto_add[OF tendsto_const[of "-c"], of "\<lambda>x. c + f x" "c + d"] by auto
 
 lemma finite_subsets_at_top_minus: 
   assumes "A\<subseteq>B"
   shows "finite_subsets_at_top (B - A) \<le> filtermap (\<lambda>F. F - A) (finite_subsets_at_top B)"
 proof (rule filter_leI)
   fix P assume "eventually P (filtermap (\<lambda>F. F - A) (finite_subsets_at_top B))"
   then obtain X where "finite X" and "X \<subseteq> B" 
     and P: "finite Y \<and> X \<subseteq> Y \<and> Y \<subseteq> B \<longrightarrow> P (Y - A)" for Y
     unfolding eventually_filtermap eventually_finite_subsets_at_top by auto
 
   hence "finite (X-A)" and "X-A \<subseteq> B - A"
     by auto
   moreover have "finite Y \<and> X-A \<subseteq> Y \<and> Y \<subseteq> B - A \<longrightarrow> P Y" for Y
     using P[where Y="Y\<union>X"] \<open>finite X\<close> \<open>X \<subseteq> B\<close>
     by (metis Diff_subset Int_Diff Un_Diff finite_Un inf.orderE le_sup_iff sup.orderE sup_ge2)
   ultimately show "eventually P (finite_subsets_at_top (B - A))"
     unfolding eventually_finite_subsets_at_top by meson
 qed
 
 
 lemma finite_subsets_at_top_inter: 
   assumes "A\<subseteq>B"
   shows "filtermap (\<lambda>F. F \<inter> A) (finite_subsets_at_top B) \<le> finite_subsets_at_top A"
 proof (rule filter_leI)
   show "eventually P (filtermap (\<lambda>F. F \<inter> A) (finite_subsets_at_top B))"
     if "eventually P (finite_subsets_at_top A)"
     for P :: "'a set \<Rightarrow> bool"
     using that unfolding eventually_filtermap
     unfolding eventually_finite_subsets_at_top
     by (metis Int_subset_iff assms finite_Int inf_le2 subset_trans)
 qed
 
 
 lemma tendsto_principal_singleton:
   shows "(f \<longlongrightarrow> f x) (principal {x})"
   unfolding tendsto_def eventually_principal by simp
 
 lemma complete_singleton: 
   "complete {s::'a::uniform_space}"
 proof-
   have "F \<le> principal {s} \<Longrightarrow>
          F \<noteq> bot \<Longrightarrow> cauchy_filter F \<Longrightarrow> F \<le> nhds s" for F
     by (metis eventually_nhds eventually_principal le_filter_def singletonD)
   thus ?thesis
     unfolding complete_uniform
     by simp
 qed
 
 subsection \<open>Complex numbers\<close>
 
 lemma cmod_Re:
   assumes "x \<ge> 0"
   shows "cmod x = Re x"
   using assms unfolding less_eq_complex_def cmod_def
   by auto
 
 lemma abs_complex_real[simp]: "abs x \<in> \<real>" for x :: complex
   by (simp add: abs_complex_def)
 
 lemma Im_abs[simp]: "Im (abs x) = 0"
   using abs_complex_real complex_is_Real_iff by blast
 
 
 lemma cnj_x_x: "cnj x * x = (abs x)\<^sup>2"
 proof (cases x)
   show "cnj x * x = \<bar>x\<bar>\<^sup>2"
     if "x = Complex x1 x2"
     for x1 :: real
       and x2 :: real
     using that   by (auto simp: complex_cnj complex_mult abs_complex_def 
         complex_norm power2_eq_square complex_of_real_def)
 qed
 
 lemma cnj_x_x_geq0[simp]: "cnj x * x \<ge> 0"
 proof (cases x)
   show "0 \<le> cnj x * x"
     if "x = Complex x1 x2"
     for x1 :: real
       and x2 :: real
-    using that by (auto simp: complex_cnj complex_mult complex_of_real_def)
+    using that by (auto simp: complex_cnj complex_mult complex_of_real_def less_eq_complex_def)
 qed
 
 
 subsection \<open>List indices and enum\<close>
 
 
 fun index_of where
   "index_of x [] = (0::nat)"
 | "index_of x (y#ys) = (if x=y then 0 else (index_of x ys + 1))"
 
 definition "enum_idx (x::'a::enum) = index_of x (enum_class.enum :: 'a list)"
 
 lemma index_of_length: "index_of x y \<le> length y"
   apply (induction y) by auto
 
 lemma index_of_correct:
   assumes "x \<in> set y"
   shows "y ! index_of x y = x"
   using assms apply (induction y arbitrary: x)
   by auto
 
 lemma enum_idx_correct: 
   "Enum.enum ! enum_idx i = i"
 proof-
   have "i \<in> set enum_class.enum"
     using UNIV_enum by blast 
   thus ?thesis
     unfolding enum_idx_def
     using index_of_correct by metis
 qed
 
 lemma index_of_bound: 
   assumes "y \<noteq> []" and "x \<in> set y"
   shows "index_of x y < length y"
   using assms proof(induction y arbitrary: x)
   case Nil
   thus ?case by auto
 next
   case (Cons a y)
   show ?case 
   proof(cases "a = x")
     case True
     thus ?thesis by auto
   next
     case False
     moreover have "a \<noteq> x \<Longrightarrow> index_of x y < length y"
       using Cons.IH Cons.prems(2) by fastforce      
     ultimately show ?thesis by auto
   qed
 qed
 
 lemma enum_idx_bound: "enum_idx x < length (Enum.enum :: 'a list)" for x :: "'a::enum"
 proof-
   have p1: "False"
     if "(Enum.enum :: 'a list) = []"
   proof-
     have "(UNIV::'a set) = set ([]::'a list)"
       using that UNIV_enum by metis
     also have "\<dots> = {}"
       by blast
     finally have "(UNIV::'a set) = {}".
     thus ?thesis by simp
   qed    
   have p2: "x \<in> set (Enum.enum :: 'a list)"
     using UNIV_enum by auto
   moreover have "(enum_class.enum::'a list) \<noteq> []"
     using p2 by auto
   ultimately show ?thesis
     unfolding enum_idx_def     
     using index_of_bound [where x = x and y = "(Enum.enum :: 'a list)"]
     by auto   
 qed
 
 lemma index_of_nth:
   assumes "distinct xs"
   assumes "i < length xs"
   shows "index_of (xs ! i) xs = i"
   using assms
   by (metis gr_implies_not_zero index_of_bound index_of_correct length_0_conv nth_eq_iff_index_eq nth_mem)
 
 lemma enum_idx_enum: 
   assumes \<open>i < CARD('a::enum)\<close>
   shows \<open>enum_idx (enum_class.enum ! i :: 'a) = i\<close>
   unfolding enum_idx_def apply (rule index_of_nth)
   using assms by (simp_all add: card_UNIV_length_enum enum_distinct)
 
 subsection \<open>Filtering lists/sets\<close>
 
 lemma map_filter_map: "List.map_filter f (map g l) = List.map_filter (f o g) l"
 proof (induction l)
   show "List.map_filter f (map g []) = List.map_filter (f \<circ> g) []"
     by (simp add: map_filter_simps)
   show "List.map_filter f (map g (a # l)) = List.map_filter (f \<circ> g) (a # l)"
     if "List.map_filter f (map g l) = List.map_filter (f \<circ> g) l"
     for a :: 'c
       and l :: "'c list"
     using that  map_filter_simps(1)
     by (metis comp_eq_dest_lhs list.simps(9))
 qed
 
 lemma map_filter_Some[simp]: "List.map_filter (\<lambda>x. Some (f x)) l = map f l"
 proof (induction l)
   show "List.map_filter (\<lambda>x. Some (f x)) [] = map f []"
     by (simp add: map_filter_simps)
   show "List.map_filter (\<lambda>x. Some (f x)) (a # l) = map f (a # l)"
     if "List.map_filter (\<lambda>x. Some (f x)) l = map f l"
     for a :: 'b
       and l :: "'b list"
     using that by (simp add: map_filter_simps(1))
 qed
 
 lemma filter_Un: "Set.filter f (x \<union> y) = Set.filter f x \<union> Set.filter f y"
   unfolding Set.filter_def by auto  
 
 lemma Set_filter_unchanged: "Set.filter P X = X" if "\<And>x. x\<in>X \<Longrightarrow> P x" for P and X :: "'z set"
   using that unfolding Set.filter_def by auto
 
 subsection \<open>Maps\<close>
 
 definition "inj_map \<pi> = (\<forall>x y. \<pi> x = \<pi> y \<and> \<pi> x \<noteq> None \<longrightarrow> x = y)"
 
 definition "inv_map \<pi> = (\<lambda>y. if Some y \<in> range \<pi> then Some (inv \<pi> (Some y)) else None)"
 
 lemma inj_map_total[simp]: "inj_map (Some o \<pi>) = inj \<pi>"
   unfolding inj_map_def inj_def by simp
 
 lemma inj_map_Some[simp]: "inj_map Some"
   by (simp add: inj_map_def)
 
 lemma inv_map_total: 
   assumes "surj \<pi>"
   shows "inv_map (Some o \<pi>) = Some o inv \<pi>"
 proof-
   have "(if Some y \<in> range (\<lambda>x. Some (\<pi> x))
           then Some (SOME x. Some (\<pi> x) = Some y)
           else None) =
          Some (SOME b. \<pi> b = y)"
     if "surj \<pi>"
     for y
     using that by auto
   hence  "surj \<pi> \<Longrightarrow>
     (\<lambda>y. if Some y \<in> range (\<lambda>x. Some (\<pi> x))
          then Some (SOME x. Some (\<pi> x) = Some y) else None) =
     (\<lambda>x. Some (SOME xa. \<pi> xa = x))"
     by (rule ext) 
   thus ?thesis 
     unfolding inv_map_def o_def inv_def
     using assms by linarith
 qed
 
 lemma inj_map_map_comp[simp]: 
   assumes a1: "inj_map f" and a2: "inj_map g" 
   shows "inj_map (f \<circ>\<^sub>m g)"
   using a1 a2
   unfolding inj_map_def
   by (metis (mono_tags, lifting) map_comp_def option.case_eq_if option.expand)
 
 lemma inj_map_inv_map[simp]: "inj_map (inv_map \<pi>)"
 proof (unfold inj_map_def, rule allI, rule allI, rule impI, erule conjE)
   fix x y
   assume same: "inv_map \<pi> x = inv_map \<pi> y"
     and pix_not_None: "inv_map \<pi> x \<noteq> None"
   have x_pi: "Some x \<in> range \<pi>" 
     using pix_not_None unfolding inv_map_def apply auto
     by (meson option.distinct(1))
   have y_pi: "Some y \<in> range \<pi>" 
     using pix_not_None unfolding same unfolding inv_map_def apply auto
     by (meson option.distinct(1))
   have "inv_map \<pi> x = Some (Hilbert_Choice.inv \<pi> (Some x))"
     unfolding inv_map_def using x_pi by simp
   moreover have "inv_map \<pi> y = Some (Hilbert_Choice.inv \<pi> (Some y))"
     unfolding inv_map_def using y_pi by simp
   ultimately have "Hilbert_Choice.inv \<pi> (Some x) = Hilbert_Choice.inv \<pi> (Some y)"
     using same by simp
   thus "x = y"
     by (meson inv_into_injective option.inject x_pi y_pi)
 qed
 
 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,432 +1,432 @@
 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 by auto
+  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>,
   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 
       unfolding corthogonal_def T_def
       apply auto
       using T_def that(2) apply auto[1]
       using T_def that(1) that(2) 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(1) that(2) 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)
 
 
 
 unbundle no_jnf_notation
 
 
 end
diff --git a/thys/Complex_Bounded_Operators/extra/Extra_Ordered_Fields.thy b/thys/Complex_Bounded_Operators/extra/Extra_Ordered_Fields.thy
--- a/thys/Complex_Bounded_Operators/extra/Extra_Ordered_Fields.thy
+++ b/thys/Complex_Bounded_Operators/extra/Extra_Ordered_Fields.thy
@@ -1,958 +1,953 @@
 section \<open>\<open>Extra_Ordered_Fields\<close> -- Additional facts about ordered fields\<close>
 
 theory Extra_Ordered_Fields
   imports Complex_Main
     Jordan_Normal_Form.Conjugate (* Defines ordering for complex. We have to use theirs, otherwise there will be conflicts *)
 begin
 
 
 subsection\<open>Ordered Fields\<close>
 text \<open>In this section we introduce some type classes for ordered rings/fields/etc.
 that are weakenings of existing classes. Most theorems in this section are
 copies of the eponymous theorems from Isabelle/HOL, except that they are now proven
 requiring weaker type classes (usually the need for a total order is removed).
 
 Since the lemmas are identical to the originals except for weaker type constraints,
 we use the same names as for the original lemmas. (In fact, the new lemmas could replace
 the original ones in Isabelle/HOL with at most minor incompatibilities.\<close>
 
 subsection \<open>Missing from Orderings.thy\<close>
 
 text \<open>This class is analogous to \<^class>\<open>unbounded_dense_linorder\<close>, except that it does not require a total order\<close>
 
 class unbounded_dense_order = dense_order + no_top + no_bot
 
 instance unbounded_dense_linorder \<subseteq> unbounded_dense_order ..
 
 subsection \<open>Missing from Rings.thy\<close>
 
 text \<open>The existing class \<^class>\<open>abs_if\<close> requires \<^term>\<open>\<bar>a\<bar> = (if a < 0 then - a else a)\<close>.
 However, if \<^term>\<open>(<)\<close> is not a total order, this condition is too strong when \<^term>\<open>a\<close>
 is incomparable with \<^term>\<open>0\<close>. (Namely, it requires the absolute value to be
 the identity on such elements. E.g., the absolute value for complex numbers does not
 satisfy this.) The following class \<open>partial_abs_if\<close> is analogous to \<^class>\<open>abs_if\<close>
 but does not require anything if \<^term>\<open>a\<close> is incomparable with \<^term>\<open>0\<close>.\<close>
 
 
 class partial_abs_if = minus + uminus + ord + zero + abs +
   assumes abs_neg: "a \<le> 0 \<Longrightarrow> abs a = -a"
   assumes abs_pos: "a \<ge> 0 \<Longrightarrow> abs a = a"
 
 class ordered_semiring_1 = ordered_semiring + semiring_1
   \<comment> \<open>missing class analogous to \<^class>\<open>linordered_semiring_1\<close> without requiring a total order\<close>
 begin
 
 lemma convex_bound_le:
   assumes "x \<le> a" and "y \<le> a" and "0 \<le> u" and "0 \<le> v" and "u + v = 1"
   shows "u * x + v * y \<le> a"
 proof-
   from assms have "u * x + v * y \<le> u * a + v * a"
     by (simp add: add_mono mult_left_mono)
   with assms show ?thesis
     unfolding distrib_right[symmetric] by simp
 qed
 
 end
 
 subclass (in linordered_semiring_1) ordered_semiring_1 ..
 
 class ordered_semiring_strict = semiring + comm_monoid_add + ordered_cancel_ab_semigroup_add +
   \<comment> \<open>missing class analogous to \<^class>\<open>linordered_semiring_strict\<close> without requiring a total order\<close>
   assumes mult_strict_left_mono: "a < b \<Longrightarrow> 0 < c \<Longrightarrow> c * a < c * b"
   assumes mult_strict_right_mono: "a < b \<Longrightarrow> 0 < c \<Longrightarrow> a * c < b * c"
 begin
 
 subclass semiring_0_cancel ..
 
 subclass ordered_semiring
 proof
   fix a b c :: 'a
   assume t1: "a \<le> b" and t2: "0 \<le> c"
   thus "c * a \<le> c * b"
     unfolding le_less
     using mult_strict_left_mono by (cases "c = 0") auto
   from t2 show "a * c \<le> b * c"
     unfolding le_less
     by (metis local.antisym_conv2 local.mult_not_zero local.mult_strict_right_mono t1)
 qed
 
 lemma mult_pos_pos[simp]: "0 < a \<Longrightarrow> 0 < b \<Longrightarrow> 0 < a * b"
   using mult_strict_left_mono [of 0 b a] by simp
 
 lemma mult_pos_neg: "0 < a \<Longrightarrow> b < 0 \<Longrightarrow> a * b < 0"
   using mult_strict_left_mono [of b 0 a] by simp
 
 lemma mult_neg_pos: "a < 0 \<Longrightarrow> 0 < b \<Longrightarrow> a * b < 0"
   using mult_strict_right_mono [of a 0 b] by simp
 
 text \<open>Strict monotonicity in both arguments\<close>
 lemma mult_strict_mono:
   assumes t1: "a < b" and t2: "c < d" and t3: "0 < b" and t4: "0 \<le> c"
   shows "a * c < b * d"
 proof-
   have "a * c < b * d"
     by (metis local.dual_order.order_iff_strict local.dual_order.strict_trans2
         local.mult_strict_left_mono local.mult_strict_right_mono local.mult_zero_right t1 t2 t3 t4)
   thus ?thesis
     using assms by blast
 qed
 
 
 text \<open>This weaker variant has more natural premises\<close>
 lemma mult_strict_mono':
   assumes "a < b" and "c < d" and "0 \<le> a" and "0 \<le> c"
   shows "a * c < b * d"
   by (rule mult_strict_mono) (insert assms, auto)
 
 lemma mult_less_le_imp_less:
   assumes t1: "a < b" and t2: "c \<le> d" and t3: "0 \<le> a" and t4: "0 < c"
   shows "a * c < b * d"
   using local.mult_strict_mono' local.mult_strict_right_mono local.order.order_iff_strict
     t1 t2 t3 t4 by auto
 
 lemma mult_le_less_imp_less:
   assumes "a \<le> b" and "c < d" and "0 < a" and "0 \<le> c"
   shows "a * c < b * d"
   by (metis assms(1) assms(2) assms(3) assms(4) local.antisym_conv2 local.dual_order.strict_trans1
       local.mult_strict_left_mono local.mult_strict_mono)
 
 end
 
 subclass (in linordered_semiring_strict) ordered_semiring_strict
 proof
   show "c * a < c * b"
     if "a < b"
       and "0 < c"
     for a :: 'a
       and b
       and c
     using that
     by (simp add: local.mult_strict_left_mono)
   show "a * c < b * c"
     if "a < b"
       and "0 < c"
     for a :: 'a
       and b
       and c
     using that
     by (simp add: local.mult_strict_right_mono)
 qed
 
 class ordered_semiring_1_strict = ordered_semiring_strict + semiring_1
   \<comment> \<open>missing class analogous to \<^class>\<open>linordered_semiring_1_strict\<close> without requiring
   a total order\<close>
 begin
 
 subclass ordered_semiring_1 ..
 
 lemma convex_bound_lt:
   assumes "x < a" and "y < a" and "0 \<le> u" and "0 \<le> v" and "u + v = 1"
   shows "u * x + v * y < a"
 proof -
   from assms have "u * x + v * y < u * a + v * a"
     by (cases "u = 0") (auto intro!: add_less_le_mono mult_strict_left_mono mult_left_mono)
   with assms show ?thesis
     unfolding distrib_right[symmetric] by simp
 qed
 
 end
 
 subclass (in linordered_semiring_1_strict) ordered_semiring_1_strict ..
 
 class ordered_comm_semiring_strict = comm_semiring_0 + ordered_cancel_ab_semigroup_add +
   \<comment> \<open>missing class analogous to \<^class>\<open>linordered_comm_semiring_strict\<close> without requiring a total order\<close>
   assumes comm_mult_strict_left_mono: "a < b \<Longrightarrow> 0 < c \<Longrightarrow> c * a < c * b"
 begin
 
 subclass ordered_semiring_strict
 proof
   fix a b c :: 'a
   assume "a < b" and "0 < c"
   thus "c * a < c * b"
     by (rule comm_mult_strict_left_mono)
   thus "a * c < b * c"
     by (simp only: mult.commute)
 qed
 
 subclass ordered_cancel_comm_semiring
 proof
   fix a b c :: 'a
   assume "a \<le> b" and "0 \<le> c"
   thus "c * a \<le> c * b"
     unfolding le_less
     using mult_strict_left_mono by (cases "c = 0") auto
 qed
 
 end
 
 subclass (in linordered_comm_semiring_strict) ordered_comm_semiring_strict
   apply standard
   by (simp add: local.mult_strict_left_mono)
 
 class ordered_ring_strict = ring + ordered_semiring_strict
   + ordered_ab_group_add + partial_abs_if
   \<comment> \<open>missing class analogous to \<^class>\<open>linordered_ring_strict\<close> without requiring a total order\<close>
 begin
 
 subclass ordered_ring ..
 
 lemma mult_strict_left_mono_neg: "b < a \<Longrightarrow> c < 0 \<Longrightarrow> c * a < c * b"
   using mult_strict_left_mono [of b a "- c"] by simp
 
 lemma mult_strict_right_mono_neg: "b < a \<Longrightarrow> c < 0 \<Longrightarrow> a * c < b * c"
   using mult_strict_right_mono [of b a "- c"] by simp
 
 lemma mult_neg_neg: "a < 0 \<Longrightarrow> b < 0 \<Longrightarrow> 0 < a * b"
   using mult_strict_right_mono_neg [of a 0 b] by simp
 
 end
 
 lemmas mult_sign_intros =
   mult_nonneg_nonneg mult_nonneg_nonpos
   mult_nonpos_nonneg mult_nonpos_nonpos
   mult_pos_pos mult_pos_neg
   mult_neg_pos mult_neg_neg
 
 
 subsection \<open>Ordered fields\<close>
 
 class ordered_field = field + order + ordered_comm_semiring_strict + ordered_ab_group_add
   + partial_abs_if
   \<comment> \<open>missing class analogous to \<^class>\<open>linordered_field\<close> without requiring a total order\<close>
 begin
 
 lemma frac_less_eq:
   "y \<noteq> 0 \<Longrightarrow> z \<noteq> 0 \<Longrightarrow> x / y < w / z \<longleftrightarrow> (x * z - w * y) / (y * z) < 0"
   by (subst less_iff_diff_less_0) (simp add: diff_frac_eq )
 
 lemma frac_le_eq:
   "y \<noteq> 0 \<Longrightarrow> z \<noteq> 0 \<Longrightarrow> x / y \<le> w / z \<longleftrightarrow> (x * z - w * y) / (y * z) \<le> 0"
   by (subst le_iff_diff_le_0) (simp add: diff_frac_eq )
 
 lemmas sign_simps = algebra_simps zero_less_mult_iff mult_less_0_iff
 
 lemmas (in -) sign_simps = algebra_simps zero_less_mult_iff mult_less_0_iff
 
 text\<open>Simplify expressions equated with 1\<close>
 
 lemma zero_eq_1_divide_iff [simp]: "0 = 1 / a \<longleftrightarrow> a = 0"
   by (cases "a = 0") (auto simp: field_simps)
 
 lemma one_divide_eq_0_iff [simp]: "1 / a = 0 \<longleftrightarrow> a = 0"
   using zero_eq_1_divide_iff[of a] by simp
 
 text\<open>Simplify expressions such as \<open>0 < 1/x\<close> to \<open>0 < x\<close>\<close>
 
 text\<open>Simplify quotients that are compared with the value 1.\<close>
 
 text \<open>Conditional Simplification Rules: No Case Splits\<close>
 
 lemma eq_divide_eq_1 [simp]:
   "(1 = b/a) = ((a \<noteq> 0 & a = b))"
   by (auto simp add: eq_divide_eq)
 
 lemma divide_eq_eq_1 [simp]:
   "(b/a = 1) = ((a \<noteq> 0 & a = b))"
   by (auto simp add: divide_eq_eq)
 
 end (* class ordered_field *)
 
 
 text \<open>The following type class intends to capture some important properties
   that are common both to the real and the complex numbers. The purpose is
   to be able to state and prove lemmas that apply both to the real and the complex
   numbers without needing to state the lemma twice.
 \<close>
 
 class nice_ordered_field = ordered_field + zero_less_one + idom_abs_sgn +
   assumes positive_imp_inverse_positive: "0 < a \<Longrightarrow> 0 < inverse a"
     and inverse_le_imp_le: "inverse a \<le> inverse b \<Longrightarrow> 0 < a \<Longrightarrow> b \<le> a"
     and dense_le: "(\<And>x. x < y \<Longrightarrow> x \<le> z) \<Longrightarrow> y \<le> z"
     and nn_comparable: "0 \<le> a \<Longrightarrow> 0 \<le> b \<Longrightarrow> a \<le> b \<or> b \<le> a"
     and abs_nn: "\<bar>x\<bar> \<ge> 0"
 begin
 
 subclass (in linordered_field) nice_ordered_field
 proof
   show "\<bar>a\<bar> = - a"
     if "a \<le> 0"
     for a :: 'a
     using that
     by simp
   show "\<bar>a\<bar> = a"
     if "0 \<le> a"
     for a :: 'a
     using that
     by simp
   show "0 < inverse a"
     if "0 < a"
     for a :: 'a
     using that
     by simp
   show "b \<le> a"
     if "inverse a \<le> inverse b"
       and "0 < a"
     for a :: 'a
       and b
     using that
     using local.inverse_le_imp_le by blast
   show "y \<le> z"
     if "\<And>x::'a. x < y \<Longrightarrow> x \<le> z"
     for y
       and z
     using that
     using local.dense_le by blast
   show "a \<le> b \<or> b \<le> a"
     if "0 \<le> a"
       and "0 \<le> b"
     for a :: 'a
       and b
     using that
     by auto
   show "0 \<le> \<bar>x\<bar>"
     for x :: 'a
     by simp
 qed
 
 lemma comparable:
   assumes h1: "a \<le> c \<or> a \<ge> c"
     and h2: "b \<le> c \<or> b \<ge> c"
   shows "a \<le> b \<or> b \<le> a"
 proof-
   have "a \<le> b"
     if t1: "\<not> b \<le> a" and t2: "a \<le> c" and t3: "b \<le> c"
   proof-
     have "0 \<le> c-a"
       by (simp add: t2)
     moreover have "0 \<le> c-b"
       by (simp add: t3)
     ultimately have "c-a \<le> c-b \<or> c-a \<ge> c-b" by (rule nn_comparable)
     hence "-a \<le> -b \<or> -a \<ge> -b"
       using local.add_le_imp_le_right local.uminus_add_conv_diff by presburger
     thus ?thesis
       by (simp add: t1)
   qed
   moreover have "a \<le> b"
     if t1: "\<not> b \<le> a" and t2: "c \<le> a" and t3: "b \<le> c"
   proof-
     have "b \<le> a"
       using local.dual_order.trans t2 t3 by blast
     thus ?thesis
       using t1 by auto
   qed
   moreover have "a \<le> b"
     if t1: "\<not> b \<le> a" and t2: "c \<le> a" and t3: "c \<le> b"
   proof-
     have "0 \<le> a-c"
       by (simp add: t2)
     moreover have "0 \<le> b-c"
       by (simp add: t3)
     ultimately have "a-c \<le> b-c \<or> a-c \<ge> b-c" by (rule nn_comparable)
     hence "a \<le> b \<or> a \<ge> b"
       by (simp add: local.le_diff_eq)
     thus ?thesis
       by (simp add: t1)
   qed
   ultimately show ?thesis using assms by auto
 qed
 
 lemma negative_imp_inverse_negative:
   "a < 0 \<Longrightarrow> inverse a < 0"
   by (insert positive_imp_inverse_positive [of "-a"],
       simp add: nonzero_inverse_minus_eq less_imp_not_eq)
 
 lemma inverse_positive_imp_positive:
   assumes inv_gt_0: "0 < inverse a" and nz: "a \<noteq> 0"
   shows "0 < a"
 proof -
   have "0 < inverse (inverse a)"
     using inv_gt_0 by (rule positive_imp_inverse_positive)
   thus "0 < a"
     using nz by (simp add: nonzero_inverse_inverse_eq)
 qed
 
 lemma inverse_negative_imp_negative:
   assumes inv_less_0: "inverse a < 0" and nz: "a \<noteq> 0"
   shows "a < 0"
 proof-
   have "inverse (inverse a) < 0"
     using inv_less_0 by (rule negative_imp_inverse_negative)
   thus "a < 0" using nz by (simp add: nonzero_inverse_inverse_eq)
 qed
 
 lemma linordered_field_no_lb:
   "\<forall>x. \<exists>y. y < x"
 proof
   fix x::'a
   have m1: "- (1::'a) < 0" by simp
   from add_strict_right_mono[OF m1, where c=x]
   have "(- 1) + x < x" by simp
   thus "\<exists>y. y < x" by blast
 qed
 
 lemma linordered_field_no_ub:
   "\<forall>x. \<exists>y. y > x"
 proof
   fix x::'a
   have m1: " (1::'a) > 0" by simp
   from add_strict_right_mono[OF m1, where c=x]
   have "1 + x > x" by simp
   thus "\<exists>y. y > x" by blast
 qed
 
 lemma less_imp_inverse_less:
   assumes less: "a < b" and apos:  "0 < a"
   shows "inverse b < inverse a"
   using assms by (metis local.dual_order.strict_iff_order
       local.inverse_inverse_eq local.inverse_le_imp_le local.positive_imp_inverse_positive)
 
 lemma inverse_less_imp_less:
   "inverse a < inverse b \<Longrightarrow> 0 < a \<Longrightarrow> b < a"
   using local.inverse_le_imp_le local.order.strict_iff_order by blast
 
 text\<open>Both premises are essential. Consider -1 and 1.\<close>
 lemma inverse_less_iff_less [simp]:
   "0 < a \<Longrightarrow> 0 < b \<Longrightarrow> inverse a < inverse b \<longleftrightarrow> b < a"
   by (blast intro: less_imp_inverse_less dest: inverse_less_imp_less)
 
 lemma le_imp_inverse_le:
   "a \<le> b \<Longrightarrow> 0 < a \<Longrightarrow> inverse b \<le> inverse a"
   by (force simp add: le_less less_imp_inverse_less)
 
 lemma inverse_le_iff_le [simp]:
   "0 < a \<Longrightarrow> 0 < b \<Longrightarrow> inverse a \<le> inverse b \<longleftrightarrow> b \<le> a"
   by (blast intro: le_imp_inverse_le dest: inverse_le_imp_le)
 
 
 text\<open>These results refer to both operands being negative.  The opposite-sign
 case is trivial, since inverse preserves signs.\<close>
 lemma inverse_le_imp_le_neg:
   "inverse a \<le> inverse b \<Longrightarrow> b < 0 \<Longrightarrow> b \<le> a"
   by (metis local.inverse_le_imp_le local.inverse_minus_eq local.neg_0_less_iff_less
       local.neg_le_iff_le)
 
 lemma inverse_less_imp_less_neg:
   "inverse a < inverse b \<Longrightarrow> b < 0 \<Longrightarrow> b < a"
   using local.dual_order.strict_iff_order local.inverse_le_imp_le_neg by blast
 
 lemma inverse_less_iff_less_neg [simp]:
   "a < 0 \<Longrightarrow> b < 0 \<Longrightarrow> inverse a < inverse b \<longleftrightarrow> b < a"
   by (metis local.antisym_conv2 local.inverse_less_imp_less_neg local.negative_imp_inverse_negative
       local.nonzero_inverse_inverse_eq local.order.strict_implies_order)
 
 lemma le_imp_inverse_le_neg:
   "a \<le> b \<Longrightarrow> b < 0 \<Longrightarrow> inverse b \<le> inverse a"
   by (force simp add: le_less less_imp_inverse_less_neg)
 
 lemma inverse_le_iff_le_neg [simp]:
   "a < 0 \<Longrightarrow> b < 0 \<Longrightarrow> inverse a \<le> inverse b \<longleftrightarrow> b \<le> a"
   by (blast intro: le_imp_inverse_le_neg dest: inverse_le_imp_le_neg)
 
 lemma one_less_inverse:
   "0 < a \<Longrightarrow> a < 1 \<Longrightarrow> 1 < inverse a"
   using less_imp_inverse_less [of a 1, unfolded inverse_1] .
 
 lemma one_le_inverse:
   "0 < a \<Longrightarrow> a \<le> 1 \<Longrightarrow> 1 \<le> inverse a"
   using le_imp_inverse_le [of a 1, unfolded inverse_1] .
 
 lemma pos_le_divide_eq [field_simps]:
   assumes "0 < c"
   shows "a \<le> b / c \<longleftrightarrow> a * c \<le> b"
   using assms by (metis local.divide_eq_imp local.divide_inverse_commute
       local.dual_order.order_iff_strict local.dual_order.strict_iff_order
       local.mult_right_mono local.mult_strict_left_mono local.nonzero_divide_eq_eq
       local.order.strict_implies_order local.positive_imp_inverse_positive)
 
 lemma pos_less_divide_eq [field_simps]:
   assumes "0 < c"
   shows "a < b / c \<longleftrightarrow> a * c < b"
   using assms local.dual_order.strict_iff_order local.nonzero_divide_eq_eq local.pos_le_divide_eq
   by auto
 
 lemma neg_less_divide_eq [field_simps]:
   assumes "c < 0"
   shows "a < b / c \<longleftrightarrow> b < a * c"
   by (metis assms local.minus_divide_divide local.mult_minus_right local.neg_0_less_iff_less
       local.neg_less_iff_less local.pos_less_divide_eq)
 
 lemma neg_le_divide_eq [field_simps]:
   assumes "c < 0"
   shows "a \<le> b / c \<longleftrightarrow> b \<le> a * c"
   by (metis assms local.dual_order.order_iff_strict local.dual_order.strict_iff_order
       local.neg_less_divide_eq local.nonzero_divide_eq_eq)
 
 lemma pos_divide_le_eq [field_simps]:
   assumes "0 < c"
   shows "b / c \<le> a \<longleftrightarrow> b \<le> a * c"
   by (metis assms local.dual_order.strict_iff_order local.nonzero_eq_divide_eq
       local.pos_le_divide_eq)
 
 lemma pos_divide_less_eq [field_simps]:
   assumes "0 < c"
   shows "b / c < a \<longleftrightarrow> b < a * c"
   by (metis assms local.minus_divide_left local.mult_minus_left local.neg_less_iff_less
       local.pos_less_divide_eq)
 
 lemma neg_divide_le_eq [field_simps]:
   assumes "c < 0"
   shows "b / c \<le> a \<longleftrightarrow> a * c \<le> b"
   by (metis assms local.minus_divide_left local.mult_minus_left local.neg_le_divide_eq
       local.neg_le_iff_le)
 
 lemma neg_divide_less_eq [field_simps]:
   assumes "c < 0"
   shows "b / c < a \<longleftrightarrow> a * c < b"
   using assms local.dual_order.strict_iff_order local.neg_divide_le_eq by auto
 
 text\<open>The following \<open>field_simps\<close> rules are necessary, as minus is always moved atop of
 division but we want to get rid of division.\<close>
 
 lemma pos_le_minus_divide_eq [field_simps]: "0 < c \<Longrightarrow> a \<le> - (b / c) \<longleftrightarrow> a * c \<le> - b"
   unfolding minus_divide_left by (rule pos_le_divide_eq)
 
 lemma neg_le_minus_divide_eq [field_simps]: "c < 0 \<Longrightarrow> a \<le> - (b / c) \<longleftrightarrow> - b \<le> a * c"
   unfolding minus_divide_left by (rule neg_le_divide_eq)
 
 lemma pos_less_minus_divide_eq [field_simps]: "0 < c \<Longrightarrow> a < - (b / c) \<longleftrightarrow> a * c < - b"
   unfolding minus_divide_left by (rule pos_less_divide_eq)
 
 lemma neg_less_minus_divide_eq [field_simps]: "c < 0 \<Longrightarrow> a < - (b / c) \<longleftrightarrow> - b < a * c"
   unfolding minus_divide_left by (rule neg_less_divide_eq)
 
 lemma pos_minus_divide_less_eq [field_simps]: "0 < c \<Longrightarrow> - (b / c) < a \<longleftrightarrow> - b < a * c"
   unfolding minus_divide_left by (rule pos_divide_less_eq)
 
 lemma neg_minus_divide_less_eq [field_simps]: "c < 0 \<Longrightarrow> - (b / c) < a \<longleftrightarrow> a * c < - b"
   unfolding minus_divide_left by (rule neg_divide_less_eq)
 
 lemma pos_minus_divide_le_eq [field_simps]: "0 < c \<Longrightarrow> - (b / c) \<le> a \<longleftrightarrow> - b \<le> a * c"
   unfolding minus_divide_left by (rule pos_divide_le_eq)
 
 lemma neg_minus_divide_le_eq [field_simps]: "c < 0 \<Longrightarrow> - (b / c) \<le> a \<longleftrightarrow> a * c \<le> - b"
   unfolding minus_divide_left by (rule neg_divide_le_eq)
 
 lemma frac_less_eq:
   "y \<noteq> 0 \<Longrightarrow> z \<noteq> 0 \<Longrightarrow> x / y < w / z \<longleftrightarrow> (x * z - w * y) / (y * z) < 0"
   by (subst less_iff_diff_less_0) (simp add: diff_frac_eq )
 
 lemma frac_le_eq:
   "y \<noteq> 0 \<Longrightarrow> z \<noteq> 0 \<Longrightarrow> x / y \<le> w / z \<longleftrightarrow> (x * z - w * y) / (y * z) \<le> 0"
   by (subst le_iff_diff_le_0) (simp add: diff_frac_eq )
 
 
 text\<open>Lemmas \<open>sign_simps\<close> is a first attempt to automate proofs
 of positivity/negativity needed for \<open>field_simps\<close>. Have not added \<open>sign_simps\<close> to \<open>field_simps\<close>
   because the former can lead to case explosions.\<close>
 
 lemma divide_pos_pos[simp]:
   "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> 0 < x / y"
   by(simp add:field_simps)
 
 lemma divide_nonneg_pos:
   "0 \<le> x \<Longrightarrow> 0 < y \<Longrightarrow> 0 \<le> x / y"
   by(simp add:field_simps)
 
 lemma divide_neg_pos:
   "x < 0 \<Longrightarrow> 0 < y \<Longrightarrow> x / y < 0"
   by(simp add:field_simps)
 
 lemma divide_nonpos_pos:
   "x \<le> 0 \<Longrightarrow> 0 < y \<Longrightarrow> x / y \<le> 0"
   by(simp add:field_simps)
 
 lemma divide_pos_neg:
   "0 < x \<Longrightarrow> y < 0 \<Longrightarrow> x / y < 0"
   by(simp add:field_simps)
 
 lemma divide_nonneg_neg:
   "0 \<le> x \<Longrightarrow> y < 0 \<Longrightarrow> x / y \<le> 0"
   by(simp add:field_simps)
 
 lemma divide_neg_neg:
   "x < 0 \<Longrightarrow> y < 0 \<Longrightarrow> 0 < x / y"
   by(simp add:field_simps)
 
 lemma divide_nonpos_neg:
   "x \<le> 0 \<Longrightarrow> y < 0 \<Longrightarrow> 0 \<le> x / y"
   by(simp add:field_simps)
 
 lemma divide_strict_right_mono:
   "a < b \<Longrightarrow> 0 < c \<Longrightarrow> a / c < b / c"
   by (simp add: less_imp_not_eq2 divide_inverse mult_strict_right_mono
       positive_imp_inverse_positive)
 
 
 lemma divide_strict_right_mono_neg:
   "b < a \<Longrightarrow> c < 0 \<Longrightarrow> a / c < b / c"
   by (simp add: local.neg_less_divide_eq)
 
 text\<open>The last premise ensures that \<^term>\<open>a\<close> and \<^term>\<open>b\<close>
       have the same sign\<close>
 lemma divide_strict_left_mono:
   "b < a \<Longrightarrow> 0 < c \<Longrightarrow> 0 < a*b \<Longrightarrow> c / a < c / b"
   by (metis local.divide_neg_pos local.dual_order.strict_iff_order local.frac_less_eq local.less_iff_diff_less_0 local.mult_not_zero local.mult_strict_left_mono)
 
 lemma divide_left_mono:
   "b \<le> a \<Longrightarrow> 0 \<le> c \<Longrightarrow> 0 < a*b \<Longrightarrow> c / a \<le> c / b"
   using local.divide_cancel_left local.divide_strict_left_mono local.dual_order.order_iff_strict by auto
 
 lemma divide_strict_left_mono_neg:
   "a < b \<Longrightarrow> c < 0 \<Longrightarrow> 0 < a*b \<Longrightarrow> c / a < c / b"
   by (metis local.divide_strict_left_mono local.minus_divide_left local.neg_0_less_iff_less local.neg_less_iff_less mult_commute)
 
 lemma mult_imp_div_pos_le: "0 < y \<Longrightarrow> x \<le> z * y \<Longrightarrow> x / y \<le> z"
   by (subst pos_divide_le_eq, assumption+)
 
 lemma mult_imp_le_div_pos: "0 < y \<Longrightarrow> z * y \<le> x \<Longrightarrow> z \<le> x / y"
   by(simp add:field_simps)
 
 lemma mult_imp_div_pos_less: "0 < y \<Longrightarrow> x < z * y \<Longrightarrow> x / y < z"
   by(simp add:field_simps)
 
 lemma mult_imp_less_div_pos: "0 < y \<Longrightarrow> z * y < x \<Longrightarrow> z < x / y"
   by(simp add:field_simps)
 
 lemma frac_le: "0 \<le> x \<Longrightarrow> x \<le> y \<Longrightarrow> 0 < w \<Longrightarrow> w \<le> z  \<Longrightarrow> x / z \<le> y / w"
   using local.mult_imp_div_pos_le local.mult_imp_le_div_pos local.mult_mono by auto
 
 lemma frac_less: "0 \<le> x \<Longrightarrow> x < y \<Longrightarrow> 0 < w \<Longrightarrow> w \<le> z \<Longrightarrow> x / z < y / w"
 proof-
   assume a1: "w \<le> z"
   assume a2: "0 < w"
   assume a3: "0 \<le> x"
   assume a4: "x < y"
   have f5: "a = 0 \<or> (b = c / a) = (b * a = c)"
     for a b c::'a
     by (meson local.nonzero_eq_divide_eq)
   have f6: "0 < z"
     using a2 a1 by (meson local.order.ordering_axioms order.strict_trans2)
   have "z \<noteq> 0"
     using a2 a1 by (meson local.leD)
   moreover have "x / z \<noteq> y / w"
     using a1 a2 a3 a4 local.frac_eq_eq local.mult_less_le_imp_less by fastforce
   ultimately have "x / z \<noteq> y / w"
     using f5 by (metis (no_types))
   thus ?thesis
     using a4 a3 a2 a1 by (meson local.frac_le local.order.not_eq_order_implies_strict
         local.order.strict_implies_order)
 qed
 
 
 lemma frac_less2: "0 < x \<Longrightarrow> x \<le> y \<Longrightarrow> 0 < w \<Longrightarrow> w < z  \<Longrightarrow> x / z < y / w"
   by (metis local.antisym_conv2 local.divide_cancel_left local.dual_order.strict_implies_order
       local.frac_le local.frac_less)
 
 lemma less_half_sum: "a < b \<Longrightarrow> a < (a+b) / (1+1)"
   by (metis local.add_pos_pos local.add_strict_left_mono local.mult_imp_less_div_pos local.semiring_normalization_rules(4) local.zero_less_one mult_commute)
 
 lemma gt_half_sum: "a < b \<Longrightarrow> (a+b)/(1+1) < b"
   by (metis local.add_pos_pos local.add_strict_left_mono local.mult_imp_div_pos_less local.semiring_normalization_rules(24) local.semiring_normalization_rules(4) local.zero_less_one mult_commute)
 
 subclass unbounded_dense_order
 proof
   fix x y :: 'a
   have less_add_one: "a < a + 1" for a::'a by auto
   from less_add_one show "\<exists>y. x < y"
     by blast
 
   from less_add_one have "x + (- 1) < (x + 1) + (- 1)"
     by (rule add_strict_right_mono)
   hence "x - 1 < x + 1 - 1" by simp
   hence "x - 1 < x" by (simp add: algebra_simps)
   thus "\<exists>y. y < x" ..
   show "x < y \<Longrightarrow> \<exists>z>x. z < y" by (blast intro!: less_half_sum gt_half_sum)
 qed
 
 
 lemma dense_le_bounded:
   fixes x y z :: 'a
   assumes "x < y"
     and *: "\<And>w. \<lbrakk> x < w ; w < y \<rbrakk> \<Longrightarrow> w \<le> z"
   shows "y \<le> z"
 proof (rule dense_le)
   fix w assume "w < y"
   from dense[OF \<open>x < y\<close>] obtain u where "x < u" "u < y" by safe
   have "u \<le> w \<or> w \<le> u"
     using \<open>u < y\<close> \<open>w < y\<close> comparable local.order.strict_implies_order by blast
   thus "w \<le> z"
     using "*" \<open>u < y\<close> \<open>w < y\<close> \<open>x < u\<close> local.dual_order.trans local.order.strict_trans2 by blast
 qed
 
 subclass field_abs_sgn ..
 
 
 lemma nonzero_abs_inverse:
   "a \<noteq> 0 \<Longrightarrow> \<bar>inverse a\<bar> = inverse \<bar>a\<bar>"
   by (rule abs_inverse)
 
 lemma nonzero_abs_divide:
   "b \<noteq> 0 \<Longrightarrow> \<bar>a / b\<bar> = \<bar>a\<bar> / \<bar>b\<bar>"
   by (rule abs_divide)
 
 lemma field_le_epsilon:
   assumes e: "\<And>e. 0 < e \<Longrightarrow> x \<le> y + e"
   shows "x \<le> y"
 proof (rule dense_le)
   fix t assume "t < x"
   hence "0 < x - t" by (simp add: less_diff_eq)
   from e [OF this] have "x + 0 \<le> x + (y - t)" by (simp add: algebra_simps)
   hence "0 \<le> y - t" by (simp only: add_le_cancel_left)
   thus "t \<le> y" by (simp add: algebra_simps)
 qed
 
 lemma inverse_positive_iff_positive [simp]:
   "(0 < inverse a) = (0 < a)"
   using local.positive_imp_inverse_positive by fastforce
 
 lemma inverse_negative_iff_negative [simp]:
   "(inverse a < 0) = (a < 0)"
   using local.negative_imp_inverse_negative by fastforce
 
 lemma inverse_nonnegative_iff_nonnegative [simp]:
   "0 \<le> inverse a \<longleftrightarrow> 0 \<le> a"
   by (simp add: local.dual_order.order_iff_strict)
 
 lemma inverse_nonpositive_iff_nonpositive [simp]:
   "inverse a \<le> 0 \<longleftrightarrow> a \<le> 0"
   using local.inverse_nonnegative_iff_nonnegative local.neg_0_le_iff_le by fastforce
 
 lemma one_less_inverse_iff: "1 < inverse x \<longleftrightarrow> 0 < x \<and> x < 1"
   using less_trans[of 1 x 0 for x]
   by (metis local.dual_order.strict_trans local.inverse_1 local.inverse_less_imp_less local.inverse_positive_iff_positive local.one_less_inverse local.zero_less_one)
 
 lemma one_le_inverse_iff: "1 \<le> inverse x \<longleftrightarrow> 0 < x \<and> x \<le> 1"
   by (metis local.dual_order.strict_trans1 local.inverse_1 local.inverse_le_imp_le local.inverse_positive_iff_positive local.one_le_inverse local.zero_less_one)
 
 lemma inverse_less_1_iff: "inverse x < 1 \<longleftrightarrow> x \<le> 0 \<or> 1 < x"
 proof (rule)
   assume invx1: "inverse x < 1"
   have "inverse x \<le> 0 \<or> inverse x \<ge> 0"
     using comparable invx1 local.order.strict_implies_order local.zero_less_one by blast
   then consider (leq0) "inverse x \<le> 0" | (pos) "inverse x > 0" | (zero) "inverse x = 0"
     using local.antisym_conv1 by blast
   thus "x \<le> 0 \<or> 1 < x"
     by (metis invx1 local.eq_refl local.inverse_1 inverse_less_imp_less
               inverse_nonpositive_iff_nonpositive inverse_positive_iff_positive)
 next
   assume "x \<le> 0 \<or> 1 < x"
   then consider (neg) "x \<le> 0" | (g1) "1 < x" by auto
   thus "inverse x < 1"
     by (metis local.dual_order.not_eq_order_implies_strict local.dual_order.strict_trans
         local.inverse_1 local.inverse_negative_iff_negative local.inverse_zero
         local.less_imp_inverse_less local.zero_less_one)
 qed
 
 lemma inverse_le_1_iff: "inverse x \<le> 1 \<longleftrightarrow> x \<le> 0 \<or> 1 \<le> x"
   by (metis local.dual_order.order_iff_strict local.inverse_1 local.inverse_le_iff_le
       local.inverse_less_1_iff local.one_le_inverse_iff)
 
 text\<open>Simplify expressions such as \<open>0 < 1/x\<close> to \<open>0 < x\<close>\<close>
 
 lemma zero_le_divide_1_iff [simp]:
   "0 \<le> 1 / a \<longleftrightarrow> 0 \<le> a"
   using local.dual_order.order_iff_strict local.inverse_eq_divide
     local.inverse_positive_iff_positive by auto
 
 lemma zero_less_divide_1_iff [simp]:
   "0 < 1 / a \<longleftrightarrow> 0 < a"
   by (simp add: local.dual_order.strict_iff_order)
 
 lemma divide_le_0_1_iff [simp]:
   "1 / a \<le> 0 \<longleftrightarrow> a \<le> 0"
   by (smt local.abs_0 local.abs_1 local.abs_divide local.abs_neg local.abs_nn
       local.divide_cancel_left local.le_minus_iff local.minus_divide_right local.zero_neq_one)
 
 lemma divide_less_0_1_iff [simp]:
   "1 / a < 0 \<longleftrightarrow> a < 0"
   using local.dual_order.strict_iff_order by auto
 
 lemma divide_right_mono:
   "a \<le> b \<Longrightarrow> 0 \<le> c \<Longrightarrow> a/c \<le> b/c"
   using local.divide_cancel_right local.divide_strict_right_mono local.dual_order.order_iff_strict by blast
 
 lemma divide_right_mono_neg: "a \<le> b
     \<Longrightarrow> c \<le> 0 \<Longrightarrow> b / c \<le> a / c"
   by (metis local.divide_cancel_right local.divide_strict_right_mono_neg local.dual_order.strict_implies_order local.eq_refl local.le_imp_less_or_eq)
 
 lemma divide_left_mono_neg: "a \<le> b
     \<Longrightarrow> c \<le> 0 \<Longrightarrow> 0 < a * b \<Longrightarrow> c / a \<le> c / b"
   by (metis local.divide_left_mono local.minus_divide_left local.neg_0_le_iff_le local.neg_le_iff_le mult_commute)
 
 lemma divide_nonneg_nonneg [simp]:
   "0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> 0 \<le> x / y"
   using local.divide_eq_0_iff local.divide_nonneg_pos local.dual_order.order_iff_strict by blast
 
 lemma divide_nonpos_nonpos:
   "x \<le> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> 0 \<le> x / y"
   using local.divide_nonpos_neg local.dual_order.order_iff_strict by auto
 
 lemma divide_nonneg_nonpos:
   "0 \<le> x \<Longrightarrow> y \<le> 0 \<Longrightarrow> x / y \<le> 0"
   by (metis local.divide_eq_0_iff local.divide_nonneg_neg local.dual_order.order_iff_strict)
 
 lemma divide_nonpos_nonneg:
   "x \<le> 0 \<Longrightarrow> 0 \<le> y \<Longrightarrow> x / y \<le> 0"
   using local.divide_nonpos_pos local.dual_order.order_iff_strict by auto
 
 text \<open>Conditional Simplification Rules: No Case Splits\<close>
 
 lemma le_divide_eq_1_pos [simp]:
   "0 < a \<Longrightarrow> (1 \<le> b/a) = (a \<le> b)"
   by (simp add: local.pos_le_divide_eq)
 
 lemma le_divide_eq_1_neg [simp]:
   "a < 0 \<Longrightarrow> (1 \<le> b/a) = (b \<le> a)"
   by (metis local.le_divide_eq_1_pos local.minus_divide_divide local.neg_0_less_iff_less local.neg_le_iff_le)
 
 lemma divide_le_eq_1_pos [simp]:
   "0 < a \<Longrightarrow> (b/a \<le> 1) = (b \<le> a)"
   using local.pos_divide_le_eq by auto
 
 lemma divide_le_eq_1_neg [simp]:
   "a < 0 \<Longrightarrow> (b/a \<le> 1) = (a \<le> b)"
   by (metis local.divide_le_eq_1_pos local.minus_divide_divide local.neg_0_less_iff_less
       local.neg_le_iff_le)
 
 lemma less_divide_eq_1_pos [simp]:
   "0 < a \<Longrightarrow> (1 < b/a) = (a < b)"
   by (simp add: local.dual_order.strict_iff_order)
 
 lemma less_divide_eq_1_neg [simp]:
   "a < 0 \<Longrightarrow> (1 < b/a) = (b < a)"
   using local.dual_order.strict_iff_order by auto
 
 lemma divide_less_eq_1_pos [simp]:
   "0 < a \<Longrightarrow> (b/a < 1) = (b < a)"
   using local.divide_le_eq_1_pos local.dual_order.strict_iff_order by auto
 
 lemma divide_less_eq_1_neg [simp]:
   "a < 0 \<Longrightarrow> b/a < 1 \<longleftrightarrow> a < b"
   using local.dual_order.strict_iff_order by auto
 
 lemma abs_div_pos: "0 < y \<Longrightarrow>
     \<bar>x\<bar> / y = \<bar>x / y\<bar>"
   by (simp add: local.abs_pos)
 
 lemma zero_le_divide_abs_iff [simp]: "(0 \<le> a / \<bar>b\<bar>) = (0 \<le> a | b = 0)"
 proof
   assume assm: "0 \<le> a / \<bar>b\<bar>"
   have absb: "abs b \<ge> 0" by (fact abs_nn)
   thus "0 \<le> a \<or> b = 0"
     using absb assm local.abs_eq_0_iff local.mult_nonneg_nonneg by fastforce
 next
   assume "0 \<le> a \<or> b = 0"
   then consider (a) "0 \<le> a" | (b) "b = 0" by atomize_elim auto
   thus "0 \<le> a / \<bar>b\<bar>"
     by (metis local.abs_eq_0_iff local.abs_nn local.divide_eq_0_iff local.divide_nonneg_nonneg)
 qed
 
 
 lemma divide_le_0_abs_iff [simp]: "(a / \<bar>b\<bar> \<le> 0) = (a \<le> 0 | b = 0)"
   by (metis local.minus_divide_left local.neg_0_le_iff_le local.zero_le_divide_abs_iff)
 
 text\<open>For creating values between \<^term>\<open>u\<close> and \<^term>\<open>v\<close>.\<close>
 lemma scaling_mono:
   assumes "u \<le> v" and "0 \<le> r" and "r \<le> s"
   shows "u + r * (v - u) / s \<le> v"
 proof -
   have "r/s \<le> 1" using assms
     by (metis local.divide_le_eq_1_pos local.division_ring_divide_zero
         local.dual_order.order_iff_strict local.dual_order.trans local.zero_less_one)
   hence "(r/s) * (v - u) \<le> 1 * (v - u)"
     using assms(1) local.diff_ge_0_iff_ge local.mult_right_mono by blast
   thus ?thesis
     by (simp add: field_simps)
 qed
 
 end (* class nice_ordered_field *)
 
 
 code_identifier
   code_module Ordered_Fields \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith
 
-subsection\<open>Ordered Complex\<close>
-
-declare Conjugate.less_eq_complex_def[simp del]
-declare Conjugate.less_complex_def[simp del]
-
 subsection \<open>Ordering on complex numbers\<close>
 
 instantiation complex :: nice_ordered_field begin
 instance
 proof intro_classes
   note defs = less_eq_complex_def less_complex_def abs_complex_def
   fix x y z a b c :: complex
   show "a \<le> 0 \<Longrightarrow> \<bar>a\<bar> = - a" unfolding defs
     by (simp add: cmod_eq_Re complex_is_Real_iff)
   show "0 \<le> a \<Longrightarrow> \<bar>a\<bar> = a"
     unfolding defs
     by (metis abs_of_nonneg cmod_eq_Re comp_apply complex.exhaust_sel complex_of_real_def zero_complex.simps(1) zero_complex.simps(2))
   show "a < b \<Longrightarrow> 0 < c \<Longrightarrow> c * a < c * b" unfolding defs by auto
   show "0 < (1::complex)" unfolding defs by simp
   show "0 < a \<Longrightarrow> 0 < inverse a" unfolding defs by auto
   define ra ia rb ib rc ic where "ra = Re a" "ia = Im a" "rb = Re b" "ib = Im b" "rc = Re c" "ic = Im c"
   note ri = this[symmetric]
   hence "a = Complex ra ia" "b = Complex rb ib" "c = Complex rc ic" by auto
   note ri = this ri
   have "rb \<le> ra"
     if "1 / ra \<le> (if rb = 0 then 0 else 1 / rb)"
       and "ia = 0" and "0 < ra" and "ib = 0"
   proof(cases "rb = 0")
     case True
     thus ?thesis
       using that(3) by auto
   next
     case False
     thus ?thesis
       by (smt nice_ordered_field_class.frac_less2 that(1) that(3))
   qed
   thus "inverse a \<le> inverse b \<Longrightarrow> 0 < a \<Longrightarrow> b \<le> a" unfolding defs ri
     by (auto simp: power2_eq_square)
   show "(\<And>a. a < b \<Longrightarrow> a \<le> c) \<Longrightarrow> b \<le> c" unfolding defs ri
     by (metis complex.sel(1) complex.sel(2) dense less_le_not_le
         nice_ordered_field_class.linordered_field_no_lb not_le_imp_less)
   show "0 \<le> a \<Longrightarrow> 0 \<le> b \<Longrightarrow> a \<le> b \<or> b \<le> a" unfolding defs by auto
   show "0 \<le> \<bar>x\<bar>" unfolding defs by auto
 qed
 end
 
 lemma less_eq_complexI: "Re x \<le> Re y \<Longrightarrow> Im x = Im y \<Longrightarrow> x\<le>y" unfolding less_eq_complex_def
   by simp
 lemma less_complexI: "Re x < Re y \<Longrightarrow> Im x = Im y \<Longrightarrow> x<y" unfolding less_complex_def
   by simp
 
 lemma complex_of_real_mono:
   "x \<le> y \<Longrightarrow> complex_of_real x \<le> complex_of_real y"
   unfolding less_eq_complex_def by auto
 
 lemma complex_of_real_mono_iff[simp]:
   "complex_of_real x \<le> complex_of_real y \<longleftrightarrow> x \<le> y"
   unfolding less_eq_complex_def by auto
 
 lemma complex_of_real_strict_mono_iff[simp]:
   "complex_of_real x < complex_of_real y \<longleftrightarrow> x < y"
   unfolding less_complex_def by auto
 
 lemma complex_of_real_nn_iff[simp]:
   "0 \<le> complex_of_real y \<longleftrightarrow> 0 \<le> y"
   unfolding less_eq_complex_def by auto
 
 lemma complex_of_real_pos_iff[simp]:
   "0 < complex_of_real y \<longleftrightarrow> 0 < y"
   unfolding less_complex_def by auto
 
 lemma Re_mono: "x \<le> y \<Longrightarrow> Re x \<le> Re y"
   unfolding less_eq_complex_def by simp
 
 lemma comp_Im_same: "x \<le> y \<Longrightarrow> Im x = Im y"
   unfolding less_eq_complex_def by simp
 
 lemma Re_strict_mono: "x < y \<Longrightarrow> Re x < Re y"
   unfolding less_complex_def by simp
 
 lemma complex_of_real_cmod: assumes "x \<ge> 0" shows "complex_of_real (cmod x) = x"
   by (metis Reals_cases abs_of_nonneg assms comp_Im_same complex_is_Real_iff complex_of_real_nn_iff norm_of_real zero_complex.simps(2))
 
 
 end
diff --git a/thys/Count_Complex_Roots/Count_Complex_Roots.thy b/thys/Count_Complex_Roots/Count_Complex_Roots.thy
--- a/thys/Count_Complex_Roots/Count_Complex_Roots.thy
+++ b/thys/Count_Complex_Roots/Count_Complex_Roots.thy
@@ -1,3446 +1,3447 @@
 (*
     Author:     Wenda Li <wl302@cam.ac.uk / liwenda1990@hotmail.com>
 *)
 
 section \<open>Procedures to count the number of complex roots\<close>
 
 theory Count_Complex_Roots imports 
   Winding_Number_Eval.Winding_Number_Eval 
   Extended_Sturm
   More_Polynomials
   Budan_Fourier.Sturm_Multiple_Roots
 begin
 
 subsection \<open>Misc\<close>
     
 (*refined version of the library one with the same name by dropping unnecessary assumptions*) 
 corollary path_image_part_circlepath_subset:
   assumes "r\<ge>0"
   shows "path_image(part_circlepath z r st tt) \<subseteq> sphere z r"
 proof (cases "st\<le>tt")
   case True
   then show ?thesis 
     by (auto simp: assms path_image_part_circlepath sphere_def dist_norm algebra_simps norm_mult) 
 next
   case False
   then have "path_image(part_circlepath z r tt st) \<subseteq> sphere z r"
     by (auto simp: assms path_image_part_circlepath sphere_def dist_norm algebra_simps norm_mult)
   moreover have "path_image(part_circlepath z r tt st) = path_image(part_circlepath z r st tt)"
     using path_image_reversepath by fastforce
   ultimately show ?thesis by auto
 qed
 
 (*refined version of the library one with the same name by dropping unnecessary assumptions*)
 proposition in_path_image_part_circlepath:
   assumes "w \<in> path_image(part_circlepath z r st tt)" "0 \<le> r"
   shows "norm(w - z) = r"
 proof -
   have "w \<in> {c. dist z c = r}"
     by (metis (no_types) path_image_part_circlepath_subset sphere_def subset_eq assms)
   thus ?thesis
     by (simp add: dist_norm norm_minus_commute)
 qed  
 
 lemma infinite_ball:
   fixes a :: "'a::euclidean_space"
   assumes "r > 0" 
   shows "infinite (ball a r)"
   using uncountable_ball[OF assms, THEN uncountable_infinite] .
 
 lemma infinite_cball:
   fixes a :: "'a::euclidean_space"
   assumes "r > 0" 
   shows "infinite (cball a r)"
   using uncountable_cball[OF assms, THEN uncountable_infinite,of a] .
 
 (*FIXME: to generalise*)
 lemma infinite_sphere:
   fixes a :: complex
   assumes "r > 0" 
   shows "infinite (sphere a r)" 
 proof -
   have "uncountable (path_image (circlepath a r))"
     apply (rule simple_path_image_uncountable)
     using simple_path_circlepath assms by simp
   then have "uncountable (sphere a r)"
     using assms by simp
   from uncountable_infinite[OF this] show ?thesis .
 qed
 
 lemma infinite_halfspace_Im_gt: "infinite {x. Im x > b}"
   apply (rule connected_uncountable[THEN uncountable_infinite,of _ "(b+1)* \<i>" "(b+2)*\<i>"])
   by (auto intro!:convex_connected simp add: convex_halfspace_Im_gt)
        
 lemma (in ring_1) Ints_minus2: "- a \<in> \<int> \<Longrightarrow> a \<in> \<int>"
   using Ints_minus[of "-a"] by auto
 
 lemma dvd_divide_Ints_iff:
   "b dvd a \<or> b=0 \<longleftrightarrow> of_int a / of_int b \<in> (\<int> :: 'a :: {field,ring_char_0} set)"  
 proof
   assume asm:"b dvd a \<or> b=0"
   let ?thesis = "of_int a / of_int b \<in> (\<int> :: 'a :: {field,ring_char_0} set)"
   have ?thesis when "b dvd a"
   proof -
     obtain c where "a=b * c" using \<open>b dvd a\<close> unfolding dvd_def by auto
     then show ?thesis by (auto simp add:field_simps)
   qed
   moreover have ?thesis when "b=0" 
     using that by auto
   ultimately show ?thesis using asm by auto
 next
   assume "of_int a / of_int b \<in> (\<int> :: 'a :: {field,ring_char_0} set)"
   from Ints_cases[OF this] obtain c where *:"(of_int::_ \<Rightarrow> 'a) c= of_int a / of_int b"
     by metis 
   have "b dvd a" when "b\<noteq>0"
   proof -
     have "(of_int::_ \<Rightarrow> 'a) a = of_int b * of_int c" using that * by auto
     then have "a = b * c" using of_int_eq_iff by fastforce
     then show ?thesis unfolding dvd_def by auto
   qed
   then show " b dvd a \<or> b = 0" by auto
 qed
  
 lemma of_int_div_field:
   assumes "d dvd n"
   shows "(of_int::_\<Rightarrow>'a::field_char_0) (n div d) = of_int n / of_int d" 
   apply (subst (2) dvd_mult_div_cancel[OF assms,symmetric])
   by (auto simp add:field_simps)
 
 lemma powr_eq_1_iff:
   assumes "a>0"
   shows "(a::real) powr b =1 \<longleftrightarrow> a=1 \<or> b=0"
 proof 
   assume "a powr b = 1"
   have "b * ln a = 0"
     using \<open>a powr b = 1\<close> ln_powr[of a b] assms by auto
   then have "b=0 \<or> ln a =0" by auto
   then show "a = 1 \<or> b = 0" using assms by auto
 qed (insert assms, auto)
 
 lemma tan_inj_pi:
   "- (pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> - (pi/2) < y \<Longrightarrow> y < pi/2 \<Longrightarrow> tan x = tan y \<Longrightarrow> x = y"
   by (metis arctan_tan)
 
 (*TODO: can we avoid fcompose in the proof?*)
 lemma finite_ReZ_segments_poly_circlepath:
           "finite_ReZ_segments (poly p \<circ> circlepath z0 r) 0"
 proof (cases "\<forall>t\<in>({0..1} - {1/2}). Re ((poly p \<circ> circlepath z0 r) t) = 0")
   case True
   have "isCont (Re \<circ> poly p \<circ> circlepath z0 r) (1/2)"
     by (auto intro!:continuous_intros simp:circlepath)
   moreover have "(Re \<circ> poly p \<circ> circlepath z0 r)\<midarrow> 1/2 \<rightarrow> 0"
   proof -
     have "\<forall>\<^sub>F x in at (1 / 2). (Re \<circ> poly p \<circ> circlepath z0 r) x = 0" 
       unfolding eventually_at_le 
       apply (rule exI[where x="1/2"])
       unfolding dist_real_def abs_diff_le_iff
       by (auto intro!:True[rule_format, unfolded comp_def])
     then show ?thesis by (rule tendsto_eventually)
   qed
   ultimately have "Re ((poly p \<circ> circlepath z0 r) (1/2)) = 0"
     unfolding comp_def by (simp add: LIM_unique continuous_within)
   then have "\<forall>t\<in>{0..1}. Re ((poly p \<circ> circlepath z0 r) t) = 0"
     using True by blast
   then show ?thesis 
     apply (rule_tac finite_ReZ_segments_constI[THEN finite_ReZ_segments_congE])
     by auto
 next
   case False
    define q1 q2 where "q1=fcompose p [:(z0+r)*\<i>,z0-r:] [:\<i>,1:]" and 
                       "q2=([:\<i>, 1:] ^ degree p)"
   define q1R q1I where "q1R=map_poly Re q1" and "q1I=map_poly Im q1"
   define q2R q2I where "q2R=map_poly Re q2" and "q2I=map_poly Im q2"
   define qq where "qq=q1R*q2R + q1I*q2I"
   
   have poly_eq:"Re ((poly p \<circ> circlepath z0 r) t) = 0 \<longleftrightarrow> poly qq (tan (pi * t)) = 0"
     when "0\<le>t" "t\<le>1" "t\<noteq>1/2" for t 
   proof -
     define tt where "tt=tan (pi * t)"
     have "Re ((poly p \<circ> circlepath z0 r) t) = 0 \<longleftrightarrow> Re (poly q1 tt / poly q2 tt) = 0"
       unfolding comp_def
       apply (subst poly_circlepath_tan_eq[of t p z0 r,folded q1_def q2_def tt_def])
       using that by simp_all
     also have "... \<longleftrightarrow> poly q1R tt * poly q2R tt + poly q1I tt * poly q2I tt = 0"
       unfolding q1I_def q1R_def q2R_def q2I_def
       by (simp add:Re_complex_div_eq_0 Re_poly_of_real Im_poly_of_real)
     also have "... \<longleftrightarrow> poly qq tt = 0"
       unfolding qq_def by simp
     finally show ?thesis unfolding tt_def .
   qed
 
   have "finite {t. Re ((poly p \<circ> circlepath z0 r) t) = 0 \<and> 0 \<le> t \<and> t \<le> 1}"
   proof - 
     define P where "P=(\<lambda>t. Re ((poly p \<circ> circlepath z0 r) t) = 0)"
     define A where "A= ({0..1}::real set)"
     define S where "S={t\<in>A-{1,1/2}. P t}"
     have "finite {t. poly qq (tan (pi * t)) = 0 \<and> 0 \<le> t \<and> t < 1 \<and> t\<noteq>1/2}"
     proof -
       define A where "A={t::real. 0 \<le> t \<and> t < 1 \<and> t \<noteq> 1 / 2}"
       have "finite ((\<lambda>t. tan (pi * t))  -`  {x. poly qq x=0} \<inter> A)"
       proof (rule finite_vimage_IntI)
         have "x = y" when "tan (pi * x) = tan (pi * y)" "x\<in>A" "y\<in>A" for x y
         proof -
           define x' where "x'=(if x<1/2 then x else x-1)"
           define y' where "y'=(if y<1/2 then y else y-1)"
           have "x'*pi = y'*pi" 
           proof (rule tan_inj_pi)
             have *:"- 1 / 2 < x'" "x' < 1 / 2" "- 1 / 2 < y'" "y' < 1 / 2" 
               using that(2,3) unfolding x'_def y'_def A_def by simp_all
             show "- (pi / 2) < x'  * pi" "x'  * pi < pi / 2" "- (pi / 2) < y'  * pi" 
                   "y'*pi < pi / 2"
               using mult_strict_right_mono[OF *(1),of pi] 
                     mult_strict_right_mono[OF *(2),of pi] 
                     mult_strict_right_mono[OF *(3),of pi] 
                     mult_strict_right_mono[OF *(4),of pi] 
               by auto
           next
             have "tan (x' * pi) = tan (x * pi)"
               unfolding x'_def using tan_periodic_int[of _ "- 1",simplified]
               by (auto simp add:algebra_simps)
             also have "... = tan (y * pi)"
               using \<open>tan (pi * x) = tan (pi * y)\<close> by (auto simp:algebra_simps)
             also have "... = tan (y' * pi)"
               unfolding y'_def using tan_periodic_int[of _ "- 1",simplified]
               by (auto simp add:algebra_simps)
             finally show "tan (x' * pi) = tan (y' * pi)" .
           qed
           then have "x'=y'" by auto
           then show ?thesis 
             using that(2,3) unfolding x'_def y'_def A_def by (auto split:if_splits)
         qed
         then show "inj_on (\<lambda>t. tan (pi * t)) A"
           unfolding inj_on_def by blast
       next
         have "qq\<noteq>0"
         proof (rule ccontr)
           assume "\<not> qq \<noteq> 0"
           then have "Re ((poly p \<circ> circlepath z0 r) t) = 0" when "t\<in>{0..1} - {1/2}" for t
             apply (subst poly_eq)
             using that by auto
           then show False using False by blast
         qed
         then show "finite {x. poly qq x = 0}" by (simp add: poly_roots_finite)
       qed
       then show ?thesis by (elim rev_finite_subset) (auto simp:A_def)
     qed
     moreover have "{t. poly qq (tan (pi * t)) = 0 \<and> 0 \<le> t \<and> t < 1 \<and> t\<noteq>1/2} = S"
       unfolding S_def P_def A_def using poly_eq by force
     ultimately have "finite S" by blast
     then have "finite (S \<union> (if P 1 then {1} else {}) \<union> (if P (1/2) then {1/2} else {}))"
       by auto
     moreover have "(S \<union> (if P 1 then {1} else {}) \<union> (if P (1/2) then {1/2} else {}))
                       = {t. P t \<and> 0 \<le> t \<and> t \<le> 1}" 
     proof -
       have "1\<in>A" "1/2 \<in>A" unfolding A_def by auto
       then have "(S \<union> (if P 1 then {1} else {}) \<union> (if P (1/2) then {1/2} else {}))
                       = {t\<in>A. P t}"
         unfolding S_def
         apply auto
         by (metis eq_divide_eq_numeral1(1) zero_neq_numeral)+
       also have "... = {t. P t \<and> 0 \<le> t \<and> t \<le> 1}"
         unfolding A_def by auto
       finally show ?thesis .
     qed
     ultimately have "finite {t. P t \<and> 0 \<le> t \<and> t \<le> 1}" by auto
     then show ?thesis unfolding P_def by simp
   qed
   then show ?thesis 
     apply (rule_tac finite_imp_finite_ReZ_segments)
     by auto
 qed
 
 subsection \<open>Some useful conformal/@{term bij_betw} properties\<close>
 
 lemma bij_betw_plane_ball:"bij_betw (\<lambda>x. (\<i>-x)/(\<i>+x)) {x. Im x>0} (ball 0 1)"
 proof (rule bij_betw_imageI)
   have neq:"\<i> + x \<noteq>0" when "Im x>0" for x 
     using that 
     by (metis add_less_same_cancel2 add_uminus_conv_diff diff_0 diff_add_cancel 
         imaginary_unit.simps(2) not_one_less_zero uminus_complex.sel(2))
   then show "inj_on (\<lambda>x. (\<i> - x) / (\<i> + x)) {x. 0 < Im x}"
     unfolding inj_on_def by (auto simp add:divide_simps algebra_simps)
   have "cmod ((\<i> - x) / (\<i> + x)) < 1" when "0 < Im x " for x
   proof -
     have "cmod (\<i> - x) < cmod (\<i> + x)" 
       unfolding norm_lt inner_complex_def using that 
       by (auto simp add:algebra_simps)
     then show ?thesis
       unfolding norm_divide using neq[OF that] by auto
   qed
   moreover have "x \<in> (\<lambda>x. (\<i> - x) / (\<i> + x)) ` {x. 0 < Im x}" when "cmod x < 1" for x 
   proof (rule rev_image_eqI[of "\<i>*(1-x)/(1+x)"])
     have "1 + x\<noteq>0" "\<i> * 2 + \<i> * (x * 2) \<noteq>0" 
       subgoal using that by (metis complex_mod_triangle_sub norm_one norm_zero not_le pth_7(1))
       subgoal using that by (metis \<open>1 + x \<noteq> 0\<close> complex_i_not_zero div_mult_self4 mult_2 
             mult_zero_right nonzero_mult_div_cancel_left nonzero_mult_div_cancel_right 
             one_add_one zero_neq_numeral)
       done        
     then show "x = (\<i> - \<i> * (1 - x) / (1 + x)) / (\<i> + \<i> * (1 - x) / (1 + x))"
       by (auto simp add:field_simps)
     show " \<i> * (1 - x) / (1 + x) \<in> {x. 0 < Im x}"
       apply (auto simp:Im_complex_div_gt_0 algebra_simps)
       using that unfolding cmod_def by (auto simp:power2_eq_square)
   qed
   ultimately show "(\<lambda>x. (\<i> - x) / (\<i> + x)) ` {x. 0 < Im x} = ball 0 1"
     by auto
 qed
     
 lemma bij_betw_axis_sphere:"bij_betw (\<lambda>x. (\<i>-x)/(\<i>+x)) {x. Im x=0} (sphere 0 1 - {-1})"
 proof (rule bij_betw_imageI)
   have neq:"\<i> + x \<noteq>0" when "Im x=0" for x 
     using that 
     by (metis add_diff_cancel_left' imaginary_unit.simps(2) minus_complex.simps(2) 
          right_minus_eq zero_complex.simps(2) zero_neq_one)
   then show "inj_on (\<lambda>x. (\<i> - x) / (\<i> + x)) {x. Im x = 0}"
     unfolding inj_on_def by (auto simp add:divide_simps algebra_simps)
   have "cmod ((\<i> - x) / (\<i> + x)) = 1" "(\<i> - x) / (\<i> + x) \<noteq> - 1" when "Im x = 0" for x 
   proof -
     have "cmod (\<i> + x) = cmod (\<i> - x)" 
       using that unfolding cmod_def by auto
     then show "cmod ((\<i> - x) / (\<i> + x)) = 1"
       unfolding norm_divide using neq[OF that] by auto
     show "(\<i> - x) / (\<i> + x) \<noteq> - 1" using neq[OF that] by (auto simp add:divide_simps)
   qed
   moreover have "x \<in> (\<lambda>x. (\<i> - x) / (\<i> + x)) ` {x. Im x = 0}" 
     when "cmod x = 1" "x\<noteq>-1" for x 
   proof (rule rev_image_eqI[of "\<i>*(1-x)/(1+x)"])
     have "1 + x\<noteq>0" "\<i> * 2 + \<i> * (x * 2) \<noteq>0" 
       subgoal using that(2) by algebra 
       subgoal using that by (metis \<open>1 + x \<noteq> 0\<close> complex_i_not_zero div_mult_self4 mult_2 
             mult_zero_right nonzero_mult_div_cancel_left nonzero_mult_div_cancel_right 
             one_add_one zero_neq_numeral)
       done        
     then show "x = (\<i> - \<i> * (1 - x) / (1 + x)) / (\<i> + \<i> * (1 - x) / (1 + x))"
       by (auto simp add:field_simps)
     show " \<i> * (1 - x) / (1 + x) \<in> {x. Im x = 0}"
       apply (auto simp:algebra_simps Im_complex_div_eq_0)
       using that(1) unfolding cmod_def by (auto simp:power2_eq_square)
   qed
   ultimately show "(\<lambda>x. (\<i> - x) / (\<i> + x)) ` {x. Im x = 0} = sphere 0 1 - {- 1}"
     by force
 qed
 
 lemma bij_betw_ball_uball:
   assumes "r>0"
   shows "bij_betw (\<lambda>x. complex_of_real r*x + z0) (ball 0 1) (ball z0 r)"
 proof (rule bij_betw_imageI)
   show "inj_on (\<lambda>x. complex_of_real r * x + z0) (ball 0 1)"
     unfolding inj_on_def using assms by simp
   have "dist z0 (complex_of_real r * x + z0) < r" when "cmod x<1" for x 
     using that assms by (auto simp:dist_norm norm_mult abs_of_pos)
   moreover have "x \<in> (\<lambda>x. complex_of_real r * x + z0) ` ball 0 1" when "dist z0 x < r" for x 
     apply (rule rev_image_eqI[of "(x-z0)/r"])
     using that assms by (auto simp add: dist_norm norm_divide norm_minus_commute)
   ultimately show "(\<lambda>x. complex_of_real r  * x + z0) ` ball 0 1 = ball z0 r" 
     by auto
 qed
 
 lemma bij_betw_sphere_usphere:
   assumes "r>0"
   shows "bij_betw (\<lambda>x. complex_of_real r*x + z0) (sphere 0 1) (sphere z0 r)"
 proof (rule bij_betw_imageI)
   show "inj_on (\<lambda>x. complex_of_real r * x + z0) (sphere 0 1)"
     unfolding inj_on_def using assms by simp
   have "dist z0 (complex_of_real r * x + z0) = r" when "cmod x=1" for x 
     using that assms by (auto simp:dist_norm norm_mult abs_of_pos)
   moreover have "x \<in> (\<lambda>x. complex_of_real r * x + z0) ` sphere 0 1" when "dist z0 x = r" for x 
     apply (rule rev_image_eqI[of "(x-z0)/r"])
     using that assms by (auto simp add: dist_norm norm_divide norm_minus_commute)
   ultimately show "(\<lambda>x. complex_of_real r  * x + z0) ` sphere 0 1 = sphere z0 r" 
     by auto
 qed
 
 lemma proots_ball_plane_eq:
   defines "q1\<equiv>[:\<i>,-1:]" and "q2\<equiv>[:\<i>,1:]"
   assumes "p\<noteq>0"
   shows "proots_count p (ball 0 1) = proots_count (fcompose p q1 q2) {x. 0 < Im x}"
   unfolding q1_def q2_def 
 proof (rule proots_fcompose_bij_eq[OF _ \<open>p\<noteq>0\<close>])
   show "\<forall>x\<in>{x. 0 < Im x}. poly [:\<i>, 1:] x \<noteq> 0" 
     apply simp 
     by (metis add_less_same_cancel2 imaginary_unit.simps(2) not_one_less_zero 
           plus_complex.simps(2) zero_complex.simps(2))
   show "infinite (UNIV::complex set)" by (simp add: infinite_UNIV_char_0)
 qed (use bij_betw_plane_ball in auto)
 
 lemma proots_sphere_axis_eq:
   defines "q1\<equiv>[:\<i>,-1:]" and "q2\<equiv>[:\<i>,1:]"
   assumes "p\<noteq>0"
   shows "proots_count p (sphere 0 1 - {- 1}) = proots_count (fcompose p q1 q2) {x. 0 = Im x}"
 unfolding q1_def q2_def 
 proof (rule proots_fcompose_bij_eq[OF _ \<open>p\<noteq>0\<close>])
   show "\<forall>x\<in>{x. 0 = Im x}. poly [:\<i>, 1:] x \<noteq> 0" by (simp add: Complex_eq_0 plus_complex.code)
   show "infinite (UNIV::complex set)" by (simp add: infinite_UNIV_char_0)
 qed (use bij_betw_axis_sphere in auto)
 
 lemma proots_card_ball_plane_eq:
   defines "q1\<equiv>[:\<i>,-1:]" and "q2\<equiv>[:\<i>,1:]"
   assumes "p\<noteq>0"
   shows "card (proots_within p (ball 0 1)) = card (proots_within (fcompose p q1 q2) {x. 0 < Im x})"
 unfolding q1_def q2_def
 proof (rule proots_card_fcompose_bij_eq[OF _ \<open>p\<noteq>0\<close>])
   show "\<forall>x\<in>{x. 0 < Im x}. poly [:\<i>, 1:] x \<noteq> 0" 
     apply simp 
     by (metis add_less_same_cancel2 imaginary_unit.simps(2) not_one_less_zero 
           plus_complex.simps(2) zero_complex.simps(2))
 qed (use bij_betw_plane_ball infinite_UNIV_char_0 in auto)
 
 lemma proots_card_sphere_axis_eq:
   defines "q1\<equiv>[:\<i>,-1:]" and "q2\<equiv>[:\<i>,1:]"
   assumes "p\<noteq>0"
   shows "card (proots_within p (sphere 0 1 - {- 1})) 
             = card (proots_within (fcompose p q1 q2) {x. 0 = Im x})"
 unfolding q1_def q2_def
 proof (rule proots_card_fcompose_bij_eq[OF _ \<open>p\<noteq>0\<close>])
   show "\<forall>x\<in>{x. 0 = Im x}. poly [:\<i>, 1:] x \<noteq> 0" by (simp add: Complex_eq_0 plus_complex.code)
 qed (use bij_betw_axis_sphere infinite_UNIV_char_0 in auto)
 
 lemma proots_uball_eq:
   fixes z0::complex and r::real
   defines "q\<equiv>[:z0, of_real r:]"
   assumes "p\<noteq>0" and "r>0"
   shows "proots_count p (ball z0 r) = proots_count (p \<circ>\<^sub>p q) (ball 0 1)"
 proof -
   show ?thesis
     apply (rule proots_pcompose_bij_eq[OF _ \<open>p\<noteq>0\<close>])
     subgoal unfolding q_def using bij_betw_ball_uball[OF \<open>r>0\<close>,of z0] by (auto simp:algebra_simps)
     subgoal unfolding q_def using \<open>r>0\<close> by auto
     done
 qed
 
 lemma proots_card_uball_eq:
   fixes z0::complex and r::real
   defines "q\<equiv>[:z0, of_real r:]"
   assumes "r>0"
   shows "card (proots_within p (ball z0 r)) = card (proots_within (p \<circ>\<^sub>p q) (ball 0 1))"
 proof -
   have ?thesis 
     when "p=0"
   proof -
     have "card (ball z0 r) = 0" "card (ball (0::complex) 1) = 0"
       using infinite_ball[OF \<open>r>0\<close>,of z0] infinite_ball[of 1 "0::complex"] by auto 
     then show ?thesis using that by auto
   qed
   moreover have ?thesis 
     when "p\<noteq>0"
     apply (rule proots_card_pcompose_bij_eq[OF _ \<open>p\<noteq>0\<close>])
     subgoal unfolding q_def using bij_betw_ball_uball[OF \<open>r>0\<close>,of z0] by (auto simp:algebra_simps)
     subgoal unfolding q_def using \<open>r>0\<close> by auto
     done
   ultimately show ?thesis 
     by blast
 qed
 
 lemma proots_card_usphere_eq:
   fixes z0::complex and r::real
   defines "q\<equiv>[:z0, of_real r:]"
   assumes "r>0"
   shows "card (proots_within p (sphere z0 r)) = card (proots_within (p \<circ>\<^sub>p q) (sphere 0 1))"
 proof -
   have ?thesis 
     when "p=0"
   proof -
     have "card (sphere z0 r) = 0" "card (sphere (0::complex) 1) = 0"
       using infinite_sphere[OF \<open>r>0\<close>,of z0] infinite_sphere[of 1 "0::complex"] by auto 
     then show ?thesis using that by auto
   qed
   moreover have ?thesis
     when "p\<noteq>0"
     apply (rule proots_card_pcompose_bij_eq[OF _ \<open>p\<noteq>0\<close>])
     subgoal unfolding q_def using bij_betw_sphere_usphere[OF \<open>r>0\<close>,of z0] 
       by (auto simp:algebra_simps)
     subgoal unfolding q_def using \<open>r>0\<close> by auto
     done
   ultimately show "card (proots_within p (sphere z0 r)) = card (proots_within (p \<circ>\<^sub>p q) (sphere 0 1))" 
     by blast
 qed
   
 subsection \<open>Combining two real polynomials into a complex one\<close>  
 
 definition cpoly_of:: "real poly \<Rightarrow> real poly \<Rightarrow> complex poly" where
   "cpoly_of pR pI = map_poly of_real pR + smult \<i> (map_poly of_real pI)"
 
 lemma cpoly_of_eq_0_iff[iff]:
   "cpoly_of pR pI = 0 \<longleftrightarrow> pR = 0 \<and> pI = 0"
 proof -
   have "pR = 0 \<and> pI = 0" when "cpoly_of pR pI = 0"
   proof -
     have "complex_of_real (coeff pR n) + \<i> * complex_of_real (coeff pI n) = 0" for n
       using that unfolding poly_eq_iff cpoly_of_def by (auto simp:coeff_map_poly)
     then have "coeff pR n = 0 \<and> coeff pI n = 0" for n
       by (metis Complex_eq Im_complex_of_real Re_complex_of_real complex.sel(1) complex.sel(2) 
           of_real_0)
     then show ?thesis unfolding poly_eq_iff by auto 
   qed
   then show ?thesis by (auto simp:cpoly_of_def)
 qed
 
 lemma cpoly_of_decompose:
     "p = cpoly_of (map_poly Re p) (map_poly Im p)"
   unfolding cpoly_of_def 
   apply (induct p)
   by (auto simp add:map_poly_pCons map_poly_map_poly complex_eq)
 
 lemma cpoly_of_dist_right:
     "cpoly_of (pR*g) (pI*g) = cpoly_of pR pI * (map_poly of_real g)"
   unfolding cpoly_of_def by (simp add: distrib_right)
   
 lemma poly_cpoly_of_real:
     "poly (cpoly_of pR pI) (of_real x) = Complex (poly pR x) (poly pI x)"
   unfolding cpoly_of_def by (simp add: Complex_eq of_real_poly_map_poly)
     
 lemma poly_cpoly_of_real_iff:
   shows "poly (cpoly_of pR pI) (of_real t) =0 \<longleftrightarrow> poly pR t = 0 \<and> poly pI t=0 "  
   unfolding  poly_cpoly_of_real using Complex_eq_0 by blast  
 
 lemma order_cpoly_gcd_eq:
   assumes "pR\<noteq>0 \<or> pI\<noteq>0"
   shows "order t (cpoly_of pR pI) = order t (gcd pR pI)"
 proof -
   define g where "g = gcd pR pI"
   have [simp]:"g\<noteq>0" unfolding g_def using assms by auto
   obtain pr pi where pri: "pR = pr * g" "pI = pi * g" "coprime pr pi"
     unfolding g_def using assms(1) gcd_coprime_exists \<open>g \<noteq> 0\<close> g_def by blast
   then have "pr \<noteq>0 \<or> pi \<noteq>0" using assms mult_zero_left by blast
 
   have "order t (cpoly_of pR pI) = order t (cpoly_of pr pi * (map_poly of_real g))"
     unfolding pri cpoly_of_dist_right by simp
   also have "... = order t (cpoly_of pr pi) + order t g" 
     apply (subst order_mult)
     using \<open>pr \<noteq>0 \<or> pi \<noteq>0\<close> by (auto simp:map_poly_order_of_real)
   also have "... = order t g"
   proof -
     have "poly (cpoly_of pr pi) t \<noteq>0" unfolding poly_cpoly_of_real_iff
       using \<open>coprime pr pi\<close> coprime_poly_0 by blast
     then have "order t (cpoly_of pr pi) = 0" by (simp add: order_0I)
     then show ?thesis by auto
   qed
   finally show ?thesis unfolding g_def .
 qed
 
 subsection \<open>Number of roots on a (bounded or unbounded) segment\<close>
 
 \<comment> \<open>1 dimensional hyperplane\<close>
 definition unbounded_line::"'a::real_vector \<Rightarrow> 'a \<Rightarrow> 'a set" where 
    "unbounded_line a b = ({x. \<exists>u::real. x= (1 - u) *\<^sub>R a + u *\<^sub>R b})"
 
 definition proots_line_card:: "complex poly \<Rightarrow> complex \<Rightarrow> complex \<Rightarrow> nat" where
   "proots_line_card p st tt = card (proots_within p (open_segment st tt))"
 
 definition proots_unbounded_line_card:: "complex poly \<Rightarrow> complex \<Rightarrow> complex \<Rightarrow> nat" where
   "proots_unbounded_line_card p st tt = card (proots_within p (unbounded_line st tt))"
 
 definition proots_unbounded_line :: "complex poly \<Rightarrow> complex \<Rightarrow> complex \<Rightarrow> nat" where
   "proots_unbounded_line p st tt = proots_count p (unbounded_line st tt)"
 
 lemma card_proots_open_segments:
   assumes "poly p st \<noteq>0" "poly p tt \<noteq> 0"
   shows "card (proots_within p (open_segment st tt)) = 
                 (let pc = pcompose p [:st, tt - st:];
                      pR = map_poly Re pc;
                      pI = map_poly Im pc;
                      g  = gcd pR pI
                  in changes_itv_smods 0 1 g (pderiv g))" (is "?L = ?R")
 proof -
   define pc pR pI g where 
       "pc = pcompose p [:st, tt-st:]" and
       "pR = map_poly Re pc" and
       "pI = map_poly Im pc" and
       "g  = gcd pR pI"
   have poly_iff:"poly g t=0 \<longleftrightarrow> poly pc t =0" for t
   proof -
     have "poly g t = 0 \<longleftrightarrow> poly pR t =0 \<and> poly pI t =0" 
       unfolding g_def using poly_gcd_iff by auto
     also have "... \<longleftrightarrow> poly pc t =0"
     proof -
       have "cpoly_of pR pI = pc"
         unfolding pc_def pR_def pI_def using cpoly_of_decompose by auto
       then show ?thesis using poly_cpoly_of_real_iff by blast
     qed
     finally show ?thesis by auto
   qed      
 
   have "?R = changes_itv_smods 0 1 g (pderiv g)"
     unfolding pc_def g_def pI_def pR_def by (auto simp add:Let_def)
   also have "... = card {t. poly g t = 0 \<and> 0 < t \<and> t < 1}"
   proof -
     have "poly g 0 \<noteq> 0" 
       using poly_iff[of 0] assms unfolding pc_def by (auto simp add:poly_pcompose)
     moreover have "poly g 1 \<noteq> 0" 
       using poly_iff[of 1] assms unfolding pc_def by (auto simp add:poly_pcompose)
     ultimately show ?thesis using sturm_interval[of 0 1 g] by auto
   qed
-  also have "... = card {t::real. poly pc t = 0 \<and> 0 < t \<and> t < 1}"
+  also have "... = card {t::real. poly pc (of_real t) = 0 \<and> 0 < t \<and> t < 1}"
     unfolding poly_iff by simp
   also have "... = ?L"
   proof (cases "st=tt")
     case True
     then show ?thesis unfolding pc_def poly_pcompose using \<open>poly p tt \<noteq> 0\<close>
       by auto
   next
     case False
     define ff where "ff = (\<lambda>t::real. st + t*(tt-st))"
     define ll where "ll = {t. poly pc (complex_of_real t) = 0 \<and> 0 < t \<and> t < 1}"
     have "ff ` ll = proots_within p (open_segment st tt)"
     proof (rule equalityI)
       show "ff ` ll \<subseteq> proots_within p (open_segment st tt)"
         unfolding ll_def ff_def pc_def poly_pcompose 
         by (auto simp add:in_segment False scaleR_conv_of_real algebra_simps)
     next
       show "proots_within p (open_segment st tt) \<subseteq> ff ` ll"
       proof clarify
         fix x assume asm:"x \<in> proots_within p (open_segment st tt)" 
         then obtain u where "0<u" and "u < 1" and u:"x = (1 - u) *\<^sub>R st + u *\<^sub>R tt"
           by (auto simp add:in_segment)
         then have "poly p ((1 - u) *\<^sub>R st + u *\<^sub>R tt) = 0" using asm by simp
         then have "u \<in> ll"
           unfolding ll_def pc_def poly_pcompose 
           by (simp add:scaleR_conv_of_real algebra_simps \<open>0<u\<close> \<open>u<1\<close>)
         moreover have "x = ff u"
           unfolding ff_def using u by (auto simp add:algebra_simps scaleR_conv_of_real)
         ultimately show "x \<in> ff ` ll" by (rule rev_image_eqI[of "u"])
       qed
     qed
     moreover have "inj_on ff ll"
       unfolding ff_def using False inj_on_def by fastforce
     ultimately show ?thesis unfolding ll_def 
       using card_image[of ff] by fastforce
   qed
   finally show ?thesis by simp
 qed
 
 lemma unbounded_line_closed_segment: "closed_segment a b \<subseteq> unbounded_line a b"
   unfolding unbounded_line_def closed_segment_def by auto
 
 lemma card_proots_unbounded_line:
   assumes "st\<noteq>tt"
   shows "card (proots_within p (unbounded_line st tt)) = 
                 (let pc = pcompose p [:st, tt - st:];
                      pR = map_poly Re pc;
                      pI = map_poly Im pc;
                      g  = gcd pR pI
                  in nat (changes_R_smods g (pderiv g)))" (is "?L = ?R")
 proof -
   define pc pR pI g where 
       "pc = pcompose p [:st, tt-st:]" and
       "pR = map_poly Re pc" and
       "pI = map_poly Im pc" and
       "g  = gcd pR pI"
   have poly_iff:"poly g t=0 \<longleftrightarrow> poly pc t =0" for t
   proof -
     have "poly g t = 0 \<longleftrightarrow> poly pR t =0 \<and> poly pI t =0" 
       unfolding g_def using poly_gcd_iff by auto
     also have "... \<longleftrightarrow> poly pc t =0"
     proof -
       have "cpoly_of pR pI = pc"
         unfolding pc_def pR_def pI_def using cpoly_of_decompose by auto
       then show ?thesis using poly_cpoly_of_real_iff by blast
     qed
     finally show ?thesis by auto
   qed      
 
   have "?R = nat (changes_R_smods g (pderiv g))"
     unfolding pc_def g_def pI_def pR_def by (auto simp add:Let_def)
   also have "... = card {t. poly g t = 0}"
     using sturm_R[of g] by simp
   also have "... = card {t::real. poly pc t = 0}"
     unfolding poly_iff by simp
   also have "... = ?L"
   proof (cases "st=tt")
     case True
     then show ?thesis unfolding pc_def poly_pcompose unbounded_line_def using assms
       by (auto simp add:proots_within_def)
   next
     case False
     define ff where "ff = (\<lambda>t::real. st + t*(tt-st))"
     define ll where "ll = {t. poly pc (complex_of_real t) = 0}"
     have "ff ` ll = proots_within p (unbounded_line st tt)"
     proof (rule equalityI)
       show "ff ` ll \<subseteq> proots_within p (unbounded_line st tt)"
         unfolding ll_def ff_def pc_def poly_pcompose 
         by (auto simp add:unbounded_line_def False scaleR_conv_of_real algebra_simps)
     next
       show "proots_within p (unbounded_line st tt) \<subseteq> ff ` ll"
       proof clarify
         fix x assume asm:"x \<in> proots_within p (unbounded_line st tt)" 
         then obtain u where u:"x = (1 - u) *\<^sub>R st + u *\<^sub>R tt"
           by (auto simp add:unbounded_line_def)
         then have "poly p ((1 - u) *\<^sub>R st + u *\<^sub>R tt) = 0" using asm by simp
         then have "u \<in> ll"
           unfolding ll_def pc_def poly_pcompose 
           by (simp add:scaleR_conv_of_real algebra_simps unbounded_line_def)
         moreover have "x = ff u"
           unfolding ff_def using u by (auto simp add:algebra_simps scaleR_conv_of_real)
         ultimately show "x \<in> ff ` ll" by (rule rev_image_eqI[of "u"])
       qed
     qed
     moreover have "inj_on ff ll"
       unfolding ff_def using False inj_on_def by fastforce
     ultimately show ?thesis unfolding ll_def 
       using card_image[of ff] by metis
   qed  
   finally show ?thesis by simp
 qed
 
 lemma proots_unbounded_line:
   assumes "st\<noteq>tt" "p\<noteq>0"
   shows "(proots_count p (unbounded_line st tt)) = 
                 (let pc = pcompose p [:st, tt - st:];
                      pR = map_poly Re pc;
                      pI = map_poly Im pc;
                      g  = gcd pR pI
                  in nat (changes_R_smods_ext g (pderiv g)))" (is "?L = ?R")
 proof -
   define pc pR pI g where 
       "pc = pcompose p [:st, tt-st:]" and
       "pR = map_poly Re pc" and
       "pI = map_poly Im pc" and
       "g  = gcd pR pI"
   have [simp]: "g\<noteq>0" "pc\<noteq>0"
   proof -
     show "pc\<noteq>0" using assms(1) assms(2) pc_def pcompose_eq_0 by fastforce
     then have "pR\<noteq>0 \<or> pI\<noteq>0" unfolding pR_def pI_def by (metis cpoly_of_decompose map_poly_0)
     then show "g\<noteq>0" unfolding g_def by simp
   qed
   have order_eq:"order t g = order t pc" for t
     apply (subst order_cpoly_gcd_eq[of pR pI,folded g_def,symmetric])
     subgoal using \<open>g\<noteq>0\<close> unfolding g_def by simp
     subgoal unfolding pR_def pI_def by (simp add:cpoly_of_decompose[symmetric])
     done
 
   have "?R = nat (changes_R_smods_ext g (pderiv g))"
     unfolding pc_def g_def pI_def pR_def by (auto simp add:Let_def)
   also have "... = proots_count g UNIV"
     using sturm_ext_R[OF \<open>g\<noteq>0\<close>] by auto
   also have "... = proots_count (map_poly complex_of_real g) (of_real ` UNIV)"
     apply (subst proots_count_of_real)
     by auto
   also have "... = proots_count (map_poly complex_of_real g) {x. Im x = 0}"
     apply (rule arg_cong2[where f=proots_count])
     using Reals_def complex_is_Real_iff by auto
   also have "... = proots_count pc {x. Im x = 0}"
     apply (rule proots_count_cong)
     apply (metis (mono_tags) Im_complex_of_real Re_complex_of_real \<open>g \<noteq> 0\<close> complex_surj 
             map_poly_order_of_real mem_Collect_eq order_eq)
     by auto
   also have "... = proots_count p (unbounded_line st tt)"
   proof -
     have "poly [:st, tt - st:] ` {x. Im x = 0} = unbounded_line st tt"
       unfolding unbounded_line_def 
       apply safe
       subgoal for _ x 
         apply (rule_tac x="Re x" in exI) 
         apply (simp add:algebra_simps)
         by (simp add: mult.commute scaleR_complex.code times_complex.code)
       subgoal for _ u
         apply (rule rev_image_eqI[of "of_real u"])
         by (auto simp:scaleR_conv_of_real algebra_simps)
       done
     then show ?thesis 
       unfolding pc_def 
       apply (subst proots_pcompose)
       using \<open>p\<noteq>0\<close> \<open>st\<noteq>tt\<close> by auto
   qed
   finally show ?thesis by simp
 qed
 
 lemma proots_unbounded_line_card_code[code]:
   "proots_unbounded_line_card p st tt = 
               (if st\<noteq>tt then 
                 (let pc = pcompose p [:st, tt - st:];
                      pR = map_poly Re pc;
                      pI = map_poly Im pc;
                      g  = gcd pR pI
                  in nat (changes_R_smods g (pderiv g))) 
               else 
                   Code.abort (STR ''proots_unbounded_line_card fails due to invalid hyperplanes.'') 
                       (\<lambda>_. proots_unbounded_line_card p st tt))"
   unfolding proots_unbounded_line_card_def using card_proots_unbounded_line[of st tt p] by auto
 
 lemma proots_unbounded_line_code[code]:
   "proots_unbounded_line p st tt = 
               ( if st\<noteq>tt then 
                 if p\<noteq>0 then 
                   (let pc = pcompose p [:st, tt - st:];
                      pR = map_poly Re pc;
                      pI = map_poly Im pc;
                      g  = gcd pR pI
                   in nat (changes_R_smods_ext g (pderiv g)))
                 else 
                   Code.abort (STR ''proots_unbounded_line fails due to p=0'') 
                       (\<lambda>_. proots_unbounded_line p st tt)
                 else 
                   Code.abort (STR ''proots_unbounded_line fails due to invalid hyperplanes.'') 
                       (\<lambda>_. proots_unbounded_line p st tt) )"
   unfolding proots_unbounded_line_def using proots_unbounded_line by auto
   
 subsection \<open>Checking if there a polynomial root on a closed segment\<close>    
     
 definition no_proots_line::"complex poly \<Rightarrow> complex \<Rightarrow> complex \<Rightarrow> bool" where
   "no_proots_line p st tt = (proots_within p (closed_segment st tt) = {})"
 
 (*TODO: the proof can probably be simplified using Lemma card_proots_open_segments*)
 lemma no_proots_line_code[code]: "no_proots_line p st tt = (if poly p st \<noteq>0 \<and> poly p tt \<noteq> 0 then 
                 (let pc = pcompose p [:st, tt - st:];
                      pR = map_poly Re pc;
                      pI = map_poly Im pc;
                      g  = gcd pR pI
                  in if changes_itv_smods 0 1 g (pderiv g) = 0 then True else False) else False)"
             (is "?L = ?R")
 proof (cases "poly p st \<noteq>0 \<and> poly p tt \<noteq> 0")
   case False
   thus ?thesis unfolding no_proots_line_def by auto
 next
   case True
   then have "poly p st \<noteq> 0" "poly p tt \<noteq> 0" by auto
   define pc pR pI g where 
       "pc = pcompose p [:st, tt-st:]" and
       "pR = map_poly Re pc" and
       "pI = map_poly Im pc" and
       "g  = gcd pR pI"
   have poly_iff:"poly g t=0 \<longleftrightarrow> poly pc t =0" for t
   proof -
     have "poly g t = 0 \<longleftrightarrow> poly pR t =0 \<and> poly pI t =0" 
       unfolding g_def using poly_gcd_iff by auto
     also have "... \<longleftrightarrow> poly pc t =0"
     proof -
       have "cpoly_of pR pI = pc"
         unfolding pc_def pR_def pI_def using cpoly_of_decompose by auto
       then show ?thesis using poly_cpoly_of_real_iff by blast
     qed
     finally show ?thesis by auto
   qed      
   have "?R = (changes_itv_smods 0 1 g (pderiv g) = 0)" 
     using True unfolding pc_def g_def pI_def pR_def
     by (auto simp add:Let_def)      
   also have "... = (card {x. poly g x = 0 \<and> 0 < x \<and> x < 1} = 0)"  
   proof -
     have "poly g 0 \<noteq> 0" 
       using poly_iff[of 0] True unfolding pc_def by (auto simp add:poly_pcompose)
     moreover have "poly g 1 \<noteq> 0" 
       using poly_iff[of 1] True unfolding pc_def by (auto simp add:poly_pcompose)
     ultimately show ?thesis using sturm_interval[of 0 1 g] by auto
   qed
-  also have "... = ({x. poly g x = 0 \<and> 0 < x \<and> x < 1} = {})"
+  also have "... = ({x. poly g (of_real x) = 0 \<and> 0 < x \<and> x < 1} = {})"
   proof -
     have "g\<noteq>0"
     proof (rule ccontr)
       assume "\<not> g \<noteq> 0"
       then have "poly pc 0 =0"
         using poly_iff[of 0] by auto
       then show False using True unfolding pc_def by (auto simp add:poly_pcompose)
     qed
     from poly_roots_finite[OF this] have "finite {x. poly g x = 0 \<and> 0 < x \<and> x < 1}"
       by auto
     then show ?thesis using card_eq_0_iff by auto
   qed
   also have "... = ?L"
   proof -
-    have "(\<exists>t. poly g t = 0 \<and> 0 < t \<and> t < 1) \<longleftrightarrow> (\<exists>t::real. poly pc t = 0 \<and> 0 < t \<and> t < 1)"
+    have "(\<exists>t. poly g (of_real t) = 0 \<and> 0 < t \<and> t < 1) \<longleftrightarrow>
+          (\<exists>t::real. poly pc (of_real t) = 0 \<and> 0 < t \<and> t < 1)"
       using poly_iff by auto
     also have "... \<longleftrightarrow> (\<exists>x. x \<in> closed_segment st tt \<and> poly p x = 0)" 
     proof 
       assume "\<exists>t. poly pc (complex_of_real t) = 0 \<and> 0 < t \<and> t < 1"
       then obtain t where *:"poly pc (of_real t) = 0" and "0 < t" "t < 1" by auto
       define x where "x=poly [:st, tt - st:] t"
       have "x \<in> closed_segment st tt" using \<open>0<t\<close> \<open>t<1\<close> unfolding x_def in_segment
         by (intro exI[where x=t],auto simp add: algebra_simps scaleR_conv_of_real)
       moreover have "poly p x=0" using * unfolding pc_def x_def
         by (auto simp add:poly_pcompose)
       ultimately show "\<exists>x. x \<in> closed_segment st tt \<and> poly p x = 0" by auto
     next
       assume "\<exists>x. x \<in> closed_segment st tt \<and> poly p x = 0"
       then obtain x where "x \<in> closed_segment st tt" "poly p x = 0" by auto
       then obtain t::real where *:"x = (1 - t) *\<^sub>R st + t *\<^sub>R tt" and "0\<le>t" "t\<le>1"  
         unfolding in_segment by auto
       then have "x=poly [:st, tt - st:] t" by (auto simp add: algebra_simps scaleR_conv_of_real)
       then have "poly pc (complex_of_real t) = 0" 
         using \<open>poly p x=0\<close> unfolding pc_def by (auto simp add:poly_pcompose)
       moreover have "t\<noteq>0" "t\<noteq>1" using True *  \<open>poly p x=0\<close> by auto
       then have "0<t" "t<1" using \<open>0\<le>t\<close> \<open>t\<le>1\<close> by auto
       ultimately show "\<exists>t. poly pc (complex_of_real t) = 0 \<and> 0 < t \<and> t < 1" by auto
     qed        
     finally show ?thesis
       unfolding no_proots_line_def proots_within_def 
       by blast
   qed
   finally show ?thesis by simp
 qed
    
 subsection \<open>Counting roots in a rectangle\<close>  
   
 definition proots_rectangle ::"complex poly \<Rightarrow> complex \<Rightarrow> complex \<Rightarrow> nat" where
   "proots_rectangle p lb ub = proots_count p (box lb ub)"  
   
 lemma closed_segment_imp_Re_Im:
   fixes x::complex
   assumes "x\<in>closed_segment lb ub" 
   shows "Re lb \<le> Re ub \<Longrightarrow> Re lb \<le> Re x \<and> Re x \<le> Re ub" 
         "Im lb \<le> Im ub \<Longrightarrow> Im lb \<le> Im x \<and> Im x \<le> Im ub"
 proof -
   obtain u where x_u:"x=(1 - u) *\<^sub>R lb + u *\<^sub>R ub " and "0 \<le> u" "u \<le> 1"
     using assms unfolding closed_segment_def by auto
   have "Re lb \<le> Re x" when "Re lb \<le> Re ub"
   proof -
     have "Re x = Re ((1 - u) *\<^sub>R lb + u *\<^sub>R ub)"
       using x_u by blast
     also have "... = Re (lb + u *\<^sub>R (ub - lb))" by (auto simp add:algebra_simps)
     also have "... = Re lb + u * (Re ub - Re lb)" by auto
     also have "... \<ge> Re lb" using \<open>u\<ge>0\<close> \<open>Re lb \<le> Re ub\<close> by auto
     finally show ?thesis .
   qed
   moreover have "Im lb \<le> Im x" when "Im lb \<le> Im ub"
   proof -
     have "Im x = Im ((1 - u) *\<^sub>R lb + u *\<^sub>R ub)"
       using x_u by blast
     also have "... = Im (lb + u *\<^sub>R (ub - lb))" by (auto simp add:algebra_simps)
     also have "... = Im lb + u * (Im ub - Im lb)" by auto
     also have "... \<ge> Im lb" using \<open>u\<ge>0\<close> \<open>Im lb \<le> Im ub\<close> by auto
     finally show ?thesis .
   qed
   moreover have "Re x \<le> Re ub" when "Re lb \<le> Re ub"
   proof -
     have "Re x = Re ((1 - u) *\<^sub>R lb + u *\<^sub>R ub)"
       using x_u by blast
     also have "... = (1 - u) * Re lb + u * Re ub" by auto
     also have "... \<le> (1 - u) * Re ub + u * Re ub"
       using \<open>u\<le>1\<close> \<open>Re lb \<le> Re ub\<close> by (auto simp add: mult_left_mono)
     also have "... = Re ub" by (auto simp add:algebra_simps)
     finally show ?thesis .
   qed
   moreover have "Im x \<le> Im ub" when "Im lb \<le> Im ub"
   proof -
     have "Im x = Im ((1 - u) *\<^sub>R lb + u *\<^sub>R ub)"
       using x_u by blast
     also have "... = (1 - u) * Im lb + u * Im ub" by auto
     also have "... \<le> (1 - u) * Im ub + u * Im ub"
       using \<open>u\<le>1\<close> \<open>Im lb \<le> Im ub\<close> by (auto simp add: mult_left_mono)
     also have "... = Im ub" by (auto simp add:algebra_simps)
     finally show ?thesis .
   qed
   ultimately show 
       "Re lb \<le> Re ub \<Longrightarrow> Re lb \<le> Re x \<and> Re x \<le> Re ub" 
       "Im lb \<le> Im ub \<Longrightarrow> Im lb \<le> Im x \<and> Im x \<le> Im ub" 
     by auto
 qed
   
 lemma closed_segment_degen_complex:
   "\<lbrakk>Re lb = Re ub; Im lb \<le> Im ub \<rbrakk> 
     \<Longrightarrow> x \<in> closed_segment lb ub \<longleftrightarrow> Re x = Re lb \<and> Im lb \<le> Im x \<and> Im x \<le> Im ub "
   "\<lbrakk>Im lb = Im ub; Re lb \<le> Re ub \<rbrakk> 
     \<Longrightarrow> x \<in> closed_segment lb ub \<longleftrightarrow> Im x = Im lb \<and> Re lb \<le> Re x \<and> Re x \<le> Re ub "  
 proof -
   show "x \<in> closed_segment lb ub \<longleftrightarrow> Re x = Re lb \<and> Im lb \<le> Im x \<and> Im x \<le> Im ub"
     when "Re lb = Re ub" "Im lb \<le> Im ub"
   proof 
     show "Re x = Re lb \<and> Im lb \<le> Im x \<and> Im x \<le> Im ub" when "x \<in> closed_segment lb ub"
       using closed_segment_imp_Re_Im[OF that] \<open>Re lb = Re ub\<close> \<open>Im lb \<le> Im ub\<close> by fastforce
   next
     assume asm:"Re x = Re lb \<and> Im lb \<le> Im x \<and> Im x \<le> Im ub"
     define u where "u=(Im x - Im lb)/ (Im ub - Im lb)"
     have "x = (1 - u) *\<^sub>R lb + u *\<^sub>R ub"
       unfolding u_def using asm \<open>Re lb = Re ub\<close> \<open>Im lb \<le> Im ub\<close>
       apply (intro complex_eqI)
       apply (auto simp add:field_simps)
       apply (cases "Im ub - Im lb =0")
       apply (auto simp add:field_simps)
       done
     moreover have "0\<le>u" "u\<le>1" unfolding u_def 
       using \<open>Im lb \<le> Im ub\<close> asm
       by (cases "Im ub - Im lb =0",auto simp add:field_simps)+
     ultimately show "x \<in> closed_segment lb ub" unfolding closed_segment_def by auto
   qed
   show "x \<in> closed_segment lb ub \<longleftrightarrow> Im x = Im lb \<and> Re lb \<le> Re x \<and> Re x \<le> Re ub"
     when "Im lb = Im ub" "Re lb \<le> Re ub"
   proof 
     show "Im x = Im lb \<and> Re lb \<le> Re x \<and> Re x \<le> Re ub" when "x \<in> closed_segment lb ub"
       using closed_segment_imp_Re_Im[OF that] \<open>Im lb = Im ub\<close> \<open>Re lb \<le> Re ub\<close> by fastforce
   next
     assume asm:"Im x = Im lb \<and> Re lb \<le> Re x \<and> Re x \<le> Re ub"
     define u where "u=(Re x - Re lb)/ (Re ub - Re lb)"
     have "x = (1 - u) *\<^sub>R lb + u *\<^sub>R ub"
       unfolding u_def using asm \<open>Im lb = Im ub\<close> \<open>Re lb \<le> Re ub\<close>
       apply (intro complex_eqI)
        apply (auto simp add:field_simps)
       apply (cases "Re ub - Re lb =0")
        apply (auto simp add:field_simps)
       done
     moreover have "0\<le>u" "u\<le>1" unfolding u_def 
       using \<open>Re lb \<le> Re ub\<close> asm
       by (cases "Re ub - Re lb =0",auto simp add:field_simps)+
     ultimately show "x \<in> closed_segment lb ub" unfolding closed_segment_def by auto
   qed   
 qed  
    
 lemma complex_box_ne_empty: 
   fixes a b::complex
   shows 
     "cbox a b \<noteq> {} \<longleftrightarrow> (Re a \<le> Re b \<and> Im a \<le> Im b)"
     "box a b \<noteq> {} \<longleftrightarrow> (Re a < Re b \<and> Im a < Im b)"
   by (auto simp add:box_ne_empty Basis_complex_def)  
       
 lemma proots_rectangle_code1:
   "proots_rectangle p lb ub = (if Re lb < Re ub \<and> Im lb < Im ub then 
             if p\<noteq>0 then 
             if no_proots_line p lb (Complex (Re ub) (Im lb))
             \<and> no_proots_line p (Complex (Re ub) (Im lb)) ub
             \<and> no_proots_line p ub (Complex (Re lb) (Im ub))
             \<and> no_proots_line p (Complex (Re lb) (Im ub)) lb then  
             (
             let p1 = pcompose p [:lb,  Complex (Re ub - Re lb) 0:];
                 pR1 = map_poly Re p1; pI1 = map_poly Im p1; gc1 = gcd pR1 pI1;
                 p2 = pcompose p [:Complex (Re ub) (Im lb), Complex 0 (Im ub - Im lb):];
                 pR2 = map_poly Re p2; pI2 = map_poly Im p2; gc2 = gcd pR2 pI2;
                 p3 = pcompose p [:ub, Complex (Re lb - Re ub) 0:];
                 pR3 = map_poly Re p3; pI3 = map_poly Im p3; gc3 = gcd pR3 pI3;
                 p4 = pcompose p [:Complex (Re lb) (Im ub), Complex 0 (Im lb - Im ub):];
                 pR4 = map_poly Re p4; pI4 = map_poly Im p4; gc4 = gcd pR4 pI4
             in 
               nat (- (changes_alt_itv_smods 0 1 (pR1 div gc1) (pI1 div gc1)
                 + changes_alt_itv_smods 0 1 (pR2 div gc2) (pI2 div gc2)
                 + changes_alt_itv_smods 0 1 (pR3 div gc3) (pI3 div gc3)
                 + changes_alt_itv_smods 0 1 (pR4 div gc4) (pI4 div gc4))  div 4)
             )
             else Code.abort (STR ''proots_rectangle fails when there is a root on the border.'') 
             (\<lambda>_. proots_rectangle p lb ub)
             else Code.abort (STR ''proots_rectangle fails when p=0.'') 
             (\<lambda>_. proots_rectangle p lb ub)
             else 0)"
 proof -
   have ?thesis when "\<not> (Re lb < Re ub \<and> Im lb < Im ub)" 
   proof -
     have "box lb ub = {}" using complex_box_ne_empty[of lb ub] that by auto
     then have "proots_rectangle p lb ub = 0" unfolding proots_rectangle_def by auto
     then show ?thesis by (simp add:that) 
   qed
   moreover have ?thesis when "Re lb < Re ub \<and> Im lb < Im ub" "p=0"
     using that by simp
   moreover have ?thesis when     
             "Re lb < Re ub" "Im lb < Im ub" "p\<noteq>0" 
             and no_proots:
             "no_proots_line p lb (Complex (Re ub) (Im lb))"
             "no_proots_line p (Complex (Re ub) (Im lb)) ub"
             "no_proots_line p ub (Complex (Re lb) (Im ub))"
             "no_proots_line p (Complex (Re lb) (Im ub)) lb"
   proof -
     define l1 where "l1 = linepath lb (Complex (Re ub) (Im lb))"
     define l2 where "l2 = linepath (Complex (Re ub) (Im lb)) ub"
     define l3 where "l3 = linepath ub (Complex (Re lb) (Im ub))"
     define l4 where "l4 = linepath (Complex (Re lb) (Im ub)) lb"
     define rec where "rec = l1 +++ l2 +++ l3 +++ l4"
     have valid[simp]:"valid_path rec" and loop[simp]:"pathfinish rec = pathstart rec"
       unfolding rec_def l1_def l2_def l3_def l4_def by auto
     have path_no_proots:"path_image rec \<inter> proots p = {}" 
       unfolding rec_def l1_def l2_def l3_def l4_def
       apply (subst path_image_join,simp_all del:Complex_eq)+  
       using no_proots[unfolded no_proots_line_def] by (auto simp del:Complex_eq)
     
     define g1 where "g1 = poly p o l1" 
     define g2 where "g2 = poly p o l2" 
     define g3 where "g3 = poly p o l3" 
     define g4 where "g4 = poly p o l4"    
     have [simp]: "path g1" "path g2" "path g3" "path g4"
       "pathfinish g1 = pathstart g2" "pathfinish g2 = pathstart g3" "pathfinish g3 = pathstart g4"
       "pathfinish g4 = pathstart g1"
       unfolding g1_def g2_def g3_def g4_def l1_def l2_def l3_def l4_def
       by (auto intro!: path_continuous_image continuous_intros 
           simp add:pathfinish_compose pathstart_compose)
     have [simp]: "finite_ReZ_segments g1 0" "finite_ReZ_segments g2 0" 
          "finite_ReZ_segments g3 0" "finite_ReZ_segments g4 0"
       unfolding g1_def l1_def g2_def l2_def g3_def l3_def g4_def l4_def poly_linepath_comp 
       by (rule finite_ReZ_segments_poly_of_real)+
     define p1 pR1 pI1 gc1
            p2 pR2 pI2 gc2
            p3 pR3 pI3 gc3
            p4 pR4 pI4 gc4
       where "p1 = pcompose p [:lb,  Complex (Re ub - Re lb) 0:]"
              and "pR1 = map_poly Re p1" and "pI1 = map_poly Im p1" and "gc1 = gcd pR1 pI1"
              and "p2 = pcompose p [:Complex (Re ub) (Im lb), Complex 0 (Im ub - Im lb):]"
              and "pR2 = map_poly Re p2" and "pI2 = map_poly Im p2" and "gc2 = gcd pR2 pI2"
              and "p3 = pcompose p [:ub, Complex (Re lb - Re ub) 0:]"
              and "pR3 = map_poly Re p3" and "pI3 = map_poly Im p3" and "gc3 = gcd pR3 pI3"
              and "p4 = pcompose p [:Complex (Re lb) (Im ub), Complex 0 (Im lb - Im ub):]"
              and "pR4 = map_poly Re p4" and "pI4 = map_poly Im p4" and "gc4 = gcd pR4 pI4"
     have "gc1\<noteq>0" "gc2\<noteq>0" "gc3\<noteq>0" "gc4\<noteq>0"
     proof -
       show "gc1\<noteq>0" 
       proof (rule ccontr)
         assume "\<not> gc1 \<noteq> 0"
         then have "pI1 = 0" "pR1 = 0" unfolding gc1_def by auto
         then have "p1 = 0" unfolding pI1_def pR1_def 
           by (metis cpoly_of_decompose map_poly_0)
         then have "p=0" unfolding p1_def using \<open>Re lb < Re ub\<close>
           by (auto elim!:pcompose_eq_0 simp add:Complex_eq_0)
         then show False using \<open>p\<noteq>0\<close> by simp
       qed
       show "gc2\<noteq>0" 
       proof (rule ccontr)
         assume "\<not> gc2 \<noteq> 0"
         then have "pI2 = 0" "pR2 = 0" unfolding gc2_def by auto
         then have "p2 = 0" unfolding pI2_def pR2_def 
           by (metis cpoly_of_decompose map_poly_0)
         then have "p=0" unfolding p2_def using \<open>Im lb < Im ub\<close>
           by (auto elim!:pcompose_eq_0 simp add:Complex_eq_0)
         then show False using \<open>p\<noteq>0\<close> by simp
       qed 
       show "gc3\<noteq>0" 
       proof (rule ccontr)
         assume "\<not> gc3 \<noteq> 0"
         then have "pI3 = 0" "pR3 = 0" unfolding gc3_def by auto
         then have "p3 = 0" unfolding pI3_def pR3_def 
           by (metis cpoly_of_decompose map_poly_0)
         then have "p=0" unfolding p3_def using \<open>Re lb < Re ub\<close>
           by (auto elim!:pcompose_eq_0 simp add:Complex_eq_0)
         then show False using \<open>p\<noteq>0\<close> by simp
       qed
       show "gc4\<noteq>0" 
       proof (rule ccontr)
         assume "\<not> gc4 \<noteq> 0"
         then have "pI4 = 0" "pR4 = 0" unfolding gc4_def by auto
         then have "p4 = 0" unfolding pI4_def pR4_def 
           by (metis cpoly_of_decompose map_poly_0)
         then have "p=0" unfolding p4_def using \<open>Im lb < Im ub\<close>
           by (auto elim!:pcompose_eq_0 simp add:Complex_eq_0)
         then show False using \<open>p\<noteq>0\<close> by simp
       qed 
     qed
     define sms where 
       "sms = (changes_alt_itv_smods 0 1 (pR1 div gc1) (pI1 div gc1)
                 + changes_alt_itv_smods 0 1 (pR2 div gc2) (pI2 div gc2)
                 + changes_alt_itv_smods 0 1 (pR3 div gc3) (pI3 div gc3)
                 + changes_alt_itv_smods 0 1 (pR4 div gc4) (pI4 div gc4))"
     have "proots_rectangle p lb ub = (\<Sum>r\<in>proots p. winding_number rec r * (order r p))" 
     proof -
       have "winding_number rec x * of_nat (order x p) = 0" 
         when "x\<in>proots p - proots_within p (box lb ub)" for x 
       proof -
         have *:"cbox lb ub = box lb ub \<union> path_image rec"
         proof -
           have "x\<in>cbox lb ub" when "x\<in>box lb ub \<union> path_image rec" for x
             using that \<open>Re lb<Re ub\<close> \<open>Im lb<Im ub\<close>
             unfolding box_def cbox_def Basis_complex_def rec_def l1_def l2_def l3_def l4_def
             apply (auto simp add:path_image_join closed_segment_degen_complex)          
                    apply (subst (asm) closed_segment_commute,simp add: closed_segment_degen_complex)+
             done  
           moreover have "x\<in>box lb ub \<union> path_image rec" when "x\<in>cbox lb ub" for x
             using that
             unfolding box_def cbox_def Basis_complex_def rec_def l1_def l2_def l3_def l4_def
             apply (auto simp add:path_image_join closed_segment_degen_complex)
              apply (subst (asm) (1 2) closed_segment_commute,simp add:closed_segment_degen_complex)+
             done
           ultimately show ?thesis by auto
         qed
         moreover have "x\<notin>path_image rec" 
           using path_no_proots that by auto
         ultimately have "x\<notin>cbox lb ub" using that by simp
         from winding_number_zero_outside[OF valid_path_imp_path[OF valid] _ loop this,simplified] * 
         have "winding_number rec x = 0" by auto
         then show ?thesis by auto
       qed
       moreover have "of_nat (order x p) = winding_number rec x * of_nat (order x p)" when 
         "x \<in> proots_within p (box lb ub)" for x 
       proof -
         have "x\<in>box lb ub" using that unfolding proots_within_def by auto 
         then have order_asms:"Re lb < Re x" "Re x < Re ub" "Im lb < Im x" "Im x < Im ub"  
           by (auto simp add:box_def Basis_complex_def)  
         have "winding_number rec x = 1"
           unfolding rec_def l1_def l2_def l3_def l4_def 
         proof eval_winding 
           let ?l1 = "linepath lb (Complex (Re ub) (Im lb))"
           and ?l2 = "linepath (Complex (Re ub) (Im lb)) ub"
           and ?l3 = "linepath ub (Complex (Re lb) (Im ub))"
           and ?l4 = "linepath (Complex (Re lb) (Im ub)) lb"
           show l1: "x \<notin> path_image ?l1" and l2: "x \<notin> path_image ?l2" and 
                l3: "x \<notin> path_image ?l3" and l4:"x \<notin> path_image ?l4"
             using no_proots that unfolding no_proots_line_def by auto
           show "- of_real (cindex_pathE ?l1 x + (cindex_pathE ?l2 x +
             (cindex_pathE ?l3 x + cindex_pathE ?l4 x))) = 2 * 1"
           proof -
             have "(Im x - Im ub) * (Re ub - Re lb) < 0" 
               using mult_less_0_iff order_asms(1) order_asms(2) order_asms(4) by fastforce
             then have "cindex_pathE ?l3 x = -1" 
               apply (subst cindex_pathE_linepath)
               using l3 by (auto simp add:algebra_simps order_asms)
             moreover have "(Im lb - Im x) * (Re ub - Re lb) <0" 
               using mult_less_0_iff order_asms(1) order_asms(2) order_asms(3) by fastforce
             then have "cindex_pathE ?l1 x = -1"    
               apply (subst cindex_pathE_linepath)
               using l1 by (auto simp add:algebra_simps order_asms)  
             moreover have "cindex_pathE ?l2 x = 0"    
               apply (subst cindex_pathE_linepath)
               using l2 order_asms by auto
             moreover have "cindex_pathE ?l4 x = 0"
               apply (subst cindex_pathE_linepath)
               using l4 order_asms by auto
             ultimately show ?thesis by auto
           qed
         qed
         then show ?thesis by auto
       qed 
       ultimately show ?thesis using \<open>p\<noteq>0\<close>
       unfolding proots_rectangle_def proots_count_def 
         by (auto intro!: sum.mono_neutral_cong_left[of "proots p" "proots_within p (box lb ub)"])
     qed    
     also have "... = 1/(2 * of_real pi * \<i>) *contour_integral rec (\<lambda>x. deriv (poly p) x / poly p x)"
     proof -
       have "contour_integral rec (\<lambda>x. deriv (poly p) x / poly p x) = 2 * of_real pi * \<i> 
               * (\<Sum>x | poly p x = 0. winding_number rec x * of_int (zorder (poly p) x))"
       proof (rule argument_principle[of UNIV "poly p" "{}" "\<lambda>_. 1" rec,simplified])
         show "connected (UNIV::complex set)" using connected_UNIV[where 'a=complex] .
         show "path_image rec \<subseteq> UNIV - {x. poly p x = 0}" 
           using path_no_proots unfolding proots_within_def by auto
         show "finite {x. poly p x = 0}" by (simp add: poly_roots_finite that(3))
       qed
       also have " ... = 2 * of_real pi * \<i> * (\<Sum>x\<in>proots p. winding_number rec x * (order x p))" 
         unfolding proots_within_def 
         apply (auto intro!:sum.cong simp add:order_zorder[OF \<open>p\<noteq>0\<close>] )
         by (metis nat_eq_iff2 of_nat_nat order_root order_zorder that(3))
       finally show ?thesis by auto
     qed  
     also have "... = winding_number (poly p \<circ> rec) 0"
     proof -
       have "0 \<notin> path_image (poly p \<circ> rec)" 
         using path_no_proots unfolding path_image_compose proots_within_def by fastforce
       from winding_number_comp[OF _ poly_holomorphic_on _ _ this,of UNIV,simplified]
       show ?thesis by auto
     qed
     also have winding_eq:"... = - cindex_pathE (poly p \<circ> rec) 0 / 2"
     proof (rule winding_number_cindex_pathE)
       show "finite_ReZ_segments (poly p \<circ> rec) 0"
         unfolding rec_def path_compose_join 
         apply (fold g1_def g2_def g3_def g4_def)
         by (auto intro!: finite_ReZ_segments_joinpaths path_join_imp)
       show "valid_path (poly p \<circ> rec)"
         by (rule valid_path_compose_holomorphic[where S=UNIV]) auto
       show "0 \<notin> path_image (poly p \<circ> rec)"
         using path_no_proots unfolding path_image_compose proots_def by fastforce
       show "pathfinish (poly p \<circ> rec) = pathstart (poly p \<circ> rec)"
         unfolding rec_def pathstart_compose pathfinish_compose  by (auto simp add:l1_def l4_def)   
     qed
     also have cindex_pathE_eq:"... = of_int (- sms) / of_int 4"
     proof -
       have "cindex_pathE (poly p \<circ> rec) 0 = cindex_pathE (g1+++g2+++g3+++g4) 0"
         unfolding rec_def path_compose_join g1_def g2_def g3_def g4_def by simp
       also have "... = cindex_pathE g1 0 + cindex_pathE g2 0 + cindex_pathE g3 0 + cindex_pathE g4 0"
         by (subst cindex_pathE_joinpaths,auto intro!:finite_ReZ_segments_joinpaths)+
       also have "... = cindex_polyE 0 1 (pI1 div gc1) (pR1 div gc1)
                      + cindex_polyE 0 1 (pI2 div gc2) (pR2 div gc2)
                      + cindex_polyE 0 1 (pI3 div gc3) (pR3 div gc3)
                      + cindex_polyE 0 1 (pI4 div gc4) (pR4 div gc4)"
       proof - 
         have "cindex_pathE g1 0 = cindex_polyE 0 1 (pI1 div gc1) (pR1 div gc1)"
         proof -
           have *:"g1 = poly p1 o of_real"
             unfolding g1_def p1_def l1_def poly_linepath_comp
             by (subst (5) complex_surj[symmetric],simp)
           then have "cindex_pathE g1 0  = cindexE 0 1 (\<lambda>t. poly pI1 t / poly pR1 t)"
             unfolding cindex_pathE_def pR1_def pI1_def 
             by (simp add:Im_poly_of_real Re_poly_of_real)
           also have "... = cindex_polyE 0 1 pI1 pR1"
             using cindexE_eq_cindex_polyE by auto
           also have "... = cindex_polyE 0 1 (pI1 div gc1) (pR1 div gc1)"
             using \<open>gc1\<noteq>0\<close>
             apply (subst (2) cindex_polyE_mult_cancel[of gc1,symmetric])
             by (simp_all add: gc1_def)  
           finally show ?thesis .
         qed
         moreover have "cindex_pathE g2 0 = cindex_polyE 0 1 (pI2 div gc2) (pR2 div gc2)"
         proof -
           have "g2 = poly p2 o of_real"
             unfolding g2_def p2_def l2_def poly_linepath_comp
             by (subst (5) complex_surj[symmetric],simp)
           then have "cindex_pathE g2 0  = cindexE 0 1 (\<lambda>t. poly pI2 t / poly pR2 t)"
             unfolding cindex_pathE_def pR2_def pI2_def 
             by (simp add:Im_poly_of_real Re_poly_of_real)
           also have "... = cindex_polyE 0 1 pI2 pR2"
             using cindexE_eq_cindex_polyE by auto
           also have "... = cindex_polyE 0 1 (pI2 div gc2) (pR2 div gc2)"
             using \<open>gc2\<noteq>0\<close>
             apply (subst (2) cindex_polyE_mult_cancel[of gc2,symmetric])
               by (simp_all add: gc2_def)
           finally show ?thesis .
         qed  
         moreover have "cindex_pathE g3 0 = cindex_polyE 0 1 (pI3 div gc3) (pR3 div gc3)"
         proof -
           have "g3 = poly p3 o of_real"
             unfolding g3_def p3_def l3_def poly_linepath_comp
             by (subst (5) complex_surj[symmetric],simp)
           then have "cindex_pathE g3 0  = cindexE 0 1 (\<lambda>t. poly pI3 t / poly pR3 t)"
             unfolding cindex_pathE_def pR3_def pI3_def 
             by (simp add:Im_poly_of_real Re_poly_of_real)
           also have "... = cindex_polyE 0 1 pI3 pR3"
             using cindexE_eq_cindex_polyE by auto
           also have "... = cindex_polyE 0 1 (pI3 div gc3) (pR3 div gc3)"
             using \<open>gc3\<noteq>0\<close>
             apply (subst (2) cindex_polyE_mult_cancel[of gc3,symmetric])
             by (simp_all add: gc3_def)
           finally show ?thesis .
         qed     
         moreover have "cindex_pathE g4 0 = cindex_polyE 0 1 (pI4 div gc4) (pR4 div gc4)"
         proof -
           have "g4 = poly p4 o of_real"
             unfolding g4_def p4_def l4_def poly_linepath_comp
             by (subst (5) complex_surj[symmetric],simp)
           then have "cindex_pathE g4 0  = cindexE 0 1 (\<lambda>t. poly pI4 t / poly pR4 t)"
             unfolding cindex_pathE_def pR4_def pI4_def 
             by (simp add:Im_poly_of_real Re_poly_of_real)
           also have "... = cindex_polyE 0 1 pI4 pR4"
             using cindexE_eq_cindex_polyE by auto
           also have "... = cindex_polyE 0 1 (pI4 div gc4) (pR4 div gc4)"
             using \<open>gc4\<noteq>0\<close>
             apply (subst (2) cindex_polyE_mult_cancel[of gc4,symmetric])
             by (simp_all add: gc4_def)
           finally show ?thesis .
         qed      
         ultimately show ?thesis by auto
       qed
       also have "... = sms / 2" 
       proof -
         have "cindex_polyE 0 1 (pI1 div gc1) (pR1 div gc1) 
             = changes_alt_itv_smods 0 1 (pR1 div gc1) (pI1 div gc1) / 2"
           apply (rule cindex_polyE_changes_alt_itv_mods)
           using \<open>gc1\<noteq>0\<close> unfolding gc1_def by (auto intro:div_gcd_coprime) 
         moreover have "cindex_polyE 0 1 (pI2 div gc2) (pR2 div gc2) 
             = changes_alt_itv_smods 0 1 (pR2 div gc2) (pI2 div gc2) / 2"
           apply (rule cindex_polyE_changes_alt_itv_mods)
           using \<open>gc2\<noteq>0\<close> unfolding gc2_def by (auto intro:div_gcd_coprime)    
         moreover have "cindex_polyE 0 1 (pI3 div gc3) (pR3 div gc3) 
             = changes_alt_itv_smods 0 1 (pR3 div gc3) (pI3 div gc3) / 2"
           apply (rule cindex_polyE_changes_alt_itv_mods)
           using \<open>gc3\<noteq>0\<close> unfolding gc3_def by (auto intro:div_gcd_coprime)    
         moreover have "cindex_polyE 0 1 (pI4 div gc4) (pR4 div gc4) 
             = changes_alt_itv_smods 0 1 (pR4 div gc4) (pI4 div gc4) / 2"
           apply (rule cindex_polyE_changes_alt_itv_mods)
           using \<open>gc4\<noteq>0\<close> unfolding gc4_def by (auto intro:div_gcd_coprime)
         ultimately show ?thesis unfolding sms_def by auto
       qed
       finally have *:"cindex_pathE (poly p \<circ> rec) 0 = real_of_int sms / 2" .
       show ?thesis 
         apply (subst *)
         by auto
     qed  
     finally have "(of_nat::_\<Rightarrow>complex) (proots_rectangle p lb ub) = of_int (- sms) / of_int 4" .
     moreover have "4 dvd sms" 
     proof -
       have "winding_number (poly p \<circ> rec) 0 \<in> \<int>"
       proof (rule integer_winding_number)
         show "path (poly p \<circ> rec)"
           by (auto intro!:valid_path_compose_holomorphic[where S=UNIV] valid_path_imp_path)
         show "pathfinish (poly p \<circ> rec) = pathstart (poly p \<circ> rec)"
           unfolding rec_def path_compose_join
           by (auto simp add:l1_def l4_def pathfinish_compose pathstart_compose)
         show "0 \<notin> path_image (poly p \<circ> rec)"
           using path_no_proots unfolding path_image_compose proots_def by fastforce
       qed         
       then have "of_int (- sms) / of_int 4 \<in> (\<int>::complex set)"
         by (simp only: winding_eq cindex_pathE_eq)
       then show ?thesis by (subst (asm) dvd_divide_Ints_iff[symmetric],auto) 
     qed
     ultimately have "proots_rectangle p lb ub = nat (- sms div 4)"
       apply (subst (asm) of_int_div_field[symmetric])
       by (simp,metis nat_int of_int_eq_iff of_int_of_nat_eq)
     then show ?thesis 
       unfolding Let_def
       apply (fold p1_def p2_def p3_def p4_def pI1_def pR1_def pI2_def pR2_def pI3_def pR3_def
           pI4_def pR4_def gc1_def gc2_def gc3_def gc4_def)
       apply (fold sms_def)
       using that by auto
   qed
   ultimately show ?thesis by fastforce
 qed
   
 (*further refinement*)
 lemma proots_rectangle_code2[code]:
   "proots_rectangle p lb ub = (if Re lb < Re ub \<and> Im lb < Im ub then 
             if p\<noteq>0 then 
             if poly p lb \<noteq> 0 \<and> poly p (Complex (Re ub) (Im lb)) \<noteq>0 
                \<and> poly p ub \<noteq>0 \<and> poly p (Complex (Re lb) (Im ub)) \<noteq>0 
             then
               (let p1 = pcompose p [:lb,  Complex (Re ub - Re lb) 0:];
                 pR1 = map_poly Re p1; pI1 = map_poly Im p1; gc1 = gcd pR1 pI1;
                 p2 = pcompose p [:Complex (Re ub) (Im lb), Complex 0 (Im ub - Im lb):];
                 pR2 = map_poly Re p2; pI2 = map_poly Im p2; gc2 = gcd pR2 pI2;
                 p3 = pcompose p [:ub, Complex (Re lb - Re ub) 0:];
                 pR3 = map_poly Re p3; pI3 = map_poly Im p3; gc3 = gcd pR3 pI3;
                 p4 = pcompose p [:Complex (Re lb) (Im ub), Complex 0 (Im lb - Im ub):];
                 pR4 = map_poly Re p4; pI4 = map_poly Im p4; gc4 = gcd pR4 pI4
               in
                 if changes_itv_smods 0 1 gc1 (pderiv gc1) = 0
                    \<and> changes_itv_smods 0 1 gc2 (pderiv gc2) = 0 
                    \<and> changes_itv_smods 0 1 gc3 (pderiv gc3) = 0
                    \<and> changes_itv_smods 0 1 gc4 (pderiv gc4) = 0
                 then 
                    nat (- (changes_alt_itv_smods 0 1 (pR1 div gc1) (pI1 div gc1)
                     + changes_alt_itv_smods 0 1 (pR2 div gc2) (pI2 div gc2)
                     + changes_alt_itv_smods 0 1 (pR3 div gc3) (pI3 div gc3)
                     + changes_alt_itv_smods 0 1 (pR4 div gc4) (pI4 div gc4)) div 4)
                 else Code.abort (STR ''proots_rectangle fails when there is a root on the border.'') 
                         (\<lambda>_. proots_rectangle p lb ub))
             else Code.abort (STR ''proots_rectangle fails when there is a root on the border.'') 
               (\<lambda>_. proots_rectangle p lb ub)  
             else Code.abort (STR ''proots_rectangle fails when p=0.'') 
             (\<lambda>_. proots_rectangle p lb ub)
             else 0)"
 proof -
   define p1 pR1 pI1 gc1
            p2 pR2 pI2 gc2
            p3 pR3 pI3 gc3
            p4 pR4 pI4 gc4
       where "p1 = pcompose p [:lb,  Complex (Re ub - Re lb) 0:]"
              and "pR1 = map_poly Re p1" and "pI1 = map_poly Im p1" and "gc1 = gcd pR1 pI1"
              and "p2 = pcompose p [:Complex (Re ub) (Im lb), Complex 0 (Im ub - Im lb):]"
              and "pR2 = map_poly Re p2" and "pI2 = map_poly Im p2" and "gc2 = gcd pR2 pI2"
              and "p3 = pcompose p [:ub, Complex (Re lb - Re ub) 0:]"
              and "pR3 = map_poly Re p3" and "pI3 = map_poly Im p3" and "gc3 = gcd pR3 pI3"
              and "p4 = pcompose p [:Complex (Re lb) (Im ub), Complex 0 (Im lb - Im ub):]"
              and "pR4 = map_poly Re p4" and "pI4 = map_poly Im p4" and "gc4 = gcd pR4 pI4" 
   define sms where 
       "sms = (- (changes_alt_itv_smods 0 1 (pR1 div gc1) (pI1 div gc1) +
                        changes_alt_itv_smods 0 1 (pR2 div gc2) (pI2 div gc2) +
                        changes_alt_itv_smods 0 1 (pR3 div gc3) (pI3 div gc3) +
                        changes_alt_itv_smods 0 1 (pR4 div gc4) (pI4 div gc4)) div
                     4)"
   have more_folds:"p1 = p \<circ>\<^sub>p [:lb, Complex (Re ub) (Im lb) - lb:]"
     "p2 = p \<circ>\<^sub>p [:Complex (Re ub) (Im lb), ub - Complex (Re ub) (Im lb):]"
     "p3 = p \<circ>\<^sub>p [:ub, Complex (Re lb) (Im ub) - ub:]"
     "p4 = p \<circ>\<^sub>p [:Complex (Re lb) (Im ub), lb - Complex (Re lb) (Im ub):]"
     subgoal unfolding p1_def 
       by (subst (10) complex_surj[symmetric],auto simp add:minus_complex.code)
     subgoal unfolding p2_def by (subst (10) complex_surj[symmetric],auto)
     subgoal unfolding p3_def by (subst (10) complex_surj[symmetric],auto simp add:minus_complex.code)
     subgoal unfolding p4_def by (subst (10) complex_surj[symmetric],auto)
     done    
   show ?thesis 
     apply (subst proots_rectangle_code1)
     apply (unfold no_proots_line_code Let_def)
     apply (fold p1_def p2_def p3_def p4_def pI1_def pR1_def pI2_def pR2_def pI3_def pR3_def
           pI4_def pR4_def gc1_def gc2_def gc3_def gc4_def more_folds)
     apply (fold sms_def)
     by presburger 
 qed  
 
 subsection \<open>Polynomial roots on the upper half-plane\<close>
 
 \<comment> \<open>Roots counted WITH multiplicity\<close>
 definition proots_upper ::"complex poly \<Rightarrow> nat" where
   "proots_upper p= proots_count p {z. Im z>0}"
 
 \<comment> \<open>Roots counted WITHOUT multiplicity\<close>
 definition proots_upper_card::"complex poly \<Rightarrow> nat" where 
   "proots_upper_card p = card (proots_within p {x. Im x >0})"
 
 lemma Im_Ln_tendsto_at_top: "((\<lambda>x. Im (Ln (Complex a x))) \<longlongrightarrow> pi/2 ) at_top " 
 proof (cases "a=0")
   case False
   define f where "f=(\<lambda>x. if a>0 then arctan (x/a) else arctan (x/a) + pi)"
   define g where "g=(\<lambda>x. Im (Ln (Complex a x)))"
   have "(f \<longlongrightarrow> pi / 2) at_top"
   proof (cases "a>0")
     case True
     then have "(f \<longlongrightarrow> pi / 2) at_top \<longleftrightarrow> ((\<lambda>x. arctan (x * inverse a)) \<longlongrightarrow> pi / 2) at_top"
       unfolding f_def field_class.field_divide_inverse by auto
     also have "... \<longleftrightarrow> (arctan \<longlongrightarrow> pi / 2) at_top"
       apply (subst filterlim_at_top_linear_iff[of "inverse a" arctan 0 "nhds (pi/2)",simplified])
       using True by auto
     also have "..." using tendsto_arctan_at_top .
     finally show ?thesis .    
   next
     case False
     then have "(f \<longlongrightarrow> pi / 2) at_top \<longleftrightarrow> ((\<lambda>x. arctan (x * inverse a) + pi) \<longlongrightarrow> pi / 2) at_top"
       unfolding f_def field_class.field_divide_inverse by auto
     also have "... \<longleftrightarrow> ((\<lambda>x. arctan (x * inverse a)) \<longlongrightarrow> - pi / 2) at_top"
       apply (subst tendsto_add_const_iff[of "-pi",symmetric])
       by auto
     also have "... \<longleftrightarrow> (arctan \<longlongrightarrow> - pi / 2) at_bot"
       apply (subst filterlim_at_top_linear_iff[of "inverse a" arctan 0,simplified])
       using False \<open>a\<noteq>0\<close> by auto
     also have "..." using tendsto_arctan_at_bot by simp
     finally show ?thesis .
   qed
   moreover have "\<forall>\<^sub>F x in at_top. f x = g x"
     unfolding f_def g_def using \<open>a\<noteq>0\<close>
     apply (subst Im_Ln_eq)
     subgoal for x using Complex_eq_0 by blast
     subgoal unfolding eventually_at_top_linorder by auto
     done
   ultimately show ?thesis 
     using tendsto_cong[of f g at_top] unfolding g_def by auto
 next
   case True
   show ?thesis
     apply (rule tendsto_eventually)
     apply (rule eventually_at_top_linorderI[of 1])
     using True by (subst Im_Ln_eq,auto simp add:Complex_eq_0) 
 qed
   
 lemma Im_Ln_tendsto_at_bot: "((\<lambda>x. Im (Ln (Complex a x))) \<longlongrightarrow> - pi/2 ) at_bot " 
 proof (cases "a=0")
   case False
   define f where "f=(\<lambda>x. if a>0 then arctan (x/a) else arctan (x/a) - pi)"
   define g where "g=(\<lambda>x. Im (Ln (Complex a x)))"
   have "(f \<longlongrightarrow> - pi / 2) at_bot"
   proof (cases "a>0")
     case True
     then have "(f \<longlongrightarrow> - pi / 2) at_bot \<longleftrightarrow> ((\<lambda>x. arctan (x * inverse a)) \<longlongrightarrow> - pi / 2) at_bot"
       unfolding f_def field_class.field_divide_inverse by auto
     also have "... \<longleftrightarrow> (arctan \<longlongrightarrow> - pi / 2) at_bot"
       apply (subst filterlim_at_bot_linear_iff[of "inverse a" arctan 0,simplified])
       using True by auto
     also have "..." using tendsto_arctan_at_bot by simp
     finally show ?thesis .    
   next
     case False
     then have "(f \<longlongrightarrow> - pi / 2) at_bot \<longleftrightarrow> ((\<lambda>x. arctan (x * inverse a) - pi) \<longlongrightarrow> - pi / 2) at_bot"
       unfolding f_def field_class.field_divide_inverse by auto
     also have "... \<longleftrightarrow> ((\<lambda>x. arctan (x * inverse a)) \<longlongrightarrow> pi / 2) at_bot"
       apply (subst tendsto_add_const_iff[of "pi",symmetric])
       by auto
     also have "... \<longleftrightarrow> (arctan \<longlongrightarrow> pi / 2) at_top"
       apply (subst filterlim_at_bot_linear_iff[of "inverse a" arctan 0,simplified])
       using False \<open>a\<noteq>0\<close> by auto
     also have "..." using tendsto_arctan_at_top by simp
     finally show ?thesis .
   qed
   moreover have "\<forall>\<^sub>F x in at_bot. f x = g x"
     unfolding f_def g_def using \<open>a\<noteq>0\<close>
     apply (subst Im_Ln_eq)
     subgoal for x using Complex_eq_0 by blast
     subgoal unfolding eventually_at_bot_linorder by (auto intro:exI[where x="-1"])
     done
   ultimately show ?thesis 
     using tendsto_cong[of f g at_bot] unfolding g_def by auto
 next
   case True
   show ?thesis
     apply (rule tendsto_eventually)  
     apply (rule eventually_at_bot_linorderI[of "-1"])
     using True by (subst Im_Ln_eq,auto simp add:Complex_eq_0)
 qed
   
 lemma Re_winding_number_tendsto_part_circlepath:
   shows "((\<lambda>r. Re (winding_number (part_circlepath z0 r 0 pi ) a)) \<longlongrightarrow> 1/2 ) at_top" 
 proof (cases "Im z0\<le>Im a")
   case True
   define g1 where "g1=(\<lambda>r. part_circlepath z0 r 0 pi)"
   define g2 where "g2=(\<lambda>r. part_circlepath z0 r pi (2*pi))"
   define f1 where "f1=(\<lambda>r. Re (winding_number (g1 r ) a))"
   define f2 where "f2=(\<lambda>r. Re (winding_number (g2 r) a))"
   have "(f2 \<longlongrightarrow> 1/2 ) at_top" 
   proof -
     define h1 where "h1 = (\<lambda>r. Im (Ln (Complex ( Im a-Im z0) (Re z0 - Re a + r))))"
     define h2 where "h2= (\<lambda>r. Im (Ln (Complex (  Im a -Im z0) (Re z0 - Re a - r))))"
     have "\<forall>\<^sub>F x in at_top. f2 x = (h1 x - h2 x) / (2 * pi)"
     proof (rule eventually_at_top_linorderI[of "cmod (a-z0) + 1"])
       fix r assume asm:"r \<ge> cmod (a - z0) + 1"
       have "Im p \<le> Im a" when "p\<in>path_image (g2 r)" for p
       proof -
         obtain t where p_def:"p=z0 + of_real r * exp (\<i> * of_real t)" and "pi\<le>t" "t\<le>2*pi"
           using \<open>p\<in>path_image (g2 r)\<close> 
           unfolding g2_def path_image_part_circlepath[of pi "2*pi",simplified]  
           by auto
         then have "Im p=Im z0 + sin t * r" by (auto simp add:Im_exp)
         also have "... \<le> Im z0"
         proof -
           have "sin t\<le>0" using \<open>pi\<le>t\<close> \<open>t\<le>2*pi\<close> sin_le_zero by fastforce
           moreover have "r\<ge>0" 
             using asm by (metis add.inverse_inverse add.left_neutral add_uminus_conv_diff
                 diff_ge_0_iff_ge norm_ge_zero order_trans zero_le_one)
           ultimately have "sin t * r\<le>0" using mult_le_0_iff by blast
           then show ?thesis by auto
         qed
         also have "... \<le> Im a" using True .
         finally show ?thesis .
       qed
       moreover have "valid_path (g2 r)" unfolding g2_def by auto
       moreover have "a \<notin> path_image (g2 r)"
         unfolding g2_def 
         apply (rule not_on_circlepathI)
         using asm by auto  
       moreover have [symmetric]:"Im (Ln (\<i> * pathfinish (g2 r) - \<i> * a)) = h1 r"
         unfolding h1_def g2_def
         apply (simp only:pathfinish_pathstart_partcirclepath_simps)
         apply (subst (4 10) complex_eq)
         by (auto simp add:algebra_simps Complex_eq)
       moreover have [symmetric]:"Im (Ln (\<i> * pathstart (g2 r) - \<i> * a)) = h2 r"
         unfolding h2_def g2_def
         apply (simp only:pathfinish_pathstart_partcirclepath_simps)
         apply (subst (4 10) complex_eq)
         by (auto simp add:algebra_simps Complex_eq)
       ultimately show "f2 r = (h1 r - h2 r) / (2 * pi)" 
         unfolding f2_def 
         apply (subst Re_winding_number_half_lower)
         by (auto simp add:exp_Euler algebra_simps)
     qed  
     moreover have "((\<lambda>x. (h1 x - h2 x) / (2 * pi)) \<longlongrightarrow> 1/2 ) at_top"
     proof -
       have "(h1 \<longlongrightarrow> pi/2) at_top"
         unfolding h1_def
         apply (subst filterlim_at_top_linear_iff[of 1 _ "Re a - Re z0" ,simplified,symmetric]) 
         using Im_Ln_tendsto_at_top by (simp del:Complex_eq)
       moreover have "(h2 \<longlongrightarrow> - pi/2) at_top"  
         unfolding h2_def
         apply (subst filterlim_at_bot_linear_iff[of "- 1" _ "- Re a + Re z0" ,simplified,symmetric])  
         using Im_Ln_tendsto_at_bot by (simp del:Complex_eq)  
       ultimately have "((\<lambda>x. h1 x- h2 x) \<longlongrightarrow> pi) at_top"    
         by (auto intro: tendsto_eq_intros)
       then show ?thesis
         by (auto intro: tendsto_eq_intros)
     qed
     ultimately show ?thesis by (auto dest:tendsto_cong)
   qed
   moreover have "\<forall>\<^sub>F r in at_top. f2 r = 1 - f1 r"
   proof (rule eventually_at_top_linorderI[of "cmod (a-z0) + 1"])
     fix r assume asm:"r \<ge> cmod (a - z0) + 1"
     have "f1 r + f2 r = Re(winding_number (g1 r +++ g2 r) a)" 
       unfolding f1_def f2_def g1_def g2_def
       apply (subst winding_number_join)
       using asm by (auto intro!:not_on_circlepathI)
     also have "... = Re(winding_number (circlepath z0 r) a)"
     proof -
       have "g1 r +++ g2 r = circlepath z0 r"
         unfolding circlepath_def g1_def g2_def joinpaths_def part_circlepath_def linepath_def
         by (auto simp add:field_simps)
       then show ?thesis by auto
     qed
     also have "... = 1"
     proof -
       have "winding_number (circlepath z0 r) a = 1"
         apply (rule winding_number_circlepath)
         using asm by auto
       then show ?thesis by auto
     qed
     finally have "f1 r+f2 r=1" .
     then show " f2 r = 1 - f1 r" by auto
   qed
   ultimately have "((\<lambda>r. 1 - f1 r) \<longlongrightarrow> 1/2 ) at_top"
     using tendsto_cong[of f2 "\<lambda>r. 1 - f1 r" at_top] by auto
   then have "(f1 \<longlongrightarrow> 1/2 ) at_top" 
     apply (rule_tac tendsto_minus_cancel)
     apply (subst tendsto_add_const_iff[of 1,symmetric])
     by auto
   then show ?thesis unfolding f1_def g1_def by auto
 next
   case False
   define g where "g=(\<lambda>r. part_circlepath z0 r 0 pi)"
   define f where "f=(\<lambda>r. Re (winding_number (g r) a))"
   have "(f \<longlongrightarrow> 1/2 ) at_top" 
   proof -
     define h1 where "h1 = (\<lambda>r. Im (Ln (Complex ( Im z0-Im a) (Re a - Re z0 + r))))"
     define h2 where "h2= (\<lambda>r. Im (Ln (Complex (  Im z0 -Im a ) (Re a - Re z0 - r))))"
     have "\<forall>\<^sub>F x in at_top. f x = (h1 x - h2 x) / (2 * pi)"
     proof (rule eventually_at_top_linorderI[of "cmod (a-z0) + 1"])
       fix r assume asm:"r \<ge> cmod (a - z0) + 1"
       have "Im p \<ge> Im a" when "p\<in>path_image (g r)" for p
       proof -
         obtain t where p_def:"p=z0 + of_real r * exp (\<i> * of_real t)" and "0\<le>t" "t\<le>pi"
           using \<open>p\<in>path_image (g r)\<close> 
           unfolding g_def path_image_part_circlepath[of 0 pi,simplified]  
           by auto
         then have "Im p=Im z0 + sin t * r" by (auto simp add:Im_exp)    
         moreover have "sin t * r\<ge>0"
         proof -
           have "sin t\<ge>0" using \<open>0\<le>t\<close> \<open>t\<le>pi\<close> sin_ge_zero by fastforce
           moreover have "r\<ge>0" 
             using asm by (metis add.inverse_inverse add.left_neutral add_uminus_conv_diff
                 diff_ge_0_iff_ge norm_ge_zero order_trans zero_le_one)
           ultimately have "sin t * r\<ge>0" by simp
           then show ?thesis by auto
         qed
         ultimately show ?thesis using False by auto
       qed
       moreover have "valid_path (g r)" unfolding g_def by auto
       moreover have "a \<notin> path_image (g r)"
         unfolding g_def 
         apply (rule not_on_circlepathI)
         using asm by auto  
       moreover have [symmetric]:"Im (Ln (\<i> * a - \<i> * pathfinish (g r))) = h1 r"
         unfolding h1_def g_def
         apply (simp only:pathfinish_pathstart_partcirclepath_simps)
         apply (subst (4 9) complex_eq)
         by (auto simp add:algebra_simps Complex_eq)
       moreover have [symmetric]:"Im (Ln (\<i> * a - \<i> * pathstart (g r))) = h2 r"
         unfolding h2_def g_def
         apply (simp only:pathfinish_pathstart_partcirclepath_simps)
         apply (subst (4 9) complex_eq)
         by (auto simp add:algebra_simps Complex_eq)
       ultimately show "f r = (h1 r - h2 r) / (2 * pi)" 
         unfolding f_def 
         apply (subst Re_winding_number_half_upper) 
         by (auto simp add:exp_Euler algebra_simps)
     qed  
     moreover have "((\<lambda>x. (h1 x - h2 x) / (2 * pi)) \<longlongrightarrow> 1/2 ) at_top"
     proof -
       have "(h1 \<longlongrightarrow> pi/2) at_top"
         unfolding h1_def
         apply (subst filterlim_at_top_linear_iff[of 1 _ "- Re a + Re z0" ,simplified,symmetric]) 
         using Im_Ln_tendsto_at_top by (simp del:Complex_eq)
       moreover have "(h2 \<longlongrightarrow> - pi/2) at_top"  
         unfolding h2_def
         apply (subst filterlim_at_bot_linear_iff[of "- 1" _ "Re a - Re z0" ,simplified,symmetric])  
         using Im_Ln_tendsto_at_bot by (simp del:Complex_eq)  
       ultimately have "((\<lambda>x. h1 x- h2 x) \<longlongrightarrow> pi) at_top"    
         by (auto intro: tendsto_eq_intros)
       then show ?thesis
         by (auto intro: tendsto_eq_intros)
     qed
     ultimately show ?thesis by (auto dest:tendsto_cong)
   qed
   then show ?thesis unfolding f_def g_def by auto
 qed
   
 lemma not_image_at_top_poly_part_circlepath:
   assumes "degree p>0"
   shows "\<forall>\<^sub>F r in at_top. b\<notin>path_image (poly p o part_circlepath z0 r st tt)"  
 proof -
   have "finite (proots (p-[:b:]))" 
     apply (rule finite_proots)
     using assms by auto  
   from finite_ball_include[OF this]
   obtain R::real where "R>0" and R_ball:"proots (p-[:b:]) \<subseteq> ball z0 R" by auto
   show ?thesis
   proof (rule eventually_at_top_linorderI[of R])
     fix r assume "r\<ge>R"    
     show  "b\<notin>path_image (poly p o part_circlepath z0 r st tt)"
       unfolding path_image_compose 
     proof clarify
       fix x assume asm:"b = poly p x" "x \<in> path_image (part_circlepath z0 r st tt)"
       then have "x\<in>proots (p-[:b:])" unfolding proots_def by auto
       then have "x\<in>ball z0 r" using R_ball \<open>r\<ge>R\<close> by auto  
       then have "cmod (x- z0) < r" 
         by (simp add: dist_commute dist_norm)
       moreover have "cmod (x - z0) = r"
         using asm(2) in_path_image_part_circlepath \<open>R>0\<close> \<open>r\<ge>R\<close>  by auto  
       ultimately show False by auto
     qed
   qed
 qed  
 
 lemma not_image_poly_part_circlepath:
   assumes "degree p>0"
   shows "\<exists>r>0.  b\<notin>path_image (poly p o part_circlepath z0 r st tt)"
 proof -
   have "finite (proots (p-[:b:]))" 
     apply (rule finite_proots)
     using assms by auto  
   from finite_ball_include[OF this]
   obtain r::real where "r>0" and r_ball:"proots (p-[:b:]) \<subseteq> ball z0 r" by auto
   have "b\<notin>path_image (poly p o part_circlepath z0 r st tt)"
     unfolding path_image_compose 
   proof clarify
     fix x assume asm:"b = poly p x" "x \<in> path_image (part_circlepath z0 r st tt)"
     then have "x\<in>proots (p-[:b:])" unfolding proots_def by auto
     then have "x\<in>ball z0 r" using r_ball by auto  
     then have "cmod (x- z0) < r" 
       by (simp add: dist_commute dist_norm)
     moreover have "cmod (x - z0) = r"
       using asm(2) in_path_image_part_circlepath \<open>r>0\<close> by auto  
     ultimately show False by auto
   qed
   then show ?thesis using \<open>r>0\<close> by blast
 qed
    
 lemma Re_winding_number_poly_part_circlepath:
   assumes "degree p>0"
   shows "((\<lambda>r. Re (winding_number (poly p o part_circlepath z0 r 0 pi) 0)) \<longlongrightarrow> degree p/2 ) at_top"
 using assms
 proof (induct rule:poly_root_induct_alt)
   case 0
   then show ?case by auto
 next
   case (no_proots p)
   then have False 
     using Fundamental_Theorem_Algebra.fundamental_theorem_of_algebra constant_degree neq0_conv
     by blast
   then show ?case by auto
 next
   case (root a p)
   define g where "g = (\<lambda>r. part_circlepath z0 r 0 pi)"
   define q where "q=[:- a, 1:] * p"
   define w where "w = (\<lambda>r. winding_number (poly q \<circ> g r) 0)"
   have ?case when "degree p=0"
   proof -
     obtain pc where pc_def:"p=[:pc:]" using \<open>degree p = 0\<close> degree_eq_zeroE by blast
     then have "pc\<noteq>0" using root(2) by auto
     have "\<forall>\<^sub>F r in at_top. Re (w r) = Re (winding_number (g r) a)" 
     proof (rule eventually_at_top_linorderI[of "cmod (( pc * a) / pc - z0) + 1"])
       fix r::real assume asm:"cmod ((pc * a) / pc - z0) + 1 \<le> r"
       have "w r =  winding_number ((\<lambda>x. pc*x - pc*a) \<circ> (g r)) 0"
         unfolding w_def pc_def g_def q_def
         apply auto
         by (metis (no_types, opaque_lifting) add.right_neutral mult.commute mult_zero_right 
             poly_0 poly_pCons uminus_add_conv_diff)
       also have "... =  winding_number (g r) a "
         apply (subst winding_number_comp_linear[where b="-pc*a",simplified])
         subgoal using \<open>pc\<noteq>0\<close> .
         subgoal unfolding g_def by auto
         subgoal unfolding g_def
           apply (rule not_on_circlepathI)
           using asm by auto
         subgoal using \<open>pc\<noteq>0\<close> by (auto simp add:field_simps)
         done
       finally have "w r = winding_number (g r) a " .
       then show "Re (w r) = Re (winding_number (g r) a)" by simp
     qed
     moreover have "((\<lambda>r. Re (winding_number (g r) a)) \<longlongrightarrow> 1/2) at_top"
       using Re_winding_number_tendsto_part_circlepath unfolding g_def by auto
     ultimately have "((\<lambda>r. Re (w r)) \<longlongrightarrow> 1/2) at_top"
       by (auto dest!:tendsto_cong)
     moreover have "degree ([:- a, 1:] * p) = 1" unfolding pc_def using \<open>pc\<noteq>0\<close> by auto
     ultimately show ?thesis unfolding w_def g_def comp_def q_def by simp
   qed
   moreover have ?case when "degree p>0"
   proof -
     have "\<forall>\<^sub>F r in at_top. 0 \<notin> path_image (poly q \<circ> g r)"  
       unfolding g_def
       apply (rule not_image_at_top_poly_part_circlepath)
       unfolding q_def using root.prems by blast
     then have "\<forall>\<^sub>F r in at_top. Re (w r) = Re (winding_number (g r) a) 
               + Re (winding_number (poly p \<circ> g r) 0)"
     proof (rule eventually_mono)
       fix r assume asm:"0 \<notin> path_image (poly q \<circ> g r)"
       define cc where "cc= 1 / (of_real (2 * pi) * \<i>)"  
       define pf where "pf=(\<lambda>w. deriv (poly p) w / poly p w)"
       define af where "af=(\<lambda>w. 1/(w-a))"  
       have "w r = cc * contour_integral (g r) (\<lambda>w. deriv (poly q) w / poly q w)"
         unfolding w_def 
         apply (subst winding_number_comp[of UNIV,simplified])
         using asm unfolding g_def cc_def  by auto
       also have "... = cc * contour_integral (g r) (\<lambda>w. deriv (poly p) w / poly p w + 1/(w-a))"  
       proof -
         have "contour_integral (g r) (\<lambda>w. deriv (poly q) w / poly q w) 
             = contour_integral (g r) (\<lambda>w. deriv (poly p) w / poly p w + 1/(w-a))"
         proof (rule contour_integral_eq)   
           fix x assume "x \<in> path_image (g r)"  
           have "deriv (poly q) x = deriv (poly p) x * (x-a) + poly p x" 
           proof -
             have "poly q = (\<lambda>x. (x-a) * poly p x)" 
               apply (rule ext)
               unfolding q_def by (auto simp add:algebra_simps) 
             then show ?thesis    
               apply simp
               apply (subst deriv_mult[of "\<lambda>x. x- a" _ "poly p"])
               by (auto intro:derivative_intros)
           qed
           moreover have "poly p x\<noteq>0 \<and> x-a\<noteq>0" 
           proof (rule ccontr)
             assume "\<not> (poly p x \<noteq> 0 \<and> x - a \<noteq> 0)"
             then have "poly q x=0" unfolding q_def by auto  
             then have "0\<in>poly q ` path_image (g r)"
               using \<open>x \<in> path_image (g r)\<close> by auto
             then show False using \<open>0 \<notin> path_image (poly q \<circ> g r)\<close> 
               unfolding path_image_compose by auto
           qed
           ultimately show "deriv (poly q) x / poly q x = deriv (poly p) x / poly p x + 1 / (x - a)" 
             unfolding q_def by (auto simp add:field_simps)  
         qed
         then show ?thesis by auto
       qed
       also have "... = cc * contour_integral (g r) (\<lambda>w. deriv (poly p) w / poly p w) 
           + cc * contour_integral (g r) (\<lambda>w. 1/(w-a))"  
       proof (subst contour_integral_add)
         have "continuous_on (path_image (g r)) (\<lambda>w. deriv (poly p) w)"
           unfolding deriv_pderiv by (intro continuous_intros)  
         moreover have "\<forall>w\<in>path_image (g r). poly p w \<noteq> 0" 
           using asm unfolding q_def path_image_compose by auto
         ultimately show "(\<lambda>w. deriv (poly p) w / poly p w) contour_integrable_on g r" 
           unfolding g_def
           by (auto intro!: contour_integrable_continuous_part_circlepath continuous_intros)
         show "(\<lambda>w. 1 / (w - a)) contour_integrable_on g r" 
           apply (rule contour_integrable_inversediff)
           subgoal unfolding g_def by auto
           subgoal using asm unfolding q_def path_image_compose by auto
           done
       qed (auto simp add:algebra_simps)
       also have "... =  winding_number (g r) a +  winding_number (poly p o g r) 0"
       proof -
         have "winding_number (poly p o g r) 0
             = cc * contour_integral (g r) (\<lambda>w. deriv (poly p) w / poly p w)"
           apply (subst winding_number_comp[of UNIV,simplified])
           using \<open>0 \<notin> path_image (poly q \<circ> g r)\<close> unfolding path_image_compose q_def g_def cc_def
           by auto
         moreover have "winding_number (g r) a = cc * contour_integral (g r) (\<lambda>w. 1/(w-a))"
           apply (subst winding_number_valid_path)
           using \<open>0 \<notin> path_image (poly q \<circ> g r)\<close> unfolding path_image_compose q_def g_def cc_def
           by auto
         ultimately show ?thesis by auto
       qed
       finally show "Re (w r) = Re (winding_number (g r) a) + Re (winding_number (poly p \<circ> g r) 0)"
         by auto
     qed
     moreover have "((\<lambda>r. Re (winding_number (g r) a) 
               + Re (winding_number (poly p \<circ> g r) 0)) \<longlongrightarrow> degree q / 2) at_top" 
     proof -
       have "((\<lambda>r. Re (winding_number (g r) a)) \<longlongrightarrow>1 / 2) at_top" 
         unfolding g_def by (rule Re_winding_number_tendsto_part_circlepath)  
       moreover have "((\<lambda>r. Re (winding_number (poly p \<circ> g r) 0)) \<longlongrightarrow> degree p / 2) at_top"
         unfolding g_def by (rule root(1)[OF that])
       moreover have "degree q = degree p + 1" 
         unfolding q_def
         apply (subst degree_mult_eq)
         using that by auto
       ultimately show ?thesis
         by (simp add: tendsto_add add_divide_distrib)
     qed
     ultimately have "((\<lambda>r. Re (w r)) \<longlongrightarrow> degree q/2) at_top"
       by (auto dest!:tendsto_cong)
     then show ?thesis unfolding w_def q_def g_def by blast
   qed
   ultimately show ?case by blast
 qed     
 
 lemma Re_winding_number_poly_linepth:
   fixes pp::"complex poly"
   defines "g \<equiv> (\<lambda>r. poly pp o linepath (-r) (of_real r))"
   assumes "lead_coeff pp=1" and no_real_zero:"\<forall>x\<in>proots pp. Im x\<noteq>0"
   shows "((\<lambda>r. 2*Re (winding_number (g r) 0) + cindex_pathE (g r) 0 ) \<longlongrightarrow> 0 ) at_top" 
 proof -
   define p where "p=map_poly Re pp" 
   define q where "q=map_poly Im pp"
   define f where "f=(\<lambda>t. poly q t / poly p t)"
   have sgnx_top:"sgnx (poly p) at_top = 1"
     unfolding sgnx_poly_at_top sgn_pos_inf_def p_def using \<open>lead_coeff pp=1\<close>
     by (subst lead_coeff_map_poly_nz,auto)
   have not_g_image:"0 \<notin> path_image (g r)" for r
   proof (rule ccontr)
     assume "\<not> 0 \<notin> path_image (g r)"
     then obtain x where "poly pp x=0" "x\<in>closed_segment (- of_real r) (of_real r)"
       unfolding g_def path_image_compose of_real_linepath by auto
     then have "Im x=0" "x\<in>proots pp" 
       using closed_segment_imp_Re_Im(2) unfolding proots_def by fastforce+
     then show False using \<open>\<forall>x\<in>proots pp. Im x\<noteq>0\<close> by auto
   qed    
   have arctan_f_tendsto:"((\<lambda>r. (arctan (f r) -  arctan (f (-r))) / pi) \<longlongrightarrow> 0) at_top"
   proof (cases "degree p>0")
     case True
     have "degree p>degree q" 
     proof -
       have "degree p=degree pp"
         unfolding p_def using \<open>lead_coeff pp=1\<close>
         by (auto intro:map_poly_degree_eq)
       moreover then have "degree q<degree pp"
         unfolding q_def using \<open>lead_coeff pp=1\<close> True
         by (auto intro!:map_poly_degree_less)
       ultimately show ?thesis by auto
     qed
     then have "(f \<longlongrightarrow> 0) at_infinity"
       unfolding f_def using poly_divide_tendsto_0_at_infinity by auto
     then have "(f \<longlongrightarrow> 0) at_bot" "(f \<longlongrightarrow> 0) at_top"
       by (auto elim!:filterlim_mono simp add:at_top_le_at_infinity at_bot_le_at_infinity)
     then have "((\<lambda>r. arctan (f r))\<longlongrightarrow> 0) at_top" "((\<lambda>r. arctan (f (-r)))\<longlongrightarrow> 0) at_top"
       apply -
       subgoal by (auto intro:tendsto_eq_intros)
       subgoal 
         apply (subst tendsto_compose_filtermap[of _ uminus,unfolded comp_def])
         by (auto intro:tendsto_eq_intros simp add:at_bot_mirror[symmetric])
       done
     then show ?thesis 
       by (auto intro:tendsto_eq_intros)
   next
     case False
     obtain c where "f=(\<lambda>r. c)"
     proof -
       have "degree p=0" using False by auto
       moreover have "degree q\<le>degree p"
       proof -
         have "degree p=degree pp" 
           unfolding p_def using \<open>lead_coeff pp=1\<close>
           by (auto intro:map_poly_degree_eq)
         moreover have "degree q\<le>degree pp"
           unfolding q_def by simp
         ultimately show ?thesis by auto
       qed
       ultimately have "degree q=0" by simp
       then obtain pa qa where "p=[:pa:]" "q=[:qa:]"
         using \<open>degree p=0\<close> by (meson degree_eq_zeroE)
       then show ?thesis using that unfolding f_def by auto
     qed
     then show ?thesis by auto
   qed
   have [simp]:"valid_path (g r)" "path (g r)" "finite_ReZ_segments (g r) 0" for r
   proof -
     show "valid_path (g r)" unfolding g_def
       apply (rule valid_path_compose_holomorphic[where S=UNIV])
       by (auto simp add:of_real_linepath)
     then show "path (g r)" using valid_path_imp_path by auto
     show "finite_ReZ_segments (g r) 0"
       unfolding g_def of_real_linepath using finite_ReZ_segments_poly_linepath by simp
   qed
   have g_f_eq:"Im (g r t) / Re (g r t) = (f o (\<lambda>x. 2*r*x - r)) t" for r t 
   proof -
     have "Im (g r t) / Re (g r t) = Im ((poly pp o of_real o (\<lambda>x. 2*r*x - r)) t) 
         / Re ((poly pp o of_real o (\<lambda>x. 2*r*x - r)) t)"
       unfolding g_def linepath_def comp_def 
       by (auto simp add:algebra_simps)
     also have "... = (f o (\<lambda>x. 2*r*x - r)) t"
       unfolding comp_def
       by (simp only:Im_poly_of_real diff_0_right Re_poly_of_real f_def q_def p_def)
     finally show ?thesis .
   qed
 
   have ?thesis when "proots p={}"
   proof -
     have "\<forall>\<^sub>Fr in at_top. 2 * Re (winding_number (g r) 0) + cindex_pathE (g r) 0
         = (arctan (f r) -  arctan (f (-r))) / pi"
     proof (rule eventually_at_top_linorderI[of 1])
       fix r::real assume "r\<ge>1"
       have image_pos:"\<forall>p\<in>path_image (g r).  0<Re p "
       proof (rule ccontr)
         assume "\<not> (\<forall>p\<in>path_image (g r). 0 < Re p)"
         then obtain t where "poly p t\<le>0" 
           unfolding g_def path_image_compose of_real_linepath p_def 
           using Re_poly_of_real
           apply (simp add:closed_segment_def)
           by (metis not_less of_real_def real_vector.scale_scale scaleR_left_diff_distrib)  
         moreover have False when "poly p t<0"    
         proof -
           have "sgnx (poly p) (at_right t) = -1"  
             using sgnx_poly_nz that by auto
           then obtain x where "x>t" "poly p x = 0"
             using sgnx_at_top_IVT[of p t] sgnx_top by auto
           then have "x\<in>proots p" unfolding proots_def by auto
           then show False using \<open>proots p={}\<close> by auto
         qed
         moreover have False when "poly p t=0"
           using \<open>proots p={}\<close> that unfolding proots_def by auto
         ultimately show False by linarith
       qed
       have "Re (winding_number (g r) 0) = (Im (Ln (pathfinish (g r))) - Im (Ln (pathstart (g r)))) 
           / (2 * pi)"
         apply (rule Re_winding_number_half_right[of "g r" 0,simplified])
         subgoal using image_pos by auto
         subgoal by (auto simp add:not_g_image)
         done
       also have "... = (arctan (f r) - arctan (f (-r)))/(2*pi)"
       proof -
         have "Im (Ln (pathfinish (g r))) = arctan (f r)"
         proof -
           have "Re (pathfinish (g r)) > 0"
             by (auto intro: image_pos[rule_format])
           then have "Im (Ln (pathfinish (g r))) 
               = arctan (Im (pathfinish (g r)) / Re (pathfinish (g r)))" 
             by (subst Im_Ln_eq,auto)
           also have "... = arctan (f r)"
             unfolding path_defs by (subst g_f_eq,auto)
           finally show ?thesis .
         qed
         moreover have "Im (Ln (pathstart (g r))) = arctan (f (-r))"
         proof -
           have "Re (pathstart (g r)) > 0"
             by (auto intro: image_pos[rule_format])
           then have "Im (Ln (pathstart (g r))) 
               = arctan (Im (pathstart (g r)) / Re (pathstart (g r)))" 
             by (subst Im_Ln_eq,auto)
           also have "... = arctan (f (-r))"
             unfolding path_defs by (subst g_f_eq,auto)
           finally show ?thesis .
         qed  
         ultimately show ?thesis by auto
       qed
       finally have "Re (winding_number (g r) 0) = (arctan (f r) - arctan (f (-r)))/(2*pi)" . 
       moreover have "cindex_pathE (g r) 0 = 0"
       proof -
         have "cindex_pathE (g r) 0 = cindex_pathE (poly pp o of_real o (\<lambda>x. 2*r*x - r)) 0"
           unfolding g_def linepath_def comp_def 
           by (auto simp add:algebra_simps)
         also have "... = cindexE 0 1 (f o (\<lambda>x. 2*r*x - r)) "
           unfolding cindex_pathE_def comp_def
           by (simp only:Im_poly_of_real diff_0_right Re_poly_of_real f_def q_def p_def)
         also have "... = cindexE (-r) r f"
           apply (subst cindexE_linear_comp[of "2*r" 0 1 _ "-r",simplified])
           using \<open>r\<ge>1\<close> by auto
         also have "... = 0"
         proof -
           have "jumpF f (at_left x) =0" "jumpF f (at_right x) = 0" when "x\<in>{-r..r}" for x
           proof -
             have "poly p x\<noteq>0" using \<open>proots p={}\<close> unfolding proots_def by auto
             then show "jumpF f (at_left x) =0" "jumpF f (at_right x) = 0"
               unfolding f_def by (auto intro!: jumpF_not_infinity continuous_intros)
           qed
           then show ?thesis unfolding cindexE_def by auto
         qed
         finally show ?thesis .
       qed
       ultimately show "2 * Re (winding_number (g r) 0) + cindex_pathE (g r) 0 
           = (arctan (f r) -  arctan (f (-r))) / pi"   
         unfolding path_defs by (auto simp add:field_simps)
     qed
     with arctan_f_tendsto show ?thesis by (auto dest:tendsto_cong)
   qed
   moreover have ?thesis when "proots p\<noteq>{}"
   proof -
     define max_r where "max_r=Max (proots p)"
     define min_r where "min_r=Min (proots p)"
     have "max_r \<in>proots p" "min_r \<in>proots p" "min_r\<le>max_r" and 
       min_max_bound:"\<forall>p\<in>proots p. p\<in>{min_r..max_r}"
     proof -
       have "p\<noteq>0" 
       proof -
         have "(0::real) \<noteq> 1"
           by simp
         then show ?thesis
           by (metis (full_types) \<open>p \<equiv> map_poly Re pp\<close> assms(2) coeff_0 coeff_map_poly one_complex.simps(1) zero_complex.sel(1))
       qed
       then have "finite (proots p)" by auto
       then show "max_r \<in>proots p" "min_r \<in>proots p"  
         using Min_in Max_in that unfolding max_r_def min_r_def by fast+
       then show "\<forall>p\<in>proots p. p\<in>{min_r..max_r}"
         using Min_le Max_ge \<open>finite (proots p)\<close> unfolding max_r_def min_r_def by auto
       then show "min_r\<le>max_r" using \<open>max_r\<in>proots p\<close> by auto
     qed
     have "\<forall>\<^sub>Fr in at_top. 2 * Re (winding_number (g r) 0) + cindex_pathE (g r) 0
         = (arctan (f r) -  arctan (f (-r))) / pi"
     proof (rule eventually_at_top_linorderI[of "max (norm max_r) (norm min_r) + 1"])  
       fix r assume r_asm:"max (norm max_r) (norm min_r) + 1 \<le> r"
       then have "r\<noteq>0" "min_r>-r" "max_r<r" by auto
       define u where "u=(min_r + r)/(2*r)" 
       define v where "v=(max_r + r)/(2*r)"  
       have uv:"u\<in>{0..1}" "v\<in>{0..1}" "u\<le>v"   
         unfolding u_def v_def using r_asm  \<open>min_r\<le>max_r\<close> 
         by (auto simp add:field_simps)
       define g1 where "g1=subpath 0 u (g r)"
       define g2 where "g2=subpath u v (g r)"
       define g3 where "g3=subpath v 1 (g r)"
       have "path g1" "path g2" "path g3" "valid_path g1" "valid_path g2" "valid_path g3"
         unfolding g1_def g2_def g3_def using uv
         by (auto intro!:path_subpath valid_path_subpath)
       define wc_add where "wc_add = (\<lambda>g. 2*Re (winding_number g 0)  + cindex_pathE g 0)"
       have "wc_add (g r) = wc_add g1 + wc_add g2 + wc_add g3" 
       proof -
         have "winding_number (g r) 0 = winding_number g1 0 + winding_number g2 0 + winding_number g3 0"
           unfolding g1_def g2_def g3_def using \<open>u\<in>{0..1}\<close> \<open>v\<in>{0..1}\<close> not_g_image
           by (subst winding_number_subpath_combine,simp_all)+
         moreover have "cindex_pathE (g r) 0 = cindex_pathE g1 0 + cindex_pathE g2 0 + cindex_pathE g3 0"
           unfolding g1_def g2_def g3_def using \<open>u\<in>{0..1}\<close> \<open>v\<in>{0..1}\<close> \<open>u\<le>v\<close> not_g_image
           by (subst cindex_pathE_subpath_combine,simp_all)+
         ultimately show ?thesis unfolding wc_add_def by auto
       qed
       moreover have "wc_add g2=0"
       proof -
         have "2 * Re (winding_number g2 0) = - cindex_pathE g2 0"
           unfolding g2_def
           apply (rule winding_number_cindex_pathE_aux)
           subgoal using uv by (auto intro:finite_ReZ_segments_subpath)
           subgoal using uv by (auto intro:valid_path_subpath)
           subgoal using Path_Connected.path_image_subpath_subset \<open>\<And>r. path (g r)\<close> not_g_image uv 
             by blast 
           subgoal unfolding subpath_def v_def g_def linepath_def using r_asm \<open>max_r \<in>proots p\<close>
             by (auto simp add:field_simps Re_poly_of_real p_def)
           subgoal unfolding subpath_def u_def g_def linepath_def using r_asm \<open>min_r \<in>proots p\<close>
             by (auto simp add:field_simps Re_poly_of_real p_def)
           done
         then show ?thesis unfolding wc_add_def by auto
       qed
       moreover have "wc_add g1=- arctan (f (-r)) / pi" 
       proof -
         have g1_pq:
           "Re (g1 t) = poly p (min_r*t+r*t-r)"
           "Im (g1 t) = poly q (min_r*t+r*t-r)"
           "Im (g1 t)/Re (g1 t) = (f o (\<lambda>x. (min_r+r)*x - r)) t"
           for t
         proof -
           have "g1 t = poly pp (of_real (min_r*t+r*t-r))"
             using \<open>r\<noteq>0\<close>  unfolding g1_def g_def linepath_def subpath_def u_def p_def 
             by (auto simp add:field_simps)
           then show 
               "Re (g1 t) = poly p (min_r*t+r*t-r)"
               "Im (g1 t) = poly q (min_r*t+r*t-r)"
             unfolding p_def q_def 
             by (simp only:Re_poly_of_real Im_poly_of_real)+
           then show "Im (g1 t)/Re (g1 t) = (f o (\<lambda>x. (min_r+r)*x - r)) t"
             unfolding f_def by (auto simp add:algebra_simps) 
         qed
         have "Re(g1 1)=0"
           using \<open>r\<noteq>0\<close> Re_poly_of_real \<open>min_r\<in>proots p\<close> 
           unfolding g1_def subpath_def u_def g_def linepath_def 
           by (auto simp add:field_simps p_def)
         have "0 \<notin> path_image g1"
           by (metis (full_types) path_image_subpath_subset \<open>\<And>r. path (g r)\<close> 
               atLeastAtMost_iff g1_def le_less not_g_image subsetCE uv(1) zero_le_one)
             
         have wc_add_pos:"wc_add h = - arctan (poly q (- r) / poly p (-r)) / pi" when 
           Re_pos:"\<forall>x\<in>{0..<1}. 0 < (Re \<circ> h) x"
           and hp:"\<forall>t. Re (h t) = c*poly p (min_r*t+r*t-r)"
           and hq:"\<forall>t. Im (h t) = c*poly q (min_r*t+r*t-r)"
           and [simp]:"c\<noteq>0"
           (*and hpq:"\<forall>t. Im (h t)/Re (h t) = (f o (\<lambda>x. (min_r+r)*x - r)) t"*)
           and "Re (h 1) = 0"
           and "valid_path h"
           and h_img:"0 \<notin> path_image h"
           for h c
         proof -
           define f where "f=(\<lambda>t. c*poly q t / (c*poly p t))"
           define farg where "farg= (if 0 < Im (h 1) then pi / 2 else - pi / 2)"
           have "Re (winding_number h 0) = (Im (Ln (pathfinish h)) 
               - Im (Ln (pathstart h))) / (2 * pi)"
             apply (rule Re_winding_number_half_right[of h 0,simplified])
             subgoal using that \<open>Re (h 1) = 0\<close> unfolding path_image_def 
               by (auto simp add:le_less)
             subgoal using \<open>valid_path h\<close> .
             subgoal using h_img .
             done
           also have "... = (farg - arctan (f (-r))) / (2 * pi)"
           proof -
             have "Im (Ln (pathfinish h)) = farg"
               using \<open>Re(h 1)=0\<close> unfolding farg_def path_defs
               apply (subst Im_Ln_eq)
               subgoal using h_img unfolding path_defs by fastforce
               subgoal by simp
               done
             moreover have "Im (Ln (pathstart h)) = arctan (f (-r))"
             proof -
               have "pathstart h \<noteq> 0" 
                 using h_img 
                 by (metis pathstart_in_path_image)
               then have "Im (Ln (pathstart h)) = arctan (Im (pathstart h) / Re (pathstart h))"
                 using Re_pos[rule_format,of 0]
                 by (simp add: Im_Ln_eq path_defs)
               also have "... = arctan (f (-r))"
                 unfolding f_def path_defs hp[rule_format] hq[rule_format] 
                 by simp
               finally show ?thesis .
             qed
             ultimately show ?thesis by auto
           qed
           finally have "Re (winding_number h 0) = (farg - arctan (f (-r))) / (2 * pi)" .
           moreover have "cindex_pathE h 0 = (-farg/pi)"
           proof -
             have "cindex_pathE h 0 = cindexE 0 1 (f \<circ> (\<lambda>x. (min_r + r) * x - r))"
               unfolding cindex_pathE_def using \<open>c\<noteq>0\<close>
               by (auto simp add:hp hq f_def comp_def algebra_simps) 
             also have "... = cindexE (-r) min_r f"
               apply (subst cindexE_linear_comp[where b="-r",simplified])
               using r_asm by auto
             also have "... = - jumpF f (at_left min_r)"
             proof -
               define right where "right = {x. jumpF f (at_right x) \<noteq> 0 \<and> - r \<le> x \<and> x < min_r}"
               define left where "left = {x. jumpF f (at_left x) \<noteq> 0 \<and> - r < x \<and> x \<le> min_r}"
               have *:"jumpF f (at_right x) =0" "jumpF f (at_left x) =0" when "x\<in>{-r..<min_r}" for x
               proof -
                 have False when "poly p x =0" 
                 proof -
                   have "x\<ge>min_r"
                     using min_max_bound[rule_format,of x] that by auto
                   then show False using \<open>x\<in>{-r..<min_r}\<close> by auto
                 qed
                 then show "jumpF f (at_right x) =0" "jumpF f (at_left x) =0"
                   unfolding f_def by (auto intro!:jumpF_not_infinity continuous_intros) 
               qed
               then have "right = {}" 
                 unfolding right_def by force
               moreover have "left = (if jumpF f (at_left min_r) = 0 then {} else {min_r})"  
                 unfolding left_def le_less using * r_asm by force  
               ultimately show ?thesis
                 unfolding cindexE_def by (fold left_def right_def,auto)
             qed
             also have "... = (-farg/pi)"
             proof -
               have p_pos:"c*poly p x > 0" when "x \<in> {- r<..<min_r}" for x
               proof -
                 define hh where "hh=(\<lambda>t. min_r*t+r*t-r)"
                 have "(x+r)/(min_r+r) \<in> {0..<1}"
                   using that r_asm by (auto simp add:field_simps)
                 then have "0 < c*poly p (hh ((x+r)/(min_r+r)))"
                   apply (drule_tac Re_pos[rule_format])
                   unfolding comp_def hp[rule_format]  hq[rule_format] hh_def .
                 moreover have "hh ((x+r)/(min_r+r)) = x"
                   unfolding hh_def using \<open>min_r>-r\<close> 
                   apply (auto simp add:divide_simps)
                   by (auto simp add:algebra_simps)
                 ultimately show ?thesis by simp
               qed
               
               have "c*poly q min_r \<noteq>0"
                 using no_real_zero \<open>c\<noteq>0\<close>
                 by (metis Im_complex_of_real UNIV_I \<open>min_r \<in> proots p\<close> cpoly_of_decompose 
                     mult_eq_0_iff p_def poly_cpoly_of_real_iff proots_within_iff q_def)
                 
               moreover have ?thesis when "c*poly q min_r > 0"
               proof -
                 have "0 < Im (h 1)" unfolding hq[rule_format] hp[rule_format] using that by auto
                 moreover have "jumpF f (at_left min_r) = 1/2"
                 proof -
                   have "((\<lambda>t. c*poly p t) has_sgnx 1) (at_left min_r)"
                     unfolding has_sgnx_def
                     apply (rule eventually_at_leftI[of "-r"])
                     using p_pos \<open>min_r>-r\<close> by auto
                   then have "filterlim f at_top (at_left min_r)" 
                     unfolding f_def
                     apply (subst filterlim_divide_at_bot_at_top_iff[of _ "c*poly q min_r"])
                     using that \<open>min_r\<in>proots p\<close> by (auto intro!:tendsto_eq_intros)
                   then show ?thesis unfolding jumpF_def by auto
                 qed
                 ultimately show ?thesis unfolding farg_def by auto
               qed
               moreover have ?thesis when "c*poly q min_r < 0"
               proof -
                 have "0 > Im (h 1)" unfolding hq[rule_format] hp[rule_format] using that by auto
                 moreover have "jumpF f (at_left min_r) = - 1/2"
                 proof -
                   have "((\<lambda>t. c*poly p t) has_sgnx 1) (at_left min_r)"
                     unfolding has_sgnx_def
                     apply (rule eventually_at_leftI[of "-r"])
                     using p_pos \<open>min_r>-r\<close> by auto
                   then have "filterlim f at_bot (at_left min_r)" 
                     unfolding f_def
                     apply (subst filterlim_divide_at_bot_at_top_iff[of _ "c*poly q min_r"])
                     using that \<open>min_r\<in>proots p\<close> by (auto intro!:tendsto_eq_intros)
                   then show ?thesis unfolding jumpF_def by auto
                 qed
                 ultimately show ?thesis unfolding farg_def by auto
               qed 
               ultimately show ?thesis by linarith
             qed
             finally show ?thesis .
           qed
           ultimately show ?thesis unfolding wc_add_def f_def by (auto simp add:field_simps)  
         qed
         
         have "\<forall>x\<in>{0..<1}. (Re \<circ> g1) x \<noteq> 0" 
         proof (rule ccontr)
           assume "\<not> (\<forall>x\<in>{0..<1}. (Re \<circ> g1) x \<noteq> 0)"
           then obtain t where t_def:"Re (g1 t) =0" "t\<in>{0..<1}"
             unfolding path_image_def by fastforce
           define m where "m=min_r*t+r*t-r"
           have "poly p m=0"
           proof -
             have "Re (g1 t) = Re (poly pp (of_real m))"
               unfolding m_def g1_def g_def linepath_def subpath_def u_def using \<open>r\<noteq>0\<close>
               by (auto simp add:field_simps)
             then show ?thesis using t_def unfolding Re_poly_of_real p_def by auto 
           qed
           moreover have "m<min_r"
           proof -
             have "min_r+r>0" using r_asm by simp
             then have "(min_r + r)*(t-1)<0" using \<open>t\<in>{0..<1}\<close> 
               by (simp add: mult_pos_neg)  
             then show ?thesis unfolding m_def by (auto simp add:algebra_simps)
           qed
           ultimately show False using min_max_bound unfolding proots_def by auto
         qed
         then have "(\<forall>x\<in>{0..<1}. 0 < (Re \<circ> g1) x) \<or> (\<forall>x\<in>{0..<1}. (Re \<circ> g1) x < 0)"
           apply (elim continuous_on_neq_split)
           using \<open>path g1\<close> unfolding path_def 
           by (auto intro!:continuous_intros elim:continuous_on_subset)
         moreover have ?thesis when "\<forall>x\<in>{0..<1}. (Re \<circ> g1) x < 0"
         proof -
           have "wc_add (uminus o g1) = - arctan (f (- r)) / pi"
             unfolding f_def
             apply (rule wc_add_pos[of _ "-1"])
             using g1_pq that \<open>min_r \<in>proots p\<close> \<open>valid_path g1\<close> \<open>0 \<notin> path_image g1\<close>  
             by (auto simp add:path_image_compose)
           moreover have "wc_add (uminus \<circ> g1) = wc_add g1"
             unfolding wc_add_def cindex_pathE_def
             apply (subst winding_number_uminus_comp)
             using \<open>valid_path g1\<close> \<open>0 \<notin> path_image g1\<close> by auto   
           ultimately show ?thesis by auto
         qed
         moreover have ?thesis when "\<forall>x\<in>{0..<1}. (Re \<circ> g1) x > 0"
           unfolding f_def
           apply (rule wc_add_pos[of _ "1"])
           using g1_pq that \<open>min_r \<in>proots p\<close> \<open>valid_path g1\<close> \<open>0 \<notin> path_image g1\<close>  
           by (auto simp add:path_image_compose)
         ultimately show ?thesis by blast
       qed
       moreover have "wc_add g3 = arctan (f r) / pi" 
       proof -
         have g3_pq:
           "Re (g3 t) = poly p ((r-max_r)*t + max_r)"
           "Im (g3 t) = poly q ((r-max_r)*t + max_r)"
           "Im (g3 t)/Re (g3 t) = (f o (\<lambda>x. (r-max_r)*x + max_r)) t"
           for t
         proof -
           have "g3 t = poly pp (of_real ((r-max_r)*t + max_r))"
             using \<open>r\<noteq>0\<close> \<open>max_r<r\<close>  unfolding g3_def g_def linepath_def subpath_def v_def p_def 
             by (auto simp add:algebra_simps)
           then show 
               "Re (g3 t) = poly p ((r-max_r)*t + max_r)"
               "Im (g3 t) = poly q ((r-max_r)*t + max_r)"
             unfolding p_def q_def 
             by (simp only:Re_poly_of_real Im_poly_of_real)+
           then show "Im (g3 t)/Re (g3 t) = (f o (\<lambda>x. (r-max_r)*x + max_r)) t"
             unfolding f_def by (auto simp add:algebra_simps) 
         qed
         have "Re(g3 0)=0"
           using \<open>r\<noteq>0\<close> Re_poly_of_real \<open>max_r\<in>proots p\<close> 
           unfolding g3_def subpath_def v_def g_def linepath_def 
           by (auto simp add:field_simps p_def)
         have "0 \<notin> path_image g3"
         proof -
           have "(1::real) \<in> {0..1}"
             by auto
           then show ?thesis
             using Path_Connected.path_image_subpath_subset \<open>\<And>r. path (g r)\<close> g3_def not_g_image uv(2) by blast
         qed
             
         have wc_add_pos:"wc_add h = arctan (poly q r / poly p r) / pi" when 
           Re_pos:"\<forall>x\<in>{0<..1}. 0 < (Re \<circ> h) x"
           and hp:"\<forall>t. Re (h t) = c*poly p ((r-max_r)*t + max_r)"
           and hq:"\<forall>t. Im (h t) = c*poly q ((r-max_r)*t + max_r)"
           and [simp]:"c\<noteq>0"
           (*and hpq:"\<forall>t. Im (h t)/Re (h t) = (f o (\<lambda>x. (min_r+r)*x - r)) t"*)
           and "Re (h 0) = 0"
           and "valid_path h"
           and h_img:"0 \<notin> path_image h"
           for h c
         proof -
           define f where "f=(\<lambda>t. c*poly q t / (c*poly p t))"
           define farg where "farg= (if 0 < Im (h 0) then pi / 2 else - pi / 2)"
           have "Re (winding_number h 0) = (Im (Ln (pathfinish h)) 
               - Im (Ln (pathstart h))) / (2 * pi)"
             apply (rule Re_winding_number_half_right[of h 0,simplified])
             subgoal using that \<open>Re (h 0) = 0\<close> unfolding path_image_def 
               by (auto simp add:le_less)
             subgoal using \<open>valid_path h\<close> .
             subgoal using h_img .
             done
           also have "... = (arctan (f r) - farg) / (2 * pi)"
           proof -
             have "Im (Ln (pathstart h)) = farg"
               using \<open>Re(h 0)=0\<close> unfolding farg_def path_defs
               apply (subst Im_Ln_eq)
               subgoal using h_img unfolding path_defs by fastforce
               subgoal by simp
               done
             moreover have "Im (Ln (pathfinish h)) = arctan (f r)"
             proof -
               have "pathfinish h \<noteq> 0" 
                 using h_img 
                 by (metis pathfinish_in_path_image)
               then have "Im (Ln (pathfinish h)) = arctan (Im (pathfinish h) / Re (pathfinish h))"
                 using Re_pos[rule_format,of 1]
                 by (simp add: Im_Ln_eq path_defs)
               also have "... = arctan (f r)"
                 unfolding f_def path_defs hp[rule_format] hq[rule_format] 
                 by simp
               finally show ?thesis .
             qed
             ultimately show ?thesis by auto
           qed
           finally have "Re (winding_number h 0) = (arctan (f r) - farg) / (2 * pi)" .
           moreover have "cindex_pathE h 0 = farg/pi"
           proof -
             have "cindex_pathE h 0 = cindexE 0 1 (f \<circ> (\<lambda>x. (r-max_r)*x + max_r))"
               unfolding cindex_pathE_def using \<open>c\<noteq>0\<close>
               by (auto simp add:hp hq f_def comp_def algebra_simps) 
             also have "... = cindexE max_r r f"
               apply (subst cindexE_linear_comp)
               using r_asm by auto
             also have "... = jumpF f (at_right max_r)"
             proof -
               define right where "right = {x. jumpF f (at_right x) \<noteq> 0 \<and> max_r \<le> x \<and> x < r}"
               define left where "left = {x. jumpF f (at_left x) \<noteq> 0 \<and> max_r < x \<and> x \<le> r}"
               have *:"jumpF f (at_right x) =0" "jumpF f (at_left x) =0" when "x\<in>{max_r<..r}" for x
               proof -
                 have False when "poly p x =0" 
                 proof -
                   have "x\<le>max_r"
                     using min_max_bound[rule_format,of x] that by auto
                   then show False using \<open>x\<in>{max_r<..r}\<close> by auto
                 qed
                 then show "jumpF f (at_right x) =0" "jumpF f (at_left x) =0"
                   unfolding f_def by (auto intro!:jumpF_not_infinity continuous_intros) 
               qed
               then have "left = {}" 
                 unfolding left_def by force
               moreover have "right = (if jumpF f (at_right max_r) = 0 then {} else {max_r})"  
                 unfolding right_def le_less using * r_asm by force  
               ultimately show ?thesis
                 unfolding cindexE_def by (fold left_def right_def,auto)
             qed
             also have "... = farg/pi"
             proof -
               have p_pos:"c*poly p x > 0" when "x \<in> {max_r<..<r}" for x
               proof -
                 define hh where "hh=(\<lambda>t. (r-max_r)*t + max_r)"
                 have "(x-max_r)/(r-max_r) \<in> {0<..1}"
                   using that r_asm by (auto simp add:field_simps)
                 then have "0 < c*poly p (hh ((x-max_r)/(r-max_r)))"
                   apply (drule_tac Re_pos[rule_format]) 
                   unfolding comp_def hp[rule_format]  hq[rule_format] hh_def .
                 moreover have "hh ((x-max_r)/(r-max_r)) = x"
                   unfolding hh_def using \<open>max_r<r\<close> 
                   by (auto simp add:divide_simps)
                 ultimately show ?thesis by simp
               qed
               
               have "c*poly q max_r \<noteq>0"
                 using no_real_zero \<open>c\<noteq>0\<close>
                 by (metis Im_complex_of_real UNIV_I \<open>max_r \<in> proots p\<close> cpoly_of_decompose 
                     mult_eq_0_iff p_def poly_cpoly_of_real_iff proots_within_iff q_def)
                 
               moreover have ?thesis when "c*poly q max_r > 0"
               proof -
                 have "0 < Im (h 0)" unfolding hq[rule_format] hp[rule_format] using that by auto
                 moreover have "jumpF f (at_right max_r) = 1/2"
                 proof -
                   have "((\<lambda>t. c*poly p t) has_sgnx 1) (at_right max_r)"
                     unfolding has_sgnx_def 
                     apply (rule eventually_at_rightI[of _ "r"])
                     using p_pos \<open>max_r<r\<close> by auto
                   then have "filterlim f at_top (at_right max_r)" 
                     unfolding f_def
                     apply (subst filterlim_divide_at_bot_at_top_iff[of _ "c*poly q max_r"])
                     using that \<open>max_r\<in>proots p\<close> by (auto intro!:tendsto_eq_intros)
                   then show ?thesis unfolding jumpF_def by auto
                 qed
                 ultimately show ?thesis unfolding farg_def by auto
               qed
               moreover have ?thesis when "c*poly q max_r < 0"
               proof -
                 have "0 > Im (h 0)" unfolding hq[rule_format] hp[rule_format] using that by auto
                 moreover have "jumpF f (at_right max_r) = - 1/2"
                 proof -
                   have "((\<lambda>t. c*poly p t) has_sgnx 1) (at_right max_r)"
                     unfolding has_sgnx_def
                     apply (rule eventually_at_rightI[of _ "r"])
                     using p_pos \<open>max_r<r\<close> by auto
                   then have "filterlim f at_bot (at_right max_r)" 
                     unfolding f_def
                     apply (subst filterlim_divide_at_bot_at_top_iff[of _ "c*poly q max_r"])
                     using that \<open>max_r\<in>proots p\<close> by (auto intro!:tendsto_eq_intros)
                   then show ?thesis unfolding jumpF_def by auto
                 qed
                 ultimately show ?thesis unfolding farg_def by auto
               qed 
               ultimately show ?thesis by linarith
             qed
             finally show ?thesis .
           qed
           ultimately show ?thesis unfolding wc_add_def f_def by (auto simp add:field_simps)  
         qed
         
         have "\<forall>x\<in>{0<..1}. (Re \<circ> g3) x \<noteq> 0" 
         proof (rule ccontr)
           assume "\<not> (\<forall>x\<in>{0<..1}. (Re \<circ> g3) x \<noteq> 0)"
           then obtain t where t_def:"Re (g3 t) =0" "t\<in>{0<..1}"
             unfolding path_image_def by fastforce
           define m where "m=(r-max_r)*t + max_r"
           have "poly p m=0"
           proof -
             have "Re (g3 t) = Re (poly pp (of_real m))"
               unfolding m_def g3_def g_def linepath_def subpath_def v_def using \<open>r\<noteq>0\<close>
               by (auto simp add:algebra_simps)
             then show ?thesis using t_def unfolding Re_poly_of_real p_def by auto 
           qed
           moreover have "m>max_r"
           proof -
             have "r-max_r>0" using r_asm by simp
             then have "(r - max_r)*t>0" using \<open>t\<in>{0<..1}\<close> 
               by (simp add: mult_pos_neg)  
             then show ?thesis unfolding m_def by (auto simp add:algebra_simps)
           qed
           ultimately show False using min_max_bound unfolding proots_def by auto
         qed
         then have "(\<forall>x\<in>{0<..1}. 0 < (Re \<circ> g3) x) \<or> (\<forall>x\<in>{0<..1}. (Re \<circ> g3) x < 0)"
           apply (elim continuous_on_neq_split)
           using \<open>path g3\<close> unfolding path_def 
           by (auto intro!:continuous_intros elim:continuous_on_subset)
         moreover have ?thesis when "\<forall>x\<in>{0<..1}. (Re \<circ> g3) x < 0"
         proof -
           have "wc_add (uminus o g3) = arctan (f r) / pi"
             unfolding f_def
             apply (rule wc_add_pos[of _ "-1"])
             using g3_pq that \<open>max_r \<in>proots p\<close> \<open>valid_path g3\<close> \<open>0 \<notin> path_image g3\<close>  
             by (auto simp add:path_image_compose)
           moreover have "wc_add (uminus \<circ> g3) = wc_add g3"
             unfolding wc_add_def cindex_pathE_def
             apply (subst winding_number_uminus_comp)
             using \<open>valid_path g3\<close> \<open>0 \<notin> path_image g3\<close> by auto   
           ultimately show ?thesis by auto
         qed
         moreover have ?thesis when "\<forall>x\<in>{0<..1}. (Re \<circ> g3) x > 0"
           unfolding f_def
           apply (rule wc_add_pos[of _ "1"])
           using g3_pq that \<open>max_r \<in>proots p\<close> \<open>valid_path g3\<close> \<open>0 \<notin> path_image g3\<close>  
           by (auto simp add:path_image_compose)
         ultimately show ?thesis by blast
       qed  
       ultimately have "wc_add (g r) = (arctan (f r) - arctan (f (-r))) / pi " 
         by (auto simp add:field_simps)
       then show "2 * Re (winding_number (g r) 0) + cindex_pathE (g r) 0 
           = (arctan (f r) - arctan (f (- r))) / pi" 
         unfolding wc_add_def .
     qed
     with arctan_f_tendsto show ?thesis by (auto dest:tendsto_cong)
   qed
   ultimately show ?thesis by auto
 qed
   
 lemma proots_upper_cindex_eq:
   assumes "lead_coeff p=1" and no_real_roots:"\<forall>x\<in>proots p. Im x\<noteq>0" 
   shows "proots_upper p =
              (degree p - cindex_poly_ubd (map_poly Im p) (map_poly Re p)) /2"  
 proof (cases "degree p = 0")
   case True
   then obtain c where "p=[:c:]" using degree_eq_zeroE by blast
   then have p_def:"p=[:1:]" using \<open>lead_coeff p=1\<close> by simp
   have "proots_count p {x. Im x>0} = 0" unfolding p_def proots_count_def by auto  
   moreover have "cindex_poly_ubd (map_poly Im p) (map_poly Re p) = 0"
     apply (subst cindex_poly_ubd_code)
     unfolding p_def 
     by (auto simp add:map_poly_pCons changes_R_smods_def changes_poly_neg_inf_def 
         changes_poly_pos_inf_def)  
   ultimately show ?thesis using True unfolding proots_upper_def by auto
 next
   case False
   then have "degree p>0" "p\<noteq>0" by auto
   define w1 where "w1=(\<lambda>r. Re (winding_number (poly p \<circ> 
               (\<lambda>x. complex_of_real (linepath (- r) (of_real r) x))) 0))"  
   define w2 where "w2=(\<lambda>r. Re (winding_number (poly p \<circ> part_circlepath 0 r 0 pi) 0))"
   define cp where "cp=(\<lambda>r. cindex_pathE (poly p \<circ> (\<lambda>x. 
       of_real (linepath (- r) (of_real r) x))) 0)"
   define ci where "ci=(\<lambda>r. cindexE (-r) r (\<lambda>x. poly (map_poly Im p) x/poly (map_poly Re p) x))"
   define cubd where "cubd =cindex_poly_ubd (map_poly Im p) (map_poly Re p)"
   obtain R where "proots p \<subseteq> ball 0 R" and "R>0"
     using \<open>p\<noteq>0\<close> finite_ball_include[of "proots p" 0] by auto
   have "((\<lambda>r. w1 r  +w2 r+ cp r / 2 -ci r/2)
        \<longlongrightarrow> real (degree p) / 2 - of_int cubd / 2) at_top"  
   proof -
     have t1:"((\<lambda>r. 2 * w1 r + cp r) \<longlongrightarrow> 0) at_top"
       using Re_winding_number_poly_linepth[OF assms] unfolding w1_def cp_def by auto
     have t2:"(w2 \<longlongrightarrow> real (degree p) / 2) at_top"
       using Re_winding_number_poly_part_circlepath[OF \<open>degree p>0\<close>,of 0] unfolding w2_def by auto
     have t3:"(ci \<longlongrightarrow> of_int cubd) at_top"
       apply (rule tendsto_eventually)
       using cindex_poly_ubd_eventually[of "map_poly Im p" "map_poly Re p"] 
       unfolding ci_def cubd_def by auto
     from tendsto_add[OF tendsto_add[OF tendsto_mult_left[OF t3,of "-1/2",simplified] 
          tendsto_mult_left[OF t1,of "1/2",simplified]]
          t2]
     show ?thesis by (simp add:algebra_simps)
   qed
   moreover have "\<forall>\<^sub>F r in at_top. w1 r  +w2 r+ cp r / 2 -ci r/2 = proots_count p {x. Im x>0}" 
   proof (rule eventually_at_top_linorderI[of R])
     fix r assume "r\<ge>R"
     then have r_ball:"proots p \<subseteq> ball 0 r" and "r>0"
       using \<open>R>0\<close> \<open>proots p \<subseteq> ball 0 R\<close> by auto
     define ll where "ll=linepath (- complex_of_real r) r"
     define rr where "rr=part_circlepath 0 r 0 pi"
     define lr where "lr = ll +++ rr"
     have img_ll:"path_image ll \<subseteq> - proots p" and img_rr: "path_image rr \<subseteq> - proots p" 
       subgoal unfolding ll_def using \<open>0 < r\<close> closed_segment_degen_complex(2) no_real_roots by auto
       subgoal unfolding rr_def using in_path_image_part_circlepath \<open>0 < r\<close> r_ball by fastforce 
       done
     have [simp]:"valid_path (poly p o ll)" "valid_path (poly p o rr)"
         "valid_path ll" "valid_path rr" 
         "pathfinish rr=pathstart ll" "pathfinish ll = pathstart rr"
     proof -
       show "valid_path (poly p o ll)" "valid_path (poly p o rr)"
         unfolding ll_def rr_def by (auto intro:valid_path_compose_holomorphic)
       then show "valid_path ll" "valid_path rr" unfolding ll_def rr_def by auto
       show "pathfinish rr=pathstart ll" "pathfinish ll = pathstart rr"
         unfolding ll_def rr_def by auto
     qed
     have "proots_count p {x. Im x>0} = (\<Sum>x\<in>proots p. winding_number lr x * of_nat (order x p))"
     unfolding proots_count_def of_nat_sum
     proof (rule sum.mono_neutral_cong_left)
       show "finite (proots p)" "proots_within p {x. 0 < Im x} \<subseteq> proots p"
         using \<open>p\<noteq>0\<close> by auto
     next
       have "winding_number lr x=0" when "x\<in>proots p - proots_within p {x. 0 < Im x}" for x
       unfolding lr_def ll_def rr_def
       proof (eval_winding,simp_all)
         show *:"x \<notin> closed_segment (- complex_of_real r) (complex_of_real r)"
           using img_ll that unfolding ll_def by auto
         show "x \<notin> path_image (part_circlepath 0 r 0 pi)"
           using img_rr that unfolding rr_def by auto
         have xr_facts:"0 > Im x" "-r<Re x" "Re x<r" "cmod x<r"
         proof -
           have "Im x\<le>0" using that by auto
           moreover have "Im x\<noteq>0" using no_real_roots that by blast
           ultimately show "0 > Im x" by auto
         next
           show "cmod x<r" using that r_ball by auto
           then have "\<bar>Re x\<bar> < r"
             using abs_Re_le_cmod[of x] by argo  
           then show "-r<Re x" "Re x<r"  by linarith+
         qed
         then have "cindex_pathE ll x = 1"
           using \<open>r>0\<close> unfolding cindex_pathE_linepath[OF *] ll_def 
           by (auto simp add: mult_pos_neg)
         moreover have "cindex_pathE rr x=-1"
           unfolding rr_def using r_ball that
           by (auto intro!: cindex_pathE_circlepath_upper)
         ultimately show "-cindex_pathE (linepath (- of_real r) (of_real r)) x =
             cindex_pathE (part_circlepath 0 r 0 pi) x"
           unfolding ll_def rr_def by auto
       qed
       then show "\<forall>i\<in>proots p - proots_within p {x. 0 < Im x}. 
           winding_number lr i * of_nat (order i p) = 0"
         by auto
     next
       fix x assume x_asm:"x \<in> proots_within p {x. 0 < Im x}"
       have "winding_number lr x=1" unfolding lr_def ll_def rr_def
       proof (eval_winding,simp_all) 
         show *:"x \<notin> closed_segment (- complex_of_real r) (complex_of_real r)"
           using img_ll x_asm unfolding ll_def by auto
         show "x \<notin> path_image (part_circlepath 0 r 0 pi)"
           using img_rr x_asm unfolding rr_def by auto
         have xr_facts:"0 < Im x" "-r<Re x" "Re x<r" "cmod x<r"
         proof -
           show "0 < Im x" using x_asm by auto
         next
           show "cmod x<r" using x_asm r_ball by auto
           then have "\<bar>Re x\<bar> < r"
             using abs_Re_le_cmod[of x] by argo  
           then show "-r<Re x" "Re x<r"  by linarith+
         qed
         then have "cindex_pathE ll x = -1"
           using \<open>r>0\<close> unfolding cindex_pathE_linepath[OF *] ll_def 
           by (auto simp add: mult_less_0_iff)
         moreover have "cindex_pathE rr x=-1"
           unfolding rr_def using r_ball x_asm
           by (auto intro!: cindex_pathE_circlepath_upper)
         ultimately show "- of_real (cindex_pathE (linepath (- of_real r) (of_real r)) x) -
             of_real (cindex_pathE (part_circlepath 0 r 0 pi) x) = 2"  
           unfolding ll_def rr_def by auto 
       qed
       then show "of_nat (order x p) = winding_number lr x * of_nat (order x p)" by auto
     qed
     also have "... = 1/(2*pi*\<i>) * contour_integral lr (\<lambda>x. deriv (poly p) x / poly p x)"
       apply (subst argument_principle_poly[of p lr])
       using \<open>p\<noteq>0\<close> img_ll img_rr unfolding lr_def ll_def rr_def
       by (auto simp add:path_image_join)
     also have "... = winding_number (poly p \<circ> lr) 0"  
       apply (subst winding_number_comp[of UNIV "poly p" lr 0])
       using \<open>p\<noteq>0\<close> img_ll img_rr unfolding lr_def ll_def rr_def
       by (auto simp add:path_image_join path_image_compose)
     also have "... = Re (winding_number (poly p \<circ> lr) 0)" 
     proof -
       have "winding_number (poly p \<circ> lr) 0 \<in> Ints" 
         apply (rule integer_winding_number)
         using \<open>p\<noteq>0\<close> img_ll img_rr unfolding lr_def 
         by (auto simp add:path_image_join path_image_compose path_compose_join 
             pathstart_compose pathfinish_compose valid_path_imp_path)
       then show ?thesis by (simp add: complex_eqI complex_is_Int_iff)
     qed
     also have "... =  Re (winding_number (poly p \<circ> ll) 0) + Re (winding_number (poly p \<circ> rr) 0)"
       unfolding lr_def path_compose_join using img_ll img_rr
       apply (subst winding_number_join)
       by (auto simp add:valid_path_imp_path path_image_compose pathstart_compose pathfinish_compose)
     also have "... = w1 r  +w2 r"
       unfolding w1_def w2_def ll_def rr_def of_real_linepath by auto
     finally have "of_nat (proots_count p {x. 0 < Im x}) = complex_of_real (w1 r + w2 r)" .
     then have "proots_count p {x. 0 < Im x} = w1 r + w2 r" 
       using of_real_eq_iff by fastforce
     moreover have "cp r = ci r"
     proof -
       define f where "f=(\<lambda>x. Im (poly p (of_real x)) / Re (poly p x))"
       have "cp r = cindex_pathE (poly p \<circ> (\<lambda>x. 2*r*x - r)) 0"
         unfolding cp_def linepath_def by (auto simp add:algebra_simps)
       also have "... = cindexE 0 1 (f o (\<lambda>x. 2*r*x - r))"
         unfolding cp_def ci_def cindex_pathE_def f_def comp_def by auto
       also have "... = cindexE (-r) r f"
         apply (subst cindexE_linear_comp[of "2*r" 0 1 f "-r",simplified])
         using \<open>r>0\<close> by auto
       also have "... = ci r"
         unfolding ci_def f_def Im_poly_of_real Re_poly_of_real by simp
       finally show ?thesis .
     qed
     ultimately show "w1 r + w2 r + cp r / 2 - ci r / 2 = real (proots_count p {x. 0 < Im x})"
       by auto
   qed
   ultimately have "((\<lambda>r::real. real (proots_count p {x. 0 < Im x})) 
       \<longlongrightarrow> real (degree p) / 2 - of_int cubd / 2) at_top"
     by (auto dest: tendsto_cong)
   then show ?thesis
     apply (subst (asm) tendsto_const_iff)
     unfolding cubd_def proots_upper_def by auto
 qed
 
 lemma cindexE_roots_on_horizontal_border:
   fixes a::complex and s::real
   defines "g\<equiv>linepath a (a + of_real s)"
   assumes pqr:"p = q * r" and r_monic:"lead_coeff r=1" and r_proots:"\<forall>x\<in>proots r. Im x=Im a"
   shows "cindexE lb ub (\<lambda>t. Im ((poly p \<circ> g) t) / Re ((poly p \<circ> g) t)) =
           cindexE lb ub (\<lambda>t. Im ((poly q \<circ> g) t) / Re ((poly q \<circ> g) t))"
   using assms
 proof (induct r arbitrary:p rule:poly_root_induct_alt)
   case 0
   then have False 
     by (metis Im_complex_of_real UNIV_I imaginary_unit.simps(2) proots_within_0 zero_neq_one)
   then show ?case by simp
 next
   case (no_proots r)
   then obtain b where "b\<noteq>0" "r=[:b:]" 
     using fundamental_theorem_of_algebra_alt by blast 
   then have "r=1" using \<open>lead_coeff r = 1\<close> by simp 
   with \<open>p = q * r\<close> show ?case by simp
 next
   case (root b r)
   then have ?case when "s=0" 
     using that(1) unfolding cindex_pathE_def by (simp add:cindexE_constI)
   moreover have ?case when "s\<noteq>0"
   proof -
     define qrg where "qrg = poly (q*r) \<circ> g"
     have "cindexE lb ub (\<lambda>t. Im ((poly p \<circ> g) t) / Re ((poly p \<circ> g) t))
           = cindexE lb ub (\<lambda>t. Im (qrg t * (g t - b)) / Re (qrg t * (g t - b)))"
       unfolding qrg_def \<open>p = q * ([:- b, 1:] * r)\<close> comp_def
       by (simp add:algebra_simps)
     also have "... = cindexE lb ub
         (\<lambda>t. ((Re a + t * s - Re b )* Im (qrg t)) /
            ((Re a + t * s - Re b )* Re (qrg t)))" 
     proof -
       have "Im b = Im a" 
         using \<open>\<forall>x\<in>proots ([:- b, 1:] * r). Im x = Im a\<close> by auto
       then show ?thesis 
         unfolding cindex_pathE_def g_def linepath_def
         by (simp add:algebra_simps)
     qed
     also have "... = cindexE lb ub (\<lambda>t. Im (qrg t) / Re (qrg t))"
     proof (rule cindexE_cong[of "{t. Re a + t * s - Re b = 0}"])
       show "finite {t. Re a + t * s - Re b = 0}"
       proof (cases "Re a= Re b")
         case True
         then have "{t. Re a + t * s - Re b = 0} = {0}"
           using \<open>s\<noteq>0\<close> by auto
         then show ?thesis by auto
       next
         case False
         then have "{t. Re a + t * s - Re b = 0} = {(Re b - Re a) / s}"
           using \<open>s\<noteq>0\<close> by (auto simp add:field_simps)
         then show ?thesis by auto
       qed
     next
       fix x assume asm:"x \<notin> {t. Re a + t * s - Re b = 0}" 
       define tt where "tt=Re a + x * s - Re b"
       have "tt\<noteq>0" using asm unfolding tt_def by auto 
       then show "tt * Im (qrg x) / (tt * Re (qrg x)) = Im (qrg x) / Re (qrg x)"
         by auto
     qed 
     also have "... = cindexE lb ub (\<lambda>t. Im ((poly q \<circ> g) t) / Re ((poly q \<circ> g) t))"
       unfolding qrg_def
     proof (rule root(1))
       show "lead_coeff r = 1" 
         by (metis lead_coeff_mult lead_coeff_pCons(1) mult_cancel_left2 one_poly_eq_simps(2) 
           root.prems(2) zero_neq_one)
     qed (use root in simp_all)
     finally show ?thesis .
   qed
   ultimately show ?case by auto
 qed
 
 
 
 lemma poly_decompose_by_proots:
   fixes p ::"'a::idom poly"
   assumes "p\<noteq>0"
   shows "\<exists>q r. p = q * r \<and> lead_coeff q=1 \<and> (\<forall>x\<in>proots q. P x) \<and> (\<forall>x\<in>proots r. \<not>P x)" using assms
 proof (induct p rule:poly_root_induct_alt)
   case 0
   then show ?case by simp
 next
   case (no_proots p)
   then show ?case 
     apply (rule_tac x=1 in exI)
     apply (rule_tac x=p in exI)
     by (simp add:proots_def)
 next
   case (root a p)
   then obtain q r where pqr:"p = q * r" and leadq:"lead_coeff q=1" 
                     and qball:"\<forall>a\<in>proots q. P a" and rball:"\<forall>x\<in>proots r. \<not> P x" 
     using mult_zero_right by blast
   have ?case when "P a"
     apply (rule_tac x="[:- a, 1:] * q" in exI)
     apply (rule_tac x=r in exI)
     using pqr qball rball that leadq unfolding lead_coeff_mult 
     by (auto simp add:algebra_simps)
   moreover have ?case when "\<not> P a"
     apply (rule_tac x="q" in exI)
     apply (rule_tac x="[:- a, 1:] *r" in exI)
     using pqr qball rball that leadq unfolding lead_coeff_mult 
     by (auto simp add:algebra_simps)
   ultimately show ?case by blast
 qed
 
 lemma proots_upper_cindex_eq':
   assumes "lead_coeff p=1"
   shows "proots_upper p = (degree p - proots_count p {x. Im x=0} 
               - cindex_poly_ubd (map_poly Im p) (map_poly Re p)) /2"
 proof -
   have "p\<noteq>0" using assms by auto
   from poly_decompose_by_proots[OF this,of "\<lambda>x. Im x\<noteq>0"] 
   obtain q r where pqr:"p = q * r" and leadq:"lead_coeff q=1"
               and qball: "\<forall>x\<in>proots q. Im x \<noteq>0" and rball:"\<forall>x\<in>proots r. Im x =0"
     by auto
   have "real_of_int (proots_upper p) = proots_upper q + proots_upper r"
     using \<open>p\<noteq>0\<close> unfolding proots_upper_def pqr by (auto simp add:proots_count_times)
   also have "... = proots_upper q"
   proof -
     have "proots_within r {z. 0 < Im z} = {}"
       using rball by auto
     then have "proots_upper r =0 " 
       unfolding proots_upper_def proots_count_def by simp
     then show ?thesis by auto
   qed
   also have "... =  (degree q - cindex_poly_ubd (map_poly Im q) (map_poly Re q)) / 2"
     by (rule proots_upper_cindex_eq[OF leadq qball])
   also have "... = (degree p - proots_count p {x. Im x=0} 
                       - cindex_poly_ubd (map_poly Im p) (map_poly Re p)) /2"
   proof -
     have "degree q = degree p - proots_count p {x. Im x=0}"
     proof -
       have "degree p= degree q + degree r"
         unfolding pqr
         apply (rule degree_mult_eq)
         using \<open>p \<noteq> 0\<close> pqr by auto
       moreover have "degree r = proots_count p {x. Im x=0}"
         unfolding degree_proots_count proots_count_def
       proof (rule sum.cong)
         fix x assume "x \<in> proots_within p {x. Im x = 0}" 
         then have "Im x=0" by auto
         then have "order x q = 0"
           using qball order_0I by blast
         then show "order x r = order x p" 
           using \<open>p\<noteq>0\<close> unfolding pqr by (simp add: order_mult)
       next 
         show "proots r = proots_within p {x. Im x = 0}"
           unfolding pqr proots_within_times using qball rball by auto
       qed
       ultimately show ?thesis by auto
     qed
     moreover have "cindex_poly_ubd (map_poly Im q) (map_poly Re q) 
             = cindex_poly_ubd (map_poly Im p) (map_poly Re p)"
     proof -
       define iq rq ip rp where "iq = map_poly Im q" and "rq=map_poly Re q" 
                            and "ip=map_poly Im p" and "rp = map_poly Re p"
       have "cindexE (- x) x (\<lambda>x. poly iq x / poly rq x) 
               = cindexE (- x) x (\<lambda>x. poly ip x / poly rp x)" for x
       proof -
         have "lead_coeff r = 1" 
           using pqr leadq \<open>lead_coeff p=1\<close> by (simp add: coeff_degree_mult)
         then have "cindexE (- x) x (\<lambda>t. Im (poly p (t *\<^sub>R 1)) / Re (poly p (t *\<^sub>R 1))) =
                       cindexE (- x) x (\<lambda>t. Im (poly q (t *\<^sub>R 1)) / Re (poly q (t *\<^sub>R 1)))"
           using cindexE_roots_on_horizontal_border[OF pqr,of 0 "-x" x 1
               ,unfolded linepath_def comp_def,simplified] rball by simp
         then show ?thesis
           unfolding scaleR_conv_of_real iq_def ip_def rq_def rp_def 
           by (simp add:Im_poly_of_real Re_poly_of_real)
       qed
       then have "\<forall>\<^sub>F r::real in at_top.
         real_of_int (cindex_poly_ubd iq rq) = cindex_poly_ubd ip rp"
         using eventually_conj[OF cindex_poly_ubd_eventually[of iq rq] 
                 cindex_poly_ubd_eventually[of ip rp]]
         by (elim eventually_mono,auto)
       then show ?thesis
         apply (fold iq_def rq_def ip_def rp_def)
         by simp
     qed
     ultimately show ?thesis by auto
   qed
   finally show ?thesis by simp
 qed
 
 (*If we know that the polynomial p is squarefree, we can cope with the case when there're 
   roots on the border.*)
 lemma proots_within_upper_squarefree:
   assumes "rsquarefree p"
   shows  "card (proots_within p {x. Im x >0}) = (let 
             pp = smult (inverse (lead_coeff p)) p;
             pI = map_poly Im pp;
             pR = map_poly Re pp;
             g = gcd pR pI
         in
             nat ((degree p - changes_R_smods g (pderiv g) - changes_R_smods pR pI) div 2)  
       )"
 proof -
   define pp where "pp = smult (inverse (lead_coeff p)) p"
   define pI where "pI = map_poly Im pp"
   define pR where "pR = map_poly Re pp"
   define g where  "g = gcd pR pI"
   have "card (proots_within p {x. Im x >0}) = proots_upper p"
     unfolding proots_upper_def using card_proots_within_rsquarefree[OF assms] by auto
   also have "... = proots_upper pp"
     unfolding proots_upper_def pp_def
     apply (subst proots_count_smult)
     using assms by auto
   also have "... = (degree pp - proots_count pp {x. Im x = 0} - cindex_poly_ubd pI pR) div 2"
   proof -
     define rr where "rr = proots_count pp {x. Im x = 0}"
     define cpp where "cpp = cindex_poly_ubd pI pR"
     have *:"proots_upper pp = (degree pp - rr - cpp) / 2"
       apply (rule proots_upper_cindex_eq'[of pp,folded rr_def cpp_def pR_def pI_def])
       unfolding pp_def using assms by auto
     also have "... = (degree pp - rr - cpp) div 2"
     proof (subst real_of_int_div)
       define tt where "tt=int (degree pp - rr) - cpp"
       have "real_of_int tt=2*proots_upper pp"
         by (simp add:*[folded tt_def])
       then show "even tt" by (metis dvd_triv_left even_of_nat of_int_eq_iff of_int_of_nat_eq)
     qed simp
     finally show ?thesis unfolding rr_def cpp_def by simp
   qed
   also have "... = (degree pp - changes_R_smods g (pderiv g) 
                         - cindex_poly_ubd pI pR) div 2"
   proof -
     have "rsquarefree pp" 
       using assms rsquarefree_smult_iff unfolding pp_def 
       by (metis inverse_eq_imp_eq inverse_zero leading_coeff_neq_0 rsquarefree_0)
     from card_proots_within_rsquarefree[OF this] 
     have "proots_count pp {x. Im x = 0} = card (proots_within pp {x. Im x = 0})"
       by simp
     also have "... = card (proots_within pp (unbounded_line 0 1))"
     proof -
       have "{x. Im x = 0} = unbounded_line 0 1"
         unfolding unbounded_line_def 
         apply auto
         subgoal for x
           apply (rule_tac x="Re x" in exI)
           by (metis complex_is_Real_iff of_real_Re of_real_def)
         done
       then show ?thesis by simp
     qed
     also have "... = changes_R_smods g (pderiv g)"
       unfolding card_proots_unbounded_line[of 0 1 pp,simplified,folded pI_def pR_def] g_def
       by (auto simp add:Let_def sturm_R[symmetric])
     finally have "proots_count pp {x. Im x = 0} = changes_R_smods g (pderiv g)" .
     moreover have "degree pp \<ge> proots_count pp {x. Im x = 0}" 
       by (metis \<open>rsquarefree pp\<close> proots_count_leq_degree rsquarefree_0)
     ultimately show ?thesis 
       by auto
   qed
   also have "... = (degree p - changes_R_smods g (pderiv g) 
                         - changes_R_smods pR pI) div 2"
     using cindex_poly_ubd_code unfolding pp_def by simp
   finally have "card (proots_within p {x. 0 < Im x}) = (degree p - changes_R_smods g (pderiv g) -
                   changes_R_smods pR pI) div 2" .
   then show ?thesis unfolding Let_def
     apply (fold pp_def pR_def pI_def g_def)
     by (simp add: pp_def)
 qed
     
 lemma proots_upper_code1[code]:
   "proots_upper p = 
     (if p \<noteq> 0 then
        (let pp=smult (inverse (lead_coeff p)) p;
             pI=map_poly Im pp;
             pR=map_poly Re pp;
             g = gcd pI pR
         in
             nat ((degree p - nat (changes_R_smods_ext g (pderiv g)) - changes_R_smods pR pI) div 2) 
         )
     else 
       Code.abort (STR ''proots_upper fails when p=0.'') (\<lambda>_. proots_upper p))"
 proof -
   define pp where "pp = smult (inverse (lead_coeff p)) p"
   define pI where "pI = map_poly Im pp"
   define pR where "pR=map_poly Re pp"
   define g where  "g = gcd pI pR"
   have ?thesis when "p=0"
     using that by auto
   moreover have ?thesis when "p\<noteq>0" 
   proof -
     have "pp\<noteq>0" unfolding pp_def using that by auto
     define rr where "rr=int (degree pp - proots_count pp {x. Im x = 0}) - cindex_poly_ubd pI pR"
     have "lead_coeff p\<noteq>0" using \<open>p\<noteq>0\<close> by simp
     then have "proots_upper pp = rr / 2" unfolding rr_def
       apply (rule_tac proots_upper_cindex_eq'[of pp, folded pI_def pR_def])
       unfolding pp_def lead_coeff_smult by auto
     then have "proots_upper pp = nat (rr div 2)" by linarith
     moreover have
       "rr = degree p - nat (changes_R_smods_ext g (pderiv g)) - changes_R_smods pR pI"
     proof -
       have "degree pp = degree p" unfolding pp_def by auto
       moreover have "proots_count pp {x. Im x = 0} = nat (changes_R_smods_ext g (pderiv g))"
       proof -
         have "{x. Im x = 0} = unbounded_line 0 1"
           unfolding unbounded_line_def by (simp add: complex_eq_iff)
         then show ?thesis 
           using proots_unbounded_line[of 0 1 pp,simplified, folded pI_def pR_def] \<open>pp\<noteq>0\<close>
           by (auto simp:Let_def g_def gcd.commute)
       qed
       moreover have "cindex_poly_ubd pI pR = changes_R_smods pR pI"
         using cindex_poly_ubd_code by auto
       ultimately show ?thesis unfolding rr_def by auto
     qed
     moreover have "proots_upper pp = proots_upper p"
       unfolding pp_def proots_upper_def 
       apply (subst proots_count_smult)
       using that by auto
     ultimately show ?thesis 
       unfolding Let_def using that
       apply (fold pp_def pI_def pR_def g_def)
       by argo
   qed
   ultimately show ?thesis by blast
 qed
 
 lemma proots_upper_card_code[code]:
   "proots_upper_card p = (if p=0 then 0 else
       (let
             pf = p div (gcd p (pderiv p));
             pp = smult (inverse (lead_coeff pf)) pf;
             pI = map_poly Im pp;
             pR = map_poly Re pp;
             g = gcd pR pI
         in
             nat ((degree pf - changes_R_smods g (pderiv g) - changes_R_smods pR pI) div 2)  
       ))"
 proof (cases "p=0")
   case True
   then show ?thesis unfolding proots_upper_card_def using infinite_halfspace_Im_gt by auto
 next
   case False
   define pf pp pI pR g where 
         "pf = p div (gcd p (pderiv p))"
     and "pp = smult (inverse (lead_coeff pf)) pf"
     and "pI = map_poly Im pp"
     and "pR = map_poly Re pp"
     and "g = gcd pR pI"
   have "proots_upper_card p = proots_upper_card pf"
   proof -
     have "proots_within p {x. 0 < Im x} = proots_within pf {x. 0 < Im x}"
       unfolding proots_within_def using poly_gcd_pderiv_iff[of p,folded pf_def]
       by auto
     then show ?thesis unfolding proots_upper_card_def by auto
   qed
   also have "... = nat ((degree pf - changes_R_smods g (pderiv g) - changes_R_smods pR pI) div 2)"
     using proots_within_upper_squarefree[OF rsquarefree_gcd_pderiv[OF \<open>p\<noteq>0\<close>]
         ,unfolded Let_def,folded pf_def,folded pp_def pI_def pR_def g_def]
     unfolding proots_upper_card_def by blast
   finally show ?thesis unfolding Let_def
     apply (fold pf_def,fold pp_def pI_def pR_def g_def)
     using False by auto
 qed
 
 subsection \<open>Polynomial roots on a general half-plane\<close>
 
 text \<open>the number of roots of polynomial @{term p}, counted with multiplicity,
    on the left half plane of the vector @{term "b-a"}.\<close>
 definition proots_half ::"complex poly \<Rightarrow> complex \<Rightarrow> complex \<Rightarrow> nat" where
   "proots_half p a b = proots_count p {w. Im ((w-a) / (b-a)) > 0}"    
   
 lemma proots_half_empty:
   assumes "a=b"
   shows "proots_half p a b = 0"  
 unfolding proots_half_def using assms by auto  
 
 (*TODO: the proof can potentially simplified with some conformal properties.*)
 lemma proots_half_proots_upper:
   assumes "a\<noteq>b" "p\<noteq>0"
   shows "proots_half p a b= proots_upper (pcompose p [:a, (b-a):])"
 proof -
   define q where "q=[:a, (b - a):]"
   define f where "f=(\<lambda>x. (b-a)*x+ a)"
   have "(\<Sum>r\<in>proots_within p {w. Im ((w-a) / (b-a)) > 0}. order r p) 
       = (\<Sum>r\<in>proots_within (p \<circ>\<^sub>p q) {z. 0 < Im z}. order r (p \<circ>\<^sub>pq))"
   proof (rule sum.reindex_cong[of f])
     have "inj f"
       using assms unfolding f_def inj_on_def by fastforce
     then show "inj_on f (proots_within (p \<circ>\<^sub>p q) {z. 0 < Im z})"
       by (elim inj_on_subset,auto)
   next
     show "proots_within p {w. Im ((w-a) / (b-a)) > 0} = f ` proots_within (p \<circ>\<^sub>p q) {z. 0 < Im z}"
     proof safe
       fix x assume x_asm:"x \<in> proots_within p {w. Im ((w-a) / (b-a)) > 0}"
       define xx where "xx=(x -a) / (b - a)"
       have "poly (p \<circ>\<^sub>p q) xx = 0"  
         unfolding q_def xx_def poly_pcompose using assms x_asm by auto
       moreover have "Im xx > 0" 
         unfolding xx_def using x_asm by auto
       ultimately have "xx \<in> proots_within (p \<circ>\<^sub>p q) {z. 0 < Im z}" by auto
       then show "x \<in> f ` proots_within (p \<circ>\<^sub>p q) {z. 0 < Im z}" 
         apply (intro rev_image_eqI[of xx])
         unfolding f_def xx_def using assms by auto
     next
       fix x assume "x \<in> proots_within (p \<circ>\<^sub>p q) {z. 0 < Im z}"
       then show "f x \<in> proots_within p {w. 0 < Im ((w-a) / (b - a))}" 
         unfolding f_def q_def using assms 
         apply (auto simp add:poly_pcompose)
         by (auto simp add:algebra_simps)
     qed
   next
     fix x assume "x \<in> proots_within (p \<circ>\<^sub>p q) {z. 0 < Im z}"
     show "order (f x) p = order x (p \<circ>\<^sub>p q)" using \<open>p\<noteq>0\<close>
     proof (induct p rule:poly_root_induct_alt)
       case 0
       then show ?case by simp
     next
       case (no_proots p)
       have "order (f x) p = 0"
         apply (rule order_0I)        
         using no_proots by auto
       moreover have "order x (p \<circ>\<^sub>p q) = 0"
         apply (rule order_0I)
         unfolding poly_pcompose q_def using no_proots by auto
       ultimately show ?case by auto
     next
       case (root c p)
       have "order (f x) ([:- c, 1:] * p) = order (f x) [:-c,1:] + order (f x) p" 
         apply (subst order_mult)
         using root by auto
       also have "... =  order x ([:- c, 1:] \<circ>\<^sub>p q) +  order x (p \<circ>\<^sub>p q)" 
       proof -
         have "order (f x) [:- c, 1:] = order x ([:- c, 1:] \<circ>\<^sub>p q)" 
         proof (cases "f x=c")
           case True
           have "[:- c, 1:] \<circ>\<^sub>p q = smult (b-a) [:-x,1:]"
             using True unfolding q_def f_def pcompose_pCons by auto
           then have "order x ([:- c, 1:] \<circ>\<^sub>p q) = order x (smult (b-a) [:-x,1:])"
             by auto
           then have "order x ([:- c, 1:] \<circ>\<^sub>p q) = 1"
             apply (subst (asm) order_smult)
             using assms order_power_n_n[of _ 1,simplified] by auto   
           moreover have "order (f x) [:- c, 1:] = 1"
             using True order_power_n_n[of _ 1,simplified] by auto
           ultimately show ?thesis by auto
         next
           case False
           have "order (f x) [:- c, 1:] = 0"
             apply (rule order_0I)
             using False unfolding f_def by auto
           moreover have "order x ([:- c, 1:] \<circ>\<^sub>p q) = 0"
             apply (rule order_0I)
             using False unfolding f_def q_def poly_pcompose by auto
           ultimately show ?thesis by auto
         qed
         moreover have "order (f x) p = order x (p \<circ>\<^sub>p q)"
           apply (rule root)
           using root by auto 
         ultimately show ?thesis by auto
       qed
       also have "... = order x (([:- c, 1:] * p) \<circ>\<^sub>p q)" 
         unfolding pcompose_mult
         apply (subst order_mult)
         subgoal unfolding q_def using assms(1) pcompose_eq_0 root.prems by fastforce  
         by simp
       finally show ?case .
     qed
   qed
   then show ?thesis unfolding proots_half_def proots_upper_def proots_count_def q_def
     by auto
 qed    
      
 lemma proots_half_code1[code]:
   "proots_half p a b = (if a\<noteq>b then 
                         if p\<noteq>0 then proots_upper (p \<circ>\<^sub>p [:a, b - a:]) 
                         else Code.abort (STR ''proots_half fails when p=0.'') 
                           (\<lambda>_. proots_half p a b) 
                         else 0)"
 proof -
   have ?thesis when "a=b"
     using proots_half_empty that by auto
   moreover have ?thesis when "a\<noteq>b" "p=0"
     using that by auto
   moreover have ?thesis when "a\<noteq>b" "p\<noteq>0"
     using proots_half_proots_upper[OF that] that by auto
   ultimately show ?thesis by auto
 qed
 
 subsection \<open>Polynomial roots within a circle (open ball)\<close>
 
 \<comment> \<open>Roots counted WITH multiplicity\<close>
 definition proots_ball::"complex poly \<Rightarrow> complex \<Rightarrow> real \<Rightarrow> nat" where
   "proots_ball p z0 r = proots_count p (ball z0 r)" 
 
 \<comment> \<open>Roots counted WITHOUT multiplicity\<close>
 definition proots_ball_card ::"complex poly \<Rightarrow> complex \<Rightarrow> real \<Rightarrow> nat" where
   "proots_ball_card p z0 r = card (proots_within p (ball z0 r))"
 
 lemma proots_ball_code1[code]:
   "proots_ball p z0 r = ( if r \<le> 0 then 
                               0
                           else if p\<noteq>0 then
                               proots_upper (fcompose (p \<circ>\<^sub>p [:z0, of_real r:]) [:\<i>,-1:] [:\<i>,1:]) 
                           else 
                               Code.abort (STR ''proots_ball fails when p=0.'') 
                                 (\<lambda>_. proots_ball p z0 r)
                         )" 
 proof (cases "p=0 \<or> r\<le>0")
   case False
   have "proots_ball p z0 r = proots_count (p \<circ>\<^sub>p [:z0, of_real r:]) (ball 0 1)"
     unfolding proots_ball_def
     apply (rule proots_uball_eq[THEN arg_cong])
     using False by auto
   also have "... = proots_upper (fcompose (p \<circ>\<^sub>p [:z0, of_real r:]) [:\<i>,-1:] [:\<i>,1:])"
     unfolding proots_upper_def
     apply (rule proots_ball_plane_eq[THEN arg_cong])
     using False pcompose_eq_0[of p "[:z0, of_real r:]"] by auto
   finally show ?thesis using False by auto
 qed (auto simp:proots_ball_def ball_empty)
 
 lemma proots_ball_card_code1[code]:
   "proots_ball_card p z0 r = 
                 ( if r \<le> 0 \<or> p=0 then 
                       0
                  else 
                     proots_upper_card (fcompose (p \<circ>\<^sub>p [:z0, of_real r:]) [:\<i>,-1:] [:\<i>,1:]) 
                         )" 
 proof (cases "p=0 \<or> r\<le>0")
   case True
   moreover have ?thesis when "r\<le>0"
   proof -
     have "proots_within p (ball z0 r) = {}" 
       by (simp add: ball_empty that)
     then show ?thesis unfolding proots_ball_card_def using that by auto
   qed
   moreover have ?thesis when "r>0" "p=0"
     unfolding proots_ball_card_def using that infinite_ball[of r z0]
     by auto
   ultimately show ?thesis by argo
 next
   case False
   then have "p\<noteq>0" "r>0" by auto
   
   have "proots_ball_card p z0 r = card (proots_within (p \<circ>\<^sub>p [:z0, of_real r:]) (ball 0 1))"
     unfolding proots_ball_card_def
     by (rule proots_card_uball_eq[OF \<open>r>0\<close>, THEN arg_cong])
   also have "... = proots_upper_card (fcompose (p \<circ>\<^sub>p [:z0, of_real r:]) [:\<i>,-1:] [:\<i>,1:])"
     unfolding proots_upper_card_def
     apply (rule proots_card_ball_plane_eq[THEN arg_cong])
     using False pcompose_eq_0[of p "[:z0, of_real r:]"] by auto
   finally show ?thesis using False by auto
 qed
 
 subsection \<open>Polynomial roots on a circle (sphere)\<close>
 
 \<comment> \<open>Roots counted WITH multiplicity\<close>
 definition proots_sphere::"complex poly \<Rightarrow> complex \<Rightarrow> real \<Rightarrow> nat" where
   "proots_sphere p z0 r = proots_count p (sphere z0 r)" 
 
 \<comment> \<open>Roots counted WITHOUT multiplicity\<close>
 definition proots_sphere_card ::"complex poly \<Rightarrow> complex \<Rightarrow> real \<Rightarrow> nat" where
   "proots_sphere_card p z0 r = card (proots_within p (sphere z0 r))"
 
 lemma proots_sphere_card_code1[code]:
   "proots_sphere_card p z0 r = 
                 ( if r=0 then 
                       (if poly p z0=0 then 1 else 0) 
                   else if r < 0 \<or> p=0 then 
                       0
                   else 
                     (if poly p (z0-r) =0 then 1 else 0) +
                     proots_unbounded_line_card (fcompose (p \<circ>\<^sub>p [:z0, of_real r:]) [:\<i>,-1:] [:\<i>,1:])
                       0 1 
                 )" 
 proof -
   have ?thesis when "r=0"
   proof -
     have "proots_within p {z0} = (if poly p z0 = 0 then {z0} else {})"
       by auto
     then show ?thesis unfolding proots_sphere_card_def using that by simp
   qed
   moreover have ?thesis when "r\<noteq>0" "r < 0 \<or> p=0"
   proof -
     have ?thesis when "r<0"
     proof -
       have "proots_within p (sphere z0 r) = {}" 
         by (auto simp add: ball_empty that)
       then show ?thesis unfolding proots_sphere_card_def using that by auto
     qed
     moreover have ?thesis when "r>0" "p=0"
       unfolding proots_sphere_card_def using that infinite_sphere[of r z0]
       by auto
     ultimately show ?thesis using that by argo
   qed
   moreover have ?thesis when "r>0" "p\<noteq>0"
   proof -
     define pp where "pp = p \<circ>\<^sub>p [:z0, of_real r:]" 
     define ppp where "ppp=fcompose pp [:\<i>, - 1:] [:\<i>, 1:]"
 
     have "pp\<noteq>0" unfolding pp_def using that pcompose_eq_0 by fastforce
 
     have "proots_sphere_card p z0 r = card (proots_within pp (sphere 0 1))"
       unfolding proots_sphere_card_def pp_def
       by (rule proots_card_usphere_eq[OF \<open>r>0\<close>, THEN arg_cong])
     also have "... = card (proots_within pp {-1} \<union> proots_within pp (sphere 0 1 - {-1}))"
       by (simp add: insert_absorb proots_within_union)
     also have "... = card (proots_within pp {-1}) + card (proots_within pp (sphere 0 1 - {-1}))"
       apply (rule card_Un_disjoint)
       using \<open>pp\<noteq>0\<close> by auto
     also have "... = card (proots_within pp {-1}) + card (proots_within ppp {x. 0 = Im x})"
       using proots_card_sphere_axis_eq[OF \<open>pp\<noteq>0\<close>,folded ppp_def] by simp
     also have "... = (if poly p (z0-r) =0 then 1 else 0) + proots_unbounded_line_card ppp 0 1"
     proof -
       have "proots_within pp {-1} = (if poly p (z0-r) =0 then {-1} else {})"
         unfolding pp_def by (auto simp:poly_pcompose)
       then have "card (proots_within pp {-1}) = (if poly p (z0-r) =0 then 1 else 0)"
         by auto
       moreover have "{x. Im x = 0} = unbounded_line 0 1" 
         unfolding unbounded_line_def 
         apply auto
         by (metis complex_is_Real_iff of_real_Re of_real_def)
       then have "card (proots_within ppp {x. 0 = Im x})
                         = proots_unbounded_line_card ppp 0 1"
         unfolding proots_unbounded_line_card_def by simp
       ultimately show ?thesis by auto
     qed
     finally show ?thesis 
       apply (fold pp_def,fold ppp_def)
       using that by auto
   qed
   ultimately show ?thesis by auto
 qed
 
 subsection \<open>Polynomial roots on a closed ball\<close>
 
 \<comment> \<open>Roots counted WITH multiplicity\<close>
 definition proots_cball::"complex poly \<Rightarrow> complex \<Rightarrow> real \<Rightarrow> nat" where
   "proots_cball p z0 r = proots_count p (cball z0 r)" 
 
 \<comment> \<open>Roots counted WITHOUT multiplicity\<close>
 definition proots_cball_card ::"complex poly \<Rightarrow> complex \<Rightarrow> real \<Rightarrow> nat" where
   "proots_cball_card p z0 r = card (proots_within p (cball z0 r))"
 
 (*FIXME: this surely can be optimised/refined.*)
 lemma proots_cball_card_code1[code]:
   "proots_cball_card p z0 r = 
                 ( if r=0 then 
                       (if poly p z0=0 then 1 else 0) 
                   else if r < 0 \<or> p=0 then 
                       0
                   else 
                     ( let pp=fcompose (p \<circ>\<^sub>p [:z0, of_real r:]) [:\<i>,-1:] [:\<i>,1:] 
                       in 
                         (if poly p (z0-r) =0 then 1 else 0) 
                         + proots_unbounded_line_card pp 0 1 
                         + proots_upper_card pp
                     )
                 )"
 proof -
   have ?thesis when "r=0"
   proof -
     have "proots_within p {z0} = (if poly p z0 = 0 then {z0} else {})"
       by auto
     then show ?thesis unfolding proots_cball_card_def using that by simp
   qed
   moreover have ?thesis when "r\<noteq>0" "r < 0 \<or> p=0"
   proof -
     have ?thesis when "r<0"
     proof -
       have "proots_within p (cball z0 r) = {}" 
         by (auto simp add: ball_empty that)
       then show ?thesis unfolding proots_cball_card_def using that by auto
     qed
     moreover have ?thesis when "r>0" "p=0"
       unfolding proots_cball_card_def using that infinite_cball[of r z0]
       by auto
     ultimately show ?thesis using that by argo
   qed
   moreover have ?thesis when "p\<noteq>0" "r>0"
   proof -
     define pp where "pp=fcompose (p \<circ>\<^sub>p [:z0, of_real r:]) [:\<i>,-1:] [:\<i>,1:]"
 
     have "proots_cball_card p z0 r = card (proots_within p (sphere z0 r) 
                                         \<union> proots_within p (ball z0 r))" 
       unfolding proots_cball_card_def 
       apply (simp add:proots_within_union)
       by (metis Diff_partition cball_diff_sphere sphere_cball)
     also have "... = card (proots_within p (sphere z0 r)) + card (proots_within p (ball z0 r))"
       apply (rule card_Un_disjoint)
       using \<open>p\<noteq>0\<close> by auto
     also have "... = (if poly p (z0-r) =0 then 1 else 0) + proots_unbounded_line_card pp 0 1 
                         + proots_upper_card pp"
       using proots_sphere_card_code1[of p z0 r,folded pp_def,unfolded proots_sphere_card_def] 
         proots_ball_card_code1[of p z0 r,folded pp_def,unfolded proots_ball_card_def]
         that
       by simp
     finally show ?thesis 
       apply (fold pp_def)
       using that by auto
   qed
   ultimately show ?thesis by auto
 qed
 
 end
   
diff --git a/thys/Jordan_Normal_Form/Conjugate.thy b/thys/Jordan_Normal_Form/Conjugate.thy
--- a/thys/Jordan_Normal_Form/Conjugate.thy
+++ b/thys/Jordan_Normal_Form/Conjugate.thy
@@ -1,91 +1,91 @@
 (*  
     Author:      René Thiemann 
                  Akihisa Yamada
     License:     BSD
 *)
 theory Conjugate
-  imports HOL.Complex
+  imports HOL.Complex "HOL-Library.Complex_Order"
 begin
 
 class conjugate =
   fixes conjugate :: "'a \<Rightarrow> 'a"
   assumes conjugate_id[simp]: "conjugate (conjugate a) = a"
       and conjugate_cancel_iff[simp]: "conjugate a = conjugate b \<longleftrightarrow> a = b"
 
 class conjugatable_ring = ring + conjugate +
   assumes conjugate_dist_mul: "conjugate (a * b) = conjugate a * conjugate b"
       and conjugate_dist_add: "conjugate (a + b) = conjugate a + conjugate b"
       and conjugate_neg: "conjugate (-a) = - conjugate a"
       and conjugate_zero[simp]: "conjugate 0 = 0"
 begin
   lemma conjugate_zero_iff[simp]: "conjugate a = 0 \<longleftrightarrow> a = 0"
     using conjugate_cancel_iff[of _ 0, unfolded conjugate_zero].
 end
 
 class conjugatable_field = conjugatable_ring + field
 
 lemma sum_conjugate:
   fixes f :: "'b \<Rightarrow> 'a :: conjugatable_ring"
   assumes finX: "finite X"
   shows "conjugate (sum f X) = sum (\<lambda>x. conjugate (f x)) X"
   using finX by (induct set:finite, auto simp: conjugate_dist_add)
 
 class conjugatable_ordered_ring = conjugatable_ring + ordered_comm_monoid_add +
   assumes conjugate_square_positive: "a * conjugate a \<ge> 0"
 
 class conjugatable_ordered_field = conjugatable_ordered_ring + field
 begin
   subclass conjugatable_field..
 end
 
 lemma conjugate_square_0:
   fixes a :: "'a :: {conjugatable_ordered_ring, semiring_no_zero_divisors}"
   shows "a * conjugate a = 0 \<Longrightarrow> a = 0" by auto
 
 
 subsection \<open>Instantiations\<close>
 
 instantiation complex :: conjugatable_ordered_field
 begin
   definition [simp]: "conjugate \<equiv> cnj"
-  definition [simp]: "x < y \<equiv> Im x = Im y \<and> Re x < Re y"
-  definition [simp]: "x \<le> y \<equiv> Im x = Im y \<and> Re x \<le> Re y"
   
-  instance by (intro_classes, auto simp: complex.expand)
+instance
+  by intro_classes (auto simp: less_eq_complex_def)
+
 end
 
 instantiation real :: conjugatable_ordered_field
 begin
   definition [simp]: "conjugate (x::real) \<equiv> x"
   instance by (intro_classes, auto)
 end
 
 instantiation rat :: conjugatable_ordered_field
 begin
   definition [simp]: "conjugate (x::rat) \<equiv> x"
   instance by (intro_classes, auto)
 end
 
 instantiation int :: conjugatable_ordered_ring
 begin
   definition [simp]: "conjugate (x::int) \<equiv> x"
   instance by (intro_classes, auto)
 end
 
 lemma conjugate_square_eq_0 [simp]:
   fixes x :: "'a :: {conjugatable_ring,semiring_no_zero_divisors}"
   shows "x * conjugate x = 0 \<longleftrightarrow> x = 0" "conjugate x * x = 0 \<longleftrightarrow> x = 0"
   by auto
 
 lemma conjugate_square_greater_0 [simp]:
   fixes x :: "'a :: {conjugatable_ordered_ring,ring_no_zero_divisors}"
   shows "x * conjugate x > 0 \<longleftrightarrow> x \<noteq> 0" 
   using conjugate_square_positive[of x]
   by (auto simp: le_less)
 
 lemma conjugate_square_smaller_0 [simp]:
   fixes x :: "'a :: {conjugatable_ordered_ring,ring_no_zero_divisors}"
   shows "\<not> x * conjugate x < 0"
   using conjugate_square_positive[of x] by auto
 
 end
diff --git a/thys/LLL_Basis_Reduction/Norms.thy b/thys/LLL_Basis_Reduction/Norms.thy
--- a/thys/LLL_Basis_Reduction/Norms.thy
+++ b/thys/LLL_Basis_Reduction/Norms.thy
@@ -1,667 +1,667 @@
 (*
     Authors:    Jose Divasón
                 Maximilian Haslbeck
                 Sebastiaan Joosten
                 René Thiemann
                 Akihisa Yamada
     License:    BSD
 *)
 
 section \<open>Norms\<close>
 
 text \<open>In this theory we provide the basic definitions and properties of several 
   norms of vectors and polynomials.
 \<close> 
 
 theory Norms
   imports "HOL-Computational_Algebra.Polynomial" 
     "HOL-Library.Adhoc_Overloading"
     "Jordan_Normal_Form.Conjugate"
     "Algebraic_Numbers.Resultant" (* only for poly_of_vec *)
     Missing_Lemmas
 begin
 
 subsection \<open>L-\<open>\<infinity>\<close> Norms\<close>
 
 consts linf_norm :: "'a \<Rightarrow> 'b" ("\<parallel>(_)\<parallel>\<^sub>\<infinity>")
 
 definition linf_norm_vec where "linf_norm_vec v \<equiv> max_list (map abs (list_of_vec v) @ [0])"
 adhoc_overloading linf_norm linf_norm_vec
 
 definition linf_norm_poly where "linf_norm_poly f \<equiv> max_list (map abs (coeffs f) @ [0])"
 adhoc_overloading linf_norm linf_norm_poly
 
 lemma linf_norm_vec: "\<parallel>vec n f\<parallel>\<^sub>\<infinity> = max_list (map (abs \<circ> f) [0..<n] @ [0])"
   by (simp add: linf_norm_vec_def)
 
 lemma linf_norm_vec_vCons[simp]: "\<parallel>vCons a v\<parallel>\<^sub>\<infinity> = max \<bar>a\<bar> \<parallel>v\<parallel>\<^sub>\<infinity>"
   by (auto simp: linf_norm_vec_def max_list_Cons)
 
 lemma linf_norm_vec_0 [simp]: "\<parallel>vec 0 f\<parallel>\<^sub>\<infinity> = 0" by (simp add: linf_norm_vec_def)
 
 lemma linf_norm_zero_vec [simp]: "\<parallel>0\<^sub>v n :: 'a :: ordered_ab_group_add_abs vec\<parallel>\<^sub>\<infinity> = 0"
   by (induct n, simp add: zero_vec_def, auto simp: zero_vec_Suc)
 
 lemma linf_norm_vec_ge_0 [intro!]:
   fixes v :: "'a :: ordered_ab_group_add_abs vec"
   shows "\<parallel>v\<parallel>\<^sub>\<infinity> \<ge> 0"
   by (induct v, auto simp: max_def)
 
 lemma linf_norm_vec_eq_0 [simp]:
   fixes v :: "'a :: ordered_ab_group_add_abs vec"
   assumes "v \<in> carrier_vec n"
   shows "\<parallel>v\<parallel>\<^sub>\<infinity> = 0 \<longleftrightarrow> v = 0\<^sub>v n"
   by (insert assms, induct rule: carrier_vec_induct, auto simp: zero_vec_Suc max_def)
 
 lemma linf_norm_vec_greater_0 [simp]:
   fixes v :: "'a :: ordered_ab_group_add_abs vec"
   assumes "v \<in> carrier_vec n"
   shows "\<parallel>v\<parallel>\<^sub>\<infinity> > 0 \<longleftrightarrow> v \<noteq> 0\<^sub>v n"
   by (insert assms, induct rule: carrier_vec_induct, auto simp: zero_vec_Suc max_def)
 
 lemma linf_norm_poly_0 [simp]: "\<parallel>0::_ poly\<parallel>\<^sub>\<infinity> = 0"
   by (simp add: linf_norm_poly_def)
 
 lemma linf_norm_pCons [simp]:
   fixes p :: "'a :: ordered_ab_group_add_abs poly"
   shows "\<parallel>pCons a p\<parallel>\<^sub>\<infinity> = max \<bar>a\<bar> \<parallel>p\<parallel>\<^sub>\<infinity>"
   by (cases "p = 0", cases "a = 0", auto simp: linf_norm_poly_def max_list_Cons)
 
 lemma linf_norm_poly_ge_0 [intro!]:
   fixes f :: "'a :: ordered_ab_group_add_abs poly"
   shows "\<parallel>f\<parallel>\<^sub>\<infinity> \<ge> 0"
   by (induct f, auto simp: max_def)
 
 lemma linf_norm_poly_eq_0 [simp]:
   fixes f :: "'a :: ordered_ab_group_add_abs poly"
   shows "\<parallel>f\<parallel>\<^sub>\<infinity> = 0 \<longleftrightarrow> f = 0"
   by (induct f, auto simp: max_def)
 
 lemma linf_norm_poly_greater_0 [simp]:
   fixes f :: "'a :: ordered_ab_group_add_abs poly"
   shows "\<parallel>f\<parallel>\<^sub>\<infinity> > 0 \<longleftrightarrow> f \<noteq> 0"
   by (induct f, auto simp: max_def)
 
 subsection \<open>Square Norms\<close>
 
 consts sq_norm :: "'a \<Rightarrow> 'b" ("\<parallel>(_)\<parallel>\<^sup>2")
 
 abbreviation "sq_norm_conjugate x \<equiv> x * conjugate x"
 adhoc_overloading sq_norm sq_norm_conjugate
 
 subsubsection \<open>Square norms for vectors\<close>
 
 text \<open>We prefer sum\_list over sum because it is not essentially dependent on commutativity,
   and easier for proving.
 \<close>
 definition "sq_norm_vec v \<equiv> \<Sum>x \<leftarrow> list_of_vec v. \<parallel>x\<parallel>\<^sup>2"
 adhoc_overloading sq_norm sq_norm_vec
 
 lemma sq_norm_vec_vCons[simp]: "\<parallel>vCons a v\<parallel>\<^sup>2 = \<parallel>a\<parallel>\<^sup>2 + \<parallel>v\<parallel>\<^sup>2"
   by (simp add: sq_norm_vec_def)
 
 lemma sq_norm_vec_0[simp]: "\<parallel>vec 0 f\<parallel>\<^sup>2 = 0"
   by (simp add: sq_norm_vec_def)
 
 lemma sq_norm_vec_as_cscalar_prod:
   fixes v :: "'a :: conjugatable_ring vec"
   shows "\<parallel>v\<parallel>\<^sup>2 = v \<bullet>c v"
   by (induct v, simp_all add: sq_norm_vec_def)
 
 lemma sq_norm_zero_vec[simp]: "\<parallel>0\<^sub>v n :: 'a :: conjugatable_ring vec\<parallel>\<^sup>2 = 0"
   by (simp add: sq_norm_vec_as_cscalar_prod)
 
 lemmas sq_norm_vec_ge_0 [intro!] = conjugate_square_ge_0_vec[folded sq_norm_vec_as_cscalar_prod]
 
 lemmas sq_norm_vec_eq_0 [simp] = conjugate_square_eq_0_vec[folded sq_norm_vec_as_cscalar_prod]
 
 lemmas sq_norm_vec_greater_0 [simp] = conjugate_square_greater_0_vec[folded sq_norm_vec_as_cscalar_prod]
 
 subsubsection \<open>Square norm for polynomials\<close>
 
 definition sq_norm_poly where "sq_norm_poly p \<equiv> \<Sum>a\<leftarrow>coeffs p. \<parallel>a\<parallel>\<^sup>2"
 
 adhoc_overloading sq_norm sq_norm_poly
 
 lemma sq_norm_poly_0 [simp]: "\<parallel>0::_poly\<parallel>\<^sup>2 = 0"
   by (auto simp: sq_norm_poly_def)
 
 lemma sq_norm_poly_pCons [simp]:
   fixes a :: "'a :: conjugatable_ring"
   shows "\<parallel>pCons a p\<parallel>\<^sup>2 = \<parallel>a\<parallel>\<^sup>2 + \<parallel>p\<parallel>\<^sup>2"
   by (cases "p = 0"; cases "a = 0", auto simp: sq_norm_poly_def)
 
 lemma sq_norm_poly_ge_0 [intro!]:
   fixes p :: "'a :: conjugatable_ordered_ring poly"
   shows "\<parallel>p\<parallel>\<^sup>2 \<ge> 0"
   by (unfold sq_norm_poly_def, rule sum_list_nonneg, auto intro!:conjugate_square_positive)
 
 lemma sq_norm_poly_eq_0 [simp]:
   fixes p :: "'a :: {conjugatable_ordered_ring,ring_no_zero_divisors} poly"
   shows "\<parallel>p\<parallel>\<^sup>2 = 0 \<longleftrightarrow> p = 0"
 proof (induct p)
   case IH: (pCons a p)
   show ?case
   proof (cases "a = 0")
     case True
     with IH show ?thesis by simp
   next
     case False
     then have "\<parallel>a\<parallel>\<^sup>2 + \<parallel>p\<parallel>\<^sup>2 > 0" by (intro add_pos_nonneg, auto)
     then show ?thesis by auto
   qed
 qed simp
 
 lemma sq_norm_poly_pos [simp]:
   fixes p :: "'a :: {conjugatable_ordered_ring,ring_no_zero_divisors} poly"
   shows "\<parallel>p\<parallel>\<^sup>2 > 0 \<longleftrightarrow> p \<noteq> 0"
   by (auto simp: less_le)
 
 lemma sq_norm_vec_of_poly [simp]:
   fixes p :: "'a :: conjugatable_ring poly"
   shows "\<parallel>vec_of_poly p\<parallel>\<^sup>2 = \<parallel>p\<parallel>\<^sup>2"
   apply (unfold sq_norm_poly_def sq_norm_vec_def)
   apply (fold sum_mset_sum_list)
   apply auto.
 
 lemma sq_norm_poly_of_vec [simp]:
   fixes v :: "'a :: conjugatable_ring vec"
   shows "\<parallel>poly_of_vec v\<parallel>\<^sup>2 = \<parallel>v\<parallel>\<^sup>2"
   apply (unfold sq_norm_poly_def sq_norm_vec_def coeffs_poly_of_vec)
   apply (fold rev_map)
   apply (fold sum_mset_sum_list)
   apply (unfold mset_rev)
   apply (unfold sum_mset_sum_list)
   by (auto intro: sum_list_map_dropWhile0)
 
 subsection \<open>Relating Norms\<close>
 
 text \<open>A class where ordering around 0 is linear.\<close>
 abbreviation (in ordered_semiring) is_real where "is_real a \<equiv> a < 0 \<or> a = 0 \<or> 0 < a"
 
 class semiring_real_line = ordered_semiring_strict + ordered_semiring_0 +
   assumes add_pos_neg_is_real: "a > 0 \<Longrightarrow> b < 0 \<Longrightarrow> is_real (a + b)"
       and mult_neg_neg: "a < 0 \<Longrightarrow> b < 0 \<Longrightarrow> 0 < a * b"
       and pos_pos_linear: "0 < a \<Longrightarrow> 0 < b \<Longrightarrow> a < b \<or> a = b \<or> b < a"
       and neg_neg_linear: "a < 0 \<Longrightarrow> b < 0 \<Longrightarrow> a < b \<or> a = b \<or> b < a"
 begin
 
 lemma add_neg_pos_is_real: "a < 0 \<Longrightarrow> b > 0 \<Longrightarrow> is_real (a + b)"
   using add_pos_neg_is_real[of b a] by (simp add: ac_simps)
 
 lemma nonneg_linorder_cases [consumes 2, case_names less eq greater]:
   assumes "0 \<le> a" and "0 \<le> b"
       and "a < b \<Longrightarrow> thesis" "a = b \<Longrightarrow> thesis" "b < a \<Longrightarrow> thesis"
   shows thesis
   using assms pos_pos_linear by (auto simp: le_less)
 
 lemma nonpos_linorder_cases [consumes 2, case_names less eq greater]:
   assumes "a \<le> 0" "b \<le> 0"
       and "a < b \<Longrightarrow> thesis" "a = b \<Longrightarrow> thesis" "b < a \<Longrightarrow> thesis"
   shows thesis
   using assms neg_neg_linear by (auto simp: le_less)
 
 lemma real_linear:
   assumes "is_real a" and "is_real b" shows "a < b \<or> a = b \<or> b < a"
   using pos_pos_linear neg_neg_linear assms by (auto dest: less_trans[of _ 0])
 
 lemma real_linorder_cases [consumes 2, case_names less eq greater]:
   assumes real: "is_real a" "is_real b"
       and cases: "a < b \<Longrightarrow> thesis" "a = b \<Longrightarrow> thesis" "b < a \<Longrightarrow> thesis"
   shows thesis
   using real_linear[OF real] cases by auto
 
 lemma
   assumes a: "is_real a" and b: "is_real b"
   shows real_add_le_cancel_left_pos: "c + a \<le> c + b \<longleftrightarrow> a \<le> b"
     and real_add_less_cancel_left_pos: "c + a < c + b \<longleftrightarrow> a < b"
     and real_add_le_cancel_right_pos: "a + c \<le> b + c \<longleftrightarrow> a \<le> b"
     and real_add_less_cancel_right_pos: "a + c < b + c \<longleftrightarrow> a < b"
   using add_strict_left_mono[of b a c] add_strict_left_mono[of a b c]
   using add_strict_right_mono[of b a c] add_strict_right_mono[of a b c]
   by (atomize(full), cases rule: real_linorder_cases[OF a b], auto)
 
 lemma
   assumes a: "is_real a" and b: "is_real b" and c: "0 < c"
   shows real_mult_le_cancel_left_pos: "c * a \<le> c * b \<longleftrightarrow> a \<le> b"
     and real_mult_less_cancel_left_pos: "c * a < c * b \<longleftrightarrow> a < b"
     and real_mult_le_cancel_right_pos: "a * c \<le> b * c \<longleftrightarrow> a \<le> b"
     and real_mult_less_cancel_right_pos: "a * c < b * c \<longleftrightarrow> a < b"
   using mult_strict_left_mono[of b a c] mult_strict_left_mono[of a b c] c
   using mult_strict_right_mono[of b a c] mult_strict_right_mono[of a b c] c
   by (atomize(full), cases rule: real_linorder_cases[OF a b], auto)
 
 lemma
   assumes a: "is_real a" and b: "is_real b"
   shows not_le_real: "\<not> a \<ge> b \<longleftrightarrow> a < b"
     and not_less_real: "\<not> a > b \<longleftrightarrow> a \<le> b"
   by (atomize(full), cases rule: real_linorder_cases[OF a b], auto simp: less_imp_le)
 
 lemma real_mult_eq_0_iff:
   assumes a: "is_real a" and b: "is_real b"
   shows "a * b = 0 \<longleftrightarrow> a = 0 \<or> b = 0"
 proof-
   { assume l: "a * b = 0" and "a \<noteq> 0" and "b \<noteq> 0"
     with a b have "a < 0 \<or> 0 < a" and "b < 0 \<or> 0 < b" by auto
     then have "False" using mult_pos_pos[of a b] mult_pos_neg[of a b] mult_neg_pos[of a b] mult_neg_neg[of a b]
       by (auto simp:l)
   } then show ?thesis by auto
 qed
 
 end
 
 lemma real_pos_mult_max:
   fixes a b c :: "'a :: semiring_real_line"
   assumes c: "c > 0" and a: "is_real a" and b: "is_real b"
   shows "c * max a b = max (c * a) (c * b)"
   by (rule hom_max, simp add: real_mult_le_cancel_left_pos[OF a b c])
 
 class ring_abs_real_line = ordered_ring_abs + semiring_real_line
 
 class semiring_1_real_line = semiring_real_line + monoid_mult + zero_less_one
 begin
 
 subclass ordered_semiring_1 by (unfold_locales, auto)
 
 lemma power_both_mono: "1 \<le> a \<Longrightarrow> m \<le> n \<Longrightarrow> a \<le> b \<Longrightarrow> a ^ m \<le> b ^ n"
   using power_mono[of a b n] power_increasing[of m n a]
   by (auto simp: order.trans[OF zero_le_one])
 
 lemma power_pos:
   assumes a0: "0 < a" shows "0 < a ^ n"
   by (induct n, insert mult_strict_mono[OF a0] a0, auto)
 
 lemma power_neg:
   assumes a0: "a < 0" shows "odd n \<Longrightarrow> a ^ n < 0" and "even n \<Longrightarrow> a ^ n > 0"
   by (atomize(full), induct n, insert a0, auto simp add: mult_pos_neg2 mult_neg_neg)
 
 lemma power_ge_0_iff:
   assumes a: "is_real a"
   shows "0 \<le> a ^ n \<longleftrightarrow> 0 \<le> a \<or> even n"
 using a proof (elim disjE)
   assume "a < 0"
   with power_neg[OF this, of n] show ?thesis by(cases "even n", auto)
 next
   assume "0 < a"
   with power_pos[OF this] show ?thesis by auto
 next
   assume "a = 0"
   then show ?thesis by (auto simp:power_0_left)
 qed
 
 lemma nonneg_power_less:
   assumes "0 \<le> a" and "0 \<le> b" shows "a^n < b^n \<longleftrightarrow> n > 0 \<and> a < b"
 proof (insert assms, induct n arbitrary: a b)
   case 0
   then show ?case by auto
 next
   case (Suc n)
   note a = \<open>0 \<le> a\<close>
   note b = \<open>0 \<le> b\<close>
   show ?case
   proof (cases "n > 0")
     case True
     from a b show ?thesis
     proof (cases rule: nonneg_linorder_cases)
       case less
       then show ?thesis by (auto simp: Suc.hyps[OF a b] True intro!:mult_strict_mono' a b zero_le_power)
     next
       case eq
       then show ?thesis by simp
     next
       case greater
       with Suc.hyps[OF b a] True have "b ^ n < a ^ n" by auto
       with mult_strict_mono'[OF greater this] b greater
       show ?thesis by auto
     qed
   qed auto
 qed
 
 lemma power_strict_mono:
   shows "a < b \<Longrightarrow> 0 \<le> a \<Longrightarrow> 0 < n \<Longrightarrow> a ^ n < b ^ n"
   by (subst nonneg_power_less, auto)
 
 lemma nonneg_power_le:
   assumes "0 \<le> a" and "0 \<le> b" shows "a^n \<le> b^n \<longleftrightarrow> n = 0 \<or> a \<le> b"
 using assms proof (cases rule: nonneg_linorder_cases)
   case less
   with power_strict_mono[OF this, of n] assms show ?thesis by (cases n, auto)
 next
   case eq
   then show ?thesis by auto
 next
   case greater
   with power_strict_mono[OF this, of n] assms show ?thesis by (cases n, auto)
 qed
 
 end
 
 subclass (in linordered_idom) semiring_1_real_line
   apply unfold_locales
   by (auto simp: mult_strict_left_mono mult_strict_right_mono mult_neg_neg)
 
 class ring_1_abs_real_line = ring_abs_real_line + semiring_1_real_line
 begin
 
 subclass ring_1..
 
 lemma abs_cases:
   assumes "a = 0 \<Longrightarrow> thesis" and "\<bar>a\<bar> > 0 \<Longrightarrow> thesis" shows thesis
   using assms by auto
 
 lemma abs_linorder_cases[case_names less eq greater]:
   assumes "\<bar>a\<bar> < \<bar>b\<bar> \<Longrightarrow> thesis" and "\<bar>a\<bar> = \<bar>b\<bar> \<Longrightarrow> thesis" and "\<bar>b\<bar> < \<bar>a\<bar> \<Longrightarrow> thesis"
   shows thesis
   apply (cases rule: nonneg_linorder_cases[of "\<bar>a\<bar>" "\<bar>b\<bar>"])
   using assms by auto
 
 lemma [simp]:
   shows not_le_abs_abs: "\<not> \<bar>a\<bar> \<ge> \<bar>b\<bar> \<longleftrightarrow> \<bar>a\<bar> < \<bar>b\<bar>"
     and not_less_abs_abs: "\<not> \<bar>a\<bar> > \<bar>b\<bar> \<longleftrightarrow> \<bar>a\<bar> \<le> \<bar>b\<bar>"
   by (atomize(full), cases a b rule: abs_linorder_cases, auto simp: less_imp_le)
 
 lemma abs_power_less [simp]: "\<bar>a\<bar>^n < \<bar>b\<bar>^n \<longleftrightarrow> n > 0 \<and> \<bar>a\<bar> < \<bar>b\<bar>"
   by (subst nonneg_power_less, auto)
 
 lemma abs_power_le [simp]: "\<bar>a\<bar>^n \<le> \<bar>b\<bar>^n \<longleftrightarrow> n = 0 \<or> \<bar>a\<bar> \<le> \<bar>b\<bar>"
   by (subst nonneg_power_le, auto)
 
 lemma abs_power_pos [simp]: "\<bar>a\<bar>^n > 0 \<longleftrightarrow> a \<noteq> 0 \<or> n = 0"
   using power_pos[of "\<bar>a\<bar>"] by (cases "n", auto)
 
 lemma abs_power_nonneg [intro!]: "\<bar>a\<bar>^n \<ge> 0" by auto
 
 lemma abs_power_eq_0 [simp]: "\<bar>a\<bar>^n = 0 \<longleftrightarrow> a = 0 \<and> n \<noteq> 0"
   apply (induct n, force)
   apply (unfold power_Suc)
   apply (subst real_mult_eq_0_iff, auto).
 
 end
 
 instance nat :: semiring_1_real_line by (intro_classes, auto)
 instance int :: ring_1_abs_real_line..
 
 lemma vec_index_vec_of_list [simp]: "vec_of_list xs $ i = xs ! i"
   by transfer (auto simp: mk_vec_def undef_vec_def dest: empty_nth)
 
 lemma vec_of_list_append: "vec_of_list (xs @ ys) = vec_of_list xs @\<^sub>v vec_of_list ys"
   by (auto simp: nth_append)
 
 lemma linf_norm_vec_of_list:
   "\<parallel>vec_of_list xs\<parallel>\<^sub>\<infinity> = max_list (map abs xs @ [0])"
   by (simp add: linf_norm_vec_def)
 
 lemma linf_norm_vec_as_Greatest:
   fixes v :: "'a :: ring_1_abs_real_line vec"
   shows "\<parallel>v\<parallel>\<^sub>\<infinity> = (GREATEST a. a \<in> abs ` set (list_of_vec v) \<union> {0})"
   unfolding linf_norm_vec_of_list[of "list_of_vec v", simplified]
   by (subst max_list_as_Greatest, auto)
 
 lemma vec_of_poly_pCons:
   assumes "f \<noteq> 0"
   shows "vec_of_poly (pCons a f) = vec_of_poly f @\<^sub>v vec_of_list [a]"
   using assms
   by (auto simp: vec_eq_iff Suc_diff_le)
 
 lemma vec_of_poly_as_vec_of_list:
   assumes "f \<noteq> 0"
   shows "vec_of_poly f = vec_of_list (rev (coeffs f))"
 proof (insert assms, induct f)
   case 0
   then show ?case by auto
 next
   case (pCons a f)
   then show ?case
     by (cases "f = 0", auto simp: vec_of_list_append vec_of_poly_pCons)
 qed
 
 lemma linf_norm_vec_of_poly [simp]:
   fixes f :: "'a :: ring_1_abs_real_line poly"
   shows "\<parallel>vec_of_poly f\<parallel>\<^sub>\<infinity> = \<parallel>f\<parallel>\<^sub>\<infinity>"
 proof (cases "f = 0")
   case False
   then show ?thesis
     apply (unfold vec_of_poly_as_vec_of_list linf_norm_vec_of_list linf_norm_poly_def)
     apply (subst (1 2) max_list_as_Greatest, auto).
 qed simp
 
 lemma linf_norm_poly_as_Greatest:
   fixes f :: "'a :: ring_1_abs_real_line poly"
   shows "\<parallel>f\<parallel>\<^sub>\<infinity> = (GREATEST a. a \<in> abs ` set (coeffs f) \<union> {0})"
   using linf_norm_vec_as_Greatest[of "vec_of_poly f"]
   by simp
 
 lemma vec_index_le_linf_norm:
   fixes v :: "'a :: ring_1_abs_real_line vec"
   assumes "i < dim_vec v"
   shows "\<bar>v$i\<bar> \<le> \<parallel>v\<parallel>\<^sub>\<infinity>"
 apply (unfold linf_norm_vec_def, rule le_max_list) using assms
 apply (auto simp:  in_set_conv_nth intro!: imageI exI[of _ i]).
 
 lemma coeff_le_linf_norm:
   fixes f :: "'a :: ring_1_abs_real_line poly"
   shows "\<bar>coeff f i\<bar> \<le> \<parallel>f\<parallel>\<^sub>\<infinity>"
   using vec_index_le_linf_norm[of "degree f - i" "vec_of_poly f"]
   by (cases "i \<le> degree f", auto simp: coeff_eq_0)
 
 class conjugatable_ring_1_abs_real_line = conjugatable_ring + ring_1_abs_real_line + power +
   assumes sq_norm_as_sq_abs [simp]: "\<parallel>a\<parallel>\<^sup>2 = \<bar>a\<bar>\<^sup>2"
 begin
 subclass conjugatable_ordered_ring by (unfold_locales, simp)
 end
 
 instance int :: conjugatable_ring_1_abs_real_line
   by (intro_classes, simp add: numeral_2_eq_2)
 
 instance rat :: conjugatable_ring_1_abs_real_line
   by (intro_classes, simp add: numeral_2_eq_2)
 
 instance real :: conjugatable_ring_1_abs_real_line
   by (intro_classes, simp add: numeral_2_eq_2)
 
 instance complex :: semiring_1_real_line
   apply intro_classes
-  by (auto simp: complex_eq_iff mult_le_cancel_left mult_le_cancel_right mult_neg_neg)
+  by (auto simp: complex_eq_iff mult_le_cancel_left mult_le_cancel_right mult_neg_neg less_complex_def less_eq_complex_def)
 
 text \<open>
   Due to the assumption @{thm abs_ge_self} from Groups.thy,
   @{type complex} cannot be @{class ring_1_abs_real_line}!
 \<close>
 instance complex :: ordered_ab_group_add_abs oops
 
 lemma sq_norm_as_sq_abs [simp]: "(sq_norm :: 'a :: conjugatable_ring_1_abs_real_line \<Rightarrow> 'a) = power2 \<circ> abs"
   by auto
 
 lemma sq_norm_vec_le_linf_norm:
   fixes v :: "'a :: {conjugatable_ring_1_abs_real_line} vec"
   assumes "v \<in> carrier_vec n"
   shows "\<parallel>v\<parallel>\<^sup>2 \<le> of_nat n * \<parallel>v\<parallel>\<^sub>\<infinity>\<^sup>2"
 proof (insert assms, induct rule: carrier_vec_induct)
   case (Suc n a v)
   have [dest!]: "\<not> \<bar>a\<bar> \<le> \<parallel>v\<parallel>\<^sub>\<infinity> \<Longrightarrow> of_nat n * \<parallel>v\<parallel>\<^sub>\<infinity>\<^sup>2 \<le> of_nat n * \<bar>a\<bar>\<^sup>2"
     by (rule real_linorder_cases[of "\<bar>a\<bar>" "\<parallel>v\<parallel>\<^sub>\<infinity>"], insert Suc, auto simp: less_le intro!: power_mono mult_left_mono)
   from Suc show ?case
     by (auto simp: ring_distribs max_def intro!:add_mono power_mono)
 qed simp
  
 lemma sq_norm_poly_le_linf_norm:
   fixes p :: "'a :: {conjugatable_ring_1_abs_real_line} poly"
   shows "\<parallel>p\<parallel>\<^sup>2 \<le> of_nat (degree p + 1) * \<parallel>p\<parallel>\<^sub>\<infinity>\<^sup>2"
   using sq_norm_vec_le_linf_norm[of "vec_of_poly p" "degree p + 1"]
     by (auto simp: carrier_dim_vec)
 
 lemma coeff_le_sq_norm:
   fixes f :: "'a :: {conjugatable_ring_1_abs_real_line} poly"
   shows "\<bar>coeff f i\<bar>\<^sup>2 \<le> \<parallel>f\<parallel>\<^sup>2"
 proof (induct f arbitrary: i)
   case (pCons a f)
   show ?case
   proof (cases i)
     case (Suc ii)
     note pCons(2)[of ii]
     also have "\<parallel>f\<parallel>\<^sup>2 \<le> \<bar>a\<bar>\<^sup>2 + \<parallel>f\<parallel>\<^sup>2" by auto
     finally show ?thesis unfolding Suc by auto
   qed auto
 qed simp
 
 lemma max_norm_witness:
   fixes f :: "'a :: ordered_ring_abs poly"
   shows "\<exists> i. \<parallel>f\<parallel>\<^sub>\<infinity> = \<bar>coeff f i\<bar>"
   by (induct f, auto simp add: max_def intro: exI[of _ "Suc _"] exI[of _ 0])
 
 lemma max_norm_le_sq_norm:
   fixes f ::  "'a :: conjugatable_ring_1_abs_real_line poly"
 shows "\<parallel>f\<parallel>\<^sub>\<infinity>\<^sup>2 \<le> \<parallel>f\<parallel>\<^sup>2" 
 proof -
   from max_norm_witness[of f] obtain i where id: "\<parallel>f\<parallel>\<^sub>\<infinity> = \<bar>coeff f i\<bar>" by auto
   show ?thesis unfolding id using coeff_le_sq_norm[of f i] by auto
 qed
 
 (*TODO MOVE*)
 lemma (in conjugatable_ring) conjugate_minus: "conjugate (x - y) = conjugate x - conjugate y"
   by (unfold diff_conv_add_uminus conjugate_dist_add conjugate_neg, rule)
 
 lemma conjugate_1[simp]: "(conjugate 1 :: 'a :: {conjugatable_ring, ring_1}) = 1"
 proof-
   have "conjugate 1 * 1 = (conjugate 1 :: 'a)" by simp
   also have "conjugate \<dots> = 1" by simp
   finally show ?thesis by (unfold conjugate_dist_mul, simp)
 qed
 
 lemma conjugate_of_int [simp]:
   "(conjugate (of_int x) :: 'a :: {conjugatable_ring,ring_1}) = of_int x"
 proof (induct x)
   case (nonneg n)
   then show ?case by (induct n, auto simp: conjugate_dist_add)
 next
   case (neg n)
   then show ?case apply (induct n, auto simp: conjugate_minus conjugate_neg)
     by (metis conjugate_1 conjugate_dist_add one_add_one)
 qed
 
 
 lemma sq_norm_of_int: "\<parallel>map_vec of_int v :: 'a :: {conjugatable_ring,ring_1} vec\<parallel>\<^sup>2 = of_int \<parallel>v\<parallel>\<^sup>2" 
   unfolding sq_norm_vec_as_cscalar_prod scalar_prod_def
   unfolding hom_distribs
   by (rule sum.cong, auto)
 
 definition "norm1 p = sum_list (map abs (coeffs p))"
 
 lemma norm1_ge_0: "norm1 (f :: 'a :: {abs,ordered_semiring_0,ordered_ab_group_add_abs}poly) \<ge> 0" 
   unfolding norm1_def by (rule sum_list_nonneg, auto)
 
 lemma norm2_norm1_main_equality: fixes f :: "nat \<Rightarrow> 'a :: linordered_idom" 
   shows "(\<Sum>i = 0..<n. \<bar>f i\<bar>)\<^sup>2 = (\<Sum>i = 0..<n. f i * f i)
       + (\<Sum>i = 0..<n. \<Sum>j = 0..<n. if i = j then 0 else \<bar>f i\<bar> * \<bar>f j\<bar>)"  
 proof (induct n)
   case (Suc n)
   have id: "{0 ..< Suc n} = insert n {0 ..< n}" by auto
   have id: "sum f {0 ..< Suc n} = f n + sum f {0 ..< n}" for f :: "nat \<Rightarrow> 'a" 
     unfolding id by (rule sum.insert, auto)
   show ?case unfolding id power2_sum unfolding Suc
     by (auto simp: power2_eq_square sum_distrib_left sum.distrib ac_simps)
 qed auto
 
 lemma norm2_norm1_main_inequality: fixes f :: "nat \<Rightarrow> 'a :: linordered_idom" 
   shows "(\<Sum>i = 0..<n. f i * f i) \<le> (\<Sum>i = 0..<n. \<bar>f i\<bar>)\<^sup>2"  
   unfolding norm2_norm1_main_equality 
   by (auto intro!: sum_nonneg)  
 
 lemma norm2_le_norm1_int: "\<parallel>f :: int poly\<parallel>\<^sup>2 \<le> (norm1 f)^2" 
 proof -
   define F where "F = (!) (coeffs f)" 
   define n where "n = length (coeffs f)" 
   have 1: "\<parallel>f\<parallel>\<^sup>2 = (\<Sum>i = 0..<n. F i * F i)" 
     unfolding norm1_def sq_norm_poly_def sum_list_sum_nth F_def n_def
     by (subst sum.cong, auto simp: power2_eq_square)
   have 2: "norm1 f = (\<Sum>i = 0..<n. \<bar>F i\<bar>)" 
     unfolding norm1_def sq_norm_poly_def sum_list_sum_nth F_def n_def
     by (subst sum.cong, auto)
   show ?thesis unfolding 1 2 by (rule norm2_norm1_main_inequality)
 qed
 
 lemma sq_norm_smult_vec: "sq_norm ((c :: 'a :: {conjugatable_ring,comm_semiring_0}) \<cdot>\<^sub>v v) = (c * conjugate c) * sq_norm v" 
   unfolding sq_norm_vec_as_cscalar_prod 
   by (subst scalar_prod_smult_left, force, unfold conjugate_smult_vec, 
     subst scalar_prod_smult_right, force, simp add: ac_simps)
 
 lemma vec_le_sq_norm:
   fixes v :: "'a :: conjugatable_ring_1_abs_real_line vec"
   assumes "v \<in> carrier_vec n" "i < n"
   shows "\<bar>v $ i\<bar>\<^sup>2 \<le> \<parallel>v\<parallel>\<^sup>2"
 using assms proof (induction v arbitrary: i)
   case (Suc n a v i)
   note IH = Suc
   show ?case 
   proof (cases i)
     case (Suc ii)
     then show ?thesis
       using IH IH(2)[of ii] le_add_same_cancel2 order_trans by fastforce
   qed auto
 qed auto
 
 class trivial_conjugatable =
   conjugate +
   assumes conjugate_id [simp]: "conjugate x = x"
 
 class trivial_conjugatable_ordered_field = 
   conjugatable_ordered_field + trivial_conjugatable
 
 class trivial_conjugatable_linordered_field = 
   trivial_conjugatable_ordered_field + linordered_field
 begin
 subclass conjugatable_ring_1_abs_real_line
   by (standard) (auto simp add: semiring_normalization_rules)
 end
 
 instance rat :: trivial_conjugatable_linordered_field 
   by (standard, auto)
 
 instance real :: trivial_conjugatable_linordered_field 
   by (standard, auto)
 
 lemma scalar_prod_ge_0: "(x :: 'a :: linordered_idom vec) \<bullet> x \<ge> 0" 
   unfolding scalar_prod_def
   by (rule sum_nonneg, auto)
 
 lemma cscalar_prod_is_scalar_prod[simp]: "(x :: 'a :: trivial_conjugatable_ordered_field vec) \<bullet>c y = x \<bullet> y"
   unfolding conjugate_id
   by (rule arg_cong[of _ _ "scalar_prod x"], auto)
 
 
 lemma scalar_prod_Cauchy:
   fixes u v::"'a :: {trivial_conjugatable_linordered_field} Matrix.vec"
   assumes "u \<in> carrier_vec n" "v \<in> carrier_vec n"
   shows "(u \<bullet> v)\<^sup>2 \<le> \<parallel>u\<parallel>\<^sup>2 * \<parallel>v\<parallel>\<^sup>2 "
 proof -
   { assume v_0: "v \<noteq> 0\<^sub>v n"
     have "0 \<le> (u - r \<cdot>\<^sub>v v) \<bullet> (u - r \<cdot>\<^sub>v v)" for r
       by (simp add: scalar_prod_ge_0)
     also have "(u - r \<cdot>\<^sub>v v) \<bullet> (u - r \<cdot>\<^sub>v v) = u \<bullet> u - r * (u \<bullet> v) - r * (u \<bullet> v) + r * r * (v \<bullet> v)" for r::'a
     proof -
       have "(u - r \<cdot>\<^sub>v v) \<bullet> (u - r \<cdot>\<^sub>v v) = (u - r \<cdot>\<^sub>v v) \<bullet> u - (u - r \<cdot>\<^sub>v v) \<bullet> (r \<cdot>\<^sub>v v)"
         using assms by (subst scalar_prod_minus_distrib) auto
       also have "\<dots> = u \<bullet> u - (r \<cdot>\<^sub>v v) \<bullet> u - r * ((u - r \<cdot>\<^sub>v v) \<bullet> v)"
         using assms by (subst minus_scalar_prod_distrib) auto
       also have "\<dots> = u \<bullet> u - r * (v \<bullet> u) - r * (u \<bullet> v - r * (v \<bullet> v))"
         using assms by (subst minus_scalar_prod_distrib) auto
       also have "\<dots> = u \<bullet> u - r * (u \<bullet> v) - r * (u \<bullet> v) + r * r * (v \<bullet> v)"
         using assms comm_scalar_prod by (auto simp add: field_simps)
       finally show ?thesis
         by simp
     qed
     also have "u \<bullet> u - r * (u \<bullet> v) - r * (u \<bullet> v) + r * r * (v \<bullet> v) = sq_norm u - (u \<bullet> v)\<^sup>2 / sq_norm v"
       if "r = (u \<bullet> v) / (v \<bullet> v)" for r
       unfolding that by (auto simp add: sq_norm_vec_as_cscalar_prod power2_eq_square)
     finally have "0 \<le> \<parallel>u\<parallel>\<^sup>2 - (u \<bullet> v)\<^sup>2 / \<parallel>v\<parallel>\<^sup>2"
       by auto
     then have "(u \<bullet> v)\<^sup>2 / \<parallel>v\<parallel>\<^sup>2 \<le> \<parallel>u\<parallel>\<^sup>2"
       by auto
     then have "(u \<bullet> v)\<^sup>2 \<le> \<parallel>u\<parallel>\<^sup>2 * \<parallel>v\<parallel>\<^sup>2"
       using pos_divide_le_eq[of "\<parallel>v\<parallel>\<^sup>2"] v_0 assms by (auto)
   }
   then show ?thesis
     by (fastforce simp add: assms)
 qed
 
 end
diff --git a/thys/Prime_Distribution_Elementary/Partial_Zeta_Bounds.thy b/thys/Prime_Distribution_Elementary/Partial_Zeta_Bounds.thy
--- a/thys/Prime_Distribution_Elementary/Partial_Zeta_Bounds.thy
+++ b/thys/Prime_Distribution_Elementary/Partial_Zeta_Bounds.thy
@@ -1,446 +1,447 @@
 (*
   File:    Partial_Zeta_Bounds.thy
   Author:  Manuel Eberl, TU München
 
   Asymptotic bounds on sums over k^(-s) for k=1..n, for fixed s and variable n.
 *)
 section \<open>Bounds on partial sums of the $\zeta$ function\<close>
 theory Partial_Zeta_Bounds
 imports
   Euler_MacLaurin.Euler_MacLaurin_Landau
   Zeta_Function.Zeta_Function
   Prime_Number_Theorem.Prime_Number_Theorem_Library
   Prime_Distribution_Elementary_Library
 begin
 
 (* TODO: This does not necessarily require the full complex zeta function. *)
 
 text \<open>
   We employ Euler--MacLaurin's summation formula to obtain asymptotic estimates
   for the partial sums of the Riemann $\zeta(s)$ function for fixed real $a$, i.\,e.\ the function
   \[f(n) = \sum_{k=1}^n k^{-s}\ .\]
   We distinguish various cases. The case $s = 1$ is simply the Harmonic numbers and is
   treated apart from the others.
 \<close>
 lemma harm_asymp_equiv: "sum_upto (\<lambda>n. 1 / n) \<sim>[at_top] ln"
 proof -
   have "sum_upto (\<lambda>n. n powr -1) \<sim>[at_top] (\<lambda>x. ln (\<lfloor>x\<rfloor> + 1))"
   proof (rule asymp_equiv_sandwich)
     have "eventually (\<lambda>x. sum_upto (\<lambda>n. n powr -1) x \<in> {ln (\<lfloor>x\<rfloor> + 1)..ln \<lfloor>x\<rfloor> + 1}) at_top"
       using eventually_ge_at_top[of 1]
     proof eventually_elim
       case (elim x)
       have "sum_upto (\<lambda>n. real n powr -1) x = harm (nat \<lfloor>x\<rfloor>)"
         unfolding sum_upto_altdef harm_def by (intro sum.cong) (auto simp: field_simps powr_minus)
       also have "\<dots> \<in> {ln (\<lfloor>x\<rfloor> + 1)..ln \<lfloor>x\<rfloor> + 1}"
         using elim harm_le[of "nat \<lfloor>x\<rfloor>"] ln_le_harm[of "nat \<lfloor>x\<rfloor>"]
         by (auto simp: le_nat_iff le_floor_iff)
       finally show ?case by simp
     qed
     thus "eventually (\<lambda>x. sum_upto (\<lambda>n. n powr -1) x \<ge> ln (\<lfloor>x\<rfloor> + 1)) at_top"
          "eventually (\<lambda>x. sum_upto (\<lambda>n. n powr -1) x \<le> ln \<lfloor>x\<rfloor> + 1) at_top"
       by (eventually_elim; simp)+
   qed real_asymp+
   also have "\<dots> \<sim>[at_top] ln" by real_asymp
   finally show ?thesis by (simp add: powr_minus field_simps)
 qed
 
 lemma
   fixes s :: real
   assumes s: "s > 0" "s \<noteq> 1"
   shows   zeta_partial_sum_bigo_pos:
             "(\<lambda>n. (\<Sum>k=1..n. real k powr -s) - real n powr (1 - s) / (1 - s) - Re (zeta s))
                 \<in> O(\<lambda>x. real x powr -s)"
     and   zeta_partial_sum_bigo_pos':
             "(\<lambda>n. \<Sum>k=1..n. real k powr -s) =o
                (\<lambda>n. real n powr (1 - s) / (1 - s) + Re (zeta s)) +o O(\<lambda>x. real x powr -s)"
 proof -
   define F where "F = (\<lambda>x. x powr (1 - s) / (1 - s))"
   define f where "f = (\<lambda>x. x powr -s)"
   define f' where "f' = (\<lambda>x. -s * x powr (-s-1))"
   define z where "z = Re (zeta s)"
   
   interpret euler_maclaurin_nat' F f "(!) [f, f']" 1 0 z "{}"
   proof
     have "(\<lambda>b. (\<Sum>k=1..b. real k powr -s) - real b powr (1 - s) / (1 - s) - real b powr -s / 2)
              \<longlonglongrightarrow> Re (zeta s) - 0"
     proof (intro tendsto_diff)
       let ?g = "\<lambda>b. (\<Sum>i<b. complex_of_real (real i + 1) powr - complex_of_real s) -
                              of_nat b powr (1 - complex_of_real s) / (1 - complex_of_real s)"
       have "\<forall>\<^sub>F b in at_top. Re (?g b) = (\<Sum>k=1..b. real k powr -s) - real b powr (1 - s) / (1 - s)"
         using eventually_ge_at_top[of 1]
       proof eventually_elim
         case (elim b)
         have "(\<Sum>k=1..b. real k powr -s) = (\<Sum>k<b. real (Suc k) powr -s) "
           by (intro sum.reindex_bij_witness[of _ Suc "\<lambda>n. n - 1"]) auto
         also have "\<dots> - real b powr (1 - s) / (1 - s) = Re (?g b)"
           by (auto simp: powr_Reals_eq add_ac)
         finally show ?case ..
       qed
       moreover have "(\<lambda>b. Re (?g b)) \<longlonglongrightarrow> Re (zeta s)"
         using hurwitz_zeta_critical_strip[of "of_real s" 1] s
         by (intro tendsto_intros) (simp add: zeta_def)
       ultimately show "(\<lambda>b. (\<Sum>k=1..b. real k powr -s) - real b powr (1 - s) / (1 - s)) \<longlonglongrightarrow> Re (zeta s)" 
         by (blast intro: Lim_transform_eventually)
     qed (use s in real_asymp)
     thus "(\<lambda>b. (\<Sum>k = 1..b. f (real k)) - F (real b) -
               (\<Sum>i<2 * 0 + 1. (bernoulli' (Suc i) / fact (Suc i)) *\<^sub>R ([f, f'] ! i) (real b)))
             \<longlonglongrightarrow> z" by (simp add: f_def F_def z_def)
   qed (use \<open>s \<noteq> 1\<close> in
          \<open>auto intro!: derivative_eq_intros continuous_intros 
                simp flip: has_field_derivative_iff_has_vector_derivative
                simp: F_def f_def f'_def nth_Cons split: nat.splits\<close>)
 
   {
     fix n :: nat assume n: "n \<ge> 1"
     have "(\<Sum>k=1..n. real k powr -s) =
             n powr (1 - s) / (1 - s) + z + 1/2 * n powr -s -
             EM_remainder 1 f' (int n)"
       using euler_maclaurin_strong_nat'[of n] n by (simp add: F_def f_def)
   } note * = this
 
   have "(\<lambda>n. (\<Sum>k=1..n. real k powr -s) - n powr (1 - s) / (1 - s) - z) \<in>
           \<Theta>(\<lambda>n. 1/2 * n powr -s - EM_remainder 1 f' (int n))"
     using * by (intro bigthetaI_cong eventually_mono[OF eventually_ge_at_top[of 1]]) auto
   also have "(\<lambda>n. 1/2 * n powr -s - EM_remainder 1 f' (int n)) \<in> O(\<lambda>n. n powr -s)"
   proof (intro sum_in_bigo)
     have "(\<lambda>x. norm (EM_remainder 1 f' (int x))) \<in> O(\<lambda>x. real x powr - s)"
     proof (rule EM_remainder_strong_bigo_nat[where a = 1 and Y = "{}"])
       fix x :: real assume "x \<ge> 1"
       show "norm (f' x) \<le> s * x powr (-s-1)"
         using s by (simp add: f'_def)
     next
       from s show "((\<lambda>x. x powr -s) \<longlongrightarrow> 0) at_top" by real_asymp
     qed (auto simp: f'_def intro!: continuous_intros derivative_eq_intros)
     thus "(\<lambda>x. EM_remainder 1 f' (int x)) \<in> O(\<lambda>x. real x powr -s)"
       by simp
   qed real_asymp+
   finally show "(\<lambda>n. (\<Sum>k=1..n. real k powr -s) - real n powr (1 - s) / (1 - s) - z)
                   \<in> O(\<lambda>x. real x powr -s)" .
   thus"(\<lambda>n. \<Sum>k=1..n. real k powr -s) =o
            (\<lambda>n. real n powr (1 - s) / (1 - s) + z) +o O(\<lambda>x. real x powr -s)"
     by (subst set_minus_plus [symmetric]) (simp_all add: fun_diff_def algebra_simps)
 qed
 
 lemma zeta_tail_bigo:
   fixes s :: real
   assumes s: "s > 1"
   shows   "(\<lambda>n. Re (hurwitz_zeta (real n + 1) s)) \<in> O(\<lambda>x. real x powr (1 - s))"
 proof -
   have [simp]: "complex_of_real (Re (zeta s)) = zeta s"
     using zeta_real[of s] by (auto elim!: Reals_cases)
     
   from s have s': "s > 0" "s \<noteq> 1" by auto
   have "(\<lambda>n. -Re (hurwitz_zeta (real n + 1) s) - real n powr (1 - s) / (1 - s)
               + real n powr (1 - s) / (1 - s))
           \<in> O(\<lambda>x. real x powr (1 - s))"
   proof (rule sum_in_bigo)
     have "(\<lambda>n. -Re (hurwitz_zeta (real n + 1) s) - real n powr (1 - s) / (1 - s)) =
             (\<lambda>n. (\<Sum>k=1..n. real k powr -s) - real n powr (1 - s) / (1 - s) - Re (zeta s))"
       (is "?lhs = ?rhs")
     proof
       fix n :: nat
       have "hurwitz_zeta (1 + real n) s = zeta s - (\<Sum>k<n. real (Suc k) powr -s)"
         by (subst hurwitz_zeta_shift) (use assms in \<open>auto simp: zeta_def powr_Reals_eq\<close>)
       also have "(\<Sum>k<n. real (Suc k) powr -s) = (\<Sum>k=1..n. real k powr -s)"
         by (rule sum.reindex_bij_witness[of _ "\<lambda>k. k - 1" Suc]) auto
       finally show "?lhs n = ?rhs n" by (simp add: add_ac)
     qed
     also have "\<dots> \<in> O(\<lambda>x. real x powr (-s))"
       by (rule zeta_partial_sum_bigo_pos) (use s in auto)
     also have "(\<lambda>x. real x powr (-s)) \<in> O(\<lambda>x. real x powr (1-s))"
       by real_asymp
     finally show "(\<lambda>n. -Re (hurwitz_zeta (real n + 1) s) - real n powr (1 - s) / (1 - s)) \<in> \<dots>" .
   qed (use s in real_asymp)
   thus ?thesis by simp
 qed
 
 lemma zeta_tail_bigo':
   fixes s :: real
   assumes s: "s > 1"
   shows   "(\<lambda>n. Re (hurwitz_zeta (real n) s)) \<in> O(\<lambda>x. real x powr (1 - s))"
 proof -
   have "(\<lambda>n. Re (hurwitz_zeta (real n) s)) \<in> \<Theta>(\<lambda>n. Re (hurwitz_zeta (real (n - 1) + 1) s))"
     by (intro bigthetaI_cong eventually_mono[OF eventually_ge_at_top[of 1]])
        (auto simp: of_nat_diff)
   also have "(\<lambda>n. Re (hurwitz_zeta (real (n - 1) + 1) s)) \<in> O(\<lambda>x. real (x - 1) powr (1 - s))"
     by (rule landau_o.big.compose[OF zeta_tail_bigo[OF assms]]) real_asymp
   also have "(\<lambda>x. real (x - 1) powr (1 - s)) \<in> O(\<lambda>x. real x powr (1 - s))"
     by real_asymp
   finally show ?thesis .
 qed
 
 lemma
   fixes s :: real
   assumes s: "s > 0"
   shows   zeta_partial_sum_bigo_neg:
             "(\<lambda>n. (\<Sum>i=1..n. real i powr s) - n powr (1 + s) / (1 + s)) \<in> O(\<lambda>n. n powr s)"
     and   zeta_partial_sum_bigo_neg':
             "(\<lambda>n. (\<Sum>i=1..n. real i powr s)) =o (\<lambda>n. n powr (1 + s) / (1 + s)) +o O(\<lambda>n. n powr s)"
 proof -
   define F where "F = (\<lambda>x. x powr (1 + s) / (1 + s))"
   define f where "f = (\<lambda>x. x powr s)"
   define f' where "f' = (\<lambda>x. s * x powr (s - 1))"
 
   have "(\<Sum>i=1..n. f (real i)) - F n =
           1 / 2 - F 1 + f n / 2 + EM_remainder' 1 f' 1 (real n)" if n: "n \<ge> 1" for n
   proof -
     have "(\<Sum>i\<in>{1<..n}. f (real i)) - integral {real 1..real n} f =
             (\<Sum>k<1. (bernoulli' (Suc k) / fact (Suc k)) *\<^sub>R (([f, f'] ! k) (real n) -
                 ([f, f'] ! k) (real 1))) + EM_remainder' 1 ([f, f'] ! 1) (real 1) (real n)"
       by (rule euler_maclaurin_strong_raw_nat[where Y = "{}"])
          (use \<open>s > 0\<close> \<open>n \<ge> 1\<close> in
            \<open>auto intro!: derivative_eq_intros continuous_intros 
                  simp flip: has_field_derivative_iff_has_vector_derivative
                  simp: F_def f_def f'_def nth_Cons split: nat.splits\<close>)
     also have "(\<Sum>i\<in>{1<..n}. f (real i)) = (\<Sum>i\<in>insert 1 {1<..n}. f (real i)) - f 1"
       using n by (subst sum.insert) auto
     also from n have "insert 1 {1<..n} = {1..n}" by auto
     finally have "(\<Sum>i=1..n. f (real i)) - F n = f 1 + (integral {1..real n} f - F n) +
                     (f (real n) - f 1) / 2 + EM_remainder' 1 f' 1 (real n)" by simp
     hence "(\<Sum>i=1..n. f (real i)) - F n = 1 / 2 + (integral {1..real n} f - F n) +
               f (real n) / 2 + EM_remainder' 1 f' 1 (real n)"
       using s by (simp add: f_def diff_divide_distrib)
     also have "(f has_integral (F (real n) - F 1)) {1..real n}" using assms n
       by (intro fundamental_theorem_of_calculus)
          (auto simp flip: has_field_derivative_iff_has_vector_derivative simp: F_def f_def
                intro!: derivative_eq_intros continuous_intros)
     hence "integral {1..real n} f - F n = - F 1"
       by (simp add: has_integral_iff)
     also have "1 / 2 + (-F 1) + f (real n) / 2 = 1 / 2 - F 1 + f n / 2"
       by simp
     finally show ?thesis .
   qed
 
   hence "(\<lambda>n. (\<Sum>i=1..n. f (real i)) - F n) \<in>
            \<Theta>(\<lambda>n. 1 / 2 - F 1 + f n / 2 + EM_remainder' 1 f' 1 (real n))"
     by (intro bigthetaI_cong eventually_mono[OF eventually_ge_at_top[of 1]])
   also have "(\<lambda>n. 1 / 2 - F 1 + f n / 2 + EM_remainder' 1 f' 1 (real n))
                \<in> O(\<lambda>n. real n powr s)"
     unfolding F_def f_def
   proof (intro sum_in_bigo)
     have "(\<lambda>x. integral {1..real x} (\<lambda>t. pbernpoly 1 t *\<^sub>R f' t)) \<in> O(\<lambda>n. 1 / s * real n powr s)"
     proof (intro landau_o.big.compose[OF integral_bigo])
       have "(\<lambda>x. pbernpoly 1 x * f' x) \<in> O(\<lambda>x. 1 * x powr (s - 1))"
         by (intro landau_o.big.mult pbernpoly_bigo) (auto simp: f'_def)
       thus "(\<lambda>x. pbernpoly 1 x *\<^sub>R f' x) \<in> O(\<lambda>x. x powr (s - 1))"
         by simp
       from s show "filterlim (\<lambda>a. 1 / s * a powr s) at_top at_top" by real_asymp
     next
       fix a' x :: real assume "a' \<ge> 1" "a' \<le> x"
       thus "(\<lambda>a. pbernpoly 1 a *\<^sub>R f' a) integrable_on {a'..x}"
         by (intro integrable_EM_remainder') (auto intro!: continuous_intros simp: f'_def)
     qed (use s in \<open>auto intro!: filterlim_real_sequentially continuous_intros derivative_eq_intros\<close>)
     thus "(\<lambda>x. EM_remainder' 1 f' 1 (real x)) \<in> O(\<lambda>n. real n powr s)"
       using \<open>s > 0\<close> by (simp add: EM_remainder'_def)
   qed (use \<open>s > 0\<close> in real_asymp)+
   finally show "(\<lambda>n. (\<Sum>i=1..n. real i powr s) - n powr (1 + s) / (1 + s)) \<in> O(\<lambda>n. n powr s)"
     by (simp add: f_def F_def)
   thus "(\<lambda>n. (\<Sum>i=1..n. real i powr s)) =o (\<lambda>n. n powr (1 + s) / (1 + s)) +o O(\<lambda>n. n powr s)"
     by (subst set_minus_plus [symmetric]) (simp_all add: fun_diff_def algebra_simps)
 qed
 
 lemma zeta_partial_sum_le_pos:
   assumes "s > 0" "s \<noteq> 1"
   defines "z \<equiv> Re (zeta (complex_of_real s))"
   shows   "\<exists>c>0. \<forall>x\<ge>1. \<bar>sum_upto (\<lambda>n. n powr -s) x - (x powr (1-s) / (1-s) + z)\<bar> \<le> c * x powr -s"
 proof (rule sum_upto_asymptotics_lift_nat_real)
   show "(\<lambda>n. (\<Sum>k = 1..n. real k powr - s) - (real n powr (1 - s) / (1 - s) + z))
           \<in> O(\<lambda>n. real n powr - s)"
     using zeta_partial_sum_bigo_pos[OF assms(1,2)] unfolding z_def
     by (simp add: algebra_simps)
 
   from assms have "s < 1 \<or> s > 1" by linarith
   thus "(\<lambda>n. real n powr (1 - s) / (1 - s) + z - (real (Suc n) powr (1 - s) / (1 - s) + z))
           \<in> O(\<lambda>n. real n powr - s)"
     by standard (use \<open>s > 0\<close> in \<open>real_asymp+\<close>)
   show "(\<lambda>n. real n powr - s) \<in> O(\<lambda>n. real (Suc n) powr - s)"
     by real_asymp
   show "mono_on (\<lambda>a. a powr - s) {1..} \<or> mono_on (\<lambda>x. - (x powr - s)) {1..}"
     using assms by (intro disjI2) (auto intro!: mono_onI powr_mono2')
 
   from assms have "s < 1 \<or> s > 1" by linarith
   hence "mono_on (\<lambda>a. a powr (1 - s) / (1 - s) + z) {1..}"
   proof
     assume "s < 1"
     thus ?thesis using \<open>s > 0\<close>
       by (intro mono_onI powr_mono2 divide_right_mono add_right_mono) auto
   next
     assume "s > 1"
     thus ?thesis
       by (intro mono_onI le_imp_neg_le add_right_mono divide_right_mono_neg powr_mono2') auto
   qed
   thus "mono_on (\<lambda>a. a powr (1 - s) / (1 - s) + z) {1..} \<or>
         mono_on (\<lambda>x. - (x powr (1 - s) / (1 - s) + z)) {1..}" by blast
 qed auto
 
 lemma zeta_partial_sum_le_pos':
   assumes "s > 0" "s \<noteq> 1"
   defines "z \<equiv> Re (zeta (complex_of_real s))"
   shows   "\<exists>c>0. \<forall>x\<ge>1. \<bar>sum_upto (\<lambda>n. n powr -s) x - x powr (1-s) / (1-s)\<bar> \<le> c"
 proof -
   have "\<exists>c>0. \<forall>x\<ge>1. \<bar>sum_upto (\<lambda>n. n powr -s) x - x powr (1-s) / (1-s)\<bar> \<le> c * 1"
   proof (rule sum_upto_asymptotics_lift_nat_real)
     have "(\<lambda>n. (\<Sum>k = 1..n. real k powr - s) - (real n powr (1 - s) / (1 - s) + z))
             \<in> O(\<lambda>n. real n powr - s)"
       using zeta_partial_sum_bigo_pos[OF assms(1,2)] unfolding z_def
       by (simp add: algebra_simps)
     also have "(\<lambda>n. real n powr -s) \<in> O(\<lambda>n. 1)"
       using assms by real_asymp
     finally have "(\<lambda>n. (\<Sum>k = 1..n. real k powr - s) - real n powr (1 - s) / (1 - s) - z)
                      \<in> O(\<lambda>n. 1)" by (simp add: algebra_simps)
     hence "(\<lambda>n. (\<Sum>k = 1..n. real k powr - s) - real n powr (1 - s) / (1 - s) - z + z) \<in> O(\<lambda>n. 1)"
       by (rule sum_in_bigo) auto
     thus "(\<lambda>n. (\<Sum>k = 1..n. real k powr - s) - (real n powr (1 - s) / (1 - s))) \<in> O(\<lambda>n. 1)"
       by simp
   
     from assms have "s < 1 \<or> s > 1" by linarith
     thus "(\<lambda>n. real n powr (1 - s) / (1 - s) - (real (Suc n) powr (1 - s) / (1 - s))) \<in> O(\<lambda>n. 1)"
       by standard (use \<open>s > 0\<close> in \<open>real_asymp+\<close>)
     show "mono_on (\<lambda>a. 1) {1..} \<or> mono_on (\<lambda>x::real. -1 :: real) {1..}"
       using assms by (intro disjI2) (auto intro!: mono_onI powr_mono2')
   
     from assms have "s < 1 \<or> s > 1" by linarith
     hence "mono_on (\<lambda>a. a powr (1 - s) / (1 - s)) {1..}"
     proof
       assume "s < 1"
       thus ?thesis using \<open>s > 0\<close>
         by (intro mono_onI powr_mono2 divide_right_mono add_right_mono) auto
     next
       assume "s > 1"
       thus ?thesis
         by (intro mono_onI le_imp_neg_le add_right_mono divide_right_mono_neg powr_mono2') auto
     qed
     thus "mono_on (\<lambda>a. a powr (1 - s) / (1 - s)) {1..} \<or>
           mono_on (\<lambda>x. - (x powr (1 - s) / (1 - s))) {1..}" by blast
   qed auto
   thus ?thesis by simp
 qed
 
 lemma zeta_partial_sum_le_pos'':
   assumes "s > 0" "s \<noteq> 1"
   shows   "\<exists>c>0. \<forall>x\<ge>1. \<bar>sum_upto (\<lambda>n. n powr -s) x\<bar> \<le> c * x powr max 0 (1 - s)"
 proof -
   from zeta_partial_sum_le_pos'[OF assms] obtain c where
     c: "c > 0" "\<And>x. x \<ge> 1 \<Longrightarrow> \<bar>sum_upto (\<lambda>x. real x powr - s) x - x powr (1 - s) / (1 - s)\<bar> \<le> c"
     by auto
 
   {
     fix x :: real assume x: "x \<ge> 1"
     have "\<bar>sum_upto (\<lambda>x. real x powr - s) x\<bar> \<le> \<bar>x powr (1 - s) / (1 - s)\<bar> + c"
       using c(1) c(2)[OF x] x by linarith
     also have "\<bar>x powr (1 - s) / (1 - s)\<bar> = x powr (1 - s) / \<bar>1 - s\<bar>"
       using assms by simp
     also have "\<dots> \<le> x powr max 0 (1 - s) / \<bar>1 - s\<bar>"
       using x by (intro divide_right_mono powr_mono) auto
     also have "c = c * x powr 0" using x by simp
     also have "c * x powr 0 \<le> c * x powr max 0 (1 - s)"
       using c(1) x by (intro mult_left_mono powr_mono) auto
     also have "x powr max 0 (1 - s) / \<bar>1 - s\<bar> + c * x powr max 0 (1 - s) =
                  (1 / \<bar>1 - s\<bar> + c) * x powr max 0 (1 - s)"
       by (simp add: algebra_simps)
     finally have "\<bar>sum_upto (\<lambda>x. real x powr - s) x\<bar> \<le> (1 / \<bar>1 - s\<bar> + c) * x powr max 0 (1 - s)"
       by simp
   }
   moreover have "(1 / \<bar>1 - s\<bar> + c) > 0"
     using c assms by (intro add_pos_pos divide_pos_pos) auto
   ultimately show ?thesis by blast
 qed
 
 lemma zeta_partial_sum_le_pos_bigo:
   assumes "s > 0" "s \<noteq> 1"
   shows   "(\<lambda>x. sum_upto (\<lambda>n. n powr -s) x) \<in> O(\<lambda>x. x powr max 0 (1 - s))"
 proof -
   from zeta_partial_sum_le_pos''[OF assms] obtain c
     where "\<forall>x\<ge>1. \<bar>sum_upto (\<lambda>n. n powr -s) x\<bar> \<le> c * x powr max 0 (1 - s)" by auto
   thus ?thesis
     by (intro bigoI[of _ c] eventually_mono[OF eventually_ge_at_top[of 1]]) auto
 qed
     
 lemma zeta_partial_sum_01_asymp_equiv:
   assumes "s \<in> {0<..<1}"
   shows "sum_upto (\<lambda>n. n powr -s) \<sim>[at_top] (\<lambda>x. x powr (1 - s) / (1 - s))"
 proof -
   from zeta_partial_sum_le_pos'[of s] assms obtain c where
     c: "c > 0" "\<forall>x\<ge>1. \<bar>sum_upto (\<lambda>x. real x powr -s) x - x powr (1 - s) / (1 - s)\<bar> \<le> c" by auto
   hence "(\<lambda>x. sum_upto (\<lambda>x. real x powr -s) x - x powr (1 - s) / (1 - s)) \<in> O(\<lambda>_. 1)"
     by (intro bigoI[of _ c] eventually_mono[OF eventually_ge_at_top[of 1]]) auto
   also have "(\<lambda>_. 1) \<in> o(\<lambda>x. x powr (1 - s) / (1 - s))"
     using assms by real_asymp
   finally show ?thesis
     by (rule smallo_imp_asymp_equiv)
 qed
 
 lemma zeta_partial_sum_gt_1_asymp_equiv:
+  fixes s :: real
   assumes "s > 1"
   defines "\<zeta> \<equiv> Re (zeta s)"
   shows "sum_upto (\<lambda>n. n powr -s) \<sim>[at_top] (\<lambda>x. \<zeta>)"
 proof -
   have [simp]: "\<zeta> \<noteq> 0"
     using assms zeta_Re_gt_1_nonzero[of s] zeta_real[of s] by (auto elim!: Reals_cases)
   from zeta_partial_sum_le_pos[of s] assms obtain c where
     c: "c > 0" "\<forall>x\<ge>1. \<bar>sum_upto (\<lambda>x. real x powr -s) x - (x powr (1 - s) / (1 - s) + \<zeta>)\<bar> \<le>
                         c * x powr -s" by (auto simp: \<zeta>_def)
   hence "(\<lambda>x. sum_upto (\<lambda>x. real x powr -s) x - \<zeta> - x powr (1 - s) / (1 - s)) \<in> O(\<lambda>x. x powr -s)"
     by (intro bigoI[of _ c] eventually_mono[OF eventually_ge_at_top[of 1]]) auto
   also have "(\<lambda>x. x powr -s) \<in> o(\<lambda>_. 1)"
     using \<open>s > 1\<close> by real_asymp
   finally have "(\<lambda>x. sum_upto (\<lambda>x. real x powr -s) x - \<zeta> - x powr (1 - s) / (1 - s) +
              x powr (1 - s) / (1 - s)) \<in> o(\<lambda>_. 1)"
     by (rule sum_in_smallo) (use \<open>s > 1\<close> in real_asymp)
   thus ?thesis by (simp add: smallo_imp_asymp_equiv)
 qed
 
 lemma zeta_partial_sum_pos_bigtheta:
   assumes "s > 0" "s \<noteq> 1"
   shows   "sum_upto (\<lambda>n. n powr -s) \<in> \<Theta>(\<lambda>x. x powr max 0 (1 - s))"
 proof (cases "s > 1")
   case False
   thus ?thesis
     using asymp_equiv_imp_bigtheta[OF zeta_partial_sum_01_asymp_equiv[of s]] assms
     by (simp add: max_def)
 next
   case True
   have [simp]: "Re (zeta s) \<noteq> 0"
     using True zeta_Re_gt_1_nonzero[of s] zeta_real[of s] by (auto elim!: Reals_cases)
   show ?thesis
     using True asymp_equiv_imp_bigtheta[OF zeta_partial_sum_gt_1_asymp_equiv[of s]]
     by (simp add: max_def)
 qed
 
 lemma zeta_partial_sum_le_neg:
   assumes "s > 0"
   shows   "\<exists>c>0. \<forall>x\<ge>1. \<bar>sum_upto (\<lambda>n. n powr s) x - x powr (1 + s) / (1 + s)\<bar> \<le> c * x powr s"
 proof (rule sum_upto_asymptotics_lift_nat_real)
   show "(\<lambda>n. (\<Sum>k = 1..n. real k powr s) - (real n powr (1 + s) / (1 + s)))
           \<in> O(\<lambda>n. real n powr s)"
     using zeta_partial_sum_bigo_neg[OF assms(1)] by (simp add: algebra_simps)
 
   show "(\<lambda>n. real n powr (1 + s) / (1 + s) - (real (Suc n) powr (1 + s) / (1 + s)))
           \<in> O(\<lambda>n. real n powr s)"
     using assms by real_asymp
   show "(\<lambda>n. real n powr s) \<in> O(\<lambda>n. real (Suc n) powr s)"
     by real_asymp
   show "mono_on (\<lambda>a. a powr s) {1..} \<or> mono_on (\<lambda>x. - (x powr s)) {1..}"
     using assms by (intro disjI1) (auto intro!: mono_onI powr_mono2)
   show "mono_on (\<lambda>a. a powr (1 + s) / (1 + s)) {1..} \<or>
         mono_on (\<lambda>x. - (x powr (1 + s) / (1 + s))) {1..}"
     using assms by (intro disjI1 divide_right_mono powr_mono2 mono_onI) auto
 qed auto
 
 lemma zeta_partial_sum_neg_asymp_equiv:
   assumes "s > 0"
   shows "sum_upto (\<lambda>n. n powr s) \<sim>[at_top] (\<lambda>x. x powr (1 + s) / (1 + s))"
 proof -
   from zeta_partial_sum_le_neg[of s] assms obtain c where
     c: "c > 0" "\<forall>x\<ge>1. \<bar>sum_upto (\<lambda>x. real x powr s) x - x powr (1 + s) / (1 + s)\<bar> \<le> c * x powr s"
     by auto
   hence "(\<lambda>x. sum_upto (\<lambda>x. real x powr s) x - x powr (1 + s) / (1 + s)) \<in> O(\<lambda>x. x powr s)"
     by (intro bigoI[of _ c] eventually_mono[OF eventually_ge_at_top[of 1]]) auto
   also have "(\<lambda>x. x powr s) \<in> o(\<lambda>x. x powr (1 + s) / (1 + s))"
     using assms by real_asymp
   finally show ?thesis
     by (rule smallo_imp_asymp_equiv)
 qed
 
 end
\ No newline at end of file
diff --git a/thys/Projective_Measurements/Linear_Algebra_Complements.thy b/thys/Projective_Measurements/Linear_Algebra_Complements.thy
--- a/thys/Projective_Measurements/Linear_Algebra_Complements.thy
+++ b/thys/Projective_Measurements/Linear_Algebra_Complements.thy
@@ -1,2269 +1,2269 @@
 (*
 Author: 
   Mnacho Echenim, Université Grenoble Alpes
 *)
 
 theory Linear_Algebra_Complements imports 
   "Isabelle_Marries_Dirac.Tensor" 
   "Isabelle_Marries_Dirac.More_Tensor"
   "QHLProver.Gates" 
   "HOL-Types_To_Sets.Group_On_With" 
   "HOL-Probability.Probability" 
 
 
 begin
 hide_const(open) S
 section \<open>Preliminaries\<close>
 
 
 subsection \<open>Misc\<close>
 
 lemma mult_real_cpx:
   fixes a::complex
   fixes b::complex
   assumes "a\<in> Reals"
   shows "a* (Re b) = Re (a * b)" using assms
   by (metis Reals_cases complex.exhaust complex.sel(1) complex_of_real_mult_Complex of_real_mult)
 
 lemma fct_bound:
   fixes f::"complex\<Rightarrow> real"
   assumes "f(-1) + f 1 = 1"
 and "0 \<le> f 1"
 and "0 \<le> f (-1)"
 shows "-1 \<le> f 1  - f(-1) \<and> f 1  - f(-1) \<le> 1"
 proof
   have "f 1  - f(-1) = 1 - f(-1) - f(-1)"  using assms by simp
   also have "...\<ge> -1" using assms by simp
   finally show "-1 \<le> f 1  - f(-1)" .
 next
   have "f(-1) - f 1  = 1 - f 1  - f 1 " using assms by simp
   also have "... \<ge> -1" using assms by simp
   finally have "-1 \<le> f(-1) - f 1" .
   thus "f 1 - f (-1) \<le> 1" by simp
 qed
 
 lemma fct_bound':
   fixes f::"complex\<Rightarrow> real"
   assumes "f(-1) + f 1 = 1"
 and "0 \<le> f 1"
 and "0 \<le> f (-1)"
 shows "\<bar>f 1  - f(-1)\<bar> \<le> 1" using assms fct_bound by auto
 
 lemma pos_sum_1_le:
   assumes "finite I"
 and "\<forall> i \<in> I. (0::real) \<le> f i"
 and "(\<Sum>i\<in> I. f i) = 1"
 and "j\<in> I"
 shows "f j \<le> 1"
 proof (rule ccontr)
   assume "\<not> f j \<le> 1"
   hence "1 < f j" by simp
   hence "1 < (\<Sum>i\<in> I. f i)" using assms by (metis \<open>\<not> f j \<le> 1\<close> sum_nonneg_leq_bound) 
   thus False using assms by simp
 qed
 
 lemma last_subset:
   assumes "A \<subseteq> {a,b}"
   and "a\<noteq> b"
 and "A \<noteq> {a, b}"
 and "A\<noteq> {}"
 and "A \<noteq> {a}"
 shows "A = {b}" using assms by blast
 
 lemma disjoint_Un:
   assumes "disjoint_family_on A (insert x F)"
   and "x\<notin> F"
 shows "(A x) \<inter> (\<Union> a\<in> F. A a) = {}" 
 proof -
   have "(A x) \<inter> (\<Union> a\<in> F. A a) = (\<Union>i\<in>F. (A x) \<inter> A i)" using Int_UN_distrib by simp
   also have "... = (\<Union>i\<in>F. {})" using assms disjoint_family_onD by fastforce
   also have "... = {}" using SUP_bot_conv(2) by simp
   finally show ?thesis .
 qed
 
 lemma sum_but_one:
   assumes "\<forall>j < (n::nat). j \<noteq>i \<longrightarrow> f j = (0::'a::ring)"
   and "i < n"
   shows "(\<Sum> j \<in> {0 ..< n}. f j * g j) = f i * g i"
 proof -
   have "sum (\<lambda>x. f x * g x) (({0 ..< n} - {i}) \<union> {i}) = sum (\<lambda>x. f x * g x) ({0 ..< n} - {i}) + 
     sum (\<lambda>x. f x * g x) {i}" by (rule sum.union_disjoint, auto)
   also have "... = sum (\<lambda>x. f x * g x) {i}" using assms by auto
   also have "... = f i * g i" by simp
   finally have "sum (\<lambda>x. f x * g x) (({0 ..< n} - {i}) \<union> {i}) = f i * g i" .
   moreover have "{0 ..< n} = ({0 ..< n} - {i}) \<union> {i}" using assms by auto
   ultimately show ?thesis by simp
 qed
 
 lemma sum_2_elems:
   assumes "I = {a,b}"
     and "a\<noteq> b"
   shows "(\<Sum>a\<in>I. f a) = f a + f b" 
 proof -
   have "(\<Sum>a\<in>I. f a) = (\<Sum>a\<in>(insert a {b}). f a)" using assms by simp
   also have "... = f a + (\<Sum>a\<in>{b}. f a)" 
   proof (rule sum.insert)
     show "finite {b}" by simp
     show "a\<notin> {b}" using assms by simp
   qed
   also have "... = f a + f b" by simp
   finally show ?thesis .
 qed
 
 lemma sum_4_elems:
   shows "(\<Sum>i<(4::nat). f i) = f 0 + f 1 + f 2 + f 3" 
 proof -
   have "(\<Sum>i<(4::nat). f i) = (\<Sum>i<(3::nat). f i)  + f 3"
     by (metis Suc_numeral semiring_norm(2) semiring_norm(8) sum.lessThan_Suc)
   moreover have "(\<Sum>i<(3::nat). f i) = (\<Sum>i<(2::nat). f i) + f 2"
     by (metis Suc_1 add_2_eq_Suc' nat_1_add_1 numeral_code(3) numerals(1) 
         one_plus_numeral_commute sum.lessThan_Suc)
   moreover have "(\<Sum>i<(2::nat). f i) = (\<Sum>i<(1::nat). f i) + f 1"
     by (metis Suc_1 sum.lessThan_Suc)
   ultimately show ?thesis by simp
 qed
 
 lemma disj_family_sum:
   shows "finite I \<Longrightarrow> disjoint_family_on A I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> finite (A i))  \<Longrightarrow> 
   (\<Sum> i \<in> (\<Union>n \<in> I. A n). f i) = (\<Sum> n\<in> I. (\<Sum> i \<in> A n. f i))" 
 proof (induct rule:finite_induct)
   case empty
   then show ?case by simp
 next
   case (insert x F)
   hence "disjoint_family_on A F"
     by (meson disjoint_family_on_mono subset_insertI) 
   have "(\<Union>n \<in> (insert x F). A n) = A x \<union> (\<Union>n \<in> F. A n)" using insert by simp
   hence "(\<Sum> i \<in> (\<Union>n \<in> (insert x F). A n). f i) = (\<Sum> i \<in> (A x \<union> (\<Union>n \<in> F. A n)). f i)" by simp
   also have "... = (\<Sum> i \<in>  A x. f i) + (\<Sum> i \<in> (\<Union>n \<in> F. A n). f i)" 
     by (rule sum.union_disjoint, (simp add: insert disjoint_Un)+)
   also have "... = (\<Sum> i \<in>  A x. f i) + (\<Sum>n\<in>F. sum f (A n))" using  \<open>disjoint_family_on A F\<close> 
     by (simp add: insert)
   also have "... = (\<Sum>n\<in>(insert x F). sum f (A n))" using insert by simp
   finally show ?case .
 qed
 
 lemma integrable_real_mult_right:
   fixes c::real
   assumes "integrable M f"
   shows "integrable M (\<lambda>w. c * f w)" 
 proof (cases "c = 0")
   case True
   thus ?thesis by simp
 next
   case False
   thus ?thesis using integrable_mult_right[of c] assms by simp
 qed
 
 
 subsection \<open>Unifying notions between Isabelle Marries Dirac and QHLProver\<close>
 
 lemma mult_conj_cmod_square:
   fixes z::complex
   shows "z * conjugate z = (cmod z)\<^sup>2"
 proof -
   have "z * conjugate z = (Re z)\<^sup>2 + (Im z)\<^sup>2" using  complex_mult_cnj by auto
   also have "... = (cmod z)\<^sup>2" unfolding cmod_def by simp
   finally show ?thesis .
 qed
 
 lemma vec_norm_sq_cpx_vec_length_sq:
   shows "(vec_norm v)\<^sup>2 = (cpx_vec_length v)\<^sup>2"
 proof -
   have "(vec_norm v)\<^sup>2 = inner_prod v v" unfolding vec_norm_def using power2_csqrt by blast
   also have "... = (\<Sum>i<dim_vec v. (cmod (Matrix.vec_index v i))\<^sup>2)" unfolding Matrix.scalar_prod_def
   proof -
     have "\<And>i. i < dim_vec v \<Longrightarrow> Matrix.vec_index v  i * conjugate (Matrix.vec_index v i) = 
       (cmod (Matrix.vec_index v i))\<^sup>2" using mult_conj_cmod_square by simp
     thus "(\<Sum>i = 0..<dim_vec (conjugate v). Matrix.vec_index v i * 
       Matrix.vec_index (conjugate v) i) =  (\<Sum>i<dim_vec v. (cmod (Matrix.vec_index v i))\<^sup>2)" 
       by (simp add: lessThan_atLeast0)
   qed
   finally show "(vec_norm v)\<^sup>2 = (cpx_vec_length v)\<^sup>2" unfolding cpx_vec_length_def
     by (simp add: sum_nonneg)
 qed
 
 lemma vec_norm_eq_cpx_vec_length:
   shows "vec_norm v = cpx_vec_length v" using vec_norm_sq_cpx_vec_length_sq
 by (metis cpx_vec_length_inner_prod inner_prod_csqrt power2_csqrt vec_norm_def) 
 
 lemma cpx_vec_length_square:
   shows "\<parallel>v\<parallel>\<^sup>2 = (\<Sum>i = 0..<dim_vec v. (cmod (Matrix.vec_index v i))\<^sup>2)" unfolding cpx_vec_length_def
   by (simp add: lessThan_atLeast0 sum_nonneg)
 
 lemma state_qbit_norm_sq:
   assumes "v\<in> state_qbit n"
   shows "(cpx_vec_length v)\<^sup>2 = 1"
 proof -
   have "cpx_vec_length v = 1" using assms unfolding state_qbit_def by simp
   thus ?thesis by simp
 qed
 
 lemma dagger_adjoint:
 shows "dagger M = Complex_Matrix.adjoint M" unfolding dagger_def Complex_Matrix.adjoint_def
   by (simp add: cong_mat)
 
 
 subsection \<open>Types to sets lemmata transfers\<close>
 
 context ab_group_add_on_with begin
 
 context includes lifting_syntax assumes ltd: "\<exists>(Rep::'s \<Rightarrow> 'a) (Abs::'a \<Rightarrow> 's). 
   type_definition Rep Abs S" begin
 interpretation local_typedef_ab_group_add_on_with pls z mns um S "TYPE('s)" by unfold_locales fact
 
 lemmas lt_sum_union_disjoint = sum.union_disjoint
   [var_simplified explicit_ab_group_add,
     unoverload_type 'c,
     OF type.comm_monoid_add_axioms,
     untransferred]
 
 lemmas lt_disj_family_sum = disj_family_sum
   [var_simplified explicit_ab_group_add,
     unoverload_type 'd,
 OF type.comm_monoid_add_axioms,
     untransferred]
 
 lemmas lt_sum_reindex_cong = sum.reindex_cong
   [var_simplified explicit_ab_group_add,
     unoverload_type 'd,
 OF type.comm_monoid_add_axioms,
     untransferred]
 end
 
 lemmas sum_with_union_disjoint =
   lt_sum_union_disjoint
     [cancel_type_definition,
     OF carrier_ne,
     simplified pred_fun_def, simplified]
 
 lemmas disj_family_sum_with =
   lt_disj_family_sum
     [cancel_type_definition,
     OF carrier_ne,
     simplified pred_fun_def, simplified]
 
 lemmas sum_with_reindex_cong = 
   lt_sum_reindex_cong
     [cancel_type_definition,
     OF carrier_ne,
     simplified pred_fun_def, simplified]
 
 end
 
 lemma (in comm_monoid_add_on_with) sum_with_cong':
   shows "finite I \<Longrightarrow> (\<And>i. i\<in> I \<Longrightarrow> A i = B i) \<Longrightarrow> (\<And>i. i\<in> I \<Longrightarrow> A i \<in> S) \<Longrightarrow> 
     (\<And>i. i\<in> I \<Longrightarrow> B i \<in> S) \<Longrightarrow> sum_with pls z A I = sum_with pls z B I"
 proof (induct rule: finite_induct)
   case empty
   then show ?case by simp
 next
   case (insert x F)
   have "sum_with pls z A (insert x F) = pls (A x) (sum_with pls z A F)" using insert 
       sum_with_insert[of A] by (simp add:  image_subset_iff) 
   also have "... = pls (B x)  (sum_with pls z B F)" using insert by simp
   also have "... = sum_with pls z B (insert x F)" using insert sum_with_insert[of B]
     by (simp add:  image_subset_iff) 
   finally show ?case .
 qed
 
 
 section \<open>Linear algebra complements\<close>
 
 subsection \<open>Additional properties of matrices\<close>
 
 lemma smult_one:
   shows "(1::'a::monoid_mult) \<cdot>\<^sub>m A = A" by (simp add:eq_matI)
 
 lemma times_diag_index:
   fixes A::"'a::comm_ring Matrix.mat"
   assumes "A \<in> carrier_mat n n"
 and "B\<in> carrier_mat n n"
 and "diagonal_mat B"
 and "j < n"
 and "i < n"
 shows "Matrix.vec_index (Matrix.row (A*B) j) i = diag_mat B ! i *A $$ (j, i)"
 proof -
   have "Matrix.vec_index (Matrix.row (A*B) j) i = (A*B) $$ (j,i)" 
     using Matrix.row_def[of "A*B" ] assms by simp
   also have "... = Matrix.scalar_prod (Matrix.row A j) (Matrix.col B i)" using assms 
       times_mat_def[of A] by simp
   also have "... = Matrix.scalar_prod (Matrix.col B i) (Matrix.row A j)" 
     using comm_scalar_prod[of "Matrix.row A j" n] assms by auto
   also have "... = (Matrix.vec_index (Matrix.col B i) i) * (Matrix.vec_index  (Matrix.row A j) i)" 
     unfolding Matrix.scalar_prod_def 
   proof (rule sum_but_one)
     show "i < dim_vec (Matrix.row A j)" using assms by simp
     show "\<forall>ia<dim_vec (Matrix.row A j). ia \<noteq> i \<longrightarrow> Matrix.vec_index (Matrix.col B i) ia = 0" using assms
       by (metis carrier_matD(1) carrier_matD(2) diagonal_mat_def index_col index_row(2))
   qed
   also have "... = B $$(i,i) * (Matrix.vec_index  (Matrix.row A j) i)" using assms by auto
   also have "... = diag_mat B ! i * (Matrix.vec_index  (Matrix.row A j) i)" unfolding diag_mat_def 
     using assms by simp
   also have "... = diag_mat B ! i * A $$ (j, i)" using assms by simp
   finally show ?thesis .
 qed
 
 lemma inner_prod_adjoint_comp:
   assumes "(U::'a::conjugatable_field Matrix.mat) \<in> carrier_mat n n"
 and "(V::'a::conjugatable_field Matrix.mat) \<in> carrier_mat n n"
 and "i < n"
 and "j < n"
 shows "Complex_Matrix.inner_prod  (Matrix.col V i) (Matrix.col U j) = 
   ((Complex_Matrix.adjoint V) * U) $$ (i, j)"
 proof -
   have "Complex_Matrix.inner_prod (Matrix.col V i) (Matrix.col U j) = 
     Matrix.scalar_prod (Matrix.col U j) (Matrix.row (Complex_Matrix.adjoint V) i)"
     using adjoint_row[of i V] assms  by simp  
   also have "... = Matrix.scalar_prod (Matrix.row (Complex_Matrix.adjoint V) i) (Matrix.col U j)"
     by (metis adjoint_row assms(1) assms(2) assms(3) carrier_matD(1) carrier_matD(2) Matrix.col_dim 
         conjugate_vec_sprod_comm)
   also have "... = ((Complex_Matrix.adjoint V) * U) $$ (i, j)" using assms 
     by (simp add:times_mat_def)
   finally show ?thesis .
 qed
 
 lemma mat_unit_vec_col:
   assumes "(A::'a::conjugatable_field Matrix.mat) \<in> carrier_mat n n"
 and "i < n"
 shows "A *\<^sub>v (unit_vec n i) = Matrix.col A i"
 proof
   show "dim_vec (A *\<^sub>v unit_vec n i) = dim_vec (Matrix.col A i)" using assms by simp
   show "\<And>j. j < dim_vec (Matrix.col A i) \<Longrightarrow> Matrix.vec_index (A *\<^sub>v unit_vec n i)  j = 
     Matrix.vec_index (Matrix.col A i)  j"
   proof -
     fix j
     assume "j < dim_vec (Matrix.col A i)"
     hence "Matrix.vec_index (A *\<^sub>v unit_vec n i)  j = 
       Matrix.scalar_prod (Matrix.row A j) (unit_vec n i)" unfolding mult_mat_vec_def by simp
     also have "... = Matrix.scalar_prod  (unit_vec n i) (Matrix.row A j)" using comm_scalar_prod
         assms by auto
     also have "... = (Matrix.vec_index (unit_vec n i) i) * (Matrix.vec_index (Matrix.row A j) i)"
       unfolding Matrix.scalar_prod_def 
     proof (rule sum_but_one)
       show "i < dim_vec (Matrix.row A j)" using assms by auto
       show "\<forall>ia<dim_vec (Matrix.row A j). ia \<noteq> i \<longrightarrow> Matrix.vec_index (unit_vec n i) ia = 0" 
         using assms unfolding unit_vec_def by auto
     qed
     also have "... = (Matrix.vec_index (Matrix.row A j) i)" using assms by simp
     also have "... = A $$ (j, i)" using assms \<open>j < dim_vec (Matrix.col A i)\<close> by simp
     also have "... = Matrix.vec_index (Matrix.col A i)  j" using assms \<open>j < dim_vec (Matrix.col A i)\<close> by simp
     finally show "Matrix.vec_index (A *\<^sub>v unit_vec n i)  j = 
       Matrix.vec_index (Matrix.col A i)  j" .
   qed
 qed
 
 lemma mat_prod_unit_vec_cong:
   assumes "(A::'a::conjugatable_field Matrix.mat) \<in> carrier_mat n n"
 and "B\<in> carrier_mat n n"
 and "\<And>i. i < n \<Longrightarrow> A *\<^sub>v (unit_vec n i) = B *\<^sub>v (unit_vec n i)"
 shows "A = B"
 proof
   show "dim_row A = dim_row B" using assms by simp
   show "dim_col A = dim_col B" using assms by simp
   show "\<And>i j. i < dim_row B \<Longrightarrow> j < dim_col B \<Longrightarrow> A $$ (i, j) = B $$ (i, j)"
   proof -
     fix i j
     assume ij: "i < dim_row B" "j < dim_col B"
     hence "A $$ (i,j) = Matrix.vec_index (Matrix.col A j) i" using assms by simp
     also have "... = Matrix.vec_index (A *\<^sub>v (unit_vec n j)) i" using mat_unit_vec_col[of A] ij assms 
       by simp
     also have "... = Matrix.vec_index (B *\<^sub>v (unit_vec n j)) i" using assms ij by simp
     also have "... = Matrix.vec_index (Matrix.col B j) i" using mat_unit_vec_col ij assms by simp
     also have "... = B $$ (i,j)" using assms ij by simp
     finally show "A $$ (i, j) = B $$ (i, j)" .
   qed
 qed
 
 lemma smult_smult_times:
   fixes a::"'a::semigroup_mult"
   shows "a\<cdot>\<^sub>m (k \<cdot>\<^sub>m A) = (a * k)\<cdot>\<^sub>m A"
 proof
   show r:"dim_row (a \<cdot>\<^sub>m (k \<cdot>\<^sub>m A)) = dim_row (a * k \<cdot>\<^sub>m A)" by simp
   show c:"dim_col (a \<cdot>\<^sub>m (k \<cdot>\<^sub>m A)) = dim_col (a * k \<cdot>\<^sub>m A)" by simp
   show "\<And>i j. i < dim_row (a * k \<cdot>\<^sub>m A) \<Longrightarrow>
            j < dim_col (a * k \<cdot>\<^sub>m A) \<Longrightarrow> (a \<cdot>\<^sub>m (k \<cdot>\<^sub>m A)) $$ (i, j) = (a * k \<cdot>\<^sub>m A) $$ (i, j)"
   proof -
     fix i j
     assume "i < dim_row (a * k \<cdot>\<^sub>m A)" and "j < dim_col (a * k \<cdot>\<^sub>m A)" note ij = this
     hence "(a \<cdot>\<^sub>m (k \<cdot>\<^sub>m A)) $$ (i, j) = a * (k \<cdot>\<^sub>m A) $$ (i, j)"  by simp
     also have "... = a * (k * A $$ (i,j))" using ij by simp
     also have "... = (a * k) * A $$ (i,j)"
       by (simp add: semigroup_mult_class.mult.assoc)
     also have "... = (a * k \<cdot>\<^sub>m A) $$ (i, j)" using r c ij by simp
     finally show "(a \<cdot>\<^sub>m (k \<cdot>\<^sub>m A)) $$ (i, j) = (a * k \<cdot>\<^sub>m A) $$ (i, j)" .
   qed
 qed
 
 lemma mat_minus_minus:
   fixes A :: "'a :: ab_group_add Matrix.mat"
   assumes "A \<in> carrier_mat n m"
   and "B\<in> carrier_mat n m"
   and "C\<in> carrier_mat n m"
 shows "A - (B - C) = A - B + C"
 proof
   show "dim_row (A - (B - C)) = dim_row (A - B + C)" using assms by simp
   show "dim_col (A - (B - C)) = dim_col (A - B + C)" using assms by simp
   show "\<And>i j. i < dim_row (A - B + C) \<Longrightarrow> j < dim_col (A - B + C) \<Longrightarrow> 
     (A - (B - C)) $$ (i, j) = (A - B + C) $$ (i, j)" 
   proof -
     fix i j
     assume "i < dim_row (A - B + C)" and "j < dim_col (A - B + C)" note ij = this
     have "(A - (B - C)) $$ (i, j) = (A $$ (i,j) - B $$ (i,j) + C $$ (i,j))" using ij assms by simp
     also have "... = (A - B + C) $$ (i, j)" using assms ij by simp
     finally show "(A - (B - C)) $$ (i, j) = (A - B + C) $$ (i, j)" .
   qed
 qed
 
 
 subsection \<open>Complements on complex matrices\<close>
 
 lemma hermitian_square:
   assumes "hermitian M"
   shows "M \<in> carrier_mat (dim_row M) (dim_row M)"
 proof -
   have "dim_col M = dim_row M" using assms unfolding hermitian_def adjoint_def
     by (metis adjoint_dim_col)
   thus ?thesis by auto
 qed
 
 lemma hermitian_add:
   assumes "A\<in> carrier_mat n n"
   and "B\<in> carrier_mat n n"
 and "hermitian A"
 and "hermitian B"
 shows "hermitian (A + B)" unfolding hermitian_def
   by (metis adjoint_add assms hermitian_def)
 
 lemma hermitian_minus:
   assumes "A\<in> carrier_mat n n"
   and "B\<in> carrier_mat n n"
 and "hermitian A"
 and "hermitian B"
 shows "hermitian (A - B)" unfolding hermitian_def
   by (metis adjoint_minus assms hermitian_def)
 
 lemma hermitian_smult:
   fixes a::real
   fixes A::"complex Matrix.mat"
   assumes "A \<in> carrier_mat n n"
 and "hermitian A"
 shows "hermitian (a \<cdot>\<^sub>m  A)"    
 proof -
   have dim: "Complex_Matrix.adjoint A \<in> carrier_mat n n" using assms by (simp add: adjoint_dim) 
   {
     fix i j
     assume "i < n" and "j < n"
     hence "Complex_Matrix.adjoint (a \<cdot>\<^sub>m A) $$ (i,j) = a * (Complex_Matrix.adjoint A $$ (i,j))" 
       using adjoint_scale[of a A] assms by simp
     also have "... = a * (A $$ (i,j))" using assms unfolding hermitian_def by simp
     also have "... = (a \<cdot>\<^sub>m A) $$ (i,j)" using \<open>i < n\<close> \<open>j < n\<close> assms by simp
     finally have "Complex_Matrix.adjoint (a \<cdot>\<^sub>m A) $$ (i,j) = (a \<cdot>\<^sub>m A) $$ (i,j)" .
   }
   thus ?thesis using dim assms unfolding hermitian_def by auto
 qed
 
 lemma unitary_eigenvalues_norm_square:
   fixes U::"complex Matrix.mat"
   assumes "unitary U"
   and "U \<in> carrier_mat n n"
   and "eigenvalue U k"
 shows "conjugate k * k = 1"
 proof -
   have "\<exists>v. eigenvector U v k" using assms unfolding eigenvalue_def by simp
   from this obtain v where "eigenvector U v k" by auto
   define vn where "vn = vec_normalize v"
   have "eigenvector U vn k" using normalize_keep_eigenvector \<open>eigenvector U v k\<close>
     using assms(2) eigenvector_def vn_def by blast
   have "vn \<in> carrier_vec n"
     using \<open>eigenvector U v k\<close> assms(2) eigenvector_def normalized_vec_dim vn_def by blast
   have "Complex_Matrix.inner_prod vn vn = 1" using \<open>vn = vec_normalize v\<close> \<open>eigenvector U v k\<close> 
         eigenvector_def normalized_vec_norm by blast
   hence "conjugate k * k = conjugate k * k * Complex_Matrix.inner_prod vn vn" by simp
   also have "... = conjugate k * Complex_Matrix.inner_prod vn (k \<cdot>\<^sub>v vn)"
   proof -
     have "k * Complex_Matrix.inner_prod vn vn = Complex_Matrix.inner_prod vn (k \<cdot>\<^sub>v vn)" 
       using inner_prod_smult_left[of vn n vn k] \<open>vn \<in> carrier_vec n\<close> by simp
     thus ?thesis by simp
   qed
   also have "... = Complex_Matrix.inner_prod (k \<cdot>\<^sub>v vn) (k \<cdot>\<^sub>v vn)"
     using inner_prod_smult_right[of vn n _ k] by (simp add: \<open>vn \<in> carrier_vec n\<close>)
   also have "... = Complex_Matrix.inner_prod (U *\<^sub>v vn) (U *\<^sub>v vn)" 
     using \<open>eigenvector U vn k\<close> unfolding eigenvector_def by simp
   also have "... =  
     Complex_Matrix.inner_prod (Complex_Matrix.adjoint U *\<^sub>v (U *\<^sub>v vn)) vn" 
     using adjoint_def_alter[of "U *\<^sub>v vn" n vn n U] assms
     by (metis \<open>eigenvector U vn k\<close> carrier_matD(1) carrier_vec_dim_vec dim_mult_mat_vec 
         eigenvector_def)
   also have "... = Complex_Matrix.inner_prod vn vn"
   proof -
     have "Complex_Matrix.adjoint U *\<^sub>v (U *\<^sub>v vn) = (Complex_Matrix.adjoint U * U) *\<^sub>v vn"
       using assms
       by (metis \<open>eigenvector U vn k\<close> adjoint_dim assoc_mult_mat_vec carrier_matD(1) eigenvector_def)
     also have "... = vn" using assms unfolding unitary_def inverts_mat_def
       by (metis \<open>eigenvector U vn k\<close> assms(1) eigenvector_def one_mult_mat_vec unitary_simps(1))
     finally show ?thesis by simp
   qed
   also have "... = 1" using \<open>vn = vec_normalize v\<close> \<open>eigenvector U v k\<close> eigenvector_def 
       normalized_vec_norm by blast
   finally show ?thesis .
 qed
 
 lemma outer_prod_smult_left:
   fixes v::"complex Matrix.vec"
   shows "outer_prod (a \<cdot>\<^sub>v v) w = a \<cdot>\<^sub>m outer_prod v w" 
 proof -
   define paw where "paw = outer_prod (a \<cdot>\<^sub>v v) w"
   define apw where "apw = a \<cdot>\<^sub>m outer_prod v w"
   have "paw = apw"
   proof
     have "dim_row paw = dim_vec v" unfolding paw_def using outer_prod_dim
       by (metis carrier_matD(1) carrier_vec_dim_vec index_smult_vec(2))
     also have "... = dim_row apw" unfolding apw_def using outer_prod_dim
       by (metis carrier_matD(1) carrier_vec_dim_vec index_smult_mat(2))
     finally show dr: "dim_row paw = dim_row apw" .
     have "dim_col paw = dim_vec w" unfolding paw_def using outer_prod_dim
       using carrier_vec_dim_vec by blast
     also have "... = dim_col apw" unfolding apw_def using outer_prod_dim
       by (metis apw_def carrier_matD(2) carrier_vec_dim_vec smult_carrier_mat)
     finally show dc: "dim_col paw = dim_col apw" .
     show "\<And>i j. i < dim_row apw \<Longrightarrow> j < dim_col apw \<Longrightarrow> paw $$ (i, j) = apw $$ (i, j)"
     proof -
       fix i j
       assume  "i < dim_row apw" and "j < dim_col apw" note ij = this
       hence "paw $$ (i,j) = a * (Matrix.vec_index v i) * cnj (Matrix.vec_index w j)" 
         using dr dc unfolding  paw_def outer_prod_def by simp
       also have "... = apw $$ (i,j)" using dr dc ij unfolding apw_def outer_prod_def by simp
       finally show "paw $$ (i, j) = apw $$ (i, j)" .
     qed
   qed
   thus ?thesis unfolding paw_def apw_def by simp
 qed
 
 lemma outer_prod_smult_right:
   fixes v::"complex Matrix.vec"
   shows "outer_prod v (a \<cdot>\<^sub>v w) = (conjugate a) \<cdot>\<^sub>m outer_prod v w" 
 proof -
   define paw where "paw = outer_prod v (a \<cdot>\<^sub>v w)"
   define apw where "apw = (conjugate a) \<cdot>\<^sub>m outer_prod v w"
   have "paw = apw"
   proof
     have "dim_row paw = dim_vec v" unfolding paw_def using outer_prod_dim
       by (metis carrier_matD(1) carrier_vec_dim_vec)
     also have "... = dim_row apw" unfolding apw_def using outer_prod_dim
       by (metis carrier_matD(1) carrier_vec_dim_vec index_smult_mat(2))
     finally show dr: "dim_row paw = dim_row apw" .
     have "dim_col paw = dim_vec w" unfolding paw_def using outer_prod_dim
       using carrier_vec_dim_vec by (metis carrier_matD(2) index_smult_vec(2)) 
     also have "... = dim_col apw" unfolding apw_def using outer_prod_dim
       by (metis apw_def carrier_matD(2) carrier_vec_dim_vec smult_carrier_mat)
     finally show dc: "dim_col paw = dim_col apw" .
     show "\<And>i j. i < dim_row apw \<Longrightarrow> j < dim_col apw \<Longrightarrow> paw $$ (i, j) = apw $$ (i, j)"
     proof -
       fix i j
       assume  "i < dim_row apw" and "j < dim_col apw" note ij = this
       hence "paw $$ (i,j) = (conjugate a) * (Matrix.vec_index v i) * cnj (Matrix.vec_index w j)" 
         using dr dc unfolding  paw_def outer_prod_def by simp
       also have "... = apw $$ (i,j)" using dr dc ij unfolding apw_def outer_prod_def by simp
       finally show "paw $$ (i, j) = apw $$ (i, j)" .
     qed
   qed
   thus ?thesis unfolding paw_def apw_def by simp
 qed
 
 lemma outer_prod_add_left:
   fixes v::"complex Matrix.vec"
   assumes "dim_vec v = dim_vec x"
   shows "outer_prod (v + x) w = outer_prod v w + (outer_prod x w)" 
 proof -
   define paw where "paw = outer_prod (v+x) w"
   define apw where "apw = outer_prod v w + (outer_prod x w)"
   have "paw = apw"
   proof
     have rv: "dim_row paw = dim_vec v" unfolding paw_def using outer_prod_dim assms
       by (metis carrier_matD(1) carrier_vec_dim_vec index_add_vec(2) paw_def)
     also have "... = dim_row apw" unfolding apw_def using outer_prod_dim assms
       by (metis carrier_matD(1) carrier_vec_dim_vec index_add_mat(2))
     finally show dr: "dim_row paw = dim_row apw" .
     have cw: "dim_col paw = dim_vec w" unfolding paw_def using outer_prod_dim assms
       using carrier_vec_dim_vec by (metis carrier_matD(2)) 
     also have "... = dim_col apw" unfolding apw_def using outer_prod_dim
       by (metis apw_def carrier_matD(2) carrier_vec_dim_vec add_carrier_mat)
     finally show dc: "dim_col paw = dim_col apw" .
     show "\<And>i j. i < dim_row apw \<Longrightarrow> j < dim_col apw \<Longrightarrow> paw $$ (i, j) = apw $$ (i, j)"
     proof -
       fix i j
       assume  "i < dim_row apw" and "j < dim_col apw" note ij = this
       hence "paw $$ (i,j) = (Matrix.vec_index v i + Matrix.vec_index x i) * 
         cnj (Matrix.vec_index w j)" 
         using dr dc unfolding  paw_def outer_prod_def by simp
       also have "... = Matrix.vec_index v i * cnj (Matrix.vec_index w j) + 
         Matrix.vec_index x i * cnj (Matrix.vec_index w j)"
         by (simp add: ring_class.ring_distribs(2))
       also have "... = (outer_prod v w) $$ (i,j) + (outer_prod x w) $$ (i,j)" 
         using rv cw dr dc ij assms unfolding outer_prod_def by auto
       also have "... = apw $$ (i,j)" using dr dc ij unfolding apw_def outer_prod_def by simp
       finally show "paw $$ (i, j) = apw $$ (i, j)" .
     qed
   qed
   thus ?thesis unfolding paw_def apw_def by simp
 qed
 
 lemma outer_prod_add_right:
   fixes v::"complex Matrix.vec"
   assumes "dim_vec w = dim_vec x"
   shows "outer_prod v (w + x) = outer_prod v w + (outer_prod v x)" 
 proof -
   define paw where "paw = outer_prod v (w+x)"
   define apw where "apw = outer_prod v w + (outer_prod v x)"
   have "paw = apw"
   proof
     have rv: "dim_row paw = dim_vec v" unfolding paw_def using outer_prod_dim assms
       by (metis carrier_matD(1) carrier_vec_dim_vec index_add_vec(2) paw_def)
     also have "... = dim_row apw" unfolding apw_def using outer_prod_dim assms
       by (metis carrier_matD(1) carrier_vec_dim_vec index_add_mat(2))
     finally show dr: "dim_row paw = dim_row apw" .
     have cw: "dim_col paw = dim_vec w" unfolding paw_def using outer_prod_dim assms
       using carrier_vec_dim_vec
       by (metis carrier_matD(2) index_add_vec(2) paw_def) 
     also have "... = dim_col apw" unfolding apw_def using outer_prod_dim
       by (metis assms carrier_matD(2) carrier_vec_dim_vec index_add_mat(3))
     finally show dc: "dim_col paw = dim_col apw" .
     show "\<And>i j. i < dim_row apw \<Longrightarrow> j < dim_col apw \<Longrightarrow> paw $$ (i, j) = apw $$ (i, j)"
     proof -
       fix i j
       assume  "i < dim_row apw" and "j < dim_col apw" note ij = this
       hence "paw $$ (i,j) = Matrix.vec_index v i * 
         (cnj (Matrix.vec_index w j + (Matrix.vec_index x j)))" 
         using dr dc unfolding  paw_def outer_prod_def by simp
       also have "... = Matrix.vec_index v i * cnj (Matrix.vec_index w j) + 
         Matrix.vec_index v i * cnj (Matrix.vec_index x j)"
         by (simp add: ring_class.ring_distribs(1))
       also have "... = (outer_prod v w) $$ (i,j) + (outer_prod v x) $$ (i,j)" 
         using rv cw dr dc ij assms unfolding outer_prod_def by auto
       also have "... = apw $$ (i,j)" using dr dc ij unfolding apw_def outer_prod_def by simp
       finally show "paw $$ (i, j) = apw $$ (i, j)" .
     qed
   qed
   thus ?thesis unfolding paw_def apw_def by simp
 qed
 
 lemma outer_prod_minus_left:
   fixes v::"complex Matrix.vec"
   assumes "dim_vec v = dim_vec x"
   shows "outer_prod (v - x) w = outer_prod v w - (outer_prod x w)" 
 proof -
   define paw where "paw = outer_prod (v-x) w"
   define apw where "apw = outer_prod v w - (outer_prod x w)"
   have "paw = apw"
   proof
     have rv: "dim_row paw = dim_vec v" unfolding paw_def using outer_prod_dim assms
       by (metis carrier_matD(1) carrier_vec_dim_vec index_minus_vec(2) paw_def)
     also have "... = dim_row apw" unfolding apw_def using outer_prod_dim assms
       by (metis carrier_matD(1) carrier_vec_dim_vec index_minus_mat(2))
     finally show dr: "dim_row paw = dim_row apw" .
     have cw: "dim_col paw = dim_vec w" unfolding paw_def using outer_prod_dim assms
       using carrier_vec_dim_vec by (metis carrier_matD(2)) 
     also have "... = dim_col apw" unfolding apw_def using outer_prod_dim
       by (metis apw_def carrier_matD(2) carrier_vec_dim_vec minus_carrier_mat)
     finally show dc: "dim_col paw = dim_col apw" .
     show "\<And>i j. i < dim_row apw \<Longrightarrow> j < dim_col apw \<Longrightarrow> paw $$ (i, j) = apw $$ (i, j)"
     proof -
       fix i j
       assume  "i < dim_row apw" and "j < dim_col apw" note ij = this
       hence "paw $$ (i,j) = (Matrix.vec_index v i - Matrix.vec_index x i) * 
         cnj (Matrix.vec_index w j)" 
         using dr dc unfolding  paw_def outer_prod_def by simp
       also have "... = Matrix.vec_index v i * cnj (Matrix.vec_index w j) - 
         Matrix.vec_index x i * cnj (Matrix.vec_index w j)"
         by (simp add: ring_class.ring_distribs)
       also have "... = (outer_prod v w) $$ (i,j) - (outer_prod x w) $$ (i,j)" 
         using rv cw dr dc ij assms unfolding outer_prod_def by auto
       also have "... = apw $$ (i,j)" using dr dc ij unfolding apw_def outer_prod_def by simp
       finally show "paw $$ (i, j) = apw $$ (i, j)" .
     qed
   qed
   thus ?thesis unfolding paw_def apw_def by simp
 qed
 
 lemma outer_prod_minus_right:
   fixes v::"complex Matrix.vec"
   assumes "dim_vec w = dim_vec x"
   shows "outer_prod v (w - x) = outer_prod v w - (outer_prod v x)" 
 proof -
   define paw where "paw = outer_prod v (w-x)"
   define apw where "apw = outer_prod v w - (outer_prod v x)"
   have "paw = apw"
   proof
     have rv: "dim_row paw = dim_vec v" unfolding paw_def using outer_prod_dim assms
       by (metis carrier_matD(1) carrier_vec_dim_vec paw_def)
     also have "... = dim_row apw" unfolding apw_def using outer_prod_dim assms
       by (metis carrier_matD(1) carrier_vec_dim_vec index_minus_mat(2))
     finally show dr: "dim_row paw = dim_row apw" .
     have cw: "dim_col paw = dim_vec w" unfolding paw_def using outer_prod_dim assms
       using carrier_vec_dim_vec
       by (metis carrier_matD(2) index_minus_vec(2) paw_def) 
     also have "... = dim_col apw" unfolding apw_def using outer_prod_dim
       by (metis assms carrier_matD(2) carrier_vec_dim_vec index_minus_mat(3))
     finally show dc: "dim_col paw = dim_col apw" .
     show "\<And>i j. i < dim_row apw \<Longrightarrow> j < dim_col apw \<Longrightarrow> paw $$ (i, j) = apw $$ (i, j)"
     proof -
       fix i j
       assume  "i < dim_row apw" and "j < dim_col apw" note ij = this
       hence "paw $$ (i,j) = Matrix.vec_index v i * 
         (cnj (Matrix.vec_index w j - (Matrix.vec_index x j)))" 
         using dr dc unfolding  paw_def outer_prod_def by simp
       also have "... = Matrix.vec_index v i * cnj (Matrix.vec_index w j) - 
         Matrix.vec_index v i * cnj (Matrix.vec_index x j)"
         by (simp add: ring_class.ring_distribs)
       also have "... = (outer_prod v w) $$ (i,j) - (outer_prod v x) $$ (i,j)" 
         using rv cw dr dc ij assms unfolding outer_prod_def by auto
       also have "... = apw $$ (i,j)" using dr dc ij unfolding apw_def outer_prod_def by simp
       finally show "paw $$ (i, j) = apw $$ (i, j)" .
     qed
   qed
   thus ?thesis unfolding paw_def apw_def by simp
 qed
 
 lemma outer_minus_minus:
   fixes a::"complex Matrix.vec" 
   assumes "dim_vec a = dim_vec b"
   and "dim_vec u = dim_vec v"
   shows "outer_prod (a - b) (u - v) = outer_prod a u - outer_prod a v -
       outer_prod b u +  outer_prod b v"
 proof -
   have "outer_prod (a - b) (u - v) = outer_prod a (u - v)
     - outer_prod b (u - v)" using  outer_prod_minus_left assms by simp 
   also have "... = outer_prod a u - outer_prod a v -
     outer_prod b (u - v)" using assms outer_prod_minus_right by simp  
   also have "... = outer_prod a u - outer_prod a v -
     (outer_prod b u - outer_prod b v)" using assms outer_prod_minus_right by simp  
   also have "...  = outer_prod a u - outer_prod a v -
     outer_prod b u +  outer_prod b v"  
   proof (rule mat_minus_minus)
     show "outer_prod b u \<in> carrier_mat (dim_vec b) (dim_vec u)" by simp
     show "outer_prod b v \<in> carrier_mat (dim_vec b) (dim_vec u)" using assms by simp
     show "outer_prod a u - outer_prod a v \<in> carrier_mat (dim_vec b) (dim_vec u)" using assms
       by (metis carrier_vecI minus_carrier_mat outer_prod_dim)
   qed
   finally show ?thesis .
 qed
 
 lemma  outer_trace_inner:
   assumes "A \<in> carrier_mat n n"
   and "dim_vec u = n"
 and "dim_vec v = n"
   shows "Complex_Matrix.trace (outer_prod u v * A) = Complex_Matrix.inner_prod v (A *\<^sub>v u)"
 proof -
  have "Complex_Matrix.trace (outer_prod u v * A) = Complex_Matrix.trace (A * outer_prod u v)"
   proof (rule trace_comm)
     show "A \<in> carrier_mat n n" using assms  by simp
     show "outer_prod u v \<in> carrier_mat n n" using  assms
       by (metis carrier_vec_dim_vec outer_prod_dim)
   qed
   also have "... = Complex_Matrix.inner_prod v (A *\<^sub>v u)" using trace_outer_prod_right[of A n u v]
     assms   carrier_vec_dim_vec  by metis
   finally show ?thesis .
 qed
 
 lemma zero_hermitian:
   shows "hermitian (0\<^sub>m n n)" unfolding hermitian_def
     by (metis adjoint_minus hermitian_def hermitian_one minus_r_inv_mat one_carrier_mat)
 
 lemma  trace_1: 
   shows "Complex_Matrix.trace ((1\<^sub>m n)::complex Matrix.mat) =(n::complex)" using one_mat_def
   by (simp add: Complex_Matrix.trace_def Matrix.mat_def)
 
 lemma  trace_add: 
   assumes "square_mat A"
   and "square_mat B"
   and "dim_row A = dim_row B"
   shows "Complex_Matrix.trace (A + B) = Complex_Matrix.trace A + Complex_Matrix.trace B" 
   using  assms by (simp add: Complex_Matrix.trace_def sum.distrib)
 
 lemma bra_vec_carrier:
   shows "bra_vec v \<in> carrier_mat 1 (dim_vec v)"
 proof -
   have "dim_row (ket_vec v) = dim_vec v" unfolding ket_vec_def by simp
   thus ?thesis using bra_bra_vec[of v] bra_def[of "ket_vec v"] by simp
 qed
 
 lemma mat_mult_ket_carrier:
   assumes "A\<in> carrier_mat n m"
 shows "A * |v\<rangle> \<in> carrier_mat n 1" using assms
       by (metis bra_bra_vec bra_vec_carrier carrier_matD(1) carrier_matI dagger_of_ket_is_bra 
           dim_row_of_dagger index_mult_mat(2) index_mult_mat(3)) 
 
 lemma mat_mult_ket:
   assumes "A \<in> carrier_mat n m"
 and "dim_vec v = m"
 shows "A * |v\<rangle> = |A *\<^sub>v v\<rangle>"
 proof -
   have rn: "dim_row (A * |v\<rangle>) = n" unfolding times_mat_def using assms by simp
   have co: "dim_col |A *\<^sub>v v\<rangle> = 1" using assms unfolding ket_vec_def by simp
   have cov: "dim_col |v\<rangle> = 1" using assms unfolding ket_vec_def by simp
   have er: "dim_row (A * |v\<rangle>) = dim_row |A *\<^sub>v v\<rangle>" using assms
     by (metis bra_bra_vec bra_vec_carrier carrier_matD(2) dagger_of_ket_is_bra dim_col_of_dagger 
         dim_mult_mat_vec index_mult_mat(2)) 
   have ec: "dim_col (A * |v\<rangle>) = dim_col |A *\<^sub>v v\<rangle>" using assms
     by (metis carrier_matD(2) index_mult_mat(3) mat_mult_ket_carrier)
   {
     fix i::nat 
     fix j::nat
     assume "i < n"
     and "j < 1"
     hence "j = 0" by simp
     have "(A * |v\<rangle>) $$ (i,0) = Matrix.scalar_prod (Matrix.row A i) (Matrix.col |v\<rangle> 0)" 
       using times_mat_def[of A] \<open>i < n\<close> rn cov by simp
     also have "... = Matrix.scalar_prod (Matrix.row A i) v"  using ket_vec_col  by simp
     also have "... =  |A *\<^sub>v v\<rangle> $$ (i,j)" unfolding mult_mat_vec_def
       using \<open>i < n\<close> \<open>j = 0\<close> assms(1) by auto
   } note idx = this
   have "A * |v\<rangle> = Matrix.mat n 1 (\<lambda>(i, j). Matrix.scalar_prod (Matrix.row A i) (Matrix.col |v\<rangle> j))" 
     using assms unfolding times_mat_def ket_vec_def by simp
   also have "... = |A *\<^sub>v v\<rangle>" using er ec idx rn co by auto
   finally show ?thesis .
 qed
 
 lemma unitary_density:
   assumes "density_operator R"
   and "unitary U"
   and "R\<in> carrier_mat n n"
   and "U\<in> carrier_mat n n"
 shows "density_operator (U * R * (Complex_Matrix.adjoint U))" unfolding density_operator_def
 proof (intro conjI)
   show "Complex_Matrix.positive (U * R * Complex_Matrix.adjoint U)" 
   proof (rule positive_close_under_left_right_mult_adjoint)
     show "U \<in> carrier_mat n n" using assms by simp
     show "R \<in> carrier_mat n n" using assms by simp
     show "Complex_Matrix.positive R" using assms unfolding density_operator_def by simp
   qed
   have "Complex_Matrix.trace (U * R * Complex_Matrix.adjoint U) = 
     Complex_Matrix.trace (Complex_Matrix.adjoint U * U * R)" 
     using trace_comm[of "U * R" n "Complex_Matrix.adjoint U"] assms
     by (metis adjoint_dim  mat_assoc_test(10))
   also have "... = Complex_Matrix.trace R" using assms by simp 
   also have "... = 1" using assms unfolding density_operator_def by simp
   finally show "Complex_Matrix.trace (U * R * Complex_Matrix.adjoint U) = 1" .
 qed
 
 
 subsection \<open>Tensor product complements\<close>
 
 lemma tensor_vec_dim[simp]:
   shows "dim_vec (tensor_vec u v) = dim_vec u * (dim_vec v)" 
 proof -
   have "length (mult.vec_vec_Tensor (*) (list_of_vec u) (list_of_vec v)) = 
     length (list_of_vec u) * length (list_of_vec v)" 
     using  mult.vec_vec_Tensor_length[of "1::real" "(*)" "list_of_vec u" "list_of_vec v"]
     by (simp add: Matrix_Tensor.mult_def)  
   thus ?thesis unfolding tensor_vec_def by simp
 qed
 
 lemma index_tensor_vec[simp]:
   assumes "0 < dim_vec v" 
   and "i < dim_vec u * dim_vec v"
 shows "vec_index (tensor_vec u v) i = 
   vec_index u (i div (dim_vec v)) * vec_index v (i mod dim_vec v)" 
 proof -
   have m: "Matrix_Tensor.mult (1::complex) (*)" by (simp add: Matrix_Tensor.mult_def) 
   have "length (list_of_vec v) = dim_vec v" using assms by simp
   hence "vec_index (tensor_vec u v) i = (*) (vec_index u (i div dim_vec v)) (vec_index v (i mod dim_vec v))"
     unfolding tensor_vec_def using mult.vec_vec_Tensor_elements assms m
     by (metis (mono_tags, lifting) length_greater_0_conv length_list_of_vec list_of_vec_index 
         mult.vec_vec_Tensor_elements vec_of_list_index)
   thus ?thesis by simp
 qed
 
 lemma  outer_prod_tensor_comm:
   fixes a::"complex Matrix.vec"
   fixes u::"complex Matrix.vec"
   assumes "0 < dim_vec a"
   and "0 < dim_vec b"
 shows "outer_prod (tensor_vec u v) (tensor_vec a b) = tensor_mat (outer_prod u a) (outer_prod v b)"
 proof -
   define ot where "ot = outer_prod (tensor_vec u v) (tensor_vec a b)"
   define to where "to = tensor_mat (outer_prod u a) (outer_prod v b)"
   define dv where "dv = dim_vec v"
   define db where "db = dim_vec b"
   have "ot = to"
   proof
     have ro: "dim_row ot = dim_vec u * dim_vec v" unfolding ot_def outer_prod_def by simp
     have "dim_row to = dim_row (outer_prod u a) * dim_row (outer_prod v b)" 
       unfolding to_def by simp 
     also have "... = dim_vec u * dim_vec v" using outer_prod_dim
       by (metis carrier_matD(1) carrier_vec_dim_vec) 
     finally have rt: "dim_row to = dim_vec u * dim_vec v" .
     show "dim_row ot = dim_row to" using ro rt by simp
     have co: "dim_col ot = dim_vec a * dim_vec b" unfolding ot_def outer_prod_def by simp
     have "dim_col to = dim_col (outer_prod u a) * dim_col (outer_prod v b)" unfolding to_def by simp
     also have "... = dim_vec a * dim_vec b" using outer_prod_dim
       by (metis carrier_matD(2) carrier_vec_dim_vec)
     finally have ct: "dim_col to = dim_vec a * dim_vec b" .
     show "dim_col ot = dim_col to" using co ct by simp
     show "\<And>i j. i < dim_row to \<Longrightarrow> j < dim_col to \<Longrightarrow> ot $$ (i, j) = to $$ (i, j)"
     proof -
       fix i j
       assume "i < dim_row to" and "j < dim_col to" note ij = this
       have "ot $$ (i,j) = Matrix.vec_index (tensor_vec u v) i * 
         (conjugate (Matrix.vec_index (tensor_vec a b) j))"
         unfolding ot_def outer_prod_def using ij rt ct by simp
       also have "... = vec_index u (i div dv) * vec_index v (i mod dv)  * 
         (conjugate (Matrix.vec_index (tensor_vec a b) j))" using ij rt assms 
         unfolding dv_def
         by (metis index_tensor_vec less_nat_zero_code nat_0_less_mult_iff neq0_conv)
       also have "... = vec_index u (i div dv) * vec_index v (i mod dv)  *
         (conjugate (vec_index a (j div db) * vec_index b (j mod db)))" using ij ct assms 
         unfolding db_def by simp
       also have "... = vec_index u (i div dv) * vec_index v (i mod dv)  *
         (conjugate (vec_index a (j div db))) * (conjugate (vec_index b (j mod db)))" by simp
       also have "... = vec_index u (i div dv) * (conjugate (vec_index a (j div db))) * 
         vec_index v (i mod dv) * (conjugate (vec_index b (j mod db)))" by simp
       also have "... = (outer_prod u a) $$ (i div dv, j div db) * 
         vec_index v (i mod dv) * (conjugate (vec_index b (j mod db)))" 
       proof -
         have "i div dv < dim_vec u" using ij rt unfolding dv_def
           by (simp add: less_mult_imp_div_less)
         moreover have "j div db < dim_vec a" using ij ct assms unfolding db_def
           by (simp add: less_mult_imp_div_less)
         ultimately have "vec_index u (i div dv) * (conjugate (vec_index a (j div db))) = 
           (outer_prod u a) $$ (i div dv, j div db)" unfolding outer_prod_def by simp
         thus ?thesis by simp
       qed
       also have "... = (outer_prod u a) $$ (i div dv, j div db) * 
         (outer_prod v b) $$ (i mod dv, j mod db)" 
       proof -
         have "i mod dv < dim_vec v" using ij rt unfolding dv_def
           using assms mod_less_divisor
           by (metis less_nat_zero_code mult.commute neq0_conv times_nat.simps(1))
         moreover have "j mod db < dim_vec b" using ij ct assms unfolding db_def
           by (simp add: less_mult_imp_div_less)
         ultimately have "vec_index v (i mod dv) * (conjugate (vec_index b (j mod db))) = 
           (outer_prod v b) $$ (i mod dv, j mod db)" unfolding outer_prod_def by simp
         thus ?thesis by simp
       qed
       also have "... = tensor_mat (outer_prod u a) (outer_prod v b) $$ (i, j)" 
       proof (rule index_tensor_mat[symmetric])
         show "dim_row (outer_prod u a) = dim_vec u" unfolding outer_prod_def by simp
         show "dim_row (outer_prod v b) = dv" unfolding outer_prod_def dv_def by simp
         show "dim_col (outer_prod v b) = db" unfolding db_def outer_prod_def by simp
         show "i < dim_vec u * dv" unfolding dv_def using ij rt by simp
         show "dim_col (outer_prod u a) = dim_vec a" unfolding outer_prod_def by simp
         show "j < dim_vec a * db" unfolding db_def using ij ct by simp
         show "0 < dim_vec a" using assms by simp
         show "0 < db" unfolding db_def using assms by simp
       qed
       finally show "ot $$ (i, j) = to $$ (i, j)" unfolding to_def .
     qed
   qed
   thus ?thesis unfolding ot_def to_def by simp
 qed
 
 lemma tensor_mat_adjoint:
   assumes "m1 \<in> carrier_mat r1 c1"
     and "m2 \<in> carrier_mat r2 c2"
     and "0 < c1"
     and "0 < c2"
 and "0 < r1"
 and "0 < r2"
   shows "Complex_Matrix.adjoint (tensor_mat m1 m2) = 
   tensor_mat (Complex_Matrix.adjoint m1) (Complex_Matrix.adjoint m2)"
   apply (rule eq_matI, auto)
 proof -
   fix i j
   assume "i < dim_col m1 * dim_col m2" and "j < dim_row m1 * dim_row m2" note ij = this
   have c1: "dim_col m1 = c1" using assms by simp
   have r1: "dim_row m1 = r1" using assms by simp
   have c2: "dim_col m2 = c2" using assms by simp
   have r2: "dim_row m2 = r2" using assms by simp
   have "Complex_Matrix.adjoint (m1 \<Otimes> m2) $$ (i, j) = conjugate ((m1 \<Otimes> m2) $$ (j, i))" 
     using  ij by (simp add: adjoint_eval) 
   also have "... = conjugate (m1 $$ (j div r2, i div c2) * m2 $$ (j mod r2, i mod c2))" 
   proof -
     have "(m1 \<Otimes> m2) $$ (j, i) = m1 $$ (j div r2, i div c2) * m2 $$ (j mod r2, i mod c2)"
     proof (rule index_tensor_mat[of m1 r1 c1 m2 r2 c2 j i], (auto simp add: assms ij c1 c2 r1 r2))
       show "j < r1 * r2" using ij r1 r2 by simp
       show "i < c1 * c2" using ij c1 c2 by simp
     qed
     thus ?thesis by simp
   qed
   also have "... = conjugate (m1 $$ (j div r2, i div c2)) * conjugate ( m2 $$ (j mod r2, i mod c2))" 
     by simp
   also have "... = (Complex_Matrix.adjoint m1) $$ (i div c2, j div r2) * 
     conjugate ( m2 $$ (j mod r2, i mod c2))"
     by (metis adjoint_eval c2 ij less_mult_imp_div_less r2)
   also have "... = (Complex_Matrix.adjoint m1) $$ (i div c2, j div r2) *
     (Complex_Matrix.adjoint m2) $$ (i mod c2, j mod r2)"
     by (metis Euclidean_Division.div_eq_0_iff adjoint_eval assms(4) bits_mod_div_trivial c2 
         gr_implies_not_zero ij(2) mult_not_zero r2)
   also have "... = (tensor_mat (Complex_Matrix.adjoint m1) (Complex_Matrix.adjoint m2)) $$ (i,j)"
   proof (rule index_tensor_mat[symmetric], (simp add: ij c1 c2 r1 r2) +)
     show "i < c1 * c2" using ij c1 c2 by simp
     show "j < r1 * r2" using ij r1 r2 by simp
     show "0 < r1" using assms by simp
     show "0 < r2" using assms by simp
   qed
   finally show "Complex_Matrix.adjoint (m1 \<Otimes> m2) $$ (i, j) =
            (Complex_Matrix.adjoint m1 \<Otimes> Complex_Matrix.adjoint m2) $$ (i, j)" .
 qed
 
 lemma index_tensor_mat':
   assumes "0 < dim_col A"
   and "0 < dim_col B"
   and "i < dim_row A * dim_row B"
   and "j < dim_col A * dim_col B"
   shows "(A \<Otimes> B) $$ (i, j) = 
     A $$ (i div (dim_row B), j div (dim_col B)) * B $$ (i mod (dim_row B), j mod (dim_col B))"
   by (rule index_tensor_mat, (simp add: assms)+)
 
 lemma tensor_mat_carrier:
   shows "tensor_mat U V \<in> carrier_mat (dim_row U * dim_row V) (dim_col U * dim_col V)" by auto
 
 lemma tensor_mat_id:
   assumes "0 < d1"
   and "0 < d2"
 shows "tensor_mat (1\<^sub>m d1) (1\<^sub>m d2) = 1\<^sub>m (d1 * d2)"
 proof (rule eq_matI, auto)
   show "tensor_mat (1\<^sub>m d1) (1\<^sub>m d2) $$ (i, i) = 1" if "i < (d1 * d2)" for i
     using that index_tensor_mat'[of "1\<^sub>m d1" "1\<^sub>m d2"]   
     by (simp add: assms less_mult_imp_div_less)  
 next
   show "tensor_mat (1\<^sub>m d1) (1\<^sub>m d2) $$ (i, j) = 0" if "i < d1 * d2" "j < d1 * d2" "i \<noteq> j" for i j
     using that index_tensor_mat[of "1\<^sub>m d1" d1 d1 "1\<^sub>m d2" d2 d2 i j]
     by (metis assms(1) assms(2) index_one_mat(1) index_one_mat(2) index_one_mat(3) 
         less_mult_imp_div_less mod_less_divisor mult_div_mod_eq mult_not_zero)
 qed
 
 lemma tensor_mat_hermitian:
   assumes "A \<in> carrier_mat n n"
   and "B \<in> carrier_mat n' n'"
   and "0 < n"
   and "0 < n'"
   and "hermitian A"
   and "hermitian B"
   shows "hermitian (tensor_mat A B)" using assms by (metis hermitian_def tensor_mat_adjoint)
 
 lemma  tensor_mat_unitary:
   assumes "Complex_Matrix.unitary U"
   and "Complex_Matrix.unitary V"
 and "0 < dim_row U"
 and "0 < dim_row V"
 shows "Complex_Matrix.unitary (tensor_mat U V)" 
 proof -
   define UI where "UI = tensor_mat U V"
   have "Complex_Matrix.adjoint UI = 
     tensor_mat (Complex_Matrix.adjoint U) (Complex_Matrix.adjoint V)" unfolding UI_def
   proof (rule tensor_mat_adjoint)
     show "U \<in> carrier_mat (dim_row U) (dim_row U)" using assms unfolding Complex_Matrix.unitary_def 
       by simp
     show "V \<in> carrier_mat (dim_row V) (dim_row V)" using assms unfolding Complex_Matrix.unitary_def 
       by simp
     show "0 < dim_row V" using assms by simp
     show "0 < dim_row U" using assms by simp
     show "0 < dim_row V" using assms by simp
     show "0 < dim_row U" using assms by simp
   qed
   hence "UI * (Complex_Matrix.adjoint UI) = 
     tensor_mat (U * Complex_Matrix.adjoint U) (V * Complex_Matrix.adjoint V)"
     using mult_distr_tensor[of U "Complex_Matrix.adjoint U" "V" "Complex_Matrix.adjoint V"]
     unfolding UI_def
     by (metis (no_types, lifting) Complex_Matrix.unitary_def adjoint_dim_col adjoint_dim_row 
         assms carrier_matD(2) )    
   also have "... = tensor_mat (1\<^sub>m (dim_row U)) (1\<^sub>m (dim_row V))" using assms unitary_simps(2)
     by (metis Complex_Matrix.unitary_def)
   also have "... = (1\<^sub>m (dim_row U * dim_row V))" using tensor_mat_id assms by simp
   finally have "UI * (Complex_Matrix.adjoint UI) = (1\<^sub>m (dim_row U * dim_row V))" .
   hence "inverts_mat UI (Complex_Matrix.adjoint UI)" unfolding inverts_mat_def UI_def by simp
   thus ?thesis using assms unfolding Complex_Matrix.unitary_def UI_def
     by (metis carrier_matD(2) carrier_matI dim_col_tensor_mat dim_row_tensor_mat)
 qed
 
 
 subsection \<open>Fixed carrier matrices locale\<close>
 
 text \<open>We define a locale for matrices with a fixed number of rows and columns, and define a
 finite sum operation on this locale. The \verb+Type_To_Sets+ transfer tools then permits to obtain
 lemmata on the locale for free. \<close>
 
 locale fixed_carrier_mat =
   fixes fc_mats::"'a::field Matrix.mat set" 
   fixes dimR dimC
   assumes fc_mats_carrier: "fc_mats = carrier_mat dimR dimC"
 begin
 
 sublocale semigroup_add_on_with fc_mats "(+)"
 proof (unfold_locales)
   show "\<And>a b. a \<in> fc_mats \<Longrightarrow> b \<in> fc_mats \<Longrightarrow> a + b \<in> fc_mats" using fc_mats_carrier by simp
   show "\<And>a b c. a \<in> fc_mats \<Longrightarrow> b \<in> fc_mats \<Longrightarrow> c \<in> fc_mats \<Longrightarrow> a + b + c = a + (b + c)" 
     using fc_mats_carrier by simp
 qed
 
 sublocale ab_semigroup_add_on_with fc_mats "(+)"
 proof (unfold_locales)
   show "\<And>a b. a \<in> fc_mats \<Longrightarrow> b \<in> fc_mats \<Longrightarrow> a + b = b + a" using fc_mats_carrier 
     by (simp add: comm_add_mat) 
 qed
 
 sublocale comm_monoid_add_on_with fc_mats "(+)" "0\<^sub>m dimR dimC"
 proof (unfold_locales)
   show "0\<^sub>m dimR dimC \<in> fc_mats" using fc_mats_carrier by simp
   show "\<And>a. a \<in> fc_mats \<Longrightarrow> 0\<^sub>m dimR dimC + a = a" using fc_mats_carrier by simp
 qed
 
 sublocale ab_group_add_on_with fc_mats "(+)" "0\<^sub>m dimR dimC" "(-)" "uminus"
 proof (unfold_locales)
   show "\<And>a. a \<in> fc_mats \<Longrightarrow> - a + a = 0\<^sub>m dimR dimC" using fc_mats_carrier by simp
   show "\<And>a b. a \<in> fc_mats \<Longrightarrow> b \<in> fc_mats \<Longrightarrow> a - b = a + - b" using fc_mats_carrier
     by (simp add: add_uminus_minus_mat)
   show "\<And>a. a \<in> fc_mats \<Longrightarrow> - a \<in> fc_mats" using fc_mats_carrier by simp
 qed
 end
 
 lemma (in fixed_carrier_mat) smult_mem:
   assumes "A \<in> fc_mats"
   shows "a \<cdot>\<^sub>m A \<in> fc_mats" using fc_mats_carrier assms by auto
 
 definition (in fixed_carrier_mat) sum_mat where
 "sum_mat A I = sum_with (+) (0\<^sub>m dimR dimC) A I"
 
 lemma (in fixed_carrier_mat) sum_mat_empty[simp]:
   shows "sum_mat A {} = 0\<^sub>m dimR dimC" unfolding sum_mat_def by simp
 
 lemma (in fixed_carrier_mat) sum_mat_carrier:
   shows "(\<And>i. i \<in> I \<Longrightarrow> (A i)\<in> fc_mats) \<Longrightarrow> sum_mat A I \<in> carrier_mat dimR dimC" 
   unfolding sum_mat_def using sum_with_mem[of A I] fc_mats_carrier by auto
 
 lemma (in fixed_carrier_mat) sum_mat_insert:
   assumes "A x \<in> fc_mats" "A ` I \<subseteq> fc_mats"
     and A: "finite I" and x: "x \<notin> I"
   shows "sum_mat A (insert x I) = A x + sum_mat A I" unfolding sum_mat_def
   using assms sum_with_insert[of A x I] by simp
 
 
 subsection \<open>A locale for square matrices\<close>
 
 locale cpx_sq_mat = fixed_carrier_mat "fc_mats::complex Matrix.mat set" for fc_mats +
   assumes dim_eq: "dimR = dimC"
   and npos: "0 < dimR"
 
 lemma (in cpx_sq_mat) one_mem:
   shows "1\<^sub>m dimR \<in> fc_mats" using fc_mats_carrier dim_eq by simp
 
 lemma (in cpx_sq_mat) square_mats:
   assumes "A \<in> fc_mats"
   shows "square_mat A" using fc_mats_carrier dim_eq assms by simp
 
 lemma (in cpx_sq_mat) cpx_sq_mat_mult:
   assumes "A \<in> fc_mats"
   and "B \<in> fc_mats"
 shows "A * B \<in> fc_mats"
 proof -
   have "dim_row (A * B) = dimR" using assms fc_mats_carrier by simp
   moreover have "dim_col (A * B) = dimR" using assms fc_mats_carrier dim_eq by simp
   ultimately show ?thesis using fc_mats_carrier carrier_mat_def dim_eq by auto
 qed
 
 lemma (in cpx_sq_mat) sum_mat_distrib_left:
   shows "finite I \<Longrightarrow> R\<in> fc_mats \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> (A i)\<in> fc_mats) \<Longrightarrow> 
     sum_mat (\<lambda>i. R * (A i)) I = R * (sum_mat A I)"
 proof (induct rule: finite_induct)
   case empty
   hence a: "sum_mat (\<lambda>i. R * (A i)) {} = 0\<^sub>m dimR dimC" unfolding sum_mat_def by simp 
   have "sum_mat A {} = 0\<^sub>m dimR dimC" unfolding sum_mat_def by simp
   hence "R * (sum_mat A {}) = 0\<^sub>m dimR dimC" using  fc_mats_carrier
       right_mult_zero_mat[of R dimR dimC dimC] empty dim_eq by simp
   thus ?case using a by simp
 next
   case (insert x F)
   hence "sum_mat (\<lambda>i. R * A i) (insert x F) = R * (A x) + sum_mat (\<lambda>i. R * A i) F"  
     using sum_mat_insert[of "\<lambda>i. R * A i" x F] by (simp add: image_subsetI fc_mats_carrier dim_eq) 
   also have "... = R * (A x) + R * (sum_mat A F)" using insert by simp
   also have "... = R * (A x + (sum_mat A F))"
     by (metis dim_eq fc_mats_carrier insert.prems(1) insert.prems(2) insertCI mult_add_distrib_mat 
         sum_mat_carrier)
   also have "... = R * sum_mat A (insert x F)" 
   proof -
     have "A x + (sum_mat A F) = sum_mat A (insert x F)" 
       by (rule sum_mat_insert[symmetric], (auto simp add: insert))
     thus ?thesis by simp
   qed
   finally show ?case .
 qed
 
 lemma (in cpx_sq_mat) sum_mat_distrib_right:
   shows "finite I \<Longrightarrow> R\<in> fc_mats \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> (A i)\<in> fc_mats) \<Longrightarrow> 
     sum_mat (\<lambda>i. (A i) * R) I = (sum_mat A I) * R"
 proof (induct rule: finite_induct)
   case empty
   hence a: "sum_mat (\<lambda>i. (A i) * R) {} = 0\<^sub>m dimR dimC" unfolding sum_mat_def by simp 
   have "sum_mat A {} = 0\<^sub>m dimR dimC" unfolding sum_mat_def by simp
   hence "(sum_mat A {}) * R = 0\<^sub>m dimR dimC" using  fc_mats_carrier right_mult_zero_mat[of R ] 
       dim_eq empty by simp
   thus ?case using a by simp
 next
   case (insert x F)
   have a: "(\<lambda>i. A i * R) ` F \<subseteq> fc_mats" using insert cpx_sq_mat_mult
     by (simp add: image_subsetI) 
   have "A x * R \<in> fc_mats" using insert 
       by (metis insertI1 local.fc_mats_carrier mult_carrier_mat dim_eq)
   hence "sum_mat (\<lambda>i. A i * R) (insert x F) = (A x) * R + sum_mat (\<lambda>i. A i * R) F"  using insert a
     using sum_mat_insert[of "\<lambda>i. A i * R" x F]  by (simp add: image_subsetI local.fc_mats_carrier) 
   also have "... = (A x) * R + (sum_mat A F) * R" using insert by simp
   also have "... = (A x + (sum_mat A F)) * R" 
   proof (rule add_mult_distrib_mat[symmetric])
     show "A x \<in> carrier_mat dimR dimC" using insert fc_mats_carrier by simp
     show "sum_mat A F \<in> carrier_mat dimR dimC" using insert fc_mats_carrier sum_mat_carrier by blast
     show "R \<in> carrier_mat dimC dimC" using insert fc_mats_carrier dim_eq by simp
   qed    
   also have "... = sum_mat A (insert x F) * R" 
   proof -
     have "A x + (sum_mat A F) = sum_mat A (insert x F)" 
       by (rule sum_mat_insert[symmetric], (auto simp add: insert))
     thus ?thesis by simp
   qed
   finally show ?case .
 qed
 
 lemma (in cpx_sq_mat)  trace_sum_mat:
   fixes A::"'b \<Rightarrow> complex Matrix.mat"
   shows "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> (A i)\<in> fc_mats) \<Longrightarrow>
   Complex_Matrix.trace (sum_mat A I) = (\<Sum> i\<in> I. Complex_Matrix.trace (A i))" unfolding sum_mat_def
 proof (induct rule: finite_induct)
   case empty
   then show ?case using trace_zero dim_eq by simp
 next
   case (insert x F)
   have "Complex_Matrix.trace (sum_with (+) (0\<^sub>m dimR dimC) A (insert x F)) = 
     Complex_Matrix.trace (A x + sum_with (+) (0\<^sub>m dimR dimC) A F)" 
     using sum_with_insert[of A x F] insert by (simp add: image_subset_iff dim_eq) 
   also have "... = Complex_Matrix.trace (A x) + 
     Complex_Matrix.trace (sum_with (+) (0\<^sub>m dimR dimC) A F)" using trace_add square_mats insert 
     by (metis carrier_matD(1) fc_mats_carrier image_subset_iff insert_iff sum_with_mem) 
   also have "... = Complex_Matrix.trace (A x) + (\<Sum> i\<in> F. Complex_Matrix.trace (A i))" 
       using insert by simp
     also have "... = (\<Sum> i\<in> (insert x F). Complex_Matrix.trace (A i))" 
       using sum_with_insert[of A x F] insert by (simp add: image_subset_iff) 
   finally show ?case .
 qed
 
 lemma (in cpx_sq_mat) cpx_sq_mat_smult:
   assumes "A \<in> fc_mats"
   shows "x  \<cdot>\<^sub>m A \<in> fc_mats"
   using assms fc_mats_carrier by auto
 
 lemma (in cpx_sq_mat) mult_add_distrib_right:
   assumes "A\<in> fc_mats" "B\<in> fc_mats" "C\<in> fc_mats"
   shows "A * (B + C) = A * B + A * C"
   using assms fc_mats_carrier mult_add_distrib_mat dim_eq by simp
 
 lemma (in cpx_sq_mat) mult_add_distrib_left:
   assumes "A\<in> fc_mats" "B\<in> fc_mats" "C\<in> fc_mats"
   shows "(B + C) * A = B * A + C * A"
   using assms fc_mats_carrier add_mult_distrib_mat dim_eq by simp
 
 lemma (in cpx_sq_mat)  mult_sum_mat_distrib_left:
   shows "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> (A i)\<in> fc_mats) \<Longrightarrow> B \<in> fc_mats \<Longrightarrow>
   (sum_mat (\<lambda>i. B * (A i)) I) = B * (sum_mat A I)" 
 proof (induct rule: finite_induct)
   case empty
   hence "sum_mat A {} = 0\<^sub>m dimR dimC" using sum_mat_empty by simp
   hence "B * (sum_mat A {}) = 0\<^sub>m dimR dimC" using empty by (simp add: fc_mats_carrier dim_eq)
   moreover have "sum_mat (\<lambda>i. B * (A i)) {} = 0\<^sub>m dimR dimC" using sum_mat_empty[of "\<lambda>i. B * (A i)"] 
     by simp
   ultimately show ?case by simp
 next
   case (insert x F)
   have "sum_mat (\<lambda>i. B * (A i)) (insert x F) = B * (A x) + sum_mat (\<lambda>i. B * (A i)) F"
     using sum_with_insert[of "\<lambda>i. B * (A i)" x F] insert
     by (simp add: image_subset_iff local.sum_mat_def cpx_sq_mat_mult)
   also have "... = B * (A x) + B * (sum_mat A F)" using insert by simp
   also have "... = B * (A x + (sum_mat A F))" 
   proof (rule mult_add_distrib_right[symmetric])
     show "B\<in> fc_mats" using insert by simp
     show "A x \<in> fc_mats" using insert by simp
     show "sum_mat A F \<in> fc_mats" using insert by (simp add: fc_mats_carrier sum_mat_carrier) 
   qed
   also have "... = B * (sum_mat A (insert x F))" using sum_with_insert[of A x F] insert 
     by (simp add: image_subset_iff sum_mat_def)
   finally show ?case .
 qed
 
 lemma (in cpx_sq_mat)  mult_sum_mat_distrib_right:
   shows "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> (A i)\<in> fc_mats) \<Longrightarrow> B \<in> fc_mats \<Longrightarrow>
   (sum_mat (\<lambda>i. (A i) * B) I) = (sum_mat A I) * B" 
 proof (induct rule: finite_induct)
   case empty
   hence "sum_mat A {} = 0\<^sub>m dimR dimC" using sum_mat_empty by simp
   hence "(sum_mat A {}) * B = 0\<^sub>m dimR dimC" using empty by (simp add: fc_mats_carrier dim_eq)
   moreover have "sum_mat (\<lambda>i. (A i) * B) {} = 0\<^sub>m dimR dimC" by simp
   ultimately show ?case by simp
 next
   case (insert x F)
   have "sum_mat (\<lambda>i. (A i) * B) (insert x F) = (A x) * B + sum_mat (\<lambda>i. (A i) * B) F"
     using sum_with_insert[of "\<lambda>i. (A i) * B" x F] insert
     by (simp add: image_subset_iff local.sum_mat_def cpx_sq_mat_mult)
   also have "... = (A x) * B + (sum_mat A F) * B" using insert by simp
   also have "... = (A x + (sum_mat A F)) * B" 
   proof (rule mult_add_distrib_left[symmetric])
     show "B\<in> fc_mats" using insert by simp
     show "A x \<in> fc_mats" using insert by simp
     show "sum_mat A F \<in> fc_mats" using insert by (simp add: fc_mats_carrier sum_mat_carrier) 
   qed
   also have "... = (sum_mat A (insert x F)) * B" using sum_with_insert[of A x F] insert 
     by (simp add: image_subset_iff sum_mat_def)
   finally show ?case .
 qed
 
 lemma (in cpx_sq_mat) trace_sum_mat_mat_distrib:
   assumes "finite I"
 and "\<And>i. i\<in> I \<Longrightarrow> B i \<in> fc_mats"
 and "A\<in> fc_mats"
 and "C \<in> fc_mats"
 shows "(\<Sum> i\<in> I. Complex_Matrix.trace(A * (B i) * C)) = 
   Complex_Matrix.trace (A * (sum_mat B I) * C)" 
 proof -
   have seq: "sum_mat (\<lambda>i. A * (B i) * C) I = A * (sum_mat B I) * C"
   proof -
     have "sum_mat (\<lambda>i. A * (B i) * C) I = (sum_mat (\<lambda>i. A * (B i)) I) * C"
     proof (rule mult_sum_mat_distrib_right)
       show "finite I" using assms by simp
       show "C\<in> fc_mats" using assms by simp
       show "\<And>i. i \<in> I \<Longrightarrow> A * B i \<in> fc_mats" using assms cpx_sq_mat_mult by simp
     qed
     moreover have "sum_mat (\<lambda>i. A * (B i)) I = A * (sum_mat B I)"
       by (rule mult_sum_mat_distrib_left, (auto simp add: assms))
     ultimately show "sum_mat (\<lambda>i. A * (B i) * C) I = A * (sum_mat B I)  * C" by simp
   qed
   have "(\<Sum> i\<in> I. Complex_Matrix.trace(A * (B i) * C)) = 
     Complex_Matrix.trace (sum_mat (\<lambda>i. A * (B i) * C) I)" 
   proof (rule trace_sum_mat[symmetric])
     show "finite I" using assms by simp
     fix i
     assume "i\<in> I"
     thus "A * B i * C \<in> fc_mats" using assms by (simp add: cpx_sq_mat_mult) 
   qed
   also have "... = Complex_Matrix.trace (A * (sum_mat B I) * C)" using seq by simp
   finally show ?thesis .
 qed
 
 definition (in cpx_sq_mat) zero_col where
 "zero_col U = (\<lambda>i. if i < dimR then Matrix.col U i else 0\<^sub>v dimR)"
 
 lemma (in cpx_sq_mat) zero_col_dim:
   assumes "U \<in> fc_mats"
   shows "dim_vec (zero_col U i) = dimR" using assms fc_mats_carrier unfolding zero_col_def by simp
 
 lemma (in cpx_sq_mat) zero_col_col:
   assumes "i < dimR"
   shows "zero_col U i = Matrix.col U i" using assms unfolding zero_col_def by simp
 
 lemma (in cpx_sq_mat) sum_mat_index:
   shows "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> (A i)\<in> fc_mats) \<Longrightarrow> i < dimR \<Longrightarrow> j < dimC \<Longrightarrow> 
     (sum_mat (\<lambda>k. (A k)) I) $$ (i,j) = (\<Sum> k\<in>I. (A k) $$ (i,j))"
 proof (induct rule: finite_induct)
   case empty
   thus ?case unfolding sum_mat_def by simp
 next
   case (insert x F)
   hence "(sum_mat (\<lambda>k. (A k)) (insert x F)) $$ (i,j) = 
     (A x + (sum_mat (\<lambda>k. (A k)) F)) $$ (i,j)" using insert sum_mat_insert[of A] 
     by (simp add: image_subsetI local.fc_mats_carrier) 
   also have "... = (A x) $$ (i,j) + (sum_mat (\<lambda>k. (A k)) F) $$ (i,j)" using insert       
       sum_mat_carrier[of F A] fc_mats_carrier by simp
   also have "... = (A x) $$ (i,j) + (\<Sum> k\<in>F. (A k) $$ (i,j))" using insert by simp
   also have "... = (\<Sum> k\<in>(insert x F). (A k) $$ (i,j))" using insert by simp
   finally show ?case .
 qed
 
 lemma (in cpx_sq_mat) sum_mat_cong:
   shows "finite I \<Longrightarrow> (\<And>i. i\<in> I \<Longrightarrow> A i = B i) \<Longrightarrow> (\<And>i. i\<in> I \<Longrightarrow> A i \<in> fc_mats) \<Longrightarrow> 
     (\<And>i. i\<in> I \<Longrightarrow> B i \<in> fc_mats) \<Longrightarrow> sum_mat A I = sum_mat B I"
 proof (induct rule: finite_induct)
   case empty
   then show ?case by simp
 next
   case (insert x F)
   have "sum_mat A (insert x F) = A x + sum_mat A F" using insert sum_mat_insert[of A]
     by (simp add:  image_subset_iff) 
   also have "... = B x + sum_mat B F" using insert by simp
   also have "... = sum_mat B (insert x F)" using insert sum_mat_insert[of B]
     by (simp add:  image_subset_iff) 
   finally show ?case .
 qed
 
 lemma (in cpx_sq_mat) smult_sum_mat:
   shows "finite I \<Longrightarrow> (\<And>i. i\<in> I \<Longrightarrow> A i \<in> fc_mats) \<Longrightarrow> a \<cdot>\<^sub>m sum_mat A I = sum_mat (\<lambda>i. a  \<cdot>\<^sub>m (A i)) I"
 proof (induct rule: finite_induct)
   case empty
   then show ?case by simp
 next
   case (insert x F)
   have "a \<cdot>\<^sub>m sum_mat A (insert x F) = a \<cdot>\<^sub>m (A x + sum_mat A F)" using insert sum_mat_insert[of A]
     by (simp add:  image_subset_iff) 
   also have "... = a \<cdot>\<^sub>m A x + a \<cdot>\<^sub>m (sum_mat A F)" using insert
     by (metis add_smult_distrib_left_mat fc_mats_carrier insert_iff sum_mat_carrier)
   also have "... = a \<cdot>\<^sub>m  A x + sum_mat (\<lambda>i. a  \<cdot>\<^sub>m (A i)) F" using insert by simp
   also have "... = sum_mat (\<lambda>i. a  \<cdot>\<^sub>m (A i)) (insert x F)" using insert 
       sum_mat_insert[of "(\<lambda>i. a  \<cdot>\<^sub>m (A i))"] by (simp add: image_subset_iff cpx_sq_mat_smult)
   finally show ?case .
 qed
 
 lemma (in cpx_sq_mat) zero_sum_mat:
   shows "finite I \<Longrightarrow> sum_mat (\<lambda>i. ((0\<^sub>m dimR dimR)::complex Matrix.mat)) I = ((0\<^sub>m dimR dimR)::complex Matrix.mat)"
 proof (induct rule:finite_induct)
   case empty
   then show ?case using dim_eq sum_mat_empty by auto
 next
   case (insert x F)
   have "sum_mat (\<lambda>i. ((0\<^sub>m dimR dimR)::complex Matrix.mat)) (insert x F) = 
     0\<^sub>m dimR dimR + sum_mat (\<lambda>i. 0\<^sub>m dimR dimR) F" 
     using insert dim_eq zero_mem sum_mat_insert[of "\<lambda>i. ((0\<^sub>m dimR dimR)::complex Matrix.mat)"]
     by fastforce
   also have "... = ((0\<^sub>m dimR dimR)::complex Matrix.mat)" using insert by auto
   finally show ?case .
 qed
 
 lemma (in cpx_sq_mat) sum_mat_adjoint:
   shows "finite I \<Longrightarrow> (\<And>i. i\<in> I \<Longrightarrow> A i \<in> fc_mats) \<Longrightarrow> 
     Complex_Matrix.adjoint (sum_mat A I) = sum_mat (\<lambda>i. Complex_Matrix.adjoint (A i)) I"
 proof (induct rule: finite_induct)
   case empty
   then show ?case using zero_hermitian[of dimR] 
     by (metis (no_types) dim_eq hermitian_def sum_mat_empty)
 next
   case (insert x F)
   have "Complex_Matrix.adjoint (sum_mat A (insert x F)) = 
     Complex_Matrix.adjoint (A x + sum_mat A F)" using insert sum_mat_insert[of A]
     by (simp add:  image_subset_iff) 
   also have "... = Complex_Matrix.adjoint (A x) + Complex_Matrix.adjoint (sum_mat A F)"
   proof (rule adjoint_add)
     show "A x \<in> carrier_mat dimR dimC" using  insert fc_mats_carrier  by simp
     show "sum_mat A F \<in> carrier_mat dimR dimC" using  insert fc_mats_carrier sum_mat_carrier[of F]  
       by simp
   qed
   also have "... = Complex_Matrix.adjoint (A x) + sum_mat (\<lambda>i. Complex_Matrix.adjoint (A i)) F"
     using insert by simp
   also have "... = sum_mat (\<lambda>i. Complex_Matrix.adjoint (A i)) (insert x F)"
   proof (rule sum_mat_insert[symmetric], (auto simp add: insert))
     show "Complex_Matrix.adjoint (A x) \<in> fc_mats" using insert fc_mats_carrier dim_eq 
       by (simp add: adjoint_dim) 
     show "\<And>i. i \<in> F \<Longrightarrow> Complex_Matrix.adjoint (A i) \<in> fc_mats" using insert fc_mats_carrier dim_eq 
       by (simp add: adjoint_dim) 
   qed 
   finally show ?case .
 qed
 
 lemma (in cpx_sq_mat) sum_mat_hermitian:
   assumes "finite I"
 and "\<forall>i\<in> I. hermitian (A i)"
 and "\<forall>i\<in> I. A i\<in> fc_mats"
 shows "hermitian (sum_mat A I)" 
 proof -
   have "Complex_Matrix.adjoint (sum_mat A I) = sum_mat (\<lambda>i. Complex_Matrix.adjoint (A i)) I"
     using assms sum_mat_adjoint[of I] by simp
   also have "... = sum_mat A I" 
   proof (rule sum_mat_cong, (auto simp add: assms))
     show "\<And>i. i \<in> I \<Longrightarrow> Complex_Matrix.adjoint (A i) = A i" using assms 
       unfolding hermitian_def by simp
     show "\<And>i. i \<in> I \<Longrightarrow> Complex_Matrix.adjoint (A i) \<in> fc_mats" using assms fc_mats_carrier dim_eq
       by (simp add: adjoint_dim) 
   qed
   finally show ?thesis unfolding hermitian_def .
 qed
 
 lemma (in cpx_sq_mat) sum_mat_positive:
 shows "finite I \<Longrightarrow> (\<And>i. i\<in> I \<Longrightarrow> Complex_Matrix.positive (A i)) \<Longrightarrow> 
   (\<And>i. i \<in> I \<Longrightarrow> A i \<in> fc_mats) \<Longrightarrow> Complex_Matrix.positive (sum_mat A I)" 
 proof (induct rule: finite_induct)
   case empty
   then show ?case using positive_zero[of dimR] by (metis (no_types) dim_eq sum_mat_empty)
 next
   case (insert x F)
   hence "sum_mat A (insert x F) = A x + (sum_mat A F)" using sum_mat_insert[of A]
     by (simp add:  image_subset_iff) 
   moreover have "Complex_Matrix.positive (A x + (sum_mat A F))"
   proof (rule positive_add, (auto simp add: insert))
     show "A x \<in> carrier_mat dimR dimR" using insert fc_mats_carrier dim_eq by simp
     show "sum_mat A F \<in> carrier_mat dimR dimR" using insert sum_mat_carrier dim_eq
       by (metis insertCI)
   qed
   ultimately show "Complex_Matrix.positive (sum_mat A (insert x F))" by simp
 qed
 
 lemma (in cpx_sq_mat) sum_mat_left_ortho_zero:
   shows "finite I \<Longrightarrow> 
     (\<And>i. i\<in> I \<Longrightarrow> A i \<in> fc_mats) \<Longrightarrow> (B \<in> fc_mats) \<Longrightarrow>
     (\<And> i. i\<in> I \<Longrightarrow> A i * B = (0\<^sub>m dimR dimR)) \<Longrightarrow> 
     (sum_mat A I) * B = 0\<^sub>m dimR dimR"
 proof (induct rule:finite_induct)
   case empty
   then show ?case using dim_eq
     by (metis  finite.intros(1) sum_mat_empty mult_sum_mat_distrib_right)
 next
   case (insert x F)
   have "(sum_mat A (insert x F)) * B = 
     (A x + sum_mat A F) * B" using insert sum_mat_insert[of A] 
     by (simp add: image_subset_iff) 
   also have "... = A x * B + sum_mat A F * B"
   proof (rule add_mult_distrib_mat)
     show "A x \<in> carrier_mat dimR dimC" using insert fc_mats_carrier by simp
     show "sum_mat A F \<in> carrier_mat dimR dimC" using insert
       by (metis insert_iff local.fc_mats_carrier sum_mat_carrier) 
     show "B \<in> carrier_mat dimC dimR" using insert fc_mats_carrier dim_eq by simp
   qed
   also have "... = A x * B + (0\<^sub>m dimR dimR)"  using insert by simp
   also have "... = 0\<^sub>m dimR dimR" using insert by simp
   finally show ?case .
 qed
 
 lemma (in cpx_sq_mat) sum_mat_right_ortho_zero:
   shows "finite I \<Longrightarrow> 
     (\<And>i. i\<in> I \<Longrightarrow> A i \<in> fc_mats) \<Longrightarrow> (B \<in> fc_mats) \<Longrightarrow>
     (\<And> i. i\<in> I \<Longrightarrow> B * A i = (0\<^sub>m dimR dimR)) \<Longrightarrow> 
     B * (sum_mat A I)  = 0\<^sub>m dimR dimR"
 proof (induct rule:finite_induct)
   case empty
   then show ?case using dim_eq
     by (metis  finite.intros(1) sum_mat_empty mult_sum_mat_distrib_left)
 next
   case (insert x F)
   have "B * (sum_mat A (insert x F)) = 
     B * (A x + sum_mat A F)" using insert sum_mat_insert[of A] 
     by (simp add: image_subset_iff) 
   also have "... = B * A x + B * sum_mat A F"
   proof (rule mult_add_distrib_mat)
     show "A x \<in> carrier_mat dimR dimC" using insert fc_mats_carrier by simp
     show "sum_mat A F \<in> carrier_mat dimR dimC" using insert
       by (metis insert_iff local.fc_mats_carrier sum_mat_carrier) 
     show "B \<in> carrier_mat dimC dimR" using insert fc_mats_carrier dim_eq by simp
   qed
   also have "... = B * A x + (0\<^sub>m dimR dimR)"  using insert by simp
   also have "... = 0\<^sub>m dimR dimR" using insert by simp
   finally show ?case .
 qed
  
 lemma (in cpx_sq_mat) sum_mat_ortho_square:
   shows "finite I \<Longrightarrow> (\<And>i. i\<in> I \<Longrightarrow> ((A i)::complex Matrix.mat) * (A i) = A i) \<Longrightarrow> 
     (\<And>i. i\<in> I \<Longrightarrow> A i \<in> fc_mats) \<Longrightarrow>
     (\<And> i j. i\<in> I \<Longrightarrow> j\<in> I \<Longrightarrow> i\<noteq> j \<Longrightarrow> A i * (A j) = (0\<^sub>m dimR dimR)) \<Longrightarrow> 
     (sum_mat A I) * (sum_mat A I) = (sum_mat A I)"
 proof (induct rule:finite_induct)
   case empty
   then show ?case using dim_eq
     by (metis fc_mats_carrier right_mult_zero_mat sum_mat_empty zero_mem)
 next
   case (insert x F)
   have "(sum_mat A (insert x F)) * (sum_mat A (insert x F)) = 
     (A x + sum_mat A F) * (A x + sum_mat A F)" using insert sum_mat_insert[of A]
     by (simp add: \<open>\<And>i. i \<in> insert x F \<Longrightarrow> A i * A i = A i\<close> image_subset_iff) 
   also have "... = A x * (A x + sum_mat A F) + sum_mat A F * (A x + sum_mat A F)"
   proof (rule add_mult_distrib_mat)
     show "A x \<in> carrier_mat dimR dimC" using insert fc_mats_carrier by simp
     show "sum_mat A F \<in> carrier_mat dimR dimC" using insert
       by (metis insert_iff local.fc_mats_carrier sum_mat_carrier) 
     thus "A x + sum_mat A F \<in> carrier_mat dimC dimC" using insert dim_eq by simp
   qed
   also have "... = A x * A x + A x * (sum_mat A F) + sum_mat A F * (A x + sum_mat A F)" 
   proof -
     have "A x * (A x + sum_mat A F) = A x * A x + A x * (sum_mat A F)"  
       using dim_eq insert.prems(2) mult_add_distrib_right sum_mat_carrier
       by (metis fc_mats_carrier insertI1 subsetD subset_insertI)
     thus ?thesis by simp
   qed
   also have "... = A x * A x + A x * (sum_mat A F) + sum_mat A F * A x + 
     sum_mat A F * (sum_mat A F)" 
   proof -
     have "sum_mat A F * (A x + local.sum_mat A F) = 
       sum_mat A F * A x + local.sum_mat A F * local.sum_mat A F"
       using insert dim_eq add_assoc add_mem mult_add_distrib_right cpx_sq_mat_mult sum_mat_carrier
       by (metis fc_mats_carrier insertI1 subsetD subset_insertI)
     hence "A x * A x + A x * sum_mat A F + sum_mat A F * (A x + sum_mat A F) =
       A x * A x + A x * sum_mat A F + (sum_mat A F * A x + sum_mat A F * sum_mat A F)" by simp
     also have "... = A x * A x + A x * sum_mat A F + sum_mat A F * A x + sum_mat A F * sum_mat A F"     
     proof (rule assoc_add_mat[symmetric])
       show "A x * A x + A x * sum_mat A F \<in> carrier_mat dimR dimR" using sum_mat_carrier insert 
         dim_eq fc_mats_carrier by (metis add_mem cpx_sq_mat_mult insertCI)
       show "sum_mat A F * A x \<in> carrier_mat dimR dimR" using sum_mat_carrier insert 
         dim_eq fc_mats_carrier by (metis cpx_sq_mat_mult insertCI)
       show "sum_mat A F * sum_mat A F \<in> carrier_mat dimR dimR" using sum_mat_carrier insert 
         dim_eq fc_mats_carrier by (metis cpx_sq_mat_mult insertCI)
     qed
     finally show ?thesis .
   qed 
   also have "... = A x +  sum_mat A F"
   proof -
     have "A x * A x = A x" using insert by simp
     moreover have "sum_mat A F * sum_mat A F = sum_mat A F" using insert by simp
     moreover have "A x * (sum_mat A F) = 0\<^sub>m dimR dimR"
     proof -
       have "A x * (sum_mat A F) = sum_mat (\<lambda>i. A x * (A i)) F"
         by (rule sum_mat_distrib_left[symmetric], (simp add: insert)+)
       also have "... = sum_mat (\<lambda>i. 0\<^sub>m dimR dimR) F"
       proof (rule sum_mat_cong, (auto simp add: insert zero_mem))
         show "\<And>i. i \<in> F \<Longrightarrow> A x * A i = 0\<^sub>m dimR dimR" using insert by auto
         show "\<And>i. i \<in> F \<Longrightarrow> A x * A i \<in> fc_mats" using insert cpx_sq_mat_mult by auto
         show "\<And>i. i \<in> F \<Longrightarrow> 0\<^sub>m dimR dimR \<in> fc_mats" using zero_mem dim_eq by simp
       qed
       also have "... = 0\<^sub>m dimR dimR" using zero_sum_mat insert by simp
       finally show ?thesis .
     qed
     moreover have "sum_mat A F * A x = 0\<^sub>m dimR dimR" 
     proof -
       have "sum_mat A F * A x = sum_mat (\<lambda>i. A i * (A x)) F"
         by (rule sum_mat_distrib_right[symmetric], (simp add: insert)+)
       also have "... = sum_mat (\<lambda>i. 0\<^sub>m dimR dimR) F"
       proof (rule sum_mat_cong, (auto simp add: insert zero_mem))
         show "\<And>i. i \<in> F \<Longrightarrow> A i * A x = 0\<^sub>m dimR dimR" using insert by auto
         show "\<And>i. i \<in> F \<Longrightarrow> A i * A x \<in> fc_mats" using insert cpx_sq_mat_mult by auto
         show "\<And>i. i \<in> F \<Longrightarrow> 0\<^sub>m dimR dimR \<in> fc_mats" using zero_mem dim_eq by simp
       qed
       also have "... = 0\<^sub>m dimR dimR" using zero_sum_mat insert by simp
       finally show ?thesis .
     qed
     ultimately show ?thesis using add_commute add_zero insert.prems(2) zero_mem dim_eq by auto
   qed
   also have "... = sum_mat A (insert x F)" using insert sum_mat_insert[of A x F]
     by (simp add: \<open>\<And>i. i \<in> insert x F \<Longrightarrow> A i * A i = A i\<close> image_subsetI)
   finally show ?case .
 qed
 
 lemma diagonal_unit_vec:
   assumes "B \<in> carrier_mat n n"
 and "diagonal_mat (B::complex Matrix.mat)"
 shows "B *\<^sub>v (unit_vec n i) = B $$ (i,i)  \<cdot>\<^sub>v (unit_vec n i)"
 proof -
   define v::"complex Matrix.vec" where "v = unit_vec n i"
   have "B *\<^sub>v v = Matrix.vec n (\<lambda> i. Matrix.scalar_prod (Matrix.row B i) v)" 
     using assms unfolding mult_mat_vec_def by simp
   also have "... = Matrix.vec n (\<lambda> i. B $$(i,i) * Matrix.vec_index v i)" 
   proof -
     have "\<forall>i < n. (Matrix.scalar_prod (Matrix.row B i) v = B $$(i,i) * Matrix.vec_index v i)"
     proof (intro allI impI)
       fix i
       assume "i < n"
       have "(Matrix.scalar_prod (Matrix.row B i) v) = 
         (\<Sum> j \<in> {0 ..< n}. Matrix.vec_index (Matrix.row B i) j * Matrix.vec_index v j)" using assms
         unfolding Matrix.scalar_prod_def v_def by simp
       also have "... = Matrix.vec_index (Matrix.row B i) i * Matrix.vec_index v i" 
       proof (rule sum_but_one)
         show "\<forall>j < n. j \<noteq> i \<longrightarrow> Matrix.vec_index (Matrix.row B i) j = 0"
         proof (intro allI impI)
           fix j
           assume "j < n" and "j \<noteq> i"
           hence "Matrix.vec_index (Matrix.row B i) j = B $$ (i,j)" using \<open>i < n\<close> \<open>j < n\<close> assms 
             by auto
           also have "... = 0" using assms \<open>i < n\<close> \<open>j < n\<close> \<open>j\<noteq> i\<close> unfolding diagonal_mat_def by simp
           finally show "Matrix.vec_index (Matrix.row B i) j = 0" .
         qed
         show "i < n" using \<open>i < n\<close> .
       qed
       also have "... = B $$(i,i) * Matrix.vec_index v i" using assms \<open>i < n\<close> by auto
       finally show "(Matrix.scalar_prod (Matrix.row B i) v) = B $$(i,i) * Matrix.vec_index v i" .
     qed
     thus ?thesis by auto
   qed
   also have "... = B $$ (i,i)  \<cdot>\<^sub>v v" unfolding v_def unit_vec_def by auto
   finally have "B *\<^sub>v v = B $$ (i,i)  \<cdot>\<^sub>v v" .
   thus ?thesis unfolding v_def by simp
 qed
 
 lemma mat_vec_mult_assoc:
   assumes "A \<in> carrier_mat n p"
 and "B\<in> carrier_mat p q"
 and "dim_vec v = q"
 shows "A *\<^sub>v (B *\<^sub>v v) = (A * B) *\<^sub>v v" using assms by auto
 
 lemma (in cpx_sq_mat) similar_eigenvectors:
   assumes "A\<in> fc_mats"
   and "B\<in> fc_mats"
   and "P\<in> fc_mats"
   and "similar_mat_wit A B P (Complex_Matrix.adjoint P)"
   and "diagonal_mat B"
   and "i < n"
 shows "A *\<^sub>v (P *\<^sub>v (unit_vec dimR i)) = B $$ (i,i) \<cdot>\<^sub>v (P *\<^sub>v (unit_vec dimR i))"
 proof -
   have "A *\<^sub>v (P *\<^sub>v (unit_vec dimR i)) = 
     (P * B * (Complex_Matrix.adjoint P)) *\<^sub>v (P *\<^sub>v (unit_vec dimR i))"
     using assms unfolding similar_mat_wit_def by metis
   also have "... = P * B * (Complex_Matrix.adjoint P) * P *\<^sub>v (unit_vec dimR i)" 
   proof (rule mat_vec_mult_assoc[of _ dimR dimR], (auto simp add: assms fc_mats_carrier))
     show "P \<in> carrier_mat dimR dimR" using assms fc_mats_carrier dim_eq by simp
     show "P * B * Complex_Matrix.adjoint P \<in> carrier_mat dimR dimR" 
         using assms fc_mats_carrier by auto
   qed
   also have "... = P * B * ((Complex_Matrix.adjoint P) * P) *\<^sub>v (unit_vec dimR i)" using assms dim_eq
     by (smt fc_mats_carrier mat_assoc_test(1) similar_mat_witD2(6) similar_mat_wit_sym)  
   also have "... = P * B *\<^sub>v (unit_vec dimR i)"
   proof -
     have "(Complex_Matrix.adjoint P) * P = 1\<^sub>m dimR" using assms dim_eq unfolding similar_mat_wit_def
       by (simp add: fc_mats_carrier)
     thus ?thesis using assms(2) local.fc_mats_carrier dim_eq by auto 
   qed
   also have "... = P *\<^sub>v (B *\<^sub>v (unit_vec dimR i))" using mat_vec_mult_assoc assms fc_mats_carrier 
       dim_eq by simp
   also have "... = P *\<^sub>v (B $$ (i,i) \<cdot>\<^sub>v (unit_vec dimR i))" using assms diagonal_unit_vec 
       fc_mats_carrier dim_eq by simp
   also have "... = B $$ (i,i) \<cdot>\<^sub>v (P *\<^sub>v (unit_vec dimR i))" 
   proof (rule mult_mat_vec)
     show "P \<in> carrier_mat dimR dimC" using assms fc_mats_carrier by simp
     show "unit_vec dimR i \<in> carrier_vec dimC" using dim_eq by simp
   qed
   finally show ?thesis .
 qed
 
 
 subsection \<open>Projectors\<close>
 
 definition projector where
 "projector M \<longleftrightarrow> (hermitian M \<and> M * M = M)"
 
 lemma projector_hermitian:
   assumes "projector M"
   shows "hermitian M" using assms unfolding projector_def by simp
 
 lemma zero_projector[simp]:
   shows "projector (0\<^sub>m n n)" unfolding projector_def
 proof
   show "hermitian (0\<^sub>m n n)" using zero_hermitian[of n] by simp
   show "0\<^sub>m n n * 0\<^sub>m n n = 0\<^sub>m n n" by simp
 qed
 
 lemma projector_square_eq:
   assumes "projector M"
   shows "M * M = M" using assms unfolding projector_def by simp
 
 lemma projector_positive:
   assumes "projector M"
   shows "Complex_Matrix.positive M"
 proof (rule positive_if_decomp)
   show "M \<in> carrier_mat (dim_row M) (dim_row M)" using assms projector_hermitian hermitian_square 
     by auto
 next
   have "M = Complex_Matrix.adjoint M" using assms projector_hermitian[of M] 
     unfolding hermitian_def by simp
   hence "M * Complex_Matrix.adjoint M = M * M" by simp
   also have "... = M" using assms projector_square_eq by auto
   finally have "M * Complex_Matrix.adjoint M = M" .
   thus "\<exists>Ma. Ma * Complex_Matrix.adjoint Ma = M" by auto
 qed
 
 lemma projector_collapse_trace:
   assumes "projector (P::complex Matrix.mat)"
   and "P \<in> carrier_mat n n"
   and "R\<in> carrier_mat n n"
 shows "Complex_Matrix.trace (P * R * P) = Complex_Matrix.trace (R * P)"
 proof -
   have "Complex_Matrix.trace (R * P) = Complex_Matrix.trace (P * R)" using trace_comm assms  by auto
   also have "... = Complex_Matrix.trace ((P * P) * R)" using assms projector_square_eq[of P] by simp
   also have "... = Complex_Matrix.trace (P * (P * R))" using assms by auto
   also have "... = Complex_Matrix.trace (P * R * P)" using trace_comm[of P n "P * R"] assms by auto
   finally have "Complex_Matrix.trace (R * P) = Complex_Matrix.trace (P * R * P)" .
   thus ?thesis by simp
 qed
 
 lemma positive_proj_trace:
   assumes "projector (P::complex Matrix.mat)"
   and "Complex_Matrix.positive R"
   and "P \<in> carrier_mat n n"
   and "R\<in> carrier_mat n n"
 shows "Complex_Matrix.trace (R * P) \<ge> 0" 
 proof -
   have "Complex_Matrix.trace (R * P) = Complex_Matrix.trace ((P * R) * P)" 
     using  assms projector_collapse_trace by auto
   also have "... = Complex_Matrix.trace ((P * R) * (Complex_Matrix.adjoint P))" 
     using assms projector_hermitian[of P]
     unfolding hermitian_def by simp
   also have "... \<ge> 0"
   proof (rule positive_trace)
     show " P * R * Complex_Matrix.adjoint P \<in> carrier_mat n n" using assms by auto
     show "Complex_Matrix.positive (P * R * Complex_Matrix.adjoint P)" 
       by (rule positive_close_under_left_right_mult_adjoint[of _ n], (auto simp add: assms))
   qed
   finally show ?thesis .
 qed
 
 lemma trace_proj_pos_real:
   assumes "projector (P::complex Matrix.mat)"
   and "Complex_Matrix.positive R"
   and "P \<in> carrier_mat n n"
   and "R\<in> carrier_mat n n"
 shows "Re (Complex_Matrix.trace (R * P)) = Complex_Matrix.trace (R * P)" 
 proof -
   have "Complex_Matrix.trace (R * P) \<ge> 0" using assms  positive_proj_trace by simp
-  thus ?thesis by (simp add: complex_eqI) 
+  thus ?thesis by (simp add: complex_eqI less_eq_complex_def)
 qed
 
 lemma (in cpx_sq_mat) trace_sum_mat_proj_pos_real:
   fixes f::"'a \<Rightarrow> real"
   assumes "finite I"
   and "\<forall> i\<in> I. projector (P i)"
   and "Complex_Matrix.positive R"
   and "\<forall>i\<in> I. P i \<in> fc_mats"
   and "R \<in> fc_mats"
 shows "Complex_Matrix.trace (R * (sum_mat (\<lambda>i. f i \<cdot>\<^sub>m (P i)) I)) = 
   Re (Complex_Matrix.trace (R * (sum_mat (\<lambda>i. f i \<cdot>\<^sub>m (P i)) I)))"
 proof -
   have sm:  "\<And>x. x \<in> I \<Longrightarrow> Complex_Matrix.trace (f x \<cdot>\<^sub>m (R * P x)) = 
     f x * Complex_Matrix.trace (R * P x)"
   proof -
     fix i
     assume "i\<in> I"
     show "Complex_Matrix.trace (f i \<cdot>\<^sub>m (R * P i)) = f i * Complex_Matrix.trace (R * P i)" 
     proof (rule trace_smult)
       show "R * P i \<in> carrier_mat dimR dimR" using assms cpx_sq_mat_mult fc_mats_carrier \<open>i\<in> I\<close> 
           dim_eq by simp
     qed
   qed
   have sw: "\<And>x. x \<in> I \<Longrightarrow> R * (f x \<cdot>\<^sub>m P x) = f x \<cdot>\<^sub>m (R * P x)" 
   proof -
     fix i
     assume "i \<in> I"
     show "R * (f i \<cdot>\<^sub>m P i) = f i \<cdot>\<^sub>m (R * P i)"
     proof (rule mult_smult_distrib)
       show "R\<in> carrier_mat dimR dimR" using assms fc_mats_carrier dim_eq by simp
       show "P i \<in> carrier_mat dimR dimR" using assms \<open>i\<in> I\<close> fc_mats_carrier dim_eq by simp
     qed
   qed
   have dr: "Complex_Matrix.trace (R * (sum_mat (\<lambda>i. f i \<cdot>\<^sub>m (P i)) I)) = 
     Complex_Matrix.trace (sum_mat (\<lambda>i. (R * (f i \<cdot>\<^sub>m (P i)))) I)"
     using sum_mat_distrib_left[of I] assms by (simp add: cpx_sq_mat_smult)
   also have trs: "... = (\<Sum> i\<in> I. Complex_Matrix.trace (R * (f i \<cdot>\<^sub>m (P i))))" 
   proof (rule trace_sum_mat, (simp add: assms))
     show "\<And>i. i \<in> I \<Longrightarrow> R * (f i \<cdot>\<^sub>m P i) \<in> fc_mats" using assms 
       by (simp add: cpx_sq_mat_smult cpx_sq_mat_mult)
   qed
   also have "... = (\<Sum> i\<in> I. Complex_Matrix.trace (f i \<cdot>\<^sub>m (R * (P i))))" 
     by (rule sum.cong, (simp add: sw)+)    
   also have "... = (\<Sum> i\<in> I. f i * Complex_Matrix.trace (R * (P i)))" 
     by (rule sum.cong, (simp add: sm)+)
   also have "... = (\<Sum> i\<in> I. complex_of_real (f i * Re (Complex_Matrix.trace (R * (P i)))))" 
   proof (rule sum.cong, simp)
     show "\<And>x. x \<in> I \<Longrightarrow>
          complex_of_real (f x) * Complex_Matrix.trace (R * P x) =
          complex_of_real (f x * Re (Complex_Matrix.trace (R * P x)))"
     proof -
       fix x
       assume "x\<in> I"
       have "complex_of_real (f x) * Complex_Matrix.trace (R * P x) = 
         complex_of_real (f x) * complex_of_real (Re (Complex_Matrix.trace (R * P x)))"
         using assms sum.cong[of I I] fc_mats_carrier trace_proj_pos_real \<open>x \<in> I\<close> dim_eq by auto
       also have "... = complex_of_real (f x * Re (Complex_Matrix.trace (R * P x)))" by simp
       finally show "complex_of_real (f x) * Complex_Matrix.trace (R * P x) =
          complex_of_real (f x * Re (Complex_Matrix.trace (R * P x)))" .
     qed
   qed
   also have "... = (\<Sum> i\<in> I. f i * Re (Complex_Matrix.trace (R * (P i))))" by simp
   also have "... = (\<Sum> i\<in> I. Re (Complex_Matrix.trace (f i \<cdot>\<^sub>m (R * (P i)))))" 
   proof -
     have "(\<Sum> i\<in> I. f i * Re (Complex_Matrix.trace (R * (P i)))) = 
       (\<Sum> i\<in> I. Re (Complex_Matrix.trace (f i \<cdot>\<^sub>m (R * (P i)))))"
       by (rule sum.cong, (simp add: sm)+)
     thus ?thesis by simp
   qed
   also have "... = (\<Sum> i\<in> I. Re (Complex_Matrix.trace (R * (f i \<cdot>\<^sub>m (P i)))))"
   proof -
     have "\<And>i. i \<in> I \<Longrightarrow> f i \<cdot>\<^sub>m (R * (P i)) = R * (f i \<cdot>\<^sub>m (P i))" using sw by simp
     thus ?thesis by simp
   qed
   also have "... = Re (\<Sum> i\<in> I. (Complex_Matrix.trace (R * (f i \<cdot>\<^sub>m (P i)))))" by simp
   also have "... = Re (Complex_Matrix.trace (sum_mat (\<lambda>i. R * (f i \<cdot>\<^sub>m (P i))) I))" using trs by simp
   also have "... = Re (Complex_Matrix.trace (R * (sum_mat (\<lambda>i. f i \<cdot>\<^sub>m (P i))) I))" using dr by simp
   finally show ?thesis .
 qed
 
 
 subsection \<open>Rank 1 projection\<close>
 
 definition rank_1_proj where
 "rank_1_proj v = outer_prod v v"
 
 lemma rank_1_proj_square_mat:
   shows "square_mat (rank_1_proj v)" using outer_prod_dim unfolding rank_1_proj_def
   by (metis carrier_matD(1) carrier_matD(2) carrier_vec_dim_vec  square_mat.simps)
 
 lemma rank_1_proj_dim[simp]:
   shows "dim_row (rank_1_proj v) = dim_vec v" using outer_prod_dim unfolding rank_1_proj_def
   using carrier_vecI by blast
 
 lemma rank_1_proj_carrier[simp]:
   shows "rank_1_proj v \<in> carrier_mat (dim_vec v) (dim_vec v)" using outer_prod_dim 
   unfolding rank_1_proj_def using carrier_vecI by blast
 
 lemma rank_1_proj_coord:
   assumes "i < dim_vec v"
   and "j < dim_vec v"
 shows "(rank_1_proj v) $$ (i, j) = Matrix.vec_index v i * (cnj (Matrix.vec_index v j))" using assms 
   unfolding rank_1_proj_def outer_prod_def by auto
 
 lemma rank_1_proj_adjoint:
   shows "Complex_Matrix.adjoint (rank_1_proj (v::complex Matrix.vec)) = rank_1_proj v"
 proof
   show "dim_row (Complex_Matrix.adjoint (rank_1_proj v)) = dim_row (rank_1_proj v)"
     using rank_1_proj_square_mat by auto
   thus "dim_col (Complex_Matrix.adjoint (rank_1_proj v)) = dim_col (rank_1_proj v)" by auto
   fix i j
   assume "i < dim_row (rank_1_proj v)" and "j < dim_col (rank_1_proj v)" note ij = this
   have "Complex_Matrix.adjoint (rank_1_proj v) $$ (i, j) = conjugate ((rank_1_proj v) $$ (j, i))" 
     using ij \<open>dim_col (Complex_Matrix.adjoint (rank_1_proj v)) = dim_col (rank_1_proj v)\<close> 
       adjoint_eval by fastforce
   also have "... = conjugate (Matrix.vec_index v j * (cnj (Matrix.vec_index v i)))" 
     using rank_1_proj_coord ij
     by (metis \<open>dim_col (Complex_Matrix.adjoint (rank_1_proj v)) = dim_col (rank_1_proj v)\<close> 
         adjoint_dim_col rank_1_proj_dim) 
   also have "... = Matrix.vec_index v i * (cnj (Matrix.vec_index v j))" by simp
   also have "... = rank_1_proj v $$ (i, j)" using ij rank_1_proj_coord
     by (metis \<open>dim_col (Complex_Matrix.adjoint (rank_1_proj v)) = dim_col (rank_1_proj v)\<close> 
         adjoint_dim_col rank_1_proj_dim) 
   finally show "Complex_Matrix.adjoint (rank_1_proj v) $$ (i, j) = rank_1_proj v $$ (i, j)".
 qed
 
 lemma rank_1_proj_hermitian:
   shows "hermitian (rank_1_proj (v::complex Matrix.vec))" using rank_1_proj_adjoint 
   unfolding hermitian_def by simp
 
 lemma rank_1_proj_trace:
   assumes "\<parallel>v\<parallel> = 1"
   shows "Complex_Matrix.trace (rank_1_proj v) = 1"
 proof -
   have "Complex_Matrix.trace (rank_1_proj v) = inner_prod v v" using trace_outer_prod 
     unfolding rank_1_proj_def using carrier_vecI by blast
   also have "... = (vec_norm v)\<^sup>2" unfolding vec_norm_def using power2_csqrt by presburger
   also have "... = \<parallel>v\<parallel>\<^sup>2" using vec_norm_sq_cpx_vec_length_sq by simp
   also have "... = 1" using assms by simp
   finally show ?thesis .
 qed
 
 lemma rank_1_proj_mat_col:
   assumes "A \<in> carrier_mat n n"
   and "i < n"
   and "j < n"
   and "k < n"
 shows "(rank_1_proj (Matrix.col A i)) $$ (j, k) = A $$ (j, i) * conjugate (A $$ (k,i))"
 proof -
   have "(rank_1_proj (Matrix.col A i)) $$ (j, k) = Matrix.vec_index (Matrix.col A i) j * 
     conjugate (Matrix.vec_index (Matrix.col A i) k)" using index_outer_prod[of "Matrix.col A i" n "Matrix.col A i" n] 
       assms unfolding rank_1_proj_def by simp
   also have "... = A $$ (j, i) * conjugate (A $$ (k,i))" using assms by simp
   finally show ?thesis .
 qed
 
 lemma (in cpx_sq_mat) weighted_sum_rank_1_proj_unitary_index:
   assumes "A \<in> fc_mats"
 and "B \<in> fc_mats"
 and "diagonal_mat B"
 and "Complex_Matrix.unitary A"
 and "j < dimR"
 and "k < dimR"
 shows "(sum_mat (\<lambda>i. (diag_mat B)!i \<cdot>\<^sub>m rank_1_proj (Matrix.col A i)) {..< dimR}) $$ (j,k) = 
   (A * B * (Complex_Matrix.adjoint A)) $$ (j,k)"
 proof -
   have "(sum_mat (\<lambda>i. (diag_mat B)!i \<cdot>\<^sub>m rank_1_proj (Matrix.col A i)) {..< dimR}) $$ (j,k) = 
     (\<Sum> i\<in> {..< dimR}. ((diag_mat B)!i \<cdot>\<^sub>m rank_1_proj (Matrix.col A i)) $$ (j,k))" 
   proof (rule sum_mat_index, (auto simp add: fc_mats_carrier assms))
     show "\<And>i. i < dimR \<Longrightarrow> (diag_mat B)!i \<cdot>\<^sub>m rank_1_proj (Matrix.col A i) \<in> carrier_mat dimR dimC" 
       using rank_1_proj_carrier assms fc_mats_carrier dim_eq 
       by (metis smult_carrier_mat zero_col_col zero_col_dim) 
     show "k < dimC" using assms dim_eq by simp
   qed
   also have "... = (\<Sum> i\<in> {..< dimR}. (diag_mat B)!i* A $$ (j, i) * conjugate (A $$ (k,i)))" 
   proof (rule sum.cong, simp)
     have idx: "\<And>x. x \<in> {..<dimR} \<Longrightarrow> (rank_1_proj (Matrix.col A x)) $$ (j, k) = 
       A $$ (j, x) * conjugate (A $$ (k, x))" using rank_1_proj_mat_col assms fc_mats_carrier dim_eq 
       by blast
     show "\<And>x. x \<in> {..<dimR} \<Longrightarrow> ((diag_mat B)!x \<cdot>\<^sub>m rank_1_proj (Matrix.col A x)) $$ (j, k) = 
       (diag_mat B)!x * A $$ (j, x) * conjugate (A $$ (k, x))" 
     proof -
       fix x
       assume "x\<in> {..< dimR}"
       have "((diag_mat B)!x \<cdot>\<^sub>m rank_1_proj (Matrix.col A x)) $$ (j, k) = 
         (diag_mat B)!x * (rank_1_proj (Matrix.col A x)) $$ (j, k)" 
       proof (rule index_smult_mat)
         show "j < dim_row (rank_1_proj (Matrix.col A x))" using \<open>x\<in> {..< dimR}\<close> assms fc_mats_carrier by simp
         show "k < dim_col (rank_1_proj (Matrix.col A x))" using \<open>x\<in> {..< dimR}\<close> assms fc_mats_carrier 
             rank_1_proj_carrier[of "Matrix.col A x"] by simp
       qed
       thus "((diag_mat B)!x \<cdot>\<^sub>m rank_1_proj (Matrix.col A x)) $$ (j, k) = 
         (diag_mat B)!x * A $$ (j, x) * conjugate (A $$ (k, x))" using idx \<open>x\<in> {..< dimR}\<close> by simp
     qed
   qed
   also have "... = Matrix.scalar_prod (Matrix.col (Complex_Matrix.adjoint A) k) (Matrix.row (A*B) j) " 
     unfolding Matrix.scalar_prod_def
   proof (rule sum.cong)
     show "{..<dimR} = {0..<dim_vec (Matrix.row (A*B) j)}" 
       using assms fc_mats_carrier dim_eq by auto
     show "\<And>x. x \<in> {0..<dim_vec (Matrix.row (A*B) j)} \<Longrightarrow>
       diag_mat B ! x * A $$ (j, x) * conjugate (A $$ (k, x)) = 
       Matrix.vec_index ((Matrix.col (Complex_Matrix.adjoint A) k)) x * 
       Matrix.vec_index (Matrix.row (A*B) j) x" 
     proof -
       fix x
       assume "x\<in> {0..<dim_vec (Matrix.row (A*B) j)}"
       hence "x\<in> {0..<dimR}" using assms fc_mats_carrier dim_eq by simp
       have "diag_mat B ! x *A $$ (j, x) = Matrix.vec_index (Matrix.row (A*B) j) x"
       proof (rule times_diag_index[symmetric, of _ dimR], (auto simp add: assms))
         show "A \<in> carrier_mat dimR dimR" using assms fc_mats_carrier dim_eq by simp
         show "B \<in> carrier_mat dimR dimR" using assms fc_mats_carrier dim_eq by simp
         show "x < dimR" using \<open>x\<in>{0..< dimR}\<close> by simp
       qed
       moreover have "conjugate (A $$ (k, x)) = 
         Matrix.vec_index ((Matrix.col (Complex_Matrix.adjoint A) k)) x" using \<open>x\<in> {0..<dimR}\<close> assms 
         fc_mats_carrier dim_eq by (simp add: adjoint_col)
       ultimately show "diag_mat B ! x * A $$ (j, x) * conjugate (A $$ (k, x)) = 
         Matrix.vec_index ((Matrix.col (Complex_Matrix.adjoint A) k)) x * 
         Matrix.vec_index (Matrix.row (A*B) j) x"  by simp
     qed
   qed
   also have "... = (A*B * (Complex_Matrix.adjoint A)) $$ (j,k)" 
   proof -
     have "Matrix.mat (dim_row (A*B)) (dim_col (Complex_Matrix.adjoint A))
      (\<lambda>(i, j). Matrix.scalar_prod (Matrix.row (A*B) i) (Matrix.col (Complex_Matrix.adjoint A) j)) $$
     (j, k) =  Matrix.scalar_prod (Matrix.row (A*B) j) (Matrix.col (Complex_Matrix.adjoint A) k)"
       using assms fc_mats_carrier by simp
     also have "... = Matrix.scalar_prod (Matrix.col (Complex_Matrix.adjoint A) k) (Matrix.row (A*B) j)" 
       using assms comm_scalar_prod[of "Matrix.row (A*B) j" dimR] fc_mats_carrier dim_eq
       by (metis adjoint_dim Matrix.col_carrier_vec row_carrier_vec cpx_sq_mat_mult) 
     thus ?thesis using assms fc_mats_carrier unfolding times_mat_def by simp
   qed  
   finally show ?thesis .
 qed
 
 lemma (in cpx_sq_mat) weighted_sum_rank_1_proj_unitary:
   assumes "A \<in> fc_mats"
 and "B \<in> fc_mats"
 and "diagonal_mat B"
 and "Complex_Matrix.unitary A"
 shows "(sum_mat (\<lambda>i. (diag_mat B)!i \<cdot>\<^sub>m rank_1_proj (Matrix.col A i)) {..< dimR}) = 
   (A * B * (Complex_Matrix.adjoint A))"
 proof
   show "dim_row (sum_mat (\<lambda>i. diag_mat B ! i \<cdot>\<^sub>m rank_1_proj (Matrix.col A i)) {..<dimR}) =
     dim_row (A * B * Complex_Matrix.adjoint A)" using assms fc_mats_carrier dim_eq
     by (metis (no_types, lifting) carrier_matD(1) cpx_sq_mat_smult dim_col index_mult_mat(2) 
         rank_1_proj_carrier sum_mat_carrier)
   show "dim_col (local.sum_mat (\<lambda>i. diag_mat B ! i \<cdot>\<^sub>m rank_1_proj (Matrix.col A i)) {..<dimR}) =
     dim_col (A * B * Complex_Matrix.adjoint A)" using assms fc_mats_carrier dim_eq
     by (metis (mono_tags, lifting) adjoint_dim_col carrier_matD(1) carrier_matI dim_col 
         index_mult_mat(3) index_smult_mat(2) index_smult_mat(3) rank_1_proj_dim 
         rank_1_proj_square_mat square_mat.elims(2) square_mats sum_mat_carrier)
   show "\<And>i j. i < dim_row (A * B * Complex_Matrix.adjoint A) \<Longrightarrow>
            j < dim_col (A * B * Complex_Matrix.adjoint A) \<Longrightarrow>
            local.sum_mat (\<lambda>i. diag_mat B ! i \<cdot>\<^sub>m rank_1_proj (Matrix.col A i)) {..<dimR} $$ (i, j) =
            (A * B * Complex_Matrix.adjoint A) $$ (i, j)" 
     using weighted_sum_rank_1_proj_unitary_index[of A B] dim_eq fc_mats_carrier using assms by auto
 qed
 
 lemma rank_1_proj_projector:
   assumes "\<parallel>v\<parallel> = 1"
   shows "projector (rank_1_proj v)" 
 proof -
   have  "Complex_Matrix.adjoint (rank_1_proj v) = rank_1_proj v" using rank_1_proj_adjoint by simp
   hence a: "hermitian (rank_1_proj v)" unfolding hermitian_def by simp
   have "rank_1_proj v * rank_1_proj v = inner_prod v v  \<cdot>\<^sub>m outer_prod v v" unfolding rank_1_proj_def 
     using outer_prod_mult_outer_prod assms using carrier_vec_dim_vec by blast
   also have "... = (vec_norm v)\<^sup>2  \<cdot>\<^sub>m outer_prod v v" unfolding vec_norm_def using power2_csqrt 
     by presburger
   also have "... =  (cpx_vec_length v)\<^sup>2 \<cdot>\<^sub>m outer_prod v v " using vec_norm_sq_cpx_vec_length_sq
     by simp
   also have "... = outer_prod v v" using assms state_qbit_norm_sq smult_one[of "outer_prod v v"]
     by simp
   also have "... = rank_1_proj v" unfolding rank_1_proj_def by simp
   finally show ?thesis using a unfolding projector_def by simp
 qed
 
 lemma rank_1_proj_positive:
   assumes "\<parallel>v\<parallel> = 1"
   shows "Complex_Matrix.positive (rank_1_proj v)"
 proof -
   have "projector (rank_1_proj v)" using assms rank_1_proj_projector by simp
   thus ?thesis using projector_positive by simp
 qed
 
 lemma rank_1_proj_density:
   assumes "\<parallel>v\<parallel> = 1"
   shows "density_operator (rank_1_proj v)" unfolding density_operator_def using assms
   by (simp add: rank_1_proj_positive rank_1_proj_trace)
 
 lemma (in cpx_sq_mat) sum_rank_1_proj_unitary_index:
   assumes "A \<in> fc_mats"
 and "Complex_Matrix.unitary A"
 and "j < dimR"
 and "k < dimR"
 shows "(sum_mat (\<lambda>i. rank_1_proj (Matrix.col A i)) {..< dimR}) $$ (j,k) = (1\<^sub>m dimR) $$ (j,k)"
 proof -
   have "(sum_mat (\<lambda>i. rank_1_proj (Matrix.col A i)) {..< dimR}) $$ (j,k) = 
     (\<Sum> i\<in> {..< dimR}. (rank_1_proj (Matrix.col A i)) $$ (j,k))" 
   proof (rule sum_mat_index, (auto simp add: fc_mats_carrier assms))
     show "\<And>i. i < dimR \<Longrightarrow> rank_1_proj (Matrix.col A i) \<in> carrier_mat dimR dimC" 
     proof -
       fix i
       assume "i < dimR"
       hence "dim_vec (Matrix.col A i) = dimR" using assms fc_mats_carrier by simp
       thus "rank_1_proj (Matrix.col A i) \<in> carrier_mat dimR dimC" using rank_1_proj_carrier assms
         fc_mats_carrier dim_eq fc_mats_carrier by (metis dim_col fc_mats_carrier) 
     qed
     show "k < dimC" using assms dim_eq by simp
   qed
   also have "... = (\<Sum> i\<in> {..< dimR}. A $$ (j, i) * conjugate (A $$ (k,i)))" 
   proof (rule sum.cong, simp)
     show "\<And>x. x \<in> {..<dimR} \<Longrightarrow> rank_1_proj (Matrix.col A x) $$ (j, k) = 
       A $$ (j, x) * conjugate (A $$ (k, x))" 
       using rank_1_proj_mat_col assms using local.fc_mats_carrier dim_eq by blast 
   qed
   also have "... = Matrix.scalar_prod (Matrix.col (Complex_Matrix.adjoint A) k) (Matrix.row A j) " 
     unfolding Matrix.scalar_prod_def
   proof (rule sum.cong)
     show "{..<dimR} = {0..<dim_vec (Matrix.row A j)}" 
       using assms fc_mats_carrier dim_eq by auto
     show "\<And>x. x \<in> {0..<dim_vec (Matrix.row A j)} \<Longrightarrow>
       A $$ (j, x) * conjugate (A $$ (k, x)) = 
       Matrix.vec_index ((Matrix.col (Complex_Matrix.adjoint A) k)) x * Matrix.vec_index (Matrix.row A j) x" 
     proof -
       fix x
       assume "x\<in> {0..<dim_vec (Matrix.row A j)}"
       hence "x\<in> {0..<dimR}" using assms fc_mats_carrier dim_eq by simp
       hence "A $$ (j, x) = Matrix.vec_index (Matrix.row A j) x" using \<open>x\<in> {0..<dimR}\<close> 
           assms fc_mats_carrier dim_eq by simp
       moreover have "conjugate (A $$ (k, x)) = 
         Matrix.vec_index ((Matrix.col (Complex_Matrix.adjoint A) k)) x" using \<open>x\<in> {0..<dimR}\<close> 
         assms fc_mats_carrier dim_eq by (simp add: adjoint_col)
       ultimately show "A $$ (j, x) * conjugate (A $$ (k, x)) = 
         Matrix.vec_index ((Matrix.col (Complex_Matrix.adjoint A) k)) x * 
         Matrix.vec_index (Matrix.row A j) x" by simp
     qed
   qed
   also have "... = (A * (Complex_Matrix.adjoint A)) $$ (j,k)" 
   proof -
     have "Matrix.mat (dim_row A) (dim_col (Complex_Matrix.adjoint A))
      (\<lambda>(i, j). Matrix.scalar_prod (Matrix.row A i) (Matrix.col (Complex_Matrix.adjoint A) j)) $$
     (j, k) =  Matrix.scalar_prod (Matrix.row A j) (Matrix.col (Complex_Matrix.adjoint A) k)"
       using assms fc_mats_carrier by simp
     also have "... = Matrix.scalar_prod (Matrix.col (Complex_Matrix.adjoint A) k) (Matrix.row A j)" 
       using assms comm_scalar_prod[of "Matrix.row A j" dimR] fc_mats_carrier
       by (simp add: adjoint_dim dim_eq)
     thus ?thesis using assms fc_mats_carrier unfolding times_mat_def by simp
   qed
   also have "... = (1\<^sub>m dimR) $$ (j,k)" using assms dim_eq by (simp add: fc_mats_carrier)
   finally show ?thesis .
 qed
 
 lemma (in cpx_sq_mat) rank_1_proj_sum_density:
   assumes "finite I"
   and "\<forall>i\<in> I. \<parallel>u i\<parallel> = 1" 
   and "\<forall>i\<in> I. dim_vec (u i) = dimR"
   and "\<forall>i\<in> I. 0 \<le> p i"
   and "(\<Sum>i\<in> I. p i) = 1"
 shows "density_operator (sum_mat (\<lambda>i. p i \<cdot>\<^sub>m (rank_1_proj (u i))) I)" unfolding density_operator_def
 proof
   have "Complex_Matrix.trace (sum_mat (\<lambda>i. p i \<cdot>\<^sub>m rank_1_proj (u i)) I) = 
     (\<Sum>i\<in> I. Complex_Matrix.trace (p i \<cdot>\<^sub>m rank_1_proj (u i)))" 
   proof (rule trace_sum_mat, (simp add: assms))
     show "\<And>i. i \<in> I \<Longrightarrow> p i \<cdot>\<^sub>m rank_1_proj (u i) \<in> fc_mats" using assms smult_mem fc_mats_carrier 
         dim_eq by auto
   qed
   also have "... = (\<Sum>i\<in> I. p i * Complex_Matrix.trace (rank_1_proj (u i)))" 
   proof -
     {
       fix i
       assume "i \<in> I"
       hence "Complex_Matrix.trace (p i \<cdot>\<^sub>m rank_1_proj (u i)) = 
         p i * Complex_Matrix.trace (rank_1_proj (u i))"
         using trace_smult[of "rank_1_proj (u i)" dimR] assms fc_mats_carrier dim_eq by auto
     }
     thus ?thesis by simp
   qed
   also have "... = 1" using assms rank_1_proj_trace assms by auto
   finally show "Complex_Matrix.trace (sum_mat (\<lambda>i. p i \<cdot>\<^sub>m rank_1_proj (u i)) I) = 1" .
 next
   show "Complex_Matrix.positive (sum_mat (\<lambda>i. p i \<cdot>\<^sub>m rank_1_proj (u i)) I)"
   proof (rule sum_mat_positive, (simp add: assms))
     fix i
     assume "i\<in> I"
     thus "p i \<cdot>\<^sub>m rank_1_proj (u i) \<in> fc_mats" using assms smult_mem fc_mats_carrier dim_eq by auto
     show "Complex_Matrix.positive (p i \<cdot>\<^sub>m rank_1_proj (u i))" using assms \<open>i\<in> I\<close> 
         rank_1_proj_positive positive_smult[of "rank_1_proj (u i)" dimR] dim_eq by auto
   qed
 qed
 
 
 
 lemma (in cpx_sq_mat) sum_rank_1_proj_unitary:
   assumes "A \<in> fc_mats"
 and "Complex_Matrix.unitary A"
 shows "(sum_mat (\<lambda>i. rank_1_proj (Matrix.col A i)) {..< dimR})= (1\<^sub>m dimR)"
 proof
   show "dim_row (sum_mat (\<lambda>i. rank_1_proj (Matrix.col A i)) {..<dimR}) = dim_row (1\<^sub>m dimR)" 
     using assms fc_mats_carrier
     by (metis carrier_matD(1) dim_col dim_eq index_one_mat(2) rank_1_proj_carrier sum_mat_carrier)
   show "dim_col (sum_mat (\<lambda>i. rank_1_proj (Matrix.col A i)) {..<dimR}) = dim_col (1\<^sub>m dimR)" 
     using assms fc_mats_carrier rank_1_proj_carrier sum_mat_carrier
     by (metis carrier_matD(2) dim_col dim_eq index_one_mat(3) square_mat.simps square_mats)
   show "\<And>i j. i < dim_row (1\<^sub>m dimR) \<Longrightarrow>
      j < dim_col (1\<^sub>m dimR) \<Longrightarrow> sum_mat (\<lambda>i. rank_1_proj (Matrix.col A i)) {..<dimR} $$ (i, j) = 
       1\<^sub>m dimR $$ (i, j)"
     using assms sum_rank_1_proj_unitary_index by simp
 qed
 
 lemma (in cpx_sq_mat) rank_1_proj_unitary:
   assumes "A \<in> fc_mats"
 and "Complex_Matrix.unitary A"
 and "j < dimR"
 and "k < dimR"
 shows "rank_1_proj (Matrix.col A j) * (rank_1_proj (Matrix.col A k)) =
   (1\<^sub>m dimR) $$ (j,k) \<cdot>\<^sub>m (outer_prod (Matrix.col A j) (Matrix.col A k))"
 proof -
   have "rank_1_proj (Matrix.col A j) * (rank_1_proj (Matrix.col A k)) = 
     Complex_Matrix.inner_prod (Matrix.col A j) (Matrix.col A k) \<cdot>\<^sub>m outer_prod (Matrix.col A j) (Matrix.col A k)"
     using outer_prod_mult_outer_prod assms Matrix.col_dim local.fc_mats_carrier unfolding rank_1_proj_def
     by blast
   also have "... = (Complex_Matrix.adjoint A * A) $$ (j, k)\<cdot>\<^sub>m (outer_prod (Matrix.col A j) (Matrix.col A k))" 
     using inner_prod_adjoint_comp[of A dimR A] assms fc_mats_carrier dim_eq by simp
   also have "... = (1\<^sub>m dimR) $$ (j,k) \<cdot>\<^sub>m (outer_prod (Matrix.col A j) (Matrix.col A k))" using assms 
     unfolding Complex_Matrix.unitary_def
     by (metis add_commute assms(2) index_add_mat(2) index_one_mat(2) one_mem unitary_simps(1))
   finally show ?thesis .
 qed
 
 lemma (in cpx_sq_mat) rank_1_proj_unitary_ne:
   assumes "A \<in> fc_mats"
 and "Complex_Matrix.unitary A"
 and "j < dimR"
 and "k < dimR"
 and "j\<noteq> k"
 shows "rank_1_proj (Matrix.col A j) * (rank_1_proj (Matrix.col A k)) =  (0\<^sub>m dimR dimR)"
 proof -
   have "dim_row (0 \<cdot>\<^sub>m outer_prod (Matrix.col A j) (Matrix.col A k)) = dim_row (outer_prod (Matrix.col A j) (Matrix.col A k))"
       by simp
   also have "... = dimR" using assms fc_mats_carrier dim_eq by auto
   finally have rw: "dim_row (0 \<cdot>\<^sub>m outer_prod (Matrix.col A j) (Matrix.col A k)) = dimR" .
   have "dim_col (0 \<cdot>\<^sub>m outer_prod (Matrix.col A j) (Matrix.col A k)) = dim_col (outer_prod (Matrix.col A j) (Matrix.col A k))"
       by simp
     also have "... = dimR" using assms fc_mats_carrier dim_eq by auto
     finally have cl: "dim_col (0 \<cdot>\<^sub>m outer_prod (Matrix.col A j) (Matrix.col A k)) = dimR" .
     have "rank_1_proj (Matrix.col A j) * (rank_1_proj (Matrix.col A k)) = 
       (0::complex) \<cdot>\<^sub>m (outer_prod (Matrix.col A j) (Matrix.col A k))"
       using assms rank_1_proj_unitary by simp
   also have "... = (0\<^sub>m dimR dimR)" 
   proof
     show "dim_row (0 \<cdot>\<^sub>m outer_prod (Matrix.col A j) (Matrix.col A k)) = dim_row (0\<^sub>m dimR dimR)" using rw by simp
   next
     show "dim_col (0 \<cdot>\<^sub>m outer_prod (Matrix.col A j) (Matrix.col A k)) = dim_col (0\<^sub>m dimR dimR)" using cl by simp
   next
     show "\<And>i p. i < dim_row (0\<^sub>m dimR dimR) \<Longrightarrow> p < dim_col (0\<^sub>m dimR dimR) \<Longrightarrow> 
       (0 \<cdot>\<^sub>m outer_prod (Matrix.col A j) (Matrix.col A k)) $$ (i, p) = 0\<^sub>m dimR dimR $$ (i, p)" using rw cl by auto
   qed
   finally show ?thesis .
 qed
 
 lemma (in cpx_sq_mat) rank_1_proj_unitary_eq:
   assumes "A \<in> fc_mats"
 and "Complex_Matrix.unitary A"
 and "j < dimR"
 shows "rank_1_proj (Matrix.col A j) * (rank_1_proj (Matrix.col A j)) =  rank_1_proj (Matrix.col A j)"
 proof -
   have "rank_1_proj (Matrix.col A j) * (rank_1_proj (Matrix.col A j)) = (1::complex) \<cdot>\<^sub>m (rank_1_proj (Matrix.col A j))"
     using assms rank_1_proj_unitary unfolding rank_1_proj_def by simp
   also have "... = (rank_1_proj (Matrix.col A j))" by (simp add: smult_one)  
   finally show ?thesis .
 qed
   
 
 end
\ No newline at end of file
diff --git a/thys/Projective_Measurements/Projective_Measurements.thy b/thys/Projective_Measurements/Projective_Measurements.thy
--- a/thys/Projective_Measurements/Projective_Measurements.thy
+++ b/thys/Projective_Measurements/Projective_Measurements.thy
@@ -1,1670 +1,1670 @@
 (*
 Author: 
   Mnacho Echenim, Université Grenoble Alpes
 *)
 
 theory Projective_Measurements imports 
   Linear_Algebra_Complements
 
 
 begin
   
 
 section \<open>Projective measurements\<close>
 
 text \<open>In this part we define projective measurements, also refered to as von Neumann measurements. 
   The latter are characterized by a set of orthogonal projectors, which are used to compute the 
 probabilities of measure outcomes and to represent the state of the system after the measurement.\<close> 
 
 text \<open>The state of the system (a density operator in this case) after a measurement is represented by 
 the \verb+density_collapse+ function.\<close>
 
 subsection \<open>First definitions\<close>
 
 text \<open>We begin by defining a type synonym for couples of measurement values (reals) and the 
 associated projectors (complex matrices).\<close>
 
 type_synonym measure_outcome = "real \<times> complex Matrix.mat"
 
 text \<open>The corresponding values and projectors are retrieved thanks to \verb+meas_outcome_val+ 
 and \verb+meas_outcome_prj+.\<close>
 
 definition meas_outcome_val::"measure_outcome \<Rightarrow> real" where
 "meas_outcome_val Mi = fst Mi"
 
 definition meas_outcome_prj::"measure_outcome \<Rightarrow> complex Matrix.mat" where
 "meas_outcome_prj Mi = snd Mi"
 
 text \<open>We define a predicate for projective measurements. A projective measurement is characterized 
 by the number $p$ of possible measure outcomes, and a function $M$ mapping outcome $i$ to the 
 corresponding \verb+measure_outcome+.\<close>
 
 definition (in cpx_sq_mat) proj_measurement::"nat \<Rightarrow> (nat \<Rightarrow> measure_outcome) \<Rightarrow> bool" where
   "proj_measurement n M \<longleftrightarrow> 
     (inj_on (\<lambda>i. meas_outcome_val (M i)) {..< n}) \<and> 
     (\<forall>j < n. meas_outcome_prj (M j) \<in> fc_mats \<and> 
     projector (meas_outcome_prj (M j))) \<and> 
     (\<forall> i < n. \<forall> j < n. i \<noteq> j \<longrightarrow> 
       meas_outcome_prj (M i) * meas_outcome_prj (M j) = 0\<^sub>m dimR dimR) \<and>
     sum_mat (\<lambda>j. meas_outcome_prj (M j)) {..< n} = 1\<^sub>m dimR"
 
 lemma (in cpx_sq_mat) proj_measurement_inj:
   assumes "proj_measurement p M"
   shows "inj_on (\<lambda>i. meas_outcome_val (M i)) {..< p}" using assms 
   unfolding proj_measurement_def by simp
 
 lemma (in cpx_sq_mat) proj_measurement_carrier:
   assumes "proj_measurement p M"
   and "i < p"
   shows "meas_outcome_prj (M i) \<in> fc_mats" using assms 
   unfolding proj_measurement_def by simp
 
 lemma (in cpx_sq_mat) proj_measurement_ortho:
   assumes "proj_measurement p M"
 and "i < p"
 and "j < p"
 and "i\<noteq> j"
 shows "meas_outcome_prj (M i) * meas_outcome_prj (M j) = 0\<^sub>m dimR dimR" using assms 
   unfolding proj_measurement_def by simp
 
 lemma (in cpx_sq_mat) proj_measurement_id:
   assumes "proj_measurement p M"
   shows "sum_mat (\<lambda>j. meas_outcome_prj (M j)) {..< p} = 1\<^sub>m dimR" using assms
   unfolding proj_measurement_def by simp
 
 lemma (in cpx_sq_mat) proj_measurement_square:
   assumes "proj_measurement p M"
 and "i < p"
 shows "meas_outcome_prj (M i) \<in> fc_mats" using assms unfolding proj_measurement_def by simp
 
 lemma (in cpx_sq_mat) proj_measurement_proj:
   assumes "proj_measurement p M"
 and "i < p"
 shows "projector (meas_outcome_prj (M i))" using assms unfolding proj_measurement_def by simp
 
 text \<open>We define the probability of obtaining a measurement outcome: this is a positive number and
 the sum over all the measurement outcomes is 1.\<close>
 
 definition (in cpx_sq_mat) meas_outcome_prob :: "complex Matrix.mat \<Rightarrow> 
   (nat \<Rightarrow> real \<times> complex Matrix.mat) \<Rightarrow> nat \<Rightarrow> complex" where
 "meas_outcome_prob R M i = Complex_Matrix.trace (R* (meas_outcome_prj (M i)))"
 
 lemma (in cpx_sq_mat) meas_outcome_prob_real:
 assumes "R\<in> fc_mats"
   and "density_operator R"
   and "proj_measurement n M"
   and "i < n"
 shows "meas_outcome_prob R M i \<in> \<real>" 
 proof -
   have "complex_of_real (Re (Complex_Matrix.trace (R * meas_outcome_prj (M i)))) = 
     Complex_Matrix.trace (R * meas_outcome_prj (M i))" 
   proof (rule trace_proj_pos_real)
     show "R \<in> carrier_mat dimR dimR" using assms fc_mats_carrier dim_eq by simp
     show "Complex_Matrix.positive R" using assms unfolding density_operator_def by simp
     show "projector (meas_outcome_prj (M i))" using assms proj_measurement_proj by simp
     show "meas_outcome_prj (M i) \<in> carrier_mat dimR dimR" using assms proj_measurement_carrier
         fc_mats_carrier dim_eq by simp
   qed
   thus ?thesis unfolding meas_outcome_prob_def by (metis Reals_of_real)
 qed
 
 lemma (in cpx_sq_mat) meas_outcome_prob_pos:
   assumes "R\<in> fc_mats"
   and "density_operator R"
   and "proj_measurement n M"
   and "i < n"
 shows "0 \<le> meas_outcome_prob R M i" unfolding meas_outcome_prob_def
 proof (rule positive_proj_trace)
   show "R \<in> carrier_mat dimR dimR" using assms fc_mats_carrier dim_eq by simp
   show "Complex_Matrix.positive R" using assms unfolding density_operator_def by simp
   show "projector (meas_outcome_prj (M i))" using assms proj_measurement_proj by simp
   show "meas_outcome_prj (M i) \<in> carrier_mat dimR dimR" using assms proj_measurement_carrier
       fc_mats_carrier dim_eq by simp
 qed
 
 lemma (in cpx_sq_mat) meas_outcome_prob_sum:
   assumes "density_operator R"
   and "R\<in> fc_mats"
   and" proj_measurement n M"
 shows "(\<Sum> j \<in> {..< n}. meas_outcome_prob R M j) = 1"  
 proof -
   have "(\<Sum> j \<in> {..< n}. Complex_Matrix.trace (R* (meas_outcome_prj (M j)))) = 
     Complex_Matrix.trace (sum_mat (\<lambda>j. R* (meas_outcome_prj (M j))) {..< n})" 
   proof (rule trace_sum_mat[symmetric], auto)
     fix j
     assume "j < n"
     thus "R * meas_outcome_prj (M j) \<in> fc_mats" using cpx_sq_mat_mult assms 
       unfolding proj_measurement_def by simp
   qed
   also have "... = Complex_Matrix.trace (R * (sum_mat (\<lambda>j. (meas_outcome_prj (M j))) {..< n}))" 
   proof -
     have "sum_mat (\<lambda>j. R* (meas_outcome_prj (M j))) {..< n} = 
       R * (sum_mat (\<lambda>j. (meas_outcome_prj (M j))) {..< n})"
     proof (rule mult_sum_mat_distrib_left, (auto simp add: assms))
       fix j
       assume "j < n"
       thus "meas_outcome_prj (M j) \<in> fc_mats" using assms unfolding proj_measurement_def by simp
     qed
     thus ?thesis by simp
   qed
   also have "... = Complex_Matrix.trace (R * 1\<^sub>m dimR)" using assms unfolding proj_measurement_def 
     by simp
   also have "... = Complex_Matrix.trace R" using assms by (simp add: fc_mats_carrier dim_eq)
   also have "... = 1" using assms unfolding density_operator_def by simp
   finally show ?thesis unfolding meas_outcome_prob_def .
 qed
 
 text \<open>We introduce the maximally mixed density operator. Intuitively, this density operator 
 corresponds to a uniform distribution of the states of an orthonormal basis.
 This operator will be used to define the density operator after a measurement for the measure 
 outcome probabilities equal to zero.\<close>
 
 definition max_mix_density :: "nat \<Rightarrow> complex Matrix.mat" where
 "max_mix_density n = ((1::real)/ n)  \<cdot>\<^sub>m (1\<^sub>m n)"
 
 lemma max_mix_density_carrier:
   shows "max_mix_density n \<in> carrier_mat n n" unfolding max_mix_density_def by simp
 
 lemma max_mix_is_density: 
   assumes "0 < n"
   shows "density_operator (max_mix_density n)" unfolding density_operator_def max_mix_density_def
 proof
   have "Complex_Matrix.trace (complex_of_real ((1::real)/n) \<cdot>\<^sub>m 1\<^sub>m n) = 
     (complex_of_real ((1::real)/n)) *  (Complex_Matrix.trace ((1\<^sub>m n)::complex Matrix.mat))" 
     using one_carrier_mat trace_smult[of "(1\<^sub>m n)::complex Matrix.mat"] by blast
   also have "... = (complex_of_real ((1::real)/n))  * (real n)"  using trace_1[of n] by simp
   also have "... = 1" using assms by simp
   finally show "Complex_Matrix.trace (complex_of_real ((1::real)/n) \<cdot>\<^sub>m 1\<^sub>m n) =  1" .
 next
   show "Complex_Matrix.positive (complex_of_real (1 / real n) \<cdot>\<^sub>m 1\<^sub>m n)" 
-    by (rule positive_smult, (auto simp add: positive_one))
+    by (rule positive_smult, (auto simp add: positive_one less_eq_complex_def))
 qed
   
 lemma (in cpx_sq_mat) max_mix_density_square:
   shows "max_mix_density dimR \<in> fc_mats" unfolding max_mix_density_def 
   using fc_mats_carrier dim_eq by simp
 
 text \<open>Given a measurement outcome, \verb+density_collapse+ represents the resulting density 
 operator. In practice only the measure outcomes with nonzero probabilities are of interest; we 
 (arbitrarily) collapse the density operator for zero-probability outcomes to the maximally mixed 
 density operator.\<close>
 
 definition density_collapse ::"complex Matrix.mat \<Rightarrow> complex Matrix.mat \<Rightarrow> complex Matrix.mat" where
 "density_collapse R P = (if ((Complex_Matrix.trace (R * P)) = 0) then (max_mix_density (dim_row R)) 
     else ((1::real)/ ((Complex_Matrix.trace (R * P)))) \<cdot>\<^sub>m (P * R * P))"
 
 lemma  density_collapse_carrier:
   assumes "0 < dim_row R"
   and "P \<in> carrier_mat n n"
   and "R \<in> carrier_mat n n"
 shows "(density_collapse R P) \<in> carrier_mat n n"
 proof (cases "(Complex_Matrix.trace (R * P)) = 0")
   case True
   hence "density_collapse R P = max_mix_density (dim_row R)" unfolding density_collapse_def by simp
   then show ?thesis using max_mix_is_density assms max_mix_density_carrier by auto 
 next
   case False
   hence "density_collapse R P = complex_of_real 1 / Complex_Matrix.trace (R * P) \<cdot>\<^sub>m (P * R * P)" 
     unfolding density_collapse_def by simp
   thus ?thesis using assms by auto
 qed
 
 lemma  density_collapse_operator:
   assumes "projector P"
   and "density_operator R"
   and "0 < dim_row R"
   and "P \<in> carrier_mat n n"
   and "R \<in> carrier_mat n n"
 shows "density_operator (density_collapse R P)"
 proof (cases "(Complex_Matrix.trace (R * P)) = 0")
   case True
   hence "density_collapse R P = max_mix_density (dim_row R)" unfolding density_collapse_def by simp
   then show ?thesis using max_mix_is_density assms by simp
 next
   case False
   show ?thesis unfolding density_operator_def
   proof (intro conjI)
     have "Complex_Matrix.positive ((1 / (Complex_Matrix.trace (R * P))) \<cdot>\<^sub>m (P * R * P))"
     proof (rule positive_smult)
       show "P * R * P \<in> carrier_mat n n" using assms by simp
       have "Complex_Matrix.positive R" using assms unfolding density_operator_def by simp
       hence "0 \<le> (Complex_Matrix.trace (R * P))" using  positive_proj_trace[of P R n] assms 
           False by auto
-      hence "0 \<le> Re (Complex_Matrix.trace (R * P))" by simp
+      hence "0 \<le> Re (Complex_Matrix.trace (R * P))" by (simp add: less_eq_complex_def)
       hence "0 \<le> 1/(Re (Complex_Matrix.trace (R * P)))" by simp
       have "Re (Complex_Matrix.trace (R * P)) = Complex_Matrix.trace (R * P)" 
         using assms \<open>Complex_Matrix.positive R\<close> trace_proj_pos_real by simp
       hence inv: "1/ (Complex_Matrix.trace (R * P)) = 1/(Re (Complex_Matrix.trace (R * P)))" by simp
       thus "0 \<le> 1/ (Complex_Matrix.trace (R * P))" 
-        using \<open>0 \<le> 1/(Re (Complex_Matrix.trace (R * P)))\<close> by (simp add: inv) 
+        using \<open>0 \<le> 1/(Re (Complex_Matrix.trace (R * P)))\<close> by (simp add: inv less_eq_complex_def) 
       show "Complex_Matrix.positive (P * R * P)" using assms 
           positive_close_under_left_right_mult_adjoint[of P n R]
         by (simp add: \<open>Complex_Matrix.positive R\<close> hermitian_def projector_def)
     qed
     thus "Complex_Matrix.positive (density_collapse R P)" using False 
       unfolding density_collapse_def by simp
   next
     have "Complex_Matrix.trace (density_collapse R P) = 
       Complex_Matrix.trace ((1/ (Complex_Matrix.trace (R * P))) \<cdot>\<^sub>m (P * R * P))" 
       using False unfolding density_collapse_def by simp
     also have "... = 1/ (Complex_Matrix.trace (R * P)) * Complex_Matrix.trace (P * R * P)" 
       using trace_smult[of "P * R * P" n] assms by simp
     also have "... = 1/ (Complex_Matrix.trace (R * P)) * Complex_Matrix.trace (R * P)" 
       using projector_collapse_trace assms by simp
     also have "... = 1" using False by simp
     finally show "Complex_Matrix.trace (density_collapse R P) = 1" .
   qed
 qed
 
 
 subsection \<open>Measurements with observables\<close>
 
 text \<open>It is standard in quantum mechanics to represent projective measurements with so-called 
 \emph{observables}. These are Hermitian matrices which encode projective measurements as follows: 
 the eigenvalues of an observable represent the possible projective measurement outcomes, and the 
 associated projectors are the projectors onto the corresponding eigenspaces. The results in this 
 part are based on the spectral theorem, which states that any Hermitian matrix admits an 
 orthonormal basis consisting of eigenvectors of the matrix.\<close>
 
 
 subsubsection \<open>On the diagonal elements of a matrix\<close>
 
 text \<open>We begin by introducing definitions that will be used on the diagonalized version of a 
 Hermitian matrix.\<close>
 
 definition diag_elems where
 "diag_elems B = {B$$(i,i) |i. i < dim_row B}"
 
 text \<open>Relationship between \verb+diag_elems+ and the list \verb+diag_mat+\<close>
 
 lemma diag_elems_set_diag_mat:
   shows "diag_elems B = set (diag_mat B)" unfolding diag_mat_def diag_elems_def 
 proof
   show "{B $$ (i, i) |i. i < dim_row B} \<subseteq> set (map (\<lambda>i. B $$ (i, i)) [0..<dim_row B])"
   proof
     fix x
     assume "x \<in> {B $$ (i, i) |i. i < dim_row B}"
     hence "\<exists>i < dim_row B. x = B $$(i,i)" by auto
     from this obtain i where "i < dim_row B" and "x = B $$(i,i)" by auto
     thus "x \<in> set (map (\<lambda>i. B $$ (i, i)) [0..<dim_row B])" by auto
   qed
 next
   show "set (map (\<lambda>i. B $$ (i, i)) [0..<dim_row B]) \<subseteq> {B $$ (i, i) |i. i < dim_row B}"
   proof
     fix x
     assume "x \<in> set (map (\<lambda>i. B $$ (i, i)) [0..<dim_row B])"
     thus "x \<in> {B $$ (i, i) |i. i < dim_row B}" by auto
   qed
 qed
 
 lemma diag_elems_finite[simp]:
   shows "finite (diag_elems B)" unfolding diag_elems_def by simp
 
 lemma diag_elems_mem[simp]:
   assumes "i < dim_row B"
   shows "B $$(i,i) \<in> diag_elems B" using assms unfolding diag_elems_def by auto
 
 text \<open>When $x$ is a diagonal element of $B$,  \verb+diag_elem_indices+ returns the set of diagonal
 indices of $B$ with value $x$.\<close>
 
 definition diag_elem_indices where
 "diag_elem_indices x B = {i|i. i < dim_row B \<and> B $$ (i,i) = x}"
 
 lemma diag_elem_indices_elem:
   assumes "a \<in> diag_elem_indices x B"
   shows "a < dim_row B \<and> B$$(a,a) = x" using assms unfolding diag_elem_indices_def by simp
 
 lemma diag_elem_indices_itself:
   assumes "i < dim_row B"
   shows "i \<in> diag_elem_indices (B $$(i,i)) B" using assms unfolding diag_elem_indices_def by simp
 
 lemma diag_elem_indices_finite:
   shows "finite (diag_elem_indices x B)" unfolding diag_elem_indices_def by simp
 
 text \<open>We can therefore partition the diagonal indices of a matrix $B$ depending on the value
 of the diagonal elements. If $B$ admits $p$ elements on its diagonal, then we define bijections 
 between its set of diagonal elements and the initial segment $[0..p-1]$.\<close>
 
 definition dist_el_card where 
 "dist_el_card B = card (diag_elems B)"
 
 definition diag_idx_to_el where
 "diag_idx_to_el B = (SOME h. bij_betw h {..< dist_el_card B} (diag_elems B))"
 
 definition diag_el_to_idx where
 "diag_el_to_idx B = inv_into {..< dist_el_card B} (diag_idx_to_el B)"
 
 lemma diag_idx_to_el_bij:
   shows "bij_betw (diag_idx_to_el B) {..< dist_el_card B} (diag_elems B)"
 proof -
   let ?V = "SOME h. bij_betw h {..< dist_el_card B} (diag_elems B)"
   have vprop: "bij_betw ?V {..< dist_el_card B} (diag_elems B)" using 
       someI_ex[of "\<lambda>h. bij_betw h {..< dist_el_card B} (diag_elems B)"]
      diag_elems_finite  unfolding dist_el_card_def using bij_betw_from_nat_into_finite by blast
   show ?thesis by (simp add:diag_idx_to_el_def vprop)
 qed
 
 lemma diag_el_to_idx_bij:
   shows "bij_betw (diag_el_to_idx B) (diag_elems B) {..< dist_el_card B}" 
   unfolding diag_el_to_idx_def 
 proof (rule bij_betw_inv_into_subset[of _ _ "diag_elems B"], (simp add: diag_idx_to_el_bij)+)
   show "diag_idx_to_el B ` {..<dist_el_card B} = diag_elems B" 
     by (simp add: diag_idx_to_el_bij bij_betw_imp_surj_on)
 qed
 
 lemma diag_idx_to_el_less_inj:
   assumes "i < dist_el_card B"
 and "j < dist_el_card B"
   and "diag_idx_to_el B i = diag_idx_to_el B j"
 shows "i = j"
 proof -
   have "i \<in> {..< dist_el_card B}" using assms by simp
   moreover have "j\<in> {..< dist_el_card B}" using assms by simp
   moreover have "inj_on (diag_idx_to_el B) {..<dist_el_card B}" 
     using diag_idx_to_el_bij[of B] 
     unfolding bij_betw_def by simp
   ultimately show ?thesis by (meson assms(3) inj_on_contraD) 
 qed
 
 lemma diag_idx_to_el_less_surj:
   assumes "x\<in> diag_elems B"
 shows "\<exists>k \<in> {..< dist_el_card B}. x = diag_idx_to_el B k"
 proof -
   have "diag_idx_to_el B ` {..<dist_el_card B} = diag_elems B" 
     using diag_idx_to_el_bij[of B] unfolding bij_betw_def by simp
   thus ?thesis using assms by auto
 qed
 
 lemma diag_idx_to_el_img:
   assumes "k < dist_el_card B"
 shows "diag_idx_to_el B k \<in> diag_elems B"
 proof -
   have "diag_idx_to_el B ` {..<dist_el_card B} = diag_elems B" 
     using diag_idx_to_el_bij[of B] unfolding bij_betw_def by simp
   thus ?thesis using assms by auto
 qed
 
 lemma diag_elems_real:
   fixes B::"complex Matrix.mat"
   assumes "\<forall>i < dim_row B. B$$(i,i) \<in> Reals"
   shows "diag_elems B \<subseteq> Reals" 
 proof
   fix x
   assume "x\<in> diag_elems B"
   hence "\<exists>i < dim_row B. x = B $$(i,i)" using assms unfolding diag_elems_def by auto
   from this obtain i where "i < dim_row B" "x = B $$ (i,i)" by auto
   thus "x \<in> Reals" using assms by simp
 qed
 
 lemma diag_elems_Re:
   fixes B::"complex Matrix.mat"
   assumes "\<forall>i < (dim_row B). B$$(i,i) \<in> Reals"
   shows "{Re x|x. x\<in> diag_elems B} = diag_elems B"
 proof
   show "{complex_of_real (Re x) |x. x \<in> diag_elems B} \<subseteq> diag_elems B" 
   proof 
     fix x
     assume "x \<in> {complex_of_real (Re x) |x. x \<in> diag_elems B}"
     hence "\<exists>y \<in> diag_elems B. x = Re y" by auto
     from this obtain y where "y\<in> diag_elems B" and "x = Re y" by auto
     hence "y = x" using assms diag_elems_real[of B] by auto
     thus "x\<in> diag_elems B" using \<open>y\<in> diag_elems B\<close> by simp
   qed
   show "diag_elems B \<subseteq> {complex_of_real (Re x) |x. x \<in> diag_elems B}" 
   proof
     fix x
     assume "x \<in> diag_elems B"
     hence "Re x = x" using assms diag_elems_real[of B] by auto
     thus "x\<in> {complex_of_real (Re x) |x. x \<in> diag_elems B}" using \<open>x\<in> diag_elems B\<close> by force
   qed
 qed
 
 lemma  diag_idx_to_el_real:
   fixes B::"complex Matrix.mat"
   assumes "\<forall>i < dim_row B. B$$(i,i) \<in> Reals"
 and "i < dist_el_card B"
 shows "Re (diag_idx_to_el B i) = diag_idx_to_el B i"
 proof -
   have "diag_idx_to_el B i \<in> diag_elems B" using diag_idx_to_el_img[of i B] assms by simp
   hence "diag_idx_to_el B i \<in> Reals" using diag_elems_real[of B] assms by auto
   thus ?thesis by simp
 qed
 
 lemma diag_elem_indices_empty:
   assumes "B \<in> carrier_mat dimR dimC"
   and "i < (dist_el_card B)"
 and "j < (dist_el_card B)"
 and "i\<noteq> j"
 shows "diag_elem_indices (diag_idx_to_el B i) B \<inter> 
   (diag_elem_indices (diag_idx_to_el B j) B) = {}"
 proof (rule ccontr)
   assume "diag_elem_indices (diag_idx_to_el B i) B \<inter> 
     diag_elem_indices (diag_idx_to_el B j) B \<noteq> {}"
   hence "\<exists>x. x\<in> diag_elem_indices (diag_idx_to_el B i) B \<inter> 
     diag_elem_indices (diag_idx_to_el B j) B" by auto
   from this obtain x where 
     xprop: "x\<in> diag_elem_indices (diag_idx_to_el B i) B \<inter> 
     diag_elem_indices (diag_idx_to_el B j) B" by auto
   hence "B $$ (x,x) = (diag_idx_to_el B i)" 
     using diag_elem_indices_elem[of x "diag_idx_to_el B i"] by simp
   moreover have "B $$ (x,x) = (diag_idx_to_el B j)" 
     using diag_elem_indices_elem[of x "diag_idx_to_el B j"] xprop by simp
   ultimately have "diag_idx_to_el B i = diag_idx_to_el B j" by simp
   hence "i = j" using diag_idx_to_el_less_inj assms by auto
   thus False using assms by simp
 qed
 
 lemma (in cpx_sq_mat) diag_elem_indices_disjoint:
   assumes "B\<in> carrier_mat dimR dimC"
   shows "disjoint_family_on (\<lambda>n. diag_elem_indices (diag_idx_to_el B n) B) 
     {..<dist_el_card B}" unfolding disjoint_family_on_def 
 proof (intro ballI impI)
   fix p m
   assume "m\<in> {..< dist_el_card B}" and "p\<in> {..< dist_el_card B}" and "m\<noteq> p"      
   thus "diag_elem_indices (diag_idx_to_el B m) B \<inter> 
     diag_elem_indices (diag_idx_to_el B p) B = {}" 
     using diag_elem_indices_empty  assms fc_mats_carrier by simp
 qed
 
 lemma diag_elem_indices_union:
   assumes "B\<in> carrier_mat dimR dimC"
   shows "(\<Union> i \<in> {..< dist_el_card B}. diag_elem_indices (diag_idx_to_el B i) B) = 
     {..< dimR}"
 proof
   show "(\<Union>i<dist_el_card B. diag_elem_indices (diag_idx_to_el B i) B) \<subseteq> {..<dimR}"
   proof
     fix x 
     assume "x \<in> (\<Union>i<dist_el_card B. diag_elem_indices (diag_idx_to_el B i) B)"
     hence "\<exists>i < dist_el_card B. x\<in> diag_elem_indices (diag_idx_to_el B i) B" by auto
     from this obtain i where "i < dist_el_card B" 
       "x\<in> diag_elem_indices (diag_idx_to_el B i) B" by auto
     hence "x < dimR" using diag_elem_indices_elem[of x _ B] assms by simp
     thus "x \<in> {..< dimR}" by auto
   qed
 next
   show "{..<dimR} \<subseteq> (\<Union>i<dist_el_card B. diag_elem_indices (diag_idx_to_el B i) B)"
   proof
     fix j
     assume "j\<in> {..< dimR}"
     hence "j < dim_row B" using assms by simp
     hence "B$$(j,j) \<in> diag_elems B" by simp
     hence "\<exists>k \<in> {..< dist_el_card B}. B$$(j,j) = diag_idx_to_el B k" 
       using diag_idx_to_el_less_surj[of "B $$(j,j)"] by simp
     from this obtain k where kprop: "k \<in> {..< dist_el_card B}" 
       "B$$(j,j) = diag_idx_to_el B k" by auto
     hence "j \<in> diag_elem_indices (diag_idx_to_el B k) B" using \<open>j < dim_row B\<close> 
         diag_elem_indices_itself by fastforce 
     thus "j \<in> (\<Union>i<dist_el_card B. diag_elem_indices (diag_idx_to_el B i) B)" 
       using kprop by auto
   qed
 qed
 
 
 subsubsection \<open>Construction of measurement outcomes\<close>
 
 text \<open>The construction of a projective measurement for a hermitian matrix $A$ is based on the Schur
 decomposition $A = U*B*U^\dagger$, where $B$ is diagonal and $U$ is unitary. The columns of $U$ are
 normalized and pairwise orthogonal; they are used to construct the projectors associated with
 a measurement value\<close>
 
 definition (in cpx_sq_mat) project_vecs where
 "project_vecs (f::nat \<Rightarrow> complex Matrix.vec) N = sum_mat (\<lambda>i. rank_1_proj (f i)) N"
 
 lemma (in cpx_sq_mat) project_vecs_dim:
   assumes "\<forall>i \<in> N. dim_vec (f i) = dimR"
   shows "project_vecs f N \<in> fc_mats" 
 proof -
   have "project_vecs f N \<in> carrier_mat dimR dimC" unfolding project_vecs_def 
   proof (rule sum_mat_carrier)
     show "\<And>i. i \<in> N \<Longrightarrow> rank_1_proj (f i) \<in> fc_mats" using assms fc_mats_carrier rank_1_proj_dim
       dim_eq rank_1_proj_carrier by fastforce
   qed
   thus ?thesis using fc_mats_carrier by simp
 qed
 
 definition (in cpx_sq_mat) mk_meas_outcome where
 "mk_meas_outcome B U = (\<lambda>i. (Re (diag_idx_to_el B i), 
   project_vecs (\<lambda>i. zero_col U i) (diag_elem_indices (diag_idx_to_el B i) B)))"
 
 lemma (in cpx_sq_mat) mk_meas_outcome_carrier:
   assumes "Complex_Matrix.unitary U"
   and "U \<in> fc_mats"
   and "B\<in> fc_mats"
 shows "meas_outcome_prj ((mk_meas_outcome B U) j) \<in> fc_mats"
 proof -
   have "project_vecs (\<lambda>i. zero_col U i) (diag_elem_indices (diag_idx_to_el B j) B) \<in> fc_mats" 
     using project_vecs_dim by (simp add: assms(2) zero_col_dim)
   thus ?thesis unfolding mk_meas_outcome_def meas_outcome_prj_def by simp
 qed
 
 lemma (in cpx_sq_mat) mk_meas_outcome_sum_id:
   assumes "Complex_Matrix.unitary U"
   and "U \<in> fc_mats"
   and "B\<in> fc_mats"
 shows "sum_mat (\<lambda>j. meas_outcome_prj ((mk_meas_outcome B U) j)) 
   {..<(dist_el_card B)} = 1\<^sub>m dimR"
 proof -
   have "sum_mat (\<lambda>j. meas_outcome_prj ((mk_meas_outcome B U) j)) {..<(dist_el_card B)} =
     sum_mat (\<lambda>j. project_vecs (\<lambda>i. zero_col U i) (diag_elem_indices (diag_idx_to_el B j) B)) 
     {..<(dist_el_card B)}"
     unfolding mk_meas_outcome_def meas_outcome_prj_def by simp
   also have "... = sum_mat (\<lambda>i. rank_1_proj (zero_col U i)) 
     (\<Union>j<dist_el_card B. diag_elem_indices (diag_idx_to_el B j) B)" 
     unfolding project_vecs_def sum_mat_def
   proof (rule disj_family_sum_with[symmetric])
     show "\<forall>j. rank_1_proj (zero_col U j) \<in> fc_mats" using zero_col_dim fc_mats_carrier dim_eq
       by (metis assms(2) rank_1_proj_carrier)
     show "finite {..<dist_el_card B}" by simp 
     show "\<And>i. i \<in> {..<dist_el_card B} \<Longrightarrow> finite (diag_elem_indices (diag_idx_to_el B i) B)" 
       using diag_elem_indices_finite by simp
     show "disjoint_family_on (\<lambda>n. diag_elem_indices (diag_idx_to_el B n) B) 
       {..<dist_el_card B}" 
       unfolding disjoint_family_on_def 
     proof (intro ballI impI)
       fix p m
       assume "m\<in> {..< dist_el_card B}" and "p\<in> {..< dist_el_card B}" and "m\<noteq> p"      
       thus "diag_elem_indices (diag_idx_to_el B m) B \<inter> 
         diag_elem_indices (diag_idx_to_el B p) B = {}" 
         using diag_elem_indices_empty  assms fc_mats_carrier by simp
     qed
   qed
   also have "... = sum_mat (\<lambda>i. rank_1_proj (zero_col U i)) {..< dimR}" 
     using diag_elem_indices_union[of B] assms fc_mats_carrier by simp
   also have "... = sum_mat (\<lambda>i. rank_1_proj (Matrix.col U i)) {..< dimR}"
   proof (rule sum_mat_cong, simp)
     show "\<And>i. i \<in> {..<dimR} \<Longrightarrow> rank_1_proj (zero_col U i) \<in> fc_mats" using dim_eq
       by (metis assms(2) local.fc_mats_carrier rank_1_proj_carrier zero_col_dim)
     thus "\<And>i. i \<in> {..<dimR} \<Longrightarrow> rank_1_proj (Matrix.col U i) \<in> fc_mats" using dim_eq
       by (metis lessThan_iff zero_col_col)
     show "\<And>i. i \<in> {..<dimR} \<Longrightarrow> rank_1_proj (zero_col U i) = rank_1_proj (Matrix.col U i)"
       by (simp add: zero_col_col) 
   qed
   also have "... = 1\<^sub>m dimR" using sum_rank_1_proj_unitary assms by simp
   finally show ?thesis .
 qed
 
 lemma (in cpx_sq_mat) make_meas_outcome_prj_ortho:
   assumes "Complex_Matrix.unitary U"
   and "U \<in> fc_mats"
   and "B\<in> fc_mats"
   and "i < dist_el_card B"
   and "j < dist_el_card B"
   and "i \<noteq> j"
 shows "meas_outcome_prj ((mk_meas_outcome B U) i) * 
   meas_outcome_prj ((mk_meas_outcome B U) j) = 0\<^sub>m dimR dimR" 
 proof -
   define Pi where "Pi = sum_mat (\<lambda>k. rank_1_proj (zero_col U k)) 
     (diag_elem_indices (diag_idx_to_el B i) B)" 
   have sneqi: "meas_outcome_prj (mk_meas_outcome B U i) = Pi" 
     unfolding mk_meas_outcome_def project_vecs_def Pi_def meas_outcome_prj_def by simp
   define Pj where "Pj = sum_mat (\<lambda>k. rank_1_proj (zero_col U k)) 
     (diag_elem_indices (diag_idx_to_el B j) B)" 
   have sneqj: "meas_outcome_prj (mk_meas_outcome B U j) = Pj"      
     unfolding mk_meas_outcome_def project_vecs_def Pj_def meas_outcome_prj_def by simp
   have "Pi * Pj = 0\<^sub>m dimR dimR" unfolding Pi_def
   proof (rule sum_mat_left_ortho_zero)
     show "finite (diag_elem_indices (diag_idx_to_el B i) B)"
       using diag_elem_indices_finite[of _ B] by simp
     show km: "\<And>k. k \<in> diag_elem_indices (diag_idx_to_el B i) B \<Longrightarrow> 
       rank_1_proj (zero_col U k) \<in> fc_mats" using zero_col_dim assms fc_mats_carrier dim_eq 
       by (metis rank_1_proj_carrier) 
     show "Pj \<in> fc_mats" using sneqj assms mk_meas_outcome_carrier by auto
     show "\<And>k. k \<in> diag_elem_indices (diag_idx_to_el B i) B \<Longrightarrow> 
       rank_1_proj (zero_col U k) * Pj = 0\<^sub>m dimR dimR"
     proof -
       fix k
       assume "k \<in> diag_elem_indices (diag_idx_to_el B i) B"
       show "rank_1_proj (zero_col U k) * Pj = 0\<^sub>m dimR dimR" unfolding Pj_def
       proof (rule sum_mat_right_ortho_zero)
         show "finite (diag_elem_indices (diag_idx_to_el B j) B)"
           using diag_elem_indices_finite[of _ B] by simp
         show "\<And>i. i \<in> diag_elem_indices (diag_idx_to_el B j) B \<Longrightarrow> 
           rank_1_proj (zero_col U i) \<in> fc_mats" using zero_col_dim assms fc_mats_carrier dim_eq 
           by (metis rank_1_proj_carrier) 
         show "rank_1_proj (zero_col U k) \<in> fc_mats"
           by (simp add: km \<open>k \<in> diag_elem_indices (diag_idx_to_el B i) B\<close>) 
         show "\<And>i. i \<in> diag_elem_indices (diag_idx_to_el B j) B \<Longrightarrow>
          rank_1_proj (zero_col U k) * rank_1_proj (zero_col U i) = 0\<^sub>m dimR dimR"
         proof -
           fix m
           assume "m \<in> diag_elem_indices (diag_idx_to_el B j) B"
           hence "m \<noteq> k" using \<open>k \<in> diag_elem_indices (diag_idx_to_el B i) B\<close> 
             diag_elem_indices_disjoint[of B] fc_mats_carrier assms unfolding disjoint_family_on_def by auto
           have "\<And>i. i \<in> diag_elem_indices (diag_idx_to_el B j) B \<Longrightarrow> i < dimR" 
             using diag_elem_indices_elem fc_mats_carrier assms dim_eq by (metis carrier_matD(1)) 
           hence "m < dimR" using \<open>m \<in> diag_elem_indices (diag_idx_to_el B j) B\<close> by simp
           have "\<And>k. k \<in> diag_elem_indices (diag_idx_to_el B i) B \<Longrightarrow> k < dimR" 
             using diag_elem_indices_elem fc_mats_carrier assms dim_eq by (metis carrier_matD(1)) 
           hence "k < dimR" using \<open>k \<in> diag_elem_indices (diag_idx_to_el B i) B\<close> by simp
           show "rank_1_proj (zero_col U k) * rank_1_proj (zero_col U m) = 0\<^sub>m dimR dimR"
             using rank_1_proj_unitary_ne[of U k m] assms \<open>m < dimR\<close> \<open>k < dimR\<close>
             by (metis \<open>m \<noteq> k\<close> zero_col_col)
         qed
       qed
     qed
   qed
   thus ?thesis using sneqi sneqj by simp
 qed
 
 lemma (in cpx_sq_mat) make_meas_outcome_prjectors:
   assumes "Complex_Matrix.unitary U"
   and "U \<in> fc_mats"
   and "B\<in> fc_mats"
   and "j < dist_el_card B"
 shows "projector (meas_outcome_prj ((mk_meas_outcome B U) j))" unfolding projector_def
 proof
   define Pj where "Pj = sum_mat (\<lambda>i. rank_1_proj (zero_col U i)) 
   (diag_elem_indices (diag_idx_to_el B j) B)" 
   have sneq: "meas_outcome_prj (mk_meas_outcome B U j) = Pj"      
     unfolding mk_meas_outcome_def project_vecs_def Pj_def meas_outcome_prj_def by simp
   moreover have "hermitian Pj" unfolding Pj_def
   proof (rule sum_mat_hermitian)
     show "finite (diag_elem_indices (diag_idx_to_el B j) B)" 
       using diag_elem_indices_finite[of _ B] by simp
     show "\<forall>i\<in>diag_elem_indices (diag_idx_to_el B j) B. hermitian (rank_1_proj (zero_col U i))" 
       using rank_1_proj_hermitian by simp
     show "\<forall>i\<in>diag_elem_indices (diag_idx_to_el B j) B. rank_1_proj (zero_col U i) \<in> fc_mats"
       using zero_col_dim fc_mats_carrier dim_eq by (metis assms(2) rank_1_proj_carrier)
   qed
   ultimately show "hermitian (meas_outcome_prj (mk_meas_outcome B U j))" by simp
   have "Pj * Pj = Pj" unfolding Pj_def
   proof (rule sum_mat_ortho_square)
     show "finite (diag_elem_indices (diag_idx_to_el B j) B)" 
       using diag_elem_indices_finite[of _ B] by simp
     show "\<And>i. i \<in> diag_elem_indices (diag_idx_to_el B j) B \<Longrightarrow>
          rank_1_proj (zero_col U i) * rank_1_proj (zero_col U i) = rank_1_proj (zero_col U i)"
     proof -
       fix i
       assume imem: "i\<in> diag_elem_indices (diag_idx_to_el B j) B"
       hence "i < dimR" using diag_elem_indices_elem fc_mats_carrier assms dim_eq
         by (metis carrier_matD(1)) 
       hence "zero_col U i = Matrix.col U i" using zero_col_col[of i] by simp
       hence "rank_1_proj (zero_col U i) = rank_1_proj (Matrix.col U i)" by simp
       moreover have "rank_1_proj (Matrix.col U i) * rank_1_proj (Matrix.col U i) = 
         rank_1_proj (Matrix.col U i)"  by (rule rank_1_proj_unitary_eq, (auto simp add: assms \<open>i < dimR\<close>))
       ultimately show "rank_1_proj (zero_col U i) * rank_1_proj (zero_col U i) = 
         rank_1_proj (zero_col U i)" by simp
     qed
     show "\<And>i. i \<in> diag_elem_indices (diag_idx_to_el B j) B \<Longrightarrow> 
       rank_1_proj (zero_col U i) \<in> fc_mats" 
       using zero_col_dim assms fc_mats_carrier dim_eq by (metis rank_1_proj_carrier) 
     have "\<And>i. i \<in> diag_elem_indices (diag_idx_to_el B j) B \<Longrightarrow> i < dimR" 
         using diag_elem_indices_elem fc_mats_carrier assms dim_eq by (metis carrier_matD(1)) 
     thus "\<And>i ja.
        i \<in> diag_elem_indices (diag_idx_to_el B j) B \<Longrightarrow>
        ja \<in> diag_elem_indices (diag_idx_to_el B j) B \<Longrightarrow>
        i \<noteq> ja \<Longrightarrow> rank_1_proj (zero_col U i) * rank_1_proj (zero_col U ja) = 0\<^sub>m dimR dimR" 
       using rank_1_proj_unitary_ne by (simp add: assms(1) assms(2) zero_col_col)
   qed
   thus "meas_outcome_prj (mk_meas_outcome B U j) * 
     meas_outcome_prj (mk_meas_outcome B U j) = 
     meas_outcome_prj (mk_meas_outcome B U j)" 
     using sneq by simp
 qed
 
 lemma (in cpx_sq_mat) mk_meas_outcome_fst_inj:
   assumes "\<forall>i < (dim_row B). B$$(i,i) \<in> Reals"
   shows "inj_on (\<lambda>i. meas_outcome_val ((mk_meas_outcome B U) i)) {..<dist_el_card B}" 
     unfolding inj_on_def
 proof (intro ballI impI)
   fix x y
   assume  "x \<in> {..<dist_el_card B}" and "y \<in> {..<dist_el_card B}" 
     and "meas_outcome_val (mk_meas_outcome B U x) = 
     meas_outcome_val (mk_meas_outcome B U y)" note xy = this
   hence "diag_idx_to_el B x = Re (diag_idx_to_el B x)" 
     using assms diag_idx_to_el_real by simp
   also have "... = Re (diag_idx_to_el B y)" using xy 
     unfolding mk_meas_outcome_def meas_outcome_val_def by simp
   also have "... = diag_idx_to_el B y" using assms diag_idx_to_el_real xy by simp
   finally have "diag_idx_to_el B x = diag_idx_to_el B y" .
   thus "x = y " using diag_idx_to_el_less_inj xy by simp
 qed
 
 lemma (in cpx_sq_mat) mk_meas_outcome_fst_bij:
   assumes "\<forall>i < (dim_row B). B$$(i,i) \<in> Reals"
   shows "bij_betw (\<lambda>i. meas_outcome_val ((mk_meas_outcome B U) i)) {..< dist_el_card B} 
     {Re x|x. x\<in> diag_elems B}" 
   unfolding bij_betw_def
 proof
   have "inj_on (\<lambda>x. (meas_outcome_val (mk_meas_outcome B U x))) {..<dist_el_card B}"
     using assms mk_meas_outcome_fst_inj by simp
   moreover have  "{Re x|x. x\<in> diag_elems B} = diag_elems B" using diag_elems_Re[of B] assms by simp
   ultimately show "inj_on (\<lambda>x. meas_outcome_val (mk_meas_outcome B U x)) 
     {..<dist_el_card B}" by simp
   show "(\<lambda>i. meas_outcome_val (mk_meas_outcome B U i)) ` {..<dist_el_card B} = 
     {Re x |x. x \<in> diag_elems B}" unfolding meas_outcome_val_def mk_meas_outcome_def
   proof
     show "(\<lambda>i. fst (Re (diag_idx_to_el B i), project_vecs (zero_col U) 
       (diag_elem_indices (diag_idx_to_el B i) B))) ` {..<dist_el_card B} \<subseteq> 
       {Re x |x. x \<in> diag_elems B}"
       using diag_idx_to_el_bij[of B] bij_betw_apply by fastforce
     show "{Re x |x. x \<in> diag_elems B}
     \<subseteq> (\<lambda>i. fst (Re (diag_idx_to_el B i), 
       project_vecs (zero_col U) (diag_elem_indices (diag_idx_to_el B i) B))) ` 
       {..<dist_el_card B}" using diag_idx_to_el_less_surj by fastforce
   qed
 qed
 
 
 subsubsection \<open>Projective measurement associated with an observable\<close>
 
 definition eigvals where
 "eigvals M = (SOME as. char_poly M = (\<Prod>a\<leftarrow>as. [:- a, 1:]) \<and> length as = dim_row M)"
 
 lemma eigvals_poly_length:
   assumes "(M::complex Matrix.mat) \<in> carrier_mat n n"
   shows "char_poly M = (\<Prod>a\<leftarrow>(eigvals M). [:- a, 1:]) \<and> length (eigvals M) = dim_row M"
 proof -
   let ?V = "SOME as. char_poly M = (\<Prod>a\<leftarrow>as. [:- a, 1:]) \<and> length as = dim_row M"
   have vprop: "char_poly M = (\<Prod>a\<leftarrow>?V. [:- a, 1:]) \<and> length ?V = dim_row M" using 
       someI_ex[of "\<lambda>as. char_poly M = (\<Prod>a\<leftarrow>as. [:- a, 1:]) \<and> length as = dim_row M"]
      complex_mat_char_poly_factorizable assms  by blast
   show ?thesis by (metis (no_types) eigvals_def vprop)
 qed
 
 text \<open>We define the spectrum of a matrix $A$: this is its set of eigenvalues; its elements are
 roots of the characteristic polynomial of $A$.\<close>
 
 definition spectrum where
 "spectrum M = set (eigvals M)"
 
 lemma spectrum_finite:
   shows "finite (spectrum M)" unfolding spectrum_def by simp
 
 lemma spectrum_char_poly_root: 
   fixes A::"complex Matrix.mat"
   assumes "A\<in> carrier_mat n n"
 and "k \<in> spectrum A"
 shows "poly (char_poly A) k = 0" using eigvals_poly_length[of A n] assms
   unfolding spectrum_def  eigenvalue_root_char_poly
   by (simp add: linear_poly_root)
 
 lemma spectrum_eigenvalues:
   fixes A::"complex Matrix.mat"
   assumes "A\<in> carrier_mat n n"
 and "k\<in> spectrum A"
 shows "eigenvalue A k" using eigenvalue_root_char_poly[of A n k] 
     spectrum_char_poly_root[of A n k] assms by simp
 
 text \<open>The main result that is used to construct a projective measurement for a Hermitian matrix
 is that it is always possible to decompose it as $A = U*B*U^\dagger$, where $B$ is diagonal and
 only contains real elements, and $U$ is unitary.\<close>
 
 definition hermitian_decomp where
 "hermitian_decomp A B U \<equiv> similar_mat_wit A B U (Complex_Matrix.adjoint U) \<and> diagonal_mat B \<and> 
     diag_mat B = (eigvals A) \<and> unitary U \<and> (\<forall>i < dim_row B. B$$(i, i) \<in> Reals)"
 
 lemma hermitian_decomp_sim: 
   assumes "hermitian_decomp A B U"
   shows "similar_mat_wit A B U (Complex_Matrix.adjoint U)" using assms 
   unfolding hermitian_decomp_def by simp
 
 lemma hermitian_decomp_diag_mat: 
   assumes "hermitian_decomp A B U"
   shows "diagonal_mat B" using assms 
   unfolding hermitian_decomp_def by simp
 
 lemma hermitian_decomp_eigenvalues: 
   assumes "hermitian_decomp A B U"
   shows "diag_mat B = (eigvals A)" using assms 
   unfolding hermitian_decomp_def by simp
 
 lemma hermitian_decomp_unitary: 
   assumes "hermitian_decomp A B U"
   shows "unitary U" using assms 
   unfolding hermitian_decomp_def by simp
 
 lemma hermitian_decomp_real_eigvals: 
   assumes "hermitian_decomp A B U"
   shows "\<forall>i < dim_row B. B$$(i, i) \<in> Reals" using assms 
   unfolding hermitian_decomp_def by simp
 
 lemma hermitian_decomp_dim_carrier: 
   assumes "hermitian_decomp A B U"
   shows "B \<in> carrier_mat (dim_row A) (dim_col A)" using assms 
   unfolding hermitian_decomp_def similar_mat_wit_def
   by (metis (full_types) index_mult_mat(3) index_one_mat(3) insert_subset)
 
 lemma similar_mat_wit_dim_row:
   assumes "similar_mat_wit A B Q R"
   shows "dim_row B = dim_row A" using assms Let_def unfolding  similar_mat_wit_def
   by (meson carrier_matD(1) insert_subset)
 
 lemma (in cpx_sq_mat) hermitian_schur_decomp:
   assumes "hermitian A"
   and "A\<in> fc_mats"
 obtains B U where "hermitian_decomp A B U" 
 proof -
   {
     have es: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> (eigvals A). [:- e, 1:])" 
       using assms fc_mats_carrier eigvals_poly_length dim_eq by auto
     obtain B U Q where us: "unitary_schur_decomposition A (eigvals A) = (B,U,Q)" 
       by (cases "unitary_schur_decomposition A (eigvals A)")
     hence pr: "similar_mat_wit A B U (Complex_Matrix.adjoint U) \<and> diagonal_mat B \<and> 
       diag_mat B = (eigvals A) \<and> unitary U \<and> (\<forall>i < dimR. B$$(i, i) \<in> Reals)" 
       using hermitian_eigenvalue_real assms fc_mats_carrier es dim_eq by auto
     moreover have "dim_row B = dimR" using assms fc_mats_carrier dim_eq similar_mat_wit_dim_row[of A]  
         pr by auto
     ultimately have "hermitian_decomp A B U" unfolding hermitian_decomp_def by simp
     hence "\<exists> B U. hermitian_decomp A B U" by auto
   }
   thus ?thesis using that by auto 
 qed
 
 lemma (in cpx_sq_mat) hermitian_spectrum_real:
   assumes "A \<in> fc_mats"
   and "hermitian A"
   and "a \<in> spectrum A"
 shows "a \<in> Reals" 
 proof -
   obtain B U where bu: "hermitian_decomp A B U"  using assms hermitian_schur_decomp by auto
   hence dimB: "B \<in> carrier_mat dimR dimR" using assms fc_mats_carrier 
       dim_eq hermitian_decomp_dim_carrier[of A] by simp
   hence  Bii: "\<And>i. i < dimR \<Longrightarrow> B$$(i, i) \<in> Reals" using hermitian_decomp_real_eigvals[of A B U]
       bu assms fc_mats_carrier by simp
   have  "diag_mat B = (eigvals A)" using bu hermitian_decomp_eigenvalues[of A B] by simp    
   hence "a \<in> set (diag_mat B)" using assms unfolding spectrum_def by simp
   hence "\<exists>i < length (diag_mat B). a = diag_mat B ! i" by (metis in_set_conv_nth)
   from this obtain i where "i < length (diag_mat B)" and "a = diag_mat B ! i" by auto
   hence "a = B $$ (i,i)" unfolding diag_mat_def by simp
   moreover have  "i < dimR" using dimB \<open>i < length (diag_mat B)\<close> unfolding diag_mat_def by simp
   ultimately show ?thesis using  Bii by simp
 qed
 
 lemma (in cpx_sq_mat) spectrum_ne:
   assumes "A\<in> fc_mats"
 and "hermitian A" 
 shows "spectrum A \<noteq> {}" 
 proof -
   obtain B U where bu: "hermitian_decomp A B U"  using assms hermitian_schur_decomp by auto
   hence dimB: "B \<in> carrier_mat dimR dimR" using assms fc_mats_carrier 
       dim_eq hermitian_decomp_dim_carrier[of A] by simp
   have  "diag_mat B = (eigvals A)" using bu hermitian_decomp_eigenvalues[of A B] by simp 
   have "B$$(0,0) \<in> set (diag_mat B)" using dimB npos unfolding diag_mat_def by simp
   hence "set (diag_mat B) \<noteq> {}" by auto
   thus ?thesis unfolding spectrum_def using \<open>diag_mat B = eigvals A\<close> by auto
 qed
 
 lemma  unitary_hermitian_eigenvalues:
   fixes U::"complex Matrix.mat"
   assumes "unitary U"
   and "hermitian U"
   and "U \<in> carrier_mat n n"
   and "0 < n"
   and "k \<in> spectrum U"
 shows "k \<in> {-1, 1}" 
 proof -
   have "cpx_sq_mat n n (carrier_mat n n)" by (unfold_locales, (simp add: assms)+)
   have "eigenvalue U k" using spectrum_eigenvalues assms by simp
   have "k \<in> Reals" using assms \<open>cpx_sq_mat n n (carrier_mat n n)\<close> 
       cpx_sq_mat.hermitian_spectrum_real by simp
   hence "conjugate k = k" by (simp add: Reals_cnj_iff) 
   hence "k\<^sup>2 = 1" using unitary_eigenvalues_norm_square[of U n k] assms
     by (simp add: \<open>eigenvalue U k\<close> power2_eq_square)
   thus ?thesis using power2_eq_1_iff by auto 
 qed
 
 lemma  unitary_hermitian_Re_spectrum:
   fixes U::"complex Matrix.mat"
   assumes "unitary U"
   and "hermitian U"
   and "U \<in> carrier_mat n n"
   and "0 < n"
   shows "{Re x|x. x\<in> spectrum U} \<subseteq> {-1,1}"
 proof
   fix y
   assume "y\<in> {Re x|x. x\<in> spectrum U}"
   hence "\<exists>x \<in> spectrum U. y = Re x" by auto
   from this obtain x where "x\<in> spectrum U" and "y = Re x" by auto
   hence "x\<in> {-1,1}" using unitary_hermitian_eigenvalues assms by simp
   thus "y \<in> {-1, 1}" using \<open>y = Re x\<close> by auto 
 qed
 
 text \<open>The projective measurement associated with matrix $M$ is obtained from its Schur 
 decomposition, by considering the number of distinct elements on the resulting diagonal matrix
 and constructing the projectors associated with each of them.\<close>
 
 type_synonym proj_meas_rep = "nat \<times> (nat \<Rightarrow> measure_outcome)"
 
 definition proj_meas_size::"proj_meas_rep \<Rightarrow> nat" where
 "proj_meas_size P = fst P"
 
 definition proj_meas_outcomes::"proj_meas_rep \<Rightarrow> (nat \<Rightarrow> measure_outcome)" where
 "proj_meas_outcomes P = snd P"
 
 definition (in cpx_sq_mat) make_pm::"complex Matrix.mat \<Rightarrow> proj_meas_rep" where
 "make_pm A = (let (B,U,_) = unitary_schur_decomposition A (eigvals A) in 
   (dist_el_card B, mk_meas_outcome B U))"
 
 lemma (in cpx_sq_mat) make_pm_decomp:
   shows "make_pm A = (proj_meas_size (make_pm A), proj_meas_outcomes (make_pm A))" 
   unfolding proj_meas_size_def proj_meas_outcomes_def by simp
 
 lemma (in cpx_sq_mat) make_pm_proj_measurement:
   assumes "A \<in> fc_mats"
   and "hermitian A"
   and "make_pm A = (n, M)"
 shows "proj_measurement n M" 
 proof -
   have es: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> (eigvals A). [:- e, 1:])" 
     using assms fc_mats_carrier eigvals_poly_length dim_eq by auto
   obtain B U Q where us: "unitary_schur_decomposition A (eigvals A) = (B,U,Q)" 
     by (cases "unitary_schur_decomposition A (eigvals A)", auto)
   then have "similar_mat_wit A B U (Complex_Matrix.adjoint U) \<and> diagonal_mat B \<and> 
     diag_mat B = (eigvals A) \<and> unitary U \<and> (\<forall>i < dimR. B$$(i, i) \<in> Reals)" 
     using hermitian_eigenvalue_real assms fc_mats_carrier es dim_eq by auto
   hence A: "A = U * B * (Complex_Matrix.adjoint U)" and dB: "diagonal_mat B"
     and Bii: "\<And>i. i < dimR \<Longrightarrow> B$$(i, i) \<in> Reals"
     and dimB: "B \<in> carrier_mat dimR dimR" and dimP: "U \<in> carrier_mat dimR dimR" and 
     dimaP: "Complex_Matrix.adjoint U \<in> carrier_mat dimR dimR" and unit: "unitary U"
     unfolding similar_mat_wit_def Let_def using assms fc_mats_carrier by auto
   hence mpeq: "make_pm A = (dist_el_card B, mk_meas_outcome B U)" using us Let_def 
     unfolding make_pm_def by simp
   hence "n = dist_el_card B" using assms by simp
   have "M = mk_meas_outcome B U" using assms mpeq by simp
   show ?thesis unfolding proj_measurement_def
   proof (intro conjI)
     show "inj_on (\<lambda>i. meas_outcome_val (M i)) {..<n}" 
         using mk_meas_outcome_fst_inj[of B U] 
         \<open>n = dist_el_card B\<close> \<open>M = mk_meas_outcome B U\<close> Bii fc_mats_carrier dimB by auto 
     show "\<forall>j<n. meas_outcome_prj (M j) \<in> fc_mats \<and> projector (meas_outcome_prj (M j))" 
     proof (intro allI impI conjI)
       fix j
       assume "j < n"
       show "meas_outcome_prj (M j) \<in> fc_mats" using \<open>M = mk_meas_outcome B U\<close> assms 
           fc_mats_carrier \<open>j < n\<close> \<open>n = dist_el_card B\<close> dim_eq mk_meas_outcome_carrier 
           dimB dimP unit by blast
       show "projector (meas_outcome_prj (M j))" using make_meas_outcome_prjectors 
           \<open>M = mk_meas_outcome B U\<close>  
           fc_mats_carrier \<open>n = dist_el_card B\<close> unit \<open>j < n\<close> dimB dimP dim_eq by blast
     qed
     show "\<forall>i<n. \<forall>j<n. i \<noteq> j \<longrightarrow> meas_outcome_prj (M i) * meas_outcome_prj (M j) = 
       0\<^sub>m dimR dimR"
     proof (intro allI impI)
       fix i
       fix j
       assume "i < n" and "j < n" and "i\<noteq> j"
       thus "meas_outcome_prj (M i) * meas_outcome_prj (M j) = 0\<^sub>m dimR dimR"
         using make_meas_outcome_prj_ortho[of U B i j] assms dimB dimP fc_mats_carrier dim_eq
         by (simp add: \<open>M = mk_meas_outcome B U\<close> \<open>n = dist_el_card B\<close> unit)
     qed
     show "sum_mat (\<lambda>j. meas_outcome_prj (M j)) {..<n} = 1\<^sub>m dimR" using 
         mk_meas_outcome_sum_id 
         \<open>M = mk_meas_outcome B U\<close> fc_mats_carrier dim_eq \<open>n = dist_el_card B\<close> unit  dimB dimP 
       by blast
   qed
 qed
 
 lemma (in cpx_sq_mat) make_pm_proj_measurement':
   assumes "A\<in> fc_mats"
   and "hermitian A"
 shows "proj_measurement (proj_meas_size (make_pm A)) (proj_meas_outcomes (make_pm A))" 
   unfolding proj_meas_size_def proj_meas_outcomes_def
   by (rule make_pm_proj_measurement[of A], (simp add: assms)+)
 
 lemma (in cpx_sq_mat) make_pm_projectors:
   assumes "A\<in> fc_mats"
   and "hermitian A"
 and "i < proj_meas_size (make_pm A)"
 shows "projector (meas_outcome_prj (proj_meas_outcomes (make_pm A) i))"
 proof -
   have "proj_measurement (proj_meas_size (make_pm A)) (proj_meas_outcomes (make_pm A))" 
     using assms make_pm_proj_measurement' by simp
   thus ?thesis using proj_measurement_proj assms by simp
 qed
 
 lemma (in cpx_sq_mat) make_pm_square:
   assumes "A\<in> fc_mats"
   and "hermitian A"
 and "i < proj_meas_size (make_pm A)"
 shows "meas_outcome_prj (proj_meas_outcomes (make_pm A) i) \<in> fc_mats"
 proof -
   have "proj_measurement (proj_meas_size (make_pm A)) (proj_meas_outcomes (make_pm A))" 
     using assms make_pm_proj_measurement' by simp
   thus ?thesis using proj_measurement_square assms by simp
 qed
 
 
 subsubsection \<open>Properties on the spectrum of a  Hermitian matrix\<close>
 
 lemma (in cpx_sq_mat) hermitian_schur_decomp':
   assumes "hermitian A"
   and "A\<in> fc_mats"
 obtains B U where "hermitian_decomp A B U \<and> 
   make_pm A = (dist_el_card B, mk_meas_outcome B U)"
 proof -
   {
     have es: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> (eigvals A). [:- e, 1:])" 
       using assms fc_mats_carrier eigvals_poly_length dim_eq by auto
     obtain B U Q where us: "unitary_schur_decomposition A (eigvals A) = (B,U,Q)" 
       by (cases "unitary_schur_decomposition A (eigvals A)")
     hence pr: "similar_mat_wit A B U (Complex_Matrix.adjoint U) \<and> diagonal_mat B \<and> 
       diag_mat B = (eigvals A) \<and> unitary U \<and> (\<forall>i < dimR. B$$(i, i) \<in> Reals)" 
       using hermitian_eigenvalue_real assms fc_mats_carrier es dim_eq by auto
     moreover have "dim_row B = dimR" using assms fc_mats_carrier dim_eq similar_mat_wit_dim_row[of A]  
         pr by auto
     ultimately have "hermitian_decomp A B U" unfolding hermitian_decomp_def by simp
     moreover have  "make_pm A = (dist_el_card B, mk_meas_outcome B U)" using us Let_def 
       unfolding make_pm_def hermitian_decomp_def by simp
     ultimately have "\<exists> B U. hermitian_decomp A B U \<and> 
       make_pm A = (dist_el_card B, mk_meas_outcome B U)"  by auto
   }
   thus ?thesis using that  by auto 
 qed
 
 lemma (in cpx_sq_mat) spectrum_meas_outcome_val_eq: 
   assumes "hermitian A" 
   and "A \<in> fc_mats"
 and "make_pm A = (p, M)"
 shows "spectrum A = (\<lambda>i. meas_outcome_val (M i)) `{..< p}" 
 proof -
   obtain B U where bu: "hermitian_decomp A B U \<and> 
     make_pm A = (dist_el_card B, mk_meas_outcome B U)" 
     using assms hermitian_schur_decomp'[OF assms(1)] by auto
   hence "p = dist_el_card B" using assms by simp
   have dimB: "B \<in> carrier_mat dimR dimR" using hermitian_decomp_dim_carrier[of A] dim_eq bu assms 
       fc_mats_carrier  by auto
   have Bvals: "diag_mat B = eigvals A" using bu hermitian_decomp_eigenvalues[of A B U] by simp
   have Bii: "\<And>i. i < dimR \<Longrightarrow> B$$(i, i) \<in> Reals" using bu hermitian_decomp_real_eigvals[of A B U] 
       dimB by simp
   have "diag_elems B = set (eigvals A)" using dimB Bvals diag_elems_set_diag_mat[of B] by simp
   have "M = mk_meas_outcome B U" using assms bu by simp  
   {
     fix i
     assume "i < p"
     have "meas_outcome_val (M i) = Re (diag_idx_to_el B i)" 
       using \<open>M = mk_meas_outcome B U\<close> 
       unfolding meas_outcome_val_def mk_meas_outcome_def by simp
     also have "... = diag_idx_to_el B i" using diag_idx_to_el_real dimB \<open>i < p\<close> 
         \<open>p = dist_el_card B\<close> Bii by simp
     finally have "meas_outcome_val (M i) = diag_idx_to_el B i" .
   } note eq = this
   have "bij_betw (diag_idx_to_el B) {..<dist_el_card B} (diag_elems B)" 
     using diag_idx_to_el_bij[of B] by simp
   hence "diag_idx_to_el B ` {..< p} = diag_elems B" using \<open>p = dist_el_card B\<close> 
     unfolding bij_betw_def by simp
   thus ?thesis using eq \<open>diag_elems B = set (eigvals A)\<close> unfolding spectrum_def by auto
 qed
 
 lemma (in cpx_sq_mat) spectrum_meas_outcome_val_eq': 
   assumes "hermitian A" 
   and "A \<in> fc_mats"
 and "make_pm A = (p, M)"
 shows "{Re x|x. x\<in> spectrum A} = (\<lambda>i. meas_outcome_val (M i)) `{..< p}" 
 proof
   show "{Re x |x. x \<in> spectrum A} \<subseteq> (\<lambda>i. meas_outcome_val (M i)) ` {..<p}" 
     using spectrum_meas_outcome_val_eq assms by force
   show "(\<lambda>i. meas_outcome_val (M i)) ` {..<p} \<subseteq> {Re x |x. x \<in> spectrum A}" 
     using spectrum_meas_outcome_val_eq assms by force
 qed
 
 lemma (in cpx_sq_mat) make_pm_eigenvalues:
   assumes "A\<in> fc_mats"
   and "hermitian A"
 and "i < proj_meas_size (make_pm A)"
 shows "meas_outcome_val (proj_meas_outcomes (make_pm A) i) \<in> spectrum A" 
   using spectrum_meas_outcome_val_eq[of A] assms make_pm_decomp by auto
 
 lemma (in cpx_sq_mat) make_pm_spectrum:
   assumes "A\<in> fc_mats"
   and "hermitian A"
   and "make_pm A = (p,M)"
 shows "(\<lambda>i. meas_outcome_val (proj_meas_outcomes (make_pm A) i)) ` {..< p} = spectrum A" 
 proof
   show "(\<lambda>x. complex_of_real (meas_outcome_val (proj_meas_outcomes (make_pm A) x))) ` {..<p} \<subseteq> 
     spectrum A"
     using assms make_pm_eigenvalues make_pm_decomp
     by (metis (mono_tags, lifting) Pair_inject image_subsetI lessThan_iff)
   show "spectrum A \<subseteq> 
     (\<lambda>x. complex_of_real (meas_outcome_val (proj_meas_outcomes (make_pm A) x))) ` {..<p}"
     by (metis Pair_inject assms equalityE  make_pm_decomp spectrum_meas_outcome_val_eq)
 qed
 
 lemma (in cpx_sq_mat) spectrum_size:
   assumes "hermitian A"
   and "A\<in> fc_mats"
 and "make_pm A = (p, M)"
 shows "p = card (spectrum A)"
 proof -
   obtain B U where bu: "hermitian_decomp A B U \<and> 
     make_pm A = (dist_el_card B, mk_meas_outcome B U)" 
     using assms hermitian_schur_decomp'[OF assms(1)] by auto
   hence "p = dist_el_card B" using assms by simp
   have "spectrum A = set (diag_mat B)" using bu hermitian_decomp_eigenvalues[of A B U] 
     unfolding spectrum_def by simp
   also have "... = diag_elems B" using diag_elems_set_diag_mat[of B] by simp
   finally have "spectrum A = diag_elems B" .
   thus ?thesis using \<open>p = dist_el_card B\<close> unfolding dist_el_card_def by simp
 qed
 
 lemma (in cpx_sq_mat) spectrum_size':
   assumes "hermitian A"
 and "A\<in> fc_mats"
 shows "proj_meas_size (make_pm A) = card (spectrum A)" using spectrum_size 
   unfolding proj_meas_size_def
   by (metis assms fst_conv surj_pair)
 
 lemma (in cpx_sq_mat) make_pm_projectors':
   assumes "hermitian A"
   and "A \<in> fc_mats"
   and "a<card (spectrum A)"
 shows "projector (meas_outcome_prj (proj_meas_outcomes (make_pm A) a))" 
   by (rule make_pm_projectors, (simp add: assms spectrum_size')+)
 
 lemma (in cpx_sq_mat) meas_outcome_prj_carrier:
   assumes "hermitian A"
   and "A \<in> fc_mats"
   and "a<card (spectrum A)"
 shows "meas_outcome_prj (proj_meas_outcomes (make_pm A) a) \<in> fc_mats" 
 proof (rule proj_measurement_square)
   show "proj_measurement (proj_meas_size (make_pm A)) (proj_meas_outcomes (make_pm A))"
     using make_pm_proj_measurement' assms by simp
   show "a < proj_meas_size (make_pm A)" using assms 
       spectrum_size[of _ "proj_meas_size (make_pm A)"] make_pm_decomp[of A] by simp
 qed
 
 lemma (in cpx_sq_mat) meas_outcome_prj_trace_real:
   assumes "hermitian A"
   and "density_operator R"
   and "R \<in> fc_mats"
   and "A\<in> fc_mats"
   and "a<card (spectrum A)"
 shows "Re (Complex_Matrix.trace (R * meas_outcome_prj (proj_meas_outcomes (make_pm A) a))) =
   Complex_Matrix.trace (R * meas_outcome_prj (proj_meas_outcomes (make_pm A) a))" 
 proof (rule trace_proj_pos_real)
   show "R \<in> carrier_mat dimR dimR" using fc_mats_carrier assms dim_eq by simp
   show "Complex_Matrix.positive R" using assms unfolding density_operator_def by simp
   show "projector (meas_outcome_prj (proj_meas_outcomes (make_pm A) a))" using assms 
       make_pm_projectors' by simp
   show "meas_outcome_prj (proj_meas_outcomes (make_pm A) a) \<in> carrier_mat dimR dimR" 
     using meas_outcome_prj_carrier assms 
     dim_eq fc_mats_carrier by simp
 qed
 
 lemma (in cpx_sq_mat) sum_over_spectrum:
   assumes "A\<in> fc_mats"
 and "hermitian A"
 and "make_pm A = (p, M)"
 shows "(\<Sum> y \<in> spectrum A. f y) =  (\<Sum> i < p. f (meas_outcome_val (M i)))"
 proof (rule sum.reindex_cong)
 show "spectrum A =(\<lambda>x. (meas_outcome_val (M x)))` {..< p}" 
     using spectrum_meas_outcome_val_eq assms by simp
   show "inj_on (\<lambda>x. complex_of_real (meas_outcome_val (M x))) {..<p}"
   proof -
     have "inj_on (\<lambda>x. (meas_outcome_val (M x))) {..<p}" 
         using make_pm_proj_measurement[of A p M] assms proj_measurement_inj by simp
     thus ?thesis by (simp add: inj_on_def) 
   qed
 qed simp
 
 lemma (in cpx_sq_mat) sum_over_spectrum':
   assumes "A\<in> fc_mats"
 and "hermitian A"
 and "make_pm A = (p, M)"
 shows "(\<Sum> y \<in> {Re x|x. x \<in> spectrum A}. f y) =  (\<Sum> i < p. f (meas_outcome_val (M i)))"
 proof (rule sum.reindex_cong)
   show "{Re x|x. x \<in> spectrum A} =(\<lambda>x. (meas_outcome_val (M x)))` {..< p}" 
     using spectrum_meas_outcome_val_eq' assms by simp
   show "inj_on (\<lambda>x. (meas_outcome_val (M x))) {..<p}" using make_pm_proj_measurement[of A p M]
         assms proj_measurement_inj by simp
 qed simp
 
 text \<open>When a matrix $A$ is decomposed into a projective measurement $\{(\lambda_a, \pi_a)\}$, it 
 can be recovered by the formula $A = \sum \lambda_a \pi_a$.\<close>
 
 lemma (in cpx_sq_mat) make_pm_sum:
   assumes "A \<in> fc_mats"
   and "hermitian A"
   and "make_pm A = (p, M)"
 shows "sum_mat (\<lambda>i.  (meas_outcome_val (M i)) \<cdot>\<^sub>m meas_outcome_prj (M i)) {..< p} = A" 
 proof -
   have es: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> (eigvals A). [:- e, 1:])" 
     using assms fc_mats_carrier eigvals_poly_length dim_eq by auto
   obtain B U Q where us: "unitary_schur_decomposition A (eigvals A) = (B,U,Q)" 
     by (cases "unitary_schur_decomposition A (eigvals A)", auto)
   then have "similar_mat_wit A B U (Complex_Matrix.adjoint U) \<and> diagonal_mat B \<and> 
     diag_mat B = (eigvals A) 
     \<and> unitary U \<and> (\<forall>i < dimR. B$$(i, i) \<in> Reals)" 
     using hermitian_eigenvalue_real assms fc_mats_carrier es dim_eq by auto
   hence A: "A = U * B * (Complex_Matrix.adjoint U)" and dB: "diagonal_mat B"
     and Bii: "\<And>i. i < dimR \<Longrightarrow> B$$(i, i) \<in> Reals"
     and dimB: "B \<in> carrier_mat dimR dimR" and dimP: "U \<in> carrier_mat dimR dimR" and 
     dimaP: "Complex_Matrix.adjoint U \<in> carrier_mat dimR dimR" and unit: "unitary U"
     unfolding similar_mat_wit_def Let_def using assms fc_mats_carrier by auto
   hence mpeq: "make_pm A = (dist_el_card B, mk_meas_outcome B U)" using us Let_def 
     unfolding make_pm_def by simp
   hence "p = dist_el_card B" using assms by simp
   have "M = mk_meas_outcome B U" using assms mpeq by simp
   have "sum_mat (\<lambda>i. meas_outcome_val (M i) \<cdot>\<^sub>m meas_outcome_prj (M i)) {..< p} = 
     sum_mat (\<lambda>j. Re (diag_idx_to_el B j)\<cdot>\<^sub>m project_vecs (\<lambda>i. zero_col U i) 
     (diag_elem_indices (diag_idx_to_el B j) B)) {..<(dist_el_card B)}" 
     using \<open>p = dist_el_card B\<close> 
     \<open>M = mk_meas_outcome B U\<close> unfolding meas_outcome_val_def meas_outcome_prj_def 
       mk_meas_outcome_def by simp
   also have "... = sum_mat
      (\<lambda>j. sum_mat (\<lambda>i. (Re (diag_idx_to_el B j)) \<cdot>\<^sub>m rank_1_proj (zero_col U i)) 
     (diag_elem_indices (diag_idx_to_el B j) B)) {..<dist_el_card B}"  
     unfolding project_vecs_def
   proof (rule sum_mat_cong)
     show "finite {..<dist_el_card B}" by simp
     show "\<And>i. i \<in> {..<dist_el_card B} \<Longrightarrow>
          complex_of_real (Re (diag_idx_to_el B i)) \<cdot>\<^sub>m
          sum_mat (\<lambda>i. rank_1_proj (zero_col U i)) (diag_elem_indices (diag_idx_to_el B i) B)
          \<in> fc_mats" using assms fc_mats_carrier dimP project_vecs_def project_vecs_dim zero_col_dim 
         dim_eq by auto
     show "\<And>i. i \<in> {..<dist_el_card B} \<Longrightarrow>
          sum_mat (\<lambda>ia. complex_of_real (Re (diag_idx_to_el B i)) \<cdot>\<^sub>m rank_1_proj (zero_col U ia))
           (diag_elem_indices (diag_idx_to_el B i) B) \<in> fc_mats" using assms fc_mats_carrier dimP 
       project_vecs_def project_vecs_dim zero_col_dim dim_eq
       by (metis (no_types, lifting) rank_1_proj_carrier cpx_sq_mat_smult sum_mat_carrier)
     show "\<And>j. j \<in> {..<dist_el_card B} \<Longrightarrow>
           (Re (diag_idx_to_el B j)) \<cdot>\<^sub>m  sum_mat (\<lambda>i. rank_1_proj (zero_col U i)) 
         (diag_elem_indices (diag_idx_to_el B j) B) =
          sum_mat (\<lambda>i. complex_of_real (Re (diag_idx_to_el B j)) \<cdot>\<^sub>m rank_1_proj (zero_col U i))
           (diag_elem_indices (diag_idx_to_el B j) B)"
     proof -
       fix j
       assume "j \<in> {..<dist_el_card B}"
       show " (Re (diag_idx_to_el B j)) \<cdot>\<^sub>m sum_mat (\<lambda>i. rank_1_proj (zero_col U i)) 
          (diag_elem_indices (diag_idx_to_el B j) B) =
         sum_mat (\<lambda>i. (Re (diag_idx_to_el B j)) \<cdot>\<^sub>m rank_1_proj (zero_col U i))
           (diag_elem_indices (diag_idx_to_el B j) B)" 
       proof (rule smult_sum_mat)
         show "finite (diag_elem_indices (diag_idx_to_el B j) B)" 
           using diag_elem_indices_finite[of _ B] by simp
         show "\<And>i. i \<in> diag_elem_indices (diag_idx_to_el B j) B \<Longrightarrow> 
           rank_1_proj (zero_col U i) \<in> fc_mats" 
           using dim_eq by (metis dimP local.fc_mats_carrier rank_1_proj_carrier zero_col_dim)
       qed
     qed
   qed
   also have "... = sum_mat
      (\<lambda>j. sum_mat (\<lambda>ia. (diag_mat B ! ia) \<cdot>\<^sub>m rank_1_proj (zero_col U ia)) 
     (diag_elem_indices (diag_idx_to_el B j) B)) {..<dist_el_card B}"    
   proof (rule sum_mat_cong)
     show "finite {..<dist_el_card B}" by simp
     show "\<And>i. i \<in> {..<dist_el_card B} \<Longrightarrow>
          sum_mat (\<lambda>ia. complex_of_real (Re (diag_idx_to_el B i)) \<cdot>\<^sub>m rank_1_proj (zero_col U ia))
           (diag_elem_indices (diag_idx_to_el B i) B) \<in> fc_mats" using assms fc_mats_carrier dimP 
       project_vecs_def project_vecs_dim zero_col_dim dim_eq
       by (metis (no_types, lifting) rank_1_proj_carrier cpx_sq_mat_smult sum_mat_carrier)
     show "\<And>i. i \<in> {..<dist_el_card B} \<Longrightarrow>
          local.sum_mat (\<lambda>ia.  (diag_mat B ! ia) \<cdot>\<^sub>m rank_1_proj (zero_col U ia))
           (diag_elem_indices (diag_idx_to_el B i) B) \<in> fc_mats" using assms fc_mats_carrier dimP 
       project_vecs_def project_vecs_dim zero_col_dim dim_eq
       by (metis (no_types, lifting) rank_1_proj_carrier cpx_sq_mat_smult sum_mat_carrier)
     show "\<And>i. i \<in> {..<dist_el_card B} \<Longrightarrow>
          sum_mat (\<lambda>ia. (Re (diag_idx_to_el B i)) \<cdot>\<^sub>m rank_1_proj (zero_col U ia))
           (diag_elem_indices (diag_idx_to_el B i) B) =
          sum_mat (\<lambda>ia. (diag_mat B ! ia) \<cdot>\<^sub>m rank_1_proj (zero_col U ia))
           (diag_elem_indices (diag_idx_to_el B i) B)"
     proof -
       fix i
       assume "i\<in> {..< dist_el_card B}"
       show "sum_mat (\<lambda>ia. (Re (diag_idx_to_el B i)) \<cdot>\<^sub>m rank_1_proj (zero_col U ia))
           (diag_elem_indices (diag_idx_to_el B i) B) =
          sum_mat (\<lambda>ia. (diag_mat B ! ia) \<cdot>\<^sub>m rank_1_proj (zero_col U ia))
           (diag_elem_indices (diag_idx_to_el B i) B)"
       proof (rule sum_mat_cong)
         show "finite (diag_elem_indices (diag_idx_to_el B i) B)" 
           using diag_elem_indices_finite[of _ B] by simp
         show "\<And>ia. ia \<in> diag_elem_indices (diag_idx_to_el B i) B \<Longrightarrow> 
           (Re (diag_idx_to_el B i)) \<cdot>\<^sub>m rank_1_proj (zero_col U ia) \<in> fc_mats"
           using assms fc_mats_carrier dimP project_vecs_def project_vecs_dim zero_col_dim dim_eq 
           by (metis (no_types, lifting) rank_1_proj_carrier cpx_sq_mat_smult)
         show "\<And>ia. ia \<in> diag_elem_indices (diag_idx_to_el B i) B \<Longrightarrow> 
           (diag_mat B !ia) \<cdot>\<^sub>m rank_1_proj (zero_col U ia) \<in> fc_mats"
           using assms fc_mats_carrier dimP project_vecs_def project_vecs_dim zero_col_dim dim_eq 
           by (metis (no_types, lifting) rank_1_proj_carrier cpx_sq_mat_smult)
         show "\<And>ia. ia \<in> diag_elem_indices (diag_idx_to_el B i) B \<Longrightarrow>
           (Re (diag_idx_to_el B i)) \<cdot>\<^sub>m rank_1_proj (zero_col U ia) =
           (diag_mat B ! ia) \<cdot>\<^sub>m rank_1_proj (zero_col U ia)"
         proof -
           fix ia
           assume ia: "ia \<in> diag_elem_indices (diag_idx_to_el B i) B"
           hence "ia < dim_row B" using diag_elem_indices_elem[of ia _ B]  by simp
           have "Re (diag_idx_to_el B i) = Re (B $$ (ia, ia))" 
             using diag_elem_indices_elem[of ia _ B] ia by simp
           also have "... = B $$ (ia, ia)" using Bii using \<open>ia < dim_row B\<close> dimB of_real_Re by blast 
           also have "... = diag_mat B ! ia" using \<open>ia < dim_row B\<close> unfolding diag_mat_def by simp
           finally have "Re (diag_idx_to_el B i) = diag_mat B ! ia" .
           thus "(Re (diag_idx_to_el B i)) \<cdot>\<^sub>m rank_1_proj (zero_col U ia) =
             (diag_mat B ! ia) \<cdot>\<^sub>m rank_1_proj (zero_col U ia)" by simp
         qed
       qed
     qed
   qed
   also have "... = sum_mat 
     (\<lambda>i. (diag_mat B ! i) \<cdot>\<^sub>m rank_1_proj (zero_col U i)) 
     (\<Union>j<dist_el_card B. diag_elem_indices (diag_idx_to_el B j) B)" 
     unfolding project_vecs_def sum_mat_def     
   proof (rule disj_family_sum_with[symmetric])
     show "finite {..<dist_el_card B}" by simp
     show "\<forall>j. (diag_mat B ! j) \<cdot>\<^sub>m rank_1_proj (zero_col U j) \<in> fc_mats" using assms fc_mats_carrier dimP 
       project_vecs_def project_vecs_dim zero_col_dim dim_eq
       by (metis (no_types, lifting) rank_1_proj_carrier cpx_sq_mat_smult)
     show "\<And>i. i \<in> {..<dist_el_card B} \<Longrightarrow> finite (diag_elem_indices (diag_idx_to_el B i) B)"
       by (simp add: diag_elem_indices_finite)
     show "disjoint_family_on (\<lambda>n. diag_elem_indices (diag_idx_to_el B n) B) 
       {..<dist_el_card B}"
       using diag_elem_indices_disjoint[of B] dimB dim_eq by simp
   qed
   also have "... = sum_mat (\<lambda>i. (diag_mat B ! i) \<cdot>\<^sub>m rank_1_proj (zero_col U i)) {..< dimR}" 
     using diag_elem_indices_union[of B] dimB dim_eq by simp
   also have "... = sum_mat (\<lambda>i. (diag_mat B ! i) \<cdot>\<^sub>mrank_1_proj (Matrix.col U i)) {..< dimR}"
   proof (rule sum_mat_cong, simp)
     show res: "\<And>i. i \<in> {..<dimR} \<Longrightarrow> (diag_mat B ! i) \<cdot>\<^sub>m rank_1_proj (zero_col U i) \<in> fc_mats"
       using assms fc_mats_carrier dimP project_vecs_def project_vecs_dim zero_col_dim dim_eq
           by (metis (no_types, lifting) rank_1_proj_carrier cpx_sq_mat_smult)
     show "\<And>i. i \<in> {..<dimR} \<Longrightarrow> (diag_mat B ! i) \<cdot>\<^sub>m rank_1_proj (Matrix.col U i) \<in> fc_mats"
       using assms fc_mats_carrier dimP project_vecs_def  project_vecs_dim zero_col_dim
       by (metis res lessThan_iff zero_col_col)  
     show "\<And>i. i \<in> {..<dimR} \<Longrightarrow> (diag_mat B ! i) \<cdot>\<^sub>m rank_1_proj (zero_col U i) = 
       (diag_mat B ! i) \<cdot>\<^sub>m rank_1_proj (Matrix.col U i)"
       by (simp add: zero_col_col) 
   qed
   also have "... = U * B * Complex_Matrix.adjoint U" 
   proof (rule weighted_sum_rank_1_proj_unitary)
     show "diagonal_mat B" using dB .
     show "Complex_Matrix.unitary U" using unit .
     show "U \<in> fc_mats" using fc_mats_carrier dim_eq dimP by simp
     show "B\<in> fc_mats" using fc_mats_carrier dim_eq dimB by simp
   qed
   also have "... = A" using A by simp
   finally show ?thesis .
 qed
 
 lemma (in cpx_sq_mat) trace_hermitian_pos_real:
   fixes f::"'a \<Rightarrow> real"
   assumes "hermitian A"
   and "Complex_Matrix.positive R"
   and "A \<in> fc_mats"
   and "R \<in> fc_mats"
 shows "Complex_Matrix.trace (R * A) = 
   Re (Complex_Matrix.trace (R * A))"
 proof -
   define prj_mems where "prj_mems = make_pm A"
   define p where "p = proj_meas_size prj_mems"
   define meas where "meas = proj_meas_outcomes prj_mems"
   have tre: "Complex_Matrix.trace (R * A) = 
     Complex_Matrix.trace (R * 
     sum_mat (\<lambda>i. (meas_outcome_val (meas i)) \<cdot>\<^sub>m meas_outcome_prj (meas i)) {..< p})"
     using make_pm_sum assms meas_def p_def proj_meas_size_def proj_meas_outcomes_def prj_mems_def 
       meas_outcome_val_def meas_outcome_prj_def by auto 
   also have "... = Re (Complex_Matrix.trace (R * 
     sum_mat (\<lambda>i. (meas_outcome_val (meas i)) \<cdot>\<^sub>m meas_outcome_prj (meas i)) {..< p}))"
   proof (rule trace_sum_mat_proj_pos_real, (auto simp add: assms))
     fix i
     assume "i < p" 
     thus "projector (meas_outcome_prj (meas i))" using make_pm_projectors assms 
       unfolding p_def meas_def prj_mems_def by simp
     show "meas_outcome_prj (meas i) \<in> fc_mats" using make_pm_square assms \<open>i < p\<close>
       unfolding p_def meas_def prj_mems_def by simp
   qed
   also have "... = Re (Complex_Matrix.trace (R * A))" using tre by simp
   finally show ?thesis .
 qed
 
 lemma (in cpx_sq_mat) hermitian_Re_spectrum:
   assumes "hermitian A"
 and "A\<in> fc_mats"
 and "{Re x |x. x \<in> spectrum A} = {a,b}"
 shows "spectrum A = {complex_of_real a, complex_of_real b}"
 proof
   have ar: "\<And>(a::complex). a \<in> spectrum A \<Longrightarrow> Re a = a" using hermitian_spectrum_real assms by simp
   show "spectrum A \<subseteq> {complex_of_real a, complex_of_real b}" 
   proof
     fix x
     assume "x\<in> spectrum A" 
     hence "Re x = x" using ar by simp
     have "Re x \<in> {a,b}" using \<open>x\<in> spectrum A\<close> assms by blast
     thus "x \<in> {complex_of_real a, complex_of_real b}" using \<open>Re x = x\<close> by auto
   qed
   show "{complex_of_real a, complex_of_real b} \<subseteq> spectrum A"
   proof
     fix x
     assume "x \<in> {complex_of_real a, complex_of_real b}"
     hence "x \<in> {complex_of_real (Re x) |x. x \<in> spectrum A}" using assms
     proof -
       have "\<And>r. r \<notin> {a, b} \<or> (\<exists>c. r = Re c \<and> c \<in> spectrum A)"
         using \<open>{Re x |x. x \<in> spectrum A} = {a, b}\<close> by blast
       then show ?thesis
         using \<open>x \<in> {complex_of_real a, complex_of_real b}\<close> by blast
     qed
     thus "x\<in> spectrum A" using ar by auto
   qed
 qed
 
 
 subsubsection \<open>Similar properties for eigenvalues rather than spectrum indices\<close>
 
 text \<open>In this part we go the other way round: given an eigenvalue of $A$, \verb+spectrum_to_pm_idx+ 
 permits to retrieve its index in the associated projective measurement\<close>
 
 definition (in cpx_sq_mat) spectrum_to_pm_idx
   where "spectrum_to_pm_idx A x = (let (B,U,_) = unitary_schur_decomposition A (eigvals A) in 
     diag_el_to_idx B x)"
 
 lemma (in cpx_sq_mat) spectrum_to_pm_idx_bij:
 assumes "hermitian A"
   and "A\<in> fc_mats"
 shows "bij_betw (spectrum_to_pm_idx A) (spectrum A) {..< card (spectrum A)}"
 proof -
   define p where "p = proj_meas_size (make_pm A)"
   define M where "M = proj_meas_outcomes (make_pm A)"
   have es: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> (eigvals A). [:- e, 1:])" 
       using assms fc_mats_carrier eigvals_poly_length dim_eq by auto
   obtain B U Q where us: "unitary_schur_decomposition A (eigvals A) = (B,U,Q)" 
     by (cases "unitary_schur_decomposition A (eigvals A)")
   hence pr: "similar_mat_wit A B U (Complex_Matrix.adjoint U) \<and> 
       diag_mat B = (eigvals A)" 
       using hermitian_eigenvalue_real assms fc_mats_carrier es dim_eq by auto
   have "(p,M) = make_pm A" unfolding p_def M_def using make_pm_decomp by simp
   hence "p = dist_el_card B" using assms us unfolding make_pm_def by simp
   have dimB: "B \<in> carrier_mat dimR dimR" using  dim_eq pr assms 
       fc_mats_carrier unfolding similar_mat_wit_def  by auto
   have Bvals: "diag_mat B = eigvals A" using pr hermitian_decomp_eigenvalues[of A B U] by simp
   have "diag_elems B = spectrum A" unfolding spectrum_def using dimB Bvals 
       diag_elems_set_diag_mat[of B] by simp
   moreover have "dist_el_card B = card (spectrum A)" using spectrum_size[of A p M] assms 
       \<open>(p,M) = make_pm A\<close> \<open>p = dist_el_card B\<close> by simp 
   ultimately show "bij_betw (spectrum_to_pm_idx A) (spectrum A) {..< card (spectrum A)}" 
     using diag_el_to_idx_bij us unfolding spectrum_to_pm_idx_def Let_def
     by (metis (mono_tags, lifting) bij_betw_cong case_prod_conv)
 qed
 
 lemma (in cpx_sq_mat) spectrum_to_pm_idx_lt_card:
 assumes "A\<in> fc_mats"
   and "hermitian A"
 and "a\<in> spectrum A"
 shows "spectrum_to_pm_idx A a < card (spectrum A)" using spectrum_to_pm_idx_bij[of A] assms
   by (meson bij_betw_apply lessThan_iff)
 
 lemma (in cpx_sq_mat) spectrum_to_pm_idx_inj:
 assumes "hermitian A"
   and "A\<in> fc_mats"
 shows "inj_on (spectrum_to_pm_idx A) (spectrum A)" using assms spectrum_to_pm_idx_bij
   unfolding bij_betw_def by simp
 
 lemma (in cpx_sq_mat) spectrum_meas_outcome_val_inv:
 assumes "A\<in> fc_mats"
   and "hermitian A"
 and "make_pm A = (p,M)"
 and "i < p"
 shows "spectrum_to_pm_idx A (meas_outcome_val (M i)) = i"
 proof -
   have es: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> (eigvals A). [:- e, 1:])" 
       using assms fc_mats_carrier eigvals_poly_length dim_eq by auto
   obtain B U Q where us: "unitary_schur_decomposition A (eigvals A) = (B,U,Q)" 
       by (cases "unitary_schur_decomposition A (eigvals A)")
   hence pr: "similar_mat_wit A B U (Complex_Matrix.adjoint U) \<and> 
     diag_mat B = (eigvals A) \<and>  (\<forall>i < dimR. B$$(i, i) \<in> Reals)" 
     using hermitian_eigenvalue_real assms fc_mats_carrier es dim_eq by auto
   have "dim_row B = dimR" using assms fc_mats_carrier dim_eq similar_mat_wit_dim_row[of A]  
       pr by auto
   hence "(p,M) = (dist_el_card B, mk_meas_outcome B U)" using assms us 
     unfolding make_pm_def by simp
   hence "M = mk_meas_outcome B U" by simp
   have "meas_outcome_val (M i) = Re (diag_idx_to_el B i)" 
     using \<open>M = mk_meas_outcome B U\<close> unfolding mk_meas_outcome_def 
       meas_outcome_val_def by simp
   also have "... = diag_idx_to_el B i" using pr
     \<open>(p, M) = (dist_el_card B, mk_meas_outcome B U)\<close> \<open>dim_row B = dimR\<close> assms 
     diag_idx_to_el_real by auto 
   finally have "meas_outcome_val (M i) = diag_idx_to_el B i" .
   hence "spectrum_to_pm_idx A (meas_outcome_val (M i)) = 
     spectrum_to_pm_idx A (diag_idx_to_el B i)" by simp
   also have "... = diag_el_to_idx B (diag_idx_to_el B i)" unfolding spectrum_to_pm_idx_def 
     using us by simp
   also have "... = i" using assms unfolding diag_el_to_idx_def
     using \<open>(p, M) = (dist_el_card B, mk_meas_outcome B U)\<close> bij_betw_inv_into_left 
       diag_idx_to_el_bij by fastforce
   finally show ?thesis .
 qed
 
 lemma (in cpx_sq_mat) meas_outcome_val_spectrum_inv:
   assumes "A\<in> fc_mats"
   and "hermitian A"
 and "x\<in> spectrum A"
 and "make_pm A = (p,M)"
 shows "meas_outcome_val (M (spectrum_to_pm_idx A x)) = x"
 proof -
   have es: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> (eigvals A). [:- e, 1:])" 
       using assms fc_mats_carrier eigvals_poly_length dim_eq by auto
   obtain B U Q where us: "unitary_schur_decomposition A (eigvals A) = (B,U,Q)" 
       by (cases "unitary_schur_decomposition A (eigvals A)")
     hence pr: "similar_mat_wit A B U (Complex_Matrix.adjoint U) \<and> diagonal_mat B \<and> 
       diag_mat B = (eigvals A) \<and> unitary U \<and> (\<forall>i < dimR. B$$(i, i) \<in> Reals)" 
       using hermitian_eigenvalue_real assms fc_mats_carrier es dim_eq by auto
     have "dim_row B = dimR" using assms fc_mats_carrier dim_eq similar_mat_wit_dim_row[of A]  
         pr by auto
     hence "(p,M) = (dist_el_card B, mk_meas_outcome B U)" using assms us 
       unfolding make_pm_def by simp
     hence "M = mk_meas_outcome B U" by simp
   have  "diag_mat B = (eigvals A)" using pr by simp
   hence "x \<in> set (diag_mat B)" using \<open>diag_mat B = eigvals A\<close> assms unfolding spectrum_def by simp
   hence "x \<in> diag_elems B" using diag_elems_set_diag_mat[of B] by simp
   hence "diag_idx_to_el B (diag_el_to_idx B x) = x" unfolding diag_el_to_idx_def
     by (meson bij_betw_inv_into_right diag_idx_to_el_bij) 
   moreover have "spectrum_to_pm_idx A x = diag_el_to_idx B x" unfolding spectrum_to_pm_idx_def 
     using us by simp
   moreover have "meas_outcome_val (M (spectrum_to_pm_idx A x)) = 
     Re (diag_idx_to_el B (diag_el_to_idx B x))" using \<open>M = mk_meas_outcome B U\<close> 
     unfolding mk_meas_outcome_def meas_outcome_val_def  by (simp add: calculation(2))
   ultimately show ?thesis by simp
 qed
   
 definition (in cpx_sq_mat) eigen_projector where
 "eigen_projector A a = 
   meas_outcome_prj ((proj_meas_outcomes (make_pm A)) (spectrum_to_pm_idx A a))"
 
 lemma (in cpx_sq_mat) eigen_projector_carrier:
   assumes "A\<in> fc_mats"
   and "a\<in> spectrum A"
   and "hermitian A"
 shows "eigen_projector A a \<in> fc_mats" unfolding eigen_projector_def 
   using meas_outcome_prj_carrier[of A "spectrum_to_pm_idx A a"] 
     spectrum_to_pm_idx_lt_card[of A a] assms by simp
 
 text \<open>We obtain the following result, which is similar to \verb+make_pm_sum+ but with a sum on 
 the elements of the spectrum of Hermitian matrix $A$, which is a more standard statement of the 
 spectral decomposition theorem.\<close>
 
 lemma (in cpx_sq_mat) make_pm_sum':
   assumes "A \<in> fc_mats"
   and "hermitian A"
 shows "sum_mat (\<lambda>a.  a \<cdot>\<^sub>m (eigen_projector A a)) (spectrum A) = A" 
 proof -
   define p where "p = proj_meas_size (make_pm A)"
   define M where "M = proj_meas_outcomes (make_pm A)"
   have "(p,M) = make_pm A" unfolding p_def M_def using make_pm_decomp by simp
   define g where 
     "g = (\<lambda>i. (if i < p 
       then complex_of_real (meas_outcome_val (M i)) \<cdot>\<^sub>m meas_outcome_prj (M i) 
       else (0\<^sub>m dimR dimC)))"
   have g: "\<forall>x. g x \<in> fc_mats"
   proof
     fix x
     show "g x \<in> fc_mats"
     proof (cases "x < p")
       case True
       hence "(meas_outcome_val (M x)) \<cdot>\<^sub>m meas_outcome_prj (M x) \<in> fc_mats" 
         using meas_outcome_prj_carrier
         spectrum_size assms cpx_sq_mat_smult make_pm_proj_measurement proj_measurement_square 
         \<open>(p,M) = make_pm A\<close> by metis
       then show ?thesis unfolding g_def using True by simp
     next
       case False
       then show ?thesis unfolding g_def using zero_mem by simp
     qed
   qed
   define h where "h = (\<lambda>a. (if a \<in> (spectrum A) then a \<cdot>\<^sub>m eigen_projector A a else (0\<^sub>m dimR dimC)))"
   have h: "\<forall>x. h x \<in> fc_mats"
   proof
     fix x
     show "h x \<in> fc_mats"
     proof (cases "x\<in> spectrum A")
     case True
       then show ?thesis unfolding h_def using eigen_projector_carrier[of A x] assms True
         by (simp add: cpx_sq_mat_smult)
     next
     case False
       then show ?thesis unfolding h_def using zero_mem by simp
     qed
   qed
   have "inj_on (spectrum_to_pm_idx A) (spectrum A)" using assms spectrum_to_pm_idx_inj by simp
   moreover have "{..<p} = spectrum_to_pm_idx A ` spectrum A" using \<open>(p,M) = make_pm A\<close>
     spectrum_to_pm_idx_bij spectrum_size unfolding bij_betw_def
     by (metis assms(1) assms(2)) 
   moreover have "\<And>x. x \<in> spectrum A \<Longrightarrow> g (spectrum_to_pm_idx A x) = h x" 
   proof -
     fix a
     assume "a \<in> spectrum A"
     hence "Re a = a" using hermitian_spectrum_real assms by simp 
     have "spectrum_to_pm_idx A a < p" using spectrum_to_pm_idx_lt_card[of A] spectrum_size assms 
       \<open>a \<in> spectrum A\<close> \<open>(p,M) = make_pm A\<close> by metis
     have "g (spectrum_to_pm_idx A a) = 
       (meas_outcome_val (M (spectrum_to_pm_idx A a))) \<cdot>\<^sub>m 
       meas_outcome_prj (M (spectrum_to_pm_idx A a))"
       using \<open>spectrum_to_pm_idx A a < p\<close> unfolding g_def by simp
     also have "... = a \<cdot>\<^sub>m meas_outcome_prj (M (spectrum_to_pm_idx A a))" 
       using meas_outcome_val_spectrum_inv[of A "Re a"] \<open>Re a = a\<close> assms \<open>a \<in> spectrum A\<close> 
         \<open>(p,M) = make_pm A\<close> by metis
     also have "... = h a" using \<open>a \<in> spectrum A\<close> unfolding eigen_projector_def M_def h_def by simp
     finally show "g (spectrum_to_pm_idx A a) = h a" .
   qed
   ultimately have "sum_mat h (spectrum A) = 
     sum_mat g (spectrum_to_pm_idx A ` spectrum A)" unfolding sum_mat_def
     using   sum_with_reindex_cong[symmetric, of g h "spectrum_to_pm_idx A" "spectrum A" "{..< p}"] 
       g h by simp
   also have "... = sum_mat g {..< p}" using \<open>{..<p} = spectrum_to_pm_idx A ` spectrum A\<close> by simp
   also have "... = sum_mat (\<lambda>i. (meas_outcome_val (M i)) \<cdot>\<^sub>m meas_outcome_prj (M i)) {..<p}"
   proof (rule sum_mat_cong, simp)
     fix i
     assume "i \<in> {..< p}"
     hence "i < p" by simp
     show "g i \<in> fc_mats" using g by simp
     show "g i = (meas_outcome_val (M i)) \<cdot>\<^sub>m meas_outcome_prj (M i)" unfolding g_def 
       using \<open>i < p\<close> by simp
     show "(meas_outcome_val (M i)) \<cdot>\<^sub>m meas_outcome_prj (M i) \<in> fc_mats" 
       using meas_outcome_prj_carrier spectrum_size assms cpx_sq_mat_smult 
         make_pm_proj_measurement proj_measurement_square \<open>i < p\<close> \<open>(p,M) = make_pm A\<close> by metis
   qed
   also have "... = A" using make_pm_sum assms \<open>(p,M) = make_pm A\<close> unfolding g_def by simp
   finally have "sum_mat h (spectrum A) = A" .
   moreover have "sum_mat h (spectrum A) = sum_mat (\<lambda>a.  a \<cdot>\<^sub>m (eigen_projector A a)) (spectrum A)"
   proof (rule sum_mat_cong)
     show "finite (spectrum A)" using spectrum_finite[of A] by simp
     fix i
     assume "i\<in> spectrum A"
     thus "h i = i \<cdot>\<^sub>m eigen_projector A i" unfolding h_def by simp
     show "h i \<in> fc_mats" using h by simp
     show "i \<cdot>\<^sub>m eigen_projector A i \<in> fc_mats" using eigen_projector_carrier[of A i] assms 
         \<open>i\<in> spectrum A\<close> by (metis \<open>h i = i \<cdot>\<^sub>m eigen_projector A i\<close> h)
   qed
   ultimately show ?thesis by simp
 qed
 
 
 
 end
\ No newline at end of file
diff --git a/thys/QHLProver/Complex_Matrix.thy b/thys/QHLProver/Complex_Matrix.thy
--- a/thys/QHLProver/Complex_Matrix.thy
+++ b/thys/QHLProver/Complex_Matrix.thy
@@ -1,2346 +1,2351 @@
 section \<open>Complex matrices\<close>
 
 theory Complex_Matrix
   imports 
     "Jordan_Normal_Form.Matrix" 
     "Jordan_Normal_Form.Conjugate" 
     "Jordan_Normal_Form.Jordan_Normal_Form_Existence"
 begin
 
 subsection \<open>Trace of a matrix\<close>
 
 definition trace :: "'a::ring mat \<Rightarrow> 'a" where
   "trace A = (\<Sum> i \<in> {0 ..< dim_row A}. A $$ (i,i))"
 
 lemma trace_zero [simp]:
   "trace (0\<^sub>m n n) = 0"
   by (simp add: trace_def)
 
 lemma trace_id [simp]:
   "trace (1\<^sub>m n) = n"
   by (simp add: trace_def)
 
 lemma trace_comm:
   fixes A B :: "'a::comm_ring mat"
   assumes A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n"
   shows "trace (A * B) = trace (B * A)"
 proof (simp add: trace_def)
   have "(\<Sum>i = 0..<n. (A * B) $$ (i, i)) = (\<Sum>i = 0..<n. \<Sum>j = 0..<n. A $$ (i,j) * B $$ (j,i))"
     apply (rule sum.cong) using assms by (auto simp add: scalar_prod_def)
   also have "\<dots> = (\<Sum>j = 0..<n. \<Sum>i = 0..<n. A $$ (i,j) * B $$ (j,i))"
     by (rule sum.swap)
   also have "\<dots> = (\<Sum>j = 0..<n. col A j \<bullet> row B j)"
     by (metis (no_types, lifting) A B atLeastLessThan_iff carrier_matD index_col index_row scalar_prod_def sum.cong)
   also have "\<dots> = (\<Sum>j = 0..<n. row B j \<bullet> col A j)"
     apply (rule sum.cong) apply auto
     apply (subst comm_scalar_prod[where n=n]) apply auto
     using assms by auto
   also have "\<dots> = (\<Sum>j = 0..<n. (B * A) $$ (j, j))"
     apply (rule sum.cong) using assms by auto
   finally show "(\<Sum>i = 0..<dim_row A. (A * B) $$ (i, i)) = (\<Sum>i = 0..<dim_row B. (B * A) $$ (i, i))"
     using A B by auto
 qed
 
 lemma trace_add_linear:
   fixes A B :: "'a::comm_ring mat"
   assumes A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n"
   shows "trace (A + B) = trace A + trace B" (is "?lhs = ?rhs")
 proof -
   have "?lhs = (\<Sum>i=0..<n. A$$(i, i) + B$$(i, i))" unfolding trace_def using A B by auto
   also have "\<dots> = (\<Sum>i=0..<n. A$$(i, i)) + (\<Sum>i=0..<n. B$$(i, i))" by (auto simp add: sum.distrib)
   finally have l: "?lhs = (\<Sum>i=0..<n. A$$(i, i)) + (\<Sum>i=0..<n. B$$(i, i))".
   have r: "?rhs = (\<Sum>i=0..<n. A$$(i, i)) + (\<Sum>i=0..<n. B$$(i, i))" unfolding trace_def using A B by auto
   from l r show ?thesis by auto
 qed
 
 lemma trace_minus_linear:
   fixes A B :: "'a::comm_ring mat"
   assumes A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n"
   shows "trace (A - B) = trace A - trace B" (is "?lhs = ?rhs")
 proof -
   have "?lhs = (\<Sum>i=0..<n. A$$(i, i) - B$$(i, i))" unfolding trace_def using A B by auto
   also have "\<dots> = (\<Sum>i=0..<n. A$$(i, i)) - (\<Sum>i=0..<n. B$$(i, i))" by (auto simp add: sum_subtractf)
   finally have l: "?lhs = (\<Sum>i=0..<n. A$$(i, i)) - (\<Sum>i=0..<n. B$$(i, i))".
   have r: "?rhs = (\<Sum>i=0..<n. A$$(i, i)) - (\<Sum>i=0..<n. B$$(i, i))" unfolding trace_def using A B by auto
   from l r show ?thesis by auto
 qed
 
 lemma trace_smult: 
   assumes "A \<in> carrier_mat n n"
   shows "trace (c \<cdot>\<^sub>m A) = c * trace A"
 proof -
   have "trace (c \<cdot>\<^sub>m A) = (\<Sum>i = 0..<dim_row A. c * A $$ (i, i))" unfolding trace_def using assms by auto
   also have "\<dots> = c * (\<Sum>i = 0..<dim_row A. A $$ (i, i))"
     by (simp add: sum_distrib_left)
   also have "\<dots> = c * trace A" unfolding trace_def by auto
   ultimately show ?thesis by auto
 qed
 
 subsection \<open>Conjugate of a vector\<close>
 
 lemma conjugate_scalar_prod:
   fixes v w :: "'a::conjugatable_ring vec"
   assumes "dim_vec v = dim_vec w"
   shows "conjugate (v \<bullet> w) = conjugate v \<bullet> conjugate w"
   using assms by (simp add: scalar_prod_def sum_conjugate conjugate_dist_mul)
 
 subsection \<open>Inner product\<close>
 
 abbreviation inner_prod :: "'a vec \<Rightarrow> 'a vec \<Rightarrow> 'a :: conjugatable_ring"
   where "inner_prod v w \<equiv> w \<bullet>c v"
 
 lemma conjugate_scalar_prod_Im [simp]:
   "Im (v \<bullet>c v) = 0"
   by (simp add: scalar_prod_def conjugate_vec_def sum.neutral)
 
 lemma conjugate_scalar_prod_Re [simp]:
   "Re (v \<bullet>c v) \<ge> 0"
   by (simp add: scalar_prod_def conjugate_vec_def sum_nonneg)
 
 lemma self_cscalar_prod_geq_0:
   fixes v ::  "'a::conjugatable_ordered_field vec"
   shows "v \<bullet>c v \<ge> 0"
   by (auto simp add: scalar_prod_def, rule sum_nonneg, rule conjugate_square_positive)
 
 lemma inner_prod_distrib_left:
   fixes u v w :: "('a::conjugatable_field) vec"
   assumes dimu: "u \<in> carrier_vec n" and dimv:"v \<in> carrier_vec n" and dimw: "w \<in> carrier_vec n" 
   shows "inner_prod (v + w) u = inner_prod v u + inner_prod w u" (is "?lhs = ?rhs")
 proof -
   have dimcv: "conjugate v \<in> carrier_vec n" and dimcw: "conjugate w \<in> carrier_vec n" using assms by auto
   have dimvw: "conjugate (v + w) \<in> carrier_vec n" using assms by auto
   have "u \<bullet> (conjugate (v + w)) = u \<bullet> conjugate v + u \<bullet> conjugate w"
     using dimv dimw dimu dimcv dimcw 
     by (metis conjugate_add_vec scalar_prod_add_distrib)
   then show ?thesis by auto
 qed
 
 lemma inner_prod_distrib_right:
   fixes u v w :: "('a::conjugatable_field) vec"
   assumes dimu: "u \<in> carrier_vec n" and dimv:"v \<in> carrier_vec n" and dimw: "w \<in> carrier_vec n" 
   shows "inner_prod u (v + w) = inner_prod u v + inner_prod u w" (is "?lhs = ?rhs")
 proof -
   have dimvw: "v + w \<in> carrier_vec n" using assms by auto
   have dimcu: "conjugate u \<in> carrier_vec n" using assms by auto
   have "(v + w) \<bullet> (conjugate u) = v \<bullet> conjugate u + w \<bullet> conjugate u"
     apply (simp add: comm_scalar_prod[OF dimvw dimcu])
     apply (simp add: scalar_prod_add_distrib[OF dimcu dimv dimw])
     apply (insert dimv dimw dimcu, simp add: comm_scalar_prod[of _ n])
     done
   then show ?thesis by auto
 qed                
 
 lemma inner_prod_minus_distrib_right:
   fixes u v w :: "('a::conjugatable_field) vec"
   assumes dimu: "u \<in> carrier_vec n" and dimv:"v \<in> carrier_vec n" and dimw: "w \<in> carrier_vec n" 
   shows "inner_prod u (v - w) = inner_prod u v - inner_prod u w" (is "?lhs = ?rhs")
 proof -
   have dimvw: "v - w \<in> carrier_vec n" using assms by auto
   have dimcu: "conjugate u \<in> carrier_vec n" using assms by auto
   have "(v - w) \<bullet> (conjugate u) = v \<bullet> conjugate u - w \<bullet> conjugate u"
     apply (simp add: comm_scalar_prod[OF dimvw dimcu])
     apply (simp add: scalar_prod_minus_distrib[OF dimcu dimv dimw])
     apply (insert dimv dimw dimcu, simp add: comm_scalar_prod[of _ n])
     done
   then show ?thesis by auto
 qed                
 
 lemma inner_prod_smult_right:
   fixes u v :: "complex vec"
   assumes dimu: "u \<in> carrier_vec n" and dimv:"v \<in> carrier_vec n" 
   shows "inner_prod (a \<cdot>\<^sub>v u) v = conjugate a * inner_prod u v" (is "?lhs = ?rhs")
   using assms apply (simp add: scalar_prod_def conjugate_dist_mul) 
   apply (subst sum_distrib_left) by (rule sum.cong, auto)
 
 lemma inner_prod_smult_left:
   fixes u v :: "complex vec"
   assumes dimu: "u \<in> carrier_vec n" and dimv: "v \<in> carrier_vec n" 
   shows "inner_prod u (a \<cdot>\<^sub>v v) = a * inner_prod u v" (is "?lhs = ?rhs")
   using assms apply (simp add: scalar_prod_def) 
   apply (subst sum_distrib_left) by (rule sum.cong, auto)
 
 lemma inner_prod_smult_left_right:
   fixes u v :: "complex vec"
   assumes dimu: "u \<in> carrier_vec n" and dimv: "v \<in> carrier_vec n" 
   shows "inner_prod (a \<cdot>\<^sub>v u) (b \<cdot>\<^sub>v v) = conjugate a * b  * inner_prod u v" (is "?lhs = ?rhs")
   using assms apply (simp add: scalar_prod_def) 
   apply (subst sum_distrib_left) by (rule sum.cong, auto)
 
 lemma inner_prod_swap:
   fixes x y :: "complex vec"
   assumes "y \<in> carrier_vec n" and "x \<in> carrier_vec n" 
   shows "inner_prod y x = conjugate (inner_prod x y)"
   apply (simp add: scalar_prod_def)
   apply (rule sum.cong) using assms by auto
 
 text \<open>Cauchy-Schwarz theorem for complex vectors. This is analogous to aux\_Cauchy
   and Cauchy\_Schwarz\_ineq in Generalizations2.thy in QR\_Decomposition. Consider
   merging and moving to Isabelle library.\<close>
 lemma aux_Cauchy:
   fixes x y :: "complex vec"
   assumes "x \<in> carrier_vec n" and "y \<in> carrier_vec n"
   shows "0 \<le> inner_prod x x + a * (inner_prod x y) + (cnj a) * ((cnj (inner_prod x y)) + a * (inner_prod y y))"
 proof -
   have "(inner_prod (x+ a \<cdot>\<^sub>v y) (x+a \<cdot>\<^sub>v y)) = (inner_prod (x+a \<cdot>\<^sub>v y) x) + (inner_prod (x+a \<cdot>\<^sub>v y) (a \<cdot>\<^sub>v y))" 
     apply (subst inner_prod_distrib_right) using assms by auto
   also have "\<dots> = inner_prod x x + (a) * (inner_prod x y) + cnj a * ((cnj (inner_prod x y)) + (a) * (inner_prod y y))"
     apply (subst (1 2) inner_prod_distrib_left[of _ n]) apply (auto simp add: assms)
     apply (subst (1 2) inner_prod_smult_right[of _ n]) apply (auto simp add: assms)
     apply (subst inner_prod_smult_left[of _ n]) apply (auto simp add: assms)
     apply (subst inner_prod_swap[of y n x]) apply (auto simp add: assms)
     unfolding distrib_left
     by auto
   finally show ?thesis by (metis self_cscalar_prod_geq_0)
 qed
 
 lemma Cauchy_Schwarz_complex_vec:
   fixes x y :: "complex vec"
   assumes "x \<in> carrier_vec n" and "y \<in> carrier_vec n"
   shows "inner_prod x y * inner_prod y x \<le> inner_prod x x * inner_prod y y"
 proof -
   define cnj_a where "cnj_a = - (inner_prod x y)/ cnj (inner_prod y y)"
   define a where "a = cnj (cnj_a)"
   have cnj_rw: "(cnj a) = cnj_a" 
     unfolding a_def by (simp)
   have rw_0: "cnj (inner_prod x y) + a * (inner_prod y y) = 0"
     unfolding a_def cnj_a_def using assms(1) assms(2) conjugate_square_eq_0_vec by fastforce
   have "0 \<le>  (inner_prod x x + a * (inner_prod x y) + (cnj a) * ((cnj (inner_prod x y)) + a * (inner_prod y y)))"
     using aux_Cauchy assms by auto
   also have "\<dots> =  (inner_prod x x + a * (inner_prod x y))" unfolding rw_0 by auto
   also have "\<dots> =  (inner_prod x x - (inner_prod x y) * cnj (inner_prod x y) / (inner_prod y y))" 
   unfolding a_def cnj_a_def by simp
   finally have " 0 \<le>  (inner_prod x x - (inner_prod x y) * cnj (inner_prod x y) / (inner_prod y y)) " .
-  hence "0 \<le> (inner_prod x x - (inner_prod x y) * cnj (inner_prod x y) / (inner_prod y y)) * (inner_prod y y)" by auto
+  hence "0 \<le> (inner_prod x x - (inner_prod x y) * cnj (inner_prod x y) / (inner_prod y y)) * (inner_prod y y)"
+    by (auto simp: less_eq_complex_def)
   also have "\<dots> = ((inner_prod x x)*(inner_prod y y) - (inner_prod x y) * cnj (inner_prod x y))"
     by (smt add.inverse_neutral add_diff_cancel diff_0 diff_divide_eq_iff divide_cancel_right mult_eq_0_iff nonzero_mult_div_cancel_right rw_0)
   finally have "(inner_prod x y) * cnj (inner_prod x y) \<le> (inner_prod x x)*(inner_prod y y)" by auto
   then show ?thesis 
     apply (subst inner_prod_swap[of y n x]) by (auto simp add: assms)
 qed
 
 subsection \<open>Hermitian adjoint of a matrix\<close>
 
 abbreviation adjoint where "adjoint \<equiv> mat_adjoint"
 
 lemma adjoint_dim_row [simp]:
   "dim_row (adjoint A) = dim_col A" by (simp add: mat_adjoint_def)
 
 lemma adjoint_dim_col [simp]:
   "dim_col (adjoint A) = dim_row A" by (simp add: mat_adjoint_def)
 
 lemma adjoint_dim:
   "A \<in> carrier_mat n n \<Longrightarrow> adjoint A \<in> carrier_mat n n"
   using adjoint_dim_col adjoint_dim_row by blast
 
 lemma adjoint_def:
   "adjoint A = mat (dim_col A) (dim_row A) (\<lambda>(i,j). conjugate (A $$ (j,i)))"
   unfolding mat_adjoint_def mat_of_rows_def by auto
 
 lemma adjoint_eval:
   assumes "i < dim_col A" "j < dim_row A"
   shows "(adjoint A) $$ (i,j) = conjugate (A $$ (j,i))"
   using assms by (simp add: adjoint_def)
 
 lemma adjoint_row:
   assumes "i < dim_col A"
   shows "row (adjoint A) i = conjugate (col A i)"
   apply (rule eq_vecI)
   using assms by (auto simp add: adjoint_eval)
 
 lemma adjoint_col:
   assumes "i < dim_row A"
   shows "col (adjoint A) i = conjugate (row A i)"
   apply (rule eq_vecI)
   using assms by (auto simp add: adjoint_eval)
 
 text \<open>The identity <v, A w> = <A* v, w>\<close>
 lemma adjoint_def_alter:
   fixes v w :: "'a::conjugatable_field vec"
     and A :: "'a::conjugatable_field mat"
   assumes dims: "v \<in> carrier_vec n" "w \<in> carrier_vec m" "A \<in> carrier_mat n m"
   shows "inner_prod v (A *\<^sub>v w) = inner_prod (adjoint A *\<^sub>v v) w" (is "?lhs = ?rhs")
 proof -
   from dims have "?lhs = (\<Sum>i=0..<dim_vec v. (\<Sum>j=0..<dim_vec w.
                 conjugate (v$i) * A$$(i, j) * w$j))"
     apply (simp add: scalar_prod_def sum_distrib_right )
     apply (rule sum.cong, simp)
     apply (rule sum.cong, auto)
     done
   moreover from assms have "?rhs = (\<Sum>i=0..<dim_vec v. (\<Sum>j=0..<dim_vec w.
                 conjugate (v$i) * A$$(i, j) * w$j))"
     apply (simp add: scalar_prod_def  adjoint_eval 
                      sum_conjugate conjugate_dist_mul sum_distrib_left)
     apply (subst sum.swap[where ?A = "{0..<n}"])
     apply (rule sum.cong, simp)
     apply (rule sum.cong, auto)
     done
   ultimately show ?thesis by simp
 qed
 
 lemma adjoint_one:
   shows "adjoint (1\<^sub>m n) = (1\<^sub>m n::complex mat)"
   apply (rule eq_matI) 
   by (auto simp add: adjoint_eval)
 
 lemma adjoint_scale:
   fixes A :: "'a::conjugatable_field mat"
   shows "adjoint (a \<cdot>\<^sub>m A) = (conjugate a) \<cdot>\<^sub>m adjoint A"
   apply (rule eq_matI) using conjugatable_ring_class.conjugate_dist_mul
   by (auto simp add: adjoint_eval)
 
 lemma adjoint_add:
   fixes A B :: "'a::conjugatable_field mat"
   assumes "A \<in> carrier_mat n m" "B \<in> carrier_mat n m"
   shows "adjoint (A + B) = adjoint A + adjoint B"
   apply (rule eq_matI)
   using assms conjugatable_ring_class.conjugate_dist_add 
   by( auto simp add: adjoint_eval)
 
 lemma adjoint_minus:
   fixes A B :: "'a::conjugatable_field mat"
   assumes "A \<in> carrier_mat n m" "B \<in> carrier_mat n m"
   shows "adjoint (A - B) = adjoint A - adjoint B"
   apply (rule eq_matI)
   using assms apply(auto simp add: adjoint_eval)
   by (metis add_uminus_conv_diff conjugate_dist_add conjugate_neg)
 
 lemma adjoint_mult:
   fixes A B :: "'a::conjugatable_field mat"
   assumes "A \<in> carrier_mat n m" "B \<in> carrier_mat m l"
   shows "adjoint (A * B) = adjoint B * adjoint A"
 proof (rule eq_matI, auto simp add: adjoint_eval adjoint_row adjoint_col)
   fix i j
   assume "i < dim_col B" "j < dim_row A"
   show "conjugate (row A j \<bullet> col B i) = conjugate (col B i) \<bullet> conjugate (row A j)"
     using assms apply (simp add: conjugate_scalar_prod)
     apply (subst comm_scalar_prod[where n="dim_row B"])
     by (auto simp add: carrier_vecI)
 qed
 
 lemma adjoint_adjoint:
   fixes A :: "'a::conjugatable_field mat"
   shows "adjoint (adjoint A) = A"
   by (rule eq_matI, auto simp add: adjoint_eval)
 
 lemma trace_adjoint_positive:
   fixes A :: "complex mat"
   shows "trace (A * adjoint A) \<ge> 0"
   apply (auto simp add: trace_def adjoint_col)
   apply (rule sum_nonneg) by auto
 
 subsection \<open>Algebraic manipulations on matrices\<close>
 
 lemma right_add_zero_mat[simp]:
   "(A :: 'a :: monoid_add mat) \<in> carrier_mat nr nc \<Longrightarrow> A + 0\<^sub>m nr nc = A"
   by (intro eq_matI, auto)
 
 lemma add_carrier_mat':
   "A \<in> carrier_mat nr nc \<Longrightarrow> B \<in> carrier_mat nr nc \<Longrightarrow> A + B \<in> carrier_mat nr nc"
   by simp
 
 lemma minus_carrier_mat':
   "A \<in> carrier_mat nr nc \<Longrightarrow> B \<in> carrier_mat nr nc \<Longrightarrow> A - B \<in> carrier_mat nr nc"
   by auto
 
 lemma swap_plus_mat:
   fixes A B C :: "'a::semiring_1 mat"
   assumes "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" "C \<in> carrier_mat n n"
   shows "A + B + C = A + C + B"
   by (metis assms assoc_add_mat comm_add_mat)
 
 lemma uminus_mat:
   fixes A :: "complex mat"
   assumes "A \<in> carrier_mat n n"
   shows "-A = (-1) \<cdot>\<^sub>m A"
   by auto
 
 ML_file "mat_alg.ML"
 method_setup mat_assoc = \<open>mat_assoc_method\<close>
   "Normalization of expressions on matrices"
 
 lemma mat_assoc_test:
   fixes A B C D :: "complex mat"
   assumes "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" "C \<in> carrier_mat n n" "D \<in> carrier_mat n n"
   shows
     "(A * B) * (C * D) = A * B * C * D"
     "adjoint (A * adjoint B) * C = B * (adjoint A * C)"
     "A * 1\<^sub>m n * 1\<^sub>m n * B * 1\<^sub>m n = A * B"
     "(A - B) + (B - C) = A + (-B) + B + (-C)"
     "A + (B - C) = A + B - C"
     "A - (B + C + D) = A - B - C - D"
     "(A + B) * (B + C) = A * B + B * B + A * C + B * C"
     "A - B = A + (-1) \<cdot>\<^sub>m B"
     "A * (B - C) * D = A * B * D - A * C * D"
     "trace (A * B * C) = trace (B * C * A)"
     "trace (A * B * C * D) = trace (C * D * A * B)"
     "trace (A + B * C) = trace A + trace (C * B)"
     "A + B = B + A"
     "A + B + C = C + B + A"
     "A + B + (C + D) = A + C + (B + D)"
   using assms by (mat_assoc n)+
 
 subsection \<open>Hermitian matrices\<close>
 
 text \<open>A Hermitian matrix is a matrix that is equal to its Hermitian adjoint.\<close>
 definition hermitian :: "'a::conjugatable_field mat \<Rightarrow> bool" where
   "hermitian A \<longleftrightarrow> (adjoint A = A)"
 
 lemma hermitian_one:
   shows "hermitian ((1\<^sub>m n)::('a::conjugatable_field mat))"
   unfolding hermitian_def 
 proof-
   have "conjugate (1::'a) = 1"   
     apply (subst mult_1_right[symmetric, of "conjugate 1"])
     apply (subst conjugate_id[symmetric, of "conjugate 1 * 1"])
     apply (subst conjugate_dist_mul)
     apply auto
     done
   then show "adjoint ((1\<^sub>m n)::('a::conjugatable_field mat)) = (1\<^sub>m n)" 
     by (auto simp add: adjoint_eval) 
 qed
 
 subsection \<open>Inverse matrices\<close>
 
 lemma inverts_mat_symm:
   fixes A B :: "'a::field mat"
   assumes dim: "A \<in> carrier_mat n n" "B \<in> carrier_mat n n"
     and AB: "inverts_mat A B"
   shows "inverts_mat B A"
 proof -
   have "A * B = 1\<^sub>m n" using dim AB unfolding inverts_mat_def by auto
   with dim have "B * A = 1\<^sub>m n"  by (rule mat_mult_left_right_inverse)
   then show "inverts_mat B A" using dim inverts_mat_def by auto
 qed
 
 lemma inverts_mat_unique:
   fixes A B C :: "'a::field mat"
   assumes dim: "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" "C \<in> carrier_mat n n" 
     and AB: "inverts_mat A B" and AC: "inverts_mat A C"
   shows "B = C"
 proof -
   have AB1: "A * B = 1\<^sub>m n" using AB dim unfolding inverts_mat_def by auto
   have "A * C = 1\<^sub>m n" using AC dim unfolding inverts_mat_def by auto
   then have CA1: "C * A = 1\<^sub>m n" using mat_mult_left_right_inverse[of A n C] dim by auto
   then have "C = C * 1\<^sub>m n" using dim by auto
   also have "\<dots> = C * (A * B)" using AB1 by auto
   also have "\<dots> = (C * A) * B" using dim by auto
   also have "\<dots> = 1\<^sub>m n * B" using CA1 by auto
   also have "\<dots> = B" using dim by auto
   finally show "B = C" ..
 qed
 
 subsection \<open>Unitary matrices\<close>
 
 text \<open>A unitary matrix is a matrix whose Hermitian adjoint is also its inverse.\<close>
 definition unitary :: "'a::conjugatable_field mat \<Rightarrow> bool" where
   "unitary A \<longleftrightarrow> A \<in> carrier_mat (dim_row A) (dim_row A) \<and> inverts_mat A (adjoint A)"
 
 lemma unitaryD2:
   assumes "A \<in> carrier_mat n n"
   shows "unitary A \<Longrightarrow> inverts_mat (adjoint A) A"
   using assms adjoint_dim inverts_mat_symm unitary_def by blast
 
 lemma unitary_simps [simp]:
   "A \<in> carrier_mat n n \<Longrightarrow> unitary A \<Longrightarrow> adjoint A * A = 1\<^sub>m n"
   "A \<in> carrier_mat n n \<Longrightarrow> unitary A \<Longrightarrow> A * adjoint A = 1\<^sub>m n"
   apply (metis adjoint_dim_row carrier_matD(2) inverts_mat_def unitaryD2)
   by (simp add: inverts_mat_def unitary_def)
 
 lemma unitary_adjoint [simp]:
   assumes "A \<in> carrier_mat n n" "unitary A"
   shows "unitary (adjoint A)" 
   unfolding unitary_def
   using  adjoint_dim[OF assms(1)] assms by (auto simp add: unitaryD2[OF assms] adjoint_adjoint)
 
 lemma unitary_one:
   shows "unitary ((1\<^sub>m n)::('a::conjugatable_field mat))"
   unfolding unitary_def 
 proof -
   define I where I_def[simp]: "I \<equiv> ((1\<^sub>m n)::('a::conjugatable_field mat))"
   have dim: "I \<in> carrier_mat n n" by auto
   have "hermitian I" using hermitian_one  by auto
   hence "adjoint I = I" using hermitian_def by auto
   with dim show "I \<in> carrier_mat (dim_row I) (dim_row I) \<and> inverts_mat I (adjoint I)" 
     unfolding inverts_mat_def using dim by auto
 qed
 
 lemma unitary_zero:
   fixes A :: "'a::conjugatable_field mat"
   assumes "A \<in> carrier_mat 0 0"
   shows "unitary A"
   unfolding unitary_def inverts_mat_def Let_def using assms by auto
 
 lemma unitary_elim:
   assumes dims: "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" "P \<in> carrier_mat n n"
     and uP: "unitary P" and eq: "P * A * adjoint P = P * B * adjoint P"
   shows "A = B"
 proof -
   have dimaP: "adjoint P \<in> carrier_mat n n" using dims by auto
   have iv: "inverts_mat P (adjoint P)" using uP unitary_def by auto
   then have "P * (adjoint P) = 1\<^sub>m n" using inverts_mat_def dims by auto
   then have aPP: "adjoint P * P = 1\<^sub>m n" using mat_mult_left_right_inverse[OF dims(3) dimaP] by auto
   have "adjoint P * (P * A * adjoint P) * P = (adjoint P * P) * A * (adjoint P * P)" 
     using dims dimaP by (mat_assoc n)
   also have "\<dots> = 1\<^sub>m n * A * 1\<^sub>m n" using aPP by auto
   also have "\<dots> = A" using dims by auto
   finally have eqA: "A = adjoint P * (P * A * adjoint P) * P" ..
   have "adjoint P * (P * B * adjoint P) * P = (adjoint P * P) * B * (adjoint P * P)" 
     using dims dimaP by (mat_assoc n)
   also have "\<dots> = 1\<^sub>m n * B * 1\<^sub>m n" using aPP by auto
   also have "\<dots> = B" using dims by auto
   finally have eqB: "B = adjoint P * (P * B * adjoint P) * P" ..
   then show ?thesis using eqA eqB eq by auto
 qed
 
 lemma unitary_is_corthogonal:
   fixes U :: "'a::conjugatable_field mat"
   assumes dim: "U \<in> carrier_mat n n" 
     and U: "unitary U"
   shows "corthogonal_mat U"
   unfolding corthogonal_mat_def Let_def
 proof (rule conjI)
   have dima: "adjoint U \<in> carrier_mat n n" using dim by auto
   have aUU: "mat_adjoint U * U = (1\<^sub>m n)"
     apply (insert U[unfolded unitary_def] dim dima, drule conjunct2)
     apply (drule inverts_mat_symm[of "U", OF dim dima], unfold inverts_mat_def, auto)
     done
   then show "diagonal_mat (mat_adjoint U * U)"
     by (simp add: diagonal_mat_def)
   show "\<forall>i<dim_col U. (mat_adjoint U * U) $$ (i, i) \<noteq> 0" using dim by (simp add: aUU)
 qed
 
 lemma unitary_times_unitary:
   fixes P Q :: "'a:: conjugatable_field mat"
   assumes dim: "P \<in> carrier_mat n n" "Q \<in> carrier_mat n n"
     and uP: "unitary P" and uQ: "unitary Q"
   shows "unitary (P * Q)"
 proof -
   have dim_pq: "P * Q \<in> carrier_mat n n" using dim by auto
   have "(P * Q) * adjoint (P * Q) = P * (Q * adjoint Q) * adjoint P" using dim by (mat_assoc n)
   also have "\<dots> = P * (1\<^sub>m n) * adjoint P" using uQ dim by auto
   also have "\<dots> = P * adjoint P" using dim by (mat_assoc n)
   also have "\<dots> = 1\<^sub>m n" using uP dim by simp
   finally have "(P * Q) * adjoint (P * Q) = 1\<^sub>m n" by auto
   hence "inverts_mat (P * Q) (adjoint (P * Q))" 
     using inverts_mat_def dim_pq by auto
   thus "unitary (P*Q)" using unitary_def dim_pq by auto
 qed
 
 lemma unitary_operator_keep_trace:
   fixes U A :: "complex mat"
   assumes dU: "U \<in> carrier_mat n n" and dA: "A \<in> carrier_mat n n" and u: "unitary U"
   shows "trace A = trace (adjoint U * A * U)"
 proof -
   have u': "U * adjoint U = 1\<^sub>m n" using u unfolding unitary_def inverts_mat_def using dU by auto
   have "trace (adjoint U * A * U) = trace (U * adjoint U * A)" using dU dA by (mat_assoc n)
   also have "\<dots> = trace A" using u' dA by auto
   finally show ?thesis by auto
 qed
 
 subsection \<open>Normalization of vectors\<close>
 
 definition vec_norm :: "complex vec \<Rightarrow> complex" where
   "vec_norm v \<equiv> csqrt (v \<bullet>c v)"
 
 lemma vec_norm_geq_0:
   fixes v :: "complex vec"
   shows "vec_norm v \<ge> 0"
-  unfolding vec_norm_def by (insert self_cscalar_prod_geq_0[of v], simp)
+  unfolding vec_norm_def by (insert self_cscalar_prod_geq_0[of v], simp add: less_eq_complex_def)
 
 lemma vec_norm_zero:
   fixes v ::  "complex vec"
   assumes dim: "v \<in> carrier_vec n"
   shows "vec_norm v = 0 \<longleftrightarrow> v = 0\<^sub>v n"
   unfolding vec_norm_def
   by (subst conjugate_square_eq_0_vec[OF dim, symmetric], rule csqrt_eq_0)
 
 lemma vec_norm_ge_0:
   fixes v ::  "complex vec"
   assumes dim_v: "v \<in> carrier_vec n" and neq0: "v \<noteq> 0\<^sub>v n"
   shows "vec_norm v > 0"
 proof -
   have geq: "vec_norm v \<ge> 0" using vec_norm_geq_0 by auto
   have neq: "vec_norm v \<noteq> 0" 
     apply (insert dim_v neq0)
     apply (drule vec_norm_zero, auto)
     done
   show ?thesis using neq geq by (rule dual_order.not_eq_order_implies_strict)
 qed
 
 definition vec_normalize :: "complex vec \<Rightarrow> complex vec" where
   "vec_normalize v = (if (v = 0\<^sub>v (dim_vec v)) then v else 1 / (vec_norm v) \<cdot>\<^sub>v v)"
 
 lemma normalized_vec_dim[simp]:
   assumes "(v::complex vec) \<in> carrier_vec n"
   shows "vec_normalize v \<in> carrier_vec n"
   unfolding vec_normalize_def using assms by auto
 
 lemma vec_eq_norm_smult_normalized:
   shows "v = vec_norm v \<cdot>\<^sub>v vec_normalize v"
 proof (cases "v = 0\<^sub>v (dim_vec v)")
   define n where "n = dim_vec v"
   then have dimv: "v \<in> carrier_vec n" by auto
   then have dimnv: "vec_normalize v \<in> carrier_vec n" by auto
   {
     case True
     then have v0: "v = 0\<^sub>v n" using n_def by auto
     then have n0: "vec_norm v = 0" using vec_norm_def by auto
     have "vec_norm v \<cdot>\<^sub>v vec_normalize v = 0\<^sub>v n" 
       unfolding smult_vec_def by (auto simp add: n0 carrier_vecD[OF dimnv])
     then show ?thesis using v0 by auto
     next
     case False
     then have v: "v \<noteq> 0\<^sub>v n" using n_def by auto
     then have ge0: "vec_norm v > 0" using vec_norm_ge_0 dimv by auto
     have "vec_normalize v = (1 / vec_norm v) \<cdot>\<^sub>v v" using False vec_normalize_def by auto
     then have "vec_norm v \<cdot>\<^sub>v vec_normalize v = (vec_norm v * (1 / vec_norm v)) \<cdot>\<^sub>v v"
       using smult_smult_assoc by auto
     also have "\<dots> = v" using ge0 by auto
     finally have "v = vec_norm v \<cdot>\<^sub>v vec_normalize v"..
     then show "v = vec_norm v \<cdot>\<^sub>v vec_normalize v" using v by auto
   }
 qed
 
 lemma normalized_cscalar_prod:
   fixes v w :: "complex vec"
   assumes dim_v: "v \<in> carrier_vec n" and dim_w: "w \<in> carrier_vec n"
   shows "v \<bullet>c w = (vec_norm v * vec_norm w) * (vec_normalize v \<bullet>c vec_normalize w)"
   unfolding vec_normalize_def apply (split if_split, split if_split)
 proof (intro conjI impI)
   note dim0 = dim_v dim_w
   have dim: "dim_vec v = n" "dim_vec w = n" using dim0 by auto
   {
     assume "w = 0\<^sub>v n" "v = 0\<^sub>v n"
     then have lhs: "v \<bullet>c w = 0" by auto
     then moreover have rhs: "vec_norm v * vec_norm w * (v \<bullet>c w) = 0" by auto
     ultimately have "v \<bullet>c w = vec_norm v * vec_norm w * (v \<bullet>c w)" by auto
   }
   with dim show "w = 0\<^sub>v (dim_vec w) \<Longrightarrow> v = 0\<^sub>v (dim_vec v) \<Longrightarrow> v \<bullet>c w = vec_norm v * vec_norm w * (v \<bullet>c w)" by auto
   {
     assume asm: "w = 0\<^sub>v n" "v \<noteq> 0\<^sub>v n"
     then have w0: "conjugate w = 0\<^sub>v n" by auto
     with dim0 have "(1 / vec_norm v \<cdot>\<^sub>v v) \<bullet>c w = 0" by auto
     then moreover have rhs: "vec_norm v * vec_norm w * ((1 / vec_norm v \<cdot>\<^sub>v v) \<bullet>c w) = 0" by auto
     moreover have "v \<bullet>c w = 0" using w0 dim0 by auto
     ultimately have "v \<bullet>c w = vec_norm v * vec_norm w * ((1 / vec_norm v \<cdot>\<^sub>v v) \<bullet>c w)" by auto
   }
   with dim show "w = 0\<^sub>v (dim_vec w) \<Longrightarrow> v \<noteq> 0\<^sub>v (dim_vec v) \<Longrightarrow> v \<bullet>c w = vec_norm v * vec_norm w * ((1 / vec_norm v \<cdot>\<^sub>v v) \<bullet>c w)" by auto
   {
     assume asm: "w \<noteq> 0\<^sub>v n" "v = 0\<^sub>v n"
     with dim0 have "v \<bullet>c (1 / vec_norm w \<cdot>\<^sub>v w) = 0" by auto
     then moreover have rhs: "vec_norm v * vec_norm w * (v \<bullet>c (1 / vec_norm w \<cdot>\<^sub>v w)) = 0" by auto
     moreover have "v \<bullet>c w = 0" using asm dim0 by auto
     ultimately have "v \<bullet>c w = vec_norm v * vec_norm w * (v \<bullet>c (1 / vec_norm w \<cdot>\<^sub>v w))" by auto
   }
   with dim show "w \<noteq> 0\<^sub>v (dim_vec w) \<Longrightarrow> v = 0\<^sub>v (dim_vec v) \<Longrightarrow> v \<bullet>c w = vec_norm v * vec_norm w * (v \<bullet>c (1 / vec_norm w \<cdot>\<^sub>v w))" by auto
   {
     assume asmw: "w \<noteq> 0\<^sub>v n" and asmv: "v \<noteq> 0\<^sub>v n"
     have "vec_norm w > 0" by (insert asmw dim0, rule vec_norm_ge_0, auto)
-    then have cw: "conjugate (1 / vec_norm w) = 1 / vec_norm w" by (simp add: complex_eq_iff complex_is_Real_iff) 
+    then have cw: "conjugate (1 / vec_norm w) = 1 / vec_norm w"
+      by (simp add: complex_eq_iff complex_is_Real_iff less_complex_def) 
     from dim0 have 
       "((1 / vec_norm v \<cdot>\<^sub>v v) \<bullet>c (1 / vec_norm w \<cdot>\<^sub>v w)) = 1 / vec_norm v * (v \<bullet>c (1 / vec_norm w \<cdot>\<^sub>v w))" by auto
     also have "\<dots> = 1 / vec_norm v * (v \<bullet> (conjugate (1 / vec_norm w) \<cdot>\<^sub>v conjugate w))"
       by (subst conjugate_smult_vec, auto)
     also have "\<dots> = 1 / vec_norm v * conjugate (1 / vec_norm w) * (v \<bullet> conjugate w)" using dim by auto
     also have "\<dots> = 1 / vec_norm v * (1 / vec_norm w) * (v \<bullet>c w)" using vec_norm_ge_0 cw by auto
     finally have eq1: "(1 / vec_norm v \<cdot>\<^sub>v v) \<bullet>c (1 / vec_norm w \<cdot>\<^sub>v w) = 1 / vec_norm v * (1 / vec_norm w) * (v \<bullet>c w)" .
     then have "vec_norm v * vec_norm w * ((1 / vec_norm v \<cdot>\<^sub>v v) \<bullet>c (1 / vec_norm w \<cdot>\<^sub>v w)) = (v \<bullet>c w)" 
       by (subst eq1, insert vec_norm_ge_0[of v n, OF dim_v asmv] vec_norm_ge_0[of w n, OF dim_w asmw], auto)
   }
   with dim show " w \<noteq> 0\<^sub>v (dim_vec w) \<Longrightarrow> v \<noteq> 0\<^sub>v (dim_vec v) \<Longrightarrow> v \<bullet>c w = vec_norm v * vec_norm w * ((1 / vec_norm v \<cdot>\<^sub>v v) \<bullet>c (1 / vec_norm w \<cdot>\<^sub>v w))" by auto
 qed
 
 lemma normalized_vec_norm :
   fixes v :: "complex vec"
   assumes dim_v: "v \<in> carrier_vec n" 
     and neq0: "v \<noteq> 0\<^sub>v n"
   shows "vec_normalize v \<bullet>c vec_normalize v = 1"
   unfolding vec_normalize_def
 proof (simp, rule conjI)
   show "v = 0\<^sub>v (dim_vec v) \<longrightarrow> v \<bullet>c v = 1" using neq0 dim_v by auto
   have dim_a: "(vec_normalize v) \<in> carrier_vec n" "conjugate (vec_normalize v) \<in> carrier_vec n" using dim_v vec_normalize_def by auto 
   note dim = dim_v dim_a
   have nvge0: "vec_norm v > 0" using vec_norm_ge_0 neq0 dim_v by auto
   then have vvvv: "v \<bullet>c v = (vec_norm v) * (vec_norm v)" unfolding vec_norm_def by (metis power2_csqrt power2_eq_square)
-  from nvge0 have "conjugate (vec_norm v) = vec_norm v" by (simp add: complex_eq_iff complex_is_Real_iff) 
+  from nvge0 have "conjugate (vec_norm v) = vec_norm v"
+    by (simp add: complex_eq_iff complex_is_Real_iff less_complex_def) 
   then have "v \<bullet>c (1 / vec_norm v \<cdot>\<^sub>v v) = 1 / vec_norm v * (v \<bullet>c v)" 
     by (subst conjugate_smult_vec, auto)
   also have "\<dots> = 1 / vec_norm v * vec_norm v * vec_norm v" using vvvv by auto
   also have "\<dots> = vec_norm v" by auto
   finally have "v \<bullet>c (1 / vec_norm v \<cdot>\<^sub>v v) = vec_norm v".
   then show "v \<noteq> 0\<^sub>v (dim_vec v) \<longrightarrow> vec_norm v \<noteq> 0 \<and> v \<bullet>c (1 / vec_norm v \<cdot>\<^sub>v v) = vec_norm v" 
     using neq0 nvge0 by auto
 qed
 
 lemma normalize_zero:
   assumes "v \<in> carrier_vec n"
   shows "vec_normalize v = 0\<^sub>v n \<longleftrightarrow> v = 0\<^sub>v n"
 proof
   show "v = 0\<^sub>v n \<Longrightarrow> vec_normalize v = 0\<^sub>v n" unfolding vec_normalize_def by auto
 next
   have "v \<noteq> 0\<^sub>v n \<Longrightarrow> vec_normalize v \<noteq> 0\<^sub>v n" unfolding vec_normalize_def 
   proof (simp, rule impI)
     assume asm: "v \<noteq> 0\<^sub>v n"
     then have "vec_norm v > 0" using vec_norm_ge_0 assms by auto
-    then have nvge0: "1 / vec_norm v > 0" by (simp add: complex_is_Real_iff)
+    then have nvge0: "1 / vec_norm v > 0" by (simp add: complex_is_Real_iff less_complex_def)
     have "\<exists>k < n. v $ k \<noteq> 0" using asm assms by auto
     then obtain k where kn: "k < n" and  vkneq0: "v $ k \<noteq> 0" by auto
     then have "(1 / vec_norm v \<cdot>\<^sub>v v) $ k = (1 / vec_norm v) * (v $ k)" 
       using assms carrier_vecD index_smult_vec(1) by blast
     with nvge0 vkneq0 have "(1 / vec_norm v \<cdot>\<^sub>v v) $ k \<noteq> 0" by auto
     then show "1 / vec_norm v \<cdot>\<^sub>v v \<noteq> 0\<^sub>v n" using assms kn by fastforce
   qed
   then show "vec_normalize v = 0\<^sub>v n \<Longrightarrow> v = 0\<^sub>v n" by auto
 qed
 
 lemma normalize_normalize[simp]:
   "vec_normalize (vec_normalize v) = vec_normalize v"
 proof (rule disjE[of "v = 0\<^sub>v (dim_vec v)" "v \<noteq> 0\<^sub>v (dim_vec v)"], auto)
   let ?n = "dim_vec v"
 {
   assume "v = 0\<^sub>v ?n"
   then have "vec_normalize v = v" unfolding vec_normalize_def by auto
   then show "vec_normalize (vec_normalize v) = vec_normalize v" by auto
 }
   assume neq0: "v \<noteq> 0\<^sub>v ?n"
   have dim: "v \<in> carrier_vec ?n" by auto
   have "vec_norm (vec_normalize v) = 1" unfolding vec_norm_def
     using normalized_vec_norm[OF dim neq0] by auto
   then show "vec_normalize (vec_normalize v) = vec_normalize v" 
     by (subst (1) vec_normalize_def, simp)
 qed
 
 subsection \<open>Spectral decomposition of normal complex matrices\<close>
 
 lemma normalize_keep_corthogonal:
   fixes vs :: "complex vec list"
   assumes cor: "corthogonal vs" and dims: "set vs \<subseteq> carrier_vec n"
   shows "corthogonal (map vec_normalize vs)"
   unfolding corthogonal_def
 proof (rule allI, rule impI, rule allI, rule impI, goal_cases)
   case c: (1 i j)
   let ?m = "length vs"
   have len: "length (map vec_normalize vs) = ?m" by auto
   have dim: "\<And>k. k < ?m \<Longrightarrow> (vs ! k) \<in> carrier_vec n" using dims by auto
   have map: "\<And>k. k < ?m \<Longrightarrow>  map vec_normalize vs ! k = vec_normalize (vs ! k)" by auto
 
   have eq1: "\<And>j k. j < ?m \<Longrightarrow> k < ?m \<Longrightarrow> ((vs ! j) \<bullet>c (vs ! k) = 0) = (j \<noteq> k)" using assms unfolding corthogonal_def by auto
   then have "\<And>k. k < ?m \<Longrightarrow> (vs ! k) \<bullet>c (vs ! k) \<noteq> 0 " by auto
   then have "\<And>k. k < ?m \<Longrightarrow> (vs ! k) \<noteq> (0\<^sub>v n)" using dim 
     by (auto simp add: conjugate_square_eq_0_vec[of _ n, OF dim])
   then have vnneq0: "\<And>k. k < ?m \<Longrightarrow> vec_norm (vs ! k) \<noteq> 0" using vec_norm_zero[OF dim] by auto
   then have i0: "vec_norm (vs ! i) \<noteq> 0" and j0: "vec_norm (vs ! j) \<noteq> 0" using c by auto
   have "(vs ! i) \<bullet>c (vs ! j) = vec_norm (vs ! i) * vec_norm (vs ! j) * (vec_normalize (vs ! i) \<bullet>c vec_normalize (vs ! j))"
     by (subst normalized_cscalar_prod[of "vs ! i" n "vs ! j"], auto, insert dim c, auto)
   with i0 j0 have "(vec_normalize (vs ! i) \<bullet>c vec_normalize (vs ! j) = 0) = ((vs ! i) \<bullet>c (vs ! j) = 0)" by auto
   with eq1 c have "(vec_normalize (vs ! i) \<bullet>c vec_normalize (vs ! j) = 0) = (i \<noteq> j)" by auto
   with map c show "(map vec_normalize vs ! i \<bullet>c map vec_normalize vs ! j = 0) = (i \<noteq> j)" by auto
 qed
 
 lemma normalized_corthogonal_mat_is_unitary:
   assumes W: "set ws \<subseteq> carrier_vec n"
     and orth: "corthogonal ws"
     and len: "length ws = n"
   shows "unitary (mat_of_cols n (map vec_normalize ws))" (is "unitary ?W")
 proof -
   define vs where "vs = map vec_normalize ws"
   define W where "W = mat_of_cols n vs"
   have W': "set vs \<subseteq> carrier_vec n" using assms vs_def by auto
   then have W'': "\<And>k. k < length vs \<Longrightarrow> vs ! k \<in> carrier_vec n" by auto
   have orth': "corthogonal vs" using assms normalize_keep_corthogonal vs_def by auto
   have len'[simp]: "length vs = n" using assms vs_def by auto
   have dimW: "W \<in> carrier_mat n n" using W_def len by auto
   have "adjoint W \<in> carrier_mat n n" using dimW by auto
   then have dimaW: "mat_adjoint W \<in> carrier_mat n n" by auto
   {
     fix i j assume i: "i < n" and j: "j < n"
     have dimws: "(ws ! i) \<in> carrier_vec n" "(ws ! j) \<in> carrier_vec n" using W len i j by auto
     have "(ws ! i) \<bullet>c (ws ! i) \<noteq> 0" "(ws ! j) \<bullet>c (ws ! j) \<noteq> 0" using orth corthogonal_def[of ws] len i j by auto
     then have neq0: "(ws ! i) \<noteq> 0\<^sub>v n" "(ws ! j) \<noteq> 0\<^sub>v n"
       by (auto simp add: conjugate_square_eq_0_vec[of "ws ! i" n])
     then have "vec_norm (ws ! i) > 0" "vec_norm (ws ! j) > 0" using vec_norm_ge_0 dimws by auto
-    then have ge0: "vec_norm (ws ! i) * vec_norm (ws ! j) > 0" by auto
+    then have ge0: "vec_norm (ws ! i) * vec_norm (ws ! j) > 0" by (auto simp: less_complex_def)
     have ws': "vs ! i = vec_normalize (ws ! i)" 
         "vs ! j = vec_normalize (ws ! j)" 
       using len i j vs_def by auto
     have ii1: "(vs ! i) \<bullet>c (vs ! i) = 1" 
       apply (simp add: ws')
       apply (rule normalized_vec_norm[of "ws ! i"], rule dimws, rule neq0)
       done
     have ij0: "i \<noteq> j \<Longrightarrow> (ws ! i)  \<bullet>c (ws ! j) = 0" using i j 
       by (insert orth, auto simp add: corthogonal_def[of ws] len)
     have "i \<noteq> j \<Longrightarrow> (ws ! i)  \<bullet>c (ws ! j) =  (vec_norm (ws ! i) * vec_norm (ws ! j)) * ((vs ! i) \<bullet>c (vs ! j))"
       apply (auto simp add: ws')
       apply (rule normalized_cscalar_prod)
        apply (rule dimws, rule dimws)
       done
     with ij0 have ij0': "i \<noteq> j \<Longrightarrow> (vs ! i) \<bullet>c (vs ! j) = 0" using ge0 by auto
     have cWk: "\<And>k. k < n \<Longrightarrow> col W k = vs ! k" unfolding W_def 
     apply (subst col_mat_of_cols)
       apply (auto simp add: W'')
       done
     have "(mat_adjoint W * W) $$ (j, i) = row (mat_adjoint W) j \<bullet> col W i"
       by (insert dimW i j dimaW, auto)
     also have "\<dots> = conjugate (col W j) \<bullet> col W i" 
       by (insert dimW i j dimaW, auto simp add: mat_adjoint_def)
     also have "\<dots> = col W i \<bullet> conjugate (col W j)" using comm_scalar_prod[of "col W i" n] dimW by auto
     also have "\<dots> = (vs ! i) \<bullet>c (vs ! j)" using W_def col_mat_of_cols i j len cWk by auto
     finally have "(mat_adjoint W * W) $$ (j, i) = (vs ! i) \<bullet>c (vs ! j)".
     then have "(mat_adjoint W * W) $$ (j, i) = (if (j = i) then 1 else 0)"
       by (auto simp add: ii1 ij0')
   }
   note maWW = this
   then have "mat_adjoint W * W = 1\<^sub>m n" unfolding one_mat_def using dimW dimaW
     by (auto simp add: maWW adjoint_def)
   then have iv0: "adjoint W * W = 1\<^sub>m n"  by auto
   have dimaW: "adjoint W \<in> carrier_mat n n" using dimaW by auto
   then have iv1: "W * adjoint W  = 1\<^sub>m n" using mat_mult_left_right_inverse dimW iv0 by auto
   then show "unitary W" unfolding unitary_def inverts_mat_def using dimW dimaW iv0 iv1 by auto 
 qed
 
 lemma normalize_keep_eigenvector:
   assumes ev: "eigenvector A v e" 
     and dim: "A \<in> carrier_mat n n" "v \<in> carrier_vec n"
   shows "eigenvector A (vec_normalize v) e"
   unfolding eigenvector_def
 proof 
   show "vec_normalize v \<in> carrier_vec (dim_row A)" using dim by auto
   have eg: "A *\<^sub>v v = e \<cdot>\<^sub>v v" using ev dim eigenvector_def by auto
   have vneq0: "v \<noteq> 0\<^sub>v n" using ev dim unfolding eigenvector_def by auto
   then have s0: "vec_normalize v \<noteq> 0\<^sub>v n" 
     by (insert dim, subst normalize_zero[of v], auto)
   from vneq0 have vvge0: "vec_norm v > 0" using vec_norm_ge_0 dim by auto
   have s1: "A *\<^sub>v vec_normalize v = e \<cdot>\<^sub>v vec_normalize v" unfolding vec_normalize_def 
     using vneq0 dim 
     apply (auto, simp add: mult_mat_vec)
     apply (subst eg, auto)
     done
   with s0 dim show "vec_normalize v \<noteq> 0\<^sub>v (dim_row A) \<and> A *\<^sub>v vec_normalize v = e \<cdot>\<^sub>v vec_normalize v" by auto
 qed
 
 lemma four_block_mat_adjoint:
   fixes A B C D :: "'a::conjugatable_field mat"
   assumes dim: "A \<in> carrier_mat nr1 nc1" "B \<in> carrier_mat nr1 nc2"
   "C \<in> carrier_mat nr2 nc1" "D \<in> carrier_mat nr2 nc2"
   shows "adjoint (four_block_mat A B C D) 
     = four_block_mat (adjoint A) (adjoint C) (adjoint B) (adjoint D)"
   by (rule eq_matI, insert dim, auto simp add: adjoint_eval)
 
 fun unitary_schur_decomposition :: "complex mat \<Rightarrow> complex list \<Rightarrow> complex mat \<times> complex mat \<times> complex mat" where 
   "unitary_schur_decomposition A [] = (A, 1\<^sub>m (dim_row A), 1\<^sub>m (dim_row A))"
 | "unitary_schur_decomposition A (e # es) = (let
        n = dim_row A;
        n1 = n - 1;
        v' = find_eigenvector A e;
        v = vec_normalize v';
        ws0 = gram_schmidt n (basis_completion v);
        ws = map vec_normalize ws0;
        W = mat_of_cols n ws;
        W' = corthogonal_inv W;
        A' = W' * A * W;
        (A1,A2,A0,A3) = split_block A' 1 1;
        (B,P,Q) = unitary_schur_decomposition A3 es;
        z_row = (0\<^sub>m 1 n1);
        z_col = (0\<^sub>m n1 1);
        one_1 = 1\<^sub>m 1
      in (four_block_mat A1 (A2 * P) A0 B, 
      W * four_block_mat one_1 z_row z_col P, 
      four_block_mat one_1 z_row z_col Q * W'))"
 
 theorem unitary_schur_decomposition:
   assumes A: "(A::complex mat) \<in> carrier_mat n n"
       and c: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> es. [:- e, 1:])"
       and B: "unitary_schur_decomposition A es = (B,P,Q)"
   shows "similar_mat_wit A B P Q \<and> upper_triangular B \<and> diag_mat B = es \<and> unitary P \<and> (Q = adjoint P)"
   using assms
 proof (induct es arbitrary: n A B P Q)
   case Nil
   with degree_monic_char_poly[of A n] 
   show ?case by (auto intro: similar_mat_wit_refl simp: diag_mat_def unitary_zero)
 next
   case (Cons e es n A C P Q)
   let ?n1 = "n - 1"
   from Cons have A: "A \<in> carrier_mat n n" and dim: "dim_row A = n" by auto
   let ?cp = "char_poly A"
   from Cons(3)
   have cp: "?cp = [: -e, 1 :] * (\<Prod>e \<leftarrow> es. [:- e, 1:])" by auto
   have mon: "monic (\<Prod>e\<leftarrow> es. [:- e, 1:])" by (rule monic_prod_list, auto)
   have deg: "degree ?cp = Suc (degree (\<Prod>e\<leftarrow> es. [:- e, 1:]))" unfolding cp
     by (subst degree_mult_eq, insert mon, auto)
   with degree_monic_char_poly[OF A] have n: "n \<noteq> 0" by auto
   define v' where "v' = find_eigenvector A e"
   define v where "v = vec_normalize v'"
   define b where "b = basis_completion v"
   define ws0 where "ws0 = gram_schmidt n b"
   define ws where "ws = map vec_normalize ws0"
   define W where "W = mat_of_cols n ws"
   define W' where "W' = corthogonal_inv W"
   define A' where "A' = W' * A * W"
   obtain A1 A2 A0 A3 where splitA': "split_block A' 1 1 = (A1,A2,A0,A3)"
     by (cases "split_block A' 1 1", auto)
   obtain B P' Q' where schur: "unitary_schur_decomposition A3 es = (B,P',Q')" 
     by (cases "unitary_schur_decomposition A3 es", auto)
   let ?P' = "four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 ?n1) (0\<^sub>m ?n1 1) P'"
   let ?Q' = "four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 ?n1) (0\<^sub>m ?n1 1) Q'"
   have C: "C = four_block_mat A1 (A2 * P') A0 B" and P: "P = W * ?P'" and Q: "Q = ?Q' * W'"
     using Cons(4) unfolding unitary_schur_decomposition.simps
     Let_def list.sel dim
     v'_def[symmetric] v_def[symmetric] b_def[symmetric] ws0_def[symmetric] ws_def[symmetric] W'_def[symmetric] W_def[symmetric]
     A'_def[symmetric] split splitA' schur by auto
   have e: "eigenvalue A e" 
     unfolding eigenvalue_root_char_poly[OF A] cp by simp
   from find_eigenvector[OF A e] have ev': "eigenvector A v' e" unfolding v'_def .
   then have "v' \<in> carrier_vec n" unfolding eigenvector_def using A by auto
   with ev' have ev: "eigenvector A v e" unfolding v_def using A dim normalize_keep_eigenvector by auto
   from this[unfolded eigenvector_def]
   have v[simp]: "v \<in> carrier_vec n" and v0: "v \<noteq> 0\<^sub>v n" using A by auto
   interpret cof_vec_space n "TYPE(complex)" .
   from basis_completion[OF v v0, folded b_def]
   have span_b: "span (set b) = carrier_vec n" and dist_b: "distinct b" 
     and indep: "\<not> lin_dep (set b)" and b: "set b \<subseteq> carrier_vec n" and hdb: "hd b = v" 
     and len_b: "length b = n" by auto
   from hdb len_b n obtain vs where bv: "b = v # vs" by (cases b, auto)
   from gram_schmidt_result[OF b dist_b indep refl, folded ws0_def]
   have ws0: "set ws0 \<subseteq> carrier_vec n" "corthogonal ws0" "length ws0 = n" 
     by (auto simp: len_b)
   then have ws: "set ws \<subseteq> carrier_vec n" "corthogonal ws" "length ws = n" unfolding ws_def
     using normalize_keep_corthogonal by auto
   have ws0ne: "ws0 \<noteq> []" using \<open>length ws0 = n\<close> n by auto
   from gram_schmidt_hd[OF v, of vs, folded bv] have hdws0: "hd ws0 = (vec_normalize v')" unfolding ws0_def v_def .
   have "hd ws = vec_normalize (hd ws0)" unfolding ws_def using hd_map[OF ws0ne]  by auto
   then have hdws: "hd ws = v" unfolding v_def using normalize_normalize[of v'] hdws0 by auto
   have orth_W: "corthogonal_mat W" using orthogonal_mat_of_cols ws unfolding W_def.
   have W: "W \<in> carrier_mat n n"
     using ws unfolding W_def using mat_of_cols_carrier(1)[of n ws] by auto
   have W': "W' \<in> carrier_mat n n" unfolding W'_def corthogonal_inv_def using W 
     by (auto simp: mat_of_rows_def)  
   from corthogonal_inv_result[OF orth_W] 
   have W'W: "inverts_mat W' W" unfolding W'_def .
   hence WW': "inverts_mat W W'" using mat_mult_left_right_inverse[OF W' W] W' W
     unfolding inverts_mat_def by auto
   have A': "A' \<in> carrier_mat n n" using W W' A unfolding A'_def by auto
   have A'A_wit: "similar_mat_wit A' A W' W"
     by (rule similar_mat_witI[of _ _ n], insert W W' A A' W'W WW', auto simp: A'_def
     inverts_mat_def)
   hence A'A: "similar_mat A' A" unfolding similar_mat_def by blast
   from similar_mat_wit_sym[OF A'A_wit] have simAA': "similar_mat_wit A A' W W'" by auto
   have eigen[simp]: "A *\<^sub>v v = e \<cdot>\<^sub>v v" and v0: "v \<noteq> 0\<^sub>v n"
     using v_def v'_def find_eigenvector[OF A e] A normalize_keep_eigenvector
     unfolding eigenvector_def by auto
   let ?f = "(\<lambda> i. if i = 0 then e else 0)"
   have col0: "col A' 0 = vec n ?f"
     unfolding A'_def W'_def W_def
     using corthogonal_col_ev_0[OF A v v0 eigen n hdws ws].
   from A' n have "dim_row A' = 1 + ?n1" "dim_col A' = 1 + ?n1" by auto
   from split_block[OF splitA' this] have A2: "A2 \<in> carrier_mat 1 ?n1"
     and A3: "A3 \<in> carrier_mat ?n1 ?n1" 
     and A'block: "A' = four_block_mat A1 A2 A0 A3" by auto
   have A1id: "A1 = mat 1 1 (\<lambda> _. e)"
     using splitA'[unfolded split_block_def Let_def] arg_cong[OF col0, of "\<lambda> v. v $ 0"] A' n
     by (auto simp: col_def)
   have A1: "A1 \<in> carrier_mat 1 1" unfolding A1id by auto
   {
     fix i
     assume "i < ?n1"
     with arg_cong[OF col0, of "\<lambda> v. v $ Suc i"] A'
     have "A' $$ (Suc i, 0) = 0" by auto
   } note A'0 = this
   have A0id: "A0 = 0\<^sub>m ?n1 1"
     using splitA'[unfolded split_block_def Let_def] A'0 A' by auto
   have A0: "A0 \<in> carrier_mat ?n1 1" unfolding A0id by auto
   from cp char_poly_similar[OF A'A]
   have cp: "char_poly A' = [: -e,1 :] * (\<Prod> e \<leftarrow> es. [:- e, 1:])" by simp
   also have "char_poly A' = char_poly A1 * char_poly A3" 
     unfolding A'block A0id
     by (rule char_poly_four_block_zeros_col[OF A1 A2 A3])
   also have "char_poly A1 = [: -e,1 :]"
     by (simp add: A1id char_poly_defs det_def)
   finally have cp: "char_poly A3 = (\<Prod> e \<leftarrow> es. [:- e, 1:])"
     by (metis mult_cancel_left pCons_eq_0_iff zero_neq_one)
   from Cons(1)[OF A3 cp schur]
   have simIH: "similar_mat_wit A3 B P' Q'" and ut: "upper_triangular B" and diag: "diag_mat B = es"
     and uP': "unitary P'" and Q'P': "Q' = adjoint P'"
     by auto
   from similar_mat_witD2[OF A3 simIH] 
   have B: "B \<in> carrier_mat ?n1 ?n1" and P': "P' \<in> carrier_mat ?n1 ?n1" and Q': "Q' \<in> carrier_mat ?n1 ?n1" 
     and PQ': "P' * Q' = 1\<^sub>m ?n1" by auto
   have A0_eq: "A0 = P' * A0 * 1\<^sub>m 1" unfolding A0id using P' by auto
   have simA'C: "similar_mat_wit A' C ?P' ?Q'" unfolding A'block C
     by (rule similar_mat_wit_four_block[OF similar_mat_wit_refl[OF A1] simIH _ A0_eq A1 A3 A0],
     insert PQ' A2 P' Q', auto)
   have ut1: "upper_triangular A1" unfolding A1id by auto
   have ut: "upper_triangular C" unfolding C A0id
     by (intro upper_triangular_four_block[OF _ B ut1 ut], auto simp: A1id)
   from A1id have diagA1: "diag_mat A1 = [e]" unfolding diag_mat_def by auto
   from diag_four_block_mat[OF A1 B] have diag: "diag_mat C = e # es" unfolding diag diagA1 C by simp
 
   have aW: "adjoint W \<in> carrier_mat n n" using W by auto
   have aW': "adjoint W' \<in> carrier_mat n n" using W' by auto
   have "unitary W" using W_def ws_def ws0 normalized_corthogonal_mat_is_unitary by auto
   then have ivWaW: "inverts_mat W (adjoint W)" using unitary_def W aW by auto
   with WW' have W'aW: "W' = (adjoint W)" using inverts_mat_unique W W' aW by auto
   then have "adjoint W' = W" using adjoint_adjoint by auto
   with ivWaW have "inverts_mat W' (adjoint W')" using inverts_mat_symm W aW W'aW by auto
   then have "unitary W'" using unitary_def W' by auto
 
   have newP': "P' \<in> carrier_mat (n - Suc 0) (n - Suc 0)" using P' by auto
   have rl: "\<And> x1 x2 x3 x4 y1 y2 y3 y4 f. x1 = y1 \<Longrightarrow> x2 = y2 \<Longrightarrow> x3 = y3 \<Longrightarrow> x4 = y4 \<Longrightarrow> f x1 x2 x3 x4 = f y1 y2 y3 y4" by simp
   have Q'aP': "?Q' = adjoint ?P'"
     apply (subst four_block_mat_adjoint, auto simp add: newP')
     apply (rule rl[where f2 = four_block_mat])
        apply (auto simp add: eq_matI adjoint_eval Q'P')
     done
   have "adjoint P = adjoint ?P' * adjoint W"  using W newP' n
     apply (simp add: P)
     apply (subst adjoint_mult[of W, symmetric])
      apply (auto simp add: W P' carrier_matD[of W n n])
     done
   also have "\<dots> = ?Q' * W'" using Q'aP' W'aW by auto
   also have "\<dots> = Q" using Q by auto
   finally have QaP: "Q = adjoint P" ..
 
   from similar_mat_wit_trans[OF simAA' simA'C, folded P Q] have smw: "similar_mat_wit A C P Q" by blast
   then have dimP: "P \<in> carrier_mat n n" and dimQ: "Q \<in> carrier_mat n n" unfolding similar_mat_wit_def using A by auto
   from smw have "P * Q = 1\<^sub>m n" unfolding similar_mat_wit_def using A  by auto
   then have "inverts_mat P Q" using inverts_mat_def dimP by auto
   then have uP: "unitary P" using QaP unitary_def dimP by auto
     
   from ut similar_mat_wit_trans[OF simAA' simA'C, folded P Q] diag uP QaP
   show ?case by blast
 qed
 
 lemma complex_mat_char_poly_factorizable:
   fixes A :: "complex mat"
   assumes "A \<in> carrier_mat n n"
   shows "\<exists>as. char_poly A =  (\<Prod> a \<leftarrow> as. [:- a, 1:]) \<and> length as = n"
 proof -
   let ?ca = "char_poly A"
   have ex0: "\<exists>bs. Polynomial.smult (lead_coeff ?ca) (\<Prod>b\<leftarrow>bs. [:- b, 1:]) = ?ca \<and>
      length bs = degree ?ca"
     by (simp add: fundamental_theorem_algebra_factorized)
   then obtain bs where " Polynomial.smult (lead_coeff ?ca) (\<Prod>b\<leftarrow>bs. [:- b, 1:]) = ?ca \<and>
      length bs = degree ?ca" by auto
   moreover have "lead_coeff ?ca = (1::complex)" 
     using assms degree_monic_char_poly by blast
   ultimately have ex1: "?ca = (\<Prod>b\<leftarrow>bs. [:- b, 1:]) \<and> length bs = degree ?ca" by auto
   moreover have "degree ?ca = n"
     by (simp add: assms degree_monic_char_poly)
   ultimately show ?thesis by auto
 qed
 
 lemma complex_mat_has_unitary_schur_decomposition:
   fixes A :: "complex mat"
   assumes "A \<in> carrier_mat n n"
   shows "\<exists>B P es. similar_mat_wit A B P (adjoint P) \<and> unitary P 
     \<and> char_poly A = (\<Prod> (e :: complex) \<leftarrow> es. [:- e, 1:]) \<and> diag_mat B = es"
 proof -
   have "\<exists>es. char_poly A =  (\<Prod> e \<leftarrow> es. [:- e, 1:]) \<and> length es = n" 
     using assms by (simp add: complex_mat_char_poly_factorizable)
   then obtain es where es: "char_poly A =  (\<Prod> e \<leftarrow> es. [:- e, 1:]) \<and> length es = n" by auto
   obtain B P Q where B: "unitary_schur_decomposition A es = (B,P,Q)" by (cases "unitary_schur_decomposition A es", auto)
 
   have "similar_mat_wit A B P Q \<and> upper_triangular B \<and> unitary P \<and> (Q = adjoint P) \<and> 
    char_poly A = (\<Prod> (e :: complex) \<leftarrow> es. [:- e, 1:]) \<and> diag_mat B = es" using assms es B
     by (auto simp add: unitary_schur_decomposition)
   then show ?thesis by auto
 qed
 
 lemma normal_upper_triangular_matrix_is_diagonal:
   fixes A :: "'a::conjugatable_ordered_field mat"
   assumes "A \<in> carrier_mat n n"
     and tri: "upper_triangular A"
     and norm: "A * adjoint A = adjoint A * A"
   shows "diagonal_mat A"
 proof (rule disjE[of "n = 0" "n > 0"], blast)
   have dim: "dim_row A = n" "dim_col A = n" using assms by auto
   from norm have eq0: "\<And>i j. (A * adjoint A)$$(i,j) = (adjoint A * A)$$(i,j)" by auto
   have nat_induct_strong: 
     "\<And>P. (P::nat\<Rightarrow>bool) 0 \<Longrightarrow> (\<And>i. i < n \<Longrightarrow> (\<And>k. k < i \<Longrightarrow> P k) \<Longrightarrow> P i) \<Longrightarrow> (\<And>i. i < n \<Longrightarrow> P i)"
     by (metis dual_order.strict_trans infinite_descent0 linorder_neqE_nat)
   show "n = 0 \<Longrightarrow> ?thesis" using dim unfolding diagonal_mat_def by auto
   show "n > 0 \<Longrightarrow> ?thesis" unfolding diagonal_mat_def dim
     apply (rule allI, rule impI)
     apply (rule nat_induct_strong)
   proof (rule allI, rule impI, rule impI)
     assume asm: "n > 0"
     from tri upper_triangularD[of A 0 j] dim have z0: "\<And>j. 0< j \<Longrightarrow> j < n \<Longrightarrow> A$$(j, 0) = 0" 
       by auto
     then have ada00: "(adjoint A * A)$$(0,0) = conjugate (A$$(0,0)) * A$$(0,0)"
       using asm dim by (auto simp add: scalar_prod_def adjoint_eval sum.atLeast_Suc_lessThan)
     have aad00: "(A * adjoint A)$$(0,0) = (\<Sum>k=0..<n. A$$(0, k) * conjugate (A$$(0, k)))"
       using asm dim by (auto simp add: scalar_prod_def adjoint_eval)
     moreover have 
       "\<dots> = A$$(0,0) * conjugate (A$$(0,0))
           + (\<Sum>k=1..<n. A$$(0, k) * conjugate (A$$(0, k)))"
       using dim asm by (subst sum.atLeast_Suc_lessThan[of 0 n "\<lambda>k. A$$(0, k) * conjugate (A$$(0, k))"], auto)
     ultimately have f1tneq0: "(\<Sum>k=(Suc 0)..<n. A$$(0, k) * conjugate (A$$(0, k))) = 0"
       using eq0 ada00 by (simp)
     have geq0: "\<And>k. k < n \<Longrightarrow> A$$(0, k) * conjugate (A$$(0, k)) \<ge> 0"  
       using conjugate_square_positive by auto
     have "\<And>k. 1 \<le> k \<Longrightarrow> k < n \<Longrightarrow> A$$(0, k) * conjugate (A$$(0, k)) = 0"
       by (rule sum_nonneg_0[of "{1..<n}"], auto, rule geq0, auto, rule f1tneq0)
     with dim asm show 
       case0: "\<And>j. 0 < n \<Longrightarrow> j < n \<Longrightarrow> 0 \<noteq> j \<Longrightarrow> A $$ (0, j) = 0"
       by auto
     {
       fix i
       assume asm: "n > 0" "i < n" "i > 0"
         and ih: "\<And>k. k < i \<Longrightarrow> \<forall>j<n. k \<noteq> j \<longrightarrow> A $$ (k, j) = 0"
       then have "\<And>j. j<n \<Longrightarrow> i \<noteq> j \<Longrightarrow> A $$ (i, j) = 0"
       proof -
         have inter_part: "\<And>b m e. (b::nat) < e \<Longrightarrow> b < m \<Longrightarrow> m < e \<Longrightarrow> {b..<m} \<union> {m..<e} = {b..<e}" by auto
         then have  
           "\<And>b m e f. (b::nat) < e \<Longrightarrow> b < m \<Longrightarrow> m < e 
             \<Longrightarrow> (\<Sum>k=b..<e. f k) = (\<Sum>k\<in>{b..<m}\<union>{m..<e}. f k)"
           using sum.union_disjoint by auto
         then have sum_part:
           "\<And>b m e f. (b::nat) < e \<Longrightarrow> b < m \<Longrightarrow> m < e 
                       \<Longrightarrow> (\<Sum>k=b..<e. f k) = (\<Sum>k=b..<m. f k) + (\<Sum>k=m..<e. f k)"
           by (auto simp add: sum.union_disjoint)
         from tri upper_triangularD[of A j i] asm dim have 
             zsi0: "\<And>j. j < i \<Longrightarrow> A$$(i, j) = 0" by auto
         from tri upper_triangularD[of A j i] asm dim have 
             zsi1: "\<And>k. i < k \<Longrightarrow> k < n \<Longrightarrow> A$$(k, i) = 0" by auto
         have 
           "(A * adjoint A)$$(i, i) 
           = (\<Sum>k=0..<n. conjugate (A$$(i, k)) * A$$(i, k))" using asm dim
           apply (auto simp add: scalar_prod_def adjoint_eval)
           apply (rule sum.cong, auto)
           done
         also have
           "\<dots> = (\<Sum>k=0..<i. conjugate (A$$(i, k)) * A$$(i, k))
               + (\<Sum>k=i..<n. conjugate (A$$(i, k)) * A$$(i, k))"
           using asm
           by (auto simp add: sum_part[of 0 n i])
         also have
           "\<dots> = (\<Sum>k=i..<n. conjugate (A$$(i, k)) * A$$(i, k))"
           using zsi0
           by auto
         also have
           "\<dots> = conjugate (A$$(i, i)) * A$$(i, i) 
             + (\<Sum>k=(Suc i)..<n. conjugate (A$$(i, k)) * A$$(i, k))"
           using asm
           by (auto simp add: sum.atLeast_Suc_lessThan)
         finally have
           adaii: "(A * adjoint A)$$(i, i) 
             = conjugate (A$$(i, i)) * A$$(i, i) 
             + (\<Sum>k=(Suc i)..<n. conjugate (A$$(i, k)) * A$$(i, k))" .
         have 
           "(adjoint A * A)$$(i, i) = (\<Sum>k=0..<n. conjugate (A$$(k, i)) * A$$(k, i))"
           using asm dim by (auto simp add: scalar_prod_def adjoint_eval)
         also have
           "\<dots> = (\<Sum>k=0..<i. conjugate (A$$(k, i)) * A$$(k, i))
               + (\<Sum>k=i..<n. conjugate (A$$(k, i)) * A$$(k, i))"
           using asm by (auto simp add: sum_part[of 0 n i])
         also have 
             "\<dots> = (\<Sum>k=i..<n. conjugate (A$$(k, i)) * A$$(k, i))"
           using asm ih by auto
         also have
             "\<dots> = conjugate (A$$(i, i)) * A$$(i, i)"
           using asm zsi1 by (auto simp add: sum.atLeast_Suc_lessThan)
         finally have "(adjoint A * A)$$(i, i) = conjugate (A$$(i, i)) * A$$(i, i)" .
         with adaii eq0 have 
           fsitoneq0: "(\<Sum>k=(Suc i)..<n. conjugate (A$$(i, k)) * A$$(i, k)) = 0" by auto
         have "\<And>k. k<n \<Longrightarrow> i < k \<Longrightarrow> conjugate (A$$(i, k)) * A$$(i, k) = 0"
           by (rule sum_nonneg_0[of "{(Suc i)..<n}"], auto, subst mult.commute, 
               rule conjugate_square_positive, rule fsitoneq0)
         then have "\<And>k. k<n  \<Longrightarrow> i<k \<Longrightarrow> A $$ (i, k) = 0" by auto
         with zsi0 show "\<And>j. j<n \<Longrightarrow> i \<noteq> j \<Longrightarrow> A $$ (i, j) = 0" 
           by (metis linorder_neqE_nat)
       qed
     }
     with case0 show "\<And>i ia.
        0 < n \<Longrightarrow>
        i < n \<Longrightarrow>
        ia < n \<Longrightarrow>
        (\<And>k. k < ia \<Longrightarrow> \<forall>j<n. k \<noteq> j \<longrightarrow> A $$ (k, j) = 0) \<Longrightarrow>
        \<forall>j<n. ia \<noteq> j \<longrightarrow> A $$ (ia, j) = 0" by auto
   qed
 qed
 
 lemma normal_complex_mat_has_spectral_decomposition:
   assumes A: "(A::complex mat) \<in> carrier_mat n n"
     and normal: "A * adjoint A  = adjoint A * A"
     and c: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> es. [:- e, 1:])"
     and B: "unitary_schur_decomposition A es = (B,P,Q)"
   shows "similar_mat_wit A B P (adjoint P) \<and> diagonal_mat B \<and> diag_mat B = es \<and> unitary P"
 proof -
   have smw: "similar_mat_wit A B P (adjoint P)" 
     and ut: "upper_triangular B"
     and uP: "unitary P" 
     and dB: "diag_mat B = es"
     and "(Q = adjoint P)"
     using assms by (auto simp add: unitary_schur_decomposition)
   from smw have dimP: "P \<in> carrier_mat n n" and dimB: "B \<in> carrier_mat n n" 
     and dimaP: "adjoint P \<in> carrier_mat n n"
     unfolding similar_mat_wit_def using A by auto
   have dimaB: "adjoint B \<in> carrier_mat n n" using dimB by auto
   note dims = dimP dimB dimaP dimaB
 
   have "inverts_mat P (adjoint P)" using unitary_def uP dims by auto
   then have iaPP: "inverts_mat (adjoint P) P" using inverts_mat_symm using dims by auto
   have aPP: "adjoint P * P = 1\<^sub>m n" using dims iaPP unfolding inverts_mat_def by auto
   from smw have A: "A = P * B * (adjoint P)" unfolding similar_mat_wit_def Let_def by auto
   then have aA: "adjoint A = P * adjoint B * adjoint P" 
     by (insert A dimP dimB dimaP, auto simp add: adjoint_mult[of _ n n _ n] adjoint_adjoint)
   have "A * adjoint A = (P * B * adjoint P) * (P * adjoint B * adjoint P)" using A aA by auto
   also have "\<dots> = P * B * (adjoint P * P) * (adjoint B * adjoint P)" using dims by (mat_assoc n)
   also have "\<dots> = P * B * 1\<^sub>m n * (adjoint B * adjoint P)" using dims aPP by (auto)
   also have "\<dots> = P * B * adjoint B * adjoint P" using dims by (mat_assoc n)
   finally have "A * adjoint A = P * B * adjoint B * adjoint P".
   then have "adjoint P * (A * adjoint A) * P = (adjoint P * P) * B * adjoint B * (adjoint P * P)"
     using dims by (simp add: assoc_mult_mat[of _ n n _ n _ n])
   also have "\<dots> = 1\<^sub>m n * B * adjoint B * 1\<^sub>m n" using aPP by auto
   also have "\<dots> = B * adjoint B" using dims by auto
   finally have eq0: "adjoint P * (A * adjoint A) * P = B * adjoint B".
 
   have "adjoint A * A = (P * adjoint B * adjoint P) * (P * B * adjoint P)" using A aA by auto
   also have "\<dots> = P * adjoint B * (adjoint P * P) * (B * adjoint P)" using dims by (mat_assoc n)
   also have "\<dots> = P * adjoint B * 1\<^sub>m n * (B * adjoint P)" using dims aPP by (auto)
   also have "\<dots> = P * adjoint B * B * adjoint P" using dims by (mat_assoc n)  
   finally have "adjoint A * A = P * adjoint B * B * adjoint P" by auto
   then have "adjoint P * (adjoint A * A) * P = (adjoint P * P) * adjoint B * B * (adjoint P * P)"
     using dims by (simp add: assoc_mult_mat[of _ n n _ n _ n])
   also have "\<dots> = 1\<^sub>m n * adjoint B * B * 1\<^sub>m n" using aPP by auto
   also have "\<dots> = adjoint B * B" using dims by auto
   finally have eq1: "adjoint P * (adjoint A * A) * P = adjoint B * B".
 
   from normal have "adjoint P * (adjoint A * A) * P = adjoint P * (A * adjoint A) * P" by auto
   with eq0 eq1 have "B * adjoint B = adjoint B * B" by auto
   with ut dims have "diagonal_mat B" using normal_upper_triangular_matrix_is_diagonal by auto
   with smw uP dB show "similar_mat_wit A B P (adjoint P) \<and> diagonal_mat B \<and> diag_mat B = es \<and> unitary P" by auto
 qed
 
 lemma complex_mat_has_jordan_nf:
   fixes A :: "complex mat"
   assumes "A \<in> carrier_mat n n"
   shows "\<exists>n_as. jordan_nf A n_as"
 proof -
   have "\<exists>as. char_poly A =  (\<Prod> a \<leftarrow> as. [:- a, 1:]) \<and> length as = n" 
     using assms by (simp add: complex_mat_char_poly_factorizable)
   then show ?thesis using assms
     by (auto simp add: jordan_nf_iff_linear_factorization)
 qed
 
 lemma hermitian_is_normal:
   assumes "hermitian A"
   shows "A * adjoint A = adjoint A * A"
   using assms by (auto simp add: hermitian_def)
 
 lemma hermitian_eigenvalue_real:
   assumes dim: "(A::complex mat) \<in> carrier_mat n n"
     and hA: "hermitian A"
     and c: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> es. [:- e, 1:])"
     and B: "unitary_schur_decomposition A es = (B,P,Q)"
   shows "similar_mat_wit A B P (adjoint P) \<and> diagonal_mat B \<and> diag_mat B = es 
     \<and> unitary P \<and> (\<forall>i < n. B$$(i, i) \<in> Reals)"
 proof -
   have normal: "A * adjoint A = adjoint A * A" using hA hermitian_is_normal by auto
   then have schur: "similar_mat_wit A B P (adjoint P) \<and> diagonal_mat B \<and> diag_mat B = es \<and> unitary P"
     using normal_complex_mat_has_spectral_decomposition[OF dim normal c B] by (simp)
   then have "similar_mat_wit A B P (adjoint P)" 
     and uP: "unitary P" and dB: "diag_mat B = es"
     using assms by auto
   then have A: "A = P * B * (adjoint P)" 
     and dimB: "B \<in> carrier_mat n n" and dimP: "P \<in> carrier_mat n n"
     unfolding similar_mat_wit_def Let_def using dim by auto
   then have dimaB: "adjoint B \<in> carrier_mat n n" by auto
   have "adjoint A = adjoint (adjoint P) * adjoint (P * B)" 
     apply (subst A)
     apply (subst adjoint_mult[of "P * B" n n "adjoint P" n])
       apply (insert dimB dimP, auto)
     done
   also have "\<dots> = P * adjoint (P * B)" by (auto simp add: adjoint_adjoint)
   also have "\<dots> = P * (adjoint B * adjoint P)" using dimB dimP by (auto simp add: adjoint_mult)
   also have "\<dots> = P * adjoint B * adjoint P" using dimB dimP by (subst assoc_mult_mat[symmetric, of P n n "adjoint B" n "adjoint P" n], auto)
   finally have aA: "adjoint A = P * adjoint B * adjoint P" .
   have "A = adjoint A" using hA hermitian_def[of A] by auto
   then have "P * B * adjoint P = P * adjoint B * adjoint P" using A aA by auto
   then have BaB: "B = adjoint B" using unitary_elim[OF dimB dimaB dimP] uP by auto
   {
     fix i 
     assume "i < n"
     then have "B$$(i, i) = conjugate (B$$(i, i))" 
       apply (subst BaB)
       by (insert dimB, simp add: adjoint_eval)
     then have "B$$(i, i) \<in> Reals" unfolding conjugate_complex_def 
       using Reals_cnj_iff by auto
   }
   then have "\<forall>i<n. B$$(i, i) \<in> Reals" by auto
   with schur show ?thesis by auto
 qed
 
 lemma hermitian_inner_prod_real:
   assumes dimA: "(A::complex mat) \<in> carrier_mat n n"
     and dimv: "v \<in> carrier_vec n"
     and hA: "hermitian A"
   shows "inner_prod v (A *\<^sub>v v) \<in> Reals"
 proof -
   obtain es where es: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> es. [:- e, 1:])" 
     using complex_mat_char_poly_factorizable dimA by auto
   obtain B P Q where "unitary_schur_decomposition A es = (B,P,Q)" 
     by (cases "unitary_schur_decomposition A es", auto)
   then have "similar_mat_wit A B P (adjoint P) \<and> diagonal_mat B \<and> diag_mat B = es 
     \<and> unitary P \<and> (\<forall>i < n. B$$(i, i) \<in> Reals)"
     using hermitian_eigenvalue_real dimA es hA by auto
   then have A: "A = P * B * (adjoint P)" and dB: "diagonal_mat B"
     and Bii: "\<And>i. i < n \<Longrightarrow> B$$(i, i) \<in> Reals"
     and dimB: "B \<in> carrier_mat n n" and dimP: "P \<in> carrier_mat n n" and dimaP: "adjoint P \<in> carrier_mat n n"
     unfolding similar_mat_wit_def Let_def using dimA by auto
   define w where "w = (adjoint P) *\<^sub>v v"
   then have dimw: "w \<in> carrier_vec n" using dimaP dimv by auto
   from A have "inner_prod v (A *\<^sub>v v) = inner_prod v ((P * B * (adjoint P)) *\<^sub>v v)" by auto
   also have "\<dots> = inner_prod v ((P * B) *\<^sub>v ((adjoint P) *\<^sub>v v))" using dimP dimB dimv
     by (subst assoc_mult_mat_vec[of _ n n "adjoint P" n], auto)
   also have "\<dots> = inner_prod v (P *\<^sub>v (B *\<^sub>v ((adjoint P) *\<^sub>v v)))" using dimP dimB dimv dimaP
     by (subst assoc_mult_mat_vec[of _ n n "B" n], auto)
   also have "\<dots> = inner_prod w (B *\<^sub>v w)" unfolding w_def 
     apply (rule adjoint_def_alter[OF _ _ dimP])
      apply (insert mult_mat_vec_carrier[OF dimB mult_mat_vec_carrier[OF dimaP dimv]], auto simp add: dimv)
     done
 
   also have "\<dots> = (\<Sum>i=0..<n. (\<Sum>j=0..<n.
                 conjugate (w$i) * B$$(i, j) * w$j))" unfolding scalar_prod_def using dimw dimB
     apply (simp add: scalar_prod_def sum_distrib_right)
     apply (rule sum.cong, auto, rule sum.cong, auto)
     done
   also have "\<dots> = (\<Sum>i=0..<n. B$$(i, i) *  conjugate (w$i) * w$i)" 
     apply (rule sum.cong, auto)
     apply (simp add: sum.remove)
     apply (insert dB[unfolded diagonal_mat_def] dimB, auto)
     done
   finally have sum: "inner_prod v (A *\<^sub>v v) = (\<Sum>i=0..<n. B$$(i, i) *  conjugate (w$i) * w$i)" .
   have "\<And>i. i < n \<Longrightarrow> B$$(i, i) *  conjugate (w$i) * w$i \<in> Reals" using Bii by (simp add: Reals_cnj_iff)
   then have "(\<Sum>i=0..<n. B$$(i, i) *  conjugate (w$i) * w$i) \<in> Reals" by auto
   then show ?thesis using sum by auto
 qed
 
 lemma unit_vec_bracket:
   fixes A :: "complex mat"
   assumes dimA: "A \<in> carrier_mat n n" and i: "i < n"
   shows "inner_prod (unit_vec n i) (A *\<^sub>v (unit_vec n i)) = A$$(i, i)"
 proof -
   define w where "(w::complex vec) = unit_vec n i"
   have "A *\<^sub>v w = col A i" using i dimA w_def by auto
   then have 1: "inner_prod w (A *\<^sub>v w) = inner_prod w (col A i)" using w_def by auto
   have "conjugate w = w" unfolding w_def unit_vec_def conjugate_vec_def using i by auto
   then have 2: "inner_prod w (col A i) = A$$(i, i)" using i dimA w_def by auto
   from 1 2 show "inner_prod w (A *\<^sub>v w) = A$$(i, i)" by auto
 qed
 
 lemma spectral_decomposition_extract_diag:
   fixes P B :: "complex mat"
   assumes dimP: "P \<in> carrier_mat n n" and dimB: "B \<in> carrier_mat n n"
     and uP: "unitary P" and dB: "diagonal_mat B" and i: "i < n"
   shows "inner_prod (col P i) (P * B * (adjoint P) *\<^sub>v (col P i)) = B$$(i, i)"
 proof -
   have dimaP: "adjoint P\<in> carrier_mat n n" using dimP by auto
   have uaP: "unitary (adjoint P)" using unitary_adjoint uP dimP by auto
   then have "inverts_mat (adjoint P) P" by (simp add: unitary_def adjoint_adjoint)
   then have iv: "(adjoint P) * P = 1\<^sub>m n" using dimaP inverts_mat_def by auto
   define v where "v = col P i"
   then have dimv: "v \<in> carrier_vec n" using dimP by auto
   define w where "(w::complex vec) = unit_vec n i"
   then have dimw: "w \<in> carrier_vec n" by auto
   have BaPv: "B *\<^sub>v (adjoint P *\<^sub>v v) \<in> carrier_vec n" using dimB dimaP dimv by auto
   have "(adjoint P) *\<^sub>v v = (col (adjoint P * P) i)" 
     by (simp add: col_mult2[OF dimaP dimP i, symmetric] v_def)
   then have aPv: "(adjoint P) *\<^sub>v v = w"
     by (auto simp add: iv i w_def)
   have "inner_prod v (P * B * (adjoint P) *\<^sub>v v) = inner_prod v ((P * B) *\<^sub>v ((adjoint P) *\<^sub>v v))" using dimP dimB dimv
     by (subst assoc_mult_mat_vec[of _ n n "adjoint P" n], auto)
   also have "\<dots> = inner_prod v (P *\<^sub>v (B *\<^sub>v ((adjoint P) *\<^sub>v v)))" using dimP dimB dimv dimaP
     by (subst assoc_mult_mat_vec[of _ n n "B" n], auto)
   also have "\<dots> = inner_prod (adjoint P *\<^sub>v v) (B *\<^sub>v (adjoint P *\<^sub>v v))" 
     by (simp add: adjoint_def_alter[OF dimv BaPv dimP])
   also have "\<dots> = inner_prod w (B *\<^sub>v w)" using aPv by auto
   also have "\<dots> = B$$(i, i)" using w_def unit_vec_bracket dimB i by auto
   finally show "inner_prod v (P * B * (adjoint P) *\<^sub>v v) = B$$(i, i)".
 qed
 
 lemma hermitian_inner_prod_zero:
   fixes A :: "complex mat"
   assumes dimA: "A \<in> carrier_mat n n" and hA: "hermitian A"
     and zero: "\<forall>v\<in>carrier_vec n. inner_prod v (A *\<^sub>v v) = 0"
   shows "A = 0\<^sub>m n n"
 proof -
   obtain es where es: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> es. [:- e, 1:])" 
     using complex_mat_char_poly_factorizable dimA by auto
   obtain B P Q where "unitary_schur_decomposition A es = (B,P,Q)" 
     by (cases "unitary_schur_decomposition A es", auto)
   then have "similar_mat_wit A B P (adjoint P) \<and> diagonal_mat B \<and> diag_mat B = es 
     \<and> unitary P \<and> (\<forall>i < n. B$$(i, i) \<in> Reals)"
     using hermitian_eigenvalue_real dimA es hA by auto
   then have A: "A = P * B * (adjoint P)" and dB: "diagonal_mat B"
     and Bii: "\<And>i. i < n \<Longrightarrow> B$$(i, i) \<in> Reals"
     and dimB: "B \<in> carrier_mat n n" and dimP: "P \<in> carrier_mat n n" and dimaP: "adjoint P \<in> carrier_mat n n"
     and uP: "unitary P"
     unfolding similar_mat_wit_def Let_def unitary_def using dimA by auto
   then have uaP: "unitary (adjoint P)" using unitary_adjoint by auto
   then have "inverts_mat (adjoint P) P" by (simp add: unitary_def adjoint_adjoint)
   then have iv: "adjoint P * P = 1\<^sub>m n" using dimaP inverts_mat_def by auto
   have "B = 0\<^sub>m n n"
   proof-
     {
       fix i assume i: "i < n"
       define v where "v = col P i"
       then have dimv: "v \<in> carrier_vec n" using v_def dimP by auto
       have "inner_prod v (A *\<^sub>v v) = B$$(i, i)" unfolding A v_def
         using spectral_decomposition_extract_diag[OF dimP dimB uP dB i]  by auto
       moreover have "inner_prod v (A *\<^sub>v v) = 0" using dimv zero by auto
       ultimately have "B$$(i, i) = 0" by auto
     }
     note zB = this
     show "B = 0\<^sub>m n n" by (insert zB dB dimB, rule eq_matI, auto simp add: diagonal_mat_def)
   qed
   then show "A = 0\<^sub>m n n" using A dimB dimP dimaP by auto
 qed
 
 lemma complex_mat_decomposition_to_hermitian:
   fixes A :: "complex mat"
   assumes dim: "A \<in> carrier_mat n n"
   shows "\<exists>B C. hermitian B \<and> hermitian C \<and> A = B + \<i> \<cdot>\<^sub>m C \<and> B \<in> carrier_mat n n \<and> C \<in> carrier_mat n n"
 proof -
   obtain B C where B: "B = (1 / 2) \<cdot>\<^sub>m (A + adjoint A)" 
     and C: "C = (-\<i> / 2) \<cdot>\<^sub>m (A - adjoint A)" by auto
   then have dimB: "B \<in> carrier_mat n n" and dimC: "C \<in> carrier_mat n n" using dim by auto
   have "hermitian B" unfolding B hermitian_def using dim
     by (auto simp add: adjoint_eval)
   moreover have "hermitian C" unfolding C hermitian_def using dim
     apply (subst eq_matI)
        apply (auto simp add: adjoint_eval algebra_simps)
     done
   moreover have "A = B + \<i> \<cdot>\<^sub>m C" using dim B C 
     apply (subst eq_matI)
        apply (auto simp add: adjoint_eval algebra_simps)
     done
   ultimately show ?thesis using dimB dimC by auto
 qed
 
 subsection \<open>Outer product\<close>
 
 definition outer_prod :: "'a::conjugatable_field vec \<Rightarrow> 'a vec \<Rightarrow> 'a mat" where
   "outer_prod v w = mat (dim_vec v) 1 (\<lambda>(i, j). v $ i) * mat 1 (dim_vec w) (\<lambda>(i, j). (conjugate w) $ j)"
 
 lemma outer_prod_dim[simp]:
   fixes v w :: "'a::conjugatable_field vec"
   assumes v: "v \<in> carrier_vec n" and w: "w \<in> carrier_vec m"
   shows "outer_prod v w \<in> carrier_mat n m"
   unfolding outer_prod_def using assms mat_of_cols_carrier mat_of_rows_carrier by auto
 
 lemma mat_of_vec_mult_eq_scalar_prod:
   fixes v w :: "'a::conjugatable_field vec"
   assumes "v \<in> carrier_vec n" and "w \<in> carrier_vec n"
   shows "mat 1 (dim_vec v) (\<lambda>(i, j). (conjugate v) $ j) * mat (dim_vec w) 1 (\<lambda>(i, j). w $ i) 
     = mat 1 1 (\<lambda>k. inner_prod v w)"
   apply (rule eq_matI) using assms apply (simp add: scalar_prod_def) apply (rule sum.cong) by auto
 
 lemma one_dim_mat_mult_is_scale:
   fixes A B :: "('a::conjugatable_field mat)"
   assumes "B \<in> carrier_mat 1 n"
   shows "(mat 1 1 (\<lambda>k. a)) * B = a \<cdot>\<^sub>m B"
   apply (rule eq_matI) using assms by (auto simp add: scalar_prod_def)
 
 lemma outer_prod_mult_outer_prod:
   fixes a b c d :: "'a::conjugatable_field vec"
   assumes a: "a \<in> carrier_vec d1" and b: "b \<in> carrier_vec d2"
     and c: "c \<in> carrier_vec d2" and d: "d \<in> carrier_vec d3"
   shows "outer_prod a b * outer_prod c d = inner_prod b c \<cdot>\<^sub>m outer_prod a d"
 proof -
   let ?ma = "mat (dim_vec a) 1 (\<lambda>(i, j). a $ i)"
   let ?mb = "mat 1 (dim_vec b) (\<lambda>(i, j). (conjugate b) $ j)"
   let ?mc = "mat (dim_vec c) 1 (\<lambda>(i, j). c $ i)"
   let ?md = "mat 1 (dim_vec d) (\<lambda>(i, j). (conjugate d) $ j)"
   have "(?ma * ?mb) * (?mc * ?md) = ?ma * (?mb * (?mc * ?md))"
     apply (subst assoc_mult_mat[of "?ma" d1 1 "?mb" d2 "?mc * ?md" d3] )
     using assms by auto
   also have "\<dots> = ?ma * ((?mb * ?mc) * ?md)"
     apply (subst assoc_mult_mat[symmetric, of "?mb" 1 d2 "?mc" 1 "?md" d3])
     using assms by auto
   also have "\<dots> = ?ma * ((mat 1 1 (\<lambda>k. inner_prod b c)) * ?md)"
     apply (subst mat_of_vec_mult_eq_scalar_prod[of b d2 c]) using assms by auto
   also have "\<dots> = ?ma * (inner_prod b c \<cdot>\<^sub>m ?md)" 
     apply (subst one_dim_mat_mult_is_scale) using assms by auto
   also have "\<dots> = (inner_prod b c) \<cdot>\<^sub>m (?ma * ?md)" using assms by auto
   finally show ?thesis unfolding outer_prod_def by auto
 qed
 
 lemma index_outer_prod:
   fixes v w :: "'a::conjugatable_field vec"
   assumes v: "v \<in> carrier_vec n" and w: "w \<in> carrier_vec m"
     and ij: "i < n" "j < m"
   shows "(outer_prod v w)$$(i, j) = v $ i * conjugate (w $ j)"
   unfolding outer_prod_def using assms by (simp add: scalar_prod_def)
 
 lemma mat_of_vec_mult_vec:
   fixes a b c :: "'a::conjugatable_field vec"
   assumes a: "a \<in> carrier_vec d" and b: "b \<in> carrier_vec d"
   shows "mat 1 d (\<lambda>(i, j). (conjugate a) $ j) *\<^sub>v b = vec 1 (\<lambda>k. inner_prod a b)"
   apply (rule eq_vecI) 
    apply (simp add: scalar_prod_def carrier_vecD[OF a] carrier_vecD[OF b])
   apply (rule sum.cong) by auto
 
 lemma mat_of_vec_mult_one_dim_vec:
   fixes a b :: "'a::conjugatable_field vec"
   assumes a: "a \<in> carrier_vec d" 
   shows "mat d 1 (\<lambda>(i, j). a $ i) *\<^sub>v vec 1 (\<lambda>k. c) = c \<cdot>\<^sub>v a"
   apply (rule eq_vecI)
   by (auto simp add: scalar_prod_def carrier_vecD[OF a])
 
 lemma outer_prod_mult_vec:
   fixes a b c :: "'a::conjugatable_field vec"
   assumes a: "a \<in> carrier_vec d1" and b: "b \<in> carrier_vec d2"
     and c: "c \<in> carrier_vec d2"
   shows "outer_prod a b *\<^sub>v c = inner_prod b c \<cdot>\<^sub>v a"
 proof -
   have "outer_prod a b *\<^sub>v c 
     = mat d1 1 (\<lambda>(i, j). a $ i) 
     * mat 1 d2 (\<lambda>(i, j). (conjugate b) $ j)
     *\<^sub>v c" unfolding outer_prod_def using assms by auto
   also have "\<dots> = mat d1 1 (\<lambda>(i, j). a $ i) 
     *\<^sub>v (mat 1 d2 (\<lambda>(i, j). (conjugate b) $ j)
     *\<^sub>v c)" apply (subst assoc_mult_mat_vec) using assms by auto
   also have "\<dots> = mat d1 1 (\<lambda>(i, j). a $ i) 
     *\<^sub>v vec 1 (\<lambda>k. inner_prod b c)" using mat_of_vec_mult_vec[of b] assms by auto
   also have "\<dots> = inner_prod b c \<cdot>\<^sub>v a" using mat_of_vec_mult_one_dim_vec assms by auto
   finally show ?thesis by auto
 qed
 
 lemma trace_outer_prod_right:
   fixes A :: "'a::conjugatable_field mat" and v w :: "'a vec"
   assumes A: "A \<in> carrier_mat n n"
     and v: "v \<in> carrier_vec n" and w: "w \<in> carrier_vec n"
   shows "trace (A * outer_prod v w) = inner_prod w (A *\<^sub>v v)" (is "?lhs = ?rhs")
 proof -
   define B where "B = outer_prod v w"
   then have B: "B \<in> carrier_mat n n" using assms by auto
   have "trace(A * B) = (\<Sum>i = 0..<n. \<Sum>j = 0..<n. A $$ (i,j) * B $$ (j,i))"
     unfolding trace_def using A B by (simp add: scalar_prod_def)
   also have "\<dots> = (\<Sum>i = 0..<n. \<Sum>j = 0..<n. A $$ (i,j) * v $ j * conjugate (w $ i))"
     unfolding B_def
     apply (rule sum.cong, simp, rule sum.cong, simp)
     by (insert v w, auto simp add: index_outer_prod)
   finally have "?lhs = (\<Sum>i = 0..<n. \<Sum>j = 0..<n. A $$ (i,j) * v $ j * conjugate (w $ i))" using B_def by auto
   moreover have "?rhs = (\<Sum>i = 0..<n. \<Sum>j = 0..<n. A $$ (i,j) * v $ j * conjugate (w $ i))" using A v w
     by (simp add: scalar_prod_def sum_distrib_right)
   ultimately show ?thesis by auto
 qed
 
 lemma trace_outer_prod:
   fixes v w :: "('a::conjugatable_field vec)"
   assumes v: "v \<in> carrier_vec n" and w: "w \<in> carrier_vec n"
   shows "trace (outer_prod v w) = inner_prod w v" (is "?lhs = ?rhs")
 proof -
   have "(1\<^sub>m n) * (outer_prod v w) = outer_prod v w" apply (subst left_mult_one_mat) using outer_prod_dim assms by auto
   moreover have "1\<^sub>m n *\<^sub>v v = v" using assms by auto
   ultimately show ?thesis using trace_outer_prod_right[of "1\<^sub>m n" n v w] assms by auto
 qed
 
 lemma inner_prod_outer_prod:
   fixes a b c d :: "'a::conjugatable_field vec"
   assumes a: "a \<in> carrier_vec n" and b: "b \<in> carrier_vec n"
     and c: "c \<in> carrier_vec m" and d: "d \<in> carrier_vec m"
   shows "inner_prod a (outer_prod b c *\<^sub>v d) = inner_prod a b * inner_prod c d" (is "?lhs = ?rhs")
 proof -
   define P where "P = outer_prod b c"
   then have dimP: "P \<in> carrier_mat n m" using assms by auto
   have "inner_prod a (P *\<^sub>v d) = (\<Sum>i=0..<n. (\<Sum>j=0..<m. conjugate (a$i) * P$$(i, j) * d$j))" using assms dimP
     apply (simp add: scalar_prod_def sum_distrib_right)
     apply (rule sum.cong, auto)
     apply (rule sum.cong, auto)
     done
   also have "\<dots> = (\<Sum>i=0..<n. (\<Sum>j=0..<m. conjugate (a$i) * b$i * conjugate(c$j) * d$j))"
     using P_def b c by(simp add: index_outer_prod algebra_simps)
   finally have eq: "?lhs = (\<Sum>i=0..<n. (\<Sum>j=0..<m. conjugate (a$i) * b$i * conjugate(c$j) * d$j))" using P_def by auto
 
   have "?rhs = (\<Sum>i=0..<n. conjugate (a$i) * b$i) * (\<Sum>j=0..<m. conjugate(c$j) * d$j)" using assms 
     by (auto simp add: scalar_prod_def algebra_simps)
   also have "\<dots> = (\<Sum>i=0..<n. (\<Sum>j=0..<m. conjugate (a$i) * b$i * conjugate(c$j) * d$j))"
     using assms by (simp add: sum_product algebra_simps)
   finally show "?lhs = ?rhs" using eq by auto
 qed
 
 subsection \<open>Semi-definite matrices\<close>
 
 definition positive :: "complex mat \<Rightarrow> bool" where
   "positive A \<longleftrightarrow>
      A \<in> carrier_mat (dim_col A) (dim_col A) \<and>
      (\<forall>v. dim_vec v = dim_col A \<longrightarrow> inner_prod v (A *\<^sub>v v) \<ge> 0)"
 
 lemma positive_iff_normalized_vec:
   "positive A \<longleftrightarrow>
     A \<in> carrier_mat (dim_col A) (dim_col A) \<and>
     (\<forall>v. (dim_vec v = dim_col A \<and> vec_norm v = 1) \<longrightarrow> inner_prod v (A *\<^sub>v v) \<ge> 0)"
 proof (rule)
   assume "positive A"
   then show "A \<in> carrier_mat (dim_col A) (dim_col A) \<and> 
     (\<forall>v. dim_vec v = dim_col A \<and> vec_norm v = 1 \<longrightarrow> 0 \<le> inner_prod v (A *\<^sub>v v))"
     unfolding positive_def by auto
 next
   define n where "n = dim_col A"
   assume "A \<in> carrier_mat (dim_col A) (dim_col A) \<and> (\<forall>v. dim_vec v = dim_col A \<and> vec_norm v = 1 \<longrightarrow> 0 \<le> inner_prod v (A *\<^sub>v v))"
   then have A: "A \<in> carrier_mat (dim_col A) (dim_col A)" and geq0: "\<forall>v. dim_vec v = dim_col A \<and> vec_norm v = 1 \<longrightarrow> 0 \<le> inner_prod v (A *\<^sub>v v)" by auto
   then have dimA: "A \<in> carrier_mat n n" using n_def[symmetric] by auto
   {
     fix v assume dimv: "(v::complex vec) \<in> carrier_vec n"
     have "0 \<le> inner_prod v (A *\<^sub>v v)"
     proof (cases "v = 0\<^sub>v n")
       case True
       then show "0 \<le> inner_prod v (A *\<^sub>v v)" using dimA by auto
     next
       case False
       then have 1: "vec_norm v > 0" using vec_norm_ge_0 dimv by auto
-      then have cnv: "cnj (vec_norm v) = vec_norm v" using Reals_cnj_iff complex_is_Real_iff by auto
+      then have cnv: "cnj (vec_norm v) = vec_norm v"
+        using Reals_cnj_iff complex_is_Real_iff less_complex_def by auto
       define w where "w = vec_normalize v"
       then have dimw: "w \<in> carrier_vec n" using dimv by auto
       have nvw: "v = vec_norm v \<cdot>\<^sub>v w" using w_def vec_eq_norm_smult_normalized by auto
       have "vec_norm w = 1" using normalized_vec_norm[OF dimv False] vec_norm_def w_def by auto
       then have 2: "0 \<le> inner_prod w (A *\<^sub>v w)" using geq0 dimw dimA by auto
       have "inner_prod v (A *\<^sub>v v) = vec_norm v * vec_norm v * inner_prod w (A *\<^sub>v w)" using dimA dimv dimw
         apply (subst (1 2) nvw)
         apply (subst mult_mat_vec, simp, simp)
         apply (subst scalar_prod_smult_left[of "(A *\<^sub>v w)" "conjugate (vec_norm v \<cdot>\<^sub>v w)" "vec_norm v"], simp)
         apply (simp add: conjugate_smult_vec cnv)
         done
       also have "\<dots> \<ge> 0" using 1 2 by auto
       finally show "0 \<le> inner_prod v (A *\<^sub>v v)" by auto
     qed
   }
   then have geq: "\<forall>v. dim_vec v = dim_col A \<longrightarrow> 0 \<le> inner_prod v (A *\<^sub>v v)" using dimA by auto
   show "positive A" unfolding positive_def 
     by (rule, simp add: A, rule geq)
 qed
 
 lemma positive_is_hermitian:
   fixes A :: "complex mat"
   assumes pA: "positive A"
   shows "hermitian A"
 proof -
   define n where "n = dim_col A"
   then have dimA: "A \<in> carrier_mat n n" using positive_def pA by auto
   obtain B C where B: "hermitian B" and C: "hermitian C" and A: "A = B + \<i> \<cdot>\<^sub>m C"
     and dimB: "B \<in> carrier_mat n n" and dimC: "C \<in> carrier_mat n n" and dimiC: "\<i> \<cdot>\<^sub>m C \<in> carrier_mat n n"
     using complex_mat_decomposition_to_hermitian[OF dimA] by auto
   {
     fix v :: "complex vec" assume dimv: "v \<in> carrier_vec n"
     have dimvA: "dim_vec v = dim_col A" using dimv dimA by auto
     have "inner_prod v (A *\<^sub>v v) = inner_prod v (B *\<^sub>v v) + inner_prod v ((\<i> \<cdot>\<^sub>m C) *\<^sub>v v)"
       unfolding A using dimB dimiC dimv by (simp add: add_mult_distrib_mat_vec inner_prod_distrib_right)
     moreover have "inner_prod v ((\<i> \<cdot>\<^sub>m C) *\<^sub>v v) = \<i> * inner_prod v (C *\<^sub>v v)" using dimv dimC
       apply (simp add: scalar_prod_def sum_distrib_left cong: sum.cong)
       apply (rule sum.cong, auto)
       done
     ultimately have ABC: "inner_prod v (A *\<^sub>v v) = inner_prod v (B *\<^sub>v v) + \<i> * inner_prod v (C *\<^sub>v v)" by auto
     moreover have "inner_prod v (B *\<^sub>v v) \<in> Reals" using B dimB dimv hermitian_inner_prod_real by auto
     moreover have "inner_prod v (C *\<^sub>v v) \<in> Reals" using C dimC dimv hermitian_inner_prod_real by auto
     moreover have "inner_prod v (A *\<^sub>v v) \<in> Reals" using pA unfolding positive_def 
       apply (rule) 
       apply (fold n_def)
       apply (simp add: complex_is_Real_iff[of "inner_prod v (A *\<^sub>v v)"])
-      apply (auto simp add: dimvA)
+      apply (auto simp add: dimvA less_complex_def less_eq_complex_def)
       done
     ultimately have "inner_prod v (C *\<^sub>v v) = 0" using of_real_Re by fastforce
   } 
   then have "C = 0\<^sub>m n n" using hermitian_inner_prod_zero dimC C by auto
   then have "A = B" using A dimC dimB by auto
   then show "hermitian A" using B by auto
 qed
 
 lemma positive_eigenvalue_positive:
   assumes dimA: "(A::complex mat) \<in> carrier_mat n n"
     and pA: "positive A"
     and c: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> es. [:- e, 1:])"
     and B: "unitary_schur_decomposition A es = (B,P,Q)"
   shows "\<And>i. i < n \<Longrightarrow> B$$(i, i) \<ge> 0"
 proof -
   have hA: "hermitian A" using positive_is_hermitian pA by auto
   have "similar_mat_wit A B P (adjoint P) \<and> diagonal_mat B \<and> diag_mat B = es 
     \<and> unitary P \<and> (\<forall>i < n. B$$(i, i) \<in> Reals)"
     using hermitian_eigenvalue_real dimA hA B c by auto
   then have A: "A = P * B * (adjoint P)" and dB: "diagonal_mat B"
     and Bii: "\<And>i. i < n \<Longrightarrow> B$$(i, i) \<in> Reals"
     and dimB: "B \<in> carrier_mat n n" and dimP: "P \<in> carrier_mat n n" and dimaP: "adjoint P \<in> carrier_mat n n"
     and uP: "unitary P" 
     unfolding similar_mat_wit_def Let_def unitary_def using dimA by auto
   {
     fix i assume i: "i < n"
     define v where "v = col P i"
     then have dimv: "v \<in> carrier_vec n" using v_def dimP by auto
     have "inner_prod v (A *\<^sub>v v) = B$$(i, i)" unfolding A v_def
       using spectral_decomposition_extract_diag[OF dimP dimB uP dB i]  by auto
     moreover have "inner_prod v (A *\<^sub>v v) \<ge> 0" using dimv pA dimA positive_def by auto
     ultimately show "B$$(i, i) \<ge> 0" by auto
   }
 qed
 
 lemma diag_mat_mult_diag_mat:
   fixes B D :: "'a::semiring_0 mat"
   assumes dimB: "B \<in> carrier_mat n n" and dimD: "D \<in> carrier_mat n n"
     and dB: "diagonal_mat B" and dD: "diagonal_mat D"
   shows "B * D = mat n n (\<lambda>(i,j). (if i = j then (B$$(i, i)) * (D$$(i, i)) else 0))"
 proof(rule eq_matI, auto)
   have Bij: "\<And>x y. x < n \<Longrightarrow> y < n \<Longrightarrow> x \<noteq> y \<Longrightarrow> B$$(x, y) = 0" using dB diagonal_mat_def dimB by auto
   have Dij: "\<And>x y. x < n \<Longrightarrow> y < n \<Longrightarrow> x \<noteq> y \<Longrightarrow> D$$(x, y) = 0" using dD diagonal_mat_def dimD by auto
 {
   fix i j assume ij: "i < n" "j < n"
   have "(B * D) $$ (i, j) = (\<Sum>k=0..<n. (B $$ (i, k)) * (D $$ (k, j)))" using dimB dimD
     by (auto simp add: scalar_prod_def ij)
   also have "\<dots> = B$$(i, i) * D$$(i, j)"
     apply (simp add: sum.remove[of _i] ij)
     apply (simp add: Bij Dij ij)
     done
   finally have "(B * D) $$ (i, j) = B$$(i, i) * D$$(i, j)".
 }
   note BDij = this
   from BDij show "\<And>j. j < n \<Longrightarrow> (B * D) $$ (j, j) = B $$ (j, j) * D $$ (j, j)" by auto
   from BDij show "\<And>i j. i < n \<Longrightarrow> j < n \<Longrightarrow> i \<noteq> j \<Longrightarrow> (B * D) $$ (i, j) = 0" using Bij Dij by auto
   from assms show "dim_row B = n" "dim_col D = n" by auto
 qed
 
 lemma positive_only_if_decomp:
   assumes dimA: "A \<in> carrier_mat n n" and pA: "positive A"
   shows "\<exists>M \<in> carrier_mat n n. M * adjoint M = A"
 proof -
   from pA have hA: "hermitian A" using positive_is_hermitian by auto
   obtain es where es: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> es. [:- e, 1:])" 
     using complex_mat_char_poly_factorizable dimA by auto
   obtain B P Q where schur: "unitary_schur_decomposition A es = (B,P,Q)" 
     by (cases "unitary_schur_decomposition A es", auto)
   then have "similar_mat_wit A B P (adjoint P) \<and> diagonal_mat B \<and> diag_mat B = es 
     \<and> unitary P \<and> (\<forall>i < n. B$$(i, i) \<in> Reals)"
     using hermitian_eigenvalue_real dimA es hA by auto
   then have A: "A = P * B * (adjoint P)" and dB: "diagonal_mat B"
     and Bii: "\<And>i. i < n \<Longrightarrow> B$$(i, i) \<in> Reals"
     and dimB: "B \<in> carrier_mat n n" and dimP: "P \<in> carrier_mat n n" and dimaP: "adjoint P \<in> carrier_mat n n"
     unfolding similar_mat_wit_def Let_def using dimA by auto
   have Bii: "\<And>i. i < n \<Longrightarrow> B$$(i, i) \<ge> 0" using pA dimA es schur positive_eigenvalue_positive by auto
   define D where "D = mat n n (\<lambda>(i, j). (if (i = j) then csqrt (B$$(i, i)) else 0))"
   then have dimD: "D \<in> carrier_mat n n" and dimaD: "adjoint D \<in> carrier_mat n n" using dimB by auto
   have dD: "diagonal_mat D" using dB D_def unfolding diagonal_mat_def by auto
   then have daD: "diagonal_mat (adjoint D)" by (simp add: adjoint_eval diagonal_mat_def)
   have Dii: "\<And>i. i < n \<Longrightarrow> D$$(i, i) = csqrt (B$$(i, i))" using dimD D_def by auto
   {
     fix i assume i: "i < n"
     define c where "c = csqrt (B$$(i, i))"
-    have c: "c \<ge> 0" using Bii i c_def by auto
+    have c: "c \<ge> 0" using Bii i c_def by (auto simp: less_complex_def less_eq_complex_def)
     then have "conjugate c = c" 
-      using Reals_cnj_iff complex_is_Real_iff by auto
+      using Reals_cnj_iff complex_is_Real_iff unfolding less_complex_def less_eq_complex_def by auto
     then have "c * cnj c = B$$(i, i)" using c_def c unfolding conjugate_complex_def by (metis power2_csqrt power2_eq_square)
   }  
   note cBii = this
   have "D * adjoint D = mat n n (\<lambda>(i,j). (if (i = j) then B$$(i, i) else 0))"
     apply (simp add: diag_mat_mult_diag_mat[OF dimD dimaD dD daD])
     apply (rule eq_matI, auto simp add: D_def adjoint_eval cBii)
     done
   also have "\<dots> = B" using dimB dB[unfolded diagonal_mat_def] by auto
   finally have DaDB: "D * adjoint D = B".
   define M where "M = P * D"
   then have dimM: "M \<in> carrier_mat n n" using dimP dimD by auto
   have "M * adjoint M = (P * D) * (adjoint D * adjoint P)" using M_def adjoint_mult[OF dimP dimD] by auto
   also have "\<dots> = P * (D * adjoint D) * (adjoint P)" using dimP dimD by (mat_assoc n)
   also have "\<dots> = P * B * (adjoint P)" using DaDB by auto
   finally have "M * adjoint M = A" using A by auto
   with dimM show "\<exists>M \<in> carrier_mat n n. M * adjoint M = A" by auto
 qed
 
 lemma positive_if_decomp:
   assumes dimA: "A \<in> carrier_mat n n" and "\<exists>M. M * adjoint M = A"
   shows "positive A"
 proof -
   from assms obtain M where M: "M * adjoint M = A" by auto
   define m where "m = dim_col M"
   have dimM: "M \<in> carrier_mat n m" using M dimA m_def by auto
 {
   fix v assume dimv: "(v::complex vec) \<in> carrier_vec n"
   have dimaM: "adjoint M \<in> carrier_mat m n" using dimM by auto
   have dimaMv: "(adjoint M) *\<^sub>v v \<in> carrier_vec m" using dimaM dimv by auto
   have "inner_prod v (A *\<^sub>v v) = inner_prod v (M * adjoint M *\<^sub>v v)" using M by auto
   also have "\<dots> = inner_prod v (M *\<^sub>v (adjoint M *\<^sub>v v))" using assoc_mult_mat_vec dimM dimaM dimv by auto
   also have "\<dots> = inner_prod (adjoint M *\<^sub>v v) (adjoint M *\<^sub>v v)" using adjoint_def_alter[OF dimv dimaMv dimM] by auto
   also have "\<dots> \<ge> 0" using self_cscalar_prod_geq_0 by auto
   finally have "inner_prod v (A *\<^sub>v v) \<ge> 0".
 }
   note geq0 = this
   from dimA geq0 show "positive A" using positive_def by auto
 qed
 
 lemma positive_iff_decomp:
   assumes dimA: "A \<in> carrier_mat n n"
   shows "positive A \<longleftrightarrow> (\<exists>M\<in>carrier_mat n n. M * adjoint M = A)"
 proof
   assume pA: "positive A"
   then show "\<exists>M\<in>carrier_mat n n. M * adjoint M = A" using positive_only_if_decomp assms by auto
 next
   assume "\<exists>M\<in>carrier_mat n n. M * adjoint M = A"
   then obtain M where M: "M * adjoint M = A" by auto
   then show "positive A" using M positive_if_decomp assms by auto
 qed
 
 lemma positive_dim_eq:
   assumes "positive A"
   shows "dim_row A = dim_col A"
   using carrier_matD(1)[of A "dim_col A" "dim_col A"]  assms[unfolded positive_def] by simp
 
 lemma positive_zero:
   "positive (0\<^sub>m n n)"
   by (simp add: positive_def zero_mat_def mult_mat_vec_def scalar_prod_def)
 
 lemma positive_one:
   "positive (1\<^sub>m n)"
 proof (rule positive_if_decomp)
   show "1\<^sub>m n \<in> carrier_mat n n" by auto
   have "adjoint (1\<^sub>m n) = 1\<^sub>m n" using hermitian_one hermitian_def by auto
   then have "1\<^sub>m n * adjoint (1\<^sub>m n) = 1\<^sub>m n" by auto
   then show "\<exists>M. M * adjoint M = 1\<^sub>m n" by fastforce
 qed
 
 lemma positive_antisym:
   assumes pA: "positive A" and pnA: "positive (-A)"
   shows "A = 0\<^sub>m (dim_col A) (dim_col A)"
 proof -
   define n where "n = dim_col A"
   from pA have dimA: "A \<in> carrier_mat n n" and dimnA: "-A \<in> carrier_mat n n"
     using positive_def n_def by auto
   from pA have hA: "hermitian A" using positive_is_hermitian by auto
   obtain es where es: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> es. [:- e, 1:])" 
     using complex_mat_char_poly_factorizable dimA by auto
   obtain B P Q where schur: "unitary_schur_decomposition A es = (B,P,Q)" 
     by (cases "unitary_schur_decomposition A es", auto)
   then have "similar_mat_wit A B P (adjoint P) \<and> diagonal_mat B \<and> unitary P"
     using hermitian_eigenvalue_real dimA es hA by auto
   then have A: "A = P * B * (adjoint P)" and dB: "diagonal_mat B" and uP: "unitary P"
     and dimB: "B \<in> carrier_mat n n" and dimnB: "-B \<in> carrier_mat n n"
     and dimP: "P \<in> carrier_mat n n" and dimaP: "adjoint P \<in> carrier_mat n n"
     unfolding similar_mat_wit_def Let_def using dimA by auto
   from es schur have geq0: "\<And>i. i < n \<Longrightarrow> B$$(i, i) \<ge> 0" using positive_eigenvalue_positive dimA pA by auto
   from A have nA: "-A = P * (-B) * (adjoint P)" using mult_smult_assoc_mat dimB dimP dimaP by auto
   from dB have dnB: "diagonal_mat (-B)" by (simp add: diagonal_mat_def)
   {
     fix i assume i: "i < n"
     define v where "v = col P i"
     then have dimv: "v \<in> carrier_vec n" using v_def dimP by auto
     have "inner_prod v ((-A) *\<^sub>v v) = (-B)$$(i, i)" unfolding nA v_def
       using spectral_decomposition_extract_diag[OF dimP dimnB uP dnB i]  by auto
     moreover have "inner_prod v ((-A) *\<^sub>v v) \<ge> 0" using dimv pnA dimnA positive_def by auto
     ultimately have "B$$(i, i) \<le> 0" using dimB i by auto
     moreover have "B$$(i, i) \<ge> 0" using i geq0 by auto
     ultimately have "B$$(i, i) = 0" by (metis no_atp(10))
   }
   then have "B = 0\<^sub>m n n" using dimB dB[unfolded diagonal_mat_def]
     by (subst eq_matI, auto)
   then show "A = 0\<^sub>m n n" using A dimB dimP dimaP by auto
 qed
 
 lemma positive_add:
   assumes pA: "positive A" and pB: "positive B"
     and dimA: "A \<in> carrier_mat n n" and dimB: "B \<in> carrier_mat n n"
   shows "positive (A + B)"
   unfolding positive_def
 proof
   have dimApB: "A + B \<in> carrier_mat n n" using dimA dimB by auto
   then show "A + B \<in> carrier_mat (dim_col (A + B)) (dim_col (A + B))" using carrier_matD[of "A+B"] by auto
   {
     fix v assume dimv: "(v::complex vec) \<in> carrier_vec n"
     have 1: "inner_prod v (A *\<^sub>v v) \<ge> 0" using dimv pA[unfolded positive_def] dimA by auto
     have 2: "inner_prod v (B *\<^sub>v v) \<ge> 0" using dimv pB[unfolded positive_def] dimB by auto
     have "inner_prod v ((A + B) *\<^sub>v v) = inner_prod v (A *\<^sub>v v) + inner_prod v (B *\<^sub>v v)"
       using dimA dimB dimv by (simp add: add_mult_distrib_mat_vec inner_prod_distrib_right) 
     also have "\<dots> \<ge> 0" using 1 2 by auto
     finally have "inner_prod v ((A + B) *\<^sub>v v) \<ge> 0".
   }
   note geq0 = this
   then have "\<And>v. dim_vec v = n \<Longrightarrow> 0 \<le> inner_prod v ((A + B) *\<^sub>v v)" by auto
   then show "\<forall>v. dim_vec v = dim_col (A + B) \<longrightarrow> 0 \<le> inner_prod v ((A + B) *\<^sub>v v)" using dimApB by auto
 qed
 
 lemma positive_trace:
   assumes "A \<in> carrier_mat n n" and "positive A"
   shows "trace A \<ge> 0"
   using assms positive_iff_decomp trace_adjoint_positive by auto
 
 lemma positive_close_under_left_right_mult_adjoint:
   fixes M A :: "complex mat"
   assumes dM: "M \<in> carrier_mat n n" and dA: "A \<in> carrier_mat n n" 
     and pA: "positive A"
   shows "positive (M * A * adjoint M)"
   unfolding positive_def
 proof (rule, simp add: mult_carrier_mat[OF mult_carrier_mat[OF dM dA] adjoint_dim[OF dM]] carrier_matD[OF dM], rule, rule)
   have daM: "adjoint M \<in> carrier_mat n n" using dM by auto
   fix v::"complex vec" assume "dim_vec v = dim_col (M * A * adjoint M)"
   then have dv: "v \<in> carrier_vec n" using assms by auto
   then have "adjoint M *\<^sub>v v \<in> carrier_vec n" using daM by auto
   have assoc: "M * A * adjoint M *\<^sub>v v = M *\<^sub>v (A *\<^sub>v (adjoint M *\<^sub>v v))"
     using dA dM daM dv by (auto simp add: assoc_mult_mat_vec[of _ n n _ n])
   have "inner_prod v (M * A * adjoint M *\<^sub>v v) = inner_prod (adjoint M *\<^sub>v v) (A *\<^sub>v (adjoint M *\<^sub>v v))"
     apply (subst assoc)
     apply (subst adjoint_def_alter[where ?A = "M"])
     by (auto simp add: dv dA daM dM carrier_matD[OF dM] mult_mat_vec_carrier[of _ n n])
   also have "\<dots> \<ge> 0" using dA dv daM pA positive_def by auto
   finally show "inner_prod v (M * A * adjoint M *\<^sub>v v) \<ge> 0" by auto
 qed
 
 lemma positive_same_outer_prod:
   fixes v w :: "complex vec"
   assumes v: "v \<in> carrier_vec n" 
   shows "positive (outer_prod v v)"
 proof -
   have d1: "adjoint (mat (dim_vec v) 1 (\<lambda>(i, j). v $ i)) \<in> carrier_mat 1 n" using assms by auto
   have d2: "mat 1 (dim_vec v) (\<lambda>(i, y). conjugate v $ y) \<in> carrier_mat 1 n" using assms by auto
   have dv: "dim_vec v = n" using assms by auto
   have "mat 1 (dim_vec v) (\<lambda>(i, y). conjugate v $ y) = adjoint (mat (dim_vec v) 1 (\<lambda>(i, j). v $ i))" (is "?r = adjoint ?l")
     apply (rule eq_matI) 
     subgoal for i j by (simp add: dv adjoint_eval)
     using d1 d2 by auto
   then have "outer_prod v v = ?l * adjoint ?l" unfolding outer_prod_def by auto
   then have "\<exists>M. M * adjoint M = outer_prod v v" by auto
   then show "positive (outer_prod v v)" using positive_if_decomp[OF outer_prod_dim[OF v v]] by auto
 qed
 
 lemma smult_smult_mat: 
   fixes k :: complex and l :: complex
   assumes "A \<in> carrier_mat nr n"
   shows "k \<cdot>\<^sub>m (l \<cdot>\<^sub>m A) = (k * l) \<cdot>\<^sub>m A" by auto
 
 lemma positive_smult: 
   assumes "A \<in> carrier_mat n n"
     and "positive A"
     and "c \<ge> 0"
   shows "positive (c \<cdot>\<^sub>m A)"
 proof -
-  have sc: "csqrt c \<ge> 0" using assms(3) by fastforce
+  have sc: "csqrt c \<ge> 0" using assms(3) by (fastforce simp: less_eq_complex_def)
   obtain M where dimM: "M \<in> carrier_mat n n" and A: "M * adjoint M = A" using assms(1-2) positive_iff_decomp by auto
   have "c \<cdot>\<^sub>m A  = c \<cdot>\<^sub>m (M * adjoint M)" using A by auto
-  have ccsq: "conjugate (csqrt c) = (csqrt c)" using sc Reals_cnj_iff[of "csqrt c"] complex_is_Real_iff by auto
+  have ccsq: "conjugate (csqrt c) = (csqrt c)" using sc Reals_cnj_iff[of "csqrt c"] complex_is_Real_iff 
+    by (auto simp: less_eq_complex_def)
   have MM: "(M * adjoint M) \<in> carrier_mat n n" using A assms by fastforce
   have leftd: "c  \<cdot>\<^sub>m (M * adjoint M) \<in> carrier_mat n n" using A assms by fastforce
   have rightd: "(csqrt c \<cdot>\<^sub>m M) * (adjoint (csqrt c \<cdot>\<^sub>m M))\<in> carrier_mat n n" using A assms by fastforce
   have "(csqrt c \<cdot>\<^sub>m M) * (adjoint (csqrt c \<cdot>\<^sub>m M)) = (csqrt c \<cdot>\<^sub>m M) * ((conjugate (csqrt c)) \<cdot>\<^sub>m  adjoint M)"
     using adjoint_scale assms(1) by (metis adjoint_scale)
   also have "\<dots> = (csqrt c \<cdot>\<^sub>m M) * (csqrt c \<cdot>\<^sub>m adjoint M)" using sc ccsq by fastforce
   also have "\<dots> = csqrt c \<cdot>\<^sub>m (M * (csqrt c \<cdot>\<^sub>m adjoint M))"
     using mult_smult_assoc_mat index_smult_mat(2,3) by fastforce
   also have "\<dots> =  csqrt c \<cdot>\<^sub>m ((csqrt c) \<cdot>\<^sub>m (M * adjoint M))"
     using mult_smult_distrib by fastforce
   also have "\<dots> = c \<cdot>\<^sub>m (M * adjoint M)" 
     using smult_smult_mat[of "M * adjoint M" n n "(csqrt c)" "(csqrt c)"]  MM sc
     by (metis power2_csqrt power2_eq_square )   
   also have "\<dots> = c \<cdot>\<^sub>m A" using A by auto
   finally have "(csqrt c \<cdot>\<^sub>m M) * (adjoint (csqrt c \<cdot>\<^sub>m M)) = c \<cdot>\<^sub>m A" by auto
   moreover have "c \<cdot>\<^sub>m A \<in> carrier_mat n n" using assms(1) by auto
   moreover have "csqrt c \<cdot>\<^sub>m M \<in> carrier_mat n n" using dimM by auto
   ultimately show ?thesis using positive_iff_decomp by auto
 qed
 
 text \<open>Version of previous theorem for real numbers\<close>
 lemma positive_scale: 
   fixes c :: real
   assumes  "A \<in> carrier_mat n n"
     and "positive A"
     and "c \<ge> 0"
   shows "positive (c \<cdot>\<^sub>m A)"
-  apply (rule positive_smult) using assms by auto
+  apply (rule positive_smult) using assms by (auto simp: less_eq_complex_def)
 
 subsection \<open>L\"{o}wner partial order\<close>
 
 definition lowner_le :: "complex mat \<Rightarrow> complex mat \<Rightarrow> bool"  (infix "\<le>\<^sub>L" 50) where
   "A \<le>\<^sub>L B \<longleftrightarrow> dim_row A = dim_row B \<and> dim_col A = dim_col B \<and> positive (B - A)"
 
 lemma lowner_le_refl:
   assumes "A \<in> carrier_mat n n"
   shows "A \<le>\<^sub>L A"
   unfolding lowner_le_def
   apply (simp add: minus_r_inv_mat[OF assms])
   by (rule positive_zero)
 
 lemma lowner_le_antisym:
   assumes A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n"
     and L1: "A \<le>\<^sub>L B" and L2: "B \<le>\<^sub>L A"
   shows "A = B"
 proof -
   from L1 have P1: "positive (B - A)" by (simp add: lowner_le_def)
   from L2 have P2: "positive (A - B)" by (simp add: lowner_le_def)
   have "A - B = - (B - A)" using A B by auto
   then have P3: "positive (- (B - A))" using P2 by auto
   have BA: "B - A \<in> carrier_mat n n" using A B by auto
   have "B - A = 0\<^sub>m n n" using BA by (subst positive_antisym[OF P1 P3], auto)
   then have "B + (-A) + A = 0\<^sub>m n n + A" using A B minus_add_uminus_mat[OF B A] by auto
   then have "B + (-A + A) = 0\<^sub>m n n + A" using A B by auto
   then show "A = B" using A B BA uminus_l_inv_mat[OF A] by auto
 qed
 
 lemma lowner_le_inner_prod_le:
   fixes A B :: "complex mat" and v :: "complex vec"
   assumes A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n"
     and v: "v \<in> carrier_vec n"
     and "A \<le>\<^sub>L B"
   shows "inner_prod v (A *\<^sub>v v) \<le> inner_prod v (B *\<^sub>v v)"
 proof -
   from assms have "positive (B-A)" by (auto simp add: lowner_le_def)
   with assms have geq: "inner_prod v ((B-A) *\<^sub>v v) \<ge> 0" 
     unfolding positive_def by auto
   have "inner_prod v ((B-A) *\<^sub>v v) = inner_prod v (B *\<^sub>v v) - inner_prod v (A *\<^sub>v v)" 
     unfolding minus_add_uminus_mat[OF B A]
     by (subst add_mult_distrib_mat_vec[OF B _ v], insert A B v, auto simp add: inner_prod_distrib_right[OF v])
   then show ?thesis using geq by auto
 qed
 
 lemma lowner_le_trans:
   fixes A B C :: "complex mat"
   assumes A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n" and C: "C \<in> carrier_mat n n"
     and L1: "A \<le>\<^sub>L B" and L2: "B \<le>\<^sub>L C"
   shows "A \<le>\<^sub>L C"
   unfolding lowner_le_def
 proof (auto simp add: carrier_matD[OF A] carrier_matD[OF C])
   have dim: "C - A \<in> carrier_mat n n" using A C by auto
   {
     fix v assume v: "(v::complex vec) \<in> carrier_vec n"
     from L1 have "inner_prod v (A *\<^sub>v v) \<le> inner_prod v (B *\<^sub>v v)" using lowner_le_inner_prod_le A B v by auto
     also from L2 have "\<dots> \<le> inner_prod v (C *\<^sub>v v)" using lowner_le_inner_prod_le B C v by auto
     finally have "inner_prod v (A *\<^sub>v v) \<le> inner_prod v (C *\<^sub>v v)".
     then have "inner_prod v (C *\<^sub>v v) - inner_prod v (A *\<^sub>v v) \<ge> 0" by auto
     then have "inner_prod v ((C - A) *\<^sub>v v) \<ge> 0" using A C v
       apply (subst minus_add_uminus_mat[OF C A])
       apply (subst add_mult_distrib_mat_vec[OF C _ v], simp)
       apply (simp add: inner_prod_distrib_right[OF v])
       done
   }
   note leq = this
   show "positive (C - A)" unfolding positive_def
     apply (rule, simp add: carrier_matD[OF A] dim)
     apply (subst carrier_matD[OF dim], insert leq, auto)
     done
 qed
 
 lemma lowner_le_imp_trace_le:
   assumes "A \<in> carrier_mat n n" and "B \<in> carrier_mat n n"
     and "A \<le>\<^sub>L B"
   shows "trace A \<le> trace B"
 proof -
   have "positive (B - A)" using assms lowner_le_def by auto
   moreover have "B - A \<in> carrier_mat n n" using assms by auto
   ultimately have "trace (B - A) \<ge> 0" using positive_trace by auto
   moreover have "trace (B - A) = trace B - trace A" using trace_minus_linear assms by auto
   ultimately have "trace B - trace A \<ge> 0" by auto
   then show "trace A \<le> trace B" by auto
 qed
 
 lemma lowner_le_add:
   assumes "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" "C \<in> carrier_mat n n" "D \<in> carrier_mat n n"
     and "A \<le>\<^sub>L B" "C \<le>\<^sub>L D"
   shows "A + C \<le>\<^sub>L B + D"
 proof -
   have "B + D - (A + C) = B - A + (D - C) " using assms by auto
   then have "positive (B + D - (A + C))" using assms unfolding lowner_le_def using positive_add
     by (metis minus_carrier_mat)
   then show "A + C \<le>\<^sub>L B + D" unfolding lowner_le_def using assms by fastforce
 qed
 
 lemma lowner_le_swap:
   assumes "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" 
     and "A \<le>\<^sub>L B" 
   shows "-B \<le>\<^sub>L -A"
 proof -
   have "positive (B - A)" using assms lowner_le_def by fastforce
   moreover have "B - A = (-A) - (-B)" using assms by fastforce
   ultimately have "positive ((-A) - (-B))" by auto
   then show ?thesis using lowner_le_def assms by fastforce
 qed
 
 lemma lowner_le_minus:
   assumes "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" "C \<in> carrier_mat n n" "D \<in> carrier_mat n n"
     and "A \<le>\<^sub>L B" "C \<le>\<^sub>L D"
   shows "A - D \<le>\<^sub>L B - C"
 proof -
   have "positive (D - C)" using assms lowner_le_def by auto
   then have "-D \<le>\<^sub>L -C" using lowner_le_swap assms by auto
   then have "A + (-D) \<le>\<^sub>L B + (-C)" using lowner_le_add[of "A" n  "B"] assms by auto
   moreover have "A + (-D) = A - D" and "B + (-C) = B - C" by auto
   ultimately show ?thesis by auto
 qed
 
 lemma outer_prod_le_one:
   assumes "v \<in> carrier_vec n"
     and "inner_prod v v \<le> 1"
   shows "outer_prod v v \<le>\<^sub>L 1\<^sub>m n"
 proof -
   let ?o = "outer_prod v v"
   have do: "?o \<in> carrier_mat n n" using assms by auto
   {
     fix u :: "complex vec" assume "dim_vec u = n"
     then have du: "u \<in> carrier_vec n" by auto
     have r: "inner_prod u u \<in> Reals" apply (simp add: scalar_prod_def carrier_vecD[OF du])
       using complex_In_mult_cnj_zero complex_is_Real_iff by blast
     have geq0: "inner_prod u u \<ge> 0" 
       using self_cscalar_prod_geq_0 by auto
 
     have "inner_prod u (?o *\<^sub>v u) = inner_prod u v * inner_prod v u"
       apply (subst inner_prod_outer_prod)
       using du assms by auto
     also have "\<dots> \<le> inner_prod u u * inner_prod v v" using Cauchy_Schwarz_complex_vec du assms by auto
     also have "\<dots> \<le> inner_prod u u" using assms(2) r geq0 
-      by (simp add: mult_right_le_one_le)
+      by (simp add: mult_right_le_one_le less_eq_complex_def)
     finally have le: "inner_prod u (?o *\<^sub>v u) \<le> inner_prod u u".
 
     have "inner_prod u ((1\<^sub>m n - ?o) *\<^sub>v u) = inner_prod u ((1\<^sub>m n *\<^sub>v u) - ?o *\<^sub>v u)"
       apply (subst minus_mult_distrib_mat_vec) using do du by auto
     also have "\<dots> = inner_prod u u - inner_prod u (?o *\<^sub>v u)"
       apply (subst inner_prod_minus_distrib_right)
       using du do by auto
     also have "\<dots> \<ge> 0" using le by auto
     finally have "inner_prod u ((1\<^sub>m n - ?o) *\<^sub>v u) \<ge> 0" by auto
   }
   then have "positive (1\<^sub>m n - outer_prod v v)"
     unfolding positive_def using do by auto
   then show ?thesis unfolding lowner_le_def using do by auto
 qed
 
 lemma zero_lowner_le_positiveD:
   fixes A :: "complex mat"
   assumes dA: "A \<in> carrier_mat n n" and le: "0\<^sub>m n n \<le>\<^sub>L A"
   shows "positive A"
   using assms unfolding lowner_le_def by (subgoal_tac "A - 0\<^sub>m n n = A", auto)
 
 lemma zero_lowner_le_positiveI:
   fixes A :: "complex mat"
   assumes dA: "A \<in> carrier_mat n n" and le: "positive A"
   shows "0\<^sub>m n n \<le>\<^sub>L A"
   using assms unfolding lowner_le_def by (subgoal_tac "A - 0\<^sub>m n n = A", auto)
 
 lemma lowner_le_trans_positiveI:
   fixes A B :: "complex mat"
   assumes dA: "A \<in> carrier_mat n n" and pA: "positive A" and le: "A \<le>\<^sub>L B"
   shows "positive B"
 proof -
   have dB: "B \<in> carrier_mat n n" using le dA lowner_le_def by auto
   have "0\<^sub>m n n \<le>\<^sub>L A" using zero_lowner_le_positiveI dA pA by auto
   then have "0\<^sub>m n n \<le>\<^sub>L B" using dA dB le by (simp add: lowner_le_trans[of _ n A B])
   then show ?thesis using dB zero_lowner_le_positiveD by auto
 qed
 
 lemma lowner_le_keep_under_measurement:
   fixes M A B :: "complex mat"
   assumes dM: "M \<in> carrier_mat n n" and dA: "A \<in> carrier_mat n n" and dB: "B \<in> carrier_mat n n"
     and le: "A \<le>\<^sub>L B"
   shows "adjoint M * A * M \<le>\<^sub>L adjoint M * B * M"
   unfolding lowner_le_def
 proof (rule conjI, fastforce)+
   have daM: "adjoint M \<in> carrier_mat n n" using dM by auto
   have dBmA: "B - A \<in> carrier_mat n n" using dB dA by fastforce
   have "positive (B - A)" using le lowner_le_def by auto
   then have p: "positive (adjoint M * (B - A) * M)" 
     using positive_close_under_left_right_mult_adjoint[OF daM dBmA] adjoint_adjoint[of M] by auto
   moreover have e: "adjoint M * (B - A) * M = adjoint M * B * M - adjoint M * A * M" using dM dB dA by (mat_assoc n)
   ultimately show "positive (adjoint M * B * M - adjoint M * A * M)" by auto
 qed
 
 lemma smult_distrib_left_minus_mat:
   fixes A B :: "'a::comm_ring_1 mat"
   assumes "A \<in> carrier_mat n n" "B \<in> carrier_mat n n"
   shows "c \<cdot>\<^sub>m (B - A) = c \<cdot>\<^sub>m B - c \<cdot>\<^sub>m A"
   using assms by (auto simp add: minus_add_uminus_mat add_smult_distrib_left_mat)
 
 lemma lowner_le_smultc:
   fixes c :: complex
   assumes "c \<ge> 0" "A \<le>\<^sub>L B" "A \<in> carrier_mat n n" "B \<in> carrier_mat n n"
   shows "c \<cdot>\<^sub>m A \<le>\<^sub>L c \<cdot>\<^sub>m B"
 proof -
   have eqBA: "c \<cdot>\<^sub>m (B - A) = c \<cdot>\<^sub>m B - c \<cdot>\<^sub>m A"
     using assms by (auto simp add: smult_distrib_left_minus_mat)
 
   have "positive (B - A)" using assms(2) unfolding lowner_le_def by auto
   then have "positive (c \<cdot>\<^sub>m (B - A))" using positive_smult[of "B-A" n c] assms by fastforce
   moreover have "c \<cdot>\<^sub>m A \<in> carrier_mat n n" using index_smult_mat(2,3) assms(3) by auto
   moreover have "c \<cdot>\<^sub>m B \<in> carrier_mat n n" using index_smult_mat(2,3) assms(4) by auto 
   ultimately show ?thesis unfolding lowner_le_def using eqBA by fastforce
 qed
 
 lemma lowner_le_smult:
   fixes c :: real
   assumes "c \<ge> 0" "A \<le>\<^sub>L B" "A \<in> carrier_mat n n" "B \<in> carrier_mat n n"
   shows "c \<cdot>\<^sub>m A \<le>\<^sub>L c \<cdot>\<^sub>m B"
-  apply (rule lowner_le_smultc) using assms by auto
+  apply (rule lowner_le_smultc) using assms by (auto simp: less_eq_complex_def)
 
 lemma minus_smult_vec_distrib:
   fixes w :: "'a::comm_ring_1 vec"
   shows "(a - b) \<cdot>\<^sub>v w = a \<cdot>\<^sub>v w - b \<cdot>\<^sub>v w"
   apply (rule eq_vecI)
   by (auto simp add: scalar_prod_def algebra_simps)
 
 lemma smult_mat_mult_mat_vec_assoc:
   fixes A :: "'a::comm_ring_1 mat"
   assumes A: "A \<in> carrier_mat n m" and w: "w \<in> carrier_vec m"
   shows "a \<cdot>\<^sub>m A *\<^sub>v w = a \<cdot>\<^sub>v (A *\<^sub>v w)"
   apply (rule eq_vecI)
    apply (simp add: scalar_prod_def carrier_matD[OF A] carrier_vecD[OF w])
    apply (subst sum_distrib_left) apply (rule sum.cong, simp)
   by auto
 
 lemma mult_mat_vec_smult_vec_assoc:
   fixes A :: "'a::comm_ring_1 mat"
   assumes A: "A \<in> carrier_mat n m" and w: "w \<in> carrier_vec m"
   shows "A *\<^sub>v (a \<cdot>\<^sub>v w) = a \<cdot>\<^sub>v (A *\<^sub>v w)"
   apply (rule eq_vecI)
    apply (simp add: scalar_prod_def carrier_matD[OF A] carrier_vecD[OF w])
    apply (subst sum_distrib_left) apply (rule sum.cong, simp)
   by auto 
 
 lemma outer_prod_left_right_mat:
   fixes A B :: "complex mat"
   assumes du: "u \<in> carrier_vec d2" and dv: "v \<in> carrier_vec d3"
     and dA: "A \<in> carrier_mat d1 d2" and dB: "B \<in> carrier_mat d3 d4"
   shows "A * (outer_prod u v) * B = (outer_prod (A *\<^sub>v u) (adjoint B *\<^sub>v v))"
   unfolding outer_prod_def
 proof -
   have eq1: "A * (mat (dim_vec u) 1 (\<lambda>(i, j). u $ i)) = mat (dim_vec (A *\<^sub>v u)) 1 (\<lambda>(i, j). (A *\<^sub>v u) $ i)"
     apply (rule eq_matI)
     by (auto simp add: dA du scalar_prod_def)
   have conj: "conjugate a * b = conjugate ((a::complex) * conjugate b) " for a b by auto
   have eq2: "mat 1 (dim_vec v) (\<lambda>(i, y). conjugate v $ y) * B = mat 1 (dim_vec (adjoint B *\<^sub>v v)) (\<lambda>(i, y). conjugate (adjoint B *\<^sub>v v) $ y)"
     apply (rule eq_matI)
       apply (auto simp add: carrier_matD[OF dB] carrier_vecD[OF dv] scalar_prod_def adjoint_def conjugate_vec_def sum_conjugate )
     apply (rule sum.cong)
     by (auto simp add: conj)
   have "A * (mat (dim_vec u) 1 (\<lambda>(i, j). u $ i) * mat 1 (dim_vec v) (\<lambda>(i, y). conjugate v $ y)) * B =
        (A * (mat (dim_vec u) 1 (\<lambda>(i, j). u $ i))) *(mat 1 (dim_vec v) (\<lambda>(i, y). conjugate v $ y)) * B"
     using dA du dv dB assoc_mult_mat[OF dA, of "mat (dim_vec u) 1 (\<lambda>(i, j). u $ i)" 1 "mat 1 (dim_vec v) (\<lambda>(i, y). conjugate v $ y)"] by fastforce
   also have "\<dots> = (A * (mat (dim_vec u) 1 (\<lambda>(i, j). u $ i))) *((mat 1 (dim_vec v) (\<lambda>(i, y). conjugate v $ y)) * B)"
     using dA du dv dB assoc_mult_mat[OF _ _ dB, of "(A * (mat (dim_vec u) 1 (\<lambda>(i, j). u $ i)))" d1 1] by fastforce
   finally show "A * (mat (dim_vec u) 1 (\<lambda>(i, j). u $ i) * mat 1 (dim_vec v) (\<lambda>(i, y). conjugate v $ y)) * B =
     mat (dim_vec (A *\<^sub>v u)) 1 (\<lambda>(i, j). (A *\<^sub>v u) $ i) * mat 1 (dim_vec (adjoint B *\<^sub>v v)) (\<lambda>(i, y). conjugate (adjoint B *\<^sub>v v) $ y)" 
     using eq1 eq2 by auto
 qed
 
 subsection \<open>Density operators\<close>
 
 definition density_operator :: "complex mat \<Rightarrow> bool" where
   "density_operator A \<longleftrightarrow> positive A \<and> trace A = 1"
 
 definition partial_density_operator :: "complex mat \<Rightarrow> bool" where
   "partial_density_operator A \<longleftrightarrow> positive A \<and> trace A \<le> 1"
 
 lemma pure_state_self_outer_prod_is_partial_density_operator:
   fixes v :: "complex vec"
   assumes dimv: "v \<in> carrier_vec n" and nv: "vec_norm v = 1"
   shows "partial_density_operator (outer_prod v v)"
   unfolding partial_density_operator_def
 proof
   have dimov: "outer_prod v v \<in> carrier_mat n n" using dimv by auto
   show "positive (outer_prod v v)" unfolding positive_def
   proof (rule, simp add: carrier_matD(2)[OF dimov] dimov, rule allI, rule impI)
     fix w assume "dim_vec (w::complex vec) = dim_col (outer_prod v v)"
     then have dimw: "w \<in> carrier_vec n"  using dimov carrier_vecI by auto
     then have "inner_prod w ((outer_prod v v) *\<^sub>v w) = inner_prod w v * inner_prod v w" 
       using inner_prod_outer_prod dimw dimv by auto
     also have "\<dots> = inner_prod w v * conjugate (inner_prod w v)" using dimw dimv
       apply (subst conjugate_scalar_prod[of v "conjugate w"], simp)
       apply (subst conjugate_vec_sprod_comm[of "conjugate v" _ "conjugate w"], auto)
        apply (rule carrier_vec_conjugate[OF dimv])
       apply (rule carrier_vec_conjugate[OF dimw])
       done
-    also have "\<dots> \<ge> 0" by auto
+    also have "\<dots> \<ge> 0" by (auto simp: less_eq_complex_def)
     finally show "inner_prod w ((outer_prod v v) *\<^sub>v w) \<ge> 0".
   qed
   have eq: "trace (outer_prod v v) = (\<Sum>i=0..<n. v$i * conjugate(v$i))" unfolding trace_def 
     apply (subst carrier_matD(1)[OF dimov])
     apply (simp add: index_outer_prod[OF dimv dimv])
     done
   have "vec_norm v = csqrt (\<Sum>i=0..<n. v$i * conjugate(v$i))" unfolding vec_norm_def using dimv
     by (simp add: scalar_prod_def)
   then have "(\<Sum>i=0..<n. v$i * conjugate(v$i)) = 1" using nv by auto
   with eq show "trace (outer_prod v v) \<le> 1" by auto
 qed
 
 (* Lemma 2.1 *)
 lemma lowner_le_trace:
   assumes A: "A \<in> carrier_mat n n"
     and B: "B \<in> carrier_mat n n"
   shows "A \<le>\<^sub>L B \<longleftrightarrow> (\<forall>\<rho>\<in>carrier_mat n n. partial_density_operator \<rho> \<longrightarrow> trace (A * \<rho>) \<le> trace (B * \<rho>))"
 proof (rule iffI)
   have dimBmA: "B - A \<in> carrier_mat n n" using A B by auto
   {
     assume "A \<le>\<^sub>L B"
     then have pBmA: "positive (B - A)" using lowner_le_def by auto
     moreover have "B - A \<in> carrier_mat n n" using assms by auto
     ultimately have "\<exists>M\<in>carrier_mat n n. M * adjoint M = B - A" using positive_iff_decomp[of "B - A"] by auto
     then obtain M where dimM: "M \<in> carrier_mat n n" and M: "M * adjoint M = B - A" by auto
     {
       fix \<rho> assume dimr: "\<rho> \<in> carrier_mat n n" and pdr: "partial_density_operator \<rho>"
       have eq: "trace(B * \<rho>) - trace(A * \<rho>) = trace((B - A) * \<rho>)" using A B dimr
         apply (subst minus_mult_distrib_mat, auto)
         apply (subst trace_minus_linear, auto)
         done
       have pr: "positive \<rho>" using pdr partial_density_operator_def by auto
       then have "\<exists>P\<in>carrier_mat n n. \<rho> = P * adjoint P" using positive_iff_decomp dimr by auto
       then obtain P where dimP: "P \<in> carrier_mat n n" and P: "\<rho> = P * adjoint P" by auto
       have "trace((B - A) * \<rho>) = trace(M * adjoint M * (P * adjoint P))" using P M by auto
       also have "\<dots> = trace((adjoint P * M) * adjoint (adjoint P * M))" using dimM dimP by (mat_assoc n)
       also have "\<dots> \<ge> 0" using trace_adjoint_positive by auto
       finally have "trace((B - A) * \<rho>) \<ge> 0".
       with eq have " trace (B * \<rho>) - trace (A * \<rho>) \<ge> 0" by auto
     }
     then show "\<forall>\<rho>\<in>carrier_mat n n. partial_density_operator \<rho> \<longrightarrow> trace (A * \<rho>) \<le> trace (B * \<rho>)" by auto
   }
 
   {
     assume asm: "\<forall>\<rho>\<in>carrier_mat n n. partial_density_operator \<rho> \<longrightarrow> trace (A * \<rho>) \<le> trace (B * \<rho>)"
     have "positive (B - A)" 
     proof -
       {
         fix v assume "dim_vec (v::complex vec) = dim_col (B - A) \<and> vec_norm v = 1"
         then have dimv: "v \<in> carrier_vec n" and nv: "vec_norm v = 1"
           using carrier_matD[OF dimBmA] by (auto intro: carrier_vecI)
         have dimov: "outer_prod v v \<in> carrier_mat n n" using dimv by auto
         then have "partial_density_operator (outer_prod v v)" 
           using dimv nv pure_state_self_outer_prod_is_partial_density_operator by auto
         then have leq: "trace(A * (outer_prod v v)) \<le> trace(B * (outer_prod v v))" using asm dimov by auto
         have "trace((B - A) * (outer_prod v v)) = trace(B * (outer_prod v v)) - trace(A * (outer_prod v v))" using A B dimov
           apply (subst minus_mult_distrib_mat, auto)
           apply (subst trace_minus_linear, auto)
           done
         then have "trace((B - A) * (outer_prod v v)) \<ge> 0" using leq by auto
         then have "inner_prod v ((B - A) *\<^sub>v v) \<ge> 0" using trace_outer_prod_right[OF dimBmA dimv dimv] by auto
       }
       then show "positive (B - A)" using positive_iff_normalized_vec[of "B - A"] dimBmA A by simp
     qed
     then show "A \<le>\<^sub>L B" using lowner_le_def A B by auto
   }
 qed
 
 lemma lowner_le_traceI:
   assumes "A \<in> carrier_mat n n"
     and "B \<in> carrier_mat n n"
     and "\<And>\<rho>. \<rho> \<in> carrier_mat n n \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> trace (A * \<rho>) \<le> trace (B * \<rho>)"
   shows "A \<le>\<^sub>L B"
   using lowner_le_trace assms by auto
 
 lemma trace_pdo_eq_imp_eq:
   assumes A: "A \<in> carrier_mat n n"
     and B: "B \<in> carrier_mat n n"
     and teq: "\<And>\<rho>. \<rho> \<in> carrier_mat n n \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> trace (A * \<rho>) = trace (B * \<rho>)"
   shows "A = B"
 proof -
   from teq have "A \<le>\<^sub>L B" using lowner_le_trace[OF A B] teq by auto
   moreover from teq have "B \<le>\<^sub>L A" using lowner_le_trace[OF B A] teq by auto
   ultimately show "A = B" using lowner_le_antisym A B by auto
 qed
 
 lemma lowner_le_traceD:
   assumes "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" "\<rho> \<in> carrier_mat n n"
     and "A \<le>\<^sub>L B"
     and "partial_density_operator \<rho>"
   shows "trace (A * \<rho>) \<le> trace (B * \<rho>)"
   using lowner_le_trace assms by blast
 
 lemma sum_only_one_neq_0:
   assumes "finite A" and "j \<in> A" and "\<And>i. i \<in> A \<Longrightarrow> i \<noteq> j \<Longrightarrow> g i = 0"
   shows "sum g A = g j" 
 proof -
   have "{j} \<subseteq> A" using assms by auto
   moreover have "\<forall>i\<in>A - {j}. g i = 0" using assms by simp
   ultimately have "sum g A = sum g {j}" using assms 
     by (auto simp add: comm_monoid_add_class.sum.mono_neutral_right[of A "{j}" g])
   moreover have "sum g {j} = g j" by simp
   ultimately show ?thesis by auto
 qed
 
 end
diff --git a/thys/Stirling_Formula/Gamma_Asymptotics.thy b/thys/Stirling_Formula/Gamma_Asymptotics.thy
--- a/thys/Stirling_Formula/Gamma_Asymptotics.thy
+++ b/thys/Stirling_Formula/Gamma_Asymptotics.thy
@@ -1,1893 +1,1893 @@
 (*
   File:    Gamma_Asymptotics.thy
   Author:  Manuel Eberl
 
   The complete asymptotics of the real and complex logarithmic Gamma functions.
   Also of the real Polygamma functions (could be extended to the complex ones fairly easily
   if needed).
 *)
 section \<open>Complete asymptotics of the logarithmic Gamma function\<close>
 theory Gamma_Asymptotics
 imports 
   "HOL-Complex_Analysis.Complex_Analysis"
   "HOL-Real_Asymp.Real_Asymp"
   Bernoulli.Bernoulli_FPS 
   Bernoulli.Periodic_Bernpoly 
   Stirling_Formula
 begin
 
 subsection \<open>Auxiliary Facts\<close>
 
 (* TODO: could be automated with Laurent series expansions in the future *)
 lemma stirling_limit_aux1: 
   "((\<lambda>y. Ln (1 + z * of_real y) / of_real y) \<longlongrightarrow> z) (at_right 0)" for z :: complex
 proof (cases "z = 0")
   case True
   then show ?thesis by simp
 next
   case False
   have "((\<lambda>y. ln (1 + z * of_real y)) has_vector_derivative 1 * z) (at 0)"
     by (rule has_vector_derivative_real_field) (auto intro!: derivative_eq_intros)
   then have "(\<lambda>y. (Ln (1 + z * of_real y) - of_real y * z) / of_real \<bar>y\<bar>) \<midarrow>0\<rightarrow> 0"
     by (auto simp add: has_vector_derivative_def has_derivative_def netlimit_at 
           scaleR_conv_of_real field_simps)
   then have "((\<lambda>y. (Ln (1 + z * of_real y) - of_real y * z) / of_real \<bar>y\<bar>) \<longlongrightarrow> 0) (at_right 0)"
     by (rule filterlim_mono[OF _ _ at_le]) simp_all
   also have "?this \<longleftrightarrow> ((\<lambda>y. Ln (1 + z * of_real y) / (of_real y) - z) \<longlongrightarrow> 0) (at_right 0)"
     using eventually_at_right_less[of "0::real"]
     by (intro filterlim_cong refl) (auto elim!: eventually_mono simp: field_simps)
   finally show ?thesis by (simp only: LIM_zero_iff)
 qed
   
 lemma stirling_limit_aux2: 
   "((\<lambda>y. y * Ln (1 + z / of_real y)) \<longlongrightarrow> z) at_top" for z :: complex
   using stirling_limit_aux1[of z] by (subst filterlim_at_top_to_right) (simp add: field_simps)
 
 lemma Union_atLeastAtMost: 
   assumes "N > 0" 
   shows   "(\<Union>n\<in>{0..<N}. {real n..real (n + 1)}) = {0..real N}"
 proof (intro equalityI subsetI)
   fix x assume x: "x \<in> {0..real N}"
   thus "x \<in> (\<Union>n\<in>{0..<N}. {real n..real (n + 1)})"
   proof (cases "x = real N")
     case True
     with assms show ?thesis by (auto intro!: bexI[of _ "N - 1"])
   next
     case False
     with x have x: "x \<ge> 0" "x < real N" by simp_all
     hence "x \<ge> real (nat \<lfloor>x\<rfloor>)" "x \<le> real (nat \<lfloor>x\<rfloor> + 1)" by linarith+
     moreover from x have "nat \<lfloor>x\<rfloor> < N" by linarith
     ultimately have "\<exists>n\<in>{0..<N}. x \<in> {real n..real (n + 1)}"
       by (intro bexI[of _ "nat \<lfloor>x\<rfloor>"]) simp_all
     thus ?thesis by blast
   qed
 qed auto
 
 
 subsection \<open>Cones in the complex plane\<close>
 
 definition complex_cone :: "real \<Rightarrow> real \<Rightarrow> complex set" where
   "complex_cone a b = {z. \<exists>y\<in>{a..b}. z = rcis (norm z) y}"
 
 abbreviation complex_cone' :: "real \<Rightarrow> complex set" where
   "complex_cone' a \<equiv> complex_cone (-a) a"
 
 lemma zero_in_complex_cone [simp, intro]: "a \<le> b \<Longrightarrow> 0 \<in> complex_cone a b"
   by (auto simp: complex_cone_def)
 
 lemma complex_coneE:
   assumes "z \<in> complex_cone a b"
   obtains r \<alpha> where "r \<ge> 0" "\<alpha> \<in> {a..b}" "z = rcis r \<alpha>"
 proof -
   from assms obtain y where "y \<in> {a..b}" "z = rcis (norm z) y"
     unfolding complex_cone_def by auto
   thus ?thesis using that[of "norm z" y] by auto
 qed
 
 lemma arg_cis [simp]:
   assumes "x \<in> {-pi<..pi}"
   shows   "Arg (cis x) = x"
   using assms by (intro cis_Arg_unique) auto
 
 lemma arg_mult_of_real_left [simp]:
   assumes "r > 0"
   shows   "Arg (of_real r * z) = Arg z"
 proof (cases "z = 0")
   case False
   thus ?thesis
     using Arg_bounded[of z] assms
     by (intro cis_Arg_unique) (auto simp: sgn_mult sgn_of_real cis_Arg)
 qed auto
 
 lemma arg_mult_of_real_right [simp]:
   assumes "r > 0"
   shows   "Arg (z * of_real r) = Arg z"
   by (subst mult.commute, subst arg_mult_of_real_left) (simp_all add: assms)
 
 lemma arg_rcis [simp]:
   assumes "x \<in> {-pi<..pi}" "r > 0"
   shows   "Arg (rcis r x) = x"
   using assms by (simp add: rcis_def)
 
 lemma rcis_in_complex_cone [intro]: 
   assumes "\<alpha> \<in> {a..b}" "r \<ge> 0"
   shows   "rcis r \<alpha> \<in> complex_cone a b"
   using assms by (auto simp: complex_cone_def)  
 
 lemma arg_imp_in_complex_cone:
   assumes "Arg z \<in> {a..b}"
   shows   "z \<in> complex_cone a b"
 proof -
   have "z = rcis (norm z) (Arg z)"
     by (simp add: rcis_cmod_Arg)
   also have "\<dots> \<in> complex_cone a b"
     using assms by auto
   finally show ?thesis .
 qed
 
 lemma complex_cone_altdef:
   assumes "-pi < a" "a \<le> b" "b \<le> pi"
   shows   "complex_cone a b = insert 0 {z. Arg z \<in> {a..b}}"
 proof (intro equalityI subsetI)
   fix z assume "z \<in> complex_cone a b"
   then obtain r \<alpha> where *: "r \<ge> 0" "\<alpha> \<in> {a..b}" "z = rcis r \<alpha>"
     by (auto elim: complex_coneE)
   have "Arg z \<in> {a..b}" if [simp]: "z \<noteq> 0"
   proof -
     have "r > 0" using that * by (subst (asm) *) auto
     hence "\<alpha> \<in> {a..b}"
       using *(1,2) assms by (auto simp: *(1))
     moreover from assms *(2) have "\<alpha> \<in> {-pi<..pi}"
       by auto
     ultimately show ?thesis using *(3) \<open>r > 0\<close>
       by (subst *) auto
   qed
   thus "z \<in> insert 0 {z. Arg z \<in> {a..b}}"
     by auto
 qed (use assms in \<open>auto intro: arg_imp_in_complex_cone\<close>)
 
 lemma nonneg_of_real_in_complex_cone [simp, intro]:
   assumes "x \<ge> 0" "a \<le> 0" "0 \<le> b"
   shows   "of_real x \<in> complex_cone a b"
 proof -
   from assms have "rcis x 0 \<in> complex_cone a b"
     by (intro rcis_in_complex_cone) auto
   thus ?thesis by simp
 qed
 
 lemma one_in_complex_cone [simp, intro]: "a \<le> 0 \<Longrightarrow> 0 \<le> b \<Longrightarrow> 1 \<in> complex_cone a b"
   using nonneg_of_real_in_complex_cone[of 1] by (simp del: nonneg_of_real_in_complex_cone)
 
 lemma of_nat_in_complex_cone [simp, intro]: "a \<le> 0 \<Longrightarrow> 0 \<le> b \<Longrightarrow> of_nat n \<in> complex_cone a b"
   using nonneg_of_real_in_complex_cone[of "real n"] by (simp del: nonneg_of_real_in_complex_cone)
 
 
 subsection \<open>Another integral representation of the Beta function\<close>
 
 lemma complex_cone_inter_nonpos_Reals:
   assumes "-pi < a" "a \<le> b" "b < pi"
   shows   "complex_cone a b \<inter> \<real>\<^sub>\<le>\<^sub>0 = {0}"
 proof (safe elim!: nonpos_Reals_cases)
   fix x :: real
   assume "complex_of_real x \<in> complex_cone a b" "x \<le> 0"
   hence "\<not>(x < 0)"
     using assms by (intro notI) (auto simp: complex_cone_altdef)
   with \<open>x \<le> 0\<close> show "complex_of_real x = 0" by auto  
 qed (use assms in auto)
 
 theorem 
   assumes a: "a > 0" and b: "b > (0 :: real)"
   shows has_integral_Beta_real': 
           "((\<lambda>u. u powr (b - 1) / (1 + u) powr (a + b)) has_integral Beta a b) {0<..}"
     and Beta_conv_nn_integral:
           "Beta a b = (\<integral>\<^sup>+u. ennreal (indicator {0<..} u * u powr (b - 1) / (1 + u) powr (a + b)) \<partial>lborel)"
 proof -
   define I where 
     "I = (\<integral>\<^sup>+u. ennreal (indicator {0<..} u * u powr (b - 1) / (1 + u) powr (a + b)) \<partial>lborel)"
   have "Gamma (a + b) > 0" "Beta a b > 0"
     using assms by (simp_all add: add_pos_pos Beta_def)
   from a b have "ennreal (Gamma a * Gamma b) =
     (\<integral>\<^sup>+ t. ennreal (indicator {0..} t * t powr (a - 1) / exp t) \<partial>lborel) *
     (\<integral>\<^sup>+ t. ennreal (indicator {0..} t * t powr (b - 1) / exp t) \<partial>lborel)"
     by (subst ennreal_mult') (simp_all add: Gamma_conv_nn_integral_real)
   also have "\<dots> = (\<integral>\<^sup>+t. \<integral>\<^sup>+u. ennreal (indicator {0..} t * t powr (a - 1) / exp t) *
                             ennreal (indicator {0..} u * u powr (b - 1) / exp u) \<partial>lborel \<partial>lborel)"
     by (simp add: nn_integral_cmult nn_integral_multc)
   also have "\<dots> = (\<integral>\<^sup>+t. indicator {0<..} t * (\<integral>\<^sup>+u. indicator {0..} u * t powr (a - 1) * u powr (b - 1)
                             / exp (t + u) \<partial>lborel) \<partial>lborel)"
     by (intro nn_integral_cong_AE AE_I[of _ _ "{0}"])
        (auto simp: indicator_def divide_ennreal ennreal_mult' [symmetric] exp_add mult_ac)
   also have "\<dots> = (\<integral>\<^sup>+t. indicator {0<..} t * (\<integral>\<^sup>+u. indicator {0..} u * t powr (a - 1) * u powr (b - 1)
                             / exp (t + u) 
                     \<partial>(density (distr lborel borel ((*) t)) (\<lambda>x. ennreal \<bar>t\<bar>))) \<partial>lborel)"
     by (intro nn_integral_cong mult_indicator_cong, subst lborel_distr_mult' [symmetric]) auto
   also have "\<dots> = (\<integral>\<^sup>+(t::real). indicator {0<..} t * (\<integral>\<^sup>+u. 
                      indicator {0..} (u * t) * t powr a *
                      (u * t) powr (b - 1) / exp (t + t * u) \<partial>lborel) \<partial>lborel)"
     by (intro nn_integral_cong mult_indicator_cong)
        (auto simp: nn_integral_density nn_integral_distr algebra_simps powr_diff
              simp flip: ennreal_mult)
   also have "\<dots> = (\<integral>\<^sup>+(t::real). \<integral>\<^sup>+u. indicator ({0<..}\<times>{0..}) (t, u) *
                      t powr a * (u * t) powr (b - 1) / exp (t * (u + 1)) \<partial>lborel \<partial>lborel)"
     by (subst nn_integral_cmult [symmetric], simp, intro nn_integral_cong)
        (auto simp: indicator_def zero_le_mult_iff algebra_simps)
   also have "\<dots> = (\<integral>\<^sup>+(t::real). \<integral>\<^sup>+u. indicator ({0<..}\<times>{0..}) (t, u) *
                      t powr (a + b - 1) * u powr (b - 1) / exp (t * (u + 1)) \<partial>lborel \<partial>lborel)"
     by (intro nn_integral_cong) (auto simp: powr_add powr_diff indicator_def powr_mult field_simps)
   also have "\<dots> = (\<integral>\<^sup>+(u::real). \<integral>\<^sup>+t. indicator ({0<..}\<times>{0..}) (t, u) *
                      t powr (a + b - 1) * u powr (b - 1) / exp (t * (u + 1)) \<partial>lborel \<partial>lborel)"
     by (rule lborel_pair.Fubini') auto
   also have "\<dots> = (\<integral>\<^sup>+(u::real). indicator {0..} u * (\<integral>\<^sup>+t. indicator {0<..} t *
                      t powr (a + b - 1) * u powr (b - 1) / exp (t * (u + 1)) \<partial>lborel) \<partial>lborel)"
     by (intro nn_integral_cong mult_indicator_cong) (auto simp: indicator_def)
   also have "\<dots> = (\<integral>\<^sup>+(u::real). indicator {0<..} u * (\<integral>\<^sup>+t. indicator {0<..} t *
                      t powr (a + b - 1) * u powr (b - 1) / exp (t * (u + 1)) \<partial>lborel) \<partial>lborel)"
     by (intro nn_integral_cong_AE AE_I[of _ _ "{0}"]) (auto simp: indicator_def)
   also have "\<dots> = (\<integral>\<^sup>+(u::real). indicator {0<..} u * (\<integral>\<^sup>+t. indicator {0<..} t *
                      t powr (a + b - 1) * u powr (b - 1) / exp (t * (u + 1)) 
                     \<partial>(density (distr lborel borel ((*) (1/(1+u)))) (\<lambda>x. ennreal \<bar>1/(1+u)\<bar>))) \<partial>lborel)"
     by (intro nn_integral_cong mult_indicator_cong, subst lborel_distr_mult' [symmetric]) auto
   also have "\<dots> = (\<integral>\<^sup>+(u::real). indicator {0<..} u * 
                     (\<integral>\<^sup>+t. ennreal (1 / (u + 1)) * ennreal (indicator {0<..} (t / (u + 1)) *
                      (t / (1+u)) powr (a + b - 1) * u powr (b - 1) / exp t)
                     \<partial>lborel) \<partial>lborel)"
     by (intro nn_integral_cong mult_indicator_cong)
        (auto simp: nn_integral_distr nn_integral_density add_ac)
   also have "\<dots> = (\<integral>\<^sup>+u. \<integral>\<^sup>+t. indicator ({0<..}\<times>{0<..}) (u, t) * 
                     1/(u+1) * (t / (u+1)) powr (a + b - 1) * u powr (b - 1) / exp t
                     \<partial>lborel \<partial>lborel)"
     by (subst nn_integral_cmult [symmetric], simp, intro nn_integral_cong)
        (auto simp: indicator_def field_simps divide_ennreal simp flip: ennreal_mult ennreal_mult')
   also have "\<dots> = (\<integral>\<^sup>+u. \<integral>\<^sup>+t. ennreal (indicator {0<..} u * u powr (b - 1) / (1 + u) powr (a + b)) *
                             ennreal (indicator {0<..} t * t powr (a + b - 1) / exp t)
                     \<partial>lborel \<partial>lborel)"
     by (intro nn_integral_cong)
        (auto simp: indicator_def powr_add powr_diff powr_divide powr_minus divide_simps add_ac
              simp flip: ennreal_mult)
   also have "\<dots> = I * (\<integral>\<^sup>+t. indicator {0<..} t * t powr (a + b - 1) / exp t \<partial>lborel)"
     by (simp add: nn_integral_cmult nn_integral_multc I_def)
   also have "(\<integral>\<^sup>+t. indicator {0<..} t * t powr (a + b - 1) / exp t \<partial>lborel) =
                ennreal (Gamma (a + b))"
     using assms
     by (subst Gamma_conv_nn_integral_real)
        (auto intro!: nn_integral_cong_AE[OF AE_I[of _ _ "{0}"]] 
              simp: indicator_def split: if_splits)
   finally have "ennreal (Gamma a * Gamma b) = I * ennreal (Gamma (a + b))" .
   hence "ennreal (Gamma a * Gamma b) / ennreal (Gamma (a + b)) =
            I * ennreal (Gamma (a + b)) / ennreal (Gamma (a + b))" by simp
   also have "\<dots> = I"
     using \<open>Gamma (a + b) > 0\<close> by (intro ennreal_mult_divide_eq) (auto simp: )
   also have "ennreal (Gamma a * Gamma b) / ennreal (Gamma (a + b)) =
                ennreal (Gamma a * Gamma b / Gamma (a + b))"
     using assms by (intro divide_ennreal) auto
   also have "\<dots> = ennreal (Beta a b)"
     by (simp add: Beta_def)
   finally show *: "ennreal (Beta a b) = I" .
 
   define f where "f = (\<lambda>u. u powr (b - 1) / (1 + u) powr (a + b))"
   have "((\<lambda>u. indicator {0<..} u * f u) has_integral Beta a b) UNIV"
     using * \<open>Beta a b > 0\<close>
     by (subst has_integral_iff_nn_integral_lebesgue)
        (auto simp: f_def measurable_completion nn_integral_completion I_def mult_ac)
   also have "(\<lambda>u. indicator {0<..} u * f u) = (\<lambda>u. if u \<in> {0<..} then f u else 0)"
     by (auto simp: fun_eq_iff)
   also have "(\<dots> has_integral Beta a b) UNIV \<longleftrightarrow> (f has_integral Beta a b) {0<..}"
     by (rule has_integral_restrict_UNIV)
   finally show \<dots> by (simp add: f_def)
 qed
 
 lemma has_integral_Beta2:
   fixes a :: real
   assumes "a < -1/2"
   shows   "((\<lambda>x. (1 + x ^ 2) powr a) has_integral Beta (- a - 1 / 2) (1 / 2) / 2) {0<..}"
 proof -
   define f where "f = (\<lambda>u. u powr (-1/2) / (1 + u) powr (-a))"
   define C where "C = Beta (-a-1/2) (1/2)"
   have I: "(f has_integral C) {0<..}"
     using has_integral_Beta_real'[of "-a-1/2" "1/2"] assms
     by (simp_all add: diff_divide_distrib f_def C_def)
 
   define g where "g = (\<lambda>x. x ^ 2 :: real)"
   have bij: "bij_betw g {0<..} {0<..}"
     by (intro bij_betwI[of _ _ _ sqrt]) (auto simp: g_def)
 
   have "(f absolutely_integrable_on g ` {0<..} \<and> integral (g ` {0<..}) f = C)"
     using I bij by (simp add: bij_betw_def has_integral_iff absolutely_integrable_on_def f_def)
   also have "?this \<longleftrightarrow> ((\<lambda>x. \<bar>2 * x\<bar> *\<^sub>R f (g x)) absolutely_integrable_on {0<..} \<and>
                          integral {0<..} (\<lambda>x. \<bar>2 * x\<bar> *\<^sub>R f (g x)) = C)"
     using bij by (intro has_absolute_integral_change_of_variables_1' [symmetric])
                  (auto intro!: derivative_eq_intros simp: g_def bij_betw_def)
   finally have "((\<lambda>x. \<bar>2 * x\<bar> * f (g x)) has_integral C) {0<..}"
     by (simp add: absolutely_integrable_on_def f_def has_integral_iff)
   also have "?this \<longleftrightarrow> ((\<lambda>x::real. 2 * (1 + x\<^sup>2) powr a) has_integral C) {0<..}"
     by (intro has_integral_cong) (auto simp: f_def g_def powr_def exp_minus ln_realpow field_simps)
   finally have "((\<lambda>x::real. 1/2 * (2 * (1 + x\<^sup>2) powr a)) has_integral 1/2 * C) {0<..}"
     by (intro has_integral_mult_right)
   thus ?thesis by (simp add: C_def)
 qed
 
 lemma has_integral_Beta3:
   fixes a b :: real
   assumes "a < -1/2" and "b > 0"
   shows   "((\<lambda>x. (b + x ^ 2) powr a) has_integral
              Beta (-a - 1/2) (1/2) / 2 * b powr (a + 1/2)) {0<..}"
 proof -
   define C where "C = Beta (- a - 1 / 2) (1 / 2) / 2"
   have int: "nn_integral lborel (\<lambda>x. indicator {0<..} x * (1 + x ^ 2) powr a) = C"
     using nn_integral_has_integral_lebesgue[OF _ has_integral_Beta2[OF assms(1)]]
     by (auto simp: C_def)
   have "nn_integral lborel (\<lambda>x. indicator {0<..} x * (b + x ^ 2) powr a) =
         (\<integral>\<^sup>+x. ennreal (indicat_real {0<..} (x * sqrt b) * (b + (x * sqrt b)\<^sup>2) powr a * sqrt b) \<partial>lborel)"
     using assms
     by (subst lborel_distr_mult'[of "sqrt b"])
        (auto simp: nn_integral_density nn_integral_distr mult_ac simp flip: ennreal_mult)
   also have "\<dots> = (\<integral>\<^sup>+x. ennreal (indicat_real {0<..} x * (b * (1 + x ^ 2)) powr a * sqrt b) \<partial>lborel)"
     using assms
     by (intro nn_integral_cong) (auto simp: indicator_def field_simps zero_less_mult_iff)
   also have "\<dots> = (\<integral>\<^sup>+x. ennreal (indicat_real {0<..} x * b powr (a + 1/2) * (1 + x ^ 2) powr a) \<partial>lborel)"
     using assms
     by (intro nn_integral_cong) (auto simp: indicator_def powr_add powr_half_sqrt powr_mult)    
   also have "\<dots> = b powr (a + 1/2) * (\<integral>\<^sup>+x. ennreal (indicat_real {0<..} x * (1 + x ^ 2) powr a) \<partial>lborel)"
     using assms by (subst nn_integral_cmult [symmetric]) (simp_all add: mult_ac flip: ennreal_mult)
   also have "(\<integral>\<^sup>+x. ennreal (indicat_real {0<..} x * (1 + x ^ 2) powr a) \<partial>lborel) = C"
     using int by simp
   also have "ennreal (b powr (a + 1/2)) * ennreal C = ennreal (C * b powr (a + 1/2))"
     using assms by (subst ennreal_mult) (auto simp: C_def mult_ac Beta_def)
   finally have *: "(\<integral>\<^sup>+ x. ennreal (indicat_real {0<..} x * (b + x\<^sup>2) powr a) \<partial>lborel) = \<dots>" .
   hence "((\<lambda>x. indicator {0<..} x * (b + x^2) powr a) has_integral C * b powr (a + 1/2)) UNIV"
     using assms
     by (subst has_integral_iff_nn_integral_lebesgue)
        (auto simp: C_def measurable_completion nn_integral_completion Beta_def)
   also have "(\<lambda>x. indicator {0<..} x * (b + x^2) powr a) =
              (\<lambda>x. if x \<in> {0<..} then (b + x^2) powr a else 0)"
     by (auto simp: fun_eq_iff)
   finally show ?thesis
     by (subst (asm) has_integral_restrict_UNIV) (auto simp: C_def)
 qed
 
   
 subsection \<open>Asymptotics of the real $\log\Gamma$ function and its derivatives\<close>
 
 text \<open>
   This is the error term that occurs in the expansion of @{term ln_Gamma}. It can be shown to 
   be of order $O(s^{-n})$.
 \<close>
 definition stirling_integral :: "nat \<Rightarrow> 'a :: {real_normed_div_algebra, banach} \<Rightarrow> 'a" where
   "stirling_integral n s = 
      lim (\<lambda>N. integral {0..N} (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n))"
 
 context
   fixes s :: complex assumes s: "s \<notin> \<real>\<^sub>\<le>\<^sub>0"
   fixes approx :: "nat \<Rightarrow> complex"
   defines "approx \<equiv> (\<lambda>N. 
     (\<Sum>n = 1..<N. s / of_nat n - ln (1 + s / of_nat n)) - (euler_mascheroni * s + ln s) - \<comment> \<open>\<open>\<longrightarrow> ln_Gamma s\<close>\<close>
     (ln_Gamma (of_nat N) - ln (2 * pi / of_nat N) / 2 - of_nat N * ln (of_nat N) + of_nat N) - \<comment> \<open>\<open>\<longrightarrow> 0\<close>\<close>
     s * (harm (N - 1) - ln (of_nat (N - 1)) - euler_mascheroni) + \<comment> \<open>\<open>\<longrightarrow> 0\<close>\<close>
     s * (ln (of_nat N + s) - ln (of_nat (N - 1))) - \<comment> \<open>\<open>\<longrightarrow> 0\<close>\<close>
     (1/2) * (ln (of_nat N + s) - ln (of_nat N)) +       \<comment> \<open>\<open>\<longrightarrow> 0\<close>\<close>
     of_nat N * (ln (of_nat N + s) - ln (of_nat N)) -  \<comment> \<open>\<open>\<longrightarrow> s\<close>\<close>
     (s - 1/2) * ln s - ln (2 * pi) / 2)"
 begin       
   
 qualified lemma
   assumes N: "N > 0"
   shows   integrable_pbernpoly_1:
             "(\<lambda>x. of_real (-pbernpoly 1 x) / (of_real x + s)) integrable_on {0..real N}"
   and     integral_pbernpoly_1_aux:
             "integral {0..real N} (\<lambda>x. -of_real (pbernpoly 1 x) / (of_real x + s)) = approx N"
   and     has_integral_pbernpoly_1:
             "((\<lambda>x. pbernpoly 1 x /(x + s)) has_integral 
               (\<Sum>m<N. (of_nat m + 1 / 2 + s) * (ln (of_nat m + s) - 
                         ln (of_nat m + 1 + s)) + 1)) {0..real N}"
 proof -
   let ?A = "(\<lambda>n. {of_nat n..of_nat (n+1)}) ` {0..<N}"
   have has_integral: 
     "((\<lambda>x. -pbernpoly 1 x / (x + s)) has_integral 
              (of_nat n + 1/2 + s) * (ln (of_nat (n + 1) + s) - ln (of_nat n + s)) - 1) 
            {of_nat n..of_nat (n + 1)}" for n
   proof (rule has_integral_spike)      
-    have "((\<lambda>x. (of_nat n + 1/2 + s) * (1 / (x + s)) - 1) has_integral 
+    have "((\<lambda>x. (of_nat n + 1/2 + s) * (1 / (of_real x + s)) - 1) has_integral 
               (of_nat n + 1/2 + s) * (ln (of_real (real (n + 1)) + s) - ln (of_real (real n) + s)) - 1) 
             {of_nat n..of_nat (n + 1)}" 
       using s has_integral_const_real[of 1 "of_nat n" "of_nat (n + 1)"]
       by (intro has_integral_diff has_integral_mult_right fundamental_theorem_of_calculus)
          (auto intro!: derivative_eq_intros has_vector_derivative_real_field
                simp: has_field_derivative_iff_has_vector_derivative [symmetric] field_simps
                      complex_nonpos_Reals_iff)
-    thus "((\<lambda>x. (of_nat n + 1/2 + s) * (1 / (x + s)) - 1) has_integral 
+    thus "((\<lambda>x. (of_nat n + 1/2 + s) * (1 / (of_real x + s)) - 1) has_integral 
               (of_nat n + 1/2 + s) * (ln (of_nat (n + 1) + s) - ln (of_nat n + s)) - 1) 
             {of_nat n..of_nat (n + 1)}" by simp
              
     show "-pbernpoly 1 x / (x + s) = (of_nat n + 1/2 + s) * (1 / (x + s)) - 1"
          if "x \<in> {of_nat n..of_nat (n + 1)} - {of_nat (n + 1)}" for x
     proof -
       have x: "x \<ge> real n" "x < real (n + 1)" using that by simp_all
       hence "floor x = int n" by linarith
       moreover from s x have "complex_of_real x \<noteq> -s" 
         by (auto simp add: complex_eq_iff complex_nonpos_Reals_iff simp del: of_nat_Suc)
       ultimately show "-pbernpoly 1 x / (x + s) = (of_nat n + 1/2 + s) * (1 / (x + s)) - 1"
         by (auto simp: pbernpoly_def bernpoly_def frac_def divide_simps add_eq_0_iff2)
     qed
   qed simp_all
   hence *: "\<And>I. I\<in>?A \<Longrightarrow> ((\<lambda>x. -pbernpoly 1 x / (x + s)) has_integral 
               (Inf I + 1/2 + s) * (ln (Inf I + 1 + s) - ln (Inf I + s)) - 1) I"
     by (auto simp: add_ac)
   have "((\<lambda>x. - pbernpoly 1 x / (x + s)) has_integral
           (\<Sum>I\<in>?A. (Inf I + 1 / 2 + s) * (ln (Inf I + 1 + s) - ln (Inf I + s)) - 1))
           (\<Union>n\<in>{0..<N}. {real n..real (n + 1)})" (is "(_ has_integral ?i) _")
     apply (intro has_integral_Union * finite_imageI)
       apply (force intro!: negligible_atLeastAtMostI pairwiseI)+
     done
   hence has_integral: "((\<lambda>x. - pbernpoly 1 x / (x + s)) has_integral ?i) {0..real N}"
     by (subst has_integral_spike_set_eq)
        (use Union_atLeastAtMost assms in \<open>auto simp: intro!: empty_imp_negligible\<close>)
   hence "(\<lambda>x. - pbernpoly 1 x / (x + s)) integrable_on {0..real N}"
     and integral:   "integral {0..real N} (\<lambda>x. - pbernpoly 1 x / (x + s)) = ?i"
     by (simp_all add: has_integral_iff)
   show "(\<lambda>x. - pbernpoly 1 x / (x + s)) integrable_on {0..real N}" by fact
 
   note has_integral_neg[OF has_integral]
   also have "-?i = (\<Sum>x<N. (of_nat x + 1 / 2 + s) * (ln (of_nat x + s) - ln (of_nat x + 1 + s)) + 1)" 
     by (subst sum.reindex) 
        (simp_all add: inj_on_def atLeast0LessThan algebra_simps sum_negf [symmetric])
   finally show has_integral: 
     "((\<lambda>x. of_real (pbernpoly 1 x) / (of_real x + s)) has_integral \<dots>) {0..real N}" by simp
       
   note integral
   also have "?i = (\<Sum>n<N. (of_nat n + 1 / 2 + s) * 
                     (ln (of_nat n + 1 + s) - ln (of_nat n + s))) - N" (is "_ = ?S - _")
     by (subst sum.reindex) (simp_all add: inj_on_def sum_subtractf atLeast0LessThan)
   also have "?S = (\<Sum>n<N. of_nat n * (ln (of_nat n + 1 + s) - ln (of_nat n + s))) +
                     (s + 1 / 2) * (\<Sum>n<N. ln (of_nat (Suc n) + s) - ln (of_nat n + s))" 
     (is "_ = ?S1 + _ * ?S2") by (simp add: algebra_simps sum.distrib sum_subtractf sum_distrib_left)
   also have "?S2 = ln (of_nat N + s) - ln s" by (subst sum_lessThan_telescope) simp
   also have "?S1 = (\<Sum>n=1..<N. of_nat n * (ln (of_nat n + 1 + s) - ln (of_nat n + s)))"
     by (intro sum.mono_neutral_right) auto
   also have "\<dots> = (\<Sum>n=1..<N. of_nat n * ln (of_nat n + 1 + s)) - (\<Sum>n=1..<N. of_nat n * ln (of_nat n + s))"
     by (simp add: algebra_simps sum_subtractf)
   also have "(\<Sum>n=1..<N. of_nat n * ln (of_nat n + 1 + s)) = 
                (\<Sum>n=1..<N. (of_nat n - 1) * ln (of_nat n + s)) + (N - 1) * ln (of_nat N + s)"
     by (induction N) (simp_all add: add_ac of_nat_diff)
   also have "\<dots> - (\<Sum>n = 1..<N. of_nat n * ln (of_nat n + s)) =
                -(\<Sum>n=1..<N. ln (of_nat n + s)) + (N - 1) * ln (of_nat N + s)"
     by (induction N) (simp_all add: algebra_simps)
   also from s have neq: "s + of_nat x \<noteq> 0" for x
     by (auto simp:  complex_nonpos_Reals_iff complex_eq_iff)
   hence "(\<Sum>n=1..<N. ln (of_nat n + s)) = (\<Sum>n=1..<N. ln (of_nat n) + ln (1 + s/n))"
     by (intro sum.cong refl, subst Ln_times_of_nat [symmetric]) (auto simp: divide_simps add_ac)
   also have "\<dots> = ln (fact (N - 1)) + (\<Sum>n=1..<N. ln (1 + s/n))"
     by (induction N) (simp_all add: Ln_times_of_nat fact_reduce add_ac)
   also have "(\<Sum>n=1..<N. ln (1 + s/n)) = -(\<Sum>n=1..<N. s / n - ln (1 + s/n)) + s * (\<Sum>n=1..<N. 1 / of_nat n)"
     by (simp add: sum_distrib_left sum_subtractf) 
   also from N have "ln (fact (N - 1)) = ln_Gamma (of_nat N :: complex)" 
     by (simp add: ln_Gamma_complex_conv_fact)
   also have "{1..<N} = {1..N - 1}" by auto
   hence "(\<Sum>n = 1..<N. 1 / of_nat n) = (harm (N - 1) :: complex)" 
     by (simp add: harm_def divide_simps)
   also have "- (ln_Gamma (of_nat N) + (- (\<Sum>n = 1..<N. s / of_nat n - ln (1 + s / of_nat n)) +
                  s * harm (N - 1))) + of_nat (N - 1) * ln (of_nat N + s) +
                 (s + 1 / 2) * (ln (of_nat N + s) - ln s) - of_nat N = approx N"
     using N by (simp add: field_simps of_nat_diff ln_div approx_def Ln_of_nat 
                           ln_Gamma_complex_of_real [symmetric])
   finally show "integral {0..of_nat N} (\<lambda>x. -of_real (pbernpoly 1 x) / (of_real x + s)) = \<dots>" 
     by simp
 qed
   
 lemma integrable_ln_Gamma_aux:
   shows   "(\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n) integrable_on {0..real N}"
 proof (cases "n = 1")
   case True
   with s show ?thesis using integrable_neg[OF integrable_pbernpoly_1[of N]] 
     by (cases "N = 0") (simp_all add: integrable_negligible)
 next
   case False
   from s have "of_real x + s \<noteq> 0" if "x \<ge> 0" for x using that 
     by (auto simp: complex_eq_iff add_eq_0_iff2 complex_nonpos_Reals_iff)
   with False s show ?thesis
     by (auto intro!: integrable_continuous_real continuous_intros)
 qed
   
 text \<open>
   This following proof is based on ``Rudiments of the theory of the gamma function'' 
   by Bruce Berndt~\cite{berndt}.
 \<close>
 lemma tendsto_of_real_0_I: 
   "(f \<longlongrightarrow> 0) G \<Longrightarrow> ((\<lambda>x. (of_real (f x))) \<longlongrightarrow> (0 ::'a::real_normed_div_algebra)) G"
   using tendsto_of_real_iff by force
 
 qualified lemma integral_pbernpoly_1:
   "(\<lambda>N. integral {0..real N} (\<lambda>x. pbernpoly 1 x / (x + s)))
      \<longlonglongrightarrow> -ln_Gamma s - s + (s - 1 / 2) * ln s + ln (2 * pi) / 2"
 proof -  
   have neq: "s + of_real x \<noteq> 0" if "x \<ge> 0" for x :: real
     using that s by (auto simp: complex_eq_iff complex_nonpos_Reals_iff)
   have "(approx \<longlongrightarrow> ln_Gamma s - 0 - 0 + 0 - 0 + s - (s - 1/2) * ln s - ln (2 * pi) / 2) at_top"
     unfolding approx_def
   proof (intro tendsto_add tendsto_diff)
     from s have s': "s \<notin> \<int>\<^sub>\<le>\<^sub>0" by (auto simp: complex_nonpos_Reals_iff elim!: nonpos_Ints_cases)
     have "(\<lambda>n. \<Sum>i=1..<n. s / of_nat i - ln (1 + s / of_nat i)) \<longlonglongrightarrow> 
              ln_Gamma s + euler_mascheroni * s + ln s" (is "?f \<longlonglongrightarrow> _")
       using ln_Gamma_series'_aux[OF s'] unfolding sums_def 
       by (subst filterlim_sequentially_Suc [symmetric], subst (asm) sum.atLeast1_atMost_eq [symmetric]) 
          (simp add: atLeastLessThanSuc_atLeastAtMost)
     thus "((\<lambda>n. ?f n - (euler_mascheroni * s + ln s)) \<longlongrightarrow> ln_Gamma s) at_top"
       by (auto intro: tendsto_eq_intros)
   next
     show "(\<lambda>x. complex_of_real (ln_Gamma (real x) - ln (2 * pi / real x) / 2 - 
                  real x * ln (real x) + real x)) \<longlonglongrightarrow> 0"
     proof (intro tendsto_of_real_0_I 
              filterlim_compose[OF tendsto_sandwich filterlim_real_sequentially])
       show "eventually (\<lambda>x::real. ln_Gamma x - ln (2 * pi / x) / 2 - x * ln x + x \<ge> 0) at_top"
         using eventually_ge_at_top[of "1::real"] 
         by eventually_elim (insert ln_Gamma_bounds(1), simp add: algebra_simps)
       show "eventually (\<lambda>x::real. ln_Gamma x - ln (2 * pi / x) / 2 - x * ln x + x \<le> 
               1 / 12 * inverse x) at_top"
         using eventually_ge_at_top[of "1::real"] 
         by eventually_elim (insert ln_Gamma_bounds(2), simp add: field_simps)
       show "((\<lambda>x::real. 1 / 12 * inverse x) \<longlongrightarrow> 0) at_top"
         by (intro tendsto_mult_right_zero tendsto_inverse_0_at_top filterlim_ident)
     qed simp_all
   next
     have "(\<lambda>x. s * of_real (harm (x - 1) - ln (real (x - 1)) - euler_mascheroni)) \<longlonglongrightarrow> 
             s * of_real (euler_mascheroni - euler_mascheroni)"
       by (subst filterlim_sequentially_Suc [symmetric], intro tendsto_intros) 
          (insert euler_mascheroni_LIMSEQ, simp_all)
     also have "?this \<longleftrightarrow> (\<lambda>x. s * (harm (x - 1) - ln (of_nat (x - 1)) - euler_mascheroni)) \<longlonglongrightarrow> 0"
       by (intro filterlim_cong refl eventually_mono[OF eventually_gt_at_top[of "1::nat"]]) 
          (auto simp: Ln_of_nat of_real_harm)
     finally show "(\<lambda>x. s * (harm (x - 1) - ln (of_nat (x - 1)) - euler_mascheroni)) \<longlonglongrightarrow> 0"  .
   next
     have "((\<lambda>x. ln (1 + (s + 1) / of_real x)) \<longlongrightarrow> ln (1 + 0)) at_top" (is ?P)
       by (intro tendsto_intros tendsto_divide_0[OF tendsto_const]) 
          (simp_all add: filterlim_ident filterlim_at_infinity_conv_norm_at_top filterlim_abs_real)
     also have "ln (of_real (x + 1) + s) - ln (complex_of_real x) = ln (1 + (s + 1) / of_real x)" 
       if "x > 1" for x using that s
       using Ln_divide_of_real[of x "of_real (x + 1) + s", symmetric] neq[of "x+1"]
       by (simp add: field_simps Ln_of_real)
     hence "?P \<longleftrightarrow> ((\<lambda>x. ln (of_real (x + 1) + s) - ln (of_real x)) \<longlongrightarrow> 0) at_top"
       by (intro filterlim_cong refl) 
          (auto intro: eventually_mono[OF eventually_gt_at_top[of "1::real"]])
     finally have "((\<lambda>n. ln (of_real (real n + 1) + s) - ln (of_real (real n))) \<longlongrightarrow> 0) at_top"
       by (rule filterlim_compose[OF _ filterlim_real_sequentially])
     hence "((\<lambda>n. ln (of_nat n + s) - ln (of_nat (n - 1))) \<longlongrightarrow> 0) at_top"
       by (subst filterlim_sequentially_Suc [symmetric]) (simp add: add_ac)
     thus "(\<lambda>x. s * (ln (of_nat x + s) - ln (of_nat (x - 1)))) \<longlonglongrightarrow> 0"
       by (rule tendsto_mult_right_zero)
   next
     have "((\<lambda>x. ln (1 + s / of_real x)) \<longlongrightarrow> ln (1 + 0)) at_top" (is ?P)
       by (intro tendsto_intros tendsto_divide_0[OF tendsto_const]) 
          (simp_all add: filterlim_ident  filterlim_at_infinity_conv_norm_at_top filterlim_abs_real)
     also have "ln (of_real x + s) - ln (of_real x) = ln (1 + s / of_real x)" if "x > 0" for x
       using Ln_divide_of_real[of x "of_real x + s"] neq[of x] that
       by (auto simp: field_simps Ln_of_real)
     hence "?P \<longleftrightarrow> ((\<lambda>x. ln (of_real x + s) - ln (of_real x)) \<longlongrightarrow> 0) at_top"
       using s by (intro filterlim_cong refl) 
                  (auto intro: eventually_mono [OF eventually_gt_at_top[of "1::real"]])
     finally have "(\<lambda>x. (1/2) * (ln (of_real (real x) + s) - ln (of_real (real x)))) \<longlonglongrightarrow> 0"        
       by (rule tendsto_mult_right_zero[OF filterlim_compose[OF _ filterlim_real_sequentially]])
     thus "(\<lambda>x. (1/2) * (ln (of_nat x + s) - ln (of_nat x))) \<longlonglongrightarrow> 0" by simp
   next
     have "((\<lambda>x. x * (ln (1 + s / of_real x))) \<longlongrightarrow> s) at_top" (is ?P) 
       by (rule stirling_limit_aux2)
     also have "ln (1 + s / of_real x) = ln (of_real x + s) - ln (of_real x)" if "x > 1" for x 
       using that s Ln_divide_of_real [of x "of_real x + s", symmetric] neq[of x]
       by (auto simp: Ln_of_real field_simps)
     hence "?P \<longleftrightarrow> ((\<lambda>x. of_real x * (ln (of_real x + s) - ln (of_real x))) \<longlongrightarrow> s) at_top"
       by (intro filterlim_cong refl) 
          (auto intro: eventually_mono[OF eventually_gt_at_top[of "1::real"]])
     finally have "(\<lambda>n. of_real (real n) * (ln (of_real (real n) + s) - ln (of_real (real n)))) \<longlonglongrightarrow> s"
       by (rule filterlim_compose[OF _ filterlim_real_sequentially])
     thus "(\<lambda>n. of_nat n * (ln (of_nat n + s) - ln (of_nat n))) \<longlonglongrightarrow> s" by simp
   qed simp_all
   also have "?this \<longleftrightarrow> ((\<lambda>N. integral {0..real N} (\<lambda>x. -pbernpoly 1 x / (x + s))) \<longlongrightarrow>
                          ln_Gamma s + s - (s - 1/2) * ln s - ln (2 * pi) / 2) at_top"
     using integral_pbernpoly_1_aux
     by (intro filterlim_cong refl) 
        (auto intro: eventually_mono[OF eventually_gt_at_top[of "0::nat"]])
   also have "(\<lambda>N. integral {0..real N} (\<lambda>x. -pbernpoly 1 x / (x + s))) =
                (\<lambda>N. -integral {0..real N} (\<lambda>x. pbernpoly 1 x / (x + s)))"
     by (simp add: fun_eq_iff)
   finally show ?thesis by (simp add: tendsto_minus_cancel_left [symmetric] algebra_simps)
 qed
 
 
 qualified lemma pbernpoly_integral_conv_pbernpoly_integral_Suc:
   assumes "n \<ge> 1"
   shows   "integral {0..real N} (\<lambda>x. pbernpoly n x / (x + s) ^ n) =
              of_real (pbernpoly (Suc n) (real N)) / (of_nat (Suc n) * (s + of_nat N) ^ n) -
              of_real (bernoulli (Suc n)) / (of_nat (Suc n) * s ^ n) + of_nat n / of_nat (Suc n) * 
                integral {0..real N} (\<lambda>x. of_real (pbernpoly (Suc n) x) / (of_real x + s) ^ Suc n)"
 proof - 
   note [derivative_intros] = has_field_derivative_pbernpoly_Suc'
   define I where "I = -of_real (pbernpoly (Suc n) (of_nat N)) / (of_nat (Suc n) * (of_nat N + s) ^ n) +
             of_real (bernoulli (Suc n) / real (Suc n)) / s ^ n +
             integral {0..real N} (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n)"
   have "((\<lambda>x. (-of_nat n * inverse (of_real x + s) ^ Suc n) * 
           (of_real (pbernpoly (Suc n) x) / (of_nat (Suc n))))
           has_integral -I) {0..real N}"
   proof (rule integration_by_parts_interior_strong[OF bounded_bilinear_mult])
     fix x :: real assume x: "x \<in> {0<..<real N} - real ` {0..N}"
     have "x \<notin> \<int>"
     proof
       assume "x \<in> \<int>"
       then obtain n where "x = of_int n" by (auto elim!: Ints_cases)
       with x have x': "x = of_nat (nat n)" by simp
       from x show False by (auto simp: x')
     qed
     hence "((\<lambda>x. of_real (pbernpoly (Suc n) x / of_nat (Suc n))) has_vector_derivative
         complex_of_real (pbernpoly n x)) (at x)"
       by (intro has_vector_derivative_of_real) (auto intro!: derivative_eq_intros)
     thus "((\<lambda>x. of_real (pbernpoly (Suc n) x) / of_nat (Suc n)) has_vector_derivative
             complex_of_real (pbernpoly n x)) (at x)" by simp
     from x s have "complex_of_real x + s \<noteq> 0"
       by (auto simp: complex_eq_iff complex_nonpos_Reals_iff)
     thus "((\<lambda>x. inverse (of_real x + s) ^ n) has_vector_derivative 
              - of_nat n * inverse (of_real x + s) ^ Suc n) (at x)" using x s assms
       by (auto intro!: derivative_eq_intros has_vector_derivative_real_field simp: divide_simps power_add [symmetric]
                simp del: power_Suc)
   next
     have "complex_of_real x + s \<noteq> 0" if "x \<ge> 0" for x 
       using that s by (auto simp: complex_eq_iff complex_nonpos_Reals_iff)
     thus "continuous_on {0..real N} (\<lambda>x. inverse (of_real x + s) ^ n)" 
          "continuous_on {0..real N} (\<lambda>x. complex_of_real (pbernpoly (Suc n) x) / of_nat (Suc n))"
       using assms s by (auto intro!: continuous_intros simp del: of_nat_Suc)
   next
     have "((\<lambda>x. inverse (of_real x + s) ^ n * of_real (pbernpoly n x)) has_integral
             pbernpoly (Suc n) (of_nat N) / (of_nat (Suc n) * (of_nat N + s) ^ n) -
             of_real (bernoulli (Suc n) / real (Suc n)) / s ^ n - -I) {0..real N}" 
       using integrable_ln_Gamma_aux[of n N] assms
       by (auto simp: I_def has_integral_integral divide_simps)
     thus "((\<lambda>x. inverse (of_real x + s) ^ n * of_real (pbernpoly n x)) has_integral
               inverse (of_real (real N) + s) ^ n * (of_real (pbernpoly (Suc n) (real N)) / 
                   of_nat (Suc n)) -
               inverse (of_real 0 + s) ^ n * (of_real (pbernpoly (Suc n) 0) / of_nat (Suc n)) - - I)
             {0..real N}" by (simp_all add: field_simps)
   qed simp_all
   also have "(\<lambda>x. - of_nat n * inverse (of_real x + s) ^ Suc n * (of_real (pbernpoly (Suc n) x) /
                          of_nat (Suc n))) =
              (\<lambda>x. - (of_nat n / of_nat (Suc n) * of_real (pbernpoly (Suc n) x) / 
                          (of_real x + s) ^ Suc n))"
     by (simp add: divide_simps fun_eq_iff)
   finally have "((\<lambda>x. - (of_nat n / of_nat (Suc n) * of_real (pbernpoly (Suc n) x) /
                             (of_real x + s) ^ Suc n)) has_integral - I) {0..real N}" .
   from has_integral_neg[OF this] show ?thesis
     by (auto simp add: I_def has_integral_iff algebra_simps integral_mult_right [symmetric] 
              simp del: power_Suc of_nat_Suc )
 qed
 
 lemma pbernpoly_over_power_tendsto_0: 
   assumes "n > 0"
   shows   "(\<lambda>x. of_real (pbernpoly (Suc n) (real x)) / (of_nat (Suc n) * (s + of_nat x) ^ n)) \<longlonglongrightarrow> 0"
 proof -
   from s have neq: "s + of_nat n \<noteq> 0" for n
     by (auto simp: complex_eq_iff complex_nonpos_Reals_iff)
   obtain c where c: "\<And>x. norm (pbernpoly (Suc n) x) \<le> c"
     using bounded_pbernpoly by auto
   have "eventually (\<lambda>x. real x + Re s > 0) at_top"
     by real_asymp
   hence "eventually (\<lambda>x. norm (of_real (pbernpoly (Suc n) (real x)) / 
                                     (of_nat (Suc n) * (s + of_nat x) ^ n)) \<le>
                           (c / real (Suc n)) / (real x + Re s) ^ n) at_top"
     using eventually_gt_at_top[of "0::nat"]
   proof eventually_elim
     case (elim x)
     have "norm (of_real (pbernpoly (Suc n) (real x)) / 
                                     (of_nat (Suc n) * (s + of_nat x) ^ n)) \<le>
             (c / real (Suc n)) / norm (s + of_nat x) ^ n" (is "_ \<le> ?rhs") using c[of x]
       by (auto simp: norm_divide norm_mult norm_power neq field_simps simp del: of_nat_Suc)
     also have "(real x + Re s) \<le> cmod (s + of_nat x)"
       using complex_Re_le_cmod[of "s + of_nat x"] s by (auto simp add: complex_nonpos_Reals_iff)
     hence "?rhs \<le> (c / real (Suc n)) / (real x + Re s) ^ n" using s elim c[of 0] neq[of x]
       by (intro divide_left_mono power_mono mult_pos_pos divide_nonneg_pos zero_less_power) auto
     finally show ?case .
   qed 
   moreover have "(\<lambda>x. (c / real (Suc n)) / (real x + Re s) ^ n) \<longlonglongrightarrow> 0"
     using \<open>n > 0\<close> by real_asymp
   ultimately show ?thesis by (rule Lim_null_comparison)
 qed
 
 lemma convergent_stirling_integral:
   assumes "n > 0"
   shows   "convergent (\<lambda>N. integral {0..real N} 
              (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n))" (is "convergent (?f n)")
 proof -
   have "convergent (?f (Suc n))" for n
   proof (induction n)
     case 0
     thus ?case using integral_pbernpoly_1 by (auto intro!: convergentI)
   next
     case (Suc n)
     have "convergent (\<lambda>N. ?f (Suc n) N -
             of_real (pbernpoly (Suc (Suc n)) (real N)) / 
                 (of_nat (Suc (Suc n)) * (s + of_nat N) ^ Suc n) +
             of_real (bernoulli (Suc (Suc n)) / (real (Suc (Suc n)))) / s ^ Suc n)" 
       (is "convergent ?g")
       by (intro convergent_add convergent_diff Suc 
             convergent_const convergentI[OF pbernpoly_over_power_tendsto_0]) simp_all
     also have "?g = (\<lambda>N. of_nat (Suc n) / of_nat (Suc (Suc n)) * ?f (Suc (Suc n)) N)" using s
       by (subst pbernpoly_integral_conv_pbernpoly_integral_Suc) 
          (auto simp: fun_eq_iff field_simps simp del: of_nat_Suc power_Suc)
     also have "convergent \<dots> \<longleftrightarrow> convergent (?f (Suc (Suc n)))"
       by (intro convergent_mult_const_iff) (simp_all del: of_nat_Suc)
     finally show ?case .
   qed
   from this[of "n - 1"] assms show ?thesis by simp
 qed
 
 lemma stirling_integral_conv_stirling_integral_Suc:
   assumes "n > 0"
   shows   "stirling_integral n s =
              of_nat n / of_nat (Suc n) * stirling_integral (Suc n) s -
              of_real (bernoulli (Suc n)) / (of_nat (Suc n) * s ^ n)"
 proof -
   have "(\<lambda>N. of_real (pbernpoly (Suc n) (real N)) / (of_nat (Suc n) * (s + of_nat N) ^ n) -
              of_real (bernoulli (Suc n)) / (real (Suc n) * s ^ n) +
              integral {0..real N} (\<lambda>x. of_nat n / of_nat (Suc n) * 
                 (of_real (pbernpoly (Suc n) x) / (of_real x + s) ^ Suc n)))
            \<longlonglongrightarrow> 0 - of_real (bernoulli (Suc n)) / (of_nat (Suc n) * s ^ n) +
                    of_nat n / of_nat (Suc n) * stirling_integral (Suc n) s" (is "?f \<longlonglongrightarrow> _")
     unfolding stirling_integral_def integral_mult_right
     using convergent_stirling_integral[of "Suc n"] assms s
     by (intro tendsto_intros pbernpoly_over_power_tendsto_0)
        (auto simp: convergent_LIMSEQ_iff simp del: of_nat_Suc)
   also have "?this \<longleftrightarrow> (\<lambda>N. integral {0..real N} 
                (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n)) \<longlonglongrightarrow>
                of_nat n / of_nat (Suc n) * stirling_integral (Suc n) s -
                  of_real (bernoulli (Suc n)) / (of_nat (Suc n) * s ^ n)" 
     using eventually_gt_at_top[of "0::nat"] pbernpoly_integral_conv_pbernpoly_integral_Suc[of n] 
           assms unfolding integral_mult_right
     by (intro filterlim_cong refl) (auto elim!: eventually_mono simp del: power_Suc)
   finally show ?thesis unfolding stirling_integral_def[of n] by (rule limI)
 qed
 
 lemma stirling_integral_1_unfold:
   assumes "m > 0"
   shows   "stirling_integral 1 s = stirling_integral m s / of_nat m - 
              (\<Sum>k=1..<m. of_real (bernoulli (Suc k)) / (of_nat k * of_nat (Suc k) * s ^ k))"
 proof -
   have "stirling_integral 1 s = stirling_integral (Suc m) s / of_nat (Suc m) -
           (\<Sum>k=1..<Suc m. of_real (bernoulli (Suc k)) / (of_nat k * of_nat (Suc k) * s ^ k))" for m
   proof (induction m)
     case (Suc m)
     let ?C = "(\<Sum>k = 1..<Suc m. of_real (bernoulli (Suc k)) / (of_nat k * of_nat (Suc k) * s ^ k))"
     note Suc.IH
     also have "stirling_integral (Suc m) s / of_nat (Suc m) = 
                  stirling_integral (Suc (Suc m)) s / of_nat (Suc (Suc m)) -
                  of_real (bernoulli (Suc (Suc m))) / 
                    (of_nat (Suc m) * of_nat (Suc (Suc m)) * s ^ Suc m)"
       (is "_ = ?A - ?B") by (subst stirling_integral_conv_stirling_integral_Suc)
                             (simp_all del: of_nat_Suc power_Suc add: divide_simps)
     also have "?A - ?B - ?C = ?A - (?B + ?C)" by (rule diff_diff_eq)
     also have "?B + ?C = (\<Sum>k = 1..<Suc (Suc m). of_real (bernoulli (Suc k)) /
                              (of_nat k * of_nat (Suc k) * s ^ k))" 
       using s by (simp add: divide_simps)
     finally show ?case .
   qed simp_all
   note this[of "m - 1"]
   also from assms have "Suc (m - 1) = m" by simp
   finally show ?thesis .
 qed
   
 lemma ln_Gamma_stirling_complex:
   assumes "m > 0"
   shows   "ln_Gamma s = (s - 1 / 2) * ln s - s + ln (2 * pi) / 2 +
              (\<Sum>k=1..<m. of_real (bernoulli (Suc k)) / (of_nat k * of_nat (Suc k) * s ^ k)) - 
              stirling_integral m s / of_nat m"
 proof -
   have "ln_Gamma s = (s - 1 / 2) * ln s - s + ln (2 * pi) / 2 - stirling_integral 1 s"
     using limI[OF integral_pbernpoly_1] by (simp add: stirling_integral_def algebra_simps)
   also have "stirling_integral 1 s = stirling_integral m s / of_nat m -
                (\<Sum>k = 1..<m. of_real (bernoulli (Suc k)) / (of_nat k * of_nat (Suc k) * s ^ k))"
     using assms by (rule stirling_integral_1_unfold)
   finally show ?thesis by simp
 qed
 
 lemma LIMSEQ_stirling_integral:
   "n > 0 \<Longrightarrow> (\<lambda>x. integral {0..real x} (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n))
      \<longlonglongrightarrow> stirling_integral n s" unfolding stirling_integral_def 
   using convergent_stirling_integral[of n] by (simp only: convergent_LIMSEQ_iff)
 
 end
 
 lemmas has_integral_of_real = has_integral_linear[OF _ bounded_linear_of_real, unfolded o_def]
 lemmas integral_of_real = integral_linear[OF _ bounded_linear_of_real, unfolded o_def]
 
 lemma integrable_ln_Gamma_aux_real:
   assumes "0 < s"
   shows   "(\<lambda>x. pbernpoly n x / (x + s) ^ n) integrable_on {0..real N}"
 proof -
   have "(\<lambda>x. complex_of_real (pbernpoly n x / (x + s) ^ n)) integrable_on {0..real N}"
     using integrable_ln_Gamma_aux[of "of_real s" n N] assms by simp
   from integrable_linear[OF this bounded_linear_Re] show ?thesis 
     by (simp only: o_def Re_complex_of_real) 
 qed
   
 lemma  
   assumes "x > 0" "n > 0"
   shows   stirling_integral_complex_of_real:
             "stirling_integral n (complex_of_real x) = of_real (stirling_integral n x)"
     and   LIMSEQ_stirling_integral_real:
             "(\<lambda>N. integral {0..real N} (\<lambda>t. pbernpoly n t / (t + x) ^ n))
             \<longlonglongrightarrow> stirling_integral n x"
     and   stirling_integral_real_convergent:
             "convergent (\<lambda>N. integral {0..real N} (\<lambda>t. pbernpoly n t / (t + x) ^ n))"
 proof -
   have "(\<lambda>N. integral {0..real N} (\<lambda>t. of_real (pbernpoly n t / (t + x) ^ n)))
            \<longlonglongrightarrow> stirling_integral n (complex_of_real x)"
     using LIMSEQ_stirling_integral[of "complex_of_real x" n] assms by simp
   hence "(\<lambda>N. of_real (integral {0..real N} (\<lambda>t. pbernpoly n t / (t + x) ^ n)))
            \<longlonglongrightarrow> stirling_integral n (complex_of_real x)"
     using integrable_ln_Gamma_aux_real[OF assms(1), of n] 
     by (subst (asm) integral_of_real) simp
   from tendsto_Re[OF this] 
     have "(\<lambda>N. integral {0..real N} (\<lambda>t. pbernpoly n t / (t + x) ^ n))
            \<longlonglongrightarrow> Re (stirling_integral n (complex_of_real x))" by simp
   thus "convergent (\<lambda>N. integral {0..real N} (\<lambda>t. pbernpoly n t / (t + x) ^ n))"
     by (rule convergentI)
   thus "(\<lambda>N. integral {0..real N} (\<lambda>t. pbernpoly n t / (t + x) ^ n))
           \<longlonglongrightarrow> stirling_integral n x" unfolding stirling_integral_def
     by (simp add: convergent_LIMSEQ_iff)
   from tendsto_of_real[OF this, where 'a = complex] 
        integrable_ln_Gamma_aux_real[OF assms(1), of n]
     have "(\<lambda>xa. integral {0..real xa} 
                     (\<lambda>xa. complex_of_real (pbernpoly n xa) / (complex_of_real xa + x) ^ n))
              \<longlonglongrightarrow> complex_of_real (stirling_integral n x)"
     by (subst (asm) integral_of_real [symmetric]) simp_all
   from LIMSEQ_unique[OF this LIMSEQ_stirling_integral[of "complex_of_real x" n]] assms
     show "stirling_integral n (complex_of_real x) = of_real (stirling_integral n x)" by simp
 qed
 
 lemma ln_Gamma_stirling_real:
   assumes "x > (0 :: real)" "m > (0::nat)"
   shows   "ln_Gamma x = (x - 1 / 2) * ln x - x + ln (2 * pi) / 2 +
               (\<Sum>k = 1..<m. bernoulli (Suc k) / (of_nat k * of_nat (Suc k) * x ^ k)) -
               stirling_integral m x / of_nat m"
 proof -
   from assms have "complex_of_real (ln_Gamma x) = ln_Gamma (complex_of_real x)"
     by (simp add: ln_Gamma_complex_of_real)
   also have "ln_Gamma (complex_of_real x) = complex_of_real (
                 (x - 1 / 2) * ln x - x + ln (2 * pi) / 2 +
                 (\<Sum>k = 1..<m. bernoulli (Suc k) / (of_nat k * of_nat (Suc k) * x ^ k)) -
                 stirling_integral m x / of_nat m)" using assms
     by (subst ln_Gamma_stirling_complex[of _ m])
        (simp_all add: Ln_of_real stirling_integral_complex_of_real)
   finally show ?thesis by (subst (asm) of_real_eq_iff)
 qed
 
 
 lemma stirling_integral_bound_aux:
   assumes n: "n > (1::nat)"
   obtains c where "\<And>s. Re s > 0 \<Longrightarrow> norm (stirling_integral n s) \<le>  c / Re s ^ (n - 1)"
 proof -
   obtain c where c: "norm (pbernpoly n x) \<le> c" for x by (rule bounded_pbernpoly[of n]) blast
   have c': "pbernpoly n x \<le> c" for x using c[of x] by (simp add: abs_real_def split: if_splits)
   from c[of 0] have c_nonneg: "c \<ge> 0" by simp
   have "norm (stirling_integral n s) \<le> c / (real n - 1) / Re s ^ (n - 1)" if s: "Re s > 0" for s
   proof (rule Lim_norm_ubound[OF _ LIMSEQ_stirling_integral])
     have pos: "x + norm s > 0" if "x \<ge> 0" for x using s that by (intro add_nonneg_pos) auto
     have nz: "of_real x + s \<noteq> 0" if "x \<ge> 0" for x using s that by (auto simp: complex_eq_iff)
     let ?bound = "\<lambda>N. c / (Re s ^ (n - 1) * (real n - 1)) - 
                         c / ((real N + Re s) ^ (n - 1) * (real n - 1))"
     show "eventually (\<lambda>N. norm (integral {0..real N} 
               (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n)) \<le> 
             c / (real n - 1) / Re s ^ (n - 1)) at_top"
       using eventually_gt_at_top[of "0::nat"]
     proof eventually_elim
       case (elim N)
       let ?F = "\<lambda>x. -c / ((x + Re s) ^ (n - 1) * (real n - 1))"
       from n s have "((\<lambda>x. c / (x + Re s) ^ n) has_integral (?F (real N) - ?F 0)) {0..real N}"
         by (intro fundamental_theorem_of_calculus)
            (auto intro!: derivative_eq_intros simp: divide_simps power_diff add_eq_0_iff2
                    has_field_derivative_iff_has_vector_derivative [symmetric])      
       also have "?F (real N) - ?F 0 = ?bound N" by simp
       finally have *: "((\<lambda>x. c / (x + Re s) ^ n) has_integral ?bound N) {0..real N}" .
       have "norm (integral {0..real N} (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n)) \<le>
               integral {0..real N} (\<lambda>x. c / (x + Re s) ^ n)"
       proof (intro integral_norm_bound_integral integrable_ln_Gamma_aux s ballI)
         fix x assume x: "x \<in> {0..real N}"
         have "norm (of_real (pbernpoly n x) / (of_real x + s) ^ n) \<le> c / norm (of_real x + s) ^ n"
           unfolding norm_divide norm_power using c by (intro divide_right_mono) simp_all
         also have "\<dots> \<le> c / (x + Re s) ^ n" 
           using x c c_nonneg s nz[of x] complex_Re_le_cmod[of "of_real x + s"]
           by (intro divide_left_mono power_mono mult_pos_pos zero_less_power add_nonneg_pos) auto
         finally show "norm (of_real (pbernpoly n x) / (of_real x + s) ^ n) \<le> \<dots>" .
       qed (insert n s * pos nz c, auto simp: complex_nonpos_Reals_iff)
       also have "\<dots> = ?bound N" using * by (simp add: has_integral_iff)
       also have "\<dots> \<le> c / (Re s ^ (n - 1) * (real n - 1))" using c_nonneg elim s n by simp
       also have "\<dots> = c / (real n - 1) / (Re s ^ (n - 1))" by simp
       finally show "norm (integral {0..real N} (\<lambda>x. of_real (pbernpoly n x) /
                       (of_real x + s) ^ n)) \<le> c / (real n - 1) / Re s ^ (n - 1)" .
     qed
   qed (insert s n, simp_all add: complex_nonpos_Reals_iff)
   thus ?thesis by (rule that)
 qed
 
 lemma stirling_integral_bound_aux_integral1:
   fixes a b c :: real and n :: nat
   assumes "a \<ge> 0" "b > 0" "c \<ge> 0" "n > 1" "l < a - b" "r > a + b"
   shows "((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral
            2*c*(n / (n - 1))/b^(n-1) - c/(n-1) * (1/(a-l)^(n-1) + 1/(r-a)^(n-1))) {l..r}"
 proof -
   define x1 x2 where "x1 = a - b" and "x2 = a + b"
   define F1 where "F1 = (\<lambda>x::real. c / (a - x) ^ (n - 1) / (n - 1))"
   define F3 where "F3 = (\<lambda>x::real. -c / (x - a) ^ (n - 1) / (n - 1))"
   have deriv: "(F1 has_vector_derivative (c / (a - x) ^ n)) (at x within A)"
               "(F3 has_vector_derivative (c / (x - a) ^ n)) (at x within A)"
     if "x \<noteq> a" for x :: real and A
     unfolding F1_def F3_def using assms that
     by (auto intro!: derivative_eq_intros simp: divide_simps power_diff add_eq_0_iff2
              simp flip: has_field_derivative_iff_has_vector_derivative)
 
   from assms have "((\<lambda>x. c / (a - x) ^ n) has_integral (F1 x1 - F1 l)) {l..x1}"
     by (intro fundamental_theorem_of_calculus deriv) (auto simp: x1_def max_def split: if_splits)
   also have "?this \<longleftrightarrow> ((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral (F1 x1 - F1 l)) {l..x1}"
     using assms
     by (intro has_integral_spike_finite_eq[of "{l}"]) (auto simp: x1_def max_def split: if_splits)
   finally have I1: "((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral (F1 x1 - F1 l)) {l..x1}" .
 
   have "((\<lambda>x. c / b ^ n) has_integral (x2 - x1) * c / b ^ n) {x1..x2}"
     using has_integral_const_real[of "c / b ^ n" x1 x2] assms by (simp add: x1_def x2_def)
   also have "?this \<longleftrightarrow> ((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral ((x2 - x1) * c / b ^ n)) {x1..x2}"
     by (intro has_integral_spike_finite_eq[of "{x1, x2}"])
        (auto simp: x1_def x2_def split: if_splits)
   finally have I2: "((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral ((x2 - x1) * c / b ^ n)) {x1..x2}" .
 
   from assms have I3: "((\<lambda>x. c / (x - a) ^ n) has_integral (F3 r - F3 x2)) {x2..r}"
     by (intro fundamental_theorem_of_calculus deriv) (auto simp: x2_def min_def split: if_splits)
   also have "?this \<longleftrightarrow> ((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral (F3 r - F3 x2)) {x2..r}"
     using assms
     by (intro has_integral_spike_finite_eq[of "{r}"]) (auto simp: x2_def min_def split: if_splits)
   finally have I3: "((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral (F3 r - F3 x2)) {x2..r}" .
 
   have "((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral (F1 x1 - F1 l) + ((x2 - x1) * c / b ^ n) + (F3 r - F3 x2)) {l..r}"
     using assms
     by (intro has_integral_combine[OF _ _ has_integral_combine[OF _ _ I1 I2] I3])
        (auto simp: x1_def x2_def)
   also have "(F1 x1 - F1 l) + ((x2 - x1) * c / b ^ n) + (F3 r - F3 x2) =
              F1 x1 - F1 l + F3 r - F3 x2 + (x2 - x1) * c / b ^ n"
     by (simp add: algebra_simps)
   also have "x2 - x1 = 2 * b"
     using assms by (simp add: x2_def x1_def min_def max_def)
   also have "2 * b * c / b ^ n = 2 * c / b ^ (n - 1)"
     using assms by (simp add: power_diff field_simps)
   also have "F1 x1 - F1 l + F3 r - F3 x2 =
                c/(n-1) * (2/b^(n-1) - 1/(a-l)^(n-1) - 1/(r-a)^(n-1))"
     using assms by (simp add: x1_def x2_def F1_def F3_def field_simps)
   also have "\<dots> + 2 * c / b ^ (n - 1) =
              2*c*(1 + 1/(n-1))/b^(n-1) - c/(n-1) * (1/(a-l)^(n-1) + 1/(r-a)^(n-1))"
     using assms by (simp add: field_simps)
   also have "1 + 1 / (n - 1) = n / (n - 1)"
     using assms by (simp add: field_simps)
   finally show ?thesis .
 qed
 
 lemma stirling_integral_bound_aux_integral2:
   fixes a b c :: real and n :: nat
   assumes "a \<ge> 0" "b > 0" "c \<ge> 0" "n > 1"
   obtains I where "((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral I) {l..r}"
                   "I \<le> 2 * c * (n / (n - 1)) / b ^ (n-1)"
 proof -
   define l' where "l' = min l (a - b - 1)"
   define r' where "r' = max r (a + b + 1)"
 
   define A where "A = 2 * c * (n / (n - 1)) / b ^ (n - 1)"
   define B where "B = c / real (n - 1) * (1 / (a - l') ^ (n - 1) + 1 / (r' - a) ^ (n - 1))"
 
   have has_int: "((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral (A - B)) {l'..r'}"
     using assms unfolding A_def B_def
     by (intro stirling_integral_bound_aux_integral1) (auto simp: l'_def r'_def)
   have "(\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) integrable_on {l..r}"
     by (rule integrable_on_subinterval[OF has_integral_integrable[OF has_int]])
        (auto simp: l'_def r'_def)
   then obtain I where has_int': "((\<lambda>x. c / max b \<bar>x - a\<bar> ^ n) has_integral I) {l..r}"
     by (auto simp: integrable_on_def)
 
   from assms have "I \<le> A - B"
     by (intro has_integral_subset_le[OF _ has_int' has_int]) (auto simp: l'_def r'_def)
   also have "\<dots> \<le> A"
     using assms by (simp add: B_def l'_def r'_def)
   finally show ?thesis using that[of I] has_int' unfolding A_def by blast
 qed
 
 lemma stirling_integral_bound_aux':
   assumes n: "n > (1::nat)" and \<alpha>: "\<alpha> \<in> {0<..<pi}"
   obtains c where "\<And>s::complex. s \<in> complex_cone' \<alpha> - {0} \<Longrightarrow>
                      norm (stirling_integral n s) \<le> c / norm s ^ (n - 1)"
 proof -
   obtain c where c: "norm (pbernpoly n x) \<le> c" for x by (rule bounded_pbernpoly[of n]) blast
   have c': "pbernpoly n x \<le> c" for x using c[of x] by (simp add: abs_real_def split: if_splits)
   from c[of 0] have c_nonneg: "c \<ge> 0" by simp
 
   define D where "D = c * Beta (- (real_of_int (- int n) / 2) - 1 / 2) (1 / 2) / 2"
   define C where "C = max D (2*c*(n/(n-1))/sin \<alpha>^(n-1))"
 
   have *: "norm (stirling_integral n s) \<le> C / norm s ^ (n - 1)"
     if s: "s \<in> complex_cone' \<alpha> - {0}" for s :: complex
   proof (rule Lim_norm_ubound[OF _ LIMSEQ_stirling_integral])
     from s \<alpha> have Arg: "\<bar>Arg s\<bar> \<le> \<alpha>" by (auto simp: complex_cone_altdef)
     have s': "s \<notin> \<real>\<^sub>\<le>\<^sub>0"
       using complex_cone_inter_nonpos_Reals[of "-\<alpha>" \<alpha>] \<alpha> s  by auto
     from s have [simp]: "s \<noteq> 0" by auto
 
     show "eventually (\<lambda>N. norm (integral {0..real N}
               (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n)) \<le> 
             C / norm s ^ (n - 1)) at_top"
       using eventually_gt_at_top[of "0::nat"]
     proof eventually_elim
       case (elim N)
       show ?case
       proof (cases "Re s > 0")
         case True
         have int: "((\<lambda>x. c * (x^2 + norm s^2) powr (-n / 2)) has_integral
                   D * (norm s ^ 2) powr (-n / 2 + 1 / 2)) {0<..}"
           using has_integral_mult_left[OF has_integral_Beta3[of "-n/2" "norm s ^ 2"], of c] assms True
           unfolding D_def by (simp add: algebra_simps)
         hence int': "((\<lambda>x. c * (x^2 + norm s^2) powr (-n / 2)) has_integral
                   D * (norm s ^ 2) powr (-n / 2 + 1 / 2)) {0..}"
           by (subst has_integral_interior [symmetric]) simp_all
         hence integrable: "(\<lambda>x. c * (x^2 + norm s^2) powr (-n / 2)) integrable_on {0..}"
           by (simp add: has_integral_iff)
 
         have "norm (integral {0..real N} (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n)) \<le>
                 integral {0..real N} (\<lambda>x. c * (x^2 + norm s^2) powr (-n / 2))"
         proof (intro integral_norm_bound_integral s ballI integrable_ln_Gamma_aux)
           have [simp]: "{0<..} - {0::real..} = {}" "{0..} - {0<..} = {0::real}"
             by auto
           have "(\<lambda>x. c * (x\<^sup>2 + (cmod s)\<^sup>2) powr (real_of_int (- int n) / 2)) integrable_on {0<..}"
             using int by (simp add: has_integral_iff)
           also have "?this \<longleftrightarrow> (\<lambda>x. c * (x\<^sup>2 + (cmod s)\<^sup>2) powr (real_of_int (- int n) / 2)) integrable_on {0..}"
             by (intro integrable_spike_set_eq) auto
           finally show "(\<lambda>x. c * (x\<^sup>2 + (cmod s)\<^sup>2) powr (real_of_int (- int n) / 2)) integrable_on
                    {0..real N}" by (rule integrable_on_subinterval) auto
         next
           fix x assume x: "x \<in> {0..real N}"
           have nz: "complex_of_real x + s \<noteq> 0"
             using True x by (auto simp: complex_eq_iff)
           have "norm (of_real (pbernpoly n x) / (of_real x + s) ^ n) \<le> c / norm (of_real x + s) ^ n"
             unfolding norm_divide norm_power using c by (intro divide_right_mono) simp_all
           also have "\<dots> \<le> c / sqrt (x ^ 2 + norm s ^ 2) ^ n"
           proof (intro divide_left_mono mult_pos_pos zero_less_power power_mono)
             show "sqrt (x\<^sup>2 + (cmod s)\<^sup>2) \<le> cmod (complex_of_real x + s)"
               using x True by (simp add: cmod_def algebra_simps power2_eq_square)
           qed (use x True c_nonneg assms nz in \<open>auto simp: add_nonneg_pos\<close>)
           also have "sqrt (x ^ 2 + norm s ^ 2) ^ n = (x ^ 2 + norm s ^ 2) powr (1/2 * n)"
             by (subst powr_powr [symmetric], subst powr_realpow)
                (auto simp: powr_half_sqrt add_nonneg_pos)
           also have "c / \<dots> = c * (x^2 + norm s^2) powr (-n / 2)"
             by (simp add: powr_minus field_simps)
           finally show "norm (complex_of_real (pbernpoly n x) / (complex_of_real x + s) ^ n) \<le> \<dots>" .
         qed fact+
         also have "\<dots> \<le> integral {0..} (\<lambda>x. c * (x^2 + norm s^2) powr (-n / 2))"
           using c_nonneg
           by (intro integral_subset_le integrable integrable_on_subinterval[OF integrable]) auto
         also have "\<dots> = D * (norm s ^ 2) powr (-n / 2 + 1 / 2)"
           using int' by (simp add: has_integral_iff)
         also have "(norm s ^ 2) powr (-n / 2 + 1 / 2) = norm s powr (2 * (-n / 2 + 1 / 2))"
           by (subst powr_powr [symmetric]) auto
         also have "\<dots> = norm s powr (-real (n - 1))"
           using assms by (simp add: of_nat_diff)
         also have "D * \<dots> = D / norm s ^ (n - 1)"
           by (auto simp: powr_minus powr_realpow field_simps)
         also have "\<dots> \<le> C / norm s ^ (n - 1)"
           by (intro divide_right_mono) (auto simp: C_def)
         finally show "norm (integral {0..real N} (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n)) \<le> \<dots>" .
 
       next
 
         case False
         have "cos \<bar>Arg s\<bar> = cos (Arg s)"
           by (simp add: abs_if)
         also have "cos (Arg s) = Re (rcis (norm s) (Arg s)) / norm s"
           by (subst Re_rcis) auto
         also have "\<dots> = Re s / norm s"
           by (subst rcis_cmod_Arg) auto
         also have "\<dots> \<le> cos (pi / 2)"
           using False by (auto simp: field_simps)
         finally have "\<bar>Arg s\<bar> \<ge> pi / 2"
           using Arg \<alpha> by (subst (asm) cos_mono_le_eq) auto
 
         have "sin \<alpha> * norm s = sin (pi - \<alpha>) * norm s"
           by simp
         also have "\<dots> \<le> sin (pi - \<bar>Arg s\<bar>) * norm s"
           using \<alpha> Arg \<open>\<bar>Arg s\<bar> \<ge> pi / 2\<close>
           by (intro mult_right_mono sin_monotone_2pi_le) auto
         also have "sin \<bar>Arg s\<bar> \<ge> 0"
           using Arg_bounded[of s] by (intro sin_ge_zero) auto
         hence "sin (pi - \<bar>Arg s\<bar>) = \<bar>sin \<bar>Arg s\<bar>\<bar>"
           by simp 
         also have "\<dots> = \<bar>sin (Arg s)\<bar>"
           by (simp add: abs_if)
         also have "\<dots> * norm s = \<bar>Im (rcis (norm s) (Arg s))\<bar>"
           by (simp add: abs_mult)
         also have "\<dots> = \<bar>Im s\<bar>"
           by (subst rcis_cmod_Arg) auto
         finally have abs_Im_ge: "\<bar>Im s\<bar> \<ge> sin \<alpha> * norm s" .
 
         have [simp]: "Im s \<noteq> 0" "s \<noteq> 0"
           using s \<open>s \<notin> \<real>\<^sub>\<le>\<^sub>0\<close> False
           by (auto simp: cmod_def zero_le_mult_iff complex_nonpos_Reals_iff)
         have "sin \<alpha> > 0"
           using assms by (intro sin_gt_zero) auto
   
         obtain I where I: "((\<lambda>x. c / max \<bar>Im s\<bar> \<bar>x + Re s\<bar> ^ n) has_integral I) {0..real N}"
                           "I \<le> 2*c*(n/(n-1)) / \<bar>Im s\<bar> ^ (n - 1)"
           using s c_nonneg assms False 
                 stirling_integral_bound_aux_integral2[of "-Re s" "\<bar>Im s\<bar>" c n 0 "real N"] by auto
   
         have "norm (integral {0..real N} (\<lambda>x. of_real (pbernpoly n x) / (of_real x + s) ^ n)) \<le>
                 integral {0..real N} (\<lambda>x. c / max \<bar>Im s\<bar> \<bar>x + Re s\<bar> ^ n)"
         proof (intro integral_norm_bound_integral integrable_ln_Gamma_aux s ballI)
           show "(\<lambda>x. c / max \<bar>Im s\<bar> \<bar>x + Re s\<bar> ^ n) integrable_on {0..real N}"
             using I(1) by (simp add: has_integral_iff)
         next
           fix x assume x: "x \<in> {0..real N}"
           have nz: "complex_of_real x + s \<noteq> 0"
             by (auto simp: complex_eq_iff)
           have "norm (complex_of_real (pbernpoly n x) / (complex_of_real x + s) ^ n) \<le>
                   c / norm (complex_of_real x + s) ^ n"
             unfolding norm_divide norm_power using c[of x] by (intro divide_right_mono) simp_all
           also have "\<dots> \<le> c / max \<bar>Im s\<bar> \<bar>x + Re s\<bar> ^ n"
             using c_nonneg nz abs_Re_le_cmod[of "of_real x + s"] abs_Im_le_cmod[of "of_real x + s"]
             by (intro divide_left_mono power_mono mult_pos_pos zero_less_power)
                (auto simp: less_max_iff_disj)
           finally show "norm (complex_of_real (pbernpoly n x) / (complex_of_real x + s) ^ n) \<le> \<dots>" .
         qed (auto simp: complex_nonpos_Reals_iff)
         also have "\<dots> \<le> 2*c*(n/(n-1)) / \<bar>Im s\<bar> ^ (n - 1)"
           using I by (simp add: has_integral_iff)
         also have "\<dots> \<le> 2*c*(n/(n-1)) / (sin \<alpha> * norm s) ^ (n - 1)"
           using \<open>sin \<alpha> > 0\<close> s c_nonneg abs_Im_ge
           by (intro divide_left_mono mult_pos_pos zero_less_power power_mono mult_nonneg_nonneg) auto
         also have "\<dots> = 2*c*(n/(n-1))/sin \<alpha>^(n-1) / norm s ^ (n - 1)"
           by (simp add: field_simps)
         also have "\<dots> \<le> C / norm s ^ (n - 1)"
           by (intro divide_right_mono) (auto simp: C_def)
         finally show ?thesis .
       qed
     qed
   qed (use that assms complex_cone_inter_nonpos_Reals[of "-\<alpha>" \<alpha>] \<alpha> in auto)
   thus ?thesis by (rule that)
 qed
 
 lemma stirling_integral_bound:
   assumes "n > 0"
   obtains c where 
     "\<And>s. Re s > 0 \<Longrightarrow> norm (stirling_integral n s) \<le> c / Re s ^ n"
 proof -
   let ?f = "\<lambda>s. of_nat n / of_nat (Suc n) * stirling_integral (Suc n) s -
                   of_real (bernoulli (Suc n)) / (of_nat (Suc n) * s ^ n)"
   from stirling_integral_bound_aux[of "Suc n"] assms obtain c where 
     c: "\<And>s. Re s > 0 \<Longrightarrow> norm (stirling_integral (Suc n) s) \<le> c / Re s ^ n" by auto
   define c1 where "c1 = real n / real (Suc n) * c"
   define c2 where "c2 = \<bar>bernoulli (Suc n)\<bar> / real (Suc n)"
   have c2_nonneg: "c2 \<ge> 0" by (simp add: c2_def)
   show ?thesis
   proof (rule that)
     fix s :: complex assume s: "Re s > 0"
     hence s': "s \<notin> \<real>\<^sub>\<le>\<^sub>0" by (auto simp: complex_nonpos_Reals_iff)
     have "stirling_integral n s = ?f s" using s' assms 
       by (rule stirling_integral_conv_stirling_integral_Suc)
     also have "norm \<dots> \<le> norm (of_nat n / of_nat (Suc n) * stirling_integral (Suc n) s) +
                            norm (of_real (bernoulli (Suc n)) / (of_nat (Suc n) * s ^ n))"
       by (rule norm_triangle_ineq4)
     also have "\<dots> = real n / real (Suc n) * norm (stirling_integral (Suc n) s) +
                       c2 / norm s ^ n" (is "_ = ?A + ?B")
       by (simp add: norm_divide norm_mult norm_power c2_def field_simps del: of_nat_Suc)
     also have "?A \<le> real n / real (Suc n) * (c / Re s ^ n)"
       by (intro mult_left_mono c s) simp_all
     also have "\<dots> = c1 / Re s ^ n" by (simp add: c1_def)
     also have "c2 / norm s ^ n \<le> c2 / Re s ^ n" using s c2_nonneg
       by (intro divide_left_mono power_mono complex_Re_le_cmod mult_pos_pos zero_less_power) auto
     also have "c1 / Re s ^ n + c2 / Re s ^ n = (c1 + c2) / Re s ^ n" 
       using s by (simp add: field_simps)
     finally show "norm (stirling_integral n s) \<le> (c1 + c2) / Re s ^ n" by - simp_all
   qed
 qed
 
 lemma stirling_integral_bound':
   assumes "n > 0" and "\<alpha> \<in> {0<..<pi}"
   obtains c where 
     "\<And>s::complex. s \<in> complex_cone' \<alpha> - {0} \<Longrightarrow> norm (stirling_integral n s) \<le> c / norm s ^ n"
 proof -
   let ?f = "\<lambda>s. of_nat n / of_nat (Suc n) * stirling_integral (Suc n) s -
                   of_real (bernoulli (Suc n)) / (of_nat (Suc n) * s ^ n)"
   from stirling_integral_bound_aux'[of "Suc n"] assms obtain c where 
     c: "\<And>s::complex. s \<in> complex_cone' \<alpha> - {0} \<Longrightarrow>
             norm (stirling_integral (Suc n) s) \<le> c / norm s ^ n" by auto
   define c1 where "c1 = real n / real (Suc n) * c"
   define c2 where "c2 = \<bar>bernoulli (Suc n)\<bar> / real (Suc n)"
   have c2_nonneg: "c2 \<ge> 0" by (simp add: c2_def)
   show ?thesis
   proof (rule that)
     fix s :: complex assume s: "s \<in> complex_cone' \<alpha> - {0}"
     have s': "s \<notin> \<real>\<^sub>\<le>\<^sub>0"
       using complex_cone_inter_nonpos_Reals[of "-\<alpha>" \<alpha>] assms s by auto
       
     have "stirling_integral n s = ?f s" using s' assms 
       by (intro stirling_integral_conv_stirling_integral_Suc) auto
     also have "norm \<dots> \<le> norm (of_nat n / of_nat (Suc n) * stirling_integral (Suc n) s) +
                            norm (of_real (bernoulli (Suc n)) / (of_nat (Suc n) * s ^ n))"
       by (rule norm_triangle_ineq4)
     also have "\<dots> = real n / real (Suc n) * norm (stirling_integral (Suc n) s) +
                       c2 / norm s ^ n" (is "_ = ?A + ?B")
       by (simp add: norm_divide norm_mult norm_power c2_def field_simps del: of_nat_Suc)
     also have "?A \<le> real n / real (Suc n) * (c / norm s ^ n)"
       by (intro mult_left_mono c s) simp_all
     also have "\<dots> = c1 / norm s ^ n" by (simp add: c1_def)
     also have "c1 / norm s ^ n + c2 / norm s ^ n = (c1 + c2) / norm s ^ n" 
       using s by (simp add: divide_simps)
     finally show "norm (stirling_integral n s) \<le> (c1 + c2) / norm s ^ n" by - simp_all
   qed
 qed
 
 
 lemma stirling_integral_holomorphic [holomorphic_intros]:
   assumes m: "m > 0" and "A \<inter> \<real>\<^sub>\<le>\<^sub>0 = {}"
   shows   "stirling_integral m holomorphic_on A"  
 proof -
   from assms have [simp]: "z \<notin> \<real>\<^sub>\<le>\<^sub>0" if "z \<in> A" for z
     using that by auto
   let ?f = "\<lambda>s::complex. of_nat m * ((s - 1 / 2) * Ln s - s + of_real (ln (2 * pi) / 2) +
           (\<Sum>k=1..<m. of_real (bernoulli (Suc k)) / (of_nat k * of_nat (Suc k) * s ^ k)) - 
           ln_Gamma s)"
   have "?f holomorphic_on A" using assms
     by (auto intro!: holomorphic_intros simp del: of_nat_Suc elim!: nonpos_Reals_cases)
   also have "?this \<longleftrightarrow> stirling_integral m holomorphic_on A" 
     using assms by (intro holomorphic_cong refl) 
                    (simp_all add: field_simps ln_Gamma_stirling_complex)
   finally show "stirling_integral m holomorphic_on A" .
 qed
 
 lemma stirling_integral_continuous_on_complex [continuous_intros]:
   assumes m: "m > 0" and "A \<inter> \<real>\<^sub>\<le>\<^sub>0 = {}"
   shows   "continuous_on A (stirling_integral m :: _ \<Rightarrow> complex)"
   by (intro holomorphic_on_imp_continuous_on stirling_integral_holomorphic assms)
     
 lemma has_field_derivative_stirling_integral_complex:
   fixes x :: complex
   assumes "x \<notin> \<real>\<^sub>\<le>\<^sub>0" "n > 0"
   shows   "(stirling_integral n has_field_derivative deriv (stirling_integral n) x) (at x)"
   using assms
   by (intro holomorphic_derivI[OF stirling_integral_holomorphic, of n  "-\<real>\<^sub>\<le>\<^sub>0"]) auto
 
 
  
 lemma
   assumes n: "n > 0" and "x > 0"
   shows   deriv_stirling_integral_complex_of_real:
             "(deriv ^^ j) (stirling_integral n) (complex_of_real x) =
                complex_of_real ((deriv ^^ j) (stirling_integral n) x)" (is "?lhs x = ?rhs x")
   and     differentiable_stirling_integral_real:
             "(deriv ^^ j) (stirling_integral n) field_differentiable at x" (is ?thesis2)
 proof -
   let ?A = "{s. Re s > 0}"
   let ?f = "\<lambda>j x. (deriv ^^ j) (stirling_integral n) (complex_of_real x)"
   let ?f' = "\<lambda>j x. complex_of_real ((deriv ^^ j) (stirling_integral n) x)"
     
   have [simp]: "open ?A" by (simp add: open_halfspace_Re_gt)      
 
   have "?lhs x = ?rhs x \<and> (deriv ^^ j) (stirling_integral n) field_differentiable at x" 
     if "x > 0" for x using that
   proof (induction j arbitrary: x)
     case 0
     have "((\<lambda>x. Re (stirling_integral n (of_real x))) has_field_derivative 
                   Re (deriv (\<lambda>x. stirling_integral n x) (of_real x))) (at x)" using 0 n
       by (auto intro!: derivative_intros has_vector_derivative_real_field
                  field_differentiable_derivI holomorphic_on_imp_differentiable_at[of _ ?A]
                  stirling_integral_holomorphic simp: complex_nonpos_Reals_iff)
     also have "?this \<longleftrightarrow> (stirling_integral n has_field_derivative 
              Re (deriv (\<lambda>x. stirling_integral n x) (of_real x))) (at x)"
       using eventually_nhds_in_open[of "{0<..}" x] 0 n
       by (intro has_field_derivative_cong_ev refl) 
          (auto elim!: eventually_mono simp: stirling_integral_complex_of_real)
     finally have "stirling_integral n field_differentiable at x"
       by (auto simp: field_differentiable_def)
     with 0 n show ?case by (auto simp: stirling_integral_complex_of_real)
   next
     case (Suc j x)
     note IH = conjunct1[OF Suc.IH] conjunct2[OF Suc.IH]
     have *: "(deriv ^^ Suc j) (stirling_integral n) (complex_of_real x) =
                  of_real ((deriv ^^ Suc j) (stirling_integral n) x)" if x: "x > 0" for x
     proof -
       have "deriv ((deriv ^^ j) (stirling_integral n)) (complex_of_real x) =
               vector_derivative (\<lambda>x. (deriv ^^ j) (stirling_integral n) (of_real x)) (at x)"
         using n x
         by (intro vector_derivative_of_real_right [symmetric] 
                    holomorphic_on_imp_differentiable_at[of _ ?A] holomorphic_higher_deriv
                    stirling_integral_holomorphic) (auto simp: complex_nonpos_Reals_iff)
       also have "\<dots> = vector_derivative (\<lambda>x. of_real ((deriv ^^ j) (stirling_integral n) x)) (at x)"
         using eventually_nhds_in_open[of "{0<..}" x] x
         by (intro vector_derivative_cong_eq) (auto elim!: eventually_mono simp: IH(1))
       also have "\<dots> = of_real (deriv ((deriv ^^ j) (stirling_integral n)) x)"
         by (intro vector_derivative_of_real_left holomorphic_on_imp_differentiable_at[of _ ?A]
               field_differentiable_imp_differentiable IH(2) x)
       finally show ?thesis by simp
     qed
     have "((\<lambda>x. Re ((deriv ^^ Suc j) (stirling_integral n) (of_real x))) has_field_derivative 
              Re (deriv ((deriv ^^ Suc j) (stirling_integral n)) (of_real x))) (at x)"
       using Suc.prems n
       by (intro derivative_intros has_vector_derivative_real_field field_differentiable_derivI
                 holomorphic_on_imp_differentiable_at[of _ ?A] stirling_integral_holomorphic
                 holomorphic_higher_deriv) (auto simp: complex_nonpos_Reals_iff)
     also have "?this \<longleftrightarrow> ((deriv ^^ Suc j) (stirling_integral n) has_field_derivative 
                   Re (deriv ((deriv ^^ Suc j) (stirling_integral n)) (of_real x))) (at x)"  
       using eventually_nhds_in_open[of "{0<..}" x] Suc.prems *
       by (intro has_field_derivative_cong_ev refl) (auto elim!: eventually_mono)
     finally have "(deriv ^^ Suc j) (stirling_integral n) field_differentiable at x"
       by (auto simp: field_differentiable_def)
     with *[OF Suc.prems] show ?case by blast
   qed
   from this[OF assms(2)] show "?lhs x = ?rhs x" ?thesis2 by blast+
 qed
 
 text \<open>
   Unfortunately, asymptotic power series cannot, in general, be differentiated. However, since 
   @{term ln_Gamma} is holomorphic on the entire positive real half-space, we can differentiate 
   its asymptotic expansion after all.
 
   To do this, we use an ad-hoc version of the more general approach outlined in Erdelyi's
   ``Asymptotic Expansions'' for holomorphic functions: We bound the value of the $j$-th derivative 
   of the remainder term at some value $x$ by applying Cauchy's integral formula along a circle 
   centred at $x$ with radius $\frac{1}{2} x$.
 \<close>
 lemma deriv_stirling_integral_real_bound:
   assumes m: "m > 0"
   shows   "(deriv ^^ j) (stirling_integral m) \<in> O(\<lambda>x::real. 1 / x ^ (m + j))"
 proof -
   obtain c where c: "\<And>s. 0 < Re s \<Longrightarrow> cmod (stirling_integral m s) \<le> c / Re s ^ m"
     using stirling_integral_bound[OF m] by auto
   have "0 \<le> cmod (stirling_integral m 1)" by simp
   also have "\<dots> \<le> c" using c[of 1] by simp
   finally have c_nonneg: "c \<ge> 0" .
   define B where "B = c * 2 ^ (m + Suc j)"
   define B' where "B' = B * fact j / 2"
 
   have "eventually (\<lambda>x::real. norm ((deriv ^^ j) (stirling_integral m) x) \<le> 
           B' * norm (1 / x ^ (m+ j))) at_top"
     using eventually_gt_at_top[of "0::real"]
   proof eventually_elim
     case (elim x)
     have "s \<notin> \<real>\<^sub>\<le>\<^sub>0" if "s \<in> cball (of_real x) (x/2)" for s :: complex
     proof -
       have "x - Re s \<le> norm (of_real x - s)" using complex_Re_le_cmod[of "of_real x - s"] by simp
       also from that have "\<dots> \<le> x/2" by (simp add: dist_complex_def)
       finally show ?thesis using elim by (auto simp: complex_nonpos_Reals_iff)
     qed
     hence "((\<lambda>u. stirling_integral m u / (u - of_real x) ^ Suc j) has_contour_integral
             complex_of_real (2 * pi) * \<i> / fact j * 
               (deriv ^^ j) (stirling_integral m) (of_real x)) (circlepath (of_real x) (x/2))"
       using m elim
       by (intro Cauchy_has_contour_integral_higher_derivative_circlepath 
                 stirling_integral_continuous_on_complex stirling_integral_holomorphic) auto
     hence "norm (of_real (2 * pi) * \<i> / fact j * (deriv ^^ j) (stirling_integral m) (of_real x)) \<le>
             B / x ^ (m + Suc j) * (2 * pi * (x / 2))"
     proof (rule has_contour_integral_bound_circlepath)
       fix u :: complex assume dist: "norm (u - of_real x) = x / 2"
       have "Re (of_real x - u) \<le> norm (of_real x - u)" by (rule complex_Re_le_cmod)
       also have "\<dots> = x / 2" using dist by (simp add: norm_minus_commute)
       finally have Re_u: "Re u \<ge> x/2" using elim by simp
       have "norm (stirling_integral m u / (u - of_real x) ^ Suc j) \<le> 
               c / Re u ^ m / (x / 2) ^ Suc j" using Re_u elim
         unfolding norm_divide norm_power dist
         by (intro divide_right_mono zero_le_power c) simp_all
       also have "\<dots> \<le> c / (x/2) ^ m / (x / 2) ^ Suc j" using c_nonneg elim Re_u
         by (intro divide_right_mono divide_left_mono power_mono) simp_all
       also have "\<dots> = B / x ^ (m + Suc j)" using elim by (simp add: B_def field_simps power_add)
       finally show "norm (stirling_integral m u / (u - of_real x) ^ Suc j) \<le> B / x ^ (m + Suc j)" .
     qed (insert elim c_nonneg, auto simp: B_def simp del: power_Suc)
     hence "cmod ((deriv ^^ j) (stirling_integral m) (of_real x)) \<le> B' / x ^ (j + m)"
       using elim by (simp add: field_simps norm_divide norm_mult norm_power B'_def)
     with elim m show ?case by (simp_all add: add_ac deriv_stirling_integral_complex_of_real)
   qed
   thus ?thesis by (rule bigoI)
 qed
 
 definition stirling_sum where
   "stirling_sum j m x = 
      (-1) ^ j * (\<Sum>k = 1..<m. (of_real (bernoulli (Suc k)) * pochhammer (of_nat k) j / (of_nat k *
                                  of_nat (Suc k))) * inverse x ^ (k + j))"
   
 definition stirling_sum' where
   "stirling_sum' j m x = 
      (-1) ^ (Suc j) * (\<Sum>k\<le>m. (of_real (bernoulli' k) * 
        pochhammer (of_nat (Suc k)) (j - 1) * inverse x ^ (k + j)))"
 
 lemma stirling_sum_complex_of_real:
   "stirling_sum j m (complex_of_real x) = complex_of_real (stirling_sum j m x)"
   by (simp add: stirling_sum_def pochhammer_of_real [symmetric] del: of_nat_Suc)
 
 lemma stirling_sum'_complex_of_real:
   "stirling_sum' j m (complex_of_real x) = complex_of_real (stirling_sum' j m x)"
   by (simp add: stirling_sum'_def pochhammer_of_real [symmetric] del: of_nat_Suc)
 
 lemma has_field_derivative_stirling_sum_complex [derivative_intros]:
   "Re x > 0 \<Longrightarrow> (stirling_sum j m has_field_derivative stirling_sum (Suc j) m x) (at x)"
     unfolding stirling_sum_def [abs_def] sum_distrib_left
     by (rule DERIV_sum) (auto intro!: derivative_eq_intros simp del: of_nat_Suc 
                               simp: pochhammer_Suc power_diff)
 
 lemma has_field_derivative_stirling_sum_real [derivative_intros]:
   "x > (0::real) \<Longrightarrow> (stirling_sum j m has_field_derivative stirling_sum (Suc j) m x) (at x)"
     unfolding stirling_sum_def [abs_def] sum_distrib_left
     by (rule DERIV_sum) (auto intro!: derivative_eq_intros simp del: of_nat_Suc 
                               simp: pochhammer_Suc power_diff)
 
 lemma has_field_derivative_stirling_sum'_complex [derivative_intros]:
   assumes "j > 0" "Re x > 0"
   shows   "(stirling_sum' j m has_field_derivative stirling_sum' (Suc j) m x) (at x)"
 proof (cases j)
   case (Suc j')
   from assms have [simp]: "x \<noteq> 0" by auto
   define c where "c = (\<lambda>n. (-1) ^ Suc j * complex_of_real (bernoulli' n) * 
                           pochhammer (of_nat (Suc n)) j')"
   define T where "T = (\<lambda>n x. c n * inverse x ^ (j + n))"
   define T' where "T' = (\<lambda>n x. - (of_nat (j + n)) * c n * inverse x ^ (Suc (j + n)))"
   have "((\<lambda>x. \<Sum>k\<le>m. T k x) has_field_derivative (\<Sum>k\<le>m. T' k x)) (at x)" using assms Suc
     by (intro DERIV_sum)
        (auto simp: T_def T'_def intro!: derivative_eq_intros 
              simp: field_simps power_add [symmetric]  simp del: of_nat_Suc power_Suc of_nat_add)
   also have "(\<lambda>x. (\<Sum>k\<le>m. T k x)) = stirling_sum' j m"
     by (simp add: Suc T_def c_def stirling_sum'_def fun_eq_iff add_ac mult.assoc sum_distrib_left)
   also have "(\<Sum>k\<le>m. T' k x) = stirling_sum' (Suc j) m x"
     by (simp add: T'_def c_def Suc stirling_sum'_def sum_distrib_left 
           sum_distrib_right algebra_simps pochhammer_Suc)
   finally show ?thesis .
 qed (insert assms, simp_all)
   
 lemma has_field_derivative_stirling_sum'_real [derivative_intros]:
   assumes "j > 0" "x > (0::real)"
   shows   "(stirling_sum' j m has_field_derivative stirling_sum' (Suc j) m x) (at x)"
 proof (cases j)
   case (Suc j')
   from assms have [simp]: "x \<noteq> 0" by auto
   define c where "c = (\<lambda>n. (-1) ^ Suc j * (bernoulli' n) * pochhammer (of_nat (Suc n)) j')"
   define T where "T = (\<lambda>n x. c n * inverse x ^ (j + n))"
   define T' where "T' = (\<lambda>n x. - (of_nat (j + n)) * c n * inverse x ^ (Suc (j + n)))"
   have "((\<lambda>x. \<Sum>k\<le>m. T k x) has_field_derivative (\<Sum>k\<le>m. T' k x)) (at x)" using assms Suc
     by (intro DERIV_sum)
        (auto simp: T_def T'_def intro!: derivative_eq_intros 
              simp: field_simps power_add [symmetric]  simp del: of_nat_Suc power_Suc of_nat_add)
   also have "(\<lambda>x. (\<Sum>k\<le>m. T k x)) = stirling_sum' j m"
     by (simp add: Suc T_def c_def stirling_sum'_def fun_eq_iff add_ac mult.assoc sum_distrib_left)
   also have "(\<Sum>k\<le>m. T' k x) = stirling_sum' (Suc j) m x"
     by (simp add: T'_def c_def Suc stirling_sum'_def sum_distrib_left 
           sum_distrib_right algebra_simps pochhammer_Suc)
   finally show ?thesis .
 qed (insert assms, simp_all)
 
 lemma higher_deriv_stirling_sum_complex:
   "Re x > 0 \<Longrightarrow> (deriv ^^ i) (stirling_sum j m) x = stirling_sum (i + j) m x"
 proof (induction i arbitrary: x)
   case (Suc i)
   have "deriv ((deriv ^^ i) (stirling_sum j m)) x = deriv (stirling_sum (i + j) m) x"
     using eventually_nhds_in_open[of "{x. Re x > 0}" x] Suc.prems
     by (intro deriv_cong_ev refl) (auto elim!: eventually_mono simp: open_halfspace_Re_gt Suc.IH)
   also from Suc.prems have "\<dots> = stirling_sum (Suc (i + j)) m x"
     by (intro DERIV_imp_deriv has_field_derivative_stirling_sum_complex)
   finally show ?case by simp
 qed simp_all
   
 
 definition Polygamma_approx :: "nat \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a :: {real_normed_field, ln}" where
   "Polygamma_approx j m = 
      (deriv ^^ j) (\<lambda>x. (x - 1 / 2) * ln x - x + of_real (ln (2 * pi)) / 2 + stirling_sum 0 m x)"
   
 lemma Polygamma_approx_Suc: "Polygamma_approx (Suc j) m = deriv (Polygamma_approx j m)"
   by (simp add: Polygamma_approx_def)  
 
 lemma Polygamma_approx_0: 
   "Polygamma_approx 0 m x = (x - 1/2) * ln x - x + of_real (ln (2*pi)) / 2 + stirling_sum 0 m x"
   by (simp add: Polygamma_approx_def)
     
 lemma Polygamma_approx_1_complex: 
   "Re x > 0 \<Longrightarrow> 
      Polygamma_approx (Suc 0) m x = ln x - 1 / (2*x) + stirling_sum (Suc 0) m x"
   unfolding Polygamma_approx_Suc Polygamma_approx_0
   by (intro DERIV_imp_deriv) 
      (auto intro!: derivative_eq_intros elim!: nonpos_Reals_cases simp: field_simps)
      
 lemma Polygamma_approx_1_real: 
   "x > (0 :: real) \<Longrightarrow> 
      Polygamma_approx (Suc 0) m x = ln x - 1 / (2*x) + stirling_sum (Suc 0) m x"
   unfolding Polygamma_approx_Suc Polygamma_approx_0
   by (intro DERIV_imp_deriv) 
      (auto intro!: derivative_eq_intros elim!: nonpos_Reals_cases simp: field_simps)
  
 lemma stirling_sum_2_conv_stirling_sum'_1:
   fixes x :: "'a :: {real_div_algebra, field_char_0}"
   assumes "m > 0" "x \<noteq> 0"
   shows   "stirling_sum' 1 m x = 1 / x + 1 / (2 * x^2) + stirling_sum 2 m x"
 proof -
   have pochhammer_2: "pochhammer (of_nat k) 2 = of_nat k * of_nat (Suc k)" for k 
     by (simp add: pochhammer_Suc eval_nat_numeral add_ac)
   have "stirling_sum 2 m x = 
           (\<Sum>k = Suc 0..<m. of_real (bernoulli' (Suc k)) * inverse x ^ Suc (Suc k))"
     unfolding stirling_sum_def pochhammer_2 power2_minus power_one mult_1_left
     by (intro sum.cong refl)
        (simp_all add: stirling_sum_def pochhammer_2 power2_eq_square divide_simps bernoulli'_def
                  del: of_nat_Suc power_Suc)
   also have "1 / (2 * x^2) + \<dots> = 
                (\<Sum>k=0..<m. of_real (bernoulli' (Suc k)) * inverse x ^ Suc (Suc k))" using assms
     by (subst (2) sum.atLeast_Suc_lessThan) (simp_all add: power2_eq_square field_simps)
   also have "1 / x + \<dots> = (\<Sum>k=0..<Suc m. of_real (bernoulli' k) * inverse x ^ Suc k)"
     by (subst sum.atLeast0_lessThan_Suc_shift) (simp_all add: bernoulli'_def divide_simps)
   also have "\<dots> = (\<Sum>k\<le>m. of_real (bernoulli' k) * inverse x ^ Suc k)"
     by (intro sum.cong) auto
   also have "\<dots> = stirling_sum' 1 m x" by (simp add: stirling_sum'_def)
   finally show ?thesis by (simp add: add_ac)
 qed
 
 lemma Polygamma_approx_2_real: 
   assumes "x > (0::real)" "m > 0"
   shows   "Polygamma_approx (Suc (Suc 0)) m x = stirling_sum' 1 m x"
 proof -
   have "Polygamma_approx (Suc (Suc 0)) m x = deriv (Polygamma_approx (Suc 0) m) x" 
     by (simp add: Polygamma_approx_Suc)
   also have "\<dots> = deriv (\<lambda>x. ln x - 1 / (2*x) + stirling_sum (Suc 0) m x) x"
     using eventually_nhds_in_open[of "{0<..}" x] assms
     by (intro deriv_cong_ev) (auto elim!: eventually_mono simp: Polygamma_approx_1_real)
   also have "\<dots> = 1 / x + 1 / (2*x^2) + stirling_sum (Suc (Suc 0)) m x" using assms
     by (intro DERIV_imp_deriv) (auto intro!: derivative_eq_intros 
            elim!: nonpos_Reals_cases simp: field_simps power2_eq_square)
   also have "\<dots> = stirling_sum' 1 m x" using stirling_sum_2_conv_stirling_sum'_1[of m x] assms
     by (simp add: eval_nat_numeral)
   finally show ?thesis .
 qed
   
 lemma Polygamma_approx_2_complex: 
   assumes "Re x > 0" "m > 0"
   shows   "Polygamma_approx (Suc (Suc 0)) m x = stirling_sum' 1 m x"
 proof -
   have "Polygamma_approx (Suc (Suc 0)) m x = deriv (Polygamma_approx (Suc 0) m) x" 
     by (simp add: Polygamma_approx_Suc)
   also have "\<dots> = deriv (\<lambda>x. ln x - 1 / (2*x) + stirling_sum (Suc 0) m x) x"
     using eventually_nhds_in_open[of "{s. Re s > 0}" x] assms
     by (intro deriv_cong_ev)
        (auto simp: open_halfspace_Re_gt elim!: eventually_mono simp: Polygamma_approx_1_complex)
   also have "\<dots> = 1 / x + 1 / (2*x^2) + stirling_sum (Suc (Suc 0)) m x" using assms
     by (intro DERIV_imp_deriv) (auto intro!: derivative_eq_intros 
            elim!: nonpos_Reals_cases simp: field_simps power2_eq_square)
   also have "\<dots> = stirling_sum' 1 m x" using stirling_sum_2_conv_stirling_sum'_1[of m x] assms
       by (subst stirling_sum_2_conv_stirling_sum'_1) (auto simp: eval_nat_numeral)
   finally show ?thesis .
 qed
   
 lemma Polygamma_approx_ge_2_real: 
   assumes "x > (0::real)" "m > 0"
   shows   "Polygamma_approx (Suc (Suc j)) m x = stirling_sum' (Suc j) m x"
 using assms(1)
 proof (induction j arbitrary: x)
   case (0 x)
   with assms show ?case by (simp add: Polygamma_approx_2_real)
 next
   case (Suc j x)
   have "Polygamma_approx (Suc (Suc (Suc j))) m x = deriv (Polygamma_approx (Suc (Suc j)) m) x"
     by (simp add: Polygamma_approx_Suc)
   also have "\<dots> = deriv (stirling_sum' (Suc j) m) x"
     using eventually_nhds_in_open[of "{0<..}" x] Suc.prems
     by (intro deriv_cong_ev refl) (auto elim!: eventually_mono simp: Suc.IH)
   also have "\<dots> = stirling_sum' (Suc (Suc j)) m x" using Suc.prems
     by (intro DERIV_imp_deriv derivative_intros) simp_all
   finally show ?case .
 qed
   
 lemma Polygamma_approx_ge_2_complex:
   assumes "Re x > 0" "m > 0"
   shows   "Polygamma_approx (Suc (Suc j)) m x = stirling_sum' (Suc j) m x"
 using assms(1)
 proof (induction j arbitrary: x)
   case (0 x)
   with assms show ?case by (simp add: Polygamma_approx_2_complex)
 next
   case (Suc j x)
   have "Polygamma_approx (Suc (Suc (Suc j))) m x = deriv (Polygamma_approx (Suc (Suc j)) m) x"
     by (simp add: Polygamma_approx_Suc)
   also have "\<dots> = deriv (stirling_sum' (Suc j) m) x"
     using eventually_nhds_in_open[of "{x. Re x > 0}" x] Suc.prems
     by (intro deriv_cong_ev refl) (auto elim!: eventually_mono simp: Suc.IH open_halfspace_Re_gt)
   also have "\<dots> = stirling_sum' (Suc (Suc j)) m x" using Suc.prems
     by (intro DERIV_imp_deriv derivative_intros) simp_all
   finally show ?case .
 qed
 
 lemma Polygamma_approx_complex_of_real:
   assumes "x > 0" "m > 0"
   shows   "Polygamma_approx j m (complex_of_real x) = of_real (Polygamma_approx j m x)"
 proof (cases j)
   case 0
   with assms show ?thesis by (simp add: Polygamma_approx_0 Ln_of_real stirling_sum_complex_of_real)
 next
   case [simp]: (Suc j')
   thus ?thesis
   proof (cases j')
     case 0
     with assms show ?thesis 
       by (simp add: Polygamma_approx_1_complex 
                     Polygamma_approx_1_real stirling_sum_complex_of_real Ln_of_real)
   next
     case (Suc j'')
     with assms show ?thesis
       by (simp add: Polygamma_approx_ge_2_complex Polygamma_approx_ge_2_real 
                     stirling_sum'_complex_of_real)
   qed
 qed
   
 lemma higher_deriv_Polygamma_approx [simp]: 
   "(deriv ^^ j) (Polygamma_approx i m) = Polygamma_approx (j + i) m"
   by (simp add: Polygamma_approx_def funpow_add)
   
 lemma stirling_sum_holomorphic [holomorphic_intros]:
   "0 \<notin> A \<Longrightarrow> stirling_sum j m holomorphic_on A"
   unfolding stirling_sum_def by (intro holomorphic_intros) auto
   
 lemma Polygamma_approx_holomorphic [holomorphic_intros]:
   "Polygamma_approx j m holomorphic_on {s. Re s > 0}"
   unfolding Polygamma_approx_def
   by (intro holomorphic_intros) (auto simp: open_halfspace_Re_gt elim!: nonpos_Reals_cases)
   
 lemma higher_deriv_lnGamma_stirling:
   assumes m: "m > 0"
   shows   "(\<lambda>x::real. (deriv ^^ j) ln_Gamma x - Polygamma_approx j m x) \<in> O(\<lambda>x. 1 / x ^ (m + j))"
 proof -
   have "eventually (\<lambda>x. \<bar>(deriv ^^ j) ln_Gamma x - Polygamma_approx j m x\<bar> =
                           inverse (real m) * \<bar>(deriv ^^ j) (stirling_integral m) x\<bar>) at_top"
     using eventually_gt_at_top[of "0::real"]
   proof eventually_elim
     case (elim x)
     note x = this
     have "\<forall>\<^sub>F y in nhds (complex_of_real x). y \<in> - \<real>\<^sub>\<le>\<^sub>0"
       using elim by (intro eventually_nhds_in_open) auto
     hence "(deriv ^^ j) (\<lambda>x. ln_Gamma x - Polygamma_approx 0 m x) (complex_of_real x) =
             (deriv ^^ j) (\<lambda>x. (-inverse (of_nat m)) * stirling_integral m x) (complex_of_real x)"
       using x m
       by (intro higher_deriv_cong_ev refl)
          (auto elim!: eventually_mono simp: ln_Gamma_stirling_complex Polygamma_approx_def 
             field_simps open_halfspace_Re_gt stirling_sum_def)
     also have "\<dots> = - inverse (of_nat m) * (deriv ^^ j) (stirling_integral m) (of_real x)" using x m
       by (intro higher_deriv_cmult[of _ "-\<real>\<^sub>\<le>\<^sub>0"] stirling_integral_holomorphic)
          (auto simp: open_halfspace_Re_gt)
     also have "(deriv ^^ j) (\<lambda>x. ln_Gamma x - Polygamma_approx 0 m x) (complex_of_real x) = 
                  (deriv ^^ j) ln_Gamma (of_real x) - (deriv ^^ j) (Polygamma_approx 0 m) (of_real x)"
       using x 
       by (intro higher_deriv_diff[of _ "{s. Re s > 0}"])
          (auto intro!: holomorphic_intros elim!: nonpos_Reals_cases simp: open_halfspace_Re_gt)
     also have "(deriv ^^ j) (Polygamma_approx 0 m) (complex_of_real x) =
                  of_real (Polygamma_approx j m x)" using x m
       by (simp add: Polygamma_approx_complex_of_real)
     also have "norm (- inverse (of_nat m) * (deriv ^^ j) (stirling_integral m) (complex_of_real x)) = 
                  inverse (real m) * \<bar>(deriv ^^ j) (stirling_integral m) x\<bar>"
       using x m by (simp add: norm_mult norm_inverse deriv_stirling_integral_complex_of_real)
     also have "(deriv ^^ j) ln_Gamma (complex_of_real x) = of_real ((deriv ^^ j) ln_Gamma x)" using x
       by (simp add: higher_deriv_ln_Gamma_complex_of_real)
     also have "norm (\<dots> - of_real (Polygamma_approx j m x)) = 
                  \<bar>(deriv ^^ j) ln_Gamma x - Polygamma_approx j m x\<bar>"
       by (simp only: of_real_diff [symmetric] norm_of_real)
     finally show ?case .
   qed
   from bigthetaI_cong[OF this] m
     have "(\<lambda>x::real. (deriv ^^ j) ln_Gamma x - Polygamma_approx j m x) \<in> 
              \<Theta>(\<lambda>x. (deriv ^^ j) (stirling_integral m) x)" by simp
   also have "(\<lambda>x::real. (deriv ^^ j) (stirling_integral m) x) \<in> O(\<lambda>x. 1 / x ^ (m + j))" using m
       by (rule deriv_stirling_integral_real_bound)
   finally show ?thesis .
 qed
 
 lemma Polygamma_approx_1_real':
   assumes x: "(x::real) > 0" and m: "m > 0"
   shows   "Polygamma_approx 1 m x = ln x - (\<Sum>k = Suc 0..m. bernoulli' k * inverse x ^ k / real k)"
 proof -
   have "Polygamma_approx 1 m x = ln x - (1 / (2 * x) + 
           (\<Sum>k=Suc 0..<m. bernoulli (Suc k) * inverse x ^ Suc k / real (Suc k)))"
     (is "_ = _ - (_ + ?S)") using x by (simp add: Polygamma_approx_1_real stirling_sum_def)
   also have "?S = (\<Sum>k=Suc 0..<m. bernoulli' (Suc k) * inverse x ^ Suc k / real (Suc k))"
     by (intro sum.cong refl) (simp_all add: bernoulli'_def)
   also have "1 / (2 * x) + \<dots> = 
                (\<Sum>k=0..<m. bernoulli' (Suc k) * inverse x ^ Suc k / real (Suc k))" using m
     by (subst (2) sum.atLeast_Suc_lessThan) (simp_all add: field_simps)
   also have "\<dots> = (\<Sum>k = Suc 0..m. bernoulli' k * inverse x ^ k / real k)" using assms
     by (subst sum.shift_bounds_Suc_ivl [symmetric]) (simp add: atLeastLessThanSuc_atLeastAtMost)
   finally show ?thesis .
 qed
 
 theorem
   assumes m: "m > 0"
   shows   ln_Gamma_real_asymptotics:
             "(\<lambda>x. ln_Gamma x - ((x - 1 / 2) * ln x - x + ln (2 * pi) / 2 +
                      (\<Sum>k = 1..<m. bernoulli (Suc k) / (real k * real (Suc k)) / x^k)))
                 \<in> O(\<lambda>x. 1 / x ^ m)" (is ?th1)
     and   Digamma_real_asymptotics:
             "(\<lambda>x. Digamma x - (ln x - (\<Sum>k=1..m. bernoulli' k / real k / x ^ k)))
                 \<in> O(\<lambda>x. 1 / (x ^ Suc m))" (is ?th2)
     and   Polygamma_real_asymptotics: "j > 0 \<Longrightarrow> 
              (\<lambda>x. Polygamma j x - (- 1) ^ Suc j * (\<Sum>k\<le>m. bernoulli' k *
                      pochhammer (real (Suc k)) (j - 1) / x ^ (k + j))) 
                 \<in> O(\<lambda>x. 1 / x ^ (m+j+1))" (is "_ \<Longrightarrow> ?th3")
 proof -
   define G :: "nat \<Rightarrow> real \<Rightarrow> real" where 
     "G = (\<lambda>m. if m = 0 then ln_Gamma else Polygamma (m - 1))"
   have *: "(\<lambda>x. G j x - h x) \<in> O(\<lambda>x. 1 / x ^ (m + j))"
     if "\<And>x::real. x > 0 \<Longrightarrow> Polygamma_approx j m x = h x" for j h
   proof -
     have "(\<lambda>x. G j x - h x) \<in> 
             \<Theta>(\<lambda>x. (deriv ^^ j) ln_Gamma x - Polygamma_approx j m x)" (is "_ \<in> \<Theta>(?f)")
       using that
       by (intro bigthetaI_cong) (auto intro: eventually_mono[OF eventually_gt_at_top[of "0::real"]]
             simp del: funpow.simps simp: higher_deriv_ln_Gamma_real G_def)
     also have "?f \<in> O(\<lambda>x::real. 1 / x ^ (m + j))" using m
       by (rule higher_deriv_lnGamma_stirling)
     finally show ?thesis .
   qed  
     
   note [[simproc del: simplify_landau_sum]]
   from *[OF Polygamma_approx_0] assms show ?th1 
     by (simp add: G_def Polygamma_approx_0 stirling_sum_def field_simps)
   from *[OF Polygamma_approx_1_real'] assms show ?th2 by (simp add: G_def field_simps)
       
   assume j: "j > 0"
   from *[OF Polygamma_approx_ge_2_real, of "j - 1"] assms j show ?th3
     by (simp add: G_def stirling_sum'_def power_add power_diff field_simps)
 qed
 
 
 
 
 subsection \<open>Asymptotics of the complex Gamma function\<close>
 
 text \<open>
   The \<open>m\<close>-th order remainder of Stirling's formula for $\log\Gamma$ is $O(s^{-m})$ uniformly over
   any complex cone $\text{Arg}(z) \leq \alpha$, $z\neq 0$ for any angle
   $\alpha\in(0, \pi)$. This means that there is bounded by $c z^{-m}$ for some constant $c$ for
   all $z$ in this cone.
 \<close>
 context
   fixes F and \<alpha>
   assumes \<alpha>: "\<alpha> \<in> {0<..<pi}"
   defines "F \<equiv> principal (complex_cone' \<alpha> - {0})"
 begin
 
 lemma stirling_integral_bigo:
   fixes m :: nat
   assumes m: "m > 0"
   shows   "stirling_integral m \<in> O[F](\<lambda>s. 1 / s ^ m)"
 proof -
   obtain c where c: "\<And>s. s \<in> complex_cone' \<alpha> - {0} \<Longrightarrow> norm (stirling_integral m s) \<le> c / norm s ^ m"
     using stirling_integral_bound'[OF \<open>m > 0\<close> \<alpha>] by blast
   have "0 \<le> norm (stirling_integral m 1 :: complex)"
     by simp
   also have "\<dots> \<le> c"
     using c[of 1] \<alpha> by simp
   finally have "c \<ge> 0" .
 
   have "eventually (\<lambda>s. s \<in> complex_cone' \<alpha> - {0}) F"
     unfolding F_def by (auto simp: eventually_principal)
   hence "eventually (\<lambda>s. norm (stirling_integral m s) \<le>
                      c * norm (1 / s ^ m)) F"
     by eventually_elim (use c in \<open>simp add: norm_divide norm_power\<close>)
   thus "stirling_integral m \<in> O[F](\<lambda>s. 1 / s ^ m)"
     by (intro bigoI[of _ c]) auto
 qed
 
 end
 
 text \<open>
   The following is a more explicit statement of this:
 \<close>
 theorem ln_Gamma_complex_asymptotics_explicit:
   fixes m :: nat and \<alpha> :: real
   assumes "m > 0" and "\<alpha> \<in> {0<..<pi}"
   obtains C :: real and R :: "complex \<Rightarrow> complex"
   where "\<forall>s::complex. s \<notin> \<real>\<^sub>\<le>\<^sub>0 \<longrightarrow>
                ln_Gamma s = (s - 1/2) * ln s - s + ln (2 * pi) / 2 +
                             (\<Sum>k=1..<m. bernoulli (k+1) / (k * (k+1) * s ^ k)) - R s"
     and "\<forall>s. s \<noteq> 0 \<and> \<bar>Arg s\<bar> \<le> \<alpha> \<longrightarrow> norm (R s) \<le> C / norm s ^ m"    
 proof -
   obtain c where c: "\<And>s. s \<in> complex_cone' \<alpha> - {0} \<Longrightarrow> norm (stirling_integral m s) \<le> c / norm s ^ m"
     using stirling_integral_bound'[OF assms] by blast
   have "0 \<le> norm (stirling_integral m 1 :: complex)"
     by simp
   also have "\<dots> \<le> c"
     using c[of 1] assms by simp
   finally have "c \<ge> 0" .
   define R where "R = (\<lambda>s::complex. stirling_integral m s / of_nat m)"
   show ?thesis
   proof (rule that)
     from ln_Gamma_stirling_complex[of _ m] assms show
            "\<forall>s::complex. s \<notin> \<real>\<^sub>\<le>\<^sub>0 \<longrightarrow>
                ln_Gamma s = (s - 1 / 2) * ln s - s + ln (2 * pi) / 2 +
                (\<Sum>k=1..<m. bernoulli (k+1) / (k * (k+1) * s ^ k)) - R s"
       by (auto simp add: R_def algebra_simps)
     show "\<forall>s. s \<noteq> 0 \<and> \<bar>Arg s\<bar> \<le> \<alpha> \<longrightarrow> cmod (R s) \<le> c / real m / cmod s ^ m"
     proof (safe, goal_cases)
       case (1 s)
       show ?case
         using 1 c[of s] assms
         by (auto simp: complex_cone_altdef abs_le_iff R_def norm_divide field_simps)
     qed
   qed
 qed
 
 
 text \<open>
   Lastly, we can also derive the asymptotics of $\Gamma$ itself:
   \[\Gamma(z) \sim \sqrt{2\pi / z} \left(\frac{z}{e}\right)^z\]
   uniformly for $|z|\to\infty$ within the cone $\text{Arg}(z) \leq \alpha$ for $\alpha\in(0,\pi)$:
 \<close>
 
 context
   fixes F and \<alpha>
   assumes \<alpha>: "\<alpha> \<in> {0<..<pi}"
   defines "F \<equiv> inf at_infinity (principal (complex_cone' \<alpha>))"
 begin
 
 lemma Gamma_complex_asymp_equiv:
   "Gamma \<sim>[F] (\<lambda>s. sqrt (2 * pi) * (s / exp 1) powr s / s powr (1 / 2))"
 proof -
   define I :: "complex \<Rightarrow> complex" where "I = stirling_integral 1"
   have "eventually (\<lambda>s. s \<in> complex_cone' \<alpha>) F"
     by (auto simp: eventually_inf_principal F_def)
   moreover have "eventually (\<lambda>s. s \<noteq> 0) F"
     unfolding F_def eventually_inf_principal
     using eventually_not_equal_at_infinity by eventually_elim auto
   ultimately have "eventually (\<lambda>s. Gamma s =
                      sqrt (2 * pi) * (s / exp 1) powr s / s powr (1 / 2) / exp (I s)) F"
   proof eventually_elim
     case (elim s)
     from elim have s': "s \<notin> \<real>\<^sub>\<le>\<^sub>0"
       using complex_cone_inter_nonpos_Reals[of "-\<alpha>" \<alpha>] \<alpha> by auto
     from elim have [simp]: "s \<noteq> 0" by auto      
     from s' have "Gamma s = exp (ln_Gamma s)"
       unfolding Gamma_complex_altdef using nonpos_Ints_subset_nonpos_Reals by auto
     also from s' have "ln_Gamma s = (s-1/2) * Ln s - s + complex_of_real (ln (2 * pi) / 2) - I s"
       by (subst ln_Gamma_stirling_complex[of _ 1]) (simp_all add: exp_add exp_diff I_def)
     also have "exp \<dots> = exp ((s - 1 / 2) * Ln s) / exp s *
                         exp (complex_of_real (ln (2 * pi) / 2)) / exp (I s)"
       unfolding exp_diff exp_add by (simp add: exp_diff exp_add)
     also have "exp ((s - 1 / 2) * Ln s) = s powr (s - 1 / 2)"
       by (simp add: powr_def)
     also have "exp (complex_of_real (ln (2 * pi) / 2)) = sqrt (2 * pi)"
       by (subst exp_of_real) (auto simp: powr_def simp flip: powr_half_sqrt)
     also have "exp s = exp 1 powr s"
       by (simp add: powr_def)
     also have "s powr (s - 1 / 2) / exp 1 powr s = (s powr s / exp 1 powr s) / s powr (1/2)"
       by (subst powr_diff) auto
     also have *: "Ln (s / exp 1) = Ln s - 1"
       using Ln_divide_of_real[of "exp 1" s] by (simp flip: exp_of_real)
     hence "s powr s / exp 1 powr s = (s / exp 1) powr s"
       unfolding powr_def by (subst *) (auto simp: exp_diff field_simps)
     finally show "Gamma s = sqrt (2 * pi) * (s / exp 1) powr s / s powr (1 / 2) / exp (I s)"
       by (simp add: algebra_simps)
   qed
   hence "Gamma \<sim>[F] (\<lambda>s. sqrt (2 * pi) * (s / exp 1) powr s / s powr (1 / 2) / exp (I s))"
     by (rule asymp_equiv_refl_ev)
   also have "\<dots> \<sim>[F] (\<lambda>s. sqrt (2 * pi) * (s / exp 1) powr s / s powr (1 / 2) / 1)"
   proof (intro asymp_equiv_intros)
     have "F \<le> principal (complex_cone' \<alpha> - {0})"
       unfolding le_principal F_def eventually_inf_principal
       using eventually_not_equal_at_infinity by eventually_elim auto
     moreover have "I \<in> O[principal (complex_cone' \<alpha> - {0})](\<lambda>s. 1 / s)"
       using stirling_integral_bigo[of \<alpha> 1] \<alpha> unfolding F_def by (simp add: I_def)
     ultimately have "I \<in> O[F](\<lambda>s. 1 / s)"
       by (rule landau_o.big.filter_mono)
     also have "(\<lambda>s. 1 / s) \<in> o[F](\<lambda>s. 1)"
     proof (rule landau_o.smallI)
       fix c :: real
       assume c: "c > 0"
       hence "eventually (\<lambda>z::complex. norm z \<ge> 1 / c) at_infinity"
         by (auto simp: eventually_at_infinity)
       moreover have "eventually (\<lambda>z::complex. z \<noteq> 0) at_infinity"
         by (rule eventually_not_equal_at_infinity)
       ultimately show "eventually (\<lambda>z::complex. norm (1 / z) \<le> c * norm (1 :: complex)) F"
         unfolding F_def eventually_inf_principal
         by eventually_elim (use \<open>c > 0\<close> in \<open>auto simp: norm_divide field_simps\<close>)
     qed
     finally have "I \<in> o[F](\<lambda>s. 1)" .
     from smalloD_tendsto[OF this] have [tendsto_intros]: "(I \<longlongrightarrow> 0) F"
       by simp
     show "(\<lambda>x. exp (I x)) \<sim>[F] (\<lambda>x. 1)"
       by (rule asymp_equivI' tendsto_eq_intros refl | simp)+
   qed
   finally show ?thesis by simp
 qed
 
 end
 
 end