(* Title:      Recursion
   Author:     Walter Guttmann
   Maintainer: Walter Guttmann <walter.guttmann at canterbury.ac.nz>
*)

section \<open>Recursion\<close>

theory Recursion

imports Approximation N_Algebras

begin

class n_algebra_apx = n_algebra + apx +
  assumes apx_def: "x \<sqsubseteq> y \<longleftrightarrow> x \<le> y \<squnion> L \<and> C y \<le> x \<squnion> n(x) * top"
begin

lemma apx_transitive_2:
  assumes "x \<sqsubseteq> y"
      and "y \<sqsubseteq> z"
    shows "x \<sqsubseteq> z"
proof -
  have "C z \<le> C (y \<squnion> n(y) * top)"
    using assms(2) apx_def le_inf_iff by blast
  also have "... = C y \<squnion> n(y) * top"
    by (simp add: C_n_mult_closed inf_sup_distrib1)
  also have "... \<le> x \<squnion> n(x) * top \<squnion> n(y) * top"
    using assms(1) apx_def sup_left_isotone by blast
  also have "... = x \<squnion> n(x) * top \<squnion> n(C y) * top"
    by (simp add: n_C)
  also have "... \<le> x \<squnion> n(x) * top"
    by (metis assms(1) sup_assoc sup_idem sup_right_isotone apx_def mult_left_isotone n_add_n_top n_isotone)
  finally show ?thesis
    by (smt assms sup_assoc sup_commute apx_def le_iff_sup)
qed

lemma apx_meet_L:
  assumes "y \<sqsubseteq> x"
    shows "x \<sqinter> L \<le> y \<sqinter> L"
proof -
  have "x \<sqinter> L = C x \<sqinter> L"
    by (simp add: inf.left_commute inf.sup_monoid.add_assoc n_L_top_meet_L)
  also have "... \<le> (y \<squnion> n(y) * top) \<sqinter> L"
    using assms apx_def inf.sup_left_isotone by blast
  also have "... = (y \<sqinter> L) \<squnion> (n(y) * top \<sqinter> L)"
    by (simp add: inf_sup_distrib2)
  also have "... \<le> (y \<sqinter> L) \<squnion> n(y \<sqinter> L) * top"
    using n_n_meet_L sup_right_isotone by force
  finally show ?thesis
    by (metis le_iff_sup inf_le2 n_less_eq_char)
qed

text \<open>AACP Theorem 4.1\<close>

subclass apx_biorder
  apply unfold_locales
  apply (simp add: apx_def inf.coboundedI2)
  apply (metis sup_same_context order.antisym apx_def apx_meet_L relative_equality)
  using apx_transitive_2 by blast

lemma sup_apx_left_isotone_2:
  assumes "x \<sqsubseteq> y"
    shows "x \<squnion> z \<sqsubseteq> y \<squnion> z"
proof -
  have 1: "x \<squnion> z \<le> y \<squnion> z \<squnion> L"
    by (smt assms sup_assoc sup_commute sup_left_isotone apx_def)
  have "C (y \<squnion> z) \<le> x \<squnion> n(x) * top \<squnion> C z"
    using assms apx_def inf_sup_distrib1 sup_left_isotone by auto
  also have "... \<le> x \<squnion> z \<squnion> n(x) * top"
    using inf.coboundedI1 inf.sup_monoid.add_commute sup.cobounded1 sup.cobounded2 sup_assoc sup_least sup_right_isotone by auto
  also have "... \<le> x \<squnion> z \<squnion> n(x \<squnion> z) * top"
    using mult_isotone n_left_upper_bound semiring.add_left_mono by force
  finally show ?thesis
    using 1 apx_def by blast
qed

lemma mult_apx_left_isotone_2:
  assumes "x \<sqsubseteq> y"
    shows "x * z \<sqsubseteq> y * z"
proof -
  have "x * z \<le> y * z \<squnion> L * z"
    by (metis assms apx_def mult_left_isotone mult_right_dist_sup)
  hence 1: "x * z \<le> y * z \<squnion> L"
    using n_L_below_L order_lesseq_imp semiring.add_left_mono by blast
  have "C (y * z) = C y * z"
    by (simp add: n_L_T_meet_mult)
  also have "... \<le> x * z \<squnion> n(x) * top * z"
    by (metis assms apx_def mult_left_isotone mult_right_dist_sup)
  also have "... \<le> x * z \<squnion> n(x * z) * top"
    by (simp add: n_top_split)
  finally show ?thesis
    using 1 by (simp add: apx_def)
qed

lemma mult_apx_right_isotone_2:
  assumes "x \<sqsubseteq> y"
    shows "z * x \<sqsubseteq> z * y"
proof -
  have "z * x \<le> z * y \<squnion> z * L"
    by (metis assms apx_def mult_left_dist_sup mult_right_isotone)
  also have "... \<le> z * y \<squnion> z * bot \<squnion> L"
    using n_L_split_L semiring.add_left_mono sup_assoc by presburger
  finally have 1: "z * x \<le> z * y \<squnion> L"
    using mult_right_isotone sup.absorb_iff1 by auto
  have "C (z * y) \<le> z * C y"
    by (simp add: n_L_T_meet_mult n_L_T_meet_mult_propagate)
  also have "... \<le> z * (x \<squnion> n(x) * top)"
    using assms apx_def mult_right_isotone by blast
  also have "... = z * x \<squnion> z * n(x) * top"
    by (simp add: mult_left_dist_sup mult_assoc)
  also have "... \<le> z * x \<squnion> n(z * x) * top"
    by (simp add: n_split_top)
  finally show ?thesis
    using 1 apx_def by blast
qed

text \<open>AACP Theorem 4.1 and Theorem 4.2\<close>

subclass apx_semiring
  apply unfold_locales
  apply (simp add: apx_def n_L_below_nL_top sup.absorb2)
  using sup_apx_left_isotone_2 apply blast
  using mult_apx_left_isotone_2 apply blast
  by (simp add: mult_apx_right_isotone_2)

text \<open>AACP Theorem 4.2\<close>

lemma meet_L_apx_isotone:
  "x \<sqsubseteq> y \<Longrightarrow> x \<sqinter> L \<sqsubseteq> y \<sqinter> L"
  by (smt (verit) apx_meet_L apx_def inf.cobounded2 inf.left_commute n_L_top_meet_L n_less_eq_char sup.absorb2)

text \<open>AACP Theorem 4.2\<close>

lemma n_L_apx_isotone:
  assumes "x \<sqsubseteq> y"
    shows "n(x) * L \<sqsubseteq> n(y) * L"
proof -
  have "C (n(y) * L) \<le> n(C y) * L"
    by (simp add: n_C)
  also have "... \<le> n(x) * L \<squnion> n(n(x) * L) * top"
    by (metis assms apx_def n_add_n_top n_galois n_isotone n_n_L)
  finally show ?thesis
    using apx_def le_inf_iff n_L_decreasing_meet_L sup.absorb2 by auto
qed

definition kappa_apx_meet :: "('a \<Rightarrow> 'a) \<Rightarrow> bool"
  where "kappa_apx_meet f \<equiv> apx.has_least_fixpoint f \<and> has_apx_meet (\<mu> f) (\<nu> f) \<and> \<kappa> f = \<mu> f \<triangle> \<nu> f"

definition kappa_mu_nu :: "('a \<Rightarrow> 'a) \<Rightarrow> bool"
  where "kappa_mu_nu f \<equiv> apx.has_least_fixpoint f \<and> \<kappa> f = \<mu> f \<squnion> (\<nu> f \<sqinter> L)"

definition nu_below_mu_nu :: "('a \<Rightarrow> 'a) \<Rightarrow> bool"
  where "nu_below_mu_nu f \<equiv> C (\<nu> f) \<le> \<mu> f \<squnion> (\<nu> f \<sqinter> L) \<squnion> n(\<nu> f) * top"

definition nu_below_mu_nu_2 :: "('a \<Rightarrow> 'a) \<Rightarrow> bool"
  where "nu_below_mu_nu_2 f \<equiv> C (\<nu> f) \<le> \<mu> f \<squnion> (\<nu> f \<sqinter> L) \<squnion> n(\<mu> f \<squnion> (\<nu> f \<sqinter> L)) * top"

