(*
    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
  "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)+

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

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

end


(*  Title:      HOL/Algebra/Sylow.thy
    Author:     Florian Kammueller, with new proofs by L C Paulson
*)

theory Sylow
  imports Coset Exponent
begin

text \<open>See also @{cite "Kammueller-Paulson:1999"}.\<close>

text \<open>The combinatorial argument is in theory \<open>Exponent\<close>.\<close>

lemma le_extend_mult: "\<lbrakk>0 < c; a \<le> b\<rbrakk> \<Longrightarrow> a \<le> b * c"
  for c :: nat
  by (metis divisors_zero dvd_triv_left leI less_le_trans nat_dvd_not_less zero_less_iff_neq_zero)

locale sylow = group +
  fixes p and a and m and calM and RelM
  assumes prime_p: "prime p"
    and order_G: "order G = (p^a) * m"
    and finite_G[iff]: "finite (carrier G)"
  defines "calM \<equiv> {s. s \<subseteq> carrier G \<and> card s = p^a}"
    and "RelM \<equiv> {(N1, N2). N1 \<in> calM \<and> N2 \<in> calM \<and> (\<exists>g \<in> carrier G. N1 = N2 #> g)}"
begin

lemma RelM_refl_on: "refl_on calM RelM"
  by (auto simp: refl_on_def RelM_def calM_def) (blast intro!: coset_mult_one [symmetric])

lemma RelM_sym: "sym RelM"
proof (unfold sym_def RelM_def, clarify)
  fix y g
  assume "y \<in> calM"
    and g: "g \<in> carrier G"
  then have "y = y #> g #> (inv g)"
    by (simp add: coset_mult_assoc calM_def)
  then show "\<exists>g'\<in>carrier G. y = y #> g #> g'"
    by (blast intro: g)
qed

lemma RelM_trans: "trans RelM"
  by (auto simp add: trans_def RelM_def calM_def coset_mult_assoc)

lemma RelM_equiv: "equiv calM RelM"
  unfolding equiv_def by (blast intro: RelM_refl_on RelM_sym RelM_trans)

lemma M_subset_calM_prep: "M' \<in> calM // RelM  \<Longrightarrow> M' \<subseteq> calM"
  unfolding RelM_def by (blast elim!: quotientE)

end

subsection \<open>Main Part of the Proof\<close>

locale sylow_central = sylow +
  fixes H and M1 and M
  assumes M_in_quot: "M \<in> calM // RelM"
    and not_dvd_M: "\<not> (p ^ Suc (multiplicity p m) dvd card M)"
    and M1_in_M: "M1 \<in> M"
  defines "H \<equiv> {g. g \<in> carrier G \<and> M1 #> g = M1}"
begin

lemma M_subset_calM: "M \<subseteq> calM"
  by (rule M_in_quot [THEN M_subset_calM_prep])

lemma card_M1: "card M1 = p^a"
  using M1_in_M M_subset_calM calM_def by blast

lemma exists_x_in_M1: "\<exists>x. x \<in> M1"
  using prime_p [THEN prime_gt_Suc_0_nat] card_M1
  by (metis Suc_lessD card_eq_0_iff empty_subsetI equalityI gr_implies_not0 nat_zero_less_power_iff subsetI)

lemma M1_subset_G [simp]: "M1 \<subseteq> carrier G"
  using M1_in_M M_subset_calM calM_def mem_Collect_eq subsetCE by blast

lemma M1_inj_H: "\<exists>f \<in> H\<rightarrow>M1. inj_on f H"
proof -
  from exists_x_in_M1 obtain m1 where m1M: "m1 \<in> M1"..
  have m1: "m1 \<in> carrier G"
    by (simp add: m1M M1_subset_G [THEN subsetD])
  show ?thesis
  proof
    show "inj_on (\<lambda>z\<in>H. m1 \<otimes> z) H"
      by (simp add: H_def inj_on_def m1)
    show "restrict ((\<otimes>) m1) H \<in> H \<rightarrow> M1"
    proof (rule restrictI)
      fix z
      assume zH: "z \<in> H"
      show "m1 \<otimes> z \<in> M1"
      proof -
        from zH
        have zG: "z \<in> carrier G" and M1zeq: "M1 #> z = M1"
          by (auto simp add: H_def)
        show ?thesis
          by (rule subst [OF M1zeq]) (simp add: m1M zG rcosI)
      qed
    qed
  qed
qed

end

subsection \<open>Discharging the Assumptions of \<open>sylow_central\<close>\<close>

context sylow
begin

lemma EmptyNotInEquivSet: "{} \<notin> calM // RelM"
  by (blast elim!: quotientE dest: RelM_equiv [THEN equiv_class_self])

lemma existsM1inM: "M \<in> calM // RelM \<Longrightarrow> \<exists>M1. M1 \<in> M"
  using RelM_equiv equiv_Eps_in by blast

lemma zero_less_o_G: "0 < order G"
  by (simp add: order_def card_gt_0_iff carrier_not_empty)

lemma zero_less_m: "m > 0"
  using zero_less_o_G by (simp add: order_G)

lemma card_calM: "card calM = (p^a) * m choose p^a"
  by (simp add: calM_def n_subsets order_G [symmetric] order_def)

lemma zero_less_card_calM: "card calM > 0"
  by (simp add: card_calM zero_less_binomial le_extend_mult zero_less_m)

lemma max_p_div_calM: "\<not> (p ^ Suc (multiplicity p m) dvd card calM)"
proof
  assume "p ^ Suc (multiplicity p m) dvd card calM"
  with zero_less_card_calM prime_p
  have "Suc (multiplicity p m) \<le> multiplicity p (card calM)"
    by (intro multiplicity_geI) auto
  then have "multiplicity p m < multiplicity p (card calM)" by simp
  also have "multiplicity p m = multiplicity p (card calM)"
    by (simp add: const_p_fac prime_p zero_less_m card_calM)
  finally show False by simp
qed

lemma finite_calM: "finite calM"
  unfolding calM_def by (rule finite_subset [where B = "Pow (carrier G)"]) auto

lemma lemma_A1: "\<exists>M \<in> calM // RelM. \<not> (p ^ Suc (multiplicity p m) dvd card M)"
  using RelM_equiv equiv_imp_dvd_card finite_calM max_p_div_calM by blast

end

subsubsection \<open>Introduction and Destruct Rules for \<open>H\<close>\<close>

context sylow_central
begin

lemma H_I: "\<lbrakk>g \<in> carrier G; M1 #> g = M1\<rbrakk> \<Longrightarrow> g \<in> H"
  by (simp add: H_def)

lemma H_into_carrier_G: "x \<in> H \<Longrightarrow> x \<in> carrier G"
  by (simp add: H_def)

lemma in_H_imp_eq: "g \<in> H \<Longrightarrow> M1 #> g = M1"
  by (simp add: H_def)

lemma H_m_closed: "\<lbrakk>x \<in> H; y \<in> H\<rbrakk> \<Longrightarrow> x \<otimes> y \<in> H"
  by (simp add: H_def coset_mult_assoc [symmetric])

lemma H_not_empty: "H \<noteq> {}"
  by (force simp add: H_def intro: exI [of _ \<one>])

lemma H_is_subgroup: "subgroup H G"
proof (rule subgroupI)
  show "H \<subseteq> carrier G"
    using H_into_carrier_G by blast
  show "\<And>a. a \<in> H \<Longrightarrow> inv a \<in> H"
    by (metis H_I H_into_carrier_G H_m_closed M1_subset_G Units_eq Units_inv_closed Units_inv_inv coset_mult_inv1 in_H_imp_eq)
  show "\<And>a b. \<lbrakk>a \<in> H; b \<in> H\<rbrakk> \<Longrightarrow> a \<otimes> b \<in> H"
    by (blast intro: H_m_closed)
qed (use H_not_empty in auto)

lemma rcosetGM1g_subset_G: "\<lbrakk>g \<in> carrier G; x \<in> M1 #> g\<rbrakk> \<Longrightarrow> x \<in> carrier G"
  by (blast intro: M1_subset_G [THEN r_coset_subset_G, THEN subsetD])

lemma finite_M1: "finite M1"
  by (rule finite_subset [OF M1_subset_G finite_G])

lemma finite_rcosetGM1g: "g \<in> carrier G \<Longrightarrow> finite (M1 #> g)"
  using rcosetGM1g_subset_G finite_G M1_subset_G cosets_finite rcosetsI by blast

lemma M1_cardeq_rcosetGM1g: "g \<in> carrier G \<Longrightarrow> card (M1 #> g) = card M1"
  by (metis M1_subset_G card_rcosets_equal rcosetsI)

lemma M1_RelM_rcosetGM1g:
  assumes "g \<in> carrier G"
  shows "(M1, M1 #> g) \<in> RelM"
proof -
  have "M1 #> g \<subseteq> carrier G"
    by (simp add: assms r_coset_subset_G)
  moreover have "card (M1 #> g) = p ^ a"
    using assms by (simp add: card_M1 M1_cardeq_rcosetGM1g)
  moreover have "\<exists>h\<in>carrier G. M1 = M1 #> g #> h"
    by (metis assms M1_subset_G coset_mult_assoc coset_mult_one r_inv_ex)
  ultimately show ?thesis
    by (simp add: RelM_def calM_def card_M1)
qed

end

subsection \<open>Equal Cardinalities of \<open>M\<close> and the Set of Cosets\<close>

text \<open>Injections between \<^term>\<open>M\<close> and \<^term>\<open>rcosets\<^bsub>G\<^esub> H\<close> show that
 their cardinalities are equal.\<close>

lemma ElemClassEquiv: "\<lbrakk>equiv A r; C \<in> A // r\<rbrakk> \<Longrightarrow> \<forall>x \<in> C. \<forall>y \<in> C. (x, y) \<in> r"
  unfolding equiv_def quotient_def sym_def trans_def by blast

context sylow_central
begin

lemma M_elem_map: "M2 \<in> M \<Longrightarrow> \<exists>g. g \<in> carrier G \<and> M1 #> g = M2"
  using M1_in_M M_in_quot [THEN RelM_equiv [THEN ElemClassEquiv]]
  by (simp add: RelM_def) (blast dest!: bspec)

lemmas M_elem_map_carrier = M_elem_map [THEN someI_ex, THEN conjunct1]

lemmas M_elem_map_eq = M_elem_map [THEN someI_ex, THEN conjunct2]

lemma M_funcset_rcosets_H:
  "(\<lambda>x\<in>M. H #> (SOME g. g \<in> carrier G \<and> M1 #> g = x)) \<in> M \<rightarrow> rcosets H"
  by (metis (lifting) H_is_subgroup M_elem_map_carrier rcosetsI restrictI subgroup.subset)

lemma inj_M_GmodH: "\<exists>f \<in> M \<rightarrow> rcosets H. inj_on f M"
proof
  let ?inv = "\<lambda>x. SOME g. g \<in> carrier G \<and> M1 #> g = x"
  show "inj_on (\<lambda>x\<in>M. H #> ?inv x) M"
  proof (rule inj_onI, simp)
    fix x y
    assume eq: "H #> ?inv x = H #> ?inv y" and xy: "x \<in> M" "y \<in> M"
    have "x = M1 #> ?inv x"
      by (simp add: M_elem_map_eq \<open>x \<in> M\<close>)
    also have "... = M1 #> ?inv y"
    proof (rule coset_mult_inv1 [OF in_H_imp_eq [OF coset_join1]])
      show "H #> ?inv x \<otimes> inv (?inv y) = H"
        by (simp add: H_into_carrier_G M_elem_map_carrier xy coset_mult_inv2 eq subsetI)
    qed (simp_all add: H_is_subgroup M_elem_map_carrier xy)
    also have "... = y"
      using M_elem_map_eq \<open>y \<in> M\<close> by simp
    finally show "x=y" .
  qed
  show "(\<lambda>x\<in>M. H #> ?inv x) \<in> M \<rightarrow> rcosets H"
    by (rule M_funcset_rcosets_H)
qed

end

subsubsection \<open>The Opposite Injection\<close>

context sylow_central
begin

lemma H_elem_map: "H1 \<in> rcosets H \<Longrightarrow> \<exists>g. g \<in> carrier G \<and> H #> g = H1"
  by (auto simp: RCOSETS_def)

lemmas H_elem_map_carrier = H_elem_map [THEN someI_ex, THEN conjunct1]

lemmas H_elem_map_eq = H_elem_map [THEN someI_ex, THEN conjunct2]

lemma rcosets_H_funcset_M:
  "(\<lambda>C \<in> rcosets H. M1 #> (SOME g. g \<in> carrier G \<and> H #> g = C)) \<in> rcosets H \<rightarrow> M"
  using in_quotient_imp_closed [OF RelM_equiv M_in_quot _  M1_RelM_rcosetGM1g]
  by (simp add: M1_in_M H_elem_map_carrier RCOSETS_def)

lemma inj_GmodH_M: "\<exists>g \<in> rcosets H\<rightarrow>M. inj_on g (rcosets H)"
proof
  let ?inv = "\<lambda>x. SOME g. g \<in> carrier G \<and> H #> g = x"
  show "inj_on (\<lambda>C\<in>rcosets H. M1 #> ?inv C) (rcosets H)"
  proof (rule inj_onI, simp)
    fix x y
    assume eq: "M1 #> ?inv x = M1 #> ?inv y" and xy: "x \<in> rcosets H" "y \<in> rcosets H"
    have "x = H #> ?inv x"
      by (simp add: H_elem_map_eq \<open>x \<in> rcosets H\<close>)
    also have "... = H #> ?inv y"
    proof (rule coset_mult_inv1 [OF coset_join2])
      show "?inv x \<otimes> inv (?inv y) \<in> carrier G"
        by (simp add: H_elem_map_carrier \<open>x \<in> rcosets H\<close> \<open>y \<in> rcosets H\<close>)
      then show "(?inv x) \<otimes> inv (?inv y) \<in> H"
        by (simp add: H_I H_elem_map_carrier xy coset_mult_inv2 eq)
      show "H \<subseteq> carrier G"
        by (simp add: H_is_subgroup subgroup.subset)
    qed (simp_all add: H_is_subgroup H_elem_map_carrier xy)
    also have "... = y"
      by (simp add: H_elem_map_eq \<open>y \<in> rcosets H\<close>)
    finally show "x=y" .
  qed
  show "(\<lambda>C\<in>rcosets H. M1 #> ?inv C) \<in> rcosets H \<rightarrow> M"
    using rcosets_H_funcset_M by blast
qed

lemma calM_subset_PowG: "calM \<subseteq> Pow (carrier G)"
  by (auto simp: calM_def)

lemma finite_M: "finite M"
  by (metis M_subset_calM finite_calM rev_finite_subset)

lemma cardMeqIndexH: "card M = card (rcosets H)"
  using inj_M_GmodH inj_GmodH_M
  by (blast intro: card_bij finite_M H_is_subgroup rcosets_subset_PowG [THEN finite_subset])

lemma index_lem: "card M * card H = order G"
  by (simp add: cardMeqIndexH lagrange H_is_subgroup)

lemma card_H_eq: "card H = p^a"
proof (rule antisym)
  show "p^a \<le> card H"
  proof (rule dvd_imp_le)
    show "p ^ a dvd card H"
      apply (rule div_combine [OF prime_imp_prime_elem[OF prime_p] not_dvd_M])
      by (simp add: index_lem multiplicity_dvd order_G power_add)
    show "0 < card H"
      by (blast intro: subgroup.finite_imp_card_positive H_is_subgroup)
  qed
next
  show "card H \<le> p^a"
    using M1_inj_H card_M1 card_inj finite_M1 by fastforce
qed

end

lemma (in sylow) sylow_thm: "\<exists>H. subgroup H G \<and> card H = p^a"
proof -
  obtain M where M: "M \<in> calM // RelM" "\<not> (p ^ Suc (multiplicity p m) dvd card M)"
    using lemma_A1 by blast
  then obtain M1 where "M1 \<in> M"
    by (metis existsM1inM)
  define H where "H \<equiv> {g. g \<in> carrier G \<and> M1 #> g = M1}"
  with M \<open>M1 \<in> M\<close>
  interpret sylow_central G p a m calM RelM H M1 M
    by unfold_locales (auto simp add: H_def calM_def RelM_def)
  show ?thesis
    using H_is_subgroup card_H_eq by blast
qed

text \<open>Needed because the locale's automatic definition refers to
  \<^term>\<open>semigroup G\<close> and \<^term>\<open>group_axioms G\<close> rather than
  simply to \<^term>\<open>group G\<close>.\<close>
lemma sylow_eq: "sylow G p a m \<longleftrightarrow> group G \<and> sylow_axioms G p a m"
  by (simp add: sylow_def group_def)

subsection \<open>Sylow's Theorem\<close>

theorem sylow_thm:
  "\<lbrakk>prime p; group G; order G = (p^a) * m; finite (carrier G)\<rbrakk>
    \<Longrightarrow> \<exists>H. subgroup H G \<and> card H = p^a"
  by (rule sylow.sylow_thm [of G p a m]) (simp add: sylow_eq sylow_axioms_def)

end


(*
    Authors:    Maximilian Haslbeck
                René Thiemann
    License:    BSD
*)
subsection \<open>Explicit Bounds for Size of Numbers that Occur During LLL Algorithm\<close>

text \<open>The LLL invariant does not contain bounds on the number that occur during the execution.
  We here strengthen the invariant so that it enforces bounds on the norms of the $f_i$ and $g_i$
  and we prove that the stronger invariant is maintained throughout the execution of the LLL algorithm.

  Based on the stronger invariant we prove bounds on the absolute values of the $\mu_{i,j}$,
  and on the absolute values of the numbers in the vectors $f_i$ and $g_i$.
  Moreover, we further show that also the denominators in all of these numbers doesn't grow to much.
  Finally, we prove that each number (i.e., numerator or denominator) during the execution
  can be represented with at most ${\cal O}(m \cdot \log(M \cdot n))$ bits, where
  $m$ is the number of input vectors, $n$ is the dimension of the input vectors,
  and $M$ is the maximum absolute value of all numbers in the input vectors.
  Hence, each arithmetic operation in the LLL algorithm can be performed in polynomial time.\<close>
theory LLL_Number_Bounds
  imports LLL
    Gram_Schmidt_Int
begin

context LLL
begin

text \<open>The bounds for the $f_i$ distinguishes whether we are inside or outside the inner for-loop.\<close>

definition f_bound :: "bool \<Rightarrow> nat \<Rightarrow> int vec list \<Rightarrow> bool" where
  "f_bound outside ii fs = (\<forall> i < m. sq_norm (fs ! i) \<le> (if i \<noteq> ii \<or> outside then int (N * m) else
     int (4 ^ (m - 1) * N ^ m * m * m)))"

