theory "C-restr"
imports C "C-Meet" "HOLCF-Utils"
begin

subsubsection {* The demand of a $C$-function *}

text {*
The demand is the least amount of resources required to produce a non-bottom element,
if at all.
*}

definition demand :: "(C \<rightarrow> 'a::pcpo) \<Rightarrow> C" where
  "demand f = (if f\<cdot>C\<^sup>\<infinity> \<noteq> \<bottom> then C\<^bsup>(LEAST n. f\<cdot>C\<^bsup>n\<^esup> \<noteq> \<bottom>)\<^esup> else C\<^sup>\<infinity>)"

text {*
Because of continuity, a non-bottom value can always be obtained with finite resources.
*}

lemma finite_resources_suffice:
  assumes "f\<cdot>C\<^sup>\<infinity> \<noteq> \<bottom>"
  obtains n where "f\<cdot>C\<^bsup>n\<^esup> \<noteq> \<bottom>"
proof-
  {
  assume "\<forall>n. f\<cdot>(C\<^bsup>n\<^esup>) = \<bottom>"
  hence "f\<cdot>C\<^sup>\<infinity> \<sqsubseteq> \<bottom>"
    by (auto intro: lub_below[OF ch2ch_Rep_cfunR[OF chain_iterate]]
             simp add: Cinf_def fix_def2 contlub_cfun_arg[OF chain_iterate])
  with assms have False by simp
  }
  thus ?thesis using that by blast
qed

text {*
Because of monotonicity, a non-bottom value can always be obtained with more resources.
*}

lemma more_resources_suffice:
  assumes "f\<cdot>r \<noteq> \<bottom>" and "r \<sqsubseteq> r'"
  shows "f\<cdot>r' \<noteq> \<bottom>"
  using assms(1) monofun_cfun_arg[OF assms(2), where  f = f]
  by auto

lemma infinite_resources_suffice:
  shows "f\<cdot>r \<noteq> \<bottom> \<Longrightarrow> f\<cdot>C\<^sup>\<infinity> \<noteq> \<bottom>"
  by (erule more_resources_suffice[OF _ below_Cinf])

lemma demand_suffices:
  assumes "f\<cdot>C\<^sup>\<infinity> \<noteq> \<bottom>"
  shows "f\<cdot>(demand f) \<noteq> \<bottom>"
  apply (simp add: assms demand_def)
  apply (rule finite_resources_suffice[OF assms])
  apply (rule LeastI)
  apply assumption
  done

lemma not_bot_demand:
  "f\<cdot>r \<noteq> \<bottom> \<longleftrightarrow> demand f \<noteq> C\<^sup>\<infinity> \<and> demand f \<sqsubseteq> r"
proof(intro iffI)
  assume "f\<cdot>r \<noteq> \<bottom>"
  thus "demand f \<noteq> C\<^sup>\<infinity> \<and> demand f \<sqsubseteq> r"
    apply (cases r rule:C_cases)
    apply (auto intro: Least_le simp add: demand_def dest: infinite_resources_suffice)
    done
next
  assume *: "demand f \<noteq> C\<^sup>\<infinity>  \<and> demand f \<sqsubseteq> r"
  then have "f\<cdot>C\<^sup>\<infinity> \<noteq> \<bottom>" by (auto intro: Least_le simp add: demand_def dest: infinite_resources_suffice)
  hence "f\<cdot>(demand f) \<noteq> \<bottom>" by (rule demand_suffices)
  moreover from * have "demand f \<sqsubseteq> r"..
  ultimately
  show "f\<cdot>r \<noteq> \<bottom>" by (rule more_resources_suffice)
qed

lemma infinity_bot_demand:
  "f\<cdot>C\<^sup>\<infinity> = \<bottom> \<longleftrightarrow> demand f = C\<^sup>\<infinity>"
  by (metis below_Cinf not_bot_demand)

lemma demand_suffices':
  assumes "demand f = C\<^bsup>n\<^esup>"
  shows "f\<cdot>(demand f) \<noteq> \<bottom>"
  by (metis C_eq_Cinf assms demand_suffices infinity_bot_demand)

lemma demand_Suc_Least:
  assumes [simp]: "f\<cdot>\<bottom> = \<bottom>"
  assumes "demand f \<noteq> C\<^sup>\<infinity>"
  shows "demand f = C\<^bsup>(Suc (LEAST n. f\<cdot>C\<^bsup>Suc n\<^esup> \<noteq> \<bottom>))\<^esup>"