definition mu_nu_apx_nu :: "('a \<Rightarrow> 'a) \<Rightarrow> bool"
  where "mu_nu_apx_nu f \<equiv> \<mu> f \<squnion> (\<nu> f \<sqinter> L) \<sqsubseteq> \<nu> f"

definition mu_nu_apx_meet :: "('a \<Rightarrow> 'a) \<Rightarrow> bool"
  where "mu_nu_apx_meet f \<equiv> has_apx_meet (\<mu> f) (\<nu> f) \<and> \<mu> f \<triangle> \<nu> f = \<mu> f \<squnion> (\<nu> f \<sqinter> L)"

definition apx_meet_below_nu :: "('a \<Rightarrow> 'a) \<Rightarrow> bool"
  where "apx_meet_below_nu f \<equiv> has_apx_meet (\<mu> f) (\<nu> f) \<and> \<mu> f \<triangle> \<nu> f \<le> \<nu> f"

lemma mu_below_l:
  "\<mu> f \<le> \<mu> f \<squnion> (\<nu> f \<sqinter> L)"
  by simp

lemma l_below_nu:
  "has_least_fixpoint f \<Longrightarrow> has_greatest_fixpoint f \<Longrightarrow> \<mu> f \<squnion> (\<nu> f \<sqinter> L) \<le> \<nu> f"
  by (simp add: mu_below_nu)

lemma n_l_nu:
  "has_least_fixpoint f \<Longrightarrow> has_greatest_fixpoint f \<Longrightarrow> (\<mu> f \<squnion> (\<nu> f \<sqinter> L)) \<sqinter> L = \<nu> f \<sqinter> L"
  by (meson l_below_nu inf.cobounded1 inf.sup_same_context order_trans sup_ge2)

lemma l_apx_mu:
  "\<mu> f \<squnion> (\<nu> f \<sqinter> L) \<sqsubseteq> \<mu> f"
proof -
  have 1: "\<mu> f \<squnion> (\<nu> f \<sqinter> L) \<le> \<mu> f \<squnion> L"
    using sup_right_isotone by auto
  have "C (\<mu> f) \<le> \<mu> f \<squnion> (\<nu> f \<sqinter> L) \<squnion> n(\<mu> f \<squnion> (\<nu> f \<sqinter> L)) * top"
    by (simp add: le_supI1)
  thus ?thesis
    using 1 apx_def by blast
qed

text \<open>AACP Theorem 4.8 implies Theorem 4.9\<close>

lemma nu_below_mu_nu_nu_below_mu_nu_2:
  assumes "nu_below_mu_nu f"
    shows "nu_below_mu_nu_2 f"
proof -
  have "C (\<nu> f) = C (C (\<nu> f))"
    by auto
  also have "... \<le> C (\<mu> f \<squnion> (\<nu> f \<sqinter> L) \<squnion> n(\<nu> f) * top)"
    using assms nu_below_mu_nu_def by auto
  also have "... = C (\<mu> f \<squnion> (\<nu> f \<sqinter> L)) \<squnion> C (n(\<nu> f) * top)"
    using inf_sup_distrib1 by auto
  also have "... = C (\<mu> f \<squnion> (\<nu> f \<sqinter> L)) \<squnion> n(\<nu> f) * top"
    by (simp add: C_n_mult_closed)
  also have "... \<le> \<mu> f \<squnion> (\<nu> f \<sqinter> L) \<squnion> n(\<nu> f) * top"
    using inf_le2 sup_left_isotone by blast
  also have "... = \<mu> f \<squnion> (\<nu> f \<sqinter> L) \<squnion> n(\<nu> f \<sqinter> L) * top"
    using n_n_meet_L by auto
  also have "... \<le> \<mu> f \<squnion> (\<nu> f \<sqinter> L) \<squnion> n(\<mu> f \<squnion> (\<nu> f \<sqinter> L)) * top"
    using mult_isotone n_right_upper_bound semiring.add_left_mono by auto
  finally show ?thesis
    by (simp add: nu_below_mu_nu_2_def)
qed

text \<open>AACP Theorem 4.9 implies Theorem 4.8\<close>

lemma nu_below_mu_nu_2_nu_below_mu_nu:
  assumes "has_least_fixpoint f"
      and "has_greatest_fixpoint f"
      and "nu_below_mu_nu_2 f"
    shows "nu_below_mu_nu f"
proof -
  have "C (\<nu> f) \<le> \<mu> f \<squnion> (\<nu> f \<sqinter> L) \<squnion> n(\<mu> f \<squnion> (\<nu> f \<sqinter> L)) * top"
    using assms(3) nu_below_mu_nu_2_def by blast
  also have "... \<le> \<mu> f \<squnion> (\<nu> f \<sqinter> L) \<squnion> n(\<nu> f) * top"
    by (metis assms(1,2) order.eq_iff n_n_meet_L n_l_nu)
  finally show ?thesis
    using nu_below_mu_nu_def by blast
qed

lemma nu_below_mu_nu_equivalent:
  "has_least_fixpoint f \<Longrightarrow> has_greatest_fixpoint f \<Longrightarrow> (nu_below_mu_nu f \<longleftrightarrow> nu_below_mu_nu_2 f)"
  using nu_below_mu_nu_2_nu_below_mu_nu nu_below_mu_nu_nu_below_mu_nu_2 by blast

text \<open>AACP Theorem 4.9 implies Theorem 4.10\<close>

lemma nu_below_mu_nu_2_mu_nu_apx_nu:
  assumes "has_least_fixpoint f"
      and "has_greatest_fixpoint f"
      and "nu_below_mu_nu_2 f"
    shows "mu_nu_apx_nu f"
proof -
  have "\<mu> f \<squnion> (\<nu> f \<sqinter> L) \<le> \<nu> f \<squnion> L"
    using assms(1,2) l_below_nu le_supI1 by blast
  thus ?thesis
    using assms(3) apx_def mu_nu_apx_nu_def nu_below_mu_nu_2_def by blast
qed

text \<open>AACP Theorem 4.10 implies Theorem 4.11\<close>

lemma mu_nu_apx_nu_mu_nu_apx_meet:
  assumes "mu_nu_apx_nu f"
    shows "mu_nu_apx_meet f"
proof -
  let ?l = "\<mu> f \<squnion> (\<nu> f \<sqinter> L)"
  have "is_apx_meet (\<mu> f) (\<nu> f) ?l"
  proof (unfold is_apx_meet_def, intro conjI)
    show "?l \<sqsubseteq> \<mu> f"
      by (simp add: l_apx_mu)
    show "?l \<sqsubseteq> \<nu> f"
      using assms mu_nu_apx_nu_def by blast
    show "\<forall>w. w \<sqsubseteq> \<mu> f \<and> w \<sqsubseteq> \<nu> f \<longrightarrow> w \<sqsubseteq> ?l"
      by (metis apx_meet_L le_inf_iff sup.absorb1 sup_apx_left_isotone)
  qed
  thus ?thesis
    by (simp add: apx_meet_char mu_nu_apx_meet_def)
qed

text \<open>AACP Theorem 4.11 implies Theorem 4.12\<close>

lemma mu_nu_apx_meet_apx_meet_below_nu:
  "has_least_fixpoint f \<Longrightarrow> has_greatest_fixpoint f \<Longrightarrow> mu_nu_apx_meet f \<Longrightarrow> apx_meet_below_nu f"
  using apx_meet_below_nu_def l_below_nu mu_nu_apx_meet_def by auto

text \<open>AACP Theorem 4.12 implies Theorem 4.9\<close>

lemma apx_meet_below_nu_nu_below_mu_nu_2:
  assumes "apx_meet_below_nu f"
    shows "nu_below_mu_nu_2 f"
proof -
  let ?l = "\<mu> f \<squnion> (\<nu> f \<sqinter> L)"
  have "\<forall>m . m \<sqsubseteq> \<mu> f \<and> m \<sqsubseteq> \<nu> f \<and> m \<le> \<nu> f \<longrightarrow> C (\<nu> f) \<le> ?l \<squnion> n(?l) * top"
  proof
    fix m
    show "m \<sqsubseteq> \<mu> f \<and> m \<sqsubseteq> \<nu> f \<and> m \<le> \<nu> f \<longrightarrow> C (\<nu> f) \<le> ?l \<squnion> n(?l) * top"
    proof
      assume 1: "m \<sqsubseteq> \<mu> f \<and> m \<sqsubseteq> \<nu> f \<and> m \<le> \<nu> f"
      hence "m \<le> ?l"
        by (smt (z3) apx_def sup.left_commute sup_inf_distrib1 sup_left_divisibility)
      hence "m \<squnion> n(m) * top \<le> ?l \<squnion> n(?l) * top"
        by (metis sup_mono mult_left_isotone n_isotone)
      thus "C (\<nu> f) \<le> ?l \<squnion> n(?l) * top"
        using 1 apx_def order.trans by blast
    qed
  qed
  thus ?thesis
    by (smt (verit, ccfv_threshold) assms apx_meet_below_nu_def apx_meet_same apx_meet_unique is_apx_meet_def nu_below_mu_nu_2_def)