definition g_bnd :: "rat \<Rightarrow> int vec list \<Rightarrow> bool" where
  "g_bnd B fs = (\<forall> i < m. sq_norm (gso fs i) \<le> B)"

definition "\<mu>_bound_row fs bnd i = (\<forall> j \<le> i. (\<mu> fs i j)^2 \<le> bnd)"
abbreviation "\<mu>_bound_row_inner fs i j \<equiv> \<mu>_bound_row fs (4 ^ (m - 1 - j) * of_nat (N ^ (m - 1) * m)) i"

definition "LLL_bound_invariant outside upw i fs =
  (LLL_invariant upw i fs \<and> f_bound outside i fs \<and> g_bound fs)"

lemma bound_invD: assumes "LLL_bound_invariant outside upw i fs"
  shows "LLL_invariant upw i fs" "f_bound outside i fs" "g_bound fs"
  using assms unfolding LLL_bound_invariant_def by auto

lemma bound_invI: assumes "LLL_invariant upw i fs" "f_bound outside i fs" "g_bound fs"
  shows "LLL_bound_invariant outside upw i fs"
  using assms unfolding LLL_bound_invariant_def by auto

lemma \<mu>_bound_rowI: assumes "\<And> j. j \<le> i \<Longrightarrow> (\<mu> fs i j)^2 \<le> bnd"
  shows "\<mu>_bound_row fs bnd i"
  using assms unfolding \<mu>_bound_row_def by auto

lemma \<mu>_bound_rowD: assumes "\<mu>_bound_row fs bnd i" "j \<le> i"
  shows "(\<mu> fs i j)^2 \<le> bnd"
  using assms unfolding \<mu>_bound_row_def by auto

lemma \<mu>_bound_row_1: assumes "\<mu>_bound_row fs bnd i"
  shows "bnd \<ge> 1"
proof -
  interpret gs1: gram_schmidt_fs n "RAT fs" .
  show ?thesis
  using \<mu>_bound_rowD[OF assms, of i]
  by (auto simp: gs1.\<mu>.simps)
qed

lemma reduced_\<mu>_bound_row: assumes red: "reduced fs i"
  and ii: "ii < i"
shows "\<mu>_bound_row fs 1 ii"
proof (intro \<mu>_bound_rowI)
  fix j
  assume "j \<le> ii"
  interpret gs1: gram_schmidt_fs n "RAT fs" .
  show "(\<mu> fs ii j)^2 \<le> 1"
  proof (cases "j < ii")
    case True
    from red[unfolded gram_schmidt_fs.reduced_def, THEN conjunct2, rule_format, OF ii True]
    have "abs (\<mu> fs ii j) \<le> 1/2" by auto
    from mult_mono[OF this this]
    show ?thesis by (auto simp: power2_eq_square)
  qed (auto simp: gs1.\<mu>.simps)
qed

lemma f_bound_True_arbitrary: assumes "f_bound True ii fs"
  shows "f_bound outside j fs"
  unfolding f_bound_def
proof (intro allI impI, rule ccontr, goal_cases)
  case (1 i)
  from 1 have nz: "\<parallel>fs ! i\<parallel>\<^sup>2 \<noteq> 0" by (auto split: if_splits)
  hence gt: "\<parallel>fs ! i\<parallel>\<^sup>2 > 0" using sq_norm_vec_ge_0[of "fs ! i"] by auto
  from assms(1)[unfolded f_bound_def, rule_format, OF 1(1)]
  have one: "\<parallel>fs ! i\<parallel>\<^sup>2 \<le> int (N * m) * 1" by auto
  from less_le_trans[OF gt one] have N0: "N \<noteq> 0" by (cases "N = 0", auto)
  note one
  also have "int (N * m) * 1 \<le> int (N * m) * int (4 ^ (m - 1) * N ^ (m - 1) * m)"
    by (rule mult_left_mono, unfold of_nat_mult, intro mult_ge_one, insert 1 N0, auto)
  also have "\<dots> = int (4 ^ (m - 1) * N ^ (Suc (m - 1)) * m * m)" unfolding of_nat_mult by simp
  also have "Suc (m - 1) = m" using 1 by simp
  finally show ?case using one 1 by (auto split: if_splits)
qed

context fixes fs :: "int vec list"
  assumes lin_indep: "lin_indep fs"
  and len: "length fs = m"
