theory Compress

imports Kyber_spec
        Mod_Plus_Minus
        Abs_Qr
        "HOL-Analysis.Finite_Cartesian_Product"

begin

context kyber_spec begin

section \<open>Compress and Decompress Functions\<close>

text \<open>Properties of the \<open>mod+-\<close> function.\<close>

lemma two_mid_lt_q:
  "2 * \<lfloor>real_of_int q/2\<rfloor> < q"
using oddE[OF prime_odd_int[OF q_prime q_gt_two]] by fastforce

lemma mod_plus_minus_range_q:
  assumes "y \<in> {-\<lfloor>q/2\<rfloor>..\<lfloor>q/2\<rfloor>}"
  shows "y mod+- q = y"
using mod_plus_minus_range[OF q_gt_zero, of y]
unfolding mod_plus_minus_def
proof (auto)
  have this': "y + \<lfloor>real_of_int q/2\<rfloor> \<in> {0..<q}"
  using assms two_mid_lt_q by auto
  have "(y + \<lfloor>real_of_int q/2\<rfloor>) mod q = (y + \<lfloor>real_of_int q/2\<rfloor>)"
    using mod_rangeE[OF this'] by auto
  then show "(y + \<lfloor>real_of_int q/2\<rfloor>) mod q - \<lfloor>real_of_int q/2\<rfloor>
     = y" by auto
qed

text \<open>Compression only works for $x \in \mathbb{Z}_q$ and outputs an integer
  in $\{0,\dots, 2^d-1\}$ , where $d$ is a positive integer with
  $d < \rceil\log_2 (q)\lceil$.
  For compression we omit the least important bits.
  Decompression rescales to the modulus q.\<close>

definition compress :: "nat \<Rightarrow> int \<Rightarrow> int" where
  "compress d x =
  round (real_of_int (2^d * x) / real_of_int q) mod (2^d)"

definition decompress :: "nat \<Rightarrow> int \<Rightarrow> int" where
  "decompress d x =
  round (real_of_int q * real_of_int x / real_of_int 2^d)"

lemma compress_zero: "compress d 0 = 0"
unfolding compress_def by auto

lemma decompress_zero: "decompress d 0 = 0"
unfolding decompress_def by auto

text \<open>Properties of the exponent $d$.\<close>

lemma d_lt_logq:
  assumes "of_nat d < \<lceil>(log 2 q)::real\<rceil>"
  shows "d< log 2 q"
using assms by linarith

lemma twod_lt_q:
  assumes "of_nat d < \<lceil>(log 2 q)::real\<rceil>"
  shows "2 powr (real d) < of_int q"
using assms less_log_iff[of 2 q d] d_lt_logq q_gt_zero
by auto

lemma prime_half:
  assumes "prime (p::int)"
          "p > 2"
  shows "\<lceil>p / 2\<rceil> > \<lfloor>p / 2\<rfloor>"
proof -
  have "odd p" using prime_odd_int[OF assms] .
  then have "\<lceil>p / 2\<rceil> > p/2"
  by (smt (verit, best) cos_npi_int cos_zero_iff_int
    le_of_int_ceiling mult.commute times_divide_eq_right)
  then have "\<lfloor>p / 2\<rfloor> < p/2"
  by (meson floor_less_iff less_ceiling_iff)
  then show ?thesis using \<open>\<lceil>p / 2\<rceil> > p/2\<close> by auto
qed

lemma break_point_gt_q_div_two:
  assumes "of_nat d < \<lceil>(log 2 q)::real\<rceil>"
  shows "\<lceil>q-(q/(2*2^d))\<rceil> > \<lfloor>q/2\<rfloor>"
proof -
  have "1/((2::real)^d) \<le> (1::real)"
    using one_le_power[of 2 d] by simp
  have "\<lceil>q-(q/(2*2^d))\<rceil> \<ge> q-(q/2)* (1/(2^d))" by simp
  moreover have "q-(q/2)* (1/(2^d)) \<ge> q - q/2"
    using \<open>1/((2::real)^d) \<le> (1::real)\<close>
    by (smt (z3) calculation divide_le_eq divide_nonneg_nonneg
      divide_self_if mult_left_mono of_int_nonneg
      times_divide_eq_right q_gt_zero)
  ultimately have "\<lceil>q-(q/(2*2^d))\<rceil> \<ge> \<lceil>q/2\<rceil> " by linarith
  moreover have "\<lceil>q/2\<rceil> > \<lfloor>q/2\<rfloor>"
    using prime_half[OF q_prime q_gt_two] .
  ultimately show ?thesis by auto
qed

lemma decompress_zero_unique:
  assumes "decompress d s = 0"
          "s \<in> {0..2^d - 1}"
          "of_nat d < \<lceil>(log 2 q)::real\<rceil>"
  shows "s = 0"
proof -
  let ?x = "real_of_int q * real_of_int s /
    real_of_int 2^d + 1/2"
  have "0 \<le> ?x \<and> ?x < 1" using assms(1)
     unfolding decompress_def round_def
    using floor_correct[of ?x] by auto
  then have "real_of_int q * real_of_int s /
    real_of_int 2^d < 1/2" by linarith
  moreover have "real_of_int q / real_of_int 2^d > 1"
    using twod_lt_q[OF assms(3)]
    by (simp add: powr_realpow)
  ultimately have "real_of_int s < 1/2"
  by (smt (verit, best) divide_less_eq_1_pos field_sum_of_halves
    pos_divide_less_eq times_divide_eq_left)
  then show ?thesis using assms(2) by auto
qed

text \<open>Range of compress and decompress functions\<close>

lemma range_compress:
  assumes "x\<in>{0..q-1}" "of_nat d < \<lceil>(log 2 q)::real\<rceil>"
  shows "compress d x \<in> {0..2^d - 1}"
using compress_def by auto

lemma range_decompress:
  assumes "x\<in>{0..2^d - 1}" "of_nat d < \<lceil>(log 2 q)::real\<rceil>"
  shows "decompress d x \<in> {0..q-1}"
using decompress_def assms
proof (auto, goal_cases)
case 1
  then show ?case
  by (smt (verit, best) divide_eq_0_iff divide_numeral_1
    less_divide_eq_1_pos mult_of_int_commute
    nonzero_mult_div_cancel_right of_int_eq_0_iff
    of_int_less_1_iff powr_realpow q_gt_zero q_nonzero
    round_0 round_mono twod_lt_q zero_less_power)
next
case 2
  have "real_of_int q/2^d > 1" using twod_lt_q[OF assms(2)]
    by (simp add: powr_realpow)
  then have log: "real_of_int q - real_of_int q/2^d \<le> q-1" by simp
  have "x \<le> 2^d-1" using assms(1) by simp
  then have "real_of_int x \<le> 2^d - 1" by (simp add: int_less_real_le)
  then have "real_of_int q * real_of_int x / 2^d \<le>
    real_of_int q * (2^d-1) / 2^d"
    by (smt (verit, best) divide_strict_right_mono
      mult_less_cancel_left_pos of_int_pos q_gt_zero
      zero_less_power)
  also have "\<dots> = real_of_int q * 2^d /2^d - real_of_int q/2^d"
    by (simp add: diff_divide_distrib right_diff_distrib)
  finally have "real_of_int q * real_of_int x / 2^d \<le>
    real_of_int q - real_of_int q/2^d" by simp
  then have "round (real_of_int q * real_of_int x / 2^d) \<le>
    round (real_of_int q - real_of_int q/2^d)"
    using round_mono by blast
  also have "\<dots> \<le> q - 1"
    using log by (metis round_mono round_of_int)
  finally show ?case by auto
qed

text \<open>Compression is a function qrom $\mathbb{Z} / q\mathbb{Z}$ to
  $\mathbb{Z} / (2^d)\mathbb{Z}$.\<close>

lemma compress_in_range:
  assumes "x\<in>{0..\<lceil>q-(q/(2*2^d))\<rceil>-1}"
          "of_nat d < \<lceil>(log 2 q)::real\<rceil>"
  shows "round (real_of_int (2^d * x) / real_of_int q) < 2^d "
proof -
  have "(2::int)^d \<noteq> 0" by simp
  have "real_of_int x < real_of_int q - real_of_int q / (2 * 2^d)"
    using assms(1) less_ceiling_iff by auto
  then have "2^d * real_of_int x / real_of_int q <
    2^d * (real_of_int q - real_of_int q / (2 * 2^d)) /
    real_of_int q"
    by (simp add: divide_strict_right_mono q_gt_zero)
  also have "\<dots> = 2^d * ((real_of_int q / real_of_int q) -
    (real_of_int q / real_of_int q) / (2 * 2^d))"
  by (simp add:algebra_simps diff_divide_distrib)
  also have "\<dots> = 2^d * (1 - 1/(2*2^d))"
    using q_nonzero by simp
  also have "\<dots> = 2^d - 1/2"
    using \<open>2^d \<noteq> 0\<close> by (simp add: right_diff_distrib')
  finally have "2^d * real_of_int x / real_of_int q <
    2^d - (1::real)/(2::real)"
    by auto
  then show ?thesis unfolding round_def
    using floor_less_iff by fastforce
qed

text \<open>When does the modulo operation in the compression function change the output?
  Only when  \<open>x \<ge> \<lceil>q-(q / (2*2^d))\<rceil>\<close>. Then we can determine that the compress function
  maps to zero. This is why we need the \<open>mod+-\<close> in the definition of Compression.
  Otherwise the error bound would not hold.\<close>

lemma compress_no_mod:
  assumes "x\<in>{0..\<lceil>q-(q / (2*2^d))\<rceil>-1}"
          "of_nat d < \<lceil>(log 2 q)::real\<rceil>"
  shows "compress d x =
    round (real_of_int (2^d * x) / real_of_int q)"
unfolding compress_def
using compress_in_range[OF assms] assms(1) q_gt_zero
by (smt (z3) atLeastAtMost_iff divide_nonneg_nonneg
  mod_pos_pos_trivial mult_less_cancel_left_pos
  of_int_nonneg of_nat_0_less_iff right_diff_distrib'
  round_0 round_mono zero_less_power)

lemma compress_2d:
  assumes "x\<in>{\<lceil>q-(q/(2*2^d))\<rceil>..q-1}"
          "of_nat d < \<lceil>(log 2 q)::real\<rceil>"
  shows "round (real_of_int (2^d * x) / real_of_int q) = 2^d "
using assms proof -
  have "(2::int)^d \<noteq> 0" by simp
  have "round (real_of_int (2^d * x) / real_of_int q) \<ge> 2^d"
  proof -
    have "real_of_int x \<ge> real_of_int q - real_of_int q / (2 * 2^d)"
      using assms(1) ceiling_le_iff by auto
    then have "2^d * real_of_int x / real_of_int q \<ge>
      2^d * (real_of_int q - real_of_int q / (2 * 2^d)) /
      real_of_int q"
      using q_gt_zero by (simp add: divide_right_mono)
    also have "2^d * (real_of_int q - real_of_int q /
      (2 * 2^d)) / real_of_int q
      = 2^d * ((real_of_int q / real_of_int q) -
      (real_of_int q / real_of_int q) / (2 * 2^d))"
      by (simp add:algebra_simps diff_divide_distrib)
    also have "\<dots> = 2^d * (1 - 1/(2*2^d))"
      using q_nonzero by simp
    also have "\<dots> = 2^d - 1/2"
      using \<open>2^d \<noteq> 0\<close> by (simp add: right_diff_distrib')
    finally have "2^d * real_of_int x / real_of_int q \<ge>
      2^d - (1::real)/(2::real)"
      by auto
    then show ?thesis unfolding round_def using le_floor_iff by force
  qed
  moreover have "round (real_of_int (2^d * x) / real_of_int q) \<le> 2^d"
  proof -
    have "d < log 2 q" using assms(2) by linarith
    then have "2 powr (real d) < of_int q"
      using less_log_iff[of 2 q d] q_gt_zero by auto
    have "x < q" using assms(1) by auto
    then have "real_of_int x/ real_of_int q < 1"
      by (simp add: q_gt_zero)
    then have "real_of_int (2^d * x) / real_of_int q <
      real_of_int (2^d)"
      by (auto) (smt (verit, best) divide_less_eq_1_pos
        nonzero_mult_div_cancel_left times_divide_eq_right
        zero_less_power)
    then show ?thesis unfolding round_def by linarith
  qed
  ultimately show ?thesis by auto
qed

lemma compress_mod:
  assumes "x\<in>{\<lceil>q-(q/(2*2^d))\<rceil>..q-1}"
          "of_nat d < \<lceil>(log 2 q)::real\<rceil>"
  shows "compress d x = 0"
unfolding compress_def using compress_2d[OF assms] by simp

text \<open>Error after compression and decompression of data.
  To prove the error bound, we distinguish the cases where the \<open>mod+-\<close> is relevant or not.\<close>

text \<open>First let us look at the error bound for no \<open>mod+-\<close> reduction.\<close>

lemma decompress_compress_no_mod:
  assumes "x\<in>{0..\<lceil>q-(q/(2*2^d))\<rceil>-1}"
          "of_nat d < \<lceil>(log 2 q)::real\<rceil>"
  shows "abs (decompress d (compress d x) - x) \<le>
    round ( real_of_int q / real_of_int (2^(d+1)))"
proof -
  have "abs (decompress d (compress d x) - x) =
    abs (real_of_int (decompress d (compress d x)) -
    real_of_int q / real_of_int (2^d) *
    (real_of_int (2^d * x) / real_of_int q))"
    using q_gt_zero by force
  also have "\<dots> \<le> abs (real_of_int (decompress d (compress d x)) -
    real_of_int q / real_of_int (2^d) * real_of_int (compress d x)) +
    abs (real_of_int q / real_of_int (2^d) *
    real_of_int (compress d x) - real_of_int q / real_of_int (2^d) *
    real_of_int (2^d) / real_of_int q * x)"
    using abs_triangle_ineq[of
      "real_of_int (decompress d (compress d x)) -
       real_of_int q / real_of_int (2^d) * real_of_int (compress d x)"
      "real_of_int q / real_of_int (2^d) * real_of_int (compress d x)
       - real_of_int q / real_of_int (2^d) * real_of_int (2^d) /
       real_of_int q * real_of_int x"] by auto
  also have "\<dots> \<le> 1/2 + abs (real_of_int q / real_of_int (2^d) *
    (real_of_int (compress d x) -
     real_of_int (2^d) / real_of_int q * real_of_int x))"
    proof -
      have part_one:
        "abs (real_of_int (decompress d (compress d x)) -
        real_of_int q / real_of_int (2^d) * real_of_int (compress d x))
        \<le> 1/2"
        unfolding decompress_def
        using of_int_round_abs_le[of "real_of_int q *
          real_of_int (compress d x) / real_of_int 2^d"] by simp
      have "real_of_int q * real_of_int (compress d x) / 2^d -
        real_of_int x =
        real_of_int q * (real_of_int (compress d x) -
        2^d * real_of_int x / real_of_int q) / 2^d"
        by (smt (verit, best) divide_cancel_right
        nonzero_mult_div_cancel_left of_int_eq_0_iff
        q_nonzero right_diff_distrib times_divide_eq_left
        zero_less_power)
      then have part_two:
        "abs (real_of_int q / real_of_int (2^d) *
        real_of_int (compress d x) -
        real_of_int q / real_of_int (2^d) * real_of_int (2^d) /
        real_of_int q * x) =
        abs (real_of_int q / real_of_int (2^d) *
        (real_of_int (compress d x) - real_of_int (2^d) /
        real_of_int q * x)) " by auto
      show ?thesis using part_one part_two by auto
   qed
  also have "\<dots> = 1/2 + (real_of_int q / real_of_int (2^d)) *
      abs (real_of_int (compress d x) - real_of_int (2^d) /
      real_of_int q * real_of_int x)"
    by (subst abs_mult) (smt (verit, best) assms(2)
      less_divide_eq_1_pos of_int_add of_int_hom.hom_one
      of_int_power powr_realpow twod_lt_q zero_less_power)
  also have "\<dots> \<le> 1/2 + (real_of_int q / real_of_int (2^d)) * (1/2) "
    using compress_no_mod[OF assms]
    using of_int_round_abs_le[of "real_of_int (2^d) *
      real_of_int x / real_of_int q"]
    by (smt (verit, ccfv_SIG) divide_nonneg_nonneg left_diff_distrib
      mult_less_cancel_left_pos of_int_mult of_int_nonneg q_gt_zero
      times_divide_eq_left zero_le_power)
  finally have "real_of_int (abs (decompress d (compress d x) - x)) \<le>
                real_of_int q / real_of_int (2*2^d) + 1/2"
    by simp
  then show ?thesis unfolding round_def using le_floor_iff
    by fastforce
qed

lemma no_mod_plus_minus:
  assumes "abs y \<le> round ( real_of_int q / real_of_int (2^(d+1)))"
          "d>0"
  shows "abs y = abs (y mod+- q)"
proof -
  have "round (real_of_int q / real_of_int (2^(d+1))) \<le> \<lfloor>q/2\<rfloor>"
  unfolding round_def
  proof -
    have "real_of_int q/real_of_int (2^d) \<le> real_of_int q/2"
    using \<open>d>0\<close>
    proof -
      have "1 / real_of_int (2^d) \<le> 1/2"
        using \<open>d>0\<close> inverse_of_nat_le[of 2 "2^d"]
        by (simp add: self_le_power)
      then show ?thesis using q_gt_zero
        by (smt (verit, best) frac_less2 of_int_le_0_iff zero_less_power)
    qed
    moreover have "real_of_int q/2 + 1 \<le> real_of_int q"
      using q_gt_two by auto
    ultimately have "real_of_int q / real_of_int (2^d) + 1 \<le>
      real_of_int q" by linarith
    then have fact: "real_of_int q / real_of_int (2 ^ (d + 1)) +
      1/2 \<le> real_of_int q/2"
      by auto
    then show "\<lfloor>real_of_int q / real_of_int (2 ^ (d + 1)) + 1/2\<rfloor> \<le>
      \<lfloor>real_of_int q/2\<rfloor>"
      using floor_mono[OF fact] by auto
  qed
  then have "abs y \<le> \<lfloor>q/2\<rfloor>" using assms by auto
  then show ?thesis using mod_plus_minus_range[OF q_gt_zero]
    using mod_plus_minus_def two_mid_lt_q by force
qed

lemma decompress_compress_no_mod_plus_minus:
  assumes "x\<in>{0..\<lceil>q-(q/(2*2^d))\<rceil>-1}"
          "of_nat d < \<lceil>(log 2 q)::real\<rceil>"
          "d>0"
  shows "abs ((decompress d (compress d x) - x) mod+- q) \<le>
          round ( real_of_int q / real_of_int (2^(d+1)))"
proof -
  have "abs ((decompress d (compress d x) - x) mod+- q) =
        abs ((decompress d (compress d x) - x)) "
    using no_mod_plus_minus[OF decompress_compress_no_mod
      [OF assms(1) assms(2)] assms(3)] by auto
  then show ?thesis using decompress_compress_no_mod
    [OF assms(1) assms(2)] by auto
qed

text \<open>Now lets look at what happens when the \<open>mod+-\<close> reduction comes into action.\<close>

lemma ceiling_int:
  "\<lceil>of_int a + b\<rceil> = a + \<lceil>b\<rceil>"
unfolding ceiling_def by (simp add: add.commute)

lemma decompress_compress_mod:
  assumes "x\<in>{\<lceil>q-(q/(2*2^d))\<rceil>..q-1}"
          "of_nat d < \<lceil>(log 2 q)::real\<rceil>"
  shows "abs ((decompress d (compress d x) - x) mod+- q) \<le>
         round ( real_of_int q / real_of_int (2^(d+1)))"
proof -
  have "(decompress d (compress d x) - x) = - x"
    using compress_mod[OF assms] unfolding decompress_def
    by auto
  moreover have "-x mod+- q = -x+q"
  proof -
    have "(-x + \<lfloor>q/2\<rfloor>) + q < q" using assms(1)
      break_point_gt_q_div_two[OF assms(2)] by force
    moreover have "(-x + \<lfloor>q/2\<rfloor>) + q \<ge> 0 "
      using assms(1) q_gt_zero
      by (smt (verit, best) atLeastAtMost_iff divide_nonneg_nonneg
        of_int_nonneg zero_le_floor)
    ultimately have "(- x + \<lfloor>q/2\<rfloor>) mod q = - x + \<lfloor>q/2\<rfloor> + q"
      by (metis mod_add_self2 mod_pos_pos_trivial)
    then show ?thesis unfolding mod_plus_minus_def by auto
  qed
  moreover have "abs (q - x) \<le> round ( real_of_int q /
    real_of_int (2^(d+1)))"
  proof -
    have "abs (q-x) = q-x"
      using assms(1) by auto
    also have "\<dots> \<le> q - \<lceil>q - q/(2*2^d)\<rceil>"
      using assms(1) by simp
    also have "\<dots> = - \<lceil>- q/(2*2^d)\<rceil>"
      using ceiling_int[of q "- q/(2*2^d)"] by auto
    also have "\<dots> = \<lfloor>q/(2*2^d)\<rfloor>"
      by (simp add: ceiling_def)
    also have "\<dots> \<le> round (q/(2*2^d))"
      using floor_le_round by blast
    finally have "abs (q-x) \<le> round (q/(2^(d+1)))" by auto
    then show ?thesis by auto
  qed
  ultimately show ?thesis by auto