qed

text \<open>AACP Theorem 4.5 implies Theorem 4.6\<close>

lemma has_apx_least_fixpoint_kappa_apx_meet:
  assumes "has_least_fixpoint f"
      and "has_greatest_fixpoint f"
      and "apx.has_least_fixpoint f"
    shows "kappa_apx_meet f"
proof -
  have 1: "\<forall>w . w \<sqsubseteq> \<mu> f \<and> w \<sqsubseteq> \<nu> f \<longrightarrow> C (\<kappa> f) \<le> w \<squnion> n(w) * top"
    by (metis assms(2,3) apx_def inf.sup_right_isotone order_trans kappa_below_nu)
  have "\<forall>w . w \<sqsubseteq> \<mu> f \<and> w \<sqsubseteq> \<nu> f \<longrightarrow> w \<le> \<kappa> f \<squnion> L"
    by (metis assms(1,3) sup_left_isotone apx_def mu_below_kappa order_trans)
  hence "\<forall>w . w \<sqsubseteq> \<mu> f \<and> w \<sqsubseteq> \<nu> f \<longrightarrow> w \<sqsubseteq> \<kappa> f"
    using 1 apx_def by blast
  hence "is_apx_meet (\<mu> f) (\<nu> f) (\<kappa> f)"
    by (simp add: assms is_apx_meet_def kappa_apx_below_mu kappa_apx_below_nu)
  thus ?thesis
    by (simp add: assms(3) kappa_apx_meet_def apx_meet_char)
qed

text \<open>AACP Theorem 4.6 implies Theorem 4.12\<close>

lemma kappa_apx_meet_apx_meet_below_nu:
  "has_greatest_fixpoint f \<Longrightarrow> kappa_apx_meet f \<Longrightarrow> apx_meet_below_nu f"
  using apx_meet_below_nu_def kappa_apx_meet_def kappa_below_nu by force

text \<open>AACP Theorem 4.12 implies Theorem 4.7\<close>

lemma apx_meet_below_nu_kappa_mu_nu:
  assumes "has_least_fixpoint f"
      and "has_greatest_fixpoint f"
      and "isotone f"
      and "apx.isotone f"
      and "apx_meet_below_nu f"
    shows "kappa_mu_nu f"
proof -
  let ?l = "\<mu> f \<squnion> (\<nu> f \<sqinter> L)"
  let ?m = "\<mu> f \<triangle> \<nu> f"
  have 1: "?m = ?l"
    by (metis assms(1,2,5) apx_meet_below_nu_nu_below_mu_nu_2 mu_nu_apx_meet_def mu_nu_apx_nu_mu_nu_apx_meet nu_below_mu_nu_2_mu_nu_apx_nu)
  have 2: "?l \<le> f(?l) \<squnion> L"
  proof -
    have "?l \<le> \<mu> f \<squnion> L"
      using sup_right_isotone by auto
    also have "... = f(\<mu> f) \<squnion> L"
      by (simp add: assms(1) mu_unfold)
    also have "... \<le> f(?l) \<squnion> L"
      using assms(3) isotone_def sup_ge1 sup_left_isotone by blast
    finally show "?l \<le> f(?l) \<squnion> L"
      .
  qed
  have "C (f(?l)) \<le> ?l \<squnion> n(?l) * top"
  proof -
    have "C (f(?l)) \<le> C (f(\<nu> f))"
      using assms(1-3) l_below_nu inf.sup_right_isotone isotone_def by blast
    also have "... = C (\<nu> f)"
      by (metis assms(2) nu_unfold)
    also have "... \<le> ?l \<squnion> n(?l) * top"
      by (metis assms(5) apx_meet_below_nu_nu_below_mu_nu_2 nu_below_mu_nu_2_def)
    finally show "C (f(?l)) \<le> ?l \<squnion> n(?l) * top"
      .
  qed
  hence 3: "?l \<sqsubseteq> f(?l)"
    using 2 apx_def by blast
  have 4: "f(?l) \<sqsubseteq> \<mu> f"
  proof -
    have "?l \<sqsubseteq> \<mu> f"
      by (simp add: l_apx_mu)
    thus "f(?l) \<sqsubseteq> \<mu> f"
      by (metis assms(1,4) mu_unfold ord.isotone_def)
  qed
  have "f(?l) \<sqsubseteq> \<nu> f"
  proof -
    have "?l \<sqsubseteq> \<nu> f"
      using 1
      by (metis apx_meet_below_nu_def assms(5) apx_meet is_apx_meet_def)
    thus "f(?l) \<sqsubseteq> \<nu> f"
      by (metis assms(2,4) nu_unfold ord.isotone_def)
  qed
  hence "f(?l) \<sqsubseteq> ?l"
    using 1 4 apx_meet_below_nu_def assms(5) apx_meet is_apx_meet_def by fastforce
  hence 5: "f(?l) = ?l"
    using 3 apx.order.antisym by blast
  have "\<forall>y . f(y) = y \<longrightarrow> ?l \<sqsubseteq> y"
  proof
    fix y
    show "f(y) = y \<longrightarrow> ?l \<sqsubseteq> y"
    proof
      assume 6: "f(y) = y"
      hence 7: "?l \<le> y \<squnion> L"
        using assms(1) inf.cobounded2 is_least_fixpoint_def least_fixpoint semiring.add_mono by blast
      have "y \<le> \<nu> f"
        using 6 assms(2) greatest_fixpoint is_greatest_fixpoint_def by auto
      hence "C y \<le> ?l \<squnion> n(?l) * top"
        using assms(5) apx_meet_below_nu_nu_below_mu_nu_2 inf.sup_right_isotone nu_below_mu_nu_2_def order_trans by blast
      thus "?l \<sqsubseteq> y"
        using 7 apx_def by blast
    qed
  qed
  thus ?thesis
    using 5 apx.least_fixpoint_same apx.has_least_fixpoint_def apx.is_least_fixpoint_def kappa_mu_nu_def by auto
qed

text \<open>AACP Theorem 4.7 implies Theorem 4.5\<close>

lemma kappa_mu_nu_has_apx_least_fixpoint:
  "kappa_mu_nu f \<Longrightarrow> apx.has_least_fixpoint f"
  by (simp add: kappa_mu_nu_def)

text \<open>AACP Theorem 4.8 implies Theorem 4.7\<close>

lemma nu_below_mu_nu_kappa_mu_nu:
  "has_least_fixpoint f \<Longrightarrow> has_greatest_fixpoint f \<Longrightarrow> isotone f \<Longrightarrow> apx.isotone f \<Longrightarrow> nu_below_mu_nu f \<Longrightarrow> kappa_mu_nu f"
  using apx_meet_below_nu_kappa_mu_nu mu_nu_apx_meet_apx_meet_below_nu mu_nu_apx_nu_mu_nu_apx_meet nu_below_mu_nu_2_mu_nu_apx_nu nu_below_mu_nu_nu_below_mu_nu_2 by blast

text \<open>AACP Theorem 4.7 implies Theorem 4.8\<close>

lemma kappa_mu_nu_nu_below_mu_nu:
  "has_least_fixpoint f \<Longrightarrow> has_greatest_fixpoint f \<Longrightarrow> kappa_mu_nu f \<Longrightarrow> nu_below_mu_nu f"
  by (simp add: apx_meet_below_nu_nu_below_mu_nu_2 has_apx_least_fixpoint_kappa_apx_meet kappa_apx_meet_apx_meet_below_nu kappa_mu_nu_has_apx_least_fixpoint nu_below_mu_nu_2_nu_below_mu_nu)

definition kappa_mu_nu_L :: "('a \<Rightarrow> 'a) \<Rightarrow> bool"
  where "kappa_mu_nu_L f \<equiv> apx.has_least_fixpoint f \<and> \<kappa> f = \<mu> f \<squnion> n(\<nu> f) * L"