proof-
  from assms
  have "demand f = C\<^bsup>(LEAST n. f\<cdot>C\<^bsup>n\<^esup> \<noteq> \<bottom>)\<^esup>" by (auto simp add: demand_def)
  also
  then obtain n where "f\<cdot>C\<^bsup>n\<^esup> \<noteq> \<bottom>" by (metis  demand_suffices')
  hence "(LEAST n. f\<cdot>C\<^bsup>n\<^esup> \<noteq> \<bottom>) = Suc (LEAST n. f\<cdot>C\<^bsup>Suc n\<^esup> \<noteq> \<bottom>)"
    apply (rule Least_Suc) by simp
  finally show ?thesis.
qed

lemma demand_C_case[simp]: "demand (C_case\<cdot>f) = C \<cdot> (demand f)"
proof(cases "demand (C_case\<cdot>f) = C\<^sup>\<infinity>")
  case True
  with assms
  have "C_case\<cdot>f\<cdot>C\<^sup>\<infinity> = \<bottom>"
    by (metis infinity_bot_demand)
  with True
  show ?thesis apply auto by (metis infinity_bot_demand)
next
  case False
  hence "demand (C_case\<cdot>f) = C\<^bsup>Suc (LEAST n. (C_case\<cdot>f)\<cdot>C\<^bsup>Suc n\<^esup> \<noteq> \<bottom>)\<^esup>"
    by (rule demand_Suc_Least[OF C.case_rews(1)])
  also have "\<dots> = C\<cdot>C\<^bsup>LEAST n. f\<cdot>C\<^bsup>n\<^esup> \<noteq> \<bottom>\<^esup>" by simp
  also have "\<dots> = C\<cdot>(demand  f)"
    using False unfolding demand_def by auto
  finally show ?thesis.
qed

lemma demand_contravariant:
  assumes "f \<sqsubseteq> g"
  shows "demand g \<sqsubseteq> demand f"
proof(cases "demand f" rule:C_cases)
  fix n
  assume "demand f = C\<^bsup>n\<^esup>"
  hence "f\<cdot>(demand f) \<noteq> \<bottom>" by (metis demand_suffices')
  also note monofun_cfun_fun[OF assms]
  finally have "g\<cdot>(demand f) \<noteq> \<bottom>" by this (intro cont2cont)
  thus "demand g \<sqsubseteq> demand f" unfolding not_bot_demand by auto
qed auto

subsubsection {* Restricting functions with domain C *}

fixrec C_restr :: "C \<rightarrow> (C \<rightarrow> 'a::pcpo) \<rightarrow> (C \<rightarrow> 'a)"
  where "C_restr\<cdot>r\<cdot>f\<cdot>r' = (f\<cdot>(r \<sqinter> r'))"

abbreviation C_restr_syn :: "(C \<rightarrow> 'a::pcpo) \<Rightarrow> C \<Rightarrow> (C \<rightarrow> 'a)" ( "_|\<^bsub>_\<^esub>" [111,110] 110)
  where "f|\<^bsub>r\<^esub> \<equiv> C_restr\<cdot>r\<cdot>f"

lemma C_restr_C_restr[simp]: "(v|\<^bsub>r'\<^esub>)|\<^bsub>r\<^esub> = v|\<^bsub>(r' \<sqinter> r)\<^esub>"
  by (rule cfun_eqI) simp

lemma C_restr_eqD:
  assumes "f|\<^bsub>r\<^esub> = g|\<^bsub>r\<^esub>"
  assumes "r' \<sqsubseteq> r"
  shows "f\<cdot>r' = g\<cdot>r'"
by (metis C_restr.simps assms below_refl is_meetI)

lemma C_restr_eq_lower:
  assumes "f|\<^bsub>r\<^esub> = g|\<^bsub>r\<^esub>"
  assumes "r' \<sqsubseteq> r"
  shows "f|\<^bsub>r'\<^esub> = g|\<^bsub>r'\<^esub>"
by (metis C_restr_C_restr assms below_refl is_meetI)

lemma C_restr_below[intro, simp]:
  "x|\<^bsub>r\<^esub> \<sqsubseteq> x"
  apply (rule cfun_belowI)
  apply simp
  by (metis below_refl meet_below2 monofun_cfun_arg)

lemma C_restr_below_cong:
  "(\<And> r'. r' \<sqsubseteq> r \<Longrightarrow> f \<cdot> r' \<sqsubseteq> g \<cdot> r') \<Longrightarrow> f|\<^bsub>r\<^esub> \<sqsubseteq> g|\<^bsub>r\<^esub>"
  apply (rule cfun_belowI)
  apply simp
  by (metis below_refl meet_below1)

lemma C_restr_cong:
  "(\<And> r'. r' \<sqsubseteq> r \<Longrightarrow> f \<cdot> r' = g \<cdot> r') \<Longrightarrow> f|\<^bsub>r\<^esub> = g|\<^bsub>r\<^esub>"
  apply (intro below_antisym C_restr_below_cong )
  by (metis below_refl)+

lemma C_restr_C_case[simp]:
  "(C_case\<cdot>f)|\<^bsub>C\<cdot>r\<^esub> = C_case\<cdot>(f|\<^bsub>r\<^esub>)"
  apply (rule cfun_eqI)
  apply simp
  apply (case_tac x)
  apply simp
  apply simp
  done

lemma C_restr_eq_Cpred:
  assumes "x|\<^bsub>r\<^esub> = y|\<^bsub>r\<^esub>"
  shows "x|\<^bsub>Cpred\<cdot>r\<^esub> = y|\<^bsub>Cpred\<cdot>r\<^esub>"
  apply (rule cfun_eqI)
  apply simp
  by (metis C_restr_eqD[OF assms] Cpred_below meet_below2 meet_comm)

lemma C_restr_bot_demand:
  assumes "C\<cdot>r \<sqsubseteq> demand f"
  shows "f|\<^bsub>r\<^esub> = \<bottom>"
proof(rule cfun_eqI)
  fix r'
  have "f\<cdot>(r \<sqinter> r') = \<bottom>"
  proof(rule classical)
    have "r \<sqsubseteq> C \<cdot> r" by (rule below_C)
    also
    note assms
    also
    assume *: "f\<cdot>(r \<sqinter> r') \<noteq> \<bottom>"
    hence "demand f \<sqsubseteq> (r \<sqinter> r')" unfolding not_bot_demand by auto
    hence "demand f \<sqsubseteq> r"  by (metis below_refl meet_below1 below_trans)
    finally (below_antisym) have "r = demand f" by this (intro cont2cont)
    with assms
    have "demand f = C\<^sup>\<infinity>" by (cases "demand f" rule:C_cases) (auto simp add: iterate_Suc[symmetric] simp del: iterate_Suc)
    thus "f\<cdot>(r \<sqinter> r') = \<bottom>" by (metis not_bot_demand)
  qed
  thus "(f|\<^bsub>r\<^esub>)\<cdot>r' = \<bottom>\<cdot>r'" by simp
qed

subsubsection {* Restricting maps of C-ranged functions *}

definition env_C_restr :: "C \<rightarrow> ('var::type \<Rightarrow> (C \<rightarrow> 'a::pcpo)) \<rightarrow> ('var \<Rightarrow> (C \<rightarrow> 'a))" where
  "env_C_restr = (\<Lambda> r f.  cfun_comp\<cdot>(C_restr\<cdot>r)\<cdot>f)"

abbreviation env_C_restr_syn :: "('var::type \<Rightarrow> (C \<rightarrow> 'a::pcpo)) \<Rightarrow> C \<Rightarrow>  ('var \<Rightarrow> (C \<rightarrow> 'a))" ( "_|\<^sup>\<circ>\<^bsub>_\<^esub>" [111,110] 110)
  where "f|\<^sup>\<circ>\<^bsub>r\<^esub> \<equiv> env_C_restr\<cdot>r\<cdot>f"

lemma env_C_restr_upd[simp]: "(\<rho>(x := v))|\<^sup>\<circ>\<^bsub>r\<^esub> = (\<rho>|\<^sup>\<circ>\<^bsub>r\<^esub>)(x := v|\<^bsub>r\<^esub>)"
  unfolding env_C_restr_def by simp

lemma env_C_restr_lookup[simp]: "(\<rho>|\<^sup>\<circ>\<^bsub>r\<^esub>) v = \<rho> v|\<^bsub>r\<^esub>"
  unfolding env_C_restr_def by simp

lemma env_C_restr_bot[simp]: " \<bottom>|\<^sup>\<circ>\<^bsub>r\<^esub> = \<bottom>"
  unfolding env_C_restr_def by auto

lemma env_C_restr_restr_below[intro]: "\<rho>|\<^sup>\<circ>\<^bsub>r\<^esub> \<sqsubseteq> \<rho>"
  by (auto intro: fun_belowI)

lemma env_C_restr_env_C_restr[simp]: "(v|\<^sup>\<circ>\<^bsub>r'\<^esub>)|\<^sup>\<circ>\<^bsub>r\<^esub> = v|\<^sup>\<circ>\<^bsub>(r' \<sqinter> r)\<^esub>"
  unfolding env_C_restr_def by auto

lemma env_C_restr_cong:
  "(\<And> x r'. r' \<sqsubseteq> r \<Longrightarrow> f x \<cdot> r' = g x \<cdot> r') \<Longrightarrow> f|\<^sup>\<circ>\<^bsub>r\<^esub> = g|\<^sup>\<circ>\<^bsub>r\<^esub>"
  unfolding env_C_restr_def
  by (rule ext) (auto intro: C_restr_cong)

lemma env_restr_eq_Cpred:
  assumes "\<rho>1|\<^sup>\<circ>\<^bsub>r\<^esub> = \<rho>2|\<^sup>\<circ>\<^bsub>r\<^esub>"
  shows "\<rho>1|\<^sup>\<circ>\<^bsub>Cpred\<cdot>r\<^esub> = \<rho>2|\<^sup>\<circ>\<^bsub>Cpred\<cdot>r\<^esub>"
proof(rule ext)
next
  fix x
  from assms
  have "(\<rho>1|\<^sup>\<circ>\<^bsub>r\<^esub>) x = (\<rho>2|\<^sup>\<circ>\<^bsub>r\<^esub>) x" by simp
  thus "(\<rho>1|\<^sup>\<circ>\<^bsub>Cpred\<cdot>r\<^esub>) x = (\<rho>2|\<^sup>\<circ>\<^bsub>Cpred\<cdot>r\<^esub>) x"
    by (auto intro: C_restr_eq_Cpred)
qed

end


(*
  File:    Moebius_Mu_Sum.thy
  Author:  Manuel Eberl, TU München

  Properties of the summatory Möbius \<mu> function, including its relationship to
  the Prime Number Theorem.
*)
section \<open>The summatory Möbius \<open>\<mu>\<close> function\<close>
theory Moebius_Mu_Sum
imports
  More_Dirichlet_Misc
  Dirichlet_Series.Partial_Summation
  Prime_Number_Theorem.Prime_Counting_Functions
  Dirichlet_Series.Arithmetic_Summatory_Asymptotics
  Shapiro_Tauberian
  Partial_Zeta_Bounds
  Prime_Number_Theorem.Prime_Number_Theorem_Library
  Prime_Distribution_Elementary_Library
begin

text \<open>
  In this section, we shall examine the summatory Möbius \<open>\<mu>\<close> function
  $M(x) := \sum_{n\leq x} \mu(n)$. The main result is that $M(x) \in o(x)$ is equivalent
  to the Prime Number Theorem.
\<close>

context
  includes prime_counting_notation
  fixes M H :: "real \<Rightarrow> real"
  defines "M \<equiv> sum_upto moebius_mu"
  defines "H \<equiv> sum_upto (\<lambda>n. moebius_mu n * ln n)"
begin

lemma sum_upto_moebius_mu_integral: "x > 1 \<Longrightarrow> ((\<lambda>t. M t / t) has_integral M x * ln x - H x) {1..x}"
  and sum_upto_moebius_mu_integrable: "a \<ge> 1 \<Longrightarrow> (\<lambda>t. M t / t) integrable_on {a..b}"
proof -
  {
    fix a b :: real
    assume ab: "a \<ge> 1" "a < b"
    have "((\<lambda>t. M t * (1 / t)) has_integral M b * ln b - M a * ln a -
            (\<Sum>n\<in>real -` {a<..b}. moebius_mu n * ln (real n))) {a..b}"
      unfolding M_def using ab
      by (intro partial_summation_strong [where X = "{}"])
         (auto intro!: derivative_eq_intros continuous_intros
               simp flip: has_real_derivative_iff_has_vector_derivative)
  } note * = this
  {
    fix x :: real assume x: "x > 1"
    have "(\<Sum>n\<in>real -` {1<..x}. moebius_mu n * ln (real n)) = H x"
      unfolding H_def sum_upto_def by (intro sum.mono_neutral_cong_left) (use x in auto)
    thus "((\<lambda>t. M t / t) has_integral M x * ln x - H x) {1..x}" using *[of 1 x] x by simp
  }
  {
    fix a b :: real assume ab: "a \<ge> 1"
    show "(\<lambda>t. M t / t) integrable_on {a..b}"
      using *[of a b] ab
      by (cases a b rule: linorder_cases) (auto intro: integrable_negligible)
  }
qed

lemma sum_moebius_mu_bound:
  assumes "x \<ge> 0"
  shows   "\<bar>M x\<bar> \<le> x"
proof -
  have "\<bar>M x\<bar> \<le> sum_upto (\<lambda>n. \<bar>moebius_mu n\<bar>) x"
    unfolding M_def sum_upto_def by (rule sum_abs)
  also have "\<dots> \<le> sum_upto (\<lambda>n. 1) x"
    unfolding sum_upto_def by (intro sum_mono) (auto simp: moebius_mu_def)
  also have "\<dots> \<le> x" using assms
    by (simp add: sum_upto_altdef)
  finally show ?thesis .
qed

lemma sum_moebius_mu_aux1: "(\<lambda>x. M x / x - H x / (x * ln x)) \<in> O(\<lambda>x. 1 / ln x)"
proof -
  define R where "R = (\<lambda>x. integral {1..x} (\<lambda>t. M t / t))"
  have "eventually (\<lambda>x. M x / x - H x / (x * ln x) = R x / (x * ln x)) at_top"
    using eventually_gt_at_top[of 1]
  proof eventually_elim
    case (elim x)
    thus ?case
      using sum_upto_moebius_mu_integral[of x] by (simp add: R_def has_integral_iff field_simps)
  qed
  hence "(\<lambda>x. M x / x - H x / (x * ln x)) \<in> \<Theta>(\<lambda>x. R x / (x * ln x))"
    by (intro bigthetaI_cong)
  also have "(\<lambda>x. R x / (x * ln x)) \<in> O(\<lambda>x. x / (x * ln x))"
  proof (intro landau_o.big.divide_right)
    have "M \<in> O(\<lambda>x. x)"
      using sum_moebius_mu_bound
      by (intro bigoI[where c = 1] eventually_mono[OF eventually_ge_at_top[of 0]]) auto
    hence "(\<lambda>t. M t / t) \<in> O(\<lambda>t. 1)"
      by (simp add: landau_divide_simps)
    thus "R \<in> O(\<lambda>x. x)"
      unfolding R_def
      by (intro integral_bigo[where g' = "\<lambda>_. 1"])
         (auto simp: filterlim_ident has_integral_iff intro!: sum_upto_moebius_mu_integrable)
  qed (intro eventually_mono[OF eventually_gt_at_top[of 1]], auto)
  also have "(\<lambda>x::real. x / (x * ln x)) \<in> \<Theta>(\<lambda>x. 1 / ln x)"
    by real_asymp
  finally show ?thesis .
qed

(* 4.13 *)
lemma sum_moebius_mu_aux2: "((\<lambda>x. M x / x - H x / (x * ln x)) \<longlongrightarrow> 0) at_top"
proof -
  have "(\<lambda>x. M x / x - H x / (x * ln x)) \<in> O(\<lambda>x. 1 / ln x)"
    by (rule sum_moebius_mu_aux1)
  also have "(\<lambda>x. 1 / ln x) \<in> o(\<lambda>_. 1 :: real)"
    by real_asymp
  finally show ?thesis by (auto dest!: smalloD_tendsto)
qed

lemma sum_moebius_mu_ln_eq: "H = (\<lambda>x. - dirichlet_prod' moebius_mu \<psi> x)"
proof
  fix x :: real
  have "fds mangoldt = (fds_deriv (fds moebius_mu) * fds_zeta :: real fds)"
    using fds_mangoldt' by (simp add: mult_ac)
  hence eq: "fds_deriv (fds moebius_mu) = fds moebius_mu * (fds mangoldt :: real fds)"
    by (subst (asm) fds_moebius_inversion [symmetric])
  have "-H x = sum_upto (\<lambda>n. -ln n * moebius_mu n) x"
    by (simp add: H_def sum_upto_def sum_negf mult_ac)
  also have "\<dots> = sum_upto (\<lambda>n. dirichlet_prod moebius_mu mangoldt n) x"
    using eq by (intro sum_upto_cong) (auto simp: fds_eq_iff fds_nth_deriv fds_nth_mult)
  also have "\<dots> = dirichlet_prod' moebius_mu \<psi> x"
    by (subst sum_upto_dirichlet_prod) (simp add: primes_psi_def dirichlet_prod'_def)
  finally show "H x = -dirichlet_prod' moebius_mu \<psi> x"
    by simp
qed

(* 4.14 *)
theorem PNT_implies_sum_moebius_mu_sublinear:
  assumes "\<psi> \<sim>[at_top] (\<lambda>x. x)"
  shows   "M \<in> o(\<lambda>x. x)"
proof -
  have "((\<lambda>x. H x / (x * ln x)) \<longlongrightarrow> 0) at_top"
  proof (rule tendstoI)
    fix \<epsilon>' :: real assume \<epsilon>': "\<epsilon>' > 0"
    define \<epsilon> where "\<epsilon> = \<epsilon>' / 2"
    from \<epsilon>' have \<epsilon>: "\<epsilon> > 0" by (simp add: \<epsilon>_def)
    from assms have "((\<lambda>x. \<psi> x / x) \<longlongrightarrow> 1) at_top"
      by (elim asymp_equivD_strong) (auto intro!: eventually_mono[OF eventually_gt_at_top[of 0]])
    from tendstoD[OF this \<epsilon>] have "eventually (\<lambda>x. \<bar>\<psi> x / x - 1\<bar> < \<epsilon>) at_top"
      by (simp add: dist_norm)
    hence "eventually (\<lambda>x. \<bar>\<psi> x - x\<bar> < \<epsilon> * x) at_top"
      using eventually_gt_at_top[of 0] by eventually_elim (auto simp: abs_if field_simps)
    then obtain A' where A': "\<And>x. x \<ge> A' \<Longrightarrow> \<bar>\<psi> x - x\<bar> < \<epsilon> * x"
      by (auto simp: eventually_at_top_linorder)
    define A where "A = max 2 A'"
    from A' have A: "A \<ge> 2" "\<And>x. x \<ge> A \<Longrightarrow> \<bar>\<psi> x - x\<bar> < \<epsilon> * x"
      by (auto simp: A_def)

    have H_bound: "\<bar>H x\<bar> / (x * ln x) \<le> (1 + \<epsilon> + \<psi> A) / ln x + \<epsilon>" if "x \<ge> A" for x
    proof -
      from \<open>x \<ge> A\<close> have "x \<ge> 2" using A(1) by linarith
      note x = \<open>x \<ge> A\<close> \<open>x \<ge> 2\<close>

      define y where "y = nat \<lfloor>floor (x / A)\<rfloor>"
      have "real y = real_of_int \<lfloor>x / A\<rfloor>" using A x by (simp add: y_def)
      also have "real_of_int \<lfloor>x / A\<rfloor> \<le> x / A" by linarith
      also have "\<dots> \<le> x" using x A(1) by (simp add: field_simps)
      finally have "y \<le> x" .
      have "y \<ge> 1" using x A(1) by (auto simp: y_def le_nat_iff le_floor_iff)
      note y = \<open>y \<ge> 1\<close> \<open>y \<le> x\<close>

      define S1 where [simp]: "S1 = sum_upto (\<lambda>m. moebius_mu m * \<psi> (x / m)) y"
      define S2 where [simp]: "S2 = (\<Sum>m | m > y \<and> real m \<le> x. moebius_mu m * \<psi> (x / m))"

      have fin: "finite {m. y < m \<and> real m \<le> x}"
        by (rule finite_subset[of _ "{..nat \<lfloor>x\<rfloor>}"]) (auto simp: le_nat_iff le_floor_iff)
      have "H x = -dirichlet_prod' moebius_mu \<psi> x"
        by (simp add: sum_moebius_mu_ln_eq)
      also have "dirichlet_prod' moebius_mu \<psi> x =
                   (\<Sum>m | m > 0 \<and> real m \<le> x. moebius_mu m * \<psi> (x / m))"
        unfolding dirichlet_prod'_def sum_upto_def ..
      also have "{m. m > 0 \<and> real m \<le> x} = {0<..y} \<union> {m. y < m \<and> real m \<le> x}"
        using x y A(1) by auto
      also have "(\<Sum>m\<in>\<dots>. moebius_mu m * \<psi> (x / m)) = S1 + S2"
        unfolding dirichlet_prod'_def sum_upto_def S1_def S2_def using fin
        by (subst sum.union_disjoint) (auto intro: sum.cong)
      finally have abs_H_eq: "\<bar>H x\<bar> = \<bar>S1 + S2\<bar>" by simp

      define S1_1 where [simp]: "S1_1 = sum_upto (\<lambda>m. moebius_mu m / m) y"
      define S1_2 where [simp]: "S1_2 = sum_upto (\<lambda>m. moebius_mu m * (\<psi> (x / m) - x / m)) y"

      have "\<bar>S1\<bar> = \<bar>x * S1_1 + S1_2\<bar>"
        by (simp add: sum_upto_def sum_distrib_left sum_distrib_right
                      mult_ac sum_subtractf ring_distribs)
      also have "\<dots> \<le> x * \<bar>S1_1\<bar> + \<bar>S1_2\<bar>"
        by (rule order.trans[OF abs_triangle_ineq]) (use x in \<open>simp add: abs_mult\<close>)
      also have "\<dots> \<le> x * 1 + \<epsilon> * x * (ln x + 1)"
      proof (intro add_mono mult_left_mono)
        show "\<bar>S1_1\<bar> \<le> 1"
          using abs_sum_upto_moebius_mu_over_n_le[of y] by simp
      next
        have "\<bar>S1_2\<bar> \<le> sum_upto (\<lambda>m. \<bar>moebius_mu m * (\<psi> (x / m) - x / m)\<bar>) y"
          unfolding S1_2_def sum_upto_def by (rule sum_abs)
        also have "\<dots> \<le> sum_upto (\<lambda>m. 1 * (\<epsilon> * (x / m))) y"
          unfolding abs_mult sum_upto_def
        proof (intro sum_mono mult_mono less_imp_le[OF A(2)])
          fix m assume m: "m \<in> {i. 0 < i \<and> real i \<le> real y}"
          hence "real m \<le> real y" by simp
          also from x A(1) have "\<dots> = of_int \<lfloor>x / A\<rfloor>" by (simp add: y_def)
          also have "\<dots> \<le> x / A" by linarith
          finally show "A \<le> x / real m" using A(1) m by (simp add: field_simps)
        qed (auto simp: moebius_mu_def field_simps)
        also have "\<dots> = \<epsilon> * x * (\<Sum>i\<in>{0<..y}. inverse (real i))"
          by (simp add: sum_upto_altdef sum_distrib_left divide_simps)
        also have "(\<Sum>i\<in>{0<..y}. inverse (real i)) = harm (nat \<lfloor>y\<rfloor>)"
          unfolding harm_def by (intro sum.cong) auto
        also have "\<dots> \<le> ln (nat \<lfloor>y\<rfloor>) + 1"
          by (rule harm_le) (use y in auto)
        also have "ln (nat \<lfloor>y\<rfloor>) \<le> ln x"
          using y by simp
        finally show "\<bar>S1_2\<bar> \<le> \<epsilon> * x * (ln x + 1)" using \<epsilon> x by simp
      qed (use x in auto)
      finally have S1_bound: "\<bar>S1\<bar> \<le> x + \<epsilon> * x * ln x + \<epsilon> * x"
        by (simp add: algebra_simps)

      have "\<bar>S2\<bar> \<le> (\<Sum>m | y < m \<and> real m \<le> x. \<bar>moebius_mu m * \<psi> (x / m)\<bar>)"
        unfolding S2_def by (rule sum_abs)
      also have "\<dots> \<le> (\<Sum>m | y < m \<and> real m \<le> x. 1 * \<psi> A)"
        unfolding abs_mult using y
      proof (intro sum_mono mult_mono)
        fix m assume m: "m \<in> {m. y < m \<and> real m \<le> x}"
        hence "y < m" by simp
        moreover have "y = of_int \<lfloor>x / A\<rfloor>" using x A(1) by (simp add: y_def)
        ultimately have "\<lfloor>x / A\<rfloor> < m" by simp
        hence "x / A \<le> real m" by linarith
        hence "\<psi> (x / real m) \<le> \<psi> A"
          using m A(1) by (intro \<psi>_mono) (auto simp: field_simps)
        thus "\<bar>\<psi> (x / real m)\<bar> \<le> \<psi> A"
          by (simp add: \<psi>_nonneg)
      qed (auto simp: moebius_mu_def \<psi>_nonneg field_simps intro!: \<psi>_mono)
      also have "\<dots> \<le> sum_upto (\<lambda>_. 1 * \<psi> A) x"
        unfolding sum_upto_def by (intro sum_mono2) auto
      also have "\<dots> = real (nat \<lfloor>x\<rfloor>) * \<psi> A"
        by (simp add: sum_upto_altdef)
      also have "\<dots> \<le> x * \<psi> A"
        using x by (intro mult_right_mono) auto
      finally have S2_bound: "\<bar>S2\<bar> \<le> x * \<psi> A" .

      have "\<bar>H x\<bar> \<le> \<bar>S1\<bar> + \<bar>S2\<bar>" using abs_H_eq by linarith
      also have "\<dots> \<le> x + \<epsilon> * x * ln x + \<epsilon> * x + x * \<psi> A"
        by (intro add_mono S1_bound S2_bound)
      finally have "\<bar>H x\<bar> \<le> (1 + \<epsilon> + \<psi> A) * x + \<epsilon> * x * ln x"
        by (simp add: algebra_simps)
      thus "\<bar>H x\<bar> / (x * ln x) \<le> (1 + \<epsilon> + \<psi> A) / ln x + \<epsilon>"
        using x by (simp add: field_simps)
    qed

    have "eventually (\<lambda>x. \<bar>H x\<bar> / (x * ln x) \<le> (1 + \<epsilon> + \<psi> A) / ln x + \<epsilon>) at_top"
      using eventually_ge_at_top[of A] by eventually_elim (use H_bound in auto)
    moreover have "eventually (\<lambda>x. (1 + \<epsilon> + \<psi> A) / ln x + \<epsilon> < \<epsilon>') at_top"
      unfolding \<epsilon>_def using \<epsilon>' by real_asymp
    moreover have "eventually (\<lambda>x. \<bar>H x\<bar> / (x * ln x) = \<bar>H x / (x * ln x)\<bar>) at_top"
      using eventually_gt_at_top[of 1] by eventually_elim (simp add: abs_mult)
    ultimately have "eventually (\<lambda>x. \<bar>H x / (x * ln x)\<bar> < \<epsilon>') at_top"
      by eventually_elim simp
    thus "eventually (\<lambda>x. dist (H x / (x * ln x)) 0 < \<epsilon>') at_top"
      by (simp add: dist_norm)
  qed
  hence "(\<lambda>x. H x / (x * ln x)) \<in> o(\<lambda>_. 1)"
    by (intro smalloI_tendsto) auto
  hence "(\<lambda>x. H x / (x * ln x) + (M x / x - H x / (x * ln x))) \<in> o(\<lambda>_. 1)"
  proof (rule sum_in_smallo)
    have "(\<lambda>x. M x / x - H x / (x * ln x)) \<in> O(\<lambda>x. 1 / ln x)"
      by (rule sum_moebius_mu_aux1)
    also have "(\<lambda>x::real. 1 / ln x) \<in> o(\<lambda>_. 1)"
      by real_asymp
    finally show "(\<lambda>x. M x / x - H x / (x * ln x)) \<in> o(\<lambda>_. 1)" .
  qed
  thus ?thesis by (simp add: landau_divide_simps)
qed

(* 4.15 *)
theorem sum_moebius_mu_sublinear_imp_PNT:
  assumes "M \<in> o(\<lambda>x. x)"
  shows   "\<psi> \<sim>[at_top] (\<lambda>x. x)"
proof -
  define \<sigma> :: "nat \<Rightarrow> real" where [simp]: "\<sigma> = (\<lambda>n. real (divisor_count n))"
  define C where [simp]: "C = (euler_mascheroni :: real)"
  define f :: "nat \<Rightarrow> real" where "f = (\<lambda>n. \<sigma> n - ln n - 2 * C)"
  define F where [simp]: "F = sum_upto f"
  write moebius_mu ("\<mu>")

  \<comment> \<open>The proof is based on the fact that $\psi(x)-x$ can be approximated fairly well by
      the Dirichlet product $\sum_{n\leq x} \sum_{d\mid n} \mu(d) f(n/d)$:\<close>
  have eq: "\<psi> x - x = -sum_upto (dirichlet_prod \<mu> f) x - frac x - 2 * C" if x: "x \<ge> 1" for x
  proof -
    have "\<lfloor>x\<rfloor> - \<psi> x - 2 * C =
            sum_upto (\<lambda>_. 1) x - sum_upto mangoldt x - sum_upto (\<lambda>n. if n = 1 then 2 * C else 0) x"
      using x by (simp add: sum_upto_altdef \<psi>_def le_nat_iff le_floor_iff)
    also have "\<dots> = sum_upto (\<lambda>n. 1 - mangoldt n - (if n = 1 then 2 * C else 0)) x"
      by (simp add: sum_upto_def sum_subtractf)
    also have "\<dots> = sum_upto (dirichlet_prod \<mu> f) x"
      by (intro sum_upto_cong refl moebius_inversion)
         (auto simp: divisor_count_def sum_subtractf mangoldt_sum f_def)
    finally show "\<psi> x - x = -sum_upto (dirichlet_prod \<mu> f) x - frac x - 2 * C"
      by (simp add: algebra_simps frac_def)
  qed

  \<comment> \<open>We now obtain a bound of the form \<open>\<bar>F x\<bar> \<le> B * sqrt x\<close>.\<close>
  have "F \<in> O(sqrt)"
  proof -
    have "F \<in> \<Theta>(\<lambda>x. (sum_upto \<sigma> x - (x * ln x + (2 * C - 1) * x)) -
                      (sum_upto ln x - x * ln x + x) + 2 * C * frac x)" (is "_ \<in> \<Theta>(?rhs)")
      by (intro bigthetaI_cong eventually_mono[OF eventually_ge_at_top[of 1]])
         (auto simp: sum_upto_altdef sum_subtractf f_def frac_def algebra_simps sum.distrib)
    also have "?rhs \<in> O(sqrt)"
    proof (rule sum_in_bigo, rule sum_in_bigo)
      show "(\<lambda>x. sum_upto \<sigma> x - (x * ln x + (2 * C - 1) * x)) \<in> O(sqrt)"
        unfolding C_def \<sigma>_def by (rule summatory_divisor_count_asymptotics)
      show "(\<lambda>x. sum_upto (\<lambda>x. ln (real x)) x - x * ln x + x) \<in> O(sqrt)"
        by (rule landau_o.big.trans[OF sum_upto_ln_stirling_weak_bigo]) real_asymp
    qed (use euler_mascheroni_pos in real_asymp)
    finally show ?thesis .
  qed
  hence "(\<lambda>n. F (real n)) \<in> O(sqrt)"
    by (rule landau_o.big.compose) real_asymp
  from natfun_bigoE[OF this, of 1] obtain B :: real
    where B: "B > 0" "\<And>n. n \<ge> 1 \<Longrightarrow> \<bar>F (real n)\<bar> \<le> B * sqrt (real n)"
    by auto
  have B': "\<bar>F x\<bar> \<le> B * sqrt x" if "x \<ge> 1" for x
  proof -
    have "\<bar>F x\<bar> \<le> B * sqrt (nat \<lfloor>x\<rfloor>)"
      using B(2)[of "nat \<lfloor>x\<rfloor>"] that by (simp add: sum_upto_altdef le_nat_iff le_floor_iff)
    also have "\<dots> \<le> B * sqrt x"
      using B(1) that by (intro mult_left_mono) auto
    finally show ?thesis .
  qed

  \<comment> \<open>Next, we obtain a good bound for $\sum_{n\leq x} \frac{1}{\sqrt{n}}$.\<close>
  from zeta_partial_sum_le_pos''[of "1 / 2"] obtain A
    where A: "A > 0" "\<And>x. x \<ge> 1 \<Longrightarrow> \<bar>sum_upto (\<lambda>n. 1 / sqrt n) x\<bar> \<le> A * sqrt x"
    by (auto simp: max_def powr_half_sqrt powr_minus field_simps)

  \<comment> \<open>Finally, we show that $\sum_{n\leq x} \sum_{d\mid n} \mu(d) f(n/d) \in o(x)$.\<close>
  have "sum_upto (dirichlet_prod \<mu> f) \<in> o(\<lambda>x. x)"
  proof (rule landau_o.smallI)
    fix \<epsilon> :: real
    assume \<epsilon>: "\<epsilon> > 0"

    have *: "eventually (\<lambda>x. \<bar>sum_upto (dirichlet_prod \<mu> f) x\<bar> \<le> \<epsilon> * x) at_top"
      if b: "b \<ge> 1" "A * B / sqrt b \<le> \<epsilon> / 3" "B / sqrt b \<le> \<epsilon> / 3" for b
    proof -
      define K :: real where "K = sum_upto (\<lambda>n. \<bar>f n\<bar> / n) b"
      have "C \<noteq> (1 / 2)" using euler_mascheroni_gt_19_over_33 by auto
      hence K: "K > 0" unfolding K_def f_def sum_upto_def
        by (intro sum_pos2[where i = 1]) (use \<open>b \<ge> 1\<close> in auto)
      have "eventually (\<lambda>x. \<bar>M x / x\<bar> < \<epsilon> / 3 / K) at_top"
        using smalloD_tendsto[OF assms] \<epsilon> K by (auto simp: tendsto_iff dist_norm)
      then obtain c' where c': "\<And>x. x \<ge> c' \<Longrightarrow> \<bar>M x / x\<bar> < \<epsilon> / 3 / K"
        by (auto simp: eventually_at_top_linorder)
      define c where "c = max 1 c'"
      have c: "\<bar>M x\<bar> < \<epsilon> / 3 / K * x" if "x \<ge> c" for x
        using c'[of x] that by (simp add: c_def field_simps)

      show "eventually (\<lambda>x. \<bar>sum_upto (dirichlet_prod \<mu> f) x\<bar> \<le> \<epsilon> * x) at_top"
        using eventually_ge_at_top[of "b * c"] eventually_ge_at_top[of 1] eventually_ge_at_top[of b]
      proof eventually_elim
        case (elim x)
        define a where "a = x / b"
        from elim \<open>b \<ge> 1\<close> have ab: "a \<ge> 1" "b \<ge> 1" "a * b = x"
          by (simp_all add: a_def field_simps)
        from ab have "a * 1 \<le> a * b" by (intro mult_mono) auto
        hence "a \<le> x" by (simp add: ab(3))
        from ab have "a * 1 \<le> a * b" and "1 * b \<le> a * b" by (intro mult_mono; simp)+
        hence "a \<le> x" "b \<le> x" by (simp_all add: ab(3))
        have "a = x / b" "b = x / a" using ab by (simp_all add: field_simps)

        have "sum_upto (dirichlet_prod \<mu> f) x =
                sum_upto (\<lambda>n. \<mu> n * F (x / n)) a + sum_upto (\<lambda>n. M (x / n) * f n) b - M a * F b"
          unfolding M_def F_def by (rule hyperbola_method) (use ab in auto)
        also have "\<bar>\<dots>\<bar> \<le> \<epsilon> / 3 * x + \<epsilon> / 3 * x + \<epsilon> / 3 * x"
        proof (rule order.trans[OF abs_triangle_ineq4] order.trans[OF abs_triangle_ineq] add_mono)+
          have "\<bar>sum_upto (\<lambda>n. \<mu> n * F (x / real n)) a\<bar> \<le> sum_upto (\<lambda>n. \<bar>\<mu> n * F (x / real n)\<bar>) a"
            unfolding sum_upto_def by (rule sum_abs)
          also have "\<dots> \<le> sum_upto (\<lambda>n. 1 * (B * sqrt (x / real n))) a"
            unfolding sum_upto_def abs_mult using \<open>a \<le> x\<close>
            by (intro sum_mono mult_mono B') (auto simp: moebius_mu_def)
          also have "\<dots> = B * sqrt x * sum_upto (\<lambda>n. 1 / sqrt n) a"
            by (simp add: sum_upto_def sum_distrib_left real_sqrt_divide)
          also have "\<dots> \<le> B * sqrt x * \<bar>sum_upto (\<lambda>n. 1 / sqrt n) a\<bar>"
            using B(1) \<open>x \<ge> 1\<close> by (intro mult_left_mono) auto
          also have "\<dots> \<le> B * sqrt x * (A * sqrt a)"
            using \<open>a \<ge> 1\<close> B(1) \<open>x \<ge> 1\<close> by (intro mult_left_mono A) auto
          also have "\<dots> = A * B / sqrt b * x"
            using ab \<open>x \<ge> 1\<close>\<open>x \<ge> 1\<close> by (subst \<open>a = x / b\<close>) (simp_all add: field_simps real_sqrt_divide)
          also have "\<dots> \<le> \<epsilon> / 3 * x" using \<open>x \<ge> 1\<close> by (intro mult_right_mono b) auto
          finally show "\<bar>sum_upto (\<lambda>n. \<mu> n * F (x / n)) a\<bar> \<le> \<epsilon> / 3 * x" .
        next
          have "\<bar>sum_upto (\<lambda>n. M (x / n) * f n) b\<bar> \<le> sum_upto (\<lambda>n. \<bar>M (x / n) * f n\<bar>) b"
            unfolding sum_upto_def by (rule sum_abs)
          also have "\<dots> \<le> sum_upto (\<lambda>n. \<epsilon> / 3 / K * (x / n) * \<bar>f n\<bar>) b"
            unfolding sum_upto_def abs_mult
          proof (intro sum_mono mult_right_mono)
            fix n assume n: "n \<in> {n. n > 0 \<and> real n \<le> b}"
            have "c \<ge> 0" by (simp add: c_def)
            with n have "c * n \<le> c * b" by (intro mult_left_mono) auto
            also have "\<dots> \<le> x" using \<open>b * c \<le> x\<close> by (simp add: algebra_simps)
            finally show "\<bar>M (x / real n)\<bar> \<le> \<epsilon> / 3 / K * (x / real n)"
              by (intro less_imp_le[OF c]) (use n in \<open>auto simp: field_simps\<close>)
          qed auto
          also have "\<dots> = \<epsilon> / 3 * x / K * sum_upto (\<lambda>n. \<bar>f n\<bar> / n) b"
            by (simp add: sum_upto_def sum_distrib_left)
          also have "\<dots> = \<epsilon> / 3 * x"
            unfolding K_def [symmetric] using K by simp
          finally show "\<bar>sum_upto (\<lambda>n. M (x / real n) * f n) b\<bar> \<le> \<epsilon> / 3 * x" .
        next
          have "\<bar>M a * F b\<bar> \<le> a * (B * sqrt b)"
            unfolding abs_mult using ab by (intro mult_mono sum_moebius_mu_bound B') auto
          also have "\<dots> = B / sqrt b * x"
            using ab(1,2) by (simp add: real_sqrt_mult \<open>b = x / a\<close> real_sqrt_divide field_simps)
          also have "\<dots> \<le> \<epsilon> / 3 * x" using \<open>x \<ge> 1\<close> by (intro mult_right_mono b) auto
          finally show "\<bar>M a * F b\<bar> \<le> \<epsilon> / 3 * x" .
        qed
        also have "\<dots> = \<epsilon> * x" by simp
        finally show ?case .
      qed
    qed

    have "eventually (\<lambda>b::real. b \<ge> 1 \<and> A * B / sqrt b \<le> \<epsilon> / 3 \<and> B / sqrt b \<le> \<epsilon> / 3) at_top"
      using \<epsilon> by (intro eventually_conj; real_asymp)
    then obtain b where "b \<ge> 1" "A * B / sqrt b \<le> \<epsilon> / 3" "B / sqrt b \<le> \<epsilon> / 3"
      by (auto simp: eventually_at_top_linorder)
    from *[OF this] have "eventually (\<lambda>x. \<bar>sum_upto (dirichlet_prod \<mu> f) x\<bar> \<le> \<epsilon> * x) at_top" .
    thus "eventually (\<lambda>x. norm (sum_upto (dirichlet_prod \<mu> f) x) \<le> \<epsilon> * norm x) at_top"
      using eventually_ge_at_top[of 0] by eventually_elim simp
  qed

  have "(\<lambda>x. \<psi> x - x) \<in> \<Theta>(\<lambda>x. -(sum_upto (dirichlet_prod \<mu> f) x + (frac x + 2 * C)))"
    by (intro bigthetaI_cong eventually_mono[OF eventually_ge_at_top[of 1]], subst eq) auto
  hence "(\<lambda>x. \<psi> x - x) \<in> \<Theta>(\<lambda>x. sum_upto (dirichlet_prod \<mu> f) x + (frac x + 2 * C))"
    by (simp only: landau_theta.uminus)
  also have "(\<lambda>x. sum_upto (dirichlet_prod \<mu> f) x + (frac x + 2 * C)) \<in> o(\<lambda>x. x)"
    using \<open>sum_upto (dirichlet_prod \<mu> f) \<in> o(\<lambda>x. x)\<close> by (rule sum_in_smallo) real_asymp+
  finally show ?thesis by (rule smallo_imp_asymp_equiv)
qed

text \<open>
  We now turn to a related fact: For the weighted sum $A(x) := \sum_{n\leq x} \mu(n)/n$, the
  asymptotic relation $A(x)\in o(1)$ is also equivalent to the Prime Number Theorem.
  Like Apostol, we only show one direction, namely that $A(x)\in o(1)$ implies the PNT.
\<close>

context
  fixes A defines "A \<equiv> sum_upto (\<lambda>n. moebius_mu n / n)"
begin

lemma sum_upto_moebius_mu_integral': "x > 1 \<Longrightarrow> (A has_integral x * A x - M x) {1..x}"
  and sum_upto_moebius_mu_integrable': "a \<ge> 1 \<Longrightarrow> A integrable_on {a..b}"
proof -
  {
    fix a b :: real
    assume ab: "a \<ge> 1" "a < b"
    have "((\<lambda>t. A t * 1) has_integral A b * b - A a * a -
            (\<Sum>n\<in>real -` {a<..b}. moebius_mu n / n * n)) {a..b}"
      unfolding M_def A_def using ab
      by (intro partial_summation_strong [where X = "{}"])
         (auto intro!: derivative_eq_intros continuous_intros
               simp flip: has_real_derivative_iff_has_vector_derivative)
  } note * = this
  {
    fix x :: real assume x: "x > 1"
    have [simp]: "A 1 = 1" by (simp add: A_def)
    have "(\<Sum>n\<in>real -` {1<..x}. moebius_mu n / n * n) =
            (\<Sum>n\<in>insert 1 (real -` {1<..x}). moebius_mu n / n * n) - 1"
      using finite_vimage_real_of_nat_greaterThanAtMost[of 1 x] by (subst sum.insert) auto
    also have "insert 1 (real -` {1<..x}) = {n. n > 0 \<and> real n \<le> x}"
      using x by auto
    also have "(\<Sum>n | 0 < n \<and> real n \<le> x. moebius_mu n / real n * real n) = M x"
      unfolding M_def sum_upto_def by (intro sum.cong) auto
    finally show "(A has_integral x * A x - M x) {1..x}" using *[of 1 x] x by (simp add: mult_ac)
  }
  {
    fix a b :: real assume ab: "a \<ge> 1"
    show "A integrable_on {a..b}"
      using *[of a b] ab
      by (cases a b rule: linorder_cases) (auto intro: integrable_negligible)
  }
qed

(* 4.16 *)
theorem sum_moebius_mu_div_n_smallo_imp_PNT:
  assumes smallo: "A \<in> o(\<lambda>_. 1)"
  shows   "M \<in> o(\<lambda>x. x)" and "\<psi> \<sim>[at_top] (\<lambda>x. x)"
proof -
  have "eventually (\<lambda>x. M x = x * A x - integral {1..x} A) at_top"
    using eventually_gt_at_top[of 1]
    by eventually_elim (use sum_upto_moebius_mu_integral' in \<open>simp add: has_integral_iff\<close>)
  hence "M \<in> \<Theta>(\<lambda>x. x * A x - integral {1..x} A)"
    by (rule bigthetaI_cong)
  also have "(\<lambda>x. x * A x - integral {1..x} A) \<in> o(\<lambda>x. x)"
  proof (intro sum_in_smallo)
    from smallo show "(\<lambda>x. x * A x) \<in> o(\<lambda>x. x)"
      by (simp add: landau_divide_simps)
    show "(\<lambda>x. integral {1..x} A) \<in> o(\<lambda>x. x)"
      by (intro integral_smallo[OF smallo] sum_upto_moebius_mu_integrable')
         (auto intro!: derivative_eq_intros filterlim_ident)
  qed
  finally show "M \<in> o(\<lambda>x. x)" .
  thus "\<psi> \<sim>[at_top] (\<lambda>x. x)"
    by (rule sum_moebius_mu_sublinear_imp_PNT)
qed

end

end

end


section \<open>Probability Spaces\<close>

text \<open>Some additional results about probability spaces in addition to "HOL-Probability".\<close>

theory Probability_Ext
  imports
    "HOL-Probability.Stream_Space"
    Universal_Hash_Families.Carter_Wegman_Hash_Family
    Frequency_Moments_Preliminary_Results
begin

text \<open>Random variables that depend on disjoint sets of the components of a product space are
independent.\<close>

lemma make_ext:
  assumes "\<And>x. P x = P (restrict x I)"
  shows "(\<forall>x \<in> Pi I A. P x) = (\<forall>x \<in> PiE I A. P x)"
  using assms by (simp add:PiE_def Pi_def set_eq_iff, force)

lemma PiE_reindex:
  assumes "inj_on f I"
  shows "PiE I (A \<circ> f) = (\<lambda>a. restrict (a \<circ> f) I) ` PiE (f ` I) A" (is "?lhs = ?g ` ?rhs")
proof -
  have "?lhs \<subseteq> ?g` ?rhs"
  proof (rule subsetI)
    fix x
    assume a:"x \<in> Pi\<^sub>E I (A \<circ> f)"
    define y where y_def: "y = (\<lambda>k. if k \<in> f ` I then x (the_inv_into I f k) else undefined)"
    have b:"y \<in> PiE (f ` I) A"
      using a assms the_inv_into_f_eq[OF assms]
      by (simp add: y_def PiE_iff extensional_def)
    have c: "x = (\<lambda>a. restrict (a \<circ> f) I) y"
      using a assms the_inv_into_f_eq extensional_arb
      by (intro ext, simp add:y_def PiE_iff, fastforce)
    show "x \<in> ?g ` ?rhs" using b c by blast
  qed
  moreover have "?g ` ?rhs \<subseteq> ?lhs"
    by (rule image_subsetI, simp add:Pi_def PiE_def)
  ultimately show ?thesis by blast
qed

context prob_space
begin

lemma indep_sets_reindex:
  assumes "inj_on f I"
  shows "indep_sets A (f ` I) = indep_sets (\<lambda>i. A (f i)) I"
proof -
  have a:"\<And>J g. J \<subseteq> I \<Longrightarrow> (\<Prod>j \<in> f ` J. g j) = (\<Prod>j \<in> J. g (f j))"
    by (metis assms prod.reindex_cong subset_inj_on)

  have "J \<subseteq> I \<Longrightarrow> (\<Pi>\<^sub>E i \<in> J. A (f i)) = (\<lambda>a. restrict (a \<circ> f) J) ` PiE (f ` J) A" for J
    using assms inj_on_subset
    by (subst PiE_reindex[symmetric]) auto

  hence b:"\<And>P J. J \<subseteq> I \<Longrightarrow>  (\<And>x. P x = P (restrict x J)) \<Longrightarrow> (\<forall>A' \<in> \<Pi>\<^sub>E i \<in> J. A (f i). P A') =  (\<forall>A'\<in>PiE (f ` J) A. P (A' \<circ> f))"
    by simp

  have c:"\<And>J. J \<subseteq> I \<Longrightarrow> finite (f ` J) = finite J"
    by (meson assms finite_image_iff inj_on_subset)

  show ?thesis
    by (simp add:indep_sets_def all_subset_image a c)
     (simp add:make_ext b cong:restrict_cong)+
qed

lemma indep_vars_cong_AE:
  assumes "AE x in M. (\<forall>i \<in> I. X' i x = Y' i x)"
  assumes "indep_vars M' X' I"
  assumes "\<And>i. i \<in> I \<Longrightarrow> random_variable (M' i) (Y' i)"
  shows "indep_vars M' Y' I"
proof (cases "I \<noteq> {}")
  case True

  have a: "AE x in M. (\<lambda>i\<in>I. Y' i x) = (\<lambda>i\<in>I. X' i x)"
    by (rule AE_mp[OF assms(1)], rule AE_I2, simp cong:restrict_cong)
  have b: "\<And>i. i \<in> I \<Longrightarrow> random_variable (M' i) (X' i)"
    using assms(2) by (simp add:indep_vars_def2)
  have c: "\<And>x. x \<in> I \<Longrightarrow> AE xa in M. X' x xa = Y' x xa"
    by (rule AE_mp[OF assms(1)], rule AE_I2, simp)

  have "distr M (Pi\<^sub>M I M') (\<lambda>x. \<lambda>i\<in>I. Y' i x) = distr M (Pi\<^sub>M I M') (\<lambda>x. \<lambda>i\<in>I. X' i x)"
    by (intro distr_cong_AE measurable_restrict a b assms(3)) auto
  also have "... =  Pi\<^sub>M I (\<lambda>i. distr M (M' i) (X' i))"
    using assms True b by (subst indep_vars_iff_distr_eq_PiM'[symmetric]) auto
  also have "... =  Pi\<^sub>M I (\<lambda>i. distr M (M' i) (Y' i))"
    by (intro PiM_cong distr_cong_AE c assms(3) b) auto
  finally have "distr M (Pi\<^sub>M I M') (\<lambda>x. \<lambda>i\<in>I. Y' i x) = Pi\<^sub>M I (\<lambda>i. distr M (M' i) (Y' i))"
    by simp

  thus ?thesis
    using True assms(3)
    by (subst indep_vars_iff_distr_eq_PiM') auto
next
  case False
  then show ?thesis
    by (simp add:indep_vars_def2 indep_sets_def)
qed

lemma indep_vars_reindex:
  assumes "inj_on f I"
  assumes "indep_vars M' X' (f ` I)"
  shows "indep_vars (M' \<circ> f) (\<lambda>k \<omega>. X' (f k) \<omega>) I"
  using assms by (simp add:indep_vars_def2 indep_sets_reindex)

lemma variance_divide:
  fixes f :: "'a \<Rightarrow> real"
  assumes "integrable M f"
  shows "variance (\<lambda>\<omega>. f \<omega> / r) = variance f / r^2"
  using assms
  by (subst Bochner_Integration.integral_divide[OF assms(1)])
    (simp add:diff_divide_distrib[symmetric] power2_eq_square algebra_simps)

lemma pmf_mono:
  assumes "M = measure_pmf p"
  assumes "\<And>x. x \<in> P \<Longrightarrow> x \<in> set_pmf p \<Longrightarrow> x \<in> Q"
  shows "prob P \<le> prob Q"
proof -
  have "prob P = prob (P \<inter> (set_pmf p))"
    by (rule  measure_pmf_eq[OF assms(1)], blast)
  also have "... \<le> prob Q"
    using assms by (intro finite_measure.finite_measure_mono, auto)
  finally show ?thesis by simp
qed

lemma pmf_add:
  assumes "M = measure_pmf p"
  assumes  "\<And>x. x \<in> P \<Longrightarrow> x \<in> set_pmf p \<Longrightarrow> x \<in> Q \<or> x \<in> R"
  shows "prob P \<le> prob Q + prob R"
proof -
  have [simp]:"events = UNIV" by (subst assms(1), simp)
  have "prob P \<le> prob (Q \<union> R)"
    using assms by (intro pmf_mono[OF assms(1)], blast)
  also have "... \<le> prob Q + prob R"
    by (rule measure_subadditive, auto)
  finally show ?thesis by simp
qed

lemma pmf_add_2:
  assumes "M = measure_pmf p"
  assumes "prob {\<omega>. P \<omega>} \<le> r1"
  assumes "prob {\<omega>. Q \<omega>} \<le> r2"
  shows "prob {\<omega>. P \<omega> \<or> Q \<omega>} \<le> r1 + r2" (is "?lhs \<le> ?rhs")
proof -
  have "?lhs \<le> prob {\<omega>. P \<omega>} + prob {\<omega>. Q \<omega>}"
    by (intro pmf_add[OF assms(1)], auto)
  also have "... \<le> ?rhs"
    by (intro add_mono assms(2-3))
  finally show ?thesis
    by simp
qed

definition covariance where
  "covariance f g = expectation (\<lambda>\<omega>. (f \<omega> - expectation f) * (g \<omega> - expectation g))"

lemma real_prod_integrable:
  fixes f g :: "'a \<Rightarrow> real"
  assumes [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
  assumes sq_int: "integrable M (\<lambda>\<omega>. f \<omega>^2)" "integrable M (\<lambda>\<omega>. g \<omega>^2)"
  shows "integrable M (\<lambda>\<omega>. f \<omega> * g \<omega>)"
  unfolding integrable_iff_bounded
proof
  have "(\<integral>\<^sup>+ \<omega>. ennreal (norm (f \<omega> * g \<omega>)) \<partial>M)\<^sup>2 = (\<integral>\<^sup>+ \<omega>. ennreal \<bar>f \<omega>\<bar> * ennreal \<bar>g \<omega>\<bar> \<partial>M)\<^sup>2"
    by (simp add: abs_mult ennreal_mult)
  also have "... \<le>  (\<integral>\<^sup>+ \<omega>. ennreal \<bar>f \<omega>\<bar>^2 \<partial>M) * (\<integral>\<^sup>+ \<omega>. ennreal \<bar>g \<omega>\<bar>^2 \<partial>M)"
    by (rule Cauchy_Schwarz_nn_integral, auto)
  also have "... < \<infinity>"
    using sq_int by (auto simp: integrable_iff_bounded ennreal_power ennreal_mult_less_top)
  finally have "(\<integral>\<^sup>+ x. ennreal (norm (f x * g x)) \<partial>M)\<^sup>2 < \<infinity>"
    by simp
  thus "(\<integral>\<^sup>+ x. ennreal (norm (f x * g x)) \<partial>M) < \<infinity>"
    by (simp add: power_less_top_ennreal)
qed auto

lemma covariance_eq:
  fixes f :: "'a \<Rightarrow> real"
  assumes "f \<in> borel_measurable M" "g \<in> borel_measurable M"
  assumes "integrable M (\<lambda>\<omega>. f \<omega>^2)" "integrable M (\<lambda>\<omega>. g \<omega>^2)"
  shows "covariance f g = expectation (\<lambda>\<omega>. f \<omega> * g \<omega>) - expectation f * expectation g"
proof -
  have "integrable M f" using square_integrable_imp_integrable assms by auto
  moreover have "integrable M g" using square_integrable_imp_integrable assms by auto
  ultimately show ?thesis
    using assms real_prod_integrable
    by (simp add:covariance_def algebra_simps prob_space)
qed

lemma covar_integrable:
  fixes f g :: "'a \<Rightarrow> real"
  assumes "f \<in> borel_measurable M" "g \<in> borel_measurable M"
  assumes "integrable M (\<lambda>\<omega>. f \<omega>^2)" "integrable M (\<lambda>\<omega>. g \<omega>^2)"
  shows "integrable M (\<lambda>\<omega>. (f \<omega> - expectation f) * (g \<omega> - expectation g))"
proof -
  have "integrable M f" using square_integrable_imp_integrable assms by auto
  moreover have "integrable M g" using square_integrable_imp_integrable assms by auto
  ultimately show ?thesis using assms real_prod_integrable by (simp add: algebra_simps)
qed

lemma sum_square_int:
  fixes f :: "'b \<Rightarrow> 'a \<Rightarrow> real"
  assumes "finite I"
  assumes "\<And>i. i \<in> I \<Longrightarrow> f i \<in> borel_measurable M"
  assumes "\<And>i. i \<in> I \<Longrightarrow> integrable M (\<lambda>\<omega>. f i \<omega>^2)"
  shows "integrable M (\<lambda>\<omega>. (\<Sum>i \<in> I. f i \<omega>)\<^sup>2)"
proof -
  have " integrable M (\<lambda>\<omega>. \<Sum>i\<in>I. \<Sum>j\<in>I. f j \<omega> * f i \<omega>)"
    using assms
    by (intro Bochner_Integration.integrable_sum real_prod_integrable, auto)
  thus ?thesis
    by (simp add:power2_eq_square sum_distrib_left sum_distrib_right)
qed

lemma var_sum_1:
  fixes f :: "'b \<Rightarrow> 'a \<Rightarrow> real"
  assumes "finite I"
  assumes "\<And>i. i \<in> I \<Longrightarrow> f i \<in> borel_measurable M"
  assumes "\<And>i. i \<in> I \<Longrightarrow> integrable M (\<lambda>\<omega>. f i \<omega>^2)"
  shows
    "variance (\<lambda>\<omega>. (\<Sum>i \<in> I. f i \<omega>)) = (\<Sum>i \<in> I. (\<Sum>j \<in> I. covariance (f i) (f j)))"
proof -
  have a:"\<And>i j. i \<in> I \<Longrightarrow> j \<in> I \<Longrightarrow> integrable M (\<lambda>\<omega>. (f i \<omega> - expectation (f i)) * (f j \<omega> - expectation (f j)))"
    using assms covar_integrable by simp
  have "variance (\<lambda>\<omega>. (\<Sum>i \<in> I. f i \<omega>)) = expectation (\<lambda>\<omega>. (\<Sum>i\<in>I. f i \<omega> - expectation (f i))\<^sup>2)"
    using square_integrable_imp_integrable[OF assms(2,3)]
    by (simp add: Bochner_Integration.integral_sum  sum_subtractf)
  also have "... = expectation (\<lambda>\<omega>. (\<Sum>i \<in> I. (\<Sum>j \<in> I. (f i \<omega> - expectation (f i)) *  (f j \<omega> - expectation (f j)))))"
    by (simp add: power2_eq_square sum_distrib_right sum_distrib_left mult.commute)
  also have "... = (\<Sum>i \<in> I. (\<Sum>j \<in> I. covariance (f i) (f j)))"
    using a by (simp add: Bochner_Integration.integral_sum covariance_def)
  finally show ?thesis by simp
qed

lemma covar_self_eq:
  fixes f :: "'a \<Rightarrow> real"
  shows "covariance f f = variance f"
  by (simp add:covariance_def power2_eq_square)

lemma covar_indep_eq_zero:
  fixes f g :: "'a \<Rightarrow> real"
  assumes "integrable M f"
  assumes "integrable M g"
  assumes "indep_var borel f borel g"
  shows "covariance f g = 0"
proof -
  have a:"indep_var borel ((\<lambda>t. t - expectation f) \<circ> f) borel ((\<lambda>t. t - expectation g) \<circ> g)"
    by (rule indep_var_compose[OF assms(3)], auto)

  have b:"expectation (\<lambda>\<omega>. (f \<omega> - expectation f) * (g \<omega> - expectation g)) = 0"
    using a assms by (subst indep_var_lebesgue_integral, auto simp add:comp_def prob_space)

  thus ?thesis by (simp add:covariance_def)
qed

lemma var_sum_2:
  fixes f :: "'b \<Rightarrow> 'a \<Rightarrow> real"
  assumes "finite I"
  assumes "\<And>i. i \<in> I \<Longrightarrow> f i \<in> borel_measurable M"
  assumes "\<And>i. i \<in> I \<Longrightarrow> integrable M (\<lambda>\<omega>. f i \<omega>^2)"
  shows "variance (\<lambda>\<omega>. (\<Sum>i \<in> I. f i \<omega>)) =
      (\<Sum>i \<in> I. variance (f i)) + (\<Sum>i \<in> I. \<Sum>j \<in> I - {i}. covariance (f i) (f j))"
proof -
  have "variance (\<lambda>\<omega>. (\<Sum>i \<in> I. f i \<omega>)) = (\<Sum>i\<in>I. \<Sum>j\<in>I. covariance (f i) (f j))"
    by (simp add: var_sum_1[OF assms(1,2,3)])
  also have "... = (\<Sum>i\<in>I. covariance (f i) (f i) + (\<Sum>j\<in>I-{i}. covariance (f i) (f j)))"
    using assms by (subst sum.insert[symmetric], auto simp add:insert_absorb)
  also have "... = (\<Sum>i\<in>I. variance (f i)) +  (\<Sum>i \<in> I. (\<Sum>j\<in>I-{i}. covariance (f i) (f j)))"
    by (simp add: covar_self_eq[symmetric] sum.distrib)
  finally show ?thesis by simp
qed

lemma var_sum_pairwise_indep:
  fixes f :: "'b \<Rightarrow> 'a \<Rightarrow> real"
  assumes "finite I"
  assumes "\<And>i. i \<in> I \<Longrightarrow> f i \<in> borel_measurable M"
  assumes "\<And>i. i \<in> I \<Longrightarrow> integrable M (\<lambda>\<omega>. f i \<omega>^2)"
  assumes "\<And>i j. i \<in> I \<Longrightarrow> j \<in> I \<Longrightarrow> i \<noteq> j \<Longrightarrow> indep_var borel (f i) borel (f j)"
  shows "variance (\<lambda>\<omega>. (\<Sum>i \<in> I. f i \<omega>)) = (\<Sum>i \<in> I. variance (f i))"
proof -
  have "\<And>i j. i \<in> I \<Longrightarrow> j \<in> I - {i} \<Longrightarrow> covariance (f i) (f j) = 0"
    using covar_indep_eq_zero assms(4) square_integrable_imp_integrable[OF assms(2,3)] by auto
  hence a:"(\<Sum>i \<in> I. \<Sum>j \<in> I - {i}. covariance (f i) (f j)) = 0"
    by simp
  thus ?thesis by (simp add: var_sum_2[OF assms(1,2,3)])
qed

lemma indep_var_from_indep_vars:
  assumes "i \<noteq> j"
  assumes "indep_vars (\<lambda>_. M') f {i, j}"
  shows "indep_var M' (f i) M' (f j)"
proof -
  have a:"inj (case_bool i j)" using assms(1)
    by (simp add: bool.case_eq_if inj_def)
  have b:"range (case_bool i j) = {i,j}"
    by (simp add: UNIV_bool insert_commute)
  have c:"indep_vars (\<lambda>_. M') f (range (case_bool i j))" using assms(2) b by simp

  have "True = indep_vars (\<lambda>x. M') (\<lambda>x. f (case_bool i j x)) UNIV"
    using indep_vars_reindex[OF a c]
    by (simp add:comp_def)
  also have "... = indep_vars (\<lambda>x. case_bool M' M' x) (\<lambda>x. case_bool (f i) (f j) x) UNIV"
    by (rule indep_vars_cong, auto simp:bool.case_distrib bool.case_eq_if)
  also have "... = ?thesis"
    by (simp add: indep_var_def)
  finally show ?thesis by simp
qed

lemma var_sum_pairwise_indep_2:
  fixes f :: "'b \<Rightarrow> 'a \<Rightarrow> real"
  assumes "finite I"
  assumes "\<And>i. i \<in> I \<Longrightarrow> f i \<in> borel_measurable M"
  assumes "\<And>i. i \<in> I \<Longrightarrow> integrable M (\<lambda>\<omega>. f i \<omega>^2)"
  assumes "\<And>J. J \<subseteq> I \<Longrightarrow> card J = 2 \<Longrightarrow> indep_vars (\<lambda> _. borel) f J"
  shows "variance (\<lambda>\<omega>. (\<Sum>i \<in> I. f i \<omega>)) = (\<Sum>i \<in> I. variance (f i))"
  using assms(4)
  by (intro var_sum_pairwise_indep[OF assms(1,2,3)] indep_var_from_indep_vars, auto)

lemma var_sum_all_indep:
  fixes f :: "'b \<Rightarrow> 'a \<Rightarrow> real"
  assumes "finite I"
  assumes "\<And>i. i \<in> I \<Longrightarrow> f i \<in> borel_measurable M"
  assumes "\<And>i. i \<in> I \<Longrightarrow> integrable M (\<lambda>\<omega>. f i \<omega>^2)"
  assumes "indep_vars (\<lambda> _. borel) f I"
  shows "variance (\<lambda>\<omega>. (\<Sum>i \<in> I. f i \<omega>)) = (\<Sum>i \<in> I. variance (f i))"
  by (intro var_sum_pairwise_indep_2[OF assms(1,2,3)] indep_vars_subset[OF assms(4)],  auto)

end

end


(* Author: Tobias Nipkow *)

theory Hoare_Examples imports Hoare begin

text{* Summing up the first @{text x} natural numbers in variable @{text y}. *}

fun sum :: "int \<Rightarrow> int" where
"sum i = (if i \<le> 0 then 0 else sum (i - 1) + i)"

lemma sum_simps[simp]:
  "0 < i \<Longrightarrow> sum i = sum (i - 1) + i"
  "i \<le> 0 \<Longrightarrow> sum i = 0"
by(simp_all)

declare sum.simps[simp del]

abbreviation "wsum ==
  WHILE Less (N 0) (V ''x'')
  DO (''y'' ::= Plus (V ''y'') (V ''x'');;
      ''x'' ::= Plus (V ''x'') (N (- 1)))"

subsubsection{* Proof by Operational Semantics *}

text{* The behaviour of the loop is proved by induction: *}

lemma while_sum:
  "(wsum, s) \<Rightarrow> t \<Longrightarrow> t ''y'' = s ''y'' + sum(s ''x'')"
apply(induction wsum s t rule: big_step_induct)
apply(auto)
done

text{* We were lucky that the proof was automatic, except for the
induction. In general, such proofs will not be so easy. The automation is
partly due to the right inversion rules that we set up as automatic
elimination rules that decompose big-step premises.

Now we prefix the loop with the necessary initialization: *}

lemma sum_via_bigstep:
  assumes "(''y'' ::= N 0;; wsum, s) \<Rightarrow> t"
  shows "t ''y'' = sum (s ''x'')"
proof -
  from assms have "(wsum,s(''y'':=0)) \<Rightarrow> t" by auto
  from while_sum[OF this] show ?thesis by simp
qed

subsubsection{* Proof by Hoare Logic *}

text{* Note that we deal with sequences of commands from right to left,
pulling back the postcondition towards the precondition. *}

lemma "\<turnstile> {\<lambda>s. s ''x'' = n} ''y'' ::= N 0;; wsum {\<lambda>s. s ''y'' = sum n}"
apply(rule Seq)
 prefer 2
 apply(rule While' [where P = "\<lambda>s. (s ''y'' = sum n - sum(s ''x''))"])
  apply(rule Seq)
   prefer 2
   apply(rule Assign)
  apply(rule Assign')
  apply simp
 apply simp
apply(rule Assign')
apply simp
done

text{* The proof is intentionally an apply script because it merely composes
the rules of Hoare logic. Of course, in a few places side conditions have to
be proved. But since those proofs are 1-liners, a structured proof is
overkill. In fact, we shall learn later that the application of the Hoare
rules can be automated completely and all that is left for the user is to
provide the loop invariants and prove the side-conditions. *}

end


(*
 * Copyright 2022, Proofcraft Pty Ltd
 *
 * SPDX-License-Identifier: BSD-2-Clause
 *)

(* Syntax for using multi-argument functions as predicates, e.g "P and Q" where P and Q are
   functions to bool, taking one or more parameters. *)

theory Fun_Pred_Syntax
imports Main
begin

section \<open>Definitions\<close>

text \<open>
  Functions are already instances of Boolean algebras and provide all the standard laws one
  would like to have. Default simplifications are automatic. Search for @{const inf}/
  @{const sup}/@{const uminus} to find further laws and/or unfold via the definitions below.

  The abbreviations here provide special syntax for the function instance of Boolean
  algebras only, leaving other instances (such as @{typ bool}) untouched.\<close>

abbreviation pred_conj :: "('a \<Rightarrow> 'b::boolean_algebra) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b)" where
  "pred_conj \<equiv> inf"

abbreviation pred_disj :: "('a \<Rightarrow> 'b::boolean_algebra) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b)" where
  "pred_disj \<equiv> sup"

abbreviation pred_neg :: "('a \<Rightarrow> 'b::boolean_algebra) \<Rightarrow> ('a \<Rightarrow> 'b)" where
  "pred_neg \<equiv> uminus"

text \<open>
  Lifted True/False: ideally, we'd map these to top/bot, but top/bot are constants and there are
  currently too many rules and tools that expect these conditions to beta-reduce and match against
  True/False directly.\<close>

abbreviation (input) pred_top :: "'a \<Rightarrow> bool" where
  "pred_top \<equiv> \<lambda>_. True"

abbreviation (input) pred_bot :: "'a \<Rightarrow> bool" where
  "pred_bot \<equiv> \<lambda>_. False"

text \<open>Version with two arguments for compatibility. Can hopefully be eliminated at some point.\<close>

abbreviation (input) pred_top2 :: "'a \<Rightarrow> 'b \<Rightarrow> bool" where
  "pred_top2 \<equiv> \<lambda>_ _. True"

abbreviation (input) pred_bot2 :: "'a \<Rightarrow> 'b \<Rightarrow> bool" where
  "pred_bot2 \<equiv> \<lambda>_ _. False"

section \<open>Syntax bundles\<close>

bundle fun_pred_syntax
begin
  (* infixl instead of infixr, because we want to split off conjuncts from the left *)
  notation pred_conj (infixl "and" 35)
  notation pred_disj (infixl "or" 30)
  notation pred_neg ("not _" [40] 40)
  notation pred_top ("\<top>")
  notation pred_bot ("\<bottom>")
  notation pred_top2 ("\<top>\<top>")
  notation pred_bot2 ("\<bottom>\<bottom>")
end

bundle no_fun_pred_syntax
begin
  no_notation pred_conj (infixl "and" 35)
  no_notation pred_disj (infixl "or" 30)
  no_notation pred_neg ("not _" [40] 40)
  no_notation pred_top ("\<top>")
  no_notation pred_bot ("\<bottom>")
  no_notation pred_top2 ("\<top>\<top>")
  no_notation pred_bot2 ("\<bottom>\<bottom>")
end

unbundle fun_pred_syntax

section \<open>Definitions specialised to @{typ bool} and @{text fun} instance of @{class boolean_algebra}\<close>

lemmas pred_conj_def =
  inf_fun_def[where 'b=bool, simplified]
  inf_fun_def[where f="f::'a \<Rightarrow> 'b::boolean_algebra" for f]

lemmas pred_disj_def =
  sup_fun_def[where 'b=bool, simplified]
  sup_fun_def[where f="f::'a \<Rightarrow> 'b::boolean_algebra" for f]

lemmas pred_neg_def =
  fun_Compl_def[where 'b=bool, simplified]
  fun_Compl_def[where A="A::'a \<Rightarrow> 'b::boolean_algebra" for A]

lemmas pred_top_def[simp] =
  top_fun_def[where 'b=bool, simplified] top_fun_def[where 'b="'b::boolean_algebra"]

lemmas pred_bot_def[simp] =
  bot_fun_def[where 'b=bool, simplified] bot_fun_def[where 'b="'b::boolean_algebra"]

section \<open>Other lemmas\<close>

text \<open>AC rewriting renamed and specialised, so we don't have to remember inf/sup\<close>

lemmas pred_conj_aci = inf_aci[where 'a="'a \<Rightarrow> 'b::boolean_algebra"]
lemmas pred_disj_aci = sup_aci[where 'a="'a \<Rightarrow> 'b::boolean_algebra"]

text \<open>Useful legacy names\<close>

lemmas pred_conjI = inf1I inf2I

lemmas pred_disjI1 = sup1I1[where 'a="'a \<Rightarrow> 'b::boolean_algebra"]
lemmas pred_disjI2 = sup1I2[where 'a="'a \<Rightarrow> 'b::boolean_algebra"]

lemmas pred_disj1CI[intro!] = sup1CI[where 'a="'a \<Rightarrow> 'b::boolean_algebra"]
lemmas pred_disj2CI = sup2CI[where 'a="'a \<Rightarrow> 'b::boolean_algebra"]

lemmas pred_conj_assoc = inf.assoc[where 'a="'a \<Rightarrow> 'b::boolean_algebra", symmetric]
lemmas pred_conj_comm = inf.commute[where 'a="'a \<Rightarrow> 'b::boolean_algebra"]

lemmas pred_disj_assoc = sup.assoc[where 'a="'a \<Rightarrow> 'b::boolean_algebra", symmetric]
lemmas pred_disj_comm = sup.commute[where 'a="'a \<Rightarrow> 'b::boolean_algebra"]

text \<open>Top/bot and function composition\<close>

lemma pred_top_comp[simp]:
  "\<top> \<circ> f = \<top>"
  by (simp add: comp_def)

lemma pred_bot_comp[simp]:
  "\<bottom> \<circ> f = \<bottom>"
  by (simp add: comp_def)

text \<open>We would get these for free if we could instantiate pred_top/pred_bot to top/bot directly:\<close>

lemmas pred_top_left_neutral[simp] =
  inf_top.left_neutral[where 'a="'a \<Rightarrow> bool", unfolded pred_top_def]

lemmas pred_top_right_neutral[simp] =
  inf_top.right_neutral[where 'a="'a \<Rightarrow> bool", unfolded pred_top_def]

lemmas pred_bot_left_neutral[simp] =
  sup_bot.left_neutral[where 'a="'a \<Rightarrow> bool", unfolded pred_bot_def]

lemmas pred_bot_right_neutral[simp] =
  sup_bot.right_neutral[where 'a="'a \<Rightarrow> bool", unfolded pred_bot_def]

lemmas pred_top_left[simp] =
  sup_top_left[where 'a="'a \<Rightarrow> bool", unfolded pred_top_def]

lemmas pred_top_right[simp] =
  sup_top_right[where 'a="'a \<Rightarrow> bool", unfolded pred_top_def]

lemmas pred_bot_left[simp] =
  inf_bot_left[where 'a="'a \<Rightarrow> bool", unfolded pred_bot_def]

lemmas pred_bot_right[simp] =
  inf_bot_right[where 'a="'a \<Rightarrow> bool", unfolded pred_bot_def]

lemmas pred_neg_top_eq[simp] =
  compl_top_eq[where 'a="'a \<Rightarrow> bool", unfolded pred_bot_def pred_top_def]

lemmas pred_neg_bot_eq[simp] =
  compl_bot_eq[where 'a="'a \<Rightarrow> bool", unfolded pred_bot_def pred_top_def]

(* no special setup for pred_top2/pred_bot2 at the moment, since we hope to eliminate these
   entirely in the future *)

section \<open>Examples\<close>

experiment
begin

(* Standard laws are available by default: *)
lemma "(P and P) = P" for P :: "'a \<Rightarrow> bool"
  by simp

(* Works for functions with multiple arguments: *)
lemma "(P and Q) = (Q and P)" for P :: "'a \<Rightarrow> 'b \<Rightarrow> bool"
  by (simp add: pred_conj_aci)

(* Unfolds automatically when applied: *)
lemma "(P and Q) s t = (P s t \<and> Q s t)"
  by simp

(* pred_top and pred_bot work for only one argument currently: *)
lemma "(P and not P) = \<bottom>" for P :: "'a \<Rightarrow> bool"
  by simp

(* You can still use them with more arguments and sometimes get simplification: *)
lemma "(P and not P) = (\<lambda>_ _. \<bottom>)" for P :: "'a \<Rightarrow> 'b \<Rightarrow> 'c \<Rightarrow> bool"
  by simp

(* But sometimes you need to fold pred_top_def/pred_bot_def for rules on top/bot to fire: *)
lemma "(P and (\<lambda>_ _. \<bottom>)) = (\<lambda>_ _. \<bottom>)"
  by (simp flip: pred_bot_def)

lemma "(P and \<bottom>\<bottom>) = \<bottom>\<bottom>"
  by (simp flip: pred_bot_def)

end

end


theory Chapter10_4
imports "HOL-IMP.Live_True" "HOL-IMP.Vars" "Short_Theory"
begin

text{*
\exercise
In the context of ordinary live variable analysis, elimination of dead variables
(@{text bury}) is not idempotent (Exercise~\ref{exe:bury-not-idemp}).
Now define the textually identical function @{text bury} in the context
of true liveness analysis (theory @{short_theory "Live_True"})
and prove that it is idempotent.
*}

fun bury :: "com \<Rightarrow> vname set \<Rightarrow> com" where
"bury SKIP X = SKIP" |
"bury (x ::= a) X = (if x \<in> X then x ::= a else SKIP)" |
"bury (c\<^sub>1;; c\<^sub>2) X = (bury c\<^sub>1 (L c\<^sub>2 X);; bury c\<^sub>2 X)" |
"bury (IF b THEN c\<^sub>1 ELSE c\<^sub>2) X = IF b THEN bury c\<^sub>1 X ELSE bury c\<^sub>2 X" |
"bury (WHILE b DO c) X = WHILE b DO bury c (L (WHILE b DO c) X)"

text{* The following two tweaks improve proof automation: *}

declare L.simps(5)[simp]
lemmas L_mono2 = L_mono[unfolded mono_def]

text{* To show that @{const bury} is idempotent we need a key lemma: *}

lemma L_bury: "X \<subseteq> Y \<Longrightarrow> L (bury c Y) X = L c X"
(* your definition/proof here *)

text{* The proof is straightforward except for the case
\noquotes{@{term[source] "While b c"}} where reasoning about @{const lfp}
is required. Sledgehammer should help with the details.

Now we can prove idempotence of @{const bury}, again by induction on @{text c}:
*}

theorem bury_idemp: "bury (bury c X) X = bury c X"
(* your definition/proof here *)

text{*
Due to lemma @{thm[source] L_bury}, even the @{text While} case should be easy.
\endexercise
*}

end


(*  Title:      HOL/Proofs/Lambda/ParRed.thy
    Author:     Tobias Nipkow
    Copyright   1995 TU Muenchen

Properties of => and "cd", in particular the diamond property of => and
confluence of beta.
*)

section {* Parallel reduction and a complete developments *}

theory ParRed imports Lambda Commutation begin

subsection {* Parallel reduction *}

inductive par_beta :: "[dB, dB] => bool"  (infixl "=>" 50)
  where
    var [simp, intro!]: "Var n => Var n"
  | abs [simp, intro!]: "s => t ==> Abs s => Abs t"
  | app [simp, intro!]: "[| s => s'; t => t' |] ==> s \<degree> t => s' \<degree> t'"
  | beta [simp, intro!]: "[| s => s'; t => t' |] ==> (Abs s) \<degree> t => s'[t'/0]"

inductive_cases par_beta_cases [elim!]:
  "Var n => t"
  "Abs s => Abs t"
  "(Abs s) \<degree> t => u"
  "s \<degree> t => u"
  "Abs s => t"

subsection {* Inclusions *}

text {* @{text "beta \<subseteq> par_beta \<subseteq> beta^*"} \medskip *}

lemma par_beta_varL [simp]:
    "(Var n => t) = (t = Var n)"
  by blast

lemma par_beta_refl [simp]: "t => t"  (* par_beta_refl [intro!] causes search to blow up *)
  by (induct t) simp_all

lemma beta_subset_par_beta: "beta <= par_beta"
  apply (rule predicate2I)
  apply (erule beta.induct)
     apply (blast intro!: par_beta_refl)+
  done

lemma par_beta_subset_beta: "par_beta <= beta^**"
  apply (rule predicate2I)
  apply (erule par_beta.induct)
     apply blast
    apply (blast del: rtranclp.rtrancl_refl intro: rtranclp.rtrancl_into_rtrancl)+
      -- {* @{thm[source] rtrancl_refl} complicates the proof by increasing the branching factor *}
  done

subsection {* Misc properties of @{text "par_beta"} *}

lemma par_beta_lift [simp]:
    "t => t' \<Longrightarrow> lift t n => lift t' n"
  by (induct t arbitrary: t' n) fastforce+

lemma par_beta_subst:
    "s => s' \<Longrightarrow> t => t' \<Longrightarrow> t[s/n] => t'[s'/n]"
  apply (induct t arbitrary: s s' t' n)
    apply (simp add: subst_Var)
   apply (erule par_beta_cases)
    apply simp
   apply (simp add: subst_subst [symmetric])
   apply (fastforce intro!: par_beta_lift)
  apply fastforce
  done

subsection {* Confluence (directly) *}

lemma diamond_par_beta: "diamond par_beta"
  apply (unfold diamond_def commute_def square_def)
  apply (rule impI [THEN allI [THEN allI]])
  apply (erule par_beta.induct)
     apply (blast intro!: par_beta_subst)+
  done

subsection {* Complete developments *}

fun
  cd :: "dB => dB"
where
  "cd (Var n) = Var n"
| "cd (Var n \<degree> t) = Var n \<degree> cd t"
| "cd ((s1 \<degree> s2) \<degree> t) = cd (s1 \<degree> s2) \<degree> cd t"
| "cd (Abs u \<degree> t) = (cd u)[cd t/0]"
| "cd (Abs s) = Abs (cd s)"

lemma par_beta_cd: "s => t \<Longrightarrow> t => cd s"
  apply (induct s arbitrary: t rule: cd.induct)
      apply auto
  apply (fast intro!: par_beta_subst)
  done

subsection {* Confluence (via complete developments) *}

lemma diamond_par_beta2: "diamond par_beta"
  apply (unfold diamond_def commute_def square_def)
  apply (blast intro: par_beta_cd)
  done

theorem beta_confluent: "confluent beta"
  apply (rule diamond_par_beta2 diamond_to_confluence
    par_beta_subset_beta beta_subset_par_beta)+
  done

end