diff --git a/thys/Frequency_Moments/Frequency_Moment_0.thy b/thys/Frequency_Moments/Frequency_Moment_0.thy
--- a/thys/Frequency_Moments/Frequency_Moment_0.thy
+++ b/thys/Frequency_Moments/Frequency_Moment_0.thy
@@ -1,1315 +1,1315 @@
 section \<open>Frequency Moment $0$\label{sec:f0}\<close>
 
 theory Frequency_Moment_0
   imports
     Frequency_Moments_Preliminary_Results
     Median_Method.Median
     K_Smallest
     Universal_Hash_Families.Carter_Wegman_Hash_Family
     Frequency_Moments
     Landau_Ext
     Probability_Ext
     Product_PMF_Ext
     Universal_Hash_Families.Universal_Hash_Families_More_Finite_Fields
 begin
 
 text \<open>This section contains a formalization of a new algorithm for the zero-th frequency moment
 inspired by ideas described in \<^cite>\<open>"baryossef2002"\<close>.
 It is a KMV-type ($k$-minimum value) algorithm with a rounding method and matches the space complexity
 of the best algorithm described in \<^cite>\<open>"baryossef2002"\<close>.
 
 In addition to the Isabelle proof here, there is also an informal hand-written proof in
 Appendix~\ref{sec:f0_proof}.\<close>
 
 type_synonym f0_state = "nat \<times> nat \<times> nat \<times> nat \<times> (nat \<Rightarrow> nat list) \<times> (nat \<Rightarrow> float set)"
 
 definition hash where "hash p = ring.hash (mod_ring p)"
 
 fun f0_init :: "rat \<Rightarrow> rat \<Rightarrow> nat \<Rightarrow> f0_state pmf" where
   "f0_init \<delta> \<epsilon> n =
     do {
       let s = nat \<lceil>-18 * ln (real_of_rat \<epsilon>)\<rceil>;
       let t = nat \<lceil>80 / (real_of_rat \<delta>)\<^sup>2\<rceil>;
       let p = prime_above (max n 19);
       let r = nat (4 * \<lceil>log 2 (1 / real_of_rat \<delta>)\<rceil> + 23);
       h \<leftarrow> prod_pmf {..<s} (\<lambda>_. pmf_of_set (bounded_degree_polynomials (mod_ring p) 2));
       return_pmf (s, t, p, r, h, (\<lambda>_ \<in> {0..<s}. {}))
     }"
 
 fun f0_update :: "nat \<Rightarrow> f0_state \<Rightarrow> f0_state pmf" where
   "f0_update x (s, t, p, r, h, sketch) =
     return_pmf (s, t, p, r, h, \<lambda>i \<in> {..<s}.
       least t (insert (float_of (truncate_down r (hash p x (h i)))) (sketch i)))"
 
 fun f0_result :: "f0_state \<Rightarrow> rat pmf" where
   "f0_result (s, t, p, r, h, sketch) = return_pmf (median s (\<lambda>i \<in> {..<s}.
       (if card (sketch i) < t then of_nat (card (sketch i)) else
         rat_of_nat t* rat_of_nat p / rat_of_float (Max (sketch i)))
     ))"
 
 fun f0_space_usage :: "(nat \<times> rat \<times> rat) \<Rightarrow> real" where
   "f0_space_usage (n, \<epsilon>, \<delta>) = (
     let s = nat \<lceil>-18 * ln (real_of_rat \<epsilon>)\<rceil> in
     let r = nat (4 * \<lceil>log 2 (1 / real_of_rat \<delta>)\<rceil> + 23) in
     let t = nat \<lceil>80 / (real_of_rat \<delta>)\<^sup>2 \<rceil> in
     6 +
     2 * log 2 (real s + 1) +
     2 * log 2 (real t + 1) +
     2 * log 2 (real n + 21) +
     2 * log 2 (real r + 1) +
     real s * (5 + 2 * log 2 (21 + real n) +
     real t * (13 + 4 * r + 2 * log 2 (log 2 (real n + 13)))))"
 
 definition encode_f0_state :: "f0_state \<Rightarrow> bool list option" where
   "encode_f0_state =
     N\<^sub>e \<Join>\<^sub>e (\<lambda>s.
     N\<^sub>e \<times>\<^sub>e (
     N\<^sub>e \<Join>\<^sub>e (\<lambda>p.
     N\<^sub>e \<times>\<^sub>e (
     ([0..<s] \<rightarrow>\<^sub>e (P\<^sub>e p 2)) \<times>\<^sub>e
     ([0..<s] \<rightarrow>\<^sub>e (S\<^sub>e F\<^sub>e))))))"
 
 lemma "inj_on encode_f0_state (dom encode_f0_state)"
 proof -
   have "is_encoding encode_f0_state"
     unfolding encode_f0_state_def
     by (intro dependent_encoding exp_golomb_encoding poly_encoding fun_encoding set_encoding float_encoding)
   thus ?thesis  by (rule encoding_imp_inj)
 qed
 
 context
   fixes \<epsilon> \<delta> :: rat
   fixes n :: nat
   fixes as :: "nat list"
   fixes result
   assumes \<epsilon>_range: "\<epsilon> \<in> {0<..<1}"
   assumes \<delta>_range: "\<delta> \<in> {0<..<1}"
   assumes as_range: "set as \<subseteq> {..<n}"
   defines "result \<equiv> fold (\<lambda>a state. state \<bind> f0_update a) as (f0_init \<delta> \<epsilon> n) \<bind> f0_result"
 begin
 
 private definition t where "t = nat \<lceil>80 / (real_of_rat \<delta>)\<^sup>2\<rceil>"
 private lemma t_gt_0: "t > 0" using \<delta>_range by (simp add:t_def)
 
 private definition s where "s = nat \<lceil>-(18 * ln (real_of_rat \<epsilon>))\<rceil>"
 private lemma s_gt_0: "s > 0" using \<epsilon>_range by (simp add:s_def)
 
 private definition p where "p = prime_above (max n 19)"
 
 private lemma p_prime:"Factorial_Ring.prime p"
   using p_def prime_above_prime by presburger
 
 private lemma p_ge_18: "p \<ge> 18"
 proof -
   have "p \<ge> 19"
     by (metis p_def prime_above_lower_bound max.bounded_iff)
   thus ?thesis by simp
 qed
 
 private lemma p_gt_0: "p > 0" using p_ge_18 by simp
 private lemma p_gt_1: "p > 1" using p_ge_18 by simp
 
 private lemma n_le_p: "n \<le> p"
 proof -
   have "n \<le> max n 19" by simp
   also have "... \<le> p"
     unfolding p_def by (rule prime_above_lower_bound)
   finally show ?thesis by simp
 qed
 
 private lemma p_le_n: "p \<le> 2*n + 40"
 proof -
   have "p \<le> 2 * (max n 19) + 2"
     by (subst p_def, rule prime_above_upper_bound)
   also have "... \<le> 2 * n + 40"
     by (cases "n \<ge> 19", auto)
   finally show ?thesis by simp
 qed
 
 private lemma as_lt_p: "\<And>x. x \<in> set as \<Longrightarrow> x < p"
   using as_range atLeastLessThan_iff
   by (intro order_less_le_trans[OF _ n_le_p]) blast
 
 private lemma as_subset_p: "set as \<subseteq> {..<p}"
    using as_lt_p  by (simp add: subset_iff)
 
 private definition r where "r = nat (4 * \<lceil>log 2 (1 / real_of_rat \<delta>)\<rceil> + 23)"
 
 private lemma r_bound: "4 * log 2 (1 / real_of_rat \<delta>) + 23 \<le> r"
 proof -
   have "0 \<le> log 2 (1 / real_of_rat \<delta>)" using \<delta>_range by simp
   hence "0 \<le> \<lceil>log 2 (1 / real_of_rat \<delta>)\<rceil>" by simp
   hence "0 \<le> 4 * \<lceil>log 2 (1 / real_of_rat \<delta>)\<rceil> + 23"
     by (intro add_nonneg_nonneg mult_nonneg_nonneg, auto)
   thus ?thesis by (simp add:r_def)
 qed
 
 private lemma r_ge_23: "r \<ge> 23"
 proof -
   have "(23::real) = 0 + 23" by simp
   also have "... \<le> 4 * log 2 (1 / real_of_rat \<delta>) + 23"
     using \<delta>_range by (intro add_mono mult_nonneg_nonneg, auto)
   also have "... \<le> r" using r_bound by simp
   finally show "23 \<le> r" by simp
 qed
 
 private lemma two_pow_r_le_1: "0 < 1 - 2 powr - real r"
 proof -
   have a: "2 powr (0::real) = 1"
     by simp
   show ?thesis using r_ge_23
     by (simp, subst a[symmetric], intro powr_less_mono, auto)
 qed
 
 interpretation carter_wegman_hash_family "mod_ring p" 2
   rewrites "ring.hash (mod_ring p) = Frequency_Moment_0.hash p"
   using carter_wegman_hash_familyI[OF mod_ring_is_field mod_ring_finite]
   using hash_def p_prime by auto
 
 private definition tr_hash where "tr_hash x \<omega> = truncate_down r (hash x \<omega>)"
 
 private definition sketch_rv where
   "sketch_rv \<omega> = least t ((\<lambda>x. float_of (tr_hash x \<omega>)) ` set as)"
 
 private definition estimate
    where "estimate S = (if card S < t then of_nat (card S) else of_nat t * of_nat p / rat_of_float (Max S))"
 
 private definition sketch_rv' where "sketch_rv' \<omega> = least t ((\<lambda>x. tr_hash x \<omega>) ` set as)"
 private definition estimate' where "estimate' S = (if card S < t then real (card S) else real t * real p / Max S)"
 
 private definition \<Omega>\<^sub>0 where "\<Omega>\<^sub>0 = prod_pmf {..<s} (\<lambda>_. pmf_of_set space)"
 
 private lemma f0_alg_sketch:
   defines "sketch \<equiv> fold (\<lambda>a state. state \<bind> f0_update a) as (f0_init \<delta> \<epsilon> n)"
   shows "sketch = map_pmf (\<lambda>x. (s,t,p,r, x, \<lambda>i \<in> {..<s}. sketch_rv (x i))) \<Omega>\<^sub>0"
   unfolding sketch_rv_def
 proof (subst sketch_def, induction as rule:rev_induct)
   case Nil
   then show ?case
     by (simp add:s_def p_def[symmetric] map_pmf_def t_def r_def Let_def least_def restrict_def space_def \<Omega>\<^sub>0_def)
 next
   case (snoc x xs)
   let ?sketch = "\<lambda>\<omega> xs. least t ((\<lambda>a. float_of (tr_hash a \<omega>)) ` set xs)"
   have "fold (\<lambda>a state. state \<bind> f0_update a) (xs @ [x]) (f0_init \<delta> \<epsilon> n) =
      (map_pmf (\<lambda>\<omega>. (s, t, p, r, \<omega>, \<lambda>i \<in> {..<s}. ?sketch (\<omega> i) xs)) \<Omega>\<^sub>0) \<bind> f0_update x"
     by (simp add: restrict_def snoc del:f0_init.simps)
   also have "... = \<Omega>\<^sub>0 \<bind> (\<lambda>\<omega>. f0_update x (s, t, p, r, \<omega>, \<lambda>i\<in>{..<s}. ?sketch (\<omega> i) xs)) "
     by (simp add:map_pmf_def bind_assoc_pmf bind_return_pmf del:f0_update.simps)
   also have "... = map_pmf (\<lambda>\<omega>. (s, t, p, r, \<omega>, \<lambda>i\<in>{..<s}. ?sketch (\<omega> i) (xs@[x]))) \<Omega>\<^sub>0"
     by (simp add:least_insert map_pmf_def tr_hash_def cong:restrict_cong)
   finally show ?case by blast
 qed
 
 private lemma card_nat_in_ball:
   fixes x :: nat
   fixes q :: real
   assumes "q \<ge> 0"
   defines "A \<equiv> {k. abs (real x - real k) \<le> q \<and> k \<noteq> x}"
   shows "real (card A) \<le> 2 * q" and "finite A"
 proof -
   have a: "of_nat x \<in> {\<lceil>real x-q\<rceil>..\<lfloor>real x+q\<rfloor>}"
     using assms
     by (simp add: ceiling_le_iff)
 
   have "card A = card (int ` A)"
     by (rule card_image[symmetric], simp)
   also have "... \<le> card ({\<lceil>real x-q\<rceil>..\<lfloor>real x+q\<rfloor>} - {of_nat x})"
     by (intro card_mono image_subsetI, simp_all add:A_def abs_le_iff, linarith)
   also have "... = card {\<lceil>real x-q\<rceil>..\<lfloor>real x+q\<rfloor>} - 1"
     by (rule card_Diff_singleton, rule a)
   also have "... = int (card {\<lceil>real x-q\<rceil>..\<lfloor>real x+q\<rfloor>}) - int 1"
     by (intro of_nat_diff)
      (metis a card_0_eq empty_iff finite_atLeastAtMost_int less_one linorder_not_le)
   also have "... \<le> \<lfloor>q+real x\<rfloor>+1 -\<lceil>real x-q\<rceil> - 1"
     using assms by (simp, linarith)
   also have "... \<le> 2*q"
     by linarith
   finally show "card A \<le> 2 * q"
     by simp
 
   have "A \<subseteq> {..x + nat \<lceil>q\<rceil>}"
     by (rule subsetI, simp add:A_def abs_le_iff, linarith)
   thus "finite A"
     by (rule finite_subset, simp)
 qed
 
 private lemma prob_degree_lt_1:
    "prob {\<omega>. degree \<omega> < 1} \<le> 1/real p"
 proof -
   have "space \<inter> {\<omega>. length \<omega> \<le> Suc 0} = bounded_degree_polynomials (mod_ring p) 1"
     by (auto simp:set_eq_iff bounded_degree_polynomials_def space_def)
   moreover have "field_size = p" by (simp add:mod_ring_def)
   hence "real (card (bounded_degree_polynomials (mod_ring p) (Suc 0))) / real (card space) = 1 / real p"
     by (simp add:space_def bounded_degree_polynomials_card power2_eq_square)
   ultimately show ?thesis
     by (simp add:M_def measure_pmf_of_set)
 qed
 
 private lemma collision_prob:
   assumes "c \<ge> 1"
   shows "prob {\<omega>. \<exists>x \<in> set as. \<exists>y \<in> set as. x \<noteq> y \<and> tr_hash x \<omega> \<le> c \<and> tr_hash x \<omega> = tr_hash y \<omega>} \<le>
     (5/2) * (real (card (set as)))\<^sup>2 * c\<^sup>2 * 2 powr -(real r) / (real p)\<^sup>2 + 1/real p" (is "prob {\<omega>. ?l \<omega>} \<le> ?r1 + ?r2")
 proof -
   define \<rho> :: real where "\<rho> = 9/8"
 
   have rho_c_ge_0: "\<rho> * c \<ge> 0" unfolding \<rho>_def using assms by simp
 
   have c_ge_0: "c\<ge>0" using assms by simp
 
   have "degree \<omega> \<ge> 1 \<Longrightarrow> \<omega> \<in> space \<Longrightarrow> degree \<omega> = 1" for \<omega>
     by (simp add:bounded_degree_polynomials_def space_def)
      (metis One_nat_def Suc_1 le_less_Suc_eq less_imp_diff_less list.size(3) pos2)
 
   hence a: "\<And>\<omega> x y. x < p \<Longrightarrow> y < p \<Longrightarrow>  x \<noteq> y \<Longrightarrow> degree \<omega> \<ge> 1 \<Longrightarrow> \<omega> \<in> space \<Longrightarrow>  hash x \<omega> \<noteq> hash y \<omega>"
     using inj_onD[OF inj_if_degree_1]  mod_ring_carr by blast
 
   have b: "prob {\<omega>. degree \<omega> \<ge> 1 \<and> tr_hash x \<omega> \<le> c \<and> tr_hash x \<omega> = tr_hash y \<omega>} \<le> 5 * c\<^sup>2 * 2 powr (-real r) /(real p)\<^sup>2"
     if b_assms: "x \<in> set as"  "y \<in> set as"  "x < y" for x y
   proof -
     have c: "real u \<le> \<rho> * c \<and> \<bar>real u - real v\<bar> \<le> \<rho> * c * 2 powr (-real r)"
       if c_assms:"truncate_down r (real u) \<le> c" "truncate_down r (real u) = truncate_down r (real v)" for u v
     proof -
       have "9 * 2 powr - real r \<le> 9 * 2 powr (- real 23)"
         using r_ge_23 by (intro mult_left_mono powr_mono, auto)
 
       also have "... \<le> 1" by simp
 
       finally have "9 * 2 powr - real r \<le> 1" by simp
 
       hence "1 \<le> \<rho> * (1 - 2 powr (- real r))"
         by (simp add:\<rho>_def)
 
       hence d: "(c*1) / (1 - 2 powr (-real r)) \<le> c * \<rho>"
         using assms two_pow_r_le_1 by (simp add: pos_divide_le_eq)
 
       have "\<And>x. truncate_down r (real x) \<le> c \<Longrightarrow> real x * (1 - 2 powr - real r) \<le> c * 1"
         using  truncate_down_pos[OF of_nat_0_le_iff] order_trans by (simp, blast)
 
       hence "\<And>x. truncate_down r (real x) \<le>  c  \<Longrightarrow> real x \<le> c * \<rho>"
         using two_pow_r_le_1 by (intro order_trans[OF _ d], simp add: pos_le_divide_eq)
 
       hence e: "real u \<le> c * \<rho>" "real v \<le> c * \<rho>"
         using c_assms by auto
 
       have " \<bar>real u - real v\<bar> \<le> (max \<bar>real u\<bar> \<bar>real v\<bar>) * 2 powr (-real r)"
         using c_assms by (intro truncate_down_eq, simp)
 
       also have "... \<le> (c * \<rho>) * 2 powr (-real r)"
         using e by (intro mult_right_mono, auto)
 
       finally have "\<bar>real u - real v\<bar> \<le> \<rho> * c * 2 powr (-real r)"
         by (simp add:algebra_simps)
 
       thus ?thesis using e by (simp add:algebra_simps)
     qed
 
     have "prob {\<omega>. degree \<omega> \<ge> 1 \<and> tr_hash x \<omega> \<le> c \<and> tr_hash x \<omega> = tr_hash y \<omega>} \<le>
       prob (\<Union> i \<in> {(u,v) \<in> {..<p} \<times> {..<p}. u \<noteq> v \<and> truncate_down r u \<le> c \<and> truncate_down r u = truncate_down r v}.
       {\<omega>.  hash x \<omega> = fst i \<and> hash y \<omega> = snd i})"
       using a by (intro pmf_mono[OF M_def], simp add:tr_hash_def)
        (metis hash_range mod_ring_carr b_assms as_subset_p lessThan_iff nat_neq_iff subset_eq)
 
     also have "... \<le> (\<Sum> i\<in> {(u,v) \<in> {..<p} \<times> {..<p}. u \<noteq> v \<and>
       truncate_down r u \<le> c \<and> truncate_down r u = truncate_down r v}.
       prob {\<omega>. hash x \<omega> = fst i \<and> hash  y \<omega> = snd i})"
       by (intro measure_UNION_le finite_cartesian_product finite_subset[where B="{0..<p} \<times> {0..<p}"])
        (auto simp add:M_def)
 
     also have "... \<le> (\<Sum> i\<in> {(u,v) \<in> {..<p} \<times> {..<p}. u \<noteq> v \<and>
       truncate_down r u \<le> c \<and> truncate_down r u = truncate_down r v}.
       prob {\<omega>. (\<forall>u \<in> {x,y}. hash u \<omega> = (if u = x then (fst i) else (snd i)))})"
       by (intro sum_mono  pmf_mono[OF M_def]) force
 
     also have "... \<le> (\<Sum> i\<in> {(u,v) \<in> {..<p} \<times> {..<p}. u \<noteq> v \<and>
       truncate_down r u \<le> c \<and> truncate_down r u = truncate_down r v}. 1/(real p)\<^sup>2)"
       using assms as_subset_p b_assms
       by (intro sum_mono, subst hash_prob)  (auto simp add: mod_ring_def power2_eq_square)
 
     also have "... = 1/(real p)\<^sup>2 *
       card {(u,v) \<in> {0..<p} \<times> {0..<p}. u \<noteq> v \<and> truncate_down r u \<le> c \<and> truncate_down r u = truncate_down r v}"
       by simp
 
     also have "... \<le> 1/(real p)\<^sup>2 *
       card {(u,v) \<in> {..<p} \<times> {..<p}. u \<noteq> v \<and> real u \<le> \<rho> * c \<and> abs (real u - real v) \<le> \<rho> * c * 2 powr (-real r)}"
       using c
       by (intro mult_mono of_nat_mono card_mono finite_cartesian_product finite_subset[where B="{..<p}\<times>{..<p}"])
         auto
 
     also have "... \<le> 1/(real p)\<^sup>2 * card (\<Union>u' \<in> {u. u < p \<and> real u \<le> \<rho> * c}.
         {(u::nat,v::nat). u = u' \<and> abs (real u - real v) \<le> \<rho> * c * 2 powr (-real r) \<and> v < p \<and> v \<noteq> u'})"
       by (intro mult_left_mono of_nat_mono card_mono finite_cartesian_product finite_subset[where B="{..<p}\<times>{..<p}"])
        auto
 
     also have "... \<le> 1/(real p)\<^sup>2 * (\<Sum> u' \<in> {u. u < p \<and> real u \<le> \<rho> * c}.
       card  {(u,v). u = u' \<and> abs (real u - real v) \<le> \<rho> * c * 2 powr (-real r) \<and> v < p \<and> v \<noteq> u'})"
       by (intro mult_left_mono of_nat_mono card_UN_le, auto)
 
     also have "... = 1/(real p)\<^sup>2 * (\<Sum> u' \<in> {u. u < p \<and>  real u \<le> \<rho> * c}.
       card ((\<lambda>x. (u' ,x)) ` {v. abs (real u' - real v) \<le> \<rho> * c * 2 powr (-real r) \<and> v < p \<and> v \<noteq> u'}))"
       by (intro arg_cong2[where f="(*)"] arg_cong[where f="real"] sum.cong arg_cong[where f="card"])
        (auto simp add:set_eq_iff)
 
     also have "... \<le> 1/(real p)\<^sup>2 * (\<Sum> u' \<in> {u. u < p \<and> real u \<le> \<rho> * c}.
       card {v. abs (real u' - real v) \<le> \<rho> * c * 2 powr (-real r) \<and> v < p \<and> v \<noteq> u'})"
       by (intro mult_left_mono of_nat_mono sum_mono card_image_le, auto)
 
     also have "... \<le> 1/(real p)\<^sup>2 * (\<Sum> u' \<in> {u. u < p \<and> real u \<le> \<rho> * c}.
       card {v. abs (real u' - real v) \<le> \<rho> * c * 2 powr (-real r) \<and> v \<noteq> u'})"
       by (intro mult_left_mono sum_mono of_nat_mono card_mono card_nat_in_ball subsetI)  auto
 
     also have "... \<le> 1/(real p)\<^sup>2 * (\<Sum> u' \<in> {u. u < p \<and> real u \<le> \<rho> * c}.
       real (card {v. abs (real u' - real v) \<le> \<rho> * c * 2 powr (-real r) \<and> v \<noteq> u'}))"
       by simp
 
     also have "... \<le> 1/(real p)\<^sup>2 * (\<Sum> u' \<in> {u. u < p \<and> real u \<le> \<rho> * c}. 2 * (\<rho> * c * 2 powr (-real r)))"
       by (intro mult_left_mono sum_mono card_nat_in_ball(1), auto)
 
     also have "... =  1/(real p)\<^sup>2 * (real (card {u. u < p \<and> real u \<le> \<rho> * c}) * (2 * (\<rho> * c * 2 powr (-real r))))"
       by simp
 
     also have "... \<le>  1/(real p)\<^sup>2 * (real (card {u. u \<le> nat (\<lfloor>\<rho> * c \<rfloor>)}) * (2 * (\<rho> * c * 2 powr (-real r))))"
       using rho_c_ge_0 le_nat_floor
       by (intro mult_left_mono mult_right_mono of_nat_mono card_mono subsetI) auto
 
     also have "... \<le>  1/(real p)\<^sup>2 * ((1+\<rho> * c) * (2 * (\<rho> * c * 2 powr (-real r))))"
       using rho_c_ge_0 by (intro mult_left_mono mult_right_mono, auto)
 
     also have "... \<le>  1/(real p)\<^sup>2 * (((1+\<rho>) * c) * (2 * (\<rho> * c * 2 powr (-real r))))"
       using assms by (intro mult_mono, auto simp add:distrib_left distrib_right \<rho>_def)
 
     also have "... = (\<rho> * (2 + \<rho> * 2)) * c\<^sup>2 * 2 powr (-real r) /(real p)\<^sup>2"
       by (simp add:ac_simps power2_eq_square)
 
     also have "... \<le> 5 * c\<^sup>2 *  2 powr (-real r) /(real p)\<^sup>2"
       by (intro divide_right_mono mult_right_mono) (auto simp add:\<rho>_def)
 
     finally show ?thesis by simp
   qed
 
   have "prob {\<omega>. ?l \<omega> \<and> degree \<omega> \<ge> 1} \<le>
     prob (\<Union> i \<in> {(x,y) \<in> (set as) \<times> (set as). x < y}. {\<omega>. degree \<omega> \<ge> 1 \<and> tr_hash (fst i) \<omega> \<le> c \<and>
     tr_hash (fst i) \<omega> = tr_hash (snd i) \<omega>})"
     by (rule pmf_mono[OF M_def], simp, metis linorder_neqE_nat)
 
   also have "... \<le> (\<Sum> i \<in> {(x,y) \<in> (set as) \<times> (set as). x < y}. prob
     {\<omega>. degree \<omega> \<ge> 1 \<and> tr_hash  (fst i) \<omega> \<le> c \<and> tr_hash (fst i) \<omega> = tr_hash (snd i) \<omega>})"
     unfolding M_def
     by (intro measure_UNION_le finite_cartesian_product finite_subset[where B="(set as) \<times> (set as)"])
       auto
 
   also have "... \<le> (\<Sum> i \<in> {(x,y) \<in> (set as) \<times> (set as). x < y}. 5  * c\<^sup>2 * 2 powr (-real r) /(real p)\<^sup>2)"
     using b by (intro sum_mono, simp add:case_prod_beta)
 
   also have "... =  ((5/2) * c\<^sup>2  * 2 powr (-real r) /(real p)\<^sup>2) * (2 * card  {(x,y) \<in> (set as) \<times> (set as). x < y})"
     by simp
 
   also have "... =  ((5/2) * c\<^sup>2  * 2 powr (-real r) /(real p)\<^sup>2) * (card (set as) * (card (set as) - 1))"
     by (subst card_ordered_pairs, auto)
 
   also have "... \<le> ((5/2) * c\<^sup>2 * 2 powr (-real r) /(real p)\<^sup>2) * (real (card (set as)))\<^sup>2"
     by (intro mult_left_mono) (auto simp add:power2_eq_square mult_left_mono)
 
   also have "... = (5/2) * (real (card (set as)))\<^sup>2 * c\<^sup>2 * 2 powr (-real r) /(real p)\<^sup>2"
     by (simp add:algebra_simps)
 
   finally have f:"prob {\<omega>. ?l \<omega> \<and> degree \<omega> \<ge> 1} \<le> ?r1" by simp
 
   have "prob {\<omega>. ?l \<omega>} \<le> prob {\<omega>. ?l \<omega> \<and> degree \<omega> \<ge> 1} + prob {\<omega>. degree \<omega> < 1}"
     by (rule pmf_add[OF M_def], auto)
   also have "... \<le> ?r1 + ?r2"
     by (intro add_mono f prob_degree_lt_1)
   finally show ?thesis by simp
 qed
 
 private lemma of_bool_square: "(of_bool x)\<^sup>2 = ((of_bool x)::real)"
   by (cases x, auto)
 
 private definition Q where "Q y \<omega> = card {x \<in> set as. int (hash x \<omega>) < y}"
 
 private definition m where "m = card (set as)"
 
 private lemma
   assumes "a \<ge> 0"
   assumes "a \<le> int p"
   shows exp_Q: "expectation (\<lambda>\<omega>. real (Q a \<omega>)) = real m * (of_int a) / p"
   and var_Q: "variance (\<lambda>\<omega>. real (Q a \<omega>)) \<le> real m * (of_int a) / p"
 proof -
   have exp_single: "expectation (\<lambda>\<omega>. of_bool (int (hash x \<omega>) < a)) = real_of_int a /real p"
     if a:"x \<in> set as" for x
   proof -
     have x_le_p: "x < p" using a as_lt_p by simp
     have "expectation (\<lambda>\<omega>. of_bool (int (hash x \<omega>) < a)) = expectation (indicat_real {\<omega>. int (Frequency_Moment_0.hash p x \<omega>) < a})"
       by (intro arg_cong2[where f="integral\<^sup>L"] ext, simp_all)
     also have "... = prob {\<omega>. hash x \<omega> \<in> {k. int k < a}}"
       by (simp add:M_def)
     also have "... = card ({k. int k < a} \<inter> {..<p}) / real p"
       by (subst prob_range, simp_all add: x_le_p mod_ring_def)
     also have "... = card {..<nat a} / real p"
       using assms by (intro arg_cong2[where f="(/)"] arg_cong[where f="real"] arg_cong[where f="card"])
        (auto simp add:set_eq_iff)
     also have "... =  real_of_int a/real p"
       using assms by simp
     finally show "expectation (\<lambda>\<omega>. of_bool (int (hash x \<omega>) < a)) = real_of_int a /real p"
       by simp
   qed
 
   have "expectation(\<lambda>\<omega>. real (Q a \<omega>)) = expectation (\<lambda>\<omega>. (\<Sum>x \<in> set as. of_bool (int (hash x \<omega>) < a)))"
     by (simp add:Q_def Int_def)
   also have "... =  (\<Sum>x \<in> set as. expectation (\<lambda>\<omega>. of_bool (int (hash x \<omega>) < a)))"
     by (rule Bochner_Integration.integral_sum, simp)
   also have "... = (\<Sum> x \<in> set as. a /real p)"
     by (rule sum.cong, simp, subst exp_single, simp, simp)
   also have "... = real m *  real_of_int a / real p"
     by (simp add:m_def)
   finally show "expectation (\<lambda>\<omega>. real (Q a \<omega>)) = real m * real_of_int a / p" by simp
 
   have indep: "J \<subseteq> set as \<Longrightarrow> card J = 2 \<Longrightarrow> indep_vars (\<lambda>_. borel) (\<lambda>i x. of_bool (int (hash i x) < a)) J" for J
     using as_subset_p mod_ring_carr
     by (intro indep_vars_compose2[where Y="\<lambda>i x. of_bool (int x < a)" and M'="\<lambda>_. discrete"]
         k_wise_indep_vars_subset[OF k_wise_indep] finite_subset[OF _ finite_set]) auto
 
   have rv: "\<And>x. x \<in> set as \<Longrightarrow> random_variable borel (\<lambda>\<omega>. of_bool (int (hash x \<omega>) < a))"
      by (simp add:M_def)
 
   have "variance (\<lambda>\<omega>. real (Q a \<omega>)) = variance (\<lambda>\<omega>. (\<Sum>x \<in> set as. of_bool (int (hash x \<omega>) < a)))"
     by (simp add:Q_def Int_def)
   also have "... = (\<Sum>x \<in> set as. variance (\<lambda>\<omega>. of_bool (int (hash x \<omega>) < a)))"
     by (intro bienaymes_identity_pairwise_indep_2 indep rv) auto
   also have "... \<le> (\<Sum> x \<in> set as. a / real p)"
     by (rule sum_mono, simp add: variance_eq of_bool_square, simp add: exp_single)
   also have "... = real m * real_of_int a /real p"
     by (simp add:m_def)
   finally show "variance (\<lambda>\<omega>. real (Q a \<omega>)) \<le> real m * real_of_int a / p"
     by simp
 qed
 
 private lemma t_bound: "t \<le> 81 / (real_of_rat \<delta>)\<^sup>2"
 proof -
   have "t \<le> 80 / (real_of_rat \<delta>)\<^sup>2 + 1" using t_def t_gt_0 by linarith
   also have "... \<le> 80 / (real_of_rat \<delta>)\<^sup>2 + 1 /  (real_of_rat \<delta>)\<^sup>2"
     using \<delta>_range by (intro add_mono, simp, simp add:power_le_one)
   also have "... = 81 / (real_of_rat \<delta>)\<^sup>2" by simp
   finally show ?thesis by simp
 qed
 
 private lemma t_r_bound:
   "18 * 40 * (real t)\<^sup>2 * 2 powr (-real r) \<le> 1"
 proof -
   have "720 * (real t)\<^sup>2 * 2 powr (-real r) \<le> 720 * (81 / (real_of_rat \<delta>)\<^sup>2)\<^sup>2 * 2 powr (-4 * log 2 (1 / real_of_rat \<delta>) - 23)"
     using r_bound t_bound by (intro mult_left_mono mult_mono power_mono powr_mono, auto)
 
   also have "... \<le> 720 * (81 / (real_of_rat \<delta>)\<^sup>2)\<^sup>2 * (2 powr (-4 * log 2 (1 / real_of_rat \<delta>)) * 2 powr (-23))"
     using \<delta>_range by (intro mult_left_mono mult_mono power_mono add_mono)
      (simp_all add:power_le_one powr_diff)
 
   also have "... = 720 * (81\<^sup>2 / (real_of_rat \<delta>)^4) * (2 powr (log 2 ((real_of_rat \<delta>)^4))  * 2 powr (-23))"
     using \<delta>_range by (intro arg_cong2[where f="(*)"])
       (simp_all add:power2_eq_square power4_eq_xxxx log_divide log_powr[symmetric])
 
   also have "... = 720 * 81\<^sup>2 * 2 powr (-23)" using \<delta>_range by simp
 
   also have "... \<le> 1" by simp
 
   finally show ?thesis by simp
 qed
 
 private lemma m_eq_F_0: "real m = of_rat (F 0 as)"
   by (simp add:m_def F_def)
 
 private lemma estimate'_bounds:
   "prob {\<omega>. of_rat \<delta> * real_of_rat (F 0 as) < \<bar>estimate' (sketch_rv' \<omega>) - of_rat (F 0 as)\<bar>} \<le> 1/3"
 proof (cases "card (set as) \<ge> t")
   case True
   define \<delta>' where "\<delta>' = 3 * real_of_rat \<delta> / 4"
   define u where "u = \<lceil>real t * p / (m * (1+\<delta>'))\<rceil>"
   define v where "v = \<lfloor>real t * p / (m * (1-\<delta>'))\<rfloor>"
 
   define has_no_collision where
     "has_no_collision = (\<lambda>\<omega>. \<forall>x\<in> set as. \<forall>y \<in> set as. (tr_hash x \<omega> = tr_hash y \<omega> \<longrightarrow> x = y) \<or> tr_hash x \<omega> > v)"
 
   have "2 powr (-real r) \<le> 2 powr (-(4 * log 2 (1 / real_of_rat \<delta>) + 23))"
     using r_bound by (intro powr_mono, linarith, simp)
   also have "... = 2 powr (-4 * log 2 (1 /real_of_rat \<delta>) -23)"
     by (rule arg_cong2[where f="(powr)"], auto simp add:algebra_simps)
   also have "... \<le> 2 powr ( -1 * log 2 (1 /real_of_rat \<delta>) -4)"
     using \<delta>_range by (intro powr_mono diff_mono, auto)
   also have "... = 2 powr ( -1 * log 2 (1 /real_of_rat \<delta>)) /  16"
     by (simp add: powr_diff)
   also have "... = real_of_rat \<delta> / 16"
     using \<delta>_range by (simp add:log_divide)
   also have "... < real_of_rat \<delta> / 8"
     using \<delta>_range by (subst pos_divide_less_eq, auto)
   finally have r_le_\<delta>: "2 powr (-real r) < real_of_rat \<delta> / 8"
     by simp
 
   have \<delta>'_gt_0: "\<delta>' > 0" using \<delta>_range by (simp add:\<delta>'_def)
   have "\<delta>' < 3/4" using \<delta>_range by (simp add:\<delta>'_def)+
   also have "... < 1" by simp
   finally have \<delta>'_lt_1: "\<delta>' < 1" by simp
 
   have "t \<le> 81 / (real_of_rat \<delta>)\<^sup>2"
     using t_bound by simp
   also have "... = (81*9/16) / (\<delta>')\<^sup>2"
     by (simp add:\<delta>'_def power2_eq_square)
   also have "... \<le> 46 / \<delta>'\<^sup>2"
     by (intro divide_right_mono, simp, simp)
   finally have t_le_\<delta>': "t \<le> 46/ \<delta>'\<^sup>2" by simp
 
   have "80 \<le> (real_of_rat \<delta>)\<^sup>2 * (80 / (real_of_rat \<delta>)\<^sup>2)" using \<delta>_range by simp
   also have "... \<le> (real_of_rat \<delta>)\<^sup>2 * t"
     by (intro mult_left_mono, simp add:t_def of_nat_ceiling, simp)
   finally have "80 \<le> (real_of_rat \<delta>)\<^sup>2 * t" by simp
   hence t_ge_\<delta>': "45 \<le> t * \<delta>' * \<delta>'" by (simp add:\<delta>'_def power2_eq_square)
 
   have "m \<le> card {..<n}" unfolding m_def using as_range by (intro card_mono, auto)
   also have "... \<le> p" using n_le_p by simp
   finally have m_le_p: "m \<le> p" by simp
 
   hence t_le_m: "t \<le> card (set as)" using True by simp
   have m_ge_0: "real m > 0" using m_def True t_gt_0 by simp
 
   have "v \<le> real t * real p / (real m * (1 - \<delta>'))" by (simp add:v_def)
 
   also have "... \<le> real t * real p / (real m * (1/4))"
     using \<delta>'_lt_1 m_ge_0 \<delta>_range
     by (intro divide_left_mono mult_left_mono mult_nonneg_nonneg mult_pos_pos, simp_all add:\<delta>'_def)
 
   finally have v_ubound: "v \<le> 4 * real t * real p / real m" by (simp add:algebra_simps)
 
   have a_ge_1: "u \<ge> 1" using \<delta>'_gt_0 p_gt_0 m_ge_0 t_gt_0
     by (auto intro!:mult_pos_pos divide_pos_pos simp add:u_def)
   hence a_ge_0: "u \<ge> 0" by simp
   have "real m * (1 - \<delta>') < real m" using \<delta>'_gt_0 m_ge_0 by simp
   also have "... \<le> 1 * real p" using m_le_p by simp
   also have "... \<le> real t * real p" using t_gt_0 by (intro mult_right_mono, auto)
   finally have " real m * (1 - \<delta>') < real t * real p" by simp
   hence v_gt_0: "v > 0" using mult_pos_pos m_ge_0 \<delta>'_lt_1 by (simp add:v_def)
   hence v_ge_1: "real_of_int v \<ge> 1" by linarith
 
   have "real t \<le> real m" using True m_def by linarith
   also have "... < (1 + \<delta>') * real m" using \<delta>'_gt_0 m_ge_0 by force
   finally have a_le_p_aux: "real t < (1 + \<delta>') * real m"  by simp
 
   have "u \<le> real t * real p / (real m * (1 + \<delta>'))+1" by (simp add:u_def)
   also have "... < real p + 1"
     using m_ge_0 \<delta>'_gt_0 a_le_p_aux  a_le_p_aux p_gt_0
     by (simp add: pos_divide_less_eq ac_simps)
   finally have "u \<le> real p"
     by (metis int_less_real_le not_less of_int_le_iff of_int_of_nat_eq)
   hence u_le_p: "u \<le> int p" by linarith
 
   have "prob {\<omega>. Q u \<omega> \<ge> t} \<le> prob {\<omega> \<in> Sigma_Algebra.space M. abs (real (Q u \<omega>) -
     expectation (\<lambda>\<omega>. real (Q u \<omega>))) \<ge> 3 * sqrt (m * real_of_int u / p)}"
   proof (rule pmf_mono[OF M_def])
     fix \<omega>
     assume "\<omega> \<in> {\<omega>. t \<le> Q u \<omega>}"
     hence t_le: "t \<le> Q u \<omega>" by simp
     have "real m * real_of_int u / real p \<le> real m * (real t * real p / (real m * (1 + \<delta>'))+1) / real p"
       using m_ge_0 p_gt_0 by (intro divide_right_mono mult_left_mono, simp_all add: u_def)
     also have "... = real m * real t * real p / (real m * (1+\<delta>') * real p) + real m / real p"
       by (simp add:distrib_left add_divide_distrib)
     also have "... = real t / (1+\<delta>') + real m / real p"
       using p_gt_0 m_ge_0 by simp
     also have "... \<le> real t / (1+\<delta>') + 1"
       using m_le_p p_gt_0 by (intro add_mono, auto)
     finally have "real m * real_of_int u / real p \<le> real t / (1 + \<delta>') + 1"
       by simp
 
     hence "3 * sqrt (real m * of_int u / real p) + real m * of_int u / real p \<le>
       3 * sqrt (t / (1+\<delta>')+1)+(t/(1+\<delta>')+1)"
       by (intro add_mono mult_left_mono real_sqrt_le_mono, auto)
     also have "... \<le> 3 * sqrt (real t+1) + ((t * (1 - \<delta>' / (1+\<delta>'))) + 1)"
       using \<delta>'_gt_0 t_gt_0 by (intro add_mono mult_left_mono real_sqrt_le_mono)
         (simp_all add: pos_divide_le_eq left_diff_distrib)
     also have "... = 3 * sqrt (real t+1) + (t - \<delta>' * t / (1+\<delta>')) + 1" by (simp add:algebra_simps)
     also have "... \<le> 3 * sqrt (46 / \<delta>'\<^sup>2 + 1 / \<delta>'\<^sup>2) + (t - \<delta>' * t/2) + 1 / \<delta>'"
       using \<delta>'_gt_0 t_gt_0 \<delta>'_lt_1 add_pos_pos  t_le_\<delta>'
       by (intro add_mono mult_left_mono real_sqrt_le_mono add_mono)
        (simp_all add: power_le_one pos_le_divide_eq)
     also have "... \<le> (21 / \<delta>' + (t - 45 / (2*\<delta>'))) + 1 / \<delta>'"
       using \<delta>'_gt_0 t_ge_\<delta>' by (intro add_mono)
          (simp_all add:real_sqrt_divide divide_le_cancel real_le_lsqrt pos_divide_le_eq ac_simps)
     also have "... \<le> t" using \<delta>'_gt_0 by simp
     also have "... \<le> Q u \<omega>" using t_le by simp
     finally have "3 * sqrt (real m * of_int u / real p) + real m * of_int u / real p \<le> Q u \<omega>"
       by simp
     hence " 3 * sqrt (real m * real_of_int u / real p) \<le> \<bar>real (Q u \<omega>) - expectation (\<lambda>\<omega>. real (Q u \<omega>))\<bar>"
       using a_ge_0 u_le_p  True by (simp add:exp_Q abs_ge_iff)
 
     thus "\<omega> \<in> {\<omega> \<in> Sigma_Algebra.space M. 3 * sqrt (real m * real_of_int u / real p) \<le>
       \<bar>real (Q u \<omega>) - expectation (\<lambda>\<omega>. real (Q u \<omega>))\<bar>}"
       by (simp add: M_def)
   qed
   also have "... \<le> variance  (\<lambda>\<omega>. real (Q u \<omega>)) / (3 * sqrt (real m * of_int u / real p))\<^sup>2"
     using a_ge_1 p_gt_0 m_ge_0
     by (intro Chebyshev_inequality, simp add:M_def, auto)
 
   also have "... \<le> (real m * real_of_int u / real p) / (3 * sqrt (real m * of_int u / real p))\<^sup>2"
     using a_ge_0 u_le_p by (intro divide_right_mono var_Q, auto)
 
   also have "... \<le> 1/9" using a_ge_0 by simp
 
   finally have case_1: "prob {\<omega>. Q u \<omega> \<ge> t} \<le> 1/9" by simp
 
   have case_2: "prob {\<omega>. Q v \<omega> < t} \<le> 1/9"
   proof (cases "v \<le> p")
     case True
     have "prob {\<omega>. Q v \<omega> < t} \<le> prob {\<omega> \<in> Sigma_Algebra.space M. abs (real (Q v \<omega>) - expectation (\<lambda>\<omega>. real (Q v \<omega>)))
       \<ge> 3 * sqrt (m * real_of_int v / p)}"
     proof (rule pmf_mono[OF M_def])
       fix \<omega>
       assume "\<omega> \<in> set_pmf (pmf_of_set space)"
       have "(real t + 3 * sqrt (real t / (1 - \<delta>') )) * (1 - \<delta>') = real t - \<delta>' * t + 3 * ((1-\<delta>') * sqrt( real t / (1-\<delta>') ))"
         by (simp add:algebra_simps)
 
       also have "... = real t - \<delta>' * t + 3 * sqrt (  (1-\<delta>')\<^sup>2 * (real t /  (1-\<delta>')))"
         using \<delta>'_lt_1 by (subst real_sqrt_mult, simp)
 
       also have "... = real t - \<delta>' * t + 3 * sqrt ( real t * (1- \<delta>'))"
         by (simp add:power2_eq_square distrib_left)
 
       also have "... \<le> real t - 45/ \<delta>' + 3 * sqrt ( real t )"
         using \<delta>'_gt_0 t_ge_\<delta>' \<delta>'_lt_1 by (intro add_mono mult_left_mono real_sqrt_le_mono)
          (simp_all add:pos_divide_le_eq ac_simps left_diff_distrib power_le_one)
 
        also have "... \<le> real t - 45/ \<delta>' + 3 * sqrt ( 46 / \<delta>'\<^sup>2)"
          using  t_le_\<delta>' \<delta>'_lt_1 \<delta>'_gt_0
          by (intro add_mono mult_left_mono real_sqrt_le_mono, simp_all add:pos_divide_le_eq power_le_one)
 
       also have "... = real t + (3 * sqrt(46) - 45)/ \<delta>'"
         using \<delta>'_gt_0 by (simp add:real_sqrt_divide diff_divide_distrib)
 
       also have "... \<le> t"
         using \<delta>'_gt_0 by (simp add:pos_divide_le_eq real_le_lsqrt)
 
       finally have aux: "(real t + 3 * sqrt (real t / (1 - \<delta>'))) * (1 - \<delta>') \<le> real t "
         by simp
 
       assume "\<omega> \<in> {\<omega>. Q v \<omega> < t}"
       hence "Q v \<omega> < t" by simp
 
       hence "real (Q v \<omega>) + 3 * sqrt (real m * real_of_int v / real p)
         \<le> real t - 1 + 3 * sqrt (real m * real_of_int v / real p)"
         using m_le_p p_gt_0 by (intro add_mono, auto simp add: algebra_simps add_divide_distrib)
 
       also have "... \<le> (real t-1) + 3 * sqrt (real m * (real t * real p / (real m * (1- \<delta>'))) / real p)"
         by (intro add_mono mult_left_mono real_sqrt_le_mono divide_right_mono)
          (auto simp add:v_def)
 
       also have "... \<le> real t + 3 * sqrt(real t / (1-\<delta>')) - 1"
         using m_ge_0 p_gt_0 by simp
 
       also have "... \<le> real t / (1-\<delta>')-1"
         using \<delta>'_lt_1 aux by (simp add: pos_le_divide_eq)
       also have "... \<le> real m * (real t * real p / (real m * (1-\<delta>'))) / real p - 1"
         using p_gt_0 m_ge_0 by simp
       also have "... \<le> real m * (real t * real p / (real m * (1-\<delta>'))) / real p - real m / real p"
           using m_le_p p_gt_0
           by (intro diff_mono, auto)
       also have "... = real m * (real t * real p / (real m * (1-\<delta>'))-1) / real p"
           by (simp add: left_diff_distrib right_diff_distrib diff_divide_distrib)
       also have "... \<le>  real m * real_of_int v / real p"
         by (intro divide_right_mono mult_left_mono, simp_all add:v_def)
 
       finally have "real (Q v \<omega>) + 3 * sqrt (real m * real_of_int v / real p)
         \<le> real m * real_of_int v / real p" by simp
 
       hence " 3 * sqrt (real m * real_of_int v / real p) \<le> \<bar>real (Q v \<omega>) -expectation (\<lambda>\<omega>. real (Q v \<omega>))\<bar>"
         using v_gt_0 True by (simp add: exp_Q abs_ge_iff)
 
       thus "\<omega> \<in> {\<omega>\<in> Sigma_Algebra.space M. 3 * sqrt (real m * real_of_int v / real p) \<le>
         \<bar>real (Q v \<omega>) - expectation (\<lambda>\<omega>. real (Q v \<omega>))\<bar>}"
         by (simp add:M_def)
     qed
     also have "... \<le> variance (\<lambda>\<omega>. real (Q v \<omega>)) / (3 * sqrt (real m * real_of_int v / real p))\<^sup>2"
       using v_gt_0 p_gt_0 m_ge_0
       by (intro Chebyshev_inequality, simp add:M_def, auto)
 
     also have "... \<le> (real m * real_of_int v / real p) / (3 * sqrt (real m * real_of_int v / real p))\<^sup>2"
       using  v_gt_0 True  by (intro divide_right_mono var_Q, auto)
 
     also have "... = 1/9"
       using p_gt_0 v_gt_0 m_ge_0 by (simp add:power2_eq_square)
 
     finally show ?thesis by simp
   next
     case False
     have "prob {\<omega>. Q v \<omega> < t} \<le> prob {\<omega>. False}"
     proof (rule pmf_mono[OF M_def])
       fix \<omega>
       assume a:"\<omega> \<in> {\<omega>. Q v \<omega> < t}"
       assume "\<omega> \<in> set_pmf (pmf_of_set space)"
       hence b:"\<And>x. x < p \<Longrightarrow> hash x \<omega> < p"
         using hash_range mod_ring_carr by (simp add:M_def measure_pmf_inverse)
       have "t \<le> card (set as)" using True by simp
       also have "... \<le> Q v \<omega>"
         unfolding Q_def  using b False as_lt_p by (intro card_mono subsetI, simp, force)
       also have "... < t" using a by simp
       finally have "False" by auto
       thus "\<omega> \<in> {\<omega>. False}" by simp
     qed
     also have "... = 0" by auto
     finally show ?thesis by simp
   qed
 
   have "prob {\<omega>. \<not>has_no_collision \<omega>} \<le>
     prob {\<omega>. \<exists>x \<in> set as. \<exists>y \<in> set as. x \<noteq> y \<and> tr_hash x \<omega> \<le> real_of_int v \<and> tr_hash x \<omega> = tr_hash y \<omega>}"
     by (rule pmf_mono[OF M_def]) (simp add:has_no_collision_def M_def, force)
 
   also have "... \<le> (5/2) * (real (card (set as)))\<^sup>2 * (real_of_int v)\<^sup>2 * 2 powr - real r / (real p)\<^sup>2 + 1 / real p"
     using collision_prob v_ge_1 by blast
 
   also have "... \<le> (5/2) * (real m)\<^sup>2 * (real_of_int v)\<^sup>2 * 2 powr - real r / (real p)\<^sup>2 + 1 / real p"
     by (intro divide_right_mono add_mono mult_right_mono mult_mono power_mono, simp_all add:m_def)
 
   also have "... \<le> (5/2) * (real m)\<^sup>2 * (4 * real t * real p / real m)\<^sup>2 * (2 powr - real r) / (real p)\<^sup>2 + 1 / real p"
     using v_def v_ge_1 v_ubound
     by (intro add_mono divide_right_mono  mult_right_mono  mult_left_mono, auto)
 
   also have "... = 40 * (real t)\<^sup>2 * (2 powr -real r) + 1 / real p"
     using p_gt_0 m_ge_0 t_gt_0 by (simp add:algebra_simps power2_eq_square)
 
   also have "... \<le> 1/18 + 1/18"
     using t_r_bound p_ge_18 by (intro add_mono, simp_all add: pos_le_divide_eq)
 
   also have "... = 1/9" by simp
 
   finally have case_3: "prob {\<omega>. \<not>has_no_collision \<omega>} \<le> 1/9" by simp
 
   have "prob {\<omega>. real_of_rat \<delta> * of_rat (F 0 as) < \<bar>estimate' (sketch_rv' \<omega>) - of_rat (F 0 as)\<bar>} \<le>
     prob {\<omega>. Q u \<omega> \<ge> t \<or> Q v \<omega> < t \<or> \<not>(has_no_collision \<omega>)}"
   proof (rule pmf_mono[OF M_def], rule ccontr)
     fix \<omega>
     assume "\<omega> \<in> set_pmf (pmf_of_set space)"
     assume "\<omega> \<in> {\<omega>. real_of_rat \<delta> * real_of_rat (F 0 as) < \<bar>estimate' (sketch_rv' \<omega>) - real_of_rat (F 0 as)\<bar>}"
     hence est: "real_of_rat \<delta> * real_of_rat (F 0 as) < \<bar>estimate' (sketch_rv' \<omega>) - real_of_rat (F 0 as)\<bar>" by simp
     assume "\<omega> \<notin> {\<omega>. t \<le> Q u \<omega> \<or> Q v \<omega> < t \<or> \<not> has_no_collision \<omega>}"
     hence "\<not>( t \<le> Q u \<omega> \<or> Q v \<omega> < t \<or> \<not> has_no_collision \<omega>)" by simp
     hence lb: "Q u \<omega> < t" and ub: "Q v \<omega> \<ge> t" and no_col: "has_no_collision \<omega>" by simp+
 
     define y where "y =  nth_mset (t-1) {#int (hash x \<omega>). x \<in># mset_set (set as)#}"
     define y' where "y' = nth_mset (t-1) {#tr_hash x \<omega>. x \<in># mset_set (set as)#}"
 
     have rank_t_lb: "u \<le> y"
       unfolding y_def using True t_gt_0 lb
       by (intro nth_mset_bound_left, simp_all add:count_less_def swap_filter_image Q_def)
 
     have rank_t_ub: "y \<le> v - 1"
       unfolding y_def using True t_gt_0 ub
       by (intro nth_mset_bound_right, simp_all add:Q_def swap_filter_image count_le_def)
 
     have y_ge_0: "real_of_int y \<ge> 0" using rank_t_lb a_ge_0 by linarith
 
     have "mono (\<lambda>x. truncate_down r (real_of_int x))"
       by (metis truncate_down_mono mono_def of_int_le_iff)
     hence y'_eq: "y' = truncate_down r y"
       unfolding y_def y'_def  using True t_gt_0
       by (subst nth_mset_commute_mono[where f="(\<lambda>x. truncate_down r (of_int x))"])
         (simp_all add: multiset.map_comp comp_def tr_hash_def)
 
     have "real_of_int u * (1 - 2 powr -real r) \<le> real_of_int y * (1 - 2 powr (-real r))"
       using rank_t_lb of_int_le_iff two_pow_r_le_1
       by (intro mult_right_mono, auto)
     also have "... \<le> y'"
       using y'_eq truncate_down_pos[OF y_ge_0] by simp
     finally have rank_t_lb': "u * (1 - 2 powr -real r) \<le> y'" by simp
 
     have "y' \<le> real_of_int y"
       by (subst y'_eq, rule truncate_down_le, simp)
     also have "... \<le> real_of_int (v-1)"
       using rank_t_ub of_int_le_iff by blast
     finally have rank_t_ub': "y' \<le> v-1"
       by simp
 
     have "0 < u * (1-2 powr -real r)"
       using a_ge_1 two_pow_r_le_1 by (intro mult_pos_pos, auto)
     hence y'_pos: "y' > 0" using rank_t_lb' by linarith
 
     have no_col': "\<And>x. x \<le> y' \<Longrightarrow> count {#tr_hash x \<omega>. x \<in># mset_set (set as)#} x \<le> 1"
       using  rank_t_ub' no_col
       by (simp add:vimage_def card_le_Suc0_iff_eq count_image_mset has_no_collision_def) force
 
     have h_1: "Max (sketch_rv' \<omega>) = y'"
       using True t_gt_0 no_col'
       by (simp add:sketch_rv'_def y'_def nth_mset_max)
 
     have "card (sketch_rv' \<omega>) = card (least ((t-1)+1) (set_mset {#tr_hash x \<omega>. x \<in># mset_set (set as)#}))"
       using t_gt_0 by (simp add:sketch_rv'_def)
     also have "... = (t-1) +1"
       using True t_gt_0 no_col' by (intro nth_mset_max(2), simp_all add:y'_def)
     also have "... = t" using t_gt_0 by simp
     finally have "card (sketch_rv' \<omega>) = t" by simp
     hence h_3: "estimate' (sketch_rv' \<omega>) = real t * real p / y'"
       using h_1 by (simp add:estimate'_def)
 
     have "(real t) * real p \<le>  (1 + \<delta>') * real m * ((real t) * real p / (real m * (1 + \<delta>')))"
       using \<delta>'_lt_1 m_def True t_gt_0 \<delta>'_gt_0 by auto
     also have "... \<le> (1+\<delta>') * m * u"
       using \<delta>'_gt_0 by (intro mult_left_mono, simp_all add:u_def)
     also have "... < ((1 + real_of_rat \<delta>)*(1-real_of_rat \<delta>/8)) * m * u"
       using True m_def t_gt_0 a_ge_1 \<delta>_range
       by (intro mult_strict_right_mono, auto simp add:\<delta>'_def right_diff_distrib)
     also have "... \<le> ((1 + real_of_rat \<delta>)*(1-2 powr (-r))) * m * u"
       using r_le_\<delta> \<delta>_range a_ge_0 by (intro mult_right_mono mult_left_mono, auto)
     also have "... = (1 + real_of_rat \<delta>) * m * (u * (1-2 powr -real r))"
       by simp
     also have "... \<le> (1 + real_of_rat \<delta>) * m * y'"
       using \<delta>_range by (intro mult_left_mono rank_t_lb', simp)
     finally have "real t * real p < (1 + real_of_rat \<delta>) * m * y'" by simp
     hence f_1: "estimate' (sketch_rv' \<omega>) < (1 + real_of_rat \<delta>) * m"
       using y'_pos by (simp add: h_3 pos_divide_less_eq)
 
     have "(1 - real_of_rat \<delta>) * m * y' \<le> (1 - real_of_rat \<delta>) * m * v"
       using \<delta>_range rank_t_ub' y'_pos by (intro mult_mono rank_t_ub', simp_all)
     also have "... = (1-real_of_rat \<delta>) * (real m * v)"
       by simp
     also have "... < (1-\<delta>') * (real m * v)"
       using \<delta>_range m_ge_0 v_ge_1
       by (intro mult_strict_right_mono mult_pos_pos, simp_all add:\<delta>'_def)
     also have "... \<le> (1-\<delta>') * (real m * (real t * real p / (real m * (1-\<delta>'))))"
       using \<delta>'_gt_0 \<delta>'_lt_1 by (intro mult_left_mono, auto simp add:v_def)
     also have "... = real t * real p"
       using \<delta>'_gt_0 \<delta>'_lt_1 t_gt_0 p_gt_0 m_ge_0 by auto
     finally have "(1 - real_of_rat \<delta>) * m * y' < real t * real p" by simp
     hence f_2: "estimate' (sketch_rv' \<omega>) > (1 - real_of_rat \<delta>) * m"
       using y'_pos by (simp add: h_3 pos_less_divide_eq)
 
     have "abs (estimate' (sketch_rv' \<omega>) - real_of_rat (F 0 as)) < real_of_rat \<delta> * (real_of_rat (F 0 as))"
       using f_1 f_2 by (simp add:abs_less_iff algebra_simps m_eq_F_0)
     thus "False" using est by linarith
   qed
   also have "... \<le> 1/9 + (1/9 + 1/9)"
     by (intro pmf_add_2[OF M_def] case_1 case_2 case_3)
   also have "... = 1/3" by simp
   finally show ?thesis by simp
 next
   case False
   have "prob {\<omega>. real_of_rat \<delta> * of_rat (F 0 as) < \<bar>estimate' (sketch_rv' \<omega>) - of_rat (F 0 as)\<bar>} \<le>
     prob {\<omega>. \<exists>x \<in> set as. \<exists>y \<in> set as. x \<noteq> y \<and> tr_hash x \<omega> \<le> real p \<and> tr_hash x \<omega> = tr_hash y \<omega>}"
   proof (rule pmf_mono[OF M_def])
     fix \<omega>
     assume a:"\<omega> \<in> {\<omega>. real_of_rat \<delta> * real_of_rat (F 0 as) < \<bar>estimate' (sketch_rv' \<omega>) - real_of_rat (F 0 as)\<bar>}"
     assume b:"\<omega> \<in> set_pmf (pmf_of_set space)"
     have c: "card (set as) < t" using False by auto
     hence "card ((\<lambda>x. tr_hash x \<omega>) ` set as) < t"
       using card_image_le order_le_less_trans by blast
     hence d:"card (sketch_rv' \<omega>) = card ((\<lambda>x. tr_hash x \<omega>) ` (set as))"
       by (simp add:sketch_rv'_def card_least)
     have "card (sketch_rv' \<omega>) < t"
       by (metis List.finite_set  c d card_image_le  order_le_less_trans)
     hence "estimate' (sketch_rv' \<omega>) = card (sketch_rv' \<omega>)" by (simp add:estimate'_def)
     hence "card (sketch_rv' \<omega>) \<noteq> real_of_rat (F 0 as)"
       using a \<delta>_range by simp
         (metis abs_zero cancel_comm_monoid_add_class.diff_cancel of_nat_less_0_iff pos_prod_lt zero_less_of_rat_iff)
     hence "card (sketch_rv' \<omega>) \<noteq> card (set as)"
       using m_def m_eq_F_0 by linarith
     hence "\<not>inj_on (\<lambda>x. tr_hash x \<omega>) (set as)"
       using card_image d by auto
     moreover have "tr_hash x \<omega> \<le> real p" if a:"x \<in> set as" for x
     proof -
       have "hash x \<omega> < p"
         using hash_range as_lt_p a b by (simp add:mod_ring_carr M_def)
       thus "tr_hash x \<omega> \<le> real p" using truncate_down_le by (simp add:tr_hash_def)
     qed
    ultimately show "\<omega> \<in> {\<omega>. \<exists>x \<in> set as. \<exists>y \<in> set as. x \<noteq> y \<and> tr_hash x \<omega> \<le> real p \<and> tr_hash x \<omega> = tr_hash y \<omega>}"
      by (simp add:inj_on_def, blast)
   qed
   also have "... \<le> (5/2) * (real (card (set as)))\<^sup>2 * (real p)\<^sup>2 * 2 powr - real r / (real p)\<^sup>2 + 1 / real p"
     using p_gt_0 by (intro collision_prob, auto)
   also have "... = (5/2) * (real (card (set as)))\<^sup>2 * 2 powr (- real r) + 1 / real p"
     using p_gt_0 by (simp add:ac_simps power2_eq_square)
   also have "... \<le> (5/2) * (real t)\<^sup>2 * 2 powr (-real r) + 1 / real p"
     using False by (intro add_mono mult_right_mono mult_left_mono power_mono, auto)
   also have "... \<le> 1/6 + 1/6"
     using t_r_bound p_ge_18 by (intro add_mono, simp_all)
   also have "... \<le> 1/3" by simp
   finally show ?thesis by simp
 qed
 
 private lemma median_bounds:
   "\<P>(\<omega> in measure_pmf \<Omega>\<^sub>0. \<bar>median s (\<lambda>i. estimate (sketch_rv (\<omega> i))) - F 0 as\<bar> \<le> \<delta> * F 0 as) \<ge> 1 - real_of_rat \<epsilon>"
 proof -
   have "strict_mono_on A real_of_float" for A by (meson less_float.rep_eq strict_mono_onI)
   hence real_g_2: "\<And>\<omega>.  sketch_rv' \<omega> = real_of_float ` sketch_rv \<omega>"
     by (simp add: sketch_rv'_def sketch_rv_def tr_hash_def least_mono_commute image_comp)
 
   moreover have "inj_on real_of_float A" for A
     using  real_of_float_inject by (simp add:inj_on_def)
   ultimately have card_eq: "\<And>\<omega>. card (sketch_rv \<omega>) = card (sketch_rv' \<omega>)"
     using real_g_2 by (auto intro!: card_image[symmetric])
 
   have "Max (sketch_rv' \<omega>) = real_of_float (Max (sketch_rv \<omega>))" if a:"card (sketch_rv' \<omega>) \<ge> t" for \<omega>
   proof -
     have "mono real_of_float"
       using less_eq_float.rep_eq mono_def by blast
     moreover have "finite (sketch_rv \<omega>)"
       by (simp add:sketch_rv_def least_def)
     moreover have " sketch_rv \<omega> \<noteq> {}"
       using card_eq[symmetric] card_gt_0_iff t_gt_0 a by (simp, force)
     ultimately show ?thesis
       by (subst mono_Max_commute[where f="real_of_float"], simp_all add:real_g_2)
   qed
   hence real_g: "\<And>\<omega>. estimate' (sketch_rv' \<omega>) = real_of_rat (estimate (sketch_rv \<omega>))"
     by (simp add:estimate_def estimate'_def card_eq of_rat_divide of_rat_mult of_rat_add real_of_rat_of_float)
 
   have indep: "prob_space.indep_vars (measure_pmf \<Omega>\<^sub>0) (\<lambda>_. borel) (\<lambda>i \<omega>. estimate' (sketch_rv' (\<omega> i))) {0..<s}"
     unfolding \<Omega>\<^sub>0_def
     by (rule indep_vars_restrict_intro', auto simp add:restrict_dfl_def lessThan_atLeast0)
 
   moreover have "- (18 * ln (real_of_rat \<epsilon>)) \<le> real s"
     using of_nat_ceiling by (simp add:s_def) blast
 
   moreover have "i < s \<Longrightarrow> measure \<Omega>\<^sub>0 {\<omega>. of_rat \<delta> * of_rat (F 0 as) < \<bar>estimate' (sketch_rv' (\<omega> i)) - of_rat (F 0 as)\<bar>} \<le> 1/3"
     for i
     using estimate'_bounds unfolding \<Omega>\<^sub>0_def M_def
     by (subst prob_prod_pmf_slice, simp_all)
 
   ultimately have "1-real_of_rat \<epsilon> \<le> \<P>(\<omega> in measure_pmf \<Omega>\<^sub>0.
       \<bar>median s (\<lambda>i. estimate' (sketch_rv' (\<omega> i))) - real_of_rat (F 0 as)\<bar> \<le>  real_of_rat \<delta> * real_of_rat (F 0 as))"
     using \<epsilon>_range prob_space_measure_pmf
     by (intro prob_space.median_bound_2) auto
   also have "... = \<P>(\<omega> in measure_pmf \<Omega>\<^sub>0.
       \<bar>median s (\<lambda>i. estimate (sketch_rv (\<omega> i))) - F 0 as\<bar> \<le>  \<delta> * F 0 as)"
     using s_gt_0 median_rat[symmetric] real_g by (intro arg_cong2[where f="measure"])
       (simp_all add:of_rat_diff[symmetric] of_rat_mult[symmetric] of_rat_less_eq)
   finally show "\<P>(\<omega> in measure_pmf \<Omega>\<^sub>0. \<bar>median s (\<lambda>i. estimate (sketch_rv (\<omega> i))) - F 0 as\<bar> \<le> \<delta> * F 0 as) \<ge> 1-real_of_rat \<epsilon>"
     by blast
 qed
 
 lemma f0_alg_correct':
   "\<P>(\<omega> in measure_pmf result. \<bar>\<omega> - F 0 as\<bar> \<le> \<delta> * F 0 as) \<ge> 1 - of_rat \<epsilon>"
 proof -
   have f0_result_elim: "\<And>x. f0_result (s, t, p, r, x, \<lambda>i\<in>{..<s}. sketch_rv (x i)) =
     return_pmf (median s (\<lambda>i. estimate (sketch_rv (x i))))"
     by (simp add:estimate_def, rule median_cong, simp)
 
   have "result = map_pmf (\<lambda>x. (s, t, p, r, x, \<lambda>i\<in>{..<s}. sketch_rv (x i))) \<Omega>\<^sub>0 \<bind> f0_result"
     by (subst result_def, subst f0_alg_sketch, simp)
   also have "... = \<Omega>\<^sub>0 \<bind> (\<lambda>x. return_pmf (s, t, p, r, x, \<lambda>i\<in>{..<s}. sketch_rv (x i))) \<bind> f0_result"
     by (simp add:t_def p_def r_def s_def map_pmf_def)
   also have "... = \<Omega>\<^sub>0 \<bind> (\<lambda>x. return_pmf (median s (\<lambda>i. estimate (sketch_rv (x i)))))"
     by (subst bind_assoc_pmf, subst bind_return_pmf, subst f0_result_elim)  simp
   finally have a:"result =  \<Omega>\<^sub>0 \<bind> (\<lambda>x. return_pmf (median s (\<lambda>i. estimate (sketch_rv (x i)))))"
     by simp
 
   show ?thesis
     using median_bounds by (simp add: a map_pmf_def[symmetric])
 qed
 
 private lemma f_subset:
   assumes "g ` A \<subseteq> h ` B"
   shows "(\<lambda>x. f (g x)) ` A \<subseteq> (\<lambda>x. f (h x)) ` B"
   using assms by auto
 
 lemma f0_exact_space_usage':
   defines "\<Omega> \<equiv> fold (\<lambda>a state. state \<bind> f0_update a) as (f0_init \<delta> \<epsilon> n)"
   shows "AE \<omega> in \<Omega>. bit_count (encode_f0_state \<omega>) \<le> f0_space_usage (n, \<epsilon>, \<delta>)"
 proof -
 
   have log_2_4: "log 2 4 = 2"
     by (metis log2_of_power_eq mult_2 numeral_Bit0 of_nat_numeral power2_eq_square)
 
   have a: "bit_count (F\<^sub>e (float_of (truncate_down r y))) \<le>
     ereal (12 + 4 * real r + 2 * log 2 (log 2 (n+13)))" if a_1:"y \<in> {..<p}" for y
   proof (cases "y \<ge> 1")
     case True
 
     have aux_1: " 0 < 2 + log 2 (real y)"
       using True by (intro add_pos_nonneg, auto)
     have aux_2: "0 < 2 + log 2 (real p)"
       using p_gt_1 by (intro add_pos_nonneg, auto)
 
     have "bit_count (F\<^sub>e (float_of (truncate_down r y))) \<le>
       ereal (10 + 4 * real r + 2 * log 2 (2 + \<bar>log 2 \<bar>real y\<bar>\<bar>))"
       by (rule truncate_float_bit_count)
     also have "... = ereal (10 + 4 * real r + 2 * log 2 (2 + (log 2 (real y))))"
       using True by simp
     also have "... \<le> ereal (10 + 4 * real r + 2 * log 2 (2 + log 2 p))"
       using aux_1 aux_2 True p_gt_0 a_1 by simp
     also have "... \<le> ereal (10 + 4 * real r + 2 * log 2 (log 2 4 + log 2 (2 * n + 40)))"
       using log_2_4 p_le_n p_gt_0
-      by (intro ereal_mono add_mono mult_left_mono log_mono of_nat_mono add_pos_nonneg, auto)
+      by (simp add: Transcendental.log_mono aux_2)
     also have "... = ereal (10 + 4 * real r + 2 * log 2 (log 2 (8 * n + 160)))"
       by (simp add:log_mult[symmetric])
     also have "... \<le> ereal (10 + 4 * real r + 2 * log 2 (log 2 ((n+13) powr 2)))"
-      by (intro ereal_mono add_mono mult_left_mono log_mono of_nat_mono add_pos_nonneg)
+      by (intro ereal_mono add_mono mult_left_mono Transcendental.log_mono of_nat_mono add_pos_nonneg)
        (auto simp add:power2_eq_square algebra_simps)
     also have "... = ereal (10 +  4 * real r + 2 * log 2 (log 2 4 * log 2 (n + 13)))"
       by (subst log_powr, simp_all add:log_2_4)
     also have "... = ereal (12 +  4 * real r + 2 * log 2 (log 2 (n + 13)))"
       by (subst log_mult, simp_all add:log_2_4)
     finally show ?thesis by simp
   next
     case False
     hence "y = 0" using a_1 by simp
     then show ?thesis by (simp add:float_bit_count_zero)
   qed
 
   have "bit_count (encode_f0_state (s, t, p, r, x, \<lambda>i\<in>{..<s}. sketch_rv (x i))) \<le>
         f0_space_usage (n, \<epsilon>, \<delta>)" if b: "x \<in> {..<s} \<rightarrow>\<^sub>E space" for x
   proof -
     have c: "x \<in> extensional {..<s}" using b by (simp add:PiE_def)
 
     have d: "sketch_rv (x y) \<subseteq> (\<lambda>k. float_of (truncate_down r k)) ` {..<p} "
       if d_1: "y < s" for y
     proof -
       have "sketch_rv (x y) \<subseteq> (\<lambda>xa. float_of (truncate_down r (hash xa (x y)))) ` set as"
         using least_subset by (auto simp add:sketch_rv_def tr_hash_def)
       also have "... \<subseteq> (\<lambda>k. float_of (truncate_down r (real k))) ` {..<p}"
         using b hash_range as_lt_p d_1
         by (intro f_subset[where f="\<lambda>x. float_of (truncate_down r (real x))"] image_subsetI)
          (simp add: PiE_iff mod_ring_carr)
       finally show ?thesis
         by simp
     qed
 
     have "\<And>y. y < s \<Longrightarrow> finite (sketch_rv (x y))"
       unfolding sketch_rv_def by (rule finite_subset[OF least_subset], simp)
     moreover have card_sketch: "\<And>y. y < s \<Longrightarrow> card (sketch_rv (x y)) \<le> t "
       by (simp add:sketch_rv_def card_least)
     moreover have "\<And>y z. y < s \<Longrightarrow> z \<in> sketch_rv (x y) \<Longrightarrow>
       bit_count (F\<^sub>e z) \<le> ereal (12 + 4 * real r + 2 * log 2 (log 2 (real n + 13)))"
       using a d by auto
     ultimately have e: "\<And>y. y < s \<Longrightarrow> bit_count (S\<^sub>e F\<^sub>e (sketch_rv (x y)))
       \<le> ereal (real t) * (ereal (12 + 4 * real r + 2 * log 2 (log 2 (real (n + 13)))) + 1) + 1"
       using float_encoding by (intro set_bit_count_est, auto)
 
     have f: "\<And>y. y < s \<Longrightarrow> bit_count (P\<^sub>e p 2 (x y)) \<le> ereal (real 2 * (log 2 (real p) + 1))"
       using p_gt_1 b
       by (intro bounded_degree_polynomial_bit_count) (simp_all add:space_def PiE_def Pi_def)
 
     have "bit_count (encode_f0_state (s, t, p, r, x, \<lambda>i\<in>{..<s}. sketch_rv (x i))) =
       bit_count (N\<^sub>e s) + bit_count (N\<^sub>e t) +  bit_count (N\<^sub>e p) + bit_count (N\<^sub>e r) +
       bit_count (([0..<s] \<rightarrow>\<^sub>e P\<^sub>e p 2) x) +
       bit_count (([0..<s] \<rightarrow>\<^sub>e S\<^sub>e F\<^sub>e) (\<lambda>i\<in>{..<s}. sketch_rv (x i)))"
       by (simp add:encode_f0_state_def dependent_bit_count lessThan_atLeast0
         s_def[symmetric] t_def[symmetric] p_def[symmetric] r_def[symmetric] ac_simps)
     also have "... \<le> ereal (2* log 2 (real s + 1) + 1) + ereal  (2* log 2 (real t + 1) + 1)
       + ereal (2* log 2 (real p + 1) + 1) + ereal (2 * log 2 (real r + 1) + 1)
       + (ereal (real s) * (ereal (real 2 * (log 2 (real p) + 1))))
       + (ereal (real s) * ((ereal (real t) *
             (ereal (12 + 4 * real r + 2 * log 2 (log 2 (real (n + 13)))) + 1) + 1)))"
       using c e f
       by (intro add_mono exp_golomb_bit_count fun_bit_count_est[where xs="[0..<s]", simplified])
        (simp_all add:lessThan_atLeast0)
     also have "... = ereal ( 4 + 2 * log 2 (real s + 1) + 2 * log 2 (real t + 1) +
       2 * log 2 (real p + 1) + 2 * log 2 (real r + 1) + real s * (3 + 2 * log 2 (real p) +
       real t * (13 + (4 * real r + 2 * log 2 (log 2 (real n + 13))))))"
       by (simp add:algebra_simps)
     also have "... \<le> ereal ( 4 + 2 * log 2 (real s + 1)  + 2 * log 2 (real t + 1) +
       2 * log 2 (2 * (21 + real n)) + 2 * log 2 (real r + 1) + real s * (3 + 2 * log 2 (2 * (21 + real n)) +
       real t * (13 + (4 * real r + 2 * log 2 (log 2 (real n + 13))))))"
       using p_le_n p_gt_0
       by (intro ereal_mono add_mono mult_left_mono, auto)
     also have "... =  ereal (6 + 2 * log 2 (real s + 1) + 2 * log 2 (real t + 1) +
       2 * log 2 (21 + real n) + 2 * log 2 (real r + 1) + real s * (5 + 2 * log 2 (21 + real n) +
       real t * (13 + (4 * real r + 2 * log 2 (log 2 (real n + 13))))))"
       by (subst (1 2) log_mult, auto)
     also have "... \<le> f0_space_usage (n, \<epsilon>, \<delta>)"
       by (simp add:s_def[symmetric] r_def[symmetric] t_def[symmetric] Let_def)
        (simp add:algebra_simps)
     finally show "bit_count (encode_f0_state (s, t, p, r, x, \<lambda>i\<in>{..<s}. sketch_rv (x i))) \<le>
         f0_space_usage (n, \<epsilon>, \<delta>)" by simp
   qed
   hence "\<And>x. x \<in> set_pmf \<Omega>\<^sub>0 \<Longrightarrow>
          bit_count (encode_f0_state (s, t, p, r, x, \<lambda>i\<in>{..<s}. sketch_rv (x i)))  \<le> ereal (f0_space_usage (n, \<epsilon>, \<delta>))"
     by (simp add:\<Omega>\<^sub>0_def set_prod_pmf del:f0_space_usage.simps)
   hence "\<And>y. y \<in> set_pmf \<Omega> \<Longrightarrow> bit_count (encode_f0_state y) \<le> ereal (f0_space_usage (n, \<epsilon>, \<delta>))"
     by (simp add: \<Omega>_def f0_alg_sketch del:f0_space_usage.simps f0_init.simps)
      (metis (no_types, lifting) image_iff pmf.set_map)
   thus ?thesis
     by (simp add: AE_measure_pmf_iff del:f0_space_usage.simps)
 qed
 
 end
 
 text \<open>Main results of this section:\<close>
 
 theorem f0_alg_correct:
   assumes "\<epsilon> \<in> {0<..<1}"
   assumes "\<delta> \<in> {0<..<1}"
   assumes "set as \<subseteq> {..<n}"
   defines "\<Omega> \<equiv> fold (\<lambda>a state. state \<bind> f0_update a) as (f0_init \<delta> \<epsilon> n) \<bind> f0_result"
   shows "\<P>(\<omega> in measure_pmf \<Omega>. \<bar>\<omega> - F 0 as\<bar> \<le> \<delta> * F 0 as) \<ge> 1 - of_rat \<epsilon>"
   using f0_alg_correct'[OF assms(1-3)] unfolding \<Omega>_def by blast
 
 theorem f0_exact_space_usage:
   assumes "\<epsilon> \<in> {0<..<1}"
   assumes "\<delta> \<in> {0<..<1}"
   assumes "set as \<subseteq> {..<n}"
   defines "\<Omega> \<equiv> fold (\<lambda>a state. state \<bind> f0_update a) as (f0_init \<delta> \<epsilon> n)"
   shows "AE \<omega> in \<Omega>. bit_count (encode_f0_state \<omega>) \<le> f0_space_usage (n, \<epsilon>, \<delta>)"
   using f0_exact_space_usage'[OF assms(1-3)] unfolding \<Omega>_def by blast
 
 theorem f0_asymptotic_space_complexity:
   "f0_space_usage \<in> O[at_top \<times>\<^sub>F at_right 0 \<times>\<^sub>F at_right 0](\<lambda>(n, \<epsilon>, \<delta>). ln (1 / of_rat \<epsilon>) *
   (ln (real n) + 1 / (of_rat \<delta>)\<^sup>2 * (ln (ln (real n)) + ln (1 / of_rat \<delta>))))"
   (is "_ \<in> O[?F](?rhs)")
 proof -
   define n_of :: "nat \<times> rat \<times> rat \<Rightarrow> nat" where "n_of = (\<lambda>(n, \<epsilon>, \<delta>). n)"
   define \<epsilon>_of :: "nat \<times> rat \<times> rat \<Rightarrow> rat" where "\<epsilon>_of = (\<lambda>(n, \<epsilon>, \<delta>). \<epsilon>)"
   define \<delta>_of :: "nat \<times> rat \<times> rat \<Rightarrow> rat" where "\<delta>_of = (\<lambda>(n, \<epsilon>, \<delta>). \<delta>)"
   define t_of where "t_of = (\<lambda>x. nat \<lceil>80 / (real_of_rat (\<delta>_of x))\<^sup>2\<rceil>)"
   define s_of where "s_of = (\<lambda>x. nat \<lceil>-(18 * ln (real_of_rat (\<epsilon>_of x)))\<rceil>)"
   define r_of where "r_of = (\<lambda>x. nat (4 * \<lceil>log 2 (1 / real_of_rat (\<delta>_of x))\<rceil> + 23))"
 
   define g where "g = (\<lambda>x. ln (1 / of_rat (\<epsilon>_of x)) * (ln (real (n_of x)) +
     1 / (of_rat (\<delta>_of x))\<^sup>2 * (ln (ln (real (n_of x))) + ln (1 / of_rat (\<delta>_of x)))))"
 
   have evt: "(\<And>x.
     0 < real_of_rat (\<delta>_of x) \<and> 0 < real_of_rat (\<epsilon>_of x) \<and>
     1/real_of_rat (\<delta>_of x) \<ge> \<delta> \<and> 1/real_of_rat (\<epsilon>_of x) \<ge> \<epsilon> \<and>
     real (n_of x) \<ge> n \<Longrightarrow> P x) \<Longrightarrow> eventually P ?F"  (is "(\<And>x. ?prem x \<Longrightarrow> _) \<Longrightarrow> _")
     for \<delta> \<epsilon> n P
     apply (rule eventually_mono[where P="?prem" and Q="P"])
     apply (simp add:\<epsilon>_of_def case_prod_beta' \<delta>_of_def n_of_def)
      apply (intro eventually_conj eventually_prod1' eventually_prod2'
         sequentially_inf eventually_at_right_less inv_at_right_0_inf)
     by (auto simp add:prod_filter_eq_bot)
 
   have exp_pos: "exp k \<le> real x \<Longrightarrow> x > 0" for k x
     using exp_gt_zero gr0I by force
 
   have exp_gt_1: "exp 1 \<ge> (1::real)"
     by simp
 
   have 1: "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<epsilon>_of x)))"
     by (auto intro!:landau_o.big_mono evt[where \<epsilon>="exp 1"] iffD2[OF ln_ge_iff] simp add:abs_ge_iff)
 
   have 2: "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<delta>_of x)))"
     by (auto intro!:landau_o.big_mono evt[where \<delta>="exp 1"] iffD2[OF ln_ge_iff] simp add:abs_ge_iff)
 
   have 3: " (\<lambda>x. 1) \<in> O[?F](\<lambda>x. ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x)))"
     using exp_pos
     by (intro landau_sum_2 2 evt[where n="exp 1" and \<delta>="1"] ln_ge_zero  iffD2[OF ln_ge_iff], auto)
   have 4: "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. 1 / (real_of_rat (\<delta>_of x))\<^sup>2)"
     using one_le_power
     by (intro landau_o.big_mono evt[where \<delta>="1"], auto simp add:power_one_over[symmetric])
 
   have "(\<lambda>x. 80 * (1 / (real_of_rat (\<delta>_of x))\<^sup>2)) \<in> O[?F](\<lambda>x. 1 / (real_of_rat (\<delta>_of x))\<^sup>2)"
     by (subst landau_o.big.cmult_in_iff, auto)
   hence 5: "(\<lambda>x. real (t_of x)) \<in> O[?F](\<lambda>x. 1 / (real_of_rat (\<delta>_of x))\<^sup>2)"
     unfolding  t_of_def
     by (intro landau_real_nat landau_ceil 4, auto)
 
   have "(\<lambda>x. ln (real_of_rat (\<epsilon>_of x))) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<epsilon>_of x)))"
     by (intro landau_o.big_mono evt[where \<epsilon>="1"], auto simp add:ln_div)
   hence 6: "(\<lambda>x. real (s_of x)) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<epsilon>_of x)))"
     unfolding s_of_def by (intro landau_nat_ceil 1, simp)
 
   have 7: " (\<lambda>x. 1) \<in> O[?F](\<lambda>x. ln (real (n_of x)))"
     using exp_pos by (auto intro!: landau_o.big_mono evt[where n="exp 1"] iffD2[OF ln_ge_iff] simp: abs_ge_iff)
 
   have 8:" (\<lambda>_. 1) \<in>
     O[?F](\<lambda>x. ln (real (n_of x)) + 1 / (real_of_rat (\<delta>_of x))\<^sup>2 * (ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x))))"
     using order_trans[OF exp_gt_1] exp_pos
     by (intro landau_sum_1 7 evt[where n="exp 1" and \<delta>="1"] ln_ge_zero  iffD2[OF ln_ge_iff]
         mult_nonneg_nonneg add_nonneg_nonneg) auto
 
   have "(\<lambda>x. ln (real (s_of x) + 1)) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<epsilon>_of x)))"
     by (intro landau_ln_3 sum_in_bigo 6 1, simp)
 
   hence 9: "(\<lambda>x. log 2 (real (s_of x) + 1)) \<in> O[?F](g)"
     unfolding g_def by (intro landau_o.big_mult_1 8, auto simp:log_def)
   have 10: "(\<lambda>x. 1) \<in> O[?F](g)"
     unfolding g_def by (intro landau_o.big_mult_1 8 1)
 
   have "(\<lambda>x. ln (real (t_of x) + 1)) \<in>
     O[?F](\<lambda>x. 1 / (real_of_rat (\<delta>_of x))\<^sup>2 * (ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x))))"
     using 5 by (intro landau_o.big_mult_1 3 landau_ln_3 sum_in_bigo 4, simp_all)
   hence " (\<lambda>x. log 2 (real (t_of x) + 1)) \<in>
   O[?F](\<lambda>x. ln (real (n_of x)) + 1 / (real_of_rat (\<delta>_of x))\<^sup>2 * (ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x))))"
     using order_trans[OF exp_gt_1] exp_pos
     by (intro landau_sum_2  evt[where n="exp 1" and \<delta>="1"] ln_ge_zero  iffD2[OF ln_ge_iff]
         mult_nonneg_nonneg add_nonneg_nonneg) (auto simp add:log_def)
   hence 11: "(\<lambda>x. log 2 (real (t_of x) + 1)) \<in> O[?F](g)"
     unfolding g_def  by (intro landau_o.big_mult_1' 1, auto)
   have " (\<lambda>x. 1) \<in> O[?F](\<lambda>x. real (n_of x))"
     by (intro landau_o.big_mono evt[where n="1"], auto)
   hence "(\<lambda>x. ln (real (n_of x) + 21)) \<in> O[?F](\<lambda>x. ln (real (n_of x)))"
     by (intro landau_ln_2[where a="2"] evt[where n="2"] sum_in_bigo, auto)
 
   hence 12: "(\<lambda>x. log 2 (real (n_of x) + 21)) \<in> O[?F](g)"
     unfolding g_def using exp_pos order_trans[OF exp_gt_1]
     by (intro landau_o.big_mult_1' 1 landau_sum_1  evt[where n="exp 1" and \<delta>="1"]
         ln_ge_zero  iffD2[OF ln_ge_iff] mult_nonneg_nonneg add_nonneg_nonneg)  (auto simp add:log_def)
 
   have "(\<lambda>x. ln (1 / real_of_rat (\<delta>_of x))) \<in> O[?F](\<lambda>x. 1 / (real_of_rat (\<delta>_of x))\<^sup>2)"
     by (intro landau_ln_3 evt[where \<delta>="1"] landau_o.big_mono)
       (auto simp add:power_one_over[symmetric] self_le_power)
   hence " (\<lambda>x. real (nat (4*\<lceil>log 2 (1 / real_of_rat (\<delta>_of x))\<rceil>+23))) \<in> O[?F](\<lambda>x. 1 / (real_of_rat (\<delta>_of x))\<^sup>2)"
     using 4 by (auto intro!: landau_real_nat sum_in_bigo landau_ceil simp:log_def)
   hence " (\<lambda>x. ln (real (r_of x) + 1)) \<in> O[?F](\<lambda>x. 1 / (real_of_rat (\<delta>_of x))\<^sup>2)"
     unfolding r_of_def
     by (intro landau_ln_3 sum_in_bigo 4, auto)
   hence " (\<lambda>x. log 2 (real (r_of x) + 1)) \<in>
     O[?F](\<lambda>x. (1 / (real_of_rat (\<delta>_of x))\<^sup>2) * (ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x))))"
     by (intro landau_o.big_mult_1 3, simp add:log_def)
   hence " (\<lambda>x. log 2 (real (r_of x) + 1)) \<in>
     O[?F](\<lambda>x. ln (real (n_of x)) + 1 / (real_of_rat (\<delta>_of x))\<^sup>2 * (ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x))))"
     using exp_pos order_trans[OF exp_gt_1]
     by (intro landau_sum_2 evt[where n="exp 1" and \<delta>="1"] ln_ge_zero
         iffD2[OF ln_ge_iff] add_nonneg_nonneg mult_nonneg_nonneg) (auto)
   hence 13: "(\<lambda>x. log 2 (real (r_of x) + 1)) \<in> O[?F](g)"
     unfolding g_def  by (intro landau_o.big_mult_1' 1, auto)
   have 14: "(\<lambda>x. 1) \<in> O[?F](\<lambda>x. real (n_of x))"
     by (intro landau_o.big_mono evt[where n="1"], auto)
 
   have "(\<lambda>x. ln (real (n_of x) + 13)) \<in> O[?F](\<lambda>x. ln (real (n_of x)))"
     using 14 by (intro landau_ln_2[where a="2"]  evt[where n="2"] sum_in_bigo, auto)
 
   hence "(\<lambda>x. ln (log 2 (real (n_of x) + 13))) \<in> O[?F](\<lambda>x. ln (ln (real (n_of x))))"
     using exp_pos by (intro landau_ln_2[where a="2"] iffD2[OF ln_ge_iff] evt[where n="exp 2"])
         (auto simp add:log_def)
 
   hence "(\<lambda>x. log 2 (log 2 (real (n_of x) + 13))) \<in> O[?F](\<lambda>x. ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x)))"
     using exp_pos by (intro landau_sum_1 evt[where n="exp 1" and \<delta>="1"] ln_ge_zero  iffD2[OF ln_ge_iff])
      (auto simp add:log_def)
 
   moreover have  "(\<lambda>x. real (r_of x)) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<delta>_of x)))"
     unfolding r_of_def using 2
     by (auto intro!: landau_real_nat sum_in_bigo landau_ceil simp:log_def)
   hence "(\<lambda>x. real (r_of x)) \<in> O[?F](\<lambda>x. ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x)))"
     using exp_pos
     by (intro landau_sum_2 evt[where n="exp 1" and \<delta>="1"] ln_ge_zero  iffD2[OF ln_ge_iff], auto)
 
   ultimately have 15:" (\<lambda>x. real (t_of x) * (13 + 4 * real (r_of x) + 2 * log 2 (log 2 (real (n_of x) + 13))))
       \<in> O[?F](\<lambda>x. 1 / (real_of_rat (\<delta>_of x))\<^sup>2 * (ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x))))"
     using 5 3
     by (intro landau_o.mult sum_in_bigo, auto)
 
   have "(\<lambda>x. 5 + 2 * log 2 (21 + real (n_of x)) + real (t_of x) * (13 + 4 * real (r_of x) + 2 * log 2 (log 2 (real (n_of x) + 13))))
       \<in> O[?F](\<lambda>x. ln (real (n_of x)) + 1 / (real_of_rat (\<delta>_of x))\<^sup>2 * (ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x))))"
   proof -
     have "\<forall>\<^sub>F x in ?F. 0 \<le> ln (real (n_of x))"
       by (intro evt[where n="1"] ln_ge_zero, auto)
     moreover have "\<forall>\<^sub>F x in ?F. 0 \<le> 1 / (real_of_rat (\<delta>_of x))\<^sup>2 * (ln (ln (real (n_of x))) + ln (1 / real_of_rat (\<delta>_of x)))"
       using exp_pos
       by (intro evt[where n="exp 1" and \<delta>="1"] mult_nonneg_nonneg add_nonneg_nonneg
           ln_ge_zero iffD2[OF ln_ge_iff]) auto
     moreover have " (\<lambda>x. ln (21 + real (n_of x))) \<in> O[?F](\<lambda>x. ln (real (n_of x)))"
       using 14 by (intro landau_ln_2[where a="2"] sum_in_bigo evt[where n="2"], auto)
     hence "(\<lambda>x. 5 + 2 * log 2 (21 + real (n_of x))) \<in> O[?F](\<lambda>x. ln (real (n_of x)))"
       using 7  by (intro sum_in_bigo, auto simp add:log_def)
     ultimately show ?thesis
       using 15 by (rule landau_sum)
   qed
 
   hence 16: "(\<lambda>x. real (s_of x) * (5 + 2 * log 2 (21 + real (n_of x)) + real (t_of x) *
     (13 + 4 * real (r_of x) + 2 * log 2 (log 2 (real (n_of x) + 13)))))  \<in> O[?F](g)"
     unfolding g_def
     by (intro landau_o.mult 6, auto)
 
   have "f0_space_usage = (\<lambda>x. f0_space_usage (n_of x, \<epsilon>_of x, \<delta>_of x))"
     by (simp add:case_prod_beta' n_of_def \<epsilon>_of_def \<delta>_of_def)
   also have "... \<in>  O[?F](g)"
     using 9 10 11 12 13 16
     by (simp add:fun_cong[OF s_of_def[symmetric]] fun_cong[OF t_of_def[symmetric]]
         fun_cong[OF r_of_def[symmetric]] Let_def) (intro sum_in_bigo, auto)
   also have "... = O[?F](?rhs)"
     by (simp add:case_prod_beta' g_def n_of_def \<epsilon>_of_def \<delta>_of_def)
   finally show ?thesis
     by simp
 qed
 
 end
diff --git a/thys/Frequency_Moments/Frequency_Moments_Preliminary_Results.thy b/thys/Frequency_Moments/Frequency_Moments_Preliminary_Results.thy
--- a/thys/Frequency_Moments/Frequency_Moments_Preliminary_Results.thy
+++ b/thys/Frequency_Moments/Frequency_Moments_Preliminary_Results.thy
@@ -1,464 +1,461 @@
 section \<open>Preliminary Results\<close>
 
 theory Frequency_Moments_Preliminary_Results
   imports
     "HOL.Transcendental"
     "HOL-Computational_Algebra.Primes"
     "HOL-Library.Extended_Real"
     "HOL-Library.Multiset"
     "HOL-Library.Sublist"
     Prefix_Free_Code_Combinators.Prefix_Free_Code_Combinators
     Bertrands_Postulate.Bertrand
     Expander_Graphs.Expander_Graphs_Multiset_Extras
 begin
 
 text \<open>This section contains various preliminary results.\<close>
 
 lemma card_ordered_pairs:
   fixes M :: "('a ::linorder) set"
   assumes "finite M"
   shows "2 * card {(x,y) \<in> M \<times> M. x < y} = card M * (card M - 1)"
 proof -
   have a: "finite (M \<times> M)" using assms by simp
 
   have inj_swap: "inj (\<lambda>x. (snd x, fst x))"
     by (rule inj_onI, simp add: prod_eq_iff)
 
   have "2 * card {(x,y) \<in> M \<times> M. x < y} =
     card {(x,y) \<in> M \<times> M. x < y} + card ((\<lambda>x. (snd x, fst x))`{(x,y) \<in> M \<times> M. x < y})"
     by (simp add: card_image[OF inj_on_subset[OF inj_swap]])
   also have "... = card {(x,y) \<in> M \<times> M. x < y} + card {(x,y) \<in> M \<times> M. y < x}"
     by (auto intro: arg_cong[where f="card"] simp add:set_eq_iff image_iff)
   also have "... = card ({(x,y) \<in> M \<times> M. x < y} \<union> {(x,y) \<in> M \<times> M. y < x})"
     by (intro card_Un_disjoint[symmetric] a finite_subset[where B="M \<times> M"] subsetI) auto
   also have "... = card ((M \<times> M) - {(x,y) \<in> M \<times> M. x = y})"
     by (auto intro: arg_cong[where f="card"] simp add:set_eq_iff)
   also have "... = card (M \<times> M) - card {(x,y) \<in> M \<times> M. x = y}"
     by (intro card_Diff_subset a finite_subset[where B="M \<times> M"] subsetI) auto
   also have "... = card M ^ 2 - card ((\<lambda>x. (x,x)) ` M)"
     using assms
     by (intro arg_cong2[where f="(-)"] arg_cong[where f="card"])
       (auto simp:power2_eq_square set_eq_iff image_iff)
   also have "... = card M ^ 2 - card M"
     by (intro arg_cong2[where f="(-)"] card_image inj_onI, auto)
   also have "... = card M * (card M - 1)"
     by (cases "card M \<ge> 0", auto simp:power2_eq_square algebra_simps)
   finally show ?thesis by simp
 qed
 
 lemma ereal_mono: "x \<le> y \<Longrightarrow> ereal x \<le> ereal y"
   by simp
 
-lemma log_mono: "a > 1 \<Longrightarrow> x \<le> y \<Longrightarrow> 0 < x \<Longrightarrow> log a x \<le> log a y"
-  by (subst log_le_cancel_iff, auto)
-
 lemma abs_ge_iff: "((x::real) \<le> abs y) = (x \<le> y \<or> x \<le> -y)"
   by linarith
 
 lemma count_list_gr_1:
   "(x \<in> set xs) = (count_list xs x \<ge> 1)"
   by (induction xs, simp, simp)
 
 lemma count_list_append: "count_list (xs@ys) v = count_list xs v + count_list ys v"
   by (induction xs, simp, simp)
 
 lemma count_list_lt_suffix:
   assumes "suffix a b"
   assumes "x \<in> {b ! i| i. i <  length b - length a}"
   shows  "count_list a x < count_list b x"
 proof -
   have "length a \<le> length b" using assms(1)
     by (simp add: suffix_length_le)
   hence "x \<in> set (nths b {i. i < length b - length a})"
     using assms diff_commute by (auto simp add:set_nths)
   hence a:"x \<in> set (take (length b - length a) b)"
     by (subst (asm) lessThan_def[symmetric], simp)
   have "b = (take (length b - length a) b)@drop (length b - length a) b"
     by simp
   also have "... = (take (length b - length a) b)@a"
     using assms(1) suffix_take by auto
   finally have b:"b = (take (length b - length a) b)@a" by simp
 
   have "count_list a x < 1 + count_list a x" by simp
   also have "... \<le> count_list (take (length b - length a) b) x + count_list a x"
     using a count_list_gr_1
     by (intro add_mono, fast, simp)
   also have "... = count_list b x"
     using b count_list_append by metis
   finally show ?thesis by simp
 qed
 
 lemma suffix_drop_drop:
   assumes "x \<ge> y"
   shows "suffix (drop x a) (drop y a)"
 proof -
   have "drop y a = take (x - y) (drop y a)@drop (x- y) (drop y a)"
     by (subst append_take_drop_id, simp)
   also have " ... = take (x-y) (drop y a)@drop x a"
     using assms by simp
   finally have "drop y a = take (x-y) (drop y a)@drop x a" by simp
   thus ?thesis
     by (auto simp add:suffix_def)
 qed
 
 lemma count_list_card: "count_list xs x = card {k. k < length xs \<and> xs ! k = x}"
 proof -
   have "count_list xs x = length (filter ((=) x) xs)"
     by (induction xs, simp, simp)
   also have "... = card {k. k < length xs \<and> xs ! k = x}"
     by (subst length_filter_conv_card, metis)
   finally show ?thesis by simp
 qed
 
 lemma card_gr_1_iff:
   assumes "finite S"  "x \<in> S"  "y \<in> S"  "x \<noteq> y"
   shows "card S > 1"
   using assms card_le_Suc0_iff_eq leI by auto
 
 lemma count_list_ge_2_iff:
   assumes "y < z"
   assumes "z < length xs"
   assumes "xs ! y = xs ! z"
   shows "count_list xs (xs ! y) > 1"
 proof -
   have " 1 < card {k. k < length xs \<and> xs ! k = xs ! y}"
     using assms by (intro card_gr_1_iff[where x="y" and y="z"], auto)
 
   thus ?thesis
     by (simp add: count_list_card)
 qed
 
 text \<open>Results about multisets and sorting\<close>
 
 lemmas disj_induct_mset = disj_induct_mset
 
 lemma prod_mset_conv:
   fixes f :: "'a \<Rightarrow> 'b::{comm_monoid_mult}"
   shows "prod_mset (image_mset f A) = prod (\<lambda>x. f x^(count A x)) (set_mset A)"
 proof (induction A rule: disj_induct_mset)
   case 1
   then show ?case by simp
 next
   case (2 n M x)
   moreover have "count M x = 0" using 2 by (simp add: count_eq_zero_iff)
   moreover have "\<And>y. y \<in> set_mset M \<Longrightarrow> y \<noteq> x" using 2 by blast
   ultimately show ?case by (simp add:algebra_simps)
 qed
 
 text \<open>There is a version @{thm [source] sum_list_map_eq_sum_count} but it doesn't work
 if the function maps into the reals.\<close>
 
 lemma sum_list_eval:
   fixes f :: "'a \<Rightarrow> 'b::{ring,semiring_1}"
   shows "sum_list (map f xs) = (\<Sum>x \<in> set xs. of_nat (count_list xs x) * f x)"
 proof -
   define M where "M = mset xs"
   have "sum_mset (image_mset f M) = (\<Sum>x \<in> set_mset M. of_nat (count M x) * f x)"
   proof (induction "M" rule:disj_induct_mset)
     case 1
     then show ?case by simp
   next
     case (2 n M x)
     have a:"\<And>y. y \<in> set_mset M \<Longrightarrow> y \<noteq> x" using 2(2) by blast
     show ?case using 2 by (simp add:a  count_eq_zero_iff[symmetric])
   qed
   moreover have "\<And>x. count_list xs x = count (mset xs) x"
     by (induction xs, simp, simp)
   ultimately show ?thesis
     by (simp add:M_def sum_mset_sum_list[symmetric])
 qed
 
 lemma prod_list_eval:
   fixes f :: "'a \<Rightarrow> 'b::{ring,semiring_1,comm_monoid_mult}"
   shows "prod_list (map f xs) = (\<Prod>x \<in> set xs. (f x)^(count_list xs x))"
 proof -
   define M where "M = mset xs"
   have "prod_mset (image_mset f M) = (\<Prod>x \<in> set_mset M. f x ^ (count M x))"
   proof (induction "M" rule:disj_induct_mset)
     case 1
     then show ?case by simp
   next
     case (2 n M x)
     have a:"\<And>y. y \<in> set_mset M \<Longrightarrow> y \<noteq> x" using 2(2) by blast
     have b:"count M x = 0" using 2 by (subst  count_eq_zero_iff) blast
     show ?case using 2  by (simp add:a b mult.commute)
   qed
   moreover have "\<And>x. count_list xs x = count (mset xs) x"
     by (induction xs, simp, simp)
   ultimately show ?thesis
     by (simp add:M_def prod_mset_prod_list[symmetric])
 qed
 
 lemma sorted_sorted_list_of_multiset: "sorted (sorted_list_of_multiset M)"
   by (induction M, auto simp:sorted_insort)
 
 lemma count_mset: "count (mset xs) a = count_list xs a"
   by (induction xs, auto)
 
 lemma swap_filter_image: "filter_mset g (image_mset f A) = image_mset f (filter_mset (g \<circ> f) A)"
   by (induction A, auto)
 
 lemma list_eq_iff:
   assumes "mset xs = mset ys"
   assumes "sorted xs"
   assumes "sorted ys"
   shows "xs = ys"
   using assms properties_for_sort by blast
 
 lemma sorted_list_of_multiset_image_commute:
   assumes "mono f"
   shows "sorted_list_of_multiset (image_mset f M) = map f (sorted_list_of_multiset M)"
 proof -
   have "sorted (sorted_list_of_multiset (image_mset f M))"
     by (simp add:sorted_sorted_list_of_multiset)
   moreover have " sorted_wrt (\<lambda>x y. f x \<le> f y) (sorted_list_of_multiset M)"
     by (rule sorted_wrt_mono_rel[where P="\<lambda>x y. x \<le> y"])
       (auto intro: monoD[OF assms] sorted_sorted_list_of_multiset)
   hence "sorted (map f (sorted_list_of_multiset M))"
     by (subst sorted_wrt_map)
   ultimately show ?thesis
     by (intro list_eq_iff, auto)
 qed
 
 text \<open>Results about rounding and floating point numbers\<close>
 
 lemma round_down_ge:
   "x \<le> round_down prec x + 2 powr (-prec)"
   using round_down_correct by (simp, meson diff_diff_eq diff_eq_diff_less_eq)
 
 lemma truncate_down_ge:
   "x \<le> truncate_down prec x + abs x * 2 powr (-prec)"
 proof (cases "abs x > 0")
   case True
   have "x \<le> round_down (int prec - \<lfloor>log 2 \<bar>x\<bar>\<rfloor>) x + 2 powr (-real_of_int(int prec - \<lfloor>log 2 \<bar>x\<bar>\<rfloor>))"
     by (rule round_down_ge)
   also have "... \<le> truncate_down prec x + 2 powr ( \<lfloor>log 2 \<bar>x\<bar>\<rfloor>) * 2 powr (-real prec)"
     by (rule add_mono, simp_all add:powr_add[symmetric] truncate_down_def)
   also have "... \<le> truncate_down prec x + \<bar>x\<bar> * 2 powr (-real prec)"
     using True
     by (intro add_mono mult_right_mono, simp_all add:le_log_iff[symmetric])
   finally show ?thesis by simp
 next
   case False
   then show ?thesis by simp
 qed
 
 lemma truncate_down_pos:
   assumes "x \<ge> 0"
   shows "x * (1 - 2 powr (-prec)) \<le> truncate_down prec x"
   by (simp add:right_diff_distrib diff_le_eq)
    (metis truncate_down_ge assms  abs_of_nonneg)
 
 lemma truncate_down_eq:
   assumes "truncate_down r x = truncate_down r y"
   shows "abs (x-y) \<le> max (abs x) (abs y) * 2 powr (-real r)"
 proof -
   have "x - y \<le> truncate_down r x + abs x * 2 powr (-real r) - y"
     by (rule diff_right_mono, rule truncate_down_ge)
   also have "... \<le> y + abs x * 2 powr (-real r) - y"
     using truncate_down_le
     by (intro diff_right_mono add_mono, subst assms(1), simp_all)
   also have "... \<le> abs x * 2 powr (-real r)" by simp
   also have "... \<le> max (abs x) (abs y) * 2 powr (-real r)" by simp
   finally have a:"x - y \<le> max (abs x) (abs y) * 2 powr (-real r)" by simp
 
   have "y - x \<le> truncate_down r y + abs y * 2 powr (-real r) - x"
     by (rule diff_right_mono, rule truncate_down_ge)
   also have "... \<le> x + abs y * 2 powr (-real r) - x"
     using truncate_down_le
     by (intro diff_right_mono add_mono, subst assms(1)[symmetric], auto)
   also have "... \<le> abs y * 2 powr (-real r)" by simp
   also have "... \<le> max (abs x) (abs y) * 2 powr (-real r)" by simp
   finally have b:"y - x \<le> max (abs x) (abs y) * 2 powr (-real r)" by simp
 
   show ?thesis
     using abs_le_iff a b by linarith
 qed
 
 definition rat_of_float :: "float \<Rightarrow> rat" where
   "rat_of_float f = of_int (mantissa f) *
     (if exponent f \<ge> 0 then 2 ^ (nat (exponent f)) else 1 / 2 ^ (nat (-exponent f)))"
 
 lemma real_of_rat_of_float: "real_of_rat (rat_of_float x) = real_of_float x"
 proof -
   have "real_of_rat (rat_of_float x) = mantissa x * (2 powr (exponent x))"
     by (simp add:rat_of_float_def of_rat_mult of_rat_divide of_rat_power powr_realpow[symmetric] powr_minus_divide)
   also have "... = real_of_float x"
     using mantissa_exponent by simp
   finally show ?thesis by simp
 qed
 
 lemma log_est: "log 2 (real n + 1) \<le> n"
 proof -
   have "1 + real n = real (n + 1)"
     by simp
   also have "... \<le> real (2 ^ n)"
     by (intro of_nat_mono suc_n_le_2_pow_n)
   also have "... = 2 powr (real n)"
     by (simp add:powr_realpow)
   finally have "1 + real n \<le> 2 powr (real n)"
     by simp
   thus ?thesis
     by (simp add: Transcendental.log_le_iff)
 qed
 
 lemma truncate_mantissa_bound:
   "abs (\<lfloor>x * 2 powr (real r - real_of_int \<lfloor>log 2 \<bar>x\<bar>\<rfloor>)\<rfloor>) \<le> 2 ^ (r+1)" (is "?lhs \<le> _")
 proof -
   define q where "q = \<lfloor>x * 2 powr (real r - real_of_int (\<lfloor>log 2 \<bar>x\<bar>\<rfloor>))\<rfloor>"
 
   have "abs q \<le> 2 ^ (r + 1)" if a:"x > 0"
   proof -
     have "abs q = q"
       using a by (intro abs_of_nonneg, simp add:q_def)
     also have "... \<le> x * 2 powr (real r - real_of_int \<lfloor>log 2 \<bar>x\<bar>\<rfloor>)"
       unfolding q_def using of_int_floor_le by blast
     also have "... = x * 2 powr real_of_int (int r - \<lfloor>log 2 \<bar>x\<bar>\<rfloor>)"
       by auto
     also have "... = 2 powr (log 2 x + real_of_int (int r - \<lfloor>log 2 \<bar>x\<bar>\<rfloor>))"
       using a by (simp add:powr_add)
     also have "... \<le> 2 powr (real r + 1)"
       using a by (intro powr_mono, linarith+)
     also have "... = 2 ^ (r+1)"
       by (subst powr_realpow[symmetric], simp_all add:add.commute)
     finally show "abs q \<le> 2 ^ (r+1)"
       by (metis of_int_le_iff of_int_numeral of_int_power)
   qed
 
   moreover have "abs q \<le> (2 ^ (r + 1))" if a: "x < 0"
   proof -
     have "-(2 ^ (r+1) + 1) = -(2 powr (real r + 1)+1)"
       by (subst powr_realpow[symmetric], simp_all add: add.commute)
     also have  "... < -(2 powr (log 2 (- x) + (r - \<lfloor>log 2 \<bar>x\<bar>\<rfloor>)) + 1)"
       using a by (simp, linarith)
     also have "... = x * 2 powr (r - \<lfloor>log 2 \<bar>x\<bar>\<rfloor>) - 1"
       using a by (simp add:powr_add)
     also have "... \<le> q"
       by (simp add:q_def)
     also have "... = - abs q"
       using a
       by (subst abs_of_neg, simp_all add: mult_pos_neg2 q_def)
     finally have "-(2 ^ (r+1)+1) < - abs q" using of_int_less_iff by fastforce
     hence "-(2 ^ (r+1)) \<le> - abs q" by linarith
     thus "abs q \<le> 2^(r+1)" by linarith
   qed
 
   moreover have "x = 0 \<Longrightarrow> abs q \<le> 2^(r+1)"
     by (simp add:q_def)
   ultimately have "abs q \<le> 2^(r+1)"
     by fastforce
   thus ?thesis using q_def by blast
 qed
 
 lemma truncate_float_bit_count:
   "bit_count (F\<^sub>e (float_of (truncate_down r x))) \<le> 10 + 4 * real r + 2*log 2 (2 + \<bar>log 2 \<bar>x\<bar>\<bar>)"
   (is "?lhs \<le> ?rhs")
 proof -
   define m where "m = \<lfloor>x * 2 powr (real r - real_of_int \<lfloor>log 2 \<bar>x\<bar>\<rfloor>)\<rfloor>"
   define e where "e = \<lfloor>log 2 \<bar>x\<bar>\<rfloor> - int r"
 
   have a: "(real_of_int \<lfloor>log 2 \<bar>x\<bar>\<rfloor> - real r) = e"
     by (simp add:e_def)
   have "abs m + 2 \<le> 2 ^ (r + 1) + 2^1"
     using truncate_mantissa_bound
     by (intro add_mono, simp_all add:m_def)
   also have "... \<le> 2 ^ (r+2)"
     by simp
   finally have b:"abs m + 2 \<le> 2 ^ (r+2)" by simp
   hence "real_of_int (\<bar>m\<bar> + 2) \<le> real_of_int (4 * 2 ^ r)"
     by (subst of_int_le_iff, simp)
   hence "\<bar>real_of_int m\<bar> + 2 \<le> 4 * 2 ^ r"
     by simp
   hence c:"log 2 (real_of_int (\<bar>m\<bar> + 2)) \<le> r+2"
     by (simp add: Transcendental.log_le_iff powr_add powr_realpow)
 
   have "real_of_int (abs e + 1) \<le> real_of_int \<bar>\<lfloor>log 2 \<bar>x\<bar>\<rfloor>\<bar> +  real_of_int r + 1"
     by (simp add:e_def)
   also have "... \<le> 1 + abs (log 2 (abs x)) + real_of_int r + 1"
     by (simp add:abs_le_iff, linarith)
   also have "... \<le> (real_of_int r+ 1) * (2 + abs (log 2 (abs x)))"
     by (simp add:distrib_left distrib_right)
   finally have d:"real_of_int (abs e + 1) \<le> (real_of_int r+ 1) * (2 + abs (log 2 (abs x)))" by simp
 
   have "log 2 (real_of_int (abs e + 1)) \<le> log 2 (real_of_int r + 1) + log 2 (2 + abs (log 2 (abs x)))"
     using d by (simp add: log_mult[symmetric])
   also have "... \<le> r + log 2 (2 + abs (log 2 (abs x)))"
     using log_est by (intro add_mono, simp_all add:add.commute)
   finally have e: "log 2 (real_of_int (abs e + 1)) \<le> r + log 2 (2 + abs (log 2 (abs x)))" by simp
 
   have "?lhs =  bit_count (F\<^sub>e (float_of (real_of_int m * 2 powr real_of_int e)))"
     by (simp add:truncate_down_def round_down_def m_def[symmetric] a)
   also have "... \<le> ereal (6 + (2 * log 2 (real_of_int (\<bar>m\<bar> + 2)) + 2 * log 2 (real_of_int (\<bar>e\<bar> + 1))))"
     using float_bit_count_2 by simp
   also have "... \<le> ereal (6 + (2 * real (r+2) + 2 * (r + log 2 (2 + abs (log 2 (abs x))))))"
     using c e
     by (subst ereal_less_eq, intro add_mono mult_left_mono, linarith+)
   also have "... = ?rhs" by simp
   finally show ?thesis by simp
 qed
 
 definition prime_above :: "nat \<Rightarrow> nat"
   where "prime_above n = (SOME x. x \<in> {n..(2*n+2)} \<and> prime x)"
 
 text \<open>The term @{term"prime_above n"} returns a prime between @{term "n::nat"} and @{term "2*(n::nat)+2"}.
 Because of Bertrand's postulate there always is such a value. In a refinement of the algorithms, it may make sense to
 replace this with an algorithm, that finds such a prime exactly or approximately.
 
 The definition is intentionally inexact, to allow refinement with various algorithms, without modifying the
 high-level mathematical correctness proof.\<close>
 
 lemma ex_subset:
   assumes "\<exists>x \<in> A. P x"
   assumes "A \<subseteq> B"
   shows "\<exists>x \<in> B. P x"
   using assms by auto
 
 lemma
   shows prime_above_prime: "prime (prime_above n)"
   and prime_above_range: "prime_above n \<in> {n..(2*n+2)}"
 proof -
   define r where "r = (\<lambda>x. x \<in> {n..(2*n+2)} \<and> prime x)"
   have "\<exists>x. r x"
   proof (cases "n>2")
     case True
     hence "n-1 > 1" by simp
     hence "\<exists>x \<in> {(n-1)<..<(2*(n-1))}. prime x"
       using bertrand by simp
     moreover have "{n - 1<..<2 * (n - 1)} \<subseteq> {n..2 * n + 2}"
       by (intro subsetI, auto)
     ultimately have "\<exists>x \<in> {n..(2*n+2)}. prime x"
       by (rule ex_subset)
     then show ?thesis by (simp add:r_def Bex_def)
   next
     case False
     hence "2 \<in> {n..(2*n+2)}"
       by simp
     moreover have "prime (2::nat)"
       using two_is_prime_nat by blast
     ultimately have "r 2"
       using r_def by simp
     then show ?thesis by (rule exI)
   qed
   moreover have "prime_above n = (SOME x. r x)"
     by (simp add:prime_above_def r_def)
   ultimately have a:"r (prime_above n)"
     using someI_ex by metis
   show "prime (prime_above n)"
     using a unfolding r_def by blast
   show "prime_above n \<in> {n..(2*n+2)}"
     using a unfolding r_def by blast
 qed
 
 lemma prime_above_min:  "prime_above n \<ge> 2"
   using prime_above_prime
   by (simp add: prime_ge_2_nat)
 
 lemma prime_above_lower_bound: "prime_above n \<ge> n"
   using prime_above_range
   by simp
 
 lemma prime_above_upper_bound: "prime_above n \<le> 2*n+2"
   using prime_above_range
   by simp
 
 end
diff --git a/thys/MDP-Algorithms/Splitting_Methods_Fin.thy b/thys/MDP-Algorithms/Splitting_Methods_Fin.thy
--- a/thys/MDP-Algorithms/Splitting_Methods_Fin.thy
+++ b/thys/MDP-Algorithms/Splitting_Methods_Fin.thy
@@ -1,772 +1,777 @@
 theory Splitting_Methods_Fin
   imports 
     "MDP-Rewards.Blinfun_Util" 
     MDP_fin
     Splitting_Methods
 begin
 subsection \<open>Util\<close>
 
 definition upper_triangular_blin :: "('a::linorder \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('a \<Rightarrow>\<^sub>b real) \<Rightarrow> bool" where 
   "upper_triangular_blin X \<longleftrightarrow> (\<forall>u v i. (\<forall>j \<ge> i. apply_bfun v j = apply_bfun u j) \<longrightarrow> X v i = X u i)"
 
 definition strict_upper_triangular_blin :: "('a::linorder \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('a \<Rightarrow>\<^sub>b real) \<Rightarrow> bool" where 
   "strict_upper_triangular_blin X \<longleftrightarrow> (\<forall>u v i. (\<forall>j > i. apply_bfun v j = apply_bfun u j) \<longrightarrow> X v i = X u i)"
 
 lemma upper_triangularD:
   fixes X :: "('a::linorder \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('a \<Rightarrow>\<^sub>b real)"
     and u v :: "'a \<Rightarrow>\<^sub>b real"
   assumes "upper_triangular_blin X" and "\<And>j. i \<le> j \<Longrightarrow> v j = u j"
   shows "X v i = X u i"
   using assms by (auto simp: upper_triangular_blin_def)
 
 lemma upper_triangularI[intro]:
   fixes X :: "('a::linorder \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('a \<Rightarrow>\<^sub>b real)"
   assumes "\<And>i u v. (\<And>j. i \<le> j \<Longrightarrow> apply_bfun v j = apply_bfun u j) \<Longrightarrow> X v i = X u i"
   shows "upper_triangular_blin X"
   using assms by (fastforce simp: upper_triangular_blin_def)
 
 lemma strict_upper_triangularD:
   fixes X :: "('a::linorder \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('a \<Rightarrow>\<^sub>b real)" and u v :: "'a \<Rightarrow>\<^sub>b real"
   assumes "strict_upper_triangular_blin X" and "\<And>j. i < j \<Longrightarrow> v j = u j"
   shows "X v i = X u i"
   using assms by (auto simp: strict_upper_triangular_blin_def)
 
 lemma strict_imp_upper_triangular_blin: "strict_upper_triangular_blin X \<Longrightarrow> upper_triangular_blin X"
   unfolding strict_upper_triangular_blin_def upper_triangular_blin_def by auto
 
 definition lower_triangular_blin :: "('a::linorder \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('a \<Rightarrow>\<^sub>b real) \<Rightarrow> bool" where
   "lower_triangular_blin X \<longleftrightarrow> (\<forall>u v i. (\<forall>j \<le> i. apply_bfun v j = apply_bfun u j) \<longrightarrow> X v i = X u i)"
 
 definition strict_lower_triangular_blin :: "('a::linorder \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('a \<Rightarrow>\<^sub>b real) \<Rightarrow> bool" where
   "strict_lower_triangular_blin X \<longleftrightarrow> (\<forall>u v i. (\<forall>j < i. apply_bfun v j = apply_bfun u j) \<longrightarrow> X v i = X u i)"
 
 lemma lower_triangularD:
   fixes X :: "('a::linorder \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('a \<Rightarrow>\<^sub>b real)"
     and u v :: "'a \<Rightarrow>\<^sub>b real"
   assumes "lower_triangular_blin X" and "\<And>j. i \<ge> j \<Longrightarrow> v j = u j"
   shows "X v i = X u i" 
   using assms by (auto simp: lower_triangular_blin_def)
 
 lemma lower_triangularI[intro]:
   fixes X :: "('a::linorder \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('a \<Rightarrow>\<^sub>b real)"
   assumes "\<And>i u v. (\<And>j. i \<ge> j \<Longrightarrow> apply_bfun v j = apply_bfun u j) \<Longrightarrow> X v i = X u i"
   shows "lower_triangular_blin X"
   using assms by (fastforce simp: lower_triangular_blin_def)
 
 lemma strict_lower_triangularI[intro]:
   fixes X :: "('a::linorder \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('a \<Rightarrow>\<^sub>b real)"
   assumes "\<And>i u v. (\<And>j. i > j \<Longrightarrow> apply_bfun v j = apply_bfun u j) \<Longrightarrow> X v i = X u i"
   shows "strict_lower_triangular_blin X"
   using assms by (fastforce simp: strict_lower_triangular_blin_def)
 
 lemma strict_lower_triangularD:
   fixes X :: "('a::linorder \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('a \<Rightarrow>\<^sub>b real)"
     and u v :: "'a \<Rightarrow>\<^sub>b real"
   assumes "strict_lower_triangular_blin X" and "\<And>j. i > j \<Longrightarrow> v j = u j"
   shows "X v i = X u i"
   using assms by (auto simp: strict_lower_triangular_blin_def)
 
 lemma strict_imp_lower_triangular_blin: "strict_lower_triangular_blin X \<Longrightarrow> lower_triangular_blin X"
   unfolding strict_lower_triangular_blin_def lower_triangular_blin_def
   by auto
 
 lemma all_imp_Max:
   assumes "finite X" "X \<noteq> {}" "\<forall>x \<in> X. P (f x)" 
   shows "P (MAX x \<in> X. f x)"
 proof -
   have "(MAX x \<in> X. f x) \<in> f ` X"
     using assms by auto
   thus ?thesis
     using assms by force
 qed
 
 lemma bounded_mult: 
   assumes "bounded ((f :: 'c \<Rightarrow> real) ` X)" "bounded (g ` X)"
   shows "bounded ((\<lambda>x. f x * g x) ` X)"
   using assms mult_mono
   by (fastforce simp: bounded_iff abs_mult intro!: mult_mono)
 
 context MDP_nat_disc
 begin
 
 subsection \<open>Gauss Seidel Splitting\<close>
 
 lemma \<P>\<^sub>1_det: "\<P>\<^sub>1 (mk_dec_det d) v s = measure_pmf.expectation (K (s, d s)) v"
   by (auto simp: mk_dec_det_def \<P>\<^sub>1.rep_eq K_st_def bind_return_pmf)
 
 lift_definition \<P>\<^sub>U :: "(nat \<Rightarrow> nat) \<Rightarrow> (nat \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L nat \<Rightarrow>\<^sub>b real" is "\<lambda>d (v :: nat \<Rightarrow>\<^sub>b real). 
   (Bfun (\<lambda>s. (\<P>\<^sub>1 (mk_dec_det d) (bfun_if (\<lambda>s'. s' < s) 0 v) s)))"
 proof (standard, goal_cases)
   let ?vl = "\<lambda>v s. (bfun_if (\<lambda>s'. s' < s) 0 v)"
   have norm_bfun_if_le: "norm (?vl v s) \<le> norm v" for v :: "nat \<Rightarrow>\<^sub>b real" and s
     by (auto simp: norm_bfun_def' bfun_if.rep_eq intro!: cSUP_mono bounded_imp_bdd_above)
   hence is_bfun2: "(\<lambda>s. \<P>\<^sub>1 (mk_dec_det d) (?vl v s) s) \<in> bfun" for v :: "nat \<Rightarrow>\<^sub>b real" and d
     by (intro bfun_normI) (fastforce intro: order.trans[OF norm_blinfun] order.trans[OF norm_le_norm_bfun])
   case (1 d u v)
   have *: "\<P>\<^sub>1 (mk_dec_det d) (?vl (u + v) x) x = \<P>\<^sub>1 (mk_dec_det d) (?vl u x) x + \<P>\<^sub>1 (mk_dec_det d) (?vl v x) x " for x
     by (auto simp: bfun_if_zero_add blinfun.add_right)
   show ?case
     by (simp add: * eq_onp_same_args is_bfun2 plus_bfun.abs_eq)
   case (2 d r v)
   have "?vl (r *\<^sub>R v) x = r *\<^sub>R ?vl v x" for x
     by (auto simp: bfun_if.rep_eq)
   hence *: "r * \<P>\<^sub>1 (mk_dec_det d) (?vl v x) x = \<P>\<^sub>1 (mk_dec_det d) (?vl (r *\<^sub>R v) x) x" for x
     by (auto simp: blinfun.scaleR_right)
   show ?case
     using is_bfun2 by (auto simp: *)
   case (3 d)
   have [simp]: "(\<lambda>s. \<bar>apply_bfun x s\<bar>) \<in> bfun" for x :: "nat \<Rightarrow>\<^sub>b real"
     unfolding bfun_def by (auto intro!: boundedI abs_le_norm_bfun)
   have *: "\<bar>(\<P>\<^sub>1 (mk_dec_det d)) (?vl v n) n\<bar> \<le> \<P>\<^sub>1 (mk_dec_det d) (bfun.Bfun (\<lambda>s. \<bar>apply_bfun v s\<bar>)) n" for v n
     unfolding \<P>\<^sub>1_det
     by (subst Bfun_inverse)
       (auto simp: bfun_if.rep_eq abs_le_norm_bfun 
         intro!: order.trans[OF integral_abs_bound] integral_mono AE_pmfI measure_pmf.integrable_const_bound[of _ "norm v"])
   have "norm (bfun.Bfun (\<lambda>s. ((\<P>\<^sub>1 (mk_dec_det d)) (bfun_if (\<lambda>s'. s' < s) 0 x)) s)) \<le> norm x" for x
     by (fastforce simp: norm_bfun_def' Bfun_inverse[OF is_bfun2] 
         intro: cSUP_least order.trans[OF *[of _ x]] order.trans[OF le_norm_bfun] order.trans[OF norm_blinfun])
   thus ?case
     by (auto intro: exI[of _ 1])
 qed
 
 lift_definition \<P>\<^sub>L :: "(nat \<Rightarrow> nat) \<Rightarrow> (nat \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L nat \<Rightarrow>\<^sub>b real" is "\<lambda>d (v :: nat \<Rightarrow>\<^sub>b real). 
   Bfun (\<lambda>s. (\<P>\<^sub>1 (mk_dec_det d) (bfun_if (\<lambda>s'. s' \<ge> s) 0 v) s))"
 proof (standard, goal_cases)
   let ?vl = "\<lambda>v s. (bfun_if (\<lambda>s'. s' \<ge> s) 0 v)"
   have "norm (?vl v s) \<le> norm v" for v :: "nat \<Rightarrow>\<^sub>b real" and s
     by (auto simp: norm_bfun_def' bfun_if.rep_eq intro!: cSUP_mono bounded_imp_bdd_above)
   hence is_bfun2: "(\<lambda>s. \<P>\<^sub>1 (mk_dec_det d) (?vl v s) s) \<in> bfun" for v :: "nat \<Rightarrow>\<^sub>b real" and d
     by (intro bfun_normI) (fastforce intro: order.trans[OF norm_blinfun] order.trans[OF norm_le_norm_bfun])
   case (1 d u v)
   have *: "\<P>\<^sub>1 (mk_dec_det d) (?vl (u + v) x) x = \<P>\<^sub>1 (mk_dec_det d) (?vl u x) x + \<P>\<^sub>1 (mk_dec_det d) (?vl v x) x " for x
     by (auto simp: bfun_if_zero_add blinfun.add_right)
   show ?case
     by (simp add: * eq_onp_same_args is_bfun2 plus_bfun.abs_eq)
   case (2 d r v)
   have "?vl (r *\<^sub>R v) x = r *\<^sub>R ?vl v x" for x
     by (auto simp: bfun_if.rep_eq)
   hence *: "r * \<P>\<^sub>1 (mk_dec_det d) (?vl v x) x = \<P>\<^sub>1 (mk_dec_det d) (?vl (r *\<^sub>R v) x) x" for x
     by (auto simp: blinfun.scaleR_right)
   show ?case
     using is_bfun2 by (auto simp: *)
   case (3 d)
   have [simp]: "(\<lambda>s. \<bar>apply_bfun x s\<bar>) \<in> bfun" for x :: "nat \<Rightarrow>\<^sub>b real"
     unfolding bfun_def by (auto intro!: boundedI abs_le_norm_bfun)
   have *: "\<bar>(\<P>\<^sub>1 (mk_dec_det d)) (?vl v n) n\<bar> \<le> \<P>\<^sub>1 (mk_dec_det d) (bfun.Bfun (\<lambda>s. \<bar>apply_bfun v s\<bar>)) n" for v n
     unfolding \<P>\<^sub>1_det
     by (subst Bfun_inverse) (auto simp: bfun_if.rep_eq abs_le_norm_bfun 
         intro!: order.trans[OF integral_abs_bound] integral_mono AE_pmfI measure_pmf.integrable_const_bound[of _ "norm v"])
   have "norm (bfun.Bfun (\<lambda>s. ((\<P>\<^sub>1 (mk_dec_det d)) (bfun_if (\<lambda>s'. s' \<ge> s) 0 x)) s)) \<le> norm x" for x
     by (fastforce simp: norm_bfun_def' Bfun_inverse[OF is_bfun2] 
         intro!: cSUP_least order.trans[OF *[of _ x]] order.trans[OF le_norm_bfun] order.trans[OF norm_blinfun])
   thus ?case
     by (auto intro: exI[of _ 1])
 qed
 
 lemma is_bfun_\<P>_raw[simp]: 
   fixes v :: "nat \<Rightarrow>\<^sub>b real" and d
   shows "(\<lambda>s. \<P>\<^sub>1 (mk_dec_det d) (bfun_if (\<lambda>s'. s' \<ge> s) 0 v) s) \<in> bfun" (is ?t1)
     "(\<lambda>s. \<P>\<^sub>1 (mk_dec_det d) (bfun_if (\<lambda>s'. s' < s) 0 v) s) \<in> bfun" (is ?t2)
 proof -
   have *: "norm ((bfun_if (\<lambda>s'. s' \<ge> s) 0 v)) \<le> norm v" "norm ((bfun_if (\<lambda>s'. s' < s) 0 v)) \<le> norm v" for v :: "nat \<Rightarrow>\<^sub>b real" and s
     by (auto simp: norm_bfun_def' bfun_if.rep_eq intro!: cSUP_mono bounded_imp_bdd_above)
   thus ?t1 ?t2
     by (fastforce intro!: bfun_normI order.trans[OF norm_blinfun] order.trans[OF norm_le_norm_bfun])+
 qed
 
 lemma \<P>\<^sub>U_rep_eq': "\<P>\<^sub>U d v s = \<P>\<^sub>1 (mk_dec_det d) (bfun_if ((>) s) 0 v) s"
   by (auto simp: \<P>\<^sub>U.rep_eq)
 
 lemma \<P>\<^sub>L_rep_eq': "\<P>\<^sub>L d v s = \<P>\<^sub>1 (mk_dec_det d) (bfun_if ((\<le>) s) 0 v) s"
   by (auto simp: \<P>\<^sub>L.rep_eq)
 
 lemma apply_bfun_plus: "apply_bfun f a + apply_bfun g a = apply_bfun (f + g) a"
   by auto
 
 lemma \<P>\<^sub>1_sum_lower_upper: "\<P>\<^sub>1 (mk_dec_det d) = \<P>\<^sub>L d + \<P>\<^sub>U d"
 proof -
   have bfun_if_sum: "bfun_if ((\<le>) s) 0 v + bfun_if (\<lambda>s'. s' < s) 0 v = v" for s and v :: "nat \<Rightarrow>\<^sub>b real"
     by (auto simp: bfun_if.rep_eq)
   show ?thesis
     by (fastforce intro: blinfun_eqI simp: blinfun.add_left \<P>\<^sub>L_rep_eq' \<P>\<^sub>U_rep_eq' apply_bfun_plus blinfun.add_right[symmetric] bfun_if_sum)
 qed
 
 lemma nonneg_\<P>\<^sub>U: "nonneg_blinfun (\<P>\<^sub>U d)"
   using \<P>\<^sub>1_nonneg is_bfun_\<P>_raw 
   by (auto simp: nonneg_blinfun_def \<P>\<^sub>U.rep_eq bfun_if.rep_eq less_eq_bfun_def)
 
 lemma nonneg_\<P>\<^sub>L: "nonneg_blinfun (\<P>\<^sub>L d)"
   using \<P>\<^sub>1_nonneg is_bfun_\<P>_raw 
   by (auto simp: nonneg_blinfun_def \<P>\<^sub>L.rep_eq bfun_if.rep_eq less_eq_bfun_def)
 
 lemma norm_\<P>\<^sub>L_le: "norm (\<P>\<^sub>L d) \<le> norm (\<P>\<^sub>1 (mk_dec_det d))"
   using nonneg_\<P>\<^sub>L \<P>\<^sub>1_mono
   by (fastforce intro!: matrix_le_norm_mono simp: bfun_if.rep_eq nonneg_blinfun_def blinfun.diff_left \<P>\<^sub>L.rep_eq less_eq_bfun_def)
 
 lemma norm_\<P>\<^sub>U_le: "norm (\<P>\<^sub>U d) \<le> norm (\<P>\<^sub>1 (mk_dec_det d))"
   using nonneg_\<P>\<^sub>U \<P>\<^sub>1_mono
   by (fastforce intro!: matrix_le_norm_mono simp: bfun_if.rep_eq nonneg_blinfun_def blinfun.diff_left \<P>\<^sub>U.rep_eq less_eq_bfun_def)
 
 lemma norm_\<P>\<^sub>L_le_one: "norm (\<P>\<^sub>L d) \<le> 1"
   using norm_\<P>\<^sub>L_le norm_\<P>\<^sub>1 by auto
 
 lemma norm_\<P>\<^sub>U_le_one: "norm (\<P>\<^sub>U d) \<le> 1"
   using norm_\<P>\<^sub>U_le norm_\<P>\<^sub>1 by auto
 
 lemma norm_\<P>\<^sub>L_less_one: "norm (l *\<^sub>R \<P>\<^sub>L d) < 1"
   using order.strict_trans1[OF mult_left_le disc_lt_one] zero_le_disc norm_\<P>\<^sub>L_le_one
   by auto
 
 lemma norm_\<P>\<^sub>U_less_one: "norm (l *\<^sub>R \<P>\<^sub>U d) < 1"
   using order.strict_trans1[OF mult_left_le disc_lt_one] zero_le_disc norm_\<P>\<^sub>U_le_one
   by auto
 
 lemma \<P>\<^sub>L_le_\<P>\<^sub>1: "0 \<le> v \<Longrightarrow> \<P>\<^sub>L d v \<le> \<P>\<^sub>1 (mk_dec_det d) v"
   using \<P>\<^sub>1_mono
   by (auto simp: bfun_if.rep_eq \<P>\<^sub>L_rep_eq' less_eq_bfun_def intro!:)
 
 lemma \<P>\<^sub>U_le_\<P>\<^sub>1: "0 \<le> v \<Longrightarrow> \<P>\<^sub>U d v \<le> \<P>\<^sub>1 (mk_dec_det d) v"
   using \<P>\<^sub>1_mono
   by (auto simp: bfun_if.rep_eq \<P>\<^sub>U_rep_eq' less_eq_bfun_def intro!:)
 
 lemma \<P>\<^sub>U_indep: "d s = d' s \<Longrightarrow> \<P>\<^sub>U d v s = \<P>\<^sub>U d' v s"
   unfolding \<P>\<^sub>U_rep_eq' \<P>\<^sub>1_det by simp
 lemma \<P>\<^sub>L_indep: "d s = d' s \<Longrightarrow> \<P>\<^sub>L d v s = \<P>\<^sub>L d' v s"
   unfolding \<P>\<^sub>L_rep_eq' \<P>\<^sub>1_det by simp
 
 lemma \<P>\<^sub>U_indep2: 
   assumes "d s = d' s" "(\<And>s'. s' \<ge> s \<Longrightarrow> apply_bfun v s' = apply_bfun v' s')" 
   shows "\<P>\<^sub>U d v s = \<P>\<^sub>U d' v' s"
   using assms by (auto simp: \<P>\<^sub>U_rep_eq' \<P>\<^sub>1_det bfun_if.rep_eq cong: if_cong)
 
 lemma \<P>\<^sub>L_indep2: "d s = d' s \<Longrightarrow> (\<And>s'. s' < s \<Longrightarrow> apply_bfun v s' = apply_bfun v' s') \<Longrightarrow> \<P>\<^sub>L d v s = \<P>\<^sub>L d' v' s"
   by (auto simp: \<P>\<^sub>L_rep_eq' \<P>\<^sub>1_det bfun_if.rep_eq cong: if_cong)
 
 lemma \<P>\<^sub>1_indep: "d s = d' s \<Longrightarrow> \<P>\<^sub>1 d v s = \<P>\<^sub>1 d' v s"
   by (simp add: K_st_def \<P>\<^sub>1.rep_eq)
 
 lemma \<P>\<^sub>U_upper: "upper_triangular_blin (\<P>\<^sub>U d)"
   using \<P>\<^sub>U_indep2 by fastforce
 
 lemma \<P>\<^sub>L_strict_lower: "strict_lower_triangular_blin (\<P>\<^sub>L d)"
   using \<P>\<^sub>L_indep2 by fastforce
 
 definition "Q_GS d = id_blinfun - l *\<^sub>R \<P>\<^sub>L d"
 definition "R_GS d = l *\<^sub>R \<P>\<^sub>U d"
 
 lemma nonneg_R_GS: "nonneg_blinfun (R_GS d)"
   by (simp add: R_GS_def nonneg_\<P>\<^sub>U nonneg_blinfun_scaleR)
 
 lemma splitting_gauss: "is_splitting_blin (id_blinfun - l *\<^sub>R \<P>\<^sub>1 (mk_dec_det d)) (Q_GS d) (R_GS d)"
   unfolding is_splitting_blin_def
 proof safe
   show "nonneg_blinfun (R_GS d)"
     using nonneg_R_GS.
 next
   show "id_blinfun - l *\<^sub>R \<P>\<^sub>1 (mk_dec_det d) = Q_GS d - R_GS d"
     using \<P>\<^sub>1_sum_lower_upper
     unfolding Q_GS_def R_GS_def
     by (auto simp: algebra_simps scaleR_add_right[symmetric] simp del: scaleR_add_right)
 next
   have n_le: "norm (l *\<^sub>R \<P>\<^sub>L d) < 1"
     using mult_left_le[OF norm_\<P>\<^sub>L_le_one[of d] zero_le_disc] order.strict_trans1
     by (auto intro: disc_lt_one)
   thus "invertible\<^sub>L (Q_GS d)"
     by (simp add: Q_GS_def invertible\<^sub>L_inf_sum)
   have "inv\<^sub>L (Q_GS d) = (\<Sum>i. (l *\<^sub>R \<P>\<^sub>L d) ^^ i)"
     using inv\<^sub>L_inf_sum n_le unfolding Q_GS_def by blast
   have "nonneg_blinfun (R_GS d ^^ i)" for i
     using nonneg_R_GS by (auto simp: nonneg_blinfun_def intro: blinfunpow_nonneg)
   have s: "summable (\<lambda>k. ((l *\<^sub>R \<P>\<^sub>L d)^^k))"
     using summable_inv_Q[of "Q_GS d"] norm_\<P>\<^sub>L_less_one
     by (simp add: Q_GS_def algebra_simps blinfun.scaleR_left blincomp_scaleR_right)
   hence s': "summable (\<lambda>k. ((l *\<^sub>R \<P>\<^sub>L d)^^k) v)" for v
     using tendsto_blinfun_apply
     by (auto simp: summable_def sums_def blinfun.sum_left[symmetric])
   hence s'': "summable (\<lambda>k. ((l *\<^sub>R \<P>\<^sub>L d)^^k) v s)" for v s
     by (fastforce simp: summable_def sums_def sum_apply_bfun[symmetric] intro: bfun_tendsto_apply_bfun)
   have "0 \<le> (\<Sum>k. ((l *\<^sub>R \<P>\<^sub>L d)^^k) v s)" if "v \<ge> 0" for v s
     by (rule suminf_nonneg[OF s''])
       (metis blinfunpow_nonneg that less_eq_bfun_def nonneg_\<P>\<^sub>L nonneg_blinfun_nonneg nonneg_blinfun_scaleR zero_bfun.rep_eq zero_le_disc)
   hence "0 \<le> (\<Sum>k. ((l *\<^sub>R \<P>\<^sub>L d)^^k) v)" if "v \<ge> 0" for v
     using that unfolding less_eq_bfun_def suminf_apply_bfun[OF s'] by auto
   hence "nonneg_blinfun (\<Sum>k. ((l *\<^sub>R \<P>\<^sub>L d)^^k))"
     unfolding nonneg_blinfun_def by (simp add: blinfun_apply_suminf s)
   thus "nonneg_blinfun (inv\<^sub>L (Q_GS d))"
     by (simp add: \<open>inv\<^sub>L (Q_GS d) = (\<Sum>i. (l *\<^sub>R \<P>\<^sub>L d) ^^ i)\<close>)
 qed
 
 abbreviation "r_det\<^sub>b d \<equiv> r_dec\<^sub>b (mk_dec_det d)"
 
 definition "GS_inv d v = inv\<^sub>L (Q_GS d) (r_dec\<^sub>b (mk_dec_det d) + R_GS d v)"
 
 text \<open>@{term Q_GS} can be expressed as an infinite sum of @{const \<P>\<^sub>L}.\<close>
 
 lemma inv_Q_suminf: "inv\<^sub>L (Q_GS d) = (\<Sum>k. (l *\<^sub>R (\<P>\<^sub>L d)) ^^ k)"
   unfolding Q_GS_def using inv\<^sub>L_inf_sum norm_\<P>\<^sub>L_less_one by blast
 
 text \<open>This recursive definition mimics the computation of the GS iteration.\<close>
 lemma GS_inv_rec: "GS_inv d v = r_det\<^sub>b d + l *\<^sub>R (\<P>\<^sub>U d v + \<P>\<^sub>L d (GS_inv d v))"
 proof -
   have "Q_GS d (GS_inv d v) = r_det\<^sub>b d + R_GS d v"
     using splitting_gauss[of d] unfolding GS_inv_def is_splitting_blin_def by simp
   thus ?thesis
     unfolding R_GS_def Q_GS_def by (auto simp: algebra_simps blinfun.diff_left blinfun.scaleR_left)
 qed
 
 text \<open>As a result, also @{term GS_inv} is independent of lower actions.\<close>
 lemma GS_indep_high_states:
   assumes "\<And>s'. s' \<le> s \<Longrightarrow> d s' = d' s'"
   shows "GS_inv d v s = GS_inv d' v s"
   using assms
 proof (induction s arbitrary: d d' v rule: less_induct)
   case (less x)
   have "r_det\<^sub>b d x = r_det\<^sub>b d' x"
     by (simp add: less.prems)
   moreover have "\<P>\<^sub>U d v x = \<P>\<^sub>U d' v x"    
     by (meson \<P>\<^sub>U_indep le_refl less.prems)
   moreover have "\<P>\<^sub>L d (GS_inv d v) x = \<P>\<^sub>L d' (GS_inv d' v) x"
     using \<P>\<^sub>L_indep2 less.IH less.prems by fastforce
   ultimately show ?case
     by (subst GS_inv_rec[of d], subst GS_inv_rec[of d']) auto
 qed
 
 lemma is_am_GS_inv_extend:
   assumes "\<And>s. s < k \<Longrightarrow> is_arg_max (\<lambda>d. GS_inv d v s) (\<lambda>d. d \<in> D\<^sub>D) d"
     and "is_arg_max (\<lambda>a. GS_inv (d (k := a)) v k) (\<lambda>a. a \<in> A k) a"
     and "s \<le> k"
     and "d \<in> D\<^sub>D"
   shows "is_arg_max (\<lambda>d. GS_inv d v s) (\<lambda>d. d \<in> D\<^sub>D) (d (k := a))"
 proof -
   have "is_arg_max (\<lambda>d. GS_inv d v k) (\<lambda>d. d \<in> D\<^sub>D) (d (k := a))"
   proof (rule is_arg_max_linorderI)
     fix y
     assume "y \<in> D\<^sub>D"
     let ?d = "d(k := y k)"   
     have "GS_inv y v k \<le> GS_inv ?d v k"
     proof -
       have "\<P>\<^sub>L y (GS_inv y v) k = (\<P>\<^sub>L ?d (GS_inv y v)) k"
         by (auto intro!: \<P>\<^sub>L_indep2 GS_indep_high_states)
       also have "\<dots> \<le> (\<P>\<^sub>L ?d (bfun_if (\<lambda>s. s < k) (GS_inv d v) (GS_inv y v))) k"
         using assms(1) \<open>y \<in> D\<^sub>D\<close>
         by (fastforce intro!: nonneg_blinfun_mono[THEN less_eq_bfunD] simp: bfun_if.rep_eq less_eq_bfun_def nonneg_\<P>\<^sub>L)
       also have "\<dots> = (\<P>\<^sub>L ?d (GS_inv d v)) k"
         by (metis (no_types, lifting) \<P>\<^sub>L_strict_lower bfun_if.rep_eq strict_lower_triangularD)
       also have "\<dots> = \<P>\<^sub>L ?d (GS_inv ?d v) k"
         using GS_indep_high_states \<P>\<^sub>L_strict_lower
         by (fastforce intro: strict_lower_triangularD[OF \<P>\<^sub>L_strict_lower])
       finally have "\<P>\<^sub>L y (GS_inv y v) k \<le> \<P>\<^sub>L ?d (GS_inv ?d v) k".
       thus ?thesis
         by (subst GS_inv_rec[of y], subst GS_inv_rec[of ?d])
           (auto simp: \<P>\<^sub>U_indep[of y _ ?d] intro!: mult_left_mono)
     qed
     thus "GS_inv y v k \<le> GS_inv (d(k := a)) v k"
       using is_arg_max_linorderD[OF assms(2)] \<open>y \<in> D\<^sub>D\<close> is_dec_det_def by fastforce
   next
     show "d(k := a) \<in> D\<^sub>D"
       using assms by (auto simp: is_dec_det_def is_arg_max_linorder)
   qed
   thus ?thesis
     using assms GS_indep_high_states[of s "d (k := a)" d] by (cases "s < k") fastforce+
 qed
 
 lemma is_am_GS_inv_extend':
   assumes "\<And>s. s < k \<Longrightarrow> is_arg_max (\<lambda>d. GS_inv d v s) (\<lambda>d. d \<in> D\<^sub>D) d"
     and "is_arg_max (\<lambda>a. GS_inv (d (k := a)) v k) (\<lambda>a. a \<in> A k) (d k)"
     and "s \<le> k"
     and "d \<in> D\<^sub>D"
   shows "is_arg_max (\<lambda>d. GS_inv d v s) (\<lambda>d. d \<in> D\<^sub>D) d"
   using assms is_am_GS_inv_extend[of k _ d  "d k"] by auto
 
 lemma norm_\<P>\<^sub>L_pow: "norm ((\<Sum>k. (l *\<^sub>R \<P>\<^sub>L d) ^^ k)) \<le> 1 / (1-l)"
   by (fastforce simp: norm_\<P>\<^sub>L_le_one mult_left_le power_mono suminf_geometric
       intro: order.trans[OF summable_norm] summable_comparison_test'[of "\<lambda>n :: nat. l ^ n" 0] 
       order.trans[OF suminf_le[of _ "\<lambda>n. l^n"]] order.trans[OF norm_blinfunpow_le])
 
 lemma summable_disc_\<P>\<^sub>L: "summable (\<lambda>i. ((l *\<^sub>R \<P>\<^sub>L d)^^i))"
   by (metis add_diff_cancel_left' diff_add_cancel norm_\<P>\<^sub>L_less_one summable_inv_Q)
 
 lemma norm_\<P>\<^sub>L_pow_elem: "norm ((\<Sum>k. (l *\<^sub>R \<P>\<^sub>L d) ^^ k) v) \<le> norm v / (1-l)"
   using norm_\<P>\<^sub>L_le_one 
   by (subst blinfun_apply_suminf[symmetric, OF summable_disc_\<P>\<^sub>L]) 
     (auto simp: blincomp_scaleR_right blinfun.scaleR_left intro!: power_le_one sum_disc_bound' 
       order.trans[OF norm_blinfunpow_le] order.trans[OF norm_blinfun] mult_left_le_one_le)
 
 lemma norm_Q_GS: "norm (inv\<^sub>L (Q_GS d) v) \<le> norm v / (1-l)"
   using inv_Q_suminf norm_\<P>\<^sub>L_pow_elem by auto
 
 lemma norm_GS_inv_le: "norm (GS_inv d v) \<le> (r\<^sub>M + l * norm v) / (1 - l)"
 proof -
   have "0 < (1 - l)"
     using disc_lt_one by auto
   thus ?thesis
     unfolding GS_inv_def inv_Q_suminf R_GS_def
     using norm_r_dec_le norm_\<P>\<^sub>U_le_one order.strict_implies_order[OF disc_lt_one]
     by (intro order.trans[OF norm_\<P>\<^sub>L_pow_elem]) 
       (auto simp: blinfun.scaleR_left intro!: mult_left_le_one_le order.trans[OF norm_blinfun] mult_left_mono divide_right_mono order.trans[OF norm_triangle_ineq] add_mono)
 qed
 
 
 lemma GS_inv_elem_eq: "GS_inv d v s = (r_det\<^sub>b d + l *\<^sub>R (\<P>\<^sub>1 (mk_dec_det d) (bfun_if (\<lambda>s'. s \<le> s') v (GS_inv d v)))) s"
 proof -
   have "bfun_if (\<lambda>s'. s' < s) 0 v + bfun_if ((\<le>) s) 0 (GS_inv d v) = bfun_if ((\<le>) s) v (GS_inv d v)" 
     by (auto simp: bfun_if.rep_eq)
   thus ?thesis
     by (subst GS_inv_rec) (auto simp: \<P>\<^sub>U_rep_eq' \<P>\<^sub>L_rep_eq' apply_bfun_plus blinfun.add_right[symmetric])
 qed
 
 subsection \<open>Maximizing Decision Rule for GS\<close>
 lemma ex_GS_inv_arg_max: "\<exists>a. is_arg_max (\<lambda>a. GS_inv (d(s:= a)) v s) (\<lambda>a. a \<in> A s) a"
 proof -
   have "\<exists>a. is_arg_max (\<lambda>a. (r_det\<^sub>b (d(s := a)) + l *\<^sub>R (\<P>\<^sub>1 (mk_dec_det (d(s := a))) (bfun_if (\<lambda>s'. s \<le> s') v (GS_inv d v)))) s) (\<lambda>a. a \<in> A s) a"
     using Sup_att by (auto simp: \<P>\<^sub>1_det max_L_ex_def has_arg_max_def)
   moreover have"(bfun_if (\<lambda>s'. s \<le> s') v (GS_inv (d(s := a)) v)) = (bfun_if (\<lambda>s'. s \<le> s') v (GS_inv d v))" for a
     using GS_indep_high_states by (fastforce simp: bfun_if.rep_eq)
   ultimately show ?thesis
     by (auto simp: GS_inv_elem_eq)
 qed
 
 text \<open>This shows that there always exists a decision rule that maximized @{const GS_inv} for all states simultaneously.\<close>
 abbreviation "some_dec \<equiv> (SOME d. d \<in> D\<^sub>D)"
 
 fun d_GS_least :: "(nat \<Rightarrow>\<^sub>b real) \<Rightarrow> nat \<Rightarrow> nat" where
   "d_GS_least v (0::nat) = (LEAST a. is_arg_max (\<lambda>a. GS_inv (some_dec(0 := a)) v 0) (\<lambda>a. a \<in> A 0) a)" |
   "d_GS_least v (Suc n) =  (LEAST a. is_arg_max (\<lambda>a. GS_inv ((\<lambda>s. if s < Suc n then d_GS_least v s else SOME a. a \<in> A s)(Suc n:= a)) v (Suc n)) (\<lambda>a. a \<in> A (Suc n)) a)"
 
 lemma d_GS_least_is_dec: "d_GS_least v \<in> D\<^sub>D"
   unfolding is_dec_det_def
 proof safe
   fix s
   show "d_GS_least v s \<in> A s"
     using LeastI_ex[OF ex_GS_inv_arg_max] by (cases s) auto
 qed
 
 lemma d_GS_least_eq: "d_GS_least v n = (LEAST a. is_arg_max (\<lambda>a. GS_inv ((d_GS_least v)(n := a)) v n) (\<lambda>a. a \<in> A n) a)"
 proof (induction n)
   case 0
   have aux: "apply_bfun (GS_inv ((d_GS_least v)(0 := a)) v) 0 = GS_inv (some_dec(0 := a)) v 0" for a
     by (auto intro: GS_indep_high_states)
   show ?case
     unfolding aux by auto
 next
   case (Suc n)
   have aux: "GS_inv ((\<lambda>s. if s < Suc n then d_GS_least v s else SOME a. a \<in> A s)(Suc n := a)) v (Suc n) = 
       (GS_inv ((d_GS_least v)(Suc n := a)) v) (Suc n)" for a
     using GS_indep_high_states by fastforce
   show ?case
     unfolding aux[symmetric] by simp
 qed
 
 lemma d_GS_least_is_arg_max: "is_arg_max (\<lambda>d. GS_inv d v s) (\<lambda>d. d \<in> D\<^sub>D) (d_GS_least v)"
 proof (induction s rule: nat_less_induct)
   case (1 n)
   assume "\<forall>m<n. is_arg_max (\<lambda>d. apply_bfun (GS_inv d v) m) (\<lambda>d. d \<in> D\<^sub>D) (d_GS_least v)"
   show ?case
     using is_am_GS_inv_extend'[of n _ "(d_GS_least v)"] 1 d_GS_least_is_dec 
     by (fastforce simp: ex_GS_inv_arg_max d_GS_least_eq[of v n] LeastI_ex)
 qed
 
 subsection \<open>Gauss-Seidel is a Valid Regular Splitting\<close>
 
 lemma norm_GS_QR_le_disc: "norm (inv\<^sub>L (Q_GS d) o\<^sub>L R_GS d) \<le> l"
 proof -
   have "norm (inv\<^sub>L (Q_GS d) o\<^sub>L R_GS d) \<le> norm (inv\<^sub>L ((\<lambda>_. id_blinfun) d) o\<^sub>L (l *\<^sub>R \<P>\<^sub>1 (mk_dec_det d))) "
   proof (rule norm_splitting_le[of "mk_dec_det d"], goal_cases)
     case 1
     then show ?case 
       unfolding is_splitting_blin_def nonneg_blinfun_def
       by (auto simp: \<P>\<^sub>1_pos blinfun.scaleR_left scaleR_nonneg_nonneg)
   next
     case 3
     then show ?case 
       by (simp add: R_GS_def \<P>\<^sub>U_le_\<P>\<^sub>1 blinfun_le_iff scaleR_blinfun.rep_eq scaleR_left_mono)
   qed (auto simp: splitting_gauss blinfun_le_iff)
   also have "\<dots> \<le> l"
     by auto
   finally show ?thesis.
 qed
 
 lemma ex_GS_arg_max_all: "\<exists>d. is_arg_max (\<lambda>d. GS_inv d v s) (\<lambda>d. d \<in> D\<^sub>D) d"
   using d_GS_least_is_arg_max by blast
 
 sublocale GS: MDP_QR A K r l Q_GS R_GS
 proof -
   have "(\<Squnion>d\<in>D\<^sub>D. norm (inv\<^sub>L (Q_GS d) o\<^sub>L R_GS d)) < 1"
     using norm_GS_QR_le_disc ex_dec_det
     by (fastforce intro: le_less_trans[of _ l 1] intro!: cSUP_least)
   thus "MDP_QR A K r l Q_GS R_GS"
     using norm_GS_QR_le_disc norm_\<P>\<^sub>L_pow d_GS_least_is_arg_max
     by unfold_locales (fastforce intro!: bdd_above.I2 simp: splitting_gauss bounded_iff inv_Q_suminf GS_inv_def)+
 qed
 
 subsection \<open>Termination\<close>
 lemma dist_\<L>\<^sub>b_split_lt_dist_opt: "dist v (GS.\<L>\<^sub>b_split v) \<le> 2 * dist v \<nu>\<^sub>b_opt"
 proof -
   have le1: "dist v (GS.\<L>\<^sub>b_split v) \<le> dist v \<nu>\<^sub>b_opt + dist (GS.\<L>\<^sub>b_split v) \<nu>\<^sub>b_opt"
     by (simp add: dist_triangle dist_commute)
   have le2: "dist (GS.\<L>\<^sub>b_split v) \<nu>\<^sub>b_opt \<le> GS.QR_disc * dist v \<nu>\<^sub>b_opt"
     using GS.\<L>\<^sub>b_split_contraction GS.\<L>\<^sub>b_split_fix by (metis (no_types, lifting))
   show ?thesis
     using mult_right_mono[of GS.QR_disc 1] GS.QR_contraction
     by (fastforce intro!: order.trans[OF le2] order.trans[OF le1])
 qed
 
 lemma GS_QR_disc_le_disc: "GS.QR_disc \<le> l"
   using norm_GS_QR_le_disc ex_dec_det by (fastforce intro!: cSUP_least)
 
 text \<open>
 The distance between an estimate for the value and the optimal value can be bounded with respect to 
 the distance between the estimate and the result of applying it to @{const \<L>\<^sub>b}
 \<close>
 
 lemma gs_rel_dec: 
   assumes "l \<noteq> 0" "GS.\<L>\<^sub>b_split v \<noteq> \<nu>\<^sub>b_opt"
   shows "\<lceil>log (1 / l) (dist (GS.\<L>\<^sub>b_split v) \<nu>\<^sub>b_opt) - c\<rceil> < \<lceil>log (1 / l) (dist v \<nu>\<^sub>b_opt) - c\<rceil>"
 proof -
   have "log (1 / l) (dist (GS.\<L>\<^sub>b_split v) \<nu>\<^sub>b_opt) - c \<le> log (1 / l) (l * dist v \<nu>\<^sub>b_opt) - c"
-    using GS.\<L>\<^sub>b_split_contraction[of _ "\<nu>\<^sub>b_opt"] GS.QR_contraction norm_GS_QR_le_disc disc_lt_one GS_QR_disc_le_disc
-    by (fastforce simp: assms less_le intro!: log_le order.trans[OF GS.\<L>\<^sub>b_split_contraction[of v "\<nu>\<^sub>b_opt", simplified]] mult_right_mono)
+  proof (intro Transcendental.log_mono diff_mono)
+    show "dist (GS.\<L>\<^sub>b_split v) \<nu>\<^sub>b_opt \<le> l * dist v \<nu>\<^sub>b_opt"
+      using GS.\<L>\<^sub>b_split_contraction[of _ "\<nu>\<^sub>b_opt"]
+      by (smt (verit, ccfv_SIG) GS.\<L>\<^sub>b_split_fix GS_QR_disc_le_disc mult_right_mono zero_le_dist)
+    show "1 < 1/l"
+      by (metis \<open>l \<noteq> 0\<close> disc_lt_one less_divide_eq_1_pos less_le zero_le_disc)
+  qed (use assms in auto)
   also have "\<dots> = log (1 / l) l + log (1/l) (dist v \<nu>\<^sub>b_opt) - c"
     using assms disc_lt_one by (auto simp: less_le intro!: log_mult)
   also have "\<dots> = -(log (1 / l) (1/l)) + (log (1/l) (dist v \<nu>\<^sub>b_opt)) - c"
     using assms disc_lt_one
     by (subst log_inverse[symmetric]) (auto simp: less_le right_inverse_eq)
   also have "\<dots> = (log (1/l) (dist v \<nu>\<^sub>b_opt)) - 1 - c"
     using assms order.strict_implies_not_eq[OF disc_lt_one]
     by (auto intro!: log_eq_one neq_le_trans)
   finally have "log (1 / l) (dist (GS.\<L>\<^sub>b_split v) \<nu>\<^sub>b_opt) - c \<le> log (1 / l) (dist v \<nu>\<^sub>b_opt) - 1 - c" .
   thus ?thesis
     by linarith
 qed
 
 abbreviation "gs_measure \<equiv> (\<lambda>(eps, v).
     if v = \<nu>\<^sub>b_opt \<or> l = 0
     then 0
     else nat (ceiling (log (1/l) (dist v \<nu>\<^sub>b_opt) - log (1/l) (eps * (1-l) / (8 * l)))))"
 
 function gs_iteration :: "real \<Rightarrow> (nat \<Rightarrow>\<^sub>b real) \<Rightarrow> (nat \<Rightarrow>\<^sub>b real)" where
   "gs_iteration eps v =
   (if 2 * l * dist v (GS.\<L>\<^sub>b_split v) < eps * (1 - l) \<or> eps \<le> 0 then GS.\<L>\<^sub>b_split v else gs_iteration eps (GS.\<L>\<^sub>b_split v))"
   by auto
 termination
 proof (relation "Wellfounded.measure gs_measure"; cases "l = 0")
   case False
   fix eps v
   assume h: "\<not> (2 * l * dist v (GS.\<L>\<^sub>b_split v) < eps * (1 - l) \<or> eps \<le> 0)"
   show "((eps, GS.\<L>\<^sub>b_split v), eps, v) \<in> Wellfounded.measure gs_measure"
   proof -
     have gt_zero[simp]: "l \<noteq> 0" "eps > 0" and dist_ge: "eps * (1 - l) \<le> dist v (GS.\<L>\<^sub>b_split v) * (2 * l)"
       using h by (auto simp: algebra_simps)
     have v_not_opt: "v \<noteq> \<nu>\<^sub>b_opt"
       using h by auto
     have "log (1 / l) (eps * (1 - l) / (8 * l)) < log (1 / l) (dist v \<nu>\<^sub>b_opt)"
     proof (intro log_less)
       show "1 < 1 / l"
         by (auto intro!: mult_imp_less_div_pos intro: neq_le_trans)
       show "0 < eps * (1 - l) / (8 * l)" 
         by (auto intro!: mult_imp_less_div_pos intro: neq_le_trans)
       show "eps * (1 - l) / (8 * l) < dist v \<nu>\<^sub>b_opt" 
         using dist_pos_lt[OF v_not_opt] dist_\<L>\<^sub>b_split_lt_dist_opt[of v] gt_zero zero_le_disc mult_strict_left_mono[of "dist v (GS.\<L>\<^sub>b_split v)" "(4 * dist v \<nu>\<^sub>b_opt)" l]
         by (intro mult_imp_div_pos_less le_less_trans[OF dist_ge]) argo+
     qed
     thus ?thesis
       using gs_rel_dec h by auto
   qed
 qed auto
 
 subsection \<open>Optimality\<close>
 
 lemma THE_fix_GS: "(THE v. GS.\<L>\<^sub>b_split v = v) = \<nu>\<^sub>b_opt"
   using GS.\<L>\<^sub>b_lim(1) GS.\<L>\<^sub>b_split_fix by blast
 
 lemma contraction_\<L>_split_dist: "(1 - l) * dist v \<nu>\<^sub>b_opt \<le> dist v (GS.\<L>\<^sub>b_split v)"
   using GS_QR_disc_le_disc 
   by (fastforce simp: THE_fix_GS
       intro: order.trans[OF _ contraction_dist, of _ l] order.trans[OF GS.\<L>\<^sub>b_split_contraction] mult_right_mono)+
 
 lemma dist_\<L>\<^sub>b_split_opt_eps:
   assumes "eps > 0" "2 * l * dist v (GS.\<L>\<^sub>b_split v) < eps * (1-l)"
   shows "dist (GS.\<L>\<^sub>b_split v) \<nu>\<^sub>b_opt < eps / 2"
 proof -
   have "dist v \<nu>\<^sub>b_opt \<le> dist v (GS.\<L>\<^sub>b_split v) / (1 - l)"
     using contraction_\<L>_split_dist
     by (simp add: mult.commute pos_le_divide_eq)
   hence "2 * l * dist v \<nu>\<^sub>b_opt \<le> 2 * l * (dist v (GS.\<L>\<^sub>b_split v) / (1 - l))"
     using contraction_\<L>_dist assms mult_le_cancel_left_pos[of "2 * l"]
     by (fastforce intro!: mult_left_mono[of _ _ "2 * l"])
   hence "2 * l * dist v \<nu>\<^sub>b_opt < eps"
     by (auto simp: assms(2) pos_divide_less_eq intro: order.strict_trans1)
   hence "dist v \<nu>\<^sub>b_opt * l < eps / 2"
     by argo
   hence *: "l * dist v \<nu>\<^sub>b_opt < eps / 2"
     by (auto simp: algebra_simps)
   show "dist (GS.\<L>\<^sub>b_split v) \<nu>\<^sub>b_opt < eps / 2"
     using GS.\<L>\<^sub>b_split_contraction[of v \<nu>\<^sub>b_opt] order.trans mult_right_mono[OF GS_QR_disc_le_disc zero_le_dist]
     by (fastforce intro!: le_less_trans[OF _ *])
 qed
 
 lemma gs_iteration_error: 
   assumes "eps > 0"
   shows "dist (gs_iteration eps v) \<nu>\<^sub>b_opt < eps / 2"
   using assms dist_\<L>\<^sub>b_split_opt_eps gs_iteration.simps
   by (induction eps v rule: gs_iteration.induct) auto
 
 lemma find_policy_error_bound_gs:
   assumes "eps > 0" "2 * l * dist v (GS.\<L>\<^sub>b_split v) < eps * (1-l)"
   shows "dist (\<nu>\<^sub>b (mk_stationary_det (d_GS_least (GS.\<L>\<^sub>b_split v)))) \<nu>\<^sub>b_opt < eps"
 proof (rule GS.find_policy_QR_error_bound[OF assms(1)])
   have "2 * GS.QR_disc * dist v (GS.\<L>\<^sub>b_split v) \<le> 2 * l * dist v (GS.\<L>\<^sub>b_split v)"
     using GS_QR_disc_le_disc by (auto intro!: mult_right_mono)
   also have "\<dots> <  eps * (1-l)" 
     using assms by auto
   also have "\<dots> \<le> eps * (1 - GS.QR_disc)" 
     using assms GS_QR_disc_le_disc by (auto intro!: mult_left_mono)
   finally show "2 * GS.QR_disc * dist v (GS.\<L>\<^sub>b_split v) < eps * (1 - GS.QR_disc)".
 next
   obtain d where d: "is_dec_det d"
     using ex_dec_det by blast  
   show "is_arg_max (\<lambda>d. (GS.L_split d (GS.\<L>\<^sub>b_split v)) s) (\<lambda>d. d \<in> D\<^sub>D) (d_GS_least (GS.\<L>\<^sub>b_split v))" for s
     unfolding GS_inv_def[symmetric] using d_GS_least_is_arg_max by auto
 qed
 
 definition "vi_gs_policy eps v = d_GS_least (gs_iteration eps v)"
 
 lemmas gs_iteration.simps[simp del]
 
 lemma vi_gs_policy_opt:
   assumes "0 < eps"
   shows "dist (\<nu>\<^sub>b (mk_stationary_det (vi_gs_policy eps v))) \<nu>\<^sub>b_opt < eps"
   unfolding vi_gs_policy_def
   using assms
 proof (induction eps v rule: gs_iteration.induct)
   case (1 v)
   then show ?case
     using find_policy_error_bound_gs by (subst gs_iteration.simps) auto
 qed
 
 section \<open>Preparation for Codegen\<close>
 lemma \<L>\<^sub>b_split_eq_GS_inv: "GS.\<L>\<^sub>b_split v = GS_inv (d_GS_least v) v"
   using arg_max_SUP[OF d_GS_least_is_arg_max]
   by (auto simp: GS.\<L>\<^sub>b_split.rep_eq GS.\<L>_split_def GS_inv_def[symmetric])
 
 lemma \<L>\<^sub>b_split_GS: "GS.\<L>\<^sub>b_split v s = (\<Squnion>a \<in> A s. r (s, a) + l * measure_pmf.expectation (K (s, a)) (bfun_if (\<lambda>s'. s' < s) (GS.\<L>\<^sub>b_split v) v))"
 proof -
   let ?d = "d_GS_least v"
   have "GS.\<L>\<^sub>b_split v s = GS_inv ?d v s"
     using \<L>\<^sub>b_split_eq_GS_inv by auto
   also have "\<dots> = (\<Squnion>a \<in> A s. GS_inv (?d(s := a)) v s)"
   proof (subst arg_max_SUP[symmetric, of _ _ "?d s"])
     show "is_arg_max (\<lambda>a. (GS_inv (?d(s := a)) v) s) (\<lambda>x. x \<in> A s) (?d s)"
       using d_GS_least_eq A_ne A_fin MDP_reward_Util.arg_max_on_in
       by (auto simp: LeastI_ex finite_is_arg_max)
   qed fastforce
   also have "\<dots> = (\<Squnion>a \<in> A s. (r_det\<^sub>b (?d(s := a)) + l *\<^sub>R (\<P>\<^sub>U (?d(s := a)) v + \<P>\<^sub>L (?d(s := a)) (GS_inv (?d(s := a)) v))) s)"
     using GS_inv_rec by auto
   also have "\<dots> = (\<Squnion>a \<in> A s. r (s, a) + l * (\<P>\<^sub>U (?d(s := a)) v + \<P>\<^sub>L (?d(s := a)) (GS_inv (?d(s := a)) v)) s)"
     by auto
   also have "\<dots> = (\<Squnion>a \<in> A s. r (s, a) + l * (\<P>\<^sub>U (?d(s := a)) v + \<P>\<^sub>L (?d(s := a)) (GS_inv ?d v)) s)"
   proof -
     have "\<P>\<^sub>L (?d(s := a)) (GS_inv (?d(s := a)) v) s = \<P>\<^sub>L (?d(s := a)) (GS_inv (?d) v) s" for a
       by (fastforce intro!: GS_indep_high_states strict_lower_triangularD[OF  \<P>\<^sub>L_strict_lower, of s _ _ "(?d(s := a))"])
     thus ?thesis
       by auto
   qed
   also have "\<dots> = (\<Squnion>a \<in> A s. r (s, a) + l * \<P>\<^sub>1 (mk_dec_det (?d(s := a))) (bfun_if (\<lambda>s'. s' < s) (GS_inv ?d v) v) s)"
   proof -
     have "(bfun_if (\<lambda>s'. s' < s) 0 v + bfun_if ((\<le>) s) 0 (GS_inv ?d v)) = (bfun_if (\<lambda>s'. s' < s) (GS_inv ?d v) v)"
       by (auto simp: bfun_if.rep_eq)
     thus ?thesis
       by (auto simp: \<P>\<^sub>L.rep_eq \<P>\<^sub>U.rep_eq blinfun.add_right[symmetric] apply_bfun_plus)
   qed
   also have "\<dots> = (\<Squnion>a \<in> A s. r (s, a) + l * \<P>\<^sub>1 (mk_dec_det (?d(s := a))) (bfun_if (\<lambda>s'. s' < s) (GS.\<L>\<^sub>b_split v) v) s)"
     using \<L>\<^sub>b_split_eq_GS_inv by presburger
   also have "\<dots> = (\<Squnion>a \<in> A s. r (s, a) + l * measure_pmf.expectation (K (s, a)) (bfun_if (\<lambda>s'. s' < s) (GS.\<L>\<^sub>b_split v) v))"
     using \<P>\<^sub>1_det by auto
   finally show ?thesis.
 qed
 
 lemma \<L>\<^sub>b_split_GS_iter:
   assumes "\<And>s'. s' < s \<Longrightarrow> v' s' = GS.\<L>\<^sub>b_split v s'" "\<And>s'. s' \<ge> s \<Longrightarrow> v' s' = v s'"
   shows "GS.\<L>\<^sub>b_split v s = (\<Squnion>a \<in> A s. L\<^sub>a a v' s)"
   unfolding \<L>\<^sub>b_split_GS using assms[symmetric] by (auto simp: bfun_if.rep_eq cong: if_cong)
 
 function GS_rec_upto where
   "GS_rec_upto n v s = (
   if n \<le> s 
   then v 
   else GS_rec_upto n (v(s := (\<Squnion>a \<in> A s. r (s, a) + l * measure_pmf.expectation (K (s, a)) v))) (Suc s))"
   by auto
 termination
   by (relation "Wellfounded.measure (\<lambda>(n,v,s). n - s)") auto
 
 lemmas GS_rec_upto.simps[simp del]
 
 lemma GS_rec_upto_ge:
   assumes "s' \<ge> n"
   shows "GS_rec_upto n v s s' = v s'"
   using assms
   by (induction s arbitrary: s' rule: GS_rec_upto.induct) (fastforce simp add:  GS_rec_upto.simps)
 
 lemma GS_rec_upto_less:
   assumes "s > s'"
   shows "GS_rec_upto n v s s' = v s'"
   using assms 
   by (induction s arbitrary: s' rule: GS_rec_upto.induct) (auto simp: GS_rec_upto.simps)
 
 lemma GS_rec_upto_eq:
   assumes "s < n"
   shows "GS_rec_upto n v s s = (\<Squnion>a \<in> A s. L\<^sub>a a v s)"
   using assms
 proof (induction n v s rule: GS_rec_upto.induct)
   case (1 n v s)
   then show ?case
     using GS_rec_upto_less by (cases "Suc s < n") (auto simp add: GS_rec_upto.simps)
 qed
 
 lemma GS_rec_upto_Suc:
   assumes "s' < n"
   shows "GS_rec_upto (Suc n) v s s' = GS_rec_upto n v s s'"
   using assms
 proof (induction n v s arbitrary: s' rule: GS_rec_upto.induct)
   case (1 n v s)
   then show ?case
     using GS_rec_upto_less by (fastforce simp: GS_rec_upto.simps)
 qed
 
 lemma GS_rec_upto_Suc':
   assumes "s \<le> n"
   shows "GS_rec_upto (Suc n) v s n = (\<Squnion>a \<in> A n. L\<^sub>a a (GS_rec_upto n v s) n)"
   using assms
 proof (induction n v s rule: GS_rec_upto.induct)
   case (1 n v s)
   then show ?case
     by (fastforce simp: not_less_eq_eq GS_rec_upto.simps)
 qed
 
 lemma GS_rec_upto_correct:
   assumes "s < n"
   shows "GS.\<L>\<^sub>b_split v s = GS_rec_upto n v 0 s"
   using assms
 proof (induction n arbitrary: s)
   case 0
   then show ?case
     by auto
 next
   case (Suc n)
   then show ?case
   proof (cases "s < n")
     case True
     thus ?thesis
       using Suc.IH by (auto simp: GS_rec_upto_Suc)
   next
     case False
     hence "s = n"
       using Suc by auto
     thus ?thesis
       using Suc.IH GS_rec_upto_ge by (auto simp: GS_rec_upto_Suc' intro: \<L>\<^sub>b_split_GS_iter)
   qed
 qed
 
 end
 end
 
diff --git a/thys/Markov_Models/ex/Crowds_Protocol.thy b/thys/Markov_Models/ex/Crowds_Protocol.thy
--- a/thys/Markov_Models/ex/Crowds_Protocol.thy
+++ b/thys/Markov_Models/ex/Crowds_Protocol.thy
@@ -1,988 +1,988 @@
 (* Author: Johannes Hölzl <hoelzl@in.tum.de> *)
 
 section \<open>Formalization of the Crowds-Protocol\<close>
 
 theory Crowds_Protocol
   imports "../Discrete_Time_Markov_Chain"
 begin
 
 lemma cond_prob_nonneg[simp]: "0 \<le> cond_prob M A B"
   by (auto simp: cond_prob_def)
 
 lemma (in MC_syntax) emeasure_suntil_geometric:
   assumes [measurable]: "Measurable.pred S P"
   assumes "s \<in> X" and *[simp]: "0 \<le> p" "0 \<le> r"
   assumes r: "\<And>s. s \<in> X \<Longrightarrow> emeasure (T s) {\<omega>\<in>space (T s). P \<omega>} = ennreal r"
   assumes p: "\<And>s. s \<in> X \<Longrightarrow> emeasure (K s) X = ennreal p" "p < 1"
   assumes "\<And>t. AE \<omega> in T t. \<not> (P \<sqinter> (HLD X \<sqinter> nxt (HLD X suntil P))) \<omega>"
   shows "emeasure (T s) {\<omega>\<in>space (T s). (HLD X suntil P) \<omega>} = r / (1 - p)"
 proof (subst emeasure_suntil_disj)
   let ?F = "\<lambda>F s. emeasure (T s) {\<omega> \<in> space (T s). P \<omega>} + \<integral>\<^sup>+ t. F t * indicator X t \<partial>K s"
   let ?f = "\<lambda>x. ennreal r + ennreal p * x"
 
   have "mono ?F" "mono ?f"
     by (auto intro!: monoI max.mono add_mono nn_integral_mono mult_left_mono mult_right_mono simp: le_fun_def)
 
   have 1: "lfp ?f \<le> lfp ?F s"
     using \<open>s \<in> X\<close>
   proof (induction arbitrary: s rule: lfp_ordinal_induct[OF \<open>mono ?f\<close>])
     case step: (1 x)
     then have "?f x \<le> ?F (\<lambda>_. x) s"
       by (auto simp: p r[simplified] nn_integral_cmult mult.commute[of _ x]
                intro!: add_mono mult_right_mono)
     also have "?F (\<lambda>_. x) \<le> ?F (lfp ?F)"
       using step
       by (intro le_funI add_mono order_refl nn_integral_mono) (auto simp: split: split_indicator)
     finally show ?case
       by (subst lfp_unfold[OF \<open>mono ?F\<close>]) (auto simp: le_fun_def)
   qed (auto intro!: Sup_least)
   also have 2: "lfp ?F s \<le> r / (1 - p)"
     using \<open>s \<in> X\<close>
   proof (induction arbitrary: s rule: lfp_ordinal_induct[OF \<open>mono ?F\<close>])
     case (1 S)
     with r have "?F S s \<le> ennreal r + (\<integral>\<^sup>+x. ennreal (r / (1 - p)) * indicator X x \<partial>K s)"
       by (intro add_mono nn_integral_mono) (auto split: split_indicator)
     also have "\<dots> \<le> ennreal r + ennreal (r * p / (1 - p))"
       using \<open>s \<in> X\<close> by (simp add: nn_integral_cmult_indicator p ennreal_mult''[symmetric])
     also have "\<dots> = ennreal (r / (1 - p))"
       using \<open>p < 1\<close> by (simp add: field_simps ennreal_plus[symmetric] del: ennreal_plus)
     finally show ?case .
   qed (auto intro!: SUP_least)
   finally obtain x where x: "lfp ?f = ennreal x" and [simp]: "0 \<le> x"
     by (cases "lfp ?f") (auto simp: top_unique)
   from \<open>p < 1\<close> have "\<And>x. x = r + p * x \<Longrightarrow> x = r / (1 - p)"
     by (auto simp: field_simps)
   with lfp_unfold[OF \<open>mono ?f\<close>] \<open>p < 1\<close> have "lfp ?f = r / (1 - p)"
     unfolding x by (auto simp add: ennreal_plus[symmetric] ennreal_mult[symmetric] simp del: ennreal_plus)
   with 1 2 show "lfp ?F s = ennreal (r / (1 - p))"
     by auto
 qed fact+
 
 subsection \<open>Definition of the Crowds-Protocol\<close>
 
 datatype 'a state = Start | Init 'a | Mix 'a | End
 
 lemma inj_Mix[simp]: "inj_on Mix A"
   by (auto intro: inj_onI)
 
 lemma inj_Init[simp]: "inj_on Init A"
   by (auto intro: inj_onI)
 
 lemma distinct_state_image[simp]:
   "Start \<notin> Mix ` A" "Init j \<notin> Mix ` A" "End \<notin> Mix ` A" "Mix j \<in> Mix ` A \<longleftrightarrow> j \<in> A"
   "Start \<notin> Init ` A" "Mix j \<notin> Init ` A" "End \<notin> Init ` A" "Init j \<in> Init ` A \<longleftrightarrow> j \<in> A"
   by auto
 
 lemma Init_cut_Mix[simp]:
   "Init ` H \<inter> Mix ` J = {}"
   by auto
 
 abbreviation "Jondo B \<equiv> Init`B \<union> Mix`B"
 
 locale Crowds_Protocol =
   fixes J :: "'a set" and C :: "'a set" and p_f :: real and p_i :: "'a \<Rightarrow> real"
   assumes J_not_empty: "J \<noteq> {}" and finite_J[simp]: "finite J"
   assumes C_smaller: "C \<subset> J" and C_non_empty: "C \<noteq> {}"
   assumes p_f: "0 < p_f" "p_f < 1"
   assumes p_i_nonneg[simp]: "\<And>j. j \<in> J \<Longrightarrow> 0 \<le> p_i j"
   assumes p_i_distr: "(\<Sum>j\<in>J. p_i j) = 1"
   assumes p_i_C: "\<And>j. j \<in> C \<Longrightarrow> p_i j = 0"
 begin
 
 abbreviation H :: "'a set" where
   "H \<equiv> J - C"
 
 definition "p_j = 1 / card J"
 
 lemma p_f_nonneg[simp]: "0 \<le> p_f" "p_f \<le> 1"
   using p_f by simp_all
 
 lemma p_j_nonneg[simp]: "0 \<le> p_j"
   by (simp add: p_j_def)
 
 definition "p_H = card H / card J"
 
 lemma p_H_nonneg[simp]: "0 \<le> p_H" "p_H \<le> 1"
   by (auto simp: p_H_def divide_le_eq_1 card_gt_0_iff intro!: card_mono )
 
 definition next_prob :: "'a state \<Rightarrow> 'a state \<Rightarrow> real" where
   "next_prob s t = (case (s, t) of (Start, Init j) \<Rightarrow> if j \<in> H then p_i j else 0
                                  | (Init j, Mix j') \<Rightarrow> if j' \<in> J then p_j else 0
                                  | (Mix j, Mix j') \<Rightarrow> if j' \<in> J then p_f * p_j else 0
                                  | (Mix j, End) \<Rightarrow> 1 - p_f
                                  | (End, End) \<Rightarrow> 1
                                  | _ \<Rightarrow> 0)"
 
 definition "N s = embed_pmf (next_prob s)"
 
 interpretation MC_syntax N .
 
 abbreviation "\<PP> \<equiv> T Start"
 
 abbreviation "E s \<equiv> set_pmf (N s)"
 
 lemma finite_C[simp]: "finite C"
   using C_smaller finite_J by (blast intro: finite_subset)
 
 lemma sum_p_i_C[simp]: "sum p_i C = 0"
   by (auto intro: sum.neutral p_i_C)
 
 lemma sum_p_i_H[simp]: "sum p_i H = 1"
   using C_smaller by (simp add: sum_diff p_i_distr)
 
 lemma possible_jondo:
   obtains j where "j \<in> J" "j \<notin> C" "p_i j \<noteq> 0"
 proof (atomize_elim, rule ccontr)
   assume "\<not> (\<exists>j. j \<in> J \<and> j \<notin> C \<and> p_i j \<noteq> 0)"
   with p_i_C have "\<forall>j\<in>J. p_i j = 0"
     by auto
   with p_i_distr show False
     by simp
 qed
 
 lemma C_le_J[simp]: "card C < card J"
   using C_smaller
   by (intro psubset_card_mono) auto
 
 lemma p_H: "0 < p_H" "p_H < 1"
   using J_not_empty C_smaller C_non_empty
   by (simp_all add: p_H_def card_Diff_subset card_mono field_simps zero_less_divide_iff card_gt_0_iff)
 
 lemma p_H_p_f_pos: "0 < p_H * p_f"
   using p_f p_H by (simp add: zero_less_mult_iff)
 
 lemma p_H_p_f_less_1: "p_H * p_f < 1"
 proof -
   have "p_H * p_f < 1 * 1"
     using p_H p_f by (intro mult_strict_mono) auto
   then show "p_H * p_f < 1" by simp
 qed
 
 lemma p_j_pos: "0 < p_j"
   unfolding p_j_def using J_not_empty by auto
 
 lemma H_compl: "1 - p_H = real (card C) / real (card J)"
   using C_non_empty J_not_empty C_smaller
   by (simp add: p_H_def card_Diff_subset card_mono of_nat_diff divide_eq_eq field_simps)
 
 lemma H_compl2: "1 - p_H = card C * p_j"
   unfolding H_compl p_j_def by simp
 
 lemma H_eq2: "card H * p_j = p_H"
   unfolding p_j_def p_H_def by simp
 
 lemma pmf_next_pmf[simp]: "pmf (N s) t = next_prob s t"
   unfolding N_def
 proof (rule pmf_embed_pmf)
   show "\<And>x. 0 \<le> next_prob s x"
     using p_j_pos p_f by (auto simp: next_prob_def intro: p_i_nonneg split: state.split)
   show "(\<integral>\<^sup>+ x. ennreal (next_prob s x) \<partial>count_space UNIV) = 1"
     using p_f J_not_empty
     by (subst nn_integral_count_space'[where A="Init`H \<union> Mix`J \<union> {End}"])
        (auto simp: next_prob_def sum.reindex sum.union_disjoint p_i_distr p_j_def
              split: state.split)
 qed
 
 lemma next_prob_Start[simp]: "next_prob Start (Init j) = (if j \<in> H then p_i j else 0)"
   by (auto simp: next_prob_def)
 
 lemma next_prob_to_Init[simp]: "j \<in> H \<Longrightarrow> next_prob s (Init j) =
     (case s of Start \<Rightarrow> p_i j | _ \<Rightarrow> 0)"
   by (cases s) (auto simp: next_prob_def)
 
 lemma next_prob_to_Mix[simp]: "j \<in> J \<Longrightarrow> next_prob s (Mix j) =
     (case s of Init j \<Rightarrow> p_j | Mix j \<Rightarrow> p_f * p_j | _ \<Rightarrow> 0)"
   by (cases s) (auto simp: next_prob_def)
 
 lemma next_prob_to_End[simp]: "next_prob s End =
     (case s of Mix j \<Rightarrow> 1 - p_f | End \<Rightarrow> 1 | _ \<Rightarrow> 0)"
   by (cases s) (auto simp: next_prob_def)
 
 lemma next_prob_from_End[simp]: "next_prob End s = 0 \<longleftrightarrow> s \<noteq> End"
   by (cases s) (auto simp: next_prob_def)
 
 lemma next_prob_Mix_MixI: "\<exists>j. s = Mix j \<Longrightarrow> \<exists>j\<in>J. s' = Mix j \<Longrightarrow> next_prob s s' = p_f * p_j"
   by (cases s) auto
 
 
 lemma E_Start: "E Start = {Init j | j. j \<in> H \<and> p_i j \<noteq> 0 }"
   using p_i_C by (auto simp: set_pmf_iff next_prob_def split: state.splits if_split_asm)
 
 lemma E_Init: "E (Init j) = {Mix j | j. j \<in> J }"
   using p_j_pos C_smaller by (auto simp: set_pmf_iff next_prob_def split: state.splits if_split_asm)
 
 lemma E_Mix: "E (Mix j) = {Mix j | j. j \<in> J } \<union> {End}"
   using p_j_pos p_f by (auto simp: set_pmf_iff next_prob_def split: state.splits if_split_asm)
 
 lemma E_End: "E End = {End}"
   by (auto simp: set_pmf_iff next_prob_def split: state.splits if_split_asm)
 
 lemma enabled_End:
   "enabled End \<omega> \<longleftrightarrow> \<omega> = sconst End"
 proof safe
   assume "enabled End \<omega>" then show "\<omega> = sconst End"
   proof (coinduction arbitrary: \<omega>)
     case Eq_stream then show ?case
       by (auto simp: enabled.simps[of _ \<omega>] E_End)
   qed
 next
   show "enabled End (sconst End)"
     by coinduction (simp add: E_End)
 qed
 
 lemma AE_End: "(AE \<omega> in T End. P \<omega>) \<longleftrightarrow> P (sconst End)"
 proof -
   have "(AE \<omega> in T End. P \<omega>) \<longleftrightarrow> (AE \<omega> in T End. P \<omega> \<and> \<omega> = sconst End)"
     using AE_T_enabled[of End] by (simp add: enabled_End)
   also have "\<dots> = (AE \<omega> in T End. P (sconst End) \<and> \<omega> = sconst End)"
     by (simp add: enabled_End del: AE_conj_iff cong: rev_conj_cong)
   also have "\<dots> = (AE \<omega> in T End. P (sconst End))"
     using AE_T_enabled[of End] by (simp add: enabled_End)
   finally show ?thesis
     by simp
 qed
 
 lemma emeasure_Init_eq_Mix:
   assumes [measurable]: "Measurable.pred S P"
   assumes AE_End: "AE x in T End. \<not> P (End ## x)"
   shows "emeasure (T (Init j)) {x\<in>space (T (Init j)). P x} =
     emeasure (T (Mix j)) {x\<in>space (T (Mix j)). P x} / p_f"
 proof -
   have *: "{Mix j | j. j \<in> J } = Mix ` J"
     by auto
   show ?thesis
     using emeasure_eq_0_AE[OF AE_End] p_f
     apply (subst (1 2) emeasure_Collect_T)
     apply simp
     apply (subst (1 2) nn_integral_measure_pmf_finite)
     apply (auto simp: E_Mix E_Init * sum.reindex sum_distrib_right[symmetric] divide_ennreal
       ennreal_times_divide[symmetric])
     done
 qed
 
 text \<open>
 
 What is the probability that the server sees a specific jondo (including the initiator) as sender.
 
 \<close>
 
 definition visit :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a state stream \<Rightarrow> bool" where
   "visit I L = Init`(I \<inter> H) \<cdot> (HLD (Mix`J) suntil (Mix`(L \<inter> J) \<cdot> HLD {End}))"
 
 lemma visit_unique1:
   "visit I1 L1 \<omega> \<Longrightarrow> visit I2 L2 \<omega> \<Longrightarrow> I1 \<inter> I2 \<noteq> {}"
   by (auto simp: visit_def HLD_iff)
 
 lemma visit_unique2:
   assumes "visit I1 L1 \<omega>" "visit I2 L2 \<omega>"
   shows "L1 \<inter> L2 \<noteq> {}"
 proof -
   let ?U = "\<lambda>L \<omega>. (HLD (Mix`J) suntil ((Mix`(L\<inter>J)) \<cdot> HLD {End})) \<omega>"
   have "?U L1 (stl \<omega>)" "?U L2 (stl \<omega>)"
     using assms by (auto simp: visit_def)
   then show "L1 \<inter> L2 \<noteq> {}"
   proof (induction "stl \<omega>" arbitrary: \<omega> rule: suntil_induct_strong)
     case base then show ?case
       by (auto simp add: suntil.simps[of _ _ "stl (stl \<omega>)"] suntil.simps[of _ _ "stl \<omega>"] HLD_iff)
   next
     case step
     show ?case
     proof cases
       assume "((Mix`(L2\<inter>J)) \<cdot> HLD {End}) (stl \<omega>)"
       with step.hyps show ?thesis
         by (auto simp: inj_Mix HLD_iff elim: suntil.cases)
     next
       assume "\<not> ((Mix`(L2\<inter>J)) \<cdot> HLD {End}) (stl \<omega>)"
       with step.prems have "?U L2 (stl (stl \<omega>))"
         by (auto elim: suntil.cases)
       then show ?thesis
         by (rule step.hyps(4)[OF refl])
     qed
   qed
 qed
 
 lemma visit_imp_in_H: "visit {i} J \<omega> \<Longrightarrow> i \<in> H"
   by (auto simp: visit_def HLD_iff)
 
 lemma emeasure_visit:
   assumes I: "I \<subseteq> H" and L: "L \<subseteq> J"
   shows "emeasure \<PP> {\<omega>\<in>space \<PP>. visit I L \<omega>} = (\<Sum>i\<in>I. p_i i) * (card L * p_j)"
 proof -
   let ?J = "HLD (Mix`J)" and ?E = "(Mix`L) \<cdot> HLD {End}"
   let ?\<phi> = "?J aand not ?E"
   let ?P = "\<lambda>x P. emeasure (T x) {\<omega>\<in>space (T x). P \<omega>}"
 
   have [intro]: "finite L"
     using finite_J \<open>L \<subseteq> J\<close> by (blast intro: finite_subset)
   have [simp, intro]: "finite I"
     using finite_J \<open>I \<subseteq> H\<close> by (blast intro: finite_subset)
 
   { fix j assume j: "j \<in> H"
     have "?P (Mix j) (?J suntil ?E) = (p_f * p_j * (1 - p_f) * card L) / (1 - p_f)"
     proof (rule emeasure_suntil_geometric)
       fix s assume s: "s \<in> Mix ` J"
       then have "?P s ?E = (\<integral>\<^sup>+x. ennreal (1 - p_f) * indicator (Mix`L) x \<partial>N s)"
         by (auto simp add: emeasure_HLD_nxt emeasure_HLD AE_measure_pmf_iff emeasure_pmf_single
                  split: state.split split_indicator simp del: space_T nxt.simps
                  intro!: nn_integral_cong_AE)
       also have "\<dots> = ennreal (1 - p_f) * emeasure (N s) (Mix`L)"
         using p_f by (intro nn_integral_cmult_indicator) auto
       also have "\<dots> = ennreal ((1 - p_f) * card L * p_j * p_f)"
         using s assms
         by (subst emeasure_measure_pmf_finite)
            (auto simp: sum.reindex subset_eq ennreal_mult mult_ac)
       finally show "?P s ?E = p_f * p_j * (1 - p_f) * card L"
         by simp
     next
       show "\<And>t. AE \<omega> in T  t. \<not> (?E \<sqinter> (?J \<sqinter> nxt (?J suntil ?E))) \<omega>"
         by (intro AE_I2) (auto simp: HLD_iff elim: suntil.cases)
     qed (insert p_f j, auto simp: emeasure_measure_pmf_finite sum.reindex p_j_def)
     then have "?P (Init j) (?J suntil ?E) = (p_f * p_j * (1 - p_f) * card L) / (1 - p_f) / p_f"
       by (subst emeasure_Init_eq_Mix) (simp_all add:  suntil.simps[of _ _ "x ## s" for x s] divide_ennreal p_f)
     then have "?P (Init j) (?J suntil ?E) = p_j * card L"
       using p_f by simp }
   note J_suntil_E = this
 
   have "?P Start (visit I L) = (\<integral>\<^sup>+x. ?P x (?J suntil ?E) * indicator (Init`I) x \<partial>N Start)"
     unfolding visit_def using I L by (subst emeasure_HLD_nxt) (auto simp: Int_absorb2)
   also have "\<dots> = (\<integral>\<^sup>+x. ennreal (p_j * card L) * indicator (Init`I) x \<partial>N Start)"
     using I J_suntil_E
     by (intro nn_integral_cong ennreal_mult_right_cong)
        (auto split: split_indicator_asm)
   also have "\<dots> = ennreal ((\<Sum>i\<in>I. p_i i) * card L * p_j)"
     using p_j_pos assms
     by (subst nn_integral_cmult_indicator)
        (auto simp: emeasure_measure_pmf_finite sum.reindex subset_eq ennreal_mult[symmetric] sum_nonneg)
   finally show ?thesis by (simp add: ac_simps)
 qed
 
 lemma measurable_visit[measurable]: "Measurable.pred S (visit I L)"
   by (simp add: visit_def)
 
 lemma AE_visit: "AE \<omega> in \<PP>. visit H J \<omega>"
 proof (rule T.AE_I_eq_1)
   show "emeasure \<PP> {\<omega>\<in>space \<PP>. visit H J \<omega>} = 1"
     using J_not_empty by (subst emeasure_visit ) (simp_all add: p_j_def)
 qed simp
 
 subsection \<open>Server gets no information\<close>
 
 lemma server_view1: "j \<in> J \<Longrightarrow> \<P>(\<omega> in \<PP>. visit H {j} \<omega>) = p_j"
   unfolding measure_def by (subst emeasure_visit) simp_all
 
 lemma server_view_indep:
   "L \<subseteq> J \<Longrightarrow> I \<subseteq> H \<Longrightarrow> \<P>(\<omega> in \<PP>. visit I L \<omega>) = \<P>(\<omega> in \<PP>. visit H L \<omega>) * \<P>(\<omega> in \<PP>. visit I J \<omega>)"
   unfolding measure_def
   by (subst (1 2 3) emeasure_visit) (auto simp: p_j_def sum_nonneg subset_eq)
 
 lemma server_view: "\<P>(\<omega> in \<PP>. \<exists>j\<in>H. visit {j} {j} \<omega>) = p_j"
   using finite_J
 proof (subst T.prob_sum[where I="H" and P="\<lambda>j. visit {j} {j}"])
   show "(\<Sum>j\<in>H. \<P>(\<omega> in \<PP>. visit {j} {j} \<omega>)) = p_j"
     by (auto simp: measure_def emeasure_visit sum_distrib_right[symmetric] simp del: space_T sets_T)
   show "AE x in \<PP>. (\<forall>n\<in>H. visit {n} {n} x \<longrightarrow> (\<exists>j\<in>H. visit {j} {j} x)) \<and>
                 ((\<exists>j\<in>H. visit {j} {j} x) \<longrightarrow> (\<exists>!n. n \<in> H \<and> visit {n} {n} x))"
     by (auto dest: visit_unique1)
 qed simp_all
 
 subsection \<open>Probability that collaborators gain information\<close>
 
 definition "hit_C = Init`H \<cdot> ev (HLD (Mix`C))"
 definition "before_C B = (HLD (Jondo H)) suntil ((Jondo (B \<inter> H)) \<cdot> HLD (Mix ` C))"
 
 lemma measurable_hit_C[measurable]: "Measurable.pred S hit_C"
   by (simp add: hit_C_def)
 
 lemma measurable_before_C[measurable]: "Measurable.pred S (before_C B)"
   by (simp add: before_C_def)
 
 lemma before_C:
   assumes \<omega>: "enabled Start \<omega>"
   shows "before_C B \<omega> \<longleftrightarrow>
     ((Init`H \<cdot> (HLD (Mix`H) suntil (Mix`(B \<inter> H) \<cdot> HLD (Mix`C)))) or (Init`(B \<inter> H) \<cdot> HLD (Mix`C))) \<omega>"
 proof -
   { fix \<omega> s assume "((HLD (Jondo H)) suntil (Jondo (B \<inter> H) \<cdot> HLD (Mix ` C))) \<omega>"
       "enabled s \<omega>" "s \<in> Jondo H"
     then have "(HLD (Mix ` H) suntil (Mix ` (B \<inter> H) \<cdot> (HLD (Mix ` C)))) \<omega>"
     proof (induction arbitrary: s)
       case (base \<omega>) then show ?case
         by (auto simp: HLD_iff enabled.simps[of _ \<omega>] E_Init E_Mix intro!: suntil.intros(1))
     next
       case (step \<omega>) from step.prems step.hyps step.IH[of "shd \<omega>"] show ?case
         by (auto simp: HLD_iff enabled.simps[of _ \<omega>] E_Init E_Mix
                        suntil.simps[of _ _ \<omega>] enabled_End suntil_sconst)
     qed }
   note this[of "stl \<omega>" "shd \<omega>"]
   moreover
   { fix \<omega> s assume "(HLD (Mix ` H) suntil (Mix ` (B \<inter> H) \<cdot> (HLD (Mix ` C)))) \<omega>"
       "enabled s \<omega>" "s \<in> Jondo H"
     then have "((HLD (Jondo H)) suntil ((Jondo (B \<inter> H)) \<cdot> HLD (Mix ` C))) \<omega>"
     proof (induction arbitrary: s)
       case (step \<omega>) from step.prems step.hyps step.IH[of "shd \<omega>"] show ?case
         by (auto simp: HLD_iff enabled.simps[of _ \<omega>] E_Init E_Mix
                        suntil.simps[of _ _ \<omega>] enabled_End suntil_sconst)
     qed (auto intro: suntil.intros simp: HLD_iff) }
   note this[of "stl \<omega>" "shd \<omega>"]
   ultimately show ?thesis
     using assms
     using \<open>enabled Start \<omega>\<close>
     unfolding before_C_def suntil.simps[of _ _ \<omega>] enabled.simps[of _ \<omega>]
     by (auto simp: E_Start HLD_iff)
 qed
 
 lemma before_C_unique:
   assumes \<omega>: "before_C I1 \<omega>" "before_C I2 \<omega>" shows "I1 \<inter> I2 \<noteq> {}"
   using \<omega> unfolding before_C_def
 proof induction
   case (base \<omega>) then show ?case
     by (auto simp add: suntil.simps[of _ _ \<omega>] suntil.simps[of _ _ "stl \<omega>"] HLD_iff)
 next
   case (step \<omega>) then show ?case
     by (auto simp add: suntil.simps[of _ _ \<omega>] suntil.simps[of _ _ "stl \<omega>"] HLD_iff)
 qed
 
 lemma hit_C_imp_before_C:
   assumes "enabled Start \<omega>" "hit_C \<omega>" shows "before_C H \<omega>"
 proof -
   let ?X = "Init`H \<union> Mix`H"
   { fix \<omega> s assume "ev (HLD (Mix`C)) \<omega>" "s\<in>?X" "enabled s \<omega>"
     then have "((HLD (Jondo H)) suntil (?X \<cdot> HLD (Mix ` C))) (s ## \<omega>)"
     proof (induction arbitrary: s rule: ev_induct_strong)
       case (step \<omega> s) from step.IH[of "shd \<omega>"] step.prems step.hyps show ?case
         by (auto simp: enabled.simps[of _ \<omega>] suntil_Stream E_Init E_Mix HLD_iff
           enabled_End ev_sconst)
     qed (auto simp: suntil_Stream) }
   from this[of "stl \<omega>" "shd \<omega>"] assms show ?thesis
     by (auto simp: before_C_def hit_C_def enabled.simps[of _ \<omega>] E_Start)
 qed
 
 lemma before_C_single:
   assumes "before_C I \<omega>" shows "\<exists>i\<in>I \<inter> H. before_C {i} \<omega>"
   using assms unfolding before_C_def by induction (auto simp: HLD_iff intro: suntil.intros)
 
 lemma before_C_imp_in_H: "before_C {i} \<omega> \<Longrightarrow> i \<in> H"
   by (auto dest: before_C_single)
 
 subsection \<open>The probability that the sender hits a collaborator\<close>
 
 lemma Pr_hit_C: "\<P>(\<omega> in \<PP>. hit_C \<omega>) = (1 - p_H) / (1 - p_H * p_f)"
 proof -
   let ?P = "\<lambda>x P. emeasure (T x) {\<omega>\<in>space (T x). P \<omega>}"
   let ?M = "HLD (Mix ` C)" and ?I = "Init`H" and ?J = "Mix`H"
   let ?\<phi> = "(HLD ?J) aand not ?M"
 
   { fix s assume s: "s \<in> Jondo J"
     have "AE \<omega> in T s. ev ?M \<omega> \<longleftrightarrow> (HLD ?J suntil ?M) \<omega>"
       using AE_T_enabled
     proof eventually_elim
       fix \<omega> assume \<omega>: "enabled s \<omega>"
       show "ev ?M \<omega> \<longleftrightarrow> (HLD ?J suntil ?M) \<omega>"
       proof
         assume "ev ?M \<omega>"
         from this \<omega> s show "(HLD ?J suntil ?M) \<omega>"
         proof (induct arbitrary: s rule: ev_induct_strong)
           case (step \<omega>) then show ?case
             by (auto simp: HLD_iff enabled.simps[of _ \<omega>] suntil.simps[of _ _ \<omega>] E_End E_Init E_Mix
                            enabled_End ev_sconst)
         qed (auto simp: HLD_iff E_Init intro: suntil.intros)
       qed (rule ev_suntil)
     qed }
   note ev_eq_suntil = this
 
   have "?P Start hit_C = (\<integral>\<^sup>+x. ?P x (ev ?M) * indicator ?I x \<partial>N Start)"
     unfolding hit_C_def by (rule emeasure_HLD_nxt) measurable
   also have "\<dots> = (\<integral>\<^sup>+x. ennreal ((1 - p_H) / (1 - p_f * p_H)) * indicator ?I x \<partial>N Start)"
   proof (intro nn_integral_cong ennreal_mult_right_cong refl)
     fix x assume "indicator (Init ` H) x \<noteq> 0"
     then have "x \<in> ?I"
       by (auto split: split_indicator_asm)
     { fix j assume j: "j \<in> H"
       with ev_eq_suntil[of "Mix j"] have "?P (Mix j) (ev ?M) = ?P (Mix j) ((HLD ?J) suntil ?M)"
         by (intro emeasure_eq_AE) auto
       also have "\<dots> = (((1 - p_H) * p_f)) / (1 - p_H * p_f)"
       proof (rule emeasure_suntil_geometric)
         fix s assume s: "s \<in> Mix ` H"
         from s C_smaller show "?P s ?M = ennreal ((1 - p_H) * p_f)"
           by (subst emeasure_HLD)
              (auto simp add: emeasure_measure_pmf_finite sum.reindex subset_eq p_j_def H_compl)
         from s show "emeasure (N s) (Mix`H) = p_H * p_f"
           by (auto simp: emeasure_measure_pmf_finite sum.reindex p_H_def p_j_def)
       qed (insert j, auto simp: HLD_iff p_H_p_f_less_1)
       finally have "?P (Init j) (ev ?M) = (1 - p_H) / (1 - p_H * p_f)"
         using p_f
         by (subst emeasure_Init_eq_Mix)
            (auto simp: ev_Stream AE_End ev_sconst HLD_iff mult_le_one divide_ennreal) }
     then show "?P x (ev ?M) = (1 - p_H) / (1 - p_f * p_H)"
       using \<open>x \<in> ?I\<close> by (auto simp: mult_ac)
   qed
   also have "\<dots> = ennreal ((1 - p_H) / (1 - p_H * p_f))"
     using p_j_pos p_H p_H_p_f_less_1
     by (subst nn_integral_cmult_indicator)
        (auto simp: emeasure_measure_pmf_finite sum.reindex subset_eq mult_ac
              intro!: divide_nonneg_nonneg)
   finally show ?thesis
     by (simp add: measure_def mult_le_one)
 qed
 
 lemma before_C_imp_hit_C:
   assumes "enabled Start \<omega>" "before_C B \<omega>"
   shows "hit_C \<omega>"
 proof -
   { fix \<omega> j assume "((HLD (Jondo H)) suntil (Jondo (B \<inter> H) \<cdot> HLD (Mix ` C))) \<omega>"
       "j \<in> H" "enabled (Mix j) \<omega>"
     then have "ev (HLD (Mix`C)) \<omega>"
     proof (induction arbitrary: j rule: suntil_induct_strong)
       case (step \<omega>) then show ?case
         by (auto simp: enabled.simps[of _ \<omega>] E_Mix enabled_End ev_sconst suntil_sconst HLD_iff)
     qed auto }
   from this[of "stl (stl \<omega>)"] assms show "hit_C \<omega>"
     by (force simp: before_C_def hit_C_def E_Start HLD_iff E_Init
       enabled.simps[of _ \<omega>] ev.simps[of _ \<omega>] suntil.simps[of _ _ \<omega>]
       enabled.simps[of _ "stl \<omega>"] ev.simps[of _ "stl \<omega>"] suntil.simps[of _ _ "stl \<omega>"])
 qed
 
 lemma negE: "\<not> P \<Longrightarrow> P \<Longrightarrow> False"
   by blast
 
 lemma Pr_visit_before_C:
   assumes L: "L \<subseteq> H" and I: "I \<subseteq> H"
   shows "\<P>(\<omega> in \<PP>. visit I J \<omega> \<and> before_C L \<omega> \<bar> hit_C \<omega> ) =
     (\<Sum>i\<in>I. p_i i) * card L * p_j * p_f + (\<Sum>i\<in>I \<inter> L. p_i i) * (1 - p_H * p_f)"
 proof -
   let ?M = "Mix`H"
   let ?P = "\<lambda>x P. emeasure (T x) {\<omega>\<in>space (T x). P \<omega>}"
   let ?V = "(visit I J aand before_C L) aand hit_C"
   let ?U = "HLD ?M suntil (Mix`L \<cdot> HLD (Mix`C))"
   let ?L = "HLD (Mix`C)"
 
   have IJ: "x \<in> I \<Longrightarrow> x \<in> J" for x
     using I by auto
 
   have [simp, intro]: "finite I" "finite L"
     using L I by (auto dest: finite_subset)
 
   have "?P Start ?V = ?P Start ((Init`I \<cdot> ?U) or (Init`(I \<inter> L) \<cdot> ?L))"
   proof (rule emeasure_Collect_eq_AE)
     show "AE \<omega> in \<PP>. ?V \<omega> \<longleftrightarrow> ((Init`I \<cdot> ?U) or (Init`(I \<inter> L) \<cdot> ?L)) \<omega>"
       using AE_T_enabled AE_visit
     proof eventually_elim
       case (elim \<omega>)
       then show ?case
         using before_C_imp_hit_C[of \<omega> "L"]  before_C[of \<omega> "L"] I L
         by (auto simp: visit_def HLD_iff Int_absorb2)
     qed
     show "Measurable.pred \<PP> ((Init`I \<cdot> ?U) or (Init`(I \<inter> L) \<cdot> ?L))"
       by measurable
   qed measurable
   also have "\<dots> = ?P Start (Init`I \<cdot> ?U) + ?P Start (Init`(I \<inter> L) \<cdot> ?L)"
     using L I
     apply (subst plus_emeasure)
     apply (auto intro!: arg_cong2[where f=emeasure])
     apply (subst (asm) suntil.simps)
     apply (auto simp add: HLD_iff[abs_def] elim: suntil.cases)
     done
   also have "?P Start (Init`(I \<inter> L) \<cdot> ?L) = (\<Sum>i\<in>I\<inter>L. p_i i * (1 - p_H))"
     using L I C_smaller p_j_pos
     apply (subst emeasure_HLD_nxt emeasure_HLD, simp)+
     apply (subst nn_integral_indicator_finite)
     apply (auto simp: emeasure_measure_pmf_finite sum.reindex next_prob_def sum.If_cases
                       Int_absorb2 H_compl2 ennreal_mult[symmetric] sum_nonneg
                       sum_distrib_left[symmetric] sum_distrib_right[symmetric]
                 intro!: sum.cong sum_nonneg)
     apply (subst (asm) ennreal_inj)
     apply (auto intro!: mult_nonneg_nonneg sum_nonneg sum.mono_neutral_left elim!: negE)
     done
   also have "?P Start (Init`I \<cdot> ?U) = (\<Sum>i\<in>I. ?P (Init i) ?U * p_i i)"
     using I
     by (subst emeasure_HLD_nxt, simp)
        (auto simp: nn_integral_indicator_finite sum.reindex emeasure_measure_pmf_finite
              intro!: sum.cong[OF refl])
   also have "\<dots> = (\<Sum>i\<in>I. ennreal (p_f * (1 - p_H) * p_j * card L / (1 - p_H * p_f)) * p_i i)"
   proof (intro sum.cong refl arg_cong2[where f="(*)"])
     fix i assume "i \<in> I"
     with I have i: "i \<in> H"
       by auto
     have "?P (Mix i) ?U = (p_f * p_f * (1 - p_H) * p_j * card L / (1 - p_H * p_f))"
       unfolding before_C_def
     proof (rule emeasure_suntil_geometric[where X="?M"])
       show "Mix i \<in> ?M"
         using i by auto
     next
       fix s assume "s \<in> ?M"
       with p_f p_j_pos L C_smaller[THEN less_imp_le]
       show "?P s (Mix`L \<cdot> (HLD (Mix ` C))) = ennreal (p_f * p_f * (1 - p_H) * p_j * card L)"
         apply (simp add: emeasure_HLD emeasure_HLD_nxt del: nxt.simps space_T)
         apply (subst nn_integral_measure_pmf_support[of "Mix`L"])
         apply (auto simp add: subset_eq emeasure_measure_pmf_finite sum.reindex H_compl p_j_def
           ennreal_mult[symmetric] ennreal_of_nat_eq_real_of_nat)
         done
     next
       fix s assume "s \<in> ?M" then show "emeasure (N s) ?M = ennreal (p_H * p_f)"
         by (auto simp add: emeasure_measure_pmf_finite sum.reindex H_eq2)
     next
       show "AE \<omega> in T t. \<not> ((Mix ` L \<cdot> ?L) \<sqinter> (HLD (Mix ` H) \<sqinter> nxt ?U)) \<omega>" for t
         using L
         apply (simp add: AE_T_iff[of _ t])
         apply (subst AE_T_iff; simp)
         apply (auto simp: HLD_iff suntil_Stream)
         done
     qed (insert L, auto simp: p_H_p_f_less_1 E_Mix)
     then show "?P (Init i) ?U = p_f * (1 - p_H) * p_j * card L / (1 - p_H * p_f)"
       by (subst emeasure_Init_eq_Mix)
          (auto simp: AE_End suntil_Stream divide_ennreal mult_le_one p_f)
   qed
   finally have *: "\<P>(\<omega> in T Start. ?V \<omega>) =
       (p_f * (1 - p_H) * p_j * (card L) / (1 - p_H * p_f)) * (\<Sum>i\<in>I. p_i i) +
       (\<Sum>i\<in>I \<inter> L. p_i i) * (1 - p_H)"
     using sum_nonneg [of "I \<inter> L" p_i]  sum_nonneg [of "I" p_i]
     by (simp add: mult_ac measure_def sum_distrib_right[symmetric] sum_distrib_left[symmetric]
                   sum_divide_distrib[symmetric] IJ ennreal_mult[symmetric] 
                   mult_le_one ennreal_plus[symmetric]
              del: ennreal_plus)
   show ?thesis
     unfolding cond_prob_def Pr_hit_C *
     using *
     using p_f p_H p_j_pos p_H_p_f_less_1 by (simp add: divide_simps) (simp add: field_simps)
 qed
 
 lemma Pr_visit_eq_before_C:
   "\<P>(\<omega> in \<PP>. \<exists>j\<in>H. visit {j} J \<omega> \<and> before_C {j} \<omega> \<bar> hit_C \<omega> ) = 1 - (p_H - p_j) * p_f"
 proof -
   let ?V = "\<lambda>j. visit {j} J aand before_C {j}" and ?H = "hit_C"
   let ?J = "H"
   have "\<P>(\<omega> in \<PP>. (\<exists>j\<in>?J. ?V j \<omega>) \<and> ?H \<omega>) = (\<Sum>j\<in>?J. \<P>(\<omega> in \<PP>. (?V j aand ?H) \<omega>))"
   proof (rule T.prob_sum)
     show "AE \<omega> in \<PP>. (\<forall>j\<in>?J. (?V j aand ?H) \<omega> \<longrightarrow> ((\<exists>j\<in>?J. ?V j \<omega>) \<and> ?H \<omega>)) \<and>
       (((\<exists>j\<in>?J. ?V j \<omega>) \<and> ?H \<omega>) \<longrightarrow> (\<exists>!j. j\<in>?J \<and> (?V j aand ?H) \<omega>))"
       by (auto intro!: AE_I2 dest: visit_unique1)
   qed auto
   then have "\<P>(\<omega> in \<PP>. (\<exists>j\<in>?J. ?V j \<omega>) \<bar> ?H \<omega>) = (\<Sum>j\<in>?J. \<P>(\<omega> in \<PP>. ?V j \<omega> \<bar> ?H \<omega>))"
     by (simp add: cond_prob_def sum_divide_distrib)
   also have "\<dots> = p_j * p_f + (1 - p_H * p_f)"
     by (simp add: Pr_visit_before_C sum_distrib_right[symmetric] sum.distrib)
   finally show ?thesis
     by (simp add: field_simps)
 qed
 
 lemma probably_innocent:
   assumes approx: "1 / (2 * (p_H - p_j)) \<le> p_f" and "p_H \<noteq> p_j"
   shows "\<P>(\<omega> in \<PP>. \<exists>j\<in>H. visit {j} J \<omega> \<and> before_C {j} \<omega> \<bar> hit_C \<omega> ) \<le> 1 / 2"
   unfolding Pr_visit_eq_before_C
 proof -
   have [simp]: "\<And>n :: nat. 1 \<le> real n \<longleftrightarrow> 1 \<le> n" by auto
   have "0 \<le> p_j" unfolding p_j_def by auto
   then have "1 * p_j \<le> p_H"
     unfolding H_eq2[symmetric] using C_smaller
     by (intro mult_mono) (auto simp: Suc_le_eq card_Diff_subset not_le)
   with \<open>p_H \<noteq> p_j\<close> have "p_j < p_H" by auto
   with approx show "1 - (p_H - p_j) * p_f \<le> 1 / 2"
     by (auto simp add: field_simps divide_le_eq split: if_split_asm)
 qed
 
 lemma Pr_before_C:
   assumes L: "L \<subseteq> H"
   shows "\<P>(\<omega> in \<PP>. before_C L \<omega> \<bar> hit_C \<omega> ) =
     card L * p_j * p_f + (\<Sum>l\<in>L. p_i l) * (1 - p_H * p_f)"
 proof -
   have "\<P>(\<omega> in \<PP>. before_C L \<omega> \<bar> hit_C \<omega> ) =
     \<P>(\<omega> in \<PP>. visit H J \<omega> \<and> before_C L \<omega> \<bar> hit_C \<omega> )"
     using AE_visit by (auto intro!: T.cond_prob_eq_AE)
   also have "\<dots> = card L * p_j * p_f + (\<Sum>i\<in>L. p_i i) * (1 - p_H * p_f)"
     using L by (subst Pr_visit_before_C[OF L order_refl]) (auto simp: Int_absorb1)
   finally show ?thesis .
 qed
 
 lemma P_visit:
   assumes I: "I \<subseteq> H"
   shows "\<P>(\<omega> in \<PP>. visit I J \<omega> \<bar> hit_C \<omega> ) = (\<Sum>i\<in>I. p_i i)"
 proof -
   have "\<P>(\<omega> in \<PP>. visit I J \<omega> \<bar> hit_C \<omega> ) =
     \<P>(\<omega> in \<PP>. visit I J \<omega> \<and> before_C H \<omega> \<bar> hit_C \<omega> )"
   proof (rule T.cond_prob_eq_AE)
     show "AE x in \<PP>. hit_C x \<longrightarrow>
                 visit I J x = (visit I J x \<and> before_C H x)"
       using AE_T_enabled by eventually_elim (auto intro: hit_C_imp_before_C)
   qed auto
   also have "\<dots> = sum p_i I"
     using I by (subst Pr_visit_before_C[OF order_refl]) (auto simp: Int_absorb2 field_simps p_H_def p_j_def)
   finally show ?thesis .
 qed
 
 subsection \<open>Probability space of hitting a collaborator\<close>
 
 definition "hC = uniform_measure \<PP> {\<omega>\<in>space \<PP>. hit_C \<omega>}"
 
 lemma emeasure_hit_C_not_0: "emeasure \<PP> {\<omega> \<in> space \<PP>. hit_C \<omega>} \<noteq> 0"
   using p_H p_H_p_f_less_1 unfolding Pr_hit_C T.emeasure_eq_measure by auto
 
 lemma measurable_hC[measurable (raw)]:
   "A \<in> sets S \<Longrightarrow> A \<in> sets hC"
   "f \<in> measurable M S \<Longrightarrow> f \<in> measurable M hC"
   "g \<in> measurable S M \<Longrightarrow> g \<in> measurable hC M"
   "A \<inter> space S \<in> sets S \<Longrightarrow> A \<inter> space hC \<in> sets S"
   unfolding hC_def uniform_measure_def
   by simp_all
 
 lemma vimage_Int_space_C[simp]:
   "f -` {x} \<inter> space hC = {\<omega>\<in>space S. f \<omega> = x}"
   by (auto simp: hC_def)
 
 sublocale hC: information_space hC 2
 proof -
   interpret hC: prob_space hC
     unfolding hC_def
     using emeasure_hit_C_not_0
     by (intro prob_space_uniform_measure) auto
   show "information_space hC 2"
     by standard simp
 qed
 
 abbreviation
   mutual_information_Pow_CP ("\<I>'(_ ; _')") where
   "\<I>(X ; Y) \<equiv> hC.mutual_information 2 (count_space (X`space hC)) (count_space (Y`space hC)) X Y"
 
 lemma simple_functionI:
   assumes "finite (range f)"
   assumes [measurable]: "\<And>x. {\<omega>\<in>space S. f \<omega> = x} \<in> sets S"
   shows "simple_function hC f"
   using assms unfolding simple_function_def hC_def
   by (simp add: vimage_def space_stream_space)
 
 subsection \<open>Estimate the information to the collaborators\<close>
 
 lemma measure_hC[simp]:
   assumes A[measurable]: "A \<in> sets S"
   shows "measure hC A = \<P>(\<omega> in \<PP>. \<omega> \<in> A \<bar> hit_C \<omega> )"
   unfolding hC_def cond_prob_def
   using emeasure_hit_C_not_0 A
   by (subst measure_uniform_measure) (simp_all add: T.emeasure_eq_measure Int_def conj_ac)
 
 subsubsection \<open>Setup random variables for mutual information\<close>
 
 definition "first_J \<omega> = (THE i. visit {i} J \<omega>)"
 
 lemma first_J_eq:
   "visit {i} J \<omega> \<Longrightarrow> first_J \<omega> = i"
   unfolding first_J_def by (intro the_equality) (auto dest: visit_unique1)
 
 lemma AE_first_J:
   "AE \<omega> in \<PP>. visit {i} J \<omega> \<longleftrightarrow> first_J \<omega> = i"
   using AE_visit
 proof eventually_elim
   fix \<omega> assume "visit H J \<omega>"
   then obtain j where "visit {j} J \<omega>" "j \<in> H"
     by (auto simp: visit_def HLD_iff)
   then show "visit {i} J \<omega> \<longleftrightarrow> first_J \<omega> = i"
     by (auto dest: visit_unique1 first_J_eq)
 qed
 
 lemma measurbale_first_J[measurable]: "first_J \<in> measurable S (count_space UNIV)"
   unfolding first_J_def[abs_def]
   by (intro measurable_THE[where I=H])
      (auto dest: visit_imp_in_H visit_unique1 intro: countable_finite)
 
 definition "last_H \<omega> = (THE i. before_C {i} \<omega>)"
 
 lemma measurbale_last_H[measurable]: "last_H \<in> measurable S (count_space UNIV)"
   unfolding last_H_def[abs_def]
   by (intro measurable_THE[where I=H])
      (auto dest: before_C_single before_C_unique intro: countable_finite)
 
 lemma last_H_eq:
   "before_C {i} \<omega> \<Longrightarrow> last_H \<omega> = i"
   unfolding last_H_def by (intro the_equality) (auto dest: before_C_unique)
 
 lemma last_H:
   assumes "enabled Start \<omega>" "hit_C \<omega>"
   shows "before_C {last_H \<omega>} \<omega>" "last_H \<omega> \<in> H"
   by (metis before_C_single hit_C_imp_before_C last_H_eq Int_iff assms)+
 
 lemma AE_last_H:
   "AE \<omega> in \<PP>. hit_C \<omega> \<longrightarrow> before_C {i} \<omega> \<longleftrightarrow> last_H \<omega> = i"
   using AE_T_enabled
 proof eventually_elim
   fix \<omega> assume "enabled Start \<omega>" then show "hit_C \<omega> \<longrightarrow> before_C {i} \<omega> = (last_H \<omega> = i)"
     by (auto dest: last_H last_H_eq)
 qed
 
 lemma information_flow:
   defines "h \<equiv> real (card H)"
   assumes init_uniform: "\<And>i. i \<in> H \<Longrightarrow> p_i i = 1 / h"
   shows "\<I>(first_J ; last_H) \<le> (1 - (h - 1) * p_j * p_f) * log 2 h"
 proof -
   let ?il = "\<lambda>i l. \<P>(\<omega> in \<PP>. visit {i} J \<omega> \<and> before_C {l} \<omega> \<bar> hit_C \<omega> )"
   let ?i = "\<lambda>i. \<P>(\<omega> in \<PP>. visit {i} J \<omega> \<bar> hit_C \<omega> )"
   let ?l = "\<lambda>l. \<P>(\<omega> in \<PP>. before_C {l} \<omega> \<bar> hit_C \<omega> )"
 
   from init_uniform have init_H: "\<And>i. i \<in> H \<Longrightarrow> p_i i = p_j / p_H"
     by (simp add: p_j_def p_H_def h_def)
 
   from h_def have "1/h = p_j/p_H" "h = p_H / p_j" "p_H = h * p_j"
     by (auto simp: p_H_def p_j_def field_simps)
   from C_smaller have h_pos: "0 < h"
     by (auto simp add: card_gt_0_iff h_def)
 
   let ?s = "(h - 1) * p_j"
   let ?f = "?s * p_f"
 
   from psubset_card_mono[OF _ C_smaller]
   have "1 \<le> card J - card C"
     by (simp del: C_le_J)
   then have "1 \<le> h"
     using C_smaller
     by (simp add: h_def card_Diff_subset card_mono field_simps del: C_le_J)
 
   have log_le_0: "?f * log 2 (p_H * p_f) \<le> ?f * log 2 1"
     using p_H_p_f_less_1 p_H_p_f_pos p_j_pos p_f \<open>1 \<le> h\<close>
-    by (intro mult_left_mono log_le mult_nonneg_nonneg) auto
+    by (intro mult_left_mono log_mono mult_nonneg_nonneg) auto
 
   have "(h - 1) * p_j < 1"
     using \<open>1 \<le> h\<close> C_smaller
     by (auto simp: h_def p_j_def divide_less_eq card_Diff_subset card_mono)
   then have 1: "(h - 1) * p_j * p_f < 1 * 1"
     using p_f by (intro mult_strict_mono) auto
 
   { fix \<omega> have "first_J \<omega> \<in> H \<or> first_J \<omega> = (THE x. False)"
       apply (cases "\<forall>i. \<not> visit {i} J \<omega>")
       apply (simp add: first_J_def)
       apply (auto dest: visit_imp_in_H first_J_eq)
       done }
   then have range_fj: "range first_J \<subseteq> H \<union> {THE x. False}"
     by auto
 
   have sf_fj: "simple_function hC first_J"
     by (rule simple_functionI) (auto intro: finite_subset[OF range_fj])
 
   have sd_fj: "simple_distributed hC first_J ?i"
     apply (rule hC.simple_distributedI[OF sf_fj])
     apply (auto intro!: T.cond_prob_eq_AE)
     apply (auto simp: space_stream_space)
     using AE_first_J
     apply eventually_elim
     apply auto
     done
 
   { fix \<omega> have "last_H \<omega> \<in> H \<or> last_H \<omega> = (THE x. False)"
       apply (cases "\<forall>i. \<not> before_C {i} \<omega>")
       apply (simp add: last_H_def)
       apply (auto dest: before_C_imp_in_H last_H_eq)
       done }
   then have range_lnc: "range last_H \<subseteq> H \<union> {THE x. False}"
     by auto
 
   have sf_lnc: "simple_function hC last_H"
     by (rule simple_functionI) (auto intro: finite_subset[OF range_lnc])
 
   have sd_lnc: "simple_distributed hC last_H ?l"
     apply (rule hC.simple_distributedI[OF sf_lnc])
     apply (auto intro!: T.cond_prob_eq_AE)
     apply (auto simp: space_stream_space)
     using AE_last_H
     apply eventually_elim
     apply auto
     done
 
   have sd_fj_lnc: "simple_distributed hC (\<lambda>\<omega>. (first_J \<omega>, last_H \<omega>)) (\<lambda>(i, l). ?il i l)"
     apply (rule hC.simple_distributedI)
     apply (rule simple_function_Pair[OF sf_fj sf_lnc])
     apply (auto intro!: T.cond_prob_eq_AE)
     apply (auto simp: space_stream_space)
     using AE_last_H AE_first_J
     apply eventually_elim
     apply auto
     done
 
   define c where "c = (SOME j. j \<in> C)"
   have c: "c \<in> C"
     using C_non_empty unfolding ex_in_conv[symmetric] c_def by (rule someI_ex)
 
   let ?inner = "\<lambda>i. \<Sum>l\<in>H. ?il i l * log 2 (?il i l / (?i i * ?l l))"
   { fix i assume i: "i \<in> H"
     with h_pos have card_idx: "real_of_nat (card (H - {i})) = p_H / p_j - 1"
       by (auto simp add: p_j_def p_H_def h_def)
 
     have neq0: "p_j \<noteq> 0" "p_H \<noteq> 0"
       unfolding p_j_def p_H_def
       using C_smaller i by auto
 
     from i have "?inner i =
       (\<Sum>l\<in>H - {i}. ?il i l * log 2 (?il i l / (?i i * ?l l))) +
       ?il i i * log 2 (?il i i / (?i i * ?l i))"
       by (simp add: sum_diff)
     also have "\<dots> =
       (\<Sum>l\<in>H - {i}. p_j/p_H * p_j * p_f * log 2 (p_j * p_f / (p_j * p_f + p_j/p_H * (1 - p_H * p_f)))) +
       p_j/p_H * (p_j * p_f + (1 - p_H * p_f)) * log 2 ((p_j * p_f + (1 - p_H * p_f)) / (p_j * p_f + p_j/p_H * (1 - p_H * p_f)))"
       using i p_f p_j_pos p_H
       apply (simp add: Pr_visit_before_C P_visit init_H Pr_before_C
                   del: sum_constant)
       apply (simp add: divide_simps distrib_left)
       apply (intro arg_cong2[where f="(*)"] refl arg_cong2[where f=log])
       apply (auto simp: field_simps)
       done
     also have "\<dots> = (?f * log 2 (h * p_j * p_f) + (1 - ?f) * log 2 ((1 - ?f) * h)) / h"
       using neq0 p_f by (simp add: card_idx field_simps \<open>p_H = h * p_j\<close>)
     finally have "?inner i = (?f * log 2 (h * p_j * p_f) + (1 - ?f) * log 2 ((1 - ?f) * h)) / h" . }
   then have "(\<Sum>i\<in>H. ?inner i) = ?f * log 2 (h * p_j * p_f) + (1 - ?f) * log 2 ((1 - ?f) * h)"
     using h_pos by (simp add: h_def[symmetric])
   also have "\<dots> = ?f * log 2 (p_H * p_f) + (1 - ?f) * log 2 ((1 - ?f) * h)"
     by (simp add: \<open>h = p_H / p_j\<close>)
   also have "\<dots> \<le> (1 - ?f) * log 2 ((1 - ?f) * h)"
     using log_le_0 by simp
   also have "\<dots> \<le> (1 - ?f) * log 2 h"
     using h_pos \<open>1 \<le> h\<close> 1 p_j_pos p_f
-    by (intro mult_left_mono log_le mult_pos_pos mult_nonneg_nonneg) auto
+    by (intro mult_left_mono log_mono mult_pos_pos mult_nonneg_nonneg) auto
   finally have "(\<Sum>i\<in>H. ?inner i) \<le> (1 - ?f) * log 2 h" .
   also have "(\<Sum>i\<in>H. ?inner i) =
       (\<Sum>(i, l)\<in>(first_J`space S) \<times> (last_H`space S). ?il i l * log 2 (?il i l / (?i i * ?l l)))"
     unfolding sum.cartesian_product
   proof (safe intro!: sum.mono_neutral_cong_left del: DiffE DiffI)
     show "finite ((first_J ` space S) \<times> (last_H ` space S))"
       using sf_fj sf_lnc by (auto simp add: hC_def dest!: simple_functionD(1))
   next
     fix i assume "i \<in> H"
     then have "visit {i} J (Init i ## Mix i ## sconst End)"
       "before_C {i} (Init i ## Mix c ## sconst End)"
       by (auto simp: before_C_def visit_def suntil_Stream HLD_iff c)
     then show "i \<in> first_J ` space S" "i \<in> last_H ` space S"
       by (auto simp: space_stream_space image_iff eq_commute dest!: first_J_eq last_H_eq)
   next
     fix i l assume "(i, l) \<in> first_J ` space S \<times> last_H ` space S - H \<times> H"
     then have H: "i \<notin> H \<or> l \<notin> H"
       by auto
     have "\<P>(\<omega> in \<PP>. (visit {i} J \<omega> \<and> before_C {l} \<omega>) \<and> hit_C \<omega>) = 0"
       using H by (intro T.prob_eq_0_AE) (auto dest: visit_imp_in_H before_C_imp_in_H)
     then show "?il i l * log 2 (?il i l / (?i i * ?l l)) = 0"
       by (simp add: cond_prob_def)
   qed
   also have "\<dots> = \<I>(first_J ; last_H)"
     unfolding sum.cartesian_product
     apply (subst hC.mutual_information_simple_distributed[OF sd_fj sd_lnc sd_fj_lnc])
     apply (simp add: hC_def)
   proof (safe intro!: sum.mono_neutral_right imageI)
     show "finite ((first_J ` space S) \<times> (last_H ` space S))"
       using sf_fj sf_lnc by (auto simp add: hC_def dest!: simple_functionD(1))
   next
     fix i l assume "(first_J i, last_H l) \<notin> (\<lambda>x. (first_J x, last_H x)) ` space S"
     moreover
     { fix i l assume "i \<in> H" "l \<in> H"
       then have "visit {i} J (Init i ## Mix l ## Mix c ## sconst End)"
         "before_C {l} (Init i ## Mix l ## Mix c ## sconst End)"
         using c C_smaller by (auto simp: before_C_def visit_def HLD_iff suntil_Stream)
       then have "first_J (Init i ## Mix l ## Mix c ## sconst End) = i"
         "last_H (Init i ## Mix l ## Mix c ## sconst End) = l"
         by (auto intro!: first_J_eq last_H_eq) }
     note this[of "first_J i" "last_H l"]
     ultimately have "(first_J i, last_H l) \<notin> H\<times>H"
       by (auto simp: space_stream_space image_iff eq_commute) metis
     then have "\<P>(\<omega> in \<PP>. (visit {first_J i} J \<omega> \<and> before_C {last_H l} \<omega>) \<and> hit_C \<omega>) = 0"
       by (intro T.prob_eq_0_AE) (auto dest: visit_imp_in_H before_C_imp_in_H)
     then show "?il (first_J i) (last_H l) *
       log 2 (?il (first_J i) (last_H l) / (?i (first_J i) * ?l (last_H l))) = 0"
       by (simp add: cond_prob_def)
   qed
   finally show ?thesis by simp
 qed
 
 end
 
 end
diff --git a/thys/Probabilistic_While/Fast_Dice_Roll.thy b/thys/Probabilistic_While/Fast_Dice_Roll.thy
--- a/thys/Probabilistic_While/Fast_Dice_Roll.thy
+++ b/thys/Probabilistic_While/Fast_Dice_Roll.thy
@@ -1,415 +1,415 @@
 (* Title: Fast_Dice_Roll.thy
    Author: Andreas Lochbihler, ETH Zurich *)
 
 subsection \<open>Arbitrary uniform distributions\<close>
 
 theory Fast_Dice_Roll imports
   Bernoulli
   While_SPMF
 begin
 
 text \<open>This formalisation follows the ideas by J\'er\'emie Lumbroso \<^cite>\<open>"Lumbroso2013arxiv"\<close>.\<close>
 
 lemma sample_bits_fusion:
   fixes v :: nat
   assumes "0 < v"
   shows
   "bind_pmf (pmf_of_set {..<v}) (\<lambda>c. bind_pmf (pmf_of_set UNIV) (\<lambda>b. f (2 * c + (if b then 1 else 0)))) =
    bind_pmf (pmf_of_set {..<2 * v}) f"
   (is "?lhs = ?rhs")
 proof -
   have "?lhs = bind_pmf (map_pmf (\<lambda>(c, b). (2 * c + (if b then 1 else 0))) (pair_pmf (pmf_of_set {..<v}) (pmf_of_set UNIV))) f"
     (is "_ = bind_pmf (map_pmf ?f _) _")
     by(simp add: pair_pmf_def bind_map_pmf bind_assoc_pmf bind_return_pmf)
   also have "map_pmf ?f (pair_pmf (pmf_of_set {..<v}) (pmf_of_set UNIV)) = pmf_of_set {..<2 * v}"
     (is "?l = ?r" is "map_pmf ?f ?p = _")
   proof(rule pmf_eqI)
     fix i :: nat
     have [simp]: "inj ?f" by(auto simp add: inj_on_def) arith+
     define i' where "i' \<equiv> i div 2"
     define b where "b \<equiv> odd i"
     have i: "i = ?f (i', b)" by(simp add: i'_def b_def)
     show "pmf ?l i = pmf ?r i"
       by(subst i; subst pmf_map_inj')(simp_all add: pmf_pair i'_def assms lessThan_empty_iff split: split_indicator)
   qed
   finally show ?thesis .
 qed
 
 lemma sample_bits_fusion2:
   fixes v :: nat
   assumes "0 < v"
   shows
   "bind_pmf (pmf_of_set UNIV) (\<lambda>b. bind_pmf (pmf_of_set {..<v}) (\<lambda>c. f (c + v * (if b then 1 else 0)))) =
    bind_pmf (pmf_of_set {..<2 * v}) f"
   (is "?lhs = ?rhs")
 proof -
   have "?lhs = bind_pmf (map_pmf (\<lambda>(c, b). (c + v * (if b then 1 else 0))) (pair_pmf (pmf_of_set {..<v}) (pmf_of_set UNIV))) f"
     (is "_ = bind_pmf (map_pmf ?f _) _")
     unfolding pair_pmf_def by(subst bind_commute_pmf)(simp add: bind_map_pmf bind_assoc_pmf bind_return_pmf)
   also have "map_pmf ?f (pair_pmf (pmf_of_set {..<v}) (pmf_of_set UNIV)) = pmf_of_set {..<2 * v}"
     (is "?l = ?r" is "map_pmf ?f ?p = _")
   proof(rule pmf_eqI)
     fix i :: nat
     have [simp]: "inj_on ?f ({..<v} \<times> UNIV)" by(auto simp add: inj_on_def)
     define i' where "i' \<equiv> if i \<ge> v then i - v else i"
     define b where "b \<equiv> i \<ge> v"
     have i: "i = ?f (i', b)" by(simp add: i'_def b_def)
     show "pmf ?l i = pmf ?r i"
     proof(cases "i < 2 * v")
       case True
       thus ?thesis
         by(subst i; subst pmf_map_inj)(auto simp add: pmf_pair i'_def assms lessThan_empty_iff split: split_indicator)
     next
       case False
       hence "i \<notin> set_pmf ?l" "i \<notin> set_pmf ?r" 
         using assms by(auto simp add: lessThan_empty_iff split: if_split_asm)
       thus ?thesis by(simp add: set_pmf_iff del: set_map_pmf)
     qed
   qed
   finally show ?thesis .
 qed
 
 context fixes n :: nat notes [[function_internals]] begin
 
 text \<open>
   The check for @{term "v >= n"} should be done already at the start of the loop. 
   Otherwise we do not see why this algorithm should be optimal (when we start with @{term "v = n"}
   and @{term "c = n - 1"}, then it can go round a few loops before it returns something).
 
   We define the algorithm as a least fixpoint. To prove termination, we later show that it is
   equivalent to a while loop which samples bitstrings of a given length, which could in turn 
   be implemented as a loop.  The fixpoint formulation is more elegant because we do not need to
   nest any loops.
 \<close>
 
 partial_function (spmf) fast_dice_roll :: "nat \<Rightarrow> nat \<Rightarrow> nat spmf"
 where
   "fast_dice_roll v c = 
   (if v \<ge> n then if c < n then return_spmf c else fast_dice_roll (v - n) (c - n)
    else do {
      b \<leftarrow> coin_spmf;
      fast_dice_roll (2 * v) (2 * c + (if b then 1 else 0)) } )"
 
 lemma fast_dice_roll_fixp_induct [case_names adm bottom step]:
   assumes "spmf.admissible (\<lambda>fast_dice_roll. P (curry fast_dice_roll))"
   and "P (\<lambda>v c. return_pmf None)"
   and "\<And>fdr. P fdr \<Longrightarrow> P (\<lambda>v c. if v \<ge> n then if c < n then return_spmf c else fdr (v - n) (c - n)
         else bind_spmf coin_spmf (\<lambda>b. fdr (2 * v) (2 * c + (if b then 1 else 0))))"
   shows "P fast_dice_roll"
 using assms by(rule fast_dice_roll.fixp_induct)
 
 definition fast_uniform :: "nat spmf"
 where "fast_uniform = fast_dice_roll 1 0"
 
 lemma spmf_fast_dice_roll_ub:
   assumes "0 < v"
   shows "spmf (bind_pmf (pmf_of_set {..<v}) (fast_dice_roll v)) x \<le> (if x < n then 1 / n else 0)"
   (is "?lhs \<le> ?rhs")
 proof -
   have "ennreal ?lhs \<le> ennreal ?rhs" using assms
   proof(induction arbitrary: v x rule: fast_dice_roll_fixp_induct)
     case adm thus ?case 
       by(rule cont_intro ccpo_class.admissible_leI)+ simp_all
     case bottom thus ?case by simp
     case (step fdr)
     show ?case (is "?lhs \<le> ?rhs")
     proof(cases "n \<le> v")
       case le: True
       then have "?lhs = spmf (bind_pmf (pmf_of_set {..<v}) (\<lambda>c. if c < n then return_spmf c else fdr (v - n) (c - n))) x"
         by simp
       also have "\<dots> = (\<integral>\<^sup>+ c'. indicator (if x < n then {x} else {}) c' \<partial>measure_pmf (pmf_of_set {..<v})) +
         (\<integral>\<^sup>+ c'. indicator {n ..< v} c' * spmf (fdr (v - n) (c' - n)) x \<partial>measure_pmf (pmf_of_set {..<v}))"
         (is "?then = ?found + ?continue") using step.prems
         by(subst nn_integral_add[symmetric])(auto simp add: ennreal_pmf_bind AE_measure_pmf_iff lessThan_empty_iff split: split_indicator intro!: nn_integral_cong_AE)
       also have "?found = (if x < n then 1 else 0) / v" using step.prems le
         by(auto simp add: measure_pmf.emeasure_eq_measure measure_pmf_of_set lessThan_empty_iff Iio_Int_singleton)
       also have "?continue = (\<integral>\<^sup>+ c'. indicator {n ..< v} c' * 1 / v * spmf (fdr (v - n) (c' - n)) x \<partial>count_space UNIV)"
         using step.prems by(auto simp add: nn_integral_measure_pmf lessThan_empty_iff ennreal_mult[symmetric] intro!: nn_integral_cong split: split_indicator)
       also have "\<dots> = (if v = n then 0 else ennreal ((v - n) / v) * spmf (bind_pmf (pmf_of_set {n..<v}) (\<lambda>c'. fdr (v - n) (c' - n))) x)"
         using le step.prems
         by(subst ennreal_pmf_bind)(auto simp add: ennreal_mult[symmetric] nn_integral_measure_pmf nn_integral_0_iff_AE AE_count_space nn_integral_cmult[symmetric] split: split_indicator)
       also {
         assume *: "n < v"
         then have "pmf_of_set {n..<v} = map_pmf ((+) n) (pmf_of_set {..<v - n})"
           by(subst map_pmf_of_set_inj)(auto 4 3 simp add: inj_on_def lessThan_empty_iff intro!: arg_cong[where f=pmf_of_set] intro: rev_image_eqI[where x="_ - n"] diff_less_mono)
         also have "bind_pmf \<dots> (\<lambda>c'. fdr (v - n) (c' - n)) = bind_pmf (pmf_of_set {..<v - n}) (fdr (v - n))"
           by(simp add: bind_map_pmf)
         also have "ennreal (spmf \<dots> x) \<le> (if x < n then 1 / n else 0)" 
           by(rule step.IH)(simp add: *)
         also note calculation }
       then have "\<dots> \<le> ennreal ((v - n) / v) * (if x < n then 1 / n else 0)" using le
         by(cases "v = n")(auto split del: if_split intro: divide_right_mono mult_left_mono)
       also have "\<dots> = (v - n) / v * (if x < n then 1 / n else 0)" by(simp add: ennreal_mult[symmetric])
       finally show ?thesis using le by(auto simp add: add_mono field_simps of_nat_diff ennreal_plus[symmetric] simp del: ennreal_plus)
     next
       case False
       then have "?lhs = spmf (bind_pmf (pmf_of_set {..<v}) (\<lambda>c. bind_pmf (pmf_of_set UNIV) (\<lambda>b. fdr (2 * v) (2 * c + (if b then 1 else 0))))) x"
         by(simp add: bind_spmf_spmf_of_set)
       also have "\<dots> = spmf (bind_pmf (pmf_of_set {..<2 * v}) (fdr (2 * v))) x" using step.prems
         by(simp add: sample_bits_fusion[symmetric])
       also have "\<dots> \<le> ?rhs" using step.prems by(intro step.IH) simp
       finally show ?thesis .
     qed
   qed
   thus ?thesis by simp
 qed
 
 lemma spmf_fast_uniform_ub:
   "spmf fast_uniform x \<le> (if x < n then 1 / n else 0)"
 proof -
   have "{..<Suc 0} = {0}" by auto
   then show ?thesis using spmf_fast_dice_roll_ub[of 1 x]
     by(simp add: fast_uniform_def pmf_of_set_singleton bind_return_pmf split: if_split_asm)
 qed
 
 lemma fast_dice_roll_0 [simp]: "fast_dice_roll 0 c = return_pmf None"
 by(induction arbitrary: c rule: fast_dice_roll_fixp_induct)(simp_all add: bind_eq_return_pmf_None)
 
 text \<open>To prove termination, we fold all the iterations that only double into one big step\<close>
 
 definition fdr_step :: "nat \<Rightarrow> nat \<Rightarrow> (nat \<times> nat) spmf"
 where
   "fdr_step v c =
   (if v = 0 then return_pmf None
    else let x = 2 ^ (nat \<lceil>log 2 (max 1 n) - log 2 v\<rceil>) in
      map_spmf (\<lambda>bs. (x * v, x * c + bs)) (spmf_of_set {..<x}))"
 
 lemma fdr_step_unfold:
   "fdr_step v c =
   (if v = 0 then return_pmf None 
    else if n \<le> v then return_spmf (v, c)
    else do {
      b \<leftarrow> coin_spmf;
      fdr_step (2 * v) (2 * c + (if b then 1 else 0)) })"
   (is "?lhs = ?rhs" is "_ = (if _ then _ else ?else)")
 proof(cases "v = 0")
   case v: False
   define x where "x \<equiv> \<lambda>v :: nat. 2 ^ (nat \<lceil>log 2 (max 1 n) - log 2 v\<rceil>) :: nat"
   have x_pos: "x v > 0" by(simp add: x_def)
 
   show ?thesis
   proof(cases "n \<le> v")
     case le: True
-    hence "x v = 1" using v by(simp add: x_def log_le)
+    hence "x v = 1" using v by(simp add: x_def log_mono)
     moreover have "{..<1} = {0 :: nat}" by auto
     ultimately show ?thesis using le v by(simp add: fdr_step_def spmf_of_set_singleton)
   next
     case less: False
     hence even: "even (x v)" using v by(simp add: x_def)
     with x_pos have x_ge_1: "x v > 1" by(cases "x v = 1") auto
     have *: "x (2 * v) = x v div 2" using v less unfolding x_def 
       apply(simp add: log_mult diff_add_eq_diff_diff_swap)
       apply(rewrite in "_ = 2 ^ \<hole> div _" le_add_diff_inverse2[symmetric, where b=1])
        apply (simp add: Suc_leI)
       apply(simp del: Suc_pred)
       done
 
     have "?lhs = map_spmf (\<lambda>bs. (x v * v, x v * c + bs)) (spmf_of_set {..<x v})"
       using v by(simp add: fdr_step_def x_def Let_def)
     also from even have "\<dots> = bind_pmf (pmf_of_set {..<2 * (x v div 2)}) (\<lambda>bs. return_spmf (x v * v, x v * c + bs))"
       by(simp add: map_spmf_conv_bind_spmf bind_spmf_spmf_of_set x_pos lessThan_empty_iff)
     also have "\<dots> = bind_spmf coin_spmf (\<lambda>b. bind_spmf (spmf_of_set {..<x v div 2}) 
       (\<lambda>c'. return_spmf (x v * v, x v * c + c' + (x v div 2) * (if b then 1 else 0))))"
       using x_ge_1
       by(simp add: sample_bits_fusion2[symmetric] bind_spmf_spmf_of_set lessThan_empty_iff add.assoc)
     also have "\<dots> = bind_spmf coin_spmf (\<lambda>b. map_spmf (\<lambda>bs. (x (2 * v) * (2 * v), x (2 * v) * (2 * c + (if b then 1 else 0)) + bs)) (spmf_of_set {..<x (2 * v)}))"
       using * even by(simp add: map_spmf_conv_bind_spmf algebra_simps)
     also have "\<dots> = ?rhs" using v less by(simp add: fdr_step_def Let_def x_def)
     finally show ?thesis .
   qed
 qed(simp add: fdr_step_def)
 
 lemma fdr_step_induct [case_names fdr_step]: 
   "(\<And>v c. (\<And>b. \<lbrakk>v \<noteq> 0; v < n\<rbrakk> \<Longrightarrow> P (2 * v) (2 * c + (if b then 1 else 0))) \<Longrightarrow> P v c)
   \<Longrightarrow> P v c"
 apply induction_schema
 apply pat_completeness
 apply(relation "Wellfounded.measure (\<lambda>(v, c). n - v)")
 apply simp_all
 done
 
 partial_function (spmf) fdr_alt :: "nat \<Rightarrow> nat \<Rightarrow> nat spmf"
 where
   "fdr_alt v c = do {
     (v', c') \<leftarrow> fdr_step v c;
     if c' < n then return_spmf c' else fdr_alt (v' - n) (c' - n) }"
 
 lemma fast_dice_roll_alt: "fdr_alt = fast_dice_roll"
 proof(intro ext)
   show "fdr_alt v c = fast_dice_roll v c" for v c
   proof(rule spmf.leq_antisym)
     show "ord_spmf (=) (fdr_alt v c) (fast_dice_roll v c)"
     proof(induction arbitrary: v c rule: fdr_alt.fixp_induct[case_names adm bottom step])
       case adm show ?case by simp
       case bottom show ?case by simp
       case (step fdra)
       show ?case
       proof(induction v c rule: fdr_step_induct)
         case inner: (fdr_step v c)
         show ?case
           apply(rewrite fdr_step_unfold)
           apply(rewrite fast_dice_roll.simps)
           apply(auto intro!: ord_spmf_bind_reflI simp add: Let_def inner.IH step.IH)
           done
       qed
     qed
     have "ord_spmf (=) (fast_dice_roll v c) (fdr_alt v c)"
       and "fast_dice_roll 0 c = return_pmf None"
     proof(induction arbitrary: v c rule: fast_dice_roll_fixp_induct)
       case adm thus ?case by simp
       case bottom case 1 thus ?case by simp
       case bottom case 2 thus ?case by simp
       case (step fdr) case 1 show ?case
         apply(rewrite fdr_alt.simps)
         apply(rewrite fdr_step_unfold)
         apply(clarsimp simp add: Let_def)
         apply(auto intro!: ord_spmf_bind_reflI simp add: fdr_alt.simps[symmetric] step.IH rel_pmf_return_pmf2 set_pmf_bind_spmf o_def set_pmf_spmf_of_set split: if_split_asm)
         done
       case step case 2 from step.IH show ?case by(simp add: Let_def bind_eq_return_pmf_None)
     qed
     then show "ord_spmf (=) (fast_dice_roll v c) (fdr_alt v c)" by -
   qed
 qed
 
 lemma lossless_fdr_step [simp]: "lossless_spmf (fdr_step v c) \<longleftrightarrow> v > 0"
 by(simp add: fdr_step_def Let_def lessThan_empty_iff)
 
 lemma fast_dice_roll_alt_conv_while:
   "fdr_alt v c = 
   map_spmf snd (bind_spmf (fdr_step v c) (loop_spmf.while (\<lambda>(v, c). n \<le> c) (\<lambda>(v, c). fdr_step (v - n) (c - n))))"
 proof(induction arbitrary: v c rule: parallel_fixp_induct_2_1[OF partial_function_definitions_spmf partial_function_definitions_spmf fdr_alt.mono loop_spmf.while.mono fdr_alt_def loop_spmf.while_def, case_names adm bottom step])
   case adm show ?case by(simp)
   case bottom show ?case by simp
   case (step fdr while)
   show ?case using step.IH
     by(auto simp add: map_spmf_bind_spmf o_def intro!: bind_spmf_cong[OF refl])
 qed
 
 lemma lossless_fast_dice_roll: 
   assumes "c < v" "v \<le> n"
   shows "lossless_spmf (fast_dice_roll v c)"
 proof(cases "v < n")
   case True
   let ?I = "\<lambda>(v, c). c < v \<and> n \<le> v \<and> v < 2 * n"
   let ?f = "\<lambda>(v, c). if n \<le> c then n + c - v + 1 else 0"
   have invar: "?I (v', c')" if step: "(v', c') \<in> set_spmf (fdr_step (v - n) (c - n))" 
     and I: "c < v" "n \<le> v" "v < 2 * n" and c: "n \<le> c" for v' c' v c
   proof(clarsimp; safe)
     define x where "x = nat \<lceil>log 2 (max 1 n) - log 2 (v - n)\<rceil>"
     have **: "-1 < log 2 (real n / real (v - n))" by(rule less_le_trans[where y=0])(use I c in \<open>auto\<close>)
 
     from I c step obtain bs where v': "v' = 2 ^ x * (v - n)" 
       and c': "c' = 2 ^ x * (c - n) + bs"
       and bs: "bs < 2 ^ x"
       unfolding fdr_step_def x_def[symmetric] by(auto simp add: Let_def)
     have "2 ^ x * (c - n) + bs < 2 ^ x * (c - n + 1)" unfolding distrib_left using bs
       by(intro add_strict_left_mono) simp
     also have "\<dots> \<le> 2 ^ x * (v - n)" using I c by(intro mult_left_mono) auto
     finally show "c' < v'" using c' v' by simp
     
     have "v' = 2 powr x * (v - n)" by(simp add: powr_realpow v')
     also have "\<dots> < 2 powr (log 2 (max 1 n) - log 2 (v - n) + 1) * (v - n)"
       using ** I c by(intro mult_strict_right_mono)(auto simp add: x_def log_divide)
     also have "\<dots> \<le> 2 * n" unfolding powr_add using I c
       by(simp add: log_divide[symmetric] max_def)
     finally show "v' < 2 * n" using c' by(simp del: of_nat_add)
     
     have "log 2 (n / (v - n)) \<le> x" using I c ** by(auto simp add: x_def log_divide max_def)
     hence "2 powr log 2 (n / (v - n)) \<le> 2 powr x" by(rule powr_mono) simp
     also have "2 powr log 2 (n / (v - n)) = n / (v - n)" using I c by(simp)
     finally have "n \<le> real (2 ^ x * (v - n))" using I c by(simp add: field_simps powr_realpow)
     then show "n \<le> v'" by(simp add: v' del: of_nat_mult)
   qed
   
   have loop: "lossless_spmf (loop_spmf.while (\<lambda>(v, c). n \<le> c) (\<lambda>(v, c). fdr_step (v - n) (c - n)) (v, c))"
     if "c < 2 * n" and "n \<le> v" and "c < v" and "v < 2 * n"
     for v c
   proof(rule termination_variant_invar; clarify?)
     fix v c
     assume I: "?I (v, c)" and c: "n \<le> c"
     show "?f (v, c) \<le> n" using I c by auto
 
     define x where "x = nat \<lceil>log 2 (max 1 n) - log 2 (v - n)\<rceil>"
     define p :: real where "p \<equiv> 1 / (2 * n)"
 
     from I c have n: "0 < n" and v: "n < v" by auto
     from I c v n have x_pos: "x > 0" by(auto simp add: x_def max_def)
     
     have **: "-1 < log 2 (real n / real (v - n))" by(rule less_le_trans[where y=0])(use I c in \<open>auto\<close>)
     then have "x \<le> log 2 (real n) + 1" using v n
       by(auto simp add: x_def log_divide[symmetric] max_def field_simps intro: order_trans[OF of_int_ceiling_le_add_one])
     hence "2 powr x \<le> 2 powr \<dots>" by(rule powr_mono) simp
     hence "p \<le> 1 / 2 ^ x" unfolding powr_add using n
       by(subst (asm) powr_realpow, simp)(subst (asm) powr_log_cancel; simp_all add: p_def field_simps)
     also
     let ?X = "{c'. n \<le> 2 ^ x * (c - n) + c' \<longrightarrow> n + (2 ^ x * (c - n) + c') - 2 ^ x * (v - n) < n + c - v}"
     have "n + c * 2 ^ x - v * 2 ^ x < c + n - v" using I c
     proof(cases "n + c * 2 ^ x \<ge> v * 2 ^ x")
       case True
       have "(int c - v) * 2 ^ x < (int c - v) * 1"
         using x_pos I c by(intro mult_strict_left_mono_neg) simp_all
       then have "int n + c * 2 ^ x - v * 2 ^ x < c + int n - v" by(simp add: algebra_simps)
       also have "\<dots> = int (c + n - v)" using I c by auto
       also have "int n + c * 2 ^ x - v * 2 ^ x = int (n + c * 2 ^ x - v * 2 ^ x)"
         using True that by(simp add: of_nat_diff)
       finally show ?thesis by simp
     qed auto
     then have "{..<2 ^ x} \<inter> ?X \<noteq> {}" using that n v
       by(auto simp add: disjoint_eq_subset_Compl Collect_neg_eq[symmetric] lessThan_subset_Collect algebra_simps intro: exI[where x=0])
     then have "0 < card ({..<2 ^ x} \<inter> ?X)" by(simp add: card_gt_0_iff)
     hence "1 / 2 ^ x \<le> \<dots> / 2 ^ x" by(simp add: field_simps)
     finally show "p \<le> spmf (map_spmf (\<lambda>s'. ?f s' < ?f (v, c)) (fdr_step (v - n) (c - n))) True"
       using I c unfolding fdr_step_def x_def[symmetric]
       by(clarsimp simp add: Let_def spmf.map_comp o_def spmf_map measure_spmf_of_set vimage_def p_def)
 
     show "lossless_spmf (fdr_step (v - n) (c - n))" using I c by simp
     show "?I (v', c')" if step: "(v', c') \<in> set_spmf (fdr_step (v - n) (c - n))" for v' c' 
       using that by(rule invar)(use I c in auto)
   next
     show "(0 :: real) < 1 / (2 * n)" using that by(simp)
     show "?I (v, c)" using that by simp
   qed
   show ?thesis using assms True 
     by(auto simp add: fast_dice_roll_alt[symmetric] fast_dice_roll_alt_conv_while intro!: loop dest: invar[of _ _ "n + v" "n + c", simplified])
 next
   case False
   with assms have "v = n" by simp
   thus ?thesis using assms by(subst fast_dice_roll.simps) simp
 qed
 
 lemma fast_dice_roll_n0: 
   assumes "n = 0"
   shows "fast_dice_roll v c = return_pmf None"
   by(induction arbitrary: v c rule: fast_dice_roll_fixp_induct)(simp_all add: assms)
 
 lemma lossless_fast_uniform [simp]: "lossless_spmf fast_uniform \<longleftrightarrow> n > 0"
 proof(cases "n = 0")
   case True
   then show ?thesis using fast_dice_roll_n0 unfolding fast_uniform_def by(simp)
 next
   case False
   then show ?thesis by(simp add: fast_uniform_def lossless_fast_dice_roll)
 qed
 
 lemma spmf_fast_uniform: "spmf fast_uniform x = (if x < n then 1 / n else 0)"
 proof(cases "n > 0")
   case n: True
   show ?thesis using spmf_fast_uniform_ub
   proof(rule spmf_ub_tight)
     have "(\<Sum>\<^sup>+ x. ennreal (if x < n then 1 / n else 0)) = (\<Sum>\<^sup>+ x\<in>{..<n}. 1 / n)"
       by(auto simp add: nn_integral_count_space_indicator simp del: nn_integral_const intro: nn_integral_cong)
     also have "\<dots> = 1" using n by(simp add: field_simps ennreal_of_nat_eq_real_of_nat ennreal_mult[symmetric])
     also have "\<dots> = weight_spmf fast_uniform" using lossless_fast_uniform n unfolding lossless_spmf_def by simp
     finally show "(\<Sum>\<^sup>+ x. ennreal (if x < n then 1 / n else 0)) = \<dots>" .
   qed
 next
   case False
   with fast_dice_roll_n0[of 1 0] show ?thesis unfolding fast_uniform_def by(simp)
 qed
 
 end
 
 lemma fast_uniform_conv_uniform: "fast_uniform n = spmf_of_set {..<n}"
 by(rule spmf_eqI)(simp add: spmf_fast_uniform spmf_of_set)
 
 end
diff --git a/thys/Source_Coding_Theorem/Source_Coding_Theorem.thy b/thys/Source_Coding_Theorem/Source_Coding_Theorem.thy
--- a/thys/Source_Coding_Theorem/Source_Coding_Theorem.thy
+++ b/thys/Source_Coding_Theorem/Source_Coding_Theorem.thy
@@ -1,603 +1,602 @@
 (* Title:       One Part of Shannon's Source Coding Theorem
    Author:      Quentin Hibon <qh225@cl.cam.ac.uk>, Lawrence Paulson <lp15@cam.ac.uk>, 2014
    Maintainer:  Quentin Hibon <qh225@cl.cam.ac.uk>
 *)
 
 theory Source_Coding_Theorem
 imports "HOL-Probability.Information"
 begin
 section\<open>Basic types\<close>
 
 type_synonym bit = bool
 type_synonym bword = "bit list"
 type_synonym letter = nat
 type_synonym 'b word = "'b list"
 
 type_synonym 'b encoder = "'b word \<Rightarrow> bword"
 type_synonym 'b decoder = "bword \<Rightarrow> 'b word option"
 
 section\<open>Locale for the source coding theorem\<close>
 locale source_code = information_space +
   fixes fi :: "'b \<Rightarrow> real"
   fixes X :: "'a \<Rightarrow> 'b"
 
   assumes distr_i: "simple_distributed M X fi"
   assumes b_val: "b = 2"
 
   fixes enc::"'b encoder"
   fixes dec::"'b decoder"
   assumes real_code:
   "dec (enc x) = Some x"
   "enc w = [] \<longleftrightarrow> w = []"
   "x \<noteq> [] \<longrightarrow> enc x = enc [hd x] @ enc (tl x)"
 
 section\<open>Source coding theorem, direct: the entropy is a lower bound of the code rate\<close>
 context source_code
 begin
 subsection\<open>The letter set\<close>
 
 definition L :: "'b set" where
   "L \<equiv> X ` space M"
 
 lemma fin_L: "finite L"
     using L_def distr_i
     by auto
 
 lemma emp_L: "L \<noteq> {}"
     using L_def subprob_not_empty
     by auto
 
 subsection\<open>Codes and words\<close>
 
 abbreviation real_word :: "'b word \<Rightarrow> bool" where
   "real_word w \<equiv> (set w \<subseteq> L)"
 
 abbreviation k_words :: "nat \<Rightarrow> ('b word) set" where
   "k_words k \<equiv> {w. length w = k \<and> real_word w}"
 
 lemma rw_tail:
   assumes "real_word w"
 shows "w = [] \<or> real_word (tl w)"
     by (meson assms list.set_sel(2) subset_code(1))
 
 definition code_word_length :: "'e encoder \<Rightarrow> 'e \<Rightarrow> nat" where
   "code_word_length e l = length (e [l])"
 
 abbreviation cw_len :: "'b \<Rightarrow> nat" where
   "cw_len l \<equiv> code_word_length enc l"
 
 definition code_rate :: "'e encoder \<Rightarrow> ('a \<Rightarrow> 'e) \<Rightarrow> real" where
   "code_rate e Xo = expectation (\<lambda>a. (code_word_length e ((Xo) a)))"
 
 lemma fi_pos: "i\<in> L \<Longrightarrow> 0 \<le> fi i"
     using simple_distributed_nonneg[OF distr_i] L_def by auto
 
 lemma (in prob_space) simp_exp_composed:
   assumes X: "simple_distributed M X Px"
 shows "expectation (\<lambda>a. f (X a)) = (\<Sum>x \<in> X`space M. f x * Px x)"
   using distributed_integral[OF simple_distributed[OF X], of f]
     simple_distributed_nonneg[OF X]
     lebesgue_integral_count_space_finite[OF simple_distributed_finite[OF X], of "\<lambda>x. f x * Px x"]
   by (simp add:  ac_simps)
 
 lemma cr_rw:
   "code_rate enc X = (\<Sum>i \<in> X ` space M. fi i * cw_len i)"
     using simp_exp_composed[OF distr_i, of "cw_len"]
     by (simp add: mult.commute code_rate_def)
 
 abbreviation cw_len_concat :: "'b word \<Rightarrow> nat" where
   "cw_len_concat w \<equiv> foldr (\<lambda>x s. (cw_len x) + s) w 0"
 
 lemma cw_len_length: "cw_len_concat w = length (enc w)"
 proof (induction w)
     case Nil
     show ?case using real_code by simp
     case (Cons a w)
     have "cw_len_concat (a # w) = cw_len a + cw_len_concat w" by simp
     thus ?case using code_word_length_def real_code Cons
       by (metis length_append list.distinct(1) list.sel(1) list.sel(3))
 qed
 
 lemma maj_fold:
   assumes "\<And>l. l\<in>L \<Longrightarrow> f l \<le> bound"
   assumes "real_word w"
 shows "foldr (\<lambda>x s. f x + s) w 0 \<le> length w * bound"
     using assms
     by(induction w) (simp,fastforce)
 
 definition max_len :: "nat" where
   "max_len = Max ((\<lambda>x. cw_len x) ` L)"
 
 lemma max_cw:
   "l \<in> L \<Longrightarrow> cw_len l \<le> max_len"
     by (simp add: max_len_def fin_L)
 
 subsection\<open>Related to the Kraft theorem\<close>
 definition \<K> :: "real" where
   "\<K> = (\<Sum>i\<in>L. 1 / b ^ (cw_len i))"
 
 lemma pos_cw_len: "0 < 1 / b ^ cw_len i" using b_gt_1 by simp
 
 lemma \<K>_pos: "0 < \<K>"
     using emp_L fin_L pos_cw_len sum_pos \<K>_def
     by metis
 
 lemma \<K>_pow: "\<K> = (\<Sum>i\<in>L. 1 / b powr cw_len i)"
     using powr_realpow b_gt_1
     by (simp add: \<K>_def)
 
 lemma k_words_rel:
   "k_words (Suc k) = {w. (hd w \<in> L \<and> tl w \<in> k_words k \<and> w \<noteq> [])}"
 proof
     fix k
     show "k_words (Suc k) \<subseteq> {w. (hd w \<in> L \<and> tl w \<in> k_words k \<and> w \<noteq> [] )}" (is "?l \<subseteq> ?r")
   proof
       fix w
       assume w_kw: "w \<in> k_words (Suc k)"
       hence "real_word w" by simp
       hence "hd w \<in> L"
         by (metis (mono_tags) w_kw hd_in_set list.size(3) mem_Collect_eq nat.distinct(1) subset_code(1))
       moreover have "length w = Suc k" using w_kw by simp
       moreover hence "w \<noteq> []" by auto
       moreover have "real_word (tl w)" using \<open>real_word w\<close> calculation(3) rw_tail by auto
       ultimately show "w \<in> ?r" using w_kw by simp
   qed
 next
     fix k
     show "k_words (Suc k) \<supseteq> {w. (hd w \<in> L \<and> tl w \<in> k_words k \<and> w \<noteq> [])}"
   proof
       fix w
       assume asm: "w \<in> {w. hd w \<in> L \<and> tl w \<in> {w. length w = k \<and> real_word w} \<and> w \<noteq> []}"
       hence "hd w \<in> L \<and> length (tl w) = k \<and> real_word (tl w)" by simp
       hence "real_word w"
         by (metis empty_iff insert_subset list.collapse list.set(1) set_simps(2) subsetI)
       moreover hence "length w = Suc k" using asm by auto
       ultimately show "w \<in> k_words (Suc k)" by simp
   qed
 qed
 
 lemma bij_k_words:
 shows "bij_betw (\<lambda>wi. Cons (fst wi) (snd wi)) (L \<times> k_words k) (k_words (Suc k))"
     unfolding bij_betw_def
 proof
     fix k
     let ?f = "(\<lambda>wi. Cons (fst wi) (snd wi))"
     let ?S = "L \<times> (k_words k)"
     let ?T = "k_words (Suc k)"
     show "inj_on ?f ?S" by (simp add: inj_on_def)
     show "?f`?S = ?T"
   proof (rule ccontr)
       assume "?f ` ?S \<noteq> ?T"
       hence "\<exists>w. w\<in> ?T \<and> w \<notin> ?f`?S" by auto
       then obtain w where asm: "w\<in> ?T \<and> w \<notin> ?f`?S" by blast
       hence "w = ?f (hd w,tl w)" using k_words_rel by simp
       moreover have "(hd w,tl w) \<in> ?S" using k_words_rel asm by simp
       ultimately have "w \<in> ?f`?S" by blast
       thus "False" using asm by simp
   qed
 qed
 
 lemma finite_k_words: "finite (k_words k)"
 proof (induct k)
     case 0
     show ?case by simp
     case (Suc n)
     thus ?case using bij_k_words bij_betw_finite fin_L by blast
 qed
 
 lemma cartesian_product:
   fixes f::"('c \<Rightarrow> real)"
   fixes g::"('d \<Rightarrow> real)"
   assumes "finite A"
   assumes "finite B"
 shows "(\<Sum>b\<in>B. g b) * (\<Sum>a\<in>A. f a) = (\<Sum>ab\<in>A\<times>B. f (fst ab) * g (snd ab))"
     using bilinear_times bilinear_sum[where h="(\<lambda>x y. x * y)" and f="f" and g="g"] assms
     by (metis (erased, lifting) sum.cong split_beta' Groups.ab_semigroup_mult_class.mult.commute)
 
 lemma \<K>_power:
 shows "\<K>^k = (\<Sum>w \<in> (k_words k). 1 / b^(cw_len_concat w))"
 proof (induct k)
     case 0
     have "k_words 0 = {[]}" by auto
     thus ?case by simp
 next
     case (Suc n)
     have " \<K> ^Suc n = \<K> ^n * \<K> " by simp
     also have "\<dots> = (\<Sum>w \<in> k_words n. 1 / b^cw_len_concat w) * (\<Sum>i\<in>L. 1 / b^cw_len i)"
       using Suc.hyps \<K>_def by auto
     also have "\<dots> = (\<Sum>wi \<in> L \<times> k_words n. 1/b^cw_len (fst wi) * (1 / b^cw_len_concat (snd wi)))"
       using fin_L finite_k_words cartesian_product
       by blast
     also have "\<dots> = (\<Sum>wi \<in> L \<times> k_words n. 1 / b^(cw_len_concat (snd wi) + cw_len (fst wi)))"
       by (metis (no_types, lifting) power_add add.commute power_one_over)
     also have "\<dots> = (\<Sum>wi \<in> L \<times> k_words n. 1 / b^cw_len_concat (fst wi # snd wi))"
       by (metis (erased, lifting) add.commute comp_apply foldr.simps(2))
     also have "\<dots> = (\<Sum>w \<in> (k_words (Suc n)). 1 / b^(cw_len_concat w))"
       using sum.reindex_bij_betw [OF bij_k_words] by fastforce
     finally show ?case by simp
 qed
 
 lemma bound_len_concat:
 shows "w \<in> k_words k \<Longrightarrow> cw_len_concat w \<le> k * max_len"
     using max_cw maj_fold by blast
 
 subsection\<open>Inequality of the kraft sum (source coding theorem, direct)\<close>
 subsubsection\<open>Sum manipulation lemmas and McMillan theorem\<close>
 
 lemma sum_vimage_proof:
   fixes g::"nat \<Rightarrow> real"
   assumes "\<And>w. f w < bd"
 shows "finite S \<Longrightarrow> (\<Sum>w\<in>S. g (f w)) = (\<Sum> m=0..<bd. (card ((f-`{m}) \<inter> S) )* g m)"
 (is "_ \<Longrightarrow> _ = (\<Sum> m=0..<bd. ?ff m S)")
 proof (induct S rule: finite_induct)
     case empty
     show ?case by simp
 next
     case (insert x F)
     let ?rr = "(\<Sum>m = 0..<bd. ?ff m (insert x F))"
     have "(f x) \<in> {0..<bd}" using assms by simp
     hence "\<And>h::(nat \<Rightarrow> real). (\<Sum>m=0..<bd. h m) = (\<Sum>y\<in>({0..<bd} - {f x}).h y) + h (f x)"
       by (metis diff_add_cancel finite_atLeastLessThan sum_diff1)
     moreover hence
     "(\<Sum>m = 0..<bd. ?ff m (insert x F))
     = (\<Sum>m\<in>{0..<bd} - {f x}. ?ff m (insert x F)) + card (f -` {f x} \<inter> F) * g (f x) + g (f x)"
       by (simp add: semiring_normalization_rules(2), simp add: insert)
     ultimately have "(\<Sum>m = 0..<bd. ?ff m (insert x F)) = (\<Sum>m\<in>{0..<bd}. ?ff m F) + g (f x)"
       by fastforce
     thus ?case using insert by simp
 qed
 
 lemma sum_vimage:
   fixes g::"nat \<Rightarrow> real"
   assumes bounded: "\<And>w. w \<in> S \<Longrightarrow> f w < bd" and "0 < bd"
   assumes finite: "finite S"
 shows "(\<Sum>w\<in>S. g (f w)) = (\<Sum> m=0..<bd. (card ((f-`{m}) \<inter> S) ) * g m)"
 (is "?s1 = ?s2")
 proof -
     let ?ff = "(\<lambda>x. if x\<in>S then f x else 0)"
     let ?ss1 = "(\<Sum>w\<in>S. g (?ff w))"
     let ?ss2 = "(\<Sum> m=0..<bd. (card ((?ff-`{m}) \<inter> S) ) * g m)"
     have "?s1 =?ss1" by simp
     moreover have"\<And>m. ?ff -`{m} \<inter> S = f-`{m} \<inter> S" by auto
     moreover hence "?s2 = ?ss2" by simp
     moreover have "\<And>w . ?ff w < bd" using assms by simp
     moreover hence "?ss1 = ?ss2" using sum_vimage_proof[of "?ff"] finite by blast
     ultimately show "?s1 = ?s2" by metis
 qed
 
 lemma \<K>_rw:
   "(\<Sum>w \<in> (k_words k). 1 / b^(cw_len_concat w)) = (\<Sum>m=0..<Suc (k*max_len). card (k_words k \<inter>
 ((cw_len_concat) -` {m})) * (1 / b^m))" (is "?L = ?R")
 proof -
     have "\<And>w. w \<in> k_words k \<Longrightarrow> cw_len_concat w < Suc ( k * max_len)"
       by (simp add: bound_len_concat le_imp_less_Suc)
     moreover have
     "?R = (\<Sum>m = 0..<Suc (k * max_len).
   (card (cw_len_concat -` {m} \<inter> k_words k)) * (1 / b ^ m))"
       by (metis Int_commute)
     moreover have "0 < Suc (k*max_len)" by simp
     ultimately show ?thesis
       using finite_k_words
     sum_vimage[where f="cw_len_concat" and g = "\<lambda>i. 1/ (b^i)"]
       by fastforce
 qed
 
 definition set_of_k_words_length_m :: "nat \<Rightarrow> nat \<Rightarrow> 'b word set" where
   "set_of_k_words_length_m k m = {xk. xk \<in> k_words k} \<inter> (cw_len_concat)-`{m}"
 
 lemma am_inj_code: "inj_on enc ((cw_len_concat)-`{m})" (is "inj_on _ ?s")
   using inj_on_def[of enc "?s"] real_code
   by (metis option.inject)
 
 lemma img_inc: "enc`cw_len_concat-`{m} \<subseteq> {bl. length bl = m}" using cw_len_length by auto
 
 lemma bool_lists_card: "card {bl::bool list. length bl = m} = b^m"
  using card_lists_length_eq[of "UNIV::bool set"]
   by (simp add: b_val)
 
 lemma bool_list_fin: "finite {bl::bool list. length bl = m}"
   using finite_lists_length_eq[of "UNIV::bool set"]
   by (simp add: b_val)
 
 lemma set_of_k_words_bound:
 shows "card (set_of_k_words_length_m k m) \<le> b^m" (is "?c \<le> ?b")
 proof -
     have card_w_len_m_bound: "card (cw_len_concat-`{m}) \<le> b^m"
       by (metis (no_types, lifting) am_inj_code bool_list_fin bool_lists_card card_image card_mono
     img_inc of_nat_le_iff)
     have "set_of_k_words_length_m k m \<subseteq> (cw_len_concat)-`{m}"
       by (simp add: set_of_k_words_length_m_def)
     hence "card (set_of_k_words_length_m k m) \<le> card ((cw_len_concat)-`{m})"
       by (metis (no_types, lifting) am_inj_code bool_list_fin card.infinite card_0_eq
     card_image card_mono empty_iff finite_subset img_inc inf_img_fin_dom)
     thus ?thesis using card_w_len_m_bound by simp
 qed
 
 lemma empty_set_k_words:
   assumes "0 < k"
 shows "set_of_k_words_length_m k 0 = {}"
 proof(rule ccontr)
     assume "\<not> set_of_k_words_length_m k 0 = {}"
     hence "\<exists>x. x \<in> set_of_k_words_length_m k 0" by auto
     then obtain x where x_def: "x \<in> set_of_k_words_length_m k 0" by auto
     hence "x \<noteq> []" unfolding set_of_k_words_length_m_def using assms by auto
     moreover have "cw_len_concat (hd x#tl x) = cw_len_concat (tl x) + cw_len (hd x)"
       by (metis add.commute comp_apply foldr.simps(2))
     moreover have "enc [(hd x)] \<noteq> []" using assms real_code by blast
     moreover hence "0 < cw_len (hd x)" unfolding code_word_length_def by simp
     ultimately have "x \<notin> set_of_k_words_length_m k 0" by (simp add:set_of_k_words_length_m_def)
     thus "False" using x_def by simp
 qed
 
 lemma \<K>_rw2:
   assumes "0 < k"
 shows "(\<Sum>m=0..<Suc (k * max_len). card (set_of_k_words_length_m k m)/ b^m) \<le> (k * max_len)"
 proof -
     have
     "(\<Sum>m=1..<Suc (k * max_len). card (set_of_k_words_length_m k m) / b^m)
     \<le> (\<Sum>m=1..<Suc(k * max_len). b^m / b^m)"
       using set_of_k_words_bound b_val
     Groups_Big.sum_mono[of "{1..<Suc(k * max_len)}"
     "(\<lambda>m. (card (set_of_k_words_length_m k m))/b^m)" "\<lambda>m. b^m /b^m"]
       by simp
     moreover have"(\<Sum>m=1..<Suc(k * max_len). b^m / b^m) = (\<Sum>m=1..<Suc(k *max_len). 1)"
       using b_gt_1 by simp
     moreover have "(\<Sum>m=1..<Suc(k * max_len). 1) = (k * max_len)"
       by simp
     ultimately have
     "(\<Sum>m = 1..<Suc (k * max_len). card (set_of_k_words_length_m k m) / b ^ m) \<le> k * max_len"
       by (metis One_nat_def card_atLeastLessThan card_eq_sum diff_Suc_Suc real_of_card)
     thus ?thesis using empty_set_k_words assms
       by (simp add: sum_shift_lb_Suc0_0_upt split: if_split_asm)
 qed
 
 lemma \<K>_power_bound :
   assumes "0 < k"
 shows " \<K>^k \<le> k * max_len"
     using assms \<K>_power \<K>_rw \<K>_rw2
     by (simp add: set_of_k_words_length_m_def)
 
 theorem McMillan :
 shows "\<K> \<le> 1"
 proof -
     have ineq: "\<And>k. 0 < k \<Longrightarrow> \<K> \<le> root k k * root k max_len"
       using \<K>_pos \<K>_power_bound
       by (metis (no_types, opaque_lifting) not_less of_nat_0_le_iff of_nat_mult power_strict_mono real_root_mult real_root_pos_pos_le real_root_pos_unique real_root_power)
     hence "0 < max_len \<Longrightarrow> (\<lambda>k. root k k * root k max_len) \<longlonglongrightarrow> 1"
       by (auto intro!: tendsto_eq_intros LIMSEQ_root LIMSEQ_root_const)
     moreover have "\<forall>n\<ge>1. \<K> \<le> root n n * root n max_len"
       using ineq by simp
     moreover have "max_len = 0 \<Longrightarrow> \<K> \<le> 1" using ineq by fastforce
     ultimately show " \<K> \<le> 1" using LIMSEQ_le_const by blast
 qed
 
 lemma entropy_rw: "\<H>(X) = -(\<Sum>i \<in> L. fi i * log b (fi i))"
     using entropy_simple_distributed[OF distr_i]
     by (simp add: L_def)
 
 subsubsection\<open>Technical lemmas about the logarithm\<close>
 lemma log_mult_ext3:
   "0 \<le> x \<Longrightarrow> 0 < y \<Longrightarrow> 0 < z \<Longrightarrow> x * log b (x*y*z) = x * log b (x*y) + x * log b z"
     by(cases "x=0")(simp add: log_mult_eq abs_of_pos distrib_left less_eq_real_def)+
 
 lemma log_mult_ext2:
   "0 \<le> x \<Longrightarrow> 0 < y \<Longrightarrow> x * log b (x*y) = x * log b x + x * log b y"
     using log_mult_ext3[where y=1] by simp
 
 subsubsection \<open>KL divergence and properties\<close>
 definition KL_div ::"'b set \<Rightarrow> ('b \<Rightarrow> real) \<Rightarrow> ('b \<Rightarrow> real) \<Rightarrow> real" where
   "KL_div S a d = (\<Sum> i \<in> S. a i * log b (a i / d i))"
 
 lemma KL_div_mul:
   assumes "0 < d" "d \<le> 1"
   assumes "\<And>i. i\<in>S \<Longrightarrow> 0 \<le> a i"
   assumes "\<And>i. i\<in>S \<Longrightarrow> 0 < e i"
 shows "KL_div S a e \<ge> KL_div S a (\<lambda>i. e i / d)"
     unfolding KL_div_def
 proof -
     {
     fix i
     assume "i\<in>S"
     hence "a i / (e i / d) \<le> a i / e i" using assms
       by (metis (no_types) div_by_1 frac_le less_imp_triv not_less)
-    hence "log b (a i / (e i / d)) \<le> log b (a i / e i)" using assms(1)
-      by (metis (full_types) b_gt_1 divide_divide_eq_left inverse_divide le_less_linear log_le
-    log_neg_const order_refl times_divide_eq_right zero_less_mult_iff)
+    hence "log b (a i / (e i / d)) \<le> log b (a i / e i)" using assms
+      by (smt (verit, best) Transcendental.log_mono \<open>i \<in> S\<close> b_gt_1 diff_divide_distrib divide_pos_pos)
     }
     thus "(\<Sum>i\<in>S. a i * log b (a i / (e i / d))) \<le> (\<Sum>i\<in>S. a i * log b (a i / e i))"
       by (meson mult_left_mono assms sum_mono)
 qed
 
 lemma KL_div_pos:
   fixes a e::"'b \<Rightarrow> real"
   assumes fin: "finite S"
   assumes nemp: "S \<noteq> {}"
   assumes non_null: "\<And>i. i\<in>S \<Longrightarrow> 0 < a i" "\<And>i. i\<in> S \<Longrightarrow> 0 < e i"
   assumes sum_a_one: "(\<Sum> i \<in> S. a i) = 1"
   assumes sum_c_one: "(\<Sum> i \<in> S. e i) = 1"
 shows "0 \<le> KL_div S a e"
     unfolding KL_div_def
 proof -
     let ?f = "\<lambda>i. e i / a i"
     have f_pos: "\<And>i. i\<in>S \<Longrightarrow> 0 < ?f i"
       using non_null
       by simp
     have a_pos: "\<And>i. i\<in> S \<Longrightarrow> 0 \<le> a i"
       using non_null
       by (simp add: order.strict_implies_order)
     have "- log b (\<Sum>i\<in>S. a i * e i / a i) \<le> (\<Sum>i\<in>S. a i * - log b (e i / a i))"
       using convex_on_sum[OF fin nemp  minus_log_convex[OF b_gt_1] 
                              sum_a_one a_pos, of "\<lambda>i. e i / a i"] f_pos by simp
     also have "-log b (\<Sum>i\<in>S. a i * e i / a i) = -log b (\<Sum>i\<in>S. e i)"
   proof -
       from non_null(1) have "\<And>i. i \<in> S \<Longrightarrow> a i * e i / a i = e i" by force
       thus ?thesis by simp
   qed
     finally have "0 \<le> (\<Sum>i\<in>S. a i * - log b (e i / a i))"
       by (simp add: sum_c_one)
     thus "0 \<le> (\<Sum>i\<in>S. a i * log b (a i / e i))"
       using b_gt_1 log_divide non_null
       by simp
 qed
 
 lemma KL_div_pos_emp:
   "0 \<le> KL_div {} a e" by (simp add: KL_div_def)
 
 lemma KL_div_pos_gen:
   fixes a d::"'b \<Rightarrow> real"
   assumes fin: "finite S"
   assumes non_null: "\<And>i. i\<in>S \<Longrightarrow> 0 < a i" "\<And>i. i\<in> S \<Longrightarrow> 0 < d i"
   assumes sum_a_one: "(\<Sum> i \<in> S. a i) = 1"
   assumes sum_d_one: "(\<Sum> i \<in> S. d i) = 1"
 shows "0 \<le> KL_div S a d"
     using KL_div_pos KL_div_pos_emp assms by metis
 
 theorem KL_div_pos2:
   fixes a d::"'b \<Rightarrow> real"
   assumes fin: "finite S"
   assumes non_null: "\<And>i. i\<in>S \<Longrightarrow> 0 \<le> a i" "\<And>i. i\<in> S \<Longrightarrow> 0 < d i"
   assumes sum_a_one: "(\<Sum> i \<in> S. a i) = 1"
   assumes sum_c_one: "(\<Sum> i \<in> S. d i) = 1"
 shows "0 \<le> KL_div S a d"
 proof -
     have "S = (S \<inter> {i. 0 < a i}) \<union> (S \<inter> {i. 0 = a i})" using non_null(1) by fastforce
     moreover have "(S \<inter> {i. 0 < a i}) \<inter> (S \<inter> {i. 0 = a i}) = {}" by auto
     ultimately have
     eq: "KL_div S a d = KL_div (S \<inter> {i. 0 < a i}) a d + KL_div (S \<inter> {i. 0 = a i}) a d"
       unfolding KL_div_def
       by (metis (mono_tags, lifting) fin finite_Un sum.union_disjoint)
     have "KL_div (S \<inter> {i. 0 = a i}) a d = 0" unfolding KL_div_def by simp
     hence "KL_div S a d = KL_div (S \<inter> {i. 0 < a i}) a d" using eq by simp
     moreover have "0 \<le> KL_div (S \<inter> {i. 0 < a i}) a d"
   proof(cases "(S \<inter> {i. 0 < a i}) = {}")
       case True
       thus ?thesis unfolding KL_div_def by simp
   next
       case False
       let ?c = "\<lambda>i. d i / (\<Sum>j \<in>(S \<inter> {i. 0 < a i}). d j)"
       have 1: "(\<And>i. i \<in> S \<inter> {i. 0 < a i} \<Longrightarrow> 0 < a i)" by simp
       have 2: "(\<And>i. i \<in> S \<inter> {i. 0 < a i} \<Longrightarrow> 0 < ?c i)"
         by (metis False IntD1 divide_pos_pos fin finite_Int non_null(2) sum_pos)
       have 3: "(\<Sum>i\<in> (S \<inter> {i. 0 < a i}). a i) = 1"
         using sum.cong[of S, of S, of "(\<lambda>x. if x \<in> {i. 0 < a i} then a x else 0)", of a]
       sum.inter_restrict[OF fin, of a] non_null(1) sum_a_one
         by fastforce
       have "(\<Sum>i\<in>S \<inter> {j. 0 < a j}. ?c i) = (\<Sum>i\<in>S \<inter> {j. 0 < a j}. d i) / (\<Sum>i\<in>S \<inter> {j. 0 < a j}. d i)"
         by (metis sum_divide_distrib)
       hence 5: "(\<Sum>i\<in>S \<inter> {j. 0 < a j}. ?c i) = 1" using 2 False by force
       hence "0 \<le> KL_div (S \<inter> {j. 0 < a j}) a ?c"
         using KL_div_pos_gen[
       OF finite_Int[OF disjI1, of S, of "{j. 0 < a j}"], of a, of ?c
       ] 1 2 3
         by (metis fin)
       have fstdb: "0 < (\<Sum>i\<in>S \<inter> {i. 0 < a i}. d i)" using non_null(2) False
         by (metis Int_Collect fin finite_Int sum_pos)
       have 6: "0 \<le> KL_div (S \<inter> {i. 0 < a i}) a (\<lambda>i. d i / (\<Sum>i\<in>(S \<inter> {i. 0 < a i}). d i))"
         using 2 3 5
         KL_div_pos_gen[
       OF finite_Int[OF disjI1, OF fin], of "{i. 0 < a i}", of "a", of "?c"
       ]
         by simp
       hence
       "KL_div (S \<inter> {j. 0 < a j}) a (\<lambda>i. d i / (\<Sum>i\<in>(S \<inter> {i. 0 < a i}). d i)) \<le> KL_div (S \<inter> {j. 0 < a j}) a d"
         using non_null sum.inter_restrict[OF fin, of d, of "{i. 0 < a i}"]
         sum_mono[of S, of "(\<lambda>x. if x \<in> {i. 0 < a i} then d x else 0)", of d] non_null(2) sum_c_one
         non_null(2) fstdb KL_div_mul
         by force
       moreover have "0 \<le> KL_div (S \<inter> {j. 0 < a j}) a (\<lambda>i. d i / (\<Sum>i\<in>(S \<inter> {i. 0 < a i}). d i))"
         using KL_div_pos_gen[ OF finite_Int[OF disjI1, OF fin]] using 2 3 5 by fastforce
       ultimately show "0 \<le> KL_div (S \<inter> {j. 0 < a j}) a d" by simp
   qed
     ultimately show ?thesis by simp
 qed
 
 lemma sum_div_1:
   fixes f::"'b \<Rightarrow> 'c::field"
   assumes "(\<Sum>i\<in>A. f i) \<noteq> 0"
 shows "(\<Sum>i\<in>A. f i / (\<Sum>j\<in>A. f j)) = 1"
     by (metis (no_types) assms right_inverse_eq sum_divide_distrib)
 
 theorem rate_lower_bound:
 shows "\<H>(X) \<le> code_rate enc X"
 proof -
     let ?cr = "code_rate enc X"
     let ?r = "(\<lambda>i. 1 / ((b powr cw_len i) * \<K>))"
     have pos_pi: "\<And>i. i \<in> L \<Longrightarrow> 0 \<le> fi i" using fi_pos by simp
     {
     fix i
     assume "i \<in> L"
     hence
     "fi i * (log b (1 / (1 / b powr (cw_len i))) + log b (fi i))
     = fi i * log b (fi i / (1 / b powr (cw_len i)))"
       using log_mult_ext2 [OF pos_pi, of i] b_gt_1
       by simp (simp add: algebra_simps)
     }
     hence eqpi:
     "\<And>i. i\<in> L \<Longrightarrow> fi i * (log b (1 / (1 / b powr (cw_len i))) + log b (fi i))
     = fi i * log b (fi i / (1 / b powr (cw_len i)))"
       by simp
     have sum_one_L: "(\<Sum> i \<in> L. fi i) = 1"
       using simple_distributed_sum_space[OF distr_i] by (simp add: L_def)
     {
     fix i
     assume "i \<in> L"
     hence h1: "0 \<le> fi i" using pos_pi by blast
     have h2: "0 < \<K> / (1/b powr cw_len i)" using b_gt_1 \<K>_pos by auto
     have h3: "0 < 1 / \<K>" using \<K>_pos by simp
     have
     "fi i * log b (fi i * \<K> / (1/b powr cw_len i) * (1/ \<K>)) =
     fi i * log b (fi i * \<K> / (1/b powr cw_len i)) + fi i * log b (1/ \<K>)"
       using log_mult_ext3[OF h1 h2 h3]
       by (metis times_divide_eq_right)
     } hence big_eq:
     "\<And>i. i \<in> L \<Longrightarrow> fi i * log b (fi i * \<K> / (1/b powr cw_len i) * (1 / \<K>)) =
     fi i * log b (fi i * \<K> / (1/b powr cw_len i)) + fi i * log b (1 / \<K>)"
       by (simp add: inverse_eq_divide)
     have 1: "?cr - \<H>(X) = (\<Sum>i \<in> L. fi i * cw_len i) + (\<Sum>i \<in> L. fi i * log b (fi i))"
       using \<K>_def entropy_rw cr_rw L_def by simp
     also have 2: "(\<Sum>i\<in>L. fi i * cw_len i) = (\<Sum>i \<in> L. fi i * (-log b (1/(b powr (cw_len i)))))"
       using b_gt_1 log_divide by simp
     also have "\<dots> = -1 * (\<Sum>i \<in> L. fi i * (log b (1/(b powr (cw_len i)))))"
       using sum_distrib_left[of "-1" "(\<lambda>i. fi i * (- 1 * log b (1 / b powr (cw_len i))))" L]
       by simp
     finally have
     "?cr - \<H>(X) = -(\<Sum>i \<in> L. fi i * log b (1/b powr cw_len i)) + (\<Sum>i \<in> L. fi i * log b (fi i))"
       by simp
     have "?cr - \<H>(X) = (\<Sum>i \<in> L. fi i * ((log b (1/ (1/(b powr (cw_len i))))) + log b (fi i)))"
       using b_gt_1 1
       by (simp add: distrib_left sum.distrib)
     also have "\<dots> = (\<Sum>i \<in> L. fi i *((log b (fi i / (1/(b powr (cw_len i)))))))"
       using Finite_Cartesian_Product.sum_cong_aux[OF eqpi] by simp
     also from big_eq have
     "\<dots> = (\<Sum>i\<in>L. fi i * (log b (fi i * \<K> / (1 / b powr (cw_len i))))) + (\<Sum>i \<in> L. fi i) * log b (1/ \<K>)"
       using \<K>_pos
       by (simp add: sum_distrib_right sum.distrib)
     also have "\<dots> = (\<Sum>i\<in>L. fi i * (log b (fi i * \<K> / (1 / b powr (cw_len i))))) - log b (\<K>)"
       using \<K>_pos
       by (simp add: log_inverse_eq divide_inverse sum_one_L)
     also have "\<dots> = (\<Sum> i \<in> L. fi i * log b (fi i / ?r i)) - log b (\<K>)"
       by (metis (mono_tags, opaque_lifting) divide_divide_eq_left divide_divide_eq_right)
     also have "\<dots> = KL_div L fi ?r - log b ( \<K>)"
       using b_gt_1 \<K>_pos log_inverse KL_div_def
       by simp
     also have "\<dots> = KL_div L fi ?r + log b (1 / \<K>)"
       using log_inverse b_val \<K>_pos
       by (simp add: inverse_eq_divide)
     finally have code_ent_kl_log: "?cr - \<H>(X) = KL_div L fi ?r + log b (1 / \<K>)" by simp
     have "(\<Sum>i\<in>L. ?r i) = 1"
       using sum_div_1[of "\<lambda>i. 1 / (b powr (cw_len i))"] \<K>_pos \<K>_pow
       by simp
     moreover have "\<And>i. 0 < ?r i" using b_gt_1 \<K>_pos by simp
     moreover have "(\<Sum>i\<in>L. fi i) = 1" using sum_one_L by simp
     ultimately have "0 \<le> KL_div L fi ?r"
       using KL_div_pos2[OF fin_L fi_pos] by simp
     hence "log b (1 / \<K>) \<le> ?cr - \<H>(X)" using code_ent_kl_log by simp
     moreover from McMillan have "0 \<le> log b (1 / \<K>)"
       using \<K>_pos
       by (simp add: b_gt_1)
     ultimately show ?thesis by simp
 qed
 
 end
 
 end