definition nu_below_mu_nu_L :: "('a \<Rightarrow> 'a) \<Rightarrow> bool"
  where "nu_below_mu_nu_L f \<equiv> C (\<nu> f) \<le> \<mu> f \<squnion> n(\<nu> f) * top"

definition mu_nu_apx_nu_L :: "('a \<Rightarrow> 'a) \<Rightarrow> bool"
  where "mu_nu_apx_nu_L f \<equiv> \<mu> f \<squnion> n(\<nu> f) * L \<sqsubseteq> \<nu> f"

definition mu_nu_apx_meet_L :: "('a \<Rightarrow> 'a) \<Rightarrow> bool"
  where "mu_nu_apx_meet_L f \<equiv> has_apx_meet (\<mu> f) (\<nu> f) \<and> \<mu> f \<triangle> \<nu> f = \<mu> f \<squnion> n(\<nu> f) * L"

lemma n_below_l:
  "x \<squnion> n(y) * L \<le> x \<squnion> (y \<sqinter> L)"
  using n_L_decreasing_meet_L semiring.add_left_mono by auto

lemma n_equal_l:
  assumes "nu_below_mu_nu_L f"
    shows "\<mu> f \<squnion> n(\<nu> f) * L = \<mu> f \<squnion> (\<nu> f \<sqinter> L)"
proof -
  have "\<nu> f \<sqinter> L \<le> (\<mu> f \<squnion> n(\<nu> f) * top) \<sqinter> L"
    by (meson assms order.trans inf.boundedI inf.cobounded2 meet_L_below_C nu_below_mu_nu_L_def)
  also have "... \<le> \<mu> f \<squnion> (n(\<nu> f) * top \<sqinter> L)"
    by (simp add: inf.coboundedI2 inf.sup_monoid.add_commute inf_sup_distrib1)
  also have "... \<le> \<mu> f \<squnion> n(\<nu> f) * L"
    by (simp add: n_T_meet_L)
  finally have "\<mu> f \<squnion> (\<nu> f \<sqinter> L) \<le> \<mu> f \<squnion> n(\<nu> f) * L"
    by simp
  thus "\<mu> f \<squnion> n(\<nu> f) * L = \<mu> f \<squnion> (\<nu> f \<sqinter> L)"
    by (meson order.antisym n_below_l)
qed

text \<open>AACP Theorem 4.14 implies Theorem 4.8\<close>

lemma nu_below_mu_nu_L_nu_below_mu_nu:
  "nu_below_mu_nu_L f \<Longrightarrow> nu_below_mu_nu f"
  by (metis sup_assoc sup_right_top mult_left_dist_sup n_equal_l nu_below_mu_nu_L_def nu_below_mu_nu_def)

text \<open>AACP Theorem 4.14 implies Theorem 4.13\<close>

lemma nu_below_mu_nu_L_kappa_mu_nu_L:
  "has_least_fixpoint f \<Longrightarrow> has_greatest_fixpoint f \<Longrightarrow> isotone f \<Longrightarrow> apx.isotone f \<Longrightarrow> nu_below_mu_nu_L f \<Longrightarrow> kappa_mu_nu_L f"
  using kappa_mu_nu_L_def kappa_mu_nu_def n_equal_l nu_below_mu_nu_L_nu_below_mu_nu nu_below_mu_nu_kappa_mu_nu by force

text \<open>AACP Theorem 4.14 implies Theorem 4.15\<close>

lemma nu_below_mu_nu_L_mu_nu_apx_nu_L:
  "has_least_fixpoint f \<Longrightarrow> has_greatest_fixpoint f \<Longrightarrow> nu_below_mu_nu_L f \<Longrightarrow> mu_nu_apx_nu_L f"
  using mu_nu_apx_nu_L_def mu_nu_apx_nu_def n_equal_l nu_below_mu_nu_2_mu_nu_apx_nu nu_below_mu_nu_L_nu_below_mu_nu nu_below_mu_nu_nu_below_mu_nu_2 by auto

text \<open>AACP Theorem 4.14 implies Theorem 4.16\<close>

lemma nu_below_mu_nu_L_mu_nu_apx_meet_L:
  "has_least_fixpoint f \<Longrightarrow> has_greatest_fixpoint f \<Longrightarrow> nu_below_mu_nu_L f \<Longrightarrow> mu_nu_apx_meet_L f"
  using mu_nu_apx_meet_L_def mu_nu_apx_meet_def mu_nu_apx_nu_mu_nu_apx_meet n_equal_l nu_below_mu_nu_2_mu_nu_apx_nu nu_below_mu_nu_L_nu_below_mu_nu nu_below_mu_nu_nu_below_mu_nu_2 by auto

text \<open>AACP Theorem 4.15 implies Theorem 4.14\<close>

lemma mu_nu_apx_nu_L_nu_below_mu_nu_L:
  assumes "has_least_fixpoint f"
      and "has_greatest_fixpoint f"
      and "mu_nu_apx_nu_L f"
    shows "nu_below_mu_nu_L f"
proof -
  let ?n = "\<mu> f \<squnion> n(\<nu> f) * L"
  let ?l = "\<mu> f \<squnion> (\<nu> f \<sqinter> L)"
  have "C (\<nu> f) \<le> ?n \<squnion> n(?n) * top"
    using assms(3) apx_def mu_nu_apx_nu_L_def by blast
  also have "... \<le> ?n \<squnion> n(?l) * top"
    using mult_left_isotone n_L_decreasing_meet_L n_isotone semiring.add_left_mono by auto
  also have "... \<le> ?n \<squnion> n(\<nu> f) * top"
    using assms(1,2) l_below_nu mult_left_isotone n_isotone sup_right_isotone by auto
  finally show ?thesis
    by (metis sup_assoc sup_right_top mult_left_dist_sup nu_below_mu_nu_L_def)
qed

text \<open>AACP Theorem 4.13 implies Theorem 4.15\<close>

lemma kappa_mu_nu_L_mu_nu_apx_nu_L:
  "has_greatest_fixpoint f \<Longrightarrow> kappa_mu_nu_L f \<Longrightarrow> mu_nu_apx_nu_L f"
  using kappa_mu_nu_L_def kappa_apx_below_nu mu_nu_apx_nu_L_def by fastforce

text \<open>AACP Theorem 4.16 implies Theorem 4.15\<close>

lemma mu_nu_apx_meet_L_mu_nu_apx_nu_L:
  "mu_nu_apx_meet_L f \<Longrightarrow> mu_nu_apx_nu_L f"
  using apx_meet_char is_apx_meet_def mu_nu_apx_meet_L_def mu_nu_apx_nu_L_def by fastforce

text \<open>AACP Theorem 4.13 implies Theorem 4.14\<close>

lemma kappa_mu_nu_L_nu_below_mu_nu_L:
  "has_least_fixpoint f \<Longrightarrow> has_greatest_fixpoint f \<Longrightarrow> kappa_mu_nu_L f \<Longrightarrow> nu_below_mu_nu_L f"
  by (simp add: kappa_mu_nu_L_mu_nu_apx_nu_L mu_nu_apx_nu_L_nu_below_mu_nu_L)

proposition nu_below_mu_nu_nu_below_mu_nu_L: "nu_below_mu_nu f \<longrightarrow> nu_below_mu_nu_L f" nitpick [expect=genuine,card=3] oops

lemma unfold_fold_1:
  "isotone f \<Longrightarrow> has_least_prefixpoint f \<Longrightarrow> apx.has_least_fixpoint f \<Longrightarrow> f(x) \<le> x \<Longrightarrow> \<kappa> f \<le> x \<squnion> L"
  by (metis sup_left_isotone apx_def has_least_fixpoint_def is_least_prefixpoint_def least_prefixpoint_char least_prefixpoint_fixpoint order_trans pmu_mu kappa_apx_below_mu)

lemma unfold_fold_2:
  assumes "isotone f"
      and "apx.isotone f"
      and "has_least_prefixpoint f"
      and "has_greatest_fixpoint f"
      and "apx.has_least_fixpoint f"
      and "f(x) \<le> x"
      and "\<kappa> f \<sqinter> L \<le> x \<sqinter> L"
    shows "\<kappa> f \<le> x"