begin

interpretation fs: fs_int_indpt n fs
  by (standard) (use lin_indep in simp)

lemma sq_norm_fs_mu_g_bound: assumes i: "i < m"
  and mu_bound: "\<mu>_bound_row fs bnd i"
  and g_bound: "g_bound fs"
shows "of_int \<parallel>fs ! i\<parallel>\<^sup>2 \<le> of_nat (Suc i * N) * bnd"
proof -
  have "of_int \<parallel>fs ! i\<parallel>\<^sup>2 = (\<Sum>j\<leftarrow>[0..<Suc i]. (\<mu> fs i j)\<^sup>2 * \<parallel>gso fs j\<parallel>\<^sup>2)"
    by (rule fs.sq_norm_fs_via_sum_mu_gso) (use assms lin_indep len in auto)
  also have "\<dots> \<le> (\<Sum>j\<leftarrow>[0..<Suc i]. bnd * of_nat N)"
  proof (rule sum_list_ge_mono, force, unfold length_map length_upt,
    subst (1 2) nth_map_upt, force, goal_cases)
    case (1 j)
    hence ji: "j \<le> i" by auto
    from g_bound[unfolded g_bound_def] i ji
    have GB: "sq_norm (gso fs j) \<le> of_nat N" by auto
    show ?case
      by (rule mult_mono, insert \<mu>_bound_rowD[OF mu_bound ji]
          GB order.trans[OF zero_le_power2], auto)
  qed
  also have "\<dots> = of_nat (Suc i) * (bnd * of_nat N)" unfolding sum_list_triv length_upt by simp
  also have "\<dots> = of_nat (Suc i * N) * bnd" unfolding of_nat_mult by simp
  finally show ?thesis .
qed
end

lemma increase_i_bound: assumes LLL: "LLL_bound_invariant True upw i fs"
  and i: "i < m"
  and upw: "upw \<Longrightarrow> i = 0"
  and red_i: "i \<noteq> 0 \<Longrightarrow> sq_norm (gso fs (i - 1)) \<le> \<alpha> * sq_norm (gso fs i)"
shows "LLL_bound_invariant True True (Suc i) fs"
proof -
  from bound_invD[OF LLL] have LLL: "LLL_invariant upw i fs"
    and "f_bound True i fs" and gbnd: "g_bound fs" by auto
  hence fbnd: "f_bound True (Suc i) fs" by (auto simp: f_bound_def)
  from increase_i[OF LLL i upw red_i]
  have inv: "LLL_invariant True (Suc i) fs" and "LLL_measure (Suc i) fs < LLL_measure i fs" (is ?g2)
    by auto
  show "LLL_bound_invariant True True (Suc i) fs"
    by (rule bound_invI[OF inv fbnd gbnd])
qed

text \<open>Addition step preserves @{term "LLL_bound_invariant False"}\<close>

lemma basis_reduction_add_row_main_bound: assumes Linv: "LLL_bound_invariant False True i fs"
  and i: "i < m"  and j: "j < i"
  and c: "c = round (\<mu> fs i j)"
  and fs': "fs' = fs[ i := fs ! i - c \<cdot>\<^sub>v fs ! j]"
  and mu_small: "\<mu>_small_row i fs (Suc j)"
  and mu_bnd: "\<mu>_bound_row_inner fs i (Suc j)"
shows "LLL_bound_invariant False True i fs'"
  "\<mu>_bound_row_inner fs' i j"
