theory Summation
imports
  Complex_Main
  "~~/src/HOL/Library/Extended_Real"
  "~~/src/HOL/Library/Liminf_Limsup"
  Liminf_Limsup_Lemma_Bucket
  Extended_Real_Lemma_Bucket
  Natlog2
begin

subsection \<open>Convergence tests for infinite sums\<close>

subsubsection \<open>Root test\<close>

lemma limsup_root_powser:
  fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
  shows "limsup (\<lambda>n. ereal (root n (norm (f n * z ^ n)))) =
             limsup (\<lambda>n. ereal (root n (norm (f n)))) * ereal (norm z)"
proof -
  have A: "(\<lambda>n. ereal (root n (norm (f n * z ^ n)))) =
              (\<lambda>n. ereal (root n (norm (f n))) * ereal (norm z))" (is "?g = ?h")
  proof
    fix n show "?g n = ?h n"
    by (cases "n = 0") (simp_all add: norm_mult real_root_mult real_root_pos2 norm_power)
  qed
  show ?thesis by (subst A, subst limsup_ereal_mult_right) simp_all
qed

lemma limsup_root_limit:
  assumes "(\<lambda>n. ereal (root n (norm (f n)))) ----> l" (is "?g ----> _")
  shows   "limsup (\<lambda>n. ereal (root n (norm (f n)))) = l"
proof -
  from assms have "convergent ?g" "lim ?g = l"
    unfolding convergent_def by (blast intro: limI)+
  with convergent_limsup_cl show ?thesis by force
qed

lemma limsup_root_limit':
  assumes "(\<lambda>n. root n (norm (f n))) ----> l"
  shows   "limsup (\<lambda>n. ereal (root n (norm (f n)))) = ereal l"
  by (intro limsup_root_limit tendsto_ereal assms)

lemma root_test_convergence':
  fixes f :: "nat \<Rightarrow> 'a :: banach"
  defines "l \<equiv> limsup (\<lambda>n. ereal (root n (norm (f n))))"
  assumes l: "l < 1"
  shows   "summable f"