proof -
  have "\<kappa> f \<sqinter> L = \<nu> f \<sqinter> L"
    by (smt (z3) apx_meet_L assms(4,5) order.eq_iff inf.cobounded1 kappa_apx_below_nu kappa_below_nu le_inf_iff)
  hence "\<kappa> f = (\<kappa> f \<sqinter> L) \<squnion> \<mu> f"
    by (metis assms(1-5) apx_meet_below_nu_kappa_mu_nu has_apx_least_fixpoint_kappa_apx_meet sup_commute least_fixpoint_char least_prefixpoint_fixpoint kappa_apx_meet_apx_meet_below_nu kappa_mu_nu_def)
  thus ?thesis
    by (metis assms(1,3,6,7) sup_least is_least_prefixpoint_def least_prefixpoint le_inf_iff pmu_mu)
qed

end

class n_algebra_apx_2 = n_algebra + apx +
  assumes apx_def: "x \<sqsubseteq> y \<longleftrightarrow> x \<le> y \<squnion> L \<and> y \<le> x \<squnion> n(x) * top"
begin

lemma apx_transitive_2:
  assumes "x \<sqsubseteq> y"
      and "y \<sqsubseteq> z"
    shows "x \<sqsubseteq> z"
proof -
  have "z \<le> y \<squnion> n(y) * top"
    using assms(2) apx_def by auto
  also have "... \<le> x \<squnion> n(x) * top \<squnion> n(y) * top"
    using assms(1) apx_def sup_left_isotone by blast
  also have "... \<le> x \<squnion> n(x) * top"
    by (metis assms(1) sup_assoc sup_idem sup_right_isotone apx_def mult_left_isotone n_add_n_top n_isotone)
  finally show ?thesis
    by (smt assms sup_assoc sup_commute apx_def le_iff_sup)
qed

lemma apx_meet_L:
  assumes "y \<sqsubseteq> x"
    shows "x \<sqinter> L \<le> y \<sqinter> L"
proof -
  have "x \<sqinter> L \<le> (y \<sqinter> L) \<squnion> (n(y) * top \<sqinter> L)"
    by (metis assms apx_def inf.sup_left_isotone inf_sup_distrib2)
  also have "... \<le> (y \<sqinter> L) \<squnion> n(y \<sqinter> L) * top"
    using n_n_meet_L sup_right_isotone by force
  finally show ?thesis
    by (metis le_iff_sup inf_le2 n_less_eq_char)
qed

text \<open>AACP Theorem 4.1\<close>

subclass apx_biorder
  apply unfold_locales
  apply (simp add: apx_def)
  using apx_def order.eq_iff n_less_eq_char apply blast
  using apx_transitive_2 by blast

lemma sup_apx_left_isotone_2:
  assumes "x \<sqsubseteq> y"
    shows "x \<squnion> z \<sqsubseteq> y \<squnion> z"
proof -
  have 1: "x \<squnion> z \<le> y \<squnion> z \<squnion> L"
    by (smt assms sup_assoc sup_commute sup_left_isotone apx_def)
  have "y \<squnion> z \<le> x \<squnion> n(x) * top \<squnion> z"
    using assms apx_def sup_left_isotone by blast
  also have "... \<le> x \<squnion> z \<squnion> n(x \<squnion> z) * top"
    by (metis sup_assoc sup_commute sup_right_isotone mult_left_isotone n_right_upper_bound)
  finally show ?thesis
    using 1 apx_def by auto
qed

lemma mult_apx_left_isotone_2:
  assumes "x \<sqsubseteq> y"
    shows "x * z \<sqsubseteq> y * z"
proof -
  have "x * z \<le> y * z \<squnion> L * z"
    by (metis assms apx_def mult_left_isotone mult_right_dist_sup)
  hence 1: "x * z \<le> y * z \<squnion> L"
    using n_L_below_L order_lesseq_imp semiring.add_left_mono by blast
  have "y * z \<le> x * z \<squnion> n(x) * top * z"
    by (metis assms apx_def mult_left_isotone mult_right_dist_sup)
  also have "... \<le> x * z \<squnion> n(x * z) * top"
    by (simp add: n_top_split)
  finally show ?thesis
    using 1 by (simp add: apx_def)
qed

lemma mult_apx_right_isotone_2:
  assumes "x \<sqsubseteq> y"
    shows "z * x \<sqsubseteq> z * y"
proof -
  have "z * x \<le> z * y \<squnion> z * L"
    by (metis assms apx_def mult_left_dist_sup mult_right_isotone)
  also have "... \<le> z * y \<squnion> z * bot \<squnion> L"
    using n_L_split_L semiring.add_left_mono sup_assoc by auto
  finally have 1: "z * x \<le> z * y \<squnion> L"
    using mult_right_isotone sup.absorb_iff1 by force
  have "z * y \<le> z * (x \<squnion> n(x) * top)"
    using assms apx_def mult_right_isotone by blast
  also have "... = z * x \<squnion> z * n(x) * top"
    by (simp add: mult_left_dist_sup mult_assoc)
  also have "... \<le> z * x \<squnion> n(z * x) * top"
    by (simp add: n_split_top)
  finally show ?thesis
    using 1 by (simp add: apx_def)
qed

end

end


(*  Title:      HOL/Algebra/Generated_Fields.thy
    Author:     Martin Baillon
*)

theory Generated_Fields
imports Generated_Rings Subrings Multiplicative_Group
begin

inductive_set
  generate_field :: "('a, 'b) ring_scheme \<Rightarrow> 'a set \<Rightarrow> 'a set"
  for R and H where
    one  : "\<one>\<^bsub>R\<^esub> \<in> generate_field R H"
  | incl : "h \<in> H \<Longrightarrow> h \<in> generate_field R H"
  | a_inv: "h \<in> generate_field R H \<Longrightarrow> \<ominus>\<^bsub>R\<^esub> h \<in> generate_field R H"
  | m_inv: "\<lbrakk> h \<in> generate_field R H; h \<noteq> \<zero>\<^bsub>R\<^esub> \<rbrakk> \<Longrightarrow> inv\<^bsub>R\<^esub> h \<in> generate_field R H"
  | eng_add : "\<lbrakk> h1 \<in> generate_field R H; h2 \<in> generate_field R H \<rbrakk> \<Longrightarrow> h1 \<oplus>\<^bsub>R\<^esub> h2 \<in> generate_field R H"
  | eng_mult: "\<lbrakk> h1 \<in> generate_field R H; h2 \<in> generate_field R H \<rbrakk> \<Longrightarrow> h1 \<otimes>\<^bsub>R\<^esub> h2 \<in> generate_field R H"

subsection\<open>Basic Properties of Generated Rings - First Part\<close>

(* REPLACED ========================================================================== *)
lemma (in field) subgroup_mult_of:
  assumes "subfield K R"
  shows "subgroup (K - {\<zero>}) (mult_of R)"
proof (intro group.group_incl_imp_subgroup[OF field_mult_group])
  show "K - {\<zero>} \<subseteq> carrier (mult_of R)"
    by (simp add: Diff_mono assms  subfieldE(3))
  show "group ((mult_of R) \<lparr> carrier := K - {\<zero>} \<rparr>)"
    using field.field_mult_group[OF subfield_iff(2)[OF assms]]
    unfolding mult_of_def by simp
qed

lemma (in field) generate_field_in_carrier:
  assumes "H \<subseteq> carrier R"
  shows "h \<in> generate_field R H \<Longrightarrow> h \<in> carrier R"
  apply (induction rule: generate_field.induct)
  using assms field_Units
  by blast+

lemma (in field) generate_field_incl:
  assumes "H \<subseteq> carrier R"
  shows "generate_field R H \<subseteq> carrier R"
  using generate_field_in_carrier[OF assms] by auto

lemma (in field) zero_in_generate: "\<zero>\<^bsub>R\<^esub> \<in> generate_field R H"
  using one a_inv generate_field.eng_add one_closed r_neg
  by metis

lemma (in field) generate_field_is_subfield:
  assumes "H \<subseteq> carrier R"
  shows "subfield (generate_field R H) R"