proof (rule bound_invI)
  from bound_invD[OF Linv]
  have Linv: "LLL_invariant True i fs" and fbnd: "f_bound False i fs" and gbnd: "g_bound fs"
    by auto
  note Linvw = LLL_inv_imp_w[OF Linv]
  note main = basis_reduction_add_row_main[OF Linvw i j fs']
  note main = main(2)[OF Linv] main(3,5-)
  note main = main(1) main(2)[OF c mu_small] main(3-)
  show Linv': "LLL_invariant True i fs'" by fact
  define bnd :: rat where bnd: "bnd = 4 ^ (m - 1 - Suc j) * of_nat (N ^ (m - 1) * m)"
  note mu_bnd = mu_bnd[folded bnd]
  note inv = LLL_invD[OF Linv]
  let ?mu = "\<mu> fs"
  let ?mu' = "\<mu> fs'"
  from j have "j \<le> i" by simp
  let ?R = rat_of_int

  (* (squared) mu bound will increase at most by factor 4 *)
  have mu_bound_factor: "\<mu>_bound_row fs' (4 * bnd) i"
  proof (intro \<mu>_bound_rowI)
    fix k
    assume ki: "k \<le> i"
    from \<mu>_bound_rowD[OF mu_bnd] have bnd_i: "\<And> j. j \<le> i \<Longrightarrow> (?mu i j)^2 \<le> bnd" by auto
    have bnd_ik: "(?mu i k)\<^sup>2 \<le> bnd" using bnd_i[OF ki] by auto
    have bnd_ij: "(?mu i j)\<^sup>2 \<le> bnd" using bnd_i[OF \<open>j \<le> i\<close>] by auto
    from \<mu>_bound_row_1[OF mu_bnd] have bnd1: "bnd \<ge> 1" "bnd \<ge> 0" by auto
    show "(?mu' i k)\<^sup>2 \<le> 4 * bnd"
    proof (cases "k > j")
      case True
      show ?thesis
        by (subst main(5), (insert True ki i bnd1, auto)[3], intro order.trans[OF bnd_ik], auto)
    next
      case False
      hence kj: "k \<le> j" by auto
      show ?thesis
      proof (cases "k = j")
        case True
        have small: "abs (?mu' i k) \<le> 1/2" using main(2) j unfolding True \<mu>_small_row_def by auto
        show ?thesis using mult_mono[OF small small] using bnd1
          by (auto simp: power2_eq_square)
      next
        case False
        with kj have k_j: "k < j" by auto
        define M where "M = max (abs (?mu i k)) (max (abs (?mu i j)) (1/2))"
        have M0: "M \<ge> 0" unfolding M_def by auto
        let ?new_mu = "?mu i k - ?R c * ?mu j k"
        have "abs ?new_mu \<le> abs (?mu i k) + abs (?R c * ?mu j k)" by simp
        also have "\<dots> = abs (?mu i k) + abs (?R c) * abs (?mu j k)" unfolding abs_mult ..
        also have "\<dots> \<le> abs (?mu i k) + (abs (?mu i j) + 1/2) * (1/2)"
        proof (rule add_left_mono[OF mult_mono], unfold c)
          show "\<bar>?R (round (?mu i j))\<bar> \<le> \<bar>?mu i j\<bar> + 1 / 2" unfolding round_def by linarith
          from inv(10)[unfolded gram_schmidt_fs.reduced_def, THEN conjunct2, rule_format, OF \<open>j < i\<close> k_j]
          show "\<bar>?mu j k\<bar> \<le> 1/2" .
        qed auto
        also have "\<dots> \<le> M + (M + M) * (1/2)"
          by (rule add_mono[OF _ mult_right_mono[OF add_mono]], auto simp: M_def)
        also have "\<dots> = 2 * M" by auto
        finally have le: "abs ?new_mu \<le> 2 * M" .
        have "(?mu' i k)\<^sup>2 = ?new_mu\<^sup>2"
          by (subst main(5), insert kj False i j, auto)
        also have "\<dots> \<le> (2 * M)^2" unfolding abs_le_square_iff[symmetric] using le M0 by auto
        also have "\<dots> = 4 * M^2" by simp
        also have "\<dots> \<le> 4 * bnd"
        proof (rule mult_left_mono)
          show "M^2 \<le> bnd" using bnd_ij bnd_ik bnd1 unfolding M_def
            by (auto simp: max_def power2_eq_square)
        qed auto
        finally show ?thesis .
      qed
    qed
  qed
  also have "4 * bnd = (4 ^ (1 + (m - 1 - Suc j)) * of_nat (N ^ (m - 1) * m))" unfolding bnd
    by simp
  also have "1 + (m - 1 - Suc j) = m - 1 - j" using i j by auto
  finally show bnd: "\<mu>_bound_row_inner fs' i j" by auto

  show gbnd: "g_bound fs'" using gbnd unfolding g_bound_def
    using main(4) by auto

  note inv' = LLL_invD[OF Linv']
  show "f_bound False i fs'"
    unfolding f_bound_def
  proof (intro allI impI, goal_cases)
    case (1 jj)
    show ?case
    proof (cases "jj = i")
      case False
      with 1 fbnd[unfolded f_bound_def] have "\<parallel>fs ! jj\<parallel>\<^sup>2 \<le> int (N * m)" by auto
      thus ?thesis unfolding fs' using False 1 inv(2-) by auto
    next
      case True
      have "of_int \<parallel>fs' ! i\<parallel>\<^sup>2 = \<parallel>RAT fs' ! i\<parallel>\<^sup>2" using i inv' by (auto simp: sq_norm_of_int)
      also have "... \<le> rat_of_nat (Suc i * N) * (4 ^ (m - 1 - j) * rat_of_nat (N ^ (m - 1) * m))"
        using sq_norm_fs_mu_g_bound[OF inv'(1,6) i bnd gbnd] i inv'
        unfolding sq_norm_of_int[symmetric]
        by (auto simp: ac_simps)
      also have "\<dots> = rat_of_int ( int (Suc i * N) * (4 ^ (m - 1 - j) * (N ^ (m - 1) * m)))"
        by simp
      finally have "\<parallel>fs' ! i\<parallel>\<^sup>2 \<le> int (Suc i * N) * (4 ^ (m - 1 - j) * (N ^ (m - 1) * m))" by linarith
      also have "\<dots> = int (Suc i) * 4 ^ (m - 1 - j) * (int N ^ (Suc (m - 1))) * int m"
        unfolding of_nat_mult by (simp add: ac_simps)
      also have "\<dots> = int (Suc i) * 4 ^ (m - 1 - j) * int N ^ m * int m" using i j by simp
      also have "\<dots> \<le> int m * 4 ^ (m - 1) * int N ^ m * int m"
        by (rule mult_right_mono[OF mult_right_mono[OF mult_mono[OF _ pow_mono_exp]]], insert i, auto)
      finally have "\<parallel>fs' ! i\<parallel>\<^sup>2 \<le> int (4 ^ (m - 1) * N ^ m * m * m)" unfolding of_nat_mult by (simp add: ac_simps)
      thus ?thesis unfolding True by auto
    qed
  qed
qed
end

context LLL_with_assms
begin

subsubsection \<open>@{const LLL_bound_invariant} is maintained during execution of @{const reduce_basis}\<close>

lemma basis_reduction_add_rows_enter_bound: assumes binv: "LLL_bound_invariant True True i fs"
  and i: "i < m"
shows "LLL_bound_invariant False True i fs"
  "\<mu>_bound_row_inner fs i i"
proof (rule bound_invI)
  from bound_invD[OF binv]
  have Linv: "LLL_invariant True i fs" (is ?g1) and fbnd: "f_bound True i fs"
    and gbnd: "g_bound fs" by auto
  note Linvw = LLL_inv_imp_w[OF Linv]
  interpret fs: fs_int' n m fs_init fs
    by standard (use Linvw in auto)
  note inv = LLL_invD[OF Linv]
  show "LLL_invariant True i fs" by fact
  show fbndF: "f_bound False i fs" using f_bound_True_arbitrary[OF fbnd] .
  have N0: "N > 0" using LLL_inv_N_pos[OF Linvw gbnd] i by auto
  {
    fix j
    assume ji: "j < i"
    have "(\<mu> fs i j)\<^sup>2 \<le> gs.Gramian_determinant (RAT fs) j * \<parallel>RAT fs ! i\<parallel>\<^sup>2"
      using ji i inv by (intro fs.gs.mu_bound_Gramian_determinant) (auto)
    also have "gs.Gramian_determinant (RAT fs) j = of_int (d fs j)" unfolding d_def
      by (subst fs.of_int_Gramian_determinant, insert ji i inv(2-), auto simp: set_conv_nth)
    also have "\<parallel>RAT fs ! i\<parallel>\<^sup>2 = of_int \<parallel>fs ! i\<parallel>\<^sup>2" using i inv(2-) by (auto simp: sq_norm_of_int)
    also have "of_int (d fs j) * \<dots> \<le> rat_of_nat (N^j) * of_int \<parallel>fs ! i\<parallel>\<^sup>2"
      by (rule mult_right_mono, insert ji i d_approx[OF Linvw gbnd, of j], auto)
    also have "\<dots> \<le> rat_of_nat (N^(m-2)) * of_int (int (N * m))"
      by (intro mult_mono, unfold of_nat_le_iff of_int_le_iff, rule pow_mono_exp,
      insert fbnd[unfolded f_bound_def, rule_format, of i] N0 ji i, auto)
    also have "\<dots> = rat_of_nat (N^(m-2) * N * m)" by simp
    also have "N^(m-2) * N = N^(Suc (m - 2))" by simp
    also have "Suc (m - 2) = m - 1" using ji i by auto
    finally have "(\<mu> fs i j)\<^sup>2 \<le> of_nat (N ^ (m - 1) * m)" .
  } note mu_bound = this
  show mu_bnd: "\<mu>_bound_row_inner fs i i"
  proof (rule \<mu>_bound_rowI)
    fix j
    assume j: "j \<le> i"
    have "(\<mu> fs i j)\<^sup>2 \<le> 1 * of_nat (N ^ (m - 1) * m)"
    proof (cases "j = i")
      case False
      with mu_bound[of j] j show ?thesis by auto
    next
      case True
      show ?thesis unfolding True fs.gs.\<mu>.simps using i N0 by auto
    qed
    also have "\<dots> \<le> 4 ^ (m - 1 - i) * of_nat (N ^ (m - 1) * m)"
      by (rule mult_right_mono, auto)
    finally show "(\<mu> fs i j)\<^sup>2 \<le> 4 ^ (m - 1 - i) * rat_of_nat (N ^ (m - 1) * m)" .
  qed
  show "g_bound fs" by fact
qed

lemma basis_basis_reduction_add_rows_loop_leave:
  assumes binv: "LLL_bound_invariant False True i fs"
  and mu_small: "\<mu>_small_row i fs 0"
  and mu_bnd: "\<mu>_bound_row_inner fs i 0"
  and i: "i < m"
shows "LLL_bound_invariant True False i fs"
proof -
  note Linv = bound_invD(1)[OF binv]
  from mu_small have mu_small: "\<mu>_small fs i" unfolding \<mu>_small_row_def \<mu>_small_def by auto
  note inv = LLL_invD[OF Linv]
  interpret gs1: gram_schmidt_fs_int n "RAT fs"
    by (standard) (use inv gs.lin_indpt_list_def in \<open>auto simp add: vec_hom_Ints\<close>)
  note fbnd = bound_invD(2)[OF binv]
  note gbnd = bound_invD(3)[OF binv]
  {
    fix ii
    assume ii: "ii < m"
    have "\<parallel>fs ! ii\<parallel>\<^sup>2 \<le> int (N * m)"
    proof (cases "ii = i")
      case False
      thus ?thesis using ii fbnd[unfolded f_bound_def] by auto
    next
      case True
      have row: "\<mu>_bound_row fs 1 i"
      proof (intro \<mu>_bound_rowI)
        fix j
        assume j: "j \<le> i"
        from mu_small[unfolded \<mu>_small_def, rule_format, of j]
        have "abs (\<mu> fs i j) \<le> 1" using j unfolding \<mu>_small_def by (cases "j = i", force simp: gs1.\<mu>.simps, auto)
        from mult_mono[OF this this] show "(\<mu> fs i j)\<^sup>2 \<le> 1" by (auto simp: power2_eq_square)
      qed
      have "rat_of_int \<parallel>fs ! i\<parallel>\<^sup>2 \<le> rat_of_int (int (Suc i * N))"
        using sq_norm_fs_mu_g_bound[OF inv(1,6) i row gbnd] by auto
      hence "\<parallel>fs ! i\<parallel>\<^sup>2 \<le> int (Suc i * N)" by linarith
      also have "\<dots> = int N * int (Suc i)" unfolding of_nat_mult by simp
      also have "\<dots> \<le> int N * int m"
        by (rule mult_left_mono, insert i, auto)
      also have "\<dots> = int (N * m)" by simp
      finally show ?thesis unfolding True .
    qed
  }
  hence f_bound: "f_bound True i fs" unfolding f_bound_def by auto
  with binv show ?thesis using basis_reduction_add_row_done[OF Linv i assms(2)]
    by (auto simp: LLL_bound_invariant_def)
qed

lemma basis_reduction_add_rows_loop_bound: assumes
  binv: "LLL_bound_invariant False True i fs"
  and mu_small: "\<mu>_small_row i fs j"
  and mu_bnd: "\<mu>_bound_row_inner fs i j"
  and res: "basis_reduction_add_rows_loop i fs j = fs'"
  and i: "i < m"
  and j: "j \<le> i"
shows "LLL_bound_invariant True False i fs'"
  using assms
proof (induct j arbitrary: fs)
  case (0 fs)
  note binv = 0(1)
  from basis_basis_reduction_add_rows_loop_leave[OF 0(1-3) i] 0(4)
  show ?case by auto
next
  case (Suc j fs)
  note binv = Suc(2)
  note Linv = bound_invD(1)[OF binv]
  note Linvw = LLL_inv_imp_w[OF Linv]
  from Suc have j: "j < i" by auto
  let ?c = "round (\<mu> fs i j)"
  note step = basis_reduction_add_row_main_bound[OF Suc(2) i j refl refl Suc(3-4)]
  note step' = basis_reduction_add_row_main(2,3,5)[OF Linvw i j refl]
  note step' = step'(1)[OF Linv] step'(2-)
  show ?case
  proof (cases "?c = 0")
    case True
    note inv = LLL_invD[OF Linv]
    from inv(5)[OF i] inv(5)[of j] i j
    have id: "fs[i := fs ! i - 0 \<cdot>\<^sub>v fs ! j] = fs"
      by (intro nth_equalityI, insert inv i, auto)
    show ?thesis
      by (rule Suc(1), insert step step' id True Suc(2-), auto)
  next
    case False
    show ?thesis using Suc(1)[OF step(1) step'(2) step(2)] Suc(2-) False step'(3) by auto
  qed
qed

lemma basis_reduction_add_rows_bound: assumes
  binv: "LLL_bound_invariant True upw i fs"
  and res: "basis_reduction_add_rows upw i fs = fs'"
  and i: "i < m"
shows "LLL_bound_invariant True False i fs'"
proof -
  note def = basis_reduction_add_rows_def
  show ?thesis
  proof (cases upw)
    case False
    with res binv show ?thesis by (simp add: def)
  next
    case True
    with binv have binv: "LLL_bound_invariant True True i fs" by auto
    note start = basis_reduction_add_rows_enter_bound[OF this i]
    from res[unfolded def] True
    have "basis_reduction_add_rows_loop i fs i = fs'" by auto
    from basis_reduction_add_rows_loop_bound[OF start(1) \<mu>_small_row_refl start(2) this i le_refl]
    show ?thesis by auto
  qed
qed

lemma g_bnd_swap:
  assumes i: "i < m" "i \<noteq> 0"
  and Linv: "LLL_invariant_weak fs"
  and mu_F1_i: "\<bar>\<mu> fs i (i-1)\<bar> \<le> 1 / 2"
  and cond: "sq_norm (gso fs (i - 1)) > \<alpha> * sq_norm (gso fs i)"
  and fs'_def: "fs' = fs[i := fs ! (i - 1), i - 1 := fs ! i]"
  and g_bnd: "g_bnd B fs"
shows "g_bnd B fs'"
proof -
  note inv = LLL_inv_wD[OF Linv]
  have choice: "fs' ! k = fs ! k \<or> fs' ! k = fs ! i \<or> fs' ! k = fs ! (i - 1)" for k
    unfolding fs'_def using i inv(6) by (cases "k = i"; cases "k = i - 1", auto)

  let ?g1 = "\<lambda> i. gso fs i"
  let ?g2 = "\<lambda> i. gso fs' i"
  let ?n1 = "\<lambda> i. sq_norm (?g1 i)"
  let ?n2 = "\<lambda> i. sq_norm (?g2 i)"
  from g_bnd[unfolded g_bnd_def] have short: "\<And> k. k < m \<Longrightarrow> ?n1 k \<le> B" by auto
  from short[of "i - 1"] i
  have short_im1: "?n1 (i - 1) \<le> B" by auto
  note swap = basis_reduction_swap_main[OF Linv disjI2[OF mu_F1_i] i cond fs'_def]
  note updates = swap(4,5)
  note Linv' = swap(1)
  note inv' = LLL_inv_wD[OF Linv']
  note inv = LLL_inv_wD[OF Linv]
  interpret gs1: gram_schmidt_fs_int n "RAT fs"
    by (standard) (use inv gs.lin_indpt_list_def in \<open>auto simp add: vec_hom_Ints\<close>)
  interpret gs2: gram_schmidt_fs_int n "RAT fs'"
    by (standard) (use inv' gs.lin_indpt_list_def in \<open>auto simp add: vec_hom_Ints\<close>)
  let ?mu1 = "\<mu> fs"
  let ?mu2 = "\<mu> fs'"
  let ?mu = "?mu1 i (i - 1)"
  have mu: "abs ?mu \<le> 1/2" using mu_F1_i .
  have "?n2 (i - 1) = ?n1 i + ?mu * ?mu * ?n1 (i - 1)"
   by (subst updates(2), insert i, auto)
  also have "\<dots> = inverse \<alpha> * (\<alpha> * ?n1 i) + (?mu * ?mu) * ?n1 (i - 1)"
    using \<alpha> by auto
  also have "\<dots> \<le> inverse \<alpha> * ?n1 (i - 1) + (abs ?mu * abs ?mu) * ?n1 (i - 1)"
    by (rule add_mono[OF mult_left_mono], insert cond \<alpha>, auto)
  also have "\<dots> = (inverse \<alpha> + abs ?mu * abs ?mu) * ?n1 (i - 1)" by (auto simp: field_simps)
  also have "\<dots> \<le> (inverse \<alpha> + (1/2) * (1/2)) * ?n1 (i - 1)"
    by (rule mult_right_mono[OF add_left_mono[OF mult_mono]], insert mu, auto)
  also have "inverse \<alpha> + (1/2) * (1/2) = reduction" unfolding reduction_def using \<alpha>0
    by (auto simp: field_simps)
  also have "\<dots> * ?n1 (i - 1) \<le> 1 * ?n1 (i - 1)"
    by (rule mult_right_mono, auto simp: reduction)
  finally have n2im1: "?n2 (i - 1) \<le> ?n1 (i - 1)" by simp
  show "g_bnd B fs'" unfolding g_bnd_def
  proof (intro allI impI)
    fix k
    assume km: "k < m"
    consider (ki) "k = i" | (im1) "k = i - 1" | (other) "k \<noteq> i" "k \<noteq> i-1" by blast
    thus "?n2 k \<le> B"
    proof cases
      case other
      from short[OF km] have "?n1 k \<le> B" by auto
      also have "?n1 k = ?n2 k" using km other
        by (subst updates(2), auto)
      finally show ?thesis by simp
    next
      case im1
      have "?n2 k = ?n2 (i - 1)" unfolding im1 ..
      also have "\<dots> \<le> ?n1 (i - 1)" by fact
      also have "\<dots> \<le> B" using short_im1 by auto
      finally show ?thesis by simp
    next
      case ki
      have "?n2 k = ?n2 i" unfolding ki using i by auto
      also have "\<dots> \<le> ?n1 (i - 1)"
      proof -
        let ?f1 = "\<lambda> i. RAT fs ! i"
        let ?f2 = "\<lambda> i. RAT fs' ! i"
        define u where "u = gs.sumlist (map (\<lambda>j. ?mu1 (i - 1) j \<cdot>\<^sub>v ?g1 j) [0..<i - 1])"
        define U where "U = ?f1 ` {0 ..< i - 1} \<union> {?f1 i}"
        have g2i: "?g2 i \<in> Rn" using i inv' by simp
        have U: "U \<subseteq> Rn" unfolding U_def using inv i by auto
        have uU: "u \<in> gs.span U"
        proof -
          have im1: "i - 1 \<le> m" using i by auto
          have G1: "?g1 ` {0..< i - 1} \<subseteq> Rn" using inv(5) i by auto
          have "u \<in> gs.span (?g1 ` {0 ..< i - 1})" unfolding u_def
            by (rule gs.sumlist_in_span[OF G1], unfold set_map, insert G1,
              auto intro!: gs.smult_in_span intro: gs.span_mem)
          also have "gs.span (?g1 ` {0 ..< i - 1}) = gs.span (?f1 ` {0 ..< i - 1})"
            apply(subst gs1.partial_span, insert im1 inv, unfold gs.lin_indpt_list_def)
             apply(blast)
            apply(rule arg_cong[of _ _ gs.span])
            apply(subst nth_image[symmetric])
            by (insert i inv, auto)
          also have "\<dots> \<subseteq> gs.span U" unfolding U_def
            by (rule gs.span_is_monotone, auto)
          finally show ?thesis .
        qed
        from i have im1: "i - 1 < m" by auto
        have u: "u \<in> Rn" using uU U by simp
        have id_u: "u + (?g1 (i - 1) - ?g2 i) = u + ?g1 (i - 1) - ?g2 i"
          using u g2i inv(5)[OF im1] by auto
        have list_id: "[0..<Suc (i - 1)] = [0..< i - 1] @ [i - 1]"
          "map f [x] = [f x]" for f x by auto
        have "gs.is_oc_projection (gs2.gso i) (gs.span (gs2.gso ` {0..<i})) ((RAT fs') ! i)"
          using i inv' unfolding gs.lin_indpt_list_def
          by (intro gs2.gso_oc_projection_span(2)) auto
        then have "gs.is_oc_projection (?g2 i) (gs.span (gs2.gso ` {0 ..< i}))  (?f1 (i - 1))"
          unfolding fs'_def using inv(6) i by auto
        also have "?f1 (i - 1) = u + ?g1 (i - 1) "
          apply(subst gs1.fi_is_sum_of_mu_gso, insert im1 inv, unfold gs.lin_indpt_list_def)
          apply(blast)
          unfolding list_id map_append u_def
          by (subst gs.M.sumlist_snoc, insert i, auto simp: gs1.\<mu>.simps intro!: inv(5))
        also have "gs.span (gs2.gso ` {0 ..< i}) = gs.span (set (take i (RAT fs')))"
          using inv' \<open>i < m\<close> unfolding gs.lin_indpt_list_def
          by (subst gs2.partial_span) auto
        also have "set (take i (RAT fs')) = ?f2 ` {0 ..< i}" using inv'(6) i
          by (subst nth_image[symmetric], auto)
        also have "{0 ..< i} = {0 ..< i - 1} \<union> {(i - 1)}" using i by auto
        also have "?f2 ` \<dots> = ?f2 ` {0 ..< i - 1} \<union> {?f2 (i - 1)}" by auto
        also have "\<dots> = U" unfolding U_def fs'_def
          by (rule arg_cong2[of _ _ _ _ "(\<union>)"], insert i inv(6), force+)
        finally have "gs.is_oc_projection (?g2 i) (gs.span U) (u + ?g1 (i - 1))" .
        hence proj: "gs.is_oc_projection (?g2 i) (gs.span U) (?g1 (i - 1))"
          unfolding gs.is_oc_projection_def using gs.span_add[OF U uU, of "?g1 (i - 1) - ?g2 i"]
          inv(5)[OF im1] g2i u id_u by (auto simp: U)
        from gs.is_oc_projection_sq_norm[OF this gs.span_is_subset2[OF U]  inv(5)[OF im1]]
        show "?n2 i \<le> ?n1 (i - 1)" .
      qed
      also have "\<dots> \<le> B" by fact
      finally show ?thesis .
    qed
  qed
qed

lemma basis_reduction_swap_bound: assumes
  binv: "LLL_bound_invariant True False i fs"
  and res: "basis_reduction_swap i fs = (upw',i',fs')"
  and cond: "sq_norm (gso fs (i - 1)) > \<alpha> * sq_norm (gso fs i)"
  and i: "i < m" "i \<noteq> 0"
shows "LLL_bound_invariant True upw' i' fs'"
proof (rule bound_invI)
  note Linv = bound_invD(1)[OF binv]
  from basis_reduction_swap[OF Linv res cond i]
  show Linv': "LLL_invariant upw' i' fs'" by auto
  from res[unfolded basis_reduction_swap_def]
  have id: "i' = i - 1" "fs' = fs[i := fs ! (i - 1), i - 1 := fs ! i]" by auto
  from LLL_invD(6)[OF Linv] i
  have choice: "fs' ! k = fs ! k \<or> fs' ! k = fs ! i \<or> fs' ! k = fs ! (i - 1)" for k
    unfolding id by (cases "k = i"; cases "k = i - 1", auto)
  from bound_invD(2)[OF binv] i
  show "f_bound True i' fs'" unfolding id(1) f_bound_def
  proof (intro allI impI, goal_cases)
    case (1 k)
    thus ?case using choice[of k] by auto
  qed

  from bound_invD(3)[OF binv, unfolded g_bound_def]
  have gbnd: "g_bnd (of_nat N) fs" unfolding g_bnd_def .
  from LLL_invD(11)[OF Linv, unfolded \<mu>_small_def] i
  have "abs (\<mu> fs i (i - 1)) \<le> 1/2" by auto
  from g_bnd_swap[OF i LLL_inv_imp_w[OF Linv] this cond id(2) gbnd]
  have "g_bnd (rat_of_nat N) fs'" .
  thus "g_bound fs'" unfolding g_bnd_def g_bound_def .
qed

lemma basis_reduction_step_bound: assumes
  binv: "LLL_bound_invariant True upw i fs"
  and res: "basis_reduction_step upw i fs = (upw',i',fs')"
  and i: "i < m"
shows "LLL_bound_invariant True upw' i' fs'"
proof -
  note def = basis_reduction_step_def
  obtain fs'' where fs'': "basis_reduction_add_rows upw i fs = fs''" by auto
  show ?thesis
  proof (cases "i = 0")
    case True
    from increase_i_bound[OF binv i True] res True
    show ?thesis by (auto simp: def)
  next
    case False
    hence id: "(i = 0) = False" by auto
    note res = res[unfolded def id if_False fs'' Let_def]
    let ?x = "sq_norm (gso fs'' (i - 1))"
    let ?y = "\<alpha> * sq_norm (gso fs'' i)"
    from basis_reduction_add_rows_bound[OF binv fs'' i]
    have binv: "LLL_bound_invariant True False i fs''" by auto
    show ?thesis
    proof (cases "?x \<le> ?y")
      case True
      from increase_i_bound[OF binv i _ True] True res
      show ?thesis by auto
    next
      case gt: False
      hence "?x > ?y" by auto
      from basis_reduction_swap_bound[OF binv _ this i False] gt res
      show ?thesis by auto
    qed
  qed
qed

lemma basis_reduction_main_bound: assumes "LLL_bound_invariant True upw i fs"
  and res: "basis_reduction_main (upw,i,fs) = fs'"
shows "LLL_bound_invariant True True m fs'"
  using assms
proof (induct "LLL_measure i fs" arbitrary: i fs upw rule: less_induct)
  case (less i fs upw)
  have id: "LLL_bound_invariant True upw i fs = True" using less by auto
  note res = less(3)[unfolded basis_reduction_main.simps[of upw i fs] id]
  note inv = less(2)
  note IH = less(1)
  note Linv = bound_invD(1)[OF inv]
  show ?case
  proof (cases "i < m")
    case i: True
    obtain i' fs' upw' where step: "basis_reduction_step upw i fs = (upw',i',fs')"
      (is "?step = _") by (cases ?step, auto)
    note decrease = basis_reduction_step(2)[OF Linv step i]
    from IH[OF decrease basis_reduction_step_bound(1)[OF inv step i]] res[unfolded step] i Linv
    show ?thesis by auto
  next
    case False
    with LLL_invD[OF Linv] have i: "i = m" by auto
    with False res inv have "LLL_bound_invariant True upw m fs'" by auto
    thus ?thesis by (auto simp: LLL_invariant_def LLL_bound_invariant_def)
  qed
qed

lemma LLL_inv_initial_state_bound: "LLL_bound_invariant True True 0 fs_init"
proof (intro bound_invI[OF LLL_inv_initial_state _ g_bound_fs_init])
  {
    fix i
    assume i: "i < m"
    let ?N = "map (nat o sq_norm) fs_init"
    let ?r = rat_of_int
    from i have mem: "nat (sq_norm (fs_init ! i)) \<in> set ?N" using fs_init len unfolding set_conv_nth by force
    from mem_set_imp_le_max_list[OF _ mem]
    have FN: "nat (sq_norm (fs_init ! i)) \<le> N" unfolding N_def by force
    hence "\<parallel>fs_init ! i\<parallel>\<^sup>2 \<le> int N" using i by auto
    also have "\<dots> \<le> int (N * m)" using i by fastforce
    finally have f_bnd:  "\<parallel>fs_init ! i\<parallel>\<^sup>2 \<le> int (N * m)" .
  }
  thus "f_bound True 0 fs_init" unfolding f_bound_def by auto
qed

lemma reduce_basis_bound: assumes res: "reduce_basis = fs"
  shows "LLL_bound_invariant True True m fs"
  using basis_reduction_main_bound[OF LLL_inv_initial_state_bound res[unfolded reduce_basis_def]] .

subsubsection \<open>Bound extracted from @{term LLL_bound_invariant}.\<close>

fun f_bnd :: "bool \<Rightarrow> nat" where
  "f_bnd False = 2 ^ (m - 1) * N ^ m * m"
| "f_bnd True = N * m"

lemma f_bnd_mono: "f_bnd outside \<le> f_bnd False"
proof (cases outside)
  case out: True
  show ?thesis
  proof (cases "N = 0 \<or> m = 0")
    case True
    thus ?thesis using out by auto
  next
    case False
    hence 0: "N > 0" "m > 0" by auto
    let ?num = "(2 ^ (m - 1) * N ^ m)"
    have "(N * m) * 1 \<le> (N * m) * (2 ^ (m - 1) * N ^ (m - 1))"
      by (rule mult_left_mono, insert 0, auto)
    also have "\<dots> = 2 ^ (m - 1) * N ^ (Suc (m - 1)) * m " by simp
    also have "Suc (m - 1) = m" using 0 by simp
    finally show ?thesis using out by auto
  qed
qed auto

lemma aux_bnd_mono: "N * m \<le> (4 ^ (m - 1) * N ^ m * m * m)"
proof (cases "N = 0 \<or> m = 0")
  case False
  hence 0: "N > 0" "m > 0" by auto
  let ?num = "(4 ^ (m - 1) * N ^ m * m * m)"
  have "(N * m) * 1 \<le> (N * m) * (4 ^ (m - 1) * N ^ (m - 1) * m)"
    by (rule mult_left_mono, insert 0, auto)
  also have "\<dots> = 4 ^ (m - 1) * N ^ (Suc (m - 1)) * m * m" by simp
  also have "Suc (m - 1) = m" using 0 by simp
  finally show "N * m \<le> ?num" by simp
qed auto

context fixes outside upw k fs
  assumes binv: "LLL_bound_invariant outside upw k fs"
begin

lemma LLL_f_bnd:
  assumes i: "i < m" and j: "j < n"
shows "\<bar>fs ! i $ j\<bar> \<le> f_bnd outside"
proof -
  from bound_invD[OF binv]
  have inv: "LLL_invariant upw k fs"
    and fbnd: "f_bound outside k fs"
    and gbnd: "g_bound fs" by auto
  note invw = LLL_inv_imp_w[OF inv]
  from LLL_inv_N_pos[OF invw gbnd] i have N0: "N > 0" by auto
  note inv = LLL_invD[OF inv]
  from inv i have fsi: "fs ! i \<in> carrier_vec n" by auto
  have one: "\<bar>fs ! i $ j\<bar>^1 \<le> \<bar>fs ! i $ j\<bar>^2"
    by (cases "fs ! i $ j \<noteq> 0", intro pow_mono_exp, auto)
  let ?num = "(4 ^ (m - 1) * N ^ m * m * m)"
  let ?sq_bnd = "if i \<noteq> k \<or> outside then int (N * m) else int ?num"
  have "\<bar>fs ! i $ j\<bar>^2 \<le> \<parallel>fs ! i\<parallel>\<^sup>2" using fsi j by (metis vec_le_sq_norm)
  also have "\<dots> \<le> ?sq_bnd"
    using fbnd[unfolded f_bound_def, rule_format, OF i] by auto
  finally have two: "(fs ! i $ j)^2 \<le> ?sq_bnd" by simp
  show ?thesis
  proof (cases outside)
    case True
    with one two show ?thesis by auto
  next
    case False
    let ?num2 = "(2 ^ (m - 1) * N ^ m * m)"
    have four: "(4 :: nat) = 2^2" by auto
    have "(fs ! i $ j)^2 \<le> int (max (N * m) ?num)"
      by (rule order.trans[OF two], auto simp: of_nat_mult[symmetric] simp del: of_nat_mult)
    also have "max (N * m) ?num = ?num" using aux_bnd_mono by presburger
    also have "int ?num = int ?num * 1" by simp
    also have "\<dots> \<le> int ?num * N ^ m"
      by (rule mult_left_mono, insert N0, auto)
    also have "\<dots> = int (?num * N ^ m)" by simp
    also have "?num * N ^ m = ?num2^2" unfolding power2_eq_square four power_mult_distrib
      by simp
    also have "int \<dots> = (int ?num2)^2" by simp
    finally have "(fs ! i $ j)\<^sup>2 \<le> (int (f_bnd outside))\<^sup>2" using False by simp
    thus ?thesis unfolding abs_le_square_iff[symmetric] by simp
  qed
qed

lemma LLL_gso_bound:
  assumes i: "i < m" and j: "j < n"
  and quot: "quotient_of (gso fs i $ j) = (num, denom)"
shows "\<bar>num\<bar>   \<le> N ^ m"
  and "\<bar>denom\<bar> \<le> N ^ m"
proof -
  from bound_invD[OF binv]
  have inv: "LLL_invariant upw k fs"
    and gbnd: "g_bound fs" by auto
  note invw = LLL_inv_imp_w[OF inv]
  note * = LLL_invD[OF inv]
  interpret fs: fs_int' n m fs_init fs
    by standard (use invw in auto)
  note d_approx[OF invw gbnd i, unfolded d_def]
  let ?r = "rat_of_int"
  have int: "(gs.Gramian_determinant (RAT fs) i \<cdot>\<^sub>v (gso fs i)) $ j \<in> \<int>"
  proof -
    have "of_int_hom.vec_hom (fs ! j) $ i \<in> \<int>" if "i < n" "j < m" for i j
      using that assms * by (intro vec_hom_Ints) (auto)
    then show ?thesis
      using * gs.gso_connect snd_gram_schmidt_int assms unfolding gs.lin_indpt_list_def
      by (intro fs.gs.d_gso_Ints) (auto)
  qed
  have gsi: "gso fs i \<in> Rn" using *(5)[OF i] .
  have gs_sq: "\<bar>(gso fs i $ j)\<bar>\<^sup>2 \<le> rat_of_nat N"
    by(rule order_trans, rule vec_le_sq_norm[of _ n])
      (use gsi assms gbnd * LLL.g_bound_def in auto)
  from i have "m * m \<noteq> 0"
    by auto
  then have N0: "N \<noteq> 0"
    using less_le_trans[OF LLL_D_pos[OF invw] D_approx[OF invw gbnd]] by auto
  have "\<bar>(gso fs i $ j)\<bar> \<le> max 1 \<bar>(gso fs i $ j)\<bar>"
    by simp
  also have "\<dots> \<le> (max 1 \<bar>gso fs i $ j\<bar>)\<^sup>2"
    by (rule self_le_power, auto)
  also have "\<dots> \<le> of_nat N"
    using gs_sq N0 unfolding max_def by auto
  finally have gs_bound: "\<bar>(gso fs i $ j)\<bar> \<le> of_nat N" .
  have "gs.Gramian_determinant (RAT fs) i = rat_of_int (gs.Gramian_determinant fs i)"
    using  assms *(4-6) carrier_vecD nth_mem by (intro fs.of_int_Gramian_determinant) (simp, blast)
  with int have "(of_int (d fs i) \<cdot>\<^sub>v gso fs i) $ j \<in> \<int>"
    unfolding d_def by simp
  also have "(of_int (d fs i) \<cdot>\<^sub>v gso fs i) $ j = of_int (d fs i) * (gso fs i $ j)"
    using gsi i j by auto
  finally have l: "of_int (d fs i) * gso fs i $ j \<in> \<int>"
    by auto
  have num: "rat_of_int \<bar>num\<bar> \<le> of_int (d fs i * int N)" and denom: "denom \<le> d fs i"
    using quotient_of_bounds[OF quot l LLL_d_pos[OF invw] gs_bound] i by auto
  from num have num: "\<bar>num\<bar> \<le> d fs i * int N"
    by linarith
  from d_approx[OF invw gbnd i] have d: "d fs i \<le> int (N ^ i)"
    by linarith
  from denom d have denom: "denom \<le> int (N ^ i)"
    by auto
  note num also have "d fs i * int N \<le> int (N ^ i) * int N"
    by (rule mult_right_mono[OF d], auto)
  also have "\<dots> = int (N ^ (Suc i))"
    by simp
  finally have num: "\<bar>num\<bar> \<le> int (N ^ (i + 1))"
    by auto
  {
    fix jj
    assume "jj \<le> i + 1"
    with i have "jj \<le> m" by auto
    from pow_mono_exp[OF _ this, of N] N0
    have "N^jj \<le> N^m" by auto
    hence "int (N^jj) \<le> int (N^m)" by linarith
  } note j_m = this
  have "\<bar>denom\<bar> = denom"
    using quotient_of_denom_pos[OF quot] by auto
  also have "\<dots> \<le> int (N ^ i)"
    by fact
  also have "\<dots> \<le> int (N ^ m)"
    by (rule j_m, auto)
  finally show "\<bar>denom\<bar> \<le> int (N ^ m)"
    by auto
  show "\<bar>num\<bar> \<le> int (N ^ m)"
    using j_m[of "i+1"] num by auto
qed

lemma LLL_f_bound:
  assumes i: "i < m" and j: "j < n"
shows "\<bar>fs ! i $ j\<bar> \<le> N ^ m * 2 ^ (m - 1) * m"
proof -
  have "\<bar>fs ! i $ j\<bar> \<le> int (f_bnd outside)" using LLL_f_bnd[OF i j] by auto
  also have "\<dots> \<le> int (f_bnd False)" using f_bnd_mono[of outside] by presburger
  also have "\<dots> = int (N ^ m * 2 ^ (m - 1) * m)" by simp
  finally show ?thesis .
qed

lemma LLL_d_bound:
  assumes i: "i \<le> m"
shows "abs (d fs i) \<le> N ^ i \<and> abs (d fs i) \<le> N ^ m"
proof (cases "m = 0")
  case True
  with i have id: "m = 0" "i = 0" by auto
  show ?thesis unfolding id(2) using id unfolding gs.Gramian_determinant_0 d_def by auto
next
  case m: False
  from bound_invD[OF binv]
  have inv: "LLL_invariant upw k fs"
     and gbnd: "g_bound fs" by auto
  note invw = LLL_inv_imp_w[OF inv]
  from LLL_inv_N_pos[OF invw gbnd] m have N: "N > 0" by auto
  let ?r = rat_of_int
  from d_approx_main[OF invw gbnd i m]
  have "rat_of_int (d fs i) \<le> of_nat (N ^ i)"
    by auto
  hence one: "d fs i \<le> N ^ i" by linarith
  also have "\<dots> \<le> N ^ m" unfolding of_nat_le_iff
    by (rule pow_mono_exp, insert N i, auto)
  finally have "d fs i \<le> N ^ m" by simp
  with LLL_d_pos[OF invw i] one
  show ?thesis by auto
qed

lemma LLL_mu_abs_bound:
  assumes i: "i < m"
  and j: "j < i"
shows "\<bar>\<mu> fs i j\<bar> \<le> rat_of_nat (N ^ (m - 1) * 2 ^ (m - 1) * m)"
proof -
  from bound_invD[OF binv]
  have inv: "LLL_invariant upw k fs"
     and fbnd: "f_bound outside k fs"
     and gbnd: "g_bound fs" by auto
  note invw = LLL_inv_imp_w[OF inv]
  from LLL_inv_N_pos[OF invw gbnd] i have N: "N > 0" by auto
  note * = LLL_invD[OF inv]
  interpret fs: fs_int' n m fs_init fs
    by standard (use invw in auto)
  let ?mu = "\<mu> fs i j"
  from j i have jm: "j < m" by auto
  from d_approx[OF invw gbnd jm]
  have dj: "d fs j \<le> int (N ^ j)" by linarith
  let ?num = "4 ^ (m - 1) * N ^ m * m * m"
  let ?bnd = "N^(m - 1) * 2 ^ (m - 1) * m"
  from fbnd[unfolded f_bound_def, rule_format, OF i]
    aux_bnd_mono[folded of_nat_le_iff[where ?'a = int]]
  have sq_f_bnd: "sq_norm (fs ! i) \<le> int ?num" by (auto split: if_splits)
  have four: "(4 :: nat) = 2^2" by auto
  have "?mu^2 \<le> (gs.Gramian_determinant (RAT fs) j) * sq_norm (RAT fs ! i)"
  proof -
    have 1: "of_int_hom.vec_hom (fs ! j) $ i \<in> \<int>" if "i < n" "j < length fs" for j i
      using * that by (metis vec_hom_Ints)
    then show ?thesis
      by (intro fs.gs.mu_bound_Gramian_determinant[OF j], insert * j i,
          auto simp: set_conv_nth gs.lin_indpt_list_def)
  qed
  also have "sq_norm (RAT fs ! i) = of_int (sq_norm (fs ! i))"
    unfolding sq_norm_of_int[symmetric] using *(6) i by auto
  also have "(gs.Gramian_determinant (RAT fs) j) = of_int (d fs j)"
    unfolding d_def by (rule fs.of_int_Gramian_determinant, insert i j *(3,6), auto simp: set_conv_nth)
  also have "\<dots> * of_int (sq_norm (fs ! i)) = of_int (d fs j * sq_norm (fs ! i))" by simp
  also have "\<dots> \<le> of_int (int (N^j) * int ?num)" unfolding of_int_le_iff
    by (rule mult_mono[OF dj sq_f_bnd], auto)
  also have "\<dots> = of_nat (N^(j + m) * (4 ^ (m - 1) * m * m))" by (simp add: power_add)
  also have "\<dots> \<le> of_nat (N^( (m - 1) + (m-1)) * (4 ^ (m - 1) * m * m))" unfolding of_nat_le_iff
    by (rule mult_right_mono[OF pow_mono_exp], insert N j i jm, auto)
  also have "\<dots> = of_nat (?bnd^2)"
    unfolding four power_mult_distrib power2_eq_square of_nat_mult by (simp add: power_add)
  finally have "?mu^2 \<le> (of_nat ?bnd)^2" by auto
  from this[folded abs_le_square_iff]
  show "abs ?mu \<le> of_nat ?bnd" by auto
qed

lemma LLL_d\<mu>_bound:
  assumes i: "i < m" and j: "j < i"
shows "abs (d\<mu> fs i j) \<le> N ^ (2 * (m - 1)) * 2 ^ (m - 1) * m"
proof -
  from bound_invD[OF binv]
  have inv: "LLL_invariant upw k fs"
     and fbnd: "f_bound outside k fs"
     and gbnd: "g_bound fs" by auto
  note invw = LLL_inv_imp_w[OF inv]
  interpret fs: fs_int' n m fs_init fs
    by standard (use invw in auto)
  from LLL_inv_N_pos[OF invw gbnd] i have N: "N > 0" by auto
  from j i have jm: "j < m - 1" "j < m" by auto
  let ?r = rat_of_int
  from LLL_d_bound[of "Suc j"] jm
  have "abs (d fs (Suc j)) \<le> N ^ Suc j" by linarith
  also have "\<dots> \<le> N ^ (m - 1)" unfolding of_nat_le_iff
    by (rule pow_mono_exp, insert N jm, auto)
  finally have dsj: "abs (d fs (Suc j)) \<le> int N ^ (m - 1)" by auto
  from fs.d\<mu>[of j i] j i LLL_invD[OF inv]
  have "?r (abs (d\<mu> fs i j)) = abs (?r (d fs (Suc j)) * \<mu> fs i j)"
    unfolding d_def fs.d_def d\<mu>_def fs.d\<mu>_def by auto
  also have "\<dots> = ?r (abs (d fs (Suc j))) * abs (\<mu> fs i j)" by (simp add: abs_mult)
  also have "\<dots> \<le> ?r (int N ^ (m - 1)) * rat_of_nat (N ^ (m - 1) * 2 ^ (m - 1) * m)"
    by (rule mult_mono[OF _ LLL_mu_abs_bound[OF i j]], insert dsj, linarith, auto)
  also have "\<dots> = ?r (int (N ^ ((m - 1) + (m - 1)) * 2 ^ (m - 1) * m))"
    by (simp add: power_add)
  also have "(m - 1) + (m - 1) = 2 * (m - 1)" by simp
  finally show "abs (d\<mu> fs i j) \<le> N ^ (2 * (m - 1)) * 2 ^ (m - 1) * m" by linarith
qed

lemma LLL_mu_num_denom_bound:
  assumes i: "i < m"
  and quot: "quotient_of (\<mu> fs i j) = (num, denom)"
shows "\<bar>num\<bar>   \<le> N ^ (2 * m) * 2 ^ m * m"
  and "\<bar>denom\<bar> \<le> N ^ m"
proof (atomize(full))
  from bound_invD[OF binv]
  have inv: "LLL_invariant upw k fs"
     and fbnd: "f_bound outside k fs"
     and gbnd: "g_bound fs" by auto
  note invw = LLL_inv_imp_w[OF inv]
  from LLL_inv_N_pos[OF invw gbnd] i have N: "N > 0" by auto
  note * = LLL_invD[OF inv]
  interpret fs: fs_int' n m fs_init fs
    by standard (use invw in auto)
  let ?mu = "\<mu> fs i j"
  let ?bnd = "N^(m - 1) * 2 ^ (m - 1) * m"
  show "\<bar>num\<bar> \<le> N ^ (2 * m) * 2 ^ m * m \<and> \<bar>denom\<bar> \<le> N ^ m"
  proof (cases "j < i")
    case j: True
    with i have jm: "j < m" by auto
    from LLL_d_pos[OF invw, of "Suc j"] i j have dsj: "0 < d fs (Suc j)" by auto
    from quotient_of_square[OF quot]
    have quot_sq: "quotient_of (?mu^2) = (num * num, denom * denom)"
      unfolding power2_eq_square by auto
    from LLL_mu_abs_bound[OF assms(1) j]
    have mu_bound: "abs ?mu \<le> of_nat ?bnd" by auto
    have "gs.Gramian_determinant (RAT fs) (Suc j) * ?mu \<in> \<int>"
      by (rule fs.gs.d_mu_Ints,
      insert j *(1,3-6) i, auto simp: set_conv_nth gs.lin_indpt_list_def vec_hom_Ints)
    also have "(gs.Gramian_determinant (RAT fs) (Suc j)) = of_int (d fs (Suc j))"
      unfolding d_def by (rule fs.of_int_Gramian_determinant, insert i j *(3,6), auto simp: set_conv_nth)
    finally have ints: "of_int (d fs (Suc j)) * ?mu \<in> \<int>" .
    from LLL_d_bound[of "Suc j"] jm
    have d_j: "d fs (Suc j) \<le> N ^ m" by auto
    note quot_bounds = quotient_of_bounds[OF quot ints dsj mu_bound]
    have "abs denom \<le> denom" using quotient_of_denom_pos[OF quot] by auto
    also have "\<dots> \<le> d fs (Suc j)" by fact
    also have "\<dots> \<le> N ^ m" by fact
    finally have denom: "abs denom \<le> N ^ m" by auto
    from quot_bounds(1) have "\<bar>num\<bar> \<le> d fs (Suc j) * int ?bnd"
      unfolding of_int_le_iff[symmetric, where ?'a = rat] by simp
    also have "\<dots> \<le> N ^ m * int ?bnd" by (rule mult_right_mono[OF d_j], auto)
    also have "\<dots> = (int N ^ (m + (m - 1))) * (2 ^ (m - 1)) * int m" unfolding power_add of_nat_mult by simp
    also have "\<dots> \<le> (int N ^ (2 * m)) * (2 ^ m) * int m" unfolding of_nat_mult
      by (intro mult_mono pow_mono_exp, insert N, auto)
    also have "\<dots> = int (N ^ (2 * m) * 2 ^ m * m)" by simp
    finally have num: "\<bar>num\<bar> \<le> N ^ (2 * m) * 2 ^ m * m" .
    from denom num show ?thesis by blast
  next
    case False
    hence "?mu = 0 \<or> ?mu = 1" unfolding fs.gs.\<mu>.simps by auto
    hence "quotient_of ?mu = (1,1) \<or> quotient_of ?mu = (0,1)" by auto
    from this[unfolded quot] show ?thesis using N i by (auto intro!: mult_ge_one)
  qed
qed

text \<open>Now we have bounds on each number $(f_i)_j$, $(g_i)_j$, and $\mu_{i,j}$, i.e.,
  for rational numbers bounds on the numerators and denominators.\<close>

lemma logN_le_2log_Mn: assumes m: "m \<noteq> 0" "n \<noteq> 0" and N: "N > 0"
  shows "log 2 N \<le> 2 * log 2 (M * n)"
proof -
  have "N \<le> nat M * nat M * n * 1" using N_le_MMn m by auto
  also have "\<dots> \<le> nat M * nat M * n * n" by (intro mult_mono, insert m, auto)
  finally have NM: "N \<le> nat M * nat M * n * n" by simp
  with N have "nat M \<noteq> 0" by auto
  hence M: "M > 0" by simp

  have "log 2 N \<le> log 2 (M * M * n * n)"
  proof (subst log_le_cancel_iff)
    show "real N \<le> (M * M * int n * int n)" using NM[folded of_nat_le_iff[where ?'a = real]] M
      by simp
  qed (insert N M m, auto)
  also have "\<dots> = log 2 (of_int (M * n) * of_int (M * n))"
    unfolding of_int_mult by (simp  add: ac_simps)
  also have "\<dots> = 2 * log 2 (M * n)"
    by (subst log_mult, insert m M, auto)
  finally show "log 2 N \<le> 2 * log 2 (M * n)" by auto
qed

text \<open>We now prove a combined size-bound for all of these numbers. The bounds clearly indicate
  that the size of the numbers grows at most polynomial, namely the sizes are roughly
  bounded by ${\cal O}(m \cdot \log(M \cdot n))$ where $m$ is the number of vectors, $n$ is the dimension
  of the vectors, and $M$ is the maximum absolute value that occurs in the input to the LLL algorithm.\<close>

lemma combined_size_bound: fixes number :: int
  assumes i: "i < m" and j: "j < n"
  and x: "x \<in> {of_int (fs ! i $ j), gso fs i $ j, \<mu> fs i j}"
  and quot: "quotient_of x = (num, denom)"
  and number: "number \<in> {num, denom}"
  and number0: "number \<noteq> 0"
shows "log 2 \<bar>number\<bar> \<le> 2 * m * log 2 N       + m + log 2 m"
      "log 2 \<bar>number\<bar> \<le> 4 * m * log 2 (M * n) + m + log 2 m"
proof -
  from bound_invD[OF binv]
  have inv: "LLL_invariant upw k fs"
     and fbnd: "f_bound outside k fs"
     and gbnd: "g_bound fs"
    by auto
  note invw = LLL_inv_imp_w[OF inv]
  from LLL_inv_N_pos[OF invw gbnd] i have N: "N > 0" by auto
  let ?bnd = "N ^ (2 * m) * 2 ^ m * m"
  have "N ^ m * int 1 \<le> N ^ (2 * m) * (2^m * int m)"
    by (rule mult_mono, unfold of_nat_le_iff, rule pow_mono_exp, insert N i, auto)
  hence le: "int (N ^ m) \<le> N ^ (2 * m) * 2^m * m" by auto
  from x consider (xfs) "x = of_int (fs ! i $ j)" | (xgs) "x = gso fs i $ j" | (xmu) "x = \<mu> fs i j"
    by auto
  hence num_denom_bound: "\<bar>num\<bar> \<le> ?bnd \<and> \<bar>denom\<bar> \<le> N ^ m"
  proof (cases)
    case xgs
    from LLL_gso_bound[OF i j quot[unfolded xgs]] le
    show ?thesis by auto
  next
    case xmu
    from LLL_mu_num_denom_bound[OF i, of j, OF quot[unfolded xmu]]
    show ?thesis by auto
  next
    case xfs
    have "\<bar>denom\<bar> = 1" using quot[unfolded xfs] by auto
    also have "\<dots> \<le> N ^ m" using N by auto
    finally have denom: "\<bar>denom\<bar> \<le> N ^ m" .
    have "\<bar>num\<bar> = \<bar>fs ! i $ j\<bar>" using quot[unfolded xfs] by auto
    also have "\<dots> \<le> int (N ^ m * 2 ^ (m - 1) * m)" using LLL_f_bound[OF i j] by auto
    also have "\<dots> \<le> ?bnd" unfolding of_nat_mult of_nat_power
      using N by (auto intro!: mult_mono pow_mono_exp)
    finally show ?thesis using denom by auto
  qed
  from number consider (num) "number = num" | (denom) "number = denom" by auto
  hence number_bound: "\<bar>number\<bar> \<le> ?bnd"
  proof (cases)
    case num
    with num_denom_bound show ?thesis by auto
  next
    case denom
    with num_denom_bound have "\<bar>number\<bar> \<le> N ^ m" by auto
    with le show ?thesis by auto
  qed
  from number_bound have bnd: "of_int \<bar>number\<bar> \<le> real ?bnd" by linarith
  have "log 2 \<bar>number\<bar> \<le> log 2 ?bnd"
    by (subst log_le_cancel_iff, insert number0 bnd, auto)
  also have "\<dots> = log 2 (N^(2 * m) * 2^m) + log 2 m"
    by (subst log_mult[symmetric], insert i N, auto)
  also have "\<dots> = log 2 (N^(2 * m)) + log 2 (2^m) + log 2 m"
    by (subst log_mult[symmetric], insert i N, auto)
  also have "log 2 (N^(2 * m)) = log 2 (N powr (2 * m))"
    by (rule arg_cong[of _ _ "log 2"], subst powr_realpow, insert N, auto)
  also have "\<dots> = (2 * m) * log 2 N"
    by (subst log_powr, insert N, auto)
  finally show boundN: "log 2 \<bar>number\<bar> \<le> 2 * m * log 2 N + m + log 2 m" by simp
  also have "\<dots> \<le> 2 * m * (2 * log 2 (M * n)) + m + log 2 m"
    by (intro add_right_mono mult_mono logN_le_2log_Mn N, insert i j N, auto)
  finally show "log 2 \<bar>number\<bar> \<le> 4 * m * log 2 (M * n) + m + log 2 m" by simp
qed

text \<open>And a combined size bound for an integer implementation which stores values
  $f_i$, $d_{j+1}\mu_{ij}$ and $d_i$.\<close>

interpretation fs: fs_int_indpt n fs_init
  by (standard) (use lin_dep in auto)

lemma fs_gs_N_N': assumes "m \<noteq> 0"
  shows "fs.gs.N = of_nat N"
proof -
  have 0: "Max (sq_norm ` set fs_init)  \<in>  sq_norm ` set fs_init"
    using len assms by auto
  then have 1: " nat (Max (sq_norm ` set fs_init)) \<in> (nat \<circ> sq_norm) ` set fs_init"
    by (auto)
  have [simp]: "0 \<le> Max (sq_norm ` set fs_init)"
    using 0 by force
  have [simp]: "sq_norm ` of_int_hom.vec_hom ` set fs_init = rat_of_int ` sq_norm ` set fs_init"
    by (auto simp add: sq_norm_of_int image_iff)
  then have [simp]: "rat_of_int (Max (sq_norm ` set fs_init)) \<in> rat_of_int ` sq_norm ` set fs_init"
    using 0 by auto
  have "(Missing_Lemmas.max_list (map (nat \<circ> sq_norm) fs_init)) = Max ((nat \<circ> sq_norm) ` set fs_init)"
    using assms len by (subst max_list_Max) (auto)
  also have "\<dots> = nat (Max (sq_norm_vec ` set fs_init))"
    using assms 1 by (auto intro!: nat_mono Max_eqI)
  also have "int \<dots> = Max (sq_norm_vec ` set fs_init)"
    by (subst int_nat_eq) (auto)
  also have "rat_of_int \<dots> = Max (sq_norm ` set (map of_int_hom.vec_hom fs_init))"
    by (rule Max_eqI[symmetric]) (auto simp add: sq_norm_of_int)
  finally show ?thesis
  unfolding N_def fs.gs.N_def by (auto)
qed

lemma fs_gs_N_N: "m \<noteq> 0 \<Longrightarrow> real_of_rat fs.gs.N = real N"
  using fs_gs_N_N' by simp

lemma combined_size_bound_gso_integer:
  assumes "x \<in>
    {fs.\<mu>' i j |i j. j \<le> i \<and> i < m} \<union>
    {fs.\<sigma>s l i j |i j l. i < m \<and> j \<le> i \<and> l < j}"
  and m: "m \<noteq> 0" and "x \<noteq> 0" "n \<noteq> 0"
shows "log 2 \<bar>real_of_int x\<bar> \<le> (6 + 6 * m) * log 2 (M * n) + log 2 m + m"
proof -
  from bound_invD[OF binv]
  have inv: "LLL_invariant upw k fs"
     and gbnd: "g_bound fs"
    by auto
  note invw = LLL_inv_imp_w[OF inv]
  from LLL_inv_N_pos[OF invw gbnd m] have N: "N > 0" by auto
  have "log 2 \<bar>real_of_int x\<bar> \<le> log 2 m + real (3 + 3 * m) * log 2 N"
    using assms len fs.combined_size_bound_integer_log by (auto simp add: fs_gs_N_N)
  also have "\<dots> \<le> log 2 m + (3 + 3 * m) * (2 * log 2 (M * n))"
    using logN_le_2log_Mn assms N by (intro add_left_mono, intro mult_left_mono) (auto)
  also have "\<dots> = log 2 m + (6 + 6 * m) * log 2 (M * n)"
    by (auto simp add: algebra_simps)
  finally show ?thesis
    by auto
qed

lemma combined_size_bound_integer':
  assumes x: "x \<in> {fs ! i $ j | i j. i < m \<and> j < n}
    \<union> {d\<mu> fs i j | i j. j < i \<and> i < m}
    \<union> {d fs i | i. i \<le> m}"
    (is "x \<in> ?fs \<union> ?d\<mu> \<union> ?d")
  and m: "m \<noteq> 0" and n: "n \<noteq> 0"
shows "abs x \<le> N ^ (2 * m) * 2 ^ m * m"
  "x \<noteq> 0 \<Longrightarrow> log 2 \<bar>x\<bar> \<le> 2 * m * log 2 N       + m + log 2 m" (is "_ \<Longrightarrow> ?l1 \<le> ?b1")
  "x \<noteq> 0 \<Longrightarrow> log 2 \<bar>x\<bar> \<le> 4 * m * log 2 (M * n) + m + log 2 m" (is "_ \<Longrightarrow> _ \<le> ?b2")
proof -
  let ?bnd = "int N ^ (2 * m) * 2 ^ m * int m"
  from bound_invD[OF binv]
  have inv: "LLL_invariant upw k fs"
     and fbnd: "f_bound outside k fs"
     and gbnd: "g_bound fs"
    by auto
  note invw = LLL_inv_imp_w[OF inv]
  from LLL_inv_N_pos[OF invw gbnd m] have N: "N > 0" by auto
  let ?r = real_of_int
  from x consider (fs) "x \<in> ?fs" | (d\<mu>) "x \<in> ?d\<mu>" | (d) "x \<in> ?d" by auto
  hence "abs x \<le> ?bnd"
  proof cases
    case fs
    then obtain i j where i: "i < m" and j: "j < n" and x: "x = fs ! i $ j" by auto
    from LLL_f_bound[OF i j, folded x]
    have "\<bar>x\<bar> \<le> int N ^ m * 2 ^ (m - 1) * int m" by simp
    also have "\<dots> \<le> ?bnd"
      by (intro mult_mono pow_mono_exp, insert N, auto)
    finally show ?thesis .
  next
    case d\<mu>
    then obtain i j where i: "i < m" and j: "j < i" and x: "x = d\<mu> fs i j" by auto
    from LLL_d\<mu>_bound[OF i j, folded x]
    have "\<bar>x\<bar> \<le> int N ^ (2 * (m - 1)) * 2 ^ (m - 1) * int m" by simp
    also have "\<dots> \<le> ?bnd"
      by (intro mult_mono pow_mono_exp, insert N, auto)
    finally show ?thesis .
  next
    case d
    then obtain i where i: "i \<le> m" and x: "x = d fs i" by auto
    from LLL_d_bound[OF i, folded x]
    have "\<bar>x\<bar> \<le> int N ^ m * 2 ^ 0 * 1" by simp
    also have "\<dots> \<le> ?bnd"
      by (intro mult_mono pow_mono_exp, insert N m, auto)
    finally show ?thesis .
  qed
  thus "abs x \<le> N ^ (2 * m) * 2 ^ m * m" by simp
  hence abs: "?r (abs x) \<le> ?r (N ^ (2 * m) * 2 ^ m * m)" by linarith
  assume "x \<noteq> 0" hence x: "abs x > 0" by auto
  from abs have "log 2 (abs x) \<le> log 2 (?r (N ^ (2 * m)) * 2 ^ m * ?r m)"
    by (subst log_le_cancel_iff, insert x N m, auto)
  also have "\<dots> = log 2 (?r N ^ (2 * m)) + m + log 2 (?r m)"
    using N m by (auto simp: log_mult)
  also have "log 2 (?r N ^ (2 * m)) = real (2 * m) * log 2 (?r N)"
    by (subst log_nat_power, insert N, auto)
  finally show "?l1 \<le> ?b1" by simp
  also have "\<dots> \<le> 2 * m * (2 * log 2 (M * n)) + m + log 2 m"
    by (intro add_right_mono mult_left_mono logN_le_2log_Mn, insert m n N, auto)
  finally show "?l1 \<le> ?b2" by simp
qed

lemma combined_size_bound_integer:
  assumes x: "x \<in>
      {fs ! i $ j | i j. i < m \<and> j < n}
    \<union> {d\<mu> fs i j | i j. j < i \<and> i < m}
    \<union> {d fs i | i. i \<le> m}
    \<union> {fs.\<mu>' i j |i j. j \<le> i \<and> i < m}
    \<union> {fs.\<sigma>s l i j |i j l. i < m \<and> j \<le> i \<and> l < j}"
    (is "?x \<in> ?s1 \<union> ?s2 \<union> ?s3 \<union> ?g1 \<union> ?g2")
  and m: "m \<noteq> 0" and n: "n \<noteq> 0" and "x \<noteq> 0" and "0 < M"
shows "log 2 \<bar>x\<bar> \<le> (6 + 6 * m) * log 2 (M * n) + log 2 m + m"
proof -
  show ?thesis
  proof (cases "?x \<in> ?g1 \<union> ?g2")
    case True
    then show ?thesis
      using combined_size_bound_gso_integer assms by simp
  next
    case False
    then have x: "x \<in> ?s1 \<union> ?s2 \<union> ?s3" using x by auto
    from combined_size_bound_integer'(3)[OF this m n \<open>x \<noteq> 0\<close>]
    have "log 2 \<bar>x\<bar> \<le> 4 * m * log 2 (M * n) + m + log 2 m" by simp
    also have "\<dots> \<le> (6 + 6 * m) * log 2 (M * n) + m + log 2 m"
       using assms by (intro add_right_mono, intro mult_right_mono) auto
    finally show ?thesis
      by simp
  qed
qed

end (* LLL_bound_invariant *)
end (* LLL locale *)
end