proof -
  have "0 = limsup (\<lambda>n. 0)" by (simp add: Limsup_const)
  also have "... \<le> l" unfolding l_def by (intro Limsup_mono) (simp_all add: real_root_ge_zero)
  finally have "l \<ge> 0" by simp
  with l obtain l' where l': "l = ereal l'" by (cases l) simp_all

  def c \<equiv> "(1 - l') / 2"
  from l and `l \<ge> 0` have c: "l + c > l" "l' + c \<ge> 0" "l' + c < 1" unfolding c_def
    by (simp_all add: field_simps l')
  have "\<forall>C>l. eventually (\<lambda>n. ereal (root n (norm (f n))) < C) sequentially"
    by (subst ge_Limsup_iff[symmetric]) (simp add: l_def)
  with c have "eventually (\<lambda>n. ereal (root n (norm (f n))) < l + ereal c) sequentially" by simp
  with eventually_gt_at_top[of "0::nat"]
    have "eventually (\<lambda>n. norm (f n) \<le> (l' + c) ^ n) sequentially"
  proof eventually_elim
    fix n :: nat assume n: "n > 0"
    assume "ereal (root n (norm (f n))) < l + ereal c"
    hence "root n (norm (f n)) \<le> l' + c" by (simp add: l')
    with c n have "root n (norm (f n)) ^ n \<le> (l' + c) ^ n"
      by (intro power_mono) (simp_all add: real_root_ge_zero)
    also from n have "root n (norm (f n)) ^ n = norm (f n)" by simp
    finally show "norm (f n) \<le> (l' + c) ^ n" by simp
  qed
  thus ?thesis
    by (rule summable_comparison_test_ev[OF _ summable_geometric]) (simp add: c)
qed

lemma root_test_divergence:
  fixes f :: "nat \<Rightarrow> 'a :: banach"
  defines "l \<equiv> limsup (\<lambda>n. ereal (root n (norm (f n))))"
  assumes l: "l > 1"
  shows   "\<not>summable f"
proof
  assume "summable f"
  hence bounded: "Bseq f" by (simp add: summable_imp_Bseq)

  have "0 = limsup (\<lambda>n. 0)" by (simp add: Limsup_const)
  also have "... \<le> l" unfolding l_def by (intro Limsup_mono) (simp_all add: real_root_ge_zero)
  finally have l_nonneg: "l \<ge> 0" by simp

  def c \<equiv> "if l = \<infinity> then 2 else 1 + (real_of_ereal l - 1) / 2"
  from l l_nonneg consider "l = \<infinity>" | "\<exists>l'. l = ereal l'" by (cases l) simp_all
  hence c: "c > 1 \<and> ereal c < l" by cases (insert l, auto simp: c_def field_simps)

  have unbounded: "\<not>bdd_above {n. root n (norm (f n)) > c}"
  proof
    assume "bdd_above {n. root n (norm (f n)) > c}"
    then obtain N where "\<forall>n. root n (norm (f n)) > c \<longrightarrow> n \<le> N" unfolding bdd_above_def by blast
    hence "\<exists>N. \<forall>n\<ge>N. root n (norm (f n)) \<le> c"
      by (intro exI[of _ "N + 1"]) (force simp: not_less_eq_eq[symmetric])
    hence "eventually (\<lambda>n. root n (norm (f n)) \<le> c) sequentially"
      by (auto simp: eventually_at_top_linorder)
    hence "l \<le> c" unfolding l_def by (intro Limsup_bounded) simp_all
    with c show False by auto
  qed

  from bounded obtain K where K: "K > 0" "\<And>n. norm (f n) \<le> K" using BseqE by blast
  def n \<equiv> "nat \<lceil>log c K\<rceil>"
  from unbounded have "\<exists>m>n. c < root m (norm (f m))" unfolding bdd_above_def
    by (auto simp: not_le)
  then guess m by (elim exE conjE) note m = this
  from c K have "K = c powr log c K" by (simp add: powr_def log_def)
  also from c have "c powr log c K \<le> c powr real n" unfolding n_def
    by (intro powr_mono, linarith, simp)
  finally have "K \<le> c ^ n" using c by (simp add: powr_realpow)
  also from c m have "c ^ n < c ^ m" by simp
  also from c m have "c ^ m < root m (norm (f m)) ^ m" by (intro power_strict_mono) simp_all
  also from m have "... = norm (f m)" by simp
  finally show False using K(2)[of m]  by simp
qed

subsection \<open>Cauchy's condensation test\<close>

context
fixes f :: "nat \<Rightarrow> real"
begin

private lemma condensation_inequality:
  assumes mono: "\<And>m n. 0 < m \<Longrightarrow> m \<le> n \<Longrightarrow> f n \<le> f m"
  shows   "(\<Sum>k=1..<n. f k) \<ge> (\<Sum>k=1..<n. f (2 * 2 ^ natlog2 k))" (is "?thesis1")
          "(\<Sum>k=1..<n. f k) \<le> (\<Sum>k=1..<n. f (2 ^ natlog2 k))" (is "?thesis2")
  by (intro setsum_mono mono pow_natlog2_ge pow_natlog2_le, simp, simp)+

private lemma condensation_condense1: "(\<Sum>k=1..<2^n. f (2 ^ natlog2 k)) = (\<Sum>k<n. 2^k * f (2 ^ k))"
proof (induction n)
  case (Suc n)
  have "{1..<2^Suc n} = {1..<2^n} \<union> {2^n..<(2^Suc n :: nat)}" by auto
  also have "(\<Sum>k\<in>\<dots>. f (2 ^ natlog2 k)) =
                 (\<Sum>k<n. 2^k * f (2^k)) + (\<Sum>k = 2^n..<2^Suc n. f (2^natlog2 k))"
    by (subst setsum.union_disjoint) (insert Suc, auto)
  also have "natlog2 k = n" if "k \<in> {2^n..<2^Suc n}" for k using that by (intro natlog2_eqI) simp_all
  hence "(\<Sum>k = 2^n..<2^Suc n. f (2^natlog2 k)) = (\<Sum>(_::nat) = 2^n..<2^Suc n. f (2^n))"
    by (intro setsum.cong) simp_all
  also have "\<dots> = 2^n * f (2^n)" by (simp add: of_nat_power)
  finally show ?case by simp
qed simp

private lemma condensation_condense2: "(\<Sum>k=1..<2^n. f (2 * 2 ^ natlog2 k)) = (\<Sum>k<n. 2^k * f (2 ^ Suc k))"
proof (induction n)
  case (Suc n)
  have "{1..<2^Suc n} = {1..<2^n} \<union> {2^n..<(2^Suc n :: nat)}" by auto
  also have "(\<Sum>k\<in>\<dots>. f (2 * 2 ^ natlog2 k)) =
                 (\<Sum>k<n. 2^k * f (2^Suc k)) + (\<Sum>k = 2^n..<2^Suc n. f (2 * 2^natlog2 k))"
    by (subst setsum.union_disjoint) (insert Suc, auto)
  also have "natlog2 k = n" if "k \<in> {2^n..<2^Suc n}" for k using that by (intro natlog2_eqI) simp_all
  hence "(\<Sum>k = 2^n..<2^Suc n. f (2*2^natlog2 k)) = (\<Sum>(_::nat) = 2^n..<2^Suc n. f (2^Suc n))"
    by (intro setsum.cong) simp_all
  also have "\<dots> = 2^n * f (2^Suc n)" by (simp add: of_nat_power)
  finally show ?case by simp
qed simp

lemma condensation_test:
  assumes mono: "\<And>m. 0 < m \<Longrightarrow> f (Suc m) \<le> f m"
  assumes nonneg: "\<And>n. f n \<ge> 0"
  shows "summable f \<longleftrightarrow> summable (\<lambda>n. 2^n * f (2^n))"
proof -
  def f' \<equiv> "\<lambda>n. if n = 0 then 0 else f n"
  from mono have mono': "decseq (\<lambda>n. f (Suc n))" by (intro decseq_SucI) simp
  hence mono': "f n \<le> f m" if "m \<le> n" "m > 0" for m n
    using that decseqD[OF mono', of "m - 1" "n - 1"] by simp

  have "(\<lambda>n. f (Suc n)) = (\<lambda>n. f' (Suc n))" by (intro ext) (simp add: f'_def)
  hence "summable f \<longleftrightarrow> summable f'"
    by (subst (1 2) summable_Suc_iff [symmetric]) (simp only:)
  also have "\<dots> \<longleftrightarrow> convergent (\<lambda>n. \<Sum>k<n. f' k)" unfolding summable_iff_convergent ..
  also have "monoseq (\<lambda>n. \<Sum>k<n. f' k)" unfolding f'_def
    by (intro mono_SucI1) (auto intro!: mult_nonneg_nonneg nonneg)
  hence "convergent (\<lambda>n. \<Sum>k<n. f' k) \<longleftrightarrow> Bseq (\<lambda>n. \<Sum>k<n. f' k)"
    by (rule monoseq_imp_convergent_iff_Bseq)
  also have "\<dots> \<longleftrightarrow> Bseq (\<lambda>n. \<Sum>k=1..<n. f' k)" unfolding One_nat_def
    by (subst setsum_shift_lb_Suc0_0_upt) (simp_all add: f'_def atLeast0LessThan)
  also have "\<dots> \<longleftrightarrow> Bseq (\<lambda>n. \<Sum>k=1..<n. f k)" unfolding f'_def by simp
  also have "\<dots> \<longleftrightarrow> Bseq (\<lambda>n. \<Sum>k=1..<2^n. f k)"
    by (rule nonneg_incseq_Bseq_subseq_iff[symmetric])
       (auto intro!: setsum_nonneg incseq_SucI nonneg simp: subseq_def)
  also have "\<dots> \<longleftrightarrow> Bseq (\<lambda>n. \<Sum>k<n. 2^k * f (2^k))"
  proof (intro iffI)
    assume A: "Bseq (\<lambda>n. \<Sum>k=1..<2^n. f k)"
    have "eventually (\<lambda>n. norm (\<Sum>k<n. 2^k * f (2^Suc k)) \<le> norm (\<Sum>k=1..<2^n. f k)) sequentially"
    proof (intro always_eventually allI)
      fix n :: nat
      have "norm (\<Sum>k<n. 2^k * f (2^Suc k)) = (\<Sum>k<n. 2^k * f (2^Suc k))" unfolding real_norm_def
        by (intro abs_of_nonneg setsum_nonneg ballI mult_nonneg_nonneg nonneg) simp_all
      also have "\<dots> \<le> (\<Sum>k=1..<2^n. f k)"
        by (subst condensation_condense2 [symmetric]) (intro condensation_inequality mono')
      also have "\<dots> = norm \<dots>" unfolding real_norm_def
        by (intro abs_of_nonneg[symmetric] setsum_nonneg ballI mult_nonneg_nonneg nonneg)
      finally show "norm (\<Sum>k<n. 2 ^ k * f (2 ^ Suc k)) \<le> norm (\<Sum>k=1..<2^n. f k)" .
    qed
    from this and A have "Bseq (\<lambda>n. \<Sum>k<n. 2^k * f (2^Suc k))" by (rule Bseq_eventually_mono)
    from Bseq_mult[OF Bfun_const[of 2] this] have "Bseq (\<lambda>n. \<Sum>k<n. 2^Suc k * f (2^Suc k))"
      by (simp add: setsum_right_distrib setsum_left_distrib mult_ac)
    hence "Bseq (\<lambda>n. (\<Sum>k=Suc 0..<Suc n. 2^k * f (2^k)) + f 1)"
      by (intro Bseq_add, subst setsum_shift_bounds_Suc_ivl) (simp add: atLeast0LessThan)
    hence "Bseq (\<lambda>n. (\<Sum>k=0..<Suc n. 2^k * f (2^k)))"
      by (subst setsum_head_upt_Suc) (simp_all add: add_ac)
    thus "Bseq (\<lambda>n. (\<Sum>k<n. 2^k * f (2^k)))"
      by (subst (asm) Bseq_Suc_iff) (simp add: atLeast0LessThan)
  next
    assume A: "Bseq (\<lambda>n. (\<Sum>k<n. 2^k * f (2^k)))"
    have "eventually (\<lambda>n. norm (\<Sum>k=1..<2^n. f k) \<le> norm (\<Sum>k<n. 2^k * f (2^k))) sequentially"
    proof (intro always_eventually allI)
      fix n :: nat
      have "norm (\<Sum>k=1..<2^n. f k) = (\<Sum>k=1..<2^n. f k)" unfolding real_norm_def
        by (intro abs_of_nonneg setsum_nonneg ballI mult_nonneg_nonneg nonneg)
      also have "\<dots> \<le> (\<Sum>k<n. 2^k * f (2^k))"
        by (subst condensation_condense1 [symmetric]) (intro condensation_inequality mono')
      also have "\<dots> = norm \<dots>" unfolding real_norm_def
        by (intro abs_of_nonneg [symmetric] setsum_nonneg ballI mult_nonneg_nonneg nonneg) simp_all
      finally show "norm (\<Sum>k=1..<2^n. f k) \<le> norm (\<Sum>k<n. 2^k * f (2^k))" .
    qed
    from this and A show "Bseq (\<lambda>n. \<Sum>k=1..<2^n. f k)" by (rule Bseq_eventually_mono)
  qed
  also have "monoseq (\<lambda>n. (\<Sum>k<n. 2^k * f (2^k)))"
    by (intro mono_SucI1) (auto intro!: mult_nonneg_nonneg nonneg)
  hence "Bseq (\<lambda>n. (\<Sum>k<n. 2^k * f (2^k))) \<longleftrightarrow> convergent (\<lambda>n. (\<Sum>k<n. 2^k * f (2^k)))"
    by (rule monoseq_imp_convergent_iff_Bseq [symmetric])
  also have "\<dots> \<longleftrightarrow> summable (\<lambda>k. 2^k * f (2^k))" by (simp only: summable_iff_convergent)
  finally show ?thesis .
qed

end

subsection \<open>Summability of powers\<close>

lemma abs_summable_complex_powr_iff:
    "summable (\<lambda>n. norm (exp (of_real (ln (of_nat n)) * s))) \<longleftrightarrow> Re s < -1"
proof (cases "Re s \<le> 0")
  let ?l = "\<lambda>n. complex_of_real (ln (of_nat n))"
  case False
  with eventually_gt_at_top[of "0::nat"]
    have "eventually (\<lambda>n. norm (1 :: real) \<le> norm (exp (?l n * s))) sequentially"
    by (auto intro!: ge_one_powr_ge_zero elim!: eventually_mono)
  from summable_comparison_test_ev[OF this] False show ?thesis by (auto simp: summable_const_iff)
next
  let ?l = "\<lambda>n. complex_of_real (ln (of_nat n))"
  case True
  hence "summable (\<lambda>n. norm (exp (?l n * s))) \<longleftrightarrow> summable (\<lambda>n. 2^n * norm (exp (?l (2^n) * s)))"
    by (intro condensation_test) (auto intro!: mult_right_mono_neg)
  also have "(\<lambda>n. 2^n * norm (exp (?l (2^n) * s))) = (\<lambda>n. (2 powr (Re s + 1)) ^ n)"
  proof
    fix n :: nat
    have "2^n * norm (exp (?l (2^n) * s)) = exp (real n * ln 2) * exp (real n * ln 2 * Re s)"
      using True by (subst exp_of_nat_mult) (simp add: ln_realpow algebra_simps)
    also have "\<dots> = exp (real n * (ln 2 * (Re s + 1)))"
      by (simp add: algebra_simps exp_add)
    also have "\<dots> = exp (ln 2 * (Re s + 1)) ^ n" by (subst exp_of_nat_mult) simp
    also have "exp (ln 2 * (Re s + 1)) = 2 powr (Re s + 1)" by (simp add: powr_def)
    finally show "2^n * norm (exp (?l (2^n) * s)) = (2 powr (Re s + 1)) ^ n" .
  qed
  also have "summable \<dots> \<longleftrightarrow> 2 powr (Re s + 1) < 2 powr 0"
    by (subst summable_geometric_iff) simp
  also have "\<dots> \<longleftrightarrow> Re s < -1" by (subst powr_less_cancel_iff) (simp, linarith)
  finally show ?thesis .
qed

lemma abs_summable_zetalike:
  assumes "Re s < -1" "Bseq a"
  shows   "summable (\<lambda>n. norm (a n * exp (complex_of_real (ln (of_nat n)) * s)))"
proof -
  from \<open>Bseq a\<close> obtain C where C: "C > 0" "\<And>n. norm (a n) \<le> C" unfolding Bseq_def by blast
  with assms have A: "summable (\<lambda>n. C * norm (exp (of_real (ln (of_nat n)) * s)))"
    by (intro summable_mult, subst abs_summable_complex_powr_iff)
  from C have B: "norm (norm (a n * exp (of_real (ln (of_nat n)) * s))) \<le>
                            C * norm (exp (of_real (ln (of_nat n)) * s))" for n
    by (auto simp: norm_mult)
  from summable_comparison_test'[OF A B] show ?thesis .
qed

lemma summable_zetalike:
  assumes "Re s < -1" "Bseq a"
  shows   "summable (\<lambda>n. a n * exp (complex_of_real (ln (of_nat n)) * s))"
  by (rule summable_norm_cancel, rule abs_summable_zetalike) fact+

lemma summable_complex_powr_iff:
  assumes "Re s < -1"
  shows   "summable (\<lambda>n. exp (of_real (ln (of_nat n)) * s))"
  by (rule summable_norm_cancel, subst abs_summable_complex_powr_iff) fact

lemma summable_real_powr_iff: "summable (\<lambda>n. of_nat n powr s :: real) \<longleftrightarrow> s < -1"
proof -
  from eventually_gt_at_top[of "0::nat"]
    have "summable (\<lambda>n. of_nat n powr s) \<longleftrightarrow> summable (\<lambda>n. exp (ln (of_nat n) * s))"
    by (intro summable_cong) (auto elim!: eventually_mono simp: powr_def)
  also have "\<dots> \<longleftrightarrow> s < -1" using abs_summable_complex_powr_iff[of "of_real s"] by simp
  finally show ?thesis .
qed

lemma inverse_power_summable:
  assumes s: "s \<ge> 2"
  shows "summable (\<lambda>n. inverse (of_nat n ^ s :: 'a :: {real_normed_div_algebra,banach}))"
proof (rule summable_norm_cancel, subst summable_cong)
  from eventually_gt_at_top[of "0::nat"]
    show "eventually (\<lambda>n. norm (inverse (of_nat n ^ s:: 'a)) = real_of_nat n powr (-real s)) at_top"
    by eventually_elim (simp add: norm_inverse norm_power powr_minus powr_realpow)
qed (insert s summable_real_powr_iff[of "-s"], simp_all)

lemma not_summable_harmonic: "\<not>summable (\<lambda>n. inverse (of_nat n) :: 'a :: real_normed_field)"
proof
  assume "summable (\<lambda>n. inverse (of_nat n) :: 'a)"
  hence "convergent (\<lambda>n. norm (of_real (\<Sum>k<n. inverse (of_nat k)) :: 'a))"
    by (simp add: summable_iff_convergent convergent_norm)
  hence "convergent (\<lambda>n. abs (\<Sum>k<n. inverse (of_nat k)) :: real)" by (simp only: norm_of_real)
  also have "(\<lambda>n. abs (\<Sum>k<n. inverse (of_nat k)) :: real) = (\<lambda>n. \<Sum>k<n. inverse (of_nat k))"
    by (intro ext abs_of_nonneg setsum_nonneg) auto
  also have "convergent \<dots> \<longleftrightarrow> summable (\<lambda>k. inverse (of_nat k) :: real)"
    by (simp add: summable_iff_convergent)
  finally show False using summable_real_powr_iff[of "-1"] by (simp add: powr_minus)
qed

subsection \<open>Kummer's test\<close>

lemma kummers_test_convergence:
  fixes f p :: "nat \<Rightarrow> real"
  assumes pos_f: "eventually (\<lambda>n. f n > 0) sequentially"
  assumes nonneg_p: "eventually (\<lambda>n. p n \<ge> 0) sequentially"
  defines "l \<equiv> liminf (\<lambda>n. ereal (p n * f n / f (Suc n) - p (Suc n)))"
  assumes l: "l > 0"
  shows   "summable f"
  unfolding summable_iff_convergent'
proof -
  def r \<equiv> "(if l = \<infinity> then 1 else real_of_ereal l / 2)"
  from l have "r > 0 \<and> of_real r < l" by (cases l) (simp_all add: r_def)
  hence r: "r > 0" "of_real r < l" by simp_all
  hence "eventually (\<lambda>n. p n * f n / f (Suc n) - p (Suc n) > r) sequentially"
    unfolding l_def by (force dest: less_LiminfD)
  moreover from pos_f have "eventually (\<lambda>n. f (Suc n) > 0) sequentially"
    by (subst eventually_sequentially_Suc)
  ultimately have "eventually (\<lambda>n. p n * f n - p (Suc n) * f (Suc n) > r * f (Suc n)) sequentially"
    by eventually_elim (simp add: field_simps)
  from eventually_conj[OF pos_f eventually_conj[OF nonneg_p this]]
    obtain m where m: "\<And>n. n \<ge> m \<Longrightarrow> f n > 0" "\<And>n. n \<ge> m \<Longrightarrow> p n \<ge> 0"
        "\<And>n. n \<ge> m \<Longrightarrow> p n * f n - p (Suc n) * f (Suc n) > r * f (Suc n)"
    unfolding eventually_at_top_linorder by blast

  let ?c = "(norm (\<Sum>k\<le>m. r * f k) + p m * f m) / r"
  have "Bseq (\<lambda>n. (\<Sum>k\<le>n + Suc m. f k))"
  proof (rule BseqI')
    fix k :: nat
    def n \<equiv> "k + Suc m"
    have n: "n > m" by (simp add: n_def)

    from r have "r * norm (\<Sum>k\<le>n. f k) = norm (\<Sum>k\<le>n. r * f k)"
      by (simp add: setsum_right_distrib[symmetric] abs_mult)
    also from n have "{..n} = {..m} \<union> {Suc m..n}" by auto
    hence "(\<Sum>k\<le>n. r * f k) = (\<Sum>k\<in>{..m} \<union> {Suc m..n}. r * f k)" by (simp only:)
    also have "\<dots> = (\<Sum>k\<le>m. r * f k) + (\<Sum>k=Suc m..n. r * f k)"
      by (subst setsum.union_disjoint) auto
    also have "norm \<dots> \<le> norm (\<Sum>k\<le>m. r * f k) + norm (\<Sum>k=Suc m..n. r * f k)"
      by (rule norm_triangle_ineq)
    also from r less_imp_le[OF m(1)] have "(\<Sum>k=Suc m..n. r * f k) \<ge> 0"
      by (intro setsum_nonneg) auto
    hence "norm (\<Sum>k=Suc m..n. r * f k) = (\<Sum>k=Suc m..n. r * f k)" by simp
    also have "(\<Sum>k=Suc m..n. r * f k) = (\<Sum>k=m..<n. r * f (Suc k))"
     by (subst setsum_shift_bounds_Suc_ivl [symmetric])
          (simp only: atLeastLessThanSuc_atLeastAtMost)
    also from m have "\<dots> \<le> (\<Sum>k=m..<n. p k * f k - p (Suc k) * f (Suc k))"
      by (intro setsum_mono[OF less_imp_le]) simp_all
    also have "\<dots> = -(\<Sum>k=m..<n. p (Suc k) * f (Suc k) - p k * f k)"
      by (simp add: setsum_negf [symmetric] algebra_simps)
    also from n have "\<dots> = p m * f m - p n * f n"
      by (cases n, simp, simp only: atLeastLessThanSuc_atLeastAtMost, subst setsum_Suc_diff) simp_all
    also from less_imp_le[OF m(1)] m(2) n have "\<dots> \<le> p m * f m" by simp
    finally show "norm (\<Sum>k\<le>n. f k) \<le> (norm (\<Sum>k\<le>m. r * f k) + p m * f m) / r" using r
      by (subst pos_le_divide_eq[OF r(1)]) (simp only: mult_ac)
  qed
  moreover have "(\<Sum>k\<le>n. f k) \<le> (\<Sum>k\<le>n'. f k)" if "Suc m \<le> n" "n \<le> n'" for n n'
    using less_imp_le[OF m(1)] that by (intro setsum_mono2) auto
  ultimately show "convergent (\<lambda>n. \<Sum>k\<le>n. f k)" by (rule Bseq_monoseq_convergent'_inc)
qed

lemma kummers_test_divergence:
  fixes f p :: "nat \<Rightarrow> real"
  assumes pos_f: "eventually (\<lambda>n. f n > 0) sequentially"
  assumes pos_p: "eventually (\<lambda>n. p n > 0) sequentially"
  assumes divergent_p: "\<not>summable (\<lambda>n. inverse (p n))"
  defines "l \<equiv> limsup (\<lambda>n. ereal (p n * f n / f (Suc n) - p (Suc n)))"
  assumes l: "l < 0"
  shows   "\<not>summable f"
proof
  assume "summable f"
  from eventually_conj[OF pos_f eventually_conj[OF pos_p gt_LimsupD[OF l[unfolded l_def]]]]
    obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> p n > 0" "\<And>n. n \<ge> N \<Longrightarrow> f n > 0"
                      "\<And>n. n \<ge> N \<Longrightarrow> p n * f n / f (Suc n) - p (Suc n) < 0"
    by (auto simp: eventually_at_top_linorder)
  hence A: "p n * f n < p (Suc n) * f (Suc n)" if "n \<ge> N" for n using that N[of n] N[of "Suc n"]
    by (simp add: field_simps)
  have "p n * f n \<ge> p N * f N" if "n \<ge> N" for n using that and A
      by (induction n rule: dec_induct) (auto intro!: less_imp_le elim!: order.trans)
  from eventually_ge_at_top[of N] N this
    have "eventually (\<lambda>n. norm (p N * f N * inverse (p n)) \<le> f n) sequentially"
    by (auto elim!: eventually_mono simp: field_simps abs_of_pos)
  from this and \<open>summable f\<close> have "summable (\<lambda>n. p N * f N * inverse (p n))"
    by (rule summable_comparison_test_ev)
  from summable_mult[OF this, of "inverse (p N * f N)"] N[OF le_refl]
    have "summable (\<lambda>n. inverse (p n))" by (simp add: divide_simps)
  with divergent_p show False by contradiction
qed

subsection \<open>Ratio test\<close>

lemma ratio_test_convergence:
  fixes f :: "nat \<Rightarrow> real"
  assumes pos_f: "eventually (\<lambda>n. f n > 0) sequentially"
  defines "l \<equiv> liminf (\<lambda>n. ereal (f n / f (Suc n)))"
  assumes l: "l > 1"
  shows   "summable f"
proof (rule kummers_test_convergence[OF pos_f])
  note l
  also have "l = liminf (\<lambda>n. ereal (f n / f (Suc n) - 1)) + 1"
    by (subst Liminf_add_ereal_right[symmetric]) (simp_all add: minus_ereal_def l_def one_ereal_def)
  finally show "liminf (\<lambda>n. ereal (1 * f n / f (Suc n) - 1)) > 0"
    by (cases "liminf (\<lambda>n. ereal (1 * f n / f (Suc n) - 1))") simp_all
qed simp

lemma ratio_test_divergence:
  fixes f :: "nat \<Rightarrow> real"
  assumes pos_f: "eventually (\<lambda>n. f n > 0) sequentially"
  defines "l \<equiv> limsup (\<lambda>n. ereal (f n / f (Suc n)))"
  assumes l: "l < 1"
  shows   "\<not>summable f"
proof (rule kummers_test_divergence[OF pos_f])
  have "limsup (\<lambda>n. ereal (f n / f (Suc n) - 1)) + 1 = l"
    by (subst Limsup_add_ereal_right[symmetric]) (simp_all add: minus_ereal_def l_def one_ereal_def)
  also note l
  finally show "limsup (\<lambda>n. ereal (1 * f n / f (Suc n) - 1)) < 0"
    by (cases "limsup (\<lambda>n. ereal (1 * f n / f (Suc n) - 1))") simp_all
qed (simp_all add: summable_const_iff)

subsection \<open>Raabe's test\<close>

lemma raabes_test_convergence:
fixes f :: "nat \<Rightarrow> real"
  assumes pos: "eventually (\<lambda>n. f n > 0) sequentially"
  defines "l \<equiv> liminf (\<lambda>n. ereal (of_nat n * (f n / f (Suc n) - 1)))"
  assumes l: "l > 1"
  shows   "summable f"
proof (rule kummers_test_convergence)
  let ?l' = "liminf (\<lambda>n. ereal (of_nat n * f n / f (Suc n) - of_nat (Suc n)))"
  have "1 < l" by fact
  also have "l = liminf (\<lambda>n. ereal (of_nat n * f n / f (Suc n) - of_nat (Suc n)) + 1)"
    by (simp add: l_def algebra_simps)
  also have "\<dots> = ?l' + 1" by (subst Liminf_add_ereal_right) simp_all
  finally show "?l' > 0" by (cases ?l') (simp_all add: algebra_simps)
qed (simp_all add: pos)

lemma raabes_test_divergence:
fixes f :: "nat \<Rightarrow> real"
  assumes pos: "eventually (\<lambda>n. f n > 0) sequentially"
  defines "l \<equiv> limsup (\<lambda>n. ereal (of_nat n * (f n / f (Suc n) - 1)))"
  assumes l: "l < 1"
  shows   "\<not>summable f"
proof (rule kummers_test_divergence)
  let ?l' = "limsup (\<lambda>n. ereal (of_nat n * f n / f (Suc n) - of_nat (Suc n)))"
  note l
  also have "l = limsup (\<lambda>n. ereal (of_nat n * f n / f (Suc n) - of_nat (Suc n)) + 1)"
    by (simp add: l_def algebra_simps)
  also have "\<dots> = ?l' + 1" by (subst Limsup_add_ereal_right) simp_all
  finally show "?l' < 0" by (cases ?l') (simp_all add: algebra_simps)
qed (insert pos eventually_gt_at_top[of "0::nat"] not_summable_harmonic, simp_all)

subsection \<open>Radius of convergence\<close>

text \<open>
  The radius of convergence of a power series. This value always exists, ranges from
  @{term "0::ereal"} to @{term "\<infinity>::ereal"}, and the power series is guaranteed to converge for
  all inputs with a norm that is smaller than that radius and to diverge for all inputs with a
  norm that is greater.
\<close>
definition conv_radius :: "(nat \<Rightarrow> 'a :: banach) \<Rightarrow> ereal" where
  "conv_radius f = inverse (limsup (\<lambda>n. ereal (root n (norm (f n)))))"

lemma conv_radius_nonneg: "conv_radius f \<ge> 0"
proof -
  have "0 = limsup (\<lambda>n. 0)" by (subst Limsup_const) simp_all
  also have "\<dots> \<le> limsup (\<lambda>n. ereal (root n (norm (f n))))"
    by (intro Limsup_mono) (simp_all add: real_root_ge_zero)
  finally show ?thesis
    unfolding conv_radius_def by (auto simp: ereal_inverse_nonneg_iff)
qed

lemma conv_radius_zero [simp]: "conv_radius (\<lambda>_. 0) = \<infinity>"
  by (auto simp: conv_radius_def zero_ereal_def [symmetric] Limsup_const)

lemma conv_radius_cong:
  assumes "eventually (\<lambda>x. f x = g x) sequentially"
  shows   "conv_radius f = conv_radius g"
proof -
  have "eventually (\<lambda>n. ereal (root n (norm (f n))) = ereal (root n (norm (g n)))) sequentially"
    using assms by eventually_elim simp
  from Limsup_eq[OF this] show ?thesis unfolding conv_radius_def by simp
qed

lemma conv_radius_altdef:
  "conv_radius f = liminf (\<lambda>n. inverse (ereal (root n (norm (f n)))))"
  by (subst Liminf_inverse_ereal) (simp_all add: real_root_ge_zero conv_radius_def)

lemma abs_summable_in_conv_radius:
  fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
  assumes "ereal (norm z) < conv_radius f"
  shows   "summable (\<lambda>n. norm (f n * z ^ n))"
proof (rule root_test_convergence')
  def l \<equiv> "limsup (\<lambda>n. ereal (root n (norm (f n))))"
  have "0 = limsup (\<lambda>n. 0)" by (simp add: Limsup_const)
  also have "... \<le> l" unfolding l_def by (intro Limsup_mono) (simp_all add: real_root_ge_zero)
  finally have l_nonneg: "l \<ge> 0" .

  have "limsup (\<lambda>n. root n (norm (f n * z^n))) = l * ereal (norm z)" unfolding l_def
    by (rule limsup_root_powser)
  also from l_nonneg consider "l = 0" | "l = \<infinity>" | "\<exists>l'. l = ereal l' \<and> l' > 0"
    by (cases "l") (auto simp: less_le)
  hence "l * ereal (norm z) < 1"
  proof cases
    assume "l = \<infinity>"
    hence "conv_radius f = 0" unfolding conv_radius_def l_def by simp
    with assms show ?thesis by simp
  next
    assume "\<exists>l'. l = ereal l' \<and> l' > 0"
    then guess l' by (elim exE conjE) note l' = this
    hence "l \<noteq> \<infinity>" by auto
    have "l * ereal (norm z) < l * conv_radius f"
      by (intro ereal_mult_strict_left_mono) (simp_all add: l' assms)
    also have "conv_radius f = inverse l" by (simp add: conv_radius_def l_def)
    also from l' have "l * inverse l = 1" by simp
    finally show ?thesis .
  qed simp_all
  finally show "limsup (\<lambda>n. ereal (root n (norm (norm (f n * z ^ n))))) < 1" by simp
qed

lemma summable_in_conv_radius:
  fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
  assumes "ereal (norm z) < conv_radius f"
  shows   "summable (\<lambda>n. f n * z ^ n)"
  by (rule summable_norm_cancel, rule abs_summable_in_conv_radius) fact+

lemma not_summable_outside_conv_radius:
  fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
  assumes "ereal (norm z) > conv_radius f"
  shows   "\<not>summable (\<lambda>n. f n * z ^ n)"
proof (rule root_test_divergence)
  def l \<equiv> "limsup (\<lambda>n. ereal (root n (norm (f n))))"
  have "0 = limsup (\<lambda>n. 0)" by (simp add: Limsup_const)
  also have "... \<le> l" unfolding l_def by (intro Limsup_mono) (simp_all add: real_root_ge_zero)
  finally have l_nonneg: "l \<ge> 0" .
  from assms have l_nz: "l \<noteq> 0" unfolding conv_radius_def l_def by auto

  have "limsup (\<lambda>n. ereal (root n (norm (f n * z^n)))) = l * ereal (norm z)"
    unfolding l_def by (rule limsup_root_powser)
  also have "... > 1"
  proof (cases l)
    assume "l = \<infinity>"
    with assms conv_radius_nonneg[of f] show ?thesis
      by (auto simp: zero_ereal_def[symmetric])
  next
    fix l' assume l': "l = ereal l'"
    from l_nonneg l_nz have "1 = l * inverse l" by (auto simp: l' field_simps)
    also from l_nz have "inverse l = conv_radius f"
      unfolding l_def conv_radius_def by auto
    also from l' l_nz l_nonneg assms have "l * \<dots> < l * ereal (norm z)"
      by (intro ereal_mult_strict_left_mono) (auto simp: l')
    finally show ?thesis .
  qed (insert l_nonneg, simp_all)
  finally show "limsup (\<lambda>n. ereal (root n (norm (f n * z^n)))) > 1" .
qed

lemma conv_radius_geI:
  assumes "summable (\<lambda>n. f n * z ^ n :: 'a :: {banach, real_normed_div_algebra})"
  shows   "conv_radius f \<ge> norm z"
  using not_summable_outside_conv_radius[of f z] assms by (force simp: not_le[symmetric])

lemma conv_radius_leI:
  assumes "\<not>summable (\<lambda>n. norm (f n * z ^ n :: 'a :: {banach, real_normed_div_algebra}))"
  shows   "conv_radius f \<le> norm z"
  using abs_summable_in_conv_radius[of z f] assms by (force simp: not_le[symmetric])

lemma conv_radius_leI':
  assumes "\<not>summable (\<lambda>n. f n * z ^ n :: 'a :: {banach, real_normed_div_algebra})"
  shows   "conv_radius f \<le> norm z"
  using summable_in_conv_radius[of z f] assms by (force simp: not_le[symmetric])

lemma conv_radius_geI_ex:
  fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
  assumes "\<And>r. 0 < r \<Longrightarrow> ereal r < R \<Longrightarrow> \<exists>z. norm z = r \<and> summable (\<lambda>n. f n * z^n)"
  shows   "conv_radius f \<ge> R"
proof (rule linorder_cases[of "conv_radius f" R])
  assume R: "conv_radius f < R"
  with conv_radius_nonneg[of f] obtain conv_radius'
    where [simp]: "conv_radius f = ereal conv_radius'"
    by (cases "conv_radius f") simp_all
  def r \<equiv> "if R = \<infinity> then conv_radius' + 1 else (real_of_ereal R + conv_radius') / 2"
  from R conv_radius_nonneg[of f] have "0 < r \<and> ereal r < R \<and> ereal r > conv_radius f"
    unfolding r_def by (cases R) (auto simp: r_def field_simps)
  with assms(1)[of r] obtain z where "norm z > conv_radius f" "summable (\<lambda>n. f n * z^n)" by auto
  with not_summable_outside_conv_radius[of f z] show ?thesis by simp
qed simp_all

lemma conv_radius_geI_ex':
  fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
  assumes "\<And>r. 0 < r \<Longrightarrow> ereal r < R \<Longrightarrow> summable (\<lambda>n. f n * of_real r^n)"
  shows   "conv_radius f \<ge> R"
proof (rule conv_radius_geI_ex)
  fix r assume "0 < r" "ereal r < R"
  with assms[of r] show "\<exists>z. norm z = r \<and> summable (\<lambda>n. f n * z ^ n)"
    by (intro exI[of _ "of_real r :: 'a"]) auto
qed

lemma conv_radius_leI_ex:
  fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
  assumes "R \<ge> 0"
  assumes "\<And>r. 0 < r \<Longrightarrow> ereal r > R \<Longrightarrow> \<exists>z. norm z = r \<and> \<not>summable (\<lambda>n. norm (f n * z^n))"
  shows   "conv_radius f \<le> R"
proof (rule linorder_cases[of "conv_radius f" R])
  assume R: "conv_radius f > R"
  from R assms(1) obtain R' where R': "R = ereal R'" by (cases R) simp_all
  def r \<equiv> "if conv_radius f = \<infinity> then R' + 1 else (R' + real_of_ereal (conv_radius f)) / 2"
  from R conv_radius_nonneg[of f] have "r > R \<and> r < conv_radius f" unfolding r_def
    by (cases "conv_radius f") (auto simp: r_def field_simps R')
  with assms(1) assms(2)[of r] R'
    obtain z where "norm z < conv_radius f" "\<not>summable (\<lambda>n. norm (f n * z^n))" by auto
  with abs_summable_in_conv_radius[of z f] show ?thesis by auto
qed simp_all

lemma conv_radius_leI_ex':
  fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
  assumes "R \<ge> 0"
  assumes "\<And>r. 0 < r \<Longrightarrow> ereal r > R \<Longrightarrow> \<not>summable (\<lambda>n. f n * of_real r^n)"
  shows   "conv_radius f \<le> R"
proof (rule conv_radius_leI_ex)
  fix r assume "0 < r" "ereal r > R"
  with assms(2)[of r] show "\<exists>z. norm z = r \<and> \<not>summable (\<lambda>n. norm (f n * z ^ n))"
    by (intro exI[of _ "of_real r :: 'a"]) (auto dest: summable_norm_cancel)
qed fact+

lemma conv_radius_eqI:
  fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
  assumes "R \<ge> 0"
  assumes "\<And>r. 0 < r \<Longrightarrow> ereal r < R \<Longrightarrow> \<exists>z. norm z = r \<and> summable (\<lambda>n. f n * z^n)"
  assumes "\<And>r. 0 < r \<Longrightarrow> ereal r > R \<Longrightarrow> \<exists>z. norm z = r \<and> \<not>summable (\<lambda>n. norm (f n * z^n))"
  shows   "conv_radius f = R"
  by (intro antisym conv_radius_geI_ex conv_radius_leI_ex assms)

lemma conv_radius_eqI':
  fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
  assumes "R \<ge> 0"
  assumes "\<And>r. 0 < r \<Longrightarrow> ereal r < R \<Longrightarrow> summable (\<lambda>n. f n * (of_real r)^n)"
  assumes "\<And>r. 0 < r \<Longrightarrow> ereal r > R \<Longrightarrow> \<not>summable (\<lambda>n. norm (f n * (of_real r)^n))"
  shows   "conv_radius f = R"
proof (intro conv_radius_eqI[OF assms(1)])
  fix r assume "0 < r" "ereal r < R" with assms(2)[OF this]
    show "\<exists>z. norm z = r \<and> summable (\<lambda>n. f n * z ^ n)" by force
next
  fix r assume "0 < r" "ereal r > R" with assms(3)[OF this]
    show "\<exists>z. norm z = r \<and> \<not>summable (\<lambda>n. norm (f n * z ^ n))" by force
qed

lemma conv_radius_zeroI:
  fixes f :: "nat \<Rightarrow> 'a :: {banach,real_normed_div_algebra}"
  assumes "\<And>z. z \<noteq> 0 \<Longrightarrow> \<not>summable (\<lambda>n. f n * z^n)"
  shows   "conv_radius f = 0"
proof (rule ccontr)
  assume "conv_radius f \<noteq> 0"
  with conv_radius_nonneg[of f] have pos: "conv_radius f > 0" by simp
  def r \<equiv> "if conv_radius f = \<infinity> then 1 else real_of_ereal (conv_radius f) / 2"
  from pos have r: "ereal r > 0 \<and> ereal r < conv_radius f"
    by (cases "conv_radius f") (simp_all add: r_def)
  hence "summable (\<lambda>n. f n * of_real r ^ n)" by (intro summable_in_conv_radius) simp
  moreover from r and assms[of "of_real r"] have "\<not>summable (\<lambda>n. f n * of_real r ^ n)" by simp
  ultimately show False by contradiction
qed

lemma conv_radius_inftyI':
  fixes f :: "nat \<Rightarrow> 'a :: {banach,real_normed_div_algebra}"
  assumes "\<And>r. r > c \<Longrightarrow> \<exists>z. norm z = r \<and> summable (\<lambda>n. f n * z^n)"
  shows   "conv_radius f = \<infinity>"
proof -
  {
    fix r :: real
    have "max r (c + 1) > c" by (auto simp: max_def)
    from assms[OF this] obtain z where "norm z = max r (c + 1)" "summable (\<lambda>n. f n * z^n)" by blast
    from conv_radius_geI[OF this(2)] this(1) have "conv_radius f \<ge> r" by simp
  }
  from this[of "real_of_ereal (conv_radius f + 1)"] show "conv_radius f = \<infinity>"
    by (cases "conv_radius f") simp_all
qed

lemma conv_radius_inftyI:
  fixes f :: "nat \<Rightarrow> 'a :: {banach,real_normed_div_algebra}"
  assumes "\<And>r. \<exists>z. norm z = r \<and> summable (\<lambda>n. f n * z^n)"
  shows   "conv_radius f = \<infinity>"
  using assms by (rule conv_radius_inftyI')

lemma conv_radius_inftyI'':
  fixes f :: "nat \<Rightarrow> 'a :: {banach,real_normed_div_algebra}"
  assumes "\<And>z. summable (\<lambda>n. f n * z^n)"
  shows   "conv_radius f = \<infinity>"
proof (rule conv_radius_inftyI')
  fix r :: real assume "r > 0"
  with assms show "\<exists>z. norm z = r \<and> summable (\<lambda>n. f n * z^n)"
    by (intro exI[of _ "of_real r"]) simp
qed

lemma conv_radius_ratio_limit_ereal:
  fixes f :: "nat \<Rightarrow> 'a :: {banach,real_normed_div_algebra}"
  assumes nz:  "eventually (\<lambda>n. f n \<noteq> 0) sequentially"
  assumes lim: "(\<lambda>n. ereal (norm (f n) / norm (f (Suc n)))) ----> c"
  shows   "conv_radius f = c"
proof (rule conv_radius_eqI')
  show "c \<ge> 0" by (intro Lim_bounded2_ereal[OF lim]) simp_all
next
  fix r assume r: "0 < r" "ereal r < c"
  let ?l = "liminf (\<lambda>n. ereal (norm (f n * of_real r ^ n) / norm (f (Suc n) * of_real r ^ Suc n)))"
  have "?l = liminf (\<lambda>n. ereal (norm (f n) / (norm (f (Suc n)))) * ereal (inverse r))"
    using r by (simp add: norm_mult norm_power divide_simps)
  also from r have "\<dots> = liminf (\<lambda>n. ereal (norm (f n) / (norm (f (Suc n))))) * ereal (inverse r)"
    by (intro Liminf_ereal_mult_right) simp_all
  also have "liminf (\<lambda>n. ereal (norm (f n) / (norm (f (Suc n))))) = c"
    by (intro lim_imp_Liminf lim) simp
  finally have l: "?l = c * ereal (inverse r)" by simp
  from r have  l': "c * ereal (inverse r) > 1" by (cases c) (simp_all add: field_simps)
  show "summable (\<lambda>n. f n * of_real r^n)"
    by (rule summable_norm_cancel, rule ratio_test_convergence)
       (insert r nz l l', auto elim!: eventually_mono)
next
  fix r assume r: "0 < r" "ereal r > c"
  let ?l = "limsup (\<lambda>n. ereal (norm (f n * of_real r ^ n) / norm (f (Suc n) * of_real r ^ Suc n)))"
  have "?l = limsup (\<lambda>n. ereal (norm (f n) / (norm (f (Suc n)))) * ereal (inverse r))"
    using r by (simp add: norm_mult norm_power divide_simps)
  also from r have "\<dots> = limsup (\<lambda>n. ereal (norm (f n) / (norm (f (Suc n))))) * ereal (inverse r)"
    by (intro Limsup_ereal_mult_right) simp_all
  also have "limsup (\<lambda>n. ereal (norm (f n) / (norm (f (Suc n))))) = c"
    by (intro lim_imp_Limsup lim) simp
  finally have l: "?l = c * ereal (inverse r)" by simp
  from r have  l': "c * ereal (inverse r) < 1" by (cases c) (simp_all add: field_simps)
  show "\<not>summable (\<lambda>n. norm (f n * of_real r^n))"
    by (rule ratio_test_divergence) (insert r nz l l', auto elim!: eventually_mono)
qed

lemma conv_radius_ratio_limit_ereal_nonzero:
  fixes f :: "nat \<Rightarrow> 'a :: {banach,real_normed_div_algebra}"
  assumes nz:  "c \<noteq> 0"
  assumes lim: "(\<lambda>n. ereal (norm (f n) / norm (f (Suc n)))) ----> c"
  shows   "conv_radius f = c"
proof (rule conv_radius_ratio_limit_ereal[OF _ lim], rule ccontr)
  assume "\<not>eventually (\<lambda>n. f n \<noteq> 0) sequentially"
  hence "frequently (\<lambda>n. f n = 0) sequentially" by (simp add: frequently_def)
  hence "frequently (\<lambda>n. ereal (norm (f n) / norm (f (Suc n))) = 0) sequentially"
    by (force elim!: frequently_elim1)
  hence "c = 0" by (intro limit_frequently_eq[OF _ _ lim]) auto
  with nz show False by contradiction
qed

lemma conv_radius_ratio_limit:
  fixes f :: "nat \<Rightarrow> 'a :: {banach,real_normed_div_algebra}"
  assumes "c' = ereal c"
  assumes nz:  "eventually (\<lambda>n. f n \<noteq> 0) sequentially"
  assumes lim: "(\<lambda>n. norm (f n) / norm (f (Suc n))) ----> c"
  shows   "conv_radius f = c'"
  using assms by (intro conv_radius_ratio_limit_ereal) simp_all

lemma conv_radius_ratio_limit_nonzero:
  fixes f :: "nat \<Rightarrow> 'a :: {banach,real_normed_div_algebra}"
  assumes "c' = ereal c"
  assumes nz:  "c \<noteq> 0"
  assumes lim: "(\<lambda>n. norm (f n) / norm (f (Suc n))) ----> c"
  shows   "conv_radius f = c'"
  using assms by (intro conv_radius_ratio_limit_ereal_nonzero) simp_all

lemma conv_radius_mult_power:
  assumes "c \<noteq> (0 :: 'a :: {real_normed_div_algebra,banach})"
  shows   "conv_radius (\<lambda>n. c ^ n * f n) = conv_radius f / ereal (norm c)"
proof -
  have "limsup (\<lambda>n. ereal (root n (norm (c ^ n * f n)))) =
          limsup (\<lambda>n. ereal (norm c) * ereal (root n (norm (f n))))"
    using eventually_gt_at_top[of "0::nat"]
    by (intro Limsup_eq)
       (auto elim!: eventually_mono simp: norm_mult norm_power real_root_mult real_root_power)
  also have "\<dots> = ereal (norm c) * limsup (\<lambda>n. ereal (root n (norm (f n))))"
    using assms by (subst Limsup_ereal_mult_left[symmetric]) simp_all
  finally have A: "limsup (\<lambda>n. ereal (root n (norm (c ^ n * f n)))) =
                       ereal (norm c) * limsup (\<lambda>n. ereal (root n (norm (f n))))" .
  show ?thesis using assms
    apply (cases "limsup (\<lambda>n. ereal (root n (norm (f n)))) = 0")
    apply (simp add: A conv_radius_def)
    apply (unfold conv_radius_def A divide_ereal_def, simp add: mult.commute ereal_inverse_mult)
    done
qed

lemma conv_radius_mult_power_right:
  assumes "c \<noteq> (0 :: 'a :: {real_normed_div_algebra,banach})"
  shows   "conv_radius (\<lambda>n. f n * c ^ n) = conv_radius f / ereal (norm c)"
  using conv_radius_mult_power[OF assms, of f]
  unfolding conv_radius_def by (simp add: mult.commute norm_mult)

lemma conv_radius_divide_power:
  assumes "c \<noteq> (0 :: 'a :: {real_normed_div_algebra,banach})"
  shows   "conv_radius (\<lambda>n. f n / c^n) = conv_radius f * ereal (norm c)"
proof -
  from assms have "inverse c \<noteq> 0" by simp
  from conv_radius_mult_power_right[OF this, of f] show ?thesis
    by (simp add: divide_inverse divide_ereal_def assms norm_inverse power_inverse)
qed

lemma conv_radius_add_ge:
  "min (conv_radius f) (conv_radius g) \<le>
       conv_radius (\<lambda>x. f x + g x :: 'a :: {banach,real_normed_div_algebra})"
  by (rule conv_radius_geI_ex')
     (auto simp: algebra_simps intro!: summable_add summable_in_conv_radius)

lemma summable_Cauchy_product:
  assumes "summable (\<lambda>k. norm (a k :: 'a :: {real_normed_algebra,banach}))"
          "summable (\<lambda>k. norm (b k))"
  shows   "summable (\<lambda>k. \<Sum>i\<le>k. a i * b (k - i))"
  using Cauchy_product_sums[OF assms] by (simp add: sums_iff)

(* TODO: Move *)
lemma scaleR_power:
  fixes y :: "'a :: real_normed_algebra_1"
  shows "(scaleR x y) ^ n = scaleR (x^n) (y^n)"
  by (induction n) simp_all

lemma conv_radius_mult_ge:
  fixes f g :: "nat \<Rightarrow> ('a :: {banach,real_normed_div_algebra})"
  shows "conv_radius (\<lambda>x. \<Sum>i\<le>x. f i * g (x - i)) \<ge> min (conv_radius f) (conv_radius g)"
proof (rule conv_radius_geI_ex')
  fix r assume r: "r > 0" "ereal r < min (conv_radius f) (conv_radius g)"
  from r have "summable (\<lambda>n. (\<Sum>i\<le>n. (f i * of_real r^i) * (g (n - i) * of_real r^(n - i))))"
    by (intro summable_Cauchy_product abs_summable_in_conv_radius) simp_all
  thus "summable (\<lambda>n. (\<Sum>i\<le>n. f i * g (n - i)) * of_real r ^ n)"
    by (simp add: algebra_simps of_real_def scaleR_power power_add [symmetric] scaleR_setsum_right)
qed

end


(*  Title:      HOL/Library/Liminf_Limsup.thy
    Author:     Johannes Hölzl, TU München
*)

section {* Liminf and Limsup on complete lattices *}

theory Liminf_Limsup
imports Complex_Main
begin

lemma le_Sup_iff_less:
  fixes x :: "'a :: {complete_linorder, dense_linorder}"
  shows "x \<le> (SUP i:A. f i) \<longleftrightarrow> (\<forall>y<x. \<exists>i\<in>A. y \<le> f i)" (is "?lhs = ?rhs")
  unfolding le_SUP_iff
  by (blast intro: less_imp_le less_trans less_le_trans dest: dense)

lemma Inf_le_iff_less:
  fixes x :: "'a :: {complete_linorder, dense_linorder}"
  shows "(INF i:A. f i) \<le> x \<longleftrightarrow> (\<forall>y>x. \<exists>i\<in>A. f i \<le> y)"
  unfolding INF_le_iff
  by (blast intro: less_imp_le less_trans le_less_trans dest: dense)

lemma SUP_pair:
  fixes f :: "_ \<Rightarrow> _ \<Rightarrow> _ :: complete_lattice"
  shows "(SUP i : A. SUP j : B. f i j) = (SUP p : A \<times> B. f (fst p) (snd p))"
  by (rule antisym) (auto intro!: SUP_least SUP_upper2)

lemma INF_pair:
  fixes f :: "_ \<Rightarrow> _ \<Rightarrow> _ :: complete_lattice"
  shows "(INF i : A. INF j : B. f i j) = (INF p : A \<times> B. f (fst p) (snd p))"
  by (rule antisym) (auto intro!: INF_greatest INF_lower2)

subsubsection {* @{text Liminf} and @{text Limsup} *}

definition Liminf :: "'a filter \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b :: complete_lattice" where
  "Liminf F f = (SUP P:{P. eventually P F}. INF x:{x. P x}. f x)"

definition Limsup :: "'a filter \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b :: complete_lattice" where
  "Limsup F f = (INF P:{P. eventually P F}. SUP x:{x. P x}. f x)"

abbreviation "liminf \<equiv> Liminf sequentially"

abbreviation "limsup \<equiv> Limsup sequentially"

lemma Liminf_eqI:
  "(\<And>P. eventually P F \<Longrightarrow> INFIMUM (Collect P) f \<le> x) \<Longrightarrow>
    (\<And>y. (\<And>P. eventually P F \<Longrightarrow> INFIMUM (Collect P) f \<le> y) \<Longrightarrow> x \<le> y) \<Longrightarrow> Liminf F f = x"
  unfolding Liminf_def by (auto intro!: SUP_eqI)

lemma Limsup_eqI:
  "(\<And>P. eventually P F \<Longrightarrow> x \<le> SUPREMUM (Collect P) f) \<Longrightarrow>
    (\<And>y. (\<And>P. eventually P F \<Longrightarrow> y \<le> SUPREMUM (Collect P) f) \<Longrightarrow> y \<le> x) \<Longrightarrow> Limsup F f = x"
  unfolding Limsup_def by (auto intro!: INF_eqI)

lemma liminf_SUP_INF: "liminf f = (SUP n. INF m:{n..}. f m)"
  unfolding Liminf_def eventually_sequentially
  by (rule SUP_eq) (auto simp: atLeast_def intro!: INF_mono)

lemma limsup_INF_SUP: "limsup f = (INF n. SUP m:{n..}. f m)"
  unfolding Limsup_def eventually_sequentially
  by (rule INF_eq) (auto simp: atLeast_def intro!: SUP_mono)

lemma Limsup_const:
  assumes ntriv: "\<not> trivial_limit F"
  shows "Limsup F (\<lambda>x. c) = c"
proof -
  have *: "\<And>P. Ex P \<longleftrightarrow> P \<noteq> (\<lambda>x. False)" by auto
  have "\<And>P. eventually P F \<Longrightarrow> (SUP x : {x. P x}. c) = c"
    using ntriv by (intro SUP_const) (auto simp: eventually_False *)
  then show ?thesis
    unfolding Limsup_def using eventually_True
    by (subst INF_cong[where D="\<lambda>x. c"])
       (auto intro!: INF_const simp del: eventually_True)
qed

lemma Liminf_const:
  assumes ntriv: "\<not> trivial_limit F"
  shows "Liminf F (\<lambda>x. c) = c"
proof -
  have *: "\<And>P. Ex P \<longleftrightarrow> P \<noteq> (\<lambda>x. False)" by auto
  have "\<And>P. eventually P F \<Longrightarrow> (INF x : {x. P x}. c) = c"
    using ntriv by (intro INF_const) (auto simp: eventually_False *)
  then show ?thesis
    unfolding Liminf_def using eventually_True
    by (subst SUP_cong[where D="\<lambda>x. c"])
       (auto intro!: SUP_const simp del: eventually_True)
qed

lemma Liminf_mono:
  assumes ev: "eventually (\<lambda>x. f x \<le> g x) F"
  shows "Liminf F f \<le> Liminf F g"
  unfolding Liminf_def
proof (safe intro!: SUP_mono)
  fix P assume "eventually P F"
  with ev have "eventually (\<lambda>x. f x \<le> g x \<and> P x) F" (is "eventually ?Q F") by (rule eventually_conj)
  then show "\<exists>Q\<in>{P. eventually P F}. INFIMUM (Collect P) f \<le> INFIMUM (Collect Q) g"
    by (intro bexI[of _ ?Q]) (auto intro!: INF_mono)
qed

lemma Liminf_eq:
  assumes "eventually (\<lambda>x. f x = g x) F"
  shows "Liminf F f = Liminf F g"
  by (intro antisym Liminf_mono eventually_mono[OF _ assms]) auto

lemma Limsup_mono:
  assumes ev: "eventually (\<lambda>x. f x \<le> g x) F"
  shows "Limsup F f \<le> Limsup F g"
  unfolding Limsup_def
proof (safe intro!: INF_mono)
  fix P assume "eventually P F"
  with ev have "eventually (\<lambda>x. f x \<le> g x \<and> P x) F" (is "eventually ?Q F") by (rule eventually_conj)
  then show "\<exists>Q\<in>{P. eventually P F}. SUPREMUM (Collect Q) f \<le> SUPREMUM (Collect P) g"
    by (intro bexI[of _ ?Q]) (auto intro!: SUP_mono)
qed

lemma Limsup_eq:
  assumes "eventually (\<lambda>x. f x = g x) net"
  shows "Limsup net f = Limsup net g"
  by (intro antisym Limsup_mono eventually_mono[OF _ assms]) auto

lemma Liminf_le_Limsup:
  assumes ntriv: "\<not> trivial_limit F"
  shows "Liminf F f \<le> Limsup F f"
  unfolding Limsup_def Liminf_def
  apply (rule SUP_least)
  apply (rule INF_greatest)
proof safe
  fix P Q assume "eventually P F" "eventually Q F"
  then have "eventually (\<lambda>x. P x \<and> Q x) F" (is "eventually ?C F") by (rule eventually_conj)
  then have not_False: "(\<lambda>x. P x \<and> Q x) \<noteq> (\<lambda>x. False)"
    using ntriv by (auto simp add: eventually_False)
  have "INFIMUM (Collect P) f \<le> INFIMUM (Collect ?C) f"
    by (rule INF_mono) auto
  also have "\<dots> \<le> SUPREMUM (Collect ?C) f"
    using not_False by (intro INF_le_SUP) auto
  also have "\<dots> \<le> SUPREMUM (Collect Q) f"
    by (rule SUP_mono) auto
  finally show "INFIMUM (Collect P) f \<le> SUPREMUM (Collect Q) f" .
qed

lemma Liminf_bounded:
  assumes ntriv: "\<not> trivial_limit F"
  assumes le: "eventually (\<lambda>n. C \<le> X n) F"
  shows "C \<le> Liminf F X"
  using Liminf_mono[OF le] Liminf_const[OF ntriv, of C] by simp

lemma Limsup_bounded:
  assumes ntriv: "\<not> trivial_limit F"
  assumes le: "eventually (\<lambda>n. X n \<le> C) F"
  shows "Limsup F X \<le> C"
  using Limsup_mono[OF le] Limsup_const[OF ntriv, of C] by simp

lemma le_Liminf_iff:
  fixes X :: "_ \<Rightarrow> _ :: complete_linorder"
  shows "C \<le> Liminf F X \<longleftrightarrow> (\<forall>y<C. eventually (\<lambda>x. y < X x) F)"
proof -
  { fix y P assume "eventually P F" "y < INFIMUM (Collect P) X"
    then have "eventually (\<lambda>x. y < X x) F"
      by (auto elim!: eventually_elim1 dest: less_INF_D) }
  moreover
  { fix y P assume "y < C" and y: "\<forall>y<C. eventually (\<lambda>x. y < X x) F"
    have "\<exists>P. eventually P F \<and> y < INFIMUM (Collect P) X"
    proof (cases "\<exists>z. y < z \<and> z < C")
      case True
      then obtain z where z: "y < z \<and> z < C" ..
      moreover from z have "z \<le> INFIMUM {x. z < X x} X"
        by (auto intro!: INF_greatest)
      ultimately show ?thesis
        using y by (intro exI[of _ "\<lambda>x. z < X x"]) auto
    next
      case False
      then have "C \<le> INFIMUM {x. y < X x} X"
        by (intro INF_greatest) auto
      with `y < C` show ?thesis
        using y by (intro exI[of _ "\<lambda>x. y < X x"]) auto
    qed }
  ultimately show ?thesis
    unfolding Liminf_def le_SUP_iff by auto
qed

lemma lim_imp_Liminf:
  fixes f :: "'a \<Rightarrow> _ :: {complete_linorder, linorder_topology}"
  assumes ntriv: "\<not> trivial_limit F"
  assumes lim: "(f ---> f0) F"
  shows "Liminf F f = f0"
proof (intro Liminf_eqI)
  fix P assume P: "eventually P F"
  then have "eventually (\<lambda>x. INFIMUM (Collect P) f \<le> f x) F"
    by eventually_elim (auto intro!: INF_lower)
  then show "INFIMUM (Collect P) f \<le> f0"
    by (rule tendsto_le[OF ntriv lim tendsto_const])
next
  fix y assume upper: "\<And>P. eventually P F \<Longrightarrow> INFIMUM (Collect P) f \<le> y"
  show "f0 \<le> y"
  proof cases
    assume "\<exists>z. y < z \<and> z < f0"
    then obtain z where "y < z \<and> z < f0" ..
    moreover have "z \<le> INFIMUM {x. z < f x} f"
      by (rule INF_greatest) simp
    ultimately show ?thesis
      using lim[THEN topological_tendstoD, THEN upper, of "{z <..}"] by auto
  next
    assume discrete: "\<not> (\<exists>z. y < z \<and> z < f0)"
    show ?thesis
    proof (rule classical)
      assume "\<not> f0 \<le> y"
      then have "eventually (\<lambda>x. y < f x) F"
        using lim[THEN topological_tendstoD, of "{y <..}"] by auto
      then have "eventually (\<lambda>x. f0 \<le> f x) F"
        using discrete by (auto elim!: eventually_elim1)
      then have "INFIMUM {x. f0 \<le> f x} f \<le> y"
        by (rule upper)
      moreover have "f0 \<le> INFIMUM {x. f0 \<le> f x} f"
        by (intro INF_greatest) simp
      ultimately show "f0 \<le> y" by simp
    qed
  qed
qed

lemma lim_imp_Limsup:
  fixes f :: "'a \<Rightarrow> _ :: {complete_linorder, linorder_topology}"
  assumes ntriv: "\<not> trivial_limit F"
  assumes lim: "(f ---> f0) F"
  shows "Limsup F f = f0"
proof (intro Limsup_eqI)
  fix P assume P: "eventually P F"
  then have "eventually (\<lambda>x. f x \<le> SUPREMUM (Collect P) f) F"
    by eventually_elim (auto intro!: SUP_upper)
  then show "f0 \<le> SUPREMUM (Collect P) f"
    by (rule tendsto_le[OF ntriv tendsto_const lim])
next
  fix y assume lower: "\<And>P. eventually P F \<Longrightarrow> y \<le> SUPREMUM (Collect P) f"
  show "y \<le> f0"
  proof (cases "\<exists>z. f0 < z \<and> z < y")
    case True
    then obtain z where "f0 < z \<and> z < y" ..
    moreover have "SUPREMUM {x. f x < z} f \<le> z"
      by (rule SUP_least) simp
    ultimately show ?thesis
      using lim[THEN topological_tendstoD, THEN lower, of "{..< z}"] by auto
  next
    case False
    show ?thesis
    proof (rule classical)
      assume "\<not> y \<le> f0"
      then have "eventually (\<lambda>x. f x < y) F"
        using lim[THEN topological_tendstoD, of "{..< y}"] by auto
      then have "eventually (\<lambda>x. f x \<le> f0) F"
        using False by (auto elim!: eventually_elim1 simp: not_less)
      then have "y \<le> SUPREMUM {x. f x \<le> f0} f"
        by (rule lower)
      moreover have "SUPREMUM {x. f x \<le> f0} f \<le> f0"
        by (intro SUP_least) simp
      ultimately show "y \<le> f0" by simp
    qed
  qed
qed

lemma Liminf_eq_Limsup:
  fixes f0 :: "'a :: {complete_linorder, linorder_topology}"
  assumes ntriv: "\<not> trivial_limit F"
    and lim: "Liminf F f = f0" "Limsup F f = f0"
  shows "(f ---> f0) F"
proof (rule order_tendstoI)
  fix a assume "f0 < a"
  with assms have "Limsup F f < a" by simp
  then obtain P where "eventually P F" "SUPREMUM (Collect P) f < a"
    unfolding Limsup_def INF_less_iff by auto
  then show "eventually (\<lambda>x. f x < a) F"
    by (auto elim!: eventually_elim1 dest: SUP_lessD)
next
  fix a assume "a < f0"
  with assms have "a < Liminf F f" by simp
  then obtain P where "eventually P F" "a < INFIMUM (Collect P) f"
    unfolding Liminf_def less_SUP_iff by auto
  then show "eventually (\<lambda>x. a < f x) F"
    by (auto elim!: eventually_elim1 dest: less_INF_D)
qed

lemma tendsto_iff_Liminf_eq_Limsup:
  fixes f0 :: "'a :: {complete_linorder, linorder_topology}"
  shows "\<not> trivial_limit F \<Longrightarrow> (f ---> f0) F \<longleftrightarrow> (Liminf F f = f0 \<and> Limsup F f = f0)"
  by (metis Liminf_eq_Limsup lim_imp_Limsup lim_imp_Liminf)

lemma liminf_subseq_mono:
  fixes X :: "nat \<Rightarrow> 'a :: complete_linorder"
  assumes "subseq r"
  shows "liminf X \<le> liminf (X \<circ> r) "
proof-
  have "\<And>n. (INF m:{n..}. X m) \<le> (INF m:{n..}. (X \<circ> r) m)"
  proof (safe intro!: INF_mono)
    fix n m :: nat assume "n \<le> m" then show "\<exists>ma\<in>{n..}. X ma \<le> (X \<circ> r) m"
      using seq_suble[OF `subseq r`, of m] by (intro bexI[of _ "r m"]) auto
  qed
  then show ?thesis by (auto intro!: SUP_mono simp: liminf_SUP_INF comp_def)
qed

lemma limsup_subseq_mono:
  fixes X :: "nat \<Rightarrow> 'a :: complete_linorder"
  assumes "subseq r"
  shows "limsup (X \<circ> r) \<le> limsup X"
proof-
  have "\<And>n. (SUP m:{n..}. (X \<circ> r) m) \<le> (SUP m:{n..}. X m)"
  proof (safe intro!: SUP_mono)
    fix n m :: nat assume "n \<le> m" then show "\<exists>ma\<in>{n..}. (X \<circ> r) m \<le> X ma"
      using seq_suble[OF `subseq r`, of m] by (intro bexI[of _ "r m"]) auto
  qed
  then show ?thesis by (auto intro!: INF_mono simp: limsup_INF_SUP comp_def)
qed

end


           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2004         |
            |               November 2004               |
            |                                           |
            |        CSP-Prover on Isabelle2005         |
            |                October 2005  (modified)   |
            |                  March 2006  (modified)   |

            |        CSP-Prover on Isabelle2016         |
            |                    May 2016  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory Norm_seq
imports CMS
begin

(*****************************************************************

         1. Definition of Normarized sequences
         2. Properties of Normarized sequences
         3. How to transform each Cauchy sequence to NF
         4. The same limit between xs and NF(xs)

 *****************************************************************)

definition
  normal :: "'a::ms infinite_seq => bool"
  where
  normal_def :
    "normal xs == ALL (n::nat) (m::nat).
        distance(xs n, xs m) <= (1/2)^(min n m)"

definition
  Nset   :: "'a::ms infinite_seq => real => nat set"
  where
  Nset_def :
    "Nset xs delta ==
     {N. ALL n m. (N <= m & N <= n) --> distance(xs n, xs m) <= delta}"

definition
  Nmin   :: "'a::ms infinite_seq => real => nat"
  where
  Nmin_def :
    "Nmin xs delta == MIN (Nset xs delta)"

definition
  NF     :: "'a::ms infinite_seq => 'a::ms infinite_seq"
  where
  NF_def :
    "NF xs == (%n. xs (Nmin xs ((1/2)^n)))"

(********************************************************************
                          Normalization
 ********************************************************************)

(*** normalized sequence --> Cauchy sequence ***)

lemma normal_cauchy: "normal xs ==> cauchy xs"
apply (simp add: cauchy_def)
apply (intro allI impI)

apply (subgoal_tac "EX n. (1/2) ^ n < delta")
apply (erule exE)
apply (rule_tac x="n" in exI)
apply (intro allI impI)
apply (simp add: normal_def)
apply (drule_tac x="i" in spec)
apply (drule_tac x="j" in spec)

apply (subgoal_tac "((1::real) / 2) ^ min i j <= (1 / 2) ^ n")
apply (simp)

apply (case_tac "i <= j")
apply (simp add: min_def power_decreasing)
apply (simp add: min_def power_decreasing)

apply (simp add: pow_convergence)
done

(*
declare realpow_Suc          [simp del]
in isabelle2008
*)

declare power_Suc          [simp del]

lemma normal_Limit:
  "[| normal xs ; xs convergeTo y |]
        ==> distance(xs (Suc n), y) < (1/2)^n"
apply (simp add: convergeTo_def)
apply (drule_tac x="(1/2)^(Suc n)" in spec)
apply (simp)
apply (erule exE)

apply (rename_tac N)
apply (case_tac "N <= Suc n")
 apply (drule_tac x="Suc n" in spec)
 apply (simp add: symmetry_ms)

 apply (subgoal_tac "((1::real) / 2) ^ Suc n <= (1 / 2) ^ n")
 apply (simp)
 apply (simp add: power_decreasing)

(* else (i.e. Suc n < N *)
 apply (drule_tac x="N" in spec)
 apply (simp)
 apply (insert triangle_inequality_ms)
 apply (drule_tac x="xs (Suc n)" in spec)
 apply (drule_tac x="xs N" in spec)
 apply (drule_tac x="y" in spec)

 apply (simp add: normal_def)
 apply (drule_tac x="Suc n" in spec)
 apply (drule_tac x="N" in spec)
 apply (simp add: symmetry_ms)
 apply (simp add: min_def)
 apply (simp add: power_Suc)
done

(*
declare realpow_Suc          [simp]
*)
declare power_Suc          [simp]

(********************************************************************
                                Nmin
 ********************************************************************)

(*** Nmin exists ***)

lemma Nmin_exists:
  "[| 0 < delta ; cauchy xs |] ==> EX N. N isMIN (Nset xs delta)"
apply (simp add: cauchy_def)
apply (drule_tac x="delta" in spec)
apply (simp)
apply (erule exE)

apply (rule EX_MIN_nat)
apply (simp add: Nset_def)
apply (rule_tac x="n" in exI)
apply (intro allI impI)
apply (drule_tac x="na" in spec)
apply (drule_tac x="m" in spec)
by (simp)

lemma Nset_hasMIN:
  "[| 0 < delta ; cauchy xs |] ==> (Nset xs delta) hasMIN"
apply (simp add: hasMIN_def)
apply (rule Nmin_exists)
by (simp)

(*** Nmin unique ***)

lemma Nmin_unique:
  "[| N isMIN (Nset xs delta) ; M isMIN (Nset xs delta) |] ==> N = M"
by (simp add: MIN_unique)

(*-----------------------*
 |       the Nmin        |
 *-----------------------*)

lemma Nset_to_Nmin :
  "[| 0 < delta ; cauchy xs |]
   ==> (N isMIN (Nset xs delta)) = (Nmin xs delta = N)"
apply (simp add: Nmin_def)
apply (rule iffI)

apply (simp add: MIN_def Nset_hasMIN)
apply (rule the_equality)
apply (simp)
apply (simp add: Nmin_unique)

by (simp add: MIN_iff Nset_hasMIN)

lemmas Nmin_to_Nset = Nset_to_Nmin[THEN sym]

lemma Nmin_to_Nset_sym :
    "[| 0 < delta ; cauchy xs |]
     ==> (N = Nmin xs delta) = (N isMIN (Nset xs delta))"
by (auto simp add: Nset_to_Nmin)

lemmas Nmin_iff = Nmin_to_Nset Nmin_to_Nset_sym

(*-----------------------*
 |      property         |
 *-----------------------*)

lemma Nmin_cauchy_lm:
  "[| 0 < delta ; cauchy xs ; Nmin xs delta = N |]
   ==> (ALL n m. (N <= m & N <= n) --> distance(xs n, xs m) <= delta)"
by (simp add: Nmin_iff Nset_def isMIN_def)

lemma Nmin_cauchy:
  "[| 0 < delta ; cauchy xs ; Nmin xs delta <= m ; Nmin xs delta <= n |]
   ==> distance(xs n, xs m) <= delta"
by (simp add: Nmin_cauchy_lm)

(*-----------------------*
 |   min_number_cauchy   |
 *-----------------------*)

(*** Nmin order (check) ***)

lemma min_number_cauchy_lm:
  "[| 0 < delta1 ; delta1 <= delta2 ; cauchy xs |]
   ==> Nset xs delta1 <= Nset xs delta2"
apply (simp add: Nset_def)
apply (rule subsetI)
apply (simp)
apply (intro allI impI)
apply (drule_tac x="n" in spec)
apply (drule_tac x="m" in spec)
by (simp)

(*** Nmin order ***)

lemma min_number_cauchy:
  "[| 0 < delta1 ; delta1 <= delta2 ; cauchy xs ;
      Nmin xs delta1 = N1 ; Nmin xs delta2 = N2 |]
   ==> N2 <= N1"
apply (simp add: Nmin_iff)
by (simp add: isMIN_subset min_number_cauchy_lm)

(*** Nmin order half ***)

lemma min_number_cauchy_half:
  "[| n <= m ; cauchy xs ; Nmin xs ((1/2)^n) = N1 ; Nmin xs ((1/2)^m) = N2 |]
   ==> N1 <= N2"
apply (rule min_number_cauchy)
by (simp_all add: power_decreasing)

(*------------------------*
 | normal_form_seq_normal |
 *------------------------*)

lemma normal_form_seq_normal: "cauchy xs ==> normal (NF(xs))"
apply (simp add: normal_def NF_def)
apply (intro allI)

apply (case_tac "n <= m")
 apply (simp add: min_def)
 apply (rule Nmin_cauchy, simp_all)
 apply (rule min_number_cauchy_half, simp_all)

(* else *)
 apply (simp add: min_def)
 apply (rule Nmin_cauchy, simp_all)
 apply (rule min_number_cauchy_half, simp_all)
done

(*----------------------------*
 | normal_form_seq_same_Limit |
 *----------------------------*)

(*** only if part ***)

lemma normal_form_seq_same_Limit_only_if:
  "[| cauchy xs ; xs convergeTo y |] ==> NF(xs) convergeTo y"
apply (simp add: convergeTo_def)
apply (intro allI impI)
apply (drule_tac x="eps/2" in spec)
apply (simp)
apply (erule exE)

apply (subgoal_tac "EX n. (1 / 2) ^ n < eps/2")
apply (erule exE)
apply (rename_tac eps N M)

apply (rule_tac x="M" in exI)
apply (intro allI impI)

apply (case_tac "N <= Nmin xs ((1/2)^m)")

 apply (drule_tac x="Nmin xs ((1/2)^m)" in spec)
 apply (simp add: NF_def)

(* else *)
 apply (insert triangle_inequality_ms)
 apply (drule_tac x="y" in spec)
 apply (drule_tac x="xs N" in spec)
 apply (drule_tac x="(NF xs) m" in spec)

 apply (drule_tac x="N" in spec)
 apply (simp add: NF_def)

 apply (subgoal_tac "distance (xs N, xs (Nmin xs ((1 / 2) ^ m))) <= (1 / 2) ^ m")
 apply (subgoal_tac "((1::real) / 2) ^ m <= (1 / 2) ^ M")
 apply (simp)

 apply (simp add: power_decreasing)
 apply (rule Nmin_cauchy)
 apply (simp, simp, simp, simp)
 apply (rule pow_convergence)
 apply (simp_all)
done

(*** if part ***)

lemma normal_form_seq_same_Limit_if:
  "[| cauchy xs ; NF (xs) convergeTo y |] ==> xs convergeTo y"
apply (simp add: convergeTo_def)
apply (intro allI impI)
apply (drule_tac x="eps/2" in spec)
apply (simp)
apply (erule exE)

apply (subgoal_tac "EX n. (1 / 2) ^ n < eps/2")
apply (erule exE)
apply (rename_tac eps N M)

apply (rule_tac x="Nmin xs ((1/2)^(max N M))" in exI)
apply (intro allI impI)

apply (insert triangle_inequality_ms)
apply (drule_tac x="y" in spec)
apply (drule_tac x="xs (Nmin xs ((1/2)^(max N M)))" in spec)
apply (drule_tac x="xs m" in spec)

apply (drule_tac x="max N M" in spec)
(* apply (simp add: le_maxI1) *)
apply (simp add: NF_def)

(* *)
 apply (subgoal_tac
   "distance(xs (Nmin xs ((1 / 2) ^ max N M)), xs m) <= (1 / 2) ^ max N M")
 apply (subgoal_tac "((1::real) / 2) ^ max N M <= (1 / 2) ^ M")
 apply (simp)
 apply (simp add: max_def power_decreasing)

 apply (rule Nmin_cauchy)
 apply (simp, simp, simp, simp)
 apply (rule pow_convergence)
 apply (simp_all)
done

(*** iff ***)

lemma normal_form_seq_same_Limit:
  "cauchy xs ==> xs convergeTo y = NF(xs) convergeTo y"
apply (rule iffI)
apply (simp add: normal_form_seq_same_Limit_only_if)
apply (simp add: normal_form_seq_same_Limit_if)
done

end


(*
  File:     Quick_Sort_Average_Case.thy
  Author:   Manuel Eberl <eberlm@in.tum.de>

  Definition and average-case analysis of the standard deterministic QuickSort algorithm
*)
section \<open>Average case analysis of deterministic QuickSort\<close>
theory Quick_Sort_Average_Case
  imports Randomised_Quick_Sort
begin

subsection \<open>Definition of deterministic QuickSort\<close>

text \<open>
  This is the functional description of the standard variant of deterministic QuickSort that
  always chooses the first list element as the pivot as given by Hoare in 1962~\cite{hoare}.
  For a list that is already sorted, this leads to $n(n-1)$
  comparisons, but as is well known, the average case is not that bad.
\<close>
fun quicksort :: "('a \<times> 'a) set \<Rightarrow> 'a list \<Rightarrow> 'a list" where
  "quicksort _ [] = []"
| "quicksort R (x # xs) =
     quicksort R (filter (\<lambda>y. (y,x) \<in> R) xs) @ [x] @ quicksort R (filter (\<lambda>y. (y,x) \<notin> R) xs)"

text \<open>
  We can easily show that this QuickSort is correct:
\<close>
theorem mset_quicksort [simp]: "mset (quicksort R xs) = mset xs"
  by (induction R xs rule: quicksort.induct) (simp_all)

corollary set_quicksort [simp]: "set (quicksort R xs) = set xs"
  by (induction R xs rule: quicksort.induct) auto

theorem sorted_wrt_quicksort:
  assumes "trans R" and "total_on (set xs) R" and "\<And>x. x \<in> set xs \<Longrightarrow> (x, x) \<in> R"
  shows   "sorted_wrt R (quicksort R xs)"
using assms
proof (induction R xs rule: quicksort.induct)
  case (2 R x xs)
  have total: "(a, b) \<in> R" if "(b, a) \<notin> R" "a \<in> set (x#xs)" "b \<in> set (x#xs)" for a b
    using "2.prems" that unfolding total_on_def by (cases "a = b") auto

  have *: "sorted_wrt R (quicksort R (filter (\<lambda>y. (y,x) \<in> R) xs))"
          "sorted_wrt R (quicksort R (filter (\<lambda>y. (y,x) \<notin> R) xs))"
    by ((rule 2 total_on_subset[OF \<open>total_on (set (x#xs)) R\<close>]) | force)+
  show ?case
    by (auto intro!: sorted_wrt_append sorted_wrt.intros \<open>trans R\<close> *
             intro: transD[OF \<open>trans R\<close>] dest!: total simp: total_on_def)
qed auto

corollary sorted_wrt_quicksort':
  assumes "linorder_on A R" and "set xs \<subseteq> A"
  shows   "sorted_wrt R (quicksort R xs)"
  by (rule sorted_wrt_quicksort)
     (insert assms, auto simp: linorder_on_def refl_on_def dest: total_on_subset)

text \<open>
  We now define another version of QuickSort that is identical to the previous one but also
  counts the number of comparisons that were made.
\<close>
fun quicksort' :: "('a \<times> 'a) set \<Rightarrow> 'a list \<Rightarrow> 'a list \<times> nat" where
  "quicksort' _ [] = ([], 0)"
| "quicksort' R (x # xs) = (
     let (ls, rs)  = partition (\<lambda>y. (y,x) \<in> R) xs;
         (ls', n1) = quicksort' R ls;
         (rs', n2) = quicksort' R rs
     in
         (ls' @ [x] @ rs', length xs + n1 + n2))"

text \<open>
  For convenience, we also define a function that computes only the number of comparisons that
  were made and not the result list.
\<close>
fun qs_cost :: "('a \<times> 'a) set \<Rightarrow> 'a list \<Rightarrow> nat" where
  "qs_cost _ [] = 0"
| "qs_cost R (x # xs) =
     length xs + qs_cost R (filter (\<lambda>y. (y,x)\<in>R) xs) + qs_cost R (filter (\<lambda>y. (y,x)\<notin>R) xs)"

text \<open>
  It is obvious that the original QuickSort and the cost function are the projections
  of the cost-counting QuickSort.
\<close>
lemma fst_quicksort' [simp]: "fst (quicksort' R xs) = quicksort R xs"
  by (induction R xs rule: quicksort.induct) (simp_all add: case_prod_unfold Let_def o_def)

lemma snd_quicksort' [simp]: "snd (quicksort' R xs) = qs_cost R xs"
  by (induction R xs rule: quicksort.induct) (simp_all add: case_prod_unfold Let_def o_def)

subsection \<open>Analysis\<close>

text \<open>
  We will reduce the average-case analysis to showing that it is essentially equivalent to
  the randomised QuickSort we analysed earlier. Similar, but more direct analyses are given
  by Hoare~\cite{hoare} and Sedgewick~\cite{sedgewick}.

  The proof is relatively straightforward -- but still a bit messy. We show that the cost
  distribution of QuickSort run on a random permutation of a set of size $n$ is exactly the same
  as that of randomised QuickSort being run on any fixed list of size $n$ (which we analysed
  before):
\<close>
theorem qs_cost_average_conv_rqs_cost:
  assumes "finite A" and "linorder_on B R" and "A \<subseteq> B"
  shows   "map_pmf (qs_cost R) (pmf_of_set (permutations_of_set A)) = rqs_cost (card A)"
using assms(1,3)
proof (induction A rule: finite_psubset_induct)
  case (psubset A)
  show ?case
  proof (cases "A = {}")
    case True
    thus ?thesis by (simp add: pmf_of_set_singleton)
  next
    case False
    note A = \<open>finite A\<close> \<open>A \<noteq> {}\<close>
    define n where "n = card A - 1"
    from A have "pmf_of_set (permutations_of_set A) =
      do {x \<leftarrow> pmf_of_set A; xs \<leftarrow> pmf_of_set (permutations_of_set (A - {x})); return_pmf (x#xs)}"
      by (rule random_permutation_of_set)
    also have "map_pmf (qs_cost R) \<dots> =
                 do {
                   x \<leftarrow> pmf_of_set A;
                   xs \<leftarrow> pmf_of_set (permutations_of_set (A - {x}));
                   return_pmf (length xs + qs_cost R [y\<leftarrow>xs. (y,x)\<in>R] + qs_cost R [y\<leftarrow>xs. (y,x)\<notin>R])
                 }" by (simp add: map_bind_pmf)
    also have "\<dots> = map_pmf (\<lambda>m. n + m) (
          do {
            x \<leftarrow> pmf_of_set A;
            xs \<leftarrow> pmf_of_set (permutations_of_set (A - {x}));
            return_pmf (qs_cost R [y\<leftarrow>xs. (y,x)\<in>R] + qs_cost R [y\<leftarrow>xs. (y,x)\<notin>R])
          })" (is "_ = map_pmf _ ?X") using A unfolding n_def map_bind_pmf
      by (intro bind_pmf_cong map_pmf_cong refl) (auto simp: length_finite_permutations_of_set)
    also have "?X = do {
                      x \<leftarrow> pmf_of_set A;
                      (ls,rs) \<leftarrow> map_pmf (partition (\<lambda>y. (y,x)\<in>R))
                                   (pmf_of_set (permutations_of_set (A - {x})));
                      return_pmf (qs_cost R ls + qs_cost R rs)
                    }" by (simp add: bind_map_pmf o_def)
    also have "\<dots> = do {
                      x \<leftarrow> pmf_of_set A;
                      (n1, n2) \<leftarrow> pair_pmf
                        (rqs_cost (linorder_rank R A x)) (rqs_cost (n - linorder_rank R A x));
                      return_pmf (n1 + n2)}"
    proof (intro bind_pmf_cong refl, goal_cases)
      case (1 x)
      have "map_pmf (partition (\<lambda>y. (y,x)\<in>R)) (pmf_of_set (permutations_of_set (A - {x})))
              \<bind> (\<lambda>(ls, rs). return_pmf (qs_cost R ls + qs_cost R rs)) =
            map_pmf (\<lambda>(n1, n2). n1 + n2) (pair_pmf
              (map_pmf (qs_cost R) (pmf_of_set (permutations_of_set {xa \<in> A - {x}. (xa, x) \<in> R})))
              (map_pmf (qs_cost R) (pmf_of_set (permutations_of_set {xa \<in> A - {x}. (xa, x) \<notin> R}))))"
        (is "_ = map_pmf _ (pair_pmf ?X ?Y)")
        by (subst partition_random_permutations)
           (simp_all add: map_pmf_def case_prod_unfold bind_return_pmf bind_assoc_pmf pair_pmf_def A)
      also {
        have "{xa \<in> A - {x}. (xa, x) \<in> R} \<subseteq> A - {x}" by blast
        also have "\<dots> \<subset> A" using 1 A by auto
        finally have subset: "{xa \<in> A - {x}. (xa, x) \<in> R} \<subset> A" .
        also have "\<dots> \<subseteq> B" by fact
        finally have "?X = rqs_cost (card {xa \<in> A - {x}. (xa, x) \<in> R})" using subset
          by (intro psubset.IH) auto
        also have "card {xa \<in> A - {x}. (xa, x) \<in> R} = linorder_rank R A x"
          by (simp add: linorder_rank_def)
        finally have "?X = rqs_cost \<dots>" .
      }
      also {
        have "{xa \<in> A - {x}. (xa, x) \<notin> R} \<subseteq> A - {x}" by blast
        also have "\<dots> \<subset> A" using 1 A by auto
        finally have subset: "{xa \<in> A - {x}. (xa, x) \<notin> R} \<subset> A" .
        also have "\<dots> \<subseteq> B" by fact
        finally have "?Y = rqs_cost (card {xa \<in> A - {x}. (xa, x) \<notin> R})" using subset
          by (intro psubset.IH) auto
        also {
          have "card ({y\<in>A-{x}. (y,x)\<in>R} \<union> {y\<in>A-{x}. (y,x)\<notin>R}) =
                  linorder_rank R A x + card {xa \<in> A - {x}. (xa, x) \<notin> R}"
            unfolding linorder_rank_def using A by (intro card_Un_disjoint) auto
          also have "{y\<in>A-{x}. (y,x)\<in>R} \<union> {y\<in>A-{x}. (y,x)\<notin>R} = A - {x}" by blast
          also have "card \<dots> = n" using A 1 by (simp add: n_def)
          finally have "card {xa \<in> A - {x}. (xa, x) \<notin> R} = n - linorder_rank R A x" by simp
        }
        finally have "?Y = rqs_cost (n - linorder_rank R A x)" .
      }
      finally show ?case by (simp add: case_prod_unfold map_pmf_def)
    qed
    also have "\<dots> = do {
                      i \<leftarrow> map_pmf (linorder_rank R A) (pmf_of_set A);
                      (n1, n2) \<leftarrow> pair_pmf (rqs_cost i) (rqs_cost (n - i));
                      return_pmf (n1 + n2)
                    }" by (simp add: bind_map_pmf)
    also have "map_pmf (linorder_rank R A) (pmf_of_set A) = pmf_of_set {..<card A}"
      by (intro map_pmf_of_set_bij_betw bij_betw_linorder_rank[OF assms(2)] A psubset.prems)
    also from A have "card A > 0" by (intro Nat.gr0I) auto
    hence "{..<card A} = {..n}" by (auto simp: n_def)
    also have "map_pmf (\<lambda>m. n + m) (
                 do {
                      i \<leftarrow> pmf_of_set {..n};
                      (n1, n2) \<leftarrow> pair_pmf (rqs_cost i) (rqs_cost (n - i));
                      return_pmf (n1 + n2)
                    }) = rqs_cost (Suc n)"
      by (simp add: pair_pmf_def map_bind_pmf case_prod_unfold
                    bind_assoc_pmf bind_return_pmf add_ac)
    also from A have "card A > 0" by (intro Nat.gr0I) auto
    hence "Suc n = card A" by (simp add: n_def)
    finally show ?thesis .
  qed
qed

text \<open>
  We therefore have the same expectation as well. (Note that we showed
  @{thm rqs_cost_exp_eq [no_vars]} and @{thm rqs_cost_exp_asymp_equiv [no_vars]} before.
\<close>
corollary expectation_qs_cost:
  assumes "finite A" and "linorder_on B R" and "A \<subseteq> B"
  defines "random_list \<equiv> pmf_of_set (permutations_of_set A)"
  shows   "measure_pmf.expectation (map_pmf (qs_cost R) random_list) real =
             rqs_cost_exp (card A)"
  unfolding random_list_def
  by (subst qs_cost_average_conv_rqs_cost[OF assms(1-3)]) (simp add: expectation_rqs_cost)

end


section \<open>Generalization of the statement about the uniqueness of the Hermite normal form\<close>

theory Uniqueness_Hermite
imports Hermite.Hermite
begin

(*This file presents a generalized version of the theorem Hermite_unique when applied to integer
matrices. More concretely, instead of assuming invertibility over Z of the input matrix A, we now
assume invertibility over Q. Only some changes to adapt the original proof are required.*)

instance int :: bezout_ring_div
proof qed

lemma map_matrix_rat_of_int_mult:
  shows "map_matrix rat_of_int (A**B) = (map_matrix rat_of_int A)**(map_matrix rat_of_int B)"
  unfolding map_matrix_def matrix_matrix_mult_def by auto

lemma det_map_matrix:
  fixes A :: "int^'n::mod_type^'n::mod_type"
  shows "det (map_matrix rat_of_int A) = rat_of_int (det A)"
  unfolding map_matrix_def unfolding Determinants.det_def by auto

lemma inv_Z_imp_inv_Q:
  fixes A :: "int^'n::mod_type^'n::mod_type"
  assumes inv_A: "invertible A"
  shows "invertible (map_matrix rat_of_int A)"
proof -
  have "is_unit (det A)" using inv_A invertible_iff_is_unit by blast
  hence "is_unit (det (map_matrix rat_of_int A))"
    by (simp add: det_map_matrix dvd_if_abs_eq)
  thus ?thesis using invertible_iff_is_unit by blast
qed

lemma upper_triangular_Z_eq_Q:
  "upper_triangular (map_matrix rat_of_int A) = upper_triangular A"
  unfolding upper_triangular_def by auto

lemma invertible_and_upper_diagonal_not0:
  fixes H :: "int^'n::mod_type^'n::mod_type"
  assumes inv_H: "invertible (map_matrix rat_of_int H)" and up_H: "upper_triangular H"
  shows "H $ i $ i \<noteq> 0"
proof -
  let ?RAT_H = "(map_matrix rat_of_int H)"
  have up_RAT_H: "upper_triangular ?RAT_H"
    using up_H unfolding upper_triangular_def by auto
  have "is_unit (det ?RAT_H)" using inv_H using invertible_iff_is_unit by blast
  hence "?RAT_H $ i $ i \<noteq> 0" using inv_H up_RAT_H is_unit_diagonal
    by (metis not_is_unit_0)
  thus ?thesis by auto
qed

lemma diagonal_least_nonzero:
  fixes H :: "int^'n::mod_type^'n::mod_type"
  assumes H: "Hermite associates residues H"
  and inv_H: "invertible (map_matrix rat_of_int H)" and up_H: "upper_triangular H"
  shows "(LEAST n. H $ i $ n \<noteq> 0) = i"
proof (rule Least_equality)
  show "H $ i $ i \<noteq> 0" by (rule invertible_and_upper_diagonal_not0[OF inv_H up_H])
  fix y
  assume Hiy: "H $ i $ y \<noteq> 0"
  show "i \<le> y"
    using up_H unfolding upper_triangular_def
    by (metis (poly_guards_query) Hiy not_less)
qed

lemma diagonal_in_associates:
  fixes H :: "int^'n::mod_type^'n::mod_type"
  assumes H: "Hermite associates residues H"
  and inv_H: "invertible (map_matrix rat_of_int H)" and up_H: "upper_triangular H"
  shows "H $ i $ i \<in> associates"
proof -
  have "H $ i $ i \<noteq> 0" by (rule invertible_and_upper_diagonal_not0[OF inv_H up_H])
  hence "\<not> is_zero_row i H" unfolding is_zero_row_def is_zero_row_upt_k_def ncols_def by auto
  thus ?thesis using H unfolding Hermite_def unfolding diagonal_least_nonzero[OF H inv_H up_H]
    by auto
qed

lemma above_diagonal_in_residues:
  fixes H :: "int^'n::mod_type^'n::mod_type"
  assumes H: "Hermite associates residues H"
  and inv_H: "invertible (map_matrix rat_of_int H)" and up_H: "upper_triangular H"
  and j_i: "j<i"
  shows "H $ j $ (LEAST n. H $ i $ n \<noteq> 0) \<in> residues (H $ i $ (LEAST n. H $ i $ n \<noteq> 0))"
proof -
  have "H $ i $ i \<noteq> 0" by (rule invertible_and_upper_diagonal_not0[OF inv_H up_H])
  hence "\<not> is_zero_row i H" unfolding is_zero_row_def is_zero_row_upt_k_def ncols_def by auto
  thus ?thesis using H j_i unfolding Hermite_def unfolding diagonal_least_nonzero[OF H inv_H up_H]
    by auto
qed

lemma Hermite_unique_generalized:
  fixes K::"int^'n::mod_type^'n::mod_type"
  assumes A_PH: "A = P ** H"
  and A_QK: "A = Q ** K"
  and inv_A: "invertible (map_matrix rat_of_int A)" (*The original statement assumes "invertible A",
                                                      that is, invertibility over integers, which is
                                                      more restrictive.*)
  and inv_P: "invertible P"
  and inv_Q: "invertible Q"
  and H: "Hermite associates residues H"
  and K: "Hermite associates residues K"
  shows "H = K"
proof -
  let ?RAT = "map_matrix rat_of_int"
  have cs_residues: "Complete_set_residues residues" using H unfolding Hermite_def by simp
  have inv_H: "invertible (?RAT H)"
  proof -
    have "?RAT A = ?RAT P ** ?RAT H" using A_PH map_matrix_rat_of_int_mult by blast
    thus ?thesis
      by (metis inv_A invertible_left_inverse matrix_inv(1) matrix_mul_assoc)
  qed
  have inv_K: "invertible (?RAT K)"
  proof -
   have "?RAT A = ?RAT Q ** ?RAT K" using A_QK map_matrix_rat_of_int_mult by blast
    thus ?thesis
      by (metis inv_A invertible_left_inverse matrix_inv(1) matrix_mul_assoc)
  qed
  define U where "U = (matrix_inv P)**Q"
  have inv_U: "invertible U"
    by (metis U_def inv_P inv_Q invertible_def invertible_mult matrix_inv_left matrix_inv_right)
  have H_UK: "H = U ** K" using A_PH A_QK inv_P
    by (metis U_def matrix_inv_left matrix_mul_assoc matrix_mul_lid)
  have "Determinants.det K *k U = H ** adjugate K"
    unfolding H_UK matrix_mul_assoc[symmetric] mult_adjugate_det matrix_mul_mat ..
  have upper_triangular_H: "upper_triangular H"
    by (metis H Hermite_def echelon_form_imp_upper_triagular)
  have upper_triangular_K: "upper_triangular K"
    by (metis K Hermite_def echelon_form_imp_upper_triagular)
  have upper_triangular_U: "upper_triangular U"
  proof -
    have U_H_K: "?RAT U = (?RAT H) ** (matrix_inv (?RAT K))"
      by (metis H_UK inv_K map_matrix_rat_of_int_mult matrix_inv(2) matrix_mul_assoc matrix_mul_rid)
    have up_inv_RAT_K: "upper_triangular (matrix_inv (?RAT K))" using upper_triangular_inverse
      by (simp add: upper_triangular_inverse inv_K upper_triangular_K upper_triangular_Z_eq_Q)
    have "upper_triangular (?RAT U)" unfolding U_H_K
      by (rule upper_triangular_mult[OF _ up_inv_RAT_K],
          auto simp add: upper_triangular_H upper_triangular_Z_eq_Q)
    thus ?thesis using upper_triangular_Z_eq_Q by auto
  qed
  have unit_det_U: "is_unit (det U)" by (metis inv_U invertible_iff_is_unit)
  have is_unit_diagonal_U: "(\<forall>i. is_unit (U $ i $ i))"
    by (rule is_unit_diagonal[OF upper_triangular_U unit_det_U])
  have Uii_1: "(\<forall>i. (U $ i $ i) = 1)" and Hii_Kii: "(\<forall>i. (H $ i $ i) = (K $ i $ i))"
  proof (auto)
    fix i
    have Hii: "H $ i $ i \<in> associates"
      by (rule diagonal_in_associates[OF H inv_H upper_triangular_H])
    have Kii: "K $ i $ i \<in> associates"
      by (rule diagonal_in_associates[OF K inv_K upper_triangular_K])
    have ass_Hii_Kii: "normalize (H $ i $ i) = normalize (K $ i $ i)"
      by (metis H_UK is_unit_diagonal_U normalize_mult_unit_left upper_triangular_K upper_triangular_U upper_triangular_mult_diagonal)
    show Hii_eq_Kii: "H $ i $ i = K $ i $ i"
      by (metis Hermite_def Hii K Kii ass_Hii_Kii in_Ass_not_associated)
    have "H $ i $ i = U $ i $ i * K $ i $ i"
      by (metis H_UK upper_triangular_K upper_triangular_U upper_triangular_mult_diagonal)
    thus "U $ i $ i = 1" unfolding Hii_eq_Kii mult_cancel_right1
      using inv_K invertible_and_upper_diagonal_not0 upper_triangular_K by blast
  qed
  have zero_above: "\<forall>j s. j\<ge>1 \<and> j < ncols A - to_nat s \<longrightarrow> U $ s $ (s + from_nat j) = 0"
  proof (clarify)
    fix j s assume  "1 \<le> j" and "j < ncols A - (to_nat (s::'n))"
    thus "U $ s $ (s + from_nat j) = 0"
    proof (induct j rule: less_induct)
      fix p
      assume induct_step: "(\<And>y. y < p \<Longrightarrow> 1 \<le> y \<Longrightarrow> y < ncols A - to_nat s \<Longrightarrow> U $ s $ (s + from_nat y) = 0)"
        and p1: "1 \<le> p" and p2: "p < ncols A - to_nat s"
      have s_less: "s < s + from_nat p" using p1 p2 unfolding ncols_def
        by (metis One_nat_def add.commute add_diff_cancel_right' add_lessD1 add_to_nat_def
          from_nat_to_nat_id less_diff_conv neq_iff not_le
          to_nat_from_nat_id to_nat_le zero_less_Suc)
      show "U $ s $ (s + from_nat p) = 0"
      proof -
        have UNIV_rw: "UNIV = insert s (UNIV-{s})" by auto
        have UNIV_s_rw: "UNIV-{s} = insert (s + from_nat p) ((UNIV-{s}) - {s + from_nat p})"
          using p1 p2 s_less unfolding ncols_def by (auto simp: algebra_simps)
        have sum_rw: "(\<Sum>k\<in>UNIV-{s}. U $ s $ k * K $ k $ (s + from_nat p))
          = U $ s $ (s + from_nat p) * K $ (s + from_nat p) $ (s + from_nat p)
          + (\<Sum>k\<in>(UNIV-{s})-{s + from_nat p}. U $ s $ k * K $ k $ (s + from_nat p))"
          using UNIV_s_rw sum.insert by (metis (erased, lifting) Diff_iff finite singletonI)
        have sum_0: "(\<Sum>k\<in>(UNIV-{s})-{s + from_nat p}. U $ s $ k * K $ k $ (s + from_nat p)) = 0"
        proof (rule sum.neutral, rule)
          fix x assume x: "x \<in> UNIV - {s} - {s + from_nat p}"
          show "U $ s $ x * K $ x $ (s + from_nat p) = 0"
          proof (cases "x<s")
            case True
            thus ?thesis using upper_triangular_U unfolding upper_triangular_def
              by auto
          next
            case False
            hence x_g_s: "x>s" using x by (metis Diff_iff neq_iff singletonI)
            show ?thesis
            proof (cases "x<s+from_nat p")
              case True
              define a where "a = to_nat x - to_nat s"
              from x_g_s have "to_nat s < to_nat x" by (rule to_nat_mono)
              hence xa: "x=s+(from_nat a)" unfolding a_def add_to_nat_def
                by (simp add: less_imp_diff_less to_nat_less_card algebra_simps to_nat_from_nat_id)
              have "U $ s $ x =0"
              proof (unfold xa, rule induct_step)
                show a_p: "a<p" unfolding a_def using p2 unfolding ncols_def
                proof -
                  have "x < from_nat (to_nat s + to_nat (from_nat p::'n))"
                    by (metis (no_types) True add_to_nat_def)
                  hence "to_nat x - to_nat s < to_nat (from_nat p::'n)"
                    by (simp add: add.commute less_diff_conv2 less_imp_le to_nat_le x_g_s)
                  thus "to_nat x - to_nat s < p"
                    by (metis (no_types) from_nat_eq_imp_eq from_nat_to_nat_id le_less_trans
                        less_imp_le not_le to_nat_less_card)
                qed
                show "1 \<le> a"
                  by (auto simp add: a_def p1 p2) (metis Suc_leI to_nat_mono x_g_s zero_less_diff)
                show "a < ncols A - to_nat s" using a_p p2 by auto
              qed
              thus ?thesis by simp
            next
              case False
              hence "x>s+from_nat p" using x_g_s x by auto
              thus ?thesis using upper_triangular_K unfolding upper_triangular_def
                by auto
            qed
          qed
        qed
        have "H $ s $ (s + from_nat p) = (\<Sum>k\<in>UNIV. U $ s $ k * K $ k $ (s + from_nat p))"
          unfolding H_UK matrix_matrix_mult_def by auto
        also have "... = (\<Sum>k\<in>insert s (UNIV-{s}). U $ s $ k * K $ k $ (s + from_nat p))"
          using UNIV_rw by simp
        also have "... = U $ s $ s * K $ s $ (s + from_nat p)
          + (\<Sum>k\<in>UNIV-{s}. U $ s $ k * K $ k $ (s + from_nat p))"
          by (rule sum.insert, simp_all)
        also have "... = U $ s $ s * K $ s $ (s + from_nat p)
          + U $ s $ (s + from_nat p) * K $ (s + from_nat p) $ (s + from_nat p)"
          unfolding sum_rw sum_0 by simp
        finally have H_s_sp: "H $ s $ (s + from_nat p)
          = U $ s $ (s + from_nat p) * K $ (s + from_nat p) $ (s + from_nat p) + K $ s $ (s + from_nat p)"
          using Uii_1 by auto
        hence cong_HK: "cong (H $ s $ (s + from_nat p)) (K $ s $ (s + from_nat p)) (K $ (s+from_nat p) $ (s + from_nat p))"
          unfolding cong_def by auto
        have H_s_sp_residues: "(H $ s $ (s + from_nat p)) \<in> residues (K $ (s+from_nat p) $ (s + from_nat p))"
          using above_diagonal_in_residues[OF H inv_H upper_triangular_H s_less]
          unfolding diagonal_least_nonzero[OF H inv_H upper_triangular_H]
          by (metis Hii_Kii)
        have K_s_sp_residues: "(K $ s $ (s + from_nat p)) \<in> residues (K $ (s+from_nat p) $ (s + from_nat p))"
          using above_diagonal_in_residues[OF K inv_K upper_triangular_K s_less]
          unfolding diagonal_least_nonzero[OF K inv_K upper_triangular_K] .
        have Hs_sp_Ks_sp: "(H $ s $ (s + from_nat p)) = (K $ s $ (s + from_nat p))"
          using cong_HK in_Res_not_congruent[OF cs_residues H_s_sp_residues K_s_sp_residues]
          by fast
        have "K $ (s + from_nat p) $ (s + from_nat p) \<noteq> 0"
          using inv_K invertible_and_upper_diagonal_not0 upper_triangular_K by blast
        thus ?thesis unfolding from_nat_1 using H_s_sp unfolding Hs_sp_Ks_sp by auto
      qed
    qed
  qed
  have "U = mat 1"
  proof (unfold mat_def vec_eq_iff, auto)
    fix ia show "U $ ia $ ia = 1" using Uii_1 by simp
    fix i assume i_ia: "i \<noteq> ia"
    show "U $ i $ ia = 0"
    proof (cases "ia<i")
      case True
      thus ?thesis using upper_triangular_U unfolding upper_triangular_def by auto
    next
      case False
      hence i_less_ia: "i<ia" using i_ia by auto
      define a where "a = to_nat ia - to_nat i"
      have ia_eq: "ia = i + from_nat a" unfolding a_def
        by (metis i_less_ia a_def add_to_nat_def dual_order.strict_iff_order from_nat_to_nat_id
            le_add_diff_inverse less_imp_diff_less to_nat_from_nat_id to_nat_less_card to_nat_mono)
      have "1 \<le> a" unfolding a_def
        by (metis diff_is_0_eq i_less_ia less_one not_less to_nat_mono)
      moreover have "a < ncols A - to_nat i"
        unfolding a_def ncols_def
        by (metis False diff_less_mono not_less to_nat_less_card to_nat_mono')
      ultimately show ?thesis using zero_above unfolding ia_eq by blast
    qed
  qed
  thus ?thesis using H_UK matrix_mul_lid by fast
qed

end


theory Permute
  imports Main Seq2less
begin

(* Here we play with permutability of triplet components of 2-less sequences. *)

(* Permutations (redundant) of a triplet *)

fun swap_12 :: "Tri \<Rightarrow> Tri" where
  "swap_12 (x1, x2, x3) = (x2, x1, x3)"

fun swap_13 :: "Tri \<Rightarrow> Tri" where
  "swap_13 (x1, x2, x3) = (x3, x2, x1)"

fun swap_23 :: "Tri \<Rightarrow> Tri" where
  "swap_23 (x1, x2, x3) =  (x1, x3, x2)"

fun rot_r :: "Tri \<Rightarrow> Tri" where
  "rot_r (x1, x2, x3) =  (x3, x1, x2)"

fun rot_l :: "Tri \<Rightarrow> Tri" where
  "rot_l (x1, x2, x3) =  (x2, x3, x1)"

(* Function perm gathers all of the above transformations. *)

datatype Perm = Swap12 | Swap13 | Swap23 | RotR | RotL

fun perm :: "Perm \<Rightarrow> Tri \<Rightarrow> Tri" where
  "perm k t = (case k of
    Swap12 \<Rightarrow> swap_12 t |
    Swap13 \<Rightarrow> swap_13 t |
    Swap23 \<Rightarrow> swap_23 t |
    RotR \<Rightarrow> rot_r t |
    RotL \<Rightarrow> rot_l t)"

(* Given a pf transform a sequence by applying pf on each element. *)

primrec permute :: "(Tri \<Rightarrow> Tri) \<Rightarrow> Tri list \<Rightarrow> Tri list" where
  "permute pf [] = []" |
  "permute pf (h#t) = ((pf h)#(permute pf t))"

(* Lemmata *)

(* Transformation of triplets preserves 2-lessness (for \<prec>, lt_all, is_2less) *)

lemma permutability_lt:
  "(x \<prec> y) \<longrightarrow> (perm k x \<prec> perm k y)"
  apply (simp add: split_def)
  by (smt Perm.exhaust Perm.simps(21) Perm.simps(22) Perm.simps(23) Perm.simps(24) Perm.simps(25) lt.elims(2) lt.simps rot_l.simps rot_r.simps swap_12.simps swap_13.simps swap_23.simps)

lemma permutability_lt_all:
  "lt_all x t \<longrightarrow> lt_all (perm k x) (permute (perm k) t)"
  apply (induction t arbitrary: k)
  using permutability_lt
  by auto

theorem permutability_is_2less:
  "is_2less t \<longrightarrow> is_2less (permute (perm k) t)"
  apply (induction t arbitrary: k)
  using permutability_lt permutability_lt_all
  by auto

end


(* Property from Productive Use of Failure in Inductive Proof,
   Andrew Ireland and Alan Bundy, JAR 1996.
   This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.
   Some proofs were added by Yutaka Nagashima.*)
  theory TIP_prop_30
  imports "../../Test_Base"
begin

datatype 'a list = nil2 | cons2 "'a" "'a list"

fun x :: "'a list => 'a list => 'a list" where
  "x (nil2) z = z"
| "x (cons2 z2 xs) z = cons2 z2 (x xs z)"

fun rev :: "'a list => 'a list" where
  "rev (nil2) = nil2"
| "rev (cons2 z xs) = x (rev xs) (cons2 z (nil2))"

lemma app_nil: "x y nil2 = y" by (induct y, auto)
lemma app_assoc: "x (x y z) w = x y (x z w)" by (induction y, auto)
lemma rev_app: "rev (x y z) = x (rev z) (rev y)"
  apply(induction y, auto)
   apply(simp add: app_nil)
  using app_assoc apply(auto)
  done

lemma revrev: "rev (rev y) = y"
  apply(induction y, auto)
  apply(simp add: rev_app)
  done

theorem property0 :
  "((rev (x (rev y) (nil2))) = y)"
  apply(simp add: app_nil revrev)
  done

end


(*  Title:      ZF/AC/WO1_WO7.thy
    Author:     Lawrence C Paulson, CU Computer Laboratory
    Copyright   1998  University of Cambridge

WO7 \<longleftrightarrow> LEMMA \<longleftrightarrow> WO1 (Rubin & Rubin p. 5)
LEMMA is the sentence denoted by (**)

Also, WO1 \<longleftrightarrow> WO8
*)

theory WO1_WO7
imports AC_Equiv
begin

definition
    "LEMMA ==
     \<forall>X. ~Finite(X) \<longrightarrow> (\<exists>R. well_ord(X,R) & ~well_ord(X,converse(R)))"

(* ********************************************************************** *)
(* It is easy to see that WO7 is equivalent to (**)                       *)
(* ********************************************************************** *)

lemma WO7_iff_LEMMA: "WO7 \<longleftrightarrow> LEMMA"
apply (unfold WO7_def LEMMA_def)
apply (blast intro: Finite_well_ord_converse)
done

(* ********************************************************************** *)
(* It is also easy to show that LEMMA implies WO1.                        *)
(* ********************************************************************** *)

lemma LEMMA_imp_WO1: "LEMMA ==> WO1"
apply (unfold WO1_def LEMMA_def Finite_def eqpoll_def)
apply (blast intro!: well_ord_rvimage [OF bij_is_inj nat_implies_well_ord])
done

(* ********************************************************************** *)
(* The Rubins' proof of the other implication is contained within the     *)
(* following sentence \<in>                                                   *)
(* "... each infinite ordinal is well ordered by < but not by >."         *)
(* This statement can be proved by the following two theorems.            *)
(* But moreover we need to show similar property for any well ordered     *)
(* infinite set. It is not very difficult thanks to Isabelle order types  *)
(* We show that if a set is well ordered by some relation and by its     *)
(* converse, then apropriate order type is well ordered by the converse   *)
(* of it's membership relation, which in connection with the previous     *)
(* gives the conclusion.                                                  *)
(* ********************************************************************** *)

lemma converse_Memrel_not_wf_on:
    "[| Ord(a); ~Finite(a) |] ==> ~wf[a](converse(Memrel(a)))"
apply (unfold wf_on_def wf_def)
apply (drule nat_le_infinite_Ord [THEN le_imp_subset], assumption)
apply (rule notI)
apply (erule_tac x = nat in allE, blast)
done

lemma converse_Memrel_not_well_ord:
    "[| Ord(a); ~Finite(a) |] ==> ~well_ord(a,converse(Memrel(a)))"
apply (unfold well_ord_def)
apply (blast dest: converse_Memrel_not_wf_on)
done

lemma well_ord_rvimage_ordertype:
     "well_ord(A,r) \<Longrightarrow>
       rvimage (ordertype(A,r), converse(ordermap(A,r)),r) =
       Memrel(ordertype(A,r))"
by (blast intro: ordertype_ord_iso [THEN ord_iso_sym] ord_iso_rvimage_eq
             Memrel_type [THEN subset_Int_iff [THEN iffD1]] trans)

lemma well_ord_converse_Memrel:
     "[| well_ord(A,r); well_ord(A,converse(r)) |]
      ==> well_ord(ordertype(A,r), converse(Memrel(ordertype(A,r))))"
apply (subst well_ord_rvimage_ordertype [symmetric], assumption)
apply (rule rvimage_converse [THEN subst])
apply (blast intro: ordertype_ord_iso ord_iso_sym ord_iso_is_bij
                    bij_is_inj well_ord_rvimage)
done

lemma WO1_imp_LEMMA: "WO1 ==> LEMMA"
apply (unfold WO1_def LEMMA_def, clarify)
apply (blast dest: well_ord_converse_Memrel
                   Ord_ordertype [THEN converse_Memrel_not_well_ord]
             intro: ordertype_ord_iso ord_iso_is_bij bij_is_inj lepoll_Finite
                    lepoll_def [THEN def_imp_iff, THEN iffD2] )
done

lemma WO1_iff_WO7: "WO1 \<longleftrightarrow> WO7"
apply (simp add: WO7_iff_LEMMA)
apply (blast intro: LEMMA_imp_WO1 WO1_imp_LEMMA)
done

(* ********************************************************************** *)
(*            The proof of WO8 \<longleftrightarrow> WO1 (Rubin & Rubin p. 6)               *)
(* ********************************************************************** *)

lemma WO1_WO8: "WO1 ==> WO8"
by (unfold WO1_def WO8_def, fast)

(* The implication "WO8 ==> WO1": a faithful image of Rubin & Rubin's proof*)
lemma WO8_WO1: "WO8 ==> WO1"
apply (unfold WO1_def WO8_def)
apply (rule allI)
apply (erule_tac x = "{{x}. x \<in> A}" in allE)
apply (erule impE)
 apply (rule_tac x = "\<lambda>a \<in> {{x}. x \<in> A}. THE x. a={x}" in exI)
 apply (force intro!: lam_type simp add: singleton_eq_iff the_equality)
apply (blast intro: lam_sing_bij bij_is_inj well_ord_rvimage)
done

end