proof (intro subfieldI', simp_all add: m_inv)
  show "subring (generate_field R H) R"
    by (auto intro: subringI[of "generate_field R H"]
             simp add: eng_add a_inv eng_mult one generate_field_in_carrier[OF assms])
qed

lemma (in field) generate_field_is_add_subgroup:
  assumes "H \<subseteq> carrier R"
  shows "subgroup (generate_field R H) (add_monoid R)"
  using subring.axioms(1)[OF subfieldE(1)[OF generate_field_is_subfield[OF assms]]] .

lemma (in field) generate_field_is_field :
  assumes "H \<subseteq> carrier R"
  shows "field (R \<lparr> carrier := generate_field R H \<rparr>)"
  using subfield_iff generate_field_is_subfield assms by simp

lemma (in field) generate_field_min_subfield1:
  assumes "H \<subseteq> carrier R"
    and "subfield E R" "H \<subseteq> E"
  shows "generate_field R H \<subseteq> E"
proof
  fix h
  assume h: "h \<in> generate_field R H"
  show "h \<in> E"
    using h and assms(3) and subfield_m_inv[OF assms(2)]
    by (induct rule: generate_field.induct)
       (auto simp add: subringE(3,5-7)[OF subfieldE(1)[OF assms(2)]])
qed

lemma (in field) generate_fieldI:
  assumes "H \<subseteq> carrier R"
    and "subfield E R" "H \<subseteq> E"
    and "\<And>K. \<lbrakk> subfield K R; H \<subseteq> K \<rbrakk> \<Longrightarrow> E \<subseteq> K"
  shows "E = generate_field R H"
proof
  show "E \<subseteq> generate_field R H"
    using assms generate_field_is_subfield generate_field.incl by (metis subset_iff)
  show "generate_field R H \<subseteq> E"
    using generate_field_min_subfield1[OF assms(1-3)] by simp
qed

lemma (in field) generate_fieldE:
  assumes "H \<subseteq> carrier R" and "E = generate_field R H"
  shows "subfield E R" and "H \<subseteq> E" and "\<And>K. \<lbrakk> subfield K R; H \<subseteq> K \<rbrakk> \<Longrightarrow> E \<subseteq> K"
proof -
  show "subfield E R" using assms generate_field_is_subfield by simp
  show "H \<subseteq> E" using assms(2) by (simp add: generate_field.incl subsetI)
  show "\<And>K. subfield K R  \<Longrightarrow> H \<subseteq> K \<Longrightarrow> E \<subseteq> K"
    using assms generate_field_min_subfield1 by auto
qed

lemma (in field) generate_field_min_subfield2:
  assumes "H \<subseteq> carrier R"
  shows "generate_field R H = \<Inter>{K. subfield K R \<and> H \<subseteq> K}"
proof
  have "subfield (generate_field R H) R \<and> H \<subseteq> generate_field R H"
    by (simp add: assms generate_fieldE(2) generate_field_is_subfield)
  thus "\<Inter>{K. subfield K R \<and> H \<subseteq> K} \<subseteq> generate_field R H" by blast
next
  have "\<And>K. subfield K R \<and> H \<subseteq> K \<Longrightarrow> generate_field R H \<subseteq> K"
    by (simp add: assms generate_field_min_subfield1)
  thus "generate_field R H \<subseteq> \<Inter>{K. subfield K R \<and> H \<subseteq> K}" by blast
qed

lemma (in field) mono_generate_field:
  assumes "I \<subseteq> J" and "J \<subseteq> carrier R"
  shows "generate_field R I \<subseteq> generate_field R J"
proof-
  have "I \<subseteq> generate_field R J "
    using assms generate_fieldE(2) by blast
  thus "generate_field R I \<subseteq> generate_field R J"
    using generate_field_min_subfield1[of I "generate_field R J"] assms generate_field_is_subfield[OF assms(2)]
    by blast
qed

lemma (in field) subfield_gen_incl :
  assumes "subfield H R"
    and  "subfield K R"
    and "I \<subseteq> H"
    and "I \<subseteq> K"
  shows "generate_field (R\<lparr>carrier := K\<rparr>) I \<subseteq> generate_field (R\<lparr>carrier := H\<rparr>) I"
proof
  {fix J assume J_def : "subfield J R" "I \<subseteq> J"
    have "generate_field (R \<lparr> carrier := J \<rparr>) I \<subseteq> J"
      using field.mono_generate_field[of "(R\<lparr>carrier := J\<rparr>)" I J] subfield_iff(2)[OF J_def(1)]
          field.generate_field_in_carrier[of "R\<lparr>carrier := J\<rparr>"]  field_axioms J_def
      by auto}
  note incl_HK = this
  {fix x have "x \<in> generate_field (R\<lparr>carrier := K\<rparr>) I \<Longrightarrow> x \<in> generate_field (R\<lparr>carrier := H\<rparr>) I"
    proof (induction  rule : generate_field.induct)
      case one
        have "\<one>\<^bsub>R\<lparr>carrier := H\<rparr>\<^esub> \<otimes> \<one>\<^bsub>R\<lparr>carrier := K\<rparr>\<^esub> = \<one>\<^bsub>R\<lparr>carrier := H\<rparr>\<^esub>" by simp
        moreover have "\<one>\<^bsub>R\<lparr>carrier := H\<rparr>\<^esub> \<otimes> \<one>\<^bsub>R\<lparr>carrier := K\<rparr>\<^esub> = \<one>\<^bsub>R\<lparr>carrier := K\<rparr>\<^esub>" by simp
        ultimately show ?case using assms generate_field.one by metis
    next
      case (incl h) thus ?case using generate_field.incl by force
    next
      case (a_inv h)
      note hyp = this
      have "a_inv (R\<lparr>carrier := K\<rparr>) h = a_inv R h"
        using assms group.m_inv_consistent[of "add_monoid R" K] a_comm_group incl_HK[of K] hyp
               subring.axioms(1)[OF subfieldE(1)[OF assms(2)]]
        unfolding comm_group_def a_inv_def by auto
      moreover have "a_inv (R\<lparr>carrier := H\<rparr>) h = a_inv R h"
        using assms group.m_inv_consistent[of "add_monoid R" H] a_comm_group incl_HK[of H] hyp
               subring.axioms(1)[OF subfieldE(1)[OF assms(1)]]
        unfolding  comm_group_def a_inv_def by auto
      ultimately show ?case using generate_field.a_inv a_inv.IH by fastforce
    next
      case (m_inv h)
      note hyp = this
      have h_K : "h \<in> (K - {\<zero>})" using incl_HK[OF assms(2) assms(4)] hyp by auto
      hence "m_inv (R\<lparr>carrier := K\<rparr>) h = m_inv R h"
        using  field.m_inv_mult_of[OF subfield_iff(2)[OF assms(2)]]
               group.m_inv_consistent[of "mult_of R" "K - {\<zero>}"] field_mult_group units_of_inv
               subgroup_mult_of subfieldE[OF assms(2)] unfolding mult_of_def apply simp
        by (metis h_K mult_of_def mult_of_is_Units subgroup.mem_carrier units_of_carrier assms(2))
      moreover have h_H : "h \<in> (H - {\<zero>})" using incl_HK[OF assms(1) assms(3)] hyp by auto
      hence "m_inv (R\<lparr>carrier := H\<rparr>) h = m_inv R h"
        using  field.m_inv_mult_of[OF subfield_iff(2)[OF assms(1)]]
               group.m_inv_consistent[of "mult_of R" "H - {\<zero>}"] field_mult_group
               subgroup_mult_of[OF assms(1)]  unfolding mult_of_def apply simp
        by (metis h_H field_Units m_inv_mult_of mult_of_is_Units subgroup.mem_carrier units_of_def)
      ultimately show ?case using generate_field.m_inv m_inv.IH h_H by fastforce
    next
      case (eng_add h1 h2)
      thus ?case using incl_HK assms generate_field.eng_add by force
    next
      case (eng_mult h1 h2)
      thus ?case using generate_field.eng_mult by force
    qed}
  thus "\<And>x. x \<in> generate_field (R\<lparr>carrier := K\<rparr>) I \<Longrightarrow> x \<in> generate_field (R\<lparr>carrier := H\<rparr>) I"
    by auto
qed

lemma (in field) subfield_gen_equality:
  assumes "subfield H R" "K \<subseteq> H"
  shows "generate_field R K = generate_field (R \<lparr> carrier := H \<rparr>) K"
  using subfield_gen_incl[OF assms(1) carrier_is_subfield assms(2)] assms subringE(1)
        subfield_gen_incl[OF carrier_is_subfield assms(1) _ assms(2)] subfieldE(1)[OF assms(1)]
  by force

end


(*  Title:    HOL/Analysis/Summation_Tests.thy
    Author:   Manuel Eberl, TU München
*)

section \<open>Radius of Convergence and Summation Tests\<close>

theory Summation_Tests
imports
  Complex_Main
  "HOL-Library.Discrete"
  "HOL-Library.Extended_Real"
  "HOL-Library.Liminf_Limsup"
  Extended_Real_Limits
begin

text \<open>
  The definition of the radius of convergence of a power series,
  various summability tests, lemmas to compute the radius of convergence etc.
\<close>

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)))) \<longlonglongrightarrow> l" (is "?g \<longlonglongrightarrow> _")
  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))) \<longlonglongrightarrow> l"
  shows   "limsup (\<lambda>n. ereal (root n (norm (f n)))) = ereal l"
  by (intro limsup_root_limit tendsto_ereal assms)

theorem 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

  define c where "c = (1 - l') / 2"
  from l and \<open>l \<ge> 0\<close> 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 Limsup_le_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

theorem 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

  define c where "c = (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
  define n where "n = 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 obtain m where m: "n < m" "c < root m (norm (f m))" by auto
  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

subsubsection \<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 ^ Discrete.log k))" (is "?thesis1")
          "(\<Sum>k=1..<n. f k) \<le> (\<Sum>k=1..<n. f (2 ^ Discrete.log k))" (is "?thesis2")
  by (intro sum_mono mono Discrete.log_exp2_ge Discrete.log_exp2_le, simp, simp)+

private lemma condensation_condense1: "(\<Sum>k=1..<2^n. f (2 ^ Discrete.log 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 ^ Discrete.log k)) =
                 (\<Sum>k<n. 2^k * f (2^k)) + (\<Sum>k = 2^n..<2^Suc n. f (2^Discrete.log k))"
    by (subst sum.union_disjoint) (insert Suc, auto)
  also have "Discrete.log k = n" if "k \<in> {2^n..<2^Suc n}" for k using that by (intro Discrete.log_eqI) simp_all
  hence "(\<Sum>k = 2^n..<2^Suc n. f (2^Discrete.log k)) = (\<Sum>(_::nat) = 2^n..<2^Suc n. f (2^n))"
    by (intro sum.cong) simp_all
  also have "\<dots> = 2^n * f (2^n)" by (simp)
  finally show ?case by simp
qed simp

private lemma condensation_condense2: "(\<Sum>k=1..<2^n. f (2 * 2 ^ Discrete.log 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 ^ Discrete.log k)) =
                 (\<Sum>k<n. 2^k * f (2^Suc k)) + (\<Sum>k = 2^n..<2^Suc n. f (2 * 2^Discrete.log k))"
    by (subst sum.union_disjoint) (insert Suc, auto)
  also have "Discrete.log k = n" if "k \<in> {2^n..<2^Suc n}" for k using that by (intro Discrete.log_eqI) simp_all
  hence "(\<Sum>k = 2^n..<2^Suc n. f (2*2^Discrete.log k)) = (\<Sum>(_::nat) = 2^n..<2^Suc n. f (2^Suc n))"
    by (intro sum.cong) simp_all
  also have "\<dots> = 2^n * f (2^Suc n)" by (simp)
  finally show ?case by simp
qed simp

theorem 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 -
  define f' where "f' n = (if n = 0 then 0 else f n)" for 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 sum_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!: sum_nonneg incseq_SucI nonneg simp: strict_mono_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 sum_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] sum_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: sum_distrib_left sum_distrib_right mult_ac)
    hence "Bseq (\<lambda>n. (\<Sum>k=Suc 0..<Suc n. 2^k * f (2^k)) + f 1)"
      by (intro Bseq_add, subst sum.shift_bounds_Suc_ivl) (simp add: atLeast0LessThan)
    hence "Bseq (\<lambda>n. (\<Sum>k=0..<Suc n. 2^k * f (2^k)))"
      by (subst sum.atLeast_Suc_lessThan) (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 sum_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] sum_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

subsubsection \<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
  have "eventually (\<lambda>n. norm (1 :: real) \<le> norm (exp (?l n * s))) sequentially"
    apply (rule eventually_mono [OF eventually_gt_at_top[of "0::nat"]])
    using False ge_one_powr_ge_zero by auto
  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

theorem 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 sum_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

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

theorem 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 -
  define r where "r = (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
    define n where "n = 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: sum_distrib_left[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 sum.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 sum_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 sum.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 sum_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: sum_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 sum_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 sum_mono2) auto
  ultimately show "convergent (\<lambda>n. \<Sum>k\<le>n. f k)" by (rule Bseq_monoseq_convergent'_inc)
qed

theorem 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 Limsup_lessD[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 B: "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)
  have "eventually (\<lambda>n. norm (p N * f N * inverse (p n)) \<le> f n) sequentially"
    apply (rule eventually_mono [OF eventually_ge_at_top[of N]])
    using B N  by (auto  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: field_split_simps)
  with divergent_p show False by contradiction
qed

subsubsection \<open>Ratio test\<close>

theorem 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

theorem 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)

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

theorem 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)

theorem 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>\<open>0::ereal\<close> to \<^term>\<open>\<infinity>::ereal\<close>, 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\<^marker>\<open>tag important\<close> 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_cong_weak [cong]: "(\<And>n. f n = g n) \<Longrightarrow> conv_radius f = conv_radius g"
  by (drule ext) simp_all

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_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 conv_radius_cong':
  assumes "eventually (\<lambda>x. f x = g x) sequentially"
  shows   "conv_radius f = conv_radius g"
  unfolding conv_radius_altdef by (intro Liminf_eq eventually_mono [OF assms]) auto

lemma conv_radius_cong:
  assumes "eventually (\<lambda>x. norm (f x) = norm (g x)) sequentially"
  shows   "conv_radius f = conv_radius g"
  unfolding conv_radius_altdef by (intro Liminf_eq eventually_mono [OF assms]) auto

theorem 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')
  define l where "l = 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 obtain l' where l': "l = ereal l'" "0 < l'" by auto
    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+

theorem 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)
  define l where "l = 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
  define r where "r = (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
  define r where
    "r = (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
  define r where "r = (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_conv_Sup:
  fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
  shows "conv_radius f = Sup {r. \<forall>z. ereal (norm z) < r \<longrightarrow> summable (\<lambda>n. f n * z ^ n)}"
proof (rule Sup_eqI [symmetric], goal_cases)
  case (1 r)
  thus ?case
    by (intro conv_radius_geI_ex') auto
next
  case (2 r)
  from 2[of 0] have r: "r \<ge> 0" by auto
  show ?case
  proof (intro conv_radius_leI_ex' r)
    fix R assume R: "R > 0" "ereal R > r"
    with r obtain r' where [simp]: "r = ereal r'" by (cases r) auto
    show "\<not>summable (\<lambda>n. f n * of_real R ^ n)"
    proof
      assume *: "summable (\<lambda>n. f n * of_real R ^ n)"
      define R' where "R' = (R + r') / 2"
      from R have R': "R' > r'" "R' < R" by (simp_all add: R'_def)
      hence "\<forall>z. norm z < R' \<longrightarrow> summable (\<lambda>n. f n * z ^ n)"
        using powser_inside[OF *] by auto
      from 2[of R'] and this have "R' \<le> r'" by auto
      with \<open>R' > r'\<close> show False by simp
    qed
  qed
qed

lemma conv_radius_shift:
  fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
  shows   "conv_radius (\<lambda>n. f (n + m)) = conv_radius f"
  unfolding conv_radius_conv_Sup summable_powser_ignore_initial_segment ..

lemma conv_radius_norm [simp]: "conv_radius (\<lambda>x. norm (f x)) = conv_radius f"
  by (simp add: conv_radius_def)

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)))) \<longlonglongrightarrow> c"
  shows   "conv_radius f = c"
proof (rule conv_radius_eqI')
  show "c \<ge> 0" by (intro Lim_bounded2[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 field_split_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 field_split_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)))) \<longlonglongrightarrow> 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))) \<longlonglongrightarrow> 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))) \<longlonglongrightarrow> c"
  shows   "conv_radius f = c'"
  using assms by (intro conv_radius_ratio_limit_ereal_nonzero) simp_all

lemma conv_radius_cmult_left:
  assumes "c \<noteq> (0 :: 'a :: {banach, real_normed_div_algebra})"
  shows   "conv_radius (\<lambda>n. c * f n) = conv_radius f"