qed

text \<open>Together, we can determine the general error bound on
  decompression of compression of the data.
  This error needs to be small enough not to disturb the encryption and decryption process.\<close>

lemma decompress_compress:
  assumes "x\<in>{0..<q}"
          "of_nat d < \<lceil>(log 2 q)::real\<rceil>"
          "d>0"
  shows "let x' = decompress d (compress d x) in
         abs ((x' - x) mod+- q) \<le>
          round ( real_of_int q / real_of_int (2^(d+1)) )"
proof (cases "x<\<lceil>q-(q/(2*2^d))\<rceil>")
case True
  then have range_x: "x\<in>{0..\<lceil>q-(q/(2*2^d))\<rceil>-1}"
    using assms(1) by auto
  show ?thesis unfolding Let_def
    using decompress_compress_no_mod_plus_minus[OF
    range_x assms(2) assms(3)] by auto
next
case False
  then have range_x: "x\<in>{\<lceil>q-(q/(2*2^d))\<rceil>..q-1}"
    using assms(1) by auto
  show ?thesis unfolding Let_def
    using decompress_compress_mod[OF range_x assms(2)]
    by auto
qed

text \<open>We have now defined compression only on integers (ie \<open>{0..<q}\<close>, corresponding to \<open>\<int>_q\<close>).
  We need to extend this notion to the ring \<open>\<int>_q[X]/(X^n+1)\<close>. Here, a compressed polynomial
  is the compression on every coefficient.\<close>

text \<open>
How to channel through the types
\begin{itemize}
\item \<open>to_qr :: 'a mod_ring poly \<Rightarrow> 'a qr\<close>
\item \<open>Poly ::  'a mod_ring list \<Rightarrow> 'a mod_ring poly\<close>
\item \<open>map of_int_mod_ring :: int list \<Rightarrow> 'a mod_ring list\<close>
\item \<open>map compress :: int list \<Rightarrow> int list\<close>
\item \<open>map to_int_mod_ring :: 'a mod_ring list \<Rightarrow> int list\<close>
\item \<open>coeffs :: 'a mod_ring poly \<Rightarrow> 'a mod_ring list\<close>
\item \<open>of_qr :: 'a qr \<Rightarrow> 'a mod_ring poly\<close>
\end{itemize}
\<close>
definition compress_poly :: "nat \<Rightarrow> 'a qr \<Rightarrow> 'a qr" where
  "compress_poly d =
        to_qr \<circ>
        Poly \<circ>
        (map of_int_mod_ring) \<circ>
        (map (compress d)) \<circ>
        (map to_int_mod_ring) \<circ>
        coeffs \<circ>
        of_qr"

definition decompress_poly :: "nat \<Rightarrow> 'a qr \<Rightarrow> 'a qr" where
  "decompress_poly d =
        to_qr \<circ>
        Poly \<circ>
        (map of_int_mod_ring) \<circ>
        (map (decompress d)) \<circ>
        (map to_int_mod_ring) \<circ>
        coeffs \<circ>
        of_qr"

text \<open>Lemmas for compression error for polynomials. Lemma telescope to go qrom module level
    down to integer coefficients and back up again.\<close>

lemma deg_Poly':
  assumes "Poly xs \<noteq> 0"
  shows "degree (Poly xs) \<le> length xs - 1"
proof (induct xs)
  case (Cons a xs)
  then show ?case
    by simp (metis Poly.simps(1) Suc_le_eq Suc_pred
    le_imp_less_Suc length_greater_0_conv)
qed simp

lemma of_int_mod_ring_eq_0:
  "((of_int_mod_ring x :: 'a mod_ring) = 0) \<longleftrightarrow>
    (x mod q = 0)"
by (metis CARD_a mod_0 of_int_code(2)
  of_int_mod_ring.abs_eq of_int_mod_ring.rep_eq
  of_int_of_int_mod_ring)

lemma dropWhile_mod_ring:
  "dropWhile ((=)0) (map of_int_mod_ring xs :: 'a mod_ring list) =
   map of_int_mod_ring (dropWhile (\<lambda>x. x mod q = 0) xs)"
proof (induct xs)
  case (Cons x xs)
  have "dropWhile ((=) 0) (map of_int_mod_ring (x # xs)) =
        dropWhile ((=) 0) ((of_int_mod_ring x :: 'a mod_ring) #
        (map of_int_mod_ring xs))"
    by auto
  also have "\<dots> = (if 0 = (of_int_mod_ring x :: 'a mod_ring)
    then dropWhile ((=) 0) (map of_int_mod_ring xs)
    else map of_int_mod_ring (x # xs))"
    unfolding dropWhile.simps(2)[of "((=) 0)"
      "of_int_mod_ring x :: 'a mod_ring" "map of_int_mod_ring xs"]
    by auto
  also have "\<dots> = (if x mod q = 0
    then map of_int_mod_ring (dropWhile (\<lambda>x. x mod q = 0) xs)
    else map of_int_mod_ring (x # xs))"
    using of_int_mod_ring_eq_0 unfolding Cons.hyps by auto
  also have "\<dots> = map of_int_mod_ring (dropWhile (\<lambda>x. x mod q = 0)
    (x # xs))"
    unfolding dropWhile.simps(2) by auto
  finally show ?case by blast
qed simp

lemma strip_while_mod_ring:
"(strip_while ((=) 0) (map of_int_mod_ring xs :: 'a mod_ring list)) =
  map of_int_mod_ring (strip_while (\<lambda>x. x mod q = 0)  xs)"
unfolding strip_while_def comp_def rev_map dropWhile_mod_ring by auto

lemma of_qr_to_qr_Poly:
  assumes "length (xs :: int list) < Suc (nat n)"
          "xs \<noteq> []"
  shows "of_qr (to_qr
    (Poly (map (of_int_mod_ring :: int \<Rightarrow> 'a mod_ring) xs))) =
     Poly (map (of_int_mod_ring :: int \<Rightarrow> 'a mod_ring) xs)"
    (is "_ = ?Poly")
proof -
  have deg: "degree (?Poly) < n"
    using deg_Poly'[of "map of_int_mod_ring xs"] assms
    by (smt (verit, del_insts) One_nat_def Suc_pred degree_0
      length_greater_0_conv length_map less_Suc_eq_le
      order_less_le_trans zless_nat_eq_int_zless)
  then show ?thesis
    using of_qr_to_qr[of "?Poly"] deg_mod_qr_poly[of "?Poly"]
      deg_qr_n by (smt (verit, best) of_nat_less_imp_less)
qed

lemma telescope_stripped:
  assumes "length (xs :: int list) < Suc (nat n)"
    "strip_while (\<lambda>x. x mod q = 0) xs = xs"
    "set xs \<subseteq> {0..<q}"
  shows "(map to_int_mod_ring)
    (coeffs (of_qr (to_qr (Poly
    (map (of_int_mod_ring :: int \<Rightarrow> 'a mod_ring) xs))))) = xs"
proof (cases "xs = []")
case False
  have ge_zero: "0\<le>x" and lt_q:"x < int CARD ('a)"
    if "x\<in>set xs" for x
    using assms(3) CARD_a atLeastLessThan_iff that by auto
  have to_int_of_int: "map (to_int_mod_ring \<circ>
    (of_int_mod_ring :: int \<Rightarrow> 'a mod_ring)) xs = xs"
    using to_int_mod_ring_of_int_mod_ring[OF ge_zero lt_q]
    by (simp add: map_idI)
  show ?thesis using assms(2)
    of_qr_to_qr_Poly[OF assms(1) False]
    by (auto simp add: to_int_of_int strip_while_mod_ring)
qed (simp)

lemma map_to_of_mod_ring:
  assumes "set xs \<subseteq> {0..<q}"
  shows "map (to_int_mod_ring \<circ>
    (of_int_mod_ring :: int \<Rightarrow> 'a mod_ring)) xs = xs"
using assms by (induct xs) (simp_all add: CARD_a)

lemma telescope:
  assumes "length (xs :: int list) < Suc (nat n)"
    "set xs \<subseteq> {0..<q}"
  shows "(map to_int_mod_ring)
    (coeffs (of_qr (to_qr (Poly
    (map (of_int_mod_ring :: int \<Rightarrow> 'a mod_ring) xs))))) =
    strip_while (\<lambda>x. x mod q = 0) xs"
proof (cases "xs = strip_while (\<lambda>x. x mod q = 0) xs")
case True
  then show ?thesis using telescope_stripped assms
    by auto
next
case False
  let ?of_int = "(map (of_int_mod_ring ::
    int \<Rightarrow> 'a mod_ring) xs)"
  have "xs \<noteq> []" using False by auto
  then have "(map to_int_mod_ring)
    (coeffs (of_qr (to_qr (Poly ?of_int)))) =
    (map to_int_mod_ring) (coeffs (Poly ?of_int))"
    using of_qr_to_qr_Poly[OF assms(1)] by auto
  also have "\<dots> = (map to_int_mod_ring)
    (strip_while ((=) 0) ?of_int)"
    by auto
  also have "\<dots> = map (to_int_mod_ring \<circ>
    (of_int_mod_ring :: int \<Rightarrow> 'a mod_ring))
    (strip_while (\<lambda>x. x mod q = 0) xs)"
    using strip_while_mod_ring by auto
  also have "\<dots> = strip_while (\<lambda>x. x mod q = 0) xs"
  using assms(2) proof (induct xs rule: rev_induct)
  case (snoc y ys)
    let ?to_of_mod_ring = "to_int_mod_ring \<circ>
      (of_int_mod_ring :: int \<Rightarrow> 'a mod_ring)"
    have "map ?to_of_mod_ring
      (strip_while (\<lambda>x. x mod q = 0) (ys @ [y])) =
      (if y mod q = 0
       then map ?to_of_mod_ring (strip_while (\<lambda>x. x mod q = 0) ys)
       else map ?to_of_mod_ring ys @ [?to_of_mod_ring y])"
      by (subst strip_while_snoc) auto
    also have "\<dots> = (if y mod q = 0
        then strip_while (\<lambda>x. x mod q = 0) ys
        else map ?to_of_mod_ring ys @ [?to_of_mod_ring y])"
    using snoc by fastforce
    also have "\<dots> = (if y mod q = 0
        then strip_while (\<lambda>x. x mod q = 0) ys
        else ys @ [y])"
      using map_to_of_mod_ring[OF snoc(2)] by auto
    also have "\<dots> = strip_while (\<lambda>x. x mod q = 0) (ys @ [y])"
      by auto
    finally show ?case .
  qed simp
  finally show ?thesis by auto
qed

lemma length_coeffs_of_qr:
  "length (coeffs (of_qr (x ::'a qr))) < Suc (nat n)"
proof (cases "x=0")
case False
  then have "of_qr x \<noteq> 0" by simp
  then show ?thesis
    using length_coeffs_degree[of "of_qr x"] deg_of_qr[of x]
    using deg_qr_n by fastforce
qed  (auto simp add: n_gt_zero)

lemma strip_while_change:
  assumes "\<And>x. P x \<longrightarrow> S x" "\<And>x. (\<not> P x) \<longrightarrow> (\<not> S x)"
  shows "strip_while P xs = strip_while S xs"
proof (induct xs rule: rev_induct)
case (snoc x xs)
  have "P x = S x" using assms[of x] by blast
  then show ?case by (simp add: snoc.hyps)
qed simp

lemma strip_while_change_subset:
  assumes "set xs \<subseteq> s"
    "\<forall>x\<in>s. P x \<longrightarrow> S x"
    "\<forall>x\<in>s. (\<not> P x) \<longrightarrow> (\<not> S x)"
  shows "strip_while P xs = strip_while S xs"
using assms(1) proof (induct xs rule: rev_induct)
case (snoc x xs)
  have "x\<in>s" using snoc(2) by simp
  then have "P x \<longrightarrow> S x" and "(\<not> P x) \<longrightarrow> (\<not> S x)"
    using assms(2) assms(3) by auto
  then have "P x = S x" by blast
  then show ?case
  using snoc.hyps snoc.prems by auto
qed simp

text \<open>Estimate for decompress compress for polynomials. Using the inequality for integers,
  chain it up to the level of polynomials.\<close>

lemma decompress_compress_poly:
  assumes "of_nat d < \<lceil>(log 2 q)::real\<rceil>"
          "d>0"
  shows "let x' = decompress_poly d (compress_poly d x) in
    abs_infty_poly (x - x') \<le>
    round ( real_of_int q / real_of_int (2^(d+1)) )"
proof -
  let ?x' = "decompress_poly d (compress_poly d x)"
  have "abs_infty_q (poly.coeff (of_qr (x - ?x')) xa)
       \<le> round (real_of_int q / real_of_int (2 ^ (d + 1)))"
  for xa
  proof -
    let ?telescope = "(\<lambda>xs. (map to_int_mod_ring)
      (coeffs (of_qr (to_qr (Poly
      (map (of_int_mod_ring :: int \<Rightarrow> 'a mod_ring) xs))))))"
    define compress_x where
      "compress_x =  map (compress d \<circ> to_int_mod_ring)
      (coeffs (of_qr x))"
    let ?to_Poly = "(\<lambda>a. Poly (map ((of_int_mod_ring ::
      int \<Rightarrow> 'a mod_ring) \<circ> decompress d) a))"
    have "abs_infty_q (poly.coeff (of_qr x) xa -
      poly.coeff (of_qr (to_qr (?to_Poly
      (?telescope compress_x)))) xa ) =
      abs_infty_q (poly.coeff (of_qr x) xa -
      poly.coeff (of_qr (to_qr (?to_Poly
      (strip_while (\<lambda>x. x = 0) compress_x)))) xa )"
    proof (cases "x = 0")
    case True
      then have "compress_x = []"
        unfolding compress_x_def by auto
      then show ?thesis by simp
    next
    case False
      then have nonempty:"compress_x \<noteq> []"
        unfolding compress_x_def by simp
      have "length compress_x < Suc (nat n)"
         by (auto simp add: compress_x_def length_coeffs_of_qr)
      moreover have "set compress_x \<subseteq> {0..<q}"
      proof -
        have to: "to_int_mod_ring (s::'a mod_ring) \<in>
            {0..q - 1}" for s
          using to_int_mod_ring_range by auto
        have "compress d (to_int_mod_ring (s::'a mod_ring)) \<in>
          {0..<q}" for s
          using range_compress[OF to assms(1), of s]
          twod_lt_q[OF assms(1)]
          by (simp add: powr_realpow)
        then show ?thesis unfolding compress_x_def by auto
      qed
      ultimately have "?telescope compress_x =
        strip_while (\<lambda>x. x mod q = 0) compress_x"
        by (intro telescope[of "compress_x"]) simp
      moreover have "strip_while (\<lambda>x. x mod q = 0) compress_x =
        strip_while (\<lambda>x. x = 0) compress_x"
      proof -
        have "compress d s = 0"
          if "compress d s mod q = 0" for s
          using that unfolding compress_def using twod_lt_q
          by (smt (verit, ccfv_threshold)
            Euclidean_Division.pos_mod_bound
            Euclidean_Division.pos_mod_sign assms(1)
            compress_def mod_pos_pos_trivial of_int_add
            of_int_hom.hom_one of_int_power_less_of_int_cancel_iff
            powr_realpow that zero_less_power)
        then have right: "\<And>s. compress d s mod q = 0 \<longrightarrow>
          compress d s = 0" by simp
        have  "\<not> (compress d s = 0)"
          if "\<not> (compress d s mod q = 0)" for s
          using twod_lt_q compress_def that by force
        then have left: "\<And>s. \<not> (compress d s mod q = 0) \<longrightarrow>
          \<not> (compress d s = 0)" by simp
        have "strip_while (\<lambda>x. x mod q = 0) compress_x =
          strip_while (\<lambda>x. x mod q = 0) (map (compress d)
          (map to_int_mod_ring (coeffs (of_qr x))))"
          (is "_ = strip_while (\<lambda>x. x mod q = 0)
            (map (compress d) ?rest)")
          unfolding compress_x_def by simp
        also have "\<dots> = map (compress d)
          (strip_while ((\<lambda>y. y mod q = 0) \<circ> compress d)
          (map to_int_mod_ring (coeffs (of_qr x))))"
          using strip_while_map[of "\<lambda>y. y mod q = 0" "compress d"]
          by blast
        also have "\<dots> = map (compress d)
          (strip_while ((\<lambda>y. y = 0) \<circ> compress d)
          (map to_int_mod_ring (coeffs (of_qr x))))"
          by (smt (verit, best) comp_eq_dest_lhs left right
            strip_while_change)
        also have "\<dots> = strip_while (\<lambda>x. x = 0)
          (map (compress d) ?rest)"
          using strip_while_map[of "\<lambda>y. y = 0"
            "compress d", symmetric] by blast
        finally show ?thesis
          unfolding compress_x_def by auto
      qed
      ultimately show ?thesis by auto
    qed
    also have "\<dots> = abs_infty_q (poly.coeff (of_qr x) xa -
      poly.coeff (?to_Poly (strip_while (\<lambda>x. x = 0) compress_x)) xa)"
    proof (cases "?to_Poly (strip_while (\<lambda>x. x = 0) compress_x) = 0")
    case False
      have "degree (?to_Poly (strip_while (\<lambda>x. x = 0) compress_x)) \<le>
        length (map ((of_int_mod_ring :: int \<Rightarrow> 'a mod_ring) \<circ>
        decompress d) (strip_while (\<lambda>x. x = 0) compress_x)) - 1"
        using deg_Poly'[OF False] .
      moreover have "length (map (of_int_mod_ring \<circ> decompress d)
          (strip_while (\<lambda>x. x = 0) compress_x)) \<le>
          length (coeffs (of_qr x))"
        unfolding compress_x_def
        by (metis length_map length_strip_while_le)
      moreover have "length (coeffs (of_qr x)) - 1 < deg_qr TYPE('a)"
        using deg_of_qr degree_eq_length_coeffs by metis
      ultimately have deg:
        "degree (?to_Poly (strip_while (\<lambda>x. x = 0) compress_x)) <
        deg_qr TYPE('a)" by auto
      show ?thesis using of_qr_to_qr'
        by (simp add: of_qr_to_qr'[OF deg])
    qed simp
    also have "\<dots> = abs_infty_q (poly.coeff (of_qr x) xa -
      poly.coeff (Poly (map of_int_mod_ring (strip_while (\<lambda>x. x = 0)
        (map (decompress d) compress_x)))) xa )"
    proof -
      have  "s = 0" if "decompress d s = 0" "s \<in> {0..2^d - 1}" for s
        using decompress_zero_unique[OF that assms(1)] .
      then have right: "\<forall>s \<in> {0..2^d-1}. decompress d s = 0 \<longrightarrow>
        s = 0" by simp
      have left: "\<forall> s \<in> {0..2^d-1}. decompress d s \<noteq> 0 \<longrightarrow> s \<noteq> 0"
        using decompress_zero[of d] by auto
      have compress_x_range: "set compress_x \<subseteq> {0..2^d - 1}"
        unfolding compress_x_def compress_def by auto
      have "map (decompress d) (strip_while (\<lambda>x. x = 0) compress_x) =
        map (decompress d) (strip_while (\<lambda>x. decompress d x = 0)
          compress_x)"
      using strip_while_change_subset[OF compress_x_range right left]
        by auto
      also have "\<dots> = strip_while (\<lambda>x. x = 0)
        (map (decompress d) compress_x)"
      proof -
        have "(\<lambda>x. x = 0) \<circ> decompress d = (\<lambda>x. decompress d x = 0)"
          using comp_def by blast
        then show ?thesis
          using strip_while_map[symmetric, of "decompress d"
            "\<lambda>x. x=0" compress_x] by auto
      qed
      finally have "map (decompress d) (strip_while (\<lambda>x. x = 0)
        compress_x) =  strip_while (\<lambda>x. x = 0) (map (decompress d)
        compress_x)" by auto
      then show ?thesis by (metis map_map)
    qed
    also have "\<dots> = abs_infty_q (poly.coeff (of_qr x) xa -
      poly.coeff (Poly (map of_int_mod_ring (strip_while
      (\<lambda>x. x mod q = 0) (map (decompress d) compress_x)))) xa )"
    proof -
      have range: "set (map (decompress d) compress_x) \<subseteq> {0..<q}"
        unfolding compress_x_def compress_def
        using range_decompress[OF _ assms(1)] by auto
      have right: " \<forall>x\<in>{0..<q}. x = 0 \<longrightarrow> x mod q = 0" by auto
      have left: "\<forall>x\<in>{0..<q}. \<not> x = 0 \<longrightarrow> \<not> x mod q = 0" by auto
      have "strip_while (\<lambda>x. x = 0) (map (decompress d) compress_x) =
        strip_while (\<lambda>x. x mod q = 0) (map (decompress d) compress_x)"
      using strip_while_change_subset[OF range right left] by auto
      then show ?thesis by auto
    qed
    also have "\<dots> = abs_infty_q (poly.coeff (of_qr x) xa -
      poly.coeff (Poly (map of_int_mod_ring
      (map (decompress d) compress_x))) xa )"
      by (metis Poly_coeffs coeffs_Poly strip_while_mod_ring)
    also have "\<dots> = abs_infty_q (poly.coeff (of_qr x) xa -
      ((of_int_mod_ring :: int \<Rightarrow> 'a mod_ring) \<circ> decompress d \<circ>
        compress d \<circ> to_int_mod_ring) (poly.coeff (of_qr x) xa))"
    using coeffs_Poly
    proof (cases "xa < length (coeffs (?to_Poly  compress_x))")
    case True
      have "poly.coeff (?to_Poly compress_x) xa =
            coeffs (?to_Poly compress_x) ! xa"
      using nth_coeffs_coeff[OF True] by simp
      also have "\<dots> = strip_while ((=) 0) (map (
        (of_int_mod_ring :: int \<Rightarrow> 'a mod_ring) \<circ> decompress d)
        compress_x) ! xa"
        using coeffs_Poly by auto
      also have "\<dots> = (map ((of_int_mod_ring :: int \<Rightarrow> 'a mod_ring) \<circ>
        decompress d) compress_x) ! xa"
        using True by (metis coeffs_Poly nth_strip_while)
      also have "\<dots> = ((of_int_mod_ring :: int \<Rightarrow> 'a mod_ring) \<circ>
        decompress d \<circ> compress d \<circ> to_int_mod_ring)
        (coeffs (of_qr x) ! xa)"
        unfolding compress_x_def
        by (smt (z3) True coeffs_Poly compress_x_def length_map
          length_strip_while_le map_map not_less nth_map order_trans)
      also have "\<dots> = ((of_int_mod_ring :: int \<Rightarrow> 'a mod_ring) \<circ>
        decompress d \<circ> compress d \<circ> to_int_mod_ring)
        (poly.coeff (of_qr x) xa)"
        by (metis (no_types, lifting) True coeffs_Poly compress_x_def
          length_map length_strip_while_le not_less nth_coeffs_coeff
          order.trans)
      finally have no_coeff: "poly.coeff (?to_Poly compress_x) xa =
          ((of_int_mod_ring :: int \<Rightarrow> 'a mod_ring) \<circ> decompress d \<circ>
          compress d \<circ> to_int_mod_ring) (poly.coeff (of_qr x) xa)"
        by auto
      show ?thesis unfolding compress_x_def
      by (metis compress_x_def map_map no_coeff)
    next
    case False
      then have "poly.coeff (?to_Poly compress_x) xa = 0"
        by (metis Poly_coeffs coeff_Poly_eq nth_default_def)
      moreover have "((of_int_mod_ring :: int \<Rightarrow> 'a mod_ring) \<circ>
        decompress d \<circ> compress d \<circ> to_int_mod_ring)
        (poly.coeff (of_qr x) xa) = 0"
      proof (cases "poly.coeff (of_qr x) xa = 0")
      case True
        then show ?thesis using compress_zero decompress_zero
          by auto
      next
      case False
        then show ?thesis
        proof (subst ccontr, goal_cases)
        case 1
          then have "poly.coeff (?to_Poly compress_x) xa \<noteq> 0"
            by (subst coeff_Poly) (metis (no_types, lifting) comp_apply
              compress_x_def compress_zero decompress_zero map_map
              nth_default_coeffs_eq nth_default_map_eq
              of_int_mod_ring_hom.hom_zero to_int_mod_ring_hom.hom_zero)
          then show ?case using \<open>poly.coeff (?to_Poly compress_x) xa = 0\<close>
            by auto
        qed auto
      qed
      ultimately show ?thesis by auto
    qed
    also have "\<dots> = abs_infty_q (
      ((of_int_mod_ring :: int \<Rightarrow> 'a mod_ring) \<circ> decompress d \<circ>
        compress d \<circ> to_int_mod_ring) (poly.coeff (of_qr x) xa) -
        poly.coeff (of_qr x) xa)"
      using abs_infty_q_minus by (metis minus_diff_eq)
    also have "\<dots> = \<bar>((decompress d \<circ> compress d \<circ> to_int_mod_ring)
      (poly.coeff (of_qr x) xa) -
       to_int_mod_ring (poly.coeff (of_qr x) xa)) mod+- q\<bar>"
      unfolding abs_infty_q_def
      using to_int_mod_ring_of_int_mod_ring
      by (smt (verit, best) CARD_a comp_apply mod_plus_minus_def
        of_int_diff of_int_mod_ring.rep_eq
        of_int_mod_ring_to_int_mod_ring of_int_of_int_mod_ring)
    also have "\<dots> \<le> round (real_of_int q / real_of_int (2 ^ (d + 1)))"
    proof -
      have range_to_int_mod_ring:
        "to_int_mod_ring (poly.coeff (of_qr x) xa) \<in> {0..<q}"
        using to_int_mod_ring_range by auto
      then show ?thesis
        unfolding abs_infty_q_def Let_def
        using decompress_compress[OF range_to_int_mod_ring assms]
        by simp
    qed
    finally have "abs_infty_q (poly.coeff (of_qr x) xa - poly.coeff
      (of_qr (to_qr (?to_Poly (?telescope compress_x)))) xa )
      \<le> round (real_of_int q / real_of_int (2 ^ (d + 1)))" by auto
    then show ?thesis unfolding compress_x_def decompress_poly_def
      compress_poly_def by (auto simp add: o_assoc)
  qed
  moreover have finite:
    "finite (range (abs_infty_q \<circ> poly.coeff (of_qr (x - ?x'))))"
    by (metis finite_Max image_comp image_image)
  ultimately show ?thesis unfolding abs_infty_poly_def
    using Max_le_iff[OF finite] by auto
qed

text \<open>More properties of compress and decompress, used for returning message at the end.\<close>

lemma compress_1:
  shows "compress 1 x \<in> {0,1}"
unfolding compress_def by auto

lemma compress_poly_1:
  shows "\<forall>i. poly.coeff (of_qr (compress_poly 1 x)) i \<in> {0,1}"
proof -
  have "poly.coeff (of_qr (compress_poly 1 x)) i \<in> {0,1}"
    for i
  proof -
    have "set (map (compress 1)
      ((map to_int_mod_ring \<circ> coeffs \<circ> of_qr) x)) \<subseteq> {0,1}"
      using compress_1 by auto
    then have "set ((map (compress 1) \<circ> map to_int_mod_ring \<circ>
      coeffs \<circ> of_qr) x) \<subseteq> {0,1}"
      (is "set (?compressed_1) \<subseteq> _")
      by auto
    then have "set (map (of_int_mod_ring :: int \<Rightarrow> 'a mod_ring)
      ?compressed_1) \<subseteq> {0,1}"
      (is "set (?of_int_compressed_1)\<subseteq>_")
      by (smt (verit, best) imageE insert_iff of_int_mod_ring_hom.hom_zero
        of_int_mod_ring_to_int_mod_ring set_map singletonD subsetD subsetI
        to_int_mod_ring_hom.hom_one)
    then have "nth_default 0 (?of_int_compressed_1) i
       \<in> {0,1}"
       by (smt (verit, best) comp_apply compress_1 compress_zero
        insert_iff nth_default_map_eq of_int_mod_ring_hom.hom_zero
        of_int_mod_ring_to_int_mod_ring singleton_iff
        to_int_mod_ring_hom.hom_one)
    moreover have "Poly (?of_int_compressed_1)
      = Poly (?of_int_compressed_1) mod qr_poly"
    proof -
      have "degree (Poly (?of_int_compressed_1)) < deg_qr TYPE('a)"
      proof (cases "Poly ?of_int_compressed_1 \<noteq> 0")
      case True
        have "degree (Poly ?of_int_compressed_1) \<le>
          length (map (of_int_mod_ring :: int \<Rightarrow> 'a mod_ring)
          ?compressed_1) - 1"
          using deg_Poly'[OF True] by simp
        also have "\<dots> = length ((coeffs \<circ> of_qr) x) - 1"
          by simp
        also have "\<dots> < n" unfolding comp_def
          using length_coeffs_of_qr
          by (metis deg_qr_n deg_of_qr degree_eq_length_coeffs
          nat_int zless_nat_conj)
        finally have "degree (Poly ?of_int_compressed_1) < n"
        using True \<open>int (length ((coeffs \<circ> of_qr) x) - 1) < n\<close>
          deg_Poly' by fastforce
        then show ?thesis using deg_qr_n by simp
      next
      case False
        then show ?thesis
        using deg_qr_pos by auto
      qed
      then show ?thesis
        using deg_mod_qr_poly[of "Poly (?of_int_compressed_1)",
          symmetric] by auto
    qed
    ultimately show ?thesis unfolding compress_poly_def comp_def
      using of_qr_to_qr[of "Poly (?of_int_compressed_1)"]
      by auto
  qed
  then show ?thesis by auto
qed

lemma of_int_mod_ring_mult:
  "of_int_mod_ring (a*b) = of_int_mod_ring a * of_int_mod_ring b"
unfolding of_int_mod_ring_def
by (metis (mono_tags, lifting) Rep_mod_ring_inverse mod_mult_eq
  of_int_mod_ring.rep_eq of_int_mod_ring_def times_mod_ring.rep_eq)

lemma decompress_1:
  assumes "a\<in>{0,1}"
  shows "decompress 1 a = round(real_of_int q/2) * a"
unfolding decompress_def using assms by auto

lemma decompress_poly_1:
  assumes "\<forall>i. poly.coeff (of_qr x) i \<in> {0,1}"
  shows "decompress_poly 1 x =
    to_module (round((real_of_int q)/2)) * x"
proof -
  have "poly.coeff (of_qr (decompress_poly 1 x)) i =
   poly.coeff (of_qr (to_module (round((real_of_int q)/2)) * x)) i"
  for i
  proof -
    have "set (map to_int_mod_ring (coeffs (of_qr x))) \<subseteq> {0,1}"
    (is "set (?int_coeffs) \<subseteq> _")
    proof -
      have "set (coeffs (of_qr x)) \<subseteq> {0,1}" using assms
      by (meson forall_coeffs_conv insert_iff subset_code(1))
      then show ?thesis by auto
    qed
    then have "map (decompress 1) (?int_coeffs) =
      map ((*) (round (real_of_int q/2))) (?int_coeffs)"
    proof (induct "?int_coeffs")
    case (Cons a xa)
      then show ?case using decompress_1
      by (meson map_eq_conv subsetD)
    qed simp
    then have "poly.coeff (of_qr (decompress_poly 1 x)) i =
      poly.coeff (of_qr (to_qr (Poly (map of_int_mod_ring
        (map (\<lambda>a. round(real_of_int q/2) * a)
        (?int_coeffs)))))) i"
      unfolding decompress_poly_def comp_def by presburger
    also have "\<dots> = poly.coeff (of_qr (to_qr (Poly
        (map (\<lambda>a. of_int_mod_ring ((round(real_of_int q/2)) * a))
        (?int_coeffs))))) i"
      using map_map[of of_int_mod_ring "((*) (round (real_of_int q/2)))"]
      by (smt (z3) map_eq_conv o_apply)
    also have "\<dots> = poly.coeff (of_qr (to_qr (Poly
        (map (\<lambda>a. of_int_mod_ring (round(real_of_int q/2)) *
        of_int_mod_ring a) (?int_coeffs))))) i"
      by (simp add: of_int_mod_ring_mult[of "(round(real_of_int q/2))"])
    also have "\<dots> = poly.coeff (of_qr (to_qr (Poly
        (map (\<lambda>a. of_int_mod_ring (round(real_of_int q/2)) * a)
        (map of_int_mod_ring (?int_coeffs)))))) i"
      using map_map[symmetric, of
        "(\<lambda>a. of_int_mod_ring (round (real_of_int q/2)) * a ::'a mod_ring)"
        "of_int_mod_ring"] unfolding comp_def by presburger
    also have "\<dots> = poly.coeff (of_qr (to_qr
        (Polynomial.smult (of_int_mod_ring (round(real_of_int q/2)))
        (Poly (map of_int_mod_ring (?int_coeffs)))))) i"
      using smult_Poly[symmetric, of
        "(of_int_mod_ring (round (real_of_int q/2)))"]
      by metis
    also have "\<dots> = poly.coeff (of_qr ((to_module
      (round (real_of_int q/2)) *
      to_qr (Poly (map of_int_mod_ring (?int_coeffs)))))) i"
      unfolding to_module_def
      using to_qr_smult_to_module
        [of "of_int_mod_ring (round (real_of_int q/2))"]
      by metis
    also have "\<dots> = poly.coeff (of_qr
       (to_module (round (real_of_int q/2)) *
        to_qr (Poly (coeffs (of_qr x)))))i"
      by (subst map_map[of of_int_mod_ring to_int_mod_ring],
        unfold comp_def)(subst of_int_mod_ring_to_int_mod_ring, auto)
    also have "\<dots> = poly.coeff (of_qr
       (to_module (round (real_of_int q/2)) * x))i"
      by (subst Poly_coeffs) (subst to_qr_of_qr, simp)
    finally show ?thesis by auto
  qed
  then have eq: "of_qr (decompress_poly 1 x) =
    of_qr (to_module (round((real_of_int q)/2)) * x)"
    by (simp add: poly_eq_iff)
  show ?thesis using arg_cong[OF eq, of "to_qr"]
    to_qr_of_qr[of "decompress_poly 1 x"]
    to_qr_of_qr[of "to_module (round (real_of_int q/2)) * x"]
    by auto
qed

text \<open>Compression and decompression for vectors.\<close>

definition map_vector ::
  "('b \<Rightarrow> 'b) \<Rightarrow> ('b, 'n) vec \<Rightarrow> ('b, 'n::finite) vec" where
  "map_vector f v = (\<chi> i. f (vec_nth v i))"

text \<open>Compression and decompression of vectors in \<open>\<int>_q[X]/(X^n+1)\<close>.\<close>

definition compress_vec ::
  "nat \<Rightarrow> ('a qr, 'k) vec \<Rightarrow> ('a qr, 'k) vec" where
  "compress_vec d = map_vector (compress_poly d)"

definition decompress_vec ::
  "nat \<Rightarrow> ('a qr, 'k) vec \<Rightarrow> ('a qr, 'k) vec" where
  "decompress_vec d = map_vector (decompress_poly d)"

end

end


(*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
    License: BSD
*)

section \<open>Asymptotic densities\<close>

theory Asymptotic_Density
  imports SG_Library_Complement
begin

text \<open>The upper asymptotic density of a subset $A$ of the integers is
$\limsup Card(A \cap [0,n)) / n \in [0,1]$. It measures how big a set of integers is,
at some times. In this paragraph, we establish the basic properties of this notion.

There is a corresponding notion of lower asymptotic density, with a liminf instead
of a limsup, measuring how big a set is at all times. The corresponding properties
are proved exactly in the same way.
\<close>

subsection \<open>Upper asymptotic densities\<close>

text \<open>As limsups are only defined for sequences taking values in a complete lattice
(here the extended reals), we define it in the extended reals and then go back to the reals.
This is a little bit artificial, but it is not a real problem as in the applications we
will never come back to this definition.\<close>

definition upper_asymptotic_density::"nat set \<Rightarrow> real"
  where "upper_asymptotic_density A = real_of_ereal(limsup (\<lambda>n. card(A \<inter> {..<n})/n))"

text \<open>First basic property: the asymptotic density is between $0$ and $1$.\<close>

lemma upper_asymptotic_density_in_01:
  "ereal(upper_asymptotic_density A) = limsup (\<lambda>n. card(A \<inter> {..<n})/n)"
  "upper_asymptotic_density A \<le> 1"
  "upper_asymptotic_density A \<ge> 0"
proof -
  {
    fix n::nat assume "n>0"
    have "card(A \<inter> {..<n}) \<le> n" by (metis card_lessThan Int_lower2 card_mono finite_lessThan)
    then have "card(A \<inter> {..<n}) / n \<le> ereal 1" using \<open>n>0\<close> by auto
  }
  then have "eventually (\<lambda>n. card(A \<inter> {..<n}) / n \<le> ereal 1) sequentially"
    by (simp add: eventually_at_top_dense)
  then have a: "limsup (\<lambda>n. card(A \<inter> {..<n})/n) \<le> 1" by (simp add: Limsup_const Limsup_bounded)

  have "card(A \<inter> {..<n}) / n \<ge> ereal 0" for n by auto
  then have "liminf (\<lambda>n. card(A \<inter> {..<n})/n) \<ge> 0" by (simp add: le_Liminf_iff less_le_trans)
  then have b: "limsup (\<lambda>n. card(A \<inter> {..<n})/n) \<ge> 0" by (meson Liminf_le_Limsup order_trans sequentially_bot)

  have "abs(limsup (\<lambda>n. card(A \<inter> {..<n})/n)) \<noteq> \<infinity>" using a b by auto
  then show "ereal(upper_asymptotic_density A) = limsup (\<lambda>n. card(A \<inter> {..<n})/n)"
    unfolding upper_asymptotic_density_def by auto
  show "upper_asymptotic_density A \<le> 1" "upper_asymptotic_density A \<ge> 0" unfolding upper_asymptotic_density_def
    using a b by (auto simp add: real_of_ereal_le_1 real_of_ereal_pos)
qed

text \<open>The two next propositions give the usable characterization of the asymptotic density, in
terms of the eventual cardinality of $A \cap [0, n)$. Note that the inequality is strict for one
implication and large for the other.\<close>

proposition upper_asymptotic_densityD:
  fixes l::real
  assumes "upper_asymptotic_density A < l"
  shows "eventually (\<lambda>n. card(A \<inter> {..<n}) < l * n) sequentially"
proof -
  have "limsup (\<lambda>n. card(A \<inter> {..<n})/n) < l"
    using assms upper_asymptotic_density_in_01(1) ereal_less_ereal_Ex by auto
  then have "eventually (\<lambda>n. card(A \<inter> {..<n})/n < ereal l) sequentially"
    using Limsup_lessD by blast
  then have "eventually (\<lambda>n. card(A \<inter> {..<n})/n < ereal l \<and> n > 0) sequentially"
    using eventually_gt_at_top eventually_conj by blast
  moreover have "card(A \<inter> {..<n}) < l * n" if "card(A \<inter> {..<n})/n < ereal l \<and> n > 0" for n
    using that by (simp add: divide_less_eq)
  ultimately show "eventually (\<lambda>n. card(A \<inter> {..<n}) < l * n) sequentially"
    by (simp add: eventually_mono)
qed

proposition upper_asymptotic_densityI:
  fixes l::real
  assumes "eventually (\<lambda>n. card(A \<inter> {..<n}) \<le> l * n) sequentially"
  shows "upper_asymptotic_density A \<le> l"
proof -
  have "eventually (\<lambda>n. card(A \<inter> {..<n}) \<le> l * n \<and> n > 0) sequentially"
    using assms eventually_gt_at_top eventually_conj by blast
  moreover have "card(A \<inter> {..<n})/n \<le> ereal l" if "card(A \<inter> {..<n}) \<le> l * n \<and> n > 0" for n
    using that by (simp add: divide_le_eq)
  ultimately have "eventually (\<lambda>n. card(A \<inter> {..<n})/n \<le> ereal l) sequentially"
    by (simp add: eventually_mono)
  then have "limsup (\<lambda>n. card(A \<inter> {..<n})/n) \<le> ereal l"
    by (simp add: Limsup_bounded)
  then have "ereal(upper_asymptotic_density A) \<le> ereal l"
    using upper_asymptotic_density_in_01(1) by auto
  then show ?thesis by (simp del: upper_asymptotic_density_in_01)
qed

text \<open>The following trivial lemma is useful to control the asymptotic density of unions.\<close>

lemma lem_ge_sum:
  fixes l x y::real
  assumes "l>x+y"
  shows "\<exists>lx ly. l = lx + ly \<and> lx > x \<and> ly > y"
proof -
  define lx ly where "lx = x + (l-(x+y))/2" and "ly = y + (l-(x+y))/2"
  have "l = lx + ly \<and> lx > x \<and> ly > y" unfolding lx_def ly_def using assms by auto
  then show ?thesis by auto
qed

text \<open>The asymptotic density of a union is bounded by the sum of the asymptotic densities.\<close>

lemma upper_asymptotic_density_union:
  "upper_asymptotic_density (A \<union> B) \<le> upper_asymptotic_density A + upper_asymptotic_density B"
proof -
  have "upper_asymptotic_density (A \<union> B) \<le> l" if H: "l > upper_asymptotic_density A + upper_asymptotic_density B" for l
  proof -
    obtain lA lB where l: "l = lA+lB" and lA: "lA > upper_asymptotic_density A" and lB: "lB > upper_asymptotic_density B"
      using lem_ge_sum H by blast
    {
      fix n assume H: "card (A \<inter> {..<n}) < lA * n \<and> card (B \<inter> {..<n}) < lB * n"
      have "card((A\<union>B) \<inter> {..<n}) \<le> card(A \<inter> {..<n}) + card(B \<inter> {..<n})"
        by (simp add: card_Un_le inf_sup_distrib2)
      also have "... \<le> l * n" using l H by (simp add: ring_class.ring_distribs(2))
      finally have "card ((A\<union>B) \<inter> {..<n}) \<le> l * n" by simp
    }
    moreover have "eventually (\<lambda>n. card (A \<inter> {..<n}) < lA * n \<and> card (B \<inter> {..<n}) < lB * n) sequentially"
      using upper_asymptotic_densityD[OF lA] upper_asymptotic_densityD[OF lB] eventually_conj by blast
    ultimately have "eventually (\<lambda>n. card((A\<union>B) \<inter> {..<n}) \<le> l * n) sequentially"
      by (simp add: eventually_mono)
    then show "upper_asymptotic_density (A \<union> B) \<le> l" using upper_asymptotic_densityI by auto
  qed
  then show ?thesis by (meson dense not_le)
qed

text \<open>It follows that the asymptotic density is an increasing function for inclusion.\<close>

lemma upper_asymptotic_density_subset:
  assumes "A \<subseteq> B"
  shows "upper_asymptotic_density A \<le> upper_asymptotic_density B"
proof -
  have "upper_asymptotic_density A \<le> l" if l: "l > upper_asymptotic_density B" for l
  proof -
    have "card(A \<inter> {..<n}) \<le> card(B \<inter> {..<n})" for n
      using assms by (metis Int_lower2 Int_mono card_mono finite_lessThan finite_subset inf.left_idem)
    then have "card(A \<inter> {..<n}) \<le> l * n" if "card(B \<inter> {..<n}) < l * n" for n
      using that by (meson lessThan_def less_imp_le of_nat_le_iff order_trans)
    moreover have "eventually (\<lambda>n. card(B \<inter> {..<n}) < l * n) sequentially"
      using upper_asymptotic_densityD l by simp
    ultimately have "eventually (\<lambda>n. card(A \<inter> {..<n}) \<le> l * n) sequentially"
      by (simp add: eventually_mono)
    then show ?thesis using upper_asymptotic_densityI by auto
  qed
  then show ?thesis by (meson dense not_le)
qed

text \<open>If a set has a density, then it is also its asymptotic density.\<close>

lemma upper_asymptotic_density_lim:
  assumes "(\<lambda>n. card(A \<inter> {..<n})/n) \<longlonglongrightarrow> l"
  shows "upper_asymptotic_density A = l"
proof -
  have "(\<lambda>n. ereal(card(A \<inter> {..<n})/n)) \<longlonglongrightarrow> l" using assms by auto
  then have "limsup (\<lambda>n. card(A \<inter> {..<n})/n) = l"
    using sequentially_bot tendsto_iff_Liminf_eq_Limsup by blast
  then show ?thesis unfolding upper_asymptotic_density_def by auto
qed

text \<open>If two sets are equal up to something small, i.e. a set with zero upper density,
then they have the same upper density.\<close>

lemma upper_asymptotic_density_0_diff:
  assumes "A \<subseteq> B" "upper_asymptotic_density (B-A) = 0"
  shows "upper_asymptotic_density A = upper_asymptotic_density B"
proof -
  have "upper_asymptotic_density B \<le> upper_asymptotic_density A + upper_asymptotic_density (B-A)"
    using upper_asymptotic_density_union[of A "B-A"] by (simp add: assms(1) sup.absorb2)
  then have "upper_asymptotic_density B \<le> upper_asymptotic_density A"
    using assms(2) by simp
  then show ?thesis using upper_asymptotic_density_subset[OF assms(1)] by simp
qed

lemma upper_asymptotic_density_0_Delta:
  assumes "upper_asymptotic_density (A \<Delta> B) = 0"
  shows "upper_asymptotic_density A = upper_asymptotic_density B"
proof -
  have "A- (A\<inter>B) \<subseteq> A \<Delta> B" "B- (A\<inter>B) \<subseteq> A \<Delta> B"
    using assms(1) by (auto simp add: Diff_Int Un_infinite)
  then have "upper_asymptotic_density (A - (A\<inter>B)) = 0"
            "upper_asymptotic_density (B - (A\<inter>B)) = 0"
    using upper_asymptotic_density_subset assms(1) upper_asymptotic_density_in_01(3)
    by (metis inf.absorb_iff2 inf.orderE)+
  then have "upper_asymptotic_density (A\<inter>B) = upper_asymptotic_density A"
            "upper_asymptotic_density (A\<inter>B) = upper_asymptotic_density B"
    using upper_asymptotic_density_0_diff by auto
  then show ?thesis by simp
qed

text \<open>Finite sets have vanishing upper asymptotic density.\<close>

lemma upper_asymptotic_density_finite:
  assumes "finite A"
  shows "upper_asymptotic_density A = 0"
proof -
  have "(\<lambda>n. card(A \<inter> {..<n})/n) \<longlonglongrightarrow> 0"
  proof (rule tendsto_sandwich[where ?f = "\<lambda>n. 0" and ?h = "\<lambda>(n::nat). card A / n"])
    have "card(A \<inter> {..<n})/n \<le> card A / n" if "n>0" for n
      using that \<open>finite A\<close> by (simp add: card_mono divide_right_mono)
    then show "eventually (\<lambda>n. card(A \<inter> {..<n})/n \<le> card A / n) sequentially"
      by (simp add: eventually_at_top_dense)
    have "(\<lambda>n. real (card A)* (1 / real n)) \<longlonglongrightarrow> real(card A) * 0"
      by (intro tendsto_intros)
    then show "(\<lambda>n. real (card A) / real n) \<longlonglongrightarrow> 0" by auto
  qed (auto)
  then show "upper_asymptotic_density A = 0" using upper_asymptotic_density_lim by auto
qed

text \<open>In particular, bounded intervals have zero upper density.\<close>

lemma upper_asymptotic_density_bdd_interval [simp]:
  "upper_asymptotic_density {} = 0"
  "upper_asymptotic_density {..N} = 0"
  "upper_asymptotic_density {..<N} = 0"
  "upper_asymptotic_density {n..N} = 0"
  "upper_asymptotic_density {n..<N} = 0"
  "upper_asymptotic_density {n<..N} = 0"
  "upper_asymptotic_density {n<..<N} = 0"
by (auto intro!: upper_asymptotic_density_finite)

text \<open>The density of a finite union is bounded by the sum of the densities.\<close>

lemma upper_asymptotic_density_finite_Union:
  assumes "finite I"
  shows "upper_asymptotic_density (\<Union>i\<in>I. A i) \<le> (\<Sum>i\<in>I. upper_asymptotic_density (A i))"
using assms apply (induction I rule: finite_induct)
using order_trans[OF upper_asymptotic_density_union] by auto

text \<open>It is sometimes useful to compute the asymptotic density by shifting a little bit the set:
this only makes a finite difference that vanishes when divided by $n$.\<close>

lemma upper_asymptotic_density_shift:
  fixes k::nat and l::int
  shows "ereal(upper_asymptotic_density A) = limsup (\<lambda>n. card(A \<inter> {k..nat(n+l)}) / n)"
proof -
  define C where "C = k+2*nat(abs(l))+1"
  have *: "(\<lambda>n. C*(1/n)) \<longlonglongrightarrow> real C * 0"
    by (intro tendsto_intros)
  have l0: "limsup (\<lambda>n. C/n) = 0"
    apply (rule lim_imp_Limsup, simp) using * by (simp add: zero_ereal_def)

  have "card(A \<inter> {k..nat(n+l)}) / n \<le> card (A \<inter> {..<n})/n + C/n" for n
  proof -
    have "card(A \<inter> {k..nat(n+l)}) \<le> card (A \<inter> {..<n} \<union> {n..n + nat(abs(l))})"
      by (rule card_mono, auto)
    also have "... \<le> card (A \<inter> {..<n}) + card {n..n + nat(abs(l))}"
      by (rule card_Un_le)
    also have "... \<le> card (A \<inter> {..<n}) + real C"
      unfolding C_def by auto
    finally have "card(A \<inter> {k..nat(n+l)}) / n \<le> (card (A \<inter> {..<n}) + real C) /n"
      by (simp add: divide_right_mono)
    also have "... = card (A \<inter> {..<n})/n + C/n"
      using add_divide_distrib by auto
    finally show ?thesis
      by auto
  qed
  then have "limsup (\<lambda>n. card(A \<inter> {k..nat(n+l)}) / n) \<le> limsup (\<lambda>n. card (A \<inter> {..<n})/n + ereal(C/n))"
    by (simp add: Limsup_mono)
  also have "... \<le> limsup (\<lambda>n. card (A \<inter> {..<n})/n) + limsup (\<lambda>n. C/n)"
    by (rule ereal_limsup_add_mono)
  finally have a: "limsup (\<lambda>n. card(A \<inter> {k..nat(n+l)}) / n) \<le> limsup (\<lambda>n. card (A \<inter> {..<n})/n)"
    using l0 by simp

  have "card (A \<inter> {..<n}) / n \<le> card (A \<inter> {k..nat(n+l)})/n + C/n" for n
  proof -
    have "card ({..<k} \<union> {n-nat(abs(l))..n + nat(abs(l))}) \<le> card {..<k} + card {n-nat(abs(l))..n + nat(abs(l))}"
      by (rule card_Un_le)
    also have "... \<le> k + 2*nat(abs(l)) + 1" by auto
    finally have *: "card ({..<k} \<union> {n-nat(abs(l))..n + nat(abs(l))}) \<le> C" unfolding C_def by blast

    have "card(A \<inter> {..<n}) \<le> card (A \<inter> {k..nat(n+l)} \<union> ({..<k} \<union> {n-nat(abs(l))..n + nat(abs(l))}))"
      by (rule card_mono, auto)
    also have "... \<le> card (A \<inter> {k..nat(n+l)}) + card ({..<k} \<union> {n-nat(abs(l))..n + nat(abs(l))})"
      by (rule card_Un_le)
    also have "... \<le> card (A \<inter> {k..nat(n+l)}) + C"
      using * by auto
    finally have "card (A \<inter> {..<n}) / n \<le> (card (A \<inter> {k..nat(n+l)}) + real C)/n"
      by (simp add: divide_right_mono)
    also have "... = card (A \<inter> {k..nat(n+l)})/n + C/n"
      using add_divide_distrib by auto
    finally show ?thesis
      by auto
  qed
  then have "limsup (\<lambda>n. card(A \<inter> {..<n}) / n) \<le> limsup (\<lambda>n. card (A \<inter> {k..nat(n+l)})/n + ereal(C/n))"
    by (simp add: Limsup_mono)
  also have "... \<le> limsup (\<lambda>n. card (A \<inter> {k..nat(n+l)})/n) + limsup (\<lambda>n. C/n)"
    by (rule ereal_limsup_add_mono)
  finally have "limsup (\<lambda>n. card(A \<inter> {..<n}) / n) \<le> limsup (\<lambda>n. card (A \<inter> {k..nat(n+l)})/n)"
    using l0 by simp
  then have "limsup (\<lambda>n. card(A \<inter> {..<n}) / n) = limsup (\<lambda>n. card (A \<inter> {k..nat(n+l)})/n)"
    using a by auto
  then show ?thesis using upper_asymptotic_density_in_01(1) by auto
qed

text \<open>Upper asymptotic density is measurable.\<close>

lemma upper_asymptotic_density_meas [measurable]:
  assumes [measurable]: "\<And>(n::nat). Measurable.pred M (P n)"
  shows "(\<lambda>x. upper_asymptotic_density {n. P n x}) \<in> borel_measurable M"
unfolding upper_asymptotic_density_def by auto

text \<open>A finite union of sets with zero upper density still has zero upper density.\<close>

lemma upper_asymptotic_density_zero_union:
  assumes "upper_asymptotic_density A = 0" "upper_asymptotic_density B = 0"
  shows "upper_asymptotic_density (A \<union> B) = 0"
using upper_asymptotic_density_in_01(3)[of "A \<union> B"] upper_asymptotic_density_union[of A B] unfolding assms by auto

lemma upper_asymptotic_density_zero_finite_Union:
  assumes "finite I" "\<And>i. i \<in> I \<Longrightarrow> upper_asymptotic_density (A i) = 0"
  shows "upper_asymptotic_density (\<Union>i\<in>I. A i) = 0"
using assms by (induction rule: finite_induct, auto intro!: upper_asymptotic_density_zero_union)

text \<open>The union of sets with small asymptotic densities can have a large density: think
of $A_n = [0,n]$, it has density $0$, but the union of the $A_n$ has density $1$. However, if one
only wants a set which contains each $A_n$ eventually, then one can obtain a ``union'' that has
essentially the same density as each $A_n$. This is often used as a replacement for the diagonal
argument in density arguments: if for each $n$ one can find a set $A_n$ with good properties and
a controlled density, then their ``union'' will have the same properties (eventually) and a
controlled density.\<close>

proposition upper_asymptotic_density_incseq_Union:
  assumes "\<And>(n::nat). upper_asymptotic_density (A n) \<le> l" "incseq A"
  shows "\<exists>B. upper_asymptotic_density B \<le> l \<and> (\<forall>n. \<exists>N. A n \<inter> {N..} \<subseteq> B)"
proof -
  have A: "\<exists>N. \<forall>j \<ge> N. card (A k \<inter> {..<j}) < (l + (1/2)^k) * j" for k
  proof -
    have *: "upper_asymptotic_density (A k) < l + (1/2)^k" using assms(1)[of k]
      by (metis add.right_neutral add_mono_thms_linordered_field(4) less_divide_eq_numeral1(1) mult_zero_left zero_less_one zero_less_power)
    show ?thesis
      using upper_asymptotic_densityD[OF *] unfolding eventually_sequentially by auto
  qed
  have "\<exists>N. \<forall>k. (\<forall>j \<ge> N k. card (A k \<inter> {..<j}) \<le> (l+(1/2)^k) * j) \<and> N (Suc k) > N k"
  proof (rule dependent_nat_choice)
    fix x k::nat
    obtain N where N: "\<forall>j\<ge>N. real (card (A (Suc k) \<inter> {..<j})) \<le> (l + (1 / 2) ^ Suc k) * real j"
      using A[of "Suc k"] less_imp_le by auto
    show "\<exists>y. (\<forall>j\<ge>y. real (card (A(Suc k) \<inter> {..<j})) \<le> (l + (1 / 2) ^ Suc k) * real j) \<and> x < y"
      apply (rule exI[of _ "max x N + 1"]) using N by auto
  next
    show "\<exists>x. \<forall>j\<ge>x. real (card ((A 0) \<inter> {..<j})) \<le> (l + (1 / 2) ^ 0) * real j"
      using A[of 0] less_imp_le by auto
  qed
  text \<open>Here is the choice of the good waiting function $N$\<close>
  then obtain N where N: "\<And>k j. j \<ge> N k \<Longrightarrow> card (A k \<inter> {..<j}) \<le> (l + (1/2)^k) * j" "\<And>k. N (Suc k) > N k"
    by blast
  then have "strict_mono N" by (simp add: strict_monoI_Suc)
  have Nmono: "N k < N l" if "k < l" for k l
    using N(2) by (simp add: lift_Suc_mono_less that)

  text \<open>We can now define the global bad set $B$.\<close>
  define B where "B = (\<Union>k. A k \<inter> {N k..})"
  text \<open>We will now show that it also has density at most $l$.\<close>
  have Bcard: "card (B \<inter> {..<n}) \<le> (l+(1/2)^k) * n" if "N k \<le> n" "n < N (Suc k)" for n k
  proof -
    have "{N j..<n} = {}" if "j \<in> {k<..}" for j
      using \<open>n < N (Suc k)\<close> that by (auto, meson \<open>strict_mono N\<close> less_trans not_less_eq strict_mono_less)
    then have *: "(\<Union>j\<in>{k<..}. A j \<inter> {N j..<n}) = {}" by force

    have "B \<inter> {..<n} = (\<Union>j. A j \<inter> {N j..<n})"
      unfolding B_def by auto
    also have "... = (\<Union>j \<in> {..k}. A j \<inter> {N j..<n}) \<union> (\<Union>j\<in>{k<..}. A j \<inter> {N j..<n})"
      unfolding UN_Un [symmetric] by (rule arg_cong [of _ _ Union]) auto
    also have "... = (\<Union>j \<in> {..k}. A j \<inter> {N j..<n})"
      unfolding * by simp
    also have "... \<subseteq> (\<Union>j \<in> {..k}. A k \<inter> {..<n})"
      using \<open>incseq A\<close> unfolding incseq_def by (auto intro!: UN_mono)
    also have "... = A k \<inter> {..<n}"
      by simp
    finally have "card (B \<inter> {..<n}) \<le> card (A k \<inter> {..<n})"
      by (rule card_mono[rotated], auto)
    then show ?thesis
      using N(1)[OF \<open>n \<ge> N k\<close>] by simp
  qed
  have "eventually (\<lambda>n. card (B \<inter> {..<n}) \<le> a * n) sequentially" if "l < a" for a::real
  proof -
    have "eventually (\<lambda>k. (l+(1/2)^k) < a) sequentially"
      apply (rule order_tendstoD[of _ "l+0"], intro tendsto_intros) using that by auto
    then obtain k where "l + (1/2)^k < a"
      unfolding eventually_sequentially by auto
    have "card (B \<inter> {..<n}) \<le> a * n" if "n \<ge> N k + 1"for n
    proof -
      have "n \<ge> N k" "n \<ge> 1" using that by auto
      have "{p. n \<ge> N p} \<subseteq> {..n}"
        using \<open>strict_mono N\<close> dual_order.trans seq_suble by blast
      then have *: "finite {p. n \<ge> N p}" "{p. n \<ge> N p} \<noteq> {}"
        using \<open>n \<ge> N k\<close> finite_subset by auto
      define m where "m = Max {p. n \<ge> N p}"
      have "k \<le> m"
        unfolding m_def using Max_ge[OF *(1), of k] that by auto
      have "N m \<le> n"
        unfolding m_def using Max_in[OF *] by auto
      have "Suc m \<notin> {p. n \<ge> N p}"
        unfolding m_def using * Max_ge Suc_n_not_le_n by blast
      then have "n < N (Suc m)" by simp
      have "card (B \<inter> {..<n}) \<le> (l+(1/2)^m) * n"
        using Bcard[OF \<open>N m \<le> n\<close> \<open>n < N (Suc m)\<close>] by simp
      also have "... \<le> (l + (1/2)^k) * n"
        apply (rule mult_right_mono) using \<open>k \<le> m\<close> by (auto simp add: power_decreasing)
      also have "... \<le> a * n"
        using \<open>l + (1/2)^k < a\<close> \<open>n \<ge> 1\<close> by auto
      finally show ?thesis by auto
    qed
    then show ?thesis unfolding eventually_sequentially by auto
  qed
  then have "upper_asymptotic_density B \<le> a" if "a > l" for a
    using upper_asymptotic_densityI that by auto
  then have "upper_asymptotic_density B \<le> l"
    by (meson dense not_le)
  moreover have "\<exists>N. A n \<inter> {N..} \<subseteq> B" for n
    apply (rule exI[of _ "N n"]) unfolding B_def by auto
  ultimately show ?thesis by auto
qed

text \<open>When the sequence of sets is not increasing, one can only obtain a set whose density
is bounded by the sum of the densities.\<close>

proposition upper_asymptotic_density_Union:
  assumes "summable (\<lambda>n. upper_asymptotic_density (A n))"
  shows "\<exists>B. upper_asymptotic_density B \<le> (\<Sum>n. upper_asymptotic_density (A n)) \<and> (\<forall>n. \<exists>N. A n \<inter> {N..} \<subseteq> B)"
proof -
  define C where "C = (\<lambda>n. (\<Union>i\<le>n. A i))"
  have C1: "incseq C"
    unfolding C_def incseq_def by fastforce
  have C2: "upper_asymptotic_density (C k) \<le> (\<Sum>n. upper_asymptotic_density (A n))" for k
  proof -
    have "upper_asymptotic_density (C k) \<le> (\<Sum>i\<le>k. upper_asymptotic_density (A i))"
      unfolding C_def by (rule upper_asymptotic_density_finite_Union, auto)
    also have "... \<le> (\<Sum>i. upper_asymptotic_density (A i))"
      apply (rule sum_le_suminf[OF assms]) using upper_asymptotic_density_in_01 by auto
    finally show ?thesis by simp
  qed
  obtain B where B: "upper_asymptotic_density B \<le> (\<Sum>n. upper_asymptotic_density (A n))"
                    "\<And>n. \<exists>N. C n \<inter> {N..} \<subseteq> B"
    using upper_asymptotic_density_incseq_Union[OF C2 C1] by blast
  have "\<exists>N. A n \<inter> {N..} \<subseteq> B" for n
    using B(2)[of n] unfolding C_def by auto
  then show ?thesis using B(1) by blast
qed

text \<open>A particular case of the previous proposition, often useful, is when all sets have density
zero.\<close>

proposition upper_asymptotic_density_zero_Union:
  assumes "\<And>n::nat. upper_asymptotic_density (A n) = 0"
  shows "\<exists>B. upper_asymptotic_density B = 0 \<and> (\<forall>n. \<exists>N. A n \<inter> {N..} \<subseteq> B)"
proof -
  have "\<exists>B. upper_asymptotic_density B \<le> (\<Sum>n. upper_asymptotic_density (A n)) \<and> (\<forall>n. \<exists>N. A n \<inter> {N..} \<subseteq> B)"
    apply (rule upper_asymptotic_density_Union) unfolding assms by auto
  then obtain B where "upper_asymptotic_density B \<le> 0" "\<And>n. \<exists>N. A n \<inter> {N..} \<subseteq> B"
    unfolding assms by auto
  then show ?thesis
    using upper_asymptotic_density_in_01(3)[of B] by auto
qed

subsection \<open>Lower asymptotic densities\<close>

text \<open>The lower asymptotic density of a set of natural numbers is defined just as its
upper asymptotic density but using a liminf instead of a limsup. Its properties are proved
exactly in the same way.\<close>

definition lower_asymptotic_density::"nat set \<Rightarrow> real"
  where "lower_asymptotic_density A = real_of_ereal(liminf (\<lambda>n. card(A \<inter> {..<n})/n))"

lemma lower_asymptotic_density_in_01:
  "ereal(lower_asymptotic_density A) = liminf (\<lambda>n. card(A \<inter> {..<n})/n)"
  "lower_asymptotic_density A \<le> 1"
  "lower_asymptotic_density A \<ge> 0"
proof -
  {
    fix n::nat assume "n>0"
    have "card(A \<inter> {..<n}) \<le> n" by (metis card_lessThan Int_lower2 card_mono finite_lessThan)
    then have "card(A \<inter> {..<n}) / n \<le> ereal 1" using \<open>n>0\<close> by auto
  }
  then have "eventually (\<lambda>n. card(A \<inter> {..<n}) / n \<le> ereal 1) sequentially"
    by (simp add: eventually_at_top_dense)
  then have "limsup (\<lambda>n. card(A \<inter> {..<n})/n) \<le> 1" by (simp add: Limsup_const Limsup_bounded)
  then have a: "liminf (\<lambda>n. card(A \<inter> {..<n})/n) \<le> 1"
    by (meson Liminf_le_Limsup less_le_trans not_le sequentially_bot)

  have "card(A \<inter> {..<n}) / n \<ge> ereal 0" for n by auto
  then have b: "liminf (\<lambda>n. card(A \<inter> {..<n})/n) \<ge> 0" by (simp add: le_Liminf_iff less_le_trans)

  have "abs(liminf (\<lambda>n. card(A \<inter> {..<n})/n)) \<noteq> \<infinity>" using a b by auto
  then show "ereal(lower_asymptotic_density A) = liminf (\<lambda>n. card(A \<inter> {..<n})/n)"
    unfolding lower_asymptotic_density_def by auto
  show "lower_asymptotic_density A \<le> 1" "lower_asymptotic_density A \<ge> 0" unfolding lower_asymptotic_density_def
    using a b by (auto simp add: real_of_ereal_le_1 real_of_ereal_pos)
qed

text \<open>The lower asymptotic density is bounded by the upper one. When they coincide,
$Card(A \cap [0,n))/n$ converges to this common value.\<close>

lemma lower_asymptotic_density_le_upper:
  "lower_asymptotic_density A \<le> upper_asymptotic_density A"
using lower_asymptotic_density_in_01(1) upper_asymptotic_density_in_01(1)
by (metis (mono_tags, lifting) Liminf_le_Limsup ereal_less_eq(3) sequentially_bot)

lemma lower_asymptotic_density_eq_upper:
  assumes "lower_asymptotic_density A = l" "upper_asymptotic_density A = l"
  shows "(\<lambda>n. card(A \<inter> {..<n})/n) \<longlonglongrightarrow> l"
apply (rule limsup_le_liminf_real)
using upper_asymptotic_density_in_01(1)[of A] lower_asymptotic_density_in_01(1)[of A] assms by auto

text \<open>In particular, when a set has a zero upper density, or a lower density one, then this
implies the corresponding convergence of $Card(A \cap [0,n))/n$.\<close>

lemma upper_asymptotic_density_zero_lim:
  assumes "upper_asymptotic_density A = 0"
  shows "(\<lambda>n. card(A \<inter> {..<n})/n) \<longlonglongrightarrow> 0"
apply (rule lower_asymptotic_density_eq_upper)
using assms lower_asymptotic_density_le_upper[of A] lower_asymptotic_density_in_01(3)[of A] by auto

lemma lower_asymptotic_density_one_lim:
  assumes "lower_asymptotic_density A = 1"
  shows "(\<lambda>n. card(A \<inter> {..<n})/n) \<longlonglongrightarrow> 1"
apply (rule lower_asymptotic_density_eq_upper)
using assms lower_asymptotic_density_le_upper[of A] upper_asymptotic_density_in_01(2)[of A] by auto

text \<open>The lower asymptotic density of a set is $1$ minus the upper asymptotic density of its complement.
Hence, most statements about one of them follow from statements about the other one,
although we will rather give direct proofs as they are not more complicated.\<close>

lemma lower_upper_asymptotic_density_complement:
  "lower_asymptotic_density A = 1 - upper_asymptotic_density (UNIV - A)"
proof -
  {
    fix n assume "n>(0::nat)"
    have "{..<n} \<inter> UNIV - (UNIV - ({..<n} - (UNIV - A))) = {..<n} \<inter> A"
      by blast
    moreover have "{..<n} \<inter> UNIV \<inter> (UNIV - ({..<n} - (UNIV - A))) = (UNIV - A) \<inter> {..<n}"
      by blast
    ultimately have "card (A \<inter> {..<n}) = n - card((UNIV-A) \<inter> {..<n})"
      by (metis (no_types) Int_commute card_Diff_subset_Int card_lessThan finite_Int finite_lessThan inf_top_right)
    then have "card (A \<inter> {..<n})/n = (real n - card((UNIV-A) \<inter> {..<n})) / n"
      by (metis Int_lower2 card_lessThan card_mono finite_lessThan of_nat_diff)
    then have "card (A \<inter> {..<n})/n = ereal 1 - card((UNIV-A) \<inter> {..<n})/n"
      using \<open>n>0\<close> by (simp add: diff_divide_distrib)
  }
  then have "eventually (\<lambda>n. card (A \<inter> {..<n})/n = ereal 1 - card((UNIV-A) \<inter> {..<n})/n) sequentially"
    by (simp add: eventually_at_top_dense)
  then have "liminf (\<lambda>n. card (A \<inter> {..<n})/n) = liminf (\<lambda>n. ereal 1 - card((UNIV-A) \<inter> {..<n})/n)"
    by (rule Liminf_eq)
  also have "... = ereal 1 - limsup (\<lambda>n. card((UNIV-A) \<inter> {..<n})/n)"
    by (rule liminf_ereal_cminus, simp)
  finally show ?thesis unfolding lower_asymptotic_density_def
    by (metis ereal_minus(1) real_of_ereal.simps(1) upper_asymptotic_density_in_01(1))
qed

proposition lower_asymptotic_densityD:
  fixes l::real
  assumes "lower_asymptotic_density A > l"
  shows "eventually (\<lambda>n. card(A \<inter> {..<n}) > l * n) sequentially"
proof -
  have "ereal(lower_asymptotic_density A) > l" using assms by auto
  then have "liminf (\<lambda>n. card(A \<inter> {..<n})/n) > l"
    using lower_asymptotic_density_in_01(1) by auto
  then have "eventually (\<lambda>n. card(A \<inter> {..<n})/n > ereal l) sequentially"
    using less_LiminfD by blast
  then have "eventually (\<lambda>n. card(A \<inter> {..<n})/n > ereal l \<and> n > 0) sequentially"
    using eventually_gt_at_top eventually_conj by blast
  moreover have "card(A \<inter> {..<n}) > l * n" if "card(A \<inter> {..<n})/n > ereal l \<and> n > 0" for n
    using that divide_le_eq ereal_less_eq(3) less_imp_of_nat_less not_less of_nat_eq_0_iff by fastforce
  ultimately show "eventually (\<lambda>n. card(A \<inter> {..<n}) > l * n) sequentially"
    by (simp add: eventually_mono)
qed

proposition lower_asymptotic_densityI:
  fixes l::real
  assumes "eventually (\<lambda>n. card(A \<inter> {..<n}) \<ge> l * n) sequentially"
  shows "lower_asymptotic_density A \<ge> l"
proof -
  have "eventually (\<lambda>n. card(A \<inter> {..<n}) \<ge> l * n \<and> n > 0) sequentially"
    using assms eventually_gt_at_top eventually_conj by blast
  moreover have "card(A \<inter> {..<n})/n \<ge> ereal l" if "card(A \<inter> {..<n}) \<ge> l * n \<and> n > 0" for n
    using that by (meson ereal_less_eq(3) not_less of_nat_0_less_iff pos_divide_less_eq)
  ultimately have "eventually (\<lambda>n. card(A \<inter> {..<n})/n \<ge> ereal l) sequentially"
    by (simp add: eventually_mono)
  then have "liminf (\<lambda>n. card(A \<inter> {..<n})/n) \<ge> ereal l"
    by (simp add: Liminf_bounded)
  then have "ereal(lower_asymptotic_density A) \<ge> ereal l"
    using lower_asymptotic_density_in_01(1) by auto
  then show ?thesis by auto
qed

text \<open>One can control the asymptotic density of an intersection in terms of the asymptotic density
of each component\<close>

lemma lower_asymptotic_density_intersection:
  "lower_asymptotic_density A + lower_asymptotic_density B \<le> lower_asymptotic_density (A \<inter> B) + 1"
using upper_asymptotic_density_union[of "UNIV - A" "UNIV - B"]
unfolding lower_upper_asymptotic_density_complement by (auto simp add: algebra_simps Diff_Int)

lemma lower_asymptotic_density_subset:
  assumes "A \<subseteq> B"
  shows "lower_asymptotic_density A \<le> lower_asymptotic_density B"
using upper_asymptotic_density_subset[of "UNIV-B" "UNIV-A"] assms
unfolding lower_upper_asymptotic_density_complement by auto

lemma lower_asymptotic_density_lim:
  assumes "(\<lambda>n. card(A \<inter> {..<n})/n) \<longlonglongrightarrow> l"
  shows "lower_asymptotic_density A = l"
proof -
  have "(\<lambda>n. ereal(card(A \<inter> {..<n})/n)) \<longlonglongrightarrow> l" using assms by auto
  then have "liminf (\<lambda>n. card(A \<inter> {..<n})/n) = l"
    using sequentially_bot tendsto_iff_Liminf_eq_Limsup by blast
  then show ?thesis unfolding lower_asymptotic_density_def by auto
qed

lemma lower_asymptotic_density_finite:
  assumes "finite A"
  shows "lower_asymptotic_density A = 0"
using lower_asymptotic_density_in_01(3) upper_asymptotic_density_finite[OF assms] lower_asymptotic_density_le_upper
by (metis antisym_conv)

text \<open>In particular, bounded intervals have zero lower density.\<close>

lemma lower_asymptotic_density_bdd_interval [simp]:
  "lower_asymptotic_density {} = 0"
  "lower_asymptotic_density {..N} = 0"
  "lower_asymptotic_density {..<N} = 0"
  "lower_asymptotic_density {n..N} = 0"
  "lower_asymptotic_density {n..<N} = 0"
  "lower_asymptotic_density {n<..N} = 0"
  "lower_asymptotic_density {n<..<N} = 0"
by (auto intro!: lower_asymptotic_density_finite)

text \<open>Conversely, unbounded intervals have density $1$.\<close>

lemma lower_asymptotic_density_infinite_interval [simp]:
  "lower_asymptotic_density {N..} = 1"
  "lower_asymptotic_density {N<..} = 1"
  "lower_asymptotic_density UNIV = 1"
proof -
  have "UNIV - {N..} = {..<N}" by auto
  then show "lower_asymptotic_density {N..} = 1"
    by (auto simp add: lower_upper_asymptotic_density_complement)
  have "UNIV - {N<..} = {..N}" by auto
  then show "lower_asymptotic_density {N<..} = 1"
    by (auto simp add: lower_upper_asymptotic_density_complement)
  show "lower_asymptotic_density UNIV = 1"
    by (auto simp add: lower_upper_asymptotic_density_complement)
qed

lemma upper_asymptotic_density_infinite_interval [simp]:
  "upper_asymptotic_density {N..} = 1"
  "upper_asymptotic_density {N<..} = 1"
  "upper_asymptotic_density UNIV = 1"
by (metis antisym upper_asymptotic_density_in_01(2) lower_asymptotic_density_infinite_interval lower_asymptotic_density_le_upper)+

text \<open>The intersection of sets with lower density one still has lower density one.\<close>

lemma lower_asymptotic_density_one_intersection:
  assumes "lower_asymptotic_density A = 1" "lower_asymptotic_density B = 1"
  shows "lower_asymptotic_density (A \<inter> B) = 1"
using lower_asymptotic_density_in_01(2)[of "A \<inter> B"] lower_asymptotic_density_intersection[of A B] unfolding assms by auto

lemma lower_asymptotic_density_one_finite_Intersection:
  assumes "finite I" "\<And>i. i \<in> I \<Longrightarrow> lower_asymptotic_density (A i) = 1"
  shows "lower_asymptotic_density (\<Inter>i\<in>I. A i) = 1"
using assms by (induction rule: finite_induct, auto intro!: lower_asymptotic_density_one_intersection)

text \<open>As for the upper asymptotic density, there is a modification of the intersection, akin
to the diagonal argument in this context, for which the ``intersection'' of sets with large
lower density still has large lower density.\<close>

proposition lower_asymptotic_density_decseq_Inter:
  assumes "\<And>(n::nat). lower_asymptotic_density (A n) \<ge> l" "decseq A"
  shows "\<exists>B. lower_asymptotic_density B \<ge> l \<and> (\<forall>n. \<exists>N. B \<inter> {N..} \<subseteq> A n)"
proof -
  define C where "C = (\<lambda>n. UNIV - A n)"
  have *: "upper_asymptotic_density (C n) \<le> 1 - l" for n
    using assms(1)[of n] unfolding C_def lower_upper_asymptotic_density_complement[of "A n"] by auto
  have **: "incseq C"
    using assms(2) unfolding C_def incseq_def decseq_def by auto
  obtain D where D: "upper_asymptotic_density D \<le> 1 - l" "\<And>n. \<exists>N. C n \<inter> {N..} \<subseteq> D"
    using upper_asymptotic_density_incseq_Union[OF * **] by blast
  define B where "B = UNIV - D"
  have "lower_asymptotic_density B \<ge> l"
    using D(1) lower_upper_asymptotic_density_complement[of B] unfolding B_def by auto
  moreover have "\<exists>N. B \<inter> {N..} \<subseteq> A n" for n
    using D(2)[of n] unfolding B_def C_def by auto
  ultimately show ?thesis by auto
qed

text \<open>In the same way, the modified intersection of sets of density $1$ still has density one,
and is eventually contained in each of them.\<close>

proposition lower_asymptotic_density_one_Inter:
  assumes "\<And>n::nat. lower_asymptotic_density (A n) = 1"
  shows "\<exists>B. lower_asymptotic_density B = 1 \<and> (\<forall>n. \<exists>N. B \<inter> {N..} \<subseteq> A n)"
proof -
  define C where "C = (\<lambda>n. UNIV - A n)"
  have *: "upper_asymptotic_density (C n) = 0" for n
    using assms(1)[of n] unfolding C_def lower_upper_asymptotic_density_complement[of "A n"] by auto
  obtain D where D: "upper_asymptotic_density D = 0" "\<And>n. \<exists>N. C n \<inter> {N..} \<subseteq> D"
    using upper_asymptotic_density_zero_Union[OF *] by force
  define B where "B = UNIV - D"
  have "lower_asymptotic_density B = 1"
    using D(1) lower_upper_asymptotic_density_complement[of B] unfolding B_def by auto
  moreover have "\<exists>N. B \<inter> {N..} \<subseteq> A n" for n
    using D(2)[of n] unfolding B_def C_def by auto
  ultimately show ?thesis by auto
qed

text \<open>Sets with density $1$ play an important role in relation to Cesaro convergence of nonnegative
bounded sequences: such a sequence converges to $0$ in Cesaro average if and only if it converges
to $0$ along a set of density $1$.

The proof is not hard. Since the Cesaro average tends to $0$, then given $\epsilon>0$ the
proportion of times where $u_n < \epsilon$ tends to $1$, i.e., the set $A_\epsilon$ of such good
times has density $1$. A modified intersection (as constructed in
Proposition~\verb+lower_asymptotic_density_one_Inter+) of these times has density $1$, and
$u_n$ tends to $0$ along this set.
\<close>

theorem cesaro_imp_density_one:
  assumes "\<And>n. u n \<ge> (0::real)" "(\<lambda>n. (\<Sum>i<n. u i)/n) \<longlonglongrightarrow> 0"
  shows "\<exists>A. lower_asymptotic_density A = 1 \<and> (\<lambda>n. u n * indicator A n) \<longlonglongrightarrow> 0"
proof -
  define B where "B = (\<lambda>e. {n. u n \<ge> e})"
  text \<open>$B e$ is the set of bad times where $u_n \geq e$. It has density $0$ thanks to
  the assumption of Cesaro convergence to $0$.\<close>
  have A: "upper_asymptotic_density (B e) = 0" if "e > 0" for e
  proof -
    have *: "card (B e \<inter> {..<n}) / n \<le> (1/e) * ((\<Sum>i\<in>{..<n}. u i)/n)" if "n \<ge> 1" for n
    proof -
      have "e * card (B e \<inter> {..<n}) = (\<Sum>i\<in>B e \<inter> {..<n}. e)" by auto
      also have "... \<le> (\<Sum>i\<in>B e \<inter> {..<n}. u i)"
        apply (rule sum_mono) unfolding B_def by auto
      also have "... \<le> (\<Sum>i\<in>{..<n}. u i)"
        apply (rule sum_mono2) using assms by auto
      finally show ?thesis
        using \<open>e > 0\<close> \<open>n \<ge> 1\<close> by (auto simp add: divide_simps algebra_simps)
    qed
    have "(\<lambda>n. card (B e \<inter> {..<n}) / n) \<longlonglongrightarrow> 0"
    proof (rule tendsto_sandwich[of "\<lambda>_. 0" _ _ "\<lambda>n. (1/e) * ((\<Sum>i\<in>{..<n}. u i)/n)"])
      have "(\<lambda>n. (1/e) * ((\<Sum>i\<in>{..<n}. u i)/n)) \<longlonglongrightarrow> (1/e) * 0"
        by (intro tendsto_intros assms)
      then show "(\<lambda>n. (1/e) * ((\<Sum>i\<in>{..<n}. u i)/n)) \<longlonglongrightarrow> 0" by simp
      show "\<forall>\<^sub>F n in sequentially. real (card (B e \<inter> {..<n})) / real n \<le> 1 / e * (sum u {..<n} / real n)"
        using * unfolding eventually_sequentially by auto
    qed (auto)
    then show ?thesis
      by (rule upper_asymptotic_density_lim)
  qed
  define C where "C = (\<lambda>n::nat. UNIV - B (((1::real)/2)^n))"
  have "lower_asymptotic_density (C n) = 1" for n
    unfolding C_def lower_upper_asymptotic_density_complement by (auto intro!: A)
  then obtain A where A: "lower_asymptotic_density A = 1" "\<And>n. \<exists>N. A \<inter> {N..} \<subseteq> C n"
    using lower_asymptotic_density_one_Inter by blast
  have E: "eventually (\<lambda>n. u n * indicator A n < e) sequentially" if "e > 0" for e
  proof -
    have "eventually (\<lambda>n. ((1::real)/2)^n < e) sequentially"
      by (rule order_tendstoD[OF _ \<open>e > 0\<close>], intro tendsto_intros, auto)
    then obtain n where n: "((1::real)/2)^n < e"
      unfolding eventually_sequentially by auto
    obtain N where N: "A \<inter> {N..} \<subseteq> C n"
      using A(2) by blast
    have "u k * indicator A k < e" if "k \<ge> N" for k
    proof (cases "k \<in> A")
      case True
      then have "k \<in> C n" using N that by auto
      then have "u k < ((1::real)/2)^n"
        unfolding C_def B_def by auto
      then have "u k < e"
        using n by auto
      then show ?thesis
        unfolding indicator_def using True by auto
    next
      case False
      then show ?thesis
        unfolding indicator_def using \<open>e > 0\<close> by auto
    qed
    then show ?thesis
      unfolding eventually_sequentially by auto
  qed
  have "(\<lambda>n. u n * indicator A n) \<longlonglongrightarrow> 0"
    apply (rule order_tendstoI[OF _ E])
    unfolding indicator_def using \<open>\<And>n. u n \<ge> 0\<close> by (simp add: less_le_trans)
  then show ?thesis
    using \<open>lower_asymptotic_density A = 1\<close> by auto
qed

text \<open>The proof of the reverse implication is more direct: in the Cesaro sum, just bound the
elements in $A$ by a small $\epsilon$, and the other ones by a uniform bound, to get a bound
which is $o(n)$.\<close>

theorem density_one_imp_cesaro:
  assumes "\<And>n. u n \<ge> (0::real)" "\<And>n. u n \<le> C"
          "lower_asymptotic_density A = 1"
          "(\<lambda>n. u n * indicator A n) \<longlonglongrightarrow> 0"
  shows "(\<lambda>n. (\<Sum>i<n. u i)/n) \<longlonglongrightarrow> 0"
proof (rule order_tendstoI)
  fix e::real assume "e < 0"
  have "(\<Sum>i<n. u i)/n \<ge> 0" for n
    using assms(1) by (simp add: sum_nonneg divide_simps)
  then have "(\<Sum>i<n. u i)/n > e" for n
    using \<open>e < 0\<close> less_le_trans by auto
  then show "eventually (\<lambda>n. (\<Sum>i<n. u i)/n > e) sequentially"
    unfolding eventually_sequentially by auto
next
  fix e::real assume "e > 0"
  have "C \<ge> 0" using \<open>u 0 \<ge> 0\<close> \<open>u 0 \<le> C\<close> by auto
  have "eventually (\<lambda>n. u n * indicator A n < e/4) sequentially"
    using order_tendstoD(2)[OF assms(4), of "e/4"] \<open>e>0\<close> by auto
  then obtain N where N: "\<And>k. k \<ge> N \<Longrightarrow> u k * indicator A k < e/4"
    unfolding eventually_sequentially by auto
  define B where "B = UNIV - A"
  have *: "upper_asymptotic_density B = 0"
    using assms unfolding B_def lower_upper_asymptotic_density_complement by auto
  have "eventually (\<lambda>n. card(B \<inter> {..<n}) < (e/(4 * (C+1))) * n) sequentially"
    apply (rule upper_asymptotic_densityD) using \<open>e > 0\<close> \<open>C \<ge> 0\<close> * by auto
  then obtain M where M: "\<And>n. n \<ge> M \<Longrightarrow> card(B \<inter> {..<n}) < (e/(4 * (C+1))) * n"
      unfolding eventually_sequentially by auto

  obtain P::nat where P: "P \<ge> 4 * N * C/e"
    using real_arch_simple by auto
  define Q where "Q = N + M + 1 + P"

  have "(\<Sum>i<n. u i)/n < e" if "n \<ge> Q" for n
  proof -
    have n: "n \<ge> N" "n \<ge> M" "n \<ge> P" "n \<ge> 1"
      using \<open>n \<ge> Q\<close> unfolding Q_def by auto
    then have n2: "n \<ge> 4 * N * C/e" using P by auto
    have "(\<Sum>i<n. u i) \<le> (\<Sum>i\<in>{..<N} \<union> ({N..<n} \<inter> A) \<union> ({N..<n} - A). u i)"
      by (rule sum_mono2, auto simp add: assms)
    also have "... = (\<Sum>i\<in>{..<N}. u i) + (\<Sum>i\<in>{N..<n} \<inter> A. u i) + (\<Sum>i\<in>{N..<n} - A. u i)"
      by (subst sum.union_disjoint, auto)+
    also have "... = (\<Sum>i\<in>{..<N}. u i) + (\<Sum>i\<in>{N..<n} \<inter> A. u i * indicator A i) + (\<Sum>i\<in>{N..<n} - A. u i)"
      unfolding indicator_def by auto
    also have "... \<le> (\<Sum>i\<in>{..<N}. u i) + (\<Sum>i\<in>{N..<n}. u i * indicator A i) + (\<Sum>i\<in> B \<inter> {..<n}. u i)"
      apply (intro add_mono sum_mono2) unfolding B_def using assms by auto
    also have "... \<le> (\<Sum>i\<in>{..<N}. C) + (\<Sum>i\<in>{N..<n}. e/4) + (\<Sum>i\<in>B \<inter> {..<n}. C)"
      apply (intro add_mono sum_mono) using assms less_imp_le[OF N] by auto
    also have "... = N * C + (n-N) * e/4 + card(B \<inter> {..<n}) * C"
      by auto
    also have "... \<le> n * e/4 + n * e/4 + (e/(4 * (C+1))) * n * C"
      apply (intro add_mono)
      using n2 \<open>e > 0\<close> mult_right_mono[OF less_imp_le[OF M[OF \<open>n \<ge> M\<close>]] \<open>C \<ge> 0\<close>] by (auto simp add: divide_simps)
    also have "... \<le> n * e * 3/4"
      using \<open>C \<ge> 0\<close> \<open>e > 0\<close> by (simp add: divide_simps algebra_simps)
    also have "... < n * e"
      using \<open>n \<ge> 1\<close> \<open>e > 0\<close> by auto
    finally show ?thesis
      using \<open>n \<ge> 1\<close> by (simp add: divide_simps algebra_simps)
  qed
  then show "eventually (\<lambda>n. (\<Sum>i<n. u i)/n < e) sequentially"
    unfolding eventually_sequentially by auto
qed

end (*of Asymptotic_Density.thy*)