diff --git a/thys/Algebraic_Numbers/Algebraic_Numbers.thy b/thys/Algebraic_Numbers/Algebraic_Numbers.thy
--- a/thys/Algebraic_Numbers/Algebraic_Numbers.thy
+++ b/thys/Algebraic_Numbers/Algebraic_Numbers.thy
@@ -1,1349 +1,1349 @@
 (*  
     Author:       René Thiemann 
                   Akihisa Yamada
     Contributors: Manuel Eberl (algebraic integers)
     License:      BSD
 *)
 section \<open>Algebraic Numbers: Addition and Multiplication\<close>
 
 text \<open>This theory contains the remaining field operations for algebraic numbers, namely
   addition and multiplication.\<close>
 
 theory Algebraic_Numbers
   imports
   Algebraic_Numbers_Prelim
   Resultant
   Polynomial_Factorization.Polynomial_Divisibility
 begin
 
 interpretation coeff_hom: monoid_add_hom "\<lambda>p. coeff p i" by (unfold_locales, auto)
 interpretation coeff_hom: comm_monoid_add_hom "\<lambda>p. coeff p i"..
 interpretation coeff_hom: group_add_hom "\<lambda>p. coeff p i"..
 interpretation coeff_hom: ab_group_add_hom "\<lambda>p. coeff p i"..
 interpretation coeff_0_hom: monoid_mult_hom "\<lambda>p. coeff p 0" by (unfold_locales, auto simp: coeff_mult)
 interpretation coeff_0_hom: semiring_hom "\<lambda>p. coeff p 0"..
 interpretation coeff_0_hom: comm_monoid_mult_hom "\<lambda>p. coeff p 0"..
 interpretation coeff_0_hom: comm_semiring_hom "\<lambda>p. coeff p 0"..
 
 subsection \<open>Addition of Algebraic Numbers\<close>
 
 definition "x_y \<equiv> [: [: 0, 1 :], -1 :]"
 
 definition "poly_x_minus_y p = poly_lift p \<circ>\<^sub>p x_y"
 
 lemma coeff_xy_power:
   assumes "k \<le> n"
   shows  "coeff (x_y ^ n :: 'a :: comm_ring_1 poly poly) k =
           monom (of_nat (n choose (n - k)) * (- 1) ^ k) (n - k)"
 proof -
   define X :: "'a poly poly" where "X = monom (monom 1 1) 0"
   define Y :: "'a poly poly" where "Y = monom (-1) 1"
 
   have [simp]: "monom 1 b * (-1) ^ k = monom ((-1)^k :: 'a) b" for b k
     by (auto simp: monom_altdef minus_one_power_iff)
 
   have "(X + Y) ^ n = (\<Sum>i\<le>n. of_nat (n choose i) * X ^ i * Y ^ (n - i))"
     by (subst binomial_ring) auto
   also have "\<dots> = (\<Sum>i\<le>n. of_nat (n choose i) * monom (monom ((-1) ^ (n - i)) i) (n - i))"
     by (simp add: X_def Y_def monom_power mult_monom mult.assoc) 
   also have "\<dots> = (\<Sum>i\<le>n. monom (monom (of_nat (n choose i) * (-1) ^ (n - i)) i) (n - i))"
     by (simp add: of_nat_poly smult_monom)
   also have "coeff \<dots> k =
     (\<Sum>i\<le>n. if n - i = k then monom (of_nat (n choose i) * (- 1) ^ (n - i)) i else 0)"
     by (simp add: of_nat_poly coeff_sum)
   also have "\<dots> = (\<Sum>i\<in>{n-k}. monom (of_nat (n choose i) * (- 1) ^ (n - i)) i)"
     using \<open>k \<le> n\<close> by (intro sum.mono_neutral_cong_right) auto
   also have "X + Y = x_y"
     by (simp add: X_def Y_def x_y_def monom_altdef)
   finally show ?thesis
     using \<open>k \<le> n\<close> by simp
 qed
 
 
 text \<open>The following polynomial represents the sum of two algebraic numbers.\<close>
 
 definition poly_add :: "'a :: comm_ring_1 poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly" where
   "poly_add p q = resultant (poly_x_minus_y p) (poly_lift q)"
 
 subsubsection \<open>@{term poly_add} has desired root\<close>
 
 interpretation poly_x_minus_y_hom:
   comm_ring_hom poly_x_minus_y by (unfold_locales; simp add: poly_x_minus_y_def hom_distribs)
 
 lemma poly2_x_y[simp]:
   fixes x :: "'a :: comm_ring_1"
   shows "poly2 x_y x y = x - y" unfolding poly2_def by (simp add: x_y_def)
 
 lemma degree_poly_x_minus_y[simp]:
   fixes p :: "'a::idom poly"
   shows "degree (poly_x_minus_y p) = degree p" unfolding poly_x_minus_y_def x_y_def by auto
 
 lemma poly_x_minus_y_pCons[simp]:
   "poly_x_minus_y (pCons a p) = [:[: a :]:] + poly_x_minus_y p * x_y"
   unfolding poly_x_minus_y_def x_y_def by simp
 
 lemma poly_poly_poly_x_minus_y[simp]:
   fixes p :: "'a :: comm_ring_1 poly"
   shows "poly (poly (poly_x_minus_y p) q) x = poly p (x - poly q x)"
   by (induct p; simp add: ring_distribs x_y_def)
 
 lemma poly2_poly_x_minus_y[simp]:
   fixes p :: "'a :: comm_ring_1 poly"
   shows "poly2 (poly_x_minus_y p) x y = poly p (x-y)" unfolding poly2_def by simp
 
 interpretation x_y_mult_hom: zero_hom_0 "\<lambda>p :: 'a :: comm_ring_1 poly poly. x_y * p"
 proof (unfold_locales)
   fix p :: "'a poly poly"
   assume "x_y * p = 0"
   then show "p = 0" apply (simp add: x_y_def)
     by (metis eq_neg_iff_add_eq_0 minus_equation_iff minus_pCons synthetic_div_unique_lemma)
 qed
 
 lemma x_y_nonzero[simp]: "x_y \<noteq> 0" by (simp add: x_y_def)
 
 lemma degree_x_y[simp]: "degree x_y = 1" by (simp add: x_y_def)
 
 interpretation x_y_mult_hom: inj_comm_monoid_add_hom "\<lambda>p :: 'a :: idom poly poly. x_y * p"
 proof (unfold_locales)
   show "x_y * p = x_y * q \<Longrightarrow> p = q" for p q :: "'a poly poly"
   proof (induct p arbitrary:q)
     case 0
     then show ?case by simp
   next
     case p: (pCons a p)
     from p(3)[unfolded mult_pCons_right]
     have "x_y * (monom a 0 + pCons 0 1 * p) = x_y * q"
       apply (subst(asm) pCons_0_as_mult)
       apply (subst(asm) smult_prod) by (simp only: field_simps distrib_left)
     then have "monom a 0 + pCons 0 1 * p = q" by simp
     then show "pCons a p = q" using pCons_as_add by (simp add: monom_0 monom_Suc)
   qed
 qed
 
 interpretation poly_x_minus_y_hom: inj_idom_hom poly_x_minus_y
 proof
   fix p :: "'a poly"
   assume 0: "poly_x_minus_y p = 0"
   then have "poly_lift p \<circ>\<^sub>p x_y = 0" by (simp add: poly_x_minus_y_def)
   then show "p = 0"
   proof (induct p)
     case 0
     then show ?case by simp
   next
     case (pCons a p)
     note p = this[unfolded poly_lift_pCons pcompose_pCons]
     show ?case
     proof (cases "a=0")
       case a0: True
       with p have "x_y * poly_lift p \<circ>\<^sub>p x_y = 0" by simp
       then have "poly_lift p \<circ>\<^sub>p x_y = 0" by simp
       then show ?thesis using p by simp
     next
       case a0: False
       with p have p0: "p \<noteq> 0" by auto
       from p have "[:[:a:]:] = - x_y * poly_lift p \<circ>\<^sub>p x_y" by (simp add: eq_neg_iff_add_eq_0)
       then have "degree [:[:a:]:] = degree (x_y * poly_lift p \<circ>\<^sub>p x_y)" by simp
       also have "... = degree (x_y::'a poly poly) + degree (poly_lift p \<circ>\<^sub>p x_y)"
         apply (subst degree_mult_eq)
           apply simp
          apply (subst pcompose_eq_0)
           apply (simp add: x_y_def)
          apply (simp add: p0)
         apply simp
        done
       finally have False by simp 
       then show ?thesis..
     qed
   qed
 qed
 
 lemma poly_add:
   fixes p q :: "'a ::comm_ring_1 poly"
   assumes q0: "q \<noteq> 0" and x: "poly p x = 0" and y: "poly q y = 0"
   shows "poly (poly_add p q) (x+y) = 0"
 proof (unfold poly_add_def, rule poly_resultant_zero[OF disjI2])
   have "degree q > 0" using poly_zero q0 y by auto
   thus degq: "degree (poly_lift q) > 0" by auto
 qed (insert x y, simp_all)
 
 
 subsubsection \<open>@{const poly_add} is nonzero\<close>
 
 text \<open>
   We first prove that @{const poly_lift} preserves factorization. The result will be essential
   also in the next section for division of algebraic numbers.
 \<close>
 
 interpretation poly_lift_hom:
   unit_preserving_hom "poly_lift :: 'a :: {comm_semiring_1,semiring_no_zero_divisors} poly \<Rightarrow> _"
 proof
   fix x :: "'a poly"
   assume "poly_lift x dvd 1"
   then have "poly_y_x (poly_lift x) dvd poly_y_x 1"
     by simp
   then show "x dvd 1"
     by (auto simp add: poly_y_x_poly_lift)
 qed
 
 interpretation poly_lift_hom:
   factor_preserving_hom "poly_lift::'a::idom poly \<Rightarrow> 'a poly poly"
 proof unfold_locales
   fix p :: "'a poly"
   assume p: "irreducible p"
   show "irreducible (poly_lift p)"
   proof(rule ccontr)
     from p have p0: "p \<noteq> 0" and "\<not> p dvd 1" by (auto dest: irreducible_not_unit)
     with poly_lift_hom.hom_dvd[of p 1] have p1: "\<not> poly_lift p dvd 1" by auto
     assume "\<not> irreducible (poly_lift p)"
     from this[unfolded irreducible_altdef,simplified] p0 p1
     obtain q where "q dvd poly_lift p" and pq: "\<not> poly_lift p dvd q" and q: "\<not> q dvd 1" by auto
     then obtain r where "q * r = poly_lift p" by (elim dvdE, auto)
     then have "poly_y_x (q * r) = poly_y_x (poly_lift p)" by auto
     also have "... = [:p:]" by (auto simp: poly_y_x_poly_lift monom_0)
     also have "poly_y_x (q * r) = poly_y_x q * poly_y_x r" by (auto simp: hom_distribs)
     finally have "... = [:p:]" by auto
     then have qp: "poly_y_x q dvd [:p:]" by (metis dvdI)
     from dvd_const[OF this] p0 have "degree (poly_y_x q) = 0" by auto
     from degree_0_id[OF this,symmetric] obtain s
       where qs: "poly_y_x q = [:s:]" by auto
     have "poly_lift s = poly_y_x (poly_y_x (poly_lift s))" by auto
       also have "... = poly_y_x [:s:]" by (auto simp: poly_y_x_poly_lift monom_0)
       also have "... = q" by (auto simp: qs[symmetric])
     finally have sq: "poly_lift s = q" by auto
     from qp[unfolded qs] have sp: "s dvd p" by (auto simp: const_poly_dvd)
     from irreducibleD'[OF p this] sq q pq show False by auto
   qed
 qed
 
 text \<open>
   We now show that @{const poly_x_minus_y} is a factor-preserving homomorphism. This is
   essential for this section. This is easy since @{const poly_x_minus_y} can be represented
   as the composition of two factor-preserving homomorphisms.
 \<close>
 
 lemma poly_x_minus_y_as_comp: "poly_x_minus_y = (\<lambda>p. p \<circ>\<^sub>p x_y) \<circ> poly_lift"
   by (intro ext, unfold poly_x_minus_y_def, auto)
 context idom_isom begin
   sublocale comm_semiring_isom..
 end
 
 interpretation poly_x_minus_y_hom:
   factor_preserving_hom "poly_x_minus_y :: 'a :: idom poly \<Rightarrow> 'a poly poly"
 proof -
   have \<open>p \<circ>\<^sub>p x_y \<circ>\<^sub>p x_y = p\<close> for p :: \<open>'a poly poly\<close>
   proof (induction p)
     case 0
     show ?case
       by simp
   next
     case (pCons a p)
     then show ?case
       by (unfold x_y_def hom_distribs pcompose_pCons) simp
   qed
   then interpret x_y_hom: bijective "\<lambda>p :: 'a poly poly. p \<circ>\<^sub>p x_y"
     by (unfold bijective_eq_bij) (rule involuntory_imp_bij)
   interpret x_y_hom: idom_isom "\<lambda>p :: 'a poly poly. p \<circ>\<^sub>p x_y"
     by standard simp_all
   have \<open>factor_preserving_hom (\<lambda>p :: 'a poly poly. p \<circ>\<^sub>p x_y)\<close>
     and \<open>factor_preserving_hom (poly_lift :: 'a poly \<Rightarrow> 'a poly poly)\<close>
     ..
   then show "factor_preserving_hom (poly_x_minus_y :: 'a poly \<Rightarrow> _)"
     by (unfold poly_x_minus_y_as_comp) (rule factor_preserving_hom_comp)
 qed
 
 text \<open>
   Now we show that results of @{const poly_x_minus_y} and @{const poly_lift} are coprime.
 \<close>
 
 lemma poly_y_x_const[simp]: "poly_y_x [:[:a:]:] = [:[:a:]:]" by (simp add: poly_y_x_def monom_0)
 
 context begin
 
 private abbreviation "y_x == [: [: 0, -1 :], 1 :]"
 
 lemma poly_y_x_x_y[simp]: "poly_y_x x_y = y_x" by (simp add: x_y_def poly_y_x_def monom_Suc monom_0)
 
 private lemma y_x[simp]: fixes x :: "'a :: comm_ring_1" shows "poly2 y_x x y = y - x"
   unfolding poly2_def by simp
 
 private definition "poly_y_minus_x p \<equiv> poly_lift p \<circ>\<^sub>p y_x"
 
 private lemma poly_y_minus_x_0[simp]: "poly_y_minus_x 0 = 0" by (simp add: poly_y_minus_x_def)
 
 private lemma poly_y_minus_x_pCons[simp]:
   "poly_y_minus_x (pCons a p) = [:[: a :]:] + poly_y_minus_x p * y_x" by (simp add: poly_y_minus_x_def)
 
 private lemma poly_y_x_poly_x_minus_y:
   fixes p :: "'a :: idom poly"
   shows "poly_y_x (poly_x_minus_y p) = poly_y_minus_x p"
   apply (induct p, simp)
   apply (unfold poly_x_minus_y_pCons hom_distribs) by simp
 
 lemma degree_poly_y_minus_x[simp]:
   fixes p :: "'a :: idom poly"
   shows "degree (poly_y_x (poly_x_minus_y p)) = degree p" 
   by (simp add: poly_y_minus_x_def poly_y_x_poly_x_minus_y)
 
 end
 
 lemma dvd_all_coeffs_iff:
   fixes x :: "'a :: comm_semiring_1" (* No addition needed! *)
   shows "(\<forall>pi \<in> set (coeffs p). x dvd pi) \<longleftrightarrow> (\<forall>i. x dvd coeff p i)" (is "?l = ?r")
 proof-
   have "?r = (\<forall>i\<in>{..degree p} \<union> {Suc (degree p)..}. x dvd coeff p i)" by auto
   also have "... = (\<forall>i\<le>degree p. x dvd coeff p i)" by (auto simp add: ball_Un coeff_eq_0)
   also have "... = ?l" by (auto simp: coeffs_def)
   finally show ?thesis..
 qed
 
 lemma primitive_imp_no_constant_factor:
   fixes p :: "'a :: {comm_semiring_1, semiring_no_zero_divisors} poly"
   assumes pr: "primitive p" and F: "mset_factors F p" and fF: "f \<in># F"
   shows "degree f \<noteq> 0"
 proof
   from F fF have irr: "irreducible f" and fp: "f dvd p" by (auto dest: mset_factors_imp_dvd)
   assume deg: "degree f = 0"
   then obtain f0 where f0: "f = [:f0:]" by (auto dest: degree0_coeffs)
   with fp have "[:f0:] dvd p" by simp
   then have "f0 dvd coeff p i" for i by (simp add: const_poly_dvd_iff)
   with primitiveD[OF pr] dvd_all_coeffs_iff have "f0 dvd 1" by (auto simp: coeffs_def)
   with f0 irr show False by auto
 qed
 
 lemma coprime_poly_x_minus_y_poly_lift:
   fixes p q :: "'a :: ufd poly"
   assumes degp: "degree p > 0" and degq: "degree q > 0"
     and pr: "primitive p"
   shows "coprime (poly_x_minus_y p) (poly_lift q)"
 proof(rule ccontr)
   from degp have p: "\<not> p dvd 1" by (auto simp: dvd_const)
   from degp have p0: "p \<noteq> 0" by auto
   from mset_factors_exist[of p, OF p0 p]
   obtain F where F: "mset_factors F p" by auto
   with poly_x_minus_y_hom.hom_mset_factors
   have pF: "mset_factors (image_mset poly_x_minus_y F) (poly_x_minus_y p)" by auto
 
   from degq have q: "\<not> q dvd 1" by (auto simp: dvd_const)
   from degq have q0: "q \<noteq> 0" by auto
   from mset_factors_exist[OF q0 q]
   obtain G where G: "mset_factors G q" by auto
   with poly_lift_hom.hom_mset_factors
   have pG: "mset_factors (image_mset poly_lift G) (poly_lift q)" by auto
 
   assume "\<not> coprime (poly_x_minus_y p) (poly_lift q)"
   from this[unfolded not_coprime_iff_common_factor]
   obtain r
   where rp: "r dvd (poly_x_minus_y p)"
     and rq: "r dvd (poly_lift q)"
     and rU: "\<not> r dvd 1" by auto note poly_lift_hom.hom_dvd
   from rp p0 have r0: "r \<noteq> 0" by auto
   from mset_factors_exist[OF r0 rU]
   obtain H where H: "mset_factors H r" by auto
   then have "H \<noteq> {#}" by auto
   then obtain h where hH: "h \<in># H" by fastforce
   with H mset_factors_imp_dvd have hr: "h dvd r" and h: "irreducible h" by auto
   from irreducible_not_unit[OF h] have hU: "\<not> h dvd 1" by auto
   from hr rp have "h dvd (poly_x_minus_y p)" by (rule dvd_trans)
   from irreducible_dvd_imp_factor[OF this h pF] p0
   obtain f where f: "f \<in># F" and fh: "poly_x_minus_y f ddvd h" by auto
   from hr rq have "h dvd (poly_lift q)" by (rule dvd_trans)
   from irreducible_dvd_imp_factor[OF this h pG] q0
   obtain g where g: "g \<in># G" and gh: "poly_lift g ddvd h" by auto
   from fh gh have "poly_x_minus_y f ddvd poly_lift g" using ddvd_trans by auto
   then have "poly_y_x (poly_x_minus_y f) ddvd poly_y_x (poly_lift g)" by simp
   also have "poly_y_x (poly_lift g) = [:g:]" unfolding poly_y_x_poly_lift monom_0 by auto
   finally have ddvd: "poly_y_x (poly_x_minus_y f) ddvd [:g:]" by auto
   then have "degree (poly_y_x (poly_x_minus_y f)) = 0" by (metis degree_pCons_0 dvd_0_left_iff dvd_const)
   then have "degree f = 0" by simp
   with primitive_imp_no_constant_factor[OF pr F f] show False by auto
 qed
 
 lemma poly_add_nonzero:
   fixes p q :: "'a :: ufd poly"
   assumes p0: "p \<noteq> 0" and q0: "q \<noteq> 0" and x: "poly p x = 0" and y: "poly q y = 0"
       and pr: "primitive p"
   shows "poly_add p q \<noteq> 0"
 proof
   have degp: "degree p > 0" using le_0_eq order_degree order_root p0 x by (metis gr0I)
   have degq: "degree q > 0" using le_0_eq order_degree order_root q0 y by (metis gr0I)
   assume 0: "poly_add p q = 0"
   from resultant_zero_imp_common_factor[OF _ this[unfolded poly_add_def]] degp
    and coprime_poly_x_minus_y_poly_lift[OF degp degq pr]
   show False by auto
 qed
 
 
 subsubsection \<open>Summary for addition\<close>
 
 text \<open>Now we lift the results to one that uses @{const ipoly}, by showing some homomorphism lemmas.\<close>
 
 lemma (in comm_ring_hom) map_poly_x_minus_y:
   "map_poly (map_poly hom) (poly_x_minus_y p) = poly_x_minus_y (map_poly hom p)"
 proof-
   interpret mp: map_poly_comm_ring_hom hom..
   interpret mmp: map_poly_comm_ring_hom "map_poly hom"..
   show ?thesis
     apply (induct p, simp)
     apply(unfold x_y_def hom_distribs poly_x_minus_y_pCons, simp) done
 qed
 
 lemma (in comm_ring_hom) hom_poly_lift[simp]:
   "map_poly (map_poly hom) (poly_lift q) = poly_lift (map_poly hom q)"
 proof -
   show ?thesis
     unfolding poly_lift_def
     unfolding map_poly_map_poly[of coeff_lift,OF coeff_lift_hom.hom_zero]
     unfolding map_poly_coeff_lift_hom by simp
 qed
 
 
 lemma lead_coeff_poly_x_minus_y:
   fixes p :: "'a::idom poly"
   shows "lead_coeff (poly_x_minus_y p) = [:lead_coeff p * ((- 1) ^ degree p):]" (is "?l = ?r")
 proof-
   have "?l = Polynomial.smult (lead_coeff p) ((- 1) ^ degree p)"
     by (unfold poly_x_minus_y_def, subst lead_coeff_comp; simp add: x_y_def)
   also have "... = ?r" by (unfold hom_distribs, simp add: smult_as_map_poly[symmetric])
   finally show ?thesis.
 qed
 
 lemma degree_coeff_poly_x_minus_y:
   fixes p q :: "'a :: {idom, semiring_char_0} poly"
   shows "degree (coeff (poly_x_minus_y p) i) = degree p - i"
 proof -
   consider "i = degree p" | "i > degree p" | "i < degree p"
     by force
   thus ?thesis
   proof cases
     assume "i > degree p"
     thus ?thesis by (subst coeff_eq_0) auto
   next
     assume "i = degree p"
     thus ?thesis using lead_coeff_poly_x_minus_y[of p]
       by (simp add: lead_coeff_poly_x_minus_y)
   next
     assume "i < degree p"
     define n where "n = degree p"
     have "degree (coeff (poly_x_minus_y p) i) =
             degree (\<Sum>j\<le>n. [:coeff p j:] * coeff (x_y ^ j) i)" (is "_ = degree (sum ?f _)")
       by (simp add: poly_x_minus_y_def pcompose_conv_poly poly_altdef coeff_sum n_def)
     also have "{..n} = insert n {..<n}"
       by auto
     also have "sum ?f \<dots> = ?f n + sum ?f {..<n}"
       by (subst sum.insert) auto
     also have "degree \<dots> = n - i"
     proof -
       have "degree (?f n) = n - i"
         using \<open>i < degree p\<close> by (simp add: n_def coeff_xy_power degree_monom_eq)
       moreover have "degree (sum ?f {..<n}) < n - i"
       proof (intro degree_sum_smaller)
         fix j assume "j \<in> {..<n}"
         have "degree ([:coeff p j:] * coeff (x_y ^ j) i) \<le> j - i"
         proof (cases "i \<le> j")
           case True
           thus ?thesis
             by (auto simp: n_def coeff_xy_power degree_monom_eq)
         next
           case False
           hence "coeff (x_y ^ j :: 'a poly poly) i = 0"
             by (subst coeff_eq_0) (auto simp: degree_power_eq)
           thus ?thesis by simp
         qed
         also have "\<dots> < n - i"
           using \<open>j \<in> {..<n}\<close> \<open>i < degree p\<close> by (auto simp: n_def)
         finally show "degree ([:coeff p j:] * coeff (x_y ^ j) i) < n - i" .
       qed (use \<open>i < degree p\<close> in \<open>auto simp: n_def\<close>)
       ultimately show ?thesis
         by (subst degree_add_eq_left) auto
     qed
     finally show ?thesis
       by (simp add: n_def)
   qed
 qed
 
 lemma coeff_0_poly_x_minus_y [simp]: "coeff (poly_x_minus_y p) 0 = p"
   by (induction p) (auto simp: poly_x_minus_y_def x_y_def)
 
 lemma (in idom_hom) poly_add_hom:
   assumes p0: "hom (lead_coeff p) \<noteq> 0" and q0: "hom (lead_coeff q) \<noteq> 0"
   shows "map_poly hom (poly_add p q) = poly_add (map_poly hom p) (map_poly hom q)"
 proof -
   interpret mh: map_poly_idom_hom..
   show ?thesis unfolding poly_add_def
     apply (subst mh.resultant_map_poly(1)[symmetric])
        apply (subst degree_map_poly_2)
        apply (unfold lead_coeff_poly_x_minus_y, unfold hom_distribs, simp add: p0)
       apply simp
      apply (subst degree_map_poly_2)
       apply (simp_all add: q0 map_poly_x_minus_y)
     done
 qed
 
 lemma(in zero_hom) hom_lead_coeff_nonzero_imp_map_poly_hom:
   assumes "hom (lead_coeff p) \<noteq> 0"
   shows "map_poly hom p \<noteq> 0"
 proof
   assume "map_poly hom p = 0"
   then have "coeff (map_poly hom p) (degree p) = 0" by simp
   with assms show False by simp
 qed
 
 lemma ipoly_poly_add:
   fixes x y :: "'a :: idom"
   assumes p0: "(of_int (lead_coeff p) :: 'a) \<noteq> 0" and q0: "(of_int (lead_coeff q) :: 'a) \<noteq> 0"
       and x: "ipoly p x = 0" and y: "ipoly q y = 0"
   shows "ipoly (poly_add p q) (x+y) = 0"
   using assms of_int_hom.hom_lead_coeff_nonzero_imp_map_poly_hom[OF q0]
   by (auto intro: poly_add simp: of_int_hom.poly_add_hom[OF p0 q0])
 
 lemma (in comm_monoid_gcd) gcd_list_eq_0_iff[simp]: "listgcd xs = 0 \<longleftrightarrow> (\<forall>x \<in> set xs. x = 0)"
   by (induct xs, auto)
 
 lemma primitive_field_poly[simp]: "primitive (p :: 'a :: field poly) \<longleftrightarrow> p \<noteq> 0"
   by (unfold primitive_iff_some_content_dvd_1,auto simp: dvd_field_iff coeffs_def)
 
 lemma ipoly_poly_add_nonzero:
   fixes x y :: "'a :: field"
   assumes "p \<noteq> 0" and "q \<noteq> 0" and "ipoly p x = 0" and "ipoly q y = 0"
       and "(of_int (lead_coeff p) :: 'a) \<noteq> 0" and "(of_int (lead_coeff q) :: 'a) \<noteq> 0"
   shows "poly_add p q \<noteq> 0"
 proof-
   from assms have "(of_int_poly (poly_add p q) :: 'a poly) \<noteq> 0"
     apply (subst of_int_hom.poly_add_hom,simp,simp)
     by (rule poly_add_nonzero, auto dest:of_int_hom.hom_lead_coeff_nonzero_imp_map_poly_hom)
   then show ?thesis by auto
 qed
 
 lemma represents_add:
   assumes x: "p represents x" and y: "q represents y"
   shows "(poly_add p q) represents (x + y)"
   using assms by (intro representsI ipoly_poly_add ipoly_poly_add_nonzero, auto)
 
 subsection \<open>Division of Algebraic Numbers\<close>
 
 definition poly_x_mult_y where
   [code del]: "poly_x_mult_y p \<equiv> (\<Sum> i \<le> degree p. monom (monom (coeff p i) i) i)"
 
 lemma coeff_poly_x_mult_y:
   shows "coeff (poly_x_mult_y p) i = monom (coeff p i) i" (is "?l = ?r")
 proof(cases "degree p < i")
   case i: False
   have "?l = sum (\<lambda>j. if j = i then (monom (coeff p j) j) else 0) {..degree p}"
    (is "_ = sum ?f ?A") by (simp add: poly_x_mult_y_def coeff_sum)
   also have "... = sum ?f {i}" using i by (intro sum.mono_neutral_right, auto)
   also have "... = ?f i" by simp
   also have "... = ?r" by auto
   finally show ?thesis.
 next
   case True then show ?thesis by (auto simp: poly_x_mult_y_def coeff_eq_0 coeff_sum)
 qed
 
 lemma poly_x_mult_y_code[code]: "poly_x_mult_y p = (let cs = coeffs p
   in poly_of_list (map (\<lambda> (i, ai). monom ai i) (zip [0 ..< length cs] cs)))" 
   unfolding Let_def poly_of_list_def 
 proof (rule poly_eqI, unfold coeff_poly_x_mult_y)
   fix n
   let ?xs = "zip [0..<length (coeffs p)] (coeffs p)" 
   let ?f = "(\<lambda>(i, ai). monom ai i)" 
   show "monom (coeff p n) n = coeff (Poly (map ?f ?xs)) n" 
   proof (cases "n < length (coeffs p)")
     case True
     hence n: "n < length (map ?f ?xs)" and nn: "n < length ?xs" 
       unfolding degree_eq_length_coeffs by auto
     show ?thesis unfolding coeff_Poly nth_default_nth[OF n] nth_map[OF nn]
       using True by (simp add: nth_coeffs_coeff)
   next
     case False
     hence id: "coeff (Poly (map ?f ?xs)) n = 0" unfolding coeff_Poly
       by (subst nth_default_beyond, auto)
     from False have "n > degree p \<or> p = 0" unfolding degree_eq_length_coeffs by (cases n, auto)
     hence "monom (coeff p n) n = 0" using coeff_eq_0[of p n] by auto
     thus ?thesis unfolding id by simp
   qed
 qed
 
 definition poly_div :: "'a :: comm_ring_1 poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly" where
   "poly_div p q = resultant (poly_x_mult_y p) (poly_lift q)"
 
 text \<open>@{const poly_div} has desired roots.\<close>
 
 lemma poly2_poly_x_mult_y:
   fixes p :: "'a :: comm_ring_1 poly"
   shows "poly2 (poly_x_mult_y p) x y = poly p (x * y)"
   apply (subst(3) poly_as_sum_of_monoms[symmetric])
   apply (unfold poly_x_mult_y_def hom_distribs)
   by (auto simp: poly2_monom poly_monom power_mult_distrib ac_simps)
 
 lemma poly_div:
   fixes p q :: "'a ::field poly"
   assumes q0: "q \<noteq> 0" and x: "poly p x = 0" and y: "poly q y = 0" and y0: "y \<noteq> 0"
   shows "poly (poly_div p q) (x/y) = 0"
 proof (unfold poly_div_def, rule poly_resultant_zero[OF disjI2])
   have "degree q > 0" using poly_zero q0 y by auto
   thus degq: "degree (poly_lift q) > 0" by auto
 qed (insert x y y0, simp_all add: poly2_poly_x_mult_y)
 
 
 text \<open>@{const poly_div} is nonzero.\<close>
 
 interpretation poly_x_mult_y_hom: ring_hom "poly_x_mult_y :: 'a :: {idom,ring_char_0} poly \<Rightarrow> _"
   by (unfold_locales, auto intro: poly2_ext simp: poly2_poly_x_mult_y hom_distribs)
 
 interpretation poly_x_mult_y_hom: inj_ring_hom "poly_x_mult_y :: 'a :: {idom,ring_char_0} poly \<Rightarrow> _"
 proof
   let ?h = poly_x_mult_y
   fix f :: "'a poly"
   assume "?h f = 0"
   then have "poly2 (?h f) x 1 = 0" for x by simp
   from this[unfolded poly2_poly_x_mult_y]
   show "f = 0" by auto
 qed
 
 lemma degree_poly_x_mult_y[simp]:
   fixes p :: "'a :: {idom, ring_char_0} poly"
   shows "degree (poly_x_mult_y p) = degree p" (is "?l = ?r")
 proof(rule antisym)
   show "?r \<le> ?l" by (cases "p=0", auto intro: le_degree simp: coeff_poly_x_mult_y)
   show "?l \<le> ?r" unfolding poly_x_mult_y_def
     by (auto intro: degree_sum_le le_trans[OF degree_monom_le])
 qed
 
 interpretation poly_x_mult_y_hom: unit_preserving_hom "poly_x_mult_y :: 'a :: field_char_0 poly \<Rightarrow> _"
 proof(unfold_locales)
   let ?h = "poly_x_mult_y :: 'a poly \<Rightarrow> _"
   fix f :: "'a poly"
   assume unit: "?h f dvd 1"
   then have "degree (?h f) = 0" and "coeff (?h f) 0 dvd 1" unfolding poly_dvd_1 by auto
   then have deg: "degree f = 0" by (auto simp add: degree_monom_eq)
   with unit show "f dvd 1" by(cases "f = 0", auto)
 qed
 
 lemmas poly_y_x_o_poly_lift = o_def[of poly_y_x poly_lift, unfolded poly_y_x_poly_lift]
 
 lemma irreducible_dvd_degree: assumes "(f::'a::field poly) dvd g"
  "irreducible g"
  "degree f > 0"
  shows "degree f = degree g"
   using assms
  by (metis irreducible_altdef degree_0 dvd_refl is_unit_field_poly linorder_neqE_nat poly_divides_conv0)
 
 lemma coprime_poly_x_mult_y_poly_lift:
   fixes p q :: "'a :: field_char_0 poly"
   assumes degp: "degree p > 0" and degq: "degree q > 0"
     and nz: "poly p 0 \<noteq> 0 \<or> poly q 0 \<noteq> 0" 
   shows "coprime (poly_x_mult_y p) (poly_lift q)"
 proof(rule ccontr)
   from degp have p: "\<not> p dvd 1" by (auto simp: dvd_const)
   from degp have p0: "p \<noteq> 0" by auto
   from mset_factors_exist[of p, OF p0 p]
   obtain F where F: "mset_factors F p" by auto
   then have pF: "prod_mset (image_mset poly_x_mult_y F) = poly_x_mult_y p"
     by (auto simp: hom_distribs)
 
   from degq have q: "\<not> is_unit q" by (auto simp: dvd_const)
   from degq have q0: "q \<noteq> 0" by auto
   from mset_factors_exist[OF q0 q]
   obtain G where G: "mset_factors G q" by auto
   with poly_lift_hom.hom_mset_factors
   have pG: "mset_factors (image_mset poly_lift G) (poly_lift q)" by auto
   from poly_y_x_hom.hom_mset_factors[OF this]
   have pG: "mset_factors (image_mset coeff_lift G) [:q:]"
     by (auto simp: poly_y_x_poly_lift monom_0 image_mset.compositionality poly_y_x_o_poly_lift)
 
   assume "\<not> coprime (poly_x_mult_y p) (poly_lift q)"
   then have "\<not> coprime (poly_y_x (poly_x_mult_y p)) (poly_y_x (poly_lift q))"
     by (simp del: coprime_iff_coprime)
   from this[unfolded not_coprime_iff_common_factor]
   obtain r
   where rp: "r dvd poly_y_x (poly_x_mult_y p)"
     and rq: "r dvd poly_y_x (poly_lift q)"
     and rU: "\<not> r dvd 1" by auto
   from rp p0 have r0: "r \<noteq> 0" by auto
   from mset_factors_exist[OF r0 rU]
   obtain H where H: "mset_factors H r" by auto
   then have "H \<noteq> {#}" by auto
   then obtain h where hH: "h \<in># H" by fastforce
   with H mset_factors_imp_dvd have hr: "h dvd r" and h: "irreducible h" by auto
   from irreducible_not_unit[OF h] have hU: "\<not> h dvd 1" by auto
   from hr rp have "h dvd poly_y_x (poly_x_mult_y p)" by (rule dvd_trans)
   note this[folded pF,unfolded poly_y_x_hom.hom_prod_mset image_mset.compositionality]
   from prime_elem_dvd_prod_mset[OF h[folded prime_elem_iff_irreducible] this]
   obtain f where f: "f \<in># F" and hf: "h dvd poly_y_x (poly_x_mult_y f)" by auto
   have irrF: "irreducible f" using f F by blast
     from dvd_trans[OF hr rq] have "h dvd [:q:]" by (simp add: poly_y_x_poly_lift monom_0)
     from irreducible_dvd_imp_factor[OF this h pG] q0
     obtain g where g: "g \<in># G" and gh: "[:g:] dvd h" by auto
     from dvd_trans[OF gh hf] have *: "[:g:] dvd poly_y_x (poly_x_mult_y f)" using dvd_trans by auto
   show False
   proof (cases "poly f 0 = 0")
     case f_0: False
     from poly_hom.hom_dvd[OF *]
     have "g dvd poly (poly_y_x (poly_x_mult_y f)) [:0:]" by simp
     also have "... = [:poly f 0:]" by (intro poly_ext, fold poly2_def, simp add: poly2_poly_x_mult_y)
     also have "... dvd 1" using f_0 by auto
     finally have "g dvd 1".
     with g G show False by (auto elim!: mset_factorsE dest!: irreducible_not_unit)
   next
     case True
     hence "[:0,1:] dvd f" by (unfold dvd_iff_poly_eq_0, simp)
     from irreducible_dvd_degree[OF this irrF]
     have "degree f = 1" by auto
     from degree1_coeffs[OF this] True obtain c where c: "c \<noteq> 0" and f: "f = [:0,c:]" by auto
     from g G have irrG: "irreducible g" by auto
     from poly_hom.hom_dvd[OF *]
     have "g dvd poly (poly_y_x (poly_x_mult_y f)) 1" by simp
     also have "\<dots> = f" by (auto simp: f poly_x_mult_y_code Let_def c poly_y_x_pCons map_poly_monom poly_monom poly_lift_def)
     also have "\<dots> dvd [:0,1:]" unfolding f dvd_def using c 
       by (intro exI[of _ "[: inverse c :]"], auto)
     finally have g01: "g dvd [:0,1:]" .
     from divides_degree[OF this] irrG have "degree g = 1" by auto
     from degree1_coeffs[OF this] obtain a b where g: "g = [:b,a:]" and a: "a \<noteq> 0" by auto
     from g01[unfolded dvd_def] g obtain k where id: "[:0,1:] = g * k" by auto
     from id have 0: "g \<noteq> 0" "k \<noteq> 0" by auto
     from arg_cong[OF id, of degree] have "degree k = 0" unfolding degree_mult_eq[OF 0] 
       unfolding g using a by auto
     from degree0_coeffs[OF this] obtain kk where k: "k = [:kk:]" by auto
     from id[unfolded g k] a have "b = 0" by auto
     hence "poly g 0 = 0" by (auto simp: g)
     from True this nz \<open>f \<in># F\<close> \<open>g \<in># G\<close> F G
     show False by (auto dest!:mset_factors_imp_dvd elim:dvdE)
   qed
 qed
 
 lemma poly_div_nonzero:
   fixes p q :: "'a :: field_char_0 poly"
   assumes p0: "p \<noteq> 0" and q0: "q \<noteq> 0" and x: "poly p x = 0" and y: "poly q y = 0"
       and p_0: "poly p 0 \<noteq> 0 \<or> poly q 0 \<noteq> 0"
   shows "poly_div p q \<noteq> 0"
 proof
   have degp: "degree p > 0" using le_0_eq order_degree order_root p0 x by (metis gr0I)
   have degq: "degree q > 0" using le_0_eq order_degree order_root q0 y by (metis gr0I)
   assume 0: "poly_div p q = 0"
   from resultant_zero_imp_common_factor[OF _ this[unfolded poly_div_def]] degp
    and coprime_poly_x_mult_y_poly_lift[OF degp degq] p_0
   show False by auto
 qed
 
 subsubsection \<open>Summary for division\<close>
 
 text \<open>Now we lift the results to one that uses @{const ipoly}, by showing some homomorphism lemmas.\<close>
 
 lemma (in inj_comm_ring_hom) poly_x_mult_y_hom:
   "poly_x_mult_y (map_poly hom p) = map_poly (map_poly hom) (poly_x_mult_y p)"
 proof -
   interpret mh: map_poly_inj_comm_ring_hom..
   interpret mmh: map_poly_inj_comm_ring_hom "map_poly hom"..
   show ?thesis unfolding poly_x_mult_y_def by (simp add: hom_distribs)
 qed
 
 lemma (in inj_comm_ring_hom) poly_div_hom:
   "map_poly hom (poly_div p q) = poly_div (map_poly hom p) (map_poly hom q)"
 proof -
   have zero: "\<forall>x. hom x = 0 \<longrightarrow> x = 0" by simp
   interpret mh: map_poly_inj_comm_ring_hom..
   show ?thesis unfolding poly_div_def mh.resultant_hom[symmetric]
     by (simp add: poly_x_mult_y_hom)
 qed
 
 lemma ipoly_poly_div:
   fixes x y :: "'a :: field_char_0"
   assumes "q \<noteq> 0" and "ipoly p x = 0" and "ipoly q y = 0" and "y \<noteq> 0"
   shows "ipoly (poly_div p q) (x/y) = 0"
   by (unfold of_int_hom.poly_div_hom, rule poly_div, insert assms, auto)
 
 lemma ipoly_poly_div_nonzero:
   fixes x y :: "'a :: field_char_0"
   assumes "p \<noteq> 0" and "q \<noteq> 0" and "ipoly p x = 0" and "ipoly q y = 0" and "poly p 0 \<noteq> 0 \<or> poly q 0 \<noteq> 0"
   shows "poly_div p q \<noteq> 0"
 proof-
   from assms have "(of_int_poly (poly_div p q) :: 'a poly) \<noteq> 0" using of_int_hom.poly_map_poly[of p]
     by (subst of_int_hom.poly_div_hom, subst poly_div_nonzero, auto) 
   then show ?thesis by auto
 qed
 
 lemma represents_div:
   fixes x y :: "'a :: field_char_0"
   assumes "p represents x" and "q represents y" and "poly q 0 \<noteq> 0"
   shows "(poly_div p q) represents (x / y)"
   using assms by (intro representsI ipoly_poly_div ipoly_poly_div_nonzero, auto)
 
 
 subsection \<open>Multiplication of Algebraic Numbers\<close>
 
 definition poly_mult where "poly_mult p q \<equiv> poly_div p (reflect_poly q)"
 
 lemma represents_mult:
   assumes px: "p represents x" and qy: "q represents y" and q_0: "poly q 0 \<noteq> 0" 
   shows "(poly_mult p q) represents (x * y)"
 proof-
   from q_0 qy have y0: "y \<noteq> 0" by auto
   from represents_inverse[OF y0 qy] y0 px q_0
   have "poly_mult p q represents x / (inverse y)"
     unfolding poly_mult_def by (intro represents_div, auto)
   with y0 show ?thesis by (simp add: field_simps)
 qed
 
 subsection \<open>Summary: Closure Properties of Algebraic Numbers\<close>
 
 lemma algebraic_representsI: "p represents x \<Longrightarrow> algebraic x"
   unfolding represents_def algebraic_altdef_ipoly by auto
 
 lemma algebraic_of_rat: "algebraic (of_rat x)"
   by (rule algebraic_representsI[OF poly_rat_represents_of_rat])
 
 lemma algebraic_uminus: "algebraic x \<Longrightarrow> algebraic (-x)"
   by (auto dest: algebraic_imp_represents_irreducible intro: algebraic_representsI represents_uminus)
 
 lemma algebraic_inverse: "algebraic x \<Longrightarrow> algebraic (inverse x)"
   using algebraic_of_rat[of 0]
   by (cases "x = 0", auto dest: algebraic_imp_represents_irreducible intro: algebraic_representsI represents_inverse)
 
 lemma algebraic_plus: "algebraic x \<Longrightarrow> algebraic y \<Longrightarrow> algebraic (x + y)"
   by (auto dest!: algebraic_imp_represents_irreducible_cf_pos intro!: algebraic_representsI[OF represents_add])
 
 lemma algebraic_div:
   assumes x: "algebraic x" and y: "algebraic y" shows "algebraic (x/y)"
 proof(cases "y = 0 \<or> x = 0")
   case True
   then show ?thesis using algebraic_of_rat[of 0] by auto
 next
   case False
   then have x0: "x \<noteq> 0" and y0: "y \<noteq> 0" by auto
   from x y obtain p q
   where px: "p represents x" and irr: "irreducible q" and qy: "q represents y"
     by (auto dest!: algebraic_imp_represents_irreducible)
   show ?thesis
     using False px represents_irr_non_0[OF irr qy]
     by (auto intro!: algebraic_representsI[OF represents_div] qy)
 qed
 
 lemma algebraic_times: "algebraic x \<Longrightarrow> algebraic y \<Longrightarrow> algebraic (x * y)"
   using algebraic_div[OF _ algebraic_inverse, of x y] by (simp add: field_simps)
 
 lemma algebraic_root: "algebraic x \<Longrightarrow> algebraic (root n x)"
 proof -
   assume "algebraic x"
   then obtain p where p: "p represents x" by (auto dest: algebraic_imp_represents_irreducible_cf_pos)
   from 
     algebraic_representsI[OF represents_nth_root_neg_real[OF _ this, of n]]
     algebraic_representsI[OF represents_nth_root_pos_real[OF _ this, of n]]
     algebraic_of_rat[of 0]
   show ?thesis by (cases "n = 0", force, cases "n > 0", force, cases "n < 0", auto)
 qed
 
 lemma algebraic_nth_root: "n \<noteq> 0 \<Longrightarrow> algebraic x \<Longrightarrow> y^n = x \<Longrightarrow> algebraic y"
   by (auto dest: algebraic_imp_represents_irreducible_cf_pos intro: algebraic_representsI represents_nth_root)
 
 
 subsection \<open>More on algebraic integers\<close>
 
 (* TODO: this is actually equal to @{term "(-1)^(m*n)"}, but we need a bit more theory on
    permutations to show this with a reasonable amount of effort. *)
 definition poly_add_sign :: "nat \<Rightarrow> nat \<Rightarrow> 'a :: comm_ring_1" where
   "poly_add_sign m n = signof (\<lambda>i. if i < n then m + i else if i < m + n then i - n else i)"
 
 lemma lead_coeff_poly_add:
   fixes p q :: "'a :: {idom, semiring_char_0} poly"
   defines "m \<equiv> degree p" and "n \<equiv> degree q"
   assumes "lead_coeff p = 1" "lead_coeff q = 1" "m > 0" "n > 0"
   shows "lead_coeff (poly_add p q :: 'a poly) = poly_add_sign m n"
 proof -
   from assms have [simp]: "p \<noteq> 0" "q \<noteq> 0"
     by auto
   define M where "M = sylvester_mat (poly_x_minus_y p) (poly_lift q)"
   define \<pi> :: "nat \<Rightarrow> nat" where
     "\<pi> = (\<lambda>i. if i < n then m + i else if i < m + n then i - n else i)"
   have \<pi>: "\<pi> permutes {0..<m+n}"
     by (rule inj_on_nat_permutes) (auto simp: \<pi>_def inj_on_def)
   have nz: "M $$ (i, \<pi> i) \<noteq> 0" if "i < m + n" for i
     using that by (auto simp: M_def \<pi>_def sylvester_index_mat m_def n_def)
 
 (*
   have "{(i,j). i \<in> {..<m+n} \<and> j \<in> {..<m+n} \<and> i < j \<and> \<pi> i > \<pi> j} =
         {..<n} \<times> {n..<m+n}" (is "?lhs = ?rhs")
   proof (intro equalityI subsetI)
     fix ij assume "ij \<in> ?lhs"
     thus "ij \<in> ?rhs"
       by (simp add: \<pi>_def split: prod.splits if_splits) auto
   qed (auto simp: \<pi>_def)
   hence "inversions_on {..<m+n} \<pi> = n * m"
     by (simp add: inversions_on_def)
   hence "signof \<pi> = (-1)^(m*n)"
     using \<pi> by (simp add: signof_def sign_def evenperm_iff_even_inversions)
 *)
 
   have indices_eq: "{0..<m+n} = {..<n} \<union> (+) n ` {..<m}"
     by (auto simp flip: atLeast0LessThan)
 
   define f where "f = (\<lambda> \<sigma>. signof \<sigma> * (\<Prod>i=0..<m+n. M $$ (i, \<sigma> i)))"
   have "degree (f \<pi>) = degree (\<Prod>i=0..<m + n. M $$ (i, \<pi> i))"
-    using nz by (auto simp: f_def degree_mult_eq signof_def)
+    using nz by (auto simp: f_def degree_mult_eq sign_def)
   also have "\<dots> = (\<Sum>i=0..<m+n. degree (M $$ (i, \<pi> i)))"
     using nz by (subst degree_prod_eq_sum_degree) auto
   also have "\<dots> = (\<Sum>i<n. degree (M $$ (i, \<pi> i))) + (\<Sum>i<m. degree (M $$ (n + i, \<pi> (n + i))))"
     by (subst indices_eq, subst sum.union_disjoint) (auto simp: sum.reindex)
   also have "(\<Sum>i<n. degree (M $$ (i, \<pi> i))) = (\<Sum>i<n. m)"
     by (intro sum.cong) (auto simp: M_def sylvester_index_mat \<pi>_def m_def n_def)
   also have "(\<Sum>i<m. degree (M $$ (n + i, \<pi> (n + i)))) = (\<Sum>i<m. 0)"
     by (intro sum.cong) (auto simp: M_def sylvester_index_mat \<pi>_def m_def n_def)
   finally have deg_f1: "degree (f \<pi>) = m * n"
     by simp
 
   have deg_f2: "degree (f \<sigma>) < m * n" if "\<sigma> permutes {0..<m+n}" "\<sigma> \<noteq> \<pi>" for \<sigma>
   proof (cases "\<exists>i\<in>{0..<m+n}. M $$ (i, \<sigma> i) = 0")
     case True
     hence *: "(\<Prod>i = 0..<m + n. M $$ (i, \<sigma> i)) = 0"
       by auto
     show ?thesis using \<open>m > 0\<close> \<open>n > 0\<close>
       by (simp add: f_def *)
   next
     case False
     note nz = this
     from that have \<sigma>_less: "\<sigma> i < m + n" if "i < m + n" for i
       using permutes_in_image[OF \<open>\<sigma> permutes _\<close>] that by auto
     have "degree (f \<sigma>) = degree (\<Prod>i=0..<m + n. M $$ (i, \<sigma> i))"
-      using nz by (auto simp: f_def degree_mult_eq signof_def)
+      using nz by (auto simp: f_def degree_mult_eq sign_def)
     also have "\<dots> = (\<Sum>i=0..<m+n. degree (M $$ (i, \<sigma> i)))"
       using nz by (subst degree_prod_eq_sum_degree) auto
     also have "\<dots> = (\<Sum>i<n. degree (M $$ (i, \<sigma> i))) + (\<Sum>i<m. degree (M $$ (n + i, \<sigma> (n + i))))"
       by (subst indices_eq, subst sum.union_disjoint) (auto simp: sum.reindex)
     also have "(\<Sum>i<m. degree (M $$ (n + i, \<sigma> (n + i)))) = (\<Sum>i<m. 0)"
       using \<sigma>_less by (intro sum.cong) (auto simp: M_def sylvester_index_mat \<pi>_def m_def n_def)
     also have "(\<Sum>i<n. degree (M $$ (i, \<sigma> i))) < (\<Sum>i<n. m)"
     proof (rule sum_strict_mono_ex1)
       show "\<forall>x\<in>{..<n}. degree (M $$ (x, \<sigma> x)) \<le> m" using \<sigma>_less
         by (auto simp: M_def sylvester_index_mat \<pi>_def m_def n_def degree_coeff_poly_x_minus_y)
     next
 
       have "\<exists>i<n. \<sigma> i \<noteq> \<pi> i"
       proof (rule ccontr)
         assume nex: "~(\<exists>i<n. \<sigma> i \<noteq> \<pi> i)"
         have "\<forall>i\<ge>m+n-k. \<sigma> i = \<pi> i" if "k \<le> m" for k
           using that
         proof (induction k)
           case 0
           thus ?case using \<open>\<pi> permutes _\<close> \<open>\<sigma> permutes _\<close>
             by (fastforce simp: permutes_def)
         next
           case (Suc k)
           have IH: "\<sigma> i = \<pi> i" if "i \<ge> m+n-k" for i
             using Suc.prems Suc.IH that by auto
           from nz have "M $$ (m + n - Suc k, \<sigma> (m + n - Suc k)) \<noteq> 0"
             using Suc.prems by auto
           moreover have "m + n - Suc k \<ge> n"
             using Suc.prems by auto
           ultimately have "\<sigma> (m+n-Suc k) \<ge> m-Suc k"
             using assms \<sigma>_less[of "m+n-Suc k"] Suc.prems
             by (auto simp: M_def sylvester_index_mat m_def n_def split: if_splits)
           have "\<not>(\<sigma> (m+n-Suc k) > m - Suc k)"
           proof
             assume *: "\<sigma> (m+n-Suc k) > m - Suc k"
             have less: "\<sigma> (m+n-Suc k) < m"
             proof (rule ccontr)
               assume *: "\<not>\<sigma> (m + n - Suc k) < m"
               define j where "j = \<sigma> (m + n - Suc k) - m"
               have "\<sigma> (m + n - Suc k) = m + j"
                 using * by (simp add: j_def)
               moreover {
                 have "j < n"
                   using \<sigma>_less[of "m+n-Suc k"] \<open>m > 0\<close> \<open>n > 0\<close> by (simp add: j_def)
                 hence "\<sigma> j = \<pi> j"
                   using nex by auto
                 with \<open>j < n\<close> have "\<sigma> j = m + j"
                   by (auto simp: \<pi>_def)
               }
               ultimately have "\<sigma> (m + n - Suc k) = \<sigma> j"
                 by simp
               hence "m + n - Suc k = j"
                 using permutes_inj[OF \<open>\<sigma> permutes _\<close>] unfolding inj_def by blast
               thus False using \<open>n \<le> m + n - Suc k\<close> \<sigma>_less[of "m+n-Suc k"] \<open>n > 0\<close> 
                 unfolding j_def by linarith
             qed
           
             define j where "j = \<sigma> (m+n-Suc k) - (m - Suc k)"
             from * have j: "\<sigma> (m+n-Suc k) = m - Suc k + j" "j > 0"
               by (auto simp: j_def)
             have "\<sigma> (m+n-Suc k + j) = \<pi> (m+n - Suc k + j)"
               using * by (intro IH) (auto simp: j_def)
             also {
               have "j < Suc k"
                 using less by (auto simp: j_def algebra_simps)
               hence "m + n - Suc k + j < m + n"
                 using \<open>m > 0\<close> \<open>n > 0\<close> Suc.prems by linarith
               hence "\<pi> (m +n - Suc k + j) = m - Suc k + j"
                 unfolding \<pi>_def using Suc.prems by (simp add: \<pi>_def)
             }
             finally have "\<sigma> (m + n - Suc k + j) = \<sigma> (m + n - Suc k)"
               using j by simp
             hence "m + n - Suc k + j = m + n - Suc k"
               using permutes_inj[OF \<open>\<sigma> permutes _\<close>] unfolding inj_def by blast
             thus False using \<open>j > 0\<close> by simp
           qed
           with \<open>\<sigma> (m+n-Suc k) \<ge> m-Suc k\<close> have eq: "\<sigma> (m+n-Suc k) = m - Suc k"
             by linarith
 
           show ?case
           proof safe
             fix i :: nat
             assume i: "i \<ge> m + n - Suc k"
             show "\<sigma> i = \<pi> i"
               using eq Suc.prems \<open>m > 0\<close> IH i
             proof (cases "i = m + n - Suc k")
               case True
               thus ?thesis using eq Suc.prems \<open>m > 0\<close>
                 by (auto simp: \<pi>_def)
             qed (use IH i in auto)
           qed
         qed
         from this[of m] and nex have "\<sigma> i = \<pi> i" for i
           by (cases "i \<ge> n") auto
         hence "\<sigma> = \<pi>" by force
         thus False using \<open>\<sigma> \<noteq> \<pi>\<close> by contradiction
       qed
 
       then obtain i where i: "i < n" "\<sigma> i \<noteq> \<pi> i"
         by auto
       have "\<sigma> i < m + n"
         using i by (intro \<sigma>_less) auto
       moreover have "\<pi> i = m + i"
         using i by (auto simp: \<pi>_def)
       ultimately have "degree (M $$ (i, \<sigma> i)) < m" using i \<open>m > 0\<close>
         by (auto simp: M_def m_def n_def sylvester_index_mat degree_coeff_poly_x_minus_y)
       thus "\<exists>i\<in>{..<n}. degree (M $$ (i, \<sigma> i)) < m"
         using i by blast
     qed auto
     finally show "degree (f \<sigma>) < m * n"
       by (simp add: mult_ac)
   qed
 
   have "lead_coeff (f \<pi>) = poly_add_sign m n"
   proof -
     have "lead_coeff (f \<pi>) = signof \<pi> * (\<Prod>i=0..<m + n. lead_coeff (M $$ (i, \<pi> i)))"
-      by (simp add: f_def signof_def lead_coeff_prod)
+      by (simp add: f_def sign_def lead_coeff_prod)
     also have "(\<Prod>i=0..<m + n. lead_coeff (M $$ (i, \<pi> i))) =
                (\<Prod>i<n. lead_coeff (M $$ (i, \<pi> i))) * (\<Prod>i<m. lead_coeff (M $$ (n + i, \<pi> (n + i))))"
       by (subst indices_eq, subst prod.union_disjoint) (auto simp: prod.reindex)
     also have "(\<Prod>i<n. lead_coeff (M $$ (i, \<pi> i))) = (\<Prod>i<n. lead_coeff p)"
       by (intro prod.cong) (auto simp: M_def m_def n_def \<pi>_def sylvester_index_mat)
     also have "(\<Prod>i<m. lead_coeff (M $$ (n + i, \<pi> (n + i)))) = (\<Prod>i<m. lead_coeff q)"
       by (intro prod.cong) (auto simp: M_def m_def n_def \<pi>_def sylvester_index_mat)
     also have "signof \<pi> = poly_add_sign m n"
       by (simp add: \<pi>_def poly_add_sign_def m_def n_def cong: if_cong)
     finally show ?thesis
       using assms by simp
   qed
 
   have "lead_coeff (poly_add p q) =
           lead_coeff (det (sylvester_mat (poly_x_minus_y p) (poly_lift q)))"
     by (simp add: poly_add_def resultant_def)
   also have "det (sylvester_mat (poly_x_minus_y p) (poly_lift q)) =
                (\<Sum>\<pi> | \<pi> permutes {0..<m+n}. f \<pi>)"
     by (simp add: det_def m_def n_def M_def f_def)
   also have "{\<pi>. \<pi> permutes {0..<m+n}} = insert \<pi> ({\<pi>. \<pi> permutes {0..<m+n}} - {\<pi>})"
     using \<pi> by auto
   also have "(\<Sum>\<sigma>\<in>\<dots>. f \<sigma>) = (\<Sum>\<sigma>\<in>{\<sigma>. \<sigma> permutes {0..<m+n}}-{\<pi>}. f \<sigma>) + f \<pi>"
     by (subst sum.insert) (auto simp: finite_permutations)
   also have "lead_coeff \<dots> = lead_coeff (f \<pi>)"
   proof -
     have "degree (\<Sum>\<sigma>\<in>{\<sigma>. \<sigma> permutes {0..<m+n}}-{\<pi>}. f \<sigma>) < m * n" using assms
       by (intro degree_sum_smaller deg_f2) (auto simp: m_def n_def finite_permutations)
     with deg_f1 show ?thesis
       by (subst lead_coeff_add_le) auto
   qed
   finally show ?thesis
     using \<open>lead_coeff (f \<pi>) = _\<close> by simp
 qed
 
 lemma lead_coeff_poly_mult:
   fixes p q :: "'a :: {idom, ring_char_0} poly"
   defines "m \<equiv> degree p" and "n \<equiv> degree q"
   assumes "lead_coeff p = 1" "lead_coeff q = 1" "m > 0" "n > 0"
   assumes "coeff q 0 \<noteq> 0"
   shows "lead_coeff (poly_mult p q :: 'a poly) = 1"
 proof -
   from assms have [simp]: "p \<noteq> 0" "q \<noteq> 0"
     by auto
   have [simp]: "degree (reflect_poly q) = n"
     using assms by (subst degree_reflect_poly_eq) (auto simp: n_def)
 
   define M where "M = sylvester_mat (poly_x_mult_y p) (poly_lift (reflect_poly q))"
   have nz: "M $$ (i, i) \<noteq> 0" if "i < m + n" for i
     using that by (auto simp: M_def sylvester_index_mat m_def n_def coeff_poly_x_mult_y)
 
   have indices_eq: "{0..<m+n} = {..<n} \<union> (+) n ` {..<m}"
     by (auto simp flip: atLeast0LessThan)
 
   define f where "f = (\<lambda> \<sigma>. signof \<sigma> * (\<Prod>i=0..<m+n. M $$ (i, \<sigma> i)))"
   have "degree (f id) = degree (\<Prod>i=0..<m + n. M $$ (i, i))"
-    using nz by (auto simp: f_def degree_mult_eq signof_def)
+    using nz by (auto simp: f_def degree_mult_eq sign_def)
   also have "\<dots> = (\<Sum>i=0..<m+n. degree (M $$ (i, i)))"
     using nz by (subst degree_prod_eq_sum_degree) auto
   also have "\<dots> = (\<Sum>i<n. degree (M $$ (i, i))) + (\<Sum>i<m. degree (M $$ (n + i, n + i)))"
     by (subst indices_eq, subst sum.union_disjoint) (auto simp: sum.reindex)
   also have "(\<Sum>i<n. degree (M $$ (i, i))) = (\<Sum>i<n. m)"
     by (intro sum.cong)
        (auto simp: M_def sylvester_index_mat m_def n_def coeff_poly_x_mult_y degree_monom_eq)
   also have "(\<Sum>i<m. degree (M $$ (n + i, n + i))) = (\<Sum>i<m. 0)"
     by (intro sum.cong) (auto simp: M_def sylvester_index_mat m_def n_def)
   finally have deg_f1: "degree (f id) = m * n"
     by (simp add: mult_ac id_def)
 
   have deg_f2: "degree (f \<sigma>) < m * n" if "\<sigma> permutes {0..<m+n}" "\<sigma> \<noteq> id" for \<sigma>
   proof (cases "\<exists>i\<in>{0..<m+n}. M $$ (i, \<sigma> i) = 0")
     case True
     hence *: "(\<Prod>i = 0..<m + n. M $$ (i, \<sigma> i)) = 0"
       by auto
     show ?thesis using \<open>m > 0\<close> \<open>n > 0\<close>
       by (simp add: f_def *)
   next
     case False
     note nz = this
     from that have \<sigma>_less: "\<sigma> i < m + n" if "i < m + n" for i
       using permutes_in_image[OF \<open>\<sigma> permutes _\<close>] that by auto
     have "degree (f \<sigma>) = degree (\<Prod>i=0..<m + n. M $$ (i, \<sigma> i))"
-      using nz by (auto simp: f_def degree_mult_eq signof_def)
+      using nz by (auto simp: f_def degree_mult_eq sign_def)
     also have "\<dots> = (\<Sum>i=0..<m+n. degree (M $$ (i, \<sigma> i)))"
       using nz by (subst degree_prod_eq_sum_degree) auto
     also have "\<dots> = (\<Sum>i<n. degree (M $$ (i, \<sigma> i))) + (\<Sum>i<m. degree (M $$ (n + i, \<sigma> (n + i))))"
       by (subst indices_eq, subst sum.union_disjoint) (auto simp: sum.reindex)
     also have "(\<Sum>i<m. degree (M $$ (n + i, \<sigma> (n + i)))) = (\<Sum>i<m. 0)"
       using \<sigma>_less by (intro sum.cong) (auto simp: M_def sylvester_index_mat m_def n_def)
     also have "(\<Sum>i<n. degree (M $$ (i, \<sigma> i))) < (\<Sum>i<n. m)"
     proof (rule sum_strict_mono_ex1)
       show "\<forall>x\<in>{..<n}. degree (M $$ (x, \<sigma> x)) \<le> m" using \<sigma>_less
         by (auto simp: M_def sylvester_index_mat m_def n_def degree_coeff_poly_x_minus_y coeff_poly_x_mult_y
                  intro: order.trans[OF degree_monom_le])
     next
       have "\<exists>i<n. \<sigma> i \<noteq> i"
       proof (rule ccontr)
         assume nex: "\<not>(\<exists>i<n. \<sigma> i \<noteq> i)"
         have "\<sigma> i = i" for i
           using that
         proof (induction i rule: less_induct)
           case (less i)
           consider "i < n" | "i \<in> {n..<m+n}" | "i \<ge> m + n"
             by force
           thus ?case
           proof cases
             assume "i < n"
             thus ?thesis using nex by auto
           next
             assume "i \<ge> m + n"
             thus ?thesis using \<open>\<sigma> permutes _\<close>
               by (auto simp: permutes_def)
           next
             assume i: "i \<in> {n..<m+n}"
             have IH: "\<sigma> j = j" if "j < i" for j
               using that less.prems by (intro less.IH) auto
 
             from nz have "M $$ (i, \<sigma> i) \<noteq> 0"
               using i by auto
             hence "\<sigma> i \<le> i"
               using i \<sigma>_less[of i] by (auto simp: M_def sylvester_index_mat m_def n_def)
             moreover have "\<sigma> i \<ge> i"
             proof (rule ccontr)
               assume *: "\<not>\<sigma> i \<ge> i"
               from * have "\<sigma> (\<sigma> i) = \<sigma> i"
                 by (subst IH) auto
               hence "\<sigma> i = i"
                 using permutes_inj[OF \<open>\<sigma> permutes _\<close>] unfolding inj_def by blast
               with * show False by simp
             qed
             ultimately show ?case by simp
           qed
         qed
         hence "\<sigma> = id"
           by force
         with \<open>\<sigma> \<noteq> id\<close> show False
           by contradiction
       qed
 
       then obtain i where i: "i < n" "\<sigma> i \<noteq> i"
         by auto
       have "\<sigma> i < m + n"
         using i by (intro \<sigma>_less) auto
       hence "degree (M $$ (i, \<sigma> i)) < m" using i \<open>m > 0\<close>
         by (auto simp: M_def m_def n_def sylvester_index_mat degree_coeff_poly_x_minus_y
                        coeff_poly_x_mult_y intro: le_less_trans[OF degree_monom_le])
       thus "\<exists>i\<in>{..<n}. degree (M $$ (i, \<sigma> i)) < m"
         using i by blast
     qed auto
     finally show "degree (f \<sigma>) < m * n"
       by (simp add: mult_ac)
   qed
 
   have "lead_coeff (f id) = 1"
   proof -
     have "lead_coeff (f id) = (\<Prod>i=0..<m + n. lead_coeff (M $$ (i, i)))"
-      by (simp add: f_def signof_def lead_coeff_prod sign_id)
+      by (simp add: f_def lead_coeff_prod)
     also have "(\<Prod>i=0..<m + n. lead_coeff (M $$ (i, i))) =
                (\<Prod>i<n. lead_coeff (M $$ (i, i))) * (\<Prod>i<m. lead_coeff (M $$ (n + i, n + i)))"
       by (subst indices_eq, subst prod.union_disjoint) (auto simp: prod.reindex)
     also have "(\<Prod>i<n. lead_coeff (M $$ (i, i))) = (\<Prod>i<n. lead_coeff p)" using assms
       by (intro prod.cong) (auto simp: M_def m_def n_def sylvester_index_mat
                                        coeff_poly_x_mult_y degree_monom_eq)
     also have "(\<Prod>i<m. lead_coeff (M $$ (n + i, n + i))) = (\<Prod>i<m. lead_coeff q)"
       by (intro prod.cong) (auto simp: M_def m_def n_def sylvester_index_mat)
     finally show ?thesis
       using assms by (simp add: id_def)
   qed
 
   have "lead_coeff (poly_mult p q) = lead_coeff (det M)"
     by (simp add: poly_mult_def resultant_def M_def poly_div_def)
   also have "det M = (\<Sum>\<pi> | \<pi> permutes {0..<m+n}. f \<pi>)"
     by (simp add: det_def m_def n_def M_def f_def)
   also have "{\<pi>. \<pi> permutes {0..<m+n}} = insert id ({\<pi>. \<pi> permutes {0..<m+n}} - {id})"
     by (auto simp: permutes_id)
   also have "(\<Sum>\<sigma>\<in>\<dots>. f \<sigma>) = (\<Sum>\<sigma>\<in>{\<sigma>. \<sigma> permutes {0..<m+n}}-{id}. f \<sigma>) + f id"
     by (subst sum.insert) (auto simp: finite_permutations)
   also have "lead_coeff \<dots> = lead_coeff (f id)"
   proof -
     have "degree (\<Sum>\<sigma>\<in>{\<sigma>. \<sigma> permutes {0..<m+n}}-{id}. f \<sigma>) < m * n" using assms
       by (intro degree_sum_smaller deg_f2) (auto simp: m_def n_def finite_permutations)
     with deg_f1 show ?thesis
       by (subst lead_coeff_add_le) auto
   qed
   finally show ?thesis
     using \<open>lead_coeff (f id) = 1\<close> by simp
 qed
 
 lemma algebraic_int_plus [intro]:
   fixes x y :: "'a :: field_char_0"
   assumes "algebraic_int x" "algebraic_int y"
   shows   "algebraic_int (x + y)"
 proof -
   from assms(1) obtain p where p: "lead_coeff p = 1" "ipoly p x = 0"
     by (auto simp: algebraic_int_altdef_ipoly)
   from assms(2) obtain q where q: "lead_coeff q = 1" "ipoly q y = 0"
     by (auto simp: algebraic_int_altdef_ipoly)
   have deg_pos: "degree p > 0" "degree q > 0"
     using p q by (auto intro!: Nat.gr0I elim!: degree_eq_zeroE)
   define r where "r = poly_add_sign (degree p) (degree q) * poly_add p q"
 
   have "lead_coeff r = 1" using p q deg_pos
-    by (simp add: r_def lead_coeff_mult poly_add_sign_def signof_def lead_coeff_poly_add)
+    by (simp add: r_def lead_coeff_mult poly_add_sign_def sign_def lead_coeff_poly_add)
   moreover have "ipoly r (x + y) = 0"
     using p q by (simp add: ipoly_poly_add r_def of_int_poly_hom.hom_mult)
   ultimately show ?thesis
     by (auto simp: algebraic_int_altdef_ipoly)
 qed
 
 lemma algebraic_int_times [intro]:
   fixes x y :: "'a :: field_char_0"
   assumes "algebraic_int x" "algebraic_int y"
   shows   "algebraic_int (x * y)"
 proof (cases "y = 0")
   case [simp]: False
   from assms(1) obtain p where p: "lead_coeff p = 1" "ipoly p x = 0"
     by (auto simp: algebraic_int_altdef_ipoly)
   from assms(2) obtain q where q: "lead_coeff q = 1" "ipoly q y = 0"
     by (auto simp: algebraic_int_altdef_ipoly)
   have deg_pos: "degree p > 0" "degree q > 0"
     using p q by (auto intro!: Nat.gr0I elim!: degree_eq_zeroE)
   have [simp]: "q \<noteq> 0"
     using q by auto
 
   define n where "n = Polynomial.order 0 q"
   have "monom 1 n dvd q"
     by (simp add: n_def monom_1_dvd_iff)
   then obtain q' where q_split: "q = q' * monom 1 n"
     by auto
   have "Polynomial.order 0 q = Polynomial.order 0 q' + n"
     using \<open>q \<noteq> 0\<close> unfolding q_split by (subst order_mult) auto
   hence "poly q' 0 \<noteq> 0"
     unfolding n_def using \<open>q \<noteq> 0\<close> by (simp add: q_split order_root)    
 
   have q': "ipoly q' y = 0" "lead_coeff q' = 1" using q_split q
     by (auto simp: of_int_poly_hom.hom_mult poly_monom lead_coeff_mult degree_monom_eq)
   from this have deg_pos': "degree q' > 0"
     by (intro Nat.gr0I) (auto elim!: degree_eq_zeroE)
   from \<open>poly q' 0 \<noteq> 0\<close> have [simp]: "coeff q' 0 \<noteq> 0"
     by (auto simp: monom_1_dvd_iff' poly_0_coeff_0)
 
   have "p represents x" "q' represents y"
     using p q' by (auto simp: represents_def)
   hence "poly_mult p q' represents x * y"
     by (rule represents_mult) (simp add: poly_0_coeff_0)
   moreover have "lead_coeff (poly_mult p q') = 1" using p deg_pos q' deg_pos'
     by (simp add: lead_coeff_mult lead_coeff_poly_mult)
   ultimately show ?thesis
     by (auto simp: algebraic_int_altdef_ipoly represents_def)
 qed auto
 
 lemma algebraic_int_power [intro]:
   "algebraic_int (x :: 'a :: field_char_0) \<Longrightarrow> algebraic_int (x ^ n)"
   by (induction n) auto
 
 lemma algebraic_int_diff [intro]:
   fixes x y :: "'a :: field_char_0"
   assumes "algebraic_int x" "algebraic_int y"
   shows   "algebraic_int (x - y)"
   using algebraic_int_plus[OF assms(1) algebraic_int_minus[OF assms(2)]] by simp
 
 lemma algebraic_int_sum [intro]:
   "(\<And>x. x \<in> A \<Longrightarrow> algebraic_int (f x :: 'a :: field_char_0))
     \<Longrightarrow> algebraic_int (sum f A)"
   by (induction A rule: infinite_finite_induct) auto
 
 lemma algebraic_int_prod [intro]:
   "(\<And>x. x \<in> A \<Longrightarrow> algebraic_int (f x :: 'a :: field_char_0))
     \<Longrightarrow> algebraic_int (prod f A)"
   by (induction A rule: infinite_finite_induct) auto
 
 lemma algebraic_int_nth_root_real_iff:
   "algebraic_int (root n x) \<longleftrightarrow> n = 0 \<or> algebraic_int x"
 proof -
   have "algebraic_int x" if "algebraic_int (root n x)" "n \<noteq> 0"
   proof -
     from that(1) have "algebraic_int (root n x ^ n)"
       by auto
     also have "root n x ^ n = (if even n then \<bar>x\<bar> else x)"
       using sgn_power_root[of n x] that(2) by (auto simp: sgn_if split: if_splits)
     finally show ?thesis
       by (auto split: if_splits)
   qed
   thus ?thesis by auto
 qed
 
 lemma algebraic_int_power_iff:
   "algebraic_int (x ^ n :: 'a :: field_char_0) \<longleftrightarrow> n = 0 \<or> algebraic_int x"
 proof -
   have "algebraic_int x" if "algebraic_int (x ^ n)" "n > 0"
   proof (rule algebraic_int_root)
     show "poly (monom 1 n) x = x ^ n"
       by (auto simp: poly_monom)
   qed (use that in \<open>auto simp: degree_monom_eq\<close>)
   thus ?thesis by auto
 qed
 
 lemma algebraic_int_power_iff' [simp]:
   "n > 0 \<Longrightarrow> algebraic_int (x ^ n :: 'a :: field_char_0) \<longleftrightarrow> algebraic_int x"
   by (subst algebraic_int_power_iff) auto
 
 lemma algebraic_int_sqrt_iff [simp]: "algebraic_int (sqrt x) \<longleftrightarrow> algebraic_int x"
   by (simp add: sqrt_def algebraic_int_nth_root_real_iff)
 
 lemma algebraic_int_csqrt_iff [simp]: "algebraic_int (csqrt x) \<longleftrightarrow> algebraic_int x"
 proof
   assume "algebraic_int (csqrt x)"
   hence "algebraic_int (csqrt x ^ 2)"
     by (rule algebraic_int_power)
   thus "algebraic_int x"
     by simp
 qed auto
 
 lemma algebraic_int_norm_complex [intro]:
   assumes "algebraic_int (z :: complex)"
   shows   "algebraic_int (norm z)"
 proof -
   from assms have "algebraic_int (z * cnj z)"
     by auto
   also have "z * cnj z = of_real (norm z ^ 2)"
     by (rule complex_norm_square [symmetric])
   finally show ?thesis
     by simp
 qed
 
 hide_const (open) x_y
 
 end
diff --git a/thys/Jordan_Normal_Form/Char_Poly.thy b/thys/Jordan_Normal_Form/Char_Poly.thy
--- a/thys/Jordan_Normal_Form/Char_Poly.thy
+++ b/thys/Jordan_Normal_Form/Char_Poly.thy
@@ -1,622 +1,624 @@
 (*  
     Author:      René Thiemann 
                  Akihisa Yamada
     License:     BSD
 *)
 section \<open>Characteristic Polynomial\<close>
 
 text \<open>We define eigenvalues, eigenvectors, and the characteristic polynomial. We further prove
   that the eigenvalues are exactly the roots of the characteristic polynomial.
   Finally, we apply the fundamental theorem of algebra to show that the characteristic polynomial
   of a complex matrix can always be represented as product of linear factors $x - a$.\<close>
  
 theory Char_Poly
 imports 
   Polynomial_Factorization.Fundamental_Theorem_Algebra_Factorized
   Polynomial_Interpolation.Missing_Polynomial
   Polynomial_Interpolation.Ring_Hom_Poly
   Determinant
   Complex_Main
 begin
 
 definition eigenvector :: "'a :: comm_ring_1 mat \<Rightarrow> 'a vec \<Rightarrow> 'a \<Rightarrow> bool" where
   "eigenvector A v k = (v \<in> carrier_vec (dim_row A) \<and> v \<noteq> 0\<^sub>v (dim_row A) \<and> A *\<^sub>v v = k \<cdot>\<^sub>v v)"
   
 lemma eigenvector_pow: assumes A: "A \<in> carrier_mat n n"
   and ev: "eigenvector A v (k :: 'a :: comm_ring_1)"
   shows "A ^\<^sub>m i *\<^sub>v v = k^i \<cdot>\<^sub>v v" 
 proof -
   let ?G = "monoid_vec TYPE ('a) n"
   from A have dim: "dim_row A = n" by auto
   from ev[unfolded eigenvector_def dim]
   have v: "v \<in> carrier_vec n" and Av: "A *\<^sub>v v = k \<cdot>\<^sub>v v" by auto
   interpret v: comm_group ?G by (rule comm_group_vec)
   show ?thesis
   proof (induct i)
     case 0
     show ?case using v dim by simp
   next
     case (Suc i)
     define P where "P = A ^\<^sub>m i"
     have P: "P \<in> carrier_mat n n" using A unfolding P_def by simp
     have "A ^\<^sub>m Suc i = P * A" unfolding P_def by simp
     also have "\<dots> *\<^sub>v v = P *\<^sub>v (A *\<^sub>v v)" using P A v by simp
     also have "A *\<^sub>v v = k \<cdot>\<^sub>v v" by (rule Av)
     also have "P *\<^sub>v (k \<cdot>\<^sub>v v) = k \<cdot>\<^sub>v (P *\<^sub>v v)" 
       by (rule eq_vecI, insert v P, auto)
     also have "(P *\<^sub>v v) = (k ^ i) \<cdot>\<^sub>v v" unfolding P_def by (rule Suc)
     also have "k \<cdot>\<^sub>v ((k ^ i) \<cdot>\<^sub>v v) = (k * k ^ i) \<cdot>\<^sub>v v"
       by (rule eq_vecI, insert v, auto)
     also have "k * k ^ i = k ^ (Suc i)" by auto
     finally show ?case .
   qed
 qed
     
 
 
 definition eigenvalue :: "'a :: comm_ring_1 mat \<Rightarrow> 'a \<Rightarrow> bool" where
   "eigenvalue A k = (\<exists> v. eigenvector A v k)"
 
 
 definition char_matrix :: "'a :: field mat \<Rightarrow> 'a \<Rightarrow> 'a mat" where
   "char_matrix A e = A + ((-e) \<cdot>\<^sub>m (1\<^sub>m (dim_row A)))"
 
 lemma char_matrix_closed[simp]: "A \<in> carrier_mat n n \<Longrightarrow> char_matrix A e \<in> carrier_mat n n"
   unfolding char_matrix_def by auto
 
 lemma eigenvector_char_matrix: assumes A: "(A :: 'a :: field mat) \<in> carrier_mat n n" 
   shows "eigenvector A v e = (v \<in> carrier_vec n \<and> v \<noteq> 0\<^sub>v n \<and> char_matrix A e *\<^sub>v v = 0\<^sub>v n)"
 proof -
   from A have dim: "dim_row A = n" "dim_col A = n" by auto
   {
     assume v: "v \<in> carrier_vec n"
     hence dimv: "dim_vec v = n" by auto
     have "(A *\<^sub>v v = e \<cdot>\<^sub>v v) = (A *\<^sub>v v + (-e) \<cdot>\<^sub>v v = 0\<^sub>v n)" (is "?id1 = ?id2")
     proof
       assume ?id1
       from arg_cong[OF this, of "\<lambda> w. w + (-e) \<cdot>\<^sub>v v"]
       show ?id2 using A v by auto
     next
       assume ?id2
       have "A *\<^sub>v v + - e \<cdot>\<^sub>v v + e \<cdot>\<^sub>v v = A *\<^sub>v v" using A v by auto
       from arg_cong[OF \<open>?id2\<close>, of "\<lambda> w. w + e \<cdot>\<^sub>v v", unfolded this]
       show ?id1 using A v by simp
     qed
     also have "(A *\<^sub>v v + (-e) \<cdot>\<^sub>v v) = char_matrix A e *\<^sub>v v" unfolding char_matrix_def
       by (rule eq_vecI, insert v A dim, auto simp: add_scalar_prod_distrib[of _ n])
     finally have "(A *\<^sub>v v = e \<cdot>\<^sub>v v) = (char_matrix A e *\<^sub>v v = 0\<^sub>v n)" .
   }
   thus ?thesis unfolding eigenvector_def dim by blast
 qed
 
 lemma eigenvalue_char_matrix: assumes A: "(A :: 'a :: field mat) \<in> carrier_mat n n" 
   shows "eigenvalue A e = (\<exists> v. v \<in> carrier_vec n \<and> v \<noteq> 0\<^sub>v n \<and> char_matrix A e *\<^sub>v v = 0\<^sub>v n)"
   unfolding eigenvalue_def eigenvector_char_matrix[OF A] .. 
 
 definition find_eigenvector :: "'a::field mat \<Rightarrow> 'a \<Rightarrow> 'a vec" where
   "find_eigenvector A e = 
     find_base_vector (fst (gauss_jordan (char_matrix A e) (0\<^sub>m (dim_row A) 0)))"
 
 lemma find_eigenvector: assumes A: "A \<in> carrier_mat n n"
   and ev: "eigenvalue A e"
   shows "eigenvector A (find_eigenvector A e) e"
 proof -
   define B where "B = char_matrix A e"
   from ev[unfolded eigenvalue_char_matrix[OF A]]  obtain v where
     v: "v \<in> carrier_vec n" "v \<noteq> 0\<^sub>v n" and Bv: "B *\<^sub>v v = 0\<^sub>v n" unfolding B_def by auto
   have B: "B \<in> carrier_mat n n" using A unfolding B_def by simp
   let ?z = "0\<^sub>m (dim_row A) 0"
   obtain C D where gauss: "gauss_jordan B ?z = (C,D)" by force
   define w where "w = find_base_vector C"
   have res: "find_eigenvector A e = w" unfolding w_def find_eigenvector_def Let_def gauss B_def[symmetric]
     by simp
   have "?z \<in> carrier_mat n 0" using A by auto
   note gauss_0 = gauss_jordan[OF B this gauss] 
   hence C: "C \<in> carrier_mat n n" by auto
   from gauss_0(1)[OF v(1)] Bv have Cv: "C *\<^sub>v v = 0\<^sub>v n" by auto
   {
     assume C: "C = 1\<^sub>m n"
     have False using id Cv v unfolding C by auto
   }
   hence C1: "C \<noteq> 1\<^sub>m n" by auto
   from find_base_vector_not_1[OF gauss_jordan_row_echelon[OF B gauss] C C1]
   have w: "w \<in> carrier_vec n" "w \<noteq> 0\<^sub>v n" and id: "C *\<^sub>v w = 0\<^sub>v n" unfolding w_def by auto
   from gauss_0(1)[OF w(1)] id have Bw: "B *\<^sub>v w = 0\<^sub>v n" by simp
   from w Bw have "eigenvector A w e" 
     unfolding eigenvector_char_matrix[OF A] B_def by auto
   thus ?thesis unfolding res .
 qed
 
 lemma eigenvalue_imp_nonzero_dim: assumes "A \<in> carrier_mat n n"
   and "eigenvalue A ev"
   shows "n > 0"
 proof (cases n)
   case 0
   from assms obtain v where "eigenvector A v ev" unfolding eigenvalue_def by auto
   from this[unfolded eigenvector_def] assms 0 
   have "v \<in> carrier_vec 0" "v \<noteq> 0\<^sub>v 0" by auto
   hence False by auto
   thus ?thesis by auto
 qed simp
   
 lemma eigenvalue_det: assumes A: "(A :: 'a :: field mat) \<in> carrier_mat n n" shows
   "eigenvalue A e = (det (char_matrix A e) = 0)"
 proof -
   from A have cA: "char_matrix A e \<in> carrier_mat n n" by auto
   show ?thesis
     unfolding eigenvalue_char_matrix[OF A]
     unfolding id det_0_negate[OF cA] det_0_iff_vec_prod_zero[OF cA]
       eigenvalue_def by auto
 qed
 
 definition char_poly_matrix :: "'a :: comm_ring_1 mat \<Rightarrow> 'a poly mat" where
   "char_poly_matrix A = (([:0,1:] \<cdot>\<^sub>m 1\<^sub>m (dim_row A)) + map_mat (\<lambda> a. [: - a :]) A)"    
 
 lemma char_poly_matrix_closed[simp]: "A \<in> carrier_mat n n \<Longrightarrow> char_poly_matrix A \<in> carrier_mat n n"
   unfolding char_poly_matrix_def by auto    
 
 definition char_poly :: "'a :: comm_ring_1 mat \<Rightarrow> 'a poly" where
   "char_poly A = (det (char_poly_matrix A))"    
 
 lemmas char_poly_defs = char_poly_def char_poly_matrix_def
 
 lemma (in comm_ring_hom) char_poly_matrix_hom: assumes A: "A \<in> carrier_mat n n"
   shows "char_poly_matrix (mat\<^sub>h A) = map_mat (map_poly hom) (char_poly_matrix A)"
   unfolding char_poly_defs
   by (rule eq_matI, insert A, auto simp: smult_mat_def hom_distribs)
 
 lemma (in comm_ring_hom) char_poly_hom: assumes A: "A \<in> carrier_mat n n"
   shows "char_poly (map_mat hom A) = map_poly hom (char_poly A)"
 proof -
   interpret map_poly_hom: map_poly_comm_ring_hom hom..
   show ?thesis
     unfolding char_poly_def map_poly_hom.hom_det[symmetric] char_poly_matrix_hom[OF A] ..
 qed
 
 context inj_comm_ring_hom
 begin
 
 lemma eigenvector_hom: assumes A: "A \<in> carrier_mat n n"
   and ev: "eigenvector A v ev"
   shows "eigenvector (mat\<^sub>h A) (vec\<^sub>h v) (hom ev)"
 proof -
   let ?A = "mat\<^sub>h A" 
   let ?v = "vec\<^sub>h v"
   let ?ev = "hom ev"
   from ev[unfolded eigenvector_def] A
   have v: "v \<in> carrier_vec n" "v \<noteq> 0\<^sub>v n" "A *\<^sub>v v = ev \<cdot>\<^sub>v v" by auto
   from v(1) have v1: "?v \<in> carrier_vec n" by simp
   from v(1-2) obtain i where "i < n" and "v $ i \<noteq> 0" by force
   with v(1) have "?v $ i \<noteq> 0" by auto
   hence v2: "?v \<noteq> 0\<^sub>v n" using \<open>i < n\<close> v(1) by force
   from arg_cong[OF v(3), of "vec\<^sub>h", unfolded mult_mat_vec_hom[OF A v(1)] vec_hom_smult]
   have v3: "?A *\<^sub>v ?v = ?ev \<cdot>\<^sub>v ?v" .
   from v1 v2 v3
   show ?thesis unfolding eigenvector_def using A by auto
 qed
 
 lemma eigenvalue_hom: assumes A: "A \<in> carrier_mat n n"
   and ev: "eigenvalue A ev"
   shows "eigenvalue (mat\<^sub>h A) (hom ev)"
   using eigenvector_hom[OF A, of _ ev] ev
   unfolding eigenvalue_def by auto
 
 lemma eigenvector_hom_rev: assumes A: "A \<in> carrier_mat n n"
   and ev: "eigenvector (mat\<^sub>h A) (vec\<^sub>h v) (hom ev)"
   shows "eigenvector A v ev"
 proof -
   let ?A = "mat\<^sub>h A" 
   let ?v = "vec\<^sub>h v"
   let ?ev = "hom ev"
   from ev[unfolded eigenvector_def] A
   have v: "v \<in> carrier_vec n" "?v \<noteq> 0\<^sub>v n" "?A *\<^sub>v ?v = ?ev \<cdot>\<^sub>v ?v" by auto
   from v(1-2) obtain i where "i < n" and "v $ i \<noteq> 0" by force
   with v(1) have "v $ i \<noteq> 0" by auto
   hence v2: "v \<noteq> 0\<^sub>v n" using \<open>i < n\<close> v(1) by force
   from vec_hom_inj[OF v(3)[folded mult_mat_vec_hom[OF A v(1)] vec_hom_smult]]
   have v3: "A *\<^sub>v v = ev \<cdot>\<^sub>v v" .
   from v(1) v2 v3
   show ?thesis unfolding eigenvector_def using A by auto
 qed
 
 end
 
 
 lemma poly_det_cong: assumes A: "A \<in> carrier_mat n n"
   and B: "B \<in> carrier_mat n n"
   and poly: "\<And> i j. i < n \<Longrightarrow> j < n \<Longrightarrow> poly (B $$ (i,j)) k = A $$ (i,j)"
   shows "poly (det B) k = det A" 
 proof -
   show ?thesis
   unfolding det_def'[OF A] det_def'[OF B] poly_sum poly_mult poly_prod
   proof (rule sum.cong[OF refl])
     fix x
     assume x: "x \<in> {p. p permutes {0..<n}}"
     let ?l = "\<Prod>ka = 0..<n. poly (B $$ (ka, x ka)) k"
     let ?r = "\<Prod>i = 0..<n. A $$ (i, x i)"
     have id: "?l = ?r"
       by (rule prod.cong[OF refl poly], insert x, auto)
-    show "poly (signof x) k * ?l = signof x * ?r" unfolding id signof_def by auto
+    show "poly (signof x) k * ?l = signof x * ?r"
+      by (cases x rule: sign_cases) (simp_all add: id) 
   qed
 qed
 
 lemma char_poly_matrix: assumes A: "(A :: 'a :: field mat) \<in> carrier_mat n n"
   shows "poly (char_poly A) k = det (- (char_matrix A k))"  unfolding char_poly_def
   by (rule poly_det_cong[of _ n], insert A, auto simp: char_poly_matrix_def char_matrix_def)
 
 lemma eigenvalue_root_char_poly: assumes A: "(A :: 'a :: field mat) \<in> carrier_mat n n"
   shows "eigenvalue A k \<longleftrightarrow> poly (char_poly A) k = 0" 
   unfolding eigenvalue_det[OF A] char_poly_matrix[OF A] 
   by (subst det_0_negate[of _ n], insert A, auto)
 
 context
   fixes A :: "'a :: comm_ring_1 mat" and n :: nat
   assumes A: "A \<in> carrier_mat n n"
   and ut: "upper_triangular A"
 begin
 lemma char_poly_matrix_upper_triangular: "upper_triangular (char_poly_matrix A)"
   using A ut unfolding upper_triangular_def char_poly_matrix_def by auto 
 
 lemma char_poly_upper_triangular: 
   "char_poly A = (\<Prod> a \<leftarrow> diag_mat A. [:- a, 1:])"
 proof -
   from A have cA: "char_poly_matrix A \<in> carrier_mat n n" by simp
   show ?thesis
     unfolding char_poly_def det_upper_triangular [OF char_poly_matrix_upper_triangular cA]
     by (rule arg_cong[where f = prod_list], unfold list_eq_iff_nth_eq, insert cA A, auto simp: diag_mat_def
       char_poly_matrix_def)
 qed
 end
 
 lemma map_poly_mult: assumes A: "A \<in> carrier_mat nr n"
   and B: "B \<in> carrier_mat n nc"
   shows 
     "map_mat (\<lambda> a. [: a :]) (A * B) = map_mat (\<lambda> a. [: a :]) A * map_mat (\<lambda> a. [: a :]) B" (is "?id")
     "map_mat (\<lambda> a. [: a :] * p) (A * B) = map_mat (\<lambda> a. [: a :] * p) A * map_mat (\<lambda> a. [: a :]) B" (is "?left")
     "map_mat (\<lambda> a. [: a :] * p) (A * B) = map_mat (\<lambda> a. [: a :]) A * map_mat (\<lambda> a. [: a :] * p) B" (is "?right")
 proof -
   from A B have dim: "dim_row A = nr" "dim_col A = n" "dim_row B = n" "dim_col B = nc" by auto
   {
     fix i j
     have "i < nr \<Longrightarrow> j < nc \<Longrightarrow> 
       row (map_mat (\<lambda>a. [:a:]) A) i \<bullet> col (map_mat (\<lambda>a. [:a:]) B) j = [:(row A i \<bullet> col B j):]"
       unfolding scalar_prod_def
       by (auto simp: dim ac_simps, induct n, auto)  
   } note id = this 
   {
     fix i j
     have "i < nr \<Longrightarrow> j < nc \<Longrightarrow> 
       [:(row A i \<bullet> col B j):] * p = row (map_mat (\<lambda> a. [: a :] * p) A) i \<bullet> col (map_mat (\<lambda>a. [:a:]) B) j"
       unfolding scalar_prod_def
       by (auto simp: dim ac_simps smult_sum) 
   } note left = this 
   {
     fix i j
     have "i < nr \<Longrightarrow> j < nc \<Longrightarrow> 
       [:(row A i \<bullet> col B j):] * p = row (map_mat (\<lambda> a. [: a :]) A) i \<bullet> col (map_mat (\<lambda>a. [:a:] * p) B) j"
       unfolding scalar_prod_def
       by (auto simp: dim ac_simps smult_sum) 
   } note right = this 
   show ?id
     by (rule eq_matI, insert id, auto simp: dim)
   show ?left
     by (rule eq_matI, insert left, auto simp: dim)
   show ?right
     by (rule eq_matI, insert right, auto simp: dim)
 qed
 
 lemma char_poly_similar: assumes "similar_mat A (B :: 'a :: comm_ring_1 mat)"
   shows "char_poly A = char_poly B"
 proof -
   from similar_matD[OF assms] obtain n P Q where
   carr: "{A, B, P, Q} \<subseteq> carrier_mat n n" (is "_ \<subseteq> ?C")
   and PQ: "P * Q = 1\<^sub>m n" 
   and AB: "A = P * B * Q" by auto
   hence A: "A \<in> ?C" and B: "B \<in> ?C" and P: "P \<in> ?C" and Q: "Q \<in> ?C" by auto
   let ?m = "\<lambda> a. [: -a :]"
   let ?P = "map_mat (\<lambda> a. [: a :]) P"
   let ?Q = "map_mat (\<lambda> a. [: a :]) Q"
   let ?B = "map_mat ?m B"
   let ?I = "map_mat (\<lambda> a. [: a :]) (1\<^sub>m n)"
   let ?XI = "[:0, 1:] \<cdot>\<^sub>m 1\<^sub>m n"
   from A B have dim: "dim_row A = n" "dim_row B = n" by auto
   have cong: "\<And> x y z. x = y \<Longrightarrow> x * z = y * z" by auto
   have id: "?m = (\<lambda> a :: 'a. [: a :] * [: -1 :])" by (intro ext, auto)
   have "char_poly A = det (?XI + map_mat (\<lambda>a. [:- a:]) (P * B * Q))" unfolding 
     char_poly_defs dim 
     by (simp add: AB)
   also have "?XI = ?P * ?XI * ?Q" (is "_ = ?left")
   proof -
     have "?P * ?XI = [:0, 1:] \<cdot>\<^sub>m (?P * 1\<^sub>m n)" 
       by (rule mult_smult_distrib[of _ n n _ n], insert P, auto)
     also have "?P * 1\<^sub>m n = ?P" using P by simp
     also have "([: 0, 1:] \<cdot>\<^sub>m ?P) * ?Q = [: 0, 1:] \<cdot>\<^sub>m (?P * ?Q)"
       by (rule mult_smult_assoc_mat, insert P Q, auto)
     also have "?P * ?Q = ?I" unfolding PQ[symmetric]
       by (rule map_poly_mult[symmetric, OF P Q])
     also have "[: 0, 1:] \<cdot>\<^sub>m ?I = ?XI"
       by rule auto
     finally show ?thesis ..
   qed
   also have "map_mat ?m (P * B * Q) = ?P * ?B * ?Q" (is "_ = ?right")
     unfolding id
     by (subst map_poly_mult[OF mult_carrier_mat[OF P B] Q],
       subst map_poly_mult(3)[OF P B], simp)
   also have "?left + ?right = (?P * ?XI + ?P * ?B) * ?Q"
     by (rule add_mult_distrib_mat[symmetric, of _ n n], insert B P Q, auto)
   also have "?P * ?XI + ?P * ?B = ?P * (?XI + ?B)"
     by (rule mult_add_distrib_mat[symmetric, of _ n n], insert B P Q, auto)
   also have "det (?P * (?XI + ?B) * ?Q) = det ?P * det (?XI + ?B) * det ?Q"
     by (rule trans[OF det_mult[of _ n] cong[OF det_mult]], insert P Q B, auto)
   also have "\<dots> = (det ?P * det ?Q) * det (?XI + ?B)" by (simp add: ac_simps)
   also have "det (?XI + ?B) = char_poly B" unfolding char_poly_defs dim by simp
   also have "det ?P * det ?Q = det (?P * ?Q)"
     by (rule det_mult[symmetric], insert P Q, auto)
   also have "?P * ?Q = ?I" unfolding PQ[symmetric]
     by (rule map_poly_mult[symmetric, OF P Q])
   also have "det \<dots> = prod_list (diag_mat ?I)"
     by (rule det_upper_triangular[of _ n], auto)
   also have "\<dots> = 1" unfolding prod_list_diag_prod
     by (rule prod.neutral) simp
   finally show ?thesis by simp
 qed
 
 lemma degree_signof_mult[simp]: "degree (signof p * q) = degree q"
-  by (cases "sign p = 1", auto simp: signof_def)
+  by (cases p rule: sign_cases) simp_all
 
 lemma degree_monic_char_poly: assumes A: "A \<in> carrier_mat n n"
   shows "degree (char_poly A) = n \<and> coeff (char_poly A) n = 1"
 proof -
   from A have A': "[:0, 1:] \<cdot>\<^sub>m 1\<^sub>m (dim_row A) + map_mat (\<lambda>a. [:- a:]) A \<in> carrier_mat n n" by auto
   from A have dA: "dim_row A = n" by simp
   show ?thesis
     unfolding char_poly_defs det_def'[OF A']
   proof (rule degree_lcoeff_sum[of _ id], auto simp: finite_permutations permutes_id dA)
     have both: "degree (\<Prod>i = 0..<n. ([:0, 1:] \<cdot>\<^sub>m 1\<^sub>m n + map_mat (\<lambda>a. [:- a:]) A) $$ (i, i)) = n \<and>
       coeff (\<Prod>i = 0..<n. ([:0, 1:] \<cdot>\<^sub>m 1\<^sub>m n + map_mat (\<lambda>a. [:- a:]) A) $$ (i, i)) n = 1"
       by (rule degree_prod_monic, insert A, auto)
     from both show "degree (\<Prod>i = 0..<n. ([:0, 1:] \<cdot>\<^sub>m 1\<^sub>m n + map_mat (\<lambda>a. [:- a:]) A) $$ (i, i)) = n" ..
     from both show "coeff (\<Prod>i = 0..<n. ([:0, 1:] \<cdot>\<^sub>m 1\<^sub>m n + map_mat (\<lambda>a. [:- a:]) A) $$ (i, i)) n = 1" ..
   next
     fix p
     assume p: "p permutes {0..<n}"
       and "p \<noteq> id"
     then obtain i where i: "i < n" and pi: "p i \<noteq> i"
       by (metis atLeastLessThan_iff order_refl permutes_natset_le)
     show "degree (\<Prod>i = 0..<n. ([:0, 1:] \<cdot>\<^sub>m 1\<^sub>m n + map_mat (\<lambda>a. [:- a:]) A) $$ (i, p i)) < n"
       by (rule degree_prod_sum_lt_n[OF _ i], insert p i pi A, auto)
   qed
 qed
 
 lemma char_poly_factorized: fixes A :: "complex mat"
   assumes A: "A \<in> carrier_mat n n"
   shows "\<exists> as. char_poly A = (\<Prod> a \<leftarrow> as. [:- a, 1:]) \<and> length as = n"
 proof -
   let ?p = "char_poly A"
   from fundamental_theorem_algebra_factorized[of ?p] obtain as
   where "Polynomial.smult (coeff ?p (degree ?p)) (\<Prod>a\<leftarrow>as. [:- a, 1:]) = ?p" by blast
   also have "coeff ?p (degree ?p) = 1" using degree_monic_char_poly[OF A] by simp
   finally have cA: "?p = (\<Prod>a\<leftarrow>as. [:- a, 1:])" by simp
   from degree_monic_char_poly[OF A] have "degree ?p = n" ..
   with degree_linear_factors[of uminus as, folded cA] have "length as = n" by auto
   with cA show ?thesis by blast
 qed
 
 lemma char_poly_four_block_zeros_col: assumes A1: "A1 \<in> carrier_mat 1 1"
   and A2: "A2 \<in> carrier_mat 1 n" and A3: "A3 \<in> carrier_mat n n"
   shows "char_poly (four_block_mat A1 A2 (0\<^sub>m n 1) A3) = char_poly A1 * char_poly A3" 
     (is "char_poly ?A = ?cp1 * ?cp3")
 proof -
   let ?cm = "\<lambda> A. [:0, 1:] \<cdot>\<^sub>m 1\<^sub>m (dim_row A) +
          map_mat (\<lambda>a. [:- a:]) A"
   let ?B2 = "map_mat (\<lambda>a. [:- a:]) A2"
   have "char_poly ?A = det (?cm ?A)"
     unfolding char_poly_defs using A1 A3 by simp
   also have "?cm ?A = four_block_mat (?cm A1) ?B2 (0\<^sub>m n 1) (?cm A3)"
     by (rule eq_matI, insert A1 A2 A3, auto simp: one_poly_def)
   also have "det \<dots> = det (?cm A1) * det (?cm A3)"
     by (rule det_four_block_mat_lower_left_zero_col[OF _ _ refl], insert A1 A2 A3, auto)
   also have "\<dots> = ?cp1 * ?cp3" unfolding char_poly_defs ..
   finally show ?thesis .
 qed
 
 lemma char_poly_transpose_mat[simp]: assumes A: "A \<in> carrier_mat n n"
   shows "char_poly (transpose_mat A) = char_poly A"
 proof -
   let ?A = "[:0, 1:] \<cdot>\<^sub>m 1\<^sub>m (dim_row A) + map_mat (\<lambda>a. [:- a:]) A"
   have A': "?A \<in> carrier_mat n n" using A by auto
   show ?thesis unfolding char_poly_defs
     by (subst det_transpose[symmetric, OF A'], rule arg_cong[of _ _ det],
     insert A, auto)
 qed
 
 lemma pderiv_char_poly: fixes A :: "'a :: idom mat" 
   assumes A: "A \<in> carrier_mat n n" 
   shows "pderiv (char_poly A) = (\<Sum>i < n. char_poly (mat_delete A i i))"
 proof -
   let ?det = Determinant.det
   let ?m = "map_mat (\<lambda>a. [:- a:])" 
   let ?lam = "[:0, 1:] \<cdot>\<^sub>m 1\<^sub>m n :: 'a poly mat" 
   from A have id: "dim_row A = n" by auto  
 
   define mA where "mA = ?m A"
   define lam where "lam = ?lam" 
   let ?sum = "lam + mA" 
   define Sum where "Sum = ?sum" 
   have mA: "mA \<in> carrier_mat n n" and 
     lam: "lam \<in> carrier_mat n n" and
     Sum: "Sum \<in> carrier_mat n n" 
     using A unfolding mA_def Sum_def lam_def by auto
   let ?P = "{p. p permutes {0..<n}}" 
   let ?e = "\<lambda> p. (\<Prod>i = 0..<n. Sum $$ (i, p i))" 
   let ?f = "\<lambda> p a. signof p * (\<Prod>i\<in>{0..<n} - {a}. Sum $$ (i, p i)) * pderiv (Sum $$ (a, p a))" 
   let ?g = "\<lambda> p a. signof p * (\<Prod>i\<in>{0..<n} - {a}. Sum $$ (i, p i))" 
   define f where "f = ?f" 
   define g where "g = ?g" 
   {
     fix p
     assume p: "p permutes {0 ..< n}" 
-    have "pderiv (signof p :: 'a poly) = 0" unfolding signof_def by (simp add: pderiv_minus) 
+    have "pderiv (signof p :: 'a poly) = 0"
+      by (cases p rule: sign_cases) (simp_all add: pderiv_minus) 
     hence "pderiv (signof p * ?e p) = signof p * pderiv (\<Prod>i = 0..<n. Sum $$ (i, p i))" 
       unfolding pderiv_mult by auto
     also have "signof p * pderiv (\<Prod>i = 0..<n. Sum $$ (i, p i)) = 
        (\<Sum>a = 0..<n. f p a)" 
       unfolding pderiv_prod sum_distrib_left f_def by (simp add: ac_simps)
     also note calculation
   } note to_f = this
   {
     fix a
     assume a: "a < n" 
     have Psplit: "?P = {p. p permutes {0..<n} \<and> p a = a} \<union> (?P - {p. p a = a})" (is "_ = ?Pa \<union> ?Pz") by auto 
     {
       fix p
       assume p: "p permutes {0 ..< n}" "p a \<noteq> a"
       hence "pderiv (Sum $$ (a, p a)) = 0" unfolding Sum_def lam_def mA_def using a p A by auto
       hence "f p a = 0" unfolding f_def by auto
     } note 0 = this
     {
       fix p
       assume p: "p permutes {0 ..< n}" "p a = a"
       hence "pderiv (Sum $$ (a, p a)) = 1" unfolding Sum_def lam_def mA_def using a p A
         by (auto simp: pderiv_pCons)
       hence "f p a = g p a" unfolding f_def g_def by auto
     } note fg = this
     let ?n = "n - 1" 
     from a have n: "Suc ?n = n" by simp
     let ?B = "[:0, 1:] \<cdot>\<^sub>m 1\<^sub>m ?n + ?m (mat_delete A a a)" 
     have B: "?B \<in> carrier_mat ?n ?n" using A by auto
     have "sum (\<lambda> p. f p a) ?P = sum (\<lambda> p. f p a) ?Pa + sum (\<lambda> p. f p a) ?Pz" 
       by (subst sum.union_disjoint[symmetric], auto simp: finite_permutations Psplit[symmetric])
     also have "\<dots> = sum (\<lambda> p. f p a) ?Pa" 
       by (subst (2) sum.neutral, insert 0, auto)
     also have "\<dots> = sum (\<lambda> p. g p a) ?Pa" 
       by (rule sum.cong, auto simp: fg)
     also have "\<dots> = ?det ?B"
       unfolding det_def'[OF B] 
       unfolding permutation_fix[of a ?n a, unfolded n, OF a a]
       unfolding sum.reindex[OF permutation_insert_inj_on[of a ?n a, unfolded n, OF a a]] o_def
     proof (rule sum.cong[OF refl])
       fix p
       let ?Q = "{p. p permutes {0..<?n}}" 
       assume "p \<in> ?Q"      
       hence p: "p permutes {0 ..< ?n}" by auto
       let ?p = "permutation_insert a a p"
       let ?i = "insert_index a" 
       have sign: "signof ?p = signof p" 
         unfolding signof_permutation_insert[OF p, unfolded n, OF a a] by simp
       show "g (permutation_insert a a p) a = signof p * (\<Prod>i = 0..<?n. ?B $$ (i, p i))" 
         unfolding g_def sign
       proof (rule arg_cong[of _ _ "(*) (signof p)"])
         have "(\<Prod>i\<in>{0..<n} - {a}. Sum $$ (i, ?p i)) = 
            prod (($$) Sum) ((\<lambda>x. (x, ?p x)) ` ({0..<n} - {a}))"
           unfolding prod.reindex[OF inj_on_convol_ident, of _ ?p] o_def ..
         also have "\<dots> = (\<Prod> ii \<in> {(i', ?p i') |i'. i' \<in> {0..<n} - {a}}. Sum $$ ii)" 
           by (rule prod.cong, auto)
         also have "\<dots> = prod (($$) Sum) ((\<lambda> i. (?i i, ?i (p i))) ` {0 ..< ?n})" 
           unfolding Determinant.foo[of a ?n a, unfolded n, OF a a p]
           by (rule arg_cong[of _ _ "prod _"], auto) 
         also have "\<dots> = prod (\<lambda> i. Sum $$ (?i i, ?i (p i))) {0 ..< ?n}"
         proof (subst prod.reindex, unfold o_def)
           show "inj_on (\<lambda>i. (?i i, ?i (p i))) {0..<?n}" using insert_index_inj_on[of a]
             by (auto simp: inj_on_def)
         qed simp
         also have "\<dots> = (\<Prod>i = 0..<?n. ?B $$ (i, p i))" 
         proof (rule prod.cong[OF refl], rename_tac i)
           fix j
           assume "j \<in> {0 ..< ?n}"
           hence j: "j < ?n" by auto
           with p have pj: "p j < ?n" by auto
           from j pj have jj: "?i j < n" "?i (p j) < n" by (auto simp: insert_index_def)
           let ?jj = "(?i j, ?i (p j))" 
           note index_adj = mat_delete_index[of _ ?n, unfolded n, OF _ a a j pj]
           have "Sum $$ ?jj = lam $$ ?jj + mA $$ ?jj" unfolding Sum_def using jj A lam mA by auto
           also have "\<dots> = ?B $$ (j, p j)" 
             unfolding index_adj[OF mA] index_adj[OF lam] using j pj A
             by (simp add: mA_def lam_def mat_delete_def)
           finally show "Sum $$ ?jj = ?B $$ (j, p j)" .
         qed
         finally 
         show "(\<Prod>i\<in>{0..<n} - {a}. Sum $$ (i, ?p i)) = (\<Prod>i = 0..<?n. ?B $$ (i, p i))" .
       qed
     qed
     also have "\<dots> = char_poly (mat_delete A a a)" unfolding char_poly_def char_poly_matrix_def
       using A by simp
     also note calculation
   } note to_char_poly = this
   have "pderiv (char_poly A) = pderiv (?det Sum)" 
     unfolding char_poly_def char_poly_matrix_def id lam_def mA_def Sum_def by auto
   also have "\<dots> = sum (\<lambda> p. pderiv (signof p * ?e p)) ?P" unfolding det_def'[OF Sum]
     pderiv_sum by (rule sum.cong, auto)
   also have "\<dots> = sum (\<lambda> p. (\<Sum>a = 0..<n. f p a)) ?P" 
     by (rule sum.cong[OF refl], subst to_f, auto)
   also have "\<dots> = (\<Sum>a = 0..<n. sum (\<lambda> p. f p a) ?P)" 
     by (rule sum.swap) 
   also have "\<dots> = (\<Sum>a <n. char_poly (mat_delete A a a))" 
     by (rule sum.cong, auto simp: to_char_poly)
   finally show ?thesis .
 qed    
 
 lemma char_poly_0_column: fixes A :: "'a :: idom mat" 
   assumes 0: "\<And> j. j < n \<Longrightarrow> A $$ (j,i) = 0" 
   and A: "A \<in> carrier_mat n n" 
   and i: "i < n"
 shows "char_poly A = monom 1 1 * char_poly (mat_delete A i i)" 
 proof -
   let ?n = "n - 1" 
   let ?A = "mat_delete A i i" 
   let ?sum = "[:0, 1:] \<cdot>\<^sub>m 1\<^sub>m n + map_mat (\<lambda>a. [:- a:]) A" 
   define Sum where "Sum = ?sum" 
   let ?f = "\<lambda> j. Sum $$ (j, i) * cofactor Sum j i" 
   have Sum: "Sum \<in> carrier_mat n n" using A unfolding Sum_def by auto
   from A have id: "dim_row A = n" by auto  
   have "char_poly A = (\<Sum>j<n. ?f j)" 
     unfolding char_poly_def[of A] char_poly_matrix_def 
     using laplace_expansion_column[OF Sum i] unfolding Sum_def using A by simp
   also have "\<dots> = ?f i + sum ?f ({..<n} - {i})" 
     by (rule sum.remove[of _ i], insert i, auto)
   also have "\<dots> = ?f i" 
   proof (subst sum.neutral, intro ballI)
     fix j
     assume "j \<in> {..<n} - {i}" 
     hence j: "j < n" and ji: "j \<noteq> i" by auto
     show "?f j = 0" unfolding Sum_def using ji j i A 0[OF j] by simp
   qed simp
   also have "?f i = [:0, 1:] * (cofactor Sum i i)" 
     unfolding Sum_def using i A 0[OF i] by simp
   also have "cofactor Sum i i = det (mat_delete Sum i i)" 
     unfolding cofactor_def by simp
   also have "\<dots> = char_poly ?A" 
     unfolding char_poly_def char_poly_matrix_def Sum_def
   proof (rule arg_cong[of _ _ det])
     show "mat_delete ?sum i i = [:0, 1:] \<cdot>\<^sub>m 1\<^sub>m (dim_row ?A) + map_mat (\<lambda>a. [:- a:]) ?A"
       using i A by (auto simp: mat_delete_def)
   qed
   also have "[:0, 1:] = (monom 1 1 :: 'a poly)" by (rule x_as_monom)
   finally show ?thesis .
 qed
 
 definition mat_erase :: "'a :: zero mat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a mat" where
   "mat_erase A i j = Matrix.mat (dim_row A) (dim_col A) 
      (\<lambda> (i',j'). if i' = i \<or> j' = j then 0 else A $$ (i',j'))"  
 
 lemma mat_erase_carrier[simp]: "(mat_erase A i j) \<in> carrier_mat nr nc \<longleftrightarrow> A \<in> carrier_mat nr nc" 
   unfolding mat_erase_def carrier_mat_def by simp
 
 lemma pderiv_char_poly_mat_erase: fixes A :: "'a :: idom mat" 
   assumes A: "A \<in> carrier_mat n n" 
   shows "monom 1 1 * pderiv (char_poly A) = (\<Sum>i < n. char_poly (mat_erase A i i))"
 proof -
   show ?thesis unfolding pderiv_char_poly[OF A] sum_distrib_left
   proof (rule sum.cong[OF refl])
     fix i
     assume "i \<in> {..<n}" 
     hence i: "i < n" by simp
     have mA: "mat_erase A i i \<in> carrier_mat n n" using A by simp
     show "monom 1 1 * char_poly (mat_delete A i i) = char_poly (mat_erase A i i)"
       by (subst char_poly_0_column[OF _ mA i], (insert i A, force simp: mat_erase_def),
       rule arg_cong[of _ _ "\<lambda> x. f * char_poly x" for f],
       auto simp: mat_delete_def mat_erase_def)
   qed
 qed
     
 end
diff --git a/thys/Jordan_Normal_Form/Determinant.thy b/thys/Jordan_Normal_Form/Determinant.thy
--- a/thys/Jordan_Normal_Form/Determinant.thy
+++ b/thys/Jordan_Normal_Form/Determinant.thy
@@ -1,2429 +1,2435 @@
 (*  
     Author:      René Thiemann 
                  Akihisa Yamada
     License:     BSD
 *)
 section \<open>Determinants\<close>
 
 text \<open>Most of the following definitions and proofs on determinants have been copied and adapted 
   from ~~/src/HOL/Multivariate-Analysis/Determinants.thy.
 
 Exceptions are \emph{det-identical-rows}.
 
 We further generalized some lemmas, e.g., that the determinant is 0 iff the kernel of a matrix
 is non-empty is available for integral domains, not just for fields.\<close>
 
 theory Determinant
 imports 
-  Missing_Permutations
+  Missing_Misc
   Column_Operations
   "HOL-Computational_Algebra.Polynomial_Factorial" (* Only for to_fract. Probably not the right place. *)
   Polynomial_Interpolation.Ring_Hom
   Polynomial_Interpolation.Missing_Unsorted
 begin
 
 definition det:: "'a mat \<Rightarrow> 'a :: comm_ring_1" where
   "det A = (if dim_row A = dim_col A then (\<Sum> p \<in> {p. p permutes {0 ..< dim_row A}}. 
      signof p * (\<Prod> i = 0 ..< dim_row A. A $$ (i, p i))) else 0)"
 
 lemma(in ring_hom) hom_signof[simp]: "hom (signof p) = signof p"
-  unfolding signof_def by (auto simp: hom_distribs)
+  by (simp add: hom_uminus sign_def)
 
 lemma(in comm_ring_hom) hom_det[simp]: "det (map_mat hom A) = hom (det A)"
   unfolding det_def by (auto simp: hom_distribs)
 
 lemma det_def': "A \<in> carrier_mat n n \<Longrightarrow> 
   det A = (\<Sum> p \<in> {p. p permutes {0 ..< n}}. 
      signof p * (\<Prod> i = 0 ..< n. A $$ (i, p i)))" unfolding det_def by auto
 
 lemma det_smult[simp]: "det (a \<cdot>\<^sub>m A) = a ^ dim_col A * det A"
 proof -
   have [simp]: "(\<Prod>i = 0..<dim_col A. a) = a ^ dim_col A" by(subst prod_constant;simp)
   show ?thesis
   unfolding det_def
   unfolding index_smult_mat
   by (auto intro: sum.cong simp: sum_distrib_left prod.distrib)
 qed
 
 lemma det_transpose: assumes A: "A \<in> carrier_mat n n"
   shows "det (transpose_mat A) = det A"
 proof -
   let ?di = "\<lambda>A i j. A $$ (i,j)"
   let ?U = "{0 ..< n}"
   have fU: "finite ?U" by simp
   let ?inv = "Hilbert_Choice.inv"
   {
     fix p
     assume p: "p \<in> {p. p permutes ?U}"
     from p have pU: "p permutes ?U"
       by blast
     have sth: "signof (?inv p) = signof p"
       by (rule signof_inv[OF _ pU], simp)
     from permutes_inj[OF pU]
     have pi: "inj_on p ?U"
       by (blast intro: subset_inj_on)
     let ?f = "\<lambda>i. transpose_mat A $$ (i, ?inv p i)"
     note pU_U = permutes_image[OF pU]
     note [simp] = permutes_less[OF pU]
     have "prod ?f ?U = prod ?f (p ` ?U)"
       using pU_U by simp
     also have "\<dots> = prod (?f \<circ> p) ?U"
       by (rule prod.reindex[OF pi])
     also have "\<dots> = prod (\<lambda>i. A $$ (i, p i)) ?U"
       by (rule prod.cong, insert A, auto)
     finally have "signof (?inv p) * prod ?f ?U =
       signof p * prod (\<lambda>i. A $$ (i, p i)) ?U"
       unfolding sth by simp
   }
   then show ?thesis
     unfolding det_def using A
     by (simp, subst sum_permutations_inverse, intro sum.cong, auto)
 qed
 
 lemma det_col:
   assumes A: "A \<in> carrier_mat n n"
   shows "det A = (\<Sum> p | p permutes {0 ..< n}. signof p * (\<Prod>j<n. A $$ (p j, j)))"
     (is "_ = (sum (\<lambda>p. _ * ?prod p) ?P)")
 proof -
   let ?i = "Hilbert_Choice.inv"
   let ?N = "{0 ..< n}"
   let ?f = "\<lambda>p. signof p * ?prod p"
   let ?prod' = "\<lambda>p. \<Prod>j<n. A $$ (j, ?i p j)"
   let ?prod'' = "\<lambda>p. \<Prod>j<n. A $$ (j, p j)"
   let ?f' = "\<lambda>p. signof (?i p) * ?prod' p"
   let ?f'' = "\<lambda>p. signof p * ?prod'' p"
   let ?P' = "{ ?i p | p. p permutes ?N }"
   have [simp]: "{0..<n} = {..<n}" by auto
   have "sum ?f ?P = sum ?f' ?P"
   proof (rule sum.cong[OF refl],unfold mem_Collect_eq)
       fix p assume p: "p permutes ?N"
       have [simp]: "?prod p = ?prod' p"
         using permutes_prod[OF p, of "\<lambda>x y. A $$ (x,y)"] by auto
       have [simp]: "signof p = signof (?i p)"
         apply(rule signof_inv[symmetric]) using p by auto
       show "?f p = ?f' p" by auto
   qed
   also have "... = sum ?f' ?P'"
     by (rule sum.cong[OF image_inverse_permutations[symmetric]],auto)
   also have "... = sum ?f'' ?P"
     unfolding sum.reindex[OF inv_inj_on_permutes,unfolded image_Collect]
     unfolding o_def
     apply (rule sum.cong[OF refl])
     using inv_inv_eq[OF permutes_bij] by force
   finally show ?thesis unfolding det_def'[OF A] by auto
 qed
 
 lemma mat_det_left_def: assumes A: "A \<in> carrier_mat n n"
   shows "det A = (\<Sum>p\<in>{p. p permutes {0..<dim_row A}}. signof p * (\<Prod>i = 0 ..< dim_row A. A $$ (p i, i)))"
 proof -
   have cong: "\<And> a b c. b = c \<Longrightarrow> a * b = a * c" by simp
   show ?thesis
   unfolding det_transpose[OF A, symmetric]
   unfolding det_def index_transpose_mat using A by simp
 qed
 
 lemma det_upper_triangular:
   assumes ut: "upper_triangular A"
   and m: "A \<in> carrier_mat n n"
   shows "det A = prod_list (diag_mat A)"
 proof -
   note det_def = det_def'[OF m]
   let ?U = "{0..<n}"
   let ?PU = "{p. p permutes ?U}"
   let ?pp = "\<lambda>p. signof p * (\<Prod> i = 0 ..< n. A $$ (i, p i))"
   have fU: "finite ?U"
     by simp
   from finite_permutations[OF fU] have fPU: "finite ?PU" .
   have id0: "{id} \<subseteq> ?PU"
     by (auto simp add: permutes_id)
   {
     fix p
     assume p: "p \<in> ?PU - {id}"
     from p have pU: "p permutes ?U" and pid: "p \<noteq> id"
       by blast+
     from permutes_natset_ge[OF pU] pid obtain i where i: "p i < i" and "i < n" 
       by fastforce
     from upper_triangularD[OF ut i] \<open>i < n\<close> m
     have ex:"\<exists>i \<in> ?U. A $$ (i,p i) = 0" by auto
     have "(\<Prod> i = 0 ..< n. A $$ (i, p i)) = 0" 
       by (rule prod_zero[OF fU ex])
     hence "?pp p = 0" by simp
   }
   then have p0: "\<And> p. p \<in> ?PU - {id} \<Longrightarrow> ?pp p = 0"
     by blast
   from m have dim: "dim_row A = n" by simp
   have "det A = (\<Sum> p \<in> ?PU. ?pp p)" unfolding det_def by auto
   also have "\<dots> = ?pp id + (\<Sum> p \<in> ?PU - {id}. ?pp p)"
     by (rule sum.remove, insert id0 fPU m, auto simp: p0)
   also have "(\<Sum> p \<in> ?PU - {id}. ?pp p) = 0"
     by (rule sum.neutral, insert fPU, auto simp: p0)
   finally show ?thesis using m by (auto simp: prod_list_diag_prod)
 qed
 
 lemma det_one[simp]: "det (1\<^sub>m n) = 1"
 proof -
   have "det (1\<^sub>m n) = prod_list (diag_mat (1\<^sub>m n))"
     by (rule det_upper_triangular[of _ n], auto)
   also have "\<dots> = 1" by (induct n, auto)
   finally show ?thesis .
 qed
 
 lemma det_zero[simp]: assumes "n > 0" shows "det (0\<^sub>m n n) = 0"
 proof -
   have "det (0\<^sub>m n n) = prod_list (diag_mat (0\<^sub>m n n))"
     by (rule det_upper_triangular[of _ n], auto)
   also have "\<dots> = 0" using \<open>n > 0\<close> by (cases n, auto)
   finally show ?thesis .
 qed
 
 lemma det_dim_zero[simp]: "A \<in> carrier_mat 0 0 \<Longrightarrow> det A = 1"
-  unfolding det_def carrier_mat_def signof_def sign_def by auto
- 
+  unfolding det_def carrier_mat_def sign_def by auto
 
 lemma det_lower_triangular:
   assumes ld: "\<And>i j. i < j \<Longrightarrow> j < n \<Longrightarrow> A $$ (i,j) = 0"
   and m: "A \<in> carrier_mat n n"
   shows "det A = prod_list (diag_mat A)"
 proof -
   have "det A = det (transpose_mat A)" using det_transpose[OF m] by simp
   also have "\<dots> = prod_list (diag_mat (transpose_mat A))"
     by (rule det_upper_triangular, insert m ld, auto)
   finally show ?thesis using m by simp
 qed
 
 lemma det_permute_rows: assumes A: "A \<in> carrier_mat n n"
   and p: "p permutes {0 ..< (n :: nat)}"
   shows "det (mat n n (\<lambda> (i,j). A $$ (p i, j))) = signof p * det A"
 proof -
   let ?U = "{0 ..< (n :: nat)}"
   have cong: "\<And> a b c. b = c \<Longrightarrow> a * b = a * c" by auto
   have "det (mat n n (\<lambda> (i,j). A $$ (p i, j))) = 
     (\<Sum> q \<in> {q . q permutes ?U}. signof q * (\<Prod> i \<in> ?U. A $$ (p i, q i)))"
     unfolding det_def using A p by auto
   also have "\<dots> = (\<Sum> q \<in> {q . q permutes ?U}. signof (q \<circ> p) * (\<Prod> i \<in> ?U. A $$ (p i, (q \<circ> p) i)))"
     by (rule sum_permutations_compose_right[OF p])
   finally have 1: "det (mat n n (\<lambda> (i,j). A $$ (p i, j)))
     = (\<Sum> q \<in> {q . q permutes ?U}. signof (q \<circ> p) * (\<Prod> i \<in> ?U. A $$ (p i, (q \<circ> p) i)))" .
   have 2: "signof p * det A = 
     (\<Sum> q\<in>{q. q permutes ?U}. signof p * signof q * (\<Prod>i\<in> ?U. A $$ (i, q i)))"
     unfolding det_def'[OF A] sum_distrib_left by (simp add: ac_simps)
   show ?thesis unfolding 1 2
   proof (rule sum.cong, insert p A, auto)
     fix q
     assume q: "q permutes ?U"
     let ?inv = "Hilbert_Choice.inv"
     from permutes_inv[OF p] have ip: "?inv p permutes ?U" .
     have "prod (\<lambda>i. A $$ (p i, (q \<circ> p) i)) ?U = 
       prod (\<lambda>i. A $$ ((p \<circ> ?inv p) i, (q \<circ> (p \<circ> ?inv p)) i)) ?U" unfolding o_def
       by (rule trans[OF prod.permute[OF ip] prod.cong], insert A p q, auto)
     also have "\<dots> = prod (\<lambda>i. A$$(i,q i)) ?U"
       by (simp only: o_def permutes_inverses[OF p])
     finally have thp: "prod (\<lambda>i. A $$ (p i, (q \<circ> p) i)) ?U = prod (\<lambda>i. A$$(i,q i)) ?U" .      
     show "signof (q \<circ> p) * (\<Prod>i\<in>{0..<n}. A $$ (p i, q (p i))) =
          signof p * signof q * (\<Prod>i\<in>{0..<n}. A $$ (i, q i))"
       unfolding thp[symmetric] signof_compose[OF q p]
       by (simp add: ac_simps)
   qed
 qed
 
 lemma det_multrow_mat: assumes k: "k < n"
   shows "det (multrow_mat n k a) = a"
 proof (rule trans[OF det_lower_triangular[of n]], unfold prod_list_diag_prod)
   let ?f = "\<lambda> i. multrow_mat n k a $$ (i, i)"
   have "(\<Prod>i\<in>{0..<n}. ?f i) = ?f k * (\<Prod>i\<in>{0..<n} - {k}. ?f i)"
     by (rule prod.remove, insert k, auto)
   also have "(\<Prod>i\<in>{0..<n} - {k}. ?f i) = 1" 
     by (rule prod.neutral, auto)
   finally show "(\<Prod>i\<in>{0..<dim_row (multrow_mat n k a)}. ?f i) = a" using k by simp
 qed (insert k, auto)
 
 lemma swap_rows_mat_eq_permute: 
   "k < n \<Longrightarrow> l < n \<Longrightarrow> swaprows_mat n k l = mat n n (\<lambda>(i, j). 1\<^sub>m n $$ (Fun.swap k l id i, j))"
   by (rule eq_matI) (auto simp add: swap_id_eq)
 
 lemma det_swaprows_mat: assumes k: "k < n" and l: "l < n" and kl: "k \<noteq> l"
   shows "det (swaprows_mat n k l) = - 1"
 proof -
   let ?n = "{0 ..< (n :: nat)}"
   let ?p = "Fun.swap k l id"
   have p: "?p permutes ?n"
     by (rule permutes_swap_id, insert k l, auto)
   show ?thesis
     by (rule trans[OF trans[OF _ det_permute_rows[OF one_carrier_mat[of n] p]]],
-    subst swap_rows_mat_eq_permute[OF k l], auto simp: signof_def sign_swap_id kl)
+    subst swap_rows_mat_eq_permute[OF k l], auto simp: sign_swap_id kl)
 qed
   
 lemma det_addrow_mat: 
   assumes l: "k \<noteq> l"
   shows "det (addrow_mat n a k l) = 1"
 proof -
   have "det (addrow_mat n a k l) = prod_list (diag_mat (addrow_mat n a k l))"
   proof (cases "k < l")
     case True
     show ?thesis
       by (rule det_upper_triangular[of _ n], insert True, auto intro!: upper_triangularI)
   next
     case False
     show ?thesis
       by (rule det_lower_triangular[of n], insert False, auto)
   qed
   also have "\<dots> = 1" unfolding prod_list_diag_prod
     by (rule prod.neutral, insert l, auto)
   finally show ?thesis .
 qed
 
 text \<open>The following proof is new, as it does not use $2 \neq 0$ as in Multivariate-Analysis.\<close>
 
 lemma det_identical_rows:
   assumes A: "A \<in> carrier_mat n n"  
     and ij: "i \<noteq> j"
     and i: "i < n" and j: "j < n"
     and r: "row A i = row A j"
   shows "det A = 0"
 proof-
   let ?p = "Fun.swap i j id"
   let ?n = "{0 ..< n}"
-  have sp: "signof ?p = - 1" "sign ?p = -1" unfolding signof_def using ij
+  have sp: "signof ?p = - 1" "sign ?p = (- 1 :: int)" using ij
     by (auto simp add: sign_swap_id)
   let ?f = "\<lambda> p. signof p * (\<Prod>i\<in>?n. A $$ (p i, i))"
   let ?all = "{p. p permutes ?n}"
-  let ?one = "{p. p permutes ?n \<and> sign p = 1}"
-  let ?none = "{p. p permutes ?n \<and> sign p \<noteq> 1}"
+  let ?one = "{p. p permutes ?n \<and> sign p = (1 :: int)}"
+  let ?none = "{p. p permutes ?n \<and> sign p \<noteq> (1 :: int)}"
   let ?pone = "(\<lambda> p. ?p o p) ` ?one"
   have split: "?one \<union> ?none = ?all" by auto
   have p: "?p permutes ?n" by (rule permutes_swap_id, insert i j, auto)
   from permutes_inj[OF p] have injp: "inj ?p" by auto
   {
     fix q
     assume q: "q permutes ?n"
     have "(\<Prod>k\<in>?n. A $$ (?p (q k), k)) = (\<Prod>k\<in>?n. A $$ (q k, k))"
     proof (rule prod.cong)
       fix k
       assume k: "k \<in> ?n"
       from r have row: "row A i $ k = row A j $ k" by simp
       hence "A $$ (i,k) = A $$ (j,k)" using k i j A by auto
       thus "A $$ (?p (q k), k) = A $$ (q k, k)"
         by (cases "q k = i", auto, cases "q k = j", auto)
     qed (insert A q, auto)
   } note * = this
   have pp: "\<And> q. q permutes ?n \<Longrightarrow> permutation q" unfolding 
     permutation_permutes by auto
   have "det A = (\<Sum>p\<in> ?one \<union> ?none. ?f p)"
     using A unfolding mat_det_left_def[OF A] split by simp
   also have "\<dots> = (\<Sum>p\<in> ?one. ?f p) + (\<Sum>p\<in> ?none. ?f p)"
     by (rule sum.union_disjoint, insert A, auto simp: finite_permutations)
   also have "?none = ?pone" 
   proof -
     {
       fix q
       assume "q \<in> ?none"
-      hence q: "q permutes ?n" and sq: "sign q = -1" unfolding sign_def by auto
+      hence q: "q permutes ?n" and sq: "sign q = (- 1 :: int)" unfolding sign_def by auto
       from permutes_compose[OF q p] sign_compose[OF pp[OF p] pp[OF q], unfolded sp sq]
       have "?p o q \<in> ?one" by auto
       hence "?p o (?p o q) \<in> ?pone" by auto
       also have "?p o (?p o q) = q"
         by (auto simp: swap_id_eq)
       finally have "q \<in> ?pone" .
     }
     moreover
     {
       fix pq
       assume "pq \<in> ?pone"
       then obtain q where q: "q \<in> ?one" and pq: "pq = ?p o q" by auto
-      from q have q: "q permutes ?n" and sq: "sign q = 1" by auto
-      from sign_compose[OF pp[OF p] pp[OF q], unfolded sq sp] have spq: "sign pq = -1" unfolding pq by auto
+      from q have q: "q permutes ?n" and sq: "sign q = (1 :: int)" by auto
+      from sign_compose[OF pp[OF p] pp[OF q], unfolded sq sp]
+      have spq: "sign pq = (- 1 :: int)" unfolding pq by auto
       from permutes_compose[OF q p] have pq: "pq permutes ?n" unfolding pq by auto
       from pq spq have "pq \<in> ?none" by auto
     }
     ultimately
     show ?thesis by blast
   qed  
   also have "(\<Sum>p\<in> ?pone. ?f p) = (\<Sum>p\<in> ?one. ?f (?p o p))"
   proof (rule trans[OF sum.reindex])
     show "inj_on ((\<circ>) ?p) ?one" 
       using fun.inj_map[OF injp] unfolding inj_on_def by auto
   qed simp
   also have "(\<Sum>p\<in> ?one. ?f p) + (\<Sum>p\<in> ?one. ?f (?p o p))
     = (\<Sum>p\<in> ?one. ?f p + ?f (?p o p))"
     by (rule sum.distrib[symmetric])
   also have "\<dots> = 0"
     by (rule sum.neutral, insert A, auto simp: 
-      sp sign_compose[OF pp[OF p] pp] ij signof_def finite_permutations *)
+      sp sign_compose[OF pp[OF p] pp] ij finite_permutations *)
   finally show ?thesis .
 qed
 
 lemma det_row_0: assumes k: "k < n"
   and c: "c \<in> {0 ..< n} \<rightarrow> carrier_vec n"
   shows "det (mat\<^sub>r n n (\<lambda>i. if i = k then 0\<^sub>v n else c i)) = 0"
 proof -
   {
     fix p
     assume p: "p permutes {0 ..< n}"
     have "(\<Prod>i\<in>{0..<n}. mat\<^sub>r n n (\<lambda>i. if i = k then 0\<^sub>v n else c i) $$ (i, p i)) = 0" 
       by (rule prod_zero[OF _ bexI[of _ k]], 
       insert k p c[unfolded carrier_vec_def], auto)
   }
   thus ?thesis unfolding det_def by simp
 qed
 
 lemma det_row_add: 
   assumes abc: "a k \<in> carrier_vec n" "b k \<in> carrier_vec n" "c \<in> {0..<n} \<rightarrow> carrier_vec n"
     and k: "k < n"
   shows "det(mat\<^sub>r n n (\<lambda> i. if i = k then a i + b i else c i)) =
     det(mat\<^sub>r n n (\<lambda> i. if i = k then a i else c i)) +
     det(mat\<^sub>r n n (\<lambda> i. if i = k then b i else c i))"
   (is "?lhs = ?rhs")
 proof -
   let ?n = "{0..<n}"
   let ?m = "\<lambda> a b p i. mat\<^sub>r n n (\<lambda>i. if i = k then a i else b i) $$ (i, p i)"
   let ?c = "\<lambda> p i. mat\<^sub>r n n c $$ (i, p i)"
   let ?ab = "\<lambda> i. a i + b i"
   note intros = add_carrier_vec[of _ n]
   have "?rhs = (\<Sum>p\<in>{p. p permutes ?n}. 
     signof p * (\<Prod>i\<in>?n. ?m a c p i)) + (\<Sum>p\<in>{p. p permutes ?n}. signof p * (\<Prod>i\<in>?n. ?m b c p i))"
     unfolding det_def by simp
   also have "\<dots> = (\<Sum>p\<in>{p. p permutes ?n}. signof p * (\<Prod>i\<in>?n. ?m a c p i) +  signof p * (\<Prod>i\<in>?n. ?m b c p i))"
     by (rule sum.distrib[symmetric])
   also have "\<dots> = (\<Sum>p\<in>{p. p permutes ?n}. signof p * (\<Prod>i\<in>?n. ?m ?ab c p i))"
   proof (rule sum.cong, force)
     fix p
     assume "p \<in> {p. p permutes ?n}"
     hence p: "p permutes ?n" by simp
     show "signof p * (\<Prod>i\<in>?n. ?m a c p i) + signof p * (\<Prod>i\<in>?n. ?m b c p i) = 
       signof p * (\<Prod>i\<in>?n. ?m ?ab c p i)"
       unfolding distrib_left[symmetric]
     proof (rule arg_cong[of _ _ "\<lambda> a. signof p * a"])
       from k have f: "finite ?n" and k': "k \<in> ?n" by auto
       let ?nk = "?n - {k}"
       note split = prod.remove[OF f k']
       have id1: "(\<Prod>i\<in>?n. ?m a c p i) = ?m a c p k * (\<Prod>i\<in>?nk. ?m a c p i)"
         by (rule split)
       have id2: "(\<Prod>i\<in>?n. ?m b c p i) = ?m b c p k * (\<Prod>i\<in>?nk. ?m b c p i)"
         by (rule split)
       have id3: "(\<Prod>i\<in>?n. ?m ?ab c p i) = ?m ?ab c p k * (\<Prod>i\<in>?nk. ?m ?ab c p i)"
         by (rule split)
       have id: "\<And> a. (\<Prod>i\<in>?nk. ?m a c p i) = (\<Prod>i\<in>?nk. ?c p i)"
         by (rule prod.cong, insert abc k p, auto intro!: intros)
       have ab: "?ab k \<in> carrier_vec n" using abc by (auto intro: intros)
       {
         fix f
         assume "f k \<in> (carrier_vec n :: 'a vec set)"
         hence "mat\<^sub>r n n (\<lambda>i. if i = k then f i else c i) $$ (k, p k) = f k $ p k"
           by (insert p k abc, auto)
       } note first = this
       note id' = id1 id2 id3
       have dist: "(a k + b k) $ p k = a k $ p k + b k $ p k"  
         by (rule index_add_vec(1), insert p k abc, force)
       show "(\<Prod>i\<in>?n. ?m a c p i) + (\<Prod>i\<in>?n. ?m b c p i) = (\<Prod>i\<in>?n. ?m ?ab c p i)"
         unfolding id' id first[of a, OF abc(1)] first[of b, OF abc(2)] first[of ?ab, OF ab] dist
         by (rule distrib_right[symmetric])
     qed 
   qed 
   also have "\<dots> = ?lhs" unfolding det_def by simp
   finally show ?thesis by simp
 qed
 
 
 lemma det_linear_row_finsum:
   assumes fS: "finite S" and c: "c \<in> {0..<n} \<rightarrow> carrier_vec n" and k: "k < n"
   and a: "a k \<in> S \<rightarrow> carrier_vec n"
   shows "det (mat\<^sub>r n n (\<lambda> i. if i = k then finsum_vec TYPE('a :: comm_ring_1) n (a i) S else c i)) =
     sum (\<lambda>j. det (mat\<^sub>r n n (\<lambda> i. if i = k then a  i j else c i))) S"
 proof -
   let ?sum = "finsum_vec TYPE('a) n"
   show ?thesis using a
   proof (induct rule: finite_induct[OF fS])
     case 1
     show ?case
       by (simp, unfold finsum_vec_empty, rule det_row_0[OF k c])
   next
     case (2 x F)
     from 2(4) have ak: "a k \<in> F \<rightarrow> carrier_vec n" and akx: "a k x \<in> carrier_vec n" by auto    
     {
       fix i
       note if_cong[OF refl finsum_vec_insert[OF 2(1-2)],
         of _ "a i" n "c i" "c i"]
     } note * = this
     show ?case
     proof (subst *)
       show "det (mat\<^sub>r n n (\<lambda>i. if i = k then a i x + ?sum (a i) F else c i)) =
         (\<Sum>j\<in>insert x F. det (mat\<^sub>r n n (\<lambda>i. if i = k then a i j else c i)))"
       proof (subst det_row_add)
         show "det (mat\<^sub>r n n (\<lambda>i. if i = k then a i x else c i)) +
           det (mat\<^sub>r n n (\<lambda>i. if i = k then ?sum (a i) F else c i)) =
         (\<Sum>j\<in>insert x F. det (mat\<^sub>r n n (\<lambda>i. if i = k then a i j else c i)))"
         unfolding 2(3)[OF ak] sum.insert[OF 2(1-2)] by simp
       qed (insert c k ak akx 2(1), 
         auto intro!: finsum_vec_closed)
     qed (insert akx ak, force+)
   qed
 qed
 
 
 lemma det_linear_rows_finsum_lemma:
   assumes fS: "finite S"
     and fT: "finite T" and c: "c \<in> {0..<n} \<rightarrow> carrier_vec n"
     and T: "T \<subseteq> {0 ..< n}"
     and a: "a \<in> T \<rightarrow> S \<rightarrow> carrier_vec n"
   shows "det (mat\<^sub>r n n (\<lambda> i. if i \<in> T then finsum_vec TYPE('a :: comm_ring_1) n (a i) S else c i)) =
     sum (\<lambda>f. det(mat\<^sub>r n n (\<lambda> i. if i \<in> T then a i (f i) else c i)))
       {f. (\<forall>i \<in> T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = i)}"
 proof -
   let ?sum = "finsum_vec TYPE('a) n"
   show ?thesis using fT c a T
   proof (induct T arbitrary: a c set: finite)
     case empty
     let ?f = "(\<lambda> i. i) :: nat \<Rightarrow> nat"
     have [simp]: "{f. \<forall>i. f i = i} = {?f}" by auto    
     show ?case by simp
   next
     case (insert z T a c)
     hence z: "z < n" and azS: "a z \<in> S \<rightarrow> carrier_vec n" by auto
     let ?F = "\<lambda>T. {f. (\<forall>i \<in> T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = i)}"
     let ?h = "\<lambda>(y,g) i. if i = z then y else g i"
     let ?k = "\<lambda>h. (h(z),(\<lambda>i. if i = z then i else h i))"
     let ?s = "\<lambda> k a c f. det(mat\<^sub>r n n (\<lambda> i. if i \<in> T then a i (f i) else c i))"
     let ?c = "\<lambda>j i. if i = z then a i j else c i"
     have thif: "\<And>a b c d. (if a \<or> b then c else d) = (if a then c else if b then c else d)"
       by simp
     have thif2: "\<And>a b c d e. (if a then b else if c then d else e) =
        (if c then (if a then b else d) else (if a then b else e))"
       by simp
     from \<open>z \<notin> T\<close> have nz: "\<And>i. i \<in> T \<Longrightarrow> i = z \<longleftrightarrow> False"
       by auto
     from insert have c: "\<And> i. i < n \<Longrightarrow> c i \<in> carrier_vec n" by auto
     have fin: "finite {f. (\<forall>i\<in>T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = i)}"
       by (rule finite_bounded_functions[OF fS insert(1)])
     have "det (mat\<^sub>r n n (\<lambda> i. if i \<in> insert z T then ?sum (a i) S else c i)) =
       det (mat\<^sub>r n n (\<lambda> i. if i = z then ?sum (a i) S else if i \<in> T then ?sum (a i) S else c i))"
       unfolding insert_iff thif ..
     also have "\<dots> = (\<Sum>j\<in>S. det (mat\<^sub>r n n (\<lambda> i. if i \<in> T then ?sum (a i) S else if i = z then a i j else c i)))"
       apply (subst det_linear_row_finsum[OF fS _ z])
       prefer 3
       apply (subst thif2)
       using nz
       apply (simp cong del: if_weak_cong cong add: if_cong)
       apply (insert azS c fS insert(5), (force intro!: finsum_vec_closed)+)
       done
     also have "\<dots> = (sum (\<lambda> (j, f). det (mat\<^sub>r n n (\<lambda> i. if i \<in> T then a i (f i)
       else if i = z then a i j
       else c i))) (S \<times> ?F T))"
       unfolding sum.cartesian_product[symmetric]
       by (rule sum.cong[OF refl], subst insert.hyps(3), 
         insert azS c fin z insert(5-6), auto)
     finally have tha:
       "det (mat\<^sub>r n n (\<lambda> i. if i \<in> insert z T then ?sum (a i) S else c i)) =
        (sum (\<lambda> (j, f). det (mat\<^sub>r n n (\<lambda> i. if i \<in> T then a i (f i)
           else if i = z then a i j
           else c i))) (S \<times> ?F T))" .                
     show ?case unfolding tha
       by (rule sum.reindex_bij_witness[where i="?k" and j="?h"], insert \<open>z \<notin> T\<close>
       azS c fS insert(5-6) z fin, 
       auto intro!: arg_cong[of _ _ det])
   qed
 qed
 
 lemma det_linear_rows_sum:
   assumes fS: "finite S"
   and a: "a \<in> {0..<n} \<rightarrow> S \<rightarrow> carrier_vec n"
   shows "det (mat\<^sub>r n n (\<lambda> i. finsum_vec TYPE('a :: comm_ring_1) n (a i) S)) =
     sum (\<lambda>f. det (mat\<^sub>r n n (\<lambda> i. a i (f i)))) 
     {f. (\<forall>i\<in>{0..<n}. f i \<in> S) \<and> (\<forall>i. i \<notin> {0..<n} \<longrightarrow> f i = i)}"
 proof -
   let ?T = "{0..<n}"
   have fT: "finite ?T" by auto
   have th0: "\<And>x y. mat\<^sub>r n n (\<lambda> i. if i \<in> ?T then x i else y i) = mat\<^sub>r n n (\<lambda> i. x i)"
     by (rule eq_rowI, auto)
   have c: "(\<lambda> _. 0\<^sub>v n) \<in> ?T \<rightarrow> carrier_vec n" by auto
   show ?thesis
     by (rule det_linear_rows_finsum_lemma[OF fS fT c subset_refl a, unfolded th0])
 qed
 
 lemma det_rows_mul:
   assumes a: "a \<in> {0..<n} \<rightarrow> carrier_vec n"
   shows "det(mat\<^sub>r n n (\<lambda> i. c i \<cdot>\<^sub>v a i)) =
     prod c {0..<n} * det(mat\<^sub>r n n (\<lambda> i. a i))"
 proof -
   have A: "mat\<^sub>r n n (\<lambda> i. c i \<cdot>\<^sub>v a i) \<in> carrier_mat n n" 
   and A': "mat\<^sub>r n n (\<lambda> i. a i) \<in> carrier_mat n n" using a unfolding carrier_mat_def by auto
   show ?thesis unfolding det_def'[OF A] det_def'[OF A']
   proof (rule trans[OF sum.cong sum_distrib_left[symmetric]])
     fix p
     assume p: "p \<in> {p. p permutes {0..<n}}"
     have id: "(\<Prod>ia\<in>{0..<n}. mat\<^sub>r n n (\<lambda>i. c i \<cdot>\<^sub>v a i) $$ (ia, p ia))
       = prod c {0..<n} * (\<Prod>ia\<in>{0..<n}. mat\<^sub>r n n a $$ (ia, p ia))"
       unfolding prod.distrib[symmetric]
       by (rule prod.cong, insert p a, force+)
     show "signof p * (\<Prod>ia\<in>{0..<n}. mat\<^sub>r n n (\<lambda>i. c i \<cdot>\<^sub>v a i) $$ (ia, p ia)) =
            prod c {0..<n} * (signof p * (\<Prod>ia\<in>{0..<n}. mat\<^sub>r n n a $$ (ia, p ia)))"
       unfolding id by auto
   qed simp
 qed
 
 
 lemma mat_mul_finsum_alt:
   assumes A: "A \<in> carrier_mat nr n" and B: "B \<in> carrier_mat n nc"
   shows "A * B = mat\<^sub>r nr nc (\<lambda> i. finsum_vec TYPE('a :: semiring_0) nc (\<lambda>k. A $$ (i,k) \<cdot>\<^sub>v row B k) {0 ..< n})"
   by (rule eq_matI, insert A B, auto, subst index_finsum_vec, auto simp: scalar_prod_def intro: sum.cong)
 
 
 lemma det_mult:
   assumes A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n"
   shows "det (A * B) = det A * det (B :: 'a :: comm_ring_1 mat)"
 proof -
   let ?U = "{0 ..< n}"
   let ?F = "{f. (\<forall>i\<in> ?U. f i \<in> ?U) \<and> (\<forall>i. i \<notin> ?U \<longrightarrow> f i = i)}"
   let ?PU = "{p. p permutes ?U}"
   have fU: "finite ?U" 
     by blast
   have fF: "finite ?F"
     by (rule finite_bounded_functions, auto)
   {
     fix p
     assume p: "p permutes ?U"
     have "p \<in> ?F" unfolding mem_Collect_eq permutes_in_image[OF p]
       using p[unfolded permutes_def] by simp
   }
   then have PUF: "?PU \<subseteq> ?F" by blast
   {
     fix f
     assume fPU: "f \<in> ?F - ?PU"
     have fUU: "f ` ?U \<subseteq> ?U"
       using fPU by auto
     from fPU have f: "\<forall>i \<in> ?U. f i \<in> ?U" "\<forall>i. i \<notin> ?U \<longrightarrow> f i = i" "\<not>(\<forall>y. \<exists>!x. f x = y)"
       unfolding permutes_def by auto
     let ?A = "mat\<^sub>r n n (\<lambda> i. A $$ (i, f i) \<cdot>\<^sub>v row B (f i))"
     let ?B = "mat\<^sub>r n n (\<lambda> i. row B (f i))"
     have B': "?B \<in> carrier_mat n n"
       by (intro mat_row_carrierI)
     {
       assume fi: "inj_on f ?U"
       from inj_on_nat_permutes[OF fi] f
       have "f permutes ?U" by auto
       with fPU have False by simp
     } 
     hence fni: "\<not> inj_on f ?U" by auto
     then obtain i j where ij: "f i = f j" "i \<noteq> j" "i < n" "j < n"
       unfolding inj_on_def by auto
     from ij
     have rth: "row ?B i = row ?B j" by auto
     have "det ?A = 0" 
       by (subst det_rows_mul, unfold det_identical_rows[OF B' ij(2-4) rth], insert f A B, auto)
   }
   then have zth: "\<And> f. f \<in> ?F - ?PU \<Longrightarrow> det (mat\<^sub>r n n (\<lambda> i. A $$ (i, f i) \<cdot>\<^sub>v row B (f i))) = 0"
     by simp
   {
     fix p
     assume pU: "p \<in> ?PU"
     from pU have p: "p permutes ?U"
       by blast
     let ?s = "\<lambda>p. (signof p) :: 'a"
     let ?f = "\<lambda>q. ?s p * (\<Prod> i\<in> ?U. A $$ (i,p i)) * (?s q * (\<Prod>i\<in> ?U. B $$ (i, q i)))"
     have "(sum (\<lambda>q. ?s q *
         (\<Prod>i\<in> ?U. mat\<^sub>r n n (\<lambda> i. A $$ (i, p i) \<cdot>\<^sub>v row B (p i)) $$ (i, q i))) ?PU) =
       (sum (\<lambda>q. ?s p * (\<Prod> i\<in> ?U. A $$ (i,p i)) * (?s q * (\<Prod> i\<in> ?U. B $$ (i, q i)))) ?PU)"
       unfolding sum_permutations_compose_right[OF permutes_inv[OF p], of ?f]
     proof (rule sum.cong[OF refl])
       fix q
       assume "q \<in> {q. q permutes ?U}"
       hence q: "q permutes ?U" by simp
       from p q have pp: "permutation p" and pq: "permutation q"
         unfolding permutation_permutes by auto
       note sign = signof_compose[OF q permutes_inv[OF p], unfolded signof_inv[OF fU p]]
       let ?inv = "Hilbert_Choice.inv"
       have th001: "prod (\<lambda>i. B$$ (i, q (?inv p i))) ?U = prod ((\<lambda>i. B$$ (i, q (?inv p i))) \<circ> p) ?U"
         by (rule prod.permute[OF p])
       have thp: "prod (\<lambda>i. mat\<^sub>r n n (\<lambda> i. A$$(i,p i) \<cdot>\<^sub>v row B (p i)) $$ (i, q i)) ?U =
         prod (\<lambda>i. A$$(i,p i)) ?U * prod (\<lambda>i. B$$ (i, q (?inv p i))) ?U"
         unfolding th001 o_def permutes_inverses[OF p]
         by (subst prod.distrib[symmetric], insert A p q B, auto intro: prod.cong)
       define AA where "AA = (\<Prod>i\<in>?U. A $$ (i, p i))"
       define BB where "BB = (\<Prod>ia\<in>{0..<n}. B $$ (ia, q (?inv p ia)))"
       have "?s q * (\<Prod>ia\<in>{0..<n}. mat\<^sub>r n n (\<lambda>i. A $$ (i, p i) \<cdot>\<^sub>v row B (p i)) $$ (ia, q ia)) =
          ?s p * (\<Prod>i\<in>{0..<n}. A $$ (i, p i)) * (?s (q \<circ> ?inv p) * (\<Prod>ia\<in>{0..<n}. B $$ (ia, q (?inv p ia))))"
         unfolding sign thp
         unfolding AA_def[symmetric] BB_def[symmetric]
-        by (simp add: ac_simps signof_def)
+        by (simp add: ac_simps flip: of_int_mult)
       thus "?s q * (\<Prod>i = 0..<n. mat\<^sub>r n n (\<lambda>i. A $$ (i, p i) \<cdot>\<^sub>v row B (p i)) $$ (i, q i)) =
          ?s p * (\<Prod>i = 0..<n. A $$ (i, p i)) *
          (?s (q \<circ> ?inv p) * (\<Prod>i = 0..<n. B $$ (i, (q \<circ> ?inv p) i)))" by simp
     qed 
   } note * = this
   have th2: "sum (\<lambda>f. det (mat\<^sub>r n n (\<lambda> i. A$$(i,f i) \<cdot>\<^sub>v row B (f i)))) ?PU = det A * det B"
     unfolding det_def'[OF A] det_def'[OF B] det_def'[OF mat_row_carrierI]
     unfolding sum_product dim_row_mat
     by (rule sum.cong, insert A, force, subst *, insert A B, auto)
   let ?f = "\<lambda> f. det (mat\<^sub>r n n (\<lambda> i. A $$ (i, f i) \<cdot>\<^sub>v row B (f i)))"
   have "det (A * B) = sum ?f ?F"
     unfolding mat_mul_finsum_alt[OF A B]
     by (rule det_linear_rows_sum[OF fU], insert A B, auto)
   also have "\<dots> = sum ?f ((?F - ?PU) \<union> (?F \<inter> ?PU))"
     by (rule arg_cong[where f = "sum ?f"], auto)
   also have "\<dots> = sum ?f (?F - ?PU) + sum ?f (?F \<inter> ?PU)"
     by (rule sum.union_disjoint, insert A B finite_bounded_functions[OF fU fU], auto)
   also have "sum ?f (?F - ?PU) = 0"
     by (rule sum.neutral, insert zth, auto)
   also have "?F \<inter> ?PU = ?PU" unfolding permutes_def by fastforce
   also have "sum ?f ?PU = det A * det B"
     unfolding th2 ..
   finally show ?thesis by simp
 qed
 
 lemma unit_imp_det_non_zero: assumes "A \<in> Units (ring_mat TYPE('a :: comm_ring_1) n b)"
    shows "det A \<noteq> 0"
 proof -
   from assms[unfolded Units_def ring_mat_def]
   obtain B where A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n" and BA: "B * A = 1\<^sub>m n" by auto
   from arg_cong[OF BA, of det, unfolded det_mult[OF B A] det_one]
   show ?thesis by auto
 qed
 
 text \<open>The following proof is based on the Gauss-Jordan algorithm.\<close>
 
 lemma det_non_zero_imp_unit: assumes A: "A \<in> carrier_mat n n"
   and dA: "det A \<noteq> (0 :: 'a :: field)"
   shows "A \<in> Units (ring_mat TYPE('a) n b)"
 proof (rule ccontr)
   let ?g = "gauss_jordan A (0\<^sub>m n 0)"
   let ?B = "fst ?g"
   obtain B C where B: "?g = (B,C)" by (cases ?g)
   assume "\<not> ?thesis"
   from this[unfolded gauss_jordan_check_invertable[OF A zero_carrier_mat[of n 0]] B]
   have "B \<noteq> 1\<^sub>m n" by auto
   with row_echelon_form_imp_1_or_0_row[OF gauss_jordan_carrier(1)[OF A _ B] gauss_jordan_row_echelon[OF A B], of 0]
   have n: "0 < n" and row: "row B (n - 1) = 0\<^sub>v n" by auto
   let ?n = "n - 1"
   from n have n1: "?n < n" by auto
   from gauss_jordan_transform[OF A _ B, of 0 b] obtain P
     where P: "P\<in>Units (ring_mat TYPE('a) n b)" and PA: "B = P * A" by auto
   from unit_imp_det_non_zero[OF P] have dP: "det P \<noteq> 0" by auto
   from P have P: "P \<in> carrier_mat n n" unfolding Units_def ring_mat_def by auto
   from det_mult[OF P A] dP dA have "det B \<noteq> 0" unfolding PA by simp
   also have "det B = 0" 
   proof -
     from gauss_jordan_carrier[OF A _ B, of 0] have B: "B \<in> carrier_mat n n" by auto
     {
       fix j
       assume j: "j < n"
       from index_row(1)[symmetric, of ?n B j, unfolded row] B
       have "B $$ (?n, j) = 0" using B n j by auto
     }
     hence "B = mat\<^sub>r n n (\<lambda>i. if i = ?n then 0\<^sub>v n else row B i)"
       by (intro eq_matI, insert B, auto)
     also have "det \<dots> = 0"
       by (rule det_row_0[OF n1], insert B, auto)
     finally show "det B = 0" .
   qed 
   finally show False by simp
 qed
 
 lemma mat_mult_left_right_inverse: assumes A: "(A :: 'a :: field mat) \<in> carrier_mat n n" 
   and B: "B \<in> carrier_mat n n" and AB: "A * B = 1\<^sub>m n"
   shows "B * A = 1\<^sub>m n"
 proof -
   let ?R = "ring_mat TYPE('a) n undefined"
   from det_mult[OF A B, unfolded AB] have "det A \<noteq> 0" "det B \<noteq> 0" by auto
   from det_non_zero_imp_unit[OF A this(1)] det_non_zero_imp_unit[OF B this(2)]  
   have U: "A \<in> Units ?R" "B \<in> Units ?R" .
   interpret ring ?R by (rule ring_mat)
   from Units_inv_comm[unfolded ring_mat_simps, OF AB U] show ?thesis .
 qed
 
 lemma det_zero_imp_zero_row: assumes A: "(A :: 'a :: field mat) \<in> carrier_mat n n"
   and det: "det A = 0"
   shows "\<exists> P. P \<in> Units (ring_mat TYPE('a) n b) \<and> row (P * A) (n - 1) = 0\<^sub>v n \<and> 0 < n
     \<and> row_echelon_form (P * A)"
 proof -
   let ?R = "ring_mat TYPE('a) n b"
   let ?U = "Units ?R"
   interpret m: ring ?R by (rule ring_mat)
   let ?g = "gauss_jordan A A"
   obtain A' B' where g: "?g = (A', B')" by (cases ?g)
   from det unit_imp_det_non_zero[of A n b] have AU: "A \<notin> ?U" by auto
   with gauss_jordan_inverse_one_direction(1)[OF A A, of _ b]
   have A'1: "A' \<noteq> 1\<^sub>m n" using g by auto
   from gauss_jordan_carrier(1)[OF A A g] have A': "A' \<in> carrier_mat n n" by auto
   from gauss_jordan_row_echelon[OF A g] have re: "row_echelon_form A'" .
   from row_echelon_form_imp_1_or_0_row[OF A' this] A'1
   have n: "0 < n" and row: "row A' (n - 1) = 0\<^sub>v n" by auto
   from gauss_jordan_transform[OF A A g, of b] obtain P
     where P: "P \<in> ?U" and A': "A' = P * A" by auto
   thus ?thesis using n row re by auto
 qed
 
 lemma det_0_iff_vec_prod_zero_field: assumes A: "(A :: 'a :: field mat) \<in> carrier_mat n n"
   shows "det A = 0 \<longleftrightarrow> (\<exists> v. v \<in> carrier_vec n \<and> v \<noteq> 0\<^sub>v n \<and> A *\<^sub>v v = 0\<^sub>v n)" (is "?l = (\<exists> v. ?P v)")
 proof -
   let ?R = "ring_mat TYPE('a) n ()"
   let ?U = "Units ?R"
   interpret m: ring ?R by (rule ring_mat)
   show ?thesis
   proof (cases "det A = 0")
     case False
     from det_non_zero_imp_unit[OF A this, of "()"]
     have "A \<in> ?U" .
     then obtain B where unit: "B * A = 1\<^sub>m n" and B: "B \<in> carrier_mat n n"
       unfolding Units_def ring_mat_def by auto
     {
       fix v
       assume "?P v"
       hence v: "v \<in> carrier_vec n" "v \<noteq> 0\<^sub>v n" "A *\<^sub>v v = 0\<^sub>v n" by auto
       have "v = (B * A) *\<^sub>v v" using v B unfolding unit by auto
       also have "\<dots> = B *\<^sub>v (A *\<^sub>v v)" using B A v by simp
       also have "\<dots> = B *\<^sub>v 0\<^sub>v n" unfolding v ..
       also have "\<dots> = 0\<^sub>v n" using B by auto
       finally have False using v by simp
     }
     with False show ?thesis by blast
   next
     case True
     let ?n = "n - 1"
     from det_zero_imp_zero_row[OF A True, of "()"]
     obtain P where PU: "P \<in> ?U" and row: "row (P * A) ?n = 0\<^sub>v n" and n: "0 < n" "?n < n"
       and re: "row_echelon_form (P * A)" by auto
     define PA where "PA = P * A"
     note row = row[folded PA_def]
     note re = re[folded PA_def]
     from PU obtain Q where P: "P \<in> carrier_mat n n" and Q: "Q \<in> carrier_mat n n"
       and unit: "Q * P = 1\<^sub>m n" "P * Q =  1\<^sub>m n" unfolding Units_def ring_mat_def by auto    
     from P A have PA: "PA \<in> carrier_mat n n" and dimPA: "dim_row PA = n" unfolding PA_def by auto
     from re[unfolded row_echelon_form_def] obtain p where p: "pivot_fun PA p n" using PA by auto 
     note piv = pivot_positions[OF PA p]
     note pivot = pivot_funD[OF dimPA p n(2)]
     {
       assume "p ?n < n"
       with pivot(4)[OF this] n arg_cong[OF row, of "\<lambda> v. v $ p ?n"] have False using PA by auto
     }
     with pivot(1) have pn: "p ?n = n" by fastforce
     with piv(1) have "set (pivot_positions PA) \<subseteq>  {(i, p i) |i. i < n \<and> p i \<noteq> n} - {(?n,p ?n)}" by auto
     also have "\<dots> \<subseteq> {(i, p i) | i. i < ?n}" using n by force
     finally have "card (set (pivot_positions PA)) \<le> card {(i, p i) | i. i < ?n}"
       by (intro card_mono, auto)
     also have "{(i, p i) | i. i < ?n} = (\<lambda> i. (i, p i)) ` {0 ..< ?n}" by auto
     also have "card \<dots> = card {0 ..< ?n}" by (rule card_image, auto simp: inj_on_def)
     also have "\<dots> < n" using n by simp
     finally have "card (set (pivot_positions PA)) < n" .
     hence "card (snd ` (set (pivot_positions PA))) < n" 
       using card_image_le[OF finite_set, of snd "pivot_positions PA"] by auto
     hence neq: "snd ` (set (pivot_positions PA)) \<noteq> {0 ..< n}" by auto
     from find_base_vector[OF re PA neq] obtain v where v: "v \<in> carrier_vec n"
       and v0: "v \<noteq> 0\<^sub>v n" and pav: "PA *\<^sub>v v = 0\<^sub>v n" by auto
     have "A *\<^sub>v v = Q * P *\<^sub>v (A *\<^sub>v v)" unfolding unit using A v by auto
     also have "\<dots> = Q *\<^sub>v (PA *\<^sub>v v)" unfolding PA_def using Q P A v by auto
     also have "PA *\<^sub>v v = 0\<^sub>v n" unfolding pav ..
     also have "Q *\<^sub>v 0\<^sub>v n = 0\<^sub>v n" using Q by auto
     finally have Av: "A *\<^sub>v v = 0\<^sub>v n" by auto
     show ?thesis unfolding True using Av v0 v by auto
   qed
 qed
 
 text \<open>In order to get the result for integral domains, we embed the domain in its
   fraction field, and then apply the result for fields.\<close>
 lemma det_0_iff_vec_prod_zero: assumes A: "(A :: 'a :: idom mat) \<in> carrier_mat n n"
   shows "det A = 0 \<longleftrightarrow> (\<exists> v. v \<in> carrier_vec n \<and> v \<noteq> 0\<^sub>v n \<and> A *\<^sub>v v = 0\<^sub>v n)"
 proof -
   let ?h = "to_fract :: 'a \<Rightarrow> 'a fract"
   let ?A = "map_mat ?h A"
   have A': "?A \<in> carrier_mat n n" using A by auto
   interpret inj_comm_ring_hom ?h by (unfold_locales, auto)
   have "(det A = 0) = (?h (det A) = ?h 0)" by auto
   also have "\<dots> = (det ?A = 0)" unfolding hom_zero hom_det ..
   also have "\<dots> = ((\<exists> v. v \<in> carrier_vec n \<and> v \<noteq> 0\<^sub>v n \<and> ?A *\<^sub>v v = 0\<^sub>v n))"
     unfolding det_0_iff_vec_prod_zero_field[OF A'] ..
   also have "\<dots> = ((\<exists> v. v \<in> carrier_vec n \<and> v \<noteq> 0\<^sub>v n \<and> A *\<^sub>v v = 0\<^sub>v n))" (is "?l = ?r")
   proof
     assume ?r
     then obtain v where v: "v \<in> carrier_vec n" "v \<noteq> 0\<^sub>v n" "A *\<^sub>v v = 0\<^sub>v n" by auto
     show ?l
       by (rule exI[of _ "map_vec ?h v"], insert v, auto simp: mult_mat_vec_hom[symmetric, OF A v(1)])
   next
     assume ?l
     then obtain v where v: "v \<in> carrier_vec n" and v0: "v \<noteq> 0\<^sub>v n" and Av: "?A *\<^sub>v v = 0\<^sub>v n" by auto
     have "\<forall> i. \<exists> a b. v $ i = Fraction_Field.Fract a b \<and> b \<noteq> 0" using Fract_cases[of "v $ i" for i] by metis
     from choice[OF this] obtain a where "\<forall> i. \<exists> b. v $ i = Fraction_Field.Fract (a i) b \<and> b \<noteq> 0" by metis
     from choice[OF this] obtain b where vi: "\<And> i. v $ i = Fraction_Field.Fract (a i) (b i)" and bi: "\<And> i. b i \<noteq> 0" by auto
     define m where "m = prod_list (map b [0..<n])"
     let ?m = "?h m"
     have m0: "m \<noteq> 0" unfolding m_def hom_0_iff prod_list_zero_iff using bi by auto
     from v0[unfolded vec_eq_iff] v obtain i where i: "i < n" "v $ i \<noteq> 0" by auto
     {
       fix i
       assume "i < n"
       hence "b i \<in> set (map b [0 ..< n])" by auto
       from split_list[OF this]
         obtain ys zs where "map b [0..<n] = ys @ b i # zs" by auto
       hence "b i dvd m" unfolding m_def by auto
       then obtain c where "m = b i * c" ..
       hence "?m * v $ i = ?h (a i * c)" unfolding vi using bi[of i]
         by (simp add: eq_fract to_fract_def)
       hence "\<exists> c. ?m * v $ i = ?h c" ..
     }
     hence "\<forall> i. \<exists> c. i < n \<longrightarrow> ?m * v $ i = ?h c" by auto
     from choice[OF this] obtain c where c: "\<And> i. i < n \<Longrightarrow> ?m * v $ i = ?h (c i)" by auto
     define w where "w = vec n c"
     have w: "w \<in> carrier_vec n" unfolding w_def by simp
     have mvw: "?m \<cdot>\<^sub>v v = map_vec ?h w" unfolding w_def using c v
       by (intro eq_vecI, auto)
     with m0 i c[OF i(1)] have "w $ i \<noteq> 0" unfolding w_def by auto
     with i w have w0: "w \<noteq> 0\<^sub>v n" by auto
     from arg_cong[OF Av, of "\<lambda> v. ?m \<cdot>\<^sub>v v"]
     have "?m \<cdot>\<^sub>v (?A *\<^sub>v v) = map_vec ?h (0\<^sub>v n)" by auto
     also have "?m \<cdot>\<^sub>v (?A *\<^sub>v v) = ?A *\<^sub>v (?m \<cdot>\<^sub>v v)" using A v by auto
     also have "\<dots> = ?A *\<^sub>v (map_vec ?h w)" unfolding mvw ..
     also have "\<dots> = map_vec ?h (A *\<^sub>v w)" unfolding mult_mat_vec_hom[OF A w] ..
     finally have "A *\<^sub>v w = 0\<^sub>v n" by (rule vec_hom_inj)
     with w w0 show ?r by blast
   qed
   finally show ?thesis .
 qed
 
 lemma det_0_negate: assumes  A: "(A :: 'a :: field mat) \<in> carrier_mat n n"
   shows "(det (- A) = 0) = (det A = 0)"
 proof -
   from A have mA: "- A \<in> carrier_mat n n" by auto
   {
     fix v :: "'a vec"
     assume v: "v \<in> carrier_vec n"
     hence Av: "A *\<^sub>v v \<in> carrier_vec n" using A by auto
     have id: "- A *\<^sub>v v = - (A *\<^sub>v v)" using v A by simp
     have "(- A *\<^sub>v v = 0\<^sub>v n) = (A *\<^sub>v v = 0\<^sub>v n)" unfolding id 
       unfolding uminus_zero_vec_eq[OF Av] ..
   }
   thus ?thesis unfolding det_0_iff_vec_prod_zero[OF A] det_0_iff_vec_prod_zero[OF mA] by auto
 qed
   
 lemma det_multrow: 
   assumes k: "k < n" and A: "A \<in> carrier_mat n n"
   shows "det (multrow k a A) = a * det A"
 proof -
   have "multrow k a A = multrow_mat n k a * A"
     by (rule multrow_mat[OF A])
   also have "det (multrow_mat n k a * A) = det (multrow_mat n k a) * det A"
     by (rule det_mult[OF _ A], auto)
   also have "det (multrow_mat n k a) = a"
     by (rule det_multrow_mat[OF k])
   finally show ?thesis .
 qed
 
 lemma det_multrow_div:
   assumes k: "k < n" and A: "A \<in> carrier_mat n n" and a0: "a \<noteq> 0"
   shows "det (multrow k a A :: 'a :: idom_divide mat) div a = det A"
 proof -
   have "det (multrow k a A) div a = a * det A div a" using k A
     by (simp add: det_multrow)
   also have "... = det A" using a0 by auto
   finally show ?thesis.
 qed
 
 lemma det_addrow: 
   assumes l: "l < n" and k: "k \<noteq> l" and A: "A \<in> carrier_mat n n"
   shows "det (addrow a k l A) = det A"
 proof -
   have "addrow a k l A = addrow_mat n a k l * A"
     by (rule addrow_mat[OF A l])
   also have "det (addrow_mat n a k l * A) = det (addrow_mat n a k l) * det A"
     by (rule det_mult[OF _ A], auto)
   also have "det (addrow_mat n a k l) = 1"
     by (rule det_addrow_mat[OF k])
   finally show ?thesis using A by simp
 qed
 
 lemma det_swaprows: 
   assumes *: "k < n" "l < n" and k: "k \<noteq> l" and A: "A \<in> carrier_mat n n"
   shows "det (swaprows k l A) = - det A"
 proof -
   have "swaprows k l A = swaprows_mat n k l * A"
     by (rule swaprows_mat[OF A *])
   also have "det (swaprows_mat n k l * A) = det (swaprows_mat n k l) * det A"
     by (rule det_mult[OF _ A], insert A, auto)
   also have "det (swaprows_mat n k l) = - 1"
     by (rule det_swaprows_mat[OF * k])
   finally show ?thesis using A by simp
 qed
 
 lemma det_similar: assumes "similar_mat A B" 
   shows "det A = det B"
 proof -
   from similar_matD[OF assms] obtain n P Q where
   carr: "{A, B, P, Q} \<subseteq> carrier_mat n n" (is "_ \<subseteq> ?C")
   and PQ: "P * Q = 1\<^sub>m n" 
   and AB: "A = P * B * Q" by blast
   hence A: "A \<in> ?C" and B: "B \<in> ?C" and P: "P \<in> ?C" and Q: "Q \<in> ?C" by auto  
   from det_mult[OF P Q, unfolded PQ] have PQ: "det P * det Q = 1" by auto
   from det_mult[OF _ Q, of "P * B", unfolded det_mult[OF P B] AB[symmetric]] P B
   have "det A = det P * det B * det Q" by auto
   also have "\<dots> = (det P * det Q) * det B" by (simp add: ac_simps)
   also have "\<dots> = det B" unfolding PQ by simp
   finally show ?thesis .
 qed
 
 lemma det_four_block_mat_upper_right_zero_col: assumes A1: "A1 \<in> carrier_mat n n"
   and A20: "A2 = (0\<^sub>m n 1)" and A3: "A3 \<in> carrier_mat 1 n"
   and A4: "A4 \<in> carrier_mat 1 1"
   shows "det (four_block_mat A1 A2 A3 A4) = det A1 * det A4" (is "det ?A = _")
 proof -
   let ?A = "four_block_mat A1 A2 A3 A4"
   from A20 have A2: "A2 \<in> carrier_mat n 1" by auto  
   define A where "A = ?A"
   from four_block_carrier_mat[OF A1 A4] A1
   have A: "A \<in> carrier_mat (Suc n) (Suc n)" and dim: "dim_row A1 = n" unfolding A_def by auto
   let ?Pn = "\<lambda> p. p permutes {0 ..< n}"
   let ?Psn = "\<lambda> p. p permutes {0 ..< Suc n}"
   let ?perm = "{p. ?Psn p}"
   let ?permn = "{p. ?Pn p}"
   let ?prod = "\<lambda> p. signof p * (\<Prod>i = 0..<Suc n. A $$ (p i, i))"
   let ?prod' = "\<lambda> p. A $$ (p n, n) * signof p * (\<Prod>i = 0..<n. A $$ (p i, i))"
   let ?prod'' = "\<lambda> p. signof p * (\<Prod>i = 0..< n. A $$ (p i, i))"
   let ?prod''' = "\<lambda> p. signof p * (\<Prod>i = 0..< n. A1 $$ (p i, i))"
   let ?p0 = "{p. p 0 = 0}"
   have [simp]: "{0..<Suc n} - {n} = {0..< n}" by auto
   {
     fix p
     assume "?Psn p"
     have "?prod p = signof p * (A $$ (p n, n) * (\<Prod> i \<in> {0..< n}. A $$ (p i, i)))"
       by (subst prod.remove[of _ n], auto)
     also have "\<dots> = A $$ (p n, n) * signof p * (\<Prod> i \<in> {0..< n}. A $$ (p i, i))" by simp
     finally have "?prod p = ?prod' p" .
   } note prod_id = this
   define prod' where "prod' = ?prod'"
   {
     fix i q
     assume i: "i \<in> {0..< n}" "q permutes {0 ..< n}"
     hence "Fun.swap n i id (q n) < n" 
       unfolding permutes_def by auto
     hence "A $$ (Fun.swap n i id (q n), n) = 0"
       unfolding A_def using A1 A20 A3 A4 by auto
     hence "prod' (Fun.swap n i id \<circ> q) = 0"
       unfolding prod'_def by simp 
   } note zero = this
   have cong: "\<And> a b c. b = c \<Longrightarrow> a * b = a * c" by auto
   have "det ?A = sum ?prod ?perm"
     unfolding A_def[symmetric] using mat_det_left_def[OF A] A by simp
   also have "\<dots> = sum prod' ?perm" unfolding prod'_def
     by (rule sum.cong[OF refl], insert prod_id, auto)
   also have "{0 ..< Suc n} = insert n {0 ..< n}" by auto
   also have "sum prod' {p. p permutes \<dots>} = 
     (\<Sum>i\<in>insert n {0..<n}. \<Sum>q\<in>?permn. prod' (Fun.swap n i id \<circ> q))"
     by (subst sum_over_permutations_insert, auto)
   also have "\<dots> = (\<Sum>q\<in>?permn. prod' q) +
     (\<Sum>i\<in>{0..<n}. \<Sum>q\<in>?permn. prod' (Fun.swap n i id \<circ> q))"
     by (subst sum.insert, auto)
   also have "(\<Sum>i\<in>{0..<n}. \<Sum>q\<in>?permn. prod' (Fun.swap n i id \<circ> q)) = 0"
     by (rule sum.neutral, intro ballI, rule sum.neutral, intro ballI, rule zero, auto)
   also have "(\<Sum>q\<in> ?permn. prod' q) = A $$ (n,n) * (\<Sum>q\<in> ?permn. ?prod'' q)"
     unfolding prod'_def
     by (subst sum_distrib_left, rule sum.cong[OF refl], auto simp: permutes_def ac_simps)
   also have "A $$ (n,n) = A4 $$ (0,0)" unfolding A_def using A1 A2 A3 A4 by auto
   also have "(\<Sum>q\<in> ?permn. ?prod'' q) = (\<Sum>q\<in> ?permn. ?prod''' q)" 
     by (rule sum.cong[OF refl], rule cong, rule prod.cong,
     insert A1 A2 A3 A4, auto simp: permutes_def A_def)
   also have "\<dots> = det A1"
     unfolding mat_det_left_def[OF A1] dim by auto
   also have "A4 $$ (0,0) = det A4"
-    using A4 unfolding det_def[of A4] by (auto simp: signof_def sign_def)
+    using A4 unfolding det_def[of A4] by (auto simp: sign_def)
   finally show ?thesis by simp
 qed
 
 lemma det_swap_initial_rows: assumes A: "A \<in> carrier_mat m m" 
   and lt: "k + n \<le> m" 
   shows "det A = (- 1) ^ (k * n) *
     det (mat m m (\<lambda>(i, j). A $$ (if i < n then i + k else if i < k + n then i - n else i, j)))" 
 proof -
   define sw where "sw = (\<lambda> (A :: 'a mat) xs. fold (\<lambda> (i,j). swaprows i j) xs A)"
   have dim_sw[simp]: "dim_row (sw A xs) = dim_row A" "dim_col (sw A xs) = dim_col A" for xs A
     unfolding sw_def by (induct xs arbitrary: A, auto)
   {
     fix xs and A :: "'a mat"
     assume "dim_row A = dim_col A" "\<And> i j. (i,j) \<in> set xs \<Longrightarrow> i < dim_col A \<and> j < dim_col A \<and> i \<noteq> j"
     hence "det (sw A xs) = (-1)^(length xs) * det A"
       unfolding sw_def
     proof (induct xs arbitrary: A)
       case (Cons xy xs A)
       obtain x y where xy: "xy = (x,y)" by force
       from Cons(3)[unfolded xy, of x y] Cons(2)
       have [simp]: "det (swaprows x y A) = - det A"
         by (intro det_swaprows, auto)
       show ?case unfolding xy by (simp, insert Cons(2-), (subst Cons(1), auto)+)
     qed simp
   } note sw = this
   define swb where "swb = (\<lambda> A i n. sw A (map (\<lambda> j. (j,Suc j)) [i ..< i + n]))"
   {
     fix k n and A :: "'a mat"
     assume k_n: "k + n < dim_row A"
     hence "swb A k n = mat (dim_row A) (dim_col A) (\<lambda> (i,j). let r = 
       (if i < k \<or> i > k + n then i else if i = k + n then k else Suc i)
       in A $$ (r,j))"
     proof (induct n)
       case 0
       show ?case unfolding swb_def sw_def by (rule eq_matI, auto)
     next
       case (Suc n)
       hence dim: "k + n < dim_row A" by auto
       have id: "swb A k (Suc n) = swaprows (k + n) (Suc k + n) (swb A k n)" unfolding swb_def sw_def by simp
       show ?case unfolding id Suc(1)[OF dim]
         by (rule eq_matI, insert Suc(2), auto)
     qed
   } note swb = this
   define swbl where "swbl = (\<lambda> A k n. fold (\<lambda> i A. swb A i n) (rev [0 ..< k]) A)"
   {
     fix k n and A :: "'a mat"
     assume k_n: "k + n \<le> dim_row A"
     hence "swbl A k n = mat (dim_row A) (dim_col A) (\<lambda> (i,j). let r = 
       (if i < n then i + k else if i < k + n then i - n else i)
       in A $$ (r,j))"
     proof (induct k arbitrary: A)
       case 0
       thus ?case unfolding swbl_def by (intro eq_matI, auto simp: swb)
     next
       case (Suc k)
       hence dim: "k + n < dim_row A" by auto
       have id: "swbl A (Suc k) n = swbl (swb A k n) k n" unfolding swbl_def by simp
       show ?case unfolding id swb[OF dim]
         by (subst Suc(1), insert dim, force, intro eq_matI, auto simp: less_Suc_eq_le) 
     qed
   } note swbl = this
   {
     fix k n and A :: "'a mat"
     assume k_n: "k + n \<le> dim_col A" "dim_row A = dim_col A" 
     hence "det (swbl A k n) = (-1)^(k*n) * det A" 
     proof (induct k arbitrary: A)
       case 0
       thus ?case unfolding swbl_def by auto
     next
       case (Suc k)
       hence dim: "k + n < dim_row A" by auto
       have id: "swbl A (Suc k) n = swbl (swb A k n) k n" unfolding swbl_def by simp
       have det: "det (swb A k n) = (-1)^n * det A" unfolding swb_def
         by (subst sw, insert Suc(2-), auto)
       show ?case unfolding id 
         by (subst Suc(1), insert Suc(2-), auto simp: det, auto simp: swb power_add)
     qed
   } note det_swbl = this
   from assms have dim: "dim_row A = dim_col A" "k + n \<le> dim_col A" "k + n \<le> dim_row A" "dim_col A = m" by auto
   from arg_cong[OF det_swbl[OF dim(2,1), unfolded swbl[OF dim(3)], unfolded Let_def dim], 
       of  "\<lambda> x. (-1)^(k*n) * x"]
   show ?thesis by simp
 qed
 
 lemma det_swap_rows: assumes A: "A \<in> carrier_mat (k + n) (k + n)" 
   shows "det A = (-1)^(k * n) * det (mat (k + n) (k + n) (\<lambda> (i,j). 
     A $$ ((if i < k then i + n else i - k),j)))" 
 proof -
   have le: "n + k \<le> k + n" by simp
   show ?thesis unfolding det_swap_initial_rows[OF A le]
     by (intro arg_cong2[of _ _ _ _ "\<lambda> x y. ((-1)^x * det y)"], force, intro eq_matI, auto)
 qed
 
 lemma det_swap_final_rows: assumes A: "A \<in> carrier_mat m m"
   and m: "m = l + k + n" 
   shows "det A = (- 1) ^ (k * n) *
     det (mat m m (\<lambda>(i, j). A $$ (if i < l then i else if i < l + n then i + k else i - n, j)))" 
     (is "_ = _ * det ?M")
 proof -
   (* l k n -swap-rows\<rightarrow> k n l -swap-initial\<rightarrow> n k l -swap-rows\<rightarrow> l n k *)
   have m1: "m = (k + n) + l" using m by simp
   have m2: "k + n \<le> m" using m by simp
   have m3: "m = l + (n + k)" using m by simp
   define M where "M = ?M" 
   let ?M1 = "mat m m (\<lambda>(i, j). A $$ (if i < k + n then i + l else i - (k + n), j))" 
   let ?M2 = "mat m m
           (\<lambda>(i, j). A $$ (if i < n then i + k + l else if i < k + n then i - n + l else i - (k + n), j))" 
   have M2: "?M2 \<in> carrier_mat m m" by auto
   have "det A = (- 1) ^ ((k + n) * l) * det ?M1" 
     unfolding det_swap_rows[OF A[unfolded m1]] m1[symmetric] by simp
   also have "det ?M1 = (- 1) ^ (k * n) * det ?M2"
     by (subst det_swap_initial_rows[OF _ m2], force, rule arg_cong[of _ _ "\<lambda> x. _ * det x"],
     rule eq_matI, auto simp: m)
   also have "det ?M2 = (- 1) ^ (l * (n + k)) * det M" 
     unfolding M_def det_swap_rows[OF M2[unfolded m3], folded m3]
     by (rule arg_cong[of _ _ "\<lambda> x. _ * det x"], rule eq_matI, auto simp: m)
   finally have "det A = (-1) ^ ((k + n) * l + (k * n) + l * (n + k)) * det M" (is "_ = ?b ^ _ * _")
     by (simp add: power_add)
   also have "(k + n) * l + (k * n) + l * (n + k) = 2 * (l * (n + k)) + k * n" by simp
   also have "?b ^ \<dots> = ?b ^ (k * n)" by (simp add: power_add)
   finally show ?thesis unfolding M_def .
 qed
 
 lemma det_swap_final_cols: assumes A: "A \<in> carrier_mat m m"
   and m: "m = l + k + n" 
   shows "det A = (- 1) ^ (k * n) *
     det (mat m m (\<lambda>(i, j). A $$ (i, if j < l then j else if j < l + n then j + k else j - n)))" 
 proof -
   have "det A = det (A\<^sup>T)" unfolding det_transpose[OF A] ..
   also have "\<dots> = (- 1) ^ (k * n) *
     det (mat m m (\<lambda>(i, j). A\<^sup>T $$ (if i < l then i else if i < l + n then i + k else i - n, j)))" 
     (is "_ = _ * det ?M")
     by (rule det_swap_final_rows[OF _ m], insert A, auto)
   also have "det ?M = det (?M\<^sup>T)" by (subst det_transpose, auto)
   also have "?M\<^sup>T = mat m m (\<lambda>(i, j). A $$ (i, if j < l then j else if j < l + n then j + k else j - n))" 
     unfolding transpose_mat_def using A m
     by (intro eq_matI, auto)
   finally show ?thesis .
 qed
 
 lemma det_swap_initial_cols: assumes A: "A \<in> carrier_mat m m" 
   and lt: "k + n \<le> m" 
   shows "det A = (- 1) ^ (k * n) *
     det (mat m m (\<lambda>(i, j). A $$ (i, if j < n then j + k else if j < k + n then j - n else j)))" 
 proof -
   have "det A = det (A\<^sup>T)" unfolding det_transpose[OF A] ..
   also have "\<dots> = (- 1) ^ (k * n) *
     det (mat m m (\<lambda>(j, i). A\<^sup>T $$ (if j < n then j + k else if j < k + n then j - n else j,i)))" 
     (is "_ = _ * det ?M")
     by (rule det_swap_initial_rows[OF _ lt], insert A, auto)
   also have "det ?M = det (?M\<^sup>T)" by (subst det_transpose, auto)
   also have "?M\<^sup>T = mat m m (\<lambda>(i, j). A $$ (i, if j < n then j + k else if j < k + n then j - n else j))" 
     unfolding transpose_mat_def using A lt
     by (intro eq_matI, auto)
   finally show ?thesis .
 qed
   
 lemma det_swap_cols: assumes A: "A \<in> carrier_mat (k + n) (k + n)" 
   shows "det A = (-1)^(k * n) * det (mat (k + n) (k + n) (\<lambda> (i,j). 
    A $$ (i,(if j < k then j + n else j - k))))" (is "_ = _ * det ?B")
 proof -
   have le: "n + k \<le> k + n" by simp
   show ?thesis unfolding det_swap_initial_cols[OF A le]
     by (intro arg_cong2[of _ _ _ _ "\<lambda> x y. ((-1)^x * det y)"], force, intro eq_matI, auto)
 qed  
   
 lemma det_four_block_mat_upper_right_zero: fixes A1 :: "'a :: idom mat" 
   assumes A1: "A1 \<in> carrier_mat n n"
   and A20: "A2 = (0\<^sub>m n m)" and A3: "A3 \<in> carrier_mat m n"
   and A4: "A4 \<in> carrier_mat m m"  
 shows "det (four_block_mat A1 A2 A3 A4) = det A1 * det A4" 
   using assms(2-)
 proof (induct m arbitrary: A2 A3 A4)  
   case (0 A2 A3 A4)
   hence *: "four_block_mat A1 A2 A3 A4 = A1" using A1
     by (intro eq_matI, auto)
   from 0 have 4: "A4 = 1\<^sub>m 0" by auto
   show ?case unfolding * unfolding 4 by simp
 next
   case (Suc m A2 A3 A4)    
   let ?m = "Suc m" 
   from Suc have A2: "A2 \<in> carrier_mat n ?m" by auto
   note A20 = Suc(2)
   note A34 = Suc(3-4)
   let ?A = "four_block_mat A1 A2 A3 A4" 
   let ?P = "\<lambda> B3 B4 v k. v \<noteq> 0 \<and> v * det ?A = det (four_block_mat A1 A2 B3 B4)
     \<and> v * det A4 = det B4 \<and> B3 \<in> carrier_mat ?m n \<and> B4 \<in> carrier_mat ?m ?m \<and> (\<forall> i < k. B4 $$ (i,m) = 0)" 
   have "k \<le> m \<Longrightarrow> \<exists> B3 B4 v. ?P B3 B4 v k" for k
   proof (induct k)
     case 0
     have "?P A3 A4 1 0" using A34 by auto
     thus ?case by blast
   next
     case (Suc k)
     then obtain B3 B4 v where v: "v \<noteq> 0" and det: "v * det ?A = 
       det (four_block_mat A1 A2 B3 B4)" "v * det A4 = det B4" 
      and B3: "B3 \<in> carrier_mat ?m n" and B4: "B4 \<in> carrier_mat ?m ?m"  and 0: "\<forall> i < k. B4 $$ (i,m) = 0" by auto
     show ?case
     proof (cases "B4 $$ (k,m) = 0")
       case True
       with 0 have 0: "\<forall> i < Suc k. B4 $$ (i,m) = 0" using less_Suc_eq by auto
       with v det B3 B4 have "?P B3 B4 v (Suc k)" by auto
       thus ?thesis by blast
     next
       case Bk: False
       let ?k = "Suc k" 
       from Suc(2) have k: "k < ?m" "Suc k < ?m" "k \<noteq> Suc k" by auto      
       show ?thesis
       proof (cases "B4 $$ (?k,m) = 0")
         case True
         let ?B4 = "swaprows k (Suc k) B4" 
         let ?B3 = "swaprows k (Suc k) B3" 
         let ?B = "four_block_mat A1 A2 ?B3 ?B4" 
         let ?v = "-v" 
         from det_swaprows[OF k B4] det have det1: "?v * det A4 = det ?B4" by simp
         from v have v: "?v \<noteq> 0" by auto
         from B3 have B3': "?B3 \<in> carrier_mat ?m n" by auto
         from B4 have B4': "?B4 \<in> carrier_mat ?m ?m" by auto
         have "?v * det ?A = - det (four_block_mat A1 A2 B3 B4)" using det by simp            
         also have "\<dots> = det (swaprows (n + k) (n + ?k) (four_block_mat A1 A2 B3 B4))" 
           by (rule sym, rule det_swaprows[of _ "n + ?m"], insert A1 A2 B3 B4 k, auto)
         also have "swaprows (n + k) (n + ?k) (four_block_mat A1 A2 B3 B4) = ?B" 
         proof (rule eq_matI, unfold index_mat_four_block index_mat_swaprows, goal_cases)
           case (1 i j)
           show ?case
           proof (cases "i < n")
             case True
             thus ?thesis using 1(2) A1 A2 B3 B4 by simp
           next
             case False
             hence "i = n + (i - n)" by simp
             then obtain d where "i = n + d" by blast 
             thus ?thesis using 1 A1 A2 B3 B4 k(2) by simp
           qed
         qed auto
         finally have det2: "?v * det ?A = det ?B" .
         from True 0 B4 k(2) have "\<forall> i < Suc k. ?B4 $$ (i,m) = 0" unfolding less_Suc_eq by auto
         with det1 det2 B3' B4' v have "?P ?B3 ?B4 ?v (Suc k)" by auto
         thus ?thesis by blast
       next
         case False
         let ?bk = "B4 $$ (?k,m)" 
         let ?b = "B4 $$ (k,m)" 
         let ?v = "v * ?bk" 
         let ?B3 = "addrow (- ?b) k ?k (multrow k ?bk B3)" 
         let ?B4 = "addrow (- ?b) k ?k (multrow k ?bk B4)" 
         have *: "det ?B4 = ?bk * det B4" 
           by (subst det_addrow[OF k(2-3)], force simp: B4, rule det_multrow[OF k(1) B4])
         with det(2)[symmetric] have det2: "?v * det A4 = det ?B4" by (auto simp: ac_simps)
         from 0 k(2) B4 have 0: "\<forall> i < Suc k. ?B4 $$ (i,m) = 0" unfolding less_Suc_eq by auto
         from False v have v: "?v \<noteq> 0" by auto
         from B3 have B3': "?B3 \<in> carrier_mat ?m n" by auto
         from B4 have B4': "?B4 \<in> carrier_mat ?m ?m" by auto
         let ?B' = "multrow (n + k) ?bk (four_block_mat A1 A2 B3 B4)" 
         have B': "?B' \<in> carrier_mat (n + ?m) (n + ?m)" using A1 A2 B3 B4 k by auto          
         let ?B = "four_block_mat A1 A2 ?B3 ?B4" 
         have "?v * det ?A = ?bk * det (four_block_mat A1 A2 B3 B4)" using det by simp            
         also have "\<dots> = det (addrow (- ?b) (n + k) (n + ?k) ?B')" 
           by (subst det_addrow[OF _ _ B'], insert k(2), force, force, rule sym, rule det_multrow[of _ "n + ?m"],
           insert A1 A2 B3 B4 k, auto)
         also have "addrow (- ?b) (n + k) (n + ?k) ?B' = ?B" 
         proof (rule eq_matI, unfold index_mat_four_block index_mat_multrow index_mat_addrow, goal_cases)
           case (1 i j)
           show ?case
           proof (cases "i < n")
             case True
             thus ?thesis using 1(2) A1 A2 B3 B4 by simp
           next
             case False
             hence "i = n + (i - n)" by simp
             then obtain d where "i = n + d" by blast 
             thus ?thesis using 1 A1 A2 B3 B4 k(2) by simp
           qed
         qed auto
         finally have det1: "?v * det ?A = det ?B" .
         from det1 det2 B3' B4' v 0 have "?P ?B3 ?B4 ?v (Suc k)" by auto
         thus ?thesis by blast
       qed
     qed
   qed
   from this[OF le_refl] obtain B3 B4 v where P: "?P B3 B4 v m" by blast
   let ?B = "four_block_mat A1 A2 B3 B4" 
   from P have v: "v \<noteq> 0" and det: "v * det ?A = det ?B" "v * det A4 = det B4" 
     and B3: "B3 \<in> carrier_mat ?m n" and B4: "B4 \<in> carrier_mat ?m ?m" and 0: "\<And> i. i < m \<Longrightarrow> B4 $$ (i, m) = 0" 
     by auto
   let ?A2 = "0\<^sub>m n m"  
   let ?A3 = "mat m n (\<lambda> ij. B3 $$ ij)" 
   let ?A4 = "mat m m (\<lambda> ij. B4 $$ ij)" 
   let ?B1 = "four_block_mat A1 ?A2 ?A3 ?A4" 
   let ?B2 = "0\<^sub>m (n + m) 1" 
   let ?B3 = "mat 1 (n + m) (\<lambda> (i,j). if j < n then B3 $$ (m,j) else B4 $$ (m,j - n))" 
   let ?B4 = "mat 1 1 (\<lambda> _. B4 $$ (m,m))" 
   have B44: "B4 = four_block_mat ?A4 (0\<^sub>m m 1) (mat 1 m (\<lambda> (i,j). B4 $$ (m,j))) ?B4" 
   proof (rule eq_matI, unfold index_mat_four_block dim_col_mat dim_row_mat, goal_cases)
     case (1 i j)
     hence [simp]: "\<not> i < m \<Longrightarrow> i = m" "\<not> j < m \<Longrightarrow> j = m" by auto
     from 1 show ?case using B4 0 by auto
   qed (insert B4, auto)
   have "?B = four_block_mat ?B1 ?B2 ?B3 ?B4"
   proof (rule eq_matI, unfold index_mat_four_block dim_col_mat dim_row_mat, goal_cases)
     case (1 i j)
     then consider (UL) "i < n + m" "j < n + m" | (UR) "i < n + m" "j = n + m" 
         | (LL) "i = n + m" "j < n + m" | (LR) "i = n + m" "j = n + m" using A1 by auto linarith
     thus ?case
     proof cases
       case UL
       hence [simp]: "\<not> i < n \<Longrightarrow> i - n < m" 
          "\<not> j < n \<Longrightarrow> j - n < m" "\<not> j < n \<Longrightarrow> j - n < Suc m" by auto
       from UL show ?thesis using A1 A20 B3 B4 by simp
     next
       case LL
       hence [simp]: "\<not> j < n \<Longrightarrow> j - n < m" "\<not> j < n \<Longrightarrow> j - n < Suc m" by auto
       from LL show ?thesis using A1 A2 B3 B4 by simp
     next
       case LR
       thus ?thesis using A1 A2 B3 B4 by simp
     next
       case UR
       hence [simp]: "\<not> i < n \<Longrightarrow> i - n < m" by auto
       from UR show ?thesis using A1 A20 0 B3 B4 by simp
     qed
   qed (insert B4, auto)
   hence "det ?B = det (four_block_mat ?B1 ?B2 ?B3 ?B4)" by simp
   also have "\<dots> = det ?B1 * det ?B4" 
     by (rule det_four_block_mat_upper_right_zero_col[of _ "n + m"], insert A1 A2 B3 B4, auto)
   also have "det ?B1 = det A1 * det (mat m m (($$) B4))"  
     by (rule Suc(1), insert B3 B4, auto)
   also have "\<dots> * det ?B4 = det A1 * (det (mat m m (($$) B4)) * det ?B4)" by simp
   also have "det (mat m m (($$) B4)) * det ?B4 = det B4"
     unfolding arg_cong[OF B44, of det] 
     by (subst det_four_block_mat_upper_right_zero_col[OF _ refl], auto)
   finally have id: "det ?B = det A1 * det B4" .
   from this[folded det] have "v * det ?A = v * (det A1 * det A4)" by simp
   with v show "det ?A = det A1 * det A4" by simp
 qed
   
 lemma det_swapcols: 
   assumes *: "k < n" "l < n" "k \<noteq> l" and A: "A \<in> carrier_mat n n"
   shows "det (swapcols k l A) = - det A"
 proof -
   let ?B = "transpose_mat A"
   let ?C = "swaprows k l ?B"
   let ?D = "transpose_mat ?C"
   have C: "?C \<in> carrier_mat n n" and B: "?B \<in> carrier_mat n n"
     unfolding transpose_carrier_mat swaprows_carrier using A by auto
   show ?thesis 
     unfolding 
       swapcols_is_transp_swap_rows[OF A *(1-2)]
       det_transpose[OF C] det_swaprows[OF * B] det_transpose[OF A] ..
 qed
 
 
 lemma swap_row_to_front_det: "A \<in> carrier_mat n n \<Longrightarrow> I < n \<Longrightarrow> det (swap_row_to_front A I)
   = (-1)^I * det A"
 proof (induct I arbitrary: A)
   case (Suc I A)
   from Suc(3) have I: "I < n" by auto
   let ?I = "Suc I"
   let ?A = "swaprows I ?I A"
   have AA: "?A \<in> carrier_mat n n" using Suc(2) by simp
   have "det (swap_row_to_front A (Suc I)) = det (swap_row_to_front ?A I)" by simp
   also have "\<dots> = (-1)^I * det ?A" by (rule Suc(1)[OF AA I])
   also have "det ?A = -1 * det A" using det_swaprows[OF I Suc(3) _ Suc(2)] by simp
   finally show ?case by simp
 qed simp
 
 lemma swap_col_to_front_det: "A \<in> carrier_mat n n \<Longrightarrow> I < n \<Longrightarrow> det (swap_col_to_front A I)
   = (-1)^I * det A"
 proof (induct I arbitrary: A)
   case (Suc I A)
   from Suc(3) have I: "I < n" by auto
   let ?I = "Suc I"
   let ?A = "swapcols I ?I A"
   have AA: "?A \<in> carrier_mat n n" using Suc(2) by simp
   have "det (swap_col_to_front A (Suc I)) = det (swap_col_to_front ?A I)" by simp
   also have "\<dots> = (-1)^I * det ?A" by (rule Suc(1)[OF AA I])
   also have "det ?A = -1 * det A" using det_swapcols[OF I Suc(3) _ Suc(2)] by simp
   finally show ?case by simp
 qed simp
 
 
 lemma swap_row_to_front_four_block: assumes A1: "A1 \<in> carrier_mat n m1"
   and A2: "A2 \<in> carrier_mat n m2" 
   and A3: "A3 \<in> carrier_mat 1 m1" 
   and A4: "A4 \<in> carrier_mat 1 m2"
   shows "swap_row_to_front (four_block_mat A1 A2 A3 A4) n = four_block_mat A3 A4 A1 A2"
   by (subst swap_row_to_front_result[OF four_block_carrier_mat[OF A1 A4]], force,
   rule eq_matI, insert A1 A2 A3 A4, auto)
 
 lemma swap_col_to_front_four_block: assumes A1: "A1 \<in> carrier_mat n1 m"
   and A2: "A2 \<in> carrier_mat n1 1" 
   and A3: "A3 \<in> carrier_mat n2 m" 
   and A4: "A4 \<in> carrier_mat n2 1"
   shows "swap_col_to_front (four_block_mat A1 A2 A3 A4) m = four_block_mat A2 A1 A4 A3"
   by (subst swap_col_to_front_result[OF four_block_carrier_mat[OF A1 A4]], force,
   rule eq_matI, insert A1 A2 A3 A4, auto)
 
 lemma det_four_block_mat_lower_right_zero_col: assumes A1: "A1 \<in> carrier_mat 1 n"
   and A2: "A2 \<in> carrier_mat 1 1"
   and A3: "A3 \<in> carrier_mat n n"
   and A40: "A4 = (0\<^sub>m n 1)" 
   shows "det (four_block_mat A1 A2 A3 A4) = (-1)^n * det A2 * det A3" (is "det ?A = _")
 proof -
   let ?B = "four_block_mat A3 A4 A1 A2"
   from four_block_carrier_mat[OF A3 A2]
   have B: "?B \<in> carrier_mat (Suc n) (Suc n)" by simp
   from A40 have A4: "A4 \<in> carrier_mat n 1" by auto
   from arg_cong[OF swap_row_to_front_four_block[OF A3 A4 A1 A2], of det]
     swap_row_to_front_det[OF B, of n]
   have "det ?A = (-1)^n * det ?B" by auto
   also have "det ?B = det A3 * det A2"
     by (rule det_four_block_mat_upper_right_zero_col[OF A3 A40 A1 A2])
   finally show ?thesis by simp
 qed
   
 lemma det_four_block_mat_lower_left_zero_col: assumes A1: "A1 \<in> carrier_mat 1 1"
   and A2: "A2 \<in> carrier_mat 1 n"
   and A30: "A3 = (0\<^sub>m n 1)" 
   and A4: "A4 \<in> carrier_mat n n"
   shows "det (four_block_mat A1 A2 A3 A4) = det A1 * det A4" (is "det ?A = _")
 proof -
   from A30 have A3: "A3 \<in> carrier_mat n 1" by auto
   let ?B = "four_block_mat A2 A1 A4 A3"
   from four_block_carrier_mat[OF A2 A3]
   have B: "?B \<in> carrier_mat (Suc n) (Suc n)" by simp
   from arg_cong[OF swap_col_to_front_four_block[OF A2 A1 A4 A3], of det]
     swap_col_to_front_det[OF B, of n]
   have "det ?A = (-1)^n * det ?B" by auto
   also have "det ?B = (- 1) ^ n * det A1 * det A4"
     by (rule det_four_block_mat_lower_right_zero_col[OF A2 A1 A4 A30])
   also have "(-1)^n * \<dots> = (-1 * -1)^n * det A1 * det A4"
     unfolding power_mult_distrib by (simp add: ac_simps)
   finally show ?thesis by simp
 qed
 
 lemma det_addcol[simp]: 
   assumes l: "l < n" and k: "k \<noteq> l" and A: "A \<in> carrier_mat n n"
   shows "det (addcol a k l A) = det A"
 proof -
   have "addcol a k l A = A * addrow_mat n a l k"
     using addcol_mat[OF A l].
   also have "det (A * addrow_mat n a l k) = det A * det (addrow_mat n a l k)"
     by(rule det_mult[OF A], auto)
   also have "det (addrow_mat n a l k) = 1"
     using det_addrow_mat[OF k[symmetric]].
   finally show ?thesis using A by simp
 qed
 
 definition "insert_index i \<equiv> \<lambda>i'. if i' < i then i' else Suc i'"
 
 definition "delete_index i \<equiv> \<lambda>i'. if i' < i then i' else i' - Suc 0"
 
 lemma insert_index[simp]:
   "i' < i \<Longrightarrow> insert_index i i' = i'"
   "i' \<ge> i \<Longrightarrow> insert_index i i' = Suc i'"
 unfolding insert_index_def by auto
 
 
 lemma delete_insert_index[simp]:
   "delete_index i (insert_index i i') = i'"
   unfolding insert_index_def delete_index_def by auto
 
 lemma insert_delete_index:
   assumes i'i: "i' \<noteq> i"
   shows "insert_index i (delete_index i i') = i'"
   unfolding insert_index_def delete_index_def using i'i by auto
 
 definition "delete_dom p i \<equiv> \<lambda>i'. p (insert_index i i')"
 
 definition "delete_ran p j \<equiv> \<lambda>i. delete_index j (p i)"
 
 definition "permutation_delete p i = delete_ran (delete_dom p i) (p i)"
 
 definition "insert_ran p j \<equiv> \<lambda>i. insert_index j (p i)"
 
 definition "insert_dom p i j \<equiv>
   \<lambda>i'. if i' < i then p i' else if i' = i then j else p (i'-1)"
 
 definition "permutation_insert i j p \<equiv> insert_dom (insert_ran p j) i j"
 
 lemmas permutation_delete_expand =
   permutation_delete_def[unfolded delete_dom_def delete_ran_def insert_index_def delete_index_def]
 
 lemmas permutation_insert_expand =
   permutation_insert_def[unfolded insert_dom_def insert_ran_def insert_index_def delete_index_def]
 
 lemma permutation_insert_inserted[simp]:
   "permutation_insert (i::nat) j p i = j"
   unfolding permutation_insert_expand by auto
 
 lemma permutation_insert_base:
   assumes p: "p permutes {0..<n}"
   shows "permutation_insert n n p = p"
 proof (rule ext)
   fix x show "permutation_insert n n p x = p x"
     apply (cases rule: linorder_cases[of "x" "n"])
     unfolding permutation_insert_expand
     using permutes_others[OF p] p by auto
 qed
 
 lemma permutation_insert_row_step:
   shows "permutation_insert (Suc i) j p \<circ> Fun.swap i (Suc i) id = permutation_insert i j p"
     (is "?l = ?r")
 proof (rule ext)
   fix x show "?l x = ?r x"
     by (cases rule: linorder_cases[of "x" "i"])
       (auto simp add: swap_id_eq permutation_insert_expand)
 qed
 
 lemma permutation_insert_column_step:
   assumes p: "p permutes {0..<n}" and "j < n"
   shows "(Fun.swap j (Suc j) id) \<circ> (permutation_insert i (Suc j) p) = permutation_insert i j p"
     (is "?l = ?r")
 proof (rule ext)
   fix x show "?l x = ?r x"
   proof (cases rule: linorder_cases[of "x" "i"])
     case less note x = this
       show ?thesis
         apply (cases rule: linorder_cases[of "p x" "j"])
         unfolding permutation_insert_expand using x by simp+
     next case equal thus ?thesis by simp
     next case greater note x = this
       show ?thesis
         apply (cases rule: linorder_cases[of "p (x-1)" "j"])
         unfolding permutation_insert_expand using x by simp+
   qed
 qed
 
 lemma delete_dom_image:
   assumes i: "i \<in> {0..<Suc n}" (is "_ \<in> ?N")
   assumes iff: "\<forall>i' \<in> ?N. f i' = f i \<longrightarrow> i' = i"
   shows "delete_dom f i ` {0..<n} = f ` ?N - {f i}" (is "?L = ?R")
 proof(unfold set_eq_iff, intro allI iffI)
   fix j'
   { assume L: "j' \<in> ?L"
     then obtain i' where i': "i' \<in> {0..<n}" and dj': "delete_dom f i i' = j'" by auto
     show "j' \<in> ?R"
     proof(cases "i' < i")
       case True
         show ?thesis
           unfolding image_def
           unfolding Diff_iff
           unfolding mem_Collect_eq singleton_iff
         proof(intro conjI bexI)
           show "j' \<noteq> f i"
           proof
             assume j': "j' = f i"
             hence "f i' = f i"
               using dj'[unfolded delete_dom_def insert_index_def] using True by simp
             thus "False" using iff i True by auto
           qed
           show "j' = f i'"
             using dj' True unfolding delete_dom_def insert_index_def by simp
         qed (insert i',simp)
       next case False
         show ?thesis
           unfolding image_def
           unfolding Diff_iff
           unfolding mem_Collect_eq singleton_iff
         proof(intro conjI bexI)
           show Si': "Suc i' \<in> ?N" using i' by auto
           show "j' \<noteq> f i"
           proof
             assume j': "j' = f i"
             hence "f (Suc i') = f i"
               using dj'[unfolded delete_dom_def insert_index_def] j' False by simp
             thus "False" using iff Si' False by auto
           qed
           show "j' = f (Suc i')"
             using dj' False unfolding delete_dom_def insert_index_def by simp
         qed
     qed
   }
   { assume R: "j' \<in> ?R"
     then obtain i'
       where i': "i' \<in> ?N" and j'fi: "j' \<noteq> f i" and j'fi': "j' = f i'" by auto
     hence i'i: "i' \<noteq> i" using iff by auto
     hence n: "n > 0" using i i' by auto
     show "j' \<in> ?L"
     proof (cases "i' < i")
       case True show ?thesis
         proof
           show "j' = delete_dom f i i'"
             unfolding delete_dom_def insert_index_def using True j'fi' by simp
         qed (insert True i, simp)
       next case False show ?thesis
         proof
           show "i'-1 \<in> {0..<n}" using i' n by auto
           show "j' = delete_dom f i (i'-1)"
             unfolding delete_dom_def insert_index_def using False j'fi' i'i by auto
         qed
     qed
   }
 qed
 
 lemma delete_ran_image:
   assumes j: "j \<in> {0..<Suc n}" (is "_ \<in> ?N")
   assumes fimg: "f ` {0..<n} =  ?N - {j}"
   shows "delete_ran f j ` {0..<n} = {0..<n}" (is "?L = ?R")
 proof(unfold set_eq_iff, intro allI iffI)
   fix j'
   { assume L: "j' \<in> ?L"
     then obtain i where i: "i \<in> {0..<n}" and ij': "delete_ran f j i = j'" by auto
     have "f i \<in> ?N - {j}" using fimg i by blast
     thus "j' \<in> ?R" using ij' j unfolding delete_ran_def delete_index_def by auto
   }
   { assume R: "j' \<in> ?R" show "j' \<in> ?L"
     proof (cases "j' < j")
       case True
         hence "j' \<in> ?N - {j}" using R by auto
         then obtain i where fij': "f i = j'" and i: "i \<in> {0..<n}"
           unfolding fimg[symmetric] by auto
         have "delete_ran f j i = j'"
           unfolding delete_ran_def delete_index_def unfolding fij' using True by simp
         thus ?thesis using i by auto
       next case False
         hence "Suc j' \<in> ?N - {j}" using R by auto
         then obtain i where fij': "f i = Suc j'" and i: "i \<in> {0..<n}"
           unfolding fimg[symmetric] by auto
         have "delete_ran f j i = j'"
           unfolding delete_ran_def delete_index_def unfolding fij' using False by simp
         thus ?thesis using i by auto
     qed
   }
 qed
 
 lemma delete_index_inj_on:
   assumes iS: "i \<notin> S"
   shows "inj_on (delete_index i) S"
 proof(intro inj_onI)
   fix x y
   assume eq: "delete_index i x = delete_index i y" and x: "x \<in> S" and y: "y \<in> S"
   have "x \<noteq> i" "y \<noteq> i" using x y iS by auto
   thus "x = y"
     using eq unfolding delete_index_def
     by(cases "x < i"; cases "y < i";simp)
 qed
 
 lemma insert_index_inj_on:
   shows "inj_on (insert_index i) S"
 proof(intro inj_onI)
   fix x y
   assume eq: "insert_index i x = insert_index i y" and x: "x \<in> S" and y: "y \<in> S"
   show "x = y"
     using eq unfolding insert_index_def
     by(cases "x < i"; cases "y < i";simp)
 qed
 
 
 lemma delete_dom_inj_on:
   assumes i: "i \<in> {0..<Suc n}" (is "_ \<in> ?N")
   assumes inj: "inj_on f ?N"
   shows "inj_on (delete_dom f i) {0..<n}"
 proof (rule eq_card_imp_inj_on)
   have "card ?N = card (f ` ?N)" using card_image[OF inj]..
   hence "card {0..<n} = card (f ` ?N - {f i})" using i by auto
   also have "... = card (delete_dom f i ` {0..<n})"
     apply(subst delete_dom_image[symmetric])
     using i inj unfolding inj_on_def by auto
   finally show "card (delete_dom f i ` {0..<n}) = card {0..<n}"..
 qed simp
 
 lemma delete_ran_inj_on:
   assumes j: "j \<in> {0..<Suc n}" (is "_ \<in> ?N")
   assumes img: "f ` {0..<n} =  ?N - {j}"
   shows "inj_on (delete_ran f j) {0..<n}"
   apply (rule eq_card_imp_inj_on)
   unfolding delete_ran_image[OF j img] by simp+
 
 lemma permutation_delete_bij_betw:
   assumes i: "i \<in> {0 ..< Suc n}" (is "_ \<in> ?N")
   assumes bij: "bij_betw p ?N ?N"
   shows "bij_betw (permutation_delete p i) {0..<n} {0..<n}" (is "bij_betw ?p _ _")
 proof-
   have inj: "inj_on p ?N" using bij_betw_imp_inj_on[OF bij].
   have ran: "p ` ?N = ?N" using bij_betw_imp_surj_on[OF bij].
   hence j: "p i \<in> ?N" using i by auto
   have "\<forall>i'\<in>?N. p i' = p i \<longrightarrow> i' = i" using inj i unfolding inj_on_def by auto
   from delete_dom_image[OF i this]
   have "delete_dom p i ` {0..<n} = ?N - {p i}" unfolding ran.
   from delete_ran_inj_on[OF j this] delete_ran_image[OF j this]
   show ?thesis unfolding permutation_delete_def
     using bij_betw_imageI by blast
 qed
 
 lemma permutation_delete_permutes:
   assumes p: "p permutes {0 ..< Suc n}" (is "_ permutes ?N")
       and i: "i < Suc n"
   shows "permutation_delete p i permutes {0..<n}" (is "?p permutes ?N'")
 proof (rule bij_imp_permutes, rule permutation_delete_bij_betw)
   have pi: "p i < Suc n" using p i by auto
   show "bij_betw p ?N ?N" using permutes_imp_bij[OF p].
   fix x assume "x \<notin> {0..<n}" hence x: "x \<ge> n" by simp
     show "?p x = x"
     proof(cases "x < i")
       case True thus ?thesis
         unfolding permutation_delete_def using x i by simp
       next case False
         hence "p (Suc x) = Suc x" using x permutes_others[OF p] by auto
         thus ?thesis
         unfolding permutation_delete_expand using False pi x by simp
     qed
 qed (insert i,auto)
 
 lemma permutation_insert_delete:
   assumes p: "p permutes {0..<Suc n}"
       and i: "i < Suc n"
   shows "permutation_insert i (p i) (permutation_delete p i) = p"
     (is "?l = _")
 proof
   fix i'
   show "?l i' = p i'"
   proof (cases rule: linorder_cases[of "i'" "i"])
     case less note i'i = this
       show ?thesis
       proof (cases "p i = p i'")
         case True
           hence "i = i'" using permutes_inj[OF p] injD by metis
           hence False using i'i by auto
           thus ?thesis by auto
         next case False thus ?thesis
           unfolding permutation_insert_expand permutation_delete_expand
           using i'i by auto
       qed
     next case equal thus ?thesis unfolding permutation_insert_expand by simp
     next case greater hence i'i: "i' > i" by auto
       hence cond: "\<not> i' - 1 < i" using i'i by simp
       show ?thesis
       proof (cases rule: linorder_cases[of "p i'" "p i"])
         case less
           hence pd: "permutation_delete p i (i'-1) = p i'"
             unfolding permutation_delete_expand
             using i'i cond by auto
           show ?thesis
             unfolding permutation_insert_expand pd
             using i'i less by simp
         next case equal
           hence "i = i'" using permutes_inj[OF p] injD by metis
           hence False using i'i by auto
           thus ?thesis by auto
         next case greater
           hence pd: "permutation_delete p i (i'-1) = p i' - 1"
             unfolding permutation_delete_expand
             using i'i cond by simp
           show ?thesis
             unfolding permutation_insert_expand pd
             using i'i greater by auto
       qed
   qed
 qed
 
 lemma insert_index_exclude[simp]:
   "insert_index i i' \<noteq> i" unfolding insert_index_def by auto
 
 lemma insert_index_image:
   assumes i: "i < Suc n"
   shows "insert_index i ` {0..<n} = {0..<Suc n} - {i}" (is "?L = ?R")
 proof(unfold set_eq_iff, intro allI iffI)
   let ?N = "{0..<Suc n}"
   fix i'
   { assume L: "i' \<in> ?L"
     then obtain i''
       where ins: "i' = insert_index i i''" and i'': "i'' \<in> {0..<n}" by auto
     show "i' \<in> ?N - {i}"
     proof(rule DiffI)
       show "i' \<in> ?N" using ins unfolding insert_index_def using i'' by auto
       show "i' \<notin> {i}"
         unfolding singleton_iff
         unfolding ins unfolding insert_index_def by auto
     qed
   }
   { assume R: "i' \<in> ?R"
     show "i' \<in> ?L"
     proof(cases rule: linorder_cases[of "i'" "i"])
       case less
         hence i': "i' \<in> {0..<n}" using i by auto
         hence "insert_index i i' = i'" unfolding insert_index_def using less by auto
         thus ?thesis using i' by force
       next case equal
         hence False using R by auto
         thus ?thesis by auto
       next case greater
         hence i'': "i'-1 \<in> {0..<n}" using i R by auto
         hence "insert_index i (i'-1) = i'"
           unfolding insert_index_def using greater by auto
         thus ?thesis using i'' by force
     qed
   }
 qed
 
 lemma insert_ran_image:
   assumes j: "j < Suc n"
   assumes img: "f ` {0..<n} = {0..<n}"
   shows "insert_ran f j ` {0..<n} = {0..<Suc n} - {j}" (is "?L = ?R")
 proof -
   have "?L = (\<lambda>i. insert_index j (f i)) ` {0..<n}" unfolding insert_ran_def..
   also have "... = (insert_index j \<circ> f) ` {0..<n}" by auto
   also have "... = insert_index j ` f ` {0..<n}" by auto
   also have "... = insert_index j ` {0..<n}" unfolding img by auto
   finally show ?thesis using insert_index_image[OF j] by auto
 qed
 
 lemma insert_dom_image:
   assumes i: "i < Suc n" and j: "j < Suc n"
     and img: "f ` {0..<n} = {0..<Suc n} - {j}" (is "_ = ?N - _")
   shows "insert_dom f i j ` ?N = ?N" (is "?f ` _ = _")
 proof(unfold set_eq_iff,intro allI iffI)
   fix j'
   { assume "j' \<in> ?f ` ?N"
     then obtain i' where i': "i' \<in> ?N" and j': "j' = ?f i'" by auto
     show "j' \<in> ?N"
     proof (cases rule:linorder_cases[of "i'" "i"])
       case less
         hence "i' \<in> {0..<n}" using i by auto
         hence "f i' < Suc n" using imageI[of i' "{0..<n}" f] img by auto
         thus ?thesis
           unfolding j' unfolding insert_dom_def using less by auto
       next case equal
         thus ?thesis unfolding j' insert_dom_def using j by auto
       next case greater
         hence "i'-1 \<in> {0..<n}" using i' by auto
         hence "f (i'-1) < Suc n" using imageI[of "i'-1" "{0..<n}" f] img by auto
         thus ?thesis
           unfolding j' insert_dom_def using greater by auto
     qed
   }
   { assume j': "j' \<in> ?N" show "j' \<in> ?f ` ?N"
     proof (cases "j' = j")
       case True
         hence "?f i = j'" unfolding insert_dom_def by auto
         thus ?thesis using i by auto
       next case False
         hence j': "j' \<in> ?N - {j}" using j j' by auto
         then obtain i' where j'fi: "j' = f i'" and i': "i' \<in> {0..<n}"
           unfolding img[symmetric] by auto
         show ?thesis
         proof(cases "i' < i")
           case True thus ?thesis unfolding j'fi insert_dom_def using i' by auto
           next case False
             hence "?f (Suc i') = j'" unfolding j'fi insert_dom_def using i' by auto
             thus ?thesis using i' by auto
         qed
     qed
   }
 qed
 
 lemma insert_ran_inj_on:
   assumes inj: "inj_on f {0..<n}" and j: "j < Suc n"
   shows "inj_on (insert_ran f j) {0..<n}" (is "inj_on ?f _")
 proof (rule inj_onI)
   fix i i'
   assume i: "i \<in> {0..<n}" and i': "i' \<in> {0..<n}" and eq: "?f i = ?f i'"
   note eq2 = eq[unfolded insert_ran_def insert_index_def]
   have "f i = f i'"
   proof (cases "f i < j")
     case True
       moreover have "f i' < j" apply (rule ccontr) using eq2 True by auto
       ultimately show ?thesis using eq2 by auto
     next case False
       moreover have "\<not> f i' < j" apply (rule ccontr) using eq2 False by auto
       ultimately show ?thesis using eq2 by auto
   qed
   from inj_onD[OF inj this i i'] show "i = i'".
 qed
 
 lemma insert_dom_inj_on:
   assumes inj: "inj_on f {0..<n}"
       and i: "i < Suc n" and j: "j < Suc n"
       and img: "f ` {0..<n} = {0..<Suc n} - {j}" (is "_ = ?N - _")
   shows "inj_on (insert_dom f i j) ?N"
   apply(rule eq_card_imp_inj_on)
   unfolding insert_dom_image[OF i j img] by simp+
 
 lemma permutation_insert_bij_betw:
   assumes q: "q permutes {0..<n}" and i: "i < Suc n" and j: "j < Suc n"
   shows "bij_betw (permutation_insert i j q) {0..<Suc n} {0..<Suc n}"
     (is "bij_betw ?q ?N _")
 proof (rule bij_betw_imageI)
   have img: "q ` {0..<n} = {0..<n}" using permutes_image[OF q].
   show "?q ` ?N = ?N"
     unfolding permutation_insert_def
     using insert_dom_image[OF i j insert_ran_image[OF j permutes_image[OF q]]].
   have inj: "inj_on q {0..<n}"
     apply(rule subset_inj_on) using permutes_inj[OF q] by auto
   show "inj_on ?q ?N"
     unfolding permutation_insert_def
     using insert_dom_inj_on[OF _ i j]
     using insert_ran_inj_on[OF inj j] insert_ran_image[OF j img] by auto
 qed
 
 lemma permutation_insert_permutes:
   assumes q: "q permutes {0..<n}"
       and i: "i < Suc n" and j: "j < Suc n"
   shows "permutation_insert i j q permutes {0..<Suc n}" (is "?p permutes ?N")
   using permutation_insert_bij_betw[OF q i j]
 proof (rule bij_imp_permutes)
   fix i' assume "i' \<notin> ?N"
   moreover hence "q (i'-1) = i'-1" using permutes_others[OF q] by auto
   ultimately show "?p i' = i'"
     unfolding permutation_insert_expand using i j by auto
 qed
 
 lemma permutation_fix:
   assumes i: "i < Suc n" and j: "j < Suc n"
   shows "{ p. p permutes {0..<Suc n} \<and> p i = j } =
          permutation_insert i j ` { q. q permutes {0..<n} }"
     (is "?L = ?R")
   unfolding set_eq_iff
 proof(intro allI iffI)
   let ?N = "{0..<Suc n}"
   fix p
   { assume "p \<in> ?L"
     hence p: "p permutes ?N" and pij: "p i = j" by auto
     show "p \<in> ?R"
       unfolding mem_Collect_eq
       using permutation_delete_permutes[OF p i]
       using permutation_insert_delete[OF p i,symmetric]
       unfolding pij by auto
   }
   { assume "p \<in> ?R"
     then obtain q where pq: "p = permutation_insert i j q" and q: "q permutes {0..<n}" by auto
     hence "p i = j" unfolding permutation_insert_expand by simp
     thus "p \<in> ?L"
       using pq permutation_insert_permutes[OF q i j] by auto
   }
 qed
 
 lemma permutation_split_ran:
   assumes j: "j \<in> S"
   shows "{ p. p permutes S } = (\<Union>i \<in> S. { p. p permutes S \<and> p i = j })"
   (is "?L = ?R")
   unfolding set_eq_iff
 proof(intro allI iffI)
   fix p
   { assume "p \<in> ?L"
     hence p: "p permutes S" by auto
     obtain i where i: "i \<in> S" and pij: "p i = j" using j permutes_image[OF p] by force
     thus "p \<in> ?R" using p by auto
   }
   { assume "p \<in> ?R"
     then obtain i
       where p: "p permutes S" and i: "i \<in> S" and pij: "p i = j"
       by auto
     show "p \<in> ?L"
       unfolding mem_Collect_eq using p.
   }
 qed
 
 lemma permutation_disjoint_dom:
   assumes i: "i \<in> S" and i': "i' \<in> S" and j: "j \<in> S" and ii': "i \<noteq> i'"
   shows "{ p. p permutes S \<and> p i = j } \<inter> { p. p permutes S \<and> p i' = j } = {}"
     (is "?L \<inter> ?R = {}")
 proof -
   {
     fix p assume "p \<in> ?L \<inter> ?R"
     hence p: "p permutes S" and "p i = j" and "p i' = j" by auto
     hence "p i = p i'" by auto
     note injD[OF permutes_inj[OF p] this]
     hence False using ii' by auto
   }
   thus ?thesis by auto
 qed
 
 lemma permutation_disjoint_ran:
   assumes i: "i \<in> S" and j: "j \<in> S" and j': "j' \<in> S" and jj': "j \<noteq> j'"
   shows "{ p. p permutes S \<and> p i = j } \<inter> { p. p permutes S \<and> p i = j' } = {}"
     (is "?L \<inter> ?R = {}")
 proof -
   {
     fix p assume "p \<in> ?L \<inter> ?R"
     hence "p permutes S" and "p i = j" and "p i = j'" by auto
     hence False using jj' by auto
   }
   thus ?thesis by auto
 qed
 
 lemma permutation_insert_inj_on:
   assumes "i < Suc n"
   assumes "j < Suc n"
   shows "inj_on (permutation_insert i j) { q. q permutes {0..<n} }"
   (is "inj_on ?f ?S")
 proof (rule inj_onI)
   fix q q'
   assume "q \<in> ?S" "q' \<in> ?S"
   hence q: "q permutes {0..<n}" and q': "q' permutes {0..<n}" by auto
   assume "?f q = ?f q'"
   hence eq: "permutation_insert i j q = permutation_insert i j q'" by auto
   note eq = cong[OF eq refl, unfolded permutation_insert_expand]
   show qq': "q = q'"
   proof(rule ext)
     fix x
     have foo: "Suc x - 1 = x" by auto
     show "q x = q' x"
     proof(cases "x < i")
       case True thus ?thesis apply(cases "q x < j";cases "q' x < j") using eq[of x] by auto
       next case False thus ?thesis
         apply(cases "q x < j";cases "q' x < j") using eq[of "Suc x"] by auto
     qed
   qed
 qed
 
 lemma signof_permutation_insert:
   assumes p: "p permutes {0..<n}" and i: "i < Suc n" and j: "j < Suc n"
   shows "signof (permutation_insert i j p) = (-1::'a::ring_1)^(i+j) * signof p"
 proof -
   { fix j assume "j \<le> n"
     hence "signof (permutation_insert n (n-j) p) = (-1::'a)^(n+(n-j)) * signof p"
     proof(induct "j")
       case 0 show ?case using permutation_insert_base[OF p] by (simp add: mult_2[symmetric])
       next case (Suc j)
         hence Sjn: "Suc j \<le> n" and j: "j < n" and Sj: "n - Suc j < n" by auto
         hence n0: "n > 0" by auto
         have ease: "Suc (n - Suc j) = n - j" using j by auto
         let ?swap = "Fun.swap (n - Suc j) (n - j) id"
         let ?prev = "permutation_insert n (n - j) p"
         have "signof (permutation_insert n (n - Suc j) p) = signof (?swap \<circ> ?prev)"
           unfolding permutation_insert_column_step[OF p Sj, unfolded ease]..
         also have "... = signof ?swap * signof ?prev"
           proof(rule signof_compose)
             show "?swap permutes {0..<Suc n}" by (rule permutes_swap_id,auto)
             show "?prev permutes {0..<Suc n}" by (rule permutation_insert_permutes[OF p],auto)
           qed
         also have "signof ?swap = -1"
           proof-
             have "n - Suc j < n - j" using Sjn by simp
-            thus ?thesis unfolding signof_def sign_swap_id by simp
+            thus ?thesis unfolding sign_swap_id by simp
           qed
         also have "signof ?prev = (-1::'a) ^ (n + (n - j)) * signof p" using Suc(1) j by auto
         also have "(-1) * ... =  (-1) ^ (1 + n + (n - j)) * signof p" by simp
         also have "n - j = 1 + (n - Suc j)" using j by simp
         also have "1 + n + ... = 2 + (n + (n - Suc j))" by simp
         also have "(-1::'a) ^ ... = (-1) ^ 2 * (-1) ^ (n + (n - Suc j))" by simp
         also have "... = (-1) ^ (n + (n - Suc j))" by simp
         finally show ?case.
     qed
   }
   note col = this
   have nj: "n - j \<le> n" using j by auto
   have row_base: "signof (permutation_insert n j p) = (-1::'a)^(n+j) * signof p"
     using col[OF nj] using j by simp
   { fix i assume "i \<le> n"
     hence "signof (permutation_insert (n-i) j p) = (-1::'a)^((n-i)+j) * signof p"
     proof (induct i)
       case 0 show ?case using row_base by auto
       next case (Suc i)
         hence Sin: "Suc i \<le> n" and i: "i \<le> n" and Si: "n - Suc i < n" by auto
         have ease: "Suc (n - Suc i) = n - i" using Sin by auto
         let ?prev = "permutation_insert (n-i) j p"
         let ?swap = "Fun.swap (n - Suc i) (n-i) id"
         have "signof (permutation_insert (n - Suc i) j p) = signof (?prev \<circ> ?swap)"
           using permutation_insert_row_step[of "n - Suc i"] unfolding ease by auto
         also have "... = signof ?prev * signof ?swap"
           proof(rule signof_compose)
             show "?swap permutes {0..<Suc n}" by (rule permutes_swap_id,auto)
             show "?prev permutes {0..<Suc n}"
               apply(rule permutation_insert_permutes[OF p]) using j by auto
           qed
         also have "signof ?swap = (-1)"
           proof-
             have "n - Suc i < n - i" using Sin by simp
-            thus ?thesis unfolding signof_def sign_swap_id by simp
+            thus ?thesis unfolding sign_swap_id by simp
           qed
         also have "signof ?prev = (-1::'a) ^ (n - i + j) * signof p"
           using Suc(1)[OF i].
         also have "... * (-1) = (-1) ^ Suc (n - i + j) * signof p"
           by auto
         also have "Suc (n - i + j) = Suc (Suc (n - Suc i + j))"
           using Sin by auto
         also have "(-1::int) ^ ... = (-1) ^ (n - Suc i + j)" by auto
         ultimately show ?case by auto
     qed
   }
   note row = this
   have ni: "n - i \<le> n" using i by auto
   show ?thesis using row[OF ni] using i by simp
 qed
 
 lemma foo:
   assumes i: "i < Suc n" and j: "j < Suc n"
   assumes q: "q permutes {0..<n}"
   shows "{(i', permutation_insert i j q i') | i'. i' \<in> {0..<Suc n} - {i} } =
   { (insert_index i i'', insert_index j (q i'')) | i''. i'' < n }" (is "?L = ?R")
   unfolding set_eq_iff
 proof(intro allI iffI)
   fix ij
   { assume "ij \<in> ?L"
     then obtain i'
       where ij: "ij = (i', permutation_insert i j q i')" and i': "i' < Suc n" and i'i: "i' \<noteq> i"
       by auto
     show "ij \<in> ?R" unfolding mem_Collect_eq
     proof(intro exI conjI)
       show "ij = (insert_index i (delete_index i i'), insert_index j (q (delete_index i i')))"
         using ij unfolding insert_delete_index[OF i'i] using i'i
         unfolding permutation_insert_expand insert_index_def delete_index_def by auto
       show "delete_index i i' < n" using i' i i'i unfolding delete_index_def by auto
     qed
   }
   { assume "ij \<in> ?R"
     then obtain i''
       where ij: "ij = (insert_index i i'', insert_index j (q i''))" and i'': "i'' < n"
       by auto
     show "ij \<in> ?L" unfolding mem_Collect_eq
     proof(intro exI conjI)
       show "insert_index i i'' \<in> {0..<Suc n} - {i}"
         unfolding insert_index_image[OF i,symmetric] using i'' by auto
       have "insert_index j (q i'') = permutation_insert i j q (insert_index i i'')"
         unfolding permutation_insert_expand insert_index_def by auto
       thus "ij = (insert_index i i'', permutation_insert i j q (insert_index i i''))"
         unfolding ij by auto
     qed
   }
 qed
 
 definition "mat_delete A i j \<equiv>
   mat (dim_row A - 1) (dim_col A - 1) (\<lambda>(i',j').
     A $$ (if i' < i then i' else Suc i', if j' < j then j' else Suc j'))"
 
 lemma mat_delete_dim[simp]:
   "dim_row (mat_delete A i j) = dim_row A - 1"
   "dim_col (mat_delete A i j) = dim_col A - 1"
   unfolding mat_delete_def by auto
 
 lemma mat_delete_carrier:
   assumes A: "A \<in> carrier_mat m n"
   shows "mat_delete A i j \<in> carrier_mat (m-1) (n-1)" unfolding mat_delete_def using A by auto
 
 lemma "mat_delete_index":
   assumes A: "A \<in> carrier_mat (Suc n) (Suc n)"
       and i: "i < Suc n" and j: "j < Suc n"
       and i': "i' < n" and j': "j' < n"
   shows "A $$ (insert_index i i', insert_index j j') = mat_delete A i j $$ (i', j')"
   unfolding mat_delete_def
   unfolding permutation_insert_expand
   unfolding insert_index_def
   using A i j i' j' by auto
 
 definition "cofactor A i j = (-1)^(i+j) * det (mat_delete A i j)"
 
 
 lemma laplace_expansion_column:
   assumes A: "(A :: 'a :: comm_ring_1 mat) \<in> carrier_mat n n"
       and j: "j < n"
   shows "det A = (\<Sum>i<n. A $$ (i,j) * cofactor A i j)"
 proof -
   define l where "l = n-1"
   have A: "A \<in> carrier_mat (Suc l) (Suc l)"
    and jl: "j < Suc l" using A j unfolding l_def by auto
   let ?N = "{0 ..< Suc l}"
   define f where "f = (\<lambda>p i. A $$ (i, p i))"
   define g where "g = (\<lambda>p. prod (f p) ?N)"
   define h where "h = (\<lambda>p. signof p * g p)"
   define Q where "Q = { q . q permutes {0..<l} }"
   have jN: "j \<in> ?N" using jl by auto
   have disj: "\<forall>i \<in> ?N. \<forall>i' \<in> ?N. i \<noteq> i' \<longrightarrow>
     {p. p permutes ?N \<and> p i = j} \<inter> {p. p permutes ?N \<and> p i' = j} = {}"
     using permutation_disjoint_dom[OF _ _ jN] by auto
   have fin: "\<forall>i\<in>?N. finite {p. p permutes ?N \<and> p i = j}"
     using finite_permutations[of ?N] by auto
 
   have "det A = sum h { p. p permutes ?N }"
     using det_def'[OF A] unfolding h_def g_def f_def using atLeast0LessThan by auto
   also have "... = sum h (\<Union>i\<in>?N. {p. p permutes ?N \<and> p i = j})"
     unfolding permutation_split_ran[OF jN]..
   also have "... = (\<Sum>i\<in>?N. sum h { p | p. p permutes ?N \<and> p i = j})"
     using sum.UNION_disjoint[OF _ fin disj] by auto
   also {
     fix i assume "i \<in> ?N"
     hence i: "i < Suc l" by auto
     have "sum h { p | p. p permutes ?N \<and> p i = j} = sum h (permutation_insert i j ` Q)"
       using permutation_fix[OF i jl] unfolding Q_def by auto
     also have "... = sum (h \<circ> permutation_insert i j) Q"
       unfolding Q_def using sum.reindex[OF permutation_insert_inj_on[OF i jl]].
     also have "... = (\<Sum> q \<in> Q.
       signof (permutation_insert i j q) * prod (f (permutation_insert i j q)) ?N)"
       unfolding h_def g_def Q_def by simp
     also {
       fix q assume "q \<in> Q"
       hence q: "q permutes {0..<l}" unfolding Q_def by auto
       let ?p = "permutation_insert i j q"
       have fin: "finite (?N - {i})" by auto
       have notin: "i \<notin> ?N - {i}" by auto
       have close: "insert i (?N - {i}) = ?N" using notin i by auto
       have "prod (f ?p) ?N = f ?p i * prod (f ?p) (?N-{i})"
         unfolding prod.insert[OF fin notin, unfolded close] by auto
       also have "... = A $$ (i, j) * prod (f ?p) (?N-{i})"
         unfolding f_def Q_def using permutation_insert_inserted by simp
       also have "prod (f ?p) (?N-{i}) = prod (\<lambda>i'. A $$ (i', permutation_insert i j q i')) (?N-{i})"
         unfolding f_def..
       also have "... = prod (\<lambda>ij. A $$ ij) ((\<lambda>i'. (i', permutation_insert i j q i')) ` (?N-{i}))"
         (is "_ = prod _ ?part")
         unfolding prod.reindex[OF inj_on_convol_ident] o_def..
       also have "?part = {(i', permutation_insert i j q i') | i'. i' \<in> ?N-{i} }"
         unfolding image_def by metis
       also have "... = {(insert_index i i'', insert_index j (q i'')) | i''. i'' < l}"
         unfolding foo[OF i jl q]..
       also have "... = ((\<lambda>i''. (insert_index i i'', insert_index j (q i''))) ` {0..<l})"
         unfolding image_def by auto
       also have "prod (\<lambda>ij. A $$ ij)... = prod ((\<lambda>ij. A $$ ij) \<circ> (\<lambda>i''. (insert_index i i'', insert_index j (q i'')))) {0..<l}"
         proof(subst prod.reindex[symmetric])
           have 1: "inj (\<lambda>i''. (i'', insert_index j (q i'')))" using inj_on_convol_ident.
           have 2: "inj (\<lambda>(i'',j). (insert_index i i'', j))"
             apply (intro injI) using injD[OF insert_index_inj_on[of _ UNIV]] by auto
           have "inj (\<lambda>i''. (insert_index i i'', insert_index j (q i'')))"
             using inj_compose[OF 2 1] unfolding o_def by auto
           thus "inj_on (\<lambda>i''. (insert_index i i'', insert_index j (q i''))) {0..<l}"
             using subset_inj_on by auto
         qed auto
       also have "... = prod (\<lambda>i''. A $$ (insert_index i i'', insert_index j (q i''))) {0..<l}"
         by auto
       also have "... = prod (\<lambda>i''. mat_delete A i j $$ (i'', q i'')) {0..<l}"
       proof (rule prod.cong[OF refl], unfold atLeastLessThan_iff, elim conjE)
         fix x assume x: "x < l"
         show "A $$ (insert_index i x, insert_index j (q x)) = mat_delete A i j $$ (x, q x)"
           apply(rule mat_delete_index[OF A i jl]) using q x by auto
       qed
       finally have "prod (f ?p) ?N =
         A $$ (i, j) * (\<Prod>i'' = 0..< l. mat_delete A i j $$ (i'', q i''))"
         by auto
       hence "signof ?p * prod (f ?p) ?N  = (-1::'a)^(i+j) * signof q * ..."
         unfolding signof_permutation_insert[OF q i jl] by auto
     }
     hence "... = (\<Sum> q \<in> Q. (-1)^(i+j) * signof q *
       A $$ (i, j) * (\<Prod>i'' = 0 ..< l. mat_delete A i j $$ (i'', q i'')))"
       by(intro sum.cong[OF refl],auto)
     also have "... = ( \<Sum> q \<in> Q. A $$ (i, j) * (-1)^(i+j) *
        ( signof q * (\<Prod>i'' = 0..< l. mat_delete A i j $$ (i'', q i'')) ) )"
       by (intro sum.cong[OF refl],auto)
     also have "... = A $$ (i, j) * (-1)^(i+j) *
       ( \<Sum> q \<in> Q. signof q * (\<Prod>i''= 0 ..< l. mat_delete A i j $$ (i'', q i'')) )"
       unfolding sum_distrib_left by auto
     also have "... = (A $$ (i, j) * (-1)^(i+j) * det (mat_delete A i j))"
       unfolding det_def'[OF mat_delete_carrier[OF A]]
       unfolding Q_def by auto
     finally have "sum h {p | p. p permutes ?N \<and> p i = j} = A $$ (i, j) * cofactor A i j"
       unfolding cofactor_def by auto
   }
   hence "... = (\<Sum>i\<in>?N. A $$ (i,j) * cofactor A i j)" by auto
   finally show ?thesis unfolding atLeast0LessThan using A j unfolding l_def by auto
 qed
 
 lemma laplace_expansion_row:
   assumes A: "(A :: 'a :: comm_ring_1 mat) \<in> carrier_mat n n"
       and i: "i < n"
     shows "det A = (\<Sum>j<n. A $$ (i,j) * cofactor A i j)"
 proof -
   have "det A = det (A\<^sup>T)" using det_transpose[OF A] by simp
   also have "\<dots> = (\<Sum>j<n. A\<^sup>T $$ (j, i) * cofactor A\<^sup>T j i)" 
     by (rule laplace_expansion_column[OF _ i], insert A, auto)
   also have "\<dots> = (\<Sum>j<n. A $$ (i,j) * cofactor A i j)" unfolding cofactor_def
   proof (rule sum.cong[OF refl], rule arg_cong2[of _ _ _ _ "\<lambda> x y. x * y"], goal_cases)
     case (1 j)
     thus ?case using A i by auto
   next
     case (2 j)
     have "det (mat_delete A\<^sup>T j i) = det ((mat_delete A\<^sup>T j i)\<^sup>T)" 
       by (subst det_transpose, insert A, auto simp: mat_delete_def)
     also have "(mat_delete A\<^sup>T j i)\<^sup>T = mat_delete A i j" 
       unfolding mat_delete_def using A by auto
     finally show ?case by (simp add: ac_simps)
   qed
   finally show ?thesis .
 qed
 
 
 lemma degree_det_le: assumes "\<And> i j. i < n \<Longrightarrow> j < n \<Longrightarrow> degree (A $$ (i,j)) \<le> k"
   and A: "A \<in> carrier_mat n n" 
 shows "degree (det A) \<le> k * n" 
 proof -
   {
     fix p
     assume p: "p permutes {0..<n}"
-    have "(\<Sum>x = 0..<n. degree (A $$ (x, p x))) \<le> (\<Sum>x = 0..<n. k)"     
+    have "(\<Sum>x = 0..<n. degree (A $$ (x, p x))) \<le> (\<Sum>x = 0..<n. k)"
       by (rule sum_mono[OF assms(1)], insert p, auto)
     also have "\<dots> = k * n" unfolding sum_constant by simp
     also note calculation 
   } note * = this
   show ?thesis unfolding det_def'[OF A]
-    by (rule degree_sum_le, insert *, auto simp: finite_permutations signof_def 
-      intro!: order.trans[OF degree_prod_sum_le])
+    apply (rule degree_sum_le)
+     apply (simp_all add: finite_permutations)
+    apply (drule *)
+    apply (rule order.trans [OF degree_mult_le])
+    apply simp
+    apply (rule order.trans [OF degree_prod_sum_le])
+     apply simp_all
+    done
 qed
 
 lemma upper_triangular_imp_det_eq_0_iff:
   fixes A :: "'a :: idom mat"
   assumes "A \<in> carrier_mat n n" and "upper_triangular A"
   shows "det A = 0 \<longleftrightarrow> 0 \<in> set (diag_mat A)"
   using assms by (auto simp: det_upper_triangular)
 
 lemma det_identical_columns:
   assumes A: "A \<in> carrier_mat n n"  
     and ij: "i \<noteq> j"
     and i: "i < n" and j: "j < n"
     and r: "col A i = col A j"
   shows "det A = 0"
 proof-
   have "det A = det A\<^sup>T" using det_transpose[OF A] ..
   also have "... = 0" 
   proof (rule det_identical_rows[of _ n i j])
      show "row (transpose_mat A) i = row (transpose_mat A) j"
        using A i j r by auto
   qed (auto simp add: assms)
   finally show ?thesis .
 qed
 
 definition adj_mat :: "'a :: comm_ring_1 mat \<Rightarrow> 'a mat" where
   "adj_mat A = mat (dim_row A) (dim_col A) (\<lambda> (i,j). cofactor A j i)" 
 
 lemma adj_mat: assumes A: "A \<in> carrier_mat n n"
   shows "adj_mat A \<in> carrier_mat n n"
   "A * adj_mat A = det A \<cdot>\<^sub>m 1\<^sub>m n" 
   "adj_mat A * A = det A \<cdot>\<^sub>m 1\<^sub>m n" 
 proof -
   from A have dims: "dim_row A = n" "dim_col A = n" by auto
   show aA: "adj_mat A \<in> carrier_mat n n" unfolding adj_mat_def dims by simp  
   {
     fix i j
     assume ij: "i < n" "j < n" 
     define B where "B = mat n n (\<lambda> (i',j'). if i' = j then A $$ (i,j') else A $$ (i',j'))" 
     have "(A * adj_mat A) $$ (i,j) = (\<Sum> k < n. A $$ (i,k) * cofactor A j k)" 
       unfolding times_mat_def scalar_prod_def adj_mat_def using ij A by (auto intro: sum.cong)
     also have "\<dots> = (\<Sum> k < n. A $$ (i,k) * (-1)^(j + k) * det (mat_delete A j k))" 
       unfolding cofactor_def by (auto intro: sum.cong)
     also have "\<dots> = (\<Sum> k < n. B $$ (j,k) * (-1)^(j + k) * det (mat_delete B j k))" 
       by (rule sum.cong[OF refl], intro arg_cong2[of _ _ _ _ "\<lambda> x y. y * _ * det x"], insert A ij,
         auto simp: B_def mat_delete_def)
     also have "\<dots> = (\<Sum> k < n. B $$ (j,k) * cofactor B j k)" 
       unfolding cofactor_def by (simp add: ac_simps)
     also have "\<dots> = det B" 
       by (rule laplace_expansion_row[symmetric], insert ij, auto simp: B_def)
     also have "\<dots> = (if i = j then det A else 0)" 
     proof (cases "i = j")
       case True
       hence "B = A" using A by (auto simp add: B_def)
       with True show ?thesis by simp
     next
       case False
       have "det B = 0" 
         by (rule Determinant.det_identical_rows[OF _ False ij], insert A ij, auto simp: B_def)
       with False show ?thesis by simp
     qed
     also have "\<dots> = (det A \<cdot>\<^sub>m 1\<^sub>m n) $$ (i,j)"  using ij by auto
     finally have "(A * adj_mat A) $$ (i, j) = (det A \<cdot>\<^sub>m 1\<^sub>m n) $$ (i, j)" .
   } note main = this
   show "A * adj_mat A = det A \<cdot>\<^sub>m 1\<^sub>m n"
     by (rule eq_matI[OF main], insert A aA, auto)
   (* now the completely symmetric version *)
   {
     fix i j
     assume ij: "i < n" "j < n" 
     define B where "B = mat n n (\<lambda> (i',j'). if j' = i then A $$ (i',j) else A $$ (i',j'))" 
     have "(adj_mat A * A) $$ (i,j) = (\<Sum> k < n. A $$ (k,j) * cofactor A k i)" 
       unfolding times_mat_def scalar_prod_def adj_mat_def using ij A by (auto intro: sum.cong)
     also have "\<dots> = (\<Sum> k < n. A $$ (k,j) * (-1)^(k + i) * det (mat_delete A k i))" 
       unfolding cofactor_def by (auto intro: sum.cong)
     also have "\<dots> = (\<Sum> k < n. B $$ (k,i) * (-1)^(k + i) * det (mat_delete B k i))" 
       by (rule sum.cong[OF refl], intro arg_cong2[of _ _ _ _ "\<lambda> x y. y * _ * det x"], insert A ij,
         auto simp: B_def mat_delete_def)
     also have "\<dots> = (\<Sum> k < n. B $$ (k,i) * cofactor B k i)" 
       unfolding cofactor_def by (simp add: ac_simps)
     also have "\<dots> = det B" 
       by (rule laplace_expansion_column[symmetric], insert ij, auto simp: B_def)
     also have "\<dots> = (if i = j then det A else 0)" 
     proof (cases "i = j")
       case True
       hence "B = A" using A by (auto simp add: B_def)
       with True show ?thesis by simp
     next
       case False
       have "det B = 0" 
         by (rule Determinant.det_identical_columns[OF _ False ij], insert A ij, auto simp: B_def)
       with False show ?thesis by simp
     qed
     also have "\<dots> = (det A \<cdot>\<^sub>m 1\<^sub>m n) $$ (i,j)"  using ij by auto
     finally have "(adj_mat A * A) $$ (i, j) = (det A \<cdot>\<^sub>m 1\<^sub>m n) $$ (i, j)" .
   } note main = this
   show "adj_mat A * A = det A \<cdot>\<^sub>m 1\<^sub>m n"
     by (rule eq_matI[OF main], insert A aA, auto)
 qed
 
 definition "replace_col A b k = mat (dim_row A) (dim_col A) (\<lambda> (i,j). if j = k then b $ i else A $$ (i,j))"
 
 lemma cramer_lemma_mat:  
   assumes A: "A \<in> carrier_mat n n" 
   and x: "x \<in> carrier_vec n" 
   and k: "k < n" 
 shows "det (replace_col A (A *\<^sub>v x) k) = x $ k * det A" 
 proof -
   define b where "b = A *\<^sub>v x" 
   have b: "b \<in> carrier_vec n" using A x unfolding b_def by auto
   let ?Ab = "replace_col A b k" 
   have Ab: "?Ab \<in> carrier_mat n n" using A by (auto simp: replace_col_def)
   have "x $ k * det A = (det A \<cdot>\<^sub>v x) $ k" using A k x by auto
   also have "det A \<cdot>\<^sub>v x = det A \<cdot>\<^sub>v (1\<^sub>m n *\<^sub>v x)" using x by auto
   also have "\<dots> = (det A \<cdot>\<^sub>m 1\<^sub>m n) *\<^sub>v x" using A x by auto
   also have "\<dots> = (adj_mat A * A) *\<^sub>v x" using adj_mat[OF A] by simp
   also have "\<dots> = adj_mat A *\<^sub>v b" using adj_mat[OF A] A x unfolding b_def
     by (metis assoc_mult_mat_vec)
   also have "\<dots> $ k = row (adj_mat A) k \<bullet> b" using adj_mat[OF A] b k by auto
   also have "\<dots> = det (replace_col A b k)" unfolding scalar_prod_def using b k A
     by (subst laplace_expansion_column[OF Ab k], auto intro!: sum.cong arg_cong[of _ _ det] 
       arg_cong[of _ _ "\<lambda> x. _ * x"] eq_matI
       simp: replace_col_def adj_mat_def Matrix.row_def cofactor_def mat_delete_def ac_simps)
   finally show ?thesis unfolding b_def by simp
 qed
 
 
 end
\ No newline at end of file
diff --git a/thys/Jordan_Normal_Form/Matrix.thy b/thys/Jordan_Normal_Form/Matrix.thy
--- a/thys/Jordan_Normal_Form/Matrix.thy
+++ b/thys/Jordan_Normal_Form/Matrix.thy
@@ -1,3003 +1,3003 @@
 (*
     Author:      René Thiemann
                  Akihisa Yamada
     License:     BSD
 *)
 (* with contributions from Alexander Bentkamp, Universität des Saarlandes *)
 
 section\<open>Vectors and Matrices\<close>
 
 text \<open>We define vectors as pairs of dimension and a characteristic function from natural numbers
 to elements.
 Similarly, matrices are defined as triples of two dimensions and one
 characteristic function from pairs of natural numbers to elements.
 Via a subtype we ensure that the characteristic function always behaves the same
 on indices outside the intended one. Hence, every matrix has a unique representation.
 
 In this part we define basic operations like matrix-addition, -multiplication, scalar-product,
 etc. We connect these operations to HOL-Algebra with its explicit carrier sets.\<close>
 
 theory Matrix
 imports
+  Polynomial_Interpolation.Ring_Hom
   Missing_Ring
+  Conjugate
   "HOL-Algebra.Module"
-  Polynomial_Interpolation.Ring_Hom
-  Conjugate
 begin
 
 subsection\<open>Vectors\<close>
 
 text \<open>Here we specify which value should be returned in case
   an index is out of bounds. The current solution has the advantage
   that in the implementation later on, no index comparison has to be performed.\<close>
 
 definition undef_vec :: "nat \<Rightarrow> 'a" where
   "undef_vec i \<equiv> [] ! i"
 
 definition mk_vec :: "nat \<Rightarrow> (nat \<Rightarrow> 'a) \<Rightarrow> (nat \<Rightarrow> 'a)" where
   "mk_vec n f \<equiv> \<lambda> i. if i < n then f i else undef_vec (i - n)"
 
 typedef 'a vec = "{(n, mk_vec n f) | n f :: nat \<Rightarrow> 'a. True}"
   by auto
 
 setup_lifting type_definition_vec
 
 lift_definition dim_vec :: "'a vec \<Rightarrow> nat" is fst .
 lift_definition vec_index :: "'a vec \<Rightarrow> (nat \<Rightarrow> 'a)" (infixl "$" 100) is snd .
 lift_definition vec :: "nat \<Rightarrow> (nat \<Rightarrow> 'a) \<Rightarrow> 'a vec"
   is "\<lambda> n f. (n, mk_vec n f)" by auto
 
 lift_definition vec_of_list :: "'a list \<Rightarrow> 'a vec" is
   "\<lambda> v. (length v, mk_vec (length v) (nth v))" by auto
 
 lift_definition list_of_vec :: "'a vec \<Rightarrow> 'a list" is
   "\<lambda> (n,v). map v [0 ..< n]" .
 
 definition carrier_vec :: "nat \<Rightarrow> 'a vec set" where
   "carrier_vec n = { v . dim_vec v = n}"
 
 lemma carrier_vec_dim_vec[simp]: "v \<in> carrier_vec (dim_vec v)" unfolding carrier_vec_def by auto
 
 lemma dim_vec[simp]: "dim_vec (vec n f) = n" by transfer simp
 lemma vec_carrier[simp]: "vec n f \<in> carrier_vec n" unfolding carrier_vec_def by auto
 lemma index_vec[simp]: "i < n \<Longrightarrow> vec n f $ i = f i" by transfer (simp add: mk_vec_def)
 lemma eq_vecI[intro]: "(\<And> i. i < dim_vec w \<Longrightarrow> v $ i = w $ i) \<Longrightarrow> dim_vec v = dim_vec w
   \<Longrightarrow> v = w"
   by (transfer, auto simp: mk_vec_def)
 
 lemma carrier_dim_vec: "v \<in> carrier_vec n \<longleftrightarrow> dim_vec v = n"
   unfolding carrier_vec_def by auto
 
 lemma carrier_vecD[simp]: "v \<in> carrier_vec n \<Longrightarrow> dim_vec v = n" using carrier_dim_vec by auto
 
 lemma carrier_vecI: "dim_vec v = n \<Longrightarrow> v \<in> carrier_vec n" using carrier_dim_vec by auto
 
 instantiation vec :: (plus) plus
 begin
 definition plus_vec :: "'a vec \<Rightarrow> 'a vec \<Rightarrow> 'a :: plus vec" where
   "v\<^sub>1 + v\<^sub>2 \<equiv> vec (dim_vec v\<^sub>2) (\<lambda> i. v\<^sub>1 $ i + v\<^sub>2 $ i)"
 instance ..
 end
 
 instantiation vec :: (minus) minus
 begin
 definition minus_vec :: "'a vec \<Rightarrow> 'a vec \<Rightarrow> 'a :: minus vec" where
   "v\<^sub>1 - v\<^sub>2 \<equiv> vec (dim_vec v\<^sub>2) (\<lambda> i. v\<^sub>1 $ i - v\<^sub>2 $ i)"
 instance ..
 end
 
 definition
   zero_vec :: "nat \<Rightarrow> 'a :: zero vec" ("0\<^sub>v")
   where "0\<^sub>v n \<equiv> vec n (\<lambda> i. 0)"
 
 lemma zero_carrier_vec[simp]: "0\<^sub>v n \<in> carrier_vec n"
   unfolding zero_vec_def carrier_vec_def by auto
 
 lemma index_zero_vec[simp]: "i < n \<Longrightarrow> 0\<^sub>v n $ i = 0" "dim_vec (0\<^sub>v n) = n"
   unfolding zero_vec_def by auto
 
 lemma vec_of_dim_0[simp]: "dim_vec v = 0 \<longleftrightarrow> v = 0\<^sub>v 0" by auto
 
 definition
   unit_vec :: "nat \<Rightarrow> nat \<Rightarrow> ('a :: zero_neq_one) vec"
   where "unit_vec n i = vec n (\<lambda> j. if j = i then 1 else 0)"
 
 lemma index_unit_vec[simp]:
   "i < n \<Longrightarrow> j < n \<Longrightarrow> unit_vec n i $ j = (if j = i then 1 else 0)"
   "i < n \<Longrightarrow> unit_vec n i $ i = 1"
   "dim_vec (unit_vec n i) = n"
   unfolding unit_vec_def by auto
 
 lemma unit_vec_eq[simp]:
   assumes i: "i < n"
   shows "(unit_vec n i = unit_vec n j) = (i = j)"
 proof -
   have "i \<noteq> j \<Longrightarrow> unit_vec n i $ i \<noteq> unit_vec n j $ i"
     unfolding unit_vec_def using i by simp
   then show ?thesis by metis
 qed
 
 lemma unit_vec_nonzero[simp]:
   assumes i_n: "i < n" shows "unit_vec n i \<noteq> zero_vec n" (is "?l \<noteq> ?r")
 proof -
   have "?l $ i = 1" "?r $ i = 0" using i_n by auto
   thus "?l \<noteq> ?r" by auto
 qed
 
 lemma unit_vec_carrier[simp]: "unit_vec n i \<in> carrier_vec n"
   unfolding unit_vec_def carrier_vec_def by auto
 
 definition unit_vecs:: "nat \<Rightarrow> 'a :: zero_neq_one vec list"
   where "unit_vecs n = map (unit_vec n) [0..<n]"
 
 text "List of first i units"
 
 fun unit_vecs_first:: "nat \<Rightarrow> nat \<Rightarrow> 'a::zero_neq_one vec list"
   where "unit_vecs_first n 0 = []"
     |   "unit_vecs_first n (Suc i) = unit_vecs_first n i @ [unit_vec n i]"
 
 lemma unit_vecs_first: "unit_vecs n = unit_vecs_first n n"
   unfolding unit_vecs_def set_map set_upt
 proof -
   {fix m
     have "m \<le> n \<Longrightarrow> map (unit_vec n) [0..<m] = unit_vecs_first n m"
     proof (induct m)
       case (Suc m) then have mn:"m\<le>n" by auto
         show ?case unfolding upt_Suc using Suc(1)[OF mn] by auto
     qed auto
   }
   thus "map (unit_vec n) [0..<n] = unit_vecs_first n n" by auto
 qed
 
 text "list of last i units"
 
 fun unit_vecs_last:: "nat \<Rightarrow> nat \<Rightarrow> 'a :: zero_neq_one vec list"
   where "unit_vecs_last n 0 = []"
     |   "unit_vecs_last n (Suc i) = unit_vec n (n - Suc i) # unit_vecs_last n i"
 
 lemma unit_vecs_last_carrier: "set (unit_vecs_last n i) \<subseteq> carrier_vec n"
   by (induct i;auto)
 
 lemma unit_vecs_last[code]: "unit_vecs n = unit_vecs_last n n"
 proof -
   { fix m assume "m = n"
     have "m \<le> n \<Longrightarrow> map (unit_vec n) [n-m..<n] = unit_vecs_last n m"
       proof (induction m)
       case (Suc m)
         then have nm:"n - Suc m < n" by auto
         have ins: "[n - Suc m ..< n] = (n - Suc m) # [n - m ..< n]"
           unfolding upt_conv_Cons[OF nm]
           by (auto simp: Suc.prems Suc_diff_Suc Suc_le_lessD)
         show ?case
           unfolding ins
           unfolding unit_vecs_last.simps
           unfolding list.map
           using Suc
           unfolding Suc by auto
       qed simp
   }
   thus "unit_vecs n = unit_vecs_last n n"
     unfolding unit_vecs_def by auto
 qed
 
 lemma unit_vecs_carrier: "set (unit_vecs n) \<subseteq> carrier_vec n"
 proof
   fix u :: "'a vec"  assume u: "u \<in> set (unit_vecs n)"
   then obtain i where "u = unit_vec n i" unfolding unit_vecs_def by auto
   then show "u \<in> carrier_vec n"
     using unit_vec_carrier by auto
 qed
 
 lemma unit_vecs_last_distinct:
   "j \<le> n \<Longrightarrow> i < n - j \<Longrightarrow> unit_vec n i \<notin> set (unit_vecs_last n j)"
   by (induction j arbitrary:i, auto)
 
 lemma unit_vecs_first_distinct:
   "i \<le> j \<Longrightarrow> j < n \<Longrightarrow> unit_vec n j \<notin> set (unit_vecs_first n i)"
   by (induction i arbitrary:j, auto)
 
 definition map_vec where "map_vec f v \<equiv> vec (dim_vec v) (\<lambda>i. f (v $ i))"
 
 instantiation vec :: (uminus) uminus
 begin
 definition uminus_vec :: "'a :: uminus vec \<Rightarrow> 'a vec" where
   "- v \<equiv> vec (dim_vec v) (\<lambda> i. - (v $ i))"
 instance ..
 end
 
 definition smult_vec :: "'a :: times \<Rightarrow> 'a vec \<Rightarrow> 'a vec" (infixl "\<cdot>\<^sub>v" 70)
   where "a \<cdot>\<^sub>v v \<equiv> vec (dim_vec v) (\<lambda> i. a * v $ i)"
 
 definition scalar_prod :: "'a vec \<Rightarrow> 'a vec \<Rightarrow> 'a :: semiring_0" (infix "\<bullet>" 70)
   where "v \<bullet> w \<equiv> \<Sum> i \<in> {0 ..< dim_vec w}. v $ i * w $ i"
 
 definition monoid_vec :: "'a itself \<Rightarrow> nat \<Rightarrow> ('a :: monoid_add vec) monoid" where
   "monoid_vec ty n \<equiv> \<lparr>
     carrier = carrier_vec n,
     mult = (+),
     one = 0\<^sub>v n\<rparr>"
 
 definition module_vec ::
   "'a :: semiring_1 itself \<Rightarrow> nat \<Rightarrow> ('a,'a vec) module" where
   "module_vec ty n \<equiv> \<lparr>
     carrier = carrier_vec n,
     mult = undefined,
     one = undefined,
     zero = 0\<^sub>v n,
     add = (+),
     smult = (\<cdot>\<^sub>v)\<rparr>"
 
 lemma monoid_vec_simps:
   "mult (monoid_vec ty n) = (+)"
   "carrier (monoid_vec ty n) = carrier_vec n"
   "one (monoid_vec ty n) = 0\<^sub>v n"
   unfolding monoid_vec_def by auto
 
 lemma module_vec_simps:
   "add (module_vec ty n) = (+)"
   "zero (module_vec ty n) = 0\<^sub>v n"
   "carrier (module_vec ty n) = carrier_vec n"
   "smult (module_vec ty n) = (\<cdot>\<^sub>v)"
   unfolding module_vec_def by auto
 
 definition finsum_vec :: "'a :: monoid_add itself \<Rightarrow> nat \<Rightarrow> ('c \<Rightarrow> 'a vec) \<Rightarrow> 'c set \<Rightarrow> 'a vec" where
   "finsum_vec ty n = finprod (monoid_vec ty n)"
 
 lemma index_add_vec[simp]:
   "i < dim_vec v\<^sub>2 \<Longrightarrow> (v\<^sub>1 + v\<^sub>2) $ i = v\<^sub>1 $ i + v\<^sub>2 $ i" "dim_vec (v\<^sub>1 + v\<^sub>2) = dim_vec v\<^sub>2"
   unfolding plus_vec_def by auto
 
 lemma index_minus_vec[simp]:
   "i < dim_vec v\<^sub>2 \<Longrightarrow> (v\<^sub>1 - v\<^sub>2) $ i = v\<^sub>1 $ i - v\<^sub>2 $ i" "dim_vec (v\<^sub>1 - v\<^sub>2) = dim_vec v\<^sub>2"
   unfolding minus_vec_def by auto
 
 lemma index_map_vec[simp]:
   "i < dim_vec v \<Longrightarrow> map_vec f v $ i = f (v $ i)"
   "dim_vec (map_vec f v) = dim_vec v"
   unfolding map_vec_def by auto
 
 lemma map_carrier_vec[simp]: "map_vec h v \<in> carrier_vec n = (v \<in> carrier_vec n)"
   unfolding map_vec_def carrier_vec_def by auto
 
 lemma index_uminus_vec[simp]:
   "i < dim_vec v \<Longrightarrow> (- v) $ i = - (v $ i)"
   "dim_vec (- v) = dim_vec v"
   unfolding uminus_vec_def by auto
 
 lemma index_smult_vec[simp]:
   "i < dim_vec v \<Longrightarrow> (a \<cdot>\<^sub>v v) $ i = a * v $ i" "dim_vec (a \<cdot>\<^sub>v v) = dim_vec v"
   unfolding smult_vec_def by auto
 
 lemma add_carrier_vec[simp]:
   "v\<^sub>1 \<in> carrier_vec n \<Longrightarrow> v\<^sub>2 \<in> carrier_vec n \<Longrightarrow> v\<^sub>1 + v\<^sub>2 \<in> carrier_vec n"
   unfolding carrier_vec_def by auto
 
 lemma minus_carrier_vec[simp]:
   "v\<^sub>1 \<in> carrier_vec n \<Longrightarrow> v\<^sub>2 \<in> carrier_vec n \<Longrightarrow> v\<^sub>1 - v\<^sub>2 \<in> carrier_vec n"
   unfolding carrier_vec_def by auto
 
 lemma comm_add_vec[ac_simps]:
   "(v\<^sub>1 :: 'a :: ab_semigroup_add vec) \<in> carrier_vec n \<Longrightarrow> v\<^sub>2 \<in> carrier_vec n \<Longrightarrow> v\<^sub>1 + v\<^sub>2 = v\<^sub>2 + v\<^sub>1"
   by (intro eq_vecI, auto simp: ac_simps)
 
 lemma assoc_add_vec[simp]:
   "(v\<^sub>1 :: 'a :: semigroup_add vec) \<in> carrier_vec n \<Longrightarrow> v\<^sub>2 \<in> carrier_vec n \<Longrightarrow> v\<^sub>3 \<in> carrier_vec n
   \<Longrightarrow> (v\<^sub>1 + v\<^sub>2) + v\<^sub>3 = v\<^sub>1 + (v\<^sub>2 + v\<^sub>3)"
   by (intro eq_vecI, auto simp: ac_simps)
 
 lemma zero_minus_vec[simp]: "(v :: 'a :: group_add vec) \<in> carrier_vec n \<Longrightarrow> 0\<^sub>v n - v = - v"
   by (intro eq_vecI, auto)
 
 lemma minus_zero_vec[simp]: "(v :: 'a :: group_add vec) \<in> carrier_vec n \<Longrightarrow> v - 0\<^sub>v n = v"
   by (intro eq_vecI, auto)
 
 lemma minus_cancel_vec[simp]: "(v :: 'a :: group_add vec) \<in> carrier_vec n \<Longrightarrow> v - v = 0\<^sub>v n"
   by (intro eq_vecI, auto)
 
 lemma minus_add_uminus_vec: "(v :: 'a :: group_add vec) \<in> carrier_vec n \<Longrightarrow>
   w \<in> carrier_vec n \<Longrightarrow> v - w = v + (- w)"
   by (intro eq_vecI, auto)
 
 lemma comm_monoid_vec: "comm_monoid (monoid_vec TYPE ('a :: comm_monoid_add) n)"
   by (unfold_locales, auto simp: monoid_vec_def ac_simps)
 
 lemma left_zero_vec[simp]: "(v :: 'a :: monoid_add vec) \<in> carrier_vec n  \<Longrightarrow> 0\<^sub>v n + v = v" by auto
 
 lemma right_zero_vec[simp]: "(v :: 'a :: monoid_add vec) \<in> carrier_vec n  \<Longrightarrow> v + 0\<^sub>v n = v" by auto
 
 
 lemma uminus_carrier_vec[simp]:
   "(- v \<in> carrier_vec n) = (v \<in> carrier_vec n)"
   unfolding carrier_vec_def by auto
 
 lemma uminus_r_inv_vec[simp]:
   "(v :: 'a :: group_add vec) \<in> carrier_vec n \<Longrightarrow> (v + - v) = 0\<^sub>v n"
   by (intro eq_vecI, auto)
 
 lemma uminus_l_inv_vec[simp]:
   "(v :: 'a :: group_add vec) \<in> carrier_vec n \<Longrightarrow> (- v + v) = 0\<^sub>v n"
   by (intro eq_vecI, auto)
 
 lemma add_inv_exists_vec:
   "(v :: 'a :: group_add vec) \<in> carrier_vec n \<Longrightarrow> \<exists> w \<in> carrier_vec n. w + v = 0\<^sub>v n \<and> v + w = 0\<^sub>v n"
   by (intro bexI[of _ "- v"], auto)
 
 lemma comm_group_vec: "comm_group (monoid_vec TYPE ('a :: ab_group_add) n)"
   by (unfold_locales, insert add_inv_exists_vec, auto simp: monoid_vec_def ac_simps Units_def)
 
 lemmas finsum_vec_insert =
   comm_monoid.finprod_insert[OF comm_monoid_vec, folded finsum_vec_def, unfolded monoid_vec_simps]
 
 lemmas finsum_vec_closed =
   comm_monoid.finprod_closed[OF comm_monoid_vec, folded finsum_vec_def, unfolded monoid_vec_simps]
 
 lemmas finsum_vec_empty =
   comm_monoid.finprod_empty[OF comm_monoid_vec, folded finsum_vec_def, unfolded monoid_vec_simps]
 
 lemma smult_carrier_vec[simp]: "(a \<cdot>\<^sub>v v \<in> carrier_vec n) = (v \<in> carrier_vec n)"
   unfolding carrier_vec_def by auto
 
 lemma scalar_prod_left_zero[simp]: "v \<in> carrier_vec n \<Longrightarrow> 0\<^sub>v n \<bullet> v = 0"
   unfolding scalar_prod_def
   by (rule sum.neutral, auto)
 
 lemma scalar_prod_right_zero[simp]: "v \<in> carrier_vec n \<Longrightarrow> v \<bullet> 0\<^sub>v n = 0"
   unfolding scalar_prod_def
   by (rule sum.neutral, auto)
 
 lemma scalar_prod_left_unit[simp]: assumes v: "(v :: 'a :: semiring_1 vec) \<in> carrier_vec n" and i: "i < n"
   shows "unit_vec n i \<bullet> v = v $ i"
 proof -
   let ?f = "\<lambda> k. unit_vec n i $ k * v $ k"
   have id: "(\<Sum>k\<in>{0..<n}. ?f k) = unit_vec n i $ i * v $ i + (\<Sum>k\<in>{0..<n} - {i}. ?f k)"
     by (rule sum.remove, insert i, auto)
   also have "(\<Sum> k\<in>{0..<n} - {i}. ?f k) = 0"
     by (rule sum.neutral, insert i, auto)
   finally
   show ?thesis unfolding scalar_prod_def using i v by simp
 qed
 
 lemma scalar_prod_right_unit[simp]: assumes i: "i < n"
   shows "(v :: 'a :: semiring_1 vec) \<bullet> unit_vec n i = v $ i"
 proof -
   let ?f = "\<lambda> k. v $ k * unit_vec n i $ k"
   have id: "(\<Sum>k\<in>{0..<n}. ?f k) = v $ i * unit_vec n i $ i + (\<Sum>k\<in>{0..<n} - {i}. ?f k)"
     by (rule sum.remove, insert i, auto)
   also have "(\<Sum>k\<in>{0..<n} - {i}. ?f k) = 0"
     by (rule sum.neutral, insert i, auto)
   finally
   show ?thesis unfolding scalar_prod_def using i by simp
 qed
 
 lemma add_scalar_prod_distrib: assumes v: "v\<^sub>1 \<in> carrier_vec n" "v\<^sub>2 \<in> carrier_vec n" "v\<^sub>3 \<in> carrier_vec n"
   shows "(v\<^sub>1 + v\<^sub>2) \<bullet> v\<^sub>3 = v\<^sub>1 \<bullet> v\<^sub>3 + v\<^sub>2 \<bullet> v\<^sub>3"
 proof -
   have "(\<Sum>i\<in>{0..<dim_vec v\<^sub>3}. (v\<^sub>1 + v\<^sub>2) $ i * v\<^sub>3 $ i) = (\<Sum>i\<in>{0..<dim_vec v\<^sub>3}. v\<^sub>1 $ i * v\<^sub>3 $ i + v\<^sub>2 $ i * v\<^sub>3 $ i)"
     by (rule sum.cong, insert v, auto simp: algebra_simps)
   thus ?thesis unfolding scalar_prod_def using v by (auto simp: sum.distrib)
 qed
 
 lemma scalar_prod_add_distrib: assumes v: "v\<^sub>1 \<in> carrier_vec n" "v\<^sub>2 \<in> carrier_vec n" "v\<^sub>3 \<in> carrier_vec n"
   shows "v\<^sub>1 \<bullet> (v\<^sub>2 + v\<^sub>3) = v\<^sub>1 \<bullet> v\<^sub>2 + v\<^sub>1 \<bullet> v\<^sub>3"
 proof -
   have "(\<Sum>i\<in>{0..<dim_vec v\<^sub>3}. v\<^sub>1 $ i * (v\<^sub>2 + v\<^sub>3) $ i) = (\<Sum>i\<in>{0..<dim_vec v\<^sub>3}. v\<^sub>1 $ i * v\<^sub>2 $ i + v\<^sub>1 $ i * v\<^sub>3 $ i)"
     by (rule sum.cong, insert v, auto simp: algebra_simps)
   thus ?thesis unfolding scalar_prod_def using v by (auto intro: sum.distrib)
 qed
 
 lemma smult_scalar_prod_distrib[simp]: assumes v: "v\<^sub>1 \<in> carrier_vec n" "v\<^sub>2 \<in> carrier_vec n"
   shows "(a \<cdot>\<^sub>v v\<^sub>1) \<bullet> v\<^sub>2 = a * (v\<^sub>1 \<bullet> v\<^sub>2)"
   unfolding scalar_prod_def sum_distrib_left
   by (rule sum.cong, insert v, auto simp: ac_simps)
 
 lemma scalar_prod_smult_distrib[simp]: assumes v: "v\<^sub>1 \<in> carrier_vec n" "v\<^sub>2 \<in> carrier_vec n"
   shows "v\<^sub>1 \<bullet> (a \<cdot>\<^sub>v v\<^sub>2) = (a :: 'a :: comm_ring) * (v\<^sub>1 \<bullet> v\<^sub>2)"
   unfolding scalar_prod_def sum_distrib_left
   by (rule sum.cong, insert v, auto simp: ac_simps)
 
 lemma comm_scalar_prod: assumes "(v\<^sub>1 :: 'a :: comm_semiring_0 vec) \<in> carrier_vec n" "v\<^sub>2 \<in> carrier_vec n"
   shows "v\<^sub>1 \<bullet> v\<^sub>2 = v\<^sub>2 \<bullet> v\<^sub>1"
   unfolding scalar_prod_def
   by (rule sum.cong, insert assms, auto simp: ac_simps)
 
 lemma add_smult_distrib_vec:
   "((a::'a::ring) + b) \<cdot>\<^sub>v v = a \<cdot>\<^sub>v v + b \<cdot>\<^sub>v v"
   unfolding smult_vec_def plus_vec_def
   by (rule eq_vecI, auto simp: distrib_right)
 
 lemma smult_add_distrib_vec:
   assumes "v \<in> carrier_vec n" "w \<in> carrier_vec n"
   shows "(a::'a::ring) \<cdot>\<^sub>v (v + w) = a \<cdot>\<^sub>v v + a \<cdot>\<^sub>v w"
   apply (rule eq_vecI)
   unfolding smult_vec_def plus_vec_def
   using assms distrib_left by auto
 
 lemma smult_smult_assoc:
   "a \<cdot>\<^sub>v (b \<cdot>\<^sub>v v) = (a * b::'a::ring) \<cdot>\<^sub>v v"
   apply (rule sym, rule eq_vecI)
   unfolding smult_vec_def plus_vec_def using mult.assoc by auto
 
 lemma one_smult_vec [simp]:
   "(1::'a::ring_1) \<cdot>\<^sub>v v = v" unfolding smult_vec_def
   by (rule eq_vecI,auto)
 
 lemma uminus_zero_vec[simp]: "- (0\<^sub>v n) = (0\<^sub>v n :: 'a :: group_add vec)" 
   by (intro eq_vecI, auto)
 
 lemma index_finsum_vec: assumes "finite F" and i: "i < n"
   and vs: "vs \<in> F \<rightarrow> carrier_vec n"
   shows "finsum_vec TYPE('a :: comm_monoid_add) n vs F $ i = sum (\<lambda> f. vs f $ i) F"
   using \<open>finite F\<close> vs
 proof (induct F)
   case (insert f F)
   hence IH: "finsum_vec TYPE('a) n vs F $ i = (\<Sum>f\<in>F. vs f $ i)"
     and vs: "vs \<in> F \<rightarrow> carrier_vec n" "vs f \<in> carrier_vec n" by auto
   show ?case unfolding finsum_vec_insert[OF insert(1-2) vs]
     unfolding sum.insert[OF insert(1-2)]
     unfolding IH[symmetric]
     by (rule index_add_vec, insert i, insert finsum_vec_closed[OF vs(1)], auto)
 qed (insert i, auto simp: finsum_vec_empty)
 
 text \<open>Definition of pointwise ordering on vectors for non-strict part, and
   strict version is defined in a way such that the @{class order} constraints are satisfied.\<close>
 
 instantiation vec :: (ord) ord
 begin
 
 definition less_eq_vec :: "'a vec \<Rightarrow> 'a vec \<Rightarrow> bool" where
   "less_eq_vec v w = (dim_vec v = dim_vec w \<and> (\<forall> i < dim_vec w. v $ i \<le> w $ i))" 
 
 definition less_vec :: "'a vec \<Rightarrow> 'a vec \<Rightarrow> bool" where
   "less_vec v w = (v \<le> w \<and> \<not> (w \<le> v))"
 instance ..
 end
 
 instantiation vec :: (preorder) preorder
 begin
 instance
   by (standard, auto simp: less_vec_def less_eq_vec_def order_trans)
 end
 
 instantiation vec :: (order) order
 begin
 instance
   by (standard, intro eq_vecI, auto simp: less_eq_vec_def order.antisym)
 end
 
 
 subsection\<open>Matrices\<close>
 
 text \<open>Similarly as for vectors, we specify which value should be returned in case
   an index is out of bounds. It is defined in a way that only few
   index comparisons have to be performed in the implementation.\<close>
 
 definition undef_mat :: "nat \<Rightarrow> nat \<Rightarrow> (nat \<times> nat \<Rightarrow> 'a) \<Rightarrow> nat \<times> nat \<Rightarrow> 'a" where
   "undef_mat nr nc f \<equiv> \<lambda> (i,j). [[f (i,j). j <- [0 ..< nc]] . i <- [0 ..< nr]] ! i ! j"
 
 lemma undef_cong_mat: assumes "\<And> i j. i < nr \<Longrightarrow> j < nc \<Longrightarrow> f (i,j) = f' (i,j)"
   shows "undef_mat nr nc f x = undef_mat nr nc f' x"
 proof (cases x)
   case (Pair i j)
   have nth_map_ge: "\<And> i xs. \<not> i < length xs \<Longrightarrow> xs ! i = [] ! (i - length xs)"
     by (metis append_Nil2 nth_append)
   note [simp] = Pair undef_mat_def nth_map_ge[of i] nth_map_ge[of j]
   show ?thesis
     by (cases "i < nr", simp, cases "j < nc", insert assms, auto)
 qed
 
 definition mk_mat :: "nat \<Rightarrow> nat \<Rightarrow> (nat \<times> nat \<Rightarrow> 'a) \<Rightarrow> (nat \<times> nat \<Rightarrow> 'a)" where
   "mk_mat nr nc f \<equiv> \<lambda> (i,j). if i < nr \<and> j < nc then f (i,j) else undef_mat nr nc f (i,j)"
 
 lemma cong_mk_mat: assumes "\<And> i j. i < nr \<Longrightarrow> j < nc \<Longrightarrow> f (i,j) = f' (i,j)"
   shows "mk_mat nr nc f = mk_mat nr nc f'"
   using undef_cong_mat[of nr nc f f', OF assms]
   using assms unfolding mk_mat_def
   by auto
 
 typedef 'a mat = "{(nr, nc, mk_mat nr nc f) | nr nc f :: nat \<times> nat \<Rightarrow> 'a. True}"
   by auto
 
 setup_lifting type_definition_mat
 
 lift_definition dim_row :: "'a mat \<Rightarrow> nat" is fst .
 lift_definition dim_col :: "'a mat \<Rightarrow> nat" is "fst o snd" .
 lift_definition index_mat :: "'a mat \<Rightarrow> (nat \<times> nat \<Rightarrow> 'a)" (infixl "$$" 100) is "snd o snd" .
 lift_definition mat :: "nat \<Rightarrow> nat \<Rightarrow> (nat \<times> nat \<Rightarrow> 'a) \<Rightarrow> 'a mat"
   is "\<lambda> nr nc f. (nr, nc, mk_mat nr nc f)" by auto
 lift_definition mat_of_row_fun :: "nat \<Rightarrow> nat \<Rightarrow> (nat \<Rightarrow> 'a vec) \<Rightarrow> 'a mat" ("mat\<^sub>r")
   is "\<lambda> nr nc f. (nr, nc, mk_mat nr nc (\<lambda> (i,j). f i $ j))" by auto
 
 definition mat_to_list :: "'a mat \<Rightarrow> 'a list list" where
   "mat_to_list A = [ [A $$ (i,j) . j <- [0 ..< dim_col A]] . i <- [0 ..< dim_row A]]"
 
 fun square_mat :: "'a mat \<Rightarrow> bool" where "square_mat A = (dim_col A = dim_row A)"
 
 definition upper_triangular :: "'a::zero mat \<Rightarrow> bool"
   where "upper_triangular A \<equiv>
     \<forall>i < dim_row A. \<forall> j < i. A $$ (i,j) = 0"
 
 lemma upper_triangularD[elim] :
   "upper_triangular A \<Longrightarrow> j < i \<Longrightarrow> i < dim_row A \<Longrightarrow> A $$ (i,j) = 0"
 unfolding upper_triangular_def by auto
 
 lemma upper_triangularI[intro] :
   "(\<And>i j. j < i \<Longrightarrow> i < dim_row A \<Longrightarrow> A $$ (i,j) = 0) \<Longrightarrow> upper_triangular A"
 unfolding upper_triangular_def by auto
 
 lemma dim_row_mat[simp]: "dim_row (mat nr nc f) = nr" "dim_row (mat\<^sub>r nr nc g) = nr"
   by (transfer, simp)+
 
 lemma dim_col_mat[simp]: "dim_col (mat nr nc f) = nc" "dim_col (mat\<^sub>r nr nc g) = nc"
   by (transfer, simp)+
 
 definition carrier_mat :: "nat \<Rightarrow> nat \<Rightarrow> 'a mat set"
   where "carrier_mat nr nc = { m . dim_row m = nr \<and> dim_col m = nc}"
 
 lemma carrier_mat_triv[simp]: "m \<in> carrier_mat (dim_row m) (dim_col m)"
   unfolding carrier_mat_def by auto
 
 lemma mat_carrier[simp]: "mat nr nc f \<in> carrier_mat nr nc"
   unfolding carrier_mat_def by auto
 
 definition elements_mat :: "'a mat \<Rightarrow> 'a set"
   where "elements_mat A = set [A $$ (i,j). i <- [0 ..< dim_row A], j <- [0 ..< dim_col A]]"
 
 lemma elements_matD [dest]:
   "a \<in> elements_mat A \<Longrightarrow> \<exists>i j. i < dim_row A \<and> j < dim_col A \<and> a = A $$ (i,j)"
   unfolding elements_mat_def by force
 
 lemma elements_matI [intro]:
   "A \<in> carrier_mat nr nc \<Longrightarrow> i < nr \<Longrightarrow> j < nc \<Longrightarrow> a = A $$ (i,j) \<Longrightarrow> a \<in> elements_mat A"
   unfolding elements_mat_def carrier_mat_def by force
 
 lemma index_mat[simp]:  "i < nr \<Longrightarrow> j < nc \<Longrightarrow> mat nr nc f $$ (i,j) = f (i,j)"
   "i < nr \<Longrightarrow> j < nc \<Longrightarrow> mat\<^sub>r nr nc g $$ (i,j) = g i $ j"
   by (transfer', simp add: mk_mat_def)+
 
 lemma eq_matI[intro]: "(\<And> i j . i < dim_row B \<Longrightarrow> j < dim_col B \<Longrightarrow> A $$ (i,j) = B $$ (i,j))
   \<Longrightarrow> dim_row A = dim_row B
   \<Longrightarrow> dim_col A = dim_col B
   \<Longrightarrow> A = B"
   by (transfer, auto intro!: cong_mk_mat, auto simp: mk_mat_def)
 
 lemma carrier_matI[intro]:
   assumes "dim_row A = nr" "dim_col A = nc" shows  "A \<in> carrier_mat nr nc"
   using assms unfolding carrier_mat_def by auto
 
 lemma carrier_matD[dest,simp]: assumes "A \<in> carrier_mat nr nc"
   shows "dim_row A = nr" "dim_col A = nc" using assms
   unfolding carrier_mat_def by auto
 
 lemma cong_mat: assumes "nr = nr'" "nc = nc'" "\<And> i j. i < nr \<Longrightarrow> j < nc \<Longrightarrow>
   f (i,j) = f' (i,j)" shows "mat nr nc f = mat nr' nc' f'"
   by (rule eq_matI, insert assms, auto)
 
 definition row :: "'a mat \<Rightarrow> nat \<Rightarrow> 'a vec" where
   "row A i = vec (dim_col A) (\<lambda> j. A $$ (i,j))"
 
 definition rows :: "'a mat \<Rightarrow> 'a vec list" where
   "rows A = map (row A) [0..<dim_row A]"
 
 lemma row_carrier[simp]: "row A i \<in> carrier_vec (dim_col A)" unfolding row_def by auto
 
 lemma rows_carrier[simp]: "set (rows A) \<subseteq> carrier_vec (dim_col A)" unfolding rows_def by auto
 
 lemma length_rows[simp]: "length (rows A) = dim_row A" unfolding rows_def by auto
 
 lemma nth_rows[simp]: "i < dim_row A \<Longrightarrow> rows A ! i = row A i"
   unfolding rows_def by auto
 
 lemma row_mat_of_row_fun[simp]: "i < nr \<Longrightarrow> dim_vec (f i) = nc \<Longrightarrow> row (mat\<^sub>r nr nc f) i = f i"
   by (rule eq_vecI, auto simp: row_def)
 
 lemma set_rows_carrier:
   assumes "A \<in> carrier_mat m n" and "v \<in> set (rows A)" shows "v \<in> carrier_vec n"
   using assms by (auto simp: rows_def row_def)
 
 definition mat_of_rows :: "nat \<Rightarrow> 'a vec list \<Rightarrow> 'a mat"
   where "mat_of_rows n rs = mat (length rs) n (\<lambda>(i,j). rs ! i $ j)"
 
 definition mat_of_rows_list :: "nat \<Rightarrow> 'a list list \<Rightarrow> 'a mat" where
   "mat_of_rows_list nc rs = mat (length rs) nc (\<lambda> (i,j). rs ! i ! j)"
 
 lemma mat_of_rows_carrier[simp]:
   "mat_of_rows n vs \<in> carrier_mat (length vs) n"
   "dim_row (mat_of_rows n vs) = length vs"
   "dim_col (mat_of_rows n vs) = n"
   unfolding mat_of_rows_def by auto
 
 lemma mat_of_rows_row[simp]:
   assumes i:"i < length vs" and n: "vs ! i \<in> carrier_vec n"
   shows "row (mat_of_rows n vs) i = vs ! i"
   unfolding mat_of_rows_def row_def using n i by auto
 
 lemma rows_mat_of_rows[simp]:
   assumes "set vs \<subseteq> carrier_vec n" shows "rows (mat_of_rows n vs) = vs"
   unfolding rows_def apply (rule nth_equalityI)
   using assms unfolding subset_code(1) by auto
 
 lemma mat_of_rows_rows[simp]:
   "mat_of_rows (dim_col A) (rows A) = A"
   unfolding mat_of_rows_def by (rule, auto simp: row_def)
 
 
 definition col :: "'a mat \<Rightarrow> nat \<Rightarrow> 'a vec" where
   "col A j = vec (dim_row A) (\<lambda> i. A $$ (i,j))"
 
 definition cols :: "'a mat \<Rightarrow> 'a vec list" where
   "cols A = map (col A) [0..<dim_col A]"
 
 definition mat_of_cols :: "nat \<Rightarrow> 'a vec list \<Rightarrow> 'a mat"
   where "mat_of_cols n cs = mat n (length cs) (\<lambda>(i,j). cs ! j $ i)"
 
 definition mat_of_cols_list :: "nat \<Rightarrow> 'a list list \<Rightarrow> 'a mat" where
   "mat_of_cols_list nr cs = mat nr (length cs) (\<lambda> (i,j). cs ! j ! i)"
 
 lemma col_dim[simp]: "col A i \<in> carrier_vec (dim_row A)" unfolding col_def by auto
 
 lemma dim_col[simp]: "dim_vec (col A i) = dim_row A" by auto
 
 lemma cols_dim[simp]: "set (cols A) \<subseteq> carrier_vec (dim_row A)" unfolding cols_def by auto
 
 lemma cols_length[simp]: "length (cols A) = dim_col A" unfolding cols_def by auto
 
 lemma cols_nth[simp]: "i < dim_col A \<Longrightarrow> cols A ! i = col A i"
   unfolding cols_def by auto
 
 lemma mat_of_cols_carrier[simp]:
   "mat_of_cols n vs \<in> carrier_mat n (length vs)"
   "dim_row (mat_of_cols n vs) = n"
   "dim_col (mat_of_cols n vs) = length vs"
   unfolding mat_of_cols_def by auto
 
 lemma col_mat_of_cols[simp]:
   assumes j:"j < length vs" and n: "vs ! j \<in> carrier_vec n"
   shows "col (mat_of_cols n vs) j = vs ! j"
   unfolding mat_of_cols_def col_def using j n by auto
 
 lemma cols_mat_of_cols[simp]:
   assumes "set vs \<subseteq> carrier_vec n" shows "cols (mat_of_cols n vs) = vs"
   unfolding cols_def apply(rule nth_equalityI)
   using assms unfolding subset_code(1) by auto
 
 lemma mat_of_cols_cols[simp]:
   "mat_of_cols (dim_row A) (cols A) = A"
   unfolding mat_of_cols_def by (rule, auto simp: col_def)
 
 
 instantiation mat :: (ord) ord
 begin
 
 definition less_eq_mat :: "'a mat \<Rightarrow> 'a mat \<Rightarrow> bool" where
   "less_eq_mat A B = (dim_row A = dim_row B \<and> dim_col A = dim_col B \<and> 
       (\<forall> i < dim_row B. \<forall> j < dim_col B. A $$ (i,j) \<le> B $$ (i,j)))" 
 
 definition less_mat :: "'a mat \<Rightarrow> 'a mat \<Rightarrow> bool" where
   "less_mat A B = (A \<le> B \<and> \<not> (B \<le> A))"
 instance ..
 end
 
 instantiation mat :: (preorder) preorder
 begin
 instance
 proof (standard, auto simp: less_mat_def less_eq_mat_def, goal_cases)
   case (1 A B C i j)
   thus ?case using order_trans[of "A $$ (i,j)" "B $$ (i,j)" "C $$ (i,j)"] by auto
 qed
 end
 
 instantiation mat :: (order) order
 begin
 instance
   by (standard, intro eq_matI, auto simp: less_eq_mat_def order.antisym)
 end
 
 instantiation mat :: (plus) plus
 begin
 definition plus_mat :: "('a :: plus) mat \<Rightarrow> 'a mat \<Rightarrow> 'a mat" where
   "A + B \<equiv> mat (dim_row B) (dim_col B) (\<lambda> ij. A $$ ij + B $$ ij)"
 instance ..
 end
 
 definition map_mat :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a mat \<Rightarrow> 'b mat" where
   "map_mat f A \<equiv> mat (dim_row A) (dim_col A) (\<lambda> ij. f (A $$ ij))"
 
 definition smult_mat :: "'a :: times \<Rightarrow> 'a mat \<Rightarrow> 'a mat" (infixl "\<cdot>\<^sub>m" 70)
   where "a \<cdot>\<^sub>m A \<equiv> map_mat (\<lambda> b. a * b) A"
 
 definition zero_mat :: "nat \<Rightarrow> nat \<Rightarrow> 'a :: zero mat" ("0\<^sub>m") where
   "0\<^sub>m nr nc \<equiv> mat nr nc (\<lambda> ij. 0)"
 
 lemma elements_0_mat [simp]: "elements_mat (0\<^sub>m nr nc) \<subseteq> {0}"
   unfolding elements_mat_def zero_mat_def by auto
 
 definition transpose_mat :: "'a mat \<Rightarrow> 'a mat" where
   "transpose_mat A \<equiv> mat (dim_col A) (dim_row A) (\<lambda> (i,j). A $$ (j,i))"
 
 definition one_mat :: "nat \<Rightarrow> 'a :: {zero,one} mat" ("1\<^sub>m") where
   "1\<^sub>m n \<equiv> mat n n (\<lambda> (i,j). if i = j then 1 else 0)"
 
 instantiation mat :: (uminus) uminus
 begin
 definition uminus_mat :: "'a :: uminus mat \<Rightarrow> 'a mat" where
   "- A \<equiv> mat (dim_row A) (dim_col A) (\<lambda> ij. - (A $$ ij))"
 instance ..
 end
 
 instantiation mat :: (minus) minus
 begin
 definition minus_mat :: "('a :: minus) mat \<Rightarrow> 'a mat \<Rightarrow> 'a mat" where
   "A - B \<equiv> mat (dim_row B) (dim_col B) (\<lambda> ij. A $$ ij - B $$ ij)"
 instance ..
 end
 
 instantiation mat :: (semiring_0) times
 begin
 definition times_mat :: "'a :: semiring_0 mat \<Rightarrow> 'a mat \<Rightarrow> 'a mat"
   where "A * B \<equiv> mat (dim_row A) (dim_col B) (\<lambda> (i,j). row A i \<bullet> col B j)"
 instance ..
 end
 
 definition mult_mat_vec :: "'a :: semiring_0 mat \<Rightarrow> 'a vec \<Rightarrow> 'a vec" (infixl "*\<^sub>v" 70)
   where "A *\<^sub>v v \<equiv> vec (dim_row A) (\<lambda> i. row A i \<bullet> v)"
 
 definition inverts_mat :: "'a :: semiring_1 mat \<Rightarrow> 'a mat \<Rightarrow> bool" where
   "inverts_mat A B \<equiv> A * B = 1\<^sub>m (dim_row A)"
 
 definition invertible_mat :: "'a :: semiring_1 mat \<Rightarrow> bool"
   where "invertible_mat A \<equiv> square_mat A \<and> (\<exists>B. inverts_mat A B \<and> inverts_mat B A)"
 
 definition monoid_mat :: "'a :: monoid_add itself \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a mat monoid" where
   "monoid_mat ty nr nc \<equiv> \<lparr>
     carrier = carrier_mat nr nc,
     mult = (+),
     one = 0\<^sub>m nr nc\<rparr>"
 
 definition ring_mat :: "'a :: semiring_1 itself \<Rightarrow> nat \<Rightarrow> 'b \<Rightarrow> ('a mat,'b) ring_scheme" where
   "ring_mat ty n b \<equiv> \<lparr>
     carrier = carrier_mat n n,
     mult = (*),
     one = 1\<^sub>m n,
     zero = 0\<^sub>m n n,
     add = (+),
     \<dots> = b\<rparr>"
 
 definition module_mat :: "'a :: semiring_1 itself \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ('a,'a mat)module" where
   "module_mat ty nr nc \<equiv> \<lparr>
     carrier = carrier_mat nr nc,
     mult = (*),
     one = 1\<^sub>m nr,
     zero = 0\<^sub>m nr nc,
     add = (+),
     smult = (\<cdot>\<^sub>m)\<rparr>"
 
 lemma ring_mat_simps:
   "mult (ring_mat ty n b) = (*)"
   "add (ring_mat ty n b) = (+)"
   "one (ring_mat ty n b) = 1\<^sub>m n"
   "zero (ring_mat ty n b) = 0\<^sub>m n n"
   "carrier (ring_mat ty n b) = carrier_mat n n"
   unfolding ring_mat_def by auto
 
 lemma module_mat_simps:
   "mult (module_mat ty nr nc) = (*)"
   "add (module_mat ty nr nc) = (+)"
   "one (module_mat ty nr nc) = 1\<^sub>m nr"
   "zero (module_mat ty nr nc) = 0\<^sub>m nr nc"
   "carrier (module_mat ty nr nc) = carrier_mat nr nc"
   "smult (module_mat ty nr nc) = (\<cdot>\<^sub>m)"
   unfolding module_mat_def by auto
 
 lemma index_zero_mat[simp]: "i < nr \<Longrightarrow> j < nc \<Longrightarrow> 0\<^sub>m nr nc $$ (i,j) = 0"
   "dim_row (0\<^sub>m nr nc) = nr" "dim_col (0\<^sub>m nr nc) = nc"
   unfolding zero_mat_def by auto
 
 lemma index_one_mat[simp]: "i < n \<Longrightarrow> j < n \<Longrightarrow> 1\<^sub>m n $$ (i,j) = (if i = j then 1 else 0)"
   "dim_row (1\<^sub>m n) = n" "dim_col (1\<^sub>m n) = n"
   unfolding one_mat_def by auto
 
 lemma index_add_mat[simp]:
   "i < dim_row B \<Longrightarrow> j < dim_col B \<Longrightarrow> (A + B) $$ (i,j) = A $$ (i,j) + B $$ (i,j)"
   "dim_row (A + B) = dim_row B" "dim_col (A + B) = dim_col B"
   unfolding plus_mat_def by auto
 
 lemma index_minus_mat[simp]:
   "i < dim_row B \<Longrightarrow> j < dim_col B \<Longrightarrow> (A - B) $$ (i,j) = A $$ (i,j) - B $$ (i,j)"
   "dim_row (A - B) = dim_row B" "dim_col (A - B) = dim_col B"
   unfolding minus_mat_def by auto
 
 lemma index_map_mat[simp]:
   "i < dim_row A \<Longrightarrow> j < dim_col A \<Longrightarrow> map_mat f A $$ (i,j) = f (A $$ (i,j))"
   "dim_row (map_mat f A) = dim_row A" "dim_col (map_mat f A) = dim_col A"
   unfolding map_mat_def by auto
 
 lemma index_smult_mat[simp]:
   "i < dim_row A \<Longrightarrow> j < dim_col A \<Longrightarrow> (a \<cdot>\<^sub>m A) $$ (i,j) = a * A $$ (i,j)"
   "dim_row (a \<cdot>\<^sub>m A) = dim_row A" "dim_col (a \<cdot>\<^sub>m A) = dim_col A"
   unfolding smult_mat_def by auto
 
 lemma index_uminus_mat[simp]:
   "i < dim_row A \<Longrightarrow> j < dim_col A \<Longrightarrow> (- A) $$ (i,j) = - (A $$ (i,j))"
   "dim_row (- A) = dim_row A" "dim_col (- A) = dim_col A"
   unfolding uminus_mat_def by auto
 
 lemma index_transpose_mat[simp]:
   "i < dim_col A \<Longrightarrow> j < dim_row A \<Longrightarrow> transpose_mat A $$ (i,j) = A $$ (j,i)"
   "dim_row (transpose_mat A) = dim_col A" "dim_col (transpose_mat A) = dim_row A"
   unfolding transpose_mat_def by auto
 
 lemma index_mult_mat[simp]:
   "i < dim_row A \<Longrightarrow> j < dim_col B \<Longrightarrow> (A * B) $$ (i,j) = row A i \<bullet> col B j"
   "dim_row (A * B) = dim_row A" "dim_col (A * B) = dim_col B"
   by (auto simp: times_mat_def)
 
 lemma dim_mult_mat_vec[simp]: "dim_vec (A *\<^sub>v v) = dim_row A"
   by (auto simp: mult_mat_vec_def)
 
 lemma index_mult_mat_vec[simp]: "i < dim_row A \<Longrightarrow> (A *\<^sub>v v) $ i = row A i \<bullet> v"
   by (auto simp: mult_mat_vec_def)
 
 lemma index_row[simp]:
   "i < dim_row A \<Longrightarrow> j < dim_col A \<Longrightarrow> row A i $ j = A $$ (i,j)"
   "dim_vec (row A i) = dim_col A"
   by (auto simp: row_def)
 
 lemma index_col[simp]: "i < dim_row A \<Longrightarrow> j < dim_col A \<Longrightarrow> col A j $ i = A $$ (i,j)"
   by (auto simp: col_def)
 
 lemma upper_triangular_one[simp]: "upper_triangular (1\<^sub>m n)"
   by (rule, auto)
 
 lemma upper_triangular_zero[simp]: "upper_triangular (0\<^sub>m n n)"
   by (rule, auto)
 
 lemma mat_row_carrierI[intro,simp]: "mat\<^sub>r nr nc r \<in> carrier_mat nr nc"
   by (unfold carrier_mat_def carrier_vec_def, auto)
 
 lemma eq_rowI: assumes rows: "\<And> i. i < dim_row B \<Longrightarrow> row A i = row B i"
   and dims: "dim_row A = dim_row B" "dim_col A = dim_col B"
   shows "A = B"
 proof (rule eq_matI[OF _ dims])
   fix i j
   assume i: "i < dim_row B" and j: "j < dim_col B"
   from rows[OF i] have id: "row A i $ j = row B i $ j" by simp
   show "A $$ (i, j) = B $$ (i, j)"
     using index_row(1)[OF i j, folded id] index_row(1)[of i A j] i j dims
     by auto
 qed
 
 lemma row_mat[simp]: "i < nr \<Longrightarrow> row (mat nr nc f) i = vec nc (\<lambda> j. f (i,j))"
   by auto
 
 lemma col_mat[simp]: "j < nc \<Longrightarrow> col (mat nr nc f) j = vec nr (\<lambda> i. f (i,j))"
   by auto
 
 lemma zero_carrier_mat[simp]: "0\<^sub>m nr nc \<in> carrier_mat nr nc"
   unfolding carrier_mat_def by auto
 
 lemma smult_carrier_mat[simp]:
   "A \<in> carrier_mat nr nc \<Longrightarrow> k \<cdot>\<^sub>m A \<in> carrier_mat nr nc"
   unfolding carrier_mat_def by auto
 
 lemma add_carrier_mat[simp]:
   "B \<in> carrier_mat nr nc \<Longrightarrow> A + B \<in> carrier_mat nr nc"
   unfolding carrier_mat_def by force
 
 lemma one_carrier_mat[simp]: "1\<^sub>m n \<in> carrier_mat n n"
   unfolding carrier_mat_def by auto
 
 lemma uminus_carrier_mat:
   "A \<in> carrier_mat nr nc \<Longrightarrow> (- A \<in> carrier_mat nr nc)"
   unfolding carrier_mat_def by auto
 
 lemma uminus_carrier_iff_mat[simp]:
   "(- A \<in> carrier_mat nr nc) = (A \<in> carrier_mat nr nc)"
   unfolding carrier_mat_def by auto
 
 lemma minus_carrier_mat:
   "B \<in> carrier_mat nr nc \<Longrightarrow> (A - B \<in> carrier_mat nr nc)"
   unfolding carrier_mat_def by auto
 
 lemma transpose_carrier_mat[simp]: "(transpose_mat A \<in> carrier_mat nc nr) = (A \<in> carrier_mat nr nc)"
   unfolding carrier_mat_def by auto
 
 lemma row_carrier_vec[simp]: "i < nr \<Longrightarrow> A \<in> carrier_mat nr nc \<Longrightarrow> row A i \<in> carrier_vec nc"
   unfolding carrier_vec_def by auto
 
 lemma col_carrier_vec[simp]: "j < nc \<Longrightarrow> A \<in> carrier_mat nr nc \<Longrightarrow> col A j \<in> carrier_vec nr"
   unfolding carrier_vec_def by auto
 
 lemma mult_carrier_mat[simp]:
   "A \<in> carrier_mat nr n \<Longrightarrow> B \<in> carrier_mat n nc \<Longrightarrow> A * B \<in> carrier_mat nr nc"
   unfolding carrier_mat_def by auto
 
 lemma mult_mat_vec_carrier[simp]:
   "A \<in> carrier_mat nr n \<Longrightarrow> v \<in> carrier_vec n \<Longrightarrow> A *\<^sub>v v \<in> carrier_vec nr"
   unfolding carrier_mat_def carrier_vec_def by auto
 
 
 lemma comm_add_mat[ac_simps]:
   "(A :: 'a :: comm_monoid_add mat) \<in> carrier_mat nr nc \<Longrightarrow> B \<in> carrier_mat nr nc \<Longrightarrow> A + B = B + A"
   by (intro eq_matI, auto simp: ac_simps)
 
 
 lemma minus_r_inv_mat[simp]:
   "(A :: 'a :: group_add mat) \<in> carrier_mat nr nc \<Longrightarrow> (A - A) = 0\<^sub>m nr nc"
   by (intro eq_matI, auto)
 
 lemma uminus_l_inv_mat[simp]:
   "(A :: 'a :: group_add mat) \<in> carrier_mat nr nc \<Longrightarrow> (- A + A) = 0\<^sub>m nr nc"
   by (intro eq_matI, auto)
 
 lemma add_inv_exists_mat:
   "(A :: 'a :: group_add mat) \<in> carrier_mat nr nc \<Longrightarrow> \<exists> B \<in> carrier_mat nr nc. B + A = 0\<^sub>m nr nc \<and> A + B = 0\<^sub>m nr nc"
   by (intro bexI[of _ "- A"], auto)
 
 lemma assoc_add_mat[simp]:
   "(A :: 'a :: monoid_add mat) \<in> carrier_mat nr nc \<Longrightarrow> B \<in> carrier_mat nr nc \<Longrightarrow> C \<in> carrier_mat nr nc
   \<Longrightarrow> (A + B) + C = A + (B + C)"
   by (intro eq_matI, auto simp: ac_simps)
 
 lemma uminus_add_mat: fixes A :: "'a :: group_add mat"
   assumes "A \<in> carrier_mat nr nc"
   and "B \<in> carrier_mat nr nc"
   shows "- (A + B) = - B + - A"
   by (intro eq_matI, insert assms, auto simp: minus_add)
 
 lemma transpose_transpose[simp]:
   "transpose_mat (transpose_mat A) = A"
   by (intro eq_matI, auto)
 
 lemma transpose_one[simp]: "transpose_mat (1\<^sub>m n) = (1\<^sub>m n)"
   by auto
 
 lemma row_transpose[simp]:
   "j < dim_col A \<Longrightarrow> row (transpose_mat A) j = col A j"
   unfolding row_def col_def
   by (intro eq_vecI, auto)
 
 lemma col_transpose[simp]:
   "i < dim_row A \<Longrightarrow> col (transpose_mat A) i = row A i"
   unfolding row_def col_def
   by (intro eq_vecI, auto)
 
 lemma row_zero[simp]:
   "i < nr \<Longrightarrow> row (0\<^sub>m nr nc) i = 0\<^sub>v nc"
    by (intro eq_vecI, auto)
 
 lemma col_zero[simp]:
   "j < nc \<Longrightarrow> col (0\<^sub>m nr nc) j = 0\<^sub>v nr"
    by (intro eq_vecI, auto)
 
 lemma row_one[simp]:
   "i < n \<Longrightarrow> row (1\<^sub>m n) i = unit_vec n i"
   by (intro eq_vecI, auto)
 
 lemma col_one[simp]:
   "j < n \<Longrightarrow> col (1\<^sub>m n) j = unit_vec n j"
   by (intro eq_vecI, auto)
 
 lemma transpose_add: "A \<in> carrier_mat nr nc \<Longrightarrow> B \<in> carrier_mat nr nc
   \<Longrightarrow> transpose_mat (A + B) = transpose_mat A + transpose_mat B"
   by (intro eq_matI, auto)
 
 lemma transpose_minus: "A \<in> carrier_mat nr nc \<Longrightarrow> B \<in> carrier_mat nr nc
   \<Longrightarrow> transpose_mat (A - B) = transpose_mat A - transpose_mat B"
   by (intro eq_matI, auto)
 
 lemma transpose_uminus: "A \<in> carrier_mat nr nc \<Longrightarrow> transpose_mat (- A) = - (transpose_mat A)"
   by (intro eq_matI, auto)
 
 lemma row_add[simp]:
   "A \<in> carrier_mat nr nc \<Longrightarrow> B \<in> carrier_mat nr nc \<Longrightarrow> i < nr
   \<Longrightarrow> row (A + B) i = row A i + row B i"
   "i < dim_row A \<Longrightarrow> dim_row B = dim_row A \<Longrightarrow> dim_col B = dim_col A \<Longrightarrow> row (A + B) i = row A i + row B i"
   by (rule eq_vecI, auto)
 
 lemma col_add[simp]:
   "A \<in> carrier_mat nr nc \<Longrightarrow> B \<in> carrier_mat nr nc \<Longrightarrow> j < nc
   \<Longrightarrow> col (A + B) j = col A j + col B j"
   by (rule eq_vecI, auto)
 
 lemma row_mult[simp]: assumes m: "A \<in> carrier_mat nr n" "B \<in> carrier_mat n nc"
   and i: "i < nr"
   shows "row (A * B) i = vec nc (\<lambda> j. row A i \<bullet> col B j)"
   by (rule eq_vecI, insert m i, auto)
 
 lemma col_mult[simp]: assumes m: "A \<in> carrier_mat nr n" "B \<in> carrier_mat n nc"
   and j: "j < nc"
   shows "col (A * B) j = vec nr (\<lambda> i. row A i \<bullet> col B j)"
   by (rule eq_vecI, insert m j, auto)
 
 lemma transpose_mult:
   "(A :: 'a :: comm_semiring_0 mat) \<in> carrier_mat nr n \<Longrightarrow> B \<in> carrier_mat n nc
   \<Longrightarrow> transpose_mat (A * B) = transpose_mat B * transpose_mat A"
   by (intro eq_matI, auto simp: comm_scalar_prod[of _ n])
 
 lemma left_add_zero_mat[simp]:
   "(A :: 'a :: monoid_add mat) \<in> carrier_mat nr nc  \<Longrightarrow> 0\<^sub>m nr nc + A = A"
   by (intro eq_matI, auto)
 
 lemma add_uminus_minus_mat: "A \<in> carrier_mat nr nc \<Longrightarrow> B \<in> carrier_mat nr nc \<Longrightarrow> 
   A + (- B) = A - (B :: 'a :: group_add mat)" 
   by (intro eq_matI, auto)
 
 lemma right_add_zero_mat[simp]: "A \<in> carrier_mat nr nc \<Longrightarrow> 
   A + 0\<^sub>m nr nc = (A :: 'a :: monoid_add mat)" 
   by (intro eq_matI, auto)
 
 lemma left_mult_zero_mat:
   "A \<in> carrier_mat n nc \<Longrightarrow> 0\<^sub>m nr n * A = 0\<^sub>m nr nc"
   by (intro eq_matI, auto)
 
 lemma left_mult_zero_mat'[simp]: "dim_row A = n \<Longrightarrow> 0\<^sub>m nr n * A = 0\<^sub>m nr (dim_col A)"
   by (rule left_mult_zero_mat, unfold carrier_mat_def, simp)
 
 lemma right_mult_zero_mat:
   "A \<in> carrier_mat nr n \<Longrightarrow> A * 0\<^sub>m n nc = 0\<^sub>m nr nc"
   by (intro eq_matI, auto)
 
 lemma right_mult_zero_mat'[simp]: "dim_col A = n \<Longrightarrow> A * 0\<^sub>m n nc = 0\<^sub>m (dim_row A) nc"
   by (rule right_mult_zero_mat, unfold carrier_mat_def, simp)
 
 lemma left_mult_one_mat:
   "(A :: 'a :: semiring_1 mat) \<in> carrier_mat nr nc \<Longrightarrow> 1\<^sub>m nr * A = A"
   by (intro eq_matI, auto)
 
 lemma left_mult_one_mat'[simp]: "dim_row (A :: 'a :: semiring_1 mat) = n \<Longrightarrow> 1\<^sub>m n * A = A"
   by (rule left_mult_one_mat, unfold carrier_mat_def, simp)
 
 lemma right_mult_one_mat:
   "(A :: 'a :: semiring_1 mat) \<in> carrier_mat nr nc \<Longrightarrow> A * 1\<^sub>m nc = A"
   by (intro eq_matI, auto)
 
 lemma right_mult_one_mat'[simp]: "dim_col (A :: 'a :: semiring_1 mat) = n \<Longrightarrow> A * 1\<^sub>m n = A"
   by (rule right_mult_one_mat, unfold carrier_mat_def, simp)
 
 lemma one_mult_mat_vec[simp]:
   "(v :: 'a :: semiring_1 vec) \<in> carrier_vec n \<Longrightarrow> 1\<^sub>m n *\<^sub>v v = v"
   by (intro eq_vecI, auto)
 
 lemma minus_add_uminus_mat: fixes A :: "'a :: group_add mat"
   shows "A \<in> carrier_mat nr nc \<Longrightarrow> B \<in> carrier_mat nr nc \<Longrightarrow>
   A - B = A + (- B)"
   by (intro eq_matI, auto)
 
 lemma add_mult_distrib_mat[algebra_simps]: assumes m: "A \<in> carrier_mat nr n"
   "B \<in> carrier_mat nr n" "C \<in> carrier_mat n nc"
   shows "(A + B) * C = A * C + B * C"
   using m by (intro eq_matI, auto simp: add_scalar_prod_distrib[of _ n])
 
 lemma mult_add_distrib_mat[algebra_simps]: assumes m: "A \<in> carrier_mat nr n"
   "B \<in> carrier_mat n nc" "C \<in> carrier_mat n nc"
   shows "A * (B + C) = A * B + A * C"
   using m by (intro eq_matI, auto simp: scalar_prod_add_distrib[of _ n])
 
 lemma add_mult_distrib_mat_vec[algebra_simps]: assumes m: "A \<in> carrier_mat nr nc"
   "B \<in> carrier_mat nr nc" "v \<in> carrier_vec nc"
   shows "(A + B) *\<^sub>v v = A *\<^sub>v v + B *\<^sub>v v"
   using m by (intro eq_vecI, auto intro!: add_scalar_prod_distrib)
 
 lemma mult_add_distrib_mat_vec[algebra_simps]: assumes m: "A \<in> carrier_mat nr nc"
   "v\<^sub>1 \<in> carrier_vec nc" "v\<^sub>2 \<in> carrier_vec nc"
   shows "A *\<^sub>v (v\<^sub>1 + v\<^sub>2) = A *\<^sub>v v\<^sub>1 + A *\<^sub>v v\<^sub>2"
   using m by (intro eq_vecI, auto simp: scalar_prod_add_distrib[of _ nc])
 
 lemma mult_mat_vec:
   assumes m: "(A::'a::field mat) \<in> carrier_mat nr nc" and v: "v \<in> carrier_vec nc"
   shows "A *\<^sub>v (k \<cdot>\<^sub>v v) = k \<cdot>\<^sub>v (A *\<^sub>v v)" (is "?l = ?r")
 proof
   have nr: "dim_vec ?l = nr" using m v by auto
   also have "... = dim_vec ?r" using m v by auto
   finally show "dim_vec ?l = dim_vec ?r".
 
   show "\<And>i. i < dim_vec ?r \<Longrightarrow> ?l $ i = ?r $ i"
   proof -
     fix i assume "i < dim_vec ?r"
     hence i: "i < dim_row A" using nr m by auto
     hence i2: "i < dim_vec (A *\<^sub>v v)" using m by auto
     show "?l $ i = ?r $ i"
     apply (subst (1) mult_mat_vec_def)
     apply (subst (2) smult_vec_def)
     unfolding index_vec[OF i] index_vec[OF i2]
     unfolding mult_mat_vec_def smult_vec_def
     unfolding scalar_prod_def index_vec[OF i]
     by (simp add: mult.left_commute sum_distrib_left)
   qed
 qed
 
 lemma assoc_scalar_prod: assumes *: "v\<^sub>1 \<in> carrier_vec nr" "A \<in> carrier_mat nr nc" "v\<^sub>2 \<in> carrier_vec nc"
   shows "vec nc (\<lambda>j. v\<^sub>1 \<bullet> col A j) \<bullet> v\<^sub>2 = v\<^sub>1 \<bullet> vec nr (\<lambda>i. row A i \<bullet> v\<^sub>2)"
 proof -
   have "vec nc (\<lambda>j. v\<^sub>1 \<bullet> col A j) \<bullet> v\<^sub>2 = (\<Sum>i\<in>{0..<nc}. vec nc (\<lambda>j. \<Sum>k\<in>{0..<nr}. v\<^sub>1 $ k * col A j $ k) $ i * v\<^sub>2 $ i)"
     unfolding scalar_prod_def using * by auto
   also have "\<dots> = (\<Sum>i\<in>{0..<nc}. (\<Sum>k\<in>{0..<nr}. v\<^sub>1 $ k * col A i $ k) * v\<^sub>2 $ i)"
     by (rule sum.cong, auto)
   also have "\<dots> = (\<Sum>i\<in>{0..<nc}. (\<Sum>k\<in>{0..<nr}. v\<^sub>1 $ k * col A i $ k * v\<^sub>2 $ i))"
     unfolding sum_distrib_right ..
   also have "\<dots> = (\<Sum>k\<in>{0..<nr}. (\<Sum>i\<in>{0..<nc}. v\<^sub>1 $ k * col A i $ k * v\<^sub>2 $ i))"
     by (rule sum.swap)
   also have "\<dots> = (\<Sum>k\<in>{0..<nr}. (\<Sum>i\<in>{0..<nc}. v\<^sub>1 $ k * (col A i $ k * v\<^sub>2 $ i)))"
     by (simp add: ac_simps)
   also have "\<dots> = (\<Sum>k\<in>{0..<nr}. v\<^sub>1 $ k * (\<Sum>i\<in>{0..<nc}. col A i $ k * v\<^sub>2 $ i))"
     unfolding sum_distrib_left ..
   also have "\<dots> = (\<Sum>k\<in>{0..<nr}. v\<^sub>1 $ k * vec nr (\<lambda>k. \<Sum>i\<in>{0..<nc}. row A k $ i * v\<^sub>2 $ i) $ k)"
     using * by auto
   also have "\<dots> = v\<^sub>1 \<bullet> vec nr (\<lambda>i. row A i \<bullet> v\<^sub>2)" unfolding scalar_prod_def using * by simp
   finally show ?thesis .
 qed
 
 lemma assoc_mult_mat[simp]:
   "A \<in> carrier_mat n\<^sub>1 n\<^sub>2 \<Longrightarrow> B \<in> carrier_mat n\<^sub>2 n\<^sub>3 \<Longrightarrow> C \<in> carrier_mat n\<^sub>3 n\<^sub>4
   \<Longrightarrow> (A * B) * C = A * (B * C)"
   by (intro eq_matI, auto simp: assoc_scalar_prod)
 
 lemma assoc_mult_mat_vec[simp]:
   "A \<in> carrier_mat n\<^sub>1 n\<^sub>2 \<Longrightarrow> B \<in> carrier_mat n\<^sub>2 n\<^sub>3 \<Longrightarrow> v \<in> carrier_vec n\<^sub>3
   \<Longrightarrow> (A * B) *\<^sub>v v = A *\<^sub>v (B *\<^sub>v v)"
   by (intro eq_vecI, auto simp add: mult_mat_vec_def assoc_scalar_prod)
 
 lemma comm_monoid_mat: "comm_monoid (monoid_mat TYPE('a :: comm_monoid_add) nr nc)"
   by (unfold_locales, auto simp: monoid_mat_def ac_simps)
 
 lemma comm_group_mat: "comm_group (monoid_mat TYPE('a :: ab_group_add) nr nc)"
   by (unfold_locales, insert add_inv_exists_mat, auto simp: monoid_mat_def ac_simps Units_def)
 
 lemma semiring_mat: "semiring (ring_mat TYPE('a :: semiring_1) n b)"
   by (unfold_locales, auto simp: ring_mat_def algebra_simps)
 
 lemma ring_mat: "ring (ring_mat TYPE('a :: comm_ring_1) n b)"
   by (unfold_locales, insert add_inv_exists_mat, auto simp: ring_mat_def algebra_simps Units_def)
 
 lemma abelian_group_mat: "abelian_group (module_mat TYPE('a :: comm_ring_1) nr nc)"
   by (unfold_locales, insert add_inv_exists_mat, auto simp: module_mat_def Units_def)
 
 lemma row_smult[simp]: assumes i: "i < dim_row A"
   shows "row (k \<cdot>\<^sub>m A) i = k \<cdot>\<^sub>v (row A i)"
   by (rule eq_vecI, insert i, auto)
 
 lemma col_smult[simp]: assumes i: "i < dim_col A"
   shows "col (k \<cdot>\<^sub>m A) i = k \<cdot>\<^sub>v (col A i)"
   by (rule eq_vecI, insert i, auto)
 
 lemma row_uminus[simp]: assumes i: "i < dim_row A"
   shows "row (- A) i = - (row A i)"
   by (rule eq_vecI, insert i, auto)
 
 lemma scalar_prod_uminus_left[simp]: assumes dim: "dim_vec v = dim_vec (w :: 'a :: ring vec)"
   shows "- v \<bullet> w = - (v \<bullet> w)"
   unfolding scalar_prod_def dim[symmetric]
   by (subst sum_negf[symmetric], rule sum.cong, auto)
 
 lemma col_uminus[simp]: assumes i: "i < dim_col A"
   shows "col (- A) i = - (col A i)"
   by (rule eq_vecI, insert i, auto)
 
 lemma scalar_prod_uminus_right[simp]: assumes dim: "dim_vec v = dim_vec (w :: 'a :: ring vec)"
   shows "v \<bullet> - w = - (v \<bullet> w)"
   unfolding scalar_prod_def dim
   by (subst sum_negf[symmetric], rule sum.cong, auto)
 
 context fixes A B :: "'a :: ring mat"
   assumes dim: "dim_col A = dim_row B"
 begin
 lemma uminus_mult_left_mat[simp]: "(- A * B) = - (A * B)"
   by (intro eq_matI, insert dim, auto)
 
 lemma uminus_mult_right_mat[simp]: "(A * - B) = - (A * B)"
   by (intro eq_matI, insert dim, auto)
 end
 
 lemma minus_mult_distrib_mat[algebra_simps]: fixes A :: "'a :: ring mat"
   assumes m: "A \<in> carrier_mat nr n" "B \<in> carrier_mat nr n" "C \<in> carrier_mat n nc"
   shows "(A - B) * C = A * C - B * C"
   unfolding minus_add_uminus_mat[OF m(1,2)]
     add_mult_distrib_mat[OF m(1) uminus_carrier_mat[OF m(2)] m(3)]
   by (subst uminus_mult_left_mat, insert m, auto)
 
 lemma minus_mult_distrib_mat_vec[algebra_simps]: assumes A: "(A :: 'a :: ring mat) \<in> carrier_mat nr nc"
   and B: "B \<in> carrier_mat nr nc"
   and v: "v \<in> carrier_vec nc"
 shows "(A - B) *\<^sub>v v = A *\<^sub>v v - B *\<^sub>v v"
   unfolding minus_add_uminus_mat[OF A B]
   by (subst add_mult_distrib_mat_vec[OF A _ v], insert A B v, auto)
 
 lemma mult_minus_distrib_mat_vec[algebra_simps]: assumes A: "(A :: 'a :: ring mat) \<in> carrier_mat nr nc"
   and v: "v \<in> carrier_vec nc"
   and w: "w \<in> carrier_vec nc"
 shows "A *\<^sub>v (v - w) = A *\<^sub>v v - A *\<^sub>v w"
   unfolding minus_add_uminus_vec[OF v w]
   by (subst mult_add_distrib_mat_vec[OF A], insert A v w, auto)
 
 lemma mult_minus_distrib_mat[algebra_simps]: fixes A :: "'a :: ring mat"
   assumes m: "A \<in> carrier_mat nr n" "B \<in> carrier_mat n nc" "C \<in> carrier_mat n nc"
   shows "A * (B - C) = A * B - A * C"
   unfolding minus_add_uminus_mat[OF m(2,3)]
     mult_add_distrib_mat[OF m(1) m(2) uminus_carrier_mat[OF m(3)]]
   by (subst uminus_mult_right_mat, insert m, auto)
 
 lemma uminus_mult_mat_vec[simp]: assumes v: "dim_vec v = dim_col (A :: 'a :: ring mat)"
   shows "- A *\<^sub>v v = - (A *\<^sub>v v)"
   using v by (intro eq_vecI, auto)
 
 lemma uminus_zero_vec_eq: assumes v: "(v :: 'a :: group_add vec) \<in> carrier_vec n"
   shows "(- v = 0\<^sub>v n) = (v = 0\<^sub>v n)"
 proof
   assume z: "- v = 0\<^sub>v n"
   {
     fix i
     assume i: "i < n"
     have "v $ i = - (- (v $ i))" by simp
     also have "- (v $ i) = 0" using arg_cong[OF z, of "\<lambda> v. v $ i"] i v by auto
     also have "- 0 = (0 :: 'a)" by simp
     finally have "v $ i = 0" .
   }
   thus "v = 0\<^sub>v n" using v
     by (intro eq_vecI, auto)
 qed auto
 
 lemma map_carrier_mat[simp]:
   "(map_mat f A \<in> carrier_mat nr nc) = (A \<in> carrier_mat nr nc)"
   unfolding carrier_mat_def by auto
 
 lemma col_map_mat[simp]:
   assumes "j < dim_col A" shows "col (map_mat f A) j = map_vec f (col A j)"
   unfolding map_mat_def map_vec_def using assms by auto
 
 lemma scalar_vec_one[simp]: "1 \<cdot>\<^sub>v (v :: 'a :: semiring_1 vec) = v"
   by (rule eq_vecI, auto)
 
 lemma scalar_prod_smult_right[simp]:
   "dim_vec w = dim_vec v \<Longrightarrow> w \<bullet> (k \<cdot>\<^sub>v v) = (k :: 'a :: comm_semiring_0) * (w \<bullet> v)"
   unfolding scalar_prod_def sum_distrib_left
   by (auto intro: sum.cong simp: ac_simps)
 
 lemma scalar_prod_smult_left[simp]:
   "dim_vec w = dim_vec v \<Longrightarrow> (k \<cdot>\<^sub>v w) \<bullet> v = (k :: 'a :: comm_semiring_0) * (w \<bullet> v)"
   unfolding scalar_prod_def sum_distrib_left
   by (auto intro: sum.cong simp: ac_simps)
 
 lemma mult_smult_distrib: assumes A: "A \<in> carrier_mat nr n" and B: "B \<in> carrier_mat n nc"
   shows "A * (k \<cdot>\<^sub>m B) = (k :: 'a :: comm_semiring_0) \<cdot>\<^sub>m (A * B)"
   by (rule eq_matI, insert A B, auto)
 
 lemma add_smult_distrib_left_mat: assumes "A \<in> carrier_mat nr nc" "B \<in> carrier_mat nr nc"
   shows "k \<cdot>\<^sub>m (A + B) = (k :: 'a :: semiring) \<cdot>\<^sub>m A + k \<cdot>\<^sub>m B"
   by (rule eq_matI, insert assms, auto simp: field_simps)
 
 lemma add_smult_distrib_right_mat: assumes "A \<in> carrier_mat nr nc"
   shows "(k + l) \<cdot>\<^sub>m A = (k :: 'a :: semiring) \<cdot>\<^sub>m A + l \<cdot>\<^sub>m A"
   by (rule eq_matI, insert assms, auto simp: field_simps)
 
 lemma mult_smult_assoc_mat: assumes A: "A \<in> carrier_mat nr n" and B: "B \<in> carrier_mat n nc"
   shows "(k \<cdot>\<^sub>m A) * B = (k :: 'a :: comm_semiring_0) \<cdot>\<^sub>m (A * B)"
   by (rule eq_matI, insert A B, auto)
 
 definition similar_mat_wit :: "'a :: semiring_1 mat \<Rightarrow> 'a mat \<Rightarrow> 'a mat \<Rightarrow> 'a mat \<Rightarrow> bool" where
   "similar_mat_wit A B P Q = (let n = dim_row A in {A,B,P,Q} \<subseteq> carrier_mat n n \<and> P * Q = 1\<^sub>m n \<and> Q * P = 1\<^sub>m n \<and>
     A = P * B * Q)"
 
 definition similar_mat :: "'a :: semiring_1 mat \<Rightarrow> 'a mat \<Rightarrow> bool" where
   "similar_mat A B = (\<exists> P Q. similar_mat_wit A B P Q)"
 
 lemma similar_matD: assumes "similar_mat A B"
   shows "\<exists> n P Q. {A,B,P,Q} \<subseteq> carrier_mat n n \<and> P * Q = 1\<^sub>m n \<and> Q * P = 1\<^sub>m n \<and> A = P * B * Q"
   using assms unfolding similar_mat_def similar_mat_wit_def[abs_def] Let_def by blast
 
 lemma similar_matI: assumes "{A,B,P,Q} \<subseteq> carrier_mat n n" "P * Q = 1\<^sub>m n" "Q * P = 1\<^sub>m n" "A = P * B * Q"
   shows "similar_mat A B" unfolding similar_mat_def
   by (rule exI[of _ P], rule exI[of _ Q], unfold similar_mat_wit_def Let_def, insert assms, auto)
 
 fun pow_mat :: "'a :: semiring_1 mat \<Rightarrow> nat \<Rightarrow> 'a mat" (infixr "^\<^sub>m" 75) where
   "A ^\<^sub>m 0 = 1\<^sub>m (dim_row A)"
 | "A ^\<^sub>m (Suc k) = A ^\<^sub>m k * A"
 
 lemma pow_mat_dim[simp]:
   "dim_row (A ^\<^sub>m k) = dim_row A"
   "dim_col (A ^\<^sub>m k) = (if k = 0 then dim_row A else dim_col A)"
   by (induct k, auto)
 
 lemma pow_mat_dim_square[simp]:
   "A \<in> carrier_mat n n \<Longrightarrow> dim_row (A ^\<^sub>m k) = n"
   "A \<in> carrier_mat n n \<Longrightarrow> dim_col (A ^\<^sub>m k) = n"
   by auto
 
 lemma pow_carrier_mat[simp]: "A \<in> carrier_mat n n \<Longrightarrow> A ^\<^sub>m k \<in> carrier_mat n n"
   unfolding carrier_mat_def by auto
 
 definition diag_mat :: "'a mat \<Rightarrow> 'a list" where
   "diag_mat A = map (\<lambda> i. A $$ (i,i)) [0 ..< dim_row A]"
 
 lemma prod_list_diag_prod: "prod_list (diag_mat A) = (\<Prod> i = 0 ..< dim_row A. A $$ (i,i))"
   unfolding diag_mat_def
   by (subst prod.distinct_set_conv_list[symmetric], auto)
 
 lemma diag_mat_transpose[simp]: "dim_row A = dim_col A \<Longrightarrow>
   diag_mat (transpose_mat A) = diag_mat A" unfolding diag_mat_def by auto
 
 lemma diag_mat_zero[simp]: "diag_mat (0\<^sub>m n n) = replicate n 0"
   unfolding diag_mat_def
   by (rule nth_equalityI, auto)
 
 lemma diag_mat_one[simp]: "diag_mat (1\<^sub>m n) = replicate n 1"
   unfolding diag_mat_def
   by (rule nth_equalityI, auto)
 
 lemma pow_mat_ring_pow: assumes A: "(A :: ('a :: semiring_1)mat) \<in> carrier_mat n n"
   shows "A ^\<^sub>m k = A [^]\<^bsub>ring_mat TYPE('a) n b\<^esub> k"
   (is "_ = A [^]\<^bsub>?C\<^esub> k")
 proof -
   interpret semiring ?C by (rule semiring_mat)
   show ?thesis
     by (induct k, insert A, auto simp: ring_mat_def nat_pow_def)
 qed
 
 definition diagonal_mat :: "'a::zero mat \<Rightarrow> bool" where
   "diagonal_mat A \<equiv> \<forall>i<dim_row A. \<forall>j<dim_col A. i \<noteq> j \<longrightarrow> A $$ (i,j) = 0"
 
 definition (in comm_monoid_add) sum_mat :: "'a mat \<Rightarrow> 'a" where
   "sum_mat A = sum (\<lambda> ij. A $$ ij) ({0 ..< dim_row A} \<times> {0 ..< dim_col A})"
 
 lemma sum_mat_0[simp]: "sum_mat (0\<^sub>m nr nc) = (0 :: 'a :: comm_monoid_add)"
   unfolding sum_mat_def
   by (rule sum.neutral, auto)
 
 lemma sum_mat_add: assumes A: "(A :: 'a :: comm_monoid_add mat) \<in> carrier_mat nr nc" and B: "B \<in> carrier_mat nr nc"
   shows "sum_mat (A + B) = sum_mat A + sum_mat B"
 proof -
   from A B have id: "dim_row A = nr" "dim_row B = nr" "dim_col A = nc" "dim_col B = nc"
     by auto
   show ?thesis unfolding sum_mat_def id
     by (subst sum.distrib[symmetric], rule sum.cong, insert A B, auto)
 qed
 
 subsection \<open>Update Operators\<close>
 
 definition update_vec :: "'a vec \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a vec" ("_ |\<^sub>v _ \<mapsto> _" [60,61,62] 60)
   where "v |\<^sub>v i \<mapsto> a = vec (dim_vec v) (\<lambda>i'. if i' = i then a else v $ i')"
 
 definition update_mat :: "'a mat \<Rightarrow> nat \<times> nat \<Rightarrow> 'a \<Rightarrow> 'a mat" ("_ |\<^sub>m _ \<mapsto> _" [60,61,62] 60)
   where "A |\<^sub>m ij \<mapsto> a = mat (dim_row A) (dim_col A) (\<lambda>ij'. if ij' = ij then a else A $$ ij')"
 
 lemma dim_update_vec[simp]:
   "dim_vec (v |\<^sub>v i \<mapsto> a) = dim_vec v" unfolding update_vec_def by simp
 
 lemma index_update_vec1[simp]:
   assumes "i < dim_vec v" shows "(v |\<^sub>v i \<mapsto> a) $ i = a"
   unfolding update_vec_def using assms by simp
 
 lemma index_update_vec2[simp]:
   assumes "i' \<noteq> i" shows "(v |\<^sub>v i \<mapsto> a) $ i' = v $ i'"
   unfolding update_vec_def
   using assms apply transfer unfolding mk_vec_def by auto
 
 lemma dim_update_mat[simp]:
   "dim_row (A |\<^sub>m ij \<mapsto> a) = dim_row A"
   "dim_col (A |\<^sub>m ij \<mapsto> a) = dim_col A" unfolding update_mat_def by simp+
 
 lemma index_update_mat1[simp]:
   assumes "i < dim_row A" "j < dim_col A" shows "(A |\<^sub>m (i,j) \<mapsto> a) $$ (i,j) = a"
   unfolding update_mat_def using assms by simp
 
 lemma index_update_mat2[simp]:
   assumes i': "i' < dim_row A" and j': "j' < dim_col A" and neq: "(i',j') \<noteq> ij"
   shows "(A |\<^sub>m ij \<mapsto> a) $$ (i',j') = A $$ (i',j')"
   unfolding update_mat_def using assms by auto
 
 subsection \<open>Block Vectors and Matrices\<close>
 
 definition append_vec :: "'a vec \<Rightarrow> 'a vec \<Rightarrow> 'a vec" (infixr "@\<^sub>v" 65) where
   "v @\<^sub>v w \<equiv> let n = dim_vec v; m = dim_vec w in
     vec (n + m) (\<lambda> i. if i < n then v $ i else w $ (i - n))"
 
 lemma index_append_vec[simp]: "i < dim_vec v + dim_vec w
   \<Longrightarrow> (v @\<^sub>v w) $ i = (if i < dim_vec v then v $ i else w $ (i - dim_vec v))"
   "dim_vec (v @\<^sub>v w) = dim_vec v + dim_vec w"
   unfolding append_vec_def Let_def by auto
 
 lemma append_carrier_vec[simp,intro]:
   "v \<in> carrier_vec n1 \<Longrightarrow> w \<in> carrier_vec n2 \<Longrightarrow> v @\<^sub>v w \<in> carrier_vec (n1 + n2)"
   unfolding carrier_vec_def by auto
 
 lemma scalar_prod_append: assumes "v1 \<in> carrier_vec n1" "v2 \<in> carrier_vec n2"
   "w1 \<in> carrier_vec n1" "w2 \<in> carrier_vec n2"
   shows "(v1 @\<^sub>v v2) \<bullet> (w1 @\<^sub>v w2) = v1 \<bullet> w1 + v2 \<bullet> w2"
 proof -
   from assms have dim: "dim_vec v1 = n1" "dim_vec v2 = n2" "dim_vec w1 = n1" "dim_vec w2 = n2" by auto
   have id: "{0 ..< n1 + n2} = {0 ..< n1} \<union> {n1 ..< n1 + n2}" by auto
   have id2: "{n1 ..< n1 + n2} = (plus n1) ` {0 ..< n2}"
     by (simp add: ac_simps)
   have "(v1 @\<^sub>v v2) \<bullet> (w1 @\<^sub>v w2) = (\<Sum>i = 0..<n1. v1 $ i * w1 $ i) +
     (\<Sum>i = n1..<n1 + n2. v2 $ (i - n1) * w2 $ (i - n1))"
   unfolding scalar_prod_def
     by (auto simp: dim id, subst sum.union_disjoint, insert assms, force+)
   also have "(\<Sum>i = n1..<n1 + n2. v2 $ (i - n1) * w2 $ (i - n1))
     = (\<Sum>i = 0..< n2. v2 $ i * w2 $ i)"
     by (rule sum.reindex_cong [OF _ id2]) simp_all
   finally show ?thesis by (simp, insert assms, auto simp: scalar_prod_def)
 qed
 
 definition "vec_first v n \<equiv> vec n (\<lambda>i. v $ i)"
 definition "vec_last v n \<equiv> vec n (\<lambda>i. v $ (dim_vec v - n + i))"
 
 lemma dim_vec_first[simp]: "dim_vec (vec_first v n) = n" unfolding vec_first_def by auto
 lemma dim_vec_last[simp]: "dim_vec (vec_last v n) = n" unfolding vec_last_def by auto
 
 lemma vec_first_carrier[simp]: "vec_first v n \<in> carrier_vec n" by (rule carrier_vecI, auto)
 lemma vec_last_carrier[simp]: "vec_last v n \<in> carrier_vec n" by (rule carrier_vecI, auto)
 
 lemma vec_first_last_append[simp]:
   assumes "v \<in> carrier_vec (n+m)" shows "vec_first v n @\<^sub>v vec_last v m = v"
   apply(rule) unfolding vec_first_def vec_last_def using assms by auto
 
 lemma append_vec_le: assumes "v \<in> carrier_vec n" and w: "w \<in> carrier_vec n" 
   shows "v @\<^sub>v v' \<le> w @\<^sub>v w' \<longleftrightarrow> v \<le> w \<and> v' \<le> w'" 
 proof -
   {
     fix i
     assume *: "\<forall>i. (\<not> i < n \<longrightarrow> i < n + dim_vec w' \<longrightarrow> v' $ (i - n) \<le> w' $ (i - n))"
       and i: "i < dim_vec w'" 
     have "v' $ i \<le> w' $ i" using *[rule_format, of "n + i"] i by auto
   }
   thus ?thesis using assms unfolding less_eq_vec_def by auto
 qed
 
 lemma all_vec_append: "(\<forall> x \<in> carrier_vec (n + m). P x) \<longleftrightarrow> (\<forall> x1 \<in> carrier_vec n. \<forall> x2 \<in> carrier_vec m. P (x1 @\<^sub>v x2))" 
 proof (standard, force, intro ballI, goal_cases)
   case (1 x)
   have "x = vec n (\<lambda> i. x $ i) @\<^sub>v vec m (\<lambda> i. x $ (n + i))" 
     by (rule eq_vecI, insert 1(2), auto)
   hence "P x = P (vec n (\<lambda> i. x $ i) @\<^sub>v vec m (\<lambda> i. x $ (n + i)))" by simp
   also have "\<dots>" using 1 by auto
   finally show ?case .
 qed
 
 
 (* A B
    C D *)
 definition four_block_mat :: "'a mat \<Rightarrow> 'a mat \<Rightarrow> 'a mat \<Rightarrow> 'a mat \<Rightarrow> 'a mat" where
   "four_block_mat A B C D =
     (let nra = dim_row A; nrd = dim_row D;
          nca = dim_col A; ncd = dim_col D
        in
     mat (nra + nrd) (nca + ncd) (\<lambda> (i,j). if i < nra then
       if j < nca then A $$ (i,j) else B $$ (i,j - nca)
       else if j < nca then C $$ (i - nra, j) else D $$ (i - nra, j - nca)))"
 
 lemma index_mat_four_block[simp]:
   "i < dim_row A + dim_row D \<Longrightarrow> j < dim_col A + dim_col D \<Longrightarrow> four_block_mat A B C D $$ (i,j)
   = (if i < dim_row A then
       if j < dim_col A then A $$ (i,j) else B $$ (i,j - dim_col A)
       else if j < dim_col A then C $$ (i - dim_row A, j) else D $$ (i - dim_row A, j - dim_col A))"
   "dim_row (four_block_mat A B C D) = dim_row A + dim_row D"
   "dim_col (four_block_mat A B C D) = dim_col A + dim_col D"
   unfolding four_block_mat_def Let_def by auto
 
 lemma four_block_carrier_mat[simp]:
   "A \<in> carrier_mat nr1 nc1 \<Longrightarrow> D \<in> carrier_mat nr2 nc2 \<Longrightarrow>
   four_block_mat A B C D \<in> carrier_mat (nr1 + nr2) (nc1 + nc2)"
   unfolding carrier_mat_def by auto
 
 lemma cong_four_block_mat: "A1 = B1 \<Longrightarrow> A2 = B2 \<Longrightarrow> A3 = B3 \<Longrightarrow> A4 = B4 \<Longrightarrow>
   four_block_mat A1 A2 A3 A4 = four_block_mat B1 B2 B3 B4" by auto
 
 lemma four_block_one_mat[simp]:
   "four_block_mat (1\<^sub>m n1) (0\<^sub>m n1 n2) (0\<^sub>m n2 n1) (1\<^sub>m n2) = 1\<^sub>m (n1 + n2)"
   by (rule eq_matI, auto)
 
 lemma four_block_zero_mat[simp]:
   "four_block_mat (0\<^sub>m nr1 nc1) (0\<^sub>m nr1 nc2) (0\<^sub>m nr2 nc1) (0\<^sub>m nr2 nc2) = 0\<^sub>m (nr1 + nr2) (nc1 + nc2)"
   by (rule eq_matI, auto)
 
 lemma row_four_block_mat:
   assumes c: "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
   "i < nr1 \<Longrightarrow> row (four_block_mat A B C D) i = row A i @\<^sub>v row B i" (is "_ \<Longrightarrow> ?AB")
   "\<not> i < nr1 \<Longrightarrow> i < nr1 + nr2 \<Longrightarrow> row (four_block_mat A B C D) i = row C (i - nr1) @\<^sub>v row D (i - nr1)"
   (is "_ \<Longrightarrow> _ \<Longrightarrow> ?CD")
 proof -
   assume i: "i < nr1"
   show ?AB by (rule eq_vecI, insert i c, auto)
 next
   assume i: "\<not> i < nr1" "i < nr1 + nr2"
   show ?CD by (rule eq_vecI, insert i c, auto)
 qed
 
 lemma col_four_block_mat:
   assumes c: "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
   "j < nc1 \<Longrightarrow> col (four_block_mat A B C D) j = col A j @\<^sub>v col C j" (is "_ \<Longrightarrow> ?AC")
   "\<not> j < nc1 \<Longrightarrow> j < nc1 + nc2 \<Longrightarrow> col (four_block_mat A B C D) j = col B (j - nc1) @\<^sub>v col D (j - nc1)"
   (is "_ \<Longrightarrow> _ \<Longrightarrow> ?BD")
 proof -
   assume j: "j < nc1"
   show ?AC by (rule eq_vecI, insert j c, auto)
 next
   assume j: "\<not> j < nc1" "j < nc1 + nc2"
   show ?BD by (rule eq_vecI, insert j c, auto)
 qed
 
 lemma mult_four_block_mat: assumes
   c1: "A1 \<in> carrier_mat nr1 n1" "B1 \<in> carrier_mat nr1 n2" "C1 \<in> carrier_mat nr2 n1" "D1 \<in> carrier_mat nr2 n2" and
   c2: "A2 \<in> carrier_mat n1 nc1" "B2 \<in> carrier_mat n1 nc2" "C2 \<in> carrier_mat n2 nc1" "D2 \<in> carrier_mat n2 nc2"
   shows "four_block_mat A1 B1 C1 D1 * four_block_mat A2 B2 C2 D2
   = four_block_mat (A1 * A2 + B1 * C2) (A1 * B2 + B1 * D2)
     (C1 * A2 + D1 * C2) (C1 * B2 + D1 * D2)" (is "?M1 * ?M2 = _")
 proof -
   note row = row_four_block_mat[OF c1]
   note col = col_four_block_mat[OF c2]
   {
     fix i j
     assume i: "i < nr1" and j: "j < nc1"
     have "row ?M1 i \<bullet> col ?M2 j = row A1 i \<bullet> col A2 j + row B1 i \<bullet> col C2 j"
       unfolding row(1)[OF i] col(1)[OF j]
       by (rule scalar_prod_append[of _ n1 _ n2], insert c1 c2 i j, auto)
   }
   moreover
   {
     fix i j
     assume i: "\<not> i < nr1" "i < nr1 + nr2" and j: "j < nc1"
     hence i': "i - nr1 < nr2" by auto
     have "row ?M1 i \<bullet> col ?M2 j = row C1 (i - nr1) \<bullet> col A2 j + row D1 (i - nr1) \<bullet> col C2 j"
       unfolding row(2)[OF i] col(1)[OF j]
       by (rule scalar_prod_append[of _ n1 _ n2], insert c1 c2 i i' j, auto)
   }
   moreover
   {
     fix i j
     assume i: "i < nr1" and j: "\<not> j < nc1" "j < nc1 + nc2"
     hence j': "j - nc1 < nc2" by auto
     have "row ?M1 i \<bullet> col ?M2 j = row A1 i \<bullet> col B2 (j - nc1) + row B1 i \<bullet> col D2 (j - nc1)"
       unfolding row(1)[OF i] col(2)[OF j]
       by (rule scalar_prod_append[of _ n1 _ n2], insert c1 c2 i j' j, auto)
   }
   moreover
   {
     fix i j
     assume i: "\<not> i < nr1" "i < nr1 + nr2" and j: "\<not> j < nc1" "j < nc1 + nc2"
     hence i': "i - nr1 < nr2" and j': "j - nc1 < nc2" by auto
     have "row ?M1 i \<bullet> col ?M2 j = row C1 (i - nr1) \<bullet> col B2 (j - nc1) + row D1 (i - nr1) \<bullet> col D2 (j - nc1)"
       unfolding row(2)[OF i] col(2)[OF j]
       by (rule scalar_prod_append[of _ n1 _ n2], insert c1 c2 i i' j' j, auto)
   }
   ultimately show ?thesis
     by (intro eq_matI, insert c1 c2, auto)
 qed
 
 definition append_rows :: "'a :: zero mat \<Rightarrow> 'a mat \<Rightarrow> 'a mat" (infixr "@\<^sub>r" 65)where
   "A @\<^sub>r B = four_block_mat A (0\<^sub>m (dim_row A) 0) B (0\<^sub>m (dim_row B) 0)" 
 
 lemma carrier_append_rows[simp,intro]: "A \<in> carrier_mat nr1 nc \<Longrightarrow> B \<in> carrier_mat nr2 nc \<Longrightarrow>
   A @\<^sub>r B \<in> carrier_mat (nr1 + nr2) nc" 
   unfolding append_rows_def by auto
 
 lemma col_mult2[simp]:
   assumes A: "A : carrier_mat nr n"
       and B: "B : carrier_mat n nc"
       and j: "j < nc"
   shows "col (A * B) j = A *\<^sub>v col B j"
 proof
   have AB: "A * B : carrier_mat nr nc" using A B by auto
   fix i assume i: "i < dim_vec (A *\<^sub>v col B j)"
   show "col (A * B) j $ i = (A *\<^sub>v col B j) $ i"
     using A B AB j i by simp
 qed auto
 
 lemma mat_vec_as_mat_mat_mult: assumes A: "A \<in> carrier_mat nr nc" 
   and v: "v \<in> carrier_vec nc" 
 shows "A *\<^sub>v v = col (A * mat_of_cols nc [v]) 0"  
   by (subst col_mult2[OF A], insert v, auto)
 
 lemma mat_mult_append: assumes A: "A \<in> carrier_mat nr1 nc" 
   and B: "B \<in> carrier_mat nr2 nc" 
   and v: "v \<in> carrier_vec nc" 
 shows "(A @\<^sub>r B) *\<^sub>v v = (A *\<^sub>v v) @\<^sub>v (B *\<^sub>v v)" 
 proof -
   let ?Fb1 = "four_block_mat A (0\<^sub>m nr1 0) B (0\<^sub>m nr2 0)" 
   let ?Fb2 = "four_block_mat (mat_of_cols nc [v]) (0\<^sub>m nc 0) (0\<^sub>m 0 1) (0\<^sub>m 0 0)" 
   have id: "?Fb2 = mat_of_cols nc [v]" 
     using v by auto
   have "(A @\<^sub>r B) *\<^sub>v v = col (?Fb1 * ?Fb2) 0" unfolding id
     by (subst mat_vec_as_mat_mat_mult[OF _ v], insert A B, auto simp: append_rows_def)
   also have "?Fb1 * ?Fb2 = four_block_mat (A * mat_of_cols nc [v] + 0\<^sub>m nr1 0 * 0\<^sub>m 0 1) (A * 0\<^sub>m nc 0 + 0\<^sub>m nr1 0 * 0\<^sub>m 0 0)
      (B * mat_of_cols nc [v] + 0\<^sub>m nr2 0 * 0\<^sub>m 0 1) (B * 0\<^sub>m nc 0 + 0\<^sub>m nr2 0 * 0\<^sub>m 0 0)" 
     by (rule mult_four_block_mat[OF A _ B], auto)
   also have "(A * mat_of_cols nc [v] + 0\<^sub>m nr1 0 * 0\<^sub>m 0 1) = A * mat_of_cols nc [v]" 
     using A v by auto
   also have "(B * mat_of_cols nc [v] + 0\<^sub>m nr2 0 * 0\<^sub>m 0 1) = B * mat_of_cols nc [v]" 
     using B v by auto
   also have "(A * 0\<^sub>m nc 0 + 0\<^sub>m nr1 0 * 0\<^sub>m 0 0) = 0\<^sub>m nr1 0" using A by auto 
   also have "(B * 0\<^sub>m nc 0 + 0\<^sub>m nr2 0 * 0\<^sub>m 0 0) = 0\<^sub>m nr2 0" using B by auto
   finally have "(A @\<^sub>r B) *\<^sub>v v = col (four_block_mat (A * mat_of_cols nc [v]) (0\<^sub>m nr1 0) (B * mat_of_cols nc [v]) (0\<^sub>m nr2 0)) 0" .
   also have "\<dots> = col (A * mat_of_cols nc [v]) 0 @\<^sub>v col (B * mat_of_cols nc [v]) 0" 
     by (rule col_four_block_mat, insert A B v, auto)
   also have "col (A * mat_of_cols nc [v]) 0 = A *\<^sub>v v" 
     by (rule mat_vec_as_mat_mat_mult[symmetric, OF A v])
   also have "col (B * mat_of_cols nc [v]) 0 = B *\<^sub>v v" 
     by (rule mat_vec_as_mat_mat_mult[symmetric, OF B v])
   finally show ?thesis .
 qed
  
 lemma append_rows_le: assumes A: "A \<in> carrier_mat nr1 nc" 
   and B: "B \<in> carrier_mat nr2 nc" 
   and a: "a \<in> carrier_vec nr1" 
   and v: "v \<in> carrier_vec nc"
 shows "(A @\<^sub>r B) *\<^sub>v v \<le> (a @\<^sub>v b) \<longleftrightarrow> A *\<^sub>v v \<le> a \<and> B *\<^sub>v v \<le> b" 
   unfolding mat_mult_append[OF A B v]
   by (rule append_vec_le[OF _ a], insert A v, auto)
 
 
 lemma elements_four_block_mat:
   assumes c: "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
   "elements_mat (four_block_mat A B C D) \<subseteq>
    elements_mat A \<union> elements_mat B \<union> elements_mat C \<union> elements_mat D"
    (is "elements_mat ?four \<subseteq> _")
 proof rule
   fix a assume "a \<in> elements_mat ?four"
   then obtain i j
     where i4: "i < dim_row ?four" and j4: "j < dim_col ?four" and a: "a = ?four $$ (i, j)"
     by auto
   show "a \<in> elements_mat A \<union> elements_mat B \<union> elements_mat C \<union> elements_mat D"
   proof (cases "i < nr1")
     case True note i1 = this
     show ?thesis
     proof (cases "j < nc1")
       case True
       then have "a = A $$ (i,j)" using c i1 a by simp
       thus ?thesis using c i1 True by auto next
       case False
       then have "a = B $$ (i,j-nc1)" using c i1 a j4 by simp
       moreover have "j - nc1 < nc2" using c j4 False by auto
       ultimately show ?thesis using c i1 by auto
     qed next
     case False note i1 = this
     have i2: "i - nr1 < nr2" using c i1 i4 by auto
     show ?thesis
     proof (cases "j < nc1")
       case True
       then have "a = C $$ (i-nr1,j)" using c i2 a i1 by simp
       thus ?thesis using c i2 True by auto next
       case False
       then have "a = D $$ (i-nr1,j-nc1)" using c i2 a i1 j4 by simp
       moreover have "j - nc1 < nc2" using c j4 False by auto
       ultimately show ?thesis using c i2 by auto
     qed
   qed
 qed
 
 lemma assoc_four_block_mat: fixes FB :: "'a mat \<Rightarrow> 'a mat \<Rightarrow> 'a :: zero mat"
   defines FB: "FB \<equiv> \<lambda> Bb Cc. four_block_mat Bb (0\<^sub>m (dim_row Bb) (dim_col Cc)) (0\<^sub>m (dim_row Cc) (dim_col Bb)) Cc"
   shows "FB A (FB B C) = FB (FB A B) C" (is "?L = ?R")
 proof -
   let ?ar = "dim_row A" let ?ac = "dim_col A"
   let ?br = "dim_row B" let ?bc = "dim_col B"
   let ?cr = "dim_row C" let ?cc = "dim_col C"
   let ?r = "?ar + ?br + ?cr" let ?c = "?ac + ?bc + ?cc"
   let ?BC = "FB B C" let ?AB = "FB A B"
   have dL: "dim_row ?L = ?r" "dim_col ?L = ?c" unfolding FB by auto
   have dR: "dim_row ?R = ?ar + ?br + ?cr" "dim_col ?R = ?ac + ?bc + ?cc" unfolding FB by auto
   have dBC: "dim_row ?BC = ?br + ?cr" "dim_col ?BC = ?bc + ?cc" unfolding FB by auto
   have dAB: "dim_row ?AB = ?ar + ?br" "dim_col ?AB = ?ac + ?bc" unfolding FB by auto
   show ?thesis
   proof (intro eq_matI[of ?R ?L, unfolded dL dR, OF _ refl refl])
     fix i j
     assume i: "i < ?r" and j: "j < ?c"
     show "?L $$ (i,j) = ?R $$ (i,j)"
     proof (cases "i < ?ar")
       case True note i = this
       thus ?thesis using j
         by (cases "j < ?ac", auto simp: FB)
     next
       case False note ii = this
       show ?thesis
       proof (cases "j < ?ac")
         case True
         with i ii show ?thesis unfolding FB by auto
       next
         case False note jj = this
         from j jj i ii have L: "?L $$ (i,j) = ?BC $$ (i - ?ar, j - ?ac)" unfolding FB by auto
         have R: "?R $$ (i,j) = ?BC $$ (i - ?ar, j - ?ac)" using ii jj i j
           by (cases "i < ?ar + ?br"; cases "j < ?ac + ?bc", auto simp: FB)
         show ?thesis unfolding L R ..
       qed
     qed
   qed
 qed
 
 definition split_block :: "'a mat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ('a mat \<times> 'a mat \<times> 'a mat \<times> 'a mat)"
   where "split_block A sr sc = (let
     nr = dim_row A; nc = dim_col A;
     nr2 = nr - sr; nc2 = nc - sc;
     A1 = mat sr sc (\<lambda> ij. A $$ ij);
     A2 = mat sr nc2 (\<lambda> (i,j). A $$ (i,j+sc));
     A3 = mat nr2 sc (\<lambda> (i,j). A $$ (i+sr,j));
     A4 = mat nr2 nc2 (\<lambda> (i,j). A $$ (i+sr,j+sc))
   in (A1,A2,A3,A4))"
 
 lemma split_block: assumes res: "split_block A sr1 sc1 = (A1,A2,A3,A4)"
   and dims: "dim_row A = sr1 + sr2" "dim_col A = sc1 + sc2"
   shows "A1 \<in> carrier_mat sr1 sc1" "A2 \<in> carrier_mat sr1 sc2"
     "A3 \<in> carrier_mat sr2 sc1" "A4 \<in> carrier_mat sr2 sc2"
     "A = four_block_mat A1 A2 A3 A4"
   using res unfolding split_block_def Let_def
   by (auto simp: dims)
 
 text \<open>Using @{const four_block_mat} we define block-diagonal matrices.\<close>
 
 fun diag_block_mat :: "'a :: zero mat list \<Rightarrow> 'a mat" where
   "diag_block_mat [] = 0\<^sub>m 0 0"
 | "diag_block_mat (A # As) = (let
      B = diag_block_mat As
      in four_block_mat A (0\<^sub>m (dim_row A) (dim_col B)) (0\<^sub>m (dim_row B) (dim_col A)) B)"
 
 lemma dim_diag_block_mat:
   "dim_row (diag_block_mat As) = sum_list (map dim_row As)" (is "?row")
   "dim_col (diag_block_mat As) = sum_list (map dim_col As)" (is "?col")
 proof -
   have "?row \<and> ?col"
     by (induct As, auto simp: Let_def)
   thus ?row and ?col by auto
 qed
 
 lemma diag_block_mat_singleton[simp]: "diag_block_mat [A] = A"
   by auto
 
 lemma diag_block_mat_append: "diag_block_mat (As @ Bs) =
   (let A = diag_block_mat As; B = diag_block_mat Bs
   in four_block_mat A (0\<^sub>m (dim_row A) (dim_col B)) (0\<^sub>m (dim_row B) (dim_col A)) B)"
   unfolding Let_def
 proof (induct As)
   case (Cons A As)
   show ?case
     unfolding append.simps
     unfolding diag_block_mat.simps Let_def
     unfolding Cons
     by (rule assoc_four_block_mat)
 qed auto
 
 lemma diag_block_mat_last: "diag_block_mat (As @ [B]) =
   (let A = diag_block_mat As
   in four_block_mat A (0\<^sub>m (dim_row A) (dim_col B)) (0\<^sub>m (dim_row B) (dim_col A)) B)"
   unfolding diag_block_mat_append diag_block_mat_singleton by auto
 
 
 lemma diag_block_mat_square:
   "Ball (set As) square_mat \<Longrightarrow> square_mat (diag_block_mat As)"
 by (induct As, auto simp:Let_def)
 
 lemma diag_block_one_mat[simp]:
   "diag_block_mat (map (\<lambda>A. 1\<^sub>m (dim_row A)) As) = (1\<^sub>m (sum_list (map dim_row As)))"
   by (induct As, auto simp: Let_def)
 
 lemma elements_diag_block_mat:
   "elements_mat (diag_block_mat As) \<subseteq> {0} \<union> \<Union> (set (map elements_mat As))"
 proof (induct As)
   case Nil then show ?case using dim_diag_block_mat[of Nil] by auto next
   case (Cons A As)
     let ?D = "diag_block_mat As"
     let ?B = "0\<^sub>m (dim_row A) (dim_col ?D)"
     let ?C = "0\<^sub>m (dim_row ?D) (dim_col A)"
     have A: "A \<in> carrier_mat (dim_row A) (dim_col A)" by auto
     have B: "?B \<in> carrier_mat (dim_row A) (dim_col ?D)" by auto
     have C: "?C \<in> carrier_mat (dim_row ?D) (dim_col A)" by auto
     have D: "?D \<in> carrier_mat (dim_row ?D) (dim_col ?D)" by auto
     have
       "elements_mat (diag_block_mat (A#As)) \<subseteq>
        elements_mat A \<union> elements_mat ?B \<union> elements_mat ?C \<union> elements_mat ?D"
       unfolding diag_block_mat.simps Let_def
       using elements_four_block_mat[OF A B C D] elements_0_mat
       by auto
     also have "... \<subseteq> {0} \<union> elements_mat A \<union> elements_mat ?D"
       using elements_0_mat by auto
     finally show ?case using Cons by auto
 qed
 
 lemma diag_block_pow_mat: assumes sq: "Ball (set As) square_mat"
   shows "diag_block_mat As ^\<^sub>m n = diag_block_mat (map (\<lambda> A. A ^\<^sub>m n) As)" (is "?As ^\<^sub>m _ = _")
 proof (induct n)
   case 0
   have "?As ^\<^sub>m 0 = 1\<^sub>m (dim_row ?As)" by simp
   also have "dim_row ?As = sum_list (map dim_row As)"
     using diag_block_mat_square[OF sq] unfolding dim_diag_block_mat by auto
   also have "1\<^sub>m \<dots> = diag_block_mat (map (\<lambda>A. 1\<^sub>m (dim_row A)) As)" by simp
   also have "\<dots> = diag_block_mat (map (\<lambda> A. A ^\<^sub>m 0) As)" by simp
   finally show ?case .
 next
   case (Suc n)
   let ?An = "\<lambda> As. diag_block_mat (map (\<lambda>A. A ^\<^sub>m n) As)"
   let ?Asn = "\<lambda> As. diag_block_mat (map (\<lambda>A. A ^\<^sub>m n * A) As)"
   from Suc have "?case = (?An As * diag_block_mat As = ?Asn As)" by simp
   also have "\<dots>" using sq
   proof (induct As)
     case (Cons A As)
     hence IH: "?An As * diag_block_mat As = ?Asn As"
       and sq: "Ball (set As) square_mat" and A: "dim_col A = dim_row A" by auto
     have sq2: "Ball (set (List.map (\<lambda>A. A ^\<^sub>m n) As)) square_mat"
       and sq3: "Ball (set (List.map (\<lambda>A. A ^\<^sub>m n * A) As)) square_mat"
       using sq by auto
     define n1 where "n1 = dim_row A"
     define n2 where "n2 = sum_list (map dim_row As)"
     from A have A: "A \<in> carrier_mat n1 n1" unfolding n1_def carrier_mat_def by simp
     have [simp]: "dim_col (?An As) = n2" "dim_row (?An As) = n2"
       unfolding n2_def
       using diag_block_mat_square[OF sq2,unfolded square_mat.simps]
       unfolding dim_diag_block_mat map_map by (auto simp:o_def)
     have [simp]: "dim_col (?Asn As) = n2" "dim_row (?Asn As) = n2"
       unfolding n2_def
       using diag_block_mat_square[OF sq3,unfolded square_mat.simps]
       unfolding dim_diag_block_mat map_map by (auto simp:o_def)
     have [simp]:
       "dim_row (diag_block_mat As) = n2"
       "dim_col (diag_block_mat As) = n2"
       unfolding n2_def
       using diag_block_mat_square[OF sq,unfolded square_mat.simps]
       unfolding dim_diag_block_mat by auto
 
     have [simp]: "diag_block_mat As \<in> carrier_mat n2 n2" unfolding carrier_mat_def by simp
     have [simp]: "?An As \<in> carrier_mat n2 n2" unfolding carrier_mat_def by simp
     show ?case unfolding diag_block_mat.simps Let_def list.simps
       by (subst mult_four_block_mat[of _ n1 n1 _ n2 _ n2 _ _ n1 _ n2],
       insert A, auto simp: IH)
   qed auto
   finally show ?case by simp
 qed
 
 lemma diag_block_upper_triangular: assumes
     "\<And> A i j. A \<in> set As \<Longrightarrow> j < i \<Longrightarrow> i < dim_row A \<Longrightarrow> A $$ (i,j) = 0"
   and "Ball (set As) square_mat"
   and "j < i" "i < dim_row (diag_block_mat As)"
   shows "diag_block_mat As $$ (i,j) = 0"
   using assms
 proof (induct As arbitrary: i j)
   case (Cons A As i j)
   let ?n1 = "dim_row A"
   let ?n2 = "sum_list (map dim_row As)"
   from Cons have [simp]: "dim_col A = ?n1" by simp
   from Cons have "Ball (set As) square_mat" by auto
   note [simp] = diag_block_mat_square[OF this,unfolded square_mat.simps]
   note [simp] = dim_diag_block_mat(1)
   from Cons(5) have i: "i < ?n1 + ?n2" by simp
   show ?case
   proof (cases "i < ?n1")
     case True
     with Cons(4) have j: "j < ?n1" by auto
     with True Cons(2)[of A, OF _ Cons(4)] show ?thesis
       by (simp add: Let_def)
   next
     case False note iAs = this
     show ?thesis
     proof (cases "j < ?n1")
       case True
       with i iAs show ?thesis by (simp add: Let_def)
     next
       case False note jAs = this
       from Cons(4) i have j: "j < ?n1 + ?n2" by auto
       show ?thesis using iAs jAs i j
         by (simp add: Let_def, subst Cons(1), insert Cons(2-4), auto)
     qed
   qed
 qed simp
 
 lemma smult_four_block_mat: assumes c: "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 "a \<cdot>\<^sub>m four_block_mat A B C D = four_block_mat (a \<cdot>\<^sub>m A) (a \<cdot>\<^sub>m B) (a \<cdot>\<^sub>m C) (a \<cdot>\<^sub>m D)"
   by (rule eq_matI, insert c, auto)
 
 lemma map_four_block_mat: assumes c: "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 "map_mat f (four_block_mat A B C D) = four_block_mat (map_mat f A) (map_mat f B) (map_mat f C) (map_mat f D)"
   by (rule eq_matI, insert c, auto)
 
 lemma add_four_block_mat: assumes
   c1: "A1 \<in> carrier_mat nr1 nc1" "B1 \<in> carrier_mat nr1 nc2" "C1 \<in> carrier_mat nr2 nc1" "D1 \<in> carrier_mat nr2 nc2" and
   c2: "A2 \<in> carrier_mat nr1 nc1" "B2 \<in> carrier_mat nr1 nc2" "C2 \<in> carrier_mat nr2 nc1" "D2 \<in> carrier_mat nr2 nc2"
   shows "four_block_mat A1 B1 C1 D1 + four_block_mat A2 B2 C2 D2
   = four_block_mat (A1 + A2) (B1 + B2) (C1 + C2) (D1 + D2)"
   by (rule eq_matI, insert assms, auto)
 
 
 lemma diag_four_block_mat: assumes c: "A \<in> carrier_mat n1 n1"
    "D \<in> carrier_mat n2 n2"
   shows "diag_mat (four_block_mat A B C D) = diag_mat A @ diag_mat D"
   by (rule nth_equalityI, insert c, auto simp: diag_mat_def nth_append)
 
 definition mk_diagonal :: "'a::zero list \<Rightarrow> 'a mat"
   where "mk_diagonal as = diag_block_mat (map (\<lambda>a. mat (Suc 0) (Suc 0) (\<lambda>_. a)) as)"
 
 lemma mk_diagonal_dim:
   "dim_row (mk_diagonal as) = length as" "dim_col (mk_diagonal as) = length as"
   unfolding mk_diagonal_def by(induct as, auto simp: Let_def)
 
 lemma mk_diagonal_diagonal: "diagonal_mat (mk_diagonal as)"
   unfolding mk_diagonal_def
 proof (induct as)
   case Nil show ?case unfolding mk_diagonal_def diagonal_mat_def by simp next
   case (Cons a as)
     let ?n = "length (a#as)"
     let ?A = "mat (Suc 0) (Suc 0) (\<lambda>_. a)"
     let ?f = "map (\<lambda>a. mat (Suc 0) (Suc 0) (\<lambda>_. a))"
     let ?AS = "diag_block_mat (?f as)"
     let ?AAS = "diag_block_mat (?f (a#as))"
     show ?case
       unfolding diagonal_mat_def
     proof(intro allI impI)
       fix i j assume ir: "i < dim_row ?AAS" and jc: "j < dim_col ?AAS" and ij: "i \<noteq> j"
       hence ir2: "i < 1 + dim_row ?AS" and jc2: "j < 1 + dim_col ?AS"
         unfolding dim_row_mat list.map diag_block_mat.simps Let_def
         by auto
       show "?AAS $$ (i,j) = 0"
       proof (cases "i = 0")
         case True
           then show ?thesis using jc ij by (auto simp: Let_def) next
         case False note i0 = this
           show ?thesis
           proof (cases "j = 0")
             case True
               then show ?thesis using ir ij by (auto simp: Let_def) next
             case False
               have ir3: "i-1 < dim_row ?AS" and jc3: "j-1 < dim_col ?AS"
                 using ir2 jc2 i0 False by auto
               have IH: "\<And>i j. i < dim_row ?AS \<Longrightarrow> j < dim_col ?AS \<Longrightarrow> i \<noteq> j \<Longrightarrow>
                 ?AS $$ (i,j) = 0"
                 using Cons unfolding diagonal_mat_def by auto
               have "?AS $$ (i-1,j-1) = 0"
                 using IH[OF ir3 jc3] i0 False ij by auto
               thus ?thesis using ir jc ij by (simp add: Let_def)
           qed
       qed
     qed
 qed
 
 definition orthogonal_mat :: "'a::semiring_0 mat \<Rightarrow> bool"
   where "orthogonal_mat A \<equiv>
     let B = transpose_mat A * A in
     diagonal_mat B \<and> (\<forall>i<dim_col A. B $$ (i,i) \<noteq> 0)"
 
 lemma orthogonal_matD[elim]:
   "orthogonal_mat A \<Longrightarrow>
    i < dim_col A \<Longrightarrow> j < dim_col A \<Longrightarrow> (col A i \<bullet> col A j = 0) = (i \<noteq> j)"
   unfolding orthogonal_mat_def diagonal_mat_def by auto
 
 lemma orthogonal_matI[intro]:
   "(\<And>i j. i < dim_col A \<Longrightarrow> j < dim_col A \<Longrightarrow> (col A i \<bullet> col A j = 0) = (i \<noteq> j)) \<Longrightarrow>
    orthogonal_mat A"
   unfolding orthogonal_mat_def diagonal_mat_def by auto
 
 definition orthogonal :: "'a::semiring_0 vec list \<Rightarrow> bool"
   where "orthogonal vs \<equiv>
     \<forall>i j. i < length vs \<longrightarrow> j < length vs \<longrightarrow>
       (vs ! i \<bullet> vs ! j = 0) = (i \<noteq> j)"
 
 lemma orthogonalD[elim]:
   "orthogonal vs \<Longrightarrow> i < length vs \<Longrightarrow> j < length vs \<Longrightarrow>
   (nth vs i \<bullet> nth vs j = 0) = (i \<noteq> j)"
   unfolding orthogonal_def by auto
 
 lemma orthogonalI[intro]:
   "(\<And>i j. i < length vs \<Longrightarrow> j < length vs \<Longrightarrow> (nth vs i \<bullet> nth vs j = 0) = (i \<noteq> j)) \<Longrightarrow>
    orthogonal vs"
   unfolding orthogonal_def by auto
 
 
 lemma transpose_four_block_mat: assumes *: "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 "transpose_mat (four_block_mat A B C D) =
     four_block_mat (transpose_mat A) (transpose_mat C) (transpose_mat B) (transpose_mat D)"
   by (rule eq_matI, insert *, auto)
 
 lemma zero_transpose_mat[simp]: "transpose_mat (0\<^sub>m n m) = (0\<^sub>m m n)"
   by (rule eq_matI, auto)
 
 lemma upper_triangular_four_block: assumes AD: "A \<in> carrier_mat n n" "D \<in> carrier_mat m m"
   and ut: "upper_triangular A" "upper_triangular D"
   shows "upper_triangular (four_block_mat A B (0\<^sub>m m n) D)"
 proof -
   let ?C = "four_block_mat A B (0\<^sub>m m n) D"
   from AD have dim: "dim_row ?C = n + m" "dim_col ?C = n + m" "dim_row A = n" by auto
   show ?thesis
   proof (rule upper_triangularI, unfold dim)
     fix i j
     assume *: "j < i" "i < n + m"
     show "?C $$ (i,j) = 0"
     proof (cases "i < n")
       case True
       with upper_triangularD[OF ut(1) *(1)] * AD show ?thesis by auto
     next
       case False note i = this
       show ?thesis by (cases "j < n", insert upper_triangularD[OF ut(2)] * i AD, auto)
     qed
   qed
 qed
 
 lemma pow_four_block_mat: assumes A: "A \<in> carrier_mat n n"
   and B: "B \<in> carrier_mat m m"
   shows "(four_block_mat A (0\<^sub>m n m) (0\<^sub>m m n) B) ^\<^sub>m k =
     four_block_mat (A ^\<^sub>m k) (0\<^sub>m n m) (0\<^sub>m m n) (B ^\<^sub>m k)"
 proof (induct k)
   case (Suc k)
   let ?FB = "\<lambda> A B. four_block_mat A (0\<^sub>m n m) (0\<^sub>m m n) B"
   let ?A = "?FB A B"
   let ?B = "?FB (A ^\<^sub>m k) (B ^\<^sub>m k)"
   from A B have Ak: "A ^\<^sub>m k \<in> carrier_mat n n" and Bk: "B ^\<^sub>m k \<in> carrier_mat m m" by auto
   have "?A ^\<^sub>m Suc k = ?A ^\<^sub>m k * ?A" by simp
   also have "?A ^\<^sub>m k = ?B " by (rule Suc)
   also have "?B * ?A = ?FB (A ^\<^sub>m Suc k) (B ^\<^sub>m Suc k)"
     by (subst mult_four_block_mat[OF Ak _ _ Bk A _ _ B], insert A B, auto)
   finally show ?case .
 qed (insert A B, auto)
 
 lemma uminus_scalar_prod:
   assumes [simp]: "v : carrier_vec n" "w : carrier_vec n"
   shows "- ((v::'a::field vec) \<bullet> w) = (- v) \<bullet> w"
   unfolding scalar_prod_def uminus_vec_def
   apply (subst sum_negf[symmetric])
 proof (rule sum.cong[OF refl])
   fix i assume i: "i : {0 ..<dim_vec w}"
   have [simp]: "dim_vec v = n" "dim_vec w = n" by auto
   show "- (v $ i * w $ i) = vec (dim_vec v) (\<lambda>i. - v $ i) $ i * w $ i"
     unfolding minus_mult_left using i by auto
 qed
 
 
 lemma append_vec_eq:
   assumes [simp]: "v : carrier_vec n" "v' : carrier_vec n"
   shows [simp]: "v @\<^sub>v w = v' @\<^sub>v w' \<longleftrightarrow> v = v' \<and> w = w'" (is "?L \<longleftrightarrow> ?R")
 proof
   have [simp]: "dim_vec v = n" "dim_vec v' = n" by auto
   { assume L: ?L
     have vv': "v = v'"
     proof
       fix i assume i: "i < dim_vec v'"
       have "(v @\<^sub>v w) $ i = (v' @\<^sub>v w') $ i" using L by auto
       thus "v $ i = v' $ i" using i by auto
     qed auto
     moreover have "w = w'"
     proof
       show "dim_vec w = dim_vec w'" using vv' L
         by (metis add_diff_cancel_left' index_append_vec(2))
       moreover fix i assume i: "i < dim_vec w'"
       have "(v @\<^sub>v w) $ (n + i) = (v' @\<^sub>v w') $ (n + i)" using L by auto
       ultimately show "w $ i = w' $ i" using i by simp
     qed
     ultimately show ?R by simp
   }
 qed auto
 
 lemma append_vec_add:
   assumes [simp]: "v : carrier_vec n" "v' : carrier_vec n"
       and [simp]: "w : carrier_vec m" "w' : carrier_vec m"
   shows "(v @\<^sub>v w) + (v' @\<^sub>v w') = (v + v') @\<^sub>v (w + w')" (is "?L = ?R")
 proof
   have [simp]: "dim_vec v = n" "dim_vec v' = n" by auto
   have [simp]: "dim_vec w = m" "dim_vec w' = m" by auto
   fix i assume i: "i < dim_vec ?R"
   thus "?L $ i = ?R $ i" by (cases "i < n",auto)
 qed auto
 
 
 lemma mult_mat_vec_split:
   assumes A: "A : carrier_mat n n"
       and D: "D : carrier_mat m m"
       and a: "a : carrier_vec n"
       and d: "d : carrier_vec m"
   shows "four_block_mat A (0\<^sub>m n m) (0\<^sub>m m n) D *\<^sub>v (a @\<^sub>v d) = A *\<^sub>v a @\<^sub>v D *\<^sub>v d"
     (is "?A00D *\<^sub>v _ = ?r")
 proof
   have A00D: "?A00D : carrier_mat (n+m) (n+m)" using four_block_carrier_mat[OF A D].
   fix i assume i: "i < dim_vec ?r"
   show "(?A00D *\<^sub>v (a @\<^sub>v d)) $ i = ?r $ i" (is "?li = _")
   proof (cases "i < n")
     case True
       have "?li = (row A i @\<^sub>v 0\<^sub>v m) \<bullet> (a @\<^sub>v d)"
         using A row_four_block_mat[OF A _ _ D] True by simp
       also have "... = row A i \<bullet> a + 0\<^sub>v m \<bullet> d"
         apply (rule scalar_prod_append) using A D a d True by auto
       also have "... = row A i \<bullet> a" using d by simp
       finally show ?thesis using A True by auto
     next case False
       let ?i = "i - n"
       have "?li = (0\<^sub>v n @\<^sub>v row D ?i) \<bullet> (a @\<^sub>v d)"
         using i row_four_block_mat[OF A _ _ D] False A D by simp
       also have "... = 0\<^sub>v n \<bullet> a + row D ?i \<bullet> d"
         apply (rule scalar_prod_append) using A D a d False by auto
       also have "... = row D ?i \<bullet> d" using a by simp
       finally show ?thesis using A D False i by auto
   qed
 qed auto
 
 lemma similar_mat_witI: assumes "P * Q = 1\<^sub>m n" "Q * P = 1\<^sub>m n" "A = P * B * Q"
   "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" "P \<in> carrier_mat n n" "Q \<in> carrier_mat n n"
   shows "similar_mat_wit A B P Q" using assms unfolding similar_mat_wit_def Let_def by auto
 
 lemma similar_mat_witD: assumes "n = dim_row A" "similar_mat_wit A B P Q"
   shows "P * Q = 1\<^sub>m n" "Q * P = 1\<^sub>m n" "A = P * B * Q"
   "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" "P \<in> carrier_mat n n" "Q \<in> carrier_mat n n"
   using assms(2) unfolding similar_mat_wit_def Let_def assms(1)[symmetric] by auto
 
 lemma similar_mat_witD2: assumes "A \<in> carrier_mat n m" "similar_mat_wit A B P Q"
   shows "P * Q = 1\<^sub>m n" "Q * P = 1\<^sub>m n" "A = P * B * Q"
   "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" "P \<in> carrier_mat n n" "Q \<in> carrier_mat n n"
   using similar_mat_witD[OF _ assms(2), of n] assms(1)[unfolded carrier_mat_def] by auto
 
 lemma similar_mat_wit_sym: assumes sim: "similar_mat_wit A B P Q"
   shows "similar_mat_wit B A Q P"
 proof -
   from similar_mat_witD[OF refl sim] obtain n where
     AB: "{A, B, P, Q} \<subseteq> carrier_mat n n" "P * Q = 1\<^sub>m n" "Q * P = 1\<^sub>m n" and A: "A = P * B * Q" by blast
   hence *: "{B, A, Q, P} \<subseteq> carrier_mat n n" "Q * P = 1\<^sub>m n" "P * Q = 1\<^sub>m n" by auto
   let ?c = "\<lambda> A. A \<in> carrier_mat n n"
   from * have Carr: "?c B" "?c P" "?c Q" by auto
   note [simp] = assoc_mult_mat[of _ n n _ n _ n]
   show ?thesis
   proof (rule similar_mat_witI[of _ _ n])
     have "Q * A * P = (Q * P) * B * (Q * P)"
       using Carr unfolding A by simp
     also have "\<dots> = B" using Carr unfolding AB by simp
     finally show "B = Q * A * P" by simp
   qed (insert * AB, auto)
 qed
 
 lemma similar_mat_wit_refl: assumes A: "A \<in> carrier_mat n n"
   shows "similar_mat_wit A A (1\<^sub>m n) (1\<^sub>m n)"
   by (rule similar_mat_witI[OF _ _ _ A], insert A, auto)
 
 lemma similar_mat_wit_trans: assumes AB: "similar_mat_wit A B P Q"
   and BC: "similar_mat_wit B C P' Q'"
   shows "similar_mat_wit A C (P * P') (Q' * Q)"
 proof -
   from similar_mat_witD[OF refl AB] obtain n where
     AB: "{A, B, P, Q} \<subseteq> carrier_mat n n" "P * Q = 1\<^sub>m n" "Q * P = 1\<^sub>m n" "A = P * B * Q" by blast
   hence B: "B \<in> carrier_mat n n" by auto
   from similar_mat_witD2[OF B BC] have
     BC: "{C, P', Q'} \<subseteq> carrier_mat n n" "P' * Q' = 1\<^sub>m n" "Q' * P' = 1\<^sub>m n" "B = P' * C * Q'" by auto
   let ?c = "\<lambda> A. A \<in> carrier_mat n n"
   let ?P = "P * P'"
   let ?Q = "Q' * Q"
   from AB BC have carr: "?c A" "?c B" "?c C" "?c P" "?c P'" "?c Q" "?c Q'"
     and Carr: "{A, C, ?P, ?Q} \<subseteq> carrier_mat n n" by auto
   note [simp] = assoc_mult_mat[of _ n n _ n _ n]
   have id: "A = ?P * C * ?Q" unfolding AB(4)[unfolded BC(4)] using carr
     by simp
   have "?P * ?Q = P * (P' * Q') * Q" using carr by simp
   also have "\<dots> = 1\<^sub>m n" unfolding BC using carr AB by simp
   finally have PQ: "?P * ?Q = 1\<^sub>m n" .
   have "?Q * ?P = Q' * (Q * P) * P'" using carr by simp
   also have "\<dots> = 1\<^sub>m n" unfolding AB using carr BC by simp
   finally have QP: "?Q * ?P = 1\<^sub>m n" .
   show ?thesis
     by (rule similar_mat_witI[OF PQ QP id], insert Carr, auto)
 qed
 
 lemma similar_mat_refl: "A \<in> carrier_mat n n \<Longrightarrow> similar_mat A A"
   using similar_mat_wit_refl unfolding similar_mat_def by blast
 
 lemma similar_mat_trans: "similar_mat A B \<Longrightarrow> similar_mat B C \<Longrightarrow> similar_mat A C"
   using similar_mat_wit_trans unfolding similar_mat_def by blast
 
 lemma similar_mat_sym: "similar_mat A B \<Longrightarrow> similar_mat B A"
   using similar_mat_wit_sym unfolding similar_mat_def by blast
 
 lemma similar_mat_wit_four_block: assumes
       1: "similar_mat_wit A1 B1 P1 Q1"
   and 2: "similar_mat_wit A2 B2 P2 Q2"
   and URA: "URA = (P1 * UR * Q2)"
   and LLA: "LLA = (P2 * LL * Q1)"
   and A1: "A1 \<in> carrier_mat n n"
   and A2: "A2 \<in> carrier_mat m m"
   and LL: "LL \<in> carrier_mat m n"
   and UR: "UR \<in> carrier_mat n m"
   shows "similar_mat_wit (four_block_mat A1 URA LLA A2) (four_block_mat B1 UR LL B2)
     (four_block_mat P1 (0\<^sub>m n m) (0\<^sub>m m n) P2) (four_block_mat Q1 (0\<^sub>m n m) (0\<^sub>m m n) Q2)"
   (is "similar_mat_wit ?A ?B ?P ?Q")
 proof -
   let ?n = "n + m"
   let ?O1 = "1\<^sub>m n"   let ?O2 = "1\<^sub>m m"   let ?O = "1\<^sub>m ?n"
   from similar_mat_witD2[OF A1 1] have 11: "P1 * Q1 = ?O1" "Q1 * P1 = ?O1"
     and P1: "P1 \<in> carrier_mat n n" and Q1: "Q1 \<in> carrier_mat n n"
     and B1: "B1 \<in> carrier_mat n n" and 1: "A1 = P1 * B1 * Q1" by auto
   from similar_mat_witD2[OF A2 2] have 21: "P2 * Q2 = ?O2" "Q2 * P2 = ?O2"
     and P2: "P2 \<in> carrier_mat m m" and Q2: "Q2 \<in> carrier_mat m m"
     and B2: "B2 \<in> carrier_mat m m" and 2: "A2 = P2 * B2 * Q2" by auto
   have PQ1: "?P * ?Q = ?O"
     by (subst mult_four_block_mat[OF P1 _ _ P2 Q1 _ _ Q2], unfold 11 21, insert P1 P2 Q1 Q2,
       auto intro!: eq_matI)
   have QP1: "?Q * ?P = ?O"
     by (subst mult_four_block_mat[OF Q1 _ _ Q2 P1 _ _ P2], unfold 11 21, insert P1 P2 Q1 Q2,
       auto intro!: eq_matI)
   let ?PB = "?P * ?B"
   have P: "?P \<in> carrier_mat ?n ?n" using P1 P2 by auto
   have Q: "?Q \<in> carrier_mat ?n ?n" using Q1 Q2 by auto
   have B: "?B \<in> carrier_mat ?n ?n" using B1 UR LL B2 by auto
   have PB: "?PB \<in> carrier_mat ?n ?n" using P B by auto
   have PB1: "P1 * B1 \<in> carrier_mat n n" using P1 B1 by auto
   have PB2: "P2 * B2 \<in> carrier_mat m m" using P2 B2 by auto
   have P1UR: "P1 * UR \<in> carrier_mat n m" using P1 UR by auto
   have P2LL: "P2 * LL \<in> carrier_mat m n" using P2 LL by auto
   have id: "?PB = four_block_mat (P1 * B1) (P1 * UR) (P2 * LL) (P2 * B2)"
     by (subst mult_four_block_mat[OF P1 _ _ P2 B1 UR LL B2], insert P1 P2 B1 B2 LL UR, auto)
   have id: "?PB * ?Q = four_block_mat (P1 * B1 * Q1) (P1 * UR * Q2)
     (P2 * LL * Q1) (P2 * B2 * Q2)" unfolding id
     by (subst mult_four_block_mat[OF PB1 P1UR P2LL PB2 Q1 _ _ Q2],
     insert P1 P2 B1 B2 Q1 Q2 UR LL, auto)
   have id: "?A = ?P * ?B * ?Q" unfolding id 1 2 URA LLA ..
   show ?thesis
     by (rule similar_mat_witI[OF PQ1 QP1 id], insert A1 A2 B1 B2 Q1 Q2 P1 P2, auto)
 qed
 
 
 lemma similar_mat_four_block_0_ex: assumes
       1: "similar_mat A1 B1"
   and 2: "similar_mat A2 B2"
   and A0: "A0 \<in> carrier_mat n m"
   and A1: "A1 \<in> carrier_mat n n"
   and A2: "A2 \<in> carrier_mat m m"
   shows "\<exists> B0. B0 \<in> carrier_mat n m \<and> similar_mat (four_block_mat A1 A0 (0\<^sub>m m n) A2)
     (four_block_mat B1 B0 (0\<^sub>m m n) B2)"
 proof -
   from 1[unfolded similar_mat_def] obtain P1 Q1 where 1: "similar_mat_wit A1 B1 P1 Q1" by auto
   note w1 = similar_mat_witD2[OF A1 1]
   from 2[unfolded similar_mat_def] obtain P2 Q2 where 2: "similar_mat_wit A2 B2 P2 Q2" by auto
   note w2 = similar_mat_witD2[OF A2 2]
   from w1 w2 have C: "B1 \<in> carrier_mat n n" "B2 \<in> carrier_mat m m" by auto
   from w1 w2 have id: "0\<^sub>m m n = Q2 * 0\<^sub>m m n * P1" by simp
   let ?wit = "Q1 * A0 * P2"
   from w1 w2 A0 have wit: "?wit \<in> carrier_mat n m" by auto
   from similar_mat_wit_sym[OF similar_mat_wit_four_block[OF similar_mat_wit_sym[OF 1] similar_mat_wit_sym[OF 2]
     refl id C zero_carrier_mat A0]]
   have "similar_mat (four_block_mat A1 A0 (0\<^sub>m m n) A2) (four_block_mat B1 (Q1 * A0 * P2) (0\<^sub>m m n) B2)"
     unfolding similar_mat_def by auto
   thus ?thesis using wit by auto
 qed
 
 lemma similar_mat_four_block_0_0: assumes
       1: "similar_mat A1 B1"
   and 2: "similar_mat A2 B2"
   and A1: "A1 \<in> carrier_mat n n"
   and A2: "A2 \<in> carrier_mat m m"
   shows "similar_mat (four_block_mat A1 (0\<^sub>m n m) (0\<^sub>m m n) A2)
     (four_block_mat B1 (0\<^sub>m n m) (0\<^sub>m m n) B2)"
 proof -
   from 1[unfolded similar_mat_def] obtain P1 Q1 where 1: "similar_mat_wit A1 B1 P1 Q1" by auto
   note w1 = similar_mat_witD2[OF A1 1]
   from 2[unfolded similar_mat_def] obtain P2 Q2 where 2: "similar_mat_wit A2 B2 P2 Q2" by auto
   note w2 = similar_mat_witD2[OF A2 2]
   from w1 w2 have C: "B1 \<in> carrier_mat n n" "B2 \<in> carrier_mat m m" by auto
   from w1 w2 have id: "0\<^sub>m m n = Q2 * 0\<^sub>m m n * P1" by simp
   from w1 w2 have id2: "0\<^sub>m n m = Q1 * 0\<^sub>m n m * P2" by simp
   from similar_mat_wit_sym[OF similar_mat_wit_four_block[OF similar_mat_wit_sym[OF 1] similar_mat_wit_sym[OF 2]
     id2 id C zero_carrier_mat zero_carrier_mat]]
   show ?thesis unfolding similar_mat_def by blast
 qed
 
 lemma similar_diag_mat_block_mat: assumes "\<And> A B. (A,B) \<in> set Ms \<Longrightarrow> similar_mat A B"
   shows "similar_mat (diag_block_mat (map fst Ms)) (diag_block_mat (map snd Ms))"
   using assms
 proof (induct Ms)
   case Nil
   show ?case by (auto intro!: similar_mat_refl[of _ 0])
 next
   case (Cons AB Ms)
   obtain A B where AB: "AB = (A,B)" by force
   from Cons(2)[of A B] have simAB: "similar_mat A B" unfolding AB by auto
   from similar_matD[OF this] obtain n where A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n" by auto
   hence [simp]: "dim_row A = n" "dim_col A = n" "dim_row B = n" "dim_col B = n" by auto
   let ?C = "diag_block_mat (map fst Ms)" let ?D = "diag_block_mat (map snd Ms)"
   from Cons(1)[OF Cons(2)] have simRec: "similar_mat ?C ?D" by auto
   from similar_matD[OF this] obtain m where C: "?C \<in> carrier_mat m m" and D: "?D \<in> carrier_mat m m" by auto
   hence [simp]: "dim_row ?C = m" "dim_col ?C = m" "dim_row ?D = m" "dim_col ?D = m" by auto
   have "similar_mat (diag_block_mat (map fst (AB # Ms))) (diag_block_mat (map snd (AB # Ms)))
     = similar_mat (four_block_mat A (0\<^sub>m n m) (0\<^sub>m m n) ?C) (four_block_mat B (0\<^sub>m n m) (0\<^sub>m m n) ?D)"
     unfolding AB by (simp add: Let_def)
   also have "\<dots>"
     by (rule similar_mat_four_block_0_0[OF simAB simRec A C])
   finally show ?case .
 qed
 
 lemma similar_mat_wit_pow: assumes wit: "similar_mat_wit A B P Q"
   shows "similar_mat_wit (A ^\<^sub>m k) (B ^\<^sub>m k) P Q"
 proof -
   define n where "n = dim_row A"
   let ?C = "carrier_mat n n"
   from similar_mat_witD[OF refl wit, folded n_def] have
     A: "A \<in> ?C" and B: "B \<in> ?C" and P: "P \<in> ?C" and Q: "Q \<in> ?C"
     and PQ: "P * Q = 1\<^sub>m n" and QP: "Q * P = 1\<^sub>m n"
     and AB: "A = P * B * Q"
     by auto
   from A B have *: "(A ^\<^sub>m k) \<in> carrier_mat n n" "B ^\<^sub>m k \<in> carrier_mat n n" by auto
   note carr = A B P Q
   have id: "A ^\<^sub>m k = P * B ^\<^sub>m k * Q" unfolding AB
   proof (induct k)
     case 0
     thus ?case using carr by (simp add: PQ)
   next
     case (Suc k)
     define Bk where "Bk = B ^\<^sub>m k"
     have Bk: "Bk \<in> carrier_mat n n" unfolding Bk_def using carr by simp
     have "(P * B * Q) ^\<^sub>m Suc k = (P * Bk * Q) * (P * B * Q)" by (simp add: Suc Bk_def)
     also have "\<dots> = P * (Bk * (Q * P) * B) * Q"
       using carr Bk by (simp add: assoc_mult_mat[of _ n n _ n _ n])
     also have "Bk * (Q * P) = Bk" unfolding QP using Bk by simp
     finally show ?case unfolding Bk_def by simp
   qed
   show ?thesis
     by (rule similar_mat_witI[OF PQ QP id * P Q])
 qed
 
 lemma similar_mat_wit_pow_id: "similar_mat_wit A B P Q \<Longrightarrow> A ^\<^sub>m k = P * B ^\<^sub>m k * Q"
   using similar_mat_wit_pow[of A B P Q k] unfolding similar_mat_wit_def Let_def by blast
 
 subsection\<open>Homomorphism properties\<close>
 
 context semiring_hom
 begin
 abbreviation mat_hom :: "'a mat \<Rightarrow> 'b mat" ("mat\<^sub>h")
   where "mat\<^sub>h \<equiv> map_mat hom"
 
 abbreviation vec_hom :: "'a vec \<Rightarrow> 'b vec" ("vec\<^sub>h")
   where "vec\<^sub>h \<equiv> map_vec hom"
 
 lemma vec_hom_zero: "vec\<^sub>h (0\<^sub>v n) = 0\<^sub>v n"
   by (rule eq_vecI, auto)
 
 lemma mat_hom_one: "mat\<^sub>h (1\<^sub>m n) = 1\<^sub>m n"
   by (rule eq_matI, auto)
 
 lemma mat_hom_mult: assumes A: "A \<in> carrier_mat nr n" and B: "B \<in> carrier_mat n nc"
   shows "mat\<^sub>h (A * B) = mat\<^sub>h A * mat\<^sub>h B"
 proof -
   let ?L = "mat\<^sub>h (A * B)"
   let ?R = "mat\<^sub>h A * mat\<^sub>h B"
   let ?A = "mat\<^sub>h A"
   let ?B = "mat\<^sub>h B"
   from A B have id:
     "dim_row ?L = nr" "dim_row ?R = nr"
     "dim_col ?L = nc" "dim_col ?R = nc"  by auto
   show ?thesis
   proof (rule eq_matI, unfold id)
     fix i j
     assume *: "i < nr" "j < nc"
     define I where "I = {0 ..< n}"
     have id: "{0 ..< dim_vec (col ?B j)} = I" "{0 ..< dim_vec (col B j)} = I"
       unfolding I_def using * B by auto
     have finite: "finite I" unfolding I_def by auto
     have I: "I \<subseteq> {0 ..< n}" unfolding I_def by auto
     have "?L $$ (i,j) = hom (row A i \<bullet> col B j)" using A B * by auto
     also have "\<dots> = row ?A i \<bullet> col ?B j" unfolding scalar_prod_def id using finite I
     proof (induct I)
       case (insert k I)
       show ?case unfolding sum.insert[OF insert(1-2)] hom_add hom_mult
         using insert(3-) * A B by auto
     qed simp
     also have "\<dots> = ?R $$ (i,j)" using A B * by auto
     finally
     show "?L $$ (i, j) = ?R $$ (i, j)" .
   qed auto
 qed
 
 lemma mult_mat_vec_hom: assumes A: "A \<in> carrier_mat nr n" and v: "v \<in> carrier_vec n"
   shows "vec\<^sub>h (A *\<^sub>v v) = mat\<^sub>h A *\<^sub>v vec\<^sub>h v"
 proof -
   let ?L = "vec\<^sub>h (A *\<^sub>v v)"
   let ?R = "mat\<^sub>h A *\<^sub>v vec\<^sub>h v"
   let ?A = "mat\<^sub>h A"
   let ?v = "vec\<^sub>h v"
   from A v have id:
     "dim_vec ?L = nr" "dim_vec ?R = nr"
     by auto
   show ?thesis
   proof (rule eq_vecI, unfold id)
     fix i
     assume *: "i < nr"
     define I where "I = {0 ..< n}"
     have id: "{0 ..< dim_vec v} = I" "{0 ..< dim_vec (vec\<^sub>h v)} = I"
       unfolding I_def using * v  by auto
     have finite: "finite I" unfolding I_def by auto
     have I: "I \<subseteq> {0 ..< n}" unfolding I_def by auto
     have "?L $ i = hom (row A i \<bullet> v)" using A v * by auto
     also have "\<dots> = row ?A i \<bullet> ?v" unfolding scalar_prod_def id using finite I
     proof (induct I)
       case (insert k I)
       show ?case unfolding sum.insert[OF insert(1-2)] hom_add hom_mult
         using insert(3-) * A v by auto
     qed simp
     also have "\<dots> = ?R $ i" using A v * by auto
     finally
     show "?L $ i = ?R $ i" .
   qed auto
 qed
 end
 
 lemma vec_eq_iff: "(x = y) = (dim_vec x = dim_vec y \<and> (\<forall> i < dim_vec y. x $ i = y $ i))" (is "?l = ?r")
 proof
   assume ?r
   show ?l
     by (rule eq_vecI, insert \<open>?r\<close>, auto)
 qed simp
 
 lemma mat_eq_iff: "(x = y) = (dim_row x = dim_row y \<and> dim_col x = dim_col y \<and>
   (\<forall> i j. i < dim_row y \<longrightarrow> j < dim_col y \<longrightarrow> x $$ (i,j) = y $$ (i,j)))" (is "?l = ?r")
 proof
   assume ?r
   show ?l
     by (rule eq_matI, insert \<open>?r\<close>, auto)
 qed simp
 
 lemma (in inj_semiring_hom) vec_hom_zero_iff[simp]: "(vec\<^sub>h x = 0\<^sub>v n) = (x = 0\<^sub>v n)"
 proof -
   {
     fix i
     assume i: "i < n" "dim_vec x = n"
     hence "vec\<^sub>h x $ i = 0 \<longleftrightarrow> x $ i = 0"
       using index_map_vec(1)[of i x] by simp
   } note main = this
   show ?thesis unfolding vec_eq_iff by (simp, insert main, auto)
 qed
 
 lemma (in inj_semiring_hom) mat_hom_inj: "mat\<^sub>h A = mat\<^sub>h B \<Longrightarrow> A = B"
   unfolding mat_eq_iff by auto
 
 lemma (in inj_semiring_hom) vec_hom_inj: "vec\<^sub>h v = vec\<^sub>h w \<Longrightarrow> v = w"
   unfolding vec_eq_iff by auto
 
 lemma (in semiring_hom) mat_hom_pow: assumes A: "A \<in> carrier_mat n n"
   shows "mat\<^sub>h (A ^\<^sub>m k) = (mat\<^sub>h A) ^\<^sub>m k"
 proof (induct k)
   case (Suc k)
   thus ?case using mat_hom_mult[OF pow_carrier_mat[OF A, of k] A] by simp
 qed (simp add: mat_hom_one)
 
 lemma (in semiring_hom) hom_sum_mat: "hom (sum_mat A) = sum_mat (mat\<^sub>h A)"
 proof -
   obtain B where id: "?thesis = (hom (sum (($$) A) B) = sum (($$) (mat\<^sub>h A)) B)"
     and B: "B \<subseteq> {0..<dim_row A} \<times> {0..<dim_col A}"
   unfolding sum_mat_def by auto
   from B have "finite B"
     using finite_subset by blast
   thus ?thesis unfolding id using B
   proof (induct B)
     case (insert x F)
     show ?case unfolding sum.insert[OF insert(1-2)] hom_add
       using insert(3-) by auto
   qed simp
 qed
 
 lemma (in semiring_hom) vec_hom_smult: "vec\<^sub>h (ev \<cdot>\<^sub>v v) = hom ev \<cdot>\<^sub>v vec\<^sub>h v"
   by (rule eq_vecI, auto simp: hom_distribs)
 
 lemma minus_scalar_prod_distrib: fixes v\<^sub>1 :: "'a :: ring vec"
   assumes v: "v\<^sub>1 \<in> carrier_vec n" "v\<^sub>2 \<in> carrier_vec n" "v\<^sub>3 \<in> carrier_vec n"
   shows "(v\<^sub>1 - v\<^sub>2) \<bullet> v\<^sub>3 = v\<^sub>1 \<bullet> v\<^sub>3 - v\<^sub>2 \<bullet> v\<^sub>3"
   unfolding minus_add_uminus_vec[OF v(1-2)]
   by (subst add_scalar_prod_distrib[OF v(1)], insert v, auto)
 
 lemma scalar_prod_minus_distrib: fixes v\<^sub>1 :: "'a :: ring vec"
   assumes v: "v\<^sub>1 \<in> carrier_vec n" "v\<^sub>2 \<in> carrier_vec n" "v\<^sub>3 \<in> carrier_vec n"
   shows "v\<^sub>1 \<bullet> (v\<^sub>2 - v\<^sub>3) = v\<^sub>1 \<bullet> v\<^sub>2 - v\<^sub>1 \<bullet> v\<^sub>3"
   unfolding minus_add_uminus_vec[OF v(2-3)]
   by (subst scalar_prod_add_distrib[OF v(1)], insert v, auto)
 
 lemma uminus_add_minus_vec:
   assumes "l \<in> carrier_vec n" "r \<in> carrier_vec n"
   shows "- ((l::'a :: ab_group_add vec) + r) = (- l - r)"
   using assms by auto
 
 lemma minus_add_minus_vec: fixes u :: "'a :: ab_group_add vec"
   assumes "u \<in> carrier_vec n" "v \<in> carrier_vec n" "w \<in> carrier_vec n"
   shows "u - (v + w) = u - v - w"
   using assms by auto
 
 lemma uminus_add_minus_mat:
   assumes "l \<in> carrier_mat nr nc" "r \<in> carrier_mat nr nc"
   shows "- ((l::'a :: ab_group_add mat) + r) = (- l - r)"
   using assms by auto
 
 lemma minus_add_minus_mat: fixes u :: "'a :: ab_group_add mat"
   assumes "u \<in> carrier_mat nr nc" "v \<in> carrier_mat nr nc" "w \<in> carrier_mat nr nc"
   shows "u - (v + w) = u - v - w"
   using assms by auto
 
 lemma uminus_uminus_vec[simp]: "- (- (v::'a:: group_add vec)) = v"
   by auto
 
 lemma uminus_eq_vec[simp]: "- (v::'a:: group_add vec) = - w \<longleftrightarrow> v = w"
   by (metis uminus_uminus_vec)
 
 lemma uminus_uminus_mat[simp]: "- (- (A::'a:: group_add mat)) = A"
   by auto
 
 lemma uminus_eq_mat[simp]: "- (A::'a:: group_add mat) = - B \<longleftrightarrow> A = B"
   by (metis uminus_uminus_mat)
 
 lemma smult_zero_mat[simp]: "(k :: 'a :: mult_zero) \<cdot>\<^sub>m 0\<^sub>m nr nc = 0\<^sub>m nr nc"
   by (intro eq_matI, auto)
 
 lemma similar_mat_wit_smult: fixes A :: "'a :: comm_ring_1 mat"
   assumes "similar_mat_wit A B P Q"
   shows "similar_mat_wit (k \<cdot>\<^sub>m A) (k \<cdot>\<^sub>m B) P Q"
 proof -
   define n where "n = dim_row A"
   note main = similar_mat_witD[OF n_def assms]
   show ?thesis
     by (rule similar_mat_witI[OF main(1-2) _ _ _ main(6-7)], insert main(3-), auto
       simp: mult_smult_distrib mult_smult_assoc_mat[of _ n n _ n])
 qed
 
 lemma similar_mat_smult: fixes A :: "'a :: comm_ring_1 mat"
   assumes "similar_mat A B"
   shows "similar_mat (k \<cdot>\<^sub>m A) (k \<cdot>\<^sub>m B)"
   using similar_mat_wit_smult assms unfolding similar_mat_def by blast
 
 definition mat_diag :: "nat \<Rightarrow> (nat \<Rightarrow> 'a :: zero) \<Rightarrow> 'a mat" where
   "mat_diag n f = Matrix.mat n n (\<lambda> (i,j). if i = j then f j else 0)"
 
 lemma mat_diag_dim[simp]: "mat_diag n f \<in> carrier_mat n n"
   unfolding mat_diag_def by auto
 
 lemma mat_diag_mult_left: assumes A: "A \<in> carrier_mat n nr"
   shows "mat_diag n f * A = Matrix.mat n nr (\<lambda> (i,j). f i * A $$ (i,j))"
 proof (rule eq_matI, insert A, auto simp: mat_diag_def scalar_prod_def, goal_cases)
   case (1 i j)
   thus ?case by (subst sum.remove[of _ i], auto)
 qed
 
 lemma mat_diag_mult_right: assumes A: "A \<in> carrier_mat nr n"
   shows "A * mat_diag n f = Matrix.mat nr n (\<lambda> (i,j). A $$ (i,j) * f j)"
 proof (rule eq_matI, insert A, auto simp: mat_diag_def scalar_prod_def, goal_cases)
   case (1 i j)
   thus ?case by (subst sum.remove[of _ j], auto)
 qed
 
 lemma mat_diag_diag[simp]: "mat_diag n f * mat_diag n g = mat_diag n (\<lambda> i. f i * g i)"
   by (subst mat_diag_mult_left[of _ n n], auto simp: mat_diag_def)
 
 lemma mat_diag_one[simp]: "mat_diag n (\<lambda> x. 1) = 1\<^sub>m n" unfolding mat_diag_def by auto
 
 text \<open>Interpret vector as row-matrix\<close>
 
 definition "mat_of_row y = mat 1 (dim_vec y) (\<lambda> ij. y $ (snd ij))" 
 
 lemma mat_of_row_carrier[simp,intro]: 
   "y \<in> carrier_vec n \<Longrightarrow> mat_of_row y \<in> carrier_mat 1 n"
   "y \<in> carrier_vec n \<Longrightarrow> mat_of_row y \<in> carrier_mat (Suc 0) n"
   unfolding mat_of_row_def by auto
 
 lemma mat_of_row_dim[simp]: "dim_row (mat_of_row y) = 1" 
   "dim_col (mat_of_row y) = dim_vec y" 
   unfolding mat_of_row_def by auto
 
 lemma mat_of_row_index[simp]: "x < dim_vec y \<Longrightarrow> mat_of_row y $$ (0,x) = y $ x" 
   unfolding mat_of_row_def by auto
 
 lemma row_mat_of_row[simp]: "row (mat_of_row y) 0 = y" 
   by auto
 
 lemma mat_of_row_mult_append_rows: assumes y1: "y1 \<in> carrier_vec nr1" 
   and y2: "y2 \<in> carrier_vec nr2" 
   and A1: "A1 \<in> carrier_mat nr1 nc" 
   and A2: "A2 \<in> carrier_mat nr2 nc" 
 shows "mat_of_row (y1 @\<^sub>v y2) * (A1 @\<^sub>r A2) = 
   mat_of_row y1 * A1 + mat_of_row y2 * A2" 
 proof -
   from A1 A2 have dim: "dim_row A1 = nr1" "dim_row A2 = nr2" by auto
   let ?M1 = "mat_of_row y1" 
   have M1: "?M1 \<in> carrier_mat 1 nr1" using y1 by auto
   let ?M2 = "mat_of_row y2" 
   have M2: "?M2 \<in> carrier_mat 1 nr2" using y2 by auto
   let ?M3 = "0\<^sub>m 0 nr1" 
   let ?M4 = "0\<^sub>m 0 nr2" 
   note z = zero_carrier_mat
   have id: "mat_of_row (y1 @\<^sub>v y2) = four_block_mat 
     ?M1 ?M2 ?M3 ?M4" using y1 y2 
     by (intro eq_matI, auto simp: mat_of_rows_def)
   show ?thesis
     unfolding id append_rows_def dim
     by (subst mult_four_block_mat[OF M1 M2 z z A1 z A2 z], insert A1 A2, auto)
 qed
 
 
 text \<open>Allowing to construct and deconstruct vectors like lists\<close>
 abbreviation vNil where "vNil \<equiv> vec 0 ((!) [])"
 definition vCons where "vCons a v \<equiv> vec (Suc (dim_vec v)) (\<lambda>i. case i of 0 \<Rightarrow> a | Suc i \<Rightarrow> v $ i)"
 
 lemma vec_index_vCons_0 [simp]: "vCons a v $ 0 = a"
   by (simp add: vCons_def)
 
 lemma vec_index_vCons_Suc [simp]:
   fixes v :: "'a vec"
   shows "vCons a v $ Suc n = v $ n"
 proof-
   have 1: "vec (Suc d) f $ Suc n = vec d (f \<circ> Suc) $ n" for d and f :: "nat \<Rightarrow> 'a"
     by (transfer, auto simp: mk_vec_def)
   show ?thesis
     apply (auto simp: 1 vCons_def o_def) apply transfer apply (auto simp: mk_vec_def)
     done
 qed
 
 lemma vec_index_vCons: "vCons a v $ n = (if n = 0 then a else v $ (n - 1))"
   by (cases n, auto)
 
 lemma dim_vec_vCons [simp]: "dim_vec (vCons a v) = Suc (dim_vec v)"
   by (simp add: vCons_def)
 
 lemma vCons_carrier_vec[simp]: "vCons a v \<in> carrier_vec (Suc n) \<longleftrightarrow> v \<in> carrier_vec n"
   by (auto dest!: carrier_vecD intro: carrier_vecI)
 
 lemma vec_Suc: "vec (Suc n) f = vCons (f 0) (vec n (f \<circ> Suc))" (is "?l = ?r")
 proof (unfold vec_eq_iff, intro conjI allI impI)
   fix i assume "i < dim_vec ?r"
   then show "?l $ i = ?r $ i" by (cases i, auto)
 qed simp
 
 declare Abs_vec_cases[cases del]
 
 lemma vec_cases [case_names vNil vCons, cases type: vec]:
   assumes "v = vNil \<Longrightarrow> thesis" and "\<And>a w. v = vCons a w \<Longrightarrow> thesis"
   shows "thesis"
 proof (cases "dim_vec v")
   case 0 then show thesis by (intro assms(1), auto)
 next
   case (Suc n)
   show thesis
   proof (rule assms(2))
     show v: "v = vCons (v $ 0) (vec n (\<lambda>i. v $ Suc i))" (is "v = ?r")
     proof (rule eq_vecI, unfold dim_vec_vCons dim_vec Suc)
       fix i
       assume "i < Suc n"
       then show "v $ i = ?r $ i" by (cases i, auto simp: vCons_def)
     qed simp
   qed
 qed
 
 lemma vec_induct [case_names vNil vCons, induct type: vec]:
   assumes "P vNil" and "\<And>a v. P v \<Longrightarrow> P (vCons a v)"
   shows "P v"
 proof (induct "dim_vec v" arbitrary:v)
   case 0 then show ?case by (cases v, auto intro: assms(1))
 next
   case (Suc n) then show ?case by (cases v, auto intro: assms(2))
 qed
 
 lemma carrier_vec_induct [consumes 1, case_names 0 Suc, induct set:carrier_vec]:
   assumes v: "v \<in> carrier_vec n"
     and 1: "P 0 vNil" and 2: "\<And>n a v. v \<in> carrier_vec n \<Longrightarrow> P n v \<Longrightarrow> P (Suc n) (vCons a v)"
   shows "P n v"
 proof (insert v, induct n arbitrary: v)
   case 0 then have "v = vec 0 ((!) [])" by auto
   with 1 show ?case by auto
 next
   case (Suc n) then show ?case by (cases v, auto dest!: carrier_vecD intro:2)
 qed
 
 lemma vec_of_list_Cons[simp]: "vec_of_list (a#as) = vCons a (vec_of_list as)"
   by (unfold vCons_def, transfer, auto simp:mk_vec_def split:nat.split)
 
 lemma vec_of_list_Nil[simp]: "vec_of_list [] = vNil"
   by (transfer', auto)
 
 lemma scalar_prod_vCons[simp]:
   "vCons a v \<bullet> vCons b w = a * b + v \<bullet> w"
   apply (unfold scalar_prod_def atLeast0_lessThan_Suc_eq_insert_0 dim_vec_vCons)
   apply (subst sum.insert) apply (simp,simp)
   apply (subst sum.reindex) apply force
   apply simp
   done
 
 lemma zero_vec_Suc: "0\<^sub>v (Suc n) = vCons 0 (0\<^sub>v n)"
   by (auto simp: zero_vec_def vec_Suc o_def)
 
 lemma zero_vec_zero[simp]: "0\<^sub>v 0 = vNil" by auto
 
 lemma vCons_eq_vCons[simp]: "vCons a v = vCons b w \<longleftrightarrow> a = b \<and> v = w" (is "?l \<longleftrightarrow> ?r")
 proof
   assume ?l
   note arg_cong[OF this]
   from this[of dim_vec] this[of "\<lambda>x. x$0"] this[of "\<lambda>x. x$Suc _"]
   show ?r by (auto simp: vec_eq_iff)
 qed simp
 
 lemma vec_carrier_vec[simp]: "vec n f \<in> carrier_vec m \<longleftrightarrow> n = m"
   unfolding carrier_vec_def by auto
 
 notation transpose_mat ("(_\<^sup>T)" [1000])
 
 lemma map_mat_transpose: "(map_mat f A)\<^sup>T = map_mat f A\<^sup>T" by auto
 
 lemma cols_transpose[simp]: "cols A\<^sup>T = rows A" unfolding cols_def rows_def by auto
 lemma rows_transpose[simp]: "rows A\<^sup>T = cols A" unfolding cols_def rows_def by auto
 lemma list_of_vec_vec [simp]: "list_of_vec (vec n f) = map f [0..<n]"
   by (transfer, auto simp: mk_vec_def)
 
 lemma list_of_vec_0 [simp]: "list_of_vec (0\<^sub>v n) = replicate n 0"
   by (simp add: zero_vec_def map_replicate_trivial)
 
 lemma diag_mat_map:
   assumes M_carrier: "M \<in> carrier_mat n n"
   shows "diag_mat (map_mat f M) = map f (diag_mat M)"
 proof -
   have dim_eq: "dim_row M = dim_col M" using M_carrier by auto
   have m: "map_mat f M $$ (i, i) = f (M $$ (i, i))" if i: "i < dim_row M" for i
     using dim_eq i by auto
   show ?thesis
     by (rule nth_equalityI, insert m, auto simp add: diag_mat_def M_carrier)
 qed
 
 lemma mat_of_rows_map [simp]:
   assumes x: "set vs \<subseteq> carrier_vec n"
   shows "mat_of_rows n (map (map_vec f) vs) = map_mat f (mat_of_rows n vs)"
 proof-
   have "\<forall>x\<in>set vs. dim_vec x = n" using x by auto
   then show ?thesis by (auto simp add: mat_eq_iff map_vec_def mat_of_rows_def)
 qed
 
 lemma mat_of_cols_map [simp]:
   assumes x: "set vs \<subseteq> carrier_vec n"
   shows "mat_of_cols n (map (map_vec f) vs) = map_mat f (mat_of_cols n vs)"
 proof-
   have "\<forall>x\<in>set vs. dim_vec x = n" using x by auto
   then show ?thesis by (auto simp add: mat_eq_iff map_vec_def mat_of_cols_def)
 qed
 
 lemma vec_of_list_map [simp]: "vec_of_list (map f xs) = map_vec f (vec_of_list xs)"
   unfolding map_vec_def by (transfer, auto simp add: mk_vec_def)
 
 lemma map_vec: "map_vec f (vec n g) = vec n (f o g)" by auto
 
 lemma mat_of_cols_Cons_index_0: "i < n \<Longrightarrow> mat_of_cols n (w # ws) $$ (i, 0) = w $ i"
   by (unfold mat_of_cols_def, transfer', auto simp: mk_mat_def)
 
 lemma nth_map_out_of_bound: "i \<ge> length xs \<Longrightarrow> map f xs ! i = [] ! (i - length xs)"
   by (induct xs arbitrary:i, auto)
 
 lemma mat_of_cols_Cons_index_Suc:
   "i < n \<Longrightarrow> mat_of_cols n (w # ws) $$ (i, Suc j) = mat_of_cols n ws $$ (i,j)"
   by (unfold mat_of_cols_def, transfer, auto simp: mk_mat_def undef_mat_def nth_append nth_map_out_of_bound)
 
 lemma mat_of_cols_index: "i < n \<Longrightarrow> j < length ws \<Longrightarrow> mat_of_cols n ws $$ (i,j) = ws ! j $ i"
   by (unfold mat_of_cols_def, auto)
 
 lemma mat_of_rows_index: "i < length rs \<Longrightarrow> j < n \<Longrightarrow> mat_of_rows n rs $$ (i,j) = rs ! i $ j"
   by (unfold mat_of_rows_def, auto)
 
 lemma transpose_mat_of_rows: "(mat_of_rows n vs)\<^sup>T = mat_of_cols n vs"
   by (auto intro!: eq_matI simp: mat_of_rows_index mat_of_cols_index)
 
 lemma transpose_mat_of_cols: "(mat_of_cols n vs)\<^sup>T = mat_of_rows n vs"
   by (auto intro!: eq_matI simp: mat_of_rows_index mat_of_cols_index)
 
 lemma nth_list_of_vec [simp]:
   assumes "i < dim_vec v" shows "list_of_vec v ! i = v $ i"
   using assms by (transfer, auto)
 
 lemma length_list_of_vec [simp]:
   "length (list_of_vec v) = dim_vec v" by (transfer, auto)
 
 lemma vec_eq_0_iff:
   "v = 0\<^sub>v n \<longleftrightarrow> n = dim_vec v \<and> (n = 0 \<or> set (list_of_vec v) = {0})" (is "?l \<longleftrightarrow> ?r")
 proof
   show "?l \<Longrightarrow> ?r" by auto
   show "?r \<Longrightarrow> ?l" by (intro iffI eq_vecI, force simp: set_conv_nth, force)
 qed
 
 lemma list_of_vec_vCons[simp]: "list_of_vec (vCons a v) = a # list_of_vec v" (is "?l = ?r")
 proof (intro nth_equalityI)
   fix i
   assume "i < length ?l"
   then show "?l ! i = ?r ! i" by (cases i, auto)
 qed simp
 
 lemma append_vec_vCons[simp]: "vCons a v @\<^sub>v w = vCons a (v @\<^sub>v w)" (is "?l = ?r")
 proof (unfold vec_eq_iff, intro conjI allI impI)
   fix i assume "i < dim_vec ?r"
   then show "?l $ i = ?r $ i" by (cases i; subst index_append_vec, auto)
 qed simp
 
 lemma append_vec_vNil[simp]: "vNil @\<^sub>v v = v"
   by (unfold vec_eq_iff, auto)
 
 lemma list_of_vec_append[simp]: "list_of_vec (v @\<^sub>v w) = list_of_vec v @ list_of_vec w"
   by (induct v, auto)
 
 lemma transpose_mat_eq[simp]: "A\<^sup>T = B\<^sup>T \<longleftrightarrow> A = B"
   using transpose_transpose by metis
 
 lemma mat_col_eqI: assumes cols: "\<And> i. i < dim_col B \<Longrightarrow> col A i = col B i"
   and dims: "dim_row A = dim_row B" "dim_col A = dim_col B"
 shows "A = B"
   by(subst transpose_mat_eq[symmetric], rule eq_rowI,insert assms,auto)
 
 lemma upper_triangular_imp_distinct:
   assumes A: "A \<in> carrier_mat n n"
     and tri: "upper_triangular A"
     and diag: "0 \<notin> set (diag_mat A)"
   shows "distinct (rows A)"
 proof-
   { fix i and j
     assume eq: "rows A ! i = rows A ! j" and ij: "i < j" and jn: "j < n"
     from tri A ij jn have "rows A ! j $ i = 0" by (auto dest!:upper_triangularD)
     with eq have "rows A ! i $ i = 0" by auto
     with diag ij jn A have False by (auto simp: diag_mat_def)
   }
   with A show ?thesis by (force simp: distinct_conv_nth nat_neq_iff)
 qed
 
 lemma dim_vec_of_list[simp] :"dim_vec (vec_of_list as) = length as" by transfer auto
 
 lemma list_vec: "list_of_vec (vec_of_list xs) = xs"
 by (transfer, metis (mono_tags, lifting) atLeastLessThan_iff map_eq_conv map_nth mk_vec_def old.prod.case set_upt)
 
 lemma vec_list: "vec_of_list (list_of_vec v) = v"
 apply transfer unfolding mk_vec_def by auto
 
 lemma index_vec_of_list: "i<length xs \<Longrightarrow> (vec_of_list xs) $ i = xs ! i"
 by (metis vec.abs_eq index_vec vec_of_list.abs_eq)
 
 lemma vec_of_list_index: "vec_of_list xs $ j = xs ! j"
   apply transfer unfolding mk_vec_def unfolding undef_vec_def
   by (simp, metis append_Nil2 nth_append)
 
 lemma list_of_vec_index: "list_of_vec v ! j = v $ j"
   by (metis vec_list vec_of_list_index)
 
 lemma list_of_vec_map: "list_of_vec xs = map (($) xs) [0..<dim_vec xs]" by transfer auto
 
 definition "component_mult v w = vec (min (dim_vec v) (dim_vec w)) (\<lambda>i. v $ i * w $ i)"
 definition vec_set::"'a vec \<Rightarrow> 'a set" ("set\<^sub>v")
   where "vec_set v = vec_index v ` {..<dim_vec v}"
 
 lemma index_component_mult:
 assumes "i < dim_vec v" "i < dim_vec w"
 shows "component_mult v w $ i = v $ i * w $ i"
   unfolding component_mult_def using assms index_vec by auto
 
 lemma dim_component_mult:
 "dim_vec (component_mult v w) = min (dim_vec v) (dim_vec w)"
   unfolding component_mult_def using index_vec by auto
 
 lemma vec_setE:
 assumes "a \<in> set\<^sub>v v"
 obtains i where "v$i = a" "i<dim_vec v" using assms unfolding vec_set_def by blast
 
 lemma vec_setI:
 assumes "v$i = a" "i<dim_vec v"
 shows "a \<in> set\<^sub>v v" using assms unfolding vec_set_def using image_eqI lessThan_iff by blast
 
 lemma set_list_of_vec: "set (list_of_vec v) = set\<^sub>v v" unfolding vec_set_def by transfer auto
 
 
 instantiation vec :: (conjugate) conjugate
 begin
 
 definition conjugate_vec :: "'a :: conjugate vec \<Rightarrow> 'a vec"
   where "conjugate v = vec (dim_vec v) (\<lambda>i. conjugate (v $ i))"
 
 lemma conjugate_vCons [simp]:
   "conjugate (vCons a v) = vCons (conjugate a) (conjugate v)"
   by (auto simp: vec_Suc conjugate_vec_def)
 
 lemma dim_vec_conjugate[simp]: "dim_vec (conjugate v) = dim_vec v"
   unfolding conjugate_vec_def by auto
 
 lemma carrier_vec_conjugate[simp]: "v \<in> carrier_vec n \<Longrightarrow> conjugate v \<in> carrier_vec n"
   by (auto intro!: carrier_vecI)
 
 lemma vec_index_conjugate[simp]:
   shows "i < dim_vec v \<Longrightarrow> conjugate v $ i = conjugate (v $ i)"
   unfolding conjugate_vec_def by auto
 
 instance
 proof
   fix v w :: "'a vec"
   show "conjugate (conjugate v) = v" by (induct v, auto simp: conjugate_vec_def)
   let ?v = "conjugate v"
   let ?w = "conjugate w"
   show "conjugate v = conjugate w \<longleftrightarrow> v = w"
   proof(rule iffI)
     assume cvw: "?v = ?w" show "v = w"
     proof(rule)
       have "dim_vec ?v = dim_vec ?w" using cvw by auto
       then show dim: "dim_vec v = dim_vec w" by simp
       fix i assume i: "i < dim_vec w"
       then have "conjugate v $ i = conjugate w $ i" using cvw by auto
       then have "conjugate (v$i) = conjugate (w $ i)" using i dim by auto
       then show "v $ i = w $ i" by auto
     qed
   qed auto
 qed
 
 end
 
 lemma conjugate_add_vec:
   fixes v w :: "'a :: conjugatable_ring vec"
   assumes dim: "v : carrier_vec n" "w : carrier_vec n"
   shows "conjugate (v + w) = conjugate v + conjugate w"
   by (rule, insert dim, auto simp: conjugate_dist_add)
 
 lemma uminus_conjugate_vec:
   fixes v w :: "'a :: conjugatable_ring vec"
   shows "- (conjugate v) = conjugate (- v)"
   by (rule, auto simp:conjugate_neg)
 
 lemma conjugate_zero_vec[simp]:
   "conjugate (0\<^sub>v n :: 'a :: conjugatable_ring vec) = 0\<^sub>v n" by auto
 
 lemma conjugate_vec_0[simp]:
   "conjugate (vec 0 f) = vec 0 f" by auto
 
 lemma sprod_vec_0[simp]: "v \<bullet> vec 0 f = 0"
   by(auto simp: scalar_prod_def)
 
 lemma conjugate_zero_iff_vec[simp]:
   fixes v :: "'a :: conjugatable_ring vec"
   shows "conjugate v = 0\<^sub>v n \<longleftrightarrow> v = 0\<^sub>v n"
   using conjugate_cancel_iff[of _ "0\<^sub>v n :: 'a vec"] by auto
 
 lemma conjugate_smult_vec:
   fixes k :: "'a :: conjugatable_ring"
   shows "conjugate (k \<cdot>\<^sub>v v) = conjugate k \<cdot>\<^sub>v conjugate v"
   using conjugate_dist_mul by (intro eq_vecI, auto)
 
 lemma conjugate_sprod_vec:
   fixes v w :: "'a :: conjugatable_ring vec"
   assumes v: "v : carrier_vec n" and w: "w : carrier_vec n"
   shows "conjugate (v \<bullet> w) = conjugate v \<bullet> conjugate w"
 proof (insert w v, induct w arbitrary: v rule:carrier_vec_induct)
   case 0 then show ?case by (cases v, auto)
 next
   case (Suc n b w) then show ?case
     by (cases v, auto dest: carrier_vecD simp:conjugate_dist_add conjugate_dist_mul)
 qed 
 
 abbreviation cscalar_prod :: "'a vec \<Rightarrow> 'a vec \<Rightarrow> 'a :: conjugatable_ring" (infix "\<bullet>c" 70)
   where "(\<bullet>c) \<equiv> \<lambda>v w. v \<bullet> conjugate w"
 
 lemma conjugate_conjugate_sprod[simp]:
   assumes v[simp]: "v : carrier_vec n" and w[simp]: "w : carrier_vec n"
   shows "conjugate (conjugate v \<bullet> w) = v \<bullet>c w"
   apply (subst conjugate_sprod_vec[of _ n]) by auto
 
 lemma conjugate_vec_sprod_comm:
   fixes v w :: "'a :: {conjugatable_ring, comm_ring} vec"
   assumes "v : carrier_vec n" and "w : carrier_vec n"
   shows "v \<bullet>c w = (conjugate w \<bullet> v)"
   unfolding scalar_prod_def using assms by(subst sum.ivl_cong, auto simp: ac_simps)
 
 lemma conjugate_square_ge_0_vec[intro!]:
   fixes v :: "'a :: conjugatable_ordered_ring vec"
   shows "v \<bullet>c v \<ge> 0"
 proof (induct v)
   case vNil
   then show ?case by auto
 next
   case (vCons a v)
   then show ?case using conjugate_square_positive[of a] by auto
 qed
 
 lemma conjugate_square_eq_0_vec[simp]:
   fixes v :: "'a :: {conjugatable_ordered_ring,semiring_no_zero_divisors} vec"
   assumes "v \<in> carrier_vec n"
   shows "v \<bullet>c v = 0 \<longleftrightarrow> v = 0\<^sub>v n"
 proof (insert assms, induct rule: carrier_vec_induct)
   case 0
   then show ?case by auto
 next
   case (Suc n a v)
   then show ?case
     using conjugate_square_positive[of a] conjugate_square_ge_0_vec[of v]
     by (auto simp: le_less add_nonneg_eq_0_iff zero_vec_Suc)
 qed
 
 lemma conjugate_square_greater_0_vec[simp]:
   fixes v :: "'a :: {conjugatable_ordered_ring,semiring_no_zero_divisors} vec"
   assumes "v \<in> carrier_vec n"
   shows "v \<bullet>c v > 0 \<longleftrightarrow> v \<noteq> 0\<^sub>v n"
   using assms by (auto simp: less_le)
 
 lemma vec_conjugate_rat[simp]: "(conjugate :: rat vec \<Rightarrow> rat vec) = (\<lambda>x. x)" by force
 lemma vec_conjugate_real[simp]: "(conjugate :: real vec \<Rightarrow> real vec) = (\<lambda>x. x)" by force
 
 
 end
diff --git a/thys/Jordan_Normal_Form/Missing_Permutations.thy b/thys/Jordan_Normal_Form/Missing_Misc.thy
rename from thys/Jordan_Normal_Form/Missing_Permutations.thy
rename to thys/Jordan_Normal_Form/Missing_Misc.thy
--- a/thys/Jordan_Normal_Form/Missing_Permutations.thy
+++ b/thys/Jordan_Normal_Form/Missing_Misc.thy
@@ -1,463 +1,296 @@
 (*  
     Author:      René Thiemann 
                  Akihisa Yamada
     License:     BSD
 *)
-section \<open>Missing Permutations\<close>
+section \<open>Material missing in the distribution\<close>
 
-text \<open>This theory provides some definitions and lemmas on permutations which we did not find in the 
+text \<open>This theory provides some definitions and lemmas which we did not find in the 
   Isabelle distribution.\<close>
 
-theory Missing_Permutations
-imports
-  Missing_Ring
-  "HOL-Combinatorics.Permutations"
+theory Missing_Misc
+  imports
+    "HOL-Library.FuncSet"
+    "HOL-Combinatorics.Permutations"
 begin
 
-definition signof :: "(nat \<Rightarrow> nat) \<Rightarrow> 'a :: ring_1" where
-  "signof p = (if sign p = 1 then 1 else - 1)"
-
-lemma signof_id[simp]: "signof id = 1" "signof (\<lambda> x. x) = 1"
-  unfolding signof_def sign_id id_def[symmetric] by auto
-
-lemma signof_inv: "finite S \<Longrightarrow> p permutes S \<Longrightarrow> signof (Hilbert_Choice.inv p) = signof p"
-  unfolding signof_def using sign_inverse permutation_permutes by metis
-
-lemma signof_pm_one: "signof p \<in> {1, - 1}"
-  unfolding signof_def by auto
-
-lemma signof_compose: assumes "p permutes {0..<(n :: nat)}"
-  and "q permutes {0 ..<(m :: nat)}"
-  shows "signof (p o q) = signof p * signof q"
-proof -
-  from assms have pp: "permutation p" "permutation q"
-    by (auto simp: permutation_permutes)
-  show "signof (p o q) = signof p * signof q"
-    unfolding signof_def sign_compose[OF pp] 
-    by (auto simp: sign_def split: if_splits)
-qed
-
-lemma permutes_funcset: "p permutes A \<Longrightarrow> (p ` A \<rightarrow> B) = (A \<rightarrow> B)"
-  by (simp add: permutes_image)
-
-context comm_monoid
-begin
-lemma finprod_permute:
-  assumes p: "p permutes S"
-  and f: "f \<in> S \<rightarrow> carrier G"
-  shows "finprod G f S = finprod G (f \<circ> p) S"
-proof -
-  from \<open>p permutes S\<close> have "inj p"
-    by (rule permutes_inj)
-  then have "inj_on p S"
-    by (auto intro: subset_inj_on)
-  from finprod_reindex[OF _ this, unfolded permutes_image[OF p], OF f]
-  show ?thesis unfolding o_def .
-qed
-
-lemma finprod_singleton_set[simp]: assumes "f a \<in> carrier G"
-  shows "finprod G f {a} = f a"
-proof -
-  have "finprod G f {a} = f a \<otimes> finprod G f {}"
-    by (rule finprod_insert, insert assms, auto)
-  also have "\<dots> = f a" using assms by auto
-  finally show ?thesis .
-qed
-end
-
-lemmas (in semiring) finsum_permute = add.finprod_permute
-lemmas (in semiring) finsum_singleton_set = add.finprod_singleton_set
+declare finite_image_iff [simp]
 
-lemma permutes_less[simp]: assumes p: "p permutes {0..<(n :: nat)}"
-  shows "i < n \<Longrightarrow> p i < n" "i < n \<Longrightarrow> Hilbert_Choice.inv p i < n" 
-  "p (Hilbert_Choice.inv p i) = i"
-  "Hilbert_Choice.inv p (p i) = i"
-proof -
-  assume i: "i < n"
-  show "p i < n" using permutes_in_image[OF p] i by auto
-  let ?inv = "Hilbert_Choice.inv p" 
-  have "\<And>n. ?inv (p n) = n"
-      using permutes_inverses[OF p] by simp
-  thus "?inv i < n" 
-      by (metis (no_types) atLeastLessThan_iff f_inv_into_f inv_into_into le0 permutes_image[OF p] i)
-qed (insert permutes_inverses[OF p], auto)
-    
-context cring
-begin
-
-lemma finsum_permutations_inverse: 
-  assumes f: "f \<in> {p. p permutes S} \<rightarrow> carrier R"
-  shows "finsum R f {p. p permutes S} = finsum R (\<lambda>p. f(Hilbert_Choice.inv p)) {p. p permutes S}"
-  (is "?lhs = ?rhs")
-proof -
-  let ?inv = "Hilbert_Choice.inv"
-  let ?S = "{p . p permutes S}"
-  have th0: "inj_on ?inv ?S"
-  proof (auto simp add: inj_on_def)
-    fix q r
-    assume q: "q permutes S"
-      and r: "r permutes S"
-      and qr: "?inv q = ?inv r"
-    then have "?inv (?inv q) = ?inv (?inv r)"
-      by simp
-    with permutes_inv_inv[OF q] permutes_inv_inv[OF r] show "q = r"
-      by metis
-  qed
-  have th1: "?inv ` ?S = ?S"
-    using image_inverse_permutations by blast
-  have th2: "?rhs = finsum R (f \<circ> ?inv) ?S"
-    by (simp add: o_def)
-  from finsum_reindex[OF _ th0, of f] show ?thesis unfolding th1 th2 using f .
-qed
-
-lemma finsum_permutations_compose_right: assumes q: "q permutes S"
-  and *: "f \<in> {p. p permutes S} \<rightarrow> carrier R"
-  shows "finsum R f {p. p permutes S} = finsum R (\<lambda>p. f(p \<circ> q)) {p. p permutes S}"
-  (is "?lhs = ?rhs")
-proof -
-  let ?S = "{p. p permutes S}"
-  let ?inv = "Hilbert_Choice.inv"
-  have th0: "?rhs = finsum R (f \<circ> (\<lambda>p. p \<circ> q)) ?S"
-    by (simp add: o_def)
-  have th1: "inj_on (\<lambda>p. p \<circ> q) ?S"
-  proof (auto simp add: inj_on_def)
-    fix p r
-    assume "p permutes S"
-      and r: "r permutes S"
-      and rp: "p \<circ> q = r \<circ> q"
-    then have "p \<circ> (q \<circ> ?inv q) = r \<circ> (q \<circ> ?inv q)"
-      by (simp add: o_assoc)
-    with permutes_surj[OF q, unfolded surj_iff] show "p = r"
-      by simp
-  qed
-  have th3: "(\<lambda>p. p \<circ> q) ` ?S = ?S"
-    using image_compose_permutations_right[OF q] by auto
-  from finsum_reindex[OF _ th1, of f]
-  show ?thesis unfolding th0 th1 th3 using * .
-qed
-
-end
+lemma inj_on_finite:
+  \<open>finite (f ` A) \<longleftrightarrow> finite A\<close> if \<open>inj_on f A\<close>
+  using that by (fact finite_image_iff)
 
 text \<open>The following lemma is slightly generalized from Determinants.thy in HMA.\<close>
 
 lemma finite_bounded_functions:
   assumes fS: "finite S"
   shows "finite T \<Longrightarrow> finite {f. (\<forall>i \<in> T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = i)}"
 proof (induct T rule: finite_induct)
   case empty
   have th: "{f. \<forall>i. f i = i} = {id}"
     by auto
   show ?case
     by (auto simp add: th)
 next
   case (insert a T)
   let ?f = "\<lambda>(y,g) i. if i = a then y else g i"
   let ?S = "?f ` (S \<times> {f. (\<forall>i\<in>T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = i)})"
   have "?S = {f. (\<forall>i\<in> insert a T. f i \<in> S) \<and> (\<forall>i. i \<notin> insert a T \<longrightarrow> f i = i)}"
     apply (auto simp add: image_iff)
     apply (rule_tac x="x a" in bexI)
     apply (rule_tac x = "\<lambda>i. if i = a then i else x i" in exI)
     apply (insert insert, auto)
     done
   with finite_imageI[OF finite_cartesian_product[OF fS insert.hyps(3)], of ?f]
   show ?case
     by metis
 qed
 
 lemma finite_bounded_functions':
   assumes fS: "finite S"
   shows "finite T \<Longrightarrow> finite {f. (\<forall>i \<in> T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = j)}"
 proof (induct T rule: finite_induct)
   case empty
   have th: "{f. \<forall>i. f i = j} = {(\<lambda> x. j)}"
     by auto
   show ?case
     by (auto simp add: th)
 next
   case (insert a T)
   let ?f = "\<lambda>(y,g) i. if i = a then y else g i"
   let ?S = "?f ` (S \<times> {f. (\<forall>i\<in>T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = j)})"
   have "?S = {f. (\<forall>i\<in> insert a T. f i \<in> S) \<and> (\<forall>i. i \<notin> insert a T \<longrightarrow> f i = j)}"
     apply (auto simp add: image_iff)
     apply (rule_tac x="x a" in bexI)
     apply (rule_tac x = "\<lambda>i. if i = a then j else x i" in exI)
     apply (insert insert, auto)
     done
   with finite_imageI[OF finite_cartesian_product[OF fS insert.hyps(3)], of ?f]
   show ?case
     by metis
 qed
 
+lemma permutes_less [simp]:
+  assumes p: "p permutes {0..<(n :: nat)}"
+  shows
+    "i < n \<Longrightarrow> p i < n"
+    "i < n \<Longrightarrow> inv p i < n" 
+    "p (inv p i) = i"
+    "inv p (p i) = i"
+  using assms
+  by (simp_all add: permutes_inverses permutes_nat_less permutes_nat_inv_less)
+
+lemma permutes_prod:
+  assumes p: "p permutes S"
+  shows "(\<Prod>s\<in>S. f (p s) s) = (\<Prod>s\<in>S. f s (inv p s))"
+    (is "?l = ?r")
+  using assms by (fact prod.permutes_inv)
+
+lemma permutes_sum:
+  assumes p: "p permutes S"
+  shows "(\<Sum>s\<in>S. f (p s) s) = (\<Sum>s\<in>S. f s (inv p s))"
+    (is "?l = ?r")
+  using assms by (fact sum.permutes_inv)
+
 context
   fixes A :: "'a set" 
     and B :: "'b set"
     and a_to_b :: "'a \<Rightarrow> 'b"
     and b_to_a :: "'b \<Rightarrow> 'a"
   assumes ab: "\<And> a. a \<in> A \<Longrightarrow> a_to_b a \<in> B"
     and ba: "\<And> b. b \<in> B \<Longrightarrow> b_to_a b \<in> A"
     and ab_ba: "\<And> a. a \<in> A \<Longrightarrow> b_to_a (a_to_b a) = a"
     and ba_ab: "\<And> b. b \<in> B \<Longrightarrow> a_to_b (b_to_a b) = b"
 begin
 
 qualified lemma permutes_memb: fixes p :: "'b \<Rightarrow> 'b"
   assumes p: "p permutes B"
   and a: "a \<in> A"
   defines "ip \<equiv> Hilbert_Choice.inv p"
   shows "a \<in> A" "a_to_b a \<in> B" "ip (a_to_b a) \<in> B" "p (a_to_b a) \<in> B" 
     "b_to_a (p (a_to_b a)) \<in> A" "b_to_a (ip (a_to_b a)) \<in> A"
 proof -
   let ?b = "a_to_b a"
   from p have ip: "ip permutes B" unfolding ip_def by (rule permutes_inv)
   note in_ip = permutes_in_image[OF ip]
   note in_p = permutes_in_image[OF p]
   show a: "a \<in> A" by fact
   show b: "?b \<in> B" by (rule ab[OF a])
   show pb: "p ?b \<in> B" unfolding in_p by (rule b)
   show ipb: "ip ?b \<in> B" unfolding in_ip by (rule b)
   show "b_to_a (p ?b) \<in> A" by (rule ba[OF pb])
   show "b_to_a (ip ?b) \<in> A" by (rule ba[OF ipb])
 qed
 
 lemma permutes_bij_main: 
   "{p . p permutes A} \<supseteq> (\<lambda> p a. if a \<in> A then b_to_a (p (a_to_b a)) else a) ` {p . p permutes B}" 
   (is "?A \<supseteq> ?f ` ?B")
 proof 
   note d = permutes_def
   let ?g = "\<lambda> q b. if b \<in> B then a_to_b (q (b_to_a b)) else b"
   let ?inv = "Hilbert_Choice.inv"
   fix p
   assume p: "p \<in> ?f ` ?B"
   then obtain q where q: "q permutes B" and p: "p = ?f q" by auto    
   let ?iq = "?inv q"
   from q have iq: "?iq permutes B" by (rule permutes_inv)
   note in_iq = permutes_in_image[OF iq]
   note in_q = permutes_in_image[OF q]
   have qiB: "\<And> b. b \<in> B \<Longrightarrow> q (?iq b) = b" using q by (rule permutes_inverses)
   have iqB: "\<And> b. b \<in> B \<Longrightarrow> ?iq (q b) = b" using q by (rule permutes_inverses)
   from q[unfolded d] 
   have q1: "\<And> b. b \<notin> B \<Longrightarrow> q b = b" 
    and q2: "\<And> b. \<exists>!b'. q b' = b" by auto
   note memb = permutes_memb[OF q]
   show "p \<in> ?A" unfolding p d
   proof (rule, intro conjI impI allI, force)
     fix a
     show "\<exists>!a'. ?f q a' = a"
     proof (cases "a \<in> A")
       case True
       note a = memb[OF True]
       let ?a = "b_to_a (?iq (a_to_b a))"
       show ?thesis
       proof 
         show "?f q ?a = a" using a by (simp add: ba_ab qiB ab_ba)
       next
         fix a'
         assume id: "?f q a' = a"
         show "a' = ?a"
         proof (cases "a' \<in> A")
           case False
           thus ?thesis using id a by auto
         next
           case True
           note a' = memb[OF this]
           from id True have "b_to_a (q (a_to_b a')) = a" by simp
           from arg_cong[OF this, of "a_to_b"] a' a
           have "q (a_to_b a') = a_to_b a" by (simp add: ba_ab)
           from arg_cong[OF this, of ?iq]
           have "a_to_b a' = ?iq (a_to_b a)" unfolding iqB[OF a'(2)] .
           from arg_cong[OF this, of b_to_a] show ?thesis unfolding ab_ba[OF True] .
         qed
       qed
     next
       case False note a = this
       show ?thesis
       proof
         show "?f q a = a" using a by simp
       next
         fix a'
         assume id: "?f q a' = a"
         show "a' = a"
         proof (cases "a' \<in> A")
           case False
           with id show ?thesis by simp
         next
           case True
           note a' = memb[OF True]
           with id False show ?thesis by auto
         qed
       qed
     qed
   qed
 qed
+
 end
 
-lemma  permutes_bij': assumes ab: "\<And> a. a \<in> A \<Longrightarrow> a_to_b a \<in> B"
+lemma permutes_bij': assumes ab: "\<And> a. a \<in> A \<Longrightarrow> a_to_b a \<in> B"
     and ba: "\<And> b. b \<in> B \<Longrightarrow> b_to_a b \<in> A"
     and ab_ba: "\<And> a. a \<in> A \<Longrightarrow> b_to_a (a_to_b a) = a"
     and ba_ab: "\<And> b. b \<in> B \<Longrightarrow> a_to_b (b_to_a b) = b"
   shows "{p . p permutes A} = (\<lambda> p a. if a \<in> A then b_to_a (p (a_to_b a)) else a) ` {p . p permutes B}" 
   (is "?A = ?f ` ?B")
 proof -
   note one_dir = ab ba ab_ba ba_ab
   note other_dir = ba ab ba_ab ab_ba
   let ?g = "(\<lambda> p b. if b \<in> B then a_to_b (p (b_to_a b)) else b)"
   define PA where "PA = ?A"
   define f where "f = ?f"
   define g where "g = ?g"
   {
     fix p
     assume "p \<in> PA"
     hence p: "p permutes A" unfolding PA_def by simp
     from p[unfolded permutes_def] have pnA: "\<And> a. a \<notin> A \<Longrightarrow> p a = a" by auto
     have "?f (?g p) = p"
     proof (rule ext)
       fix a
       show "?f (?g p) a = p a"
       proof (cases "a \<in> A")
         case False
         thus ?thesis by (simp add: pnA)
       next
         case True note a = this
         hence "p a \<in> A" unfolding permutes_in_image[OF p] .
         thus ?thesis using a by (simp add: ab_ba ba_ab ab)
       qed
     qed
     hence "f (g p) = p" unfolding f_def g_def .
   }
   hence "f ` g ` PA = PA" by force
   hence id: "?f ` ?g ` ?A = ?A" unfolding PA_def f_def g_def .
   have "?f ` ?B \<subseteq> ?A" by (rule permutes_bij_main[OF one_dir])
   moreover have "?g ` ?A \<subseteq> ?B" by (rule permutes_bij_main[OF ba ab ba_ab ab_ba])
   hence "?f ` ?g ` ?A \<subseteq> ?f ` ?B" by auto
   hence "?A \<subseteq> ?f ` ?B" unfolding id .
   ultimately show ?thesis by blast
 qed    
 
+lemma permutes_others:
+  assumes p: "p permutes S" and x: "x \<notin> S" shows "p x = x"
+  using p x by (rule permutes_not_in)
+
 lemma inj_on_nat_permutes: assumes i: "inj_on f (S :: nat set)"
   and fS: "f \<in> S \<rightarrow> S"
   and fin: "finite S"
   and f: "\<And> i. i \<notin> S \<Longrightarrow> f i = i"
   shows "f permutes S"
   unfolding permutes_def
 proof (intro conjI allI impI, rule f)
   fix y
   from endo_inj_surj[OF fin _ i] fS have fs: "f ` S = S" by auto
   show "\<exists>!x. f x = y"
   proof (cases "y \<in> S")
     case False
     thus ?thesis by (intro ex1I[of _ y], insert fS f, auto)
   next
     case True
     with fs obtain x where x: "x \<in> S" and fx: "f x = y" by force
     show ?thesis
     proof (rule ex1I, rule fx)
       fix x'
       assume fx': "f x' = y"
       with True f[of x'] have "x' \<in> S" by metis
       from inj_onD[OF i fx[folded fx'] x this]
       show "x' = x" by simp
     qed
   qed
 qed
 
+abbreviation (input) signof :: \<open>(nat \<Rightarrow> nat) \<Rightarrow> 'a :: ring_1\<close>
+  where \<open>signof p \<equiv> of_int (sign p)\<close>
 
-lemma permutes_pair_eq:
-  assumes p: "p permutes S"
-  shows "{ (p s, s) | s. s \<in> S } = { (s, Hilbert_Choice.inv p s) | s. s \<in> S }"
-    (is "?L = ?R")
-proof
-  show "?L \<subseteq> ?R"
-  proof
-    fix x assume "x \<in> ?L"
-    then obtain s where x: "x = (p s, s)" and s: "s \<in> S" by auto
-    note x
-    also have "(p s, s) = (p s, Hilbert_Choice.inv p (p s))"
-      using permutes_inj[OF p] inv_f_f by auto
-    also have "... \<in> ?R" using s permutes_in_image[OF p] by auto
-    finally show "x \<in> ?R".
-  qed
-  show "?R \<subseteq> ?L"
-  proof
-    fix x assume "x \<in> ?R"
-    then obtain s
-      where x: "x = (s, Hilbert_Choice.inv p s)" (is "_ = (s, ?ips)")
-        and s: "s \<in> S" by auto
-    note x
-    also have "(s, ?ips) = (p ?ips, ?ips)"
-      using inv_f_f[OF permutes_inj[OF permutes_inv[OF p]]]
-      using inv_inv_eq[OF permutes_bij[OF p]] by auto
-    also have "... \<in> ?L"
-      using s permutes_in_image[OF permutes_inv[OF p]] by auto
-    finally show "x \<in> ?L".
-  qed
-qed
+lemma signof_id:
+  "signof id = 1"
+  "signof (\<lambda>x. x) = 1"
+  by simp_all
 
-lemma inj_on_finite[simp]:
-  assumes inj: "inj_on f A" shows "finite (f ` A) = finite A"
-proof
-  assume fin: "finite (f ` A)"
-  show "finite A"
-  proof (cases "card (f ` A) = 0")
-    case True thus ?thesis using fin by auto
-    next case False 
-      hence "card A > 0" unfolding card_image[OF inj] by auto
-      thus ?thesis using card.infinite by force
-  qed
-qed auto
-
-lemma permutes_prod:
-  assumes p: "p permutes S"
-  shows "(\<Prod>s\<in>S. f (p s) s) = (\<Prod>s\<in>S. f s (Hilbert_Choice.inv p s))"
-    (is "?l = ?r")
+lemma signof_inv: "finite S \<Longrightarrow> p permutes S \<Longrightarrow> signof (inv p) = signof p"
+  by (simp add: permutes_imp_permutation sign_inverse)
+  
+lemma signof_pm_one: "signof p \<in> {1, - 1}"
+  by (simp add: sign_def)
+  
+lemma signof_compose:
+  assumes "p permutes {0..<(n :: nat)}"
+  and "q permutes {0 ..<(m :: nat)}"
+  shows "signof (p o q) = signof p * signof q"
 proof -
-  let ?f = "\<lambda>(x,y). f x y"
-  let ?ps = "\<lambda>s. (p s, s)"
-  let ?ips = "\<lambda>s. (s, Hilbert_Choice.inv p s)"
-  have inj1: "inj_on ?ps S" by (rule inj_onI;auto)
-  have inj2: "inj_on ?ips S" by (rule inj_onI;auto)
-  have "?l = prod ?f (?ps ` S)"
-    using prod.reindex[OF inj1, of ?f] by simp
-  also have "?ps ` S = {(p s, s) |s. s \<in> S}" by auto
-  also have "... = {(s, Hilbert_Choice.inv p s) | s. s \<in> S}"
-    unfolding permutes_pair_eq[OF p] by simp
-  also have "... = ?ips ` S" by auto
-  also have "prod ?f ... = ?r"
-    using prod.reindex[OF inj2, of ?f] by simp
-  finally show ?thesis.
-qed
+  from assms have pp: "permutation p" "permutation q"
+    by (auto simp: permutation_permutes)
+  then show "signof (p o q) = signof p * signof q"
+    by (simp add: sign_compose)
+qed 
 
-lemma permutes_sum:
-  assumes p: "p permutes S"
-  shows "(\<Sum>s\<in>S. f (p s) s) = (\<Sum>s\<in>S. f s (Hilbert_Choice.inv p s))"
-    (is "?l = ?r")
-proof -
-  let ?f = "\<lambda>(x,y). f x y"
-  let ?ps = "\<lambda>s. (p s, s)"
-  let ?ips = "\<lambda>s. (s, Hilbert_Choice.inv p s)"
-  have inj1: "inj_on ?ps S" by (rule inj_onI;auto)
-  have inj2: "inj_on ?ips S" by (rule inj_onI;auto)
-  have "?l = sum ?f (?ps ` S)"
-    using sum.reindex[OF inj1, of ?f] by simp
-  also have "?ps ` S = {(p s, s) |s. s \<in> S}" by auto
-  also have "... = {(s, Hilbert_Choice.inv p s) | s. s \<in> S}"
-    unfolding permutes_pair_eq[OF p] by simp
-  also have "... = ?ips ` S" by auto
-  also have "sum ?f ... = ?r"
-    using sum.reindex[OF inj2, of ?f] by simp
-  finally show ?thesis.
-qed
-
-lemma inv_inj_on_permutes: "inj_on Hilbert_Choice.inv { p. p permutes S }"
-proof (intro inj_onI, unfold mem_Collect_eq)
-  let ?i = "Hilbert_Choice.inv"
-  fix p q
-  assume p: "p permutes S" and q: "q permutes S" and eq: "?i p = ?i q"
-  have "?i (?i p) = ?i (?i q)" using eq by simp
-  thus "p = q"
-    using inv_inv_eq[OF permutes_bij] p q by metis
-qed
-
-lemma permutes_others:
-  assumes p: "p permutes S" and x: "x \<notin> S" shows "p x = x"
-  using p unfolding permutes_def using x by simp
-
-end
\ No newline at end of file
+end
diff --git a/thys/Jordan_Normal_Form/Missing_Ring.thy b/thys/Jordan_Normal_Form/Missing_Ring.thy
--- a/thys/Jordan_Normal_Form/Missing_Ring.thy
+++ b/thys/Jordan_Normal_Form/Missing_Ring.thy
@@ -1,298 +1,390 @@
 (*  
     Author:      René Thiemann 
                  Akihisa Yamada
     License:     BSD
 *)
 section \<open>Missing Ring\<close>
 
 text \<open>This theory contains several lemmas which might be of interest to the Isabelle distribution.\<close>
 
 theory Missing_Ring
-imports
+  imports
+  "Missing_Misc"
   "HOL-Algebra.Ring"
 begin
 
+context ordered_cancel_semiring
+begin
+
+subclass ordered_cancel_ab_semigroup_add ..
+
+end
+
+text \<open>partially ordered variant\<close>
+class ordered_semiring_strict = semiring + comm_monoid_add + ordered_cancel_ab_semigroup_add +
+  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 A: "a \<le> b" "0 \<le> c"
+  from A show "c * a \<le> c * b"
+    unfolding le_less
+    using mult_strict_left_mono by (cases "c = 0") auto
+  from A show "a * c \<le> b * c"
+    unfolding le_less
+    using mult_strict_right_mono by (cases "c = 0") auto
+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>Legacy - use \<open>mult_neg_pos\<close>\<close>
+lemma mult_pos_neg2: "0 < a \<Longrightarrow> b < 0 \<Longrightarrow> b * a < 0" 
+by (drule mult_strict_right_mono [of b 0], auto)
+
+text\<open>Strict monotonicity in both arguments\<close>
+lemma mult_strict_mono:
+  assumes "a < b" and "c < d" and "0 < b" and "0 \<le> c"
+  shows "a * c < b * d"
+  using assms apply (cases "c=0")
+  apply (simp)
+  apply (erule mult_strict_right_mono [THEN less_trans])
+  apply (force simp add: le_less)
+  apply (erule mult_strict_left_mono, assumption)
+  done
+
+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 "a < b" and "c \<le> d" and "0 \<le> a" and "0 < c"
+  shows "a * c < b * d"
+  using assms apply (subgoal_tac "a * c < b * c")
+  apply (erule less_le_trans)
+  apply (erule mult_left_mono)
+  apply simp
+  apply (erule mult_strict_right_mono)
+  apply assumption
+  done
+
+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"
+  using assms apply (subgoal_tac "a * c \<le> b * c")
+  apply (erule le_less_trans)
+  apply (erule mult_strict_left_mono)
+  apply simp
+  apply (erule mult_right_mono)
+  apply simp
+  done
+
+end
+
+class ordered_idom = idom + ordered_semiring_strict +
+  assumes zero_less_one [simp]: "0 < 1" begin
+
+subclass semiring_1 ..
+subclass comm_ring_1 ..
+subclass ordered_ring ..
+subclass ordered_comm_semiring by(unfold_locales, fact mult_left_mono)
+subclass ordered_ab_semigroup_add ..
+
+lemma of_nat_ge_0[simp]: "of_nat x \<ge> 0"
+proof (induct x)
+  case 0 thus ?case by auto
+  next case (Suc x)
+    hence "0 \<le> of_nat x" by auto
+    also have "of_nat x < of_nat (Suc x)" by auto
+    finally show ?case by auto
+qed
+
+lemma of_nat_eq_0[simp]: "of_nat x = 0 \<longleftrightarrow> x = 0"
+proof(induct x,simp)
+  case (Suc x)
+    have "of_nat (Suc x) > 0" apply(rule le_less_trans[of _ "of_nat x"]) by auto
+    thus ?case by auto
+qed
+
+lemma inj_of_nat: "inj (of_nat :: nat \<Rightarrow> 'a)"
+proof(rule injI)
+  fix x y show "of_nat x = of_nat y \<Longrightarrow> x = y"
+  proof (induct x arbitrary: y)
+    case 0 thus ?case
+      proof (induct y)
+        case 0 thus ?case by auto
+        next case (Suc y)
+          hence "of_nat (Suc y) = 0" by auto
+          hence "Suc y = 0" unfolding of_nat_eq_0 by auto
+          hence False by auto
+          thus ?case by auto
+      qed
+    next case (Suc x)
+      thus ?case
+      proof (induct y)
+        case 0
+          hence "of_nat (Suc x) = 0" by auto
+          hence "Suc x = 0" unfolding of_nat_eq_0 by auto
+          hence False by auto
+          thus ?case by auto
+        next case (Suc y) thus ?case by auto
+      qed
+  qed
+qed
+
+subclass ring_char_0 by(unfold_locales, fact inj_of_nat)
+
+end
+
+(*
+instance linordered_idom \<subseteq> ordered_semiring_strict by (intro_classes,auto)
+instance linordered_idom \<subseteq> ordered_idom by (intro_classes, auto)
+*)
+
 context comm_monoid
 begin
 
 lemma finprod_reindex_bij_betw: "bij_betw h S T 
   \<Longrightarrow> g \<in> h ` S \<rightarrow> carrier G 
   \<Longrightarrow> finprod G (\<lambda>x. g (h x)) S = finprod G g T"
   using finprod_reindex[of g h S] unfolding bij_betw_def by auto
 
 lemma finprod_reindex_bij_witness:
   assumes witness:
     "\<And>a. a \<in> S \<Longrightarrow> i (j a) = a"
     "\<And>a. a \<in> S \<Longrightarrow> j a \<in> T"
     "\<And>b. b \<in> T \<Longrightarrow> j (i b) = b"
     "\<And>b. b \<in> T \<Longrightarrow> i b \<in> S"
   assumes eq:
     "\<And>a. a \<in> S \<Longrightarrow> h (j a) = g a"
   assumes g: "g \<in> S \<rightarrow> carrier G"
   and h: "h \<in> j ` S \<rightarrow> carrier G"
   shows "finprod G g S = finprod G h T"
 proof -
   have b: "bij_betw j S T"
     using bij_betw_byWitness[where A=S and f=j and f'=i and A'=T] witness by auto
   have fp: "finprod G g S = finprod G (\<lambda>x. h (j x)) S"
     by (rule finprod_cong, insert eq g, auto)
   show ?thesis
     using finprod_reindex_bij_betw[OF b h] unfolding fp .
 qed
 end
 
 lemmas (in abelian_monoid) finsum_reindex_bij_witness = add.finprod_reindex_bij_witness
 
 locale csemiring = semiring + comm_monoid R
 
 context cring
 begin
 sublocale csemiring ..
 end
 
 lemma (in comm_monoid) finprod_one': 
   "(\<And> a. a \<in> A \<Longrightarrow> f a = \<one>) \<Longrightarrow> finprod G f A = \<one>"
   by (induct A rule: infinite_finite_induct, auto)
 
 lemma (in comm_monoid) finprod_split: 
   "finite A \<Longrightarrow> f ` A \<subseteq> carrier G \<Longrightarrow> a \<in> A \<Longrightarrow> finprod G f A = f a \<otimes> finprod G f (A - {a})"
   by (rule trans[OF trans[OF _ finprod_Un_disjoint[of "{a}" "A - {a}" f]]], auto,
   rule arg_cong[of _ _ "finprod G f"], auto)
 
 lemma (in comm_monoid) finprod_finprod:
   "finite A \<Longrightarrow> finite B \<Longrightarrow> (\<And> a b. a \<in> A  \<Longrightarrow> b \<in> B \<Longrightarrow> g a b \<in> carrier G) \<Longrightarrow>
   finprod G (\<lambda> a. finprod G (g a) B) A = finprod G (\<lambda> (a,b). g a b) (A \<times> B)"
 proof (induct A rule: finite_induct)
   case (insert a' A)
   note IH = this
   let ?l = "(\<Otimes>a\<in>insert a' A. finprod G (g a) B)"
   let ?r = "(\<Otimes>a\<in>insert a' A \<times> B. case a of (a, b) \<Rightarrow> g a b)"
   have "?l = finprod G (g a') B \<otimes> (\<Otimes>a\<in>A. finprod G (g a) B)"
     using IH by simp
   also have "(\<Otimes>a\<in>A. finprod G (g a) B) = finprod G (\<lambda> (a,b). g a b) (A \<times> B)"
     by (rule IH(3), insert IH, auto)
   finally have idl: "?l = finprod G (g a') B \<otimes> finprod G (\<lambda> (a,b). g a b) (A \<times> B)" .
   from IH(2) have "insert a' A \<times> B = {a'} \<times> B \<union> A \<times> B" by auto
   hence "?r = (\<Otimes>a\<in>{a'} \<times> B \<union> A \<times> B. case a of (a, b) \<Rightarrow> g a b)" by simp
   also have "\<dots> = (\<Otimes>a\<in>{a'} \<times> B. case a of (a, b) \<Rightarrow> g a b) \<otimes> (\<Otimes>a\<in> A \<times> B. case a of (a, b) \<Rightarrow> g a b)"
     by (rule finprod_Un_disjoint, insert IH, auto)
   also have "(\<Otimes>a\<in>{a'} \<times> B. case a of (a, b) \<Rightarrow> g a b) = finprod G (g a') B"
     using IH(4) IH(5)
   proof (induct B rule: finite_induct)
     case (insert b' B)
     note IH = this
     have id: "(\<Otimes>a\<in>{a'} \<times> B. case a of (a, b) \<Rightarrow> g a b) = finprod G (g a') B"
       by (rule IH(3)[OF IH(4)], auto)
     have id2: "\<And> x F. {a'} \<times> insert x F = insert (a',x) ({a'} \<times> F)" by auto
     have id3: "(\<Otimes>a\<in>insert (a', b') ({a'} \<times> B). case a of (a, b) \<Rightarrow> g a b)
       = g a' b' \<otimes> (\<Otimes>a\<in>({a'} \<times> B). case a of (a, b) \<Rightarrow> g a b)"
       by (rule trans[OF finprod_insert], insert IH, auto)
     show ?case unfolding id2 id3 id
       by (rule sym, rule finprod_insert, insert IH, auto)
   qed simp
   finally have idr: "?r = finprod G (g a') B \<otimes> (\<Otimes>a\<in>A \<times> B. case a of (a, b) \<Rightarrow> g a b)" .
   show ?case unfolding idl idr ..
 qed simp
 
 lemma (in comm_monoid) finprod_swap:
   assumes "finite A" "finite B" "\<And> a b. a \<in> A  \<Longrightarrow> b \<in> B \<Longrightarrow> g a b \<in> carrier G"
   shows "finprod G (\<lambda> (b,a). g a b) (B \<times> A) = finprod G (\<lambda> (a,b). g a b) (A \<times> B)"
 proof -
   have [simp]: "(\<lambda>(a, b). (b, a)) ` (A \<times> B) = B \<times> A" by auto
   have [simp]: "(\<lambda> x. case case x of (a, b) \<Rightarrow> (b, a) of (a, b) \<Rightarrow> g b a) = (\<lambda> (a,b). g a b)"
     by (intro ext, auto)
   show ?thesis 
     by (rule trans[OF trans[OF _ finprod_reindex[of "\<lambda> (a,b). g b a" "\<lambda> (a,b). (b,a)"]]],
     insert assms, auto simp: inj_on_def)
 qed
 
 lemma (in comm_monoid) finprod_finprod_swap:
   "finite A \<Longrightarrow> finite B \<Longrightarrow> (\<And> a b. a \<in> A  \<Longrightarrow> b \<in> B \<Longrightarrow> g a b \<in> carrier G) \<Longrightarrow>
   finprod G (\<lambda> a. finprod G (g a) B) A = finprod G (\<lambda> b. finprod G (\<lambda> a. g a b) A) B"
   using finprod_finprod[of A B] finprod_finprod[of B A] finprod_swap[of A B]
   by simp
 
 
 
 lemmas (in semiring) finsum_zero' = add.finprod_one' 
 lemmas (in semiring) finsum_split = add.finprod_split 
 lemmas (in semiring) finsum_finsum_swap = add.finprod_finprod_swap
 
 
 lemma (in csemiring) finprod_zero: 
   "finite A \<Longrightarrow> f \<in> A \<rightarrow> carrier R \<Longrightarrow> \<exists>a\<in>A. f a = \<zero>
    \<Longrightarrow> finprod R f A = \<zero>"
 proof (induct A rule: finite_induct)
   case (insert a A)
   from finprod_insert[OF insert(1-2), of f] insert(4)
   have ins: "finprod R f (insert a A) = f a \<otimes> finprod R f A" by simp
   have fA: "finprod R f A \<in> carrier R"
     by (rule finprod_closed, insert insert, auto)
   show ?case
   proof (cases "f a = \<zero>")
     case True
     with fA show ?thesis unfolding ins by simp
   next
     case False
     with insert(5) have "\<exists> a \<in> A. f a = \<zero>" by auto
     from insert(3)[OF _ this] insert have "finprod R f A = \<zero>" by auto
     with insert show ?thesis unfolding ins by auto
   qed
 qed simp
 
 lemma (in semiring) finsum_product:
   assumes A: "finite A" and B: "finite B"
   and f: "f \<in> A \<rightarrow> carrier R" and g: "g \<in> B \<rightarrow> carrier R" 
   shows "finsum R f A \<otimes> finsum R g B = (\<Oplus>i\<in>A. \<Oplus>j\<in>B. f i \<otimes> g j)"
   unfolding finsum_ldistr[OF A finsum_closed[OF g] f]
 proof (rule finsum_cong'[OF refl])
   fix a
   assume a: "a \<in> A"
   show "f a \<otimes> finsum R g B = (\<Oplus>j\<in>B. f a \<otimes> g j)"
   by (rule finsum_rdistr[OF B _ g], insert a f, auto)
 qed (insert f g B, auto intro: finsum_closed)
     
 lemma (in semiring) Units_one_side_I: 
   "a \<in> carrier R \<Longrightarrow> p \<in> Units R \<Longrightarrow> p \<otimes> a = \<one> \<Longrightarrow> a \<in> Units R"
   "a \<in> carrier R \<Longrightarrow> p \<in> Units R \<Longrightarrow> a \<otimes> p = \<one> \<Longrightarrow> a \<in> Units R"
   by (metis Units_closed Units_inv_Units Units_l_inv inv_unique)+
 
-context ordered_cancel_semiring begin
-subclass ordered_cancel_ab_semigroup_add ..
-end
-
-text \<open>partially ordered variant\<close>
-class ordered_semiring_strict = semiring + comm_monoid_add + ordered_cancel_ab_semigroup_add +
-  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 ..
+lemma permutes_funcset: "p permutes A \<Longrightarrow> (p ` A \<rightarrow> B) = (A \<rightarrow> B)"
+  by (simp add: permutes_image)
 
-subclass ordered_semiring
-proof
-  fix a b c :: 'a
-  assume A: "a \<le> b" "0 \<le> c"
-  from A show "c * a \<le> c * b"
-    unfolding le_less
-    using mult_strict_left_mono by (cases "c = 0") auto
-  from A show "a * c \<le> b * c"
-    unfolding le_less
-    using mult_strict_right_mono by (cases "c = 0") auto
+context comm_monoid
+begin
+lemma finprod_permute:
+  assumes p: "p permutes S"
+  and f: "f \<in> S \<rightarrow> carrier G"
+  shows "finprod G f S = finprod G (f \<circ> p) S"
+proof -
+  from \<open>p permutes S\<close> have "inj p"
+    by (rule permutes_inj)
+  then have "inj_on p S"
+    by (auto intro: subset_inj_on)
+  from finprod_reindex[OF _ this, unfolded permutes_image[OF p], OF f]
+  show ?thesis unfolding o_def .
 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>Legacy - use \<open>mult_neg_pos\<close>\<close>
-lemma mult_pos_neg2: "0 < a \<Longrightarrow> b < 0 \<Longrightarrow> b * a < 0" 
-by (drule mult_strict_right_mono [of b 0], auto)
-
-text\<open>Strict monotonicity in both arguments\<close>
-lemma mult_strict_mono:
-  assumes "a < b" and "c < d" and "0 < b" and "0 \<le> c"
-  shows "a * c < b * d"
-  using assms apply (cases "c=0")
-  apply (simp)
-  apply (erule mult_strict_right_mono [THEN less_trans])
-  apply (force simp add: le_less)
-  apply (erule mult_strict_left_mono, assumption)
-  done
+lemma finprod_singleton_set[simp]: assumes "f a \<in> carrier G"
+  shows "finprod G f {a} = f a"
+proof -
+  have "finprod G f {a} = f a \<otimes> finprod G f {}"
+    by (rule finprod_insert, insert assms, auto)
+  also have "\<dots> = f a" using assms by auto
+  finally show ?thesis .
+qed
+end
 
-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)
+lemmas (in semiring) finsum_permute = add.finprod_permute
+lemmas (in semiring) finsum_singleton_set = add.finprod_singleton_set
 
-lemma mult_less_le_imp_less:
-  assumes "a < b" and "c \<le> d" and "0 \<le> a" and "0 < c"
-  shows "a * c < b * d"
-  using assms apply (subgoal_tac "a * c < b * c")
-  apply (erule less_le_trans)
-  apply (erule mult_left_mono)
-  apply simp
-  apply (erule mult_strict_right_mono)
-  apply assumption
-  done
+context cring
+begin
 
-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"
-  using assms apply (subgoal_tac "a * c \<le> b * c")
-  apply (erule le_less_trans)
-  apply (erule mult_strict_left_mono)
-  apply simp
-  apply (erule mult_right_mono)
-  apply simp
-  done
+lemma finsum_permutations_inverse: 
+  assumes f: "f \<in> {p. p permutes S} \<rightarrow> carrier R"
+  shows "finsum R f {p. p permutes S} = finsum R (\<lambda>p. f(Hilbert_Choice.inv p)) {p. p permutes S}"
+  (is "?lhs = ?rhs")
+proof -
+  let ?inv = "Hilbert_Choice.inv"
+  let ?S = "{p . p permutes S}"
+  have th0: "inj_on ?inv ?S"
+  proof (auto simp add: inj_on_def)
+    fix q r
+    assume q: "q permutes S"
+      and r: "r permutes S"
+      and qr: "?inv q = ?inv r"
+    then have "?inv (?inv q) = ?inv (?inv r)"
+      by simp
+    with permutes_inv_inv[OF q] permutes_inv_inv[OF r] show "q = r"
+      by metis
+  qed
+  have th1: "?inv ` ?S = ?S"
+    using image_inverse_permutations by blast
+  have th2: "?rhs = finsum R (f \<circ> ?inv) ?S"
+    by (simp add: o_def)
+  from finsum_reindex[OF _ th0, of f] show ?thesis unfolding th1 th2 using f .
+qed
+
+lemma finsum_permutations_compose_right: assumes q: "q permutes S"
+  and *: "f \<in> {p. p permutes S} \<rightarrow> carrier R"
+  shows "finsum R f {p. p permutes S} = finsum R (\<lambda>p. f(p \<circ> q)) {p. p permutes S}"
+  (is "?lhs = ?rhs")
+proof -
+  let ?S = "{p. p permutes S}"
+  let ?inv = "Hilbert_Choice.inv"
+  have th0: "?rhs = finsum R (f \<circ> (\<lambda>p. p \<circ> q)) ?S"
+    by (simp add: o_def)
+  have th1: "inj_on (\<lambda>p. p \<circ> q) ?S"
+  proof (auto simp add: inj_on_def)
+    fix p r
+    assume "p permutes S"
+      and r: "r permutes S"
+      and rp: "p \<circ> q = r \<circ> q"
+    then have "p \<circ> (q \<circ> ?inv q) = r \<circ> (q \<circ> ?inv q)"
+      by (simp add: o_assoc)
+    with permutes_surj[OF q, unfolded surj_iff] show "p = r"
+      by simp
+  qed
+  have th3: "(\<lambda>p. p \<circ> q) ` ?S = ?S"
+    using image_compose_permutations_right[OF q] by auto
+  from finsum_reindex[OF _ th1, of f]
+  show ?thesis unfolding th0 th1 th3 using * .
+qed
 
 end
 
-class ordered_idom = idom + ordered_semiring_strict +
-  assumes zero_less_one [simp]: "0 < 1" begin
-
-subclass semiring_1 ..
-subclass comm_ring_1 ..
-subclass ordered_ring ..
-subclass ordered_comm_semiring by(unfold_locales, fact mult_left_mono)
-subclass ordered_ab_semigroup_add ..
-
-lemma of_nat_ge_0[simp]: "of_nat x \<ge> 0"
-proof (induct x)
-  case 0 thus ?case by auto
-  next case (Suc x)
-    hence "0 \<le> of_nat x" by auto
-    also have "of_nat x < of_nat (Suc x)" by auto
-    finally show ?case by auto
-qed
-
-lemma of_nat_eq_0[simp]: "of_nat x = 0 \<longleftrightarrow> x = 0"
-proof(induct x,simp)
-  case (Suc x)
-    have "of_nat (Suc x) > 0" apply(rule le_less_trans[of _ "of_nat x"]) by auto
-    thus ?case by auto
-qed
-
-lemma inj_of_nat: "inj (of_nat :: nat \<Rightarrow> 'a)"
-proof(rule injI)
-  fix x y show "of_nat x = of_nat y \<Longrightarrow> x = y"
-  proof (induct x arbitrary: y)
-    case 0 thus ?case
-      proof (induct y)
-        case 0 thus ?case by auto
-        next case (Suc y)
-          hence "of_nat (Suc y) = 0" by auto
-          hence "Suc y = 0" unfolding of_nat_eq_0 by auto
-          hence False by auto
-          thus ?case by auto
-      qed
-    next case (Suc x)
-      thus ?case
-      proof (induct y)
-        case 0
-          hence "of_nat (Suc x) = 0" by auto
-          hence "Suc x = 0" unfolding of_nat_eq_0 by auto
-          hence False by auto
-          thus ?case by auto
-        next case (Suc y) thus ?case by auto
-      qed
-  qed
-qed
-
-subclass ring_char_0 by(unfold_locales, fact inj_of_nat)
-
 end
-
-(*
-instance linordered_idom \<subseteq> ordered_semiring_strict by (intro_classes,auto)
-instance linordered_idom \<subseteq> ordered_idom by (intro_classes, auto)
-*)
-
-end
diff --git a/thys/Jordan_Normal_Form/ROOT b/thys/Jordan_Normal_Form/ROOT
--- a/thys/Jordan_Normal_Form/ROOT
+++ b/thys/Jordan_Normal_Form/ROOT
@@ -1,22 +1,22 @@
 chapter AFP
 
 session "Jordan_Normal_Form" (AFP) = "JNF-AFP-Lib" +
   options [timeout = 1200]
   sessions
     "HOL-Combinatorics"
     Polynomial_Factorization
   theories
+    Missing_Misc
     Missing_Ring
-    Missing_Permutations
   theories
     Matrix_Impl
     Strassen_Algorithm_Code
     Matrix_Complexity
     Jordan_Normal_Form_Existence
     Jordan_Normal_Form_Uniqueness
     Spectral_Radius
   theories
     DL_Rank_Submatrix
   document_files
     "root.bib"
     "root.tex"
diff --git a/thys/Jordan_Normal_Form/Schur_Decomposition.thy b/thys/Jordan_Normal_Form/Schur_Decomposition.thy
--- a/thys/Jordan_Normal_Form/Schur_Decomposition.thy
+++ b/thys/Jordan_Normal_Form/Schur_Decomposition.thy
@@ -1,667 +1,667 @@
 (*  
     Author:      René Thiemann 
                  Akihisa Yamada
     License:     BSD
 *)
 section \<open>Schur Decomposition\<close>
 
 text \<open>We implement Schur decomposition as an algorithm which, given a square matrix $A$
   and a list eigenvalues, computes $B$, $P$, and $Q$ such that 
   $A = PBQ$, $B$ is upper-triangular and $PQ = 1$. The algorithm works is generic in
   the kind of field and can be applied on the rationals, the reals, and the complex numbers.
   The algorithm relies on the method of Gram-Schmidt to create an orthogonal basis,
   and on the Gauss-Jordan algorithm to find eigenvectors to a given eigenvalue.
   
  The algorithm is a key ingredient to show that every matrix with a linear factorizable 
  characteristic polynomial has a Jordan normal form. 
 
   A further consequence of the algorithm is that the characteristic polynomial of 
   a block diagonal matrix is the product of the characteristic polynomials of the blocks.\<close>
 
 theory Schur_Decomposition
 imports 
   Polynomial_Interpolation.Missing_Polynomial
   Gram_Schmidt 
   Char_Poly
 begin
 
 definition vec_inv :: "'a::conjugatable_field vec \<Rightarrow> 'a vec"
   where "vec_inv v = 1 / (v \<bullet>c v) \<cdot>\<^sub>v conjugate v"
 
 lemma vec_inv_closed[simp]: "v \<in> carrier_vec n \<Longrightarrow> vec_inv v \<in> carrier_vec n"
   unfolding vec_inv_def by auto
 
 lemma vec_inv_dim[simp]: "dim_vec (vec_inv v) = dim_vec v"
   unfolding vec_inv_def by auto
 
 lemma vec_inv[simp]:
   assumes v: "v : carrier_vec n"
       and v0: "(v::'a::conjugatable_ordered_field vec) \<noteq> 0\<^sub>v n"
   shows "vec_inv v \<bullet> v = 1"
 proof -
   { assume "v \<bullet>c v = 0"
     hence "v = 0\<^sub>v n" using conjugate_square_eq_0_vec[OF v] by auto
     hence False using v0 by auto
   }
   moreover have "conjugate v \<bullet> v = v \<bullet>c v"
     apply (rule comm_scalar_prod) using v by auto
   ultimately show ?thesis
     unfolding vec_inv_def
     apply (subst smult_scalar_prod_distrib)
     using assms by auto
 qed
 
 lemma corthogonal_inv:
   assumes orth: "corthogonal (vs ::'a::conjugatable_field vec list)"
       and V: "set vs \<subseteq> carrier_vec n"
   shows "inverts_mat (mat_of_rows n (map vec_inv vs)) (mat_of_cols n vs)"
     (is "inverts_mat ?W ?V")
 proof -
   define l where "l = length vs"
   have rW[simp]: "dim_row ?W = l" using l_def by auto
   have cV[simp]:"dim_col ?V = l" using l_def by auto
   have dim: "\<And>i. i < length vs \<Longrightarrow> vs!i \<in> carrier_vec n" using V by auto
   show ?thesis
     unfolding inverts_mat_def
     apply rule
     unfolding mat_of_rows_carrier length_map l_def[symmetric]
     unfolding index_one_mat
   proof -
     show "dim_row (?W * ?V) = l" "dim_col (?W * ?V) = l"
       unfolding times_mat_def rW cV by auto
     fix i j assume i:"i<l" and j: "j<l"
     hence i2: "i<length vs"
       and i3: "i<length (map vec_inv vs)"
       and j2: "j<length vs" using l_def by auto
     hence id2: "vs ! i \<in> carrier_vec n"
       and id3: "map vec_inv vs ! i \<in> carrier_vec n"
       and id4: "conjugate (vs ! i) \<in> carrier_vec n"
       and jd2: "vs ! j \<in> carrier_vec n" using dim by auto
     show "(?W * ?V) $$ (i,j) = (if i = j then 1 else 0)"
       unfolding times_mat_def rW cV
       unfolding index_mat[OF i j] split
       unfolding mat_of_rows_row[OF i3 id3]
       unfolding col_mat_of_cols[OF j2 jd2]
       unfolding nth_map[OF i2]
       unfolding vec_inv_def
       unfolding smult_scalar_prod_distrib[OF id4 jd2]
       unfolding comm_scalar_prod[OF id4 jd2]
       using corthogonalD[OF orth j2 i2] by auto
   qed
 qed
 
 definition corthogonal_inv :: "'a::conjugatable_field mat \<Rightarrow> 'a mat"
   where "corthogonal_inv A = mat_of_rows (dim_row A) (map vec_inv (cols A))"
 
 definition mat_adjoint :: "'a :: conjugatable_field mat \<Rightarrow> 'a mat"
   where "mat_adjoint A \<equiv> mat_of_rows (dim_row A) (map conjugate (cols A))"
 
 definition corthogonal_mat :: "'a::conjugatable_field mat \<Rightarrow> bool"
   where "corthogonal_mat A \<equiv>
     let B = mat_adjoint A * A in
     diagonal_mat B \<and> (\<forall>i<dim_col A. B $$ (i,i) \<noteq> 0)"
 
 lemma corthogonal_matD[elim]:
   assumes orth: "corthogonal_mat A"
       and i: "i < dim_col A"
       and j: "j < dim_col A"
   shows "(col A i \<bullet>c col A j = 0) = (i \<noteq> j)"
 proof
   have ci: "col A i : carrier_vec (dim_row A)"
    and cj: "col A j : carrier_vec (dim_row A)" by auto
   note [simp] = conjugate_conjugate_sprod[OF ci cj]
 
   let ?B = "mat_adjoint A * A"
   have diag: "diagonal_mat ?B" and zero: "\<And>i. i<dim_col A \<Longrightarrow> ?B $$ (i,i) \<noteq> 0"
     using orth unfolding corthogonal_mat_def Let_def by auto
   { assume "i = j"
     hence "conjugate (col A i) \<bullet> col A j \<noteq> 0"
       using zero[OF i] unfolding mat_adjoint_def using i by simp
     hence "conjugate (conjugate (col A i) \<bullet> col A j) \<noteq> 0"
       unfolding conjugate_zero_iff.
     hence "col A i \<bullet>c col A j \<noteq> 0" by simp
   }
   thus "col A i \<bullet>c col A j = 0 \<Longrightarrow> i \<noteq> j" by auto
   { assume "i \<noteq> j"
     hence "conjugate (col A i) \<bullet> col A j = 0"
       using diag
       unfolding diagonal_mat_def
       unfolding mat_adjoint_def using i j by simp
     hence "conjugate (conjugate (col A i) \<bullet> col A j) = 0" by simp
     thus "col A i \<bullet>c col A j = 0" by simp
   }
 qed
 
 lemma corthogonal_matI[intro]:
   assumes "(\<And>i j. i < dim_col A \<Longrightarrow> j < dim_col A \<Longrightarrow> (col A i \<bullet>c col A j = 0) = (i \<noteq> j))"
   shows "corthogonal_mat A"
 proof -
   { fix i j assume i: "i < dim_col A" and j: "j < dim_col A" and ij: "i \<noteq> j"
     have "conjugate (col A i) \<bullet> col A j = 0"
       by (metis assms col_dim i j ij conjugate_vec_sprod_comm)
   }
   moreover
   { fix i assume "i < dim_col A"
     hence "conjugate (col A i) \<bullet> col A i \<noteq> 0"
       by (metis assms comm_scalar_prod carrier_vec_conjugate carrier_vecI)
   }
   ultimately show ?thesis
   unfolding corthogonal_mat_def Let_def
   unfolding diagonal_mat_def
   unfolding mat_adjoint_def by auto
 qed
 
 lemma corthogonal_inv_result:
   assumes o: "corthogonal_mat (A::'a::conjugatable_field mat)"
   shows "inverts_mat (corthogonal_inv A) A"
 proof -
   have oc: "corthogonal (cols A)"
     apply (intro corthogonalI) using corthogonal_matD[OF o] by auto
   show ?thesis unfolding corthogonal_inv_def
     using corthogonal_inv[OF oc cols_dim] by auto
 qed
 
 text "extends a vector to a basis"
 
 definition basis_completion :: "'a::ring_1 vec \<Rightarrow> 'a vec list" where
   "basis_completion v \<equiv> let 
      n = dim_vec v;
      drop_index = hd ([ i . i <- [0..<n], v $ i \<noteq> 0]);
      vs = [unit_vec n i. i <- [0..<n], i \<noteq> drop_index] 
    in v # vs"
 
 lemma (in vec_space) basis_completion: fixes v :: "'a :: field vec"
   assumes v: "v \<in> carrier_vec n"
       and v0: "v \<noteq> 0\<^sub>v n"
   shows 
     "basis (set (basis_completion v))"
     "set (basis_completion v) \<subseteq> carrier_vec n"
     "span (set (basis_completion v)) = carrier_vec n" 
     "distinct (basis_completion v)"
     "\<not> lin_dep (set (basis_completion v))"
     "length (basis_completion v) = n"
     "hd (basis_completion v) = v"
 proof -
   let ?b = "basis_completion v"
   note d = basis_completion_def Let_def
   from v have dim: "dim_vec v = n" by auto
   let ?is = "[ i . i <- [0..<n], v $ i \<noteq> 0]"
   {
     assume empty: "set ?is = {}"
     have "v = 0\<^sub>v n"
       by (rule eq_vecI, insert empty v, auto)
   }
   with v0 obtain k ids where id: "?is = k # ids" and mem: "k \<in> set ?is" by (cases ?is, auto)
   from mem have vk: "v $ k \<noteq> 0" and k: "k < n" by auto
   {
     fix i 
     assume i: "\<not> i < k"
     have id: "k # [Suc k..<n] = [k ..< n]" using k by (simp add: upt_conv_Cons)
     from i have "i < n \<Longrightarrow> (k # [Suc k..<n]) ! (i - k) = i" 
       unfolding id
       by (subst nth_upt, auto)
   }
   hence split: "[0 ..< n] = [0 ..< k] @ k # [Suc k ..< n]"
     by (intro nth_equalityI, insert k, auto simp: nth_append) 
   {
     fix as
     assume "k \<notin> set as"
     hence "[unit_vec n i. i <- as, i \<noteq> k] = [unit_vec n i. i <- as]"
       by (induct as, auto)
   } note conv = this
   have b_all: "?b = v # [unit_vec n i. i <- [0..<n], i \<noteq> k]"
     unfolding d dim id by simp 
   also have "[unit_vec n i. i <- [0..<n], i \<noteq> k] = [unit_vec n i. i <- [0..<k]] @ [unit_vec n i. i <- [Suc k..<n]]"
     unfolding split by (auto simp: conv)
   finally have b: "?b = v # [unit_vec n i. i <- [0..<k]] @ [unit_vec n i. i <- [Suc k..<n]]" by simp
   show carr: "set ?b \<subseteq> carrier_vec n" (is "?S \<subseteq> _")
     unfolding b using assms by auto
   show "hd ?b = v" unfolding b by auto
   show len: "length (basis_completion v) = n" unfolding b using k
     by auto
   define I where "I = (\<lambda> i. if i < k then i else Suc i)"
   have I: "\<And> i. I i \<noteq> k" "\<And> i. Suc i < n \<Longrightarrow> I i < n" unfolding I_def by auto
   {
     fix i
     assume i: "i < n"
     have "?b ! i = (if i = 0 then v else unit_vec n (I (i - 1)))"
       unfolding b I_def using i
       by (auto split: if_splits simp: nth_append)
   } note bi = this
   show dist: "distinct ?b" unfolding distinct_conv_nth len
   proof (intro allI impI)
     fix i j
     assume i: "i < n" and j: "j < n" and ij: "i \<noteq> j"
     show "?b ! i \<noteq> ?b ! j"
     proof 
       assume id1: "?b ! i = ?b ! j" 
       hence id2: "\<And> l. ?b ! i $ l = ?b ! j $ l" by auto
       have "i = j" 
       proof (cases "i = 0")
         case True
         hence biv: "?b ! i = v" unfolding b by simp
         from True ij have bj: "?b ! j = unit_vec n (I (j - 1))" "Suc (j - 1) = j" unfolding bi[OF j] by auto
         with id2[of k, unfolded biv bj] vk I[of "j - 1"] k j
         have False by simp
         thus ?thesis ..
       next
         case False note i0 = this
         hence bi': "?b ! i = unit_vec n (I (i - 1))" "Suc (i - 1) = i" unfolding bi[OF i] by auto
         show ?thesis
         proof (cases "j = 0")
           case True
           hence bj: "?b ! j = v" unfolding b by simp
           from id2[of k, unfolded bi' bj] vk I[of "i - 1"] k i bi'
           have False by simp
           thus ?thesis by simp
         next
           case False note j0 = this
           hence bj: "?b ! j = unit_vec n (I (j - 1))" "Suc (j - 1) = j" unfolding bi[OF j] by auto
           have "1 = ?b ! i $ I (i - 1)" unfolding bi' using I[of "i - 1"] i i0 by auto
           also have "\<dots> = unit_vec n (I (j - 1)) $ I (i - 1)" unfolding id1 bj by simp
           also have "\<dots> = (if I (i - 1) = I (j - 1) then 1 else 0)"
             using I[of "i - 1"] I[of "j - 1"] i0 j0 i j by auto
           finally have "I (i - 1) = I (j - 1)" by (auto split: if_splits)
           with i0 j0 show "i = j" unfolding I_def by (auto split: if_splits)
         qed
       qed   
       thus False using ij by simp
     qed
   qed
   have "span (set ?b) \<subseteq> carrier_vec n" using carr by auto
   moreover
   {
     fix w :: "'a vec"
     assume w: "w \<in> carrier_vec n"
     define lookup where "lookup = (v,k) # [(unit_vec n i, i). i <- [0..<n], i \<noteq> k]"
     define a where "a = (\<lambda> vi. case map_of lookup vi of Some i \<Rightarrow> if i = k then w $ k / v $ k else
        w $ i - w $ k / v $ k * v $ i)" 
     have "map fst lookup = ?b" unfolding b_all lookup_def 
       by (auto simp: map_concat o_def if_distrib, unfold list.simps fst_def prod.simps, simp)
     with dist have dist: "distinct (map fst lookup)" by simp
     let ?w = "lincomb a (set ?b)"
     have "?w \<in> carrier_vec n" using carr by auto
     with w have dim: "dim_vec w = n" "dim_vec ?w = n" by auto
     have "w = ?w" 
     proof (rule eq_vecI; unfold dim)
       fix i
       assume i: "i < n"
       show "w $ i = ?w $ i" unfolding lincomb_def 
       proof (subst finsum_index[OF i _ carr]) 
         show "(\<lambda>v. a v \<cdot>\<^sub>v v) \<in> set ?b \<rightarrow> carrier_vec n" using carr by auto
         {
           fix x :: "'a vec" and j
           assume "x = unit_vec n j" "j \<noteq> k" "j < n"
           hence "(x,j) \<in> set lookup" unfolding lookup_def by auto
           from map_of_is_SomeI[OF dist this]
           have "a x = w $ j - w $ k / v $ k * v $ j" unfolding a_def using \<open>j \<noteq> k\<close> by auto
         } note a = this          
         have "(\<Sum>x\<in>set ?b. (a x \<cdot>\<^sub>v x) $ i) = (a v \<cdot>\<^sub>v v) $ i + (\<Sum>x\<in>(set ?b) - {v}. (a x \<cdot>\<^sub>v x) $ i)"
           by (rule sum.remove[OF finite_set], auto simp: b)
         also have "a v = w $ k / v $ k" unfolding a_def lookup_def by auto
         also have "(\<dots> \<cdot>\<^sub>v v) $ i = w $ k / v $ k * v $ i" using i v by auto
         finally have "(\<Sum>x\<in>set ?b. (a x \<cdot>\<^sub>v x) $ i) = w $ k / v $ k * v $ i + (\<Sum>x\<in>(set ?b) - {v}. (a x \<cdot>\<^sub>v x) $ i)" .
         also have "\<dots> = w $ i"
         proof (cases "i = k")
           case True
           hence "w $ k / v $ k * v $ i = w $ k" using vk by auto
           moreover have "(\<Sum>x\<in>(set ?b) - {v}. (a x \<cdot>\<^sub>v x) $ i) = 0" unfolding True
           proof (rule sum.neutral, intro ballI)
             fix x
             assume "x \<in> set ?b - {v}"
             then obtain j where x: "x = unit_vec n j" "j \<noteq> k" "j < n" using k unfolding b by auto
             show "(a x \<cdot>\<^sub>v x) $ k = 0" unfolding a[OF x] unfolding x using x k by auto
           qed
           ultimately show ?thesis unfolding True by simp
         next
           case False
           let ?ui = "unit_vec n i :: 'a vec"
           {
             assume "?ui = v"
             from arg_cong[OF this, of "\<lambda> v. v $ k"] vk i k False have False by auto
           }
           hence diff: "?ui \<noteq> v" by auto
           from a[OF refl False] have ai: "(a ?ui \<cdot>\<^sub>v ?ui) $ i = w $ i - w $ k / v $ k * v $ i" 
             using i by auto          
           have "?ui \<in> set ?b" unfolding b_all using False k i by auto
           with diff have mem: "unit_vec n i \<in> set ?b - {v}" by auto
           have "w $ k / v $ k * v $ i + (\<Sum>x\<in>(set ?b) - {v}. (a x \<cdot>\<^sub>v x) $ i)
             = w $ i + (\<Sum>x\<in>(set ?b) - {v,?ui}. (a x \<cdot>\<^sub>v x) $ i)"
             by (subst sum.remove[OF _ mem], auto simp: ai intro!: sum.cong)
           also have "(\<Sum>x\<in>(set ?b) - {v,?ui}. (a x \<cdot>\<^sub>v x) $ i) = 0"
             by (rule sum.neutral, unfold b_all, insert i k, auto)
           finally show ?thesis by simp
         qed
         finally show "w $ i = (\<Sum>x\<in>set ?b. (a x \<cdot>\<^sub>v x) $ i)" by simp
       qed
     qed auto
     hence "w \<in> span (set ?b)" unfolding span_def by auto
   }
   ultimately show span: "span (set ?b) = carrier_vec n" by blast
   show "basis (set ?b)"
   proof (rule dim_gen_is_basis[OF finite_set carr span])
     have "card (set ?b) = dim" using dist len distinct_card unfolding dim_is_n by blast
     thus "card (set ?b) \<le> dim" by simp
   qed
   thus "\<not> lin_dep (set ?b)" unfolding basis_def by auto
 qed
 
 lemma orthogonal_mat_of_cols:
   assumes W: "set ws \<subseteq> carrier_vec n"
     and orth: "corthogonal ws"
     and len: "length ws = n"
   shows "corthogonal_mat (mat_of_cols n ws)" (is "corthogonal_mat ?W")
 proof
     fix i j assume i: "i < dim_col ?W" and j: "j < dim_col ?W"
     hence [simp]: "ws ! i : carrier_vec n" "ws ! j : carrier_vec n"
       using W len by auto
     have "i < length ws" and "j < length ws" using i j using len W by auto
     thus "col ?W i \<bullet>c col ?W j = 0 \<longleftrightarrow> i \<noteq> j"
       using orth
       unfolding corthogonal_def
       by simp
 qed
 
 lemma corthogonal_col_ev_0: fixes A :: "'a :: conjugatable_ordered_field mat"
   assumes A: "A \<in> carrier_mat n n"
   and v: "v \<in> carrier_vec n"
   and v0: "v \<noteq> 0\<^sub>v n"
   and eigen[simp]: "A *\<^sub>v v = e \<cdot>\<^sub>v v"
   and n: "n \<noteq> 0"
   and hdws: "hd ws = v"
   and ws: "set ws \<subseteq> carrier_vec n" "corthogonal ws" "length ws = n"
   defines "W == mat_of_cols n ws"
   defines "W' == corthogonal_inv W"
   defines "A' == W' * A * W"
   shows "col A' 0 = vec n (\<lambda> i. if i = 0 then e else 0)"
 proof -
   let ?f = "(\<lambda> i. if i = 0 then e else 0)"
   from ws have W: "W \<in> carrier_mat n n" unfolding W_def by auto
   from W have W': "W' \<in> carrier_mat n n" unfolding W'_def 
     corthogonal_inv_def mat_of_rows_def by auto
   from A W W' have A': "A' \<in> carrier_mat n n" unfolding A'_def by auto
   show "col A' 0 = vec n ?f"
   proof (rule,unfold dim_vec)
     show dim: "dim_vec (col A' 0) = n" using A' by simp
     have row0: "vec_inv v \<bullet> (A *\<^sub>v v) = e"
       using scalar_prod_smult_distrib[OF vec_inv_closed[OF v] v]
       using vec_inv[OF v v0] by auto
     fix i assume i: "i < n"
     hence i2: "i < length ws" using ws by auto
     let ?wsi = "ws ! i"
     have z: "0 < dim_col A'" using A' n by auto
     hence z2: "0 < length ws" using A' ws by auto
     have wsi[simp]: "ws!i : carrier_vec n" using ws i by auto
     hence ws0[simp]: "ws!0 = v" using hd_conv_nth[symmetric] hdws z2 by auto
     have "col A' 0 $ i = A' $$ (i, 0)" using A' i by auto
     also have "... = (W' * (A * W)) $$ (i, 0)" unfolding A'_def using W' A W by auto
     also have "... = row W' i \<bullet> col (A * W) 0"
       apply (subst index_mult_mat) using W W' A i by auto
     also have "row W' i = vec_inv ?wsi"
       unfolding W'_def W_def unfolding corthogonal_inv_def using i ws by auto
     also have "col (A * W) 0 = A *\<^sub>v col W 0" using A W z A' by auto
     also have "col W 0 = v" unfolding W_def using z2 ws0 n col_mat_of_cols v by blast
     also have "A *\<^sub>v v = e \<cdot>\<^sub>v v" using eigen.
     also have "vec_inv ?wsi \<bullet> (e \<cdot>\<^sub>v v) = e * (vec_inv ?wsi \<bullet> v)"
       using scalar_prod_smult_distrib[OF vec_inv_closed[OF wsi] v].
     also have "... = ?f i"
     proof(cases "i = 0")
       case True thus ?thesis using vec_inv[OF v v0] by simp
     next 
       case False
       hence z: "0 < length ws" using i ws by auto
       note cwsi = carrier_vec_conjugate[OF wsi]
       have "vec_inv ?wsi \<bullet> v = 1 / (?wsi \<bullet>c ?wsi) * (conjugate ?wsi \<bullet> v)"
         unfolding vec_inv_def unfolding smult_scalar_prod_distrib[OF cwsi v].. 
       also have "conjugate ?wsi \<bullet> v = v \<bullet>c ?wsi"
         using comm_scalar_prod[OF cwsi v].
       also have "... = 0"
         using corthogonalD[OF ws(2) z i2] False unfolding ws0 by auto
       finally show ?thesis using False by auto
     qed
     also have "... = vec n ?f $ i" using i by simp
     finally show "col A' 0 $ i = vec n ?f $ i" .
   qed
 qed
 
 
 text "Schur decomposition"
 fun schur_decomposition :: "'a::conjugatable_field mat \<Rightarrow> 'a list \<Rightarrow> 'a mat \<times> 'a mat \<times> 'a mat" where 
   "schur_decomposition A [] = (A, 1\<^sub>m (dim_row A), 1\<^sub>m (dim_row A))"
 | "schur_decomposition A (e # es) = (let
        n = dim_row A;
        n1 = n - 1;
        v = find_eigenvector A e;
        ws = gram_schmidt n (basis_completion v);
        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) = 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 schur_decomposition:
   assumes A: "(A::'a::conjugatable_ordered_field mat) \<in> carrier_mat n n"
       and c: "char_poly A = (\<Prod> (e :: 'a) \<leftarrow> es. [:- e, 1:])"
       and B: "schur_decomposition A es = (B,P,Q)"
   shows "similar_mat_wit A B P Q \<and> upper_triangular B \<and> diag_mat B = es"
   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)
 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 b where "b = basis_completion v"
   define ws where "ws = gram_schmidt n b"
   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: "schur_decomposition A3 es = (B,P',Q')" 
     by (cases "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 schur_decomposition.simps
     Let_def list.sel dim
     v_def[symmetric] b_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 .
   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('a)" .
   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 ws_def]
   have ws: "set ws \<subseteq> carrier_vec n" "corthogonal ws" "length ws = n" 
     by (auto simp: len_b)
   from gram_schmidt_hd[OF v, of vs, folded bv] have hdws: "hd ws = v" unfolding ws_def .
   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 find_eigenvector[OF A e] A
     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 signof_def sign_def)
+    by (simp add: A1id char_poly_defs det_def sign_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" 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
   from ut similar_mat_wit_trans[OF simAA' simA'C, folded P Q] diag
   show ?case by blast
 qed
 
 definition schur_upper_triangular :: "'a::conjugatable_field mat \<Rightarrow> 'a list \<Rightarrow> 'a mat" where 
   "schur_upper_triangular A es = (case schur_decomposition A es of (B,_,_) \<Rightarrow> B)"
 
 
 lemma schur_upper_triangular:
   assumes A: "(A :: 'a :: conjugatable_ordered_field mat) \<in> carrier_mat n n"
   and linear: "char_poly A = (\<Prod> a \<leftarrow> es. [:- a, 1:])"
   defines B: "B \<equiv> schur_upper_triangular A es"
   shows "B \<in> carrier_mat n n" "upper_triangular B" "similar_mat A B" 
 proof -
   let ?B = "schur_upper_triangular A es"
   obtain C P Q where schur: "schur_decomposition A es = (C,P,Q)" 
     by (cases "schur_decomposition A es", auto)
   hence B: "B = C" using A unfolding schur_upper_triangular_def B by auto
   from schur_decomposition[OF A linear schur]
   have sim: "similar_mat_wit A B P Q" and B: "upper_triangular B" unfolding B by auto
   from sim show "similar_mat A B" unfolding similar_mat_def by auto
   from similar_mat_witD2[OF A sim] show "B \<in> carrier_mat n n" by auto
   show "upper_triangular B" by fact
 qed
 
 lemma schur_decomposition_exists: assumes A: "A \<in> carrier_mat n n"
   and linear: "char_poly A = (\<Prod> (a :: 'a :: conjugatable_ordered_field) \<leftarrow> es. [:- a, 1:])"
   shows "\<exists> B \<in> carrier_mat n n. upper_triangular B \<and> similar_mat A B" 
   using schur_upper_triangular[OF A linear] by blast
 
 lemma char_poly_0_block: fixes A :: "'a :: conjugatable_ordered_field mat"
   assumes A: "A = four_block_mat B C (0\<^sub>m m n) D"
   and linearB: "\<exists> es. char_poly B = (\<Prod> a \<leftarrow> es. [:- a, 1:])"
   and linearD: "\<exists> es. char_poly D = (\<Prod> a \<leftarrow> es. [:- a, 1:])"
   and B: "B \<in> carrier_mat n n"
   and C: "C \<in> carrier_mat n m"
   and D: "D \<in> carrier_mat m m"
   shows "char_poly A = char_poly B * char_poly D"
 proof -
   from linearB obtain bs where cB: "char_poly B = (\<Prod>a\<leftarrow>bs. [:- a, 1:])" by auto
   from linearD obtain ds where cD: "char_poly D = (\<Prod>a\<leftarrow>ds. [:- a, 1:])" by auto
   from schur_decomposition_exists[OF B cB] 
   obtain B' PB QB where sB: "schur_decomposition B bs = (B',PB,QB)" 
     by (cases "schur_decomposition B bs", auto)
   obtain D' PD QD where sD: "schur_decomposition D ds = (D',PD,QD)" 
     by (cases "schur_decomposition D ds", auto)
   from schur_decomposition[OF B cB sB] similar_mat_witD2[OF B, of B'] have 
     simB: "similar_mat B B'" and utB: "upper_triangular B'" and diagB: "diag_mat B' = bs"
     and B': "B' \<in> carrier_mat n n"
     by (auto simp: similar_mat_def)
   from schur_decomposition[OF D cD sD] similar_mat_witD2[OF D, of D'] have 
     simD: "similar_mat D D'" and utD: "upper_triangular D'" and diagD: "diag_mat D' = ds"
     and D': "D' \<in> carrier_mat m m"
     by (auto simp: similar_mat_def)
   let ?z = "0\<^sub>m m n"
   from similar_mat_four_block_0_ex[OF simB simD C B D, folded A]
     obtain B0 where B0: "B0 \<in> carrier_mat n m" and sim: "similar_mat A (four_block_mat B' B0 ?z D')" 
     by auto
   let ?block = "four_block_mat B' B0 ?z D'"
   let ?cp = char_poly
   let ?prod = "QB * C * PD"
   let ?diag = "\<lambda> A. (\<Prod>a\<leftarrow>diag_mat A. [:- a, 1:])"
   from char_poly_similar[OF sim] have "?cp A = ?cp ?block" by simp
   also have "\<dots> = ?diag ?block"
     by (rule char_poly_upper_triangular[OF four_block_carrier_mat[OF B' D'] upper_triangular_four_block[OF B' D' utB utD]])      
   also have "\<dots> = ?diag B' * ?diag D'" unfolding diag_four_block_mat[OF B' D']
     by auto
   also have "?diag B' = ?cp B'"
     by (subst char_poly_upper_triangular[OF B' utB], simp)
   also have "\<dots> = ?cp B"
     by (rule char_poly_similar[OF similar_mat_sym[OF simB]])
   also have "?diag D' = ?cp D'"
     by (subst char_poly_upper_triangular[OF D' utD], simp)
   also have "\<dots> = ?cp D"
     by (rule char_poly_similar[OF similar_mat_sym[OF simD]])
   finally show ?thesis .
 qed
 
 
 lemma char_poly_0_block': fixes A :: "'a :: conjugatable_ordered_field mat"
   assumes A: "A = four_block_mat B (0\<^sub>m n m) C D"
   and linearB: "\<exists> es. char_poly B = (\<Prod> a \<leftarrow> es. [:- a, 1:])"
   and linearD: "\<exists> es. char_poly D = (\<Prod> a \<leftarrow> es. [:- a, 1:])"
   and B: "B \<in> carrier_mat n n"
   and C: "C \<in> carrier_mat m n"
   and D: "D \<in> carrier_mat m m"
   shows "char_poly A = char_poly B * char_poly D"
 proof -
   let ?A = "four_block_mat B (0\<^sub>m n m) C D"
   let ?B = "transpose_mat B"
   let ?D = "transpose_mat D"
   have AC: "?A \<in> carrier_mat (n + m) (n + m)" using B D by auto
   from arg_cong[OF transpose_four_block_mat[OF B zero_carrier_mat C D], of char_poly,
     unfolded char_poly_transpose_mat[OF AC], folded A]
   have "char_poly A =
     char_poly (four_block_mat ?B (transpose_mat C) (0\<^sub>m m n) ?D)" by auto
   also have "\<dots> = char_poly ?B * char_poly ?D"
     by (rule char_poly_0_block[OF refl], insert B C D linearB linearD, auto)
   also have "\<dots> = char_poly B * char_poly D" using B D
     by simp
   finally show ?thesis .
 qed
 
 end
diff --git a/thys/LLL_Basis_Reduction/Gram_Schmidt_2.thy b/thys/LLL_Basis_Reduction/Gram_Schmidt_2.thy
--- a/thys/LLL_Basis_Reduction/Gram_Schmidt_2.thy
+++ b/thys/LLL_Basis_Reduction/Gram_Schmidt_2.thy
@@ -1,2820 +1,2820 @@
 (*
     Authors:    Ralph Bottesch
                 Jose Divasón
                 Maximilian Haslbeck
                 Sebastiaan Joosten
                 René Thiemann
                 Akihisa Yamada
     License:    BSD
 *)
 
 section \<open>Gram-Schmidt\<close>
 
 theory Gram_Schmidt_2
   imports 
     Jordan_Normal_Form.Gram_Schmidt
     Jordan_Normal_Form.Show_Matrix
     Jordan_Normal_Form.Matrix_Impl
     Norms
     Int_Rat_Operations
 begin
 (* TODO: Documentation and add references to computer algebra book *)
 
 no_notation Group.m_inv  ("inv\<index> _" [81] 80)
 
 (* TODO: Is a function like this already in the library
    find_index is used to rewrite the sumlists in the lattice_of definition to finsums *)
 
 fun find_index :: "'b list \<Rightarrow> 'b \<Rightarrow> nat" where
   "find_index [] _ = 0" |
   "find_index (x#xs) y = (if x = y then 0 else find_index xs y + 1)"
 
 lemma find_index_not_in_set: "x \<notin> set xs \<longleftrightarrow> find_index xs x = length xs"
   by (induction xs) auto
 
 lemma find_index_in_set: "x \<in> set xs \<Longrightarrow> xs ! (find_index xs x) = x"
   by (induction xs) auto
 
 lemma find_index_inj: "inj_on (find_index xs) (set xs)"
   by (induction xs) (auto simp add: inj_on_def)
 
 lemma find_index_leq_length: "find_index xs x < length xs \<longleftrightarrow> x \<in> set xs"
   by (induction xs) (auto)
 
 
 (* TODO: move *)
 
 lemma rev_unsimp: "rev xs @ (r # rs) = rev (r#xs) @ rs" by(induct xs,auto)
 
 
 (* TODO: unify *)
 
 lemma corthogonal_is_orthogonal[simp]: 
   "corthogonal (xs :: 'a :: trivial_conjugatable_ordered_field vec list) = orthogonal xs"
   unfolding corthogonal_def orthogonal_def by simp
 
 
 (* TODO: move *)
 
 context vec_module begin
 
 definition lattice_of :: "'a vec list \<Rightarrow> 'a vec set" where
   "lattice_of fs = range (\<lambda> c. sumlist (map (\<lambda> i. of_int (c i) \<cdot>\<^sub>v fs ! i) [0 ..< length fs]))"
 
 lemma lattice_of_finsum:
   assumes "set fs \<subseteq> carrier_vec n"
   shows "lattice_of fs = range (\<lambda> c. finsum V (\<lambda> i. of_int (c i) \<cdot>\<^sub>v fs ! i) {0 ..< length fs})"
 proof -
   have "sumlist (map (\<lambda> i. of_int (c i) \<cdot>\<^sub>v fs ! i) [0 ..< length fs])
         = finsum V (\<lambda> i. of_int (c i) \<cdot>\<^sub>v fs ! i) {0 ..< length fs}" for c
     using  assms by (subst sumlist_map_as_finsum) (fastforce)+
   then show ?thesis
     unfolding lattice_of_def by auto
 qed
 
 lemma in_latticeE: assumes "f \<in> lattice_of fs" obtains c where
     "f = sumlist (map (\<lambda> i. of_int (c i) \<cdot>\<^sub>v fs ! i) [0 ..< length fs])" 
   using assms unfolding lattice_of_def by auto
     
 lemma in_latticeI: assumes "f = sumlist (map (\<lambda> i. of_int (c i) \<cdot>\<^sub>v fs ! i) [0 ..< length fs])" 
   shows "f \<in> lattice_of fs" 
   using assms unfolding lattice_of_def by auto
 
 lemma finsum_over_indexes_to_vectors:
   assumes "set vs \<subseteq> carrier_vec n" "l = length vs"
   shows "\<exists>c. (\<Oplus>\<^bsub>V\<^esub>x\<in>{0..<l}. of_int (g x) \<cdot>\<^sub>v vs ! x) = (\<Oplus>\<^bsub>V\<^esub>v\<in>set vs. of_int (c v) \<cdot>\<^sub>v v)"
   using assms proof (induction l arbitrary: vs)
   case (Suc l)
   then obtain vs' v where vs'_def: "vs = vs' @ [v]"
     by (metis Zero_not_Suc length_0_conv rev_exhaust)
   have c: "\<exists>c. (\<Oplus>\<^bsub>V\<^esub>i\<in>{0..<l}. of_int (g i) \<cdot>\<^sub>v vs' ! i) = (\<Oplus>\<^bsub>V\<^esub>v\<in>set vs'. of_int (c v) \<cdot>\<^sub>v v)"
     using Suc vs'_def by (auto)
   then obtain c 
     where c_def: "(\<Oplus>\<^bsub>V\<^esub>x\<in>{0..<l}. of_int (g x) \<cdot>\<^sub>v vs' ! x) = (\<Oplus>\<^bsub>V\<^esub>v\<in>set vs'. of_int (c v) \<cdot>\<^sub>v v)"
     by blast
   have "(\<Oplus>\<^bsub>V\<^esub>x\<in>{0..<Suc l}. of_int (g x) \<cdot>\<^sub>v vs ! x) 
         = of_int (g l) \<cdot>\<^sub>v vs ! l + (\<Oplus>\<^bsub>V\<^esub>x\<in>{0..<l}. of_int (g x) \<cdot>\<^sub>v vs ! x)"
      using Suc by (subst finsum_insert[symmetric]) (fastforce intro!: finsum_cong')+
   also have "vs = vs' @ [v]"
     using vs'_def by simp
   also have "(\<Oplus>\<^bsub>V\<^esub>x\<in>{0..<l}. of_int (g x) \<cdot>\<^sub>v (vs' @ [v]) ! x) = (\<Oplus>\<^bsub>V\<^esub>x\<in>{0..<l}. of_int (g x) \<cdot>\<^sub>v vs' ! x)"
     using Suc vs'_def by (intro finsum_cong') (auto simp add: in_mono append_Cons_nth_left)
   also note c_def
   also have "(vs' @ [v]) ! l = v"
     using Suc vs'_def by auto
   also have "\<exists>d'. of_int (g l) \<cdot>\<^sub>v v + (\<Oplus>\<^bsub>V\<^esub>v\<in>set vs'. of_int (c v) \<cdot>\<^sub>v v) = (\<Oplus>\<^bsub>V\<^esub>v\<in>set vs. of_int (d' v) \<cdot>\<^sub>v v)"
   proof (cases "v \<in> set vs'")
     case True
     then have I: "set vs' = insert v (set vs' - {v})"
       by blast
     define c' where "c' x = (if x = v then c x + g l else c x)" for x
     have "of_int (g l) \<cdot>\<^sub>v v + (\<Oplus>\<^bsub>V\<^esub>v\<in>set vs'. of_int (c v) \<cdot>\<^sub>v v)
           = of_int (g l) \<cdot>\<^sub>v v + (of_int (c v) \<cdot>\<^sub>v v + (\<Oplus>\<^bsub>V\<^esub>v\<in>set vs' - {v}. of_int (c v) \<cdot>\<^sub>v v))"
       using Suc vs'_def by (subst I, subst finsum_insert) fastforce+
     also have "\<dots> = of_int (g l) \<cdot>\<^sub>v v + of_int (c v) \<cdot>\<^sub>v v + (\<Oplus>\<^bsub>V\<^esub>v\<in>set vs' - {v}. of_int (c v) \<cdot>\<^sub>v v)"
       using Suc vs'_def by (subst a_assoc) (auto intro!: finsum_closed)
     also have "of_int (g l) \<cdot>\<^sub>v v + of_int (c v) \<cdot>\<^sub>v v = of_int (c' v)  \<cdot>\<^sub>v v"
       unfolding c'_def by (auto simp add: add_smult_distrib_vec)
     also have "(\<Oplus>\<^bsub>V\<^esub>v\<in>set vs' - {v}. of_int (c v) \<cdot>\<^sub>v v) = (\<Oplus>\<^bsub>V\<^esub>v\<in>set vs' - {v}. of_int (c' v) \<cdot>\<^sub>v v)"
       using Suc vs'_def unfolding c'_def by (intro finsum_cong') (auto)
     also have "of_int (c' v) \<cdot>\<^sub>v v + (\<Oplus>\<^bsub>V\<^esub>v\<in>set vs' - {v}. of_int (c' v) \<cdot>\<^sub>v v)
                = (\<Oplus>\<^bsub>V\<^esub>v\<in>insert v (set vs'). of_int (c' v) \<cdot>\<^sub>v v)"
       using Suc vs'_def by (subst finsum_insert[symmetric]) (auto)
     finally show ?thesis
       using vs'_def by force
   next
     case False
     define c' where "c' x = (if x = v then g l else c x)" for x
     have "of_int (g l) \<cdot>\<^sub>v v + (\<Oplus>\<^bsub>V\<^esub>v\<in>set vs'. of_int (c v) \<cdot>\<^sub>v v)
           = of_int (c' v) \<cdot>\<^sub>v v + (\<Oplus>\<^bsub>V\<^esub>v\<in>set vs'. of_int (c v) \<cdot>\<^sub>v v)"
       unfolding c'_def by simp
     also have "(\<Oplus>\<^bsub>V\<^esub>v\<in>set vs'. of_int (c v) \<cdot>\<^sub>v v) = (\<Oplus>\<^bsub>V\<^esub>v\<in>set vs'. of_int (c' v) \<cdot>\<^sub>v v)"
       unfolding c'_def using Suc False vs'_def by (auto intro!: finsum_cong')
     also have "of_int (c' v) \<cdot>\<^sub>v v + (\<Oplus>\<^bsub>V\<^esub>v\<in>set vs'. of_int (c' v) \<cdot>\<^sub>v v)
                = (\<Oplus>\<^bsub>V\<^esub>v\<in>insert v (set vs'). of_int (c' v) \<cdot>\<^sub>v v)"
       using False Suc vs'_def by (subst finsum_insert[symmetric]) (auto)
     also have "(\<Oplus>\<^bsub>V\<^esub>v\<in>set vs'. of_int (c' v) \<cdot>\<^sub>v v) = (\<Oplus>\<^bsub>V\<^esub>v\<in>set vs'. of_int (c v) \<cdot>\<^sub>v v)"
       unfolding c'_def using False Suc vs'_def by (auto intro!: finsum_cong')
     finally show ?thesis
       using vs'_def by auto
   qed
   finally show ?case
     unfolding vs'_def by blast
 qed (auto)
 
 lemma lattice_of_altdef:
   assumes "set vs \<subseteq> carrier_vec n"
   shows "lattice_of vs = range (\<lambda>c. \<Oplus>\<^bsub>V\<^esub>v\<in>set vs. of_int (c v) \<cdot>\<^sub>v v)"
 proof -
   have "v \<in> lattice_of vs" if "v \<in> range (\<lambda>c. \<Oplus>\<^bsub>V\<^esub>v\<in>set vs. of_int (c v) \<cdot>\<^sub>v v)" for v
   proof -
     obtain c where v: "v = (\<Oplus>\<^bsub>V\<^esub>v\<in>set vs. of_int (c v) \<cdot>\<^sub>v v)"
       using \<open>v \<in> range (\<lambda>c. \<Oplus>\<^bsub>V\<^esub>v\<in>set vs. of_int (c v) \<cdot>\<^sub>v v)\<close> by (auto)
     define c' where "c' i = (if find_index vs (vs ! i) = i then c (vs ! i) else 0)" for i
     have "v = (\<Oplus>\<^bsub>V\<^esub>v\<in>set vs. of_int (c' (find_index vs v)) \<cdot>\<^sub>v vs ! (find_index vs v))"
       unfolding v
       using assms by (auto intro!: finsum_cong' simp add: c'_def find_index_in_set in_mono)
     also have "\<dots> = (\<Oplus>\<^bsub>V\<^esub>i\<in>find_index vs ` (set vs). of_int (c' i) \<cdot>\<^sub>v vs ! i)"
       using assms find_index_in_set find_index_inj by (subst finsum_reindex) fastforce+
     also have "\<dots> = (\<Oplus>\<^bsub>V\<^esub>i\<in>set [0..<length vs]. of_int (c' i) \<cdot>\<^sub>v vs ! i)"
     proof -
       have "i \<in> find_index vs ` set vs" if "i < length vs" "find_index vs (vs ! i) = i" for i
         using that by (metis imageI nth_mem)
       then show ?thesis
         unfolding c'_def using find_index_leq_length assms 
         by (intro add.finprod_mono_neutral_cong_left) (auto simp add: in_mono find_index_leq_length)
     qed
     also have "\<dots> = sumlist (map (\<lambda>i. of_int (c' i) \<cdot>\<^sub>v vs ! i) [0..<length vs])"
       using assms by (subst sumlist_map_as_finsum) (fastforce)+
     finally show ?thesis
       unfolding lattice_of_def by blast
   qed
   moreover have "v \<in> range (\<lambda>c. \<Oplus>\<^bsub>V\<^esub>v\<in>set vs. of_int (c v) \<cdot>\<^sub>v v)" if "v \<in> lattice_of vs" for v
   proof -
     obtain c where "v = sumlist (map (\<lambda>i. of_int (c i) \<cdot>\<^sub>v vs ! i) [0..<length vs])"
       using \<open>v \<in> lattice_of vs\<close> unfolding lattice_of_def by (auto)
     also have "\<dots> = (\<Oplus>\<^bsub>V\<^esub>x\<in>{0..<length vs}. of_int (c x) \<cdot>\<^sub>v vs ! x)"
       using that assms by (subst sumlist_map_as_finsum) fastforce+
     also obtain d where  "\<dots> = (\<Oplus>\<^bsub>V\<^esub>v\<in>set vs. of_int (d v) \<cdot>\<^sub>v v)"
       using finsum_over_indexes_to_vectors assms by blast
     finally show ?thesis
       by blast
   qed
   ultimately show ?thesis
     by fastforce
 qed
 
 lemma basis_in_latticeI:
   assumes fs: "set fs \<subseteq> carrier_vec n" and "f \<in> set fs" 
   shows "f \<in> lattice_of fs"
 proof -
   define c :: "'a vec \<Rightarrow> int" where "c v = (if v = f then 1 else 0)" for v
   have "f = (\<Oplus>\<^bsub>V\<^esub>v\<in>{f}. of_int (c v) \<cdot>\<^sub>v v)"
     using assms by (auto simp add: c_def)
   also have "\<dots> = (\<Oplus>\<^bsub>V\<^esub>v\<in>set fs. of_int (c v) \<cdot>\<^sub>v v)"
     using assms by (intro add.finprod_mono_neutral_cong_left) (auto simp add: c_def)
   finally show ?thesis
     using assms lattice_of_altdef by blast
 qed
 
 lemma lattice_of_eq_set:
   assumes "set fs = set gs" "set fs \<subseteq> carrier_vec n"
   shows "lattice_of fs = lattice_of gs"
   using assms lattice_of_altdef by simp
 
 lemma lattice_of_swap: assumes fs: "set fs \<subseteq> carrier_vec n" 
   and ij: "i < length fs" "j < length fs" "i \<noteq> j" 
   and gs: "gs = fs[ i := fs ! j, j := fs ! i]" 
 shows "lattice_of gs = lattice_of fs"
   using assms mset_swap by (intro lattice_of_eq_set) auto
 
 lemma lattice_of_add: assumes fs: "set fs \<subseteq> carrier_vec n" 
   and ij: "i < length fs" "j < length fs" "i \<noteq> j" 
   and gs: "gs = fs[ i := fs ! i + of_int l \<cdot>\<^sub>v fs ! j]" 
 shows "lattice_of gs = lattice_of fs"
 proof -
   {
     fix i j l and fs :: "'a vec list" 
     assume *: "i < j" "j < length fs" and fs: "set fs \<subseteq> carrier_vec n"
     note * = ij(1) *
     let ?gs = "fs[ i := fs ! i + of_int l \<cdot>\<^sub>v fs ! j]"
     let ?len = "[0..<i] @ [i] @ [Suc i..<j] @ [j] @ [Suc j..<length fs]" 
     have "[0 ..< length fs] = [0 ..< j] @ [j] @ [Suc j ..< length fs]" using *
       by (metis append_Cons append_self_conv2 less_Suc_eq_le less_imp_add_positive upt_add_eq_append 
           upt_conv_Cons zero_less_Suc)
     also have "[0 ..< j] = [0 ..< i] @ [i] @ [Suc i ..< j]" using *
       by (metis append_Cons append_self_conv2 less_Suc_eq_le less_imp_add_positive upt_add_eq_append 
           upt_conv_Cons zero_less_Suc)
     finally have len: "[0..<length fs] = ?len" by simp
     from fs have fs: "\<And> i. i < length fs \<Longrightarrow> fs ! i \<in> carrier_vec n" unfolding set_conv_nth by auto
     from fs have fsd: "\<And> i. i < length fs \<Longrightarrow> dim_vec (fs ! i) = n" by auto
     from fsd[of i] fsd[of j] * have fsd: "dim_vec (fs ! i) = n" "dim_vec (fs ! j) = n" by auto
     {
       fix f
       assume "f \<in> lattice_of fs" 
       from in_latticeE[OF this, unfolded len] obtain c where
         f: "f = sumlist (map (\<lambda>i. of_int (c i) \<cdot>\<^sub>v fs ! i) ?len)" by auto
       define sc where "sc = (\<lambda> xs. sumlist (map (\<lambda>i. of_int (c i) \<cdot>\<^sub>v fs ! i) xs))"
       define d where "d = (\<lambda> k. if k = j then c j - c i * l else c k)"
       define sd where "sd = (\<lambda> xs. sumlist (map (\<lambda>i. of_int (d i) \<cdot>\<^sub>v ?gs ! i) xs))"
       have isc: "set is \<subseteq> {0 ..< length fs} \<Longrightarrow> sc is \<in> carrier_vec n" for "is" 
         unfolding sc_def by (intro sumlist_carrier, auto simp: fs)
       have isd: "set is \<subseteq> {0 ..< length fs} \<Longrightarrow> sd is \<in> carrier_vec n" for "is" 
         unfolding sd_def using * by (intro sumlist_carrier, auto, rename_tac k,
         case_tac "k = i", auto simp: fs)
       let ?a = "sc [0..<i]" let ?b = "sc [i]" let ?c = "sc [Suc i ..< j]" let ?d = "sc [j]" 
       let ?e = "sc [Suc j ..< length fs]" 
       let ?A = "sd [0..<i]" let ?B = "sd [i]" let ?C = "sd [Suc i ..< j]" let ?D = "sd [j]" 
       let ?E = "sd [Suc j ..< length fs]" 
       let ?CC = "carrier_vec n" 
       have ae: "?a \<in> ?CC" "?b \<in> ?CC" "?c \<in> ?CC" "?d \<in> ?CC" "?e \<in> ?CC"  
         using * by (auto intro: isc)
       have AE: "?A \<in> ?CC" "?B \<in> ?CC" "?C \<in> ?CC" "?D \<in> ?CC" "?E \<in> ?CC"  
         using * by (auto intro: isd)
       have sc_sd: "{i,j} \<inter> set is \<subseteq> {} \<Longrightarrow> sc is = sd is" for "is" 
         unfolding sc_def sd_def by (rule arg_cong[of _ _ sumlist], rule map_cong, auto simp: d_def,
         rename_tac k, case_tac "i = k", auto)
       have "f = ?a + (?b + (?c + (?d + ?e)))"         
         unfolding f map_append sc_def using fs *
         by ((subst sumlist_append, force, force)+, simp)
       also have "\<dots> = ?a + ((?b + ?d) + (?c + ?e))" using ae by auto          
       also have "\<dots> = ?A + ((?b + ?d) + (?C + ?E))" 
         using * by (auto simp: sc_sd)
       also have "?b + ?d = ?B + ?D" unfolding sd_def sc_def d_def sumlist_def
         by (rule eq_vecI, insert * fsd, auto simp: algebra_simps)
       finally have "f = ?A + (?B + (?C + (?D + ?E)))" using AE by auto
       also have "\<dots> = sumlist (map (\<lambda>i. of_int (d i) \<cdot>\<^sub>v ?gs ! i) ?len)" 
         unfolding f map_append sd_def using fs *
         by ((subst sumlist_append, force, force)+, simp)
       also have "\<dots> = sumlist (map (\<lambda>i. of_int (d i) \<cdot>\<^sub>v ?gs ! i) [0 ..< length ?gs])"
         unfolding len[symmetric] by simp
       finally have "f = sumlist (map (\<lambda>i. of_int (d i) \<cdot>\<^sub>v ?gs ! i) [0 ..< length ?gs])" .
       from in_latticeI[OF this] have "f \<in> lattice_of ?gs" .
     }
     hence "lattice_of fs \<subseteq> lattice_of ?gs" by blast
   } note main = this 
   {
     fix i j and fs :: "'a vec list" 
     assume *: "i < j" "j < length fs" and fs: "set fs \<subseteq> carrier_vec n"
     let ?gs = "fs[ i := fs ! i + of_int l \<cdot>\<^sub>v fs ! j]"
     define gs where "gs = ?gs" 
     from main[OF * fs, of l, folded gs_def]
     have one: "lattice_of fs \<subseteq> lattice_of gs" .
     have *: "i < j" "j < length gs" "set gs \<subseteq> carrier_vec n" using * fs unfolding gs_def set_conv_nth
       by (auto, rename_tac k, case_tac "k = i", (force intro!: add_carrier_vec)+)
     from fs have fs: "\<And> i. i < length fs \<Longrightarrow> fs ! i \<in> carrier_vec n" unfolding set_conv_nth by auto
     from fs have fsd: "\<And> i. i < length fs \<Longrightarrow> dim_vec (fs ! i) = n" by auto
     from fsd[of i] fsd[of j] * have fsd: "dim_vec (fs ! i) = n" "dim_vec (fs ! j) = n" by (auto simp: gs_def)
     from main[OF *, of "-l"]
     have "lattice_of gs \<subseteq> lattice_of (gs[i := gs ! i + of_int (- l) \<cdot>\<^sub>v gs ! j])" .
     also have "gs[i := gs ! i + of_int (- l) \<cdot>\<^sub>v gs ! j] = fs" unfolding gs_def
       by (rule nth_equalityI, auto, insert * fsd, rename_tac k, case_tac "k = i", auto)
     ultimately have "lattice_of fs = lattice_of ?gs" using one unfolding gs_def by auto
   } note main = this
   show ?thesis
   proof (cases "i < j")
     case True
     from main[OF this ij(2) fs] show ?thesis unfolding gs by simp
   next
     case False
     with ij have ji: "j < i" by auto
     define hs where "hs = fs[i := fs ! j, j := fs ! i]" 
     define ks where "ks = hs[j := hs ! j + of_int l \<cdot>\<^sub>v hs ! i]" 
     from ij fs have ij': "i < length hs" "set hs \<subseteq> carrier_vec n" unfolding hs_def by auto
     hence ij'': "set ks \<subseteq> carrier_vec n" "i < length ks" "j < length ks" "i \<noteq> j" 
       using ji unfolding ks_def set_conv_nth by (auto, rename_tac k, case_tac "k = i", 
         force, case_tac "k = j", (force intro!: add_carrier_vec)+)
     from lattice_of_swap[OF fs ij refl] 
     have "lattice_of fs = lattice_of hs" unfolding hs_def by auto
     also have "\<dots> = lattice_of ks" 
       using main[OF ji ij'] unfolding ks_def .
     also have "\<dots> = lattice_of (ks[i := ks ! j, j := ks ! i])" 
       by (rule sym, rule lattice_of_swap[OF ij'' refl])
     also have "ks[i := ks ! j, j := ks ! i] = gs" unfolding gs ks_def hs_def
       by (rule nth_equalityI, insert ij, auto, 
        rename_tac k, case_tac "k = i", force, case_tac "k = j", auto)
     finally show ?thesis by simp
   qed
 qed
 
 definition "orthogonal_complement W = {x. x \<in> carrier_vec n \<and> (\<forall>y \<in> W. x \<bullet> y = 0)}"
 
 lemma orthogonal_complement_subset:
   assumes "A \<subseteq> B"
   shows "orthogonal_complement B \<subseteq> orthogonal_complement A"
 unfolding orthogonal_complement_def using assms by auto
 
 end
 
 context vec_space
 begin
 
 
 lemma in_orthogonal_complement_span[simp]:
   assumes [intro]:"S \<subseteq> carrier_vec n"
   shows "orthogonal_complement (span S) = orthogonal_complement S"
 proof
   show "orthogonal_complement (span S) \<subseteq> orthogonal_complement S"
     by(fact orthogonal_complement_subset[OF in_own_span[OF assms]])
   {fix x :: "'a vec"
     fix a fix A :: "'a vec set"
     assume x [intro]:"x \<in> carrier_vec n" and f: "finite A" and S:"A \<subseteq> S"
     assume i0:"\<forall>y\<in>S. x \<bullet> y = 0"
     have "x \<bullet> lincomb a A = 0"
       unfolding comm_scalar_prod[OF x lincomb_closed[OF subset_trans[OF S assms]]]
     proof(insert S,atomize(full),rule finite_induct[OF f],goal_cases)
       case 1 thus ?case using assms x by force
     next
       case (2 f F)
       { assume i:"insert f F \<subseteq> S"
         hence F:"F \<subseteq> S" and f: "f \<in> S" by auto
         from F f assms
         have [intro]:"F \<subseteq> carrier_vec n"
           and fc[intro]:"f \<in> carrier_vec n"
           and [intro]:"x \<in> F \<Longrightarrow> x \<in> carrier_vec n" for x by auto
         have laf:"lincomb a F \<bullet> x = 0" using F 2 by auto
         have [simp]:"(\<Sum>u\<in>F. (a u \<cdot>\<^sub>v u) \<bullet> x) = 0"
           by(insert laf[unfolded lincomb_def],atomize(full),subst finsum_scalar_prod_sum) auto
         from f i0 have [simp]:"f \<bullet> x = 0" by (subst comm_scalar_prod) auto
         from lincomb_closed[OF subset_trans[OF i assms]]
         have "lincomb a (insert f F) \<bullet> x = 0" unfolding lincomb_def
           apply(subst finsum_scalar_prod_sum,force,force)
           using 2(1,2) smult_scalar_prod_distrib[OF fc x] by auto
       } thus ?case by auto
       qed
   }
   thus "orthogonal_complement S \<subseteq> orthogonal_complement (span S)"
     unfolding orthogonal_complement_def span_def by auto
 qed
 
 end
 
 context cof_vec_space
 begin
 
 definition lin_indpt_list :: "'a vec list \<Rightarrow> bool" where
   "lin_indpt_list fs = (set fs \<subseteq> carrier_vec n \<and> distinct fs \<and> lin_indpt (set fs))" 
 
 definition basis_list :: "'a vec list \<Rightarrow> bool" where
   "basis_list fs = (set fs \<subseteq> carrier_vec n \<and> length fs = n \<and> carrier_vec n \<subseteq> span (set fs))"
 
 lemma upper_triangular_imp_lin_indpt_list:
   assumes A: "A \<in> carrier_mat n n"
     and tri: "upper_triangular A"
     and diag: "0 \<notin> set (diag_mat A)"
   shows "lin_indpt_list (rows A)"
   using upper_triangular_imp_distinct[OF assms]
   using upper_triangular_imp_lin_indpt_rows[OF assms] A
   unfolding lin_indpt_list_def by (auto simp: rows_def)
 
 lemma basis_list_basis: assumes "basis_list fs" 
   shows "distinct fs" "lin_indpt (set fs)" "basis (set fs)" 
 proof -
   from assms[unfolded basis_list_def] 
   have len: "length fs = n" and C: "set fs \<subseteq> carrier_vec n" 
     and span: "carrier_vec n \<subseteq> span (set fs)" by auto
   show b: "basis (set fs)" 
   proof (rule dim_gen_is_basis[OF finite_set C])
     show "card (set fs) \<le> dim" unfolding dim_is_n unfolding len[symmetric] by (rule card_length)
     show "span (set fs) = carrier_vec n" using span C by auto
   qed
   thus "lin_indpt (set fs)" unfolding basis_def by auto  
   show "distinct fs" 
   proof (rule ccontr)
     assume "\<not> distinct fs" 
     hence "card (set fs) < length fs" using antisym_conv1 card_distinct card_length by auto
     also have "\<dots> = dim" unfolding len dim_is_n ..
     finally have "card (set fs) < dim" by auto
     also have "\<dots> \<le> card (set fs)" using span finite_set[of fs] 
       using b basis_def gen_ge_dim by auto
     finally show False by simp
   qed
 qed
 
 lemma basis_list_imp_lin_indpt_list: assumes "basis_list fs" shows "lin_indpt_list fs" 
   using basis_list_basis[OF assms] assms unfolding lin_indpt_list_def basis_list_def by auto
 
 lemma basis_det_nonzero:
   assumes db:"basis (set G)" and len:"length G = n"
   shows "det (mat_of_rows n G) \<noteq> 0"
 proof -
   have M_car1:"mat_of_rows n G \<in> carrier_mat n n" using assms by auto
   hence M_car:"(mat_of_rows n G)\<^sup>T \<in> carrier_mat n n" by auto
   have li:"lin_indpt (set G)"
    and inc_2:"set G \<subseteq> carrier_vec n"
    and issp:"carrier_vec n = span (set G)"
    and RG_in_carr:"\<And>i. i < length G \<Longrightarrow> G ! i \<in> carrier_vec n"
     using assms[unfolded basis_def] by auto
   hence "basis_list G" unfolding basis_list_def using len by auto
   from basis_list_basis[OF this] have di:"distinct G" by auto
   have "det ((mat_of_rows n G)\<^sup>T) \<noteq> 0" unfolding det_0_iff_vec_prod_zero[OF M_car] 
   proof
     assume "\<exists>v. v \<in> carrier_vec n \<and> v \<noteq> 0\<^sub>v n \<and> (mat_of_rows n G)\<^sup>T *\<^sub>v v = 0\<^sub>v n"
     then obtain v where v:"v \<in> span (set G)"
                           "v \<noteq> 0\<^sub>v n" "(mat_of_rows n G)\<^sup>T *\<^sub>v v = 0\<^sub>v n"
       unfolding issp by blast
     from finite_in_span[OF finite_set inc_2 v(1)] obtain a
       where aA: "v = lincomb a (set G)" by blast
     from v(1,2)[folded issp] obtain i where i:"v $ i \<noteq> 0" "i < n" by fastforce
     hence inG:"G ! i \<in> set G" using len by auto
     have di2: "distinct [0..<length G]" by auto
     define f where "f = (\<lambda>l. \<Sum>i \<in> set [0..<length G]. if l = G ! i then v $ i else 0)"
     hence f':"f (G ! i) = (\<Sum>ia\<leftarrow>[0..<n]. if G ! ia = G ! i then v $ ia else 0)"
       unfolding f_def sum.distinct_set_conv_list[OF di2] unfolding len by metis
     from v have "mat_of_cols n G *\<^sub>v v = 0\<^sub>v n"
       unfolding transpose_mat_of_rows by auto
     with mat_of_cols_mult_as_finsum[OF v(1)[folded issp len] RG_in_carr]
     have f:"lincomb f (set G) = 0\<^sub>v n" unfolding len f_def by auto
     note [simp] = list_trisect[OF i(2)[folded len],unfolded len]
     note x = i(2)[folded len]
     have [simp]:"(\<Sum>x\<leftarrow>[0..<i]. if G ! x = G ! i then v $ x else 0) = 0"
       by (rule sum_list_0,auto simp: nth_eq_iff_index_eq[OF di less_trans[OF _ x] x])
     have [simp]:"(\<Sum>x\<leftarrow>[Suc i..<n]. if G ! x = G ! i then v $ x else 0) = 0"
       apply (rule sum_list_0) using nth_eq_iff_index_eq[OF di _ x] len by auto
     from i(1) have "f (G ! i) \<noteq> 0" unfolding f' by auto
   from lin_dep_crit[OF finite_set subset_refl TrueI inG this f]
     have "lin_dep (set G)".
     thus False using li by auto
   qed
   thus det0:"det (mat_of_rows n G) \<noteq> 0" by (unfold det_transpose[OF M_car1])
 qed
 
 lemma lin_indpt_list_add_vec: assumes  
       i: "j < length us" "i < length us" "i \<noteq> j" 
    and indep: "lin_indpt_list  us" 
 shows "lin_indpt_list (us [i := us ! i + c \<cdot>\<^sub>v us ! j])" (is "lin_indpt_list ?V")
 proof -
   from indep[unfolded lin_indpt_list_def] have us: "set us \<subseteq> carrier_vec n" 
     and dist: "distinct us" and indep: "lin_indpt (set us)" by auto
   let ?E = "set us - {us ! i}" 
   let ?us = "insert (us ! i) ?E"
   let ?v = "us ! i + c \<cdot>\<^sub>v us ! j"     
   from us i have usi: "us ! i \<in> carrier_vec n" "us ! i \<notin> ?E" "us ! i \<in> set us" 
     and usj: "us ! j \<in> carrier_vec n" by auto
   from usi usj have v: "?v \<in> carrier_vec n" by auto      
   have fin: "finite ?E" by auto
   have id: "set us = insert (us ! i) (set us - {us ! i})" using i(2) by auto
   from dist i have diff': "us ! i \<noteq> us ! j" unfolding distinct_conv_nth by auto
   from subset_li_is_li[OF indep] have indepE: "lin_indpt ?E" by auto
   have Vid: "set ?V = insert ?v ?E" using set_update_distinct[OF dist i(2)] by auto
   have E: "?E \<subseteq> carrier_vec n" using us by auto
   have V: "set ?V \<subseteq> carrier_vec n" using us v unfolding Vid by auto
   from dist i have diff: "us ! i \<noteq> us ! j" unfolding distinct_conv_nth by auto
   have vspan: "?v \<notin> span ?E"
   proof
     assume mem: "?v \<in> span ?E" 
     from diff i have "us ! j \<in> ?E" by auto
     hence "us ! j \<in> span ?E" using E by (metis span_mem)
     hence "- c \<cdot>\<^sub>v us ! j \<in> span ?E" using smult_in_span[OF E] by auto
     from span_add1[OF E mem this] have "?v + (- c \<cdot>\<^sub>v us ! j) \<in> span ?E" .
     also have "?v + (- c \<cdot>\<^sub>v us ! j) = us ! i" using usi usj by auto
     finally have mem: "us ! i \<in> span ?E" .
     from in_spanE[OF this] obtain a A where lc: "us ! i = lincomb a A" and A: "finite A" 
       "A \<subseteq> set us - {us ! i}" 
       by auto
     let ?a = "a (us ! i := -1)" let ?A = "insert (us ! i) A" 
     from A have fin: "finite ?A" by auto
     have lc: "lincomb ?a A = us ! i" unfolding lc
       by (rule lincomb_cong, insert A us lc, auto)
     have "lincomb ?a ?A = 0\<^sub>v n" 
       by (subst lincomb_insert2[OF A(1)], insert A us lc usi diff, auto)
     from not_lindepD[OF indep _ _ _ this] A usi 
     show False by auto
   qed
   hence vmem: "?v \<notin> ?E" using span_mem[OF E, of ?v] by auto
   from lin_dep_iff_in_span[OF E indepE v this] vspan 
   have indep1: "lin_indpt (set ?V)" unfolding Vid by auto
   from vmem dist have "distinct ?V" by (metis distinct_list_update)
   with indep1 V show ?thesis unfolding lin_indpt_list_def by auto
 qed
 
 lemma scalar_prod_lincomb_orthogonal: assumes ortho: "orthogonal gs" and gs: "set gs \<subseteq> carrier_vec n"
   shows "k \<le> length gs \<Longrightarrow> sumlist (map (\<lambda> i. g i \<cdot>\<^sub>v gs ! i) [0 ..< k]) \<bullet> sumlist (map (\<lambda> i. h i \<cdot>\<^sub>v gs ! i) [0 ..< k])
   = sum_list (map (\<lambda> i. g i * h i * (gs ! i \<bullet> gs ! i)) [0 ..< k])"
 proof (induct k)
   case (Suc k)
   note ortho = orthogonalD[OF ortho]
   let ?m = "length gs" 
   from gs Suc(2) have gsi[simp]: "\<And> i. i \<le> k \<Longrightarrow> gs ! i \<in> carrier_vec n" by auto
   from Suc have kn: "k \<le> ?m" and k: "k < ?m" by auto
   let ?v1 = "sumlist (map (\<lambda>i. g i \<cdot>\<^sub>v gs ! i) [0..<k])" 
   let ?v2 = "(g k \<cdot>\<^sub>v gs ! k)" 
   let ?w1 = "sumlist (map (\<lambda>i. h i \<cdot>\<^sub>v gs ! i) [0..<k])" 
   let ?w2 = "(h k \<cdot>\<^sub>v gs ! k)" 
   from Suc have id: "[0 ..< Suc k] = [0 ..< k] @ [k]" by simp
   have id: "sumlist (map (\<lambda>i. g i \<cdot>\<^sub>v gs ! i) [0..<Suc k]) = ?v1 + ?v2"
      "sumlist (map (\<lambda>i. h i \<cdot>\<^sub>v gs ! i) [0..<Suc k]) = ?w1 + ?w2"
     unfolding id map_append
     by (subst sumlist_append, insert Suc(2), auto)+
   have v1: "?v1 \<in> carrier_vec n" by (rule sumlist_carrier, insert Suc(2), auto)
   have v2: "?v2 \<in> carrier_vec n" by (insert Suc(2), auto)
   have w1: "?w1 \<in> carrier_vec n" by (rule sumlist_carrier, insert Suc(2), auto)
   have w2: "?w2 \<in> carrier_vec n" by (insert Suc(2), auto)
   have gsk: "gs ! k \<in> carrier_vec n" by simp
   have v12: "?v1 + ?v2 \<in> carrier_vec n" using v1 v2 by auto
   have w12: "?w1 + ?w2 \<in> carrier_vec n" using w1 w2 by auto
   have 0: "\<And> g h. i < k \<Longrightarrow> (g \<cdot>\<^sub>v gs ! i) \<bullet> (h \<cdot>\<^sub>v gs ! k) = 0" for i
     by (subst scalar_prod_smult_distrib[OF _ gsk], (insert k, auto)[1],
     subst smult_scalar_prod_distrib[OF _ gsk], (insert k, auto)[1], insert ortho[of i k] k, auto)
   have 1: "?v1 \<bullet> ?w2 = 0" 
     by (subst scalar_prod_left_sum_distrib[OF _ w2], (insert Suc(2), auto)[1], rule sum_list_neutral, 
         insert 0, auto)   
   have 2: "?v2 \<bullet> ?w1 = 0" unfolding comm_scalar_prod[OF v2 w1]
     apply (subst scalar_prod_left_sum_distrib[OF _ v2])
      apply ((insert gs, force)[1])
     apply (rule sum_list_neutral)
     by (insert 0, auto)
   show ?case unfolding id
     unfolding scalar_prod_add_distrib[OF v12 w1 w2]
       add_scalar_prod_distrib[OF v1 v2 w1]
       add_scalar_prod_distrib[OF v1 v2 w2]
       scalar_prod_smult_distrib[OF w2 gsk]
       smult_scalar_prod_distrib[OF gsk gsk]
     unfolding Suc(1)[OF kn]
     by (simp add: 1 2 comm_scalar_prod[OF v2 w1])
 qed auto
 end
 
 
 locale gram_schmidt = cof_vec_space n f_ty
   for n :: nat and f_ty :: "'a :: {trivial_conjugatable_linordered_field} itself"
 begin
 
 definition Gramian_matrix where
   "Gramian_matrix G k = (let M = mat k n (\<lambda> (i,j). (G ! i) $ j) in M * M\<^sup>T)"
 
 lemma Gramian_matrix_alt_def: "k \<le> length G \<Longrightarrow> 
   Gramian_matrix G k = (let M = mat_of_rows n (take k G) in M * M\<^sup>T)"
   unfolding Gramian_matrix_def Let_def
   by (rule arg_cong[of _ _ "\<lambda> x. x * x\<^sup>T"], unfold mat_of_rows_def, intro eq_matI, auto)
 
 definition Gramian_determinant where
   "Gramian_determinant G k = det (Gramian_matrix G k)"
 
 lemma Gramian_determinant_0 [simp]: "Gramian_determinant G 0 = 1"
   unfolding Gramian_determinant_def Gramian_matrix_def Let_def
   by (simp add: times_mat_def)
 
 lemma orthogonal_imp_lin_indpt_list: 
   assumes ortho: "orthogonal gs" and gs: "set gs \<subseteq> carrier_vec n"
   shows "lin_indpt_list gs" 
 proof -
   from corthogonal_distinct[of gs] ortho have dist: "distinct gs" by simp
   show ?thesis unfolding lin_indpt_list_def
   proof (intro conjI gs dist finite_lin_indpt2 finite_set)
     fix lc
     assume 0: "lincomb lc (set gs) = 0\<^sub>v n" (is "?lc = _") 
     have lc: "?lc \<in> carrier_vec n" by (rule lincomb_closed[OF gs])
     let ?m = "length gs" 
     from 0 have "0 = ?lc \<bullet> ?lc" by simp
     also have "?lc = lincomb_list (\<lambda>i. lc (gs ! i)) gs" 
       unfolding lincomb_as_lincomb_list_distinct[OF gs dist] ..
     also have "\<dots> = sumlist (map (\<lambda>i. lc (gs ! i) \<cdot>\<^sub>v gs ! i) [0..< ?m])" 
       unfolding lincomb_list_def by auto 
     also have "\<dots> \<bullet> \<dots> = (\<Sum>i\<leftarrow>[0..<?m]. (lc (gs ! i) * lc (gs ! i)) * sq_norm (gs ! i))" (is "_ = sum_list ?sum")
       unfolding scalar_prod_lincomb_orthogonal[OF ortho gs le_refl]
       by (auto simp: sq_norm_vec_as_cscalar_prod power2_eq_square)
     finally have sum_0: "sum_list ?sum = 0" ..
     have nonneg: "\<And> x. x \<in> set ?sum \<Longrightarrow> x \<ge> 0" 
       using zero_le_square[of "lc (gs ! i)" for i] sq_norm_vec_ge_0[of "gs ! i" for i] by auto  
     {
       fix x
       assume x: "x \<in> set gs" 
       then obtain i where i: "i < ?m" and x: "x = gs ! i" unfolding set_conv_nth 
         by auto
       hence "lc x * lc x * sq_norm x \<in> set ?sum" by auto
       with sum_list_nonneg_eq_0_iff[of ?sum, OF nonneg] sum_0 
       have "lc x = 0 \<or> sq_norm x = 0" by auto
       with orthogonalD[OF ortho, OF i i, folded x]
       have "lc x = 0" by (auto simp: sq_norm_vec_as_cscalar_prod)
     }
     thus "\<forall>v\<in>set gs. lc v = 0" by auto
   qed
 qed
 
 lemma orthocompl_span:
   assumes "\<And> x. x \<in> S \<Longrightarrow> v \<bullet> x = 0" "S \<subseteq> carrier_vec n" and [intro]: "v \<in> carrier_vec n"
   and "y \<in> span S" 
   shows "v \<bullet> y = 0"
 proof -
   {fix a A
    assume "y = lincomb a A" "finite A" "A \<subseteq> S"
    note assms = assms this
    hence [intro!]:"lincomb a A \<in> carrier_vec n" "(\<lambda>v. a v \<cdot>\<^sub>v v) \<in> A \<rightarrow> carrier_vec n" by auto
    have "\<forall>x\<in>A. (a x \<cdot>\<^sub>v x) \<bullet> v = 0" proof fix x assume "x \<in> A" note assms = assms this
      hence x:"x \<in> S" by auto
      with assms have [intro]:"x \<in> carrier_vec n" by auto
      from assms(1)[OF x] have "x \<bullet> v = 0" by(subst comm_scalar_prod) force+
      thus "(a x \<cdot>\<^sub>v x) \<bullet> v = 0"
        apply(subst smult_scalar_prod_distrib) by force+
    qed
    hence "v \<bullet> lincomb a A = 0" apply(subst comm_scalar_prod) apply force+ unfolding lincomb_def
      apply(subst finsum_scalar_prod_sum) by force+
   }
   thus ?thesis using \<open>y \<in> span S\<close> unfolding span_def by auto
 qed
 
 lemma orthogonal_sumlist:
   assumes ortho: "\<And> x. x \<in> set S \<Longrightarrow> v \<bullet> x = 0" and S: "set S \<subseteq> carrier_vec n" and v: "v \<in> carrier_vec n"
   shows "v \<bullet> sumlist S = 0"
   by (rule orthocompl_span[OF ortho S v sumlist_in_span[OF S span_mem[OF S]]])
 
 lemma oc_projection_alt_def:
   assumes carr:"(W::'a vec set) \<subseteq> carrier_vec n" "x \<in> carrier_vec n"
       and alt1:"y1 \<in> W" "x - y1 \<in> orthogonal_complement W"
       and alt2:"y2 \<in> W" "x - y2 \<in> orthogonal_complement W"
   shows  "y1 = y2"
 proof -
   have carr:"y1 \<in> carrier_vec n" "y2 \<in> carrier_vec n" "x \<in> carrier_vec n" "- y1 \<in> carrier_vec n" 
     "0\<^sub>v n \<in> carrier_vec n"
     using alt1 alt2 carr by auto
   hence "y1 - y2 \<in> carrier_vec n" by auto
   note carr = this carr
   from alt1 have "ya\<in>W \<Longrightarrow> (x - y1) \<bullet> ya = 0" for ya
     unfolding orthogonal_complement_def by blast
   hence "(x - y1) \<bullet> y2 = 0" "(x - y1) \<bullet> y1 = 0" using alt2 alt1 by auto
   hence eq1:"y1 \<bullet> y2 = x \<bullet> y2" "y1 \<bullet> y1 = x \<bullet> y1" using carr minus_scalar_prod_distrib by force+
   from this(1) have eq2:"y2 \<bullet> y1 = x \<bullet> y2" using carr comm_scalar_prod by force
   from alt2 have "ya\<in>W \<Longrightarrow> (x - y2) \<bullet> ya = 0" for ya
     unfolding orthogonal_complement_def by blast
   hence "(x - y2) \<bullet> y1 = 0" "(x - y2) \<bullet> y2 = 0" using alt2 alt1 by auto
   hence eq3:"y2 \<bullet> y2 = x \<bullet> y2" "y2 \<bullet> y1 = x \<bullet> y1" using carr minus_scalar_prod_distrib by force+
   with eq2 have eq4:"x \<bullet> y1 = x \<bullet> y2" by auto
   have "\<parallel>(y1 - y2)\<parallel>\<^sup>2 = 0" unfolding sq_norm_vec_as_cscalar_prod cscalar_prod_is_scalar_prod using carr
     apply(subst minus_scalar_prod_distrib) apply force+
     apply(subst (0 0) scalar_prod_minus_distrib) apply force+
     unfolding eq1 eq2 eq3 eq4 by auto
   with sq_norm_vec_eq_0[of "(y1 - y2)"] carr have "y1 - y2 = 0\<^sub>v n" by fastforce
   hence "y1 - y2 + y2 = y2" using carr by fastforce
   also have "y1 - y2 + y2 = y1" using carr by auto
   finally show "y1 = y2" .
 qed
 
 definition
   "is_oc_projection w S v = (w \<in> carrier_vec n \<and> v - w \<in> span S \<and> (\<forall> u. u \<in> S \<longrightarrow> w \<bullet> u = 0))"
 
 lemma is_oc_projection_sq_norm: assumes "is_oc_projection w S v"
   and S: "S \<subseteq> carrier_vec n" 
   and v: "v \<in> carrier_vec n" 
 shows "sq_norm w \<le> sq_norm v" 
 proof -
   from assms[unfolded is_oc_projection_def]
   have w: "w \<in> carrier_vec n" 
     and vw: "v - w \<in> span S" and ortho: "\<And> u. u \<in> S \<Longrightarrow> w \<bullet> u = 0" by auto
   have "sq_norm v = sq_norm ((v - w) + w)" using v w 
     by (intro arg_cong[of _ _ sq_norm_vec], auto)
   also have "\<dots> = ((v - w) + w) \<bullet> ((v - w) + w)" unfolding sq_norm_vec_as_cscalar_prod
     by simp
   also have "\<dots> = (v - w) \<bullet> ((v - w) + w) + w \<bullet> ((v - w) + w)" 
     by (rule add_scalar_prod_distrib, insert v w, auto)
   also have "\<dots> = ((v - w) \<bullet> (v - w) + (v - w) \<bullet> w) + (w \<bullet> (v - w) + w \<bullet> w)" 
     by (subst (1 2) scalar_prod_add_distrib, insert v w, auto)
   also have "\<dots> = sq_norm (v - w) + 2 * (w \<bullet> (v - w)) + sq_norm w" 
     unfolding sq_norm_vec_as_cscalar_prod using v w by (auto simp: comm_scalar_prod[of w _ "v - w"])
   also have "\<dots> \<ge> 2 * (w \<bullet> (v - w)) + sq_norm w" using sq_norm_vec_ge_0[of "v - w"] by auto
   also have "w \<bullet> (v - w) = 0" using orthocompl_span[OF ortho S w vw] by auto
   finally show ?thesis by auto
 qed
 
 definition oc_projection where
 "oc_projection S fi \<equiv> (SOME v. is_oc_projection v S fi)"
 
 lemma inv_in_span:
   assumes incarr[intro]:"U \<subseteq> carrier_vec n" and insp:"a \<in> span U"
   shows "- a \<in> span U"
 proof -
   from insp[THEN in_spanE] obtain aa A where a:"a = lincomb aa A" "finite A" "A \<subseteq> U" by auto
   with assms have [intro!]:"(\<lambda>v. aa v \<cdot>\<^sub>v v) \<in> A \<rightarrow> carrier_vec n" by auto
   from a(1) have e1:"- a = lincomb (\<lambda> x. - 1 * aa x) A" unfolding smult_smult_assoc[symmetric] lincomb_def
     by(subst finsum_smult[symmetric]) force+
   show ?thesis using e1 a span_def by blast
 qed
 
 lemma non_span_det_zero:
   assumes len: "length G = n"
   and nonb:"\<not> (carrier_vec n \<subseteq> span (set G))"
   and carr:"set G \<subseteq> carrier_vec n"
   shows "det (mat_of_rows n G) = 0" unfolding det_0_iff_vec_prod_zero
 proof -
   let ?A = "(mat_of_rows n G)\<^sup>T" let ?B = "1\<^sub>m n"
   from carr have carr_mat:"?A \<in> carrier_mat n n" "?B \<in> carrier_mat n n" "mat_of_rows n G \<in> carrier_mat n n"
     using len mat_of_rows_carrier(1) by auto
   from carr have g_len:"\<And> i. i < length G \<Longrightarrow> G ! i \<in> carrier_vec n" by auto
   from nonb obtain v where v:"v \<in> carrier_vec n" "v \<notin> span (set G)" by fast
   hence "v \<noteq> 0\<^sub>v n" using span_zero by auto
   obtain B C where gj:"gauss_jordan ?A ?B = (B,C)" by force
   note gj = carr_mat(1,2) gj
   hence B:"B = fst (gauss_jordan ?A ?B)" by auto
   from gauss_jordan[OF gj] have BC:"B \<in> carrier_mat n n" by auto
   from gauss_jordan_transform[OF gj] obtain P where
    P:"P\<in>Units (ring_mat TYPE('a) n ?B)"  "B = P * ?A" by fast
   hence PC:"P \<in> carrier_mat n n" unfolding Units_def by (simp add: ring_mat_simps)
   from mat_inverse[OF PC] P obtain PI where "mat_inverse P = Some PI" by fast
   from mat_inverse(2)[OF PC this]
   have PI:"P * PI = 1\<^sub>m n" "PI * P = 1\<^sub>m n" "PI \<in> carrier_mat n n" by auto
   have "B \<noteq> 1\<^sub>m n" proof
     assume "B = ?B"
     hence "?A * P = ?B" unfolding P
       using PC P(2) carr_mat(1) mat_mult_left_right_inverse by blast
     hence "?A * P *\<^sub>v v = v" using v by auto
     hence "?A *\<^sub>v (P *\<^sub>v v) = v" unfolding assoc_mult_mat_vec[OF carr_mat(1) PC v(1)].
     hence v_eq:"mat_of_cols n G *\<^sub>v (P *\<^sub>v v) = v"
       unfolding transpose_mat_of_rows by auto
     have pvc:"P *\<^sub>v v \<in> carrier_vec (length G)" using PC v len by auto
     from mat_of_cols_mult_as_finsum[OF pvc g_len,unfolded v_eq] obtain a where
       "v = lincomb a (set G)" by auto
     hence "v \<in> span (set G)" by (intro in_spanI[OF _ finite_set subset_refl])
     thus False using v by auto
   qed
   with det_non_zero_imp_unit[OF carr_mat(1)] show ?thesis
     unfolding gauss_jordan_check_invertable[OF carr_mat(1,2)] B det_transpose[OF carr_mat(3)]
     by metis
 qed
 
 lemma span_basis_det_zero_iff:
 assumes "length G = n" "set G \<subseteq> carrier_vec n"
 shows "carrier_vec n \<subseteq> span (set G) \<longleftrightarrow> det (mat_of_rows n G) \<noteq> 0" (is ?q1)
       "carrier_vec n \<subseteq> span (set G) \<longleftrightarrow> basis (set G)" (is ?q2)
       "det (mat_of_rows n G) \<noteq> 0 \<longleftrightarrow> basis (set G)" (is ?q3)
 proof -
   have dc:"det (mat_of_rows n G) \<noteq> 0 \<Longrightarrow> carrier_vec n \<subseteq> span (set G)"
     using assms non_span_det_zero by auto
   have cb:"carrier_vec n \<subseteq> span (set G) \<Longrightarrow> basis (set G)" using assms basis_list_basis 
     by (auto simp: basis_list_def)
   have bd:"basis (set G) \<Longrightarrow> det (mat_of_rows n G) \<noteq> 0" using assms basis_det_nonzero by auto
   show ?q1 ?q2 ?q3 using dc cb bd by metis+
 qed
 
 lemma lin_indpt_list_nonzero:
   assumes "lin_indpt_list G" 
   shows "0\<^sub>v n \<notin> set G"
 proof-
   from assms[unfolded lin_indpt_list_def] have "lin_indpt (set G)" by auto
   from vs_zero_lin_dep[OF _ this] assms[unfolded lin_indpt_list_def] show zero: "0\<^sub>v n \<notin> set G" by auto
 qed
 
 lemma is_oc_projection_eq:
   assumes ispr:"is_oc_projection a S v" "is_oc_projection b S v" 
     and carr: "S \<subseteq> carrier_vec n" "v \<in> carrier_vec n"
   shows "a = b"
 proof -
   from carr have c2:"span S \<subseteq> carrier_vec n" "v \<in> carrier_vec n" by auto
   have a:"v - (v - a) = a" using carr ispr by auto
   have b:"v - (v - b) = b" using carr ispr by auto
   have "(v - a) = (v - b)" 
     apply(rule oc_projection_alt_def[OF c2])
     using ispr a b unfolding in_orthogonal_complement_span[OF carr(1)]
     unfolding orthogonal_complement_def is_oc_projection_def by auto
   hence "v - (v - a) = v - (v - b)" by metis
   thus ?thesis unfolding a b.
 qed
 
 
 
 fun adjuster_wit :: "'a list \<Rightarrow> 'a vec \<Rightarrow> 'a vec list \<Rightarrow> 'a list \<times> 'a vec"
   where "adjuster_wit wits w [] = (wits, 0\<^sub>v n)"
   |  "adjuster_wit wits w (u#us) = (let a = (w \<bullet> u)/ sq_norm u in 
             case adjuster_wit (a # wits) w us of (wit, v)
          \<Rightarrow> (wit, -a \<cdot>\<^sub>v u + v))"
 
 fun sub2_wit where
     "sub2_wit us [] = ([], [])"
   | "sub2_wit us (w # ws) =
      (case adjuster_wit [] w us of (wit,aw) \<Rightarrow> let u = aw + w in
       case sub2_wit (u # us) ws of (wits, vvs) \<Rightarrow> (wit # wits, u # vvs))"  
     
 definition main :: "'a vec list \<Rightarrow> 'a list list \<times> 'a vec list" where 
   "main us = sub2_wit [] us"
 end
 
 
 locale gram_schmidt_fs = 
   fixes n :: nat and fs :: "'a :: {trivial_conjugatable_linordered_field} vec list"
 begin
 
 sublocale gram_schmidt n "TYPE('a)" .
 
 fun gso and \<mu> where
   "gso i = fs ! i + sumlist (map (\<lambda> j. - \<mu> i j \<cdot>\<^sub>v gso j) [0 ..< i])" 
 | "\<mu> i j = (if j < i then (fs ! i \<bullet> gso j)/ sq_norm (gso j) else if i = j then 1 else 0)" 
     
 declare gso.simps[simp del]
 declare \<mu>.simps[simp del]
 
 
 lemma gso_carrier'[intro]:
   assumes "\<And> i. i \<le> j \<Longrightarrow> fs ! i \<in> carrier_vec n"
   shows "gso j \<in> carrier_vec n"
 using assms proof(induct j rule:nat_less_induct[rule_format])
   case (1 j)
   then show ?case unfolding gso.simps[of j] by (auto intro!:sumlist_carrier add_carrier_vec)
 qed
 
 lemma adjuster_wit: assumes res: "adjuster_wit wits w us = (wits',a)"
   and w: "w \<in> carrier_vec n"
     and us: "\<And> i. i \<le> j \<Longrightarrow> fs ! i \<in> carrier_vec n"
     and us_gs: "us = map gso (rev [0 ..< j])" 
     and wits: "wits = map (\<mu> i) [j ..< i]" 
     and j: "j \<le> n" "j \<le> i" 
     and wi: "w = fs ! i" 
   shows "adjuster n w us = a \<and> a \<in> carrier_vec n \<and> wits' = map (\<mu> i) [0 ..< i] \<and>
       (a = sumlist (map (\<lambda>j. - \<mu> i j \<cdot>\<^sub>v gso j) [0..<j]))"
   using res us us_gs wits j
 proof (induct us arbitrary: wits wits' a j)
   case (Cons u us wits wits' a j)
   note us_gs = Cons(4)
   note wits = Cons(5)
   note jn = Cons(6-7)
   from us_gs obtain jj where j: "j = Suc jj" by (cases j, auto)
   from jn j have jj: "jj \<le> n" "jj < n" "jj \<le> i" "jj < i" by auto
   have zj: "[0 ..< j] = [0 ..< jj] @ [jj]" unfolding j by simp
   have jjn: "[jj ..< i] = jj # [j ..< i]" using jj unfolding j by (metis upt_conv_Cons)
   from us_gs[unfolded zj] have ugs: "u = gso jj" and us: "us = map gso (rev [0..<jj])" by auto
   let ?w = "w \<bullet> u / (u \<bullet> u)" 
   have muij: "?w = \<mu> i jj" unfolding \<mu>.simps[of i jj] ugs wi sq_norm_vec_as_cscalar_prod using jj by auto
   have wwits: "?w # wits = map (\<mu> i) [jj..<i]" unfolding jjn wits muij by simp
   obtain wwits b where rec: "adjuster_wit (?w # wits) w us = (wwits,b)" by force
   from Cons(1)[OF this Cons(3) us wwits jj(1,3),unfolded j] have IH: 
      "adjuster n w us = b" "wwits = map (\<mu> i) [0..<i]"
      "b = sumlist (map (\<lambda>j. - \<mu> i j \<cdot>\<^sub>v gso j) [0..<jj])"
       and b: "b \<in> carrier_vec n" by auto
   from Cons(2)[simplified, unfolded Let_def rec split sq_norm_vec_as_cscalar_prod 
       cscalar_prod_is_scalar_prod]
   have id: "wits' = wwits" and a: "a = - ?w \<cdot>\<^sub>v u + b" by auto
   have 1: "adjuster n w (u # us) = a" unfolding a IH(1)[symmetric] by auto     
   from id IH(2) have wits': "wits' =  map (\<mu> i) [0..<i]" by simp
   have carr:"set (map (\<lambda>j. - \<mu> i j \<cdot>\<^sub>v gso j) [0..<j]) \<subseteq> carrier_vec n"
             "set (map (\<lambda>j. - \<mu> i j \<cdot>\<^sub>v gso j) [0..<jj]) \<subseteq> carrier_vec n" and u:"u \<in> carrier_vec n" 
     using Cons j by (auto intro!:gso_carrier')
   from u b a have ac: "a \<in> carrier_vec n" "dim_vec (-?w \<cdot>\<^sub>v u) = n" "dim_vec b = n" "dim_vec u = n" by auto
   show ?case
     apply (intro conjI[OF 1] ac exI conjI wits')
     unfolding carr a IH zj muij ugs[symmetric] map_append
     apply (subst sumlist_append)
     using Cons.prems j apply force
     using b u ugs IH(3) by auto
 qed auto
 
 lemma sub2_wit:
   assumes "set us \<subseteq> carrier_vec n" "set ws \<subseteq> carrier_vec n" "length us + length ws = m" 
     and "ws = map (\<lambda> i. fs ! i) [i ..< m]"
     and "us = map gso (rev [0 ..< i])" 
     and us: "\<And> j. j < m \<Longrightarrow> fs ! j \<in> carrier_vec n"
     and mn: "m \<le> n" 
   shows "sub2_wit us ws = (wits,vvs) \<Longrightarrow> gram_schmidt_sub2 n us ws = vvs 
     \<and> vvs = map gso [i ..< m] \<and> wits = map (\<lambda> i. map (\<mu> i) [0..<i]) [i ..< m]"
   using assms(1-6)
 proof (induct ws arbitrary: us vvs i wits)
   case (Cons w ws us vs)  
   note us = Cons(3) note wws = Cons(4)
   note wsf' = Cons(6)
   note us_gs = Cons(7)
   from wsf' have "i < m" "i \<le> m" by (cases "i < m", auto)+
   hence i_m: "[i ..< m] = i # [Suc i ..< m]" by (metis upt_conv_Cons)
   from \<open>i < m\<close> mn have "i < n" "i \<le> n" "i \<le> m" by auto
   hence i_n: "[i ..< n] = i # [Suc i ..< n]" by (metis upt_conv_Cons)
   from wsf' i_m have wsf: "ws = map (\<lambda> i. fs ! i) [Suc i ..< m]" 
     and fiw: "fs !  i = w" by auto
   from wws have w: "w \<in> carrier_vec n" and ws: "set ws \<subseteq> carrier_vec n" by auto
   have list: "map (\<mu> i) [i ..< i] = []" by auto
   let ?a = "adjuster_wit [] w us" 
   obtain wit a where a: "?a = (wit,a)" by force
   obtain wits' vv where gs: "sub2_wit ((a + w) # us) ws = (wits',vv)" by force      
   from adjuster_wit[OF a w Cons(8) us_gs list[symmetric] \<open>i \<le> n\<close> _ fiw[symmetric]] us wws \<open>i < m\<close>
   have awus: "set ((a + w) # us) \<subseteq> carrier_vec n"  
      and aa: "adjuster n w us = a" "a \<in> carrier_vec n" 
      and aaa: "a = sumlist (map (\<lambda>j. - \<mu> i j \<cdot>\<^sub>v gso j) [0..<i])"  
      and wit: "wit = map (\<mu> i) [0..<i]" 
     by auto
   have aw_gs: "a + w = gso i" unfolding gso.simps[of i] fiw aaa[symmetric] using aa(2) w by auto
   with us_gs have us_gs': "(a + w) # us = map gso (rev [0..<Suc i])" by auto
   from Cons(1)[OF gs awus ws _ wsf us_gs' Cons(8)] Cons(5) 
   have IH: "gram_schmidt_sub2 n ((a + w) # us) ws = vv"  
     and vv: "vv = map gso [Suc i..<m]" 
     and wits': "wits' = map (\<lambda>i. map (\<mu> i) [0..<i]) [Suc i ..< m]" by auto
   from gs a aa IH Cons(5) 
   have gs_vs: "gram_schmidt_sub2 n us (w # ws) = vs" and vs: "vs = (a + w) # vv" using Cons(2)
     by (auto simp add: Let_def snd_def split:prod.splits)
   from Cons(2)[unfolded sub2_wit.simps a split Let_def gs] have wits: "wits = wit # wits'" by auto
   from vs vv aw_gs have vs: "vs = map gso [i ..< m]" unfolding i_m by auto
   with gs_vs show ?case unfolding wits wit wits' by (auto simp: i_m)
 qed auto
   
 lemma partial_connect: fixes vs
   assumes "length fs = m" "k \<le> m" "m \<le> n" "set us \<subseteq> carrier_vec n" "snd (main us) = vs" 
   "us = take k fs" "set fs \<subseteq> carrier_vec n"
 shows "gram_schmidt n us = vs" 
     "vs = map gso [0..<k]" 
 proof -
   have [simp]: "map ((!) fs) [0..<k] = take k fs" using assms(1,2) by (intro nth_equalityI, auto)
   have carr: "j < m \<Longrightarrow> fs ! j \<in> carrier_vec n" for j using assms by auto
   note assms(5)[unfolded main_def]
   have "gram_schmidt_sub2 n [] (take k fs) = vvs \<and> vvs = map gso [0..<k] \<and> wits = map (\<lambda>i. map (\<mu> i) [0..<i]) [0..<k]"
     if "vvs = snd (sub2_wit [] (take k fs))" "wits = fst (sub2_wit [] (take k fs))" for vvs wits
     using assms that by (intro sub2_wit) (auto)
   with assms main_def
   show "gram_schmidt n us = vs" "vs = map gso [0..<k]" unfolding gram_schmidt_code
     by (auto simp add: main_def case_prod_beta')
 qed
 
 lemma adjuster_wit_small:
   "(adjuster_wit v a xs) = (x1,x2)
   \<longleftrightarrow> (fst (adjuster_wit v a xs) = x1 \<and> x2 = adjuster n a xs)"
 proof(induct xs arbitrary: a v x1 x2)
   case (Cons a xs)
   then show ?case
     by (auto simp:Let_def sq_norm_vec_as_cscalar_prod split:prod.splits) 
 qed auto
 
 lemma sub2: "rev xs @ snd (sub2_wit xs us) = rev (gram_schmidt_sub n xs us)"
 proof -
   have "sub2_wit xs us = (x1, x2) \<Longrightarrow> rev xs @ x2 = rev (gram_schmidt_sub n xs us)"
     for x1 x2 xs us
     apply(induct us arbitrary: xs x1 x2)
     by (auto simp:Let_def rev_unsimp adjuster_wit_small split:prod.splits simp del:rev.simps)
   thus ?thesis 
     apply (cases us)
     by (auto simp:Let_def rev_unsimp adjuster_wit_small split:prod.splits simp del:rev.simps)
 qed
 
 lemma gso_connect: "snd (main us) = gram_schmidt n us" unfolding main_def gram_schmidt_def
   using sub2[of Nil us] by auto
 
 definition weakly_reduced :: "'a \<Rightarrow> nat \<Rightarrow> bool" 
   (* for k = n, this is reduced according to "Modern Computer Algebra" *)
   where "weakly_reduced \<alpha> k = (\<forall> i. Suc i < k \<longrightarrow> 
     sq_norm (gso i) \<le> \<alpha> * sq_norm (gso (Suc i)))" 
   
 definition reduced :: "'a \<Rightarrow> nat \<Rightarrow> bool" 
   (* this is reduced according to LLL original paper *)
   where "reduced \<alpha> k = (weakly_reduced \<alpha> k \<and> 
     (\<forall> i j. i < k \<longrightarrow> j < i \<longrightarrow> abs (\<mu> i j) \<le> 1/2))"
 
 
 end (* gram_schmidt_fs *)
 
 
 locale gram_schmidt_fs_Rn = gram_schmidt_fs +
   assumes fs_carrier: "set fs \<subseteq> carrier_vec n"
 begin
 
 abbreviation (input) m where "m \<equiv> length fs"
 
 definition M where "M k = mat k k (\<lambda> (i,j). \<mu> i j)"
 
 lemma f_carrier[simp]: "i < m \<Longrightarrow> fs ! i \<in> carrier_vec n" 
   using fs_carrier unfolding set_conv_nth by force
 
 lemma gso_carrier[simp]: "i < m \<Longrightarrow> gso i \<in> carrier_vec n" 
   using gso_carrier' f_carrier by auto
 
 lemma gso_dim[simp]: "i < m \<Longrightarrow> dim_vec (gso i) = n" by auto
 lemma f_dim[simp]: "i < m \<Longrightarrow> dim_vec (fs ! i) = n" by auto
 
 lemma fs0_gso0: "0 < m \<Longrightarrow> fs ! 0 = gso 0" 
   unfolding gso.simps[of 0] using f_dim[of 0] 
   by (cases fs, auto simp add: upt_rec)
 
 lemma fs_by_gso_def : 
 assumes i: "i < m"
 shows "fs ! i = gso i + M.sumlist (map (\<lambda>ja. \<mu> i ja \<cdot>\<^sub>v gso ja) [0..<i])" (is "_ = _ + ?sum")
 proof -
   {
     fix f
     have a: "M.sumlist (map (\<lambda>ja. f ja \<cdot>\<^sub>v gso ja) [0..<i]) \<in> carrier_vec n" 
       using gso_carrier i by (intro M.sumlist_carrier, auto)
     hence "dim_vec (M.sumlist (map (\<lambda>ja. f ja \<cdot>\<^sub>v gso ja) [0..<i])) = n" by auto
     note a this
   } note sum_carrier = this
   note [simp] = sum_carrier(2)
   have f: "fs ! i \<in> carrier_vec n" using i by simp
   have "gso i + ?sum = fs ! i + M.sumlist (map (\<lambda>j. - \<mu> i j \<cdot>\<^sub>v gso j) [0..<i]) + ?sum " 
     (is "_ = _ + ?minus_sum + _")
     unfolding gso.simps[of i] by simp
   also have "?minus_sum = - ?sum"
     using gso_carrier i sum_carrier
     by (intro eq_vecI, auto simp: sumlist_nth sum_negf)
   also have "fs ! i + (-?sum) + ?sum = fs ! i"
     using sum_carrier fs_carrier f by simp
   finally show ?thesis by auto
 qed
 
 
 lemma main_connect:
   assumes "m \<le> n"
   shows "gram_schmidt n fs = map gso [0..<m]"
 proof -
   obtain vs where snd_main: "snd (main fs) = vs" by auto
   have "gram_schmidt_sub2 n [] fs = snd (sub2_wit [] fs) \<and> snd (sub2_wit [] fs) = map gso [0..<length fs]
         \<and> wits = map (\<lambda>i. map (\<mu> i) [0..<i]) [0..<length fs]" 
     if "wits = fst (sub2_wit [] fs)" for wits
     using assms that fs_carrier by (intro  sub2_wit) (auto simp add: map_nth) 
   then have "gram_schmidt_sub2 n [] fs = vs \<and> vs = map gso [0..<m]"
     using snd_main main_def by auto
   thus "gram_schmidt n fs = map gso [0..<m]" by (auto simp: gram_schmidt_code)
 qed
 
 
 lemma reduced_gso_E: "weakly_reduced \<alpha> k \<Longrightarrow> k \<le> m \<Longrightarrow> Suc i < k \<Longrightarrow> 
   sq_norm (gso i) \<le> \<alpha> * sq_norm (gso (Suc i))" 
   unfolding weakly_reduced_def by auto
       
 abbreviation (input) FF where "FF \<equiv> mat_of_rows n fs"
 abbreviation (input) Fs where "Fs \<equiv> mat_of_rows n (map gso [0..<m])" 
   
 lemma FF_dim[simp]: "dim_row FF = m" "dim_col FF = n" "FF \<in> carrier_mat m n" 
   unfolding mat_of_rows_def by (auto)
 
 lemma Fs_dim[simp]: "dim_row Fs = m" "dim_col Fs = n" "Fs \<in> carrier_mat m n" 
   unfolding mat_of_rows_def by (auto simp: main_connect)
 
 lemma M_dim[simp]: "dim_row (M m) = m" "dim_col (M m) = m" "(M m) \<in> carrier_mat m m"
   unfolding M_def by auto
     
 lemma FF_index[simp]: "i < m \<Longrightarrow> j < n \<Longrightarrow> FF $$ (i,j) = fs ! i $ j" 
   unfolding mat_of_rows_def by auto
 
 lemma M_index[simp]:"i < m \<Longrightarrow> j < m \<Longrightarrow> (M m) $$ (i,j) = \<mu> i j"
   unfolding M_def by auto
     
 (* equation 2 on page 463 of textbook *)      
 lemma matrix_equality: "FF = (M m) * Fs" 
 proof - 
   let ?P = "(M m) * Fs" 
   have dim: "dim_row FF = m" "dim_col FF = n" "dim_row ?P = m" "dim_col ?P = n" "dim_row (M m) = m" "dim_col (M m) = m" 
       "dim_row Fs = m" "dim_col Fs = n" 
     by (auto simp: mat_of_rows_def mat_of_rows_list_def main_connect)
   show ?thesis 
   proof (rule eq_matI; unfold dim)
     fix i j
     assume i: "i < m" and j: "j < n" 
     from i have split: "[0 ..< m] = [0 ..< i] @ [i] @ [Suc i ..< m]"
       by (metis append_Cons append_self_conv2 less_Suc_eq_le less_imp_add_positive upt_add_eq_append upt_rec zero_less_Suc)
     let ?prod = "\<lambda> k. \<mu> i k * gso k $ j" 
     have dim2: "dim_vec (col Fs j) = m" using j dim by auto
     define idx where "idx = [0..<i]" 
     have idx: "set idx \<subseteq> {0 ..< i}" unfolding idx_def using i by auto
     let ?vec = "sumlist (map (\<lambda>j. - \<mu> i j \<cdot>\<^sub>v gso j) idx)" 
     have vec: "?vec \<in> carrier_vec n" by (rule sumlist_carrier, insert idx gso_carrier i, auto)
     hence dimv: "dim_vec ?vec = n" by auto
     have "?P $$ (i,j) = row (M m) i \<bullet> col Fs j" using dim i j by auto
     also have "\<dots> = (\<Sum> k = 0..<m. row (M m) i $ k * col Fs j $ k)" 
       unfolding scalar_prod_def dim2 by auto
     also have "\<dots> = (\<Sum> k = 0..<m. ?prod k)" 
       by (rule sum.cong[OF refl], insert i j dim, auto simp: mat_of_rows_list_def mat_of_rows_def)
     also have "\<dots> = sum_list (map ?prod [0 ..< m])"       
       by (subst sum_list_distinct_conv_sum_set, auto)
     also have "\<dots> = sum_list (map ?prod idx) + ?prod i + sum_list (map ?prod [Suc i ..< m])" 
       unfolding split idx_def by auto
     also have "?prod i = gso i $ j" unfolding \<mu>.simps by simp
     also have "\<dots> = fs ! i $ j + sum_list (map (\<lambda>k. - \<mu> i k * gso k $ j) idx)" unfolding gso.simps[of i] idx_def[symmetric]
       by (subst index_add_vec, unfold dimv, rule j, subst sumlist_vec_index[OF _ j], insert idx gso_carrier i j, 
       auto simp: o_def intro!: arg_cong[OF map_cong])
     also have "sum_list (map (\<lambda>k. - \<mu> i k * gso k $ j) idx) = - sum_list (map (\<lambda>k. \<mu> i k * gso k $ j) idx)" 
       by (induct idx, auto)
     also have "sum_list (map ?prod [Suc i ..< m]) = 0"
       by (rule sum_list_neutral, auto simp: \<mu>.simps)
     finally have "?P $$ (i,j) = fs ! i $ j" by simp
     with FF_index[OF i j]
     show "FF $$ (i,j) = ?P $$ (i,j)" by simp
   qed auto
 qed
   
 lemma fi_is_sum_of_mu_gso: assumes i: "i < m" 
   shows "fs ! i = sumlist (map (\<lambda> j. \<mu> i j \<cdot>\<^sub>v gso j) [0 ..< Suc i])" 
 proof -
   let ?l = "sumlist (map (\<lambda> j. \<mu> i j \<cdot>\<^sub>v gso j) [0 ..< Suc i])" 
   have "?l \<in> carrier_vec n" by (rule sumlist_carrier, insert gso_carrier i, auto)
   hence dim: "dim_vec ?l = n" by (rule carrier_vecD)
   show ?thesis 
   proof (rule eq_vecI, unfold dim f_dim[OF i])
     fix j
     assume j: "j < n"     
     from i have split: "[0 ..< m] = [0 ..< Suc i] @ [Suc i ..< m]"
       by (metis Suc_lessI append.assoc append_same_eq less_imp_add_positive order_refl upt_add_eq_append zero_le)
     let ?prod = "\<lambda> k. \<mu> i k * gso k $ j" 
     have "fs ! i $ j = FF $$ (i,j)" using i j by simp
     also have "\<dots> = ((M m) * Fs) $$ (i,j)" using matrix_equality by simp
     also have "\<dots> = row (M m) i \<bullet> col Fs j" using i j by auto
     also have "\<dots> = (\<Sum> k = 0..<m. row (M m) i $ k * col Fs j $ k)" 
       unfolding scalar_prod_def by auto
     also have "\<dots> = (\<Sum> k = 0..<m. ?prod k)" 
       by (rule sum.cong[OF refl], insert i j dim, auto simp: mat_of_rows_list_def mat_of_rows_def)
     also have "\<dots> = sum_list (map ?prod [0 ..< m])"       
       by (subst sum_list_distinct_conv_sum_set, auto)
     also have "\<dots> = sum_list (map ?prod [0 ..< Suc i]) + sum_list (map ?prod [Suc i ..< m])" 
       unfolding split by auto
     also have "sum_list (map ?prod [Suc i ..< m]) = 0" 
       by (rule sum_list_neutral, auto simp: \<mu>.simps)
     also have "sum_list (map ?prod [0 ..< Suc i]) = ?l $ j" 
       by (subst sumlist_vec_index[OF _ j], (insert i, auto simp: intro!: gso_carrier)[1], 
         rule arg_cong[of _ _ sum_list], insert i j, auto)
     finally show "fs ! i $ j = ?l $ j" by simp
   qed simp
 qed
 
 lemma gi_is_fi_minus_sum_mu_gso:
   assumes i: "i < m" 
   shows "gso i = fs ! i - sumlist (map (\<lambda> j. \<mu> i j \<cdot>\<^sub>v gso j) [0 ..< i])" (is "_ = _ - ?sum")
 proof -
   have sum: "?sum \<in> carrier_vec n" 
     by (rule sumlist_carrier, insert gso_carrier i, auto)
   show ?thesis unfolding fs_by_gso_def[OF i]
     by (intro eq_vecI, insert gso_carrier[OF i] sum, auto)
 qed
 
 (* Theorem 16.5 (iv) *)  
 lemma det: assumes m: "m = n" shows "det FF = det Fs" 
   unfolding matrix_equality
   apply (subst det_mult[OF M_dim(3)], (insert Fs_dim(3) m, auto)[1])
   apply (subst det_lower_triangular[OF _ M_dim(3)]) 
   by (subst M_index, (auto simp: \<mu>.simps)[3], unfold prod_list_diag_prod, auto simp: \<mu>.simps) 
 end
 
 locale gram_schmidt_fs_lin_indpt = gram_schmidt_fs_Rn +
   assumes lin_indpt: "lin_indpt (set fs)" and dist: "distinct fs"
 begin
 
 lemmas loc_assms = lin_indpt dist
 
 lemma mn:
   shows "m \<le> n"
 proof -
   have n: "n = dim" by (simp add: dim_is_n)
   have m: "m = card (set fs)"
     using distinct_card loc_assms by metis
   from m n have mn: "m \<le> n \<longleftrightarrow> card (set fs) \<le> dim" by simp
   show ?thesis unfolding mn
     by (rule li_le_dim, use loc_assms fs_carrier in auto)
 qed
 
 lemma
 shows span_gso: "span (gso ` {0..<m}) = span (set fs)"
   and orthogonal_gso: "orthogonal (map gso [0..<m])" 
   and dist_gso: "distinct (map gso [0..<m])"
   using gram_schmidt_result[OF fs_carrier _ _ main_connect[symmetric]] loc_assms mn by auto
 
 lemma gso_inj[intro]:
   assumes "i < m"
   shows "inj_on gso {0..<i}"
 proof -
   { fix x y assume assms': "i < m" "x \<in> {0..<i}" "y \<in> {0..<i}" "gso x = gso y"
   have "distinct (map gso [0..<m])" "x < length (map gso [0..<m])" "y < length (map gso [0..<m])" 
     using dist_gso assms mn assms' by (auto intro!: dist_gso)
   from nth_eq_iff_index_eq[OF this] assms' have "x = y" by auto }
   then show ?thesis
     using assms by (intro inj_onI) auto
 qed
 
 lemma partial_span:
   assumes i: "i \<le> m" 
   shows "span (gso ` {0 ..< i}) = span (set (take i fs))" 
 proof -
   let ?f = "\<lambda> i. fs ! i" 
   let ?us = "take i fs" 
   have len: "length ?us = i" using i by auto
   from fs_carrier i have us: "set ?us \<subseteq> carrier_vec n" 
     by (meson set_take_subset subset_trans)
   obtain vi where main: "snd (main ?us) = vi" by force
   from dist have dist: "distinct ?us" by auto
   from lin_indpt have indpt: "lin_indpt (set ?us)" 
     using supset_ld_is_ld[of "set ?us", of "set (?us @ drop i fs)"] 
     by (auto simp: set_take_subset)
   from partial_connect[OF _ i mn us main refl fs_carrier] assms
   have gso: "vi = gram_schmidt n ?us" and vi: "vi = map gso [0 ..< i]" by auto
   from cof_vec_space.gram_schmidt_result(1)[OF us dist indpt gso, unfolded vi]
   show ?thesis by auto
 qed
 
 lemma partial_span': 
   assumes i: "i \<le> m" 
   shows "span (gso ` {0 ..< i}) = span ((\<lambda> j. fs ! j) ` {0 ..< i})"
   unfolding partial_span[OF i]
   by (rule arg_cong[of _ _ span], subst nth_image, insert i loc_assms, auto)
 
 (* Theorem 16.5 (iii) *)
 lemma orthogonal:
   assumes "i < m" "j < m" "i \<noteq> j"
   shows "gso i \<bullet> gso j = 0"
   using assms mn orthogonal_gso[unfolded orthogonal_def] by auto
 
 (* Theorem 16.5 (i) not in full general form *)  
 lemma same_base:
   shows "span (set fs) = span (gso ` {0..<m})" 
   using span_gso loc_assms by simp
 
 (* Theorem 16.5 (ii), second half *)
 lemma sq_norm_gso_le_f:
   assumes i: "i < m"
   shows "sq_norm (gso i) \<le> sq_norm (fs ! i)"
 proof -
   have id: "[0 ..< Suc i] = [0 ..< i] @ [i]" by simp
   let ?sum = "sumlist (map (\<lambda>j. \<mu> i j \<cdot>\<^sub>v gso j) [0..<i])" 
   have sum: "?sum \<in> carrier_vec n" and gsoi: "gso i \<in> carrier_vec n" using i
     by (auto intro!: sumlist_carrier gso_carrier)
   from fi_is_sum_of_mu_gso[OF i, unfolded id]
   have "sq_norm (fs ! i) = sq_norm (sumlist (map (\<lambda>j. \<mu> i j \<cdot>\<^sub>v gso j) [0..<i] @ [gso i]))" by (simp add: \<mu>.simps)
   also have "\<dots> = sq_norm (?sum + gso i)" 
     by (subst sumlist_append, insert gso_carrier i, auto)
   also have "\<dots> = (?sum + gso i) \<bullet> (?sum + gso i)" by (simp add: sq_norm_vec_as_cscalar_prod)
   also have "\<dots> = ?sum \<bullet> (?sum + gso i) + gso i \<bullet> (?sum + gso i)" 
     by (rule add_scalar_prod_distrib[OF sum gsoi], insert sum gsoi, auto)
   also have "\<dots> = (?sum \<bullet> ?sum + ?sum \<bullet> gso i) + (gso i \<bullet> ?sum + gso i \<bullet> gso i)" 
     by (subst (1 2) scalar_prod_add_distrib[of _ n], insert sum gsoi, auto)
   also have "?sum \<bullet> ?sum = sq_norm ?sum" by (simp add: sq_norm_vec_as_cscalar_prod)
   also have "gso i \<bullet> gso i = sq_norm (gso i)" by (simp add: sq_norm_vec_as_cscalar_prod)
   also have "gso i \<bullet> ?sum = ?sum \<bullet> gso i" using gsoi sum by (simp add: comm_scalar_prod)
   finally have "sq_norm (fs ! i) = sq_norm ?sum + 2 * (?sum \<bullet> gso i) + sq_norm (gso i)" by simp
   also have "\<dots> \<ge> 2 * (?sum \<bullet> gso i) + sq_norm (gso i)" using sq_norm_vec_ge_0[of ?sum] by simp
   also have "?sum \<bullet> gso i = (\<Sum>v\<leftarrow>map (\<lambda>j. \<mu> i j \<cdot>\<^sub>v gso j) [0..<i]. v \<bullet> gso i)" 
     by (subst scalar_prod_left_sum_distrib[OF _ gsoi], insert i gso_carrier, auto)
   also have "\<dots> = 0" 
   proof (rule sum_list_neutral, goal_cases)
     case (1 x)
     then obtain j where j: "j < i" and x: "x = (\<mu> i j \<cdot>\<^sub>v gso j) \<bullet> gso i" by auto
     from j i have gsoj: "gso j \<in> carrier_vec n" by auto
     have "x = \<mu> i j * (gso j \<bullet> gso i)" using gsoi gsoj unfolding x by simp
     also have "gso j \<bullet> gso i = 0" 
       by (rule orthogonal, insert j i assms, auto)
     finally show "x = 0" by simp
   qed
   finally show ?thesis by simp
 qed
 
 (* Theorem 16.5 (ii), first half *)
 lemma oc_projection_exist:
   assumes i: "i < m" 
   shows "fs ! i - gso i \<in> span (gso ` {0..<i})"
 proof
   let ?A = "gso ` {0..<i}"
   show finA:"finite ?A" by auto
   have carA[intro!]:"?A \<subseteq> carrier_vec n" using gso_dim assms by auto
   let "?a v" = "\<Sum>n\<leftarrow>[0..<i]. if v = gso n then \<mu> i n else 0"
   have d:"(sumlist (map (\<lambda>j. - \<mu> i j \<cdot>\<^sub>v gso j) [0..<i])) \<in> carrier_vec n"
     using gso.simps[of i] gso_dim[OF i] unfolding carrier_vec_def by auto
   note [intro] = f_carrier[OF i] gso_carrier[OF i] d
   have [intro!]:"(\<lambda>v. ?a v \<cdot>\<^sub>v v) \<in> gso ` {0..<i} \<rightarrow> carrier_vec n"
      using gso_carrier assms by auto
   {fix ia assume ia[intro]:"ia < n"
     have "(\<Sum>x\<in>gso ` {0..<i}. (?a x \<cdot>\<^sub>v x) $ ia) =
       - (\<Sum>x\<leftarrow>map (\<lambda>j. - \<mu> i j \<cdot>\<^sub>v gso j) [0..<i]. x $ ia)"
     unfolding map_map comm_monoid_add_class.sum.reindex[OF gso_inj[OF assms]]
     unfolding atLeastLessThan_upt sum_set_upt_conv_sum_list_nat uminus_sum_list_map o_def
     proof(rule arg_cong[OF map_cong, OF refl],goal_cases)
       case (1 x) hence x:"x < m" "x < i" using assms by auto
       hence d:"insert x (set [0..<i]) = {0..<i}"
               "count (mset [0..<i]) x = 1" by auto
       hence "inj_on gso (insert x (set [0..<i]))" using gso_inj[OF assms] by auto
       from inj_on_filter_key_eq[OF this,folded replicate_count_mset_eq_filter_eq]
       have "[n\<leftarrow>[0..<i] . gso x = gso n] = [x]" using x assms d replicate.simps(2)[of 0] by auto
       hence "(\<Sum>n\<leftarrow>[0..<i]. if gso x = gso n then \<mu> i n else 0) = \<mu> i x"
         unfolding sum_list_map_filter'[symmetric] by auto
       with ia gso_dim x show ?case apply(subst index_smult_vec) by force+
     qed
     hence "(\<Oplus>\<^bsub>V\<^esub>v\<in>gso ` {0..<i}. ?a v \<cdot>\<^sub>v v) $ ia =
           (- local.sumlist (map (\<lambda>j. - \<mu> i j \<cdot>\<^sub>v gso j) [0..<i])) $ ia"
       using d assms
       apply (subst (0 0) finsum_index index_uminus_vec) apply force+
       apply (subst sumlist_vec_index) by force+
   }
   hence id: "(\<Oplus>\<^bsub>V\<^esub>v\<in>?A. ?a v \<cdot>\<^sub>v v) = - sumlist (map (\<lambda>j. - \<mu> i j \<cdot>\<^sub>v gso j) [0..<i])"
     using d lincomb_dim[OF finA carA,unfolded lincomb_def] by(intro eq_vecI,auto)
   show "fs ! i - gso i = lincomb ?a ?A" unfolding lincomb_def gso.simps[of i] id
     by (rule eq_vecI, auto)
 qed auto
 
 lemma oc_projection_unique:
   assumes "i < m" 
           "v \<in> carrier_vec n"
           "\<And> x. x \<in> gso ` {0..<i} \<Longrightarrow> v \<bullet> x = 0"
           "fs ! i - v \<in> span (gso ` {0..<i})"
   shows "v = gso i"
 proof -
   from assms have carr_span:"span (gso ` {0..<i}) \<subseteq> carrier_vec n" by(intro span_is_subset2) auto
   from assms have carr: "gso ` {0..<i} \<subseteq> carrier_vec n" by auto
   from assms have eq:"fs ! i - (fs ! i - v) = v" for v by auto
   from orthocompl_span[OF _ carr] assms
   have "y \<in> span (gso ` {0..<i}) \<Longrightarrow> v \<bullet> y = 0" for y by auto
   hence oc1:"fs ! i - (fs ! i - v) \<in> orthogonal_complement (span (gso ` {0..< i}))"
     unfolding eq orthogonal_complement_def using assms by auto
   have "x \<in> gso ` {0..<i} \<Longrightarrow> gso i \<bullet> x = 0" for x using assms orthogonal by auto
   hence "y \<in> span (gso ` {0..<i}) \<Longrightarrow> gso i \<bullet> y = 0" for y
     by (rule orthocompl_span) (use carr gso_carrier assms in auto)
   hence oc2:"fs ! i - (fs ! i - gso i) \<in> orthogonal_complement (span (gso ` {0..< i}))"
     unfolding eq orthogonal_complement_def using assms by auto
   note pe= oc_projection_exist[OF assms(1)]
   note prerec = carr_span f_carrier[OF assms(1)] assms(4) oc1 oc_projection_exist[OF assms(1)] oc2
   note prerec = carr_span f_carrier[OF assms(1)] assms(4) oc1 oc_projection_exist[OF assms(1)] oc2
   have gsoi: "gso i \<in> carrier_vec n" "fs ! i \<in> carrier_vec n"
     by (rule gso_carrier[OF \<open>i < m\<close>], rule f_carrier[OF \<open>i < m\<close>])
   note main = arg_cong[OF oc_projection_alt_def[OF carr_span f_carrier[OF assms(1)] assms(4) oc1 pe oc2], 
      of "\<lambda> v. - v $ j + fs ! i $ j" for j]
   show "v = gso i" 
   proof (intro eq_vecI)
     fix j
     show "j < dim_vec (gso i) \<Longrightarrow> v $ j = gso i $ j" 
       using assms gsoi main[of j] by (auto)
   qed (insert assms gsoi, auto)
 qed
 
 lemma gso_oc_projection:
   assumes "i < m"
   shows "gso i = oc_projection (gso ` {0..<i}) (fs ! i)"
   unfolding oc_projection_def is_oc_projection_def
 proof (rule some_equality[symmetric,OF _ oc_projection_unique[OF assms]])
   have orthogonal:"\<And> xa. xa < i \<Longrightarrow> gso i \<bullet> gso xa = 0" by (rule orthogonal,insert assms, auto)
   show "gso i \<in> carrier_vec n \<and>
         fs ! i - gso i \<in> span (gso ` {0..<i}) \<and>
         (\<forall>x. x \<in> gso ` {0..<i} \<longrightarrow> gso i \<bullet> x = 0)"
     using gso_carrier oc_projection_exist assms orthogonal by auto
 qed auto
 
 lemma gso_oc_projection_span:
   assumes "i < m"
   shows "gso i = oc_projection (span (gso ` {0..<i})) (fs ! i)"
     and "is_oc_projection (gso i) (span (gso ` {0..<i})) (fs ! i)"
   unfolding oc_projection_def is_oc_projection_def
 proof (rule some_equality[symmetric,OF _ oc_projection_unique[OF assms]])
   let ?P = "\<lambda>v. v \<in> carrier_vec n \<and> fs ! i - v \<in> span (span (gso ` {0..<i}))
     \<and> (\<forall>x. x \<in> span (gso ` {0..<i}) \<longrightarrow> v \<bullet> x = 0)"
   have carr:"gso ` {0..<i} \<subseteq> carrier_vec n" using assms by auto
   have *:  "\<And> xa. xa < i \<Longrightarrow> gso i \<bullet> gso xa = 0" by (rule orthogonal,insert assms, auto)
   have orthogonal:"\<And>x. x \<in> span (gso ` {0..<i}) \<Longrightarrow> gso i \<bullet> x = 0"
     apply(rule orthocompl_span) using assms * by auto
   show "?P (gso i)" "?P (gso i)" unfolding span_span[OF carr]
     using gso_carrier oc_projection_exist assms orthogonal by auto
   fix v assume p:"?P v"
   then show "v \<in> carrier_vec n" by auto
   from p show "fs ! i - v \<in> span (gso ` {0..<i})" unfolding span_span[OF carr] by auto
   fix xa assume "xa \<in> gso ` {0..<i}"
   hence "xa \<in> span (gso ` {0..<i})" using in_own_span[OF carr] by auto
   thus "v \<bullet> xa = 0" using p by auto
 qed
 
 lemma gso_is_oc_projection:
   assumes "i < m"
   shows "is_oc_projection (gso i) (set (take i fs)) (fs ! i)"
 proof -
   have [simp]: "v \<in> carrier_vec n" if "v \<in> set (take i fs)" for v
     using that by (meson contra_subsetD fs_carrier in_set_takeD)
   have "span (gso ` {0..<i}) = span (set (take i fs))"
     by (rule partial_span) (auto simp add: assms less_or_eq_imp_le)
   moreover have "is_oc_projection (gso i) (span (gso ` {0..<i})) (fs ! i)"
     by (rule gso_oc_projection_span) (auto simp add: assms less_or_eq_imp_le)
   ultimately have "is_oc_projection (gso i) (span (set (take i fs))) (fs ! i)"
     by auto
   moreover have "set (take i fs) \<subseteq> span (set (take i fs))"
     by (auto intro!: span_mem)
   ultimately show ?thesis
     unfolding is_oc_projection_def by (subst (asm) span_span) (auto)
 qed
 
 lemma fi_scalar_prod_gso:
   assumes i: "i < m" and j: "j < m" 
   shows "fs ! i \<bullet> gso j = \<mu> i j * \<parallel>gso j\<parallel>\<^sup>2" 
 proof -
   let ?mu = "\<lambda>j. \<mu> i j \<cdot>\<^sub>v gso j" 
   from i have list1: "[0..< m] = [0..< Suc i] @ [Suc i ..< m]" 
     by (intro nth_equalityI, auto simp: nth_append, rename_tac j, case_tac "j - i", auto)
   from j have list2: "[0..< m] = [0..< j] @ [j] @ [Suc j ..< m]" 
     by (intro nth_equalityI, auto simp: nth_append, rename_tac k, case_tac "k - j", auto)
   have "fs ! i \<bullet> gso j = sumlist (map ?mu [0..<Suc i]) \<bullet> gso j" 
     unfolding fi_is_sum_of_mu_gso[OF i] by simp
   also have "\<dots> = (\<Sum>v\<leftarrow>map ?mu [0..<Suc i]. v \<bullet> gso j) + 0" 
     by (subst scalar_prod_left_sum_distrib, insert gso_carrier assms, auto)
   also have "\<dots> = (\<Sum>v\<leftarrow>map ?mu [0..<Suc i]. v \<bullet> gso j) + (\<Sum>v\<leftarrow>map ?mu [Suc i..<m]. v \<bullet> gso j)" 
     by (subst (3) sum_list_neutral, insert assms gso_carrier, auto intro!: orthogonal simp: \<mu>.simps)
   also have "\<dots> = (\<Sum>v\<leftarrow>map ?mu [0..< m]. v \<bullet> gso j)" 
     unfolding list1 by simp
   also have "\<dots> = (\<Sum>v\<leftarrow>map ?mu [0..< j]. v \<bullet> gso j) + ?mu j \<bullet> gso j + (\<Sum>v\<leftarrow>map ?mu [Suc j..< m]. v \<bullet> gso j)" 
     unfolding list2 by simp
   also have "(\<Sum>v\<leftarrow>map ?mu [0..< j]. v \<bullet> gso j) = 0" 
     by (rule sum_list_neutral, insert assms gso_carrier, auto intro!: orthogonal)
   also have "(\<Sum>v\<leftarrow>map ?mu [Suc j..< m]. v \<bullet> gso j) = 0" 
     by (rule sum_list_neutral, insert assms gso_carrier, auto intro!: orthogonal)
   also have "?mu j \<bullet> gso j = \<mu> i j * sq_norm (gso j)" 
     using gso_carrier[OF j] by (simp add: sq_norm_vec_as_cscalar_prod)  
   finally show ?thesis by simp
 qed
 
 lemma gso_scalar_zero:
   assumes "k < m" "i < k"
   shows "(gso k) \<bullet> (fs ! i) = 0"
   by (subst comm_scalar_prod[OF gso_carrier]; (subst fi_scalar_prod_gso)?,
   insert assms, auto simp: \<mu>.simps)
 
 lemma scalar_prod_lincomb_gso:
   assumes k: "k \<le> m"
   shows "sumlist (map (\<lambda> i. g i \<cdot>\<^sub>v gso i) [0 ..< k]) \<bullet> sumlist (map (\<lambda> i. h i \<cdot>\<^sub>v gso i) [0 ..< k])
     = sum_list (map (\<lambda> i. g i * h i * (gso i \<bullet> gso i)) [0 ..< k])" 
 proof -
   have id1: "map (\<lambda>i. g i \<cdot>\<^sub>v map (gso) [0..<m] ! i) [0..<k] = map (\<lambda>i. g i \<cdot>\<^sub>v gso i) [0..<k]" for g using k
     by auto
   have id2: "(\<Sum>i\<leftarrow>[0..<k]. g i * h i * (map (gso) [0..<m] ! i \<bullet> map (gso) [0..<m] ! i)) 
     = (\<Sum>i\<leftarrow>[0..<k]. g i * h i * (gso i \<bullet> gso i))" using k
     by (intro arg_cong[OF map_cong], auto)
   define gs where "gs = map (gso) [0..<m]"
   have gs_gso: "gs ! i = gso i" if "i < k" for i
     using that assms unfolding gs_def by auto
   have "M.sumlist (map (\<lambda>i. g i \<cdot>\<^sub>v gs ! i) [0..<k]) \<bullet> M.sumlist (map (\<lambda>i. h i \<cdot>\<^sub>v gs ! i) [0..<k]) = 
         (\<Sum>i\<leftarrow>[0..<k]. g i * h i * (gs ! i \<bullet> gs ! i))"
     unfolding gs_def using  assms  orthogonal_gso 
     by (intro scalar_prod_lincomb_orthogonal) auto
   also have "map (\<lambda>i. g i \<cdot>\<^sub>v gs ! i) [0..<k] = map (\<lambda>i. g i \<cdot>\<^sub>v gso i) [0..<k]"
     using gs_gso by (intro map_cong) (auto)
   also have "map (\<lambda>i. h i \<cdot>\<^sub>v gs ! i) [0..<k] = map (\<lambda>i. h i \<cdot>\<^sub>v gso i) [0..<k]"
     using gs_gso by (intro map_cong) (auto)
   also have "map (\<lambda>i. g i * h i * (gs ! i \<bullet> gs ! i)) [0..<k] = map (\<lambda>i. g i * h i * (gso i \<bullet> gso i)) [0..<k]"
     using gs_gso by (intro map_cong) (auto)
   finally show ?thesis by simp
 qed
 
 lemma gso_times_self_is_norm:
   assumes "j < m"
   shows "fs ! j \<bullet> gso j = sq_norm (gso j)"
   by (subst fi_scalar_prod_gso, insert assms, auto simp: \<mu>.simps)
 
 (* Lemma 16.7 *)
 lemma gram_schmidt_short_vector: 
   assumes in_L: "h \<in> lattice_of fs - {0\<^sub>v n}" 
   shows "\<exists> i < m. \<parallel>h\<parallel>\<^sup>2 \<ge> \<parallel>gso i\<parallel>\<^sup>2"
 proof -
   from in_L have non_0: "h \<noteq> 0\<^sub>v n" by auto
   from in_L[unfolded lattice_of_def] obtain lam where 
     h: "h =  sumlist (map (\<lambda> i. of_int (lam i) \<cdot>\<^sub>v fs ! i) [0 ..< length fs])" 
     by auto
   have in_L: "h = sumlist (map (\<lambda> i. of_int (lam i) \<cdot>\<^sub>v fs ! i) [0 ..< m])" unfolding length_map h
     by (rule arg_cong[of _ _ sumlist], rule map_cong, auto)
   let ?n = "[0 ..< m]" 
   let ?f = "(\<lambda> i. of_int (lam i) \<cdot>\<^sub>v fs ! i)" 
   let ?vs = "map ?f ?n" 
   let ?P = "\<lambda> k. k < m \<and> lam k \<noteq> 0" 
   define k where "k = (GREATEST kk. ?P kk)" 
   { 
     assume *: "\<forall> i < m. lam i = 0" 
     have vs: "?vs = map (\<lambda> i. 0\<^sub>v n) ?n"
       by (rule map_cong, insert f_dim *, auto)
     have "h = 0\<^sub>v n" unfolding in_L vs
       by (rule sumlist_neutral, auto)
     with non_0 have False by auto
   }  
   then obtain kk where "?P kk" by auto
   from GreatestI_nat[of ?P, OF this, of m] have Pk: "?P k" unfolding k_def by auto      
   hence kn: "k < m" by auto
   let ?gso = "(\<lambda>i j. \<mu> i j \<cdot>\<^sub>v gso j)" 
   have k: "k < i \<Longrightarrow> i < m \<Longrightarrow> lam i = 0" for i
     using Greatest_le_nat[of ?P i m, folded k_def] by auto
   define l where "l = lam k" 
   from Pk have l: "l \<noteq> 0" unfolding l_def by auto
   define idx where "idx = [0 ..< k]" 
   have idx: "\<And> i. i \<in> set idx \<Longrightarrow> i < k" "\<And> i. i \<in> set idx \<Longrightarrow> i < m"  unfolding idx_def using kn by auto
   from Pk have split: "[0 ..< m] = idx @ [k] @ [Suc k ..< m]" unfolding idx_def
     by (metis append_Cons append_self_conv2 less_Suc_eq_le less_imp_add_positive upt_add_eq_append 
         upt_rec zero_less_Suc)  
   define gg where "gg = sumlist 
     (map (\<lambda>i. of_int (lam i) \<cdot>\<^sub>v fs ! i) idx) + of_int l \<cdot>\<^sub>v sumlist (map (\<lambda>j. \<mu> k j \<cdot>\<^sub>v gso j) idx)" 
   have "h = sumlist ?vs" unfolding in_L ..
   also have "\<dots> = sumlist ((map ?f idx @ [?f k]) @ map ?f [Suc k ..< m])" unfolding split by auto
   also have "\<dots> = sumlist (map ?f idx @ [?f k]) + sumlist (map ?f [Suc k ..< m])" 
     by (rule sumlist_append, auto intro!: f_carrier, insert Pk idx, auto)
   also have "sumlist (map ?f [Suc k ..< m]) = 0\<^sub>v n" by (rule sumlist_neutral, auto simp: k)
   also have "sumlist (map ?f idx @ [?f k]) = sumlist (map ?f idx) + ?f k" 
     by (subst sumlist_append, auto intro!: f_carrier, insert Pk idx, auto)
   also have "fs ! k = sumlist (map (?gso k) [0..<Suc k])" using fi_is_sum_of_mu_gso[OF kn] by simp
   also have "\<dots> = sumlist (map (?gso k) idx @ [gso k])" by (simp add: \<mu>.simps[of k k] idx_def)
   also have "\<dots> = sumlist (map (?gso k) idx) + gso k" 
     by (subst sumlist_append, auto intro!: f_carrier, insert Pk idx, auto)
   also have "of_int (lam k) \<cdot>\<^sub>v \<dots> = of_int (lam k) \<cdot>\<^sub>v (sumlist (map (?gso k) idx)) 
     + of_int (lam k) \<cdot>\<^sub>v gso k" 
     unfolding idx_def
     by (rule smult_add_distrib_vec[OF sumlist_carrier], auto intro!: gso_carrier, insert kn, auto)
   finally have "h = sumlist (map ?f idx) +
        (of_int (lam k) \<cdot>\<^sub>v sumlist (map (?gso k) idx) + of_int (lam k) \<cdot>\<^sub>v gso k) + 0\<^sub>v n " by simp 
   also have "\<dots> = gg + of_int l \<cdot>\<^sub>v gso k" unfolding gg_def l_def
     by (rule eq_vecI, insert idx kn, auto simp: sumlist_vec_index,
       subst index_add_vec, auto simp: sumlist_dim kn, subst sumlist_dim, auto)
   finally have hgg: "h = gg + of_int l \<cdot>\<^sub>v gso k" .      
   let ?k = "[0 ..< k]" 
   define R where "R = {gg. \<exists> nu. gg = sumlist (map (\<lambda> i. nu i \<cdot>\<^sub>v gso i) idx)}" 
   {
     fix nu
     have "dim_vec (sumlist (map (\<lambda> i. nu i \<cdot>\<^sub>v gso i) idx)) = n" 
       by (rule sumlist_dim, insert kn, auto simp: idx_def)
   } note dim_nu[simp] = this
   define kk where "kk = ?k" 
   {
     fix v
     assume "v \<in> R"
     then obtain nu where v: "v = sumlist (map (\<lambda> i. nu i \<cdot>\<^sub>v gso i) idx)" unfolding R_def by auto
     have "dim_vec v = n" unfolding gg_def v by simp
   } note dim_R = this
   {
     fix v1 v2
     assume "v1 \<in> R" "v2 \<in> R" 
     then obtain nu1 nu2 where v1: "v1 = sumlist (map (\<lambda> i. nu1 i \<cdot>\<^sub>v gso i) idx)" and
       v2: "v2 = sumlist (map (\<lambda> i. nu2 i \<cdot>\<^sub>v gso i) idx)"
       unfolding R_def by auto
     have "v1 + v2 \<in> R" unfolding R_def
       by (standard, rule exI[of _ "\<lambda> i. nu1 i + nu2 i"], unfold v1 v2, rule eq_vecI, 
         (subst sumlist_vec_index, insert idx, auto intro!: gso_carrier simp: o_def)+, 
         unfold sum_list_addf[symmetric], induct idx, auto simp: algebra_simps)
   } note add_R = this
   have "gg \<in> R" unfolding gg_def
   proof (rule add_R)
     show "of_int l \<cdot>\<^sub>v sumlist (map (\<lambda>j. \<mu> k j \<cdot>\<^sub>v gso j) idx) \<in> R" 
       unfolding R_def
       by (standard, rule exI[of _ "\<lambda>i. of_int l * \<mu> k i"], rule eq_vecI,
        (subst sumlist_vec_index, insert idx, auto intro!: gso_carrier simp: o_def)+, 
        induct idx, auto simp: algebra_simps)
     show "sumlist (map ?f idx) \<in> R" using idx
     proof (induct idx)
       case Nil
       show ?case by (simp add: R_def, intro exI[of _ "\<lambda> i. 0"], rule eq_vecI,
         (subst sumlist_vec_index, insert idx, auto intro!: gso_carrier simp: o_def)+, 
         induct idx, auto)
     next      
       case (Cons i idxs)
       have "sumlist (map ?f (i # idxs)) = sumlist ([?f i] @ map ?f idxs)" by simp
       also have "\<dots> = ?f i + sumlist (map ?f idxs)" 
         by (subst sumlist_append, insert Cons(3), auto intro!: f_carrier)
       finally have id: "sumlist (map ?f (i # idxs)) = ?f i + sumlist (map ?f idxs)" .
       show ?case unfolding id
       proof (rule add_R[OF _ Cons(1)[OF Cons(2-3)]])
         from Cons(2-3) have i: "i < m" "i < k" by auto
         hence idx_split: "idx = [0 ..< Suc i] @ [Suc i ..< k]" unfolding idx_def 
           by (metis Suc_lessI append_Nil2 less_imp_add_positive upt_add_eq_append upt_rec zero_le)
         {
           fix j
           assume j: "j < n" 
           define idxs where "idxs = [0 ..< Suc i]"
           let ?f = "\<lambda> x. ((if x < Suc i then of_int (lam i) * \<mu> i x else 0) \<cdot>\<^sub>v gso x) $ j" 
           have "(\<Sum>x\<leftarrow>idx. ?f x) = (\<Sum>x\<leftarrow>[0 ..< Suc i]. ?f x) + (\<Sum>x\<leftarrow> [Suc i ..< k]. ?f x)" 
             unfolding idx_split by auto
           also have "(\<Sum>x\<leftarrow> [Suc i ..< k]. ?f x) = 0" by (rule sum_list_neutral, insert j kn, auto)          
           also have "(\<Sum>x\<leftarrow>[0 ..< Suc i]. ?f x) = (\<Sum>x\<leftarrow>idxs. of_int (lam i) * (\<mu> i x \<cdot>\<^sub>v gso x) $ j)" 
             unfolding idxs_def by (rule arg_cong[of _ _ sum_list], rule map_cong[OF refl], 
                 subst index_smult_vec, insert j i kn, auto)
           also have "\<dots> = of_int (lam i) * ((\<Sum>x\<leftarrow>[0..<Suc i]. (\<mu> i x \<cdot>\<^sub>v gso x) $ j))" 
             unfolding idxs_def[symmetric] by (induct idxs, auto simp: algebra_simps)
           finally have "(\<Sum>x\<leftarrow>idx. ?f x) = of_int (lam i) * ((\<Sum>x\<leftarrow>[0..<Suc i]. (\<mu> i x \<cdot>\<^sub>v gso x) $ j))" 
             by simp
         } note main = this
         show "?f i \<in> R" unfolding fi_is_sum_of_mu_gso[OF i(1)] R_def
           apply (standard, rule exI[of _ "\<lambda> j. if j < Suc i then of_int (lam i) * \<mu> i j else 0"], rule eq_vecI)
            apply (subst sumlist_vec_index, insert idx i, auto intro!: gso_carrier sumlist_dim simp: o_def)
           apply (subst index_smult_vec, subst sumlist_dim, auto) 
           apply (subst sumlist_vec_index, auto, insert idx i main, auto simp: o_def)
         done
       qed auto
     qed
   qed
   then obtain nu where gg: "gg = sumlist (map (\<lambda> i. nu i \<cdot>\<^sub>v gso i) idx)" unfolding R_def by auto
   let ?ff = "sumlist (map (\<lambda>i. nu i \<cdot>\<^sub>v gso i) idx) + of_int l \<cdot>\<^sub>v gso k" 
   define hh where "hh = (\<lambda> i. (if i < k then nu i else of_int l))" 
   let ?hh = "sumlist (map (\<lambda> i. hh i \<cdot>\<^sub>v gso i) [0 ..< Suc k])" 
   have ffhh: "?hh = sumlist (map (\<lambda> i. hh i \<cdot>\<^sub>v gso i) [0 ..< k] @ [hh k \<cdot>\<^sub>v gso k])" 
     by simp
   also have "\<dots> = sumlist (map (\<lambda> i. hh i \<cdot>\<^sub>v gso i) [0 ..< k]) + sumlist [hh k \<cdot>\<^sub>v gso k]" 
     by (rule sumlist_append, insert kn, auto)
   also have "sumlist [hh k \<cdot>\<^sub>v gso k] = hh k \<cdot>\<^sub>v gso k" using kn by auto
   also have "\<dots> = of_int l \<cdot>\<^sub>v gso k" unfolding hh_def by auto
   also have "map (\<lambda> i. hh i \<cdot>\<^sub>v gso i) [0 ..< k] = map (\<lambda> i. nu i \<cdot>\<^sub>v gso i) [0 ..< k]" 
     by (rule map_cong, auto simp: hh_def)
   finally have ffhh: "?ff = ?hh" by (simp add: idx_def)
   from hgg[unfolded gg] 
   have h: "h = ?ff" by auto
   have "gso k \<bullet> gso k \<le> 1 * (gso k \<bullet> gso k)" by simp
   also have "\<dots> \<le> of_int (l * l) * (gso k \<bullet> gso k)" 
   proof (rule mult_right_mono)
     from l have "l * l \<ge> 1" by (meson eq_iff int_one_le_iff_zero_less mult_le_0_iff not_le)
     thus "1 \<le> (of_int (l * l) :: 'a)" by presburger     
     show "0 \<le> gso k \<bullet> gso k" by (rule scalar_prod_ge_0)
   qed
   also have "\<dots> = 0 + of_int (l * l) * (gso k \<bullet> gso k)" by simp
   also have "\<dots> \<le> sum_list (map (\<lambda> i. (nu i * nu i) * (gso i \<bullet> gso i)) idx) + of_int (l * l) * (gso k \<bullet> gso k)" 
     by (rule add_right_mono, rule sum_list_nonneg, auto, rule mult_nonneg_nonneg, auto simp: scalar_prod_ge_0)
   also have "map (\<lambda> i. (nu i * nu i) * (gso i \<bullet> gso i)) idx = map (\<lambda> i. hh i * hh i * (gso i \<bullet> gso i)) [0..<k]" 
     unfolding idx_def by (rule map_cong, auto simp: hh_def) 
   also have "of_int (l * l) = hh k * hh k" unfolding hh_def by auto
   also have "(\<Sum>i\<leftarrow>[0..<k]. hh i * hh i * (gso i \<bullet> gso i)) + hh k * hh k * (gso k \<bullet> gso k)
      = (\<Sum>i\<leftarrow>[0..<Suc k]. hh i * hh i * (gso i \<bullet> gso i))" by simp
   also have "\<dots> = ?hh \<bullet> ?hh" by (rule sym, rule scalar_prod_lincomb_gso, insert kn assms, auto)
   also have "\<dots> = ?ff \<bullet> ?ff" by (simp add: ffhh)
   also have "\<dots> = h \<bullet> h" unfolding h ..
   finally show ?thesis using kn unfolding sq_norm_vec_as_cscalar_prod by auto
 qed
 
    
 (* Theorem 16.9 
   (bound in textbook looks better as it uses 2^((n-1)/2), but this difference
   is caused by the fact that we here we look at the squared norms) *)
 lemma weakly_reduced_imp_short_vector: 
   assumes "weakly_reduced \<alpha> m"
     and in_L: "h \<in> lattice_of fs - {0\<^sub>v n}" and \<alpha>_pos:"\<alpha> \<ge> 1"
   shows "fs \<noteq> [] \<and> sq_norm (fs ! 0) \<le> \<alpha>^(m-1) * sq_norm h"
 proof -
   from gram_schmidt_short_vector assms obtain i where 
     i: "i < m" and le: "sq_norm (gso i) \<le> sq_norm h" by auto
   have small: "sq_norm (fs ! 0) \<le> \<alpha>^i * sq_norm (gso i)" using i
   proof (induct i)
     case 0
     show ?case unfolding fs0_gso0[OF 0] by auto
   next
     case (Suc i)
     hence "sq_norm (fs ! 0) \<le> \<alpha>^i * sq_norm (gso i)" by auto
     also have "\<dots> \<le> \<alpha>^i * (\<alpha> * (sq_norm (gso (Suc i))))" 
       using reduced_gso_E[OF assms(1) le_refl Suc(2)] \<alpha>_pos by auto
     finally show ?case unfolding class_semiring.nat_pow_Suc[of \<alpha> i] by auto
   qed
   also have "\<dots> \<le> \<alpha>^(m-1) * sq_norm h" 
     by (rule mult_mono[OF power_increasing le], insert i \<alpha>_pos, auto)
   finally show ?thesis using i by (cases fs, auto)
 qed
 
 
 lemma sq_norm_pos: 
   assumes j: "j < m" 
   shows "sq_norm (gso j) > 0"
 proof -
   from j have jj: "j < m - 0" by simp
   from orthogonalD[OF orthogonal_gso, unfolded length_map length_upt, OF jj jj] assms
   have "sq_norm (gso j) \<noteq> 0" using j by (simp add: sq_norm_vec_as_cscalar_prod)    
   moreover have "sq_norm (gso j) \<ge> 0" by auto
   ultimately show "0 < sq_norm (gso j)" by auto
 qed
 
 lemma Gramian_determinant: 
   assumes k: "k \<le> m" 
   shows "Gramian_determinant fs k = (\<Prod> j<k. sq_norm (gso j))"
     "Gramian_determinant fs k > 0" 
 proof -
   define Gk where "Gk = mat k n (\<lambda> (i,j). fs ! i $ j)" 
   have Gk: "Gk \<in> carrier_mat k n" unfolding Gk_def by auto
   define Mk where "Mk = mat k k (\<lambda> (i,j). \<mu> i j)" 
   have Mk_\<mu>: "i < k \<Longrightarrow> j < k \<Longrightarrow> Mk $$ (i,j) = \<mu> i j" for i j
     unfolding Mk_def using k by auto
   have Mk: "Mk \<in> carrier_mat k k" and [simp]: "dim_row Mk = k" "dim_col Mk = k" unfolding Mk_def by auto
   have "det Mk = prod_list (diag_mat Mk)" 
     by (rule det_lower_triangular[OF _ Mk], auto simp: Mk_\<mu> \<mu>.simps)
   also have "\<dots> = 1" 
     by (rule prod_list_neutral, auto simp: diag_mat_def Mk_\<mu> \<mu>.simps)
   finally have detMk: "det Mk = 1" .
   define Gsk where "Gsk = mat k n (\<lambda> (i,j). gso i $ j)" 
   have Gsk: "Gsk \<in> carrier_mat k n" unfolding Gsk_def by auto
   have Gsk': "Gsk\<^sup>T \<in> carrier_mat n k" using Gsk by auto
   let ?Rn = "carrier_vec n" 
   have id: "Gk = Mk * Gsk" 
   proof (rule eq_matI)
     from Gk Mk Gsk 
     have dim: "dim_row Gk = k" "dim_row (Mk * Gsk) = k" "dim_col Gk = n" "dim_col (Mk * Gsk) = n" by auto
     from dim show "dim_row Gk = dim_row (Mk * Gsk)" "dim_col Gk = dim_col (Mk * Gsk)" by auto
     fix i j
     assume "i < dim_row (Mk * Gsk)" "j < dim_col (Mk * Gsk)"     
     hence ij: "i < k" "j < n" and i: "i < m" using dim k by auto    
     have Gi: "fs ! i \<in> ?Rn" using i by simp
     have "Gk $$ (i, j) = fs ! i $ j" unfolding Gk_def using ij k Gi by auto
     also have "... = FF $$ (i,j)" using ij i by simp
     also have "FF = (M m) * Fs" by (rule matrix_equality)
     also have "\<dots> $$ (i,j) = row (M m) i \<bullet> col Fs j" 
       by (rule index_mult_mat(1), insert i ij, auto simp: mat_of_rows_list_def)
     also have "row (M m) i = vec m (\<lambda> j. if j < k then Mk $$ (i,j) else 0)" 
       (is "_ = vec m ?Mk") 
       unfolding Mk_def using ij i
       by (auto simp: mat_of_rows_list_def \<mu>.simps)
     also have "col Fs j = vec m (\<lambda> i'. if i' < k then Gsk $$ (i',j) else (Fs $$ (i',j)))" 
       (is "_ = vec m ?Gsk") 
       unfolding Gsk_def using ij i by (auto simp: mat_of_rows_def)
     also have "vec m ?Mk \<bullet> vec m ?Gsk = (\<Sum> i \<in> {0 ..< m}. ?Mk i * ?Gsk i)" 
       unfolding scalar_prod_def by auto
     also have "\<dots> = (\<Sum> i \<in> {0 ..< k} \<union> {k ..< m}. ?Mk i * ?Gsk i)"
       by (rule sum.cong, insert k, auto)
     also have "\<dots> = (\<Sum> i \<in> {0 ..< k}. ?Mk i * ?Gsk i) + (\<Sum> i \<in> {k ..< m}. ?Mk i * ?Gsk i)" 
       by (rule sum.union_disjoint, auto)
     also have "(\<Sum> i \<in> {k ..< m}. ?Mk i * ?Gsk i) = 0" 
       by (rule sum.neutral, auto)
     also have "(\<Sum> i \<in> {0 ..< k}. ?Mk i * ?Gsk i) = (\<Sum> i' \<in> {0 ..< k}. Mk $$ (i,i') * Gsk $$ (i',j))"
       by (rule sum.cong, auto)
     also have "\<dots> = row Mk i \<bullet> col Gsk j" unfolding scalar_prod_def using ij 
       by (auto simp: Gsk_def Mk_def)
     also have "\<dots> = (Mk * Gsk) $$ (i, j)" using ij Mk Gsk by simp
     finally show "Gk $$ (i, j) = (Mk * Gsk) $$ (i, j)" by simp
   qed
   have cong: "\<And> a b c d. a = b \<Longrightarrow> c = d \<Longrightarrow> a * c = b * d" by auto
   have "Gramian_determinant fs k = det (Gk * Gk\<^sup>T)" 
     unfolding Gramian_determinant_def Gramian_matrix_def Let_def
     by (rule arg_cong[of _ _ det], rule cong, insert k, auto simp: Gk_def) 
   also have "Gk\<^sup>T = Gsk\<^sup>T * Mk\<^sup>T" (is "_ = ?TGsk * ?TMk") unfolding id 
     by (rule transpose_mult[OF Mk Gsk])
   also have "Gk = Mk * Gsk" by fact
   also have "\<dots> * (?TGsk * ?TMk) = Mk * (Gsk * (?TGsk * ?TMk))" 
     by (rule assoc_mult_mat[OF Mk Gsk, of _ k], insert Gsk Mk, auto)
   also have "det \<dots> = det Mk * det (Gsk * (?TGsk * ?TMk))" 
     by (rule det_mult[OF Mk], insert Gsk Mk, auto)
   also have "\<dots> = det (Gsk * (?TGsk * ?TMk))" using detMk by simp
   also have "Gsk * (?TGsk * ?TMk) = (Gsk * ?TGsk) * ?TMk" 
     by (rule assoc_mult_mat[symmetric, OF Gsk], insert Gsk Mk, auto)
   also have "det \<dots> = det (Gsk * ?TGsk) * det ?TMk" 
     by (rule det_mult, insert Gsk Mk, auto)
   also have "\<dots> = det (Gsk * ?TGsk)" using detMk det_transpose[OF Mk] by simp
   also have "Gsk * ?TGsk = mat k k (\<lambda> (i,j). if i = j then sq_norm (gso j) else 0)" (is "_ = ?M")
   proof (rule eq_matI)
     show "dim_row (Gsk * ?TGsk) = dim_row ?M" unfolding Gsk_def by auto
     show "dim_col (Gsk * ?TGsk) = dim_col ?M" unfolding Gsk_def by auto
     fix i j
     assume "i < dim_row ?M" "j < dim_col ?M" 
     hence ij: "i < k" "j < k" and ijn: "i < m" "j < m" using k by auto
     {
       fix i
       assume "i < k" 
       hence "i < m" using k by auto
       hence Gs: "gso i \<in> ?Rn" by auto
       have "row Gsk i = gso i" unfolding row_def Gsk_def
         by (rule eq_vecI, insert Gs \<open>i < k\<close>, auto)
     } note row = this
     have "(Gsk * ?TGsk) $$ (i,j) = row Gsk i \<bullet> row Gsk j" using ij Gsk by auto
     also have "\<dots> = gso i \<bullet> gso j" using row ij by simp
     also have "\<dots> = (if i = j then sq_norm (gso j) else 0)" 
     proof (cases "i = j")
       assume "i = j" 
       thus ?thesis by (simp add: sq_norm_vec_as_cscalar_prod) 
     next
       assume "i \<noteq> j" 
       from \<open>i \<noteq> j\<close> orthogonalD[OF orthogonal_gso] ijn assms
       show ?thesis by auto
     qed
     also have "\<dots> = ?M $$ (i,j)" using ij by simp
     finally show "(Gsk * ?TGsk) $$ (i,j) = ?M $$ (i,j)" .
   qed
   also have "det ?M = prod_list (diag_mat ?M)" 
     by (rule det_upper_triangular, auto)
   also have "diag_mat ?M = map (\<lambda> j. sq_norm (gso j)) [0 ..< k]" unfolding diag_mat_def by auto
   also have "prod_list \<dots> = (\<Prod> j < k. sq_norm (gso j))"
     by (subst prod.distinct_set_conv_list[symmetric], force, rule prod.cong, auto) 
   finally show "Gramian_determinant fs k = (\<Prod>j<k. \<parallel>gso j\<parallel>\<^sup>2)" .
   also have "\<dots> > 0" 
     by (rule prod_pos, intro ballI sq_norm_pos, insert k assms, auto)
   finally show "0 < Gramian_determinant fs k" by auto
 qed
 
 lemma Gramian_determinant_div:
   assumes "l < m"
   shows "Gramian_determinant fs (Suc l) / Gramian_determinant fs l = \<parallel>gso l\<parallel>\<^sup>2"
 proof -
   note gram = Gramian_determinant(1)[symmetric]
   from assms have le: "Suc l \<le> m" "l \<le> m" by auto
   have "(\<Prod>j<Suc l. \<parallel>gso j\<parallel>\<^sup>2) = (\<Prod>j \<in> {0..<l} \<union> {l}. \<parallel>gso j\<parallel>\<^sup>2)"
     using assms by (intro prod.cong) (auto)
   also have "\<dots> = (\<Prod>j<l. \<parallel>gso j\<parallel>\<^sup>2) * \<parallel>gso l\<parallel>\<^sup>2"
     using assms by (subst prod_Un) (auto simp add: atLeast0LessThan)
   finally show ?thesis unfolding gram[OF le(1)] gram[OF le(2)]
     using Gramian_determinant(2)[OF le(2)] assms by auto 
 qed
 
 end
 
 lemma (in gram_schmidt_fs_Rn) Gramian_determinant_Ints:
   assumes "k \<le> m" "\<And>i j. i < n \<Longrightarrow> j < m \<Longrightarrow> fs ! j $ i \<in> \<int>"
   shows "Gramian_determinant fs k \<in> \<int>"
 proof -
   let ?oi = "of_int :: int \<Rightarrow> 'a" 
   from assms have "\<And> i. i < n \<Longrightarrow> \<forall>j. \<exists> c. j < m \<longrightarrow> fs ! j $ i = ?oi c" unfolding Ints_def by auto
   from choice[OF this] have "\<forall> i. \<exists> c. \<forall> j. i < n \<longrightarrow> j < m \<longrightarrow> fs ! j $ i = ?oi (c j)" by blast
   from choice[OF this] obtain c where c: "\<And> i j. i < n \<Longrightarrow> j < m \<Longrightarrow> fs ! j $ i = ?oi (c i j)" by blast
   define d where "d = map (\<lambda> j. vec n (\<lambda> i. c i j)) [0..<m]" 
   have fs: "fs = map (map_vec ?oi) d" 
     unfolding d_def by (rule nth_equalityI, auto intro!: eq_vecI c)
   have id: "mat k n (\<lambda>(i, y). map (map_vec ?oi) d ! i $ y) = map_mat of_int (mat k n (\<lambda>(i, y). d ! i $ y))" 
     by (rule eq_matI, insert \<open>k \<le> m\<close>, auto simp: d_def o_def)
   show ?thesis unfolding fs Gramian_determinant_def Gramian_matrix_def Let_def id
     map_mat_transpose
     by (subst of_int_hom.mat_hom_mult[symmetric], auto)
 qed
 
 locale gram_schmidt_fs_int = gram_schmidt_fs_lin_indpt +
   assumes fs_int: "\<And>i j. i < n \<Longrightarrow> j < m \<Longrightarrow> fs ! j $ i \<in> \<int>"
 begin
 
 lemma Gramian_determinant_ge1:
   assumes "k \<le> m"
   shows "1 \<le> Gramian_determinant fs k"
 proof -
   have "0 < Gramian_determinant fs k"
     by (simp add: assms Gramian_determinant(2) less_or_eq_imp_le)
   moreover have "Gramian_determinant fs k \<in> \<int>"
     by (simp add: Gramian_determinant_Ints assms fs_int)
   ultimately show ?thesis
     using Ints_nonzero_abs_ge1 by fastforce
 qed
 
 lemma mu_bound_Gramian_determinant:
   assumes "l < k" "k < m"
   shows "(\<mu> k l)\<^sup>2 \<le> Gramian_determinant fs l * \<parallel>fs ! k\<parallel>\<^sup>2"
 proof -
   have "(\<mu> k l)\<^sup>2  = (fs ! k \<bullet> gso l)\<^sup>2 / (\<parallel>gso l\<parallel>\<^sup>2)\<^sup>2"
     using assms by (simp add: power_divide \<mu>.simps)
   also have "\<dots> \<le> (\<parallel>fs ! k\<parallel>\<^sup>2 * \<parallel>gso l\<parallel>\<^sup>2) / (\<parallel>gso l\<parallel>\<^sup>2)\<^sup>2"
     using assms by (auto intro!: scalar_prod_Cauchy divide_right_mono)
   also have "\<dots> = \<parallel>fs ! k\<parallel>\<^sup>2 / \<parallel>gso l\<parallel>\<^sup>2"
     by (auto simp add: field_simps power2_eq_square)
   also have "\<dots> =  \<parallel>fs ! k\<parallel>\<^sup>2 / (Gramian_determinant fs (Suc l) / Gramian_determinant fs l)"
     using assms by (subst Gramian_determinant_div[symmetric]) auto
   also have "\<dots> =  Gramian_determinant fs l * \<parallel>fs ! k\<parallel>\<^sup>2 / Gramian_determinant fs (Suc l)"
     by (auto simp add: field_simps)
   also have "\<dots> \<le> Gramian_determinant fs l * \<parallel>fs ! k\<parallel>\<^sup>2 / 1"
     by (rule divide_left_mono, insert Gramian_determinant_ge1[of l] Gramian_determinant_ge1[of "Suc l"] assms,
     auto intro!: mult_nonneg_nonneg) 
   finally show ?thesis
     by simp
 qed
 
 end (* gram_schmidt_fs_int *)
 
 context gram_schmidt
 begin
 
 lemma gso_cong:
   fixes f1 f2 :: "'a vec list"
   assumes "\<And> i. i \<le> x \<Longrightarrow> f1 ! i = f2 ! i"
   shows "gram_schmidt_fs.gso n f1 x = gram_schmidt_fs.gso n f2 x"
   using assms
 proof(induct x rule:nat_less_induct[rule_format])
   case (1 x)
   interpret f1: gram_schmidt_fs n f1 .
   interpret f2: gram_schmidt_fs n f2 .
   have *: "map (\<lambda>j. - f1.\<mu> x j \<cdot>\<^sub>v f1.gso j) [0..<x] = map (\<lambda>j. - f2.\<mu> x j \<cdot>\<^sub>v f2.gso j) [0..<x]"
     using 1 by (intro map_cong) (auto simp add: f1.\<mu>.simps f2.\<mu>.simps)
   show ?case
     using 1 by (subst f1.gso.simps, subst f2.gso.simps, subst *) auto
 qed
 
 lemma \<mu>_cong:
   fixes f1 f2 :: "'a vec list"
   assumes "\<And> k. j < i \<Longrightarrow> k \<le> j \<Longrightarrow> f1 ! k = f2 ! k"
     and "j < i \<Longrightarrow> f1 ! i = f2 ! i" 
   shows "gram_schmidt_fs.\<mu> n f1 i j = gram_schmidt_fs.\<mu> n f2 i j"
 proof -
   interpret f1: gram_schmidt_fs n f1 .
   interpret f2: gram_schmidt_fs n f2 .
   from gso_cong[of j f1 f2] assms have id: "j < i \<Longrightarrow> f1.gso j = f2.gso j" by auto
   show ?thesis unfolding f1.\<mu>.simps f2.\<mu>.simps using assms id by auto
 qed
 
 end
 
 lemma prod_list_le_mono: fixes us :: "'a :: {linordered_nonzero_semiring,ordered_ring} list" 
   assumes "length us = length vs" 
   and "\<And> i. i < length vs \<Longrightarrow> 0 \<le> us ! i \<and> us ! i \<le> vs ! i" 
 shows "0 \<le> prod_list us \<and> prod_list us \<le> prod_list vs" 
   using assms 
 proof (induction us vs rule: list_induct2)
   case (Cons u us v vs)
   have "0 \<le> prod_list us \<and> prod_list us \<le> prod_list vs" 
     by (rule Cons.IH, insert Cons.prems[of "Suc i" for i], auto)
   moreover have "0 \<le> u \<and> u \<le> v" using Cons.prems[of 0] by auto
   ultimately show ?case by (auto intro: mult_mono)
 qed simp
 
 lemma lattice_of_of_int: assumes G: "set F \<subseteq> carrier_vec n" 
   and "f \<in> vec_module.lattice_of n F"     
 shows "map_vec rat_of_int f \<in> vec_module.lattice_of n (map (map_vec of_int) F)" 
   (is "?f \<in> vec_module.lattice_of _ ?F")
 proof -
   let ?sl = "abelian_monoid.sumlist (module_vec TYPE('a::semiring_1) n)" 
   note d = vec_module.lattice_of_def
   note dim = vec_module.sumlist_dim
   note sumlist_vec_index = vec_module.sumlist_vec_index
   from G have Gi: "\<And> i. i < length F \<Longrightarrow> F ! i \<in> carrier_vec n" by auto
   from Gi have Gid: "\<And> i. i < length F \<Longrightarrow> dim_vec (F ! i) = n" by auto
   from assms(2)[unfolded d]
   obtain c where 
     ffc: "f = ?sl (map (\<lambda>i. of_int (c i) \<cdot>\<^sub>v F ! i) [0..<length F])" (is "_ = ?g") by auto   
   have "?f = ?sl (map (\<lambda>i. of_int (c i) \<cdot>\<^sub>v ?F ! i) [0..<length ?F])" (is "_ = ?gg")
   proof -
     have d1[simp]: "dim_vec ?g = n" by (subst dim, auto simp: Gi)
     have d2[simp]: "dim_vec ?gg = n" unfolding length_map by (subst vec_module.sumlist_dim, auto simp: Gi G)
     show ?thesis
       unfolding ffc length_map
       apply (rule eq_vecI)
        apply (insert d1 d2, auto)[2]
       apply (subst (1 2) sumlist_vec_index, auto simp: o_def Gi G)
       apply (unfold of_int_hom.hom_sum_list)
       apply (intro arg_cong[of _ _ sum_list] map_cong)
         by (auto simp: G Gi, (subst index_smult_vec, simp add: Gid)+,
          subst index_map_vec, auto simp: Gid)
   qed
   thus "?f \<in> vec_module.lattice_of n ?F" unfolding d by auto
 qed
 
 
 (* Theorem 16.6, difficult part *)
 lemma Hadamard's_inequality: 
   fixes A::"real mat"
   assumes A: "A \<in> carrier_mat n n" 
   shows  "abs (det A) \<le> sqrt (prod_list (map sq_norm (rows A)))" 
 proof -
   let ?us = "map (row A) [0 ..< n]"
   interpret gso: gram_schmidt_fs n ?us .
   have len: "length ?us = n" by simp
   have us: "set ?us \<subseteq> carrier_vec n" using A by auto
   let ?vs = "map gso.gso [0..<n]" 
   show ?thesis
   proof (cases "carrier_vec n \<subseteq> gso.span (set ?us)")
     case True
     with us len have basis: "gso.basis_list ?us" unfolding gso.basis_list_def by auto
     note in_dep = gso.basis_list_imp_lin_indpt_list[OF basis]
     interpret gso: gram_schmidt_fs_lin_indpt n ?us
       by (standard) (use in_dep gso.lin_indpt_list_def in auto)
     have last: "0 \<le> prod_list (map sq_norm ?vs) \<and> prod_list (map sq_norm ?vs) \<le> prod_list (map sq_norm ?us)" 
     proof (rule prod_list_le_mono, force, unfold length_map length_upt)
       fix i
       assume "i < n - 0" 
       hence i: "i < n" by simp
       have vsi: "map sq_norm ?vs ! i = sq_norm (?vs ! i)" using i by simp
       have usi: "map sq_norm ?us ! i = sq_norm (row A i)" using i by simp
       have zero: "0 \<le> sq_norm (?vs ! i)" by auto
       have le: "sq_norm (?vs ! i) \<le> sq_norm (row A i)"
         using gso.sq_norm_gso_le_f i by simp
       show "0 \<le> map sq_norm ?vs ! i \<and> map sq_norm ?vs ! i \<le> map sq_norm ?us ! i" 
         unfolding vsi usi using zero le by auto
     qed
     have Fs: "gso.FF \<in> carrier_mat n n" by auto
     have A_Fs: "A = gso.FF" 
       by (rule eq_matI, subst gso.FF_index, insert A, auto)
     hence "abs (det A) = abs (det (gso.FF))" by simp
     (* the following three steps are based on a discussion with Bertram Felgenhauer *)
     also have "\<dots> = abs (sqrt (det (gso.FF) * det (gso.FF)))" by simp
     also have "det (gso.FF) * det (gso.FF) = det (gso.FF) * det (gso.FF)\<^sup>T" 
       unfolding det_transpose[OF Fs] ..
     also have "\<dots> = det (gso.FF * (gso.FF)\<^sup>T)" 
       by (subst det_mult[OF Fs], insert Fs, auto)
     also have "\<dots> = gso.Gramian_determinant ?us n" 
       unfolding gso.Gramian_matrix_def gso.Gramian_determinant_def Let_def A_Fs[symmetric]
       by (rule arg_cong[of _ _ det], rule arg_cong2[of _ _ _ _ "(*)"], insert A, auto)
     also have "\<dots> = (\<Prod>j \<in> set [0 ..< n]. \<parallel>?vs ! j\<parallel>\<^sup>2)"
       by (subst gso.Gramian_determinant) (auto intro!: prod.cong)
     also have "\<dots> = prod_list (map (\<lambda> i. sq_norm (?vs ! i)) [0 ..< n])"
       by (subst prod.distinct_set_conv_list, auto)
     also have "map (\<lambda> i. sq_norm (?vs ! i)) [0 ..< n] = map sq_norm ?vs" 
       by (intro nth_equalityI, auto)
     also have "abs (sqrt (prod_list \<dots>)) \<le> sqrt (prod_list (map sq_norm ?us))" 
       using last by simp
     also have "?us = rows A" unfolding rows_def using A by simp
     finally show ?thesis .
   next
     case False
     from mat_of_rows_rows[unfolded rows_def,of A] A gram_schmidt.non_span_det_zero[OF len False us]
     have zero: "det A = 0" by auto
     have ge: "prod_list (map sq_norm (rows A)) \<ge> 0" 
       by (rule prod_list_nonneg, auto simp: sq_norm_vec_ge_0)
     show ?thesis unfolding zero using ge by simp
   qed
 qed
 
 
 definition "gram_schmidt_wit = gram_schmidt.main" 
 
 declare gram_schmidt.adjuster_wit.simps[code]
 declare gram_schmidt.sub2_wit.simps[code]
 declare gram_schmidt.main_def[code]
       
 definition gram_schmidt_int :: "nat \<Rightarrow> int vec list \<Rightarrow> rat list list \<times> rat vec list" where
   "gram_schmidt_int n us = gram_schmidt_wit n (map (map_vec of_int) us)" 
 
 lemma snd_gram_schmidt_int : "snd (gram_schmidt_int n us) = gram_schmidt n (map (map_vec of_int) us)"
   unfolding gram_schmidt_int_def gram_schmidt_wit_def gram_schmidt_fs.gso_connect by metis
 
 text \<open>Faster implementation for rational vectors which also avoid recomputations
   of square-norms\<close>
 
 fun adjuster_triv :: "nat \<Rightarrow> rat vec \<Rightarrow> (rat vec \<times> rat) list \<Rightarrow> rat vec"
   where "adjuster_triv n w [] = 0\<^sub>v n"
     |  "adjuster_triv n w ((u,nu)#us) = -(w \<bullet> u)/ nu \<cdot>\<^sub>v u + adjuster_triv n w us"
 
 fun gram_schmidt_sub_triv
   where "gram_schmidt_sub_triv n us [] = us"
   | "gram_schmidt_sub_triv n us (w # ws) = (let u = adjuster_triv n w us + w in
      gram_schmidt_sub_triv n ((u, sq_norm_vec_rat u) # us) ws)"
 
 definition gram_schmidt_triv :: "nat \<Rightarrow> rat vec list \<Rightarrow> (rat vec \<times> rat) list"
   where "gram_schmidt_triv n ws = rev (gram_schmidt_sub_triv n [] ws)"
 
 lemma adjuster_triv: "adjuster_triv n w (map (\<lambda> x. (x,sq_norm x)) us) = adjuster n w us" 
   by (induct us, auto simp: sq_norm_vec_as_cscalar_prod) 
 
 lemma gram_schmidt_sub_triv: "gram_schmidt_sub_triv n ((map (\<lambda> x. (x,sq_norm x)) us)) ws = 
   map (\<lambda> x. (x, sq_norm x)) (gram_schmidt_sub n us ws)" 
   by (rule sym, induct ws arbitrary: us, auto simp: adjuster_triv o_def Let_def)
 
 lemma gram_schmidt_triv[simp]: "gram_schmidt_triv n ws = map (\<lambda> x. (x,sq_norm x)) (gram_schmidt n ws)" 
   unfolding gram_schmidt_def gram_schmidt_triv_def rev_map[symmetric] 
   by (auto simp: gram_schmidt_sub_triv[symmetric])
 
 context gram_schmidt
 begin
 
 fun mus_adjuster :: "'a vec \<Rightarrow> ('a vec \<times> 'a) list \<Rightarrow> 'a list \<Rightarrow> 'a vec \<Rightarrow> 'a list \<times> 'a vec"
   where
   "mus_adjuster f []           mus g' = (mus, g')" |
   "mus_adjuster f ((g, ng)#n_gs) mus g' = (let a = (f \<bullet> g) / ng in
                                              mus_adjuster f n_gs (a # mus) (-a \<cdot>\<^sub>v g + g'))"
 
 fun norms_mus' where
   "norms_mus' []       n_gs mus = (map snd n_gs, mus)" |
   "norms_mus' (f # fs) n_gs mus =
     (let (mus_row, g') = mus_adjuster f n_gs [] (0\<^sub>v n);
                      g = g' + f in
       norms_mus' fs ((g, sq_norm_vec g) # n_gs) (mus_row#mus))"
 
 lemma adjuster_wit_carrier_vec:
   assumes "f \<in> carrier_vec n" "set gs \<subseteq> carrier_vec n"
   shows "snd (adjuster_wit mus f gs) \<in> carrier_vec n"
   using assms
   by (induction mus f gs rule: adjuster_wit.induct) (auto simp add: Let_def case_prod_beta')
 
 lemma adjuster_wit'':
   assumes "adjuster_wit mus_acc f gs = (mus, g')" "n_gs = map (\<lambda>x. (x, sq_norm_vec x)) gs"
  "f \<in> carrier_vec n" "acc \<in> carrier_vec n" "set gs \<subseteq> carrier_vec n"
   shows "mus_adjuster f n_gs mus_acc acc = (mus, acc + g')"
   using assms proof(induction f n_gs mus_acc acc arbitrary: g' gs mus rule: mus_adjuster.induct)
   case (1 mus' f acc g)
   then show ?case
     by auto
 next
   case (2 f g n_g n_gs mus_acc acc g' gs mus)
   let ?gg = "snd (adjuster_wit (f \<bullet> g / n_g # mus_acc) f (tl gs))"
   from 2 have l: "gs = g # tl gs"
     by auto
   have gg: "?gg \<in> carrier_vec n"
     using 2 by (auto intro!: adjuster_wit_carrier_vec)
   then have [simp]: "g' = (- (f \<bullet> g / \<parallel>g\<parallel>\<^sup>2) \<cdot>\<^sub>v g + ?gg)"
     using 2 by (auto simp add: Let_def case_prod_beta')
   have "mus_adjuster f ((g, n_g) # n_gs) mus_acc acc =
         mus_adjuster f n_gs (f \<bullet> g / n_g # mus_acc) (- (f \<bullet> g / n_g) \<cdot>\<^sub>v g + acc)"
     by (auto simp add: Let_def)
   also have "\<dots> = (mus, - (f \<bullet> g / n_g) \<cdot>\<^sub>v g + acc + ?gg)"
   proof -
     have "adjuster_wit (f \<bullet> g / n_g # mus_acc) f (tl gs) = (mus, ?gg)"
       using 2 by (subst (asm) l) (auto simp add: Let_def case_prod_beta')
     then show ?thesis
       using 2 by (subst 2(1)[of _ "tl gs"]) (auto simp add: Let_def case_prod_beta')
   qed
   finally show ?case
     using 2 gg by auto
 qed
 
 lemma adjuster_wit':
   assumes "n_gs = map (\<lambda>x. (x, sq_norm_vec x)) gs" "f \<in> carrier_vec n" "set gs \<subseteq> carrier_vec n"
   shows "mus_adjuster f n_gs mus_acc (0\<^sub>v n) = adjuster_wit mus_acc f gs"
 proof -
   let ?g = "snd (adjuster_wit mus_acc f gs)"
   let ?mus = "fst (adjuster_wit mus_acc f gs)"
   have "?g \<in> carrier_vec n"
     using assms by (auto intro!: adjuster_wit_carrier_vec)
   then show ?thesis
     using assms by (subst adjuster_wit''[of _ _ gs ?mus ?g]) (auto simp add: case_prod_beta')
 qed
 
 lemma sub2_wit_norms_mus':
   assumes "n_gs' = map (\<lambda>v. (v, sq_norm_vec v)) gs'"
    "sub2_wit gs' fs = (mus, gs)" "set fs \<subseteq> carrier_vec n" "set gs' \<subseteq> carrier_vec n"
  shows "norms_mus' fs n_gs' mus_acc = (map sq_norm_vec (rev gs @ gs'), rev mus @ mus_acc)"
   using assms proof (induction fs n_gs' mus_acc arbitrary: gs' mus gs rule: norms_mus'.induct)
   case (1 n_gs mus_acc)
   then show ?case by (auto simp add: rev_map)
 next
   case (2  f fs n_gs mus_acc)
   note aw1 = conjunct1[OF conjunct2[OF gram_schmidt_fs.adjuster_wit]]
   let ?aw = "mus_adjuster f n_gs [] (0\<^sub>v n)"
   have aw: "?aw = adjuster_wit [] f gs'"
     apply(subst adjuster_wit') using 2 by auto
   have "sub2_wit ((snd ?aw + f) # gs') fs = sub2_wit ((snd (adjuster_wit [] f gs') + f) # gs') fs"
     apply(subst adjuster_wit') using 2 by auto
   also have "\<dots> = (tl mus, tl gs)"
     using 2 by (auto simp add: Let_def case_prod_beta')
   finally have sub_tl: "sub2_wit ((snd ?aw + f) # gs') fs = (tl mus, tl gs)"
     by simp
   have aw_c: "snd ?aw \<in> carrier_vec n"
     apply(subst adjuster_wit'[of _ gs'])
      using 2 adjuster_wit_carrier_vec by (auto)
   have gs: "gs = (snd ?aw + f) # tl gs"
     apply(subst aw) using 2 by (auto simp add: Let_def case_prod_beta')
   have mus: "mus = fst ?aw # tl mus"
     apply(subst aw) using 2 by (auto simp add: Let_def case_prod_beta')
   show ?case apply(simp add: Let_def case_prod_beta')
     apply(subst 2(1)[of _ _ _ _ "(snd ?aw + f)#gs'"  "tl mus" "tl gs"]) apply(simp) defer apply(simp)
          apply (simp add: "2.prems"(1))
     using sub_tl apply(simp)
     using 2 apply(simp)
     subgoal using 2 aw_c by (auto)
      defer
      apply(simp)
     apply(auto)
     using gs 
      apply(subst gs) apply(subst (2) gs)
      apply (metis list.simps(9) rev.simps(2) rev_map)
     using mus
     by (metis rev.simps(2))
 qed
 
 lemma sub2_wit_gram_schmidt_sub_triv'':
   assumes "sub2_wit [] fs = (mus, gs)" "set fs \<subseteq> carrier_vec n"
   shows "norms_mus' fs [] [] = (map sq_norm_vec (rev gs), rev mus)"
   using assms by (subst sub2_wit_norms_mus') (simp)+
 
 definition norms_mus where
   "norms_mus fs = (let (n_gs, mus) = norms_mus' fs [] [] in (rev n_gs, rev mus))"
 
 lemma sub2_wit_gram_schmidt_norm_mus:
   assumes "sub2_wit [] fs = (mus, gs)" "set fs \<subseteq> carrier_vec n"
   shows "norms_mus fs = (map sq_norm_vec gs, mus)"
   unfolding norms_mus_def using assms sub2_wit_gram_schmidt_sub_triv''
   by (auto simp add: Let_def case_prod_beta' rev_map)
 
 lemma (in gram_schmidt_fs_Rn) norms_mus: assumes "set fs \<subseteq> carrier_vec n" "length fs \<le> n"
   shows "norms_mus fs = (map (\<lambda>j. \<parallel>gso j\<parallel>\<^sup>2) [0..<length fs], map (\<lambda>i. map (\<mu> i) [0..<i]) [0..<length fs])" 
 proof -
   let ?s = "sub2_wit [] fs"
   have "gram_schmidt_sub2 n [] fs = snd ?s \<and> snd ?s = map (gso) [0..<length fs] \<and> fst ?s = map (\<lambda>i. map (\<mu> i) [0..<i]) [0..<length fs]"
     using assms by (intro sub2_wit) (auto simp add: map_nth)
   then have 1: "snd ?s = map (gso) [0..<length fs]" and 2: "fst ?s = map (\<lambda>i. map (\<mu> i) [0..<i]) [0..<length fs]" 
     by auto
   have s: "?s = (fst ?s, snd ?s)" by auto
   show ?thesis
     unfolding sub2_wit_gram_schmidt_norm_mus[OF s assms(1)]
     unfolding 1 2 o_def map_map by auto
 qed
 
 end
 
 fun mus_adjuster_rat :: "rat vec \<Rightarrow> (rat vec \<times> rat) list \<Rightarrow> rat list \<Rightarrow> rat vec \<Rightarrow> rat list \<times> rat vec"
   where
   "mus_adjuster_rat f []           mus g' = (mus, g')" |
   "mus_adjuster_rat f ((g, ng)#n_gs) mus g' = (let a = (f \<bullet> g) / ng in
                                              mus_adjuster_rat f n_gs (a # mus) (-a \<cdot>\<^sub>v g + g'))"
 
 fun norms_mus_rat' where
   "norms_mus_rat' n []       n_gs mus = (map snd n_gs, mus)" |
   "norms_mus_rat' n (f # fs) n_gs mus =
     (let (mus_row, g') = mus_adjuster_rat f n_gs [] (0\<^sub>v n);
                      g = g' + f in
       norms_mus_rat' n fs ((g, sq_norm_vec g) # n_gs) (mus_row#mus))"
 
 definition norms_mus_rat where
   "norms_mus_rat n fs = (let (n_gs, mus) = norms_mus_rat' n fs [] [] in (rev n_gs, rev mus))"
 
 lemma norms_mus_rat_norms_mus:
   "norms_mus_rat n fs = gram_schmidt.norms_mus n fs"
 proof -
   have "mus_adjuster_rat f n_gs mus_acc g_acc = gram_schmidt.mus_adjuster f n_gs mus_acc g_acc"
     for f n_gs mus_acc g_acc
     by(induction f n_gs mus_acc g_acc rule: mus_adjuster_rat.induct)
       (auto simp add: gram_schmidt.mus_adjuster.simps)
   then have "norms_mus_rat' n fs n_gs mus = gram_schmidt.norms_mus' n fs n_gs mus" for n fs n_gs mus
     by(induction n fs n_gs mus rule: norms_mus_rat'.induct)
       (auto simp add: gram_schmidt.norms_mus'.simps case_prod_beta')
   then show ?thesis
     unfolding norms_mus_rat_def gram_schmidt.norms_mus_def by auto
 qed
 
 lemma of_int_dvd:
   "b dvd a" if "of_int a / (of_int b :: 'a :: field_char_0) \<in> \<int>" "b \<noteq> 0"
   using that by (cases rule: Ints_cases)
     (simp add: field_simps flip: of_int_mult)
 
 lemma denom_dvd_ints:
   fixes i::int
   assumes "quotient_of r = (z, n)" "of_int i * r \<in> \<int>"
   shows "n dvd i"
 proof -
   have "rat_of_int i * (rat_of_int z / rat_of_int n) \<in> \<int>"
     using assms quotient_of_div by blast
   then have "n dvd i * z"
     using quotient_of_denom_pos assms by (auto intro!: of_int_dvd)
   then show "n dvd i"
     using assms algebraic_semidom_class.coprime_commute 
       quotient_of_coprime coprime_dvd_mult_left_iff by blast
 qed
 
 lemma quotient_of_bounds: 
   assumes "quotient_of r = (n, d)" "rat_of_int i * r \<in> \<int>" "0 < i" "\<bar>r\<bar> \<le> b"
   shows "of_int \<bar>n\<bar> \<le> of_int i * b" "d \<le> i" 
 proof -
   show ni: "d \<le> i"
     using assms denom_dvd_ints  by (intro zdvd_imp_le) blast+
   have "\<bar>r\<bar> = \<bar>rat_of_int n / rat_of_int d\<bar>"
     using assms quotient_of_div by blast
   also have "\<dots> = rat_of_int \<bar>n\<bar> / rat_of_int d"
     using assms using quotient_of_denom_pos by force
   finally have "of_int \<bar>n\<bar> = rat_of_int d * \<bar>r\<bar>"
     using assms by auto
   also have "\<dots> \<le> rat_of_int d * b"
     using assms quotient_of_denom_pos by auto
   also have "\<dots> \<le> rat_of_int i * b"
     using ni assms of_int_le_iff by (auto intro!: mult_right_mono)
   finally show "rat_of_int \<bar>n\<bar> \<le> rat_of_int i * b" 
     by simp
 qed
 
 context gram_schmidt_fs_Rn
 begin
 
 (* Lemma 16.17 *) 
 
 lemma ex_\<kappa>:
   assumes "i < length fs" "l \<le> i"
   shows "\<exists>\<kappa>. sumlist (map (\<lambda>j. - \<mu> i j \<cdot>\<^sub>v gso j) [0 ..< l]) =
              sumlist (map (\<lambda>j. \<kappa> j \<cdot>\<^sub>v fs ! j) [0 ..< l])" (is "\<exists>\<kappa>. ?Prop l i \<kappa>")
   using assms 
 proof (induction l arbitrary: i)
   case (Suc l)
   then obtain \<kappa>\<^sub>i where \<kappa>\<^sub>i_def: "?Prop l i \<kappa>\<^sub>i"
     by force
   from Suc obtain \<kappa>\<^sub>l where \<kappa>\<^sub>l_def: "?Prop l l \<kappa>\<^sub>l"
     by force
   have [simp]: "dim_vec (M.sumlist (map (\<lambda>j. f j \<cdot>\<^sub>v fs ! j) [0..<y])) = n" if "y \<le> Suc l" for f y
     using Suc that by (auto intro!: dim_sumlist)
   define \<kappa> where "\<kappa> = (\<lambda>x. (if x < l then \<kappa>\<^sub>i x - \<kappa>\<^sub>l x * \<mu> i l else  - \<mu> i l))"
   let ?sum = "\<lambda>i. sumlist (map (\<lambda>j. - \<mu> i j \<cdot>\<^sub>v gso j) [0..<l])"
   have "M.sumlist (map (\<lambda>j. - \<mu> i j \<cdot>\<^sub>v gso j) [0..<Suc l]) = 
         M.sumlist (map (\<lambda>j. \<kappa>\<^sub>i j \<cdot>\<^sub>v fs ! j) [0..<l]) + - \<mu> i l \<cdot>\<^sub>v gso l"
     using Suc by (subst \<kappa>\<^sub>i_def[symmetric], subst sumlist_snoc[symmetric]) (auto)
   also have "gso l = fs ! l + M.sumlist (map (\<lambda>j. \<kappa>\<^sub>l j \<cdot>\<^sub>v fs ! j) [0..<l])"
     by (subst gso.simps) (auto simp add: \<kappa>\<^sub>l_def)
   also have "M.sumlist (map (\<lambda>j. \<kappa>\<^sub>i j \<cdot>\<^sub>v fs ! j) [0..<l]) +
              - \<mu> i l \<cdot>\<^sub>v (fs ! l + M.sumlist (map (\<lambda>j. \<kappa>\<^sub>l j \<cdot>\<^sub>v fs ! j) [0..<l]))
              = M.sumlist (map (\<lambda>j. \<kappa> j \<cdot>\<^sub>v fs ! j) [0..<Suc l])" (is "?lhs = ?rhs")
   proof -
     have "?lhs $ k = ?rhs $ k" if "k < n" for k
     proof -
       have "(M.sumlist (map (\<lambda>j. \<kappa>\<^sub>i j \<cdot>\<^sub>v fs ! j) [0..<l]) + 
                 - \<mu> i l \<cdot>\<^sub>v (fs ! l + M.sumlist (map (\<lambda>j. \<kappa>\<^sub>l j \<cdot>\<^sub>v fs ! j) [0..<l]))) $ k
           = (M.sumlist (map (\<lambda>j. \<kappa>\<^sub>i j \<cdot>\<^sub>v fs ! j) [0..<l]) $ k + 
                 - \<mu> i l * (fs ! l $ k + M.sumlist (map (\<lambda>j. \<kappa>\<^sub>l j \<cdot>\<^sub>v fs ! j) [0..<l]) $ k))"
         using that by auto
       also have "\<dots> = (\<Sum>j = 0..<l. \<kappa>\<^sub>i j * fs ! j $ k) 
                  + (- \<mu> i l * (\<Sum>j = 0..<l. \<kappa>\<^sub>l j * fs ! j $ k)) - \<mu> i l * fs ! l $ k"
         using that Suc by (auto simp add: algebra_simps sumlist_nth)
       also have "- \<mu> i l * (\<Sum>j = 0..<l. \<kappa>\<^sub>l j * fs ! j $ k) 
                = (\<Sum>j = 0..<l. - \<mu> i l * (\<kappa>\<^sub>l j * fs ! j $ k))"
         using sum_distrib_left by blast
       also have "(\<Sum>j = 0..<l. \<kappa>\<^sub>i j * fs ! j $ k) + (\<Sum>j = 0..<l. - \<mu> i l * (\<kappa>\<^sub>l j * fs ! j $ k)) =
                (\<Sum>x = 0..<l. (\<kappa>\<^sub>i x - \<kappa>\<^sub>l x * \<mu> i l) * fs ! x $ k)"
         by (subst sum.distrib[symmetric]) (simp add: algebra_simps)
       also have "\<dots> = (\<Sum>x = 0..<l. \<kappa> x * fs ! x $ k)"
         unfolding \<kappa>_def by (rule sum.cong) (auto)
       also have "(\<Sum>x = 0..<l. \<kappa> x * fs ! x $ k) - \<mu> i l * fs ! l $ k =
                  (\<Sum>x = 0..<l. \<kappa> x * fs ! x $ k) + (\<Sum>x = l..<Suc l. \<kappa> x * fs ! x $ k)"
         unfolding \<kappa>_def by auto
       also have "\<dots> = (\<Sum>x = 0..<Suc l. \<kappa> x * fs ! x $ k)"
         by (subst sum.union_disjoint[symmetric]) auto
       also have "\<dots> = (\<Sum>x = 0..<Suc l. (\<kappa> x \<cdot>\<^sub>v fs ! x) $ k)"
         using that Suc by auto
       also have "\<dots> = M.sumlist (map (\<lambda>j. \<kappa> j \<cdot>\<^sub>v fs ! j) [0..<Suc l]) $ k"
         by (subst sumlist_nth, insert that Suc, auto simp: nth_append)
       finally show ?thesis by simp
     qed
     then show ?thesis
       using Suc by (auto simp add: dim_sumlist)
   qed
   finally show ?case by (intro exI[of _ \<kappa>]) simp
 qed auto
 
 
 definition \<kappa>_SOME_def:
   "\<kappa> = (SOME \<kappa>. \<forall>i l. i < length fs \<longrightarrow> l \<le> i \<longrightarrow>
         sumlist (map (\<lambda>j. - \<mu> i j \<cdot>\<^sub>v gso j) [0..<l]) =
         sumlist (map (\<lambda>j. \<kappa> i l j \<cdot>\<^sub>v fs ! j) [0..<l]))"
 
 lemma \<kappa>_def:
   assumes "i < length fs" "l \<le> i"
   shows "sumlist (map (\<lambda>j. - \<mu> i j \<cdot>\<^sub>v gso j) [0..<l]) =
          sumlist (map (\<lambda>j. \<kappa> i l j \<cdot>\<^sub>v fs ! j) [0..<l])"
 proof -
   let ?P = "\<lambda> i l \<kappa>. (i < length fs \<longrightarrow> l \<le> i \<longrightarrow>
                   sumlist (map (\<lambda>j. - \<mu> i j \<cdot>\<^sub>v gso j) [0..<l]) =
                   sumlist (map (\<lambda>j. \<kappa> j \<cdot>\<^sub>v fs ! j) [0..<l]))" 
   from ex_\<kappa> have "\<And> i. \<forall> l. \<exists>\<kappa>. ?P i l \<kappa>" by blast
   from choice[OF this] have "\<forall>i. \<exists>\<kappa>. \<forall> l. ?P i l (\<kappa> l)" by blast
   from choice[OF this] have "\<exists>\<kappa>. \<forall>i l. ?P i l (\<kappa> i l)" by blast
   from someI_ex[OF this] show ?thesis
     unfolding \<kappa>_SOME_def using assms by blast
 qed
 
 lemma (in gram_schmidt_fs_lin_indpt) fs_i_sumlist_\<kappa>:
   assumes "i < m" "l \<le> i" "j < l"
   shows "(fs ! i + sumlist (map (\<lambda>j. \<kappa> i l j \<cdot>\<^sub>v fs ! j) [0..<l])) \<bullet> fs ! j = 0"
 proof -
   have "fs ! i + sumlist (map (\<lambda>j. \<kappa> i l j \<cdot>\<^sub>v fs ! j) [0..<l])
         = fs ! i - M.sumlist (map (\<lambda>j. \<mu> i j \<cdot>\<^sub>v gso j) [0..<l])"
     using assms gso_carrier assms 
     by (subst \<kappa>_def[symmetric]) (auto simp add: dim_sumlist sumlist_nth sum_negf)
   also have "\<dots> = M.sumlist (map (\<lambda>j. \<mu> i j \<cdot>\<^sub>v gso j) [l..<Suc i])"
   proof -
     have "fs ! i = M.sumlist (map (\<lambda>j. \<mu> i j \<cdot>\<^sub>v gso j) [0..<Suc i])"
       using assms by (intro fi_is_sum_of_mu_gso) auto
     also have "\<dots> = M.sumlist (map (\<lambda>j. \<mu> i j \<cdot>\<^sub>v gso j) [0..<l]) +
                   M.sumlist (map (\<lambda>j. \<mu> i j \<cdot>\<^sub>v gso j) [l..<Suc i])"
     proof -
       have *: "[0..<Suc i] = [0..<l] @ [l..<Suc i]"
         using assms by (metis diff_zero le_imp_less_Suc length_upt list_trisect upt_conv_Cons)
       show ?thesis
         by (subst *, subst map_append, subst sumlist_append) (use gso_carrier assms in auto)
     qed
     finally show ?thesis
       using assms gso_carrier assms by (auto simp add: algebra_simps dim_sumlist)
   qed
   finally have "fs ! i + M.sumlist (map (\<lambda>j. \<kappa> i l j \<cdot>\<^sub>v fs ! j) [0..<l]) =
                 M.sumlist (map (\<lambda>j. \<mu> i j \<cdot>\<^sub>v gso j) [l..<Suc i])"
     by simp
   moreover have "\<dots> \<bullet> (fs ! j) = 0"
     using assms gso_carrier assms unfolding lin_indpt_list_def
     by (subst scalar_prod_left_sum_distrib)
        (auto simp add: algebra_simps dim_sumlist gso_scalar_zero intro!: sum_list_zero)
   ultimately show ?thesis using assms by auto
 qed
 
 
 end (* gram_schmidt_fs_Rn *)
 
 lemma Ints_sum:
   assumes "\<And>a. a \<in> A \<Longrightarrow> f a \<in> \<int>"
   shows "sum f A \<in> \<int>"
   using assms by (induction A rule: infinite_finite_induct) auto
 
 lemma Ints_prod:
   assumes "\<And>a. a \<in> A \<Longrightarrow> f a \<in> \<int>"
   shows "prod f A \<in> \<int>"
 using assms by (induction A rule: infinite_finite_induct) auto
 
 lemma Ints_scalar_prod: 
   "v \<in> carrier_vec n \<Longrightarrow> w \<in> carrier_vec n
    \<Longrightarrow> (\<And> i. i < n \<Longrightarrow> v $ i \<in> \<int>) \<Longrightarrow> (\<And> i. i < n \<Longrightarrow> w $ i \<in> \<int>) \<Longrightarrow> v \<bullet> w \<in> \<int>" 
   unfolding scalar_prod_def by (intro Ints_sum Ints_mult, auto)
 
 lemma Ints_det: assumes "\<And> i j. i < dim_row A \<Longrightarrow> j < dim_col A 
   \<Longrightarrow> A $$ (i,j) \<in> \<int>"
   shows "det A \<in> \<int>" 
 proof (cases "dim_row A = dim_col A")
   case True
   show ?thesis unfolding Determinant.det_def using True assms
-    by (auto intro!: Ints_sum Ints_mult Ints_prod simp: signof_def)
+    by (auto intro!: Ints_mult Ints_prod)
 next
   case False
   show ?thesis unfolding Determinant.det_def using False by simp
 qed
 
 
 lemma (in gram_schmidt_fs_Rn) Gramian_matrix_alt_alt_def:
   assumes "k \<le> m"
   shows "Gramian_matrix fs k = mat k k (\<lambda>(i,j). fs ! i \<bullet> fs ! j)"
 proof -
   have *: "vec n (($) (fs ! i)) = fs ! i" if "i < m" for i
     using that by auto
   then show ?thesis
     unfolding Gramian_matrix_def using assms
     by (intro eq_matI) (auto simp add: Let_def)
 qed
 
 lemma (in gram_schmidt_fs_int) fs_scalar_Ints:
   assumes "i < m" "j < m"
   shows "fs ! i \<bullet> fs ! j \<in> \<int>"
   by (rule Ints_scalar_prod[of _ n], insert fs_int assms, auto)
 
 abbreviation (in gram_schmidt_fs_lin_indpt) d where "d \<equiv> Gramian_determinant fs" 
 
 
 lemma (in gram_schmidt_fs_lin_indpt) fs_i_fs_j_sum_\<kappa> :
   assumes "i < m" "l \<le> i" "j < l"
   shows "- (fs ! i \<bullet> fs ! j) = (\<Sum>t = 0..<l. fs ! t \<bullet> fs ! j * \<kappa> i l t)"
 proof -
   have [simp]: "M.sumlist (map (\<lambda>j. \<kappa> i l j \<cdot>\<^sub>v fs ! j) [0..<l]) \<in> carrier_vec n"
     using assms by (auto intro!: sumlist_carrier simp add: dim_sumlist)
   have "0  = (fs ! i + M.sumlist (map (\<lambda>j. \<kappa> i l j \<cdot>\<^sub>v fs ! j) [0..<l])) \<bullet> fs ! j"
     using fs_i_sumlist_\<kappa> assms by simp
   also have "\<dots> = fs ! i \<bullet> fs ! j + M.sumlist (map (\<lambda>j. \<kappa> i l j \<cdot>\<^sub>v fs ! j) [0..<l]) \<bullet> fs ! j"
     using assms by (subst add_scalar_prod_distrib[of _ n]) (auto)
   also have "M.sumlist (map (\<lambda>j. \<kappa> i l j \<cdot>\<^sub>v fs ! j) [0..<l]) \<bullet> fs ! j =
              (\<Sum>v\<leftarrow>map (\<lambda>j. \<kappa> i l j \<cdot>\<^sub>v fs ! j) [0..<l]. v \<bullet> fs ! j)"
     using assms by (intro scalar_prod_left_sum_distrib) (auto)
   also have "\<dots> = (\<Sum>t\<leftarrow>[0..<l]. (\<kappa> i l t \<cdot>\<^sub>v fs ! t) \<bullet> fs ! j)"
     by (rule arg_cong[where f=sum_list]) (auto)
   also have "\<dots> =  (\<Sum>t = 0..<l. (\<kappa> i l t \<cdot>\<^sub>v fs ! t) \<bullet> fs ! j) "
     by (subst interv_sum_list_conv_sum_set_nat) (auto)
   also have "\<dots> = (\<Sum>t = 0..<l. fs ! t \<bullet> fs ! j * \<kappa> i l t)"
     using assms by (intro sum.cong) auto
   finally show ?thesis by (simp add: field_simps)
 qed
 
 lemma (in gram_schmidt_fs_lin_indpt) Gramian_matrix_times_\<kappa> :
   assumes "i < m" "l \<le> i"
   shows "Gramian_matrix fs l *\<^sub>v (vec l (\<lambda>t. \<kappa> i l t)) = (vec l (\<lambda>j. - (fs ! i \<bullet> fs ! j)))"
 proof -
   have "- (fs ! i \<bullet> fs ! j) = (\<Sum>t = 0..<l. fs ! t \<bullet> fs ! j * \<kappa> i l t)" if "j < l" for j
     using fs_i_fs_j_sum_\<kappa> assms that by simp
   then show ?thesis using assms
     by (subst Gramian_matrix_alt_alt_def) (auto simp add: scalar_prod_def algebra_simps)
 qed
 
 lemma (in gram_schmidt_fs_int) d_\<kappa>_Ints :
   assumes "i < m" "l \<le> i" "t < l"
   shows "d l * \<kappa> i l t \<in> \<int>"
 proof -
   let ?A = "Gramian_matrix fs l"
   let ?B = "replace_col ?A (Gramian_matrix fs l *\<^sub>v vec l (\<kappa> i l)) t" 
   have deteq: "d l = det ?A"
     unfolding Gramian_determinant_def
     using Gramian_determinant_Ints
     by auto
 
   have **: "Gramian_matrix fs l \<in> carrier_mat l l" unfolding Gramian_matrix_def Let_def  using fs_carrier by auto
       
   then have " \<kappa> i l t * det ?A = det ?B"
     using assms fs_carrier cramer_lemma_mat[of ?A l " (vec l (\<lambda>t. \<kappa> i l t))" t]
     by auto
 
   also have " ... \<in> \<int> "
   proof -
     have *: "t<l \<Longrightarrow> (?A *\<^sub>v vec l (\<kappa> i l)) $ t \<in> \<int>" for t
       using assms
       apply(subst Gramian_matrix_times_\<kappa>, force, force)
       using fs_int fs_carrier
       by (auto intro!: fs_scalar_Ints Ints_minus)
 
     define B where "B = ?B"
 
     have Bint: "t1<l \<longrightarrow> s1 < l \<longrightarrow> B $$ (t1,s1) \<in> \<int>" for t1 s1
     proof (cases "s1 = t")
       case True
       from * ** this show ?thesis 
         unfolding replace_col_def B_def
         by auto
     next
       case False
       from * ** Gramian_matrix_def this fs_carrier assms show ?thesis
         unfolding replace_col_def B_def
         by (auto simp: Gramian_matrix_def Let_def scalar_prod_def intro!: Ints_sum Ints_mult fs_int)
     qed
     have B: "B \<in> carrier_mat l l"
       using ** replace_col_def unfolding B_def
       by (auto simp: replace_col_def)
     have "det B \<in> \<int>"
       using B Bint assms  det_col[of B l]
-      by (auto intro!: Ints_sum Ints_mult Ints_prod simp: signof_def)
+      by (auto intro!: Ints_sum Ints_mult Ints_prod)
     thus ?thesis unfolding B_def.
   qed
   finally show ?thesis using deteq by (auto simp add: algebra_simps)
 qed
 
 lemma (in gram_schmidt_fs_int) d_gso_Ints:
   assumes "i < n" "k < m"
   shows "(d k \<cdot>\<^sub>v (gso k)) $ i \<in> \<int>"
 proof -
   note d_\<kappa>_Ints[intro!]
   then have "(d k * \<kappa> k k j) * fs ! j $ i \<in> \<int>" if "j < k" for j
     using that fs_int assms by (auto intro: Ints_mult )
   moreover have "(d k * \<kappa> k k j) * fs ! j $ i = d k * \<kappa> k k j * fs ! j $ i" for j
     by (auto simp add: field_simps)
   ultimately have "d k * (\<Sum>j = 0..<k. \<kappa> k k j * fs ! j $ i) \<in> \<int>"
      by (subst sum_distrib_left) (auto simp add: field_simps intro!: Ints_sum)
   moreover have "(gso k) $ i = fs ! k $ i + sum (\<lambda>j. (\<kappa> k k j \<cdot>\<^sub>v fs ! j) $ i) {0..<k}"
   proof -
     have " i < dim_vec (M.sumlist (map (\<lambda>j. \<kappa> k k j \<cdot>\<^sub>v fs ! j) [0..<k]))"
       using assms by (subst sumlist_dim) auto
     then show ?thesis
       using assms by (subst gso.simps) (auto simp add: sumlist_nth sumlist_dim \<kappa>_def)
   qed
   ultimately show ?thesis
     using assms
     by (auto simp add: distrib_left Gramian_determinant_Ints fs_int intro!: Ints_mult Ints_add)
 qed
 
 lemma (in gram_schmidt_fs_int) d_mu_Ints:
   assumes "l \<le> k" "k < m"
   shows "d (Suc l) * \<mu> k l \<in> \<int>"
 proof (cases "l < k")
   case True
   have ll: "d l * gso l $ i = (d l \<cdot>\<^sub>v gso l) $ i" if "i < n" for i
     using that assms by auto
   have "d (Suc l) * \<mu> k l =d (Suc l) * (fs ! k \<bullet> gso l) / \<parallel>gso l\<parallel>\<^sup>2 "
     using assms True unfolding \<mu>.simps by simp
   also have "\<dots> = fs ! k \<bullet> (d l \<cdot>\<^sub>v gso l)"
     using assms Gramian_determinant(2)[of "Suc l"]
     by (subst Gramian_determinant_div[symmetric]) (auto)
   also have "\<dots> \<in> \<int>"
   proof -
     have "d l * gso l $ i \<in> \<int>" if "i < n" for i
       using assms d_gso_Ints that ll by (simp)
     then show ?thesis
       using assms by (auto intro!: Ints_sum simp add: fs_int scalar_prod_def)
  qed
  finally show ?thesis
    by simp
 next
   case False
   with assms have l: "l = k" by auto
   show ?thesis unfolding l \<mu>.simps using Gramian_determinant_Ints fs_int assms by simp
 qed
 
 
 lemma max_list_Max: "ls \<noteq> [] \<Longrightarrow> max_list ls = Max (set ls)"
   by (induction ls) (auto simp add: max_list_Cons)
 
 subsection \<open>Explicit Bounds for Size of Numbers that Occur During GSO Algorithm \<close>
 
 context gram_schmidt_fs_lin_indpt
 begin
 
 definition "N = Max (sq_norm ` set fs)"
 
 
 
 lemma N_ge_0:
   assumes "0 < m"
   shows "0 \<le> N"
 proof -
   have "x \<in> sq_norm ` set fs \<Longrightarrow> 0 \<le> x" for x
     by auto
   then show ?thesis
   using assms unfolding N_def by auto
 qed
 
 lemma N_fs:
   assumes "i < m"
   shows "\<parallel>fs ! i\<parallel>\<^sup>2 \<le> N"
     using assms unfolding N_def by (auto)
 
 lemma N_gso:
   assumes "i < m"
   shows "\<parallel>gso i\<parallel>\<^sup>2 \<le> N"
   using assms N_fs sq_norm_gso_le_f by fastforce
 
 lemma N_d:
   assumes "i \<le> m"
   shows "Gramian_determinant fs i \<le> N ^ i"
 proof -
   have "(\<Prod>j<i. \<parallel>gso j\<parallel>\<^sup>2) \<le> (\<Prod>j<i. N)"
       using assms N_gso by (intro prod_mono) auto
     then show ?thesis
       using assms Gramian_determinant by auto
   qed
 
 
 end
 
 lemma ex_MAXIMUM: assumes "finite A" "A \<noteq> {}"
   shows "\<exists>a \<in> A. Max (f ` A) = f a"
 proof -
   have "Max (f ` A) \<in> f ` A"
     using assms by (auto intro!: Max_in)
   then show ?thesis
     using assms imageE by blast
 qed
 
 context gram_schmidt_fs_int
 begin
 
 lemma fs_int': "k < n \<Longrightarrow> f \<in> set fs \<Longrightarrow> f $ k \<in> \<int>"
   by (metis fs_int in_set_conv_nth)
 
 lemma
   assumes "i < m"
   shows fs_sq_norm_Ints: "\<parallel>fs ! i\<parallel>\<^sup>2 \<in> \<int>" and fs_sq_norm_ge_1: "1 \<le> \<parallel>fs ! i\<parallel>\<^sup>2"
 proof -
   show fs_Ints: "\<parallel>fs ! i\<parallel>\<^sup>2 \<in> \<int>"
     using assms fs_int' carrier_vecD fs_carrier
     by (auto simp add: sq_norm_vec_as_cscalar_prod scalar_prod_def intro!: Ints_sum Ints_mult)
   have "fs ! i \<noteq> 0\<^sub>v n"
     using assms fs_carrier loc_assms nth_mem vs_zero_lin_dep by force
   then have *: "0 \<noteq> \<parallel>fs ! i\<parallel>\<^sup>2"
     using assms sq_norm_vec_eq_0 f_carrier by metis
   show "1 \<le> \<parallel>fs ! i\<parallel>\<^sup>2"
     by (rule Ints_cases[OF fs_Ints]) (use * sq_norm_vec_ge_0[of "fs ! i"] assms in auto)
 qed
 
 lemma
   assumes "set fs \<noteq> {}"
   shows N_Ints: "N \<in> \<int>" and N_1: "1 \<le> N"  
 proof -
   have "\<exists>v\<^sub>m \<in> set fs. N = sq_norm v\<^sub>m"
     unfolding N_def using assms by (auto intro!: ex_MAXIMUM)
   then obtain v\<^sub>m::"'a vec" where v\<^sub>m_def: "v\<^sub>m \<in> set fs" "N = sq_norm v\<^sub>m"
     by blast
   then show N_Ints: "N \<in> \<int>"
     using fs_int' carrier_vecD fs_carrier
     by (auto simp add: sq_norm_vec_as_cscalar_prod scalar_prod_def intro!: Ints_sum Ints_mult)
   have *: "0 \<noteq> N"
     using N_gso sq_norm_pos assms by fastforce
   show "1 \<le> N"
     by (rule Ints_cases[OF N_Ints]) (use * N_ge_0 assms in force)+
 qed
 
 lemma N_mu:
   assumes "i < m" "j \<le> i"
   shows "(\<mu> i j)\<^sup>2 \<le> N ^ (Suc j)"
 proof -
   { assume ji: "j < i"
     have "(\<mu> i j)\<^sup>2 \<le> Gramian_determinant fs j * \<parallel>fs ! i\<parallel>\<^sup>2"
       using assms ji by (intro mu_bound_Gramian_determinant) auto
     also have "\<dots> \<le> N ^ j * \<parallel>fs ! i\<parallel>\<^sup>2"
       using assms N_d N_ge_0 by (intro mult_mono) fastforce+
     also have "N ^ j * \<parallel>fs ! i\<parallel>\<^sup>2 \<le> N ^ j * N"
       using assms N_fs N_ge_0 by (intro mult_mono) fastforce+
     also have "\<dots> = N ^ (Suc j)"
       by auto
     finally have ?thesis
       by simp }
   moreover 
   { assume ji: "j = i"
     have "(\<mu> i j)\<^sup>2 = 1"
       using ji by (simp add: \<mu>.simps)
     also have "\<dots> \<le> N"
       using assms N_1 by fastforce
     also have "\<dots> \<le> N ^ (Suc j)"
       using assms N_1 by fastforce
     finally have ?thesis
       by simp }
   ultimately show ?thesis
     using assms by fastforce
 qed
 
 end
 
 
 lemma vec_hom_Ints:
   assumes "i < n" "xs \<in> carrier_vec n"
   shows "of_int_hom.vec_hom xs $ i \<in> \<int>"
   using assms by auto
 
 lemma division_to_div: "(of_int x  :: 'a :: floor_ceiling) = of_int y / of_int z \<Longrightarrow> x = y div z" 
   by (metis floor_divide_of_int_eq floor_of_int)
 
 lemma exact_division: assumes "of_int x / (of_int y  :: 'a :: floor_ceiling) \<in> \<int>"
   shows "of_int (x div y) = of_int x / (of_int y :: 'a)" 
   using assms by (metis Ints_cases division_to_div)
 
 lemma int_via_rat_eqI: "rat_of_int x = rat_of_int y \<Longrightarrow> x = y" by auto
 
 locale fs_int =
   fixes
     n :: nat (* n-dimensional vectors, *) and
     fs_init :: "int vec list" (* initial basis *)
 begin
 
 sublocale vec_module "TYPE(int)" n .
 
 abbreviation RAT where "RAT \<equiv> map (map_vec rat_of_int)" 
 abbreviation (input) m where "m \<equiv> length fs_init"
 
 sublocale gs: gram_schmidt_fs n "RAT fs_init" .
 
 definition d :: "int vec list \<Rightarrow> nat \<Rightarrow> int" where "d fs k = gs.Gramian_determinant fs k"
 definition D :: "int vec list \<Rightarrow> nat" where "D fs = nat (\<Prod> i < length fs. d fs i)" 
 
 lemma of_int_Gramian_determinant:
   assumes "k \<le> length F" "\<And>i. i < length F \<Longrightarrow> dim_vec (F ! i) = n"
   shows "gs.Gramian_determinant (map of_int_hom.vec_hom F) k = of_int (gs.Gramian_determinant F k)"
   unfolding gs.Gramian_determinant_def of_int_hom.hom_det[symmetric]
 proof (rule arg_cong[of _ _ det])
   let ?F = "map of_int_hom.vec_hom F"
   have cong: "\<And> a b c d. a = b \<Longrightarrow> c = d \<Longrightarrow> a * c = b * d" by auto
   show "gs.Gramian_matrix ?F k = map_mat of_int (gs.Gramian_matrix F k)" 
     unfolding gs.Gramian_matrix_def Let_def
   proof (subst of_int_hom.mat_hom_mult[of _ k n _ k], (auto)[2], rule cong)
     show id: "mat k n (\<lambda> (i,j). ?F ! i $ j) = map_mat of_int (mat k n (\<lambda> (i, j). F ! i $ j))" (is "?L = map_mat _ ?R")
     proof (rule eq_matI, goal_cases)
       case (1 i j)
       hence ij: "i < k" "j < n" "i < length F" "dim_vec (F ! i) = n" using assms by auto
       show ?case using ij by simp 
     qed auto
     show "?L\<^sup>T = map_mat of_int ?R\<^sup>T" unfolding id by (rule eq_matI, auto)
   qed
 qed
 
 end
 
 locale fs_int_indpt = fs_int n fs for n fs +
   assumes lin_indep: "gs.lin_indpt_list (RAT fs)"
 begin
 
 sublocale gs: gram_schmidt_fs_lin_indpt n "RAT fs"
   by (standard) (use lin_indep gs.lin_indpt_list_def in auto)
 
 sublocale gs: gram_schmidt_fs_int n "RAT fs"
   by (standard) (use gs.f_carrier lin_indep gs.lin_indpt_list_def in \<open>auto intro!: vec_hom_Ints\<close>)
 
 lemma f_carrier[dest]: "i < m \<Longrightarrow> fs ! i \<in> carrier_vec n"
   and fs_carrier [simp]: "set fs \<subseteq> carrier_vec n"
   using lin_indep gs.f_carrier gs.gso_carrier unfolding gs.lin_indpt_list_def by auto
 
 lemma Gramian_determinant:
   assumes k: "k \<le> m" 
   shows "of_int (gs.Gramian_determinant fs k) = (\<Prod> j<k. sq_norm (gs.gso j))" (is ?g1)
     "gs.Gramian_determinant fs k > 0" (is ?g2)
 proof -
   have hom: "gs.Gramian_determinant (RAT fs) k = of_int (gs.Gramian_determinant fs k)"
     using k by (intro of_int_Gramian_determinant) auto
   show ?g1
     unfolding hom[symmetric] using gs.Gramian_determinant assms by auto
   show ?g2
     using hom gs.Gramian_determinant assms by fastforce
 qed
 
 lemma fs_int_d_pos [intro]:
   assumes k: "k \<le> m" 
 shows "d fs k > 0"
   unfolding d_def using Gramian_determinant[OF k] by auto
 
 lemma fs_int_d_Suc:
   assumes k: "k < m" 
 shows "of_int (d fs (Suc k)) = sq_norm (gs.gso k) * of_int (d fs k)" 
 proof -
   from k have k: "k \<le> m" "Suc k \<le> m" by auto
   show ?thesis unfolding Gramian_determinant[OF k(1)] Gramian_determinant[OF k(2)] d_def
     by (subst prod.remove[of _ k], force+, rule arg_cong[of _ _ "\<lambda> x. _ * x"], rule prod.cong, auto)
 qed
 
 lemma fs_int_D_pos:
 shows "D fs > 0"
 proof -
   have "(\<Prod> j < m. d fs j) > 0"
     by (rule prod_pos, insert fs_int_d_pos, auto)
   thus ?thesis unfolding D_def by auto
 qed
 
 definition "d\<mu> i j = int_of_rat (of_int (d fs (Suc j)) * gs.\<mu> i j)" 
 
 lemma fs_int_mu_d_Z:
   assumes j: "j \<le> ii" and ii: "ii < m" 
   shows "of_int (d fs (Suc j)) * gs.\<mu> ii j \<in> \<int>"
 proof -
   have id: "of_int (d fs (Suc j)) = gs.Gramian_determinant (RAT fs) (Suc j)" 
     unfolding d_def
     by (rule of_int_Gramian_determinant[symmetric], insert j ii , auto)
   have "of_int_hom.vec_hom (fs ! j) $ i \<in> \<int>" if "i < n" "j < length fs" for i j
      using that by (intro vec_hom_Ints) auto
   then show ?thesis
     unfolding id using j ii unfolding gs.lin_indpt_list_def 
     by (intro gs.d_mu_Ints) (auto)
 qed
 
 lemma fs_int_mu_d_Z_m_m:
   assumes j: "j < m" and ii: "ii < m" 
   shows "of_int (d fs (Suc j)) * gs.\<mu> ii j \<in> \<int>"
 proof (cases "j \<le> ii")
   case True
   thus ?thesis using fs_int_mu_d_Z[OF True ii] by auto
 next
   case False thus ?thesis by (simp add: gs.\<mu>.simps)
 qed
 
 
 lemma sq_norm_fs_via_sum_mu_gso: assumes i: "i < m" 
   shows "of_int \<parallel>fs ! i\<parallel>\<^sup>2 = (\<Sum>j\<leftarrow>[0..<Suc i]. (gs.\<mu> i j)\<^sup>2 * \<parallel>gs.gso j\<parallel>\<^sup>2)" 
 proof -
   let ?G = "map (gs.gso) [0 ..< m]" 
   let ?gso = "\<lambda> fs j. ?G ! j"
   have "of_int \<parallel>fs ! i\<parallel>\<^sup>2 = \<parallel>RAT fs ! i\<parallel>\<^sup>2" unfolding sq_norm_of_int[symmetric] using insert i by auto
   also have "RAT fs ! i = gs.sumlist (map (\<lambda>j. gs.\<mu> i j \<cdot>\<^sub>v gs.gso j) [0..<Suc i])" 
     using gs.fi_is_sum_of_mu_gso i by auto
   also have id: "map (\<lambda>j. gs.\<mu> i j \<cdot>\<^sub>v gs.gso j) [0..<Suc i] = map (\<lambda>j. gs.\<mu> i j \<cdot>\<^sub>v ?gso fs j) [0..<Suc i]" 
     by (rule nth_equalityI, insert i, auto simp: nth_append)
   also have "sq_norm (gs.sumlist \<dots>) = sum_list (map sq_norm (map (\<lambda>j. gs.\<mu> i j \<cdot>\<^sub>v gs.gso j) [0..<Suc i]))" 
     unfolding map_map o_def sq_norm_smult_vec
     unfolding sq_norm_vec_as_cscalar_prod cscalar_prod_is_scalar_prod conjugate_id
   proof (subst gs.scalar_prod_lincomb_orthogonal)
     show "Suc i \<le> length ?G" using i by auto
     show "set ?G \<subseteq> carrier_vec n" using gs.gso_carrier by auto
     show "orthogonal ?G" using gs.orthogonal_gso by auto
   qed (rule arg_cong[of _ _ sum_list], intro nth_equalityI, insert i, auto simp: nth_append)
   also have "map sq_norm (map (\<lambda>j. gs.\<mu> i j \<cdot>\<^sub>v gs.gso j) [0..<Suc i]) = map (\<lambda>j. (gs.\<mu> i j)^2 * sq_norm (gs.gso j)) [0..<Suc i]" 
     unfolding map_map o_def sq_norm_smult_vec by (rule map_cong, auto simp: power2_eq_square)
   finally show ?thesis . 
 qed
 
 lemma d\<mu>: assumes "j < m" "ii < m" 
   shows "of_int (d\<mu> ii j) = of_int (d fs (Suc j)) * gs.\<mu> ii j" 
   unfolding d\<mu>_def using fs_int_mu_d_Z_m_m assms by auto
 
 end
 
 end
diff --git a/thys/Linear_Inequalities/Integral_Bounded_Vectors.thy b/thys/Linear_Inequalities/Integral_Bounded_Vectors.thy
--- a/thys/Linear_Inequalities/Integral_Bounded_Vectors.thy
+++ b/thys/Linear_Inequalities/Integral_Bounded_Vectors.thy
@@ -1,244 +1,244 @@
 section \<open>Integral and Bounded Matrices and Vectors\<close>
 
 text \<open>We define notions of integral vectors and matrices and bounded vectors and matrices
   and prove some preservation lemmas. Moreover, we prove a bound on determinants.\<close>
 theory Integral_Bounded_Vectors
   imports
     Missing_VS_Connect
     Sum_Vec_Set
     LLL_Basis_Reduction.Gram_Schmidt_2 (* for some simp-rules *)
 begin
 
 (* TODO: move into theory Norms *)
 lemma sq_norm_unit_vec[simp]: assumes i: "i < n"
   shows "\<parallel>unit_vec n i\<parallel>\<^sup>2 = (1 :: 'a :: {comm_ring_1,conjugatable_ring})"
 proof -
   from i have id: "[0..<n] = [0..<i] @ [i] @ [Suc i ..< n]"
     by (metis append_Cons append_Nil diff_zero length_upt list_trisect)
   show ?thesis unfolding sq_norm_vec_def unit_vec_def
     by (auto simp: o_def id, subst (1 2) sum_list_0, auto)
 qed
 
 definition Ints_vec ("\<int>\<^sub>v") where
   "\<int>\<^sub>v = {x. \<forall> i < dim_vec x. x $ i \<in> \<int>}"
 
 definition indexed_Ints_vec  where
   "indexed_Ints_vec I = {x. \<forall> i < dim_vec x. i \<in> I \<longrightarrow> x $ i \<in> \<int>}"
 
 lemma indexed_Ints_vec_UNIV: "\<int>\<^sub>v = indexed_Ints_vec UNIV"
   unfolding Ints_vec_def indexed_Ints_vec_def by auto
 
 lemma indexed_Ints_vec_subset: "\<int>\<^sub>v \<subseteq> indexed_Ints_vec I"
   unfolding Ints_vec_def indexed_Ints_vec_def by auto
 
 lemma Ints_vec_vec_set: "v \<in> \<int>\<^sub>v = (vec_set v \<subseteq> \<int>)"
   unfolding Ints_vec_def vec_set_def by auto
 
 definition Ints_mat ("\<int>\<^sub>m") where
   "\<int>\<^sub>m = {A. \<forall> i < dim_row A. \<forall> j < dim_col A. A $$ (i,j) \<in> \<int>}"
 
 lemma Ints_mat_elements_mat: "A \<in> \<int>\<^sub>m = (elements_mat A \<subseteq> \<int>)"
   unfolding Ints_mat_def elements_mat_def by force
 
 lemma minus_in_Ints_vec_iff[simp]: "(-x) \<in> \<int>\<^sub>v \<longleftrightarrow> (x :: 'a :: ring_1 vec) \<in> \<int>\<^sub>v"
   unfolding Ints_vec_vec_set by (auto simp: minus_in_Ints_iff)
 
 lemma minus_in_Ints_mat_iff[simp]: "(-A) \<in> \<int>\<^sub>m \<longleftrightarrow> (A :: 'a :: ring_1 mat) \<in> \<int>\<^sub>m"
   unfolding Ints_mat_elements_mat by (auto simp: minus_in_Ints_iff)
 
 lemma Ints_vec_rows_Ints_mat[simp]: "set (rows A) \<subseteq> \<int>\<^sub>v \<longleftrightarrow> A \<in> \<int>\<^sub>m"
   unfolding rows_def Ints_vec_def Ints_mat_def by force
 
 lemma unit_vec_integral[simp,intro]: "unit_vec n i \<in> \<int>\<^sub>v"
   unfolding Ints_vec_def by (auto simp: unit_vec_def)
 
 lemma diff_indexed_Ints_vec:
   "x \<in> carrier_vec n \<Longrightarrow> y \<in> carrier_vec n \<Longrightarrow> x \<in> indexed_Ints_vec I \<Longrightarrow> y \<in> indexed_Ints_vec I
   \<Longrightarrow> x - y \<in> indexed_Ints_vec I"
   unfolding indexed_Ints_vec_def by auto
 
 lemma smult_indexed_Ints_vec: "x \<in> \<int> \<Longrightarrow> v \<in> indexed_Ints_vec I \<Longrightarrow> x \<cdot>\<^sub>v v \<in> indexed_Ints_vec I" 
   unfolding indexed_Ints_vec_def smult_vec_def by simp
 
 lemma add_indexed_Ints_vec:
   "x \<in> carrier_vec n \<Longrightarrow> y \<in> carrier_vec n \<Longrightarrow> x \<in> indexed_Ints_vec I \<Longrightarrow> y \<in> indexed_Ints_vec I
   \<Longrightarrow> x + y \<in> indexed_Ints_vec I"
   unfolding indexed_Ints_vec_def by auto
 
 lemma (in vec_space) lincomb_indexed_Ints_vec: assumes cI: "\<And> x. x \<in> C \<Longrightarrow> c x \<in> \<int>"
   and C: "C \<subseteq> carrier_vec n"
   and CI: "C \<subseteq> indexed_Ints_vec I"
 shows "lincomb c C \<in> indexed_Ints_vec I"
 proof -
   from C have id: "dim_vec (lincomb c C) = n" by auto
   show ?thesis unfolding indexed_Ints_vec_def mem_Collect_eq id
   proof (intro allI impI)
     fix i
     assume i: "i < n" and iI: "i \<in> I"
     have "lincomb c C $ i = (\<Sum>x\<in>C. c x * x $ i)"
       by (rule lincomb_index[OF i C])
     also have "\<dots> \<in> \<int>"
       by (intro Ints_sum Ints_mult cI, insert i iI CI[unfolded indexed_Ints_vec_def] C, force+)
     finally show "lincomb c C $ i \<in> \<int>" .
   qed
 qed
 
 definition "Bounded_vec (b :: 'a :: linordered_idom) = {x . \<forall> i < dim_vec x . abs (x $ i) \<le> b}"
 
 lemma Bounded_vec_vec_set: "v \<in> Bounded_vec b \<longleftrightarrow> (\<forall> x \<in> vec_set v. abs x \<le> b)"
   unfolding Bounded_vec_def vec_set_def by auto
 
 definition "Bounded_mat (b :: 'a :: linordered_idom) =
   {A . (\<forall> i < dim_row A . \<forall> j < dim_col A. abs (A $$ (i,j)) \<le> b)}"
 
 lemma Bounded_mat_elements_mat: "A \<in> Bounded_mat b \<longleftrightarrow> (\<forall> x \<in> elements_mat A. abs x \<le> b)"
   unfolding Bounded_mat_def elements_mat_def by auto
 
 lemma Bounded_vec_rows_Bounded_mat[simp]: "set (rows A) \<subseteq> Bounded_vec B \<longleftrightarrow> A \<in> Bounded_mat B"
   unfolding rows_def Bounded_vec_def Bounded_mat_def by force
 
 lemma unit_vec_Bounded_vec[simp,intro]: "unit_vec n i \<in> Bounded_vec (max 1 Bnd)"
   unfolding Bounded_vec_def unit_vec_def by auto
 
 lemma Bounded_matD: assumes "A \<in> Bounded_mat b"
   "A \<in> carrier_mat nr nc"
 shows "i < nr \<Longrightarrow> j < nc \<Longrightarrow> abs (A $$ (i,j)) \<le> b"
   using assms unfolding Bounded_mat_def by auto
 
 lemma Bounded_vec_mono: "b \<le> B \<Longrightarrow> Bounded_vec b \<subseteq> Bounded_vec B"
   unfolding Bounded_vec_def by auto
 
 lemma Bounded_mat_mono: "b \<le> B \<Longrightarrow> Bounded_mat b \<subseteq> Bounded_mat B"
   unfolding Bounded_mat_def by force
 
 lemma finite_Bounded_vec_Max:
   assumes A: "A \<subseteq> carrier_vec n"
     and fin: "finite A"
   shows "A \<subseteq> Bounded_vec (Max { abs (a $ i) | a i. a \<in> A \<and> i < n})"
 proof
   let ?B = "{ abs (a $ i) | a i. a \<in> A \<and> i < n}"
   have fin: "finite ?B"
     by (rule finite_subset[of _ "(\<lambda> (a,i). abs (a $ i)) ` (A \<times> {0 ..< n})"], insert fin, auto)
   fix a
   assume a: "a \<in> A"
   show "a \<in> Bounded_vec (Max ?B)"
     unfolding Bounded_vec_def
     by (standard, intro allI impI Max_ge[OF fin], insert a A, force)
 qed
 
 definition det_bound :: "nat \<Rightarrow> 'a :: linordered_idom \<Rightarrow> 'a" where
   "det_bound n x = fact n * (x^n)"
 
 lemma det_bound: assumes A: "A \<in> carrier_mat n n"
   and x: "A \<in> Bounded_mat x"
 shows "abs (det A) \<le> det_bound n x"
 proof -
   have "abs (det A) = abs (\<Sum>p | p permutes {0..<n}. signof p * (\<Prod>i = 0..<n. A $$ (i, p i)))"
     unfolding det_def'[OF A] ..
   also have "\<dots> \<le> (\<Sum>p | p permutes {0..<n}. abs (signof p * (\<Prod>i = 0..<n. A $$ (i, p i))))"
     by (rule sum_abs)
   also have "\<dots> = (\<Sum>p | p permutes {0..<n}. (\<Prod>i = 0..<n. abs (A $$ (i, p i))))"
-    by (rule sum.cong[OF refl], auto simp: abs_mult abs_prod signof_def)
+    by (rule sum.cong[OF refl], auto simp: abs_mult abs_prod sign_def simp flip: of_int_abs)
   also have "\<dots> \<le> (\<Sum>p | p permutes {0..<n}. (\<Prod>i = 0..<n. x))"
     by (intro sum_mono prod_mono conjI Bounded_matD[OF x A], auto)
   also have "\<dots> = fact n * x^n" by (auto simp add: card_permutations)
   finally show "abs (det A) \<le> det_bound n x" unfolding det_bound_def by auto
 qed
 
 lemma minus_in_Bounded_vec[simp]:
   "(-x) \<in> Bounded_vec b \<longleftrightarrow> x \<in> Bounded_vec b"
   unfolding Bounded_vec_def by auto
 
 lemma sum_in_Bounded_vecI[intro]: assumes
   xB: "x \<in> Bounded_vec B1" and
   yB: "y \<in> Bounded_vec B2" and
   x: "x \<in> carrier_vec n" and
   y: "y \<in> carrier_vec n"
 shows "x + y \<in> Bounded_vec (B1 + B2)"
 proof -
   from x y have id: "dim_vec (x + y) = n" by auto
   show ?thesis unfolding Bounded_vec_def mem_Collect_eq id
   proof (intro allI impI)
     fix i
     assume i: "i < n"
     with x y xB yB have *: "abs (x $ i) \<le> B1" "abs (y $ i) \<le> B2"
       unfolding Bounded_vec_def by auto
     thus "\<bar>(x + y) $ i\<bar> \<le> B1 + B2" using i x y by simp
   qed
 qed
 
 lemma (in gram_schmidt) lincomb_card_bound: assumes XBnd: "X \<subseteq> Bounded_vec Bnd"
   and X: "X \<subseteq> carrier_vec n"
   and Bnd: "Bnd \<ge> 0"
   and c: "\<And> x. x \<in> X \<Longrightarrow> abs (c x) \<le> 1"
   and card: "card X \<le> k"
 shows "lincomb c X \<in> Bounded_vec (of_nat k * Bnd)"
 proof -
   from X have dim: "dim_vec (lincomb c X) = n" by auto
   show ?thesis unfolding Bounded_vec_def mem_Collect_eq dim
   proof (intro allI impI)
     fix i
     assume i: "i < n"
     have "abs (lincomb c X $ i) = abs (\<Sum>x\<in>X. c x * x $ i)"
       by (subst lincomb_index[OF i X], auto)
     also have "\<dots> \<le> (\<Sum>x\<in>X. abs (c x * x $ i))" by auto
     also have "\<dots> = (\<Sum>x\<in>X. abs (c x) * abs (x $ i))" by (auto simp: abs_mult)
     also have "\<dots> \<le> (\<Sum>x\<in>X. 1 * abs (x $ i))"
       by (rule sum_mono[OF mult_right_mono], insert c, auto)
     also have "\<dots> = (\<Sum>x\<in>X. abs (x $ i))" by simp
     also have "\<dots> \<le> (\<Sum>x\<in>X. Bnd)"
       by (rule sum_mono, insert i XBnd[unfolded Bounded_vec_def] X, force)
     also have "\<dots> = of_nat (card X) * Bnd" by simp
     also have "\<dots> \<le> of_nat k * Bnd"
       by (rule mult_right_mono[OF _ Bnd], insert card, auto)
     finally show "abs (lincomb c X $ i) \<le> of_nat k * Bnd" by auto
   qed
 qed
 
 lemma bounded_vecset_sum:
   assumes Acarr: "A \<subseteq> carrier_vec n"
     and Bcarr: "B \<subseteq> carrier_vec n"
     and sum: "C = A + B"
     and Cbnd: "\<exists> bndC. C \<subseteq> Bounded_vec bndC"
   shows "A \<noteq> {} \<Longrightarrow> (\<exists> bndB. B \<subseteq> Bounded_vec bndB)"
     and "B \<noteq> {} \<Longrightarrow> (\<exists> bndA. A \<subseteq> Bounded_vec bndA)"
 proof -
   {
     fix A B :: "'a vec set"
     assume Acarr: "A \<subseteq> carrier_vec n"
     assume Bcarr: "B \<subseteq> carrier_vec n"
     assume sum: "C = A + B"
     assume Ane: "A \<noteq> {}"
     have "\<exists> bndB. B \<subseteq> Bounded_vec bndB"
     proof(cases "B = {}")
       case Bne: False
       from Cbnd obtain bndC where bndC: "C \<subseteq> Bounded_vec bndC" by auto
       from Ane obtain a where aA: "a \<in> A" and acarr: "a \<in> carrier_vec n" using Acarr by auto
       let ?M = "{abs (a $ i) | i. i < n}"
       have finM: "finite ?M" by simp
       define nb where "nb = abs bndC + Max ?M"
       {
         fix b
         assume bB: "b \<in> B" and bcarr: "b \<in> carrier_vec n"
         have ab: "a + b \<in> Bounded_vec bndC" using aA bB bndC sum by auto
         {
           fix i
           assume i_lt_n: "i < n"
           hence ai_le_max: "abs(a $ i) \<le> Max ?M" using acarr finM Max_ge by blast
           hence "abs(a $ i + b $ i) \<le> abs bndC"
             using ab bcarr acarr index_add_vec(1) i_lt_n unfolding Bounded_vec_def by auto
           hence "abs(b $ i) \<le> abs bndC + abs(a $ i)" by simp
           hence "abs(b $ i) \<le> nb" using i_lt_n bcarr ai_le_max unfolding nb_def by simp
         }
         hence "b \<in> Bounded_vec nb" unfolding Bounded_vec_def using bcarr carrier_vecD by blast
       }
       hence "B \<subseteq> Bounded_vec nb" unfolding Bounded_vec_def using Bcarr by auto
       thus ?thesis by auto
     qed auto
   } note theor = this
   show "A \<noteq> {} \<Longrightarrow> (\<exists> bndB. B \<subseteq> Bounded_vec bndB)" using theor[OF Acarr Bcarr sum] by simp
   have CBA: "C = B + A" unfolding sum by (rule comm_add_vecset[OF Acarr Bcarr])
   show "B \<noteq> {} \<Longrightarrow> \<exists> bndA. A \<subseteq> Bounded_vec bndA" using theor[OF Bcarr Acarr CBA] by simp
 qed
 
 end
\ No newline at end of file
diff --git a/thys/Perron_Frobenius/HMA_Connect.thy b/thys/Perron_Frobenius/HMA_Connect.thy
--- a/thys/Perron_Frobenius/HMA_Connect.thy
+++ b/thys/Perron_Frobenius/HMA_Connect.thy
@@ -1,751 +1,751 @@
 (*
   Authors: J. Divasón, R. Thiemann, A. Yamada, O. Kunčar
 *)
 
 subsection \<open>Transfer rules to convert theorems from JNF to HMA and vice-versa.\<close>
 
 theory HMA_Connect
 imports 
   Jordan_Normal_Form.Spectral_Radius 
   "HOL-Analysis.Determinants"
   "HOL-Analysis.Cartesian_Euclidean_Space"
   Bij_Nat
   Cancel_Card_Constraint
   "HOL-Eisbach.Eisbach" 
 begin
 
 text \<open>Prefer certain constants and lemmas without prefix.\<close>
 
 hide_const (open) Matrix.mat
 hide_const (open) Matrix.row
 hide_const (open) Determinant.det
 
 lemmas mat_def = Finite_Cartesian_Product.mat_def
 lemmas det_def = Determinants.det_def
 lemmas row_def = Finite_Cartesian_Product.row_def
 
 notation vec_index (infixl "$v" 90)
 notation vec_nth (infixl "$h" 90)
 
 
 text \<open>Forget that @{typ "'a mat"}, @{typ "'a Matrix.vec"}, and @{typ "'a poly"} 
   have been defined via lifting\<close>
 
 
 (* TODO: add to end of matrix theory, stores lifting + transfer setup *)
 lifting_forget vec.lifting
 lifting_forget mat.lifting
 
 lifting_forget poly.lifting
 
 text \<open>Some notions which we did not find in the HMA-world.\<close>
 definition eigen_vector :: "'a::comm_ring_1 ^ 'n ^ 'n \<Rightarrow> 'a ^ 'n \<Rightarrow> 'a \<Rightarrow> bool" where
   "eigen_vector A v ev = (v \<noteq> 0 \<and> A *v v = ev *s v)"
 
 definition eigen_value :: "'a :: comm_ring_1 ^ 'n ^ 'n \<Rightarrow> 'a \<Rightarrow> bool" where
   "eigen_value A k = (\<exists> v. eigen_vector A v k)"
 
 definition similar_matrix_wit 
   :: "'a :: semiring_1 ^ 'n ^ 'n \<Rightarrow> 'a ^ 'n ^ 'n \<Rightarrow> 'a ^ 'n ^ 'n \<Rightarrow> 'a ^ 'n ^ 'n \<Rightarrow> bool" where
   "similar_matrix_wit A B P Q = (P ** Q = mat 1 \<and> Q ** P = mat 1 \<and> A = P ** B ** Q)"
 
 definition similar_matrix 
   :: "'a :: semiring_1 ^ 'n ^ 'n \<Rightarrow> 'a ^ 'n ^ 'n \<Rightarrow> bool" where
   "similar_matrix A B = (\<exists> P Q. similar_matrix_wit A B P Q)"
 
 definition spectral_radius :: "complex ^ 'n ^ 'n \<Rightarrow> real" where
   "spectral_radius A = Max { norm ev | v ev. eigen_vector A v ev}"
 
 definition Spectrum :: "'a :: field ^ 'n ^ 'n \<Rightarrow> 'a set" where
   "Spectrum A = Collect (eigen_value A)" 
 
 definition vec_elements_h :: "'a ^ 'n \<Rightarrow> 'a set" where
   "vec_elements_h v = range (vec_nth v)"
 
 lemma vec_elements_h_def': "vec_elements_h v = {v $h i | i. True}"
   unfolding vec_elements_h_def by auto
 
 definition elements_mat_h :: "'a ^ 'nc ^ 'nr \<Rightarrow> 'a set" where
   "elements_mat_h A = range (\<lambda> (i,j). A $h i $h j)"
 
 lemma elements_mat_h_def': "elements_mat_h A = {A $h i $h j | i j. True}"
   unfolding elements_mat_h_def by auto
 
 definition map_vector :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a ^'n \<Rightarrow> 'b ^'n" where 
   "map_vector f v \<equiv> \<chi> i. f (v $h i)"
 
 definition map_matrix :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a ^ 'n ^ 'm \<Rightarrow> 'b ^ 'n ^ 'm" where 
   "map_matrix f A \<equiv> \<chi> i. map_vector f (A $h i)"
 
 definition normbound :: "'a :: real_normed_field ^ 'nc ^ 'nr \<Rightarrow> real \<Rightarrow> bool" where
   "normbound A b \<equiv> \<forall> x \<in> elements_mat_h A. norm x \<le> b"
 
 lemma spectral_radius_ev_def: "spectral_radius A = Max (norm ` (Collect (eigen_value A)))"
   unfolding spectral_radius_def eigen_value_def[abs_def]
   by (rule arg_cong[where f = Max], auto) 
 
 lemma elements_mat: "elements_mat A = {A $$ (i,j) | i j. i < dim_row A \<and> j < dim_col A}"
   unfolding elements_mat_def by force
 
 definition vec_elements :: "'a Matrix.vec \<Rightarrow> 'a set"
   where "vec_elements v = set [v $ i. i <- [0 ..< dim_vec v]]"
 
 lemma vec_elements: "vec_elements v = { v $ i | i. i < dim_vec v}"
   unfolding vec_elements_def by auto
 
 
 (* TODO: restore a bundle, for e.g., for matrix_impl *)
 context includes vec.lifting 
 begin
 end
 
 definition from_hma\<^sub>v :: "'a ^ 'n  \<Rightarrow> 'a Matrix.vec" where
   "from_hma\<^sub>v v = Matrix.vec CARD('n) (\<lambda> i. v $h from_nat i)"
 
 definition from_hma\<^sub>m :: "'a ^ 'nc ^ 'nr \<Rightarrow> 'a Matrix.mat" where
   "from_hma\<^sub>m a = Matrix.mat CARD('nr) CARD('nc) (\<lambda> (i,j). a $h from_nat i $h from_nat j)"
 
 definition to_hma\<^sub>v :: "'a Matrix.vec \<Rightarrow> 'a ^ 'n" where
   "to_hma\<^sub>v v = (\<chi> i. v $v to_nat i)"
 
 definition to_hma\<^sub>m :: "'a Matrix.mat \<Rightarrow> 'a ^ 'nc  ^ 'nr " where
   "to_hma\<^sub>m a = (\<chi> i j. a $$ (to_nat i, to_nat j))"
 
 declare vec_lambda_eta[simp]
 
 lemma to_hma_from_hma\<^sub>v[simp]: "to_hma\<^sub>v (from_hma\<^sub>v v) = v"
   by (auto simp: to_hma\<^sub>v_def from_hma\<^sub>v_def to_nat_less_card)
 
 lemma to_hma_from_hma\<^sub>m[simp]: "to_hma\<^sub>m (from_hma\<^sub>m v) = v"
   by (auto simp: to_hma\<^sub>m_def from_hma\<^sub>m_def to_nat_less_card)
 
 lemma from_hma_to_hma\<^sub>v[simp]:
   "v \<in> carrier_vec (CARD('n)) \<Longrightarrow> from_hma\<^sub>v (to_hma\<^sub>v v :: 'a ^ 'n) = v"
   by (auto simp: to_hma\<^sub>v_def from_hma\<^sub>v_def to_nat_from_nat_id)
 
 lemma from_hma_to_hma\<^sub>m[simp]:
   "A \<in> carrier_mat (CARD('nr)) (CARD('nc)) \<Longrightarrow> from_hma\<^sub>m (to_hma\<^sub>m A :: 'a ^ 'nc  ^ 'nr) = A"
   by (auto simp: to_hma\<^sub>m_def from_hma\<^sub>m_def to_nat_from_nat_id)
 
 lemma from_hma\<^sub>v_inj[simp]: "from_hma\<^sub>v x = from_hma\<^sub>v y \<longleftrightarrow> x = y"
   by (intro iffI, insert to_hma_from_hma\<^sub>v[of x], auto)
 
 lemma from_hma\<^sub>m_inj[simp]: "from_hma\<^sub>m x = from_hma\<^sub>m y \<longleftrightarrow> x = y"
   by(intro iffI, insert to_hma_from_hma\<^sub>m[of x], auto)
 
 definition HMA_V :: "'a Matrix.vec \<Rightarrow> 'a ^ 'n  \<Rightarrow> bool" where 
   "HMA_V = (\<lambda> v w. v = from_hma\<^sub>v w)"
 
 definition HMA_M :: "'a Matrix.mat \<Rightarrow> 'a ^ 'nc  ^ 'nr  \<Rightarrow> bool" where 
   "HMA_M = (\<lambda> a b. a = from_hma\<^sub>m b)"
 
 definition HMA_I :: "nat \<Rightarrow> 'n :: finite \<Rightarrow> bool" where
   "HMA_I = (\<lambda> i a. i = to_nat a)"
 
 context includes lifting_syntax
 begin
 
 lemma Domainp_HMA_V [transfer_domain_rule]: 
   "Domainp (HMA_V :: 'a Matrix.vec \<Rightarrow> 'a ^ 'n \<Rightarrow> bool) = (\<lambda> v. v \<in> carrier_vec (CARD('n )))"
   by(intro ext iffI, insert from_hma_to_hma\<^sub>v[symmetric], auto simp: from_hma\<^sub>v_def HMA_V_def)
 
 lemma Domainp_HMA_M [transfer_domain_rule]: 
   "Domainp (HMA_M :: 'a Matrix.mat \<Rightarrow> 'a ^ 'nc  ^ 'nr  \<Rightarrow> bool) 
   = (\<lambda> A. A \<in> carrier_mat CARD('nr) CARD('nc))"
   by (intro ext iffI, insert from_hma_to_hma\<^sub>m[symmetric], auto simp: from_hma\<^sub>m_def HMA_M_def)
 
 lemma Domainp_HMA_I [transfer_domain_rule]: 
   "Domainp (HMA_I :: nat \<Rightarrow> 'n :: finite \<Rightarrow> bool) = (\<lambda> i. i < CARD('n))" (is "?l = ?r")
 proof (intro ext)
   fix i :: nat
   show "?l i = ?r i"
     unfolding HMA_I_def Domainp_iff
     by (auto intro: exI[of _ "from_nat i"] simp: to_nat_from_nat_id to_nat_less_card)
 qed
 
 lemma bi_unique_HMA_V [transfer_rule]: "bi_unique HMA_V" "left_unique HMA_V" "right_unique HMA_V"
   unfolding HMA_V_def bi_unique_def left_unique_def right_unique_def by auto
 
 lemma bi_unique_HMA_M [transfer_rule]: "bi_unique HMA_M" "left_unique HMA_M" "right_unique HMA_M"
   unfolding HMA_M_def bi_unique_def left_unique_def right_unique_def by auto
 
 lemma bi_unique_HMA_I [transfer_rule]: "bi_unique HMA_I" "left_unique HMA_I" "right_unique HMA_I"
   unfolding HMA_I_def bi_unique_def left_unique_def right_unique_def by auto
 
 lemma right_total_HMA_V [transfer_rule]: "right_total HMA_V"
   unfolding HMA_V_def right_total_def by simp
 
 lemma right_total_HMA_M [transfer_rule]: "right_total HMA_M"
   unfolding HMA_M_def right_total_def by simp
 
 lemma right_total_HMA_I [transfer_rule]: "right_total HMA_I"
   unfolding HMA_I_def right_total_def by simp
 
 lemma HMA_V_index [transfer_rule]: "(HMA_V ===> HMA_I ===> (=)) ($v) ($h)"
   unfolding rel_fun_def HMA_V_def HMA_I_def from_hma\<^sub>v_def
   by (auto simp: to_nat_less_card)
 
 text \<open>We introduce the index function to have pointwise access to 
   HMA-matrices by a constant. Otherwise, the transfer rule 
   with @{term "\<lambda> A i j. A $h i $h j"} instead of index is not applicable.\<close>
 
 definition "index_hma A i j \<equiv> A $h i $h j"
 
 lemma HMA_M_index [transfer_rule]:
   "(HMA_M ===> HMA_I ===> HMA_I ===> (=)) (\<lambda> A i j. A $$ (i,j)) index_hma"
   by (intro rel_funI, simp add: index_hma_def to_nat_less_card HMA_M_def HMA_I_def from_hma\<^sub>m_def)  
 
 lemma HMA_V_0 [transfer_rule]: "HMA_V (0\<^sub>v CARD('n)) (0 :: 'a :: zero ^ 'n)"
   unfolding HMA_V_def from_hma\<^sub>v_def by auto
 
 lemma HMA_M_0 [transfer_rule]: 
   "HMA_M (0\<^sub>m CARD('nr) CARD('nc)) (0 :: 'a :: zero ^ 'nc  ^ 'nr )"
   unfolding HMA_M_def from_hma\<^sub>m_def by auto
 
 lemma HMA_M_1[transfer_rule]:
   "HMA_M (1\<^sub>m (CARD('n))) (mat 1 :: 'a::{zero,one}^'n^'n)"
   unfolding HMA_M_def
   by (auto simp add: mat_def from_hma\<^sub>m_def from_nat_inj)
 
 lemma from_hma\<^sub>v_add: "from_hma\<^sub>v v + from_hma\<^sub>v w = from_hma\<^sub>v (v + w)"
   unfolding from_hma\<^sub>v_def by auto
 
 lemma HMA_V_add [transfer_rule]: "(HMA_V ===> HMA_V ===> HMA_V) (+) (+) "
   unfolding rel_fun_def HMA_V_def
   by (auto simp: from_hma\<^sub>v_add)
 
 lemma from_hma\<^sub>v_diff: "from_hma\<^sub>v v - from_hma\<^sub>v w = from_hma\<^sub>v (v - w)"
   unfolding from_hma\<^sub>v_def by auto
 
 lemma HMA_V_diff [transfer_rule]: "(HMA_V ===> HMA_V ===> HMA_V) (-) (-)"
   unfolding rel_fun_def HMA_V_def
   by (auto simp: from_hma\<^sub>v_diff)
 
 lemma from_hma\<^sub>m_add: "from_hma\<^sub>m a + from_hma\<^sub>m b = from_hma\<^sub>m (a + b)"
   unfolding from_hma\<^sub>m_def by auto
 
 lemma HMA_M_add [transfer_rule]: "(HMA_M ===> HMA_M ===> HMA_M) (+) (+) "
   unfolding rel_fun_def HMA_M_def
   by (auto simp: from_hma\<^sub>m_add)
 
 lemma from_hma\<^sub>m_diff: "from_hma\<^sub>m a - from_hma\<^sub>m b = from_hma\<^sub>m (a - b)"
   unfolding from_hma\<^sub>m_def by auto
 
 lemma HMA_M_diff [transfer_rule]: "(HMA_M ===> HMA_M ===> HMA_M) (-) (-) "
   unfolding rel_fun_def HMA_M_def
   by (auto simp: from_hma\<^sub>m_diff)
 
 lemma scalar_product: fixes v :: "'a :: semiring_1 ^ 'n "
   shows "scalar_prod (from_hma\<^sub>v v) (from_hma\<^sub>v w) = scalar_product v w"
   unfolding scalar_product_def scalar_prod_def from_hma\<^sub>v_def dim_vec
   by (simp add: sum.reindex[OF inj_to_nat, unfolded range_to_nat])
 
 lemma [simp]:
   "from_hma\<^sub>m (y :: 'a ^ 'nc  ^ 'nr) \<in> carrier_mat (CARD('nr)) (CARD('nc))"
   "dim_row (from_hma\<^sub>m (y :: 'a ^ 'nc  ^ 'nr )) = CARD('nr)"
   "dim_col (from_hma\<^sub>m (y :: 'a ^ 'nc  ^ 'nr )) = CARD('nc)"
   unfolding from_hma\<^sub>m_def by simp_all
 
 lemma [simp]:
   "from_hma\<^sub>v (y :: 'a ^ 'n) \<in> carrier_vec (CARD('n))"
   "dim_vec (from_hma\<^sub>v (y :: 'a ^ 'n)) = CARD('n)"
   unfolding from_hma\<^sub>v_def by simp_all
 
 declare rel_funI [intro!]
 
 lemma HMA_scalar_prod [transfer_rule]:
   "(HMA_V ===> HMA_V ===> (=)) scalar_prod scalar_product"
   by (auto simp: HMA_V_def scalar_product)
 
 lemma HMA_row [transfer_rule]: "(HMA_I ===> HMA_M ===> HMA_V) (\<lambda> i a. Matrix.row a i) row"
   unfolding HMA_M_def HMA_I_def HMA_V_def
   by (auto simp: from_hma\<^sub>m_def from_hma\<^sub>v_def to_nat_less_card row_def)
 
 lemma HMA_col [transfer_rule]: "(HMA_I ===> HMA_M ===> HMA_V) (\<lambda> i a. col a i) column"
   unfolding HMA_M_def HMA_I_def HMA_V_def
   by (auto simp: from_hma\<^sub>m_def from_hma\<^sub>v_def to_nat_less_card column_def)
 
 definition mk_mat :: "('i \<Rightarrow> 'j \<Rightarrow> 'c) \<Rightarrow> 'c^'j^'i" where
   "mk_mat f = (\<chi> i j. f i j)"
 
 definition mk_vec :: "('i \<Rightarrow> 'c) \<Rightarrow> 'c^'i" where
   "mk_vec f = (\<chi> i. f i)"
 
 lemma HMA_M_mk_mat[transfer_rule]: "((HMA_I ===> HMA_I ===> (=)) ===> HMA_M) 
   (\<lambda> f. Matrix.mat (CARD('nr)) (CARD('nc)) (\<lambda> (i,j). f i j)) 
   (mk_mat :: (('nr \<Rightarrow> 'nc \<Rightarrow> 'a) \<Rightarrow> 'a^'nc^'nr))"
 proof-
   {
     fix x y i j
     assume id: "\<forall> (ya :: 'nr) (yb :: 'nc). (x (to_nat ya) (to_nat yb) :: 'a) = y ya yb"
        and i: "i < CARD('nr)" and j: "j < CARD('nc)"
     from to_nat_from_nat_id[OF i] to_nat_from_nat_id[OF j] id[rule_format, of "from_nat i" "from_nat j"]
     have "x i j = y (from_nat i) (from_nat j)" by auto
   }
   thus ?thesis
     unfolding rel_fun_def mk_mat_def HMA_M_def HMA_I_def from_hma\<^sub>m_def by auto
 qed
 
 lemma HMA_M_mk_vec[transfer_rule]: "((HMA_I ===> (=)) ===> HMA_V) 
   (\<lambda> f. Matrix.vec (CARD('n)) (\<lambda> i. f i)) 
   (mk_vec :: (('n \<Rightarrow> 'a) \<Rightarrow> 'a^'n))"
 proof-
   {
     fix x y i
     assume id: "\<forall> (ya :: 'n). (x (to_nat ya) :: 'a) = y ya"
        and i: "i < CARD('n)" 
     from to_nat_from_nat_id[OF i] id[rule_format, of "from_nat i"]
     have "x i = y (from_nat i)" by auto
   }
   thus ?thesis
     unfolding rel_fun_def mk_vec_def HMA_V_def HMA_I_def from_hma\<^sub>v_def by auto
 qed
 
 
 lemma mat_mult_scalar: "A ** B = mk_mat (\<lambda> i j. scalar_product (row i A) (column j B))"
   unfolding vec_eq_iff matrix_matrix_mult_def scalar_product_def mk_mat_def
   by (auto simp: row_def column_def)
 
 lemma mult_mat_vec_scalar: "A *v v = mk_vec (\<lambda> i. scalar_product (row i A) v)"
   unfolding vec_eq_iff matrix_vector_mult_def scalar_product_def mk_mat_def mk_vec_def
   by (auto simp: row_def column_def)
 
 lemma dim_row_transfer_rule: 
   "HMA_M A (A' :: 'a ^ 'nc ^ 'nr) \<Longrightarrow> (=) (dim_row A) (CARD('nr))"
   unfolding HMA_M_def by auto
 
 lemma dim_col_transfer_rule: 
   "HMA_M A (A' :: 'a ^ 'nc ^ 'nr) \<Longrightarrow> (=) (dim_col A) (CARD('nc))"
   unfolding HMA_M_def by auto
 
 lemma HMA_M_mult [transfer_rule]: "(HMA_M ===> HMA_M ===> HMA_M) ((*)) ((**))"
 proof -
   {
     fix A B :: "'a :: semiring_1 mat" and A' :: "'a ^ 'n  ^ 'nr" and B' :: "'a ^ 'nc ^ 'n"
     assume 1[transfer_rule]: "HMA_M A A'" "HMA_M B B'"
     note [transfer_rule] = dim_row_transfer_rule[OF 1(1)] dim_col_transfer_rule[OF 1(2)]
     have "HMA_M (A * B) (A' ** B')"
       unfolding times_mat_def mat_mult_scalar
       by (transfer_prover_start, transfer_step+, transfer, auto)
   }
   thus ?thesis by blast
 qed
       
 
 lemma HMA_V_smult [transfer_rule]: "((=) ===> HMA_V ===> HMA_V) (\<cdot>\<^sub>v) ((*s))"
   unfolding smult_vec_def 
   unfolding rel_fun_def HMA_V_def from_hma\<^sub>v_def
   by auto
 
 lemma HMA_M_mult_vec [transfer_rule]: "(HMA_M ===> HMA_V ===> HMA_V) ((*\<^sub>v)) ((*v))"
 proof -
   {
     fix A :: "'a :: semiring_1 mat" and v :: "'a Matrix.vec"
       and A' :: "'a ^ 'nc  ^ 'nr" and v' :: "'a ^ 'nc"
     assume 1[transfer_rule]: "HMA_M A A'" "HMA_V v v'"
     note [transfer_rule] = dim_row_transfer_rule
     have "HMA_V (A *\<^sub>v v) (A' *v v')"
       unfolding mult_mat_vec_def mult_mat_vec_scalar
       by (transfer_prover_start, transfer_step+, transfer, auto)
   }
   thus ?thesis by blast  
 qed
 
 lemma HMA_det [transfer_rule]: "(HMA_M ===> (=)) Determinant.det 
   (det :: 'a :: comm_ring_1 ^ 'n ^ 'n \<Rightarrow> 'a)"
 proof -
   {
     fix a :: "'a ^ 'n ^ 'n"
     let ?tn = "to_nat :: 'n :: finite \<Rightarrow> nat"
     let ?fn = "from_nat :: nat \<Rightarrow> 'n"
     let ?zn = "{0..< CARD('n)}"
     let ?U = "UNIV :: 'n set"
     let ?p1 = "{p. p permutes ?zn}"
     let ?p2 = "{p. p permutes ?U}"  
     let ?f= "\<lambda> p i. if i \<in> ?U then ?fn (p (?tn i)) else i"
     let ?g = "\<lambda> p i. ?fn (p (?tn i))"
     have fg: "\<And> a b c. (if a \<in> ?U then b else c) = b" by auto
     have "?p2 = ?f ` ?p1" 
       by (rule permutes_bij', auto simp: to_nat_less_card to_nat_from_nat_id)
     hence id: "?p2 = ?g ` ?p1" by simp
     have inj_g: "inj_on ?g ?p1"
       unfolding inj_on_def
     proof (intro ballI impI ext, auto)
       fix p q i
       assume p: "p permutes ?zn" and q: "q permutes ?zn"
         and id: "(\<lambda> i. ?fn (p (?tn i))) = (\<lambda> i. ?fn (q (?tn i)))"
       {
         fix i
         from permutes_in_image[OF p] have pi: "p (?tn i) < CARD('n)" by (simp add: to_nat_less_card)
         from permutes_in_image[OF q] have qi: "q (?tn i) < CARD('n)" by (simp add: to_nat_less_card)
         from fun_cong[OF id] have "?fn (p (?tn i))  = from_nat (q (?tn i))" .
         from arg_cong[OF this, of ?tn] have "p (?tn i) = q (?tn i)"
           by (simp add: to_nat_from_nat_id pi qi)
       } note id = this             
       show "p i = q i"
       proof (cases "i < CARD('n)")
         case True
         hence "?tn (?fn i) = i" by (simp add: to_nat_from_nat_id)
         from id[of "?fn i", unfolded this] show ?thesis .
       next
         case False
         thus ?thesis using p q unfolding permutes_def by simp
       qed
     qed
     have mult_cong: "\<And> a b c d. a = b \<Longrightarrow> c = d \<Longrightarrow> a * c = b * d" by simp
     have "sum (\<lambda> p. 
       signof p * (\<Prod>i\<in>?zn. a $h ?fn i $h ?fn (p i))) ?p1
       = sum (\<lambda> p. of_int (sign p) * (\<Prod>i\<in>UNIV. a $h i $h p i)) ?p2"
       unfolding id sum.reindex[OF inj_g]
     proof (rule sum.cong[OF refl], unfold mem_Collect_eq o_def, rule mult_cong)
       fix p
       assume p: "p permutes ?zn"
       let ?q = "\<lambda> i. ?fn (p (?tn i))"
       from id p have q: "?q permutes ?U" by auto
       from p have pp: "permutation p" unfolding permutation_permutes by auto
       let ?ft = "\<lambda> p i. ?fn (p (?tn i))"
       have fin: "finite ?zn" by simp
       have "sign p = sign ?q \<and> p permutes ?zn"
       using p fin proof (induction rule: permutes_induct)
         case id
         show ?case by (auto simp: sign_id[unfolded id_def] permutes_id[unfolded id_def])
       next
         case (swap a b p)
         then have \<open>permutation p\<close>
           by (auto intro: permutes_imp_permutation)
         let ?sab = "Fun.swap a b id"
         let ?sfab = "Fun.swap (?fn a) (?fn b) id"
         have p_sab: "permutation ?sab" by (rule permutation_swap_id)
         have p_sfab: "permutation ?sfab" by (rule permutation_swap_id)
         from swap(4) have IH1: "p permutes ?zn" and IH2: "sign p = sign (?ft p)" by auto
         have sab_perm: "?sab permutes ?zn" using swap(1-2) by (rule permutes_swap_id)
         from permutes_compose[OF IH1 this] have perm1: "?sab o p permutes ?zn" .
         from IH1 have p_p1: "p \<in> ?p1" by simp
         hence "?ft p \<in> ?ft ` ?p1" by (rule imageI)
         from this[folded id] have "?ft p permutes ?U" by simp
         hence p_ftp: "permutation (?ft p)" unfolding permutation_permutes by auto
         {
           fix a b
           assume a: "a \<in> ?zn" and b: "b \<in> ?zn"
           hence "(?fn a = ?fn b) = (a = b)" using swap(1-2)
             by (auto simp: from_nat_inj)
         } note inj = this
         from inj[OF swap(1-2)] have id2: "sign ?sfab = sign ?sab" unfolding sign_swap_id by simp
         have id: "?ft (Fun.swap a b id \<circ> p) = Fun.swap (?fn a) (?fn b) id \<circ> ?ft p"
         proof
           fix c 
           show "?ft (Fun.swap a b id \<circ> p) c = (Fun.swap (?fn a) (?fn b) id \<circ> ?ft p) c"
           proof (cases "p (?tn c) = a \<or> p (?tn c) = b")
             case True
             thus ?thesis by (cases, auto simp add: swap_id_eq)
           next
             case False
             hence neq: "p (?tn c) \<noteq> a" "p (?tn c) \<noteq> b" by auto
             have pc: "p (?tn c) \<in> ?zn" unfolding permutes_in_image[OF IH1] 
               by (simp add: to_nat_less_card)
             from neq[folded inj[OF pc swap(1)] inj[OF pc swap(2)]]
             have "?fn (p (?tn c)) \<noteq> ?fn a" "?fn (p (?tn c)) \<noteq> ?fn b" .
             with neq show ?thesis by (auto simp: swap_id_eq)
           qed
         qed
         show ?case unfolding IH2 id sign_compose[OF p_sab \<open>permutation p\<close>] sign_compose[OF p_sfab p_ftp] id2
           by (rule conjI[OF refl perm1])
       qed
-      thus "signof p = of_int (sign ?q)" unfolding signof_def sign_def by auto
+      thus "signof p = of_int (sign ?q)" unfolding sign_def by auto
       show "(\<Prod>i = 0..<CARD('n). a $h ?fn i $h ?fn (p i)) =
            (\<Prod>i\<in>UNIV. a $h i $h ?q i)" unfolding 
            range_to_nat[symmetric] prod.reindex[OF inj_to_nat]
         by (rule prod.cong[OF refl], unfold o_def, simp)
     qed   
   }
   thus ?thesis unfolding HMA_M_def 
     by (auto simp: from_hma\<^sub>m_def Determinant.det_def det_def)
 qed
 
 lemma HMA_mat[transfer_rule]: "((=) ===> HMA_M) (\<lambda> k. k \<cdot>\<^sub>m 1\<^sub>m CARD('n)) 
   (Finite_Cartesian_Product.mat :: 'a::semiring_1 \<Rightarrow> 'a^'n^'n)"
   unfolding Finite_Cartesian_Product.mat_def[abs_def] rel_fun_def HMA_M_def
   by (auto simp: from_hma\<^sub>m_def from_nat_inj)
 
 
 lemma HMA_mat_minus[transfer_rule]: "(HMA_M ===> HMA_M ===> HMA_M) 
   (\<lambda> A B. A + map_mat uminus B) ((-) :: 'a :: group_add ^'nc^'nr \<Rightarrow> 'a^'nc^'nr \<Rightarrow> 'a^'nc^'nr)"
   unfolding rel_fun_def HMA_M_def from_hma\<^sub>m_def by auto
 
 definition mat2matofpoly where "mat2matofpoly A = (\<chi> i j. [: A $ i $ j :])"
 
 definition charpoly where charpoly_def: "charpoly A = det (mat (monom 1 (Suc 0)) - mat2matofpoly A)"
 
 definition erase_mat :: "'a :: zero ^ 'nc ^ 'nr \<Rightarrow> 'nr \<Rightarrow> 'nc \<Rightarrow> 'a ^ 'nc ^ 'nr" 
   where "erase_mat A i j = (\<chi> i'. \<chi>  j'. if i' = i \<or> j' = j then 0 else A $ i' $ j')" 
 
 definition sum_UNIV_type :: "('n :: finite \<Rightarrow> 'a :: comm_monoid_add) \<Rightarrow> 'n itself \<Rightarrow> 'a" where
   "sum_UNIV_type f _ = sum f UNIV" 
 
 definition sum_UNIV_set :: "(nat \<Rightarrow> 'a :: comm_monoid_add) \<Rightarrow> nat \<Rightarrow> 'a" where
   "sum_UNIV_set f n = sum f {..<n}" 
 
 definition HMA_T :: "nat \<Rightarrow> 'n :: finite itself \<Rightarrow> bool" where
   "HMA_T n _ = (n = CARD('n))" 
 
 lemma HMA_mat2matofpoly[transfer_rule]: "(HMA_M ===> HMA_M) (\<lambda>x. map_mat (\<lambda>a. [:a:]) x) mat2matofpoly"
   unfolding rel_fun_def HMA_M_def from_hma\<^sub>m_def mat2matofpoly_def by auto
 
 lemma HMA_char_poly [transfer_rule]: 
   "((HMA_M :: ('a:: comm_ring_1 mat \<Rightarrow> 'a^'n^'n \<Rightarrow> bool)) ===> (=)) char_poly charpoly"
 proof -
   {
     fix A :: "'a mat" and A' :: "'a^'n^'n"
     assume [transfer_rule]: "HMA_M A A'"
     hence [simp]: "dim_row A = CARD('n)" by (simp add: HMA_M_def)
     have [simp]: "monom 1 (Suc 0) = [:0, 1 :: 'a :]"
       by (simp add: monom_Suc)
     have [simp]: "map_mat uminus (map_mat (\<lambda>a. [:a:]) A) = map_mat (\<lambda>a. [:-a:]) A"
       by (rule eq_matI, auto)
     have "char_poly A = charpoly A'"
       unfolding char_poly_def[abs_def] char_poly_matrix_def charpoly_def[abs_def]
       by (transfer, simp)
   }
   thus ?thesis by blast
 qed
  
 
 lemma HMA_eigen_vector [transfer_rule]: "(HMA_M ===> HMA_V ===> (=)) eigenvector eigen_vector"
 proof -
   { 
     fix A :: "'a mat" and v :: "'a Matrix.vec" 
     and A' :: "'a ^ 'n ^ 'n" and v' :: "'a ^ 'n" and k :: 'a
     assume 1[transfer_rule]: "HMA_M A A'" and 2[transfer_rule]: "HMA_V v v'"
     hence [simp]: "dim_row A = CARD('n)" "dim_vec v = CARD('n)" by (auto simp add: HMA_V_def HMA_M_def)
     have [simp]: "v \<in> carrier_vec CARD('n)" using 2 unfolding HMA_V_def by simp
     have "eigenvector A v = eigen_vector A' v'" 
       unfolding eigenvector_def[abs_def] eigen_vector_def[abs_def] 
       by (transfer, simp)
   }
   thus ?thesis by blast
 qed
 
 
 lemma HMA_eigen_value [transfer_rule]: "(HMA_M ===> (=) ===> (=)) eigenvalue eigen_value"
 proof -
   {
     fix A :: "'a mat" and A' :: "'a ^ 'n  ^ 'n" and k
     assume 1[transfer_rule]: "HMA_M A A'"
     hence [simp]: "dim_row A = CARD('n)" by (simp add: HMA_M_def)
     note [transfer_rule] = dim_row_transfer_rule[OF 1(1)]    
     have "(eigenvalue A k) = (eigen_value A' k)"
       unfolding eigenvalue_def[abs_def] eigen_value_def[abs_def] 
       by (transfer, auto simp add: eigenvector_def)
   }
   thus ?thesis by blast
 qed
 
 
 lemma HMA_spectral_radius [transfer_rule]: 
   "(HMA_M ===> (=)) Spectral_Radius.spectral_radius spectral_radius"
   unfolding Spectral_Radius.spectral_radius_def[abs_def] spectrum_def 
     spectral_radius_ev_def[abs_def]
   by transfer_prover
 
 lemma HMA_elements_mat[transfer_rule]: "((HMA_M :: ('a mat \<Rightarrow> 'a ^ 'nc ^ 'nr \<Rightarrow> bool))  ===> (=)) 
   elements_mat elements_mat_h"
 proof -
   {
     fix y :: "'a ^ 'nc ^ 'nr" and i j :: nat
     assume i: "i < CARD('nr)" and j: "j < CARD('nc)"
     hence "from_hma\<^sub>m y $$ (i, j) \<in> range (\<lambda>(i, ya). y $h i $h ya)"      
       using to_nat_from_nat_id[OF i] to_nat_from_nat_id[OF j] by (auto simp: from_hma\<^sub>m_def)
   }
   moreover
   {
     fix y :: "'a ^ 'nc ^ 'nr" and a b
     have "\<exists>i j. y $h a $h b = from_hma\<^sub>m y $$ (i, j) \<and> i < CARD('nr) \<and> j < CARD('nc)"
       unfolding from_hma\<^sub>m_def
       by (rule exI[of _ "Bij_Nat.to_nat a"], rule exI[of _ "Bij_Nat.to_nat b"], auto
         simp: to_nat_less_card)
   }
   ultimately show ?thesis
     unfolding elements_mat[abs_def] elements_mat_h_def[abs_def] HMA_M_def
     by auto
 qed  
 
 lemma HMA_vec_elements[transfer_rule]: "((HMA_V :: ('a Matrix.vec \<Rightarrow> 'a ^ 'n \<Rightarrow> bool))  ===> (=)) 
   vec_elements vec_elements_h"
 proof -
   {
     fix y :: "'a ^ 'n" and i :: nat
     assume i: "i < CARD('n)" 
     hence "from_hma\<^sub>v y $ i \<in> range (vec_nth y)"      
       using to_nat_from_nat_id[OF i] by (auto simp: from_hma\<^sub>v_def)
   }
   moreover
   {
     fix y :: "'a ^ 'n" and a
     have "\<exists>i. y $h a = from_hma\<^sub>v y $ i \<and> i < CARD('n)"
       unfolding from_hma\<^sub>v_def
       by (rule exI[of _ "Bij_Nat.to_nat a"], auto simp: to_nat_less_card)
   }
   ultimately show ?thesis
     unfolding vec_elements[abs_def] vec_elements_h_def[abs_def] rel_fun_def HMA_V_def
     by auto
 qed  
   
 lemma norm_bound_elements_mat: "norm_bound A b = (\<forall> x \<in> elements_mat A. norm x \<le> b)"
   unfolding norm_bound_def elements_mat by auto
 
 lemma HMA_normbound [transfer_rule]: 
   "((HMA_M :: 'a :: real_normed_field mat \<Rightarrow> 'a ^ 'nc ^ 'nr \<Rightarrow> bool) ===> (=) ===> (=))
   norm_bound normbound"
   unfolding normbound_def[abs_def] norm_bound_elements_mat[abs_def]
   by (transfer_prover)
 
 lemma HMA_map_matrix [transfer_rule]: 
   "((=) ===> HMA_M ===> HMA_M) map_mat map_matrix"
   unfolding map_vector_def map_matrix_def[abs_def] map_mat_def[abs_def] HMA_M_def from_hma\<^sub>m_def
   by auto
 
 lemma HMA_transpose_matrix [transfer_rule]: 
   "(HMA_M ===> HMA_M) transpose_mat transpose"
   unfolding transpose_mat_def transpose_def HMA_M_def from_hma\<^sub>m_def by auto
 
 lemma HMA_map_vector [transfer_rule]: 
   "((=) ===> HMA_V ===> HMA_V) map_vec map_vector"
   unfolding map_vector_def[abs_def] map_vec_def[abs_def] HMA_V_def from_hma\<^sub>v_def
   by auto
 
 lemma HMA_similar_mat_wit [transfer_rule]: 
   "((HMA_M :: _ \<Rightarrow> 'a :: comm_ring_1 ^ 'n ^ 'n \<Rightarrow> _) ===> HMA_M ===> HMA_M ===> HMA_M ===> (=)) 
   similar_mat_wit similar_matrix_wit"
 proof (intro rel_funI, goal_cases)
   case (1 a A b B c C d D)  
   note [transfer_rule] = this
   hence id: "dim_row a = CARD('n)" by (auto simp: HMA_M_def)
   have *: "(c * d = 1\<^sub>m (dim_row a) \<and> d * c = 1\<^sub>m (dim_row a) \<and> a = c * b * d) =
     (C ** D = mat 1 \<and> D ** C = mat 1 \<and> A = C ** B ** D)" unfolding id
     by (transfer, simp)
   show ?case unfolding similar_mat_wit_def Let_def similar_matrix_wit_def *
     using 1 by (auto simp: HMA_M_def)
 qed
 
 lemma HMA_similar_mat [transfer_rule]: 
   "((HMA_M :: _ \<Rightarrow> 'a :: comm_ring_1 ^ 'n ^ 'n \<Rightarrow> _) ===> HMA_M ===> (=)) 
   similar_mat similar_matrix"
 proof (intro rel_funI, goal_cases)
   case (1 a A b B)
   note [transfer_rule] = this
   hence id: "dim_row a = CARD('n)" by (auto simp: HMA_M_def)
   {
     fix c d
     assume "similar_mat_wit a b c d" 
     hence "{c,d} \<subseteq> carrier_mat CARD('n) CARD('n)" unfolding similar_mat_wit_def id Let_def by auto
   } note * = this
   show ?case unfolding similar_mat_def similar_matrix_def
     by (transfer, insert *, blast)
 qed
 
 lemma HMA_spectrum[transfer_rule]: "(HMA_M ===> (=)) spectrum Spectrum"
   unfolding spectrum_def[abs_def] Spectrum_def[abs_def]
   by transfer_prover
 
 lemma HMA_M_erase_mat[transfer_rule]: "(HMA_M ===> HMA_I ===> HMA_I ===> HMA_M) mat_erase erase_mat" 
   unfolding mat_erase_def[abs_def] erase_mat_def[abs_def]
   by (auto simp: HMA_M_def HMA_I_def from_hma\<^sub>m_def to_nat_from_nat_id intro!: eq_matI)
 
 lemma HMA_M_sum_UNIV[transfer_rule]: 
   "((HMA_I ===> (=)) ===> HMA_T ===> (=)) sum_UNIV_set sum_UNIV_type"
   unfolding rel_fun_def 
 proof (clarify, rename_tac f fT n nT)
   fix f and fT :: "'b \<Rightarrow> 'a" and n and nT :: "'b itself" 
   assume f: "\<forall>x y. HMA_I x y \<longrightarrow> f x = fT y"
     and n: "HMA_T n nT" 
   let ?f = "from_nat :: nat \<Rightarrow> 'b" 
   let ?t = "to_nat :: 'b \<Rightarrow> nat" 
   from n[unfolded HMA_T_def] have n: "n = CARD('b)" .
   from to_nat_from_nat_id[where 'a = 'b, folded n]
   have tf: "i < n \<Longrightarrow> ?t (?f i) = i" for i by auto
   have "sum_UNIV_set f n = sum f (?t ` ?f ` {..<n})" 
     unfolding sum_UNIV_set_def
     by (rule arg_cong[of _ _ "sum f"], insert tf, force)
   also have "\<dots> = sum (f \<circ> ?t) (?f ` {..<n})" 
     by (rule sum.reindex, insert tf n, auto simp: inj_on_def)
   also have "?f ` {..<n} = UNIV" 
     using range_to_nat[where 'a = 'b, folded n] by force
   also have "sum (f \<circ> ?t) UNIV = sum fT UNIV" 
   proof (rule sum.cong[OF refl])
     fix i :: 'b
     show "(f \<circ> ?t) i = fT i" unfolding o_def 
       by (rule f[rule_format], auto simp: HMA_I_def)
   qed
   also have "\<dots> = sum_UNIV_type fT nT" 
     unfolding sum_UNIV_type_def ..
   finally show "sum_UNIV_set f n = sum_UNIV_type fT nT" .
 qed
 end
 
 text \<open>Setup a method to easily convert theorems from JNF into HMA.\<close>
 
 method transfer_hma uses rule = (
   (fold index_hma_def)?, (* prepare matrix access for transfer *)
   transfer,
   rule rule, 
   (unfold carrier_vec_def carrier_mat_def)?, 
   auto)
 
 text \<open>Now it becomes easy to transfer results which are not yet proven in HMA, such as:\<close>
 
 lemma matrix_add_vect_distrib: "(A + B) *v v = A *v v + B *v v"
   by (transfer_hma rule: add_mult_distrib_mat_vec)
 
 lemma matrix_vector_right_distrib: "M *v (v + w) = M *v v + M *v w"
   by (transfer_hma rule: mult_add_distrib_mat_vec)
 
 lemma matrix_vector_right_distrib_diff: "(M :: 'a :: ring_1 ^ 'nr ^ 'nc) *v (v - w) = M *v v - M *v w"
   by (transfer_hma rule: mult_minus_distrib_mat_vec)
 
 lemma eigen_value_root_charpoly: 
   "eigen_value A k \<longleftrightarrow> poly (charpoly (A :: 'a :: field ^ 'n ^ 'n)) k = 0"
   by (transfer_hma rule: eigenvalue_root_char_poly)
 
 lemma finite_spectrum: fixes A :: "'a :: field ^ 'n ^ 'n"
   shows "finite (Collect (eigen_value A))" 
   by (transfer_hma rule: card_finite_spectrum(1)[unfolded spectrum_def])
 
 lemma non_empty_spectrum: fixes A :: "complex ^ 'n ^ 'n"
   shows "Collect (eigen_value A) \<noteq> {}"
   by (transfer_hma rule: spectrum_non_empty[unfolded spectrum_def])
 
 lemma charpoly_transpose: "charpoly (transpose A :: 'a :: field ^ 'n ^ 'n) = charpoly A"
   by (transfer_hma rule: char_poly_transpose_mat)
 
 lemma eigen_value_transpose: "eigen_value (transpose A :: 'a :: field ^ 'n ^ 'n) v = eigen_value A v" 
   unfolding eigen_value_root_charpoly charpoly_transpose by simp
 
 lemma matrix_diff_vect_distrib: "(A - B) *v v = A *v v - B *v (v :: 'a :: ring_1 ^ 'n)"
   by (transfer_hma rule: minus_mult_distrib_mat_vec)
 
 lemma similar_matrix_charpoly: "similar_matrix A B \<Longrightarrow> charpoly A = charpoly B" 
   by (transfer_hma rule: char_poly_similar)
 
 lemma pderiv_char_poly_erase_mat: fixes A :: "'a :: idom ^ 'n ^ 'n" 
   shows "monom 1 1 * pderiv (charpoly A) = sum (\<lambda> i. charpoly (erase_mat A i i)) UNIV" 
 proof -
   let ?A = "from_hma\<^sub>m A" 
   let ?n = "CARD('n)" 
   have tA[transfer_rule]: "HMA_M ?A A" unfolding HMA_M_def by simp
   have tN[transfer_rule]: "HMA_T ?n TYPE('n)" unfolding HMA_T_def by simp
   have A: "?A \<in> carrier_mat ?n ?n" unfolding from_hma\<^sub>m_def by auto
   have id: "sum (\<lambda> i. charpoly (erase_mat A i i)) UNIV = 
     sum_UNIV_type (\<lambda> i. charpoly (erase_mat A i i)) TYPE('n)"
     unfolding sum_UNIV_type_def ..
   show ?thesis unfolding id
     by (transfer, insert pderiv_char_poly_mat_erase[OF A], simp add: sum_UNIV_set_def)
 qed
 
 lemma degree_monic_charpoly: fixes A :: "'a :: comm_ring_1 ^ 'n ^ 'n" 
   shows "degree (charpoly A) = CARD('n) \<and> monic (charpoly A)" 
 proof (transfer, goal_cases)
   case 1
   from degree_monic_char_poly[OF 1] show ?case by auto
 qed
 
 end
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,2346 @@
 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
   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)
 
 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) 
     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) 
   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)
     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
     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 signof_def sign_def)
+    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
       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)
       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
     then have "conjugate c = c" 
       using Reals_cnj_iff complex_is_Real_iff 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
   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 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
 
 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)
     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
 
 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
     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/Smith_Normal_Form/Mod_Type_Connect.thy b/thys/Smith_Normal_Form/Mod_Type_Connect.thy
--- a/thys/Smith_Normal_Form/Mod_Type_Connect.thy
+++ b/thys/Smith_Normal_Form/Mod_Type_Connect.thy
@@ -1,583 +1,583 @@
 (*
   Author: Jose Divasón
   Email:  jose.divason@unirioja.es
 *)
 
 section \<open>A new bridge to convert theorems from JNF to HOL Analysis and vice-versa, 
 based on the @{text "mod_type"} class\<close>
 
 theory Mod_Type_Connect
   imports 
           Perron_Frobenius.HMA_Connect
           Rank_Nullity_Theorem.Mod_Type
           Gauss_Jordan.Elementary_Operations
 begin
 
 text \<open>Some lemmas on @{text "Mod_Type.to_nat"} and @{text "Mod_Type.from_nat"} are added to have 
 them with the same names as the analogous ones for @{text "Bij_Nat.to_nat"} 
 and @{text "Bij_Nat.to_nat"}.\<close>
 
 lemma inj_to_nat: "inj to_nat" by (simp add: inj_on_def)
 lemmas from_nat_inj = from_nat_eq_imp_eq
 lemma range_to_nat: "range (to_nat :: 'a :: mod_type \<Rightarrow> nat) = {0 ..< CARD('a)}"
   by (simp add: bij_betw_imp_surj_on mod_type_class.bij_to_nat)
 
 
 text \<open>This theory is an adaptation of the one presented in @{text "Perron_Frobenius.HMA_Connect"},
   but for matrices and vectors where indexes have the @{text "mod_type"} class restriction.
 
   It is worth noting that some definitions still use the old abbreviation for HOL Analysis 
   (HMA, from HOL Multivariate Analysis) instead of HA. This is done to be consistent with 
   the existing names in the Perron-Frobenius development\<close>
 
 context includes vec.lifting 
 begin
 end
 
 definition from_hma\<^sub>v :: "'a ^ 'n :: mod_type \<Rightarrow> 'a Matrix.vec" where
   "from_hma\<^sub>v v = Matrix.vec CARD('n) (\<lambda> i. v $h from_nat i)"
 
 definition from_hma\<^sub>m :: "'a ^ 'nc :: mod_type ^ 'nr :: mod_type \<Rightarrow> 'a Matrix.mat" where
   "from_hma\<^sub>m a = Matrix.mat CARD('nr) CARD('nc) (\<lambda> (i,j). a $h from_nat i $h from_nat j)"
 
 definition to_hma\<^sub>v :: "'a Matrix.vec \<Rightarrow> 'a ^ 'n :: mod_type" where
   "to_hma\<^sub>v v = (\<chi> i. v $v to_nat i)"
 
 definition to_hma\<^sub>m :: "'a Matrix.mat \<Rightarrow> 'a ^ 'nc :: mod_type ^ 'nr :: mod_type " where
   "to_hma\<^sub>m a = (\<chi> i j. a $$ (to_nat i, to_nat j))"
 
 lemma to_hma_from_hma\<^sub>v[simp]: "to_hma\<^sub>v (from_hma\<^sub>v v) = v"
   by (auto simp: to_hma\<^sub>v_def from_hma\<^sub>v_def to_nat_less_card)
 
 lemma to_hma_from_hma\<^sub>m[simp]: "to_hma\<^sub>m (from_hma\<^sub>m v) = v"
   by (auto simp: to_hma\<^sub>m_def from_hma\<^sub>m_def to_nat_less_card)
 
 lemma from_hma_to_hma\<^sub>v[simp]:
   "v \<in> carrier_vec (CARD('n)) \<Longrightarrow> from_hma\<^sub>v (to_hma\<^sub>v v :: 'a ^ 'n :: mod_type) = v"
   by (auto simp: to_hma\<^sub>v_def from_hma\<^sub>v_def to_nat_from_nat_id)
 
 lemma from_hma_to_hma\<^sub>m[simp]:
   "A \<in> carrier_mat (CARD('nr)) (CARD('nc)) \<Longrightarrow> from_hma\<^sub>m (to_hma\<^sub>m A :: 'a ^ 'nc :: mod_type  ^ 'nr :: mod_type) = A"
   by (auto simp: to_hma\<^sub>m_def from_hma\<^sub>m_def to_nat_from_nat_id)
 
 lemma from_hma\<^sub>v_inj[simp]: "from_hma\<^sub>v x = from_hma\<^sub>v y \<longleftrightarrow> x = y"
   by (intro iffI, insert to_hma_from_hma\<^sub>v[of x], auto)
 
 lemma from_hma\<^sub>m_inj[simp]: "from_hma\<^sub>m x = from_hma\<^sub>m y \<longleftrightarrow> x = y"
   by(intro iffI, insert to_hma_from_hma\<^sub>m[of x], auto)
 
 definition HMA_V :: "'a Matrix.vec \<Rightarrow> 'a ^ 'n :: mod_type \<Rightarrow> bool" where 
   "HMA_V = (\<lambda> v w. v = from_hma\<^sub>v w)"
 
 definition HMA_M :: "'a Matrix.mat \<Rightarrow> 'a ^ 'nc :: mod_type ^ 'nr :: mod_type  \<Rightarrow> bool" where 
   "HMA_M = (\<lambda> a b. a = from_hma\<^sub>m b)"
 
 definition HMA_I :: "nat \<Rightarrow> 'n :: mod_type \<Rightarrow> bool" where
   "HMA_I = (\<lambda> i a. i = to_nat a)"
 
 
 
 context includes lifting_syntax
 begin
 
 lemma Domainp_HMA_V [transfer_domain_rule]: 
   "Domainp (HMA_V :: 'a Matrix.vec \<Rightarrow> 'a ^ 'n :: mod_type \<Rightarrow> bool) = (\<lambda> v. v \<in> carrier_vec (CARD('n )))"
   by(intro ext iffI, insert from_hma_to_hma\<^sub>v[symmetric], auto simp: from_hma\<^sub>v_def HMA_V_def)
 
 lemma Domainp_HMA_M [transfer_domain_rule]: 
   "Domainp (HMA_M :: 'a Matrix.mat \<Rightarrow> 'a ^ 'nc :: mod_type  ^ 'nr :: mod_type \<Rightarrow> bool) 
   = (\<lambda> A. A \<in> carrier_mat CARD('nr) CARD('nc))"
   by (intro ext iffI, insert from_hma_to_hma\<^sub>m[symmetric], auto simp: from_hma\<^sub>m_def HMA_M_def)
 
 lemma Domainp_HMA_I [transfer_domain_rule]: 
   "Domainp (HMA_I :: nat \<Rightarrow> 'n :: mod_type \<Rightarrow> bool) = (\<lambda> i. i < CARD('n))" (is "?l = ?r")
 proof (intro ext)
   fix i :: nat
   show "?l i = ?r i"
     unfolding HMA_I_def Domainp_iff
     by (auto intro: exI[of _ "from_nat i"] simp: to_nat_from_nat_id to_nat_less_card)
 qed
 
 lemma bi_unique_HMA_V [transfer_rule]: "bi_unique HMA_V" "left_unique HMA_V" "right_unique HMA_V"
   unfolding HMA_V_def bi_unique_def left_unique_def right_unique_def by auto
 
 lemma bi_unique_HMA_M [transfer_rule]: "bi_unique HMA_M" "left_unique HMA_M" "right_unique HMA_M"
   unfolding HMA_M_def bi_unique_def left_unique_def right_unique_def by auto
 
 lemma bi_unique_HMA_I [transfer_rule]: "bi_unique HMA_I" "left_unique HMA_I" "right_unique HMA_I"
   unfolding HMA_I_def bi_unique_def left_unique_def right_unique_def by auto
 
 lemma right_total_HMA_V [transfer_rule]: "right_total HMA_V"
   unfolding HMA_V_def right_total_def by simp
 
 lemma right_total_HMA_M [transfer_rule]: "right_total HMA_M"
   unfolding HMA_M_def right_total_def by simp
 
 lemma right_total_HMA_I [transfer_rule]: "right_total HMA_I"
   unfolding HMA_I_def right_total_def by simp
 
 lemma HMA_V_index [transfer_rule]: "(HMA_V ===> HMA_I ===> (=)) ($v) ($h)"
   unfolding rel_fun_def HMA_V_def HMA_I_def from_hma\<^sub>v_def
   by (auto simp: to_nat_less_card)
 
 
 lemma HMA_M_index [transfer_rule]:
   "(HMA_M ===> HMA_I ===> HMA_I ===> (=)) (\<lambda> A i j. A $$ (i,j)) index_hma"
   by (intro rel_funI, simp add: index_hma_def to_nat_less_card HMA_M_def HMA_I_def from_hma\<^sub>m_def)  
 
 
 lemma HMA_V_0 [transfer_rule]: "HMA_V (0\<^sub>v CARD('n)) (0 :: 'a :: zero ^ 'n:: mod_type)"
   unfolding HMA_V_def from_hma\<^sub>v_def by auto
 
 lemma HMA_M_0 [transfer_rule]: 
   "HMA_M (0\<^sub>m CARD('nr) CARD('nc)) (0 :: 'a :: zero ^ 'nc:: mod_type  ^ 'nr :: mod_type)"
   unfolding HMA_M_def from_hma\<^sub>m_def by auto
 
 lemma HMA_M_1[transfer_rule]:
   "HMA_M (1\<^sub>m (CARD('n))) (mat 1 :: 'a::{zero,one}^'n:: mod_type^'n:: mod_type)"
   unfolding HMA_M_def
   by (auto simp add: mat_def from_hma\<^sub>m_def from_nat_inj)
  
 
 lemma from_hma\<^sub>v_add: "from_hma\<^sub>v v + from_hma\<^sub>v w = from_hma\<^sub>v (v + w)"
   unfolding from_hma\<^sub>v_def by auto
 
 lemma HMA_V_add [transfer_rule]: "(HMA_V ===> HMA_V ===> HMA_V) (+) (+) "
   unfolding rel_fun_def HMA_V_def
   by (auto simp: from_hma\<^sub>v_add)
 
 lemma from_hma\<^sub>v_diff: "from_hma\<^sub>v v - from_hma\<^sub>v w = from_hma\<^sub>v (v - w)"
   unfolding from_hma\<^sub>v_def by auto
 
 lemma HMA_V_diff [transfer_rule]: "(HMA_V ===> HMA_V ===> HMA_V) (-) (-)"
   unfolding rel_fun_def HMA_V_def
   by (auto simp: from_hma\<^sub>v_diff)
 
 lemma from_hma\<^sub>m_add: "from_hma\<^sub>m a + from_hma\<^sub>m b = from_hma\<^sub>m (a + b)"
   unfolding from_hma\<^sub>m_def by auto
 
 lemma HMA_M_add [transfer_rule]: "(HMA_M ===> HMA_M ===> HMA_M) (+) (+) "
   unfolding rel_fun_def HMA_M_def
   by (auto simp: from_hma\<^sub>m_add)
 
 lemma from_hma\<^sub>m_diff: "from_hma\<^sub>m a - from_hma\<^sub>m b = from_hma\<^sub>m (a - b)"
   unfolding from_hma\<^sub>m_def by auto
 
 lemma HMA_M_diff [transfer_rule]: "(HMA_M ===> HMA_M ===> HMA_M) (-) (-) "
   unfolding rel_fun_def HMA_M_def
   by (auto simp: from_hma\<^sub>m_diff)
 
 lemma scalar_product: fixes v :: "'a :: semiring_1 ^ 'n :: mod_type"
   shows "scalar_prod (from_hma\<^sub>v v) (from_hma\<^sub>v w) = scalar_product v w"
   unfolding scalar_product_def scalar_prod_def from_hma\<^sub>v_def dim_vec
   by (simp add: sum.reindex[OF inj_to_nat, unfolded range_to_nat])
 
 lemma [simp]:
   "from_hma\<^sub>m (y :: 'a ^ 'nc :: mod_type ^ 'nr:: mod_type) \<in> carrier_mat (CARD('nr)) (CARD('nc))"
   "dim_row (from_hma\<^sub>m (y :: 'a ^ 'nc:: mod_type  ^ 'nr :: mod_type)) = CARD('nr)"
   "dim_col (from_hma\<^sub>m (y :: 'a ^ 'nc :: mod_type ^ 'nr:: mod_type )) = CARD('nc)"
   unfolding from_hma\<^sub>m_def by simp_all
 
 lemma [simp]:
   "from_hma\<^sub>v (y :: 'a ^ 'n:: mod_type) \<in> carrier_vec (CARD('n))"
   "dim_vec (from_hma\<^sub>v (y :: 'a ^ 'n:: mod_type)) = CARD('n)"
   unfolding from_hma\<^sub>v_def by simp_all
 
 lemma HMA_scalar_prod [transfer_rule]:
   "(HMA_V ===> HMA_V ===> (=)) scalar_prod scalar_product" 
   by (auto simp: HMA_V_def scalar_product)
 
 lemma HMA_row [transfer_rule]: "(HMA_I ===> HMA_M ===> HMA_V) (\<lambda> i a. Matrix.row a i) row"
   unfolding HMA_M_def HMA_I_def HMA_V_def
   by (auto simp: from_hma\<^sub>m_def from_hma\<^sub>v_def to_nat_less_card row_def)
 
 lemma HMA_col [transfer_rule]: "(HMA_I ===> HMA_M ===> HMA_V) (\<lambda> i a. col a i) column"
   unfolding HMA_M_def HMA_I_def HMA_V_def
   by (auto simp: from_hma\<^sub>m_def from_hma\<^sub>v_def to_nat_less_card column_def)
 
 
 lemma HMA_M_mk_mat[transfer_rule]: "((HMA_I ===> HMA_I ===> (=)) ===> HMA_M) 
   (\<lambda> f. Matrix.mat (CARD('nr)) (CARD('nc)) (\<lambda> (i,j). f i j)) 
   (mk_mat :: (('nr \<Rightarrow> 'nc \<Rightarrow> 'a) \<Rightarrow> 'a^'nc:: mod_type^'nr:: mod_type))"
 proof-
   {
     fix x y i j
     assume id: "\<forall> (ya :: 'nr) (yb :: 'nc). (x (to_nat ya) (to_nat yb) :: 'a) = y ya yb"
        and i: "i < CARD('nr)" and j: "j < CARD('nc)"
     from to_nat_from_nat_id[OF i] to_nat_from_nat_id[OF j] id[rule_format, of "from_nat i" "from_nat j"]
     have "x i j = y (from_nat i) (from_nat j)" by auto
   }
   thus ?thesis
     unfolding rel_fun_def mk_mat_def HMA_M_def HMA_I_def from_hma\<^sub>m_def by auto
 qed
 
 lemma HMA_M_mk_vec[transfer_rule]: "((HMA_I ===> (=)) ===> HMA_V) 
   (\<lambda> f. Matrix.vec (CARD('n)) (\<lambda> i. f i)) 
   (mk_vec :: (('n \<Rightarrow> 'a) \<Rightarrow> 'a^'n:: mod_type))"
 proof-
   {
     fix x y i
     assume id: "\<forall> (ya :: 'n). (x (to_nat ya) :: 'a) = y ya"
        and i: "i < CARD('n)" 
     from to_nat_from_nat_id[OF i] id[rule_format, of "from_nat i"]
     have "x i = y (from_nat i)" by auto
   }
   thus ?thesis
     unfolding rel_fun_def mk_vec_def HMA_V_def HMA_I_def from_hma\<^sub>v_def by auto
 qed
 
 
 lemma mat_mult_scalar: "A ** B = mk_mat (\<lambda> i j. scalar_product (row i A) (column j B))"
   unfolding vec_eq_iff matrix_matrix_mult_def scalar_product_def mk_mat_def
   by (auto simp: row_def column_def)
 
 lemma mult_mat_vec_scalar: "A *v v = mk_vec (\<lambda> i. scalar_product (row i A) v)"
   unfolding vec_eq_iff matrix_vector_mult_def scalar_product_def mk_mat_def mk_vec_def
   by (auto simp: row_def column_def)
 
 lemma dim_row_transfer_rule: 
   "HMA_M A (A' :: 'a ^ 'nc:: mod_type ^ 'nr:: mod_type) \<Longrightarrow> (=) (dim_row A) (CARD('nr))"
   unfolding HMA_M_def by auto
 
 lemma dim_col_transfer_rule: 
   "HMA_M A (A' :: 'a ^ 'nc:: mod_type ^ 'nr:: mod_type) \<Longrightarrow> (=) (dim_col A) (CARD('nc))"
   unfolding HMA_M_def by auto
 
 
 lemma HMA_M_mult [transfer_rule]: "(HMA_M ===> HMA_M ===> HMA_M) (*) (**)"
 proof -
   {
     fix A B :: "'a :: semiring_1 mat" and A' :: "'a ^ 'n :: mod_type ^ 'nr:: mod_type" 
       and B' :: "'a ^ 'nc :: mod_type ^ 'n:: mod_type"
     assume 1[transfer_rule]: "HMA_M A A'" "HMA_M B B'"
     note [transfer_rule] = dim_row_transfer_rule[OF 1(1)] dim_col_transfer_rule[OF 1(2)]
     have "HMA_M (A * B) (A' ** B')"
       unfolding times_mat_def mat_mult_scalar
       by (transfer_prover_start, transfer_step+, transfer, auto)
   }
   thus ?thesis by blast
 qed
       
 
 lemma HMA_V_smult [transfer_rule]: "((=) ===> HMA_V ===> HMA_V) (\<cdot>\<^sub>v) (*s)"
   unfolding smult_vec_def 
   unfolding rel_fun_def HMA_V_def from_hma\<^sub>v_def
   by auto
 
 lemma HMA_M_mult_vec [transfer_rule]: "(HMA_M ===> HMA_V ===> HMA_V) (*\<^sub>v) (*v)"
 proof -
   {
     fix A :: "'a :: semiring_1 mat" and v :: "'a Matrix.vec"
       and A' :: "'a ^ 'nc :: mod_type ^ 'nr :: mod_type" and v' :: "'a ^ 'nc :: mod_type"
     assume 1[transfer_rule]: "HMA_M A A'" "HMA_V v v'"
     note [transfer_rule] = dim_row_transfer_rule
     have "HMA_V (A *\<^sub>v v) (A' *v v')"
       unfolding mult_mat_vec_def mult_mat_vec_scalar
       by (transfer_prover_start, transfer_step+, transfer, auto)
   }
   thus ?thesis by blast  
 qed
 
 
 lemma HMA_det [transfer_rule]: "(HMA_M ===> (=)) Determinant.det 
   (det :: 'a :: comm_ring_1 ^ 'n :: mod_type ^ 'n :: mod_type \<Rightarrow> 'a)"
 proof -
   {
     fix a :: "'a ^ 'n :: mod_type^ 'n:: mod_type"
     let ?tn = "to_nat :: 'n :: mod_type \<Rightarrow> nat"
     let ?fn = "from_nat :: nat \<Rightarrow> 'n"
     let ?zn = "{0..< CARD('n)}"
     let ?U = "UNIV :: 'n set"
     let ?p1 = "{p. p permutes ?zn}"
     let ?p2 = "{p. p permutes ?U}"  
     let ?f= "\<lambda> p i. if i \<in> ?U then ?fn (p (?tn i)) else i"
     let ?g = "\<lambda> p i. ?fn (p (?tn i))"
     have fg: "\<And> a b c. (if a \<in> ?U then b else c) = b" by auto
     have "?p2 = ?f ` ?p1" 
       by (rule permutes_bij', auto simp: to_nat_less_card to_nat_from_nat_id)
     hence id: "?p2 = ?g ` ?p1" by simp
     have inj_g: "inj_on ?g ?p1"
       unfolding inj_on_def
     proof (intro ballI impI ext, auto)
       fix p q i
       assume p: "p permutes ?zn" and q: "q permutes ?zn"
         and id: "(\<lambda> i. ?fn (p (?tn i))) = (\<lambda> i. ?fn (q (?tn i)))"
       {
         fix i
         from permutes_in_image[OF p] have pi: "p (?tn i) < CARD('n)" by (simp add: to_nat_less_card)
         from permutes_in_image[OF q] have qi: "q (?tn i) < CARD('n)" by (simp add: to_nat_less_card)
         from fun_cong[OF id] have "?fn (p (?tn i))  = from_nat (q (?tn i))" .
         from arg_cong[OF this, of ?tn] have "p (?tn i) = q (?tn i)"
           by (simp add: to_nat_from_nat_id pi qi)
       } note id = this             
       show "p i = q i"
       proof (cases "i < CARD('n)")
         case True
         hence "?tn (?fn i) = i" by (simp add: to_nat_from_nat_id)
         from id[of "?fn i", unfolded this] show ?thesis .
       next
         case False
         thus ?thesis using p q unfolding permutes_def by simp
       qed
     qed
     have mult_cong: "\<And> a b c d. a = b \<Longrightarrow> c = d \<Longrightarrow> a * c = b * d" by simp
     have "sum (\<lambda> p. 
       signof p * (\<Prod>i\<in>?zn. a $h ?fn i $h ?fn (p i))) ?p1
       = sum (\<lambda> p. of_int (sign p) * (\<Prod>i\<in>UNIV. a $h i $h p i)) ?p2"
       unfolding id sum.reindex[OF inj_g]
     proof (rule sum.cong[OF refl], unfold mem_Collect_eq o_def, rule mult_cong)
       fix p
       assume p: "p permutes ?zn"
       let ?q = "\<lambda> i. ?fn (p (?tn i))"
       from id p have q: "?q permutes ?U" by auto
       from p have pp: "permutation p" unfolding permutation_permutes by auto
       let ?ft = "\<lambda> p i. ?fn (p (?tn i))"
       have fin: "finite ?zn" by simp
       have "sign p = sign ?q \<and> p permutes ?zn"
       using p fin proof (induction rule: permutes_induct)
         case id
         show ?case by (auto simp: sign_id[unfolded id_def] permutes_id[unfolded id_def])
       next
         case (swap a b p)
         then have \<open>permutation p\<close>
           using permutes_imp_permutation by blast 
         let ?sab = "Fun.swap a b id"
         let ?sfab = "Fun.swap (?fn a) (?fn b) id"
         have p_sab: "permutation ?sab" by (rule permutation_swap_id)
         have p_sfab: "permutation ?sfab" by (rule permutation_swap_id)
         from swap(4) have IH1: "p permutes ?zn" and IH2: "sign p = sign (?ft p)" by auto
         have sab_perm: "?sab permutes ?zn" using swap(1-2) by (rule permutes_swap_id)
         from permutes_compose[OF IH1 this] have perm1: "?sab o p permutes ?zn" .
         from IH1 have p_p1: "p \<in> ?p1" by simp
         hence "?ft p \<in> ?ft ` ?p1" by (rule imageI)
         from this[folded id] have "?ft p permutes ?U" by simp
         hence p_ftp: "permutation (?ft p)" unfolding permutation_permutes by auto
         {
           fix a b
           assume a: "a \<in> ?zn" and b: "b \<in> ?zn" 
           hence "(?fn a = ?fn b) = (a = b)" using swap(1-2)
             by (auto simp add: from_nat_eq_imp_eq)
         } note inj = this
         from inj[OF swap(1-2)] have id2: "sign ?sfab = sign ?sab" unfolding sign_swap_id by simp
         have id: "?ft (Fun.swap a b id \<circ> p) = Fun.swap (?fn a) (?fn b) id \<circ> ?ft p"
         proof
           fix c 
           show "?ft (Fun.swap a b id \<circ> p) c = (Fun.swap (?fn a) (?fn b) id \<circ> ?ft p) c"
           proof (cases "p (?tn c) = a \<or> p (?tn c) = b")
             case True
             thus ?thesis by (cases, auto simp add: o_def swap_id_eq)
           next
             case False
             hence neq: "p (?tn c) \<noteq> a" "p (?tn c) \<noteq> b" by auto
             have pc: "p (?tn c) \<in> ?zn" unfolding permutes_in_image[OF IH1] 
               by (simp add: to_nat_less_card)
             from neq[folded inj[OF pc swap(1)] inj[OF pc swap(2)]]
             have "?fn (p (?tn c)) \<noteq> ?fn a" "?fn (p (?tn c)) \<noteq> ?fn b" .
             with neq show ?thesis by (auto simp: o_def swap_id_eq)
           qed
         qed
         show ?case unfolding IH2 id sign_compose[OF p_sab \<open>permutation p\<close>] sign_compose[OF p_sfab p_ftp] id2 
           by (rule conjI[OF refl perm1])
       qed
-      thus "signof p = of_int (sign ?q)" unfolding signof_def sign_def by auto
+      thus "signof p = of_int (sign ?q)" by simp
       show "(\<Prod>i = 0..<CARD('n). a $h ?fn i $h ?fn (p i)) =
            (\<Prod>i\<in>UNIV. a $h i $h ?q i)" unfolding 
            range_to_nat[symmetric] prod.reindex[OF inj_to_nat]
             by (rule prod.cong[OF refl], unfold o_def, simp)
     qed   
   }
   thus ?thesis unfolding HMA_M_def 
     by (auto simp: from_hma\<^sub>m_def Determinant.det_def det_def)
 qed
 
 lemma HMA_mat[transfer_rule]: "((=) ===> HMA_M) (\<lambda> k. k \<cdot>\<^sub>m 1\<^sub>m CARD('n)) 
   (Finite_Cartesian_Product.mat :: 'a::semiring_1 \<Rightarrow> 'a^'n :: mod_type^'n :: mod_type)"
   unfolding Finite_Cartesian_Product.mat_def[abs_def] rel_fun_def HMA_M_def
   by (auto simp: from_hma\<^sub>m_def from_nat_inj)
 
 
 lemma HMA_mat_minus[transfer_rule]: "(HMA_M ===> HMA_M ===> HMA_M) 
   (\<lambda> A B. A + map_mat uminus B) ((-) :: 'a :: group_add ^'nc:: mod_type^'nr:: mod_type 
   \<Rightarrow> 'a^'nc:: mod_type^'nr:: mod_type \<Rightarrow> 'a^'nc:: mod_type^'nr:: mod_type)"
   unfolding rel_fun_def HMA_M_def from_hma\<^sub>m_def by auto
 
 lemma HMA_transpose_matrix [transfer_rule]: 
   "(HMA_M ===> HMA_M) transpose_mat transpose"
   unfolding transpose_mat_def transpose_def HMA_M_def from_hma\<^sub>m_def by auto
 
 
 lemma HMA_invertible_matrix_mod_type[transfer_rule]: 
   "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: comm_ring_1 ^ 'n :: mod_type ^ 'n :: mod_type 
       \<Rightarrow> _) ===> (=)) invertible_mat invertible" 
 proof (intro rel_funI, goal_cases)
   case (1 x y)
   note rel_xy[transfer_rule] = "1"
   have eq_dim: "dim_col x = dim_row x"
     using Mod_Type_Connect.dim_col_transfer_rule Mod_Type_Connect.dim_row_transfer_rule rel_xy 
     by fastforce    
   moreover have "\<exists>A'. y ** A' = mat 1 \<and> A' ** y = mat 1" 
     if xB: "x * B = 1\<^sub>m (dim_row x)" and Bx: "B * x = 1\<^sub>m (dim_row B)" for B
   proof -
     let ?A' = "Mod_Type_Connect.to_hma\<^sub>m B:: 'a :: comm_ring_1 ^ 'n :: mod_type^ 'n :: mod_type" 
     have rel_BA[transfer_rule]: "Mod_Type_Connect.HMA_M B ?A'"
       by (metis (no_types, lifting) Bx Mod_Type_Connect.HMA_M_def eq_dim carrier_mat_triv dim_col_mat(1)
           Mod_Type_Connect.from_hma\<^sub>m_def Mod_Type_Connect.from_hma_to_hma\<^sub>m index_mult_mat(3) 
           index_one_mat(3) rel_xy xB)
     have [simp]: "dim_row B = CARD('n)" using Mod_Type_Connect.dim_row_transfer_rule rel_BA by blast
     have [simp]: "dim_row x = CARD('n)" using Mod_Type_Connect.dim_row_transfer_rule rel_xy by blast
     have "y ** ?A' = mat 1" using xB by (transfer, simp)
     moreover have "?A' ** y  = mat 1" using Bx by (transfer, simp)
     ultimately show ?thesis by blast
   qed
   moreover have "\<exists>B. x * B = 1\<^sub>m (dim_row x) \<and> B * x = 1\<^sub>m (dim_row B)"
     if yA: "y ** A' = mat 1" and Ay: "A' ** y = mat 1" for A'
   proof -
     let ?B = "(Mod_Type_Connect.from_hma\<^sub>m A')"
     have [simp]: "dim_row x = CARD('n)" using rel_xy Mod_Type_Connect.dim_row_transfer_rule by blast
     have [transfer_rule]: "Mod_Type_Connect.HMA_M ?B A'" by (simp add: Mod_Type_Connect.HMA_M_def)
     hence [simp]: "dim_row ?B = CARD('n)" using dim_row_transfer_rule by auto
     have "x * ?B = 1\<^sub>m (dim_row x)" using yA by (transfer', auto)
     moreover have "?B * x = 1\<^sub>m (dim_row ?B)" using Ay by (transfer', auto)
     ultimately show ?thesis by auto
   qed
   ultimately show ?case unfolding invertible_mat_def invertible_def inverts_mat_def by auto
 qed
 
 
 end
 
 
 text \<open>Some transfer rules for relating the elementary operations are also proved.\<close>
 
 context
   includes lifting_syntax
 begin
 
 lemma HMA_swaprows[transfer_rule]: 
   "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: comm_ring_1 ^ 'nc :: mod_type ^ 'nr :: mod_type \<Rightarrow> _)
     ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow>'nr :: mod_type \<Rightarrow> _ )
     ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow>'nr :: mod_type \<Rightarrow> _ )     
     ===> Mod_Type_Connect.HMA_M) 
     (\<lambda>A a b. swaprows a b A) interchange_rows" 
   by (intro rel_funI, goal_cases, auto simp add: Mod_Type_Connect.HMA_M_def interchange_rows_def)
      (rule eq_matI, auto simp add: Mod_Type_Connect.from_hma\<^sub>m_def Mod_Type_Connect.HMA_I_def 
       to_nat_less_card to_nat_from_nat_id)
 
 lemma HMA_swapcols[transfer_rule]: 
   "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: comm_ring_1 ^ 'nc :: mod_type ^ 'nr :: mod_type \<Rightarrow> _)
     ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow>'nc :: mod_type \<Rightarrow> _ )
     ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow>'nc :: mod_type \<Rightarrow> _ )     
     ===> Mod_Type_Connect.HMA_M) 
     (\<lambda>A a b. swapcols a b A) interchange_columns" 
   by (intro rel_funI, goal_cases, auto simp add: Mod_Type_Connect.HMA_M_def interchange_columns_def)
      (rule eq_matI, auto simp add: Mod_Type_Connect.from_hma\<^sub>m_def Mod_Type_Connect.HMA_I_def 
       to_nat_less_card to_nat_from_nat_id)
 
 lemma HMA_addrow[transfer_rule]: 
   "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: comm_ring_1 ^ 'nc :: mod_type ^ 'nr :: mod_type \<Rightarrow> _) 
     ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow>'nr :: mod_type \<Rightarrow> _ )
     ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow>'nr :: mod_type \<Rightarrow> _ ) 
     ===> (=)
     ===> Mod_Type_Connect.HMA_M) 
     (\<lambda>A a b q. addrow q a b A) row_add"
   by (intro rel_funI, goal_cases, auto simp add: Mod_Type_Connect.HMA_M_def row_add_def)
      (rule eq_matI, auto simp add: Mod_Type_Connect.from_hma\<^sub>m_def Mod_Type_Connect.HMA_I_def 
       to_nat_less_card to_nat_from_nat_id)
 
 lemma HMA_addcol[transfer_rule]: 
   "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: comm_ring_1 ^ 'nc :: mod_type ^ 'nr :: mod_type \<Rightarrow> _) 
     ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow>'nc :: mod_type \<Rightarrow> _ )
     ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow>'nc :: mod_type \<Rightarrow> _ ) 
     ===> (=)
     ===> Mod_Type_Connect.HMA_M) 
     (\<lambda>A a b q. addcol q a b A) column_add"
   by (intro rel_funI, goal_cases, auto simp add: Mod_Type_Connect.HMA_M_def column_add_def)
      (rule eq_matI, auto simp add: Mod_Type_Connect.from_hma\<^sub>m_def Mod_Type_Connect.HMA_I_def 
       to_nat_less_card to_nat_from_nat_id)
 
 lemma HMA_multrow[transfer_rule]: 
   "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: comm_ring_1 ^ 'nc :: mod_type ^ 'nr :: mod_type \<Rightarrow> _)
     ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow>'nr :: mod_type \<Rightarrow> _ )
     ===> (=)     
     ===> Mod_Type_Connect.HMA_M) 
     (\<lambda>A i q. multrow i q A) mult_row"
   by (intro rel_funI, goal_cases, auto simp add: Mod_Type_Connect.HMA_M_def mult_row_def)
      (rule eq_matI, auto simp add: Mod_Type_Connect.from_hma\<^sub>m_def Mod_Type_Connect.HMA_I_def 
       to_nat_less_card to_nat_from_nat_id)
 
 lemma HMA_multcol[transfer_rule]: 
   "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: comm_ring_1 ^ 'nc :: mod_type ^ 'nr :: mod_type \<Rightarrow> _)
     ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow>'nc :: mod_type \<Rightarrow> _ )
     ===> (=)     
     ===> Mod_Type_Connect.HMA_M) 
     (\<lambda>A i q. multcol i q A) mult_column"
   by (intro rel_funI, goal_cases, auto simp add: Mod_Type_Connect.HMA_M_def mult_column_def)
      (rule eq_matI, auto simp add: Mod_Type_Connect.from_hma\<^sub>m_def Mod_Type_Connect.HMA_I_def 
       to_nat_less_card to_nat_from_nat_id)
 
 end
 
 fun HMA_M3 where
   "HMA_M3 (P,A,Q) 
   (P' :: 'a :: comm_ring_1 ^ 'nr :: mod_type ^ 'nr :: mod_type,
    A' :: 'a ^ 'nc :: mod_type ^ 'nr :: mod_type,
    Q' :: 'a ^ 'nc :: mod_type ^ 'nc :: mod_type) = 
   (Mod_Type_Connect.HMA_M P P' \<and> Mod_Type_Connect.HMA_M A A' \<and> Mod_Type_Connect.HMA_M Q Q')"
 
 lemma HMA_M3_def: 
   "HMA_M3 A B = (Mod_Type_Connect.HMA_M (fst A) (fst B) 
   \<and> Mod_Type_Connect.HMA_M (fst (snd A)) (fst (snd B)) 
   \<and> Mod_Type_Connect.HMA_M (snd (snd A)) (snd (snd B)))"  
   by (smt HMA_M3.simps prod.collapse)
 
 
 context 
   includes lifting_syntax
 begin
 
 lemma Domainp_HMA_M3 [transfer_domain_rule]: 
  "Domainp (HMA_M3 :: _\<Rightarrow>(_\<times>('a::comm_ring_1^'nc::mod_type^'nr::mod_type)\<times>_)\<Rightarrow>_) 
  = (\<lambda>(P,A,Q). P \<in> carrier_mat CARD('nr) CARD('nr) \<and> A \<in> carrier_mat CARD('nr) CARD('nc) 
   \<and> Q \<in> carrier_mat CARD('nc) CARD('nc))"
 proof -
   let ?HMA_M3 = "HMA_M3::_\<Rightarrow>(_\<times>('a::comm_ring_1^'nc::mod_type^'nr::mod_type)\<times>_)\<Rightarrow>_"
   have 1: "P \<in> carrier_mat CARD('nr) CARD('nr) \<and>
          A \<in> carrier_mat CARD('nr) CARD('nc) \<and> Q \<in> carrier_mat CARD('nc) CARD('nc)"
     if "Domainp ?HMA_M3 (P,A,Q)" for P A Q
       using that unfolding Domainp_iff by (auto simp add: Mod_Type_Connect.HMA_M_def)  
   have 2: "Domainp ?HMA_M3 (P,A,Q)" if PAQ: "P \<in> carrier_mat CARD('nr) CARD('nr)
    \<and> A \<in> carrier_mat CARD('nr) CARD('nc) \<and>Q \<in> carrier_mat CARD('nc) CARD('nc)" for P A Q
   proof -
      let ?P = "Mod_Type_Connect.to_hma\<^sub>m P::'a^'nr::mod_type^'nr::mod_type"
      let ?A = "Mod_Type_Connect.to_hma\<^sub>m A::'a^'nc::mod_type^'nr::mod_type"
      let ?Q = "Mod_Type_Connect.to_hma\<^sub>m Q::'a^'nc::mod_type^'nc::mod_type"
      have "HMA_M3 (P,A,Q) (?P,?A,?Q)"
        by (auto simp add: Mod_Type_Connect.HMA_M_def PAQ)  
      thus ?thesis unfolding Domainp_iff by auto
    qed  
    have "fst x \<in> carrier_mat CARD('nr) CARD('nr) \<and> fst (snd x) \<in> carrier_mat CARD('nr) CARD('nc) 
       \<and> (snd (snd x)) \<in> carrier_mat CARD('nc) CARD('nc)"
     if "Domainp ?HMA_M3 x" for x using 1
     by (metis (full_types) surjective_pairing that)
   moreover have "Domainp ?HMA_M3 x" 
     if "fst x \<in> carrier_mat CARD('nr) CARD('nr) \<and> fst (snd x) \<in> carrier_mat CARD('nr) CARD('nc) 
       \<and> (snd (snd x)) \<in> carrier_mat CARD('nc) CARD('nc)" for x 
     using 2
     by (metis (full_types) surjective_pairing that)
   ultimately show ?thesis by (intro ext iffI, unfold split_beta, metis+) 
 qed
 
 lemma bi_unique_HMA_M3 [transfer_rule]: "bi_unique HMA_M3" "left_unique HMA_M3" "right_unique HMA_M3"
   unfolding HMA_M3_def bi_unique_def left_unique_def right_unique_def
   by (auto simp add: Mod_Type_Connect.HMA_M_def)
 
 lemma right_total_HMA_M3 [transfer_rule]: "right_total HMA_M3"
   unfolding HMA_M_def right_total_def
   by (simp add: Mod_Type_Connect.HMA_M_def)
 
 end
 
 (*
   TODO: add more theorems to connect everything from HA to JNF in this setting.
 *)
 end
diff --git a/thys/Subresultants/Coeff_Int.thy b/thys/Subresultants/Coeff_Int.thy
--- a/thys/Subresultants/Coeff_Int.thy
+++ b/thys/Subresultants/Coeff_Int.thy
@@ -1,89 +1,89 @@
 section \<open>Polynomial coefficients with integer index\<close>
   
 text \<open>We provide a function to access the coefficients of a polynomial
   via an integer index. Then index-shifting becomes more convenient,
   e.g., compare in the lemmas for accessing the coeffiencent of a product
   with a monomial there is no special case for integer coefficients, whereas
   for natural number coefficients there is a case-distinction.\<close>
   
 theory Coeff_Int
-imports 
-  Polynomial_Interpolation.Missing_Polynomial 
-  Jordan_Normal_Form.Missing_Permutations
+  imports 
+    "HOL-Combinatorics.Permutations"
+    Polynomial_Interpolation.Missing_Polynomial 
 begin
   
 definition coeff_int :: "'a :: zero poly \<Rightarrow> int \<Rightarrow> 'a" where
   "coeff_int p i = (if i < 0 then 0 else coeff p (nat i))"
 
 lemma coeff_int_eq_0: "i < 0 \<or> i > int (degree p) \<Longrightarrow> coeff_int p i = 0"
   unfolding coeff_int_def
   by (cases "i < 0", auto intro: coeff_eq_0)
 
 lemma coeff_int_smult[simp]: "coeff_int (smult c p) i = c * coeff_int p i"
   unfolding coeff_int_def by simp
 
-lemma coeff_int_signof_mult: "coeff_int (signof x * f) i = signof x * (coeff_int f i)"
-  unfolding signof_def by (auto simp: coeff_int_def)
+lemma coeff_int_signof_mult: "coeff_int (of_int (sign x) * f) i = of_int (sign x) * coeff_int f i"
+  by (auto simp: coeff_int_def sign_def) 
 
 lemma coeff_int_sum: "coeff_int (sum p A) i = (\<Sum>x\<in>A. coeff_int (p x) i)"
   using coeff_sum[of p A "nat i"] unfolding coeff_int_def
   by (cases "i < 0", auto)
 
 lemma coeff_int_0[simp]: "coeff_int f 0 = coeff f 0" unfolding coeff_int_def by simp
 
 lemma coeff_int_monom_mult: "coeff_int (monom a d * f) i = (a * coeff_int f (i - d))"
 proof (cases "i < 0")
   case True
   thus ?thesis unfolding coeff_int_def by simp
 next
   case False
   hence "i \<ge> 0" by auto
   then obtain j where i: "i = int j" by (rule nonneg_eq_int)
   show ?thesis
   proof (cases "i \<ge> d")
     case True
     with i have "nat (int j - int d) = j - d" by auto
     with coeff_monom_mult[of a] show ?thesis unfolding coeff_int_def i
       by simp
   next
     case False
     thus ?thesis unfolding i by (simp add: coeff_int_def coeff_monom_mult)
   qed
 qed
 
 lemma coeff_prod_const: assumes "finite xs" and "y \<notin> xs"
   and "\<And> x. x \<in> xs \<Longrightarrow> degree (f x) = 0"
 shows "coeff (prod f (insert y xs)) i = prod (\<lambda> x. coeff (f x) 0) xs * coeff (f y) i"
   using assms
 proof (induct xs rule: finite_induct)
   case (insert x xs)
   from insert(2,4) have id: "insert y (insert x xs) - {x} = insert y xs" by auto
   have "prod f (insert y (insert x xs)) = f x * prod f (insert y xs)"
     by (subst prod.remove[of _ x], insert insert(1,2) id, auto)
   hence "coeff (prod f (insert y (insert x xs))) i = coeff (f x * prod f (insert y xs)) i" by simp
   also have "\<dots> = coeff (f x) 0 * (coeff (prod f (insert y xs)) i)"
   proof -
     from insert(5)[of x] degree0_coeffs[of "f x"] obtain c where fx: "f x = [: c :]" by auto
     show ?thesis unfolding fx by auto
   qed
   also have "(coeff (prod f (insert y xs)) i) = (\<Prod>x\<in>xs. coeff (f x) 0) * coeff (f y) i" using insert by auto
   also have "coeff (f x) 0 * \<dots> = prod (\<lambda> x. coeff (f x) 0) (insert x xs) * coeff (f y) i"
     by (subst prod.insert_remove, insert insert(1,2,4), auto simp: ac_simps)
   finally show ?case .
 qed simp
 
 lemma coeff_int_prod_const: assumes "finite xs" and "y \<notin> xs"
   and "\<And> x. x \<in> xs \<Longrightarrow> degree (f x) = 0"
 shows "coeff_int (prod f (insert y xs)) i = prod (\<lambda> x. coeff_int (f x) 0) xs * coeff_int (f y) i"
   using coeff_prod_const[OF assms] unfolding coeff_int_def by (cases "i < 0", auto)
 
 lemma coeff_int[simp]: "coeff_int p n = coeff p n"  unfolding coeff_int_def by auto
 
 lemma coeff_int_minus[simp]:
   "coeff_int (a - b) i = coeff_int a i - coeff_int b i"
   by (auto simp: coeff_int_def)
 
 lemma coeff_int_pCons_0[simp]: "coeff_int (pCons 0 b) i = coeff_int b (i - 1)"
   by (auto simp: Nitpick.case_nat_unfold coeff_int_def coeff_pCons nat_diff_distrib')
     
 end