proof -
  have "conv_radius (\<lambda>n. c * f n) =
          inverse (limsup (\<lambda>n. ereal (root n (norm (c * f n)))))"
    unfolding conv_radius_def ..
  also have "(\<lambda>n. ereal (root n (norm (c * f n)))) =
               (\<lambda>n. ereal (root n (norm c)) * ereal (root n (norm (f n))))"
    by (rule ext) (auto simp: norm_mult real_root_mult)
  also have "limsup \<dots> = ereal 1 * limsup (\<lambda>n. ereal (root n (norm (f n))))"
    using assms by (intro ereal_limsup_lim_mult tendsto_ereal LIMSEQ_root_const) auto
  also have "inverse \<dots> = conv_radius f" by (simp add: conv_radius_def)
  finally show ?thesis .
qed

lemma conv_radius_cmult_right:
  assumes "c \<noteq> (0 :: 'a :: {banach, real_normed_div_algebra})"
  shows   "conv_radius (\<lambda>n. f n * c) = conv_radius f"
proof -
  have "conv_radius (\<lambda>n. f n * c) = conv_radius (\<lambda>n. c * f n)"
    by (simp add: conv_radius_def norm_mult mult.commute)
  with conv_radius_cmult_left[OF assms, of f] show ?thesis by simp
qed

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))))"
    by (intro Limsup_eq eventually_mono [OF eventually_gt_at_top[of "0::nat"]])
       (auto 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 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 power_add [symmetric] scaleR_sum_right)
qed

lemma le_conv_radius_iff:
  fixes a :: "nat \<Rightarrow> 'a::{real_normed_div_algebra,banach}"
  shows "r \<le> conv_radius a \<longleftrightarrow> (\<forall>x. norm (x-\<xi>) < r \<longrightarrow> summable (\<lambda>i. a i * (x - \<xi>) ^ i))"
apply (intro iffI allI impI summable_in_conv_radius conv_radius_geI_ex)
apply (meson less_ereal.simps(1) not_le order_trans)
apply (rule_tac x="of_real ra" in exI, simp)
apply (metis abs_of_nonneg add_diff_cancel_left' less_eq_real_def norm_of_real)
done

end


(* Author:     Tobias Nipkow
    Copyright   2000 TUM
*)

section \<open>Fixed Length Lists\<close>

theory NList
imports Main
begin

definition nlists :: "nat \<Rightarrow> 'a set \<Rightarrow> 'a list set"
  where "nlists n A = {xs. size xs = n \<and> set xs \<subseteq> A}"

lemma nlistsI: "\<lbrakk> size xs = n; set xs \<subseteq> A \<rbrakk> \<Longrightarrow> xs \<in> nlists n A"
  by (simp add: nlists_def)

text \<open>These [simp] attributes are double-edged.
 Many proofs in Jinja rely on it but they can degrade performance.\<close>

lemma nlistsE_length [simp]: "xs \<in> nlists n A \<Longrightarrow> size xs = n"
  by (simp add: nlists_def)

lemma less_lengthI: "\<lbrakk> xs \<in> nlists n A; p < n \<rbrakk> \<Longrightarrow> p < size xs"
by (simp)

lemma nlistsE_set[simp]: "xs \<in> nlists n A \<Longrightarrow> set xs \<subseteq> A"
unfolding nlists_def by (simp)

lemma nlists_mono:
assumes "A \<subseteq> B" shows "nlists n A \<subseteq> nlists n B"
proof
  fix xs assume "xs \<in> nlists n A"
  then obtain size: "size xs = n" and inA: "set xs \<subseteq> A" by (simp)
  with assms have "set xs \<subseteq> B" by simp
  with size show "xs \<in> nlists n B" by(clarsimp intro!: nlistsI)
qed

lemma nlists_n_0 [simp]: "nlists 0 A = {[]}"
unfolding nlists_def by (auto)

lemma in_nlists_Suc_iff: "(xs \<in> nlists (Suc n) A) = (\<exists>y\<in>A. \<exists>ys \<in> nlists n A. xs = y#ys)"
unfolding nlists_def by (cases "xs") auto

lemma Cons_in_nlists_Suc [iff]: "(x#xs \<in> nlists (Suc n) A) \<longleftrightarrow> (x\<in>A \<and> xs \<in> nlists n A)"
unfolding nlists_def by (auto)

lemma nlists_not_empty: "A\<noteq>{} \<Longrightarrow> \<exists>xs. xs \<in> nlists n A"
by (induct "n") (auto simp: in_nlists_Suc_iff)

lemma nlistsE_nth_in: "\<lbrakk> xs \<in> nlists n A; i < n \<rbrakk> \<Longrightarrow> xs!i \<in> A"
unfolding nlists_def by (auto)

lemma nlists_Cons_Suc [elim!]:
  "l#xs \<in> nlists n A \<Longrightarrow> (\<And>n'. n = Suc n' \<Longrightarrow> l \<in> A \<Longrightarrow> xs \<in> nlists n' A \<Longrightarrow> P) \<Longrightarrow> P"
unfolding nlists_def by (auto)

lemma nlists_appendE [elim!]:
  "a@b \<in> nlists n A \<Longrightarrow> (\<And>n1 n2. n=n1+n2 \<Longrightarrow> a \<in> nlists n1 A \<Longrightarrow> b \<in> nlists n2 A \<Longrightarrow> P) \<Longrightarrow> P"
proof -
  have "\<And>n. a@b \<in> nlists n A \<Longrightarrow> \<exists>n1 n2. n=n1+n2 \<and> a \<in> nlists n1 A \<and> b \<in> nlists n2 A"
    (is "\<And>n. ?list a n \<Longrightarrow> \<exists>n1 n2. ?P a n n1 n2")
  proof (induct a)
    fix n assume "?list [] n"
    hence "?P [] n 0 n" by simp
    thus "\<exists>n1 n2. ?P [] n n1 n2" by fast
  next
    fix n l ls
    assume "?list (l#ls) n"
    then obtain n' where n: "n = Suc n'" "l \<in> A" and n': "ls@b \<in> nlists n' A" by fastforce
    assume "\<And>n. ls @ b \<in> nlists n A \<Longrightarrow> \<exists>n1 n2. n = n1 + n2 \<and> ls \<in> nlists n1 A \<and> b \<in> nlists n2 A"
    from this and n' have "\<exists>n1 n2. n' = n1 + n2 \<and> ls \<in> nlists n1 A \<and> b \<in> nlists n2 A" .
    then obtain n1 n2 where "n' = n1 + n2" "ls \<in> nlists n1 A" "b \<in> nlists n2 A" by fast
    with n have "?P (l#ls) n (n1+1) n2" by simp
    thus "\<exists>n1 n2. ?P (l#ls) n n1 n2" by fastforce
  qed
  moreover assume "a@b \<in> nlists n A" "\<And>n1 n2. n=n1+n2 \<Longrightarrow> a \<in> nlists n1 A \<Longrightarrow> b \<in> nlists n2 A \<Longrightarrow> P"
  ultimately show ?thesis by blast
qed

lemma nlists_update_in_list [simp, intro!]:
  "\<lbrakk> xs \<in> nlists n A; x\<in>A \<rbrakk> \<Longrightarrow> xs[i := x] \<in> nlists n A"
  by (metis length_list_update nlistsE_length nlistsE_set nlistsI set_update_subsetI)

lemma nlists_appendI [intro?]:
  "\<lbrakk> a \<in> nlists n A; b \<in> nlists m A \<rbrakk> \<Longrightarrow> a @ b \<in> nlists (n+m) A"
unfolding nlists_def by (auto)

lemma nlists_append:
  "xs @ ys \<in> nlists k A \<longleftrightarrow>
   k = length(xs @ ys) \<and> xs \<in> nlists (length xs) A \<and> ys \<in> nlists (length ys) A"
unfolding nlists_def by (auto)

lemma nlists_map [simp]: "(map f xs \<in> nlists (size xs) A) = (f ` set xs \<subseteq> A)"
unfolding nlists_def by (auto)

lemma nlists_replicateI [intro]: "x \<in> A \<Longrightarrow> replicate n x \<in> nlists n A"
 by (induct n) auto

lemma nlists_set[code]: "nlists n (set xs) = set (List.n_lists n xs)"
unfolding nlists_def by (rule sym, induct n) (auto simp: image_iff length_Suc_conv)

end