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

section \<open>Transfer Operator\<close>

theory Transfer_Operator
  imports Recurrence
begin

context qmpt begin

text \<open>The map $T$ acts on measures by push-forward. In particular, if $f d\mu$ is absolutely continuous
with respect to the reference measure $\mu$, then its push-forward $T_*(f d\mu)$ is absolutely
continuous with respect to $\mu$, and can therefore be written as $g d\mu$ for some function $g$.
The map $f \mapsto g$, representing the action of $T$ on the level of densities, is called the
transfer operator associated to $T$ and often denoted by $\hat T$.

We first define it on nonnegative functions, using Radon-Nikodym derivatives. Then, we extend it
to general real-valued functions by separating it into positive and negative parts.

The theory presents many similarities with the theory of conditional expectations. Indeed, it is
possible to make a theory encompassing the two. When the map is measure preserving,
there is also a direct relationship: $(\hat T f) \circ T$ is the conditional expectation of $f$
with respect to $T^{-1}B$ where $B$ is the sigma-algebra. Instead of building a general theory,
we copy the proofs for conditional expectations and adapt them where needed.\<close>

subsection \<open>The transfer operator on nonnegative functions\<close>

definition nn_transfer_operator :: "('a \<Rightarrow> ennreal) \<Rightarrow> ('a \<Rightarrow> ennreal)"
where
  "nn_transfer_operator f = (if f \<in> borel_measurable M then RN_deriv M (distr (density M f) M T)
                              else (\<lambda>_. 0))"

lemma borel_measurable_nn_transfer_operator [measurable]:
  "nn_transfer_operator f \<in> borel_measurable M"
unfolding nn_transfer_operator_def by auto

lemma borel_measurable_nn_transfer_operator_iterates [measurable]:
  assumes [measurable]: "f \<in> borel_measurable M"
  shows "(nn_transfer_operator^^n) f \<in> borel_measurable M"
by (cases n, auto)

text \<open>The next lemma is arguably the most fundamental property of the transfer operator: it is the
adjoint of the composition by $T$. If one defined it as an abstract adjoint, it would be defined
on the dual of $L^\infty$, which is a large unwieldy space. The point is that it can be defined
on genuine functions, using the push-forward point of view above. However, once we have this
property, we can forget completely about the definition, since this property characterizes
the transfer operator, as the second lemma below shows.
From this point on, we will only work with it, and forget completely about
the definition using Radon-Nikodym derivatives.
\<close>

lemma nn_transfer_operator_intg:
  assumes [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
  shows "(\<integral>\<^sup>+ x. f x * nn_transfer_operator g x \<partial>M) = (\<integral>\<^sup>+ x. f (T x) * g x \<partial>M)"
proof -
  have *: "density M (RN_deriv M (distr (density M g) M T)) = distr (density M g) M T"
    by (rule density_RN_deriv) (auto intro!: quasi_measure_preserving_absolutely_continuous simp add: Tqm)
  have "(\<integral>\<^sup>+ x. f x * nn_transfer_operator g x \<partial>M) = (\<integral>\<^sup>+ x. f x \<partial>(density M (RN_deriv M (distr (density M g) M T))))"
    unfolding nn_transfer_operator_def by (simp add: nn_integral_densityR)
  also have "... = (\<integral>\<^sup>+ x. f x \<partial>(distr (density M g) M T))"
    unfolding * by simp
  also have "... = (\<integral>\<^sup>+ x. f (T x) \<partial>(density M g))"
    by (rule nn_integral_distr, auto)
  also have "... = (\<integral>\<^sup>+ x. f (T x) * g x \<partial>M)"
    by (simp add: nn_integral_densityR)
  finally show ?thesis by auto
qed

lemma nn_transfer_operator_intTn_g:
  assumes "f \<in> borel_measurable M" "g \<in> borel_measurable M"
  shows "(\<integral>\<^sup>+ x. f x * (nn_transfer_operator^^n) g x \<partial>M) = (\<integral>\<^sup>+ x. f ((T^^n) x) * g x \<partial>M)"
proof -
  have "\<And>f g. f \<in> borel_measurable M \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow> (\<integral>\<^sup>+ x. f x * (nn_transfer_operator^^n) g x \<partial>M) = (\<integral>\<^sup>+ x. f ((T^^n) x) * g x \<partial>M)" for n
  proof (induction n)
    case (Suc n)
    have [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M" by fact+
    have "(\<integral>\<^sup>+ x. f x * (nn_transfer_operator ^^ Suc n) g x \<partial>M) = (\<integral>\<^sup>+ x. f x * (nn_transfer_operator ((nn_transfer_operator^^n) g)) x \<partial>M)"
      apply (rule nn_integral_cong) using funpow.simps(2) unfolding comp_def by auto
    also have "... = (\<integral>\<^sup>+ x. f (T x) * (nn_transfer_operator^^n) g x \<partial>M)"
      by (rule nn_transfer_operator_intg, auto)
    also have "... = (\<integral>\<^sup>+ x. (\<lambda>x. f (T x)) ((T^^n) x) * g x \<partial>M)"
      by (rule Suc.IH, auto)
    also have "... = (\<integral>\<^sup>+ x. f ((T^^(Suc n)) x) * g x \<partial>M)"
      apply (rule nn_integral_cong) using funpow.simps(2) unfolding comp_def by auto
    finally show ?case by auto
  qed (simp)
  then show ?thesis using assms by auto
qed

lemma nn_transfer_operator_intg_Tn:
  assumes "f \<in> borel_measurable M" "g \<in> borel_measurable M"
  shows "(\<integral>\<^sup>+ x. (nn_transfer_operator^^n) g x * f x \<partial>M) = (\<integral>\<^sup>+ x. g x * f ((T^^n) x) \<partial>M)"
using nn_transfer_operator_intTn_g[OF assms, of n] by (simp add: algebra_simps)

lemma nn_transfer_operator_charact:
  assumes "\<And>A. A \<in> sets M \<Longrightarrow> (\<integral>\<^sup>+ x. indicator A x * g x \<partial>M) = (\<integral>\<^sup>+ x. indicator A (T x) * f x \<partial>M)" and
          [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
  shows "AE x in M. nn_transfer_operator f x = g x"
proof -
  have *:"set_nn_integral M A g = set_nn_integral M A (nn_transfer_operator f)" if [measurable]: "A \<in> sets M" for A
  proof -
    have "set_nn_integral M A g = (\<integral>\<^sup>+ x. indicator A x * g x \<partial>M)"
      using mult.commute by metis
    also have "... = (\<integral>\<^sup>+ x. indicator A (T x) * f x \<partial>M)"
      using assms(1) by auto
    also have "... = (\<integral>\<^sup>+ x. indicator A x * nn_transfer_operator f x \<partial>M)"
      by (rule nn_transfer_operator_intg[symmetric], auto)
    finally show ?thesis
      using mult.commute by (metis (no_types, lifting) nn_integral_cong)
  qed
  show ?thesis
    by (rule sigma_finite_measure.density_unique2, auto simp add: sigma_finite_measure_axioms *)
qed

text \<open>When $T$ is measure-preserving, $\hat T(f \circ T) = f$.\<close>

lemma (in mpt) nn_transfer_operator_foT:
  assumes [measurable]: "f \<in> borel_measurable M"
  shows "AE x in M. nn_transfer_operator (f o T) x = f x"
proof -
  have *: "(\<integral>\<^sup>+ x. indicator A x * f x \<partial>M) = (\<integral>\<^sup>+ x. indicator A (T x) * f (T x) \<partial>M)" if [measurable]: "A \<in> sets M" for A
    by (subst T_nn_integral_preserving[symmetric]) auto
  show ?thesis
    by (rule nn_transfer_operator_charact) (auto simp add: assms *)
qed

text \<open>In general, one only has $\hat T(f\circ T \cdot g) = f \cdot \hat T g$.\<close>
lemma nn_transfer_operator_foT_g:
  assumes [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
  shows "AE x in M. nn_transfer_operator (\<lambda>x. f (T x) * g x) x = f x * nn_transfer_operator g x"
proof -
  have *: "(\<integral>\<^sup>+ x. indicator A x * (f x * nn_transfer_operator g x) \<partial>M) = (\<integral>\<^sup>+ x. indicator A (T x) * (f (T x) * g x) \<partial>M)"
    if [measurable]: "A \<in> sets M" for A
    by (simp add: mult.assoc[symmetric] nn_transfer_operator_intg)
  show ?thesis
    by (rule nn_transfer_operator_charact) (auto simp add: assms *)
qed

lemma nn_transfer_operator_cmult:
  assumes [measurable]: "g \<in> borel_measurable M"
  shows "AE x in M. nn_transfer_operator (\<lambda>x. c * g x) x = c * nn_transfer_operator g x"
apply (rule nn_transfer_operator_foT_g) using assms by auto

lemma nn_transfer_operator_zero:
  "AE x in M. nn_transfer_operator (\<lambda>x. 0) x = 0"
using nn_transfer_operator_cmult[of "\<lambda>x. 0" 0] by auto

lemma nn_transfer_operator_sum:
  assumes [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
  shows "AE x in M. nn_transfer_operator (\<lambda>x. f x + g x) x = nn_transfer_operator f x + nn_transfer_operator g x"
proof (rule nn_transfer_operator_charact)
  fix A assume [measurable]: "A \<in> sets M"
  have "(\<integral>\<^sup>+ x. indicator A x * (nn_transfer_operator f x + nn_transfer_operator g x) \<partial>M) =
        (\<integral>\<^sup>+ x. indicator A x * nn_transfer_operator f x + indicator A x * nn_transfer_operator g x \<partial>M)"
    by (auto simp add: algebra_simps)
  also have "... = (\<integral>\<^sup>+x. indicator A x * nn_transfer_operator f x \<partial>M) + (\<integral>\<^sup>+x. indicator A x * nn_transfer_operator g x \<partial>M)"
    by (rule nn_integral_add, auto)
  also have "... = (\<integral>\<^sup>+x. indicator A (T x) * f x \<partial>M) + (\<integral>\<^sup>+x. indicator A (T x) * g x \<partial>M)"
    by (simp add: nn_transfer_operator_intg)
  also have "... = (\<integral>\<^sup>+x. indicator A (T x) * f x + indicator A (T x) * g x \<partial>M)"
    by (rule nn_integral_add[symmetric], auto)
  also have "... = (\<integral>\<^sup>+x. indicator A (T x) * (f x + g x) \<partial>M)"
    by (auto simp add: algebra_simps)
  finally show "(\<integral>\<^sup>+ x. indicator A x * (nn_transfer_operator f x + nn_transfer_operator g x) \<partial>M) = (\<integral>\<^sup>+x. indicator A (T x) * (f x + g x) \<partial>M)"
    by simp
qed (auto simp add: assms)

lemma nn_transfer_operator_cong:
  assumes "AE x in M. f x = g x"
      and [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
  shows "AE x in M. nn_transfer_operator f x = nn_transfer_operator g x"
apply (rule nn_transfer_operator_charact)
apply (auto simp add: nn_transfer_operator_intg assms intro!: nn_integral_cong_AE)
using assms by auto

lemma nn_transfer_operator_mono:
  assumes "AE x in M. f x \<le> g x"
      and [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
  shows "AE x in M. nn_transfer_operator f x \<le> nn_transfer_operator g x"
proof -
  define h where "h = (\<lambda>x. g x - f x)"
  have [measurable]: "h \<in> borel_measurable M" unfolding h_def by simp
  have *: "AE x in M. g x = f x + h x" unfolding h_def using assms(1) by (auto simp: ennreal_ineq_diff_add)
  have "AE x in M. nn_transfer_operator g x = nn_transfer_operator (\<lambda>x. f x + h x) x"
    by (rule nn_transfer_operator_cong) (auto simp add: * assms)
  moreover have "AE x in M. nn_transfer_operator (\<lambda>x. f x + h x) x = nn_transfer_operator f x + nn_transfer_operator h x"
    by (rule nn_transfer_operator_sum) (auto simp add: assms)
  ultimately have "AE x in M. nn_transfer_operator g x = nn_transfer_operator f x + nn_transfer_operator h x" by auto
  then show ?thesis by force
qed

subsection \<open>The transfer operator on real functions\<close>

text \<open>Once the transfer operator of positive functions is defined, the definition for real-valued
functions follows readily, by taking the difference of positive and negative parts.
\<close>

definition real_transfer_operator :: "('a \<Rightarrow> real) \<Rightarrow> ('a \<Rightarrow> real)" where
  "real_transfer_operator f =
    (\<lambda>x. enn2real(nn_transfer_operator (\<lambda>x. ennreal (f x)) x) - enn2real(nn_transfer_operator (\<lambda>x. ennreal (-f x)) x))"

lemma borel_measurable_transfer_operator [measurable]:
  "real_transfer_operator f \<in> borel_measurable M"
unfolding real_transfer_operator_def by auto

lemma borel_measurable_transfer_operator_iterates [measurable]:
  assumes [measurable]: "f \<in> borel_measurable M"
  shows "(real_transfer_operator^^n) f \<in> borel_measurable M"
by (cases n, auto)

lemma real_transfer_operator_abs:
  assumes [measurable]: "f \<in> borel_measurable M"
  shows "AE x in M. abs (real_transfer_operator f x) \<le> nn_transfer_operator (\<lambda>x. ennreal (abs(f x))) x"
proof -
  define fp where "fp = (\<lambda>x. ennreal (f x))"
  define fm where "fm = (\<lambda>x. ennreal (- f x))"
  have [measurable]: "fp \<in> borel_measurable M" "fm \<in> borel_measurable M" unfolding fp_def fm_def by auto
  have eq: "\<And>x. ennreal \<bar>f x\<bar> = fp x + fm x" unfolding fp_def fm_def by (simp add: abs_real_def ennreal_neg)

  {
    fix x assume H: "nn_transfer_operator (\<lambda>x. fp x + fm x) x = nn_transfer_operator fp x + nn_transfer_operator fm x"
    have "\<bar>real_transfer_operator f x\<bar> \<le> \<bar>enn2real(nn_transfer_operator fp x)\<bar> + \<bar>enn2real(nn_transfer_operator fm x)\<bar>"
      unfolding real_transfer_operator_def fp_def fm_def by (auto intro: abs_triangle_ineq4 simp del: enn2real_nonneg)
    from ennreal_leI[OF this]
    have "abs(real_transfer_operator f x) \<le> nn_transfer_operator fp x + nn_transfer_operator fm x"
      by simp (metis add.commute ennreal_enn2real le_iff_add not_le top_unique)
    also have "... = nn_transfer_operator (\<lambda>x. fp x + fm x) x" using H by simp
    finally have "abs(real_transfer_operator f x) \<le> nn_transfer_operator (\<lambda>x. fp x + fm x) x" by simp
  }
  moreover have "AE x in M. nn_transfer_operator (\<lambda>x. fp x + fm x) x = nn_transfer_operator fp x + nn_transfer_operator fm x"
    by (rule nn_transfer_operator_sum) (auto simp add: fp_def fm_def)
  ultimately have "AE x in M. abs(real_transfer_operator f x) \<le> nn_transfer_operator (\<lambda>x. fp x + fm x) x"
    by auto
  then show ?thesis using eq by simp
qed

text \<open>The next lemma shows that the transfer operator as we have defined it satisfies the basic
duality relation $\int \hat T f \cdot g = \int f \cdot g \circ T$. It follows from the same relation
for nonnegative functions, and splitting into positive and negative parts.

Moreover, this relation characterizes the transfer operator. Hence, once this lemma is proved, we
will never come back to the original definition of the transfer operator.\<close>

lemma real_transfer_operator_intg_fpos:
  assumes "integrable M (\<lambda>x. f (T x) * g x)" and f_pos[simp]: "\<And>x. f x \<ge> 0" and
          [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
  shows "integrable M (\<lambda>x. f x * real_transfer_operator g x)"
        "(\<integral> x. f x * real_transfer_operator g x \<partial>M) = (\<integral> x. f (T x) * g x \<partial>M)"
proof -
  define gp where "gp = (\<lambda>x. ennreal (g x))"
  define gm where "gm = (\<lambda>x. ennreal (- g x))"
  have [measurable]: "gp \<in> borel_measurable M" "gm \<in> borel_measurable M" unfolding gp_def gm_def by auto
  define h where "h = (\<lambda>x. ennreal(abs(g x)))"
  have hgpgm: "\<And>x. h x = gp x + gm x" unfolding gp_def gm_def h_def by (simp add: abs_real_def ennreal_neg)
  have [measurable]: "h \<in> borel_measurable M" unfolding h_def by simp
  have pos[simp]: "\<And>x. h x \<ge> 0" "\<And>x. gp x \<ge> 0" "\<And>x. gm x \<ge> 0" unfolding h_def gp_def gm_def by simp_all
  have gp_real: "\<And>x. enn2real(gp x) = max (g x) 0"
    unfolding gp_def by (simp add: max_def ennreal_neg)
  have gm_real: "\<And>x. enn2real(gm x) = max (-g x) 0"
    unfolding gm_def by (simp add: max_def ennreal_neg)

  have "(\<integral>\<^sup>+ x. norm(f (T x) * max (g x) 0) \<partial>M) \<le> (\<integral>\<^sup>+ x. norm(f (T x) * g x) \<partial>M)"
    by (simp add: nn_integral_mono)
  also have "... < \<infinity>" using assms(1) by (simp add: integrable_iff_bounded)
  finally have "(\<integral>\<^sup>+ x. norm(f (T x) * max (g x) 0) \<partial>M) < \<infinity>" by simp
  then have int1: "integrable M (\<lambda>x. f (T x) * max (g x) 0)" by (simp add: integrableI_bounded)

  have "(\<integral>\<^sup>+ x. norm(f (T x) * max (-g x) 0) \<partial>M) \<le> (\<integral>\<^sup>+ x. norm(f (T x) * g x) \<partial>M)"
    by (simp add: nn_integral_mono)
  also have "... < \<infinity>" using assms(1) by (simp add: integrable_iff_bounded)
  finally have "(\<integral>\<^sup>+ x. norm(f (T x) * max (-g x) 0) \<partial>M) < \<infinity>" by simp
  then have int2: "integrable M (\<lambda>x. f (T x) * max (-g x) 0)" by (simp add: integrableI_bounded)

  have "(\<integral>\<^sup>+x. f x * nn_transfer_operator h x \<partial>M) = (\<integral>\<^sup>+x. f (T x) * h x \<partial>M)"
    by (rule nn_transfer_operator_intg) auto
  also have "\<dots> = \<integral>\<^sup>+ x. ennreal (f (T x) * max (g x) 0 + f (T x) * max (- g x) 0) \<partial>M"
    unfolding h_def
    by (intro nn_integral_cong)(auto simp: ennreal_mult[symmetric] abs_mult split: split_max)
  also have "... < \<infinity>"
    using Bochner_Integration.integrable_add[OF int1 int2, THEN integrableD(2)] by (auto simp add: less_top)
  finally have *: "(\<integral>\<^sup>+x. f x * nn_transfer_operator h x \<partial>M) < \<infinity>" by simp

  have "(\<integral>\<^sup>+x. norm(f x * real_transfer_operator g x) \<partial>M) = (\<integral>\<^sup>+x. f x * abs(real_transfer_operator g x) \<partial>M)"
    by (simp add: abs_mult)
  also have "... \<le> (\<integral>\<^sup>+x. f x * nn_transfer_operator h x \<partial>M)"
  proof (rule nn_integral_mono_AE)
    {
      fix x assume *: "abs(real_transfer_operator g x) \<le> nn_transfer_operator h x"
      have "ennreal (f x * \<bar>real_transfer_operator g x\<bar>) = f x * ennreal(\<bar>real_transfer_operator g x\<bar>)"
        by (simp add: ennreal_mult)
      also have "... \<le> f x * nn_transfer_operator h x"
        using * by (auto intro!: mult_left_mono)
      finally have "ennreal (f x * \<bar>real_transfer_operator g x\<bar>) \<le> f x * nn_transfer_operator h x"
        by simp
    }
    then show "AE x in M. ennreal (f x * \<bar>real_transfer_operator g x\<bar>) \<le> f x * nn_transfer_operator h x"
      using real_transfer_operator_abs[OF assms(4)] h_def by auto
  qed
  finally have **: "(\<integral>\<^sup>+x. norm(f x * real_transfer_operator g x) \<partial>M) < \<infinity>" using * by auto
  show "integrable M (\<lambda>x. f x * real_transfer_operator g x)"
    using ** by (intro integrableI_bounded) auto

  have "(\<integral>\<^sup>+x. f x * nn_transfer_operator gp x \<partial>M) \<le> (\<integral>\<^sup>+x. f x * nn_transfer_operator h x \<partial>M)"
  proof (rule nn_integral_mono_AE)
    have "AE x in M. nn_transfer_operator gp x \<le> nn_transfer_operator h x"
      by (rule nn_transfer_operator_mono) (auto simp add: hgpgm)
    then show "AE x in M. f x * nn_transfer_operator gp x \<le> f x * nn_transfer_operator h x"
      by (auto simp: mult_left_mono)
  qed
  then have a: "(\<integral>\<^sup>+x. f x * nn_transfer_operator gp x \<partial>M) < \<infinity>"
    using * by auto
  have "ennreal(norm(f x * enn2real(nn_transfer_operator gp x))) \<le> f x * nn_transfer_operator gp x" for x
    by (auto simp add: ennreal_mult intro!: mult_left_mono)
       (metis enn2real_ennreal enn2real_nonneg le_cases le_ennreal_iff)
  then have "(\<integral>\<^sup>+x. norm(f x * enn2real(nn_transfer_operator gp x)) \<partial>M) \<le> (\<integral>\<^sup>+x. f x * nn_transfer_operator gp x \<partial>M)"
    by (simp add: nn_integral_mono)
  then have "(\<integral>\<^sup>+x. norm(f x * enn2real(nn_transfer_operator gp x)) \<partial>M) < \<infinity>" using a by auto
  then have gp_int: "integrable M (\<lambda>x. f x * enn2real(nn_transfer_operator gp x))" by (simp add: integrableI_bounded)
  have gp_fin: "AE x in M. f x * nn_transfer_operator gp x \<noteq> \<infinity>"
    apply (rule nn_integral_PInf_AE) using a by auto

  have "(\<integral> x. f x * enn2real(nn_transfer_operator gp x) \<partial>M) = enn2real (\<integral>\<^sup>+ x. f x * enn2real(nn_transfer_operator gp x) \<partial>M)"
    by (rule integral_eq_nn_integral) auto
  also have "... = enn2real(\<integral>\<^sup>+ x. ennreal(f (T x) * enn2real(gp x)) \<partial>M)"
  proof -
    {
      fix x assume "f x * nn_transfer_operator gp x \<noteq> \<infinity>"
      then have "ennreal (f x * enn2real (nn_transfer_operator gp x)) = ennreal (f x) * nn_transfer_operator gp x"
        by (auto simp add: ennreal_mult ennreal_mult_eq_top_iff less_top intro!: ennreal_mult_left_cong)
    }
    then have "AE x in M. ennreal (f x * enn2real (nn_transfer_operator gp x)) = ennreal (f x) * nn_transfer_operator gp x"
      using gp_fin by auto
    then have "(\<integral>\<^sup>+ x. f x * enn2real(nn_transfer_operator gp x) \<partial>M) = (\<integral>\<^sup>+ x. f x * nn_transfer_operator gp x \<partial>M)"
      by (rule nn_integral_cong_AE)
    also have "... = (\<integral>\<^sup>+ x. f (T x) * gp x \<partial>M)"
      by (rule nn_transfer_operator_intg) (auto simp add: gp_def)
    also have "... = (\<integral>\<^sup>+ x. ennreal(f (T x) * enn2real(gp x)) \<partial>M)"
      by (rule nn_integral_cong_AE) (auto simp: ennreal_mult gp_def)
    finally have "(\<integral>\<^sup>+ x. f x * enn2real(nn_transfer_operator gp x) \<partial>M) = (\<integral>\<^sup>+ x. ennreal(f (T x) * enn2real(gp x)) \<partial>M)" by simp
    then show ?thesis by simp
  qed
  also have "... = (\<integral> x. f (T x) * enn2real(gp x) \<partial>M)"
    by (rule integral_eq_nn_integral[symmetric]) (auto simp add: gp_def)
  finally have gp_expr: "(\<integral> x. f x * enn2real(nn_transfer_operator gp x) \<partial>M) = (\<integral> x. f (T x) * enn2real(gp x) \<partial>M)" by simp

  have "(\<integral>\<^sup>+x. f x * nn_transfer_operator gm x \<partial>M) \<le> (\<integral>\<^sup>+x. f x * nn_transfer_operator h x \<partial>M)"
  proof (rule nn_integral_mono_AE)
    have "AE x in M. nn_transfer_operator gm x \<le> nn_transfer_operator h x"
      by (rule nn_transfer_operator_mono) (auto simp add: hgpgm)
    then show "AE x in M. f x * nn_transfer_operator gm x \<le> f x * nn_transfer_operator h x"
      by (auto simp: mult_left_mono)
  qed
  then have a: "(\<integral>\<^sup>+x. f x * nn_transfer_operator gm x \<partial>M) < \<infinity>"
    using * by auto
  have "\<And>x. ennreal(norm(f x * enn2real(nn_transfer_operator gm x))) \<le> f x * nn_transfer_operator gm x"
    by (auto simp add: ennreal_mult intro!: mult_left_mono)
       (metis enn2real_ennreal enn2real_nonneg le_cases le_ennreal_iff)
  then have "(\<integral>\<^sup>+x. norm(f x * enn2real(nn_transfer_operator gm x)) \<partial>M) \<le> (\<integral>\<^sup>+x. f x * nn_transfer_operator gm x \<partial>M)"
    by (simp add: nn_integral_mono)
  then have "(\<integral>\<^sup>+x. norm(f x * enn2real(nn_transfer_operator gm x)) \<partial>M) < \<infinity>" using a by auto
  then have gm_int: "integrable M (\<lambda>x. f x * enn2real(nn_transfer_operator gm x))" by (simp add: integrableI_bounded)
  have gm_fin: "AE x in M. f x * nn_transfer_operator gm x \<noteq> \<infinity>"
    apply (rule nn_integral_PInf_AE) using a by auto

  have "(\<integral> x. f x * enn2real(nn_transfer_operator gm x) \<partial>M) = enn2real (\<integral>\<^sup>+ x. f x * enn2real(nn_transfer_operator gm x) \<partial>M)"
    by (rule integral_eq_nn_integral) auto
  also have "... = enn2real(\<integral>\<^sup>+ x. ennreal(f (T x) * enn2real(gm x)) \<partial>M)"
  proof -
    {
      fix x assume "f x * nn_transfer_operator gm x \<noteq> \<infinity>"
      then have "ennreal (f x * enn2real (nn_transfer_operator gm x)) = ennreal (f x) * nn_transfer_operator gm x"
        by (auto simp add: ennreal_mult ennreal_mult_eq_top_iff less_top intro!: ennreal_mult_left_cong)
    }
    then have "AE x in M. ennreal (f x * enn2real (nn_transfer_operator gm x)) = ennreal (f x) * nn_transfer_operator gm x"
      using gm_fin by auto
    then have "(\<integral>\<^sup>+ x. f x * enn2real(nn_transfer_operator gm x) \<partial>M) = (\<integral>\<^sup>+ x. f x * nn_transfer_operator gm x \<partial>M)"
      by (rule nn_integral_cong_AE)
    also have "... = (\<integral>\<^sup>+ x. f (T x) * gm x \<partial>M)"
      by (rule nn_transfer_operator_intg) (auto simp add: gm_def)
    also have "... = (\<integral>\<^sup>+ x. ennreal(f (T x) * enn2real(gm x)) \<partial>M)"
      by (rule nn_integral_cong_AE) (auto simp: ennreal_mult gm_def)
    finally have "(\<integral>\<^sup>+ x. f x * enn2real(nn_transfer_operator gm x) \<partial>M) = (\<integral>\<^sup>+ x. ennreal(f (T x) * enn2real(gm x)) \<partial>M)" by simp
    then show ?thesis by simp
  qed
  also have "... = (\<integral> x. f (T x) * enn2real(gm x) \<partial>M)"
    by (rule integral_eq_nn_integral[symmetric]) (auto simp add: gm_def)
  finally have gm_expr: "(\<integral> x. f x * enn2real(nn_transfer_operator gm x) \<partial>M) = (\<integral> x. f (T x) * enn2real(gm x) \<partial>M)" by simp

  have "(\<integral> x. f x * real_transfer_operator g x \<partial>M) = (\<integral> x. f x * enn2real(nn_transfer_operator gp x) - f x * enn2real(nn_transfer_operator gm x) \<partial>M)"
    unfolding real_transfer_operator_def gp_def gm_def by (simp add: right_diff_distrib)
  also have "... = (\<integral> x. f x * enn2real(nn_transfer_operator gp x) \<partial>M) - (\<integral> x. f x * enn2real(nn_transfer_operator gm x) \<partial>M)"
    by (rule Bochner_Integration.integral_diff) (simp_all add: gp_int gm_int)
  also have "... = (\<integral> x. f (T x) * enn2real(gp x) \<partial>M) - (\<integral> x. f (T x) * enn2real(gm x) \<partial>M)"
    using gp_expr gm_expr by simp
  also have "... = (\<integral> x. f (T x) * max (g x) 0 \<partial>M) - (\<integral> x. f (T x) * max (-g x) 0 \<partial>M)"
    using gp_real gm_real by simp
  also have "... = (\<integral> x. f (T x) * max (g x) 0 - f (T x) * max (-g x) 0 \<partial>M)"
    by (rule Bochner_Integration.integral_diff[symmetric]) (simp_all add: int1 int2)
  also have "... = (\<integral>x. f (T x) * g x \<partial>M)"
    by (metis (mono_tags, hide_lams) diff_0 diff_zero eq_iff max.cobounded2 max_def minus_minus neg_le_0_iff_le right_diff_distrib)
  finally show "(\<integral> x. f x * real_transfer_operator g x \<partial>M) = (\<integral>x. f (T x) * g x \<partial>M)"
    by simp
qed

lemma real_transfer_operator_intg:
  assumes "integrable M (\<lambda>x. f (T x) * g x)" and
          [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
  shows "integrable M (\<lambda>x. f x * real_transfer_operator g x)"
        "(\<integral> x. f x * real_transfer_operator g x \<partial>M) = (\<integral> x. f (T x) * g x \<partial>M)"
proof -
  define fp where "fp = (\<lambda>x. max (f x) 0)"
  define fm where "fm = (\<lambda>x. max (-f x) 0)"
  have [measurable]: "fp \<in> borel_measurable M" "fm \<in> borel_measurable M"
    unfolding fp_def fm_def by simp_all

  have "(\<integral>\<^sup>+ x. norm(fp (T x) * g x) \<partial>M) \<le> (\<integral>\<^sup>+ x. norm(f (T x) * g x) \<partial>M)"
    by (simp add: fp_def nn_integral_mono)
  also have "... < \<infinity>" using assms(1) by (simp add: integrable_iff_bounded)
  finally have "(\<integral>\<^sup>+ x. norm(fp (T x) * g x) \<partial>M) < \<infinity>" by simp
  then have intp: "integrable M (\<lambda>x. fp (T x) * g x)" by (simp add: integrableI_bounded)
  moreover have "\<And>x. fp x \<ge> 0" unfolding fp_def by simp
  ultimately have Rp: "integrable M (\<lambda>x. fp x * real_transfer_operator g x)"
    "(\<integral> x. fp x * real_transfer_operator g x \<partial>M) = (\<integral> x. fp (T x) * g x \<partial>M)"
  using real_transfer_operator_intg_fpos by auto

  have "(\<integral>\<^sup>+ x. norm(fm (T x) * g x) \<partial>M) \<le> (\<integral>\<^sup>+ x. norm(f (T x) * g x) \<partial>M)"
    by (simp add: fm_def nn_integral_mono)
  also have "... < \<infinity>" using assms(1) by (simp add: integrable_iff_bounded)
  finally have "(\<integral>\<^sup>+ x. norm(fm (T x) * g x) \<partial>M) < \<infinity>" by simp
  then have intm: "integrable M (\<lambda>x. fm (T x) * g x)" by (simp add: integrableI_bounded)
  moreover have "\<And>x. fm x \<ge> 0" unfolding fm_def by simp
  ultimately have Rm: "integrable M (\<lambda>x. fm x * real_transfer_operator g x)"
    "(\<integral> x. fm x * real_transfer_operator g x \<partial>M) = (\<integral> x. fm (T x) * g x \<partial>M)"
  using real_transfer_operator_intg_fpos by auto

  have "integrable M (\<lambda>x. fp x * real_transfer_operator g x - fm x * real_transfer_operator g x)"
    using Rp(1) Rm(1) integrable_diff by simp
  moreover have *: "\<And>x. f x * real_transfer_operator g x = fp x * real_transfer_operator g x - fm x * real_transfer_operator g x"
    unfolding fp_def fm_def by (simp add: max_def)
  ultimately show "integrable M (\<lambda>x. f x * real_transfer_operator g x)"
    by simp

  have "(\<integral> x. f x * real_transfer_operator g x \<partial>M) = (\<integral> x. fp x * real_transfer_operator g x - fm x * real_transfer_operator g x \<partial>M)"
    using * by simp
  also have "... = (\<integral> x. fp x * real_transfer_operator g x \<partial>M) - (\<integral> x. fm x * real_transfer_operator g x \<partial>M)"
    using Rp(1) Rm(1) by simp
  also have "... = (\<integral> x. fp (T x) * g x \<partial>M) - (\<integral> x. fm (T x) * g x \<partial>M)"
    using Rp(2) Rm(2) by simp
  also have "... = (\<integral> x. fp (T x) * g x - fm (T x) * g x \<partial>M)"
    using intm intp by simp
  also have "... = (\<integral> x. f (T x) * g x \<partial>M)"
    unfolding fp_def fm_def by (metis (no_types, hide_lams) diff_0 diff_zero max.commute
    max_def minus_minus mult.commute neg_le_iff_le right_diff_distrib)
  finally show "(\<integral> x. f x * real_transfer_operator g x \<partial>M) = (\<integral> x. f (T x) * g x \<partial>M)" by simp
qed

lemma real_transfer_operator_int [intro]:
  assumes "integrable M f"
  shows "integrable M (real_transfer_operator f)"
        "(\<integral>x. real_transfer_operator f x \<partial>M) = (\<integral>x. f x \<partial>M)"
using real_transfer_operator_intg[where ?f = "\<lambda>x. 1" and ?g = f] assms by auto

lemma real_transfer_operator_charact:
  assumes "\<And>A. A \<in> sets M \<Longrightarrow> (\<integral>x. indicator A x * g x \<partial>M) = (\<integral>x. indicator A (T x) * f x \<partial>M)"
      and [measurable]: "integrable M f" "integrable M g"
  shows "AE x in M. real_transfer_operator f x = g x"
proof (rule AE_symmetric[OF density_unique_real])
  fix A assume [measurable]: "A \<in> sets M"
  have "set_lebesgue_integral M A (real_transfer_operator f) = (\<integral>x. indicator A x * real_transfer_operator f x \<partial>M)"
    unfolding set_lebesgue_integral_def by auto
  also have "... = (\<integral>x. indicator A (T x) * f x \<partial>M)"
    apply (rule real_transfer_operator_intg, auto)
    by (rule Bochner_Integration.integrable_bound[of _ "\<lambda>x. abs(f x)"], auto simp add: assms indicator_def)
  also have "... = set_lebesgue_integral M A g"
    unfolding set_lebesgue_integral_def using assms(1)[OF \<open>A \<in> sets M\<close>] by auto
  finally show "set_lebesgue_integral M A g = set_lebesgue_integral M A (real_transfer_operator f)"
    by simp
qed (auto simp add: assms real_transfer_operator_int)

lemma (in mpt) real_transfer_operator_foT:
  assumes "integrable M f"
  shows "AE x in M. real_transfer_operator (f o T) x = f x"
proof -
  have *: "(\<integral> x. indicator A x * f x \<partial>M) = (\<integral>x. indicator A (T x) * f (T x) \<partial>M)" if [measurable]: "A \<in> sets M" for A
    apply (subst T_integral_preserving)
    using integrable_real_mult_indicator[OF that assms] by (auto simp add: mult.commute)
  show ?thesis
    apply (rule real_transfer_operator_charact)
    using assms * by (auto simp add: comp_def T_integral_preserving)
qed

lemma real_transfer_operator_foT_g:
  assumes [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M" "integrable M (\<lambda>x. f (T x) * g x)"
  shows "AE x in M. real_transfer_operator (\<lambda>x. f (T x) * g x) x = f x * real_transfer_operator g x"
proof -
  have *: "(\<integral>x. indicator A x * (f x * real_transfer_operator g x) \<partial>M) = (\<integral>x. indicator A (T x) * (f (T x) * g x) \<partial>M)"
    if [measurable]: "A \<in> sets M" for A
    apply (simp add: mult.assoc[symmetric])
    apply (subst real_transfer_operator_intg)
    apply (rule Bochner_Integration.integrable_bound[of _ "(\<lambda>x. f (T x) * g x)"])
    by (auto simp add: assms indicator_def)
  show ?thesis
    by (rule real_transfer_operator_charact) (auto simp add: assms * intro!: real_transfer_operator_intg)
qed

lemma real_transfer_operator_add [intro]:
  assumes [measurable]: "integrable M f" "integrable M g"
  shows "AE x in M. real_transfer_operator (\<lambda>x. f x + g x) x = real_transfer_operator f x + real_transfer_operator g x"
proof (rule real_transfer_operator_charact)
  have "integrable M (real_transfer_operator f)" "integrable M (real_transfer_operator g)"
    using real_transfer_operator_int(1) assms by auto
  then show "integrable M (\<lambda>x. real_transfer_operator f x + real_transfer_operator g x)"
    by auto

  fix A assume [measurable]: "A \<in> sets M"
  have intAf: "integrable M (\<lambda>x. indicator A (T x) * f x)"
    apply (rule Bochner_Integration.integrable_bound[OF assms(1)]) unfolding indicator_def by auto
  have intAg: "integrable M (\<lambda>x. indicator A (T x) * g x)"
    apply (rule Bochner_Integration.integrable_bound[OF assms(2)]) unfolding indicator_def by auto

  have "(\<integral>x. indicator A x * (real_transfer_operator f x + real_transfer_operator g x)\<partial>M)
      = (\<integral>x. indicator A x * real_transfer_operator f x + indicator A x* real_transfer_operator g x \<partial>M)"
    by (simp add: algebra_simps)
  also have "... = (\<integral>x. indicator A x * real_transfer_operator f x \<partial>M) + (\<integral>x. indicator A x * real_transfer_operator g x \<partial>M)"
    apply (rule Bochner_Integration.integral_add)
    using integrable_real_mult_indicator[OF \<open>A \<in> sets M\<close> real_transfer_operator_int(1)[OF assms(1)]]
          integrable_real_mult_indicator[OF \<open>A \<in> sets M\<close> real_transfer_operator_int(1)[OF assms(2)]]
    by (auto simp add: mult.commute)
  also have "... = (\<integral>x. indicator A (T x) * f x \<partial>M) + (\<integral>x. indicator A (T x) * g x \<partial>M)"
    using real_transfer_operator_intg(2) assms \<open>A \<in> sets M\<close> intAf intAg by auto
  also have "... = (\<integral>x. indicator A (T x) * f x + indicator A (T x) * g x \<partial>M)"
    by (rule Bochner_Integration.integral_add[symmetric]) (auto simp add: assms \<open>A \<in> sets M\<close> intAf intAg)
  also have "... = \<integral>x. indicator A (T x) * (f x + g x)\<partial>M"
    by (simp add: algebra_simps)
  finally show "(\<integral>x. indicator A x * (real_transfer_operator f x + real_transfer_operator g x)\<partial>M) = \<integral>x. indicator A (T x) * (f x + g x)\<partial>M"
    by simp
qed (auto simp add: assms)

lemma real_transfer_operator_cong:
  assumes ae: "AE x in M. f x = g x" and [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
  shows "AE x in M. real_transfer_operator f x = real_transfer_operator g x"
proof -
  have "AE x in M. nn_transfer_operator (\<lambda>x. ennreal (f x)) x = nn_transfer_operator (\<lambda>x. ennreal (g x)) x"
    apply (rule nn_transfer_operator_cong) using assms by auto
  moreover have "AE x in M. nn_transfer_operator (\<lambda>x. ennreal (-f x)) x = nn_transfer_operator (\<lambda>x. ennreal(-g x)) x"
    apply (rule nn_transfer_operator_cong) using assms by auto
  ultimately show "AE x in M. real_transfer_operator f x = real_transfer_operator g x"
    unfolding real_transfer_operator_def by auto
qed

lemma real_transfer_operator_cmult [intro, simp]:
  fixes c::real
  assumes "integrable M f"
  shows "AE x in M. real_transfer_operator (\<lambda>x. c * f x) x = c * real_transfer_operator f x"
by (rule real_transfer_operator_foT_g) (auto simp add: assms borel_measurable_integrable)

lemma real_transfer_operator_cdiv [intro, simp]:
  fixes c::real
  assumes "integrable M f"
  shows "AE x in M. real_transfer_operator (\<lambda>x. f x / c) x = real_transfer_operator f x / c"
using real_transfer_operator_cmult[of _ "1/c", OF assms] by (auto simp add: divide_simps)

lemma real_transfer_operator_diff [intro, simp]:
  assumes [measurable]: "integrable M f" "integrable M g"
  shows "AE x in M. real_transfer_operator (\<lambda>x. f x - g x) x = real_transfer_operator f x - real_transfer_operator g x"
proof -
  have "AE x in M. real_transfer_operator (\<lambda>x. f x + (- g x)) x = real_transfer_operator f x + real_transfer_operator (\<lambda>x. -g x) x"
    using real_transfer_operator_add[where ?f = f and ?g = "\<lambda>x. - g x"] assms by auto
  moreover have "AE x in M. real_transfer_operator (\<lambda>x. -g x) x = - real_transfer_operator g x"
    using real_transfer_operator_cmult[where ?f = g and ?c = "-1"] assms(2) by auto
  ultimately show ?thesis by auto
qed

lemma real_transfer_operator_pos [intro]:
  assumes "AE x in M. f x \<ge> 0" and [measurable]: "f \<in> borel_measurable M"
  shows "AE x in M. real_transfer_operator f x \<ge> 0"
proof -
  define g where "g = (\<lambda>x. max (f x) 0)"
  have "AE x in M. f x = g x" using assms g_def by auto
  then have *: "AE x in M. real_transfer_operator f x = real_transfer_operator g x" using real_transfer_operator_cong g_def by auto

  have "\<And>x. g x \<ge> 0" unfolding g_def by simp
  then have "(\<lambda>x. ennreal(-g x)) = (\<lambda>x. 0)"
    by (simp add: ennreal_neg)
  then have "AE x in M. nn_transfer_operator (\<lambda>x. ennreal(-g x)) x = 0"
    using nn_transfer_operator_zero by simp
  then have "AE x in M. real_transfer_operator g x = enn2real(nn_transfer_operator (\<lambda>x. ennreal (g x)) x)"
    unfolding real_transfer_operator_def by auto
  then have "AE x in M. real_transfer_operator g x \<ge> 0" by auto
  then show ?thesis using * by auto
qed

lemma real_transfer_operator_mono:
  assumes "AE x in M. f x \<le> g x" and [measurable]: "integrable M f" "integrable M g"
  shows "AE x in M. real_transfer_operator f x \<le> real_transfer_operator g x"
proof -
  have "AE x in M. real_transfer_operator g x - real_transfer_operator f x = real_transfer_operator (\<lambda>x. g x - f x) x"
    by (rule AE_symmetric[OF real_transfer_operator_diff], auto simp add: assms)
  moreover have "AE x in M. real_transfer_operator (\<lambda>x. g x - f x) x \<ge> 0"
    by (rule real_transfer_operator_pos, auto simp add: assms(1))
  ultimately have "AE x in M. real_transfer_operator g x - real_transfer_operator f x \<ge> 0" by auto
  then show ?thesis by auto
qed

lemma real_transfer_operator_sum [intro, simp]:
  fixes f::"'b \<Rightarrow> 'a \<Rightarrow> real"
  assumes [measurable]: "\<And>i. integrable M (f i)"
  shows "AE x in M. real_transfer_operator (\<lambda>x. \<Sum>i\<in>I. f i x) x = (\<Sum>i\<in>I. real_transfer_operator (f i) x)"
proof (rule real_transfer_operator_charact)
  fix A assume [measurable]: "A \<in> sets M"
  have *: "integrable M (\<lambda>x. indicator A (T x) * f i x)" for i
    apply (rule Bochner_Integration.integrable_bound[of _ "f i"]) by (auto simp add: assms indicator_def)
  have **: "integrable M (\<lambda>x. indicator A x * real_transfer_operator (f i) x)" for i
    apply (rule Bochner_Integration.integrable_bound[of _ "real_transfer_operator (f i)"]) by (auto simp add: assms indicator_def)
  have inti: "(\<integral>x. indicator A (T x) * f i x \<partial>M) = (\<integral>x. indicator A x * real_transfer_operator (f i) x \<partial>M)" for i
    by (rule real_transfer_operator_intg(2)[symmetric], auto simp add: *)

  have "(\<integral>x. indicator A (T x) * (\<Sum>i\<in>I. f i x)\<partial>M) = (\<integral>x. (\<Sum>i\<in>I. indicator A (T x) * f i x)\<partial>M)"
    by (simp add: sum_distrib_left)
  also have "... = (\<Sum>i\<in>I. (\<integral>x. indicator A (T x) * f i x \<partial>M))"
    by (rule Bochner_Integration.integral_sum, simp add: *)
  also have "... = (\<Sum>i\<in>I. (\<integral>x. indicator A x * real_transfer_operator (f i) x \<partial>M))"
    using inti by auto
  also have "... = (\<integral>x. (\<Sum>i\<in>I. indicator A x * real_transfer_operator (f i) x)\<partial>M)"
    by (rule Bochner_Integration.integral_sum[symmetric], simp add: **)
  also have "... = (\<integral>x. indicator A x * (\<Sum>i\<in>I. real_transfer_operator (f i) x)\<partial>M)"
    by (simp add: sum_distrib_left)
  finally show "(\<integral>x. indicator A x * (\<Sum>i\<in>I. real_transfer_operator (f i) x)\<partial>M) = (\<integral>x. indicator A (T x) * (\<Sum>i\<in>I. f i x)\<partial>M)" by auto
qed (auto simp add: assms real_transfer_operator_int(1)[OF assms(1)])
end (*of context qmpt*)

subsection \<open>Conservativity in terms of transfer operators\<close>

text \<open>Conservativity amounts to the fact that $\sum f(T^n x) = \infty$ for almost every $x$
such that $f(x)>0$, if $f$ is nonnegative (see Lemma \verb+recurrent_series_infinite+).
There is a dual formulation, in terms of transfer
operators, asserting that $\sum \hat T^n f(x) = \infty$ for almost every $x$ such that $f(x)>0$.
It is proved by duality, reducing to the previous statement.\<close>

theorem (in conservative) recurrence_series_infinite_transfer_operator:
  assumes [measurable]: "f \<in> borel_measurable M"
  shows "AE x in M. f x > 0 \<longrightarrow> (\<Sum>n. (nn_transfer_operator^^n) f x) = \<infinity>"
proof -
  define A where "A = {x \<in> space M. f x > 0}"
  have [measurable]: "A \<in> sets M"
    unfolding A_def by auto
  have K: "emeasure M {x \<in> A. (\<Sum>n. (nn_transfer_operator^^n) f x) \<le> K} = 0" if "K < \<infinity>" for K
  proof (rule ccontr)
    assume "emeasure M {x \<in> A. (\<Sum>n. (nn_transfer_operator^^n) f x) \<le> K} \<noteq> 0"
    then have *: "emeasure M {x \<in> A. (\<Sum>n. (nn_transfer_operator^^n) f x) \<le> K} > 0"
      using not_gr_zero by blast
    obtain B where B [measurable]: "B \<in> sets M" "B \<subseteq> {x \<in> A. (\<Sum>n. (nn_transfer_operator^^n) f x) \<le> K}" "emeasure M B < \<infinity>" "emeasure M B > 0"
      using approx_with_finite_emeasure[OF _ *] by auto
    have "f x > 0" if "x \<in> B" for x
      using B(2) that unfolding A_def by auto
    moreover have "AE x\<in>B in M. (\<Sum>n. indicator B ((T^^n) x)) = (\<infinity>::ennreal)"
      using recurrence_series_infinite[of "indicator B"] by (auto simp add: indicator_def)
    ultimately have PInf: "AE x\<in>B in M. (\<Sum>n. indicator B ((T^^n) x)) * f x = \<top>"
      unfolding ennreal_mult_eq_top_iff by fastforce

    have "(\<integral>\<^sup>+x. indicator B x * (\<Sum>n. (nn_transfer_operator^^n) f x) \<partial>M) \<le> (\<integral>\<^sup>+x. indicator B x * K \<partial>M)"
      apply (rule nn_integral_mono) using B(2) unfolding indicator_def by auto
    also have "... = K * emeasure M B"
      by (simp add: mult.commute nn_integral_cmult_indicator)
    also have "... < \<infinity>" using \<open>K < \<infinity>\<close> B(3)
      using ennreal_mult_eq_top_iff top.not_eq_extremum by auto
    finally have *: "(\<integral>\<^sup>+x. indicator B x * (\<Sum>n. (nn_transfer_operator^^n) f x) \<partial>M) < \<infinity>" by auto

    have "(\<integral>\<^sup>+x. indicator B x * (\<Sum>n. (nn_transfer_operator^^n) f x) \<partial>M)
            = (\<integral>\<^sup>+x. (\<Sum>n. indicator B x * (nn_transfer_operator^^n) f x) \<partial>M)"
      by auto
    also have "... = (\<Sum>n. (\<integral>\<^sup>+x. indicator B x * (nn_transfer_operator^^n) f x \<partial>M))"
      by (rule nn_integral_suminf, auto)
    also have "... = (\<Sum>n. (\<integral>\<^sup>+x. indicator B ((T^^n) x) * f x \<partial>M))"
      using nn_transfer_operator_intTn_g by auto
    also have "... = (\<integral>\<^sup>+x. (\<Sum>n. indicator B ((T^^n) x) * f x) \<partial>M)"
      by (rule nn_integral_suminf[symmetric], auto)
    also have "... = (\<integral>\<^sup>+x. (\<Sum>n. indicator B ((T^^n) x)) * f x \<partial>M)"
      by auto
    finally have **: "(\<integral>\<^sup>+x. (\<Sum>n. indicator B ((T^^n) x)) * f x \<partial>M) \<noteq> \<infinity>"
      using * by simp
    have "AE x in M. (\<Sum>n. indicator B ((T^^n) x)) * f x \<noteq> \<infinity>"
      by (rule nn_integral_noteq_infinite[OF _ **], auto)
    then have "AE x\<in>B in M. False"
      using PInf by auto
    then have "emeasure M B = 0"
      by (smt AE_E B(1) Collect_mem_eq Collect_mono_iff dual_order.trans emeasure_eq_0 subsetD sets.sets_into_space)
    then show False
      using B by auto
  qed
  have L: "{x \<in> A. (\<Sum>n. (nn_transfer_operator^^n) f x) \<le> K} \<in> null_sets M" if "K < \<infinity>" for K
    using K[OF that] by auto
  have P: "AE x in M. x \<in> A \<longrightarrow> (\<Sum>n. (nn_transfer_operator^^n) f x) \<ge> K" if "K < \<infinity>" for K
    using AE_not_in[OF L[OF that]] by auto
  have "AE x in M. \<forall>N::nat. (x \<in> A \<longrightarrow> (\<Sum>n. (nn_transfer_operator^^n) f x) \<ge> of_nat N)"
    unfolding AE_all_countable by (auto simp add: of_nat_less_top intro!: P)
  then have "AE x in M. f x > 0 \<longrightarrow> (\<forall>N::nat. (\<Sum>n. (nn_transfer_operator^^n) f x) \<ge> of_nat N)"
    unfolding A_def by auto
  then show "AE x in M. 0 < f x \<longrightarrow> (\<Sum>n. (nn_transfer_operator ^^ n) f x) = \<infinity>"
    using ennreal_ge_nat_imp_PInf by auto
qed

end (*of Transfer_Operator.thy*)


(* Author: Tobias Nipkow *)

section \<open>2-3-4 Tree Implementation of Maps\<close>

theory Tree234_Map
imports
  Tree234_Set
  "../Data_Structures/Map_by_Ordered"
begin

subsection \<open>Map operations on 2-3-4 trees\<close>

fun lookup :: "('a::linorder * 'b) tree234 \<Rightarrow> 'a \<Rightarrow> 'b option" where
"lookup Leaf x = None" |
"lookup (Node2 l (a,b) r) x = (case cmp x a of
  LT \<Rightarrow> lookup l x |
  GT \<Rightarrow> lookup r x |
  EQ \<Rightarrow> Some b)" |
"lookup (Node3 l (a1,b1) m (a2,b2) r) x = (case cmp x a1 of
  LT \<Rightarrow> lookup l x |
  EQ \<Rightarrow> Some b1 |
  GT \<Rightarrow> (case cmp x a2 of
          LT \<Rightarrow> lookup m x |
          EQ \<Rightarrow> Some b2 |
          GT \<Rightarrow> lookup r x))" |
"lookup (Node4 t1 (a1,b1) t2 (a2,b2) t3 (a3,b3) t4) x = (case cmp x a2 of
  LT \<Rightarrow> (case cmp x a1 of
           LT \<Rightarrow> lookup t1 x | EQ \<Rightarrow> Some b1 | GT \<Rightarrow> lookup t2 x) |
  EQ \<Rightarrow> Some b2 |
  GT \<Rightarrow> (case cmp x a3 of
           LT \<Rightarrow> lookup t3 x | EQ \<Rightarrow> Some b3 | GT \<Rightarrow> lookup t4 x))"

fun upd :: "'a::linorder \<Rightarrow> 'b \<Rightarrow> ('a*'b) tree234 \<Rightarrow> ('a*'b) up\<^sub>i" where
"upd x y Leaf = Up\<^sub>i Leaf (x,y) Leaf" |
"upd x y (Node2 l ab r) = (case cmp x (fst ab) of
   LT \<Rightarrow> (case upd x y l of
           T\<^sub>i l' => T\<^sub>i (Node2 l' ab r)
         | Up\<^sub>i l1 ab' l2 => T\<^sub>i (Node3 l1 ab' l2 ab r)) |
   EQ \<Rightarrow> T\<^sub>i (Node2 l (x,y) r) |
   GT \<Rightarrow> (case upd x y r of
           T\<^sub>i r' => T\<^sub>i (Node2 l ab r')
         | Up\<^sub>i r1 ab' r2 => T\<^sub>i (Node3 l ab r1 ab' r2)))" |
"upd x y (Node3 l ab1 m ab2 r) = (case cmp x (fst ab1) of
   LT \<Rightarrow> (case upd x y l of
           T\<^sub>i l' => T\<^sub>i (Node3 l' ab1 m ab2 r)
         | Up\<^sub>i l1 ab' l2 => Up\<^sub>i (Node2 l1 ab' l2) ab1 (Node2 m ab2 r)) |
   EQ \<Rightarrow> T\<^sub>i (Node3 l (x,y) m ab2 r) |
   GT \<Rightarrow> (case cmp x (fst ab2) of
           LT \<Rightarrow> (case upd x y m of
                   T\<^sub>i m' => T\<^sub>i (Node3 l ab1 m' ab2 r)
                 | Up\<^sub>i m1 ab' m2 => Up\<^sub>i (Node2 l ab1 m1) ab' (Node2 m2 ab2 r)) |
           EQ \<Rightarrow> T\<^sub>i (Node3 l ab1 m (x,y) r) |
           GT \<Rightarrow> (case upd x y r of
                   T\<^sub>i r' => T\<^sub>i (Node3 l ab1 m ab2 r')
                 | Up\<^sub>i r1 ab' r2 => Up\<^sub>i (Node2 l ab1 m) ab2 (Node2 r1 ab' r2))))" |
"upd x y (Node4 t1 ab1 t2 ab2 t3 ab3 t4) = (case cmp x (fst ab2) of
   LT \<Rightarrow> (case cmp x (fst ab1) of
            LT \<Rightarrow> (case upd x y t1 of
                     T\<^sub>i t1' => T\<^sub>i (Node4 t1' ab1 t2 ab2 t3 ab3 t4)
                  | Up\<^sub>i t11 q t12 => Up\<^sub>i (Node2 t11 q t12) ab1 (Node3 t2 ab2 t3 ab3 t4)) |
            EQ \<Rightarrow> T\<^sub>i (Node4 t1 (x,y) t2 ab2 t3 ab3 t4) |
            GT \<Rightarrow> (case upd x y t2 of
                    T\<^sub>i t2' => T\<^sub>i (Node4 t1 ab1 t2' ab2 t3 ab3 t4)
                  | Up\<^sub>i t21 q t22 => Up\<^sub>i (Node2 t1 ab1 t21) q (Node3 t22 ab2 t3 ab3 t4))) |
   EQ \<Rightarrow> T\<^sub>i (Node4 t1 ab1 t2 (x,y) t3 ab3 t4) |
   GT \<Rightarrow> (case cmp x (fst ab3) of
            LT \<Rightarrow> (case upd x y t3 of
                    T\<^sub>i t3' \<Rightarrow> T\<^sub>i (Node4 t1 ab1 t2 ab2 t3' ab3 t4)
                  | Up\<^sub>i t31 q t32 => Up\<^sub>i (Node2 t1 ab1 t2) ab2(*q*) (Node3 t31 q t32 ab3 t4)) |
            EQ \<Rightarrow> T\<^sub>i (Node4 t1 ab1 t2 ab2 t3 (x,y) t4) |
            GT \<Rightarrow> (case upd x y t4 of
                    T\<^sub>i t4' => T\<^sub>i (Node4 t1 ab1 t2 ab2 t3 ab3 t4')
                  | Up\<^sub>i t41 q t42 => Up\<^sub>i (Node2 t1 ab1 t2) ab2 (Node3 t3 ab3 t41 q t42))))"

definition update :: "'a::linorder \<Rightarrow> 'b \<Rightarrow> ('a*'b) tree234 \<Rightarrow> ('a*'b) tree234" where
"update x y t = tree\<^sub>i(upd x y t)"

fun del :: "'a::linorder \<Rightarrow> ('a*'b) tree234 \<Rightarrow> ('a*'b) up\<^sub>d" where
"del x Leaf = T\<^sub>d Leaf" |
"del x (Node2 Leaf ab1 Leaf) = (if x=fst ab1 then Up\<^sub>d Leaf else T\<^sub>d(Node2 Leaf ab1 Leaf))" |
"del x (Node3 Leaf ab1 Leaf ab2 Leaf) = T\<^sub>d(if x=fst ab1 then Node2 Leaf ab2 Leaf
  else if x=fst ab2 then Node2 Leaf ab1 Leaf else Node3 Leaf ab1 Leaf ab2 Leaf)" |
"del x (Node4 Leaf ab1 Leaf ab2 Leaf ab3 Leaf) =
  T\<^sub>d(if x = fst ab1 then Node3 Leaf ab2 Leaf ab3 Leaf else
     if x = fst ab2 then Node3 Leaf ab1 Leaf ab3 Leaf else
     if x = fst ab3 then Node3 Leaf ab1 Leaf ab2 Leaf
     else Node4 Leaf ab1 Leaf ab2 Leaf ab3 Leaf)" |
"del x (Node2 l ab1 r) = (case cmp x (fst ab1) of
  LT \<Rightarrow> node21 (del x l) ab1 r |
  GT \<Rightarrow> node22 l ab1 (del x r) |
  EQ \<Rightarrow> let (ab1',t) = del_min r in node22 l ab1' t)" |
"del x (Node3 l ab1 m ab2 r) = (case cmp x (fst ab1) of
  LT \<Rightarrow> node31 (del x l) ab1 m ab2 r |
  EQ \<Rightarrow> let (ab1',m') = del_min m in node32 l ab1' m' ab2 r |
  GT \<Rightarrow> (case cmp x (fst ab2) of
           LT \<Rightarrow> node32 l ab1 (del x m) ab2 r |
           EQ \<Rightarrow> let (ab2',r') = del_min r in node33 l ab1 m ab2' r' |
           GT \<Rightarrow> node33 l ab1 m ab2 (del x r)))" |
"del x (Node4 t1 ab1 t2 ab2 t3 ab3 t4) = (case cmp x (fst ab2) of
  LT \<Rightarrow> (case cmp x (fst ab1) of
           LT \<Rightarrow> node41 (del x t1) ab1 t2 ab2 t3 ab3 t4 |
           EQ \<Rightarrow> let (ab',t2') = del_min t2 in node42 t1 ab' t2' ab2 t3 ab3 t4 |
           GT \<Rightarrow> node42 t1 ab1 (del x t2) ab2 t3 ab3 t4) |
  EQ \<Rightarrow> let (ab',t3') = del_min t3 in node43 t1 ab1 t2 ab' t3' ab3 t4 |
  GT \<Rightarrow> (case cmp x (fst ab3) of
          LT \<Rightarrow> node43 t1 ab1 t2 ab2 (del x t3) ab3 t4 |
          EQ \<Rightarrow> let (ab',t4') = del_min t4 in node44 t1 ab1 t2 ab2 t3 ab' t4' |
          GT \<Rightarrow> node44 t1 ab1 t2 ab2 t3 ab3 (del x t4)))"

definition delete :: "'a::linorder \<Rightarrow> ('a*'b) tree234 \<Rightarrow> ('a*'b) tree234" where
"delete x t = tree\<^sub>d(del x t)"

subsection "Functional correctness"

lemma lookup_map_of:
  "sorted1(inorder t) \<Longrightarrow> lookup t x = map_of (inorder t) x"
by (induction t) (auto simp: map_of_simps split: option.split)

lemma inorder_upd:
  "sorted1(inorder t) \<Longrightarrow> inorder(tree\<^sub>i(upd a b t)) = upd_list a b (inorder t)"
by(induction t)
  (auto simp: upd_list_simps, auto simp: upd_list_simps split: up\<^sub>i.splits)

lemma inorder_update:
  "sorted1(inorder t) \<Longrightarrow> inorder(update a b t) = upd_list a b (inorder t)"
by(simp add: update_def inorder_upd)

lemma inorder_del: "\<lbrakk> bal t ; sorted1(inorder t) \<rbrakk> \<Longrightarrow>
  inorder(tree\<^sub>d (del x t)) = del_list x (inorder t)"
by(induction t rule: del.induct)
  (auto simp: del_list_simps inorder_nodes del_minD split!: if_splits prod.splits)
(* 30 secs (2016) *)

lemma inorder_delete: "\<lbrakk> bal t ; sorted1(inorder t) \<rbrakk> \<Longrightarrow>
  inorder(delete x t) = del_list x (inorder t)"
by(simp add: delete_def inorder_del)

subsection \<open>Balancedness\<close>

lemma bal_upd: "bal t \<Longrightarrow> bal (tree\<^sub>i(upd x y t)) \<and> height(upd x y t) = height t"
by (induct t) (auto, auto split!: if_split up\<^sub>i.split) (* 20 secs (2015) *)

lemma bal_update: "bal t \<Longrightarrow> bal (update x y t)"
by (simp add: update_def bal_upd)

lemma height_del: "bal t \<Longrightarrow> height(del x t) = height t"
by(induction x t rule: del.induct)
  (auto simp add: heights height_del_min split!: if_split prod.split)

lemma bal_tree\<^sub>d_del: "bal t \<Longrightarrow> bal(tree\<^sub>d(del x t))"
by(induction x t rule: del.induct)
  (auto simp: bals bal_del_min height_del height_del_min split!: if_split prod.split)

corollary bal_delete: "bal t \<Longrightarrow> bal(delete x t)"
by(simp add: delete_def bal_tree\<^sub>d_del)

subsection \<open>Overall Correctness\<close>

interpretation Map_by_Ordered
where empty = Leaf and lookup = lookup and update = update and delete = delete
and inorder = inorder and inv = bal
proof (standard, goal_cases)
  case 2 thus ?case by(simp add: lookup_map_of)
next
  case 3 thus ?case by(simp add: inorder_update)
next
  case 4 thus ?case by(simp add: inorder_delete)
next
  case 6 thus ?case by(simp add: bal_update)
next
  case 7 thus ?case by(simp add: bal_delete)
qed simp+

end


(* Title:      HOL/Presburger.thy
   Author:     Amine Chaieb, TU Muenchen
*)

section {* Decision Procedure for Presburger Arithmetic *}

theory Presburger
imports Groebner_Basis Set_Interval
keywords "try0" :: diag
begin

ML_file "Tools/Qelim/qelim.ML"
ML_file "Tools/Qelim/cooper_procedure.ML"

subsection{* The @{text "-\<infinity>"} and @{text "+\<infinity>"} Properties *}

lemma minf:
  "\<lbrakk>\<exists>(z ::'a::linorder).\<forall>x<z. P x = P' x; \<exists>z.\<forall>x<z. Q x = Q' x\<rbrakk>
     \<Longrightarrow> \<exists>z.\<forall>x<z. (P x \<and> Q x) = (P' x \<and> Q' x)"
  "\<lbrakk>\<exists>(z ::'a::linorder).\<forall>x<z. P x = P' x; \<exists>z.\<forall>x<z. Q x = Q' x\<rbrakk>
     \<Longrightarrow> \<exists>z.\<forall>x<z. (P x \<or> Q x) = (P' x \<or> Q' x)"
  "\<exists>(z ::'a::{linorder}).\<forall>x<z.(x = t) = False"
  "\<exists>(z ::'a::{linorder}).\<forall>x<z.(x \<noteq> t) = True"
  "\<exists>(z ::'a::{linorder}).\<forall>x<z.(x < t) = True"
  "\<exists>(z ::'a::{linorder}).\<forall>x<z.(x \<le> t) = True"
  "\<exists>(z ::'a::{linorder}).\<forall>x<z.(x > t) = False"
  "\<exists>(z ::'a::{linorder}).\<forall>x<z.(x \<ge> t) = False"
  "\<exists>z.\<forall>(x::'b::{linorder,plus,Rings.dvd})<z. (d dvd x + s) = (d dvd x + s)"
  "\<exists>z.\<forall>(x::'b::{linorder,plus,Rings.dvd})<z. (\<not> d dvd x + s) = (\<not> d dvd x + s)"
  "\<exists>z.\<forall>x<z. F = F"
  by ((erule exE, erule exE,rule_tac x="min z za" in exI,simp)+, (rule_tac x="t" in exI,fastforce)+) simp_all

lemma pinf:
  "\<lbrakk>\<exists>(z ::'a::linorder).\<forall>x>z. P x = P' x; \<exists>z.\<forall>x>z. Q x = Q' x\<rbrakk>
     \<Longrightarrow> \<exists>z.\<forall>x>z. (P x \<and> Q x) = (P' x \<and> Q' x)"
  "\<lbrakk>\<exists>(z ::'a::linorder).\<forall>x>z. P x = P' x; \<exists>z.\<forall>x>z. Q x = Q' x\<rbrakk>
     \<Longrightarrow> \<exists>z.\<forall>x>z. (P x \<or> Q x) = (P' x \<or> Q' x)"
  "\<exists>(z ::'a::{linorder}).\<forall>x>z.(x = t) = False"
  "\<exists>(z ::'a::{linorder}).\<forall>x>z.(x \<noteq> t) = True"
  "\<exists>(z ::'a::{linorder}).\<forall>x>z.(x < t) = False"
  "\<exists>(z ::'a::{linorder}).\<forall>x>z.(x \<le> t) = False"
  "\<exists>(z ::'a::{linorder}).\<forall>x>z.(x > t) = True"
  "\<exists>(z ::'a::{linorder}).\<forall>x>z.(x \<ge> t) = True"
  "\<exists>z.\<forall>(x::'b::{linorder,plus,Rings.dvd})>z. (d dvd x + s) = (d dvd x + s)"
  "\<exists>z.\<forall>(x::'b::{linorder,plus,Rings.dvd})>z. (\<not> d dvd x + s) = (\<not> d dvd x + s)"
  "\<exists>z.\<forall>x>z. F = F"
  by ((erule exE, erule exE,rule_tac x="max z za" in exI,simp)+,(rule_tac x="t" in exI,fastforce)+) simp_all

lemma inf_period:
  "\<lbrakk>\<forall>x k. P x = P (x - k*D); \<forall>x k. Q x = Q (x - k*D)\<rbrakk>
    \<Longrightarrow> \<forall>x k. (P x \<and> Q x) = (P (x - k*D) \<and> Q (x - k*D))"
  "\<lbrakk>\<forall>x k. P x = P (x - k*D); \<forall>x k. Q x = Q (x - k*D)\<rbrakk>
    \<Longrightarrow> \<forall>x k. (P x \<or> Q x) = (P (x - k*D) \<or> Q (x - k*D))"
  "(d::'a::{comm_ring,Rings.dvd}) dvd D \<Longrightarrow> \<forall>x k. (d dvd x + t) = (d dvd (x - k*D) + t)"
  "(d::'a::{comm_ring,Rings.dvd}) dvd D \<Longrightarrow> \<forall>x k. (\<not>d dvd x + t) = (\<not>d dvd (x - k*D) + t)"
  "\<forall>x k. F = F"
apply (auto elim!: dvdE simp add: algebra_simps)
unfolding mult.assoc [symmetric] distrib_right [symmetric] left_diff_distrib [symmetric]
unfolding dvd_def mult.commute [of d]
by auto

subsection{* The A and B sets *}
lemma bset:
  "\<lbrakk>\<forall>x.(\<forall>j \<in> {1 .. D}. \<forall>b\<in>B. x \<noteq> b + j)\<longrightarrow> P x \<longrightarrow> P(x - D) ;
     \<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j)\<longrightarrow> Q x \<longrightarrow> Q(x - D)\<rbrakk> \<Longrightarrow>
  \<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j) \<longrightarrow> (P x \<and> Q x) \<longrightarrow> (P(x - D) \<and> Q (x - D))"
  "\<lbrakk>\<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j)\<longrightarrow> P x \<longrightarrow> P(x - D) ;
     \<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j)\<longrightarrow> Q x \<longrightarrow> Q(x - D)\<rbrakk> \<Longrightarrow>
  \<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j)\<longrightarrow> (P x \<or> Q x) \<longrightarrow> (P(x - D) \<or> Q (x - D))"
  "\<lbrakk>D>0; t - 1\<in> B\<rbrakk> \<Longrightarrow> (\<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j)\<longrightarrow> (x = t) \<longrightarrow> (x - D = t))"
  "\<lbrakk>D>0 ; t \<in> B\<rbrakk> \<Longrightarrow>(\<forall>(x::int).(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j)\<longrightarrow> (x \<noteq> t) \<longrightarrow> (x - D \<noteq> t))"
  "D>0 \<Longrightarrow> (\<forall>(x::int).(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j)\<longrightarrow> (x < t) \<longrightarrow> (x - D < t))"
  "D>0 \<Longrightarrow> (\<forall>(x::int).(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j)\<longrightarrow> (x \<le> t) \<longrightarrow> (x - D \<le> t))"
  "\<lbrakk>D>0 ; t \<in> B\<rbrakk> \<Longrightarrow>(\<forall>(x::int).(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j)\<longrightarrow> (x > t) \<longrightarrow> (x - D > t))"
  "\<lbrakk>D>0 ; t - 1 \<in> B\<rbrakk> \<Longrightarrow>(\<forall>(x::int).(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j)\<longrightarrow> (x \<ge> t) \<longrightarrow> (x - D \<ge> t))"
  "d dvd D \<Longrightarrow>(\<forall>(x::int).(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j)\<longrightarrow> (d dvd x+t) \<longrightarrow> (d dvd (x - D) + t))"
  "d dvd D \<Longrightarrow>(\<forall>(x::int).(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j)\<longrightarrow> (\<not>d dvd x+t) \<longrightarrow> (\<not> d dvd (x - D) + t))"
  "\<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j) \<longrightarrow> F \<longrightarrow> F"
proof (blast, blast)
  assume dp: "D > 0" and tB: "t - 1\<in> B"
  show "(\<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j)\<longrightarrow> (x = t) \<longrightarrow> (x - D = t))"
    apply (rule allI, rule impI,erule ballE[where x="1"],erule ballE[where x="t - 1"])
    apply algebra using dp tB by simp_all
next
  assume dp: "D > 0" and tB: "t \<in> B"
  show "(\<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j)\<longrightarrow> (x \<noteq> t) \<longrightarrow> (x - D \<noteq> t))"
    apply (rule allI, rule impI,erule ballE[where x="D"],erule ballE[where x="t"])
    apply algebra
    using dp tB by simp_all
next
  assume dp: "D > 0" thus "(\<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j)\<longrightarrow> (x < t) \<longrightarrow> (x - D < t))" by arith
next
  assume dp: "D > 0" thus "\<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j)\<longrightarrow> (x \<le> t) \<longrightarrow> (x - D \<le> t)" by arith
next
  assume dp: "D > 0" and tB:"t \<in> B"
  {fix x assume nob: "\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j" and g: "x > t" and ng: "\<not> (x - D) > t"
    hence "x -t \<le> D" and "1 \<le> x - t" by simp+
      hence "\<exists>j \<in> {1 .. D}. x - t = j" by auto
      hence "\<exists>j \<in> {1 .. D}. x = t + j" by (simp add: algebra_simps)
      with nob tB have "False" by simp}
  thus "\<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j)\<longrightarrow> (x > t) \<longrightarrow> (x - D > t)" by blast
next
  assume dp: "D > 0" and tB:"t - 1\<in> B"
  {fix x assume nob: "\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j" and g: "x \<ge> t" and ng: "\<not> (x - D) \<ge> t"
    hence "x - (t - 1) \<le> D" and "1 \<le> x - (t - 1)" by simp+
      hence "\<exists>j \<in> {1 .. D}. x - (t - 1) = j" by auto
      hence "\<exists>j \<in> {1 .. D}. x = (t - 1) + j" by (simp add: algebra_simps)
      with nob tB have "False" by simp}
  thus "\<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j)\<longrightarrow> (x \<ge> t) \<longrightarrow> (x - D \<ge> t)" by blast
next
  assume d: "d dvd D"
  {fix x assume H: "d dvd x + t" with d have "d dvd (x - D) + t" by algebra}
  thus "\<forall>(x::int).(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j)\<longrightarrow> (d dvd x+t) \<longrightarrow> (d dvd (x - D) + t)" by simp
next
  assume d: "d dvd D"
  {fix x assume H: "\<not>(d dvd x + t)" with d have "\<not> d dvd (x - D) + t"
      by (clarsimp simp add: dvd_def,erule_tac x= "ka + k" in allE,simp add: algebra_simps)}
  thus "\<forall>(x::int).(\<forall>j\<in>{1 .. D}. \<forall>b\<in>B. x \<noteq> b + j)\<longrightarrow> (\<not>d dvd x+t) \<longrightarrow> (\<not>d dvd (x - D) + t)" by auto
qed blast

lemma aset:
  "\<lbrakk>\<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j)\<longrightarrow> P x \<longrightarrow> P(x + D) ;
     \<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j)\<longrightarrow> Q x \<longrightarrow> Q(x + D)\<rbrakk> \<Longrightarrow>
  \<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j) \<longrightarrow> (P x \<and> Q x) \<longrightarrow> (P(x + D) \<and> Q (x + D))"
  "\<lbrakk>\<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j)\<longrightarrow> P x \<longrightarrow> P(x + D) ;
     \<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j)\<longrightarrow> Q x \<longrightarrow> Q(x + D)\<rbrakk> \<Longrightarrow>
  \<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j)\<longrightarrow> (P x \<or> Q x) \<longrightarrow> (P(x + D) \<or> Q (x + D))"
  "\<lbrakk>D>0; t + 1\<in> A\<rbrakk> \<Longrightarrow> (\<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j)\<longrightarrow> (x = t) \<longrightarrow> (x + D = t))"
  "\<lbrakk>D>0 ; t \<in> A\<rbrakk> \<Longrightarrow>(\<forall>(x::int).(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j)\<longrightarrow> (x \<noteq> t) \<longrightarrow> (x + D \<noteq> t))"
  "\<lbrakk>D>0; t\<in> A\<rbrakk> \<Longrightarrow>(\<forall>(x::int). (\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j)\<longrightarrow> (x < t) \<longrightarrow> (x + D < t))"
  "\<lbrakk>D>0; t + 1 \<in> A\<rbrakk> \<Longrightarrow> (\<forall>(x::int).(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j)\<longrightarrow> (x \<le> t) \<longrightarrow> (x + D \<le> t))"
  "D>0 \<Longrightarrow>(\<forall>(x::int).(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j)\<longrightarrow> (x > t) \<longrightarrow> (x + D > t))"
  "D>0 \<Longrightarrow>(\<forall>(x::int).(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j)\<longrightarrow> (x \<ge> t) \<longrightarrow> (x + D \<ge> t))"
  "d dvd D \<Longrightarrow>(\<forall>(x::int).(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j)\<longrightarrow> (d dvd x+t) \<longrightarrow> (d dvd (x + D) + t))"
  "d dvd D \<Longrightarrow>(\<forall>(x::int).(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j)\<longrightarrow> (\<not>d dvd x+t) \<longrightarrow> (\<not> d dvd (x + D) + t))"
  "\<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j) \<longrightarrow> F \<longrightarrow> F"
proof (blast, blast)
  assume dp: "D > 0" and tA: "t + 1 \<in> A"
  show "(\<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j)\<longrightarrow> (x = t) \<longrightarrow> (x + D = t))"
    apply (rule allI, rule impI,erule ballE[where x="1"],erule ballE[where x="t + 1"])
    using dp tA by simp_all
next
  assume dp: "D > 0" and tA: "t \<in> A"
  show "(\<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j)\<longrightarrow> (x \<noteq> t) \<longrightarrow> (x + D \<noteq> t))"
    apply (rule allI, rule impI,erule ballE[where x="D"],erule ballE[where x="t"])
    using dp tA by simp_all
next
  assume dp: "D > 0" thus "(\<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j)\<longrightarrow> (x > t) \<longrightarrow> (x + D > t))" by arith
next
  assume dp: "D > 0" thus "\<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j)\<longrightarrow> (x \<ge> t) \<longrightarrow> (x + D \<ge> t)" by arith
next
  assume dp: "D > 0" and tA:"t \<in> A"
  {fix x assume nob: "\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j" and g: "x < t" and ng: "\<not> (x + D) < t"
    hence "t - x \<le> D" and "1 \<le> t - x" by simp+
      hence "\<exists>j \<in> {1 .. D}. t - x = j" by auto
      hence "\<exists>j \<in> {1 .. D}. x = t - j" by (auto simp add: algebra_simps)
      with nob tA have "False" by simp}
  thus "\<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j)\<longrightarrow> (x < t) \<longrightarrow> (x + D < t)" by blast
next
  assume dp: "D > 0" and tA:"t + 1\<in> A"
  {fix x assume nob: "\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j" and g: "x \<le> t" and ng: "\<not> (x + D) \<le> t"
    hence "(t + 1) - x \<le> D" and "1 \<le> (t + 1) - x" by (simp_all add: algebra_simps)
      hence "\<exists>j \<in> {1 .. D}. (t + 1) - x = j" by auto
      hence "\<exists>j \<in> {1 .. D}. x = (t + 1) - j" by (auto simp add: algebra_simps)
      with nob tA have "False" by simp}
  thus "\<forall>x.(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j)\<longrightarrow> (x \<le> t) \<longrightarrow> (x + D \<le> t)" by blast
next
  assume d: "d dvd D"
  {fix x assume H: "d dvd x + t" with d have "d dvd (x + D) + t"
      by (clarsimp simp add: dvd_def,rule_tac x= "ka + k" in exI,simp add: algebra_simps)}
  thus "\<forall>(x::int).(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j)\<longrightarrow> (d dvd x+t) \<longrightarrow> (d dvd (x + D) + t)" by simp
next
  assume d: "d dvd D"
  {fix x assume H: "\<not>(d dvd x + t)" with d have "\<not>d dvd (x + D) + t"
      by (clarsimp simp add: dvd_def,erule_tac x= "ka - k" in allE,simp add: algebra_simps)}
  thus "\<forall>(x::int).(\<forall>j\<in>{1 .. D}. \<forall>b\<in>A. x \<noteq> b - j)\<longrightarrow> (\<not>d dvd x+t) \<longrightarrow> (\<not>d dvd (x + D) + t)" by auto
qed blast

subsection{* Cooper's Theorem @{text "-\<infinity>"} and @{text "+\<infinity>"} Version *}

subsubsection{* First some trivial facts about periodic sets or predicates *}
lemma periodic_finite_ex:
  assumes dpos: "(0::int) < d" and modd: "ALL x k. P x = P(x - k*d)"
  shows "(EX x. P x) = (EX j : {1..d}. P j)"
  (is "?LHS = ?RHS")
proof
  assume ?LHS
  then obtain x where P: "P x" ..
  have "x mod d = x - (x div d)*d" by(simp add:zmod_zdiv_equality ac_simps eq_diff_eq)
  hence Pmod: "P x = P(x mod d)" using modd by simp
  show ?RHS
  proof (cases)
    assume "x mod d = 0"
    hence "P 0" using P Pmod by simp
    moreover have "P 0 = P(0 - (-1)*d)" using modd by blast
    ultimately have "P d" by simp
    moreover have "d : {1..d}" using dpos by simp
    ultimately show ?RHS ..
  next
    assume not0: "x mod d \<noteq> 0"
    have "P(x mod d)" using dpos P Pmod by simp
    moreover have "x mod d : {1..d}"
    proof -
      from dpos have "0 \<le> x mod d" by(rule pos_mod_sign)
      moreover from dpos have "x mod d < d" by(rule pos_mod_bound)
      ultimately show ?thesis using not0 by simp
    qed
    ultimately show ?RHS ..
  qed
qed auto

subsubsection{* The @{text "-\<infinity>"} Version*}

lemma decr_lemma: "0 < (d::int) \<Longrightarrow> x - (abs(x-z)+1) * d < z"
by(induct rule: int_gr_induct,simp_all add:int_distrib)

lemma incr_lemma: "0 < (d::int) \<Longrightarrow> z < x + (abs(x-z)+1) * d"
by(induct rule: int_gr_induct, simp_all add:int_distrib)

lemma decr_mult_lemma:
  assumes dpos: "(0::int) < d" and minus: "\<forall>x. P x \<longrightarrow> P(x - d)" and knneg: "0 <= k"
  shows "ALL x. P x \<longrightarrow> P(x - k*d)"
using knneg
proof (induct rule:int_ge_induct)
  case base thus ?case by simp
next
  case (step i)
  {fix x
    have "P x \<longrightarrow> P (x - i * d)" using step.hyps by blast
    also have "\<dots> \<longrightarrow> P(x - (i + 1) * d)" using minus[THEN spec, of "x - i * d"]
      by (simp add: algebra_simps)
    ultimately have "P x \<longrightarrow> P(x - (i + 1) * d)" by blast}
  thus ?case ..
qed

lemma  minusinfinity:
  assumes dpos: "0 < d" and
    P1eqP1: "ALL x k. P1 x = P1(x - k*d)" and ePeqP1: "EX z::int. ALL x. x < z \<longrightarrow> (P x = P1 x)"
  shows "(EX x. P1 x) \<longrightarrow> (EX x. P x)"
proof
  assume eP1: "EX x. P1 x"
  then obtain x where P1: "P1 x" ..
  from ePeqP1 obtain z where P1eqP: "ALL x. x < z \<longrightarrow> (P x = P1 x)" ..
  let ?w = "x - (abs(x-z)+1) * d"
  from dpos have w: "?w < z" by(rule decr_lemma)
  have "P1 x = P1 ?w" using P1eqP1 by blast
  also have "\<dots> = P(?w)" using w P1eqP by blast
  finally have "P ?w" using P1 by blast
  thus "EX x. P x" ..
qed

lemma cpmi:
  assumes dp: "0 < D" and p1:"\<exists>z. \<forall> x< z. P x = P' x"
  and nb:"\<forall>x.(\<forall> j\<in> {1..D}. \<forall>(b::int) \<in> B. x \<noteq> b+j) --> P (x) --> P (x - D)"
  and pd: "\<forall> x k. P' x = P' (x-k*D)"
  shows "(\<exists>x. P x) = ((\<exists> j\<in> {1..D} . P' j) | (\<exists> j \<in> {1..D}.\<exists> b\<in> B. P (b+j)))"
         (is "?L = (?R1 \<or> ?R2)")
proof-
 {assume "?R2" hence "?L"  by blast}
 moreover
 {assume H:"?R1" hence "?L" using minusinfinity[OF dp pd p1] periodic_finite_ex[OF dp pd] by simp}
 moreover
 { fix x
   assume P: "P x" and H: "\<not> ?R2"
   {fix y assume "\<not> (\<exists>j\<in>{1..D}. \<exists>b\<in>B. P (b + j))" and P: "P y"
     hence "~(EX (j::int) : {1..D}. EX (b::int) : B. y = b+j)" by auto
     with nb P  have "P (y - D)" by auto }
   hence "ALL x.~(EX (j::int) : {1..D}. EX (b::int) : B. P(b+j)) --> P (x) --> P (x - D)" by blast
   with H P have th: " \<forall>x. P x \<longrightarrow> P (x - D)" by auto
   from p1 obtain z where z: "ALL x. x < z --> (P x = P' x)" by blast
   let ?y = "x - (\<bar>x - z\<bar> + 1)*D"
   have zp: "0 <= (\<bar>x - z\<bar> + 1)" by arith
   from dp have yz: "?y < z" using decr_lemma[OF dp] by simp
   from z[rule_format, OF yz] decr_mult_lemma[OF dp th zp, rule_format, OF P] have th2: " P' ?y" by auto
   with periodic_finite_ex[OF dp pd]
   have "?R1" by blast}
 ultimately show ?thesis by blast
qed

subsubsection {* The @{text "+\<infinity>"} Version*}

lemma  plusinfinity:
  assumes dpos: "(0::int) < d" and
    P1eqP1: "\<forall>x k. P' x = P'(x - k*d)" and ePeqP1: "\<exists> z. \<forall> x>z. P x = P' x"
  shows "(\<exists> x. P' x) \<longrightarrow> (\<exists> x. P x)"
proof
  assume eP1: "EX x. P' x"
  then obtain x where P1: "P' x" ..
  from ePeqP1 obtain z where P1eqP: "\<forall>x>z. P x = P' x" ..
  let ?w' = "x + (abs(x-z)+1) * d"
  let ?w = "x - (-(abs(x-z) + 1))*d"
  have ww'[simp]: "?w = ?w'" by (simp add: algebra_simps)
  from dpos have w: "?w > z" by(simp only: ww' incr_lemma)
  hence "P' x = P' ?w" using P1eqP1 by blast
  also have "\<dots> = P(?w)" using w P1eqP by blast
  finally have "P ?w" using P1 by blast
  thus "EX x. P x" ..
qed

lemma incr_mult_lemma:
  assumes dpos: "(0::int) < d" and plus: "ALL x::int. P x \<longrightarrow> P(x + d)" and knneg: "0 <= k"
  shows "ALL x. P x \<longrightarrow> P(x + k*d)"
using knneg
proof (induct rule:int_ge_induct)
  case base thus ?case by simp
next
  case (step i)
  {fix x
    have "P x \<longrightarrow> P (x + i * d)" using step.hyps by blast
    also have "\<dots> \<longrightarrow> P(x + (i + 1) * d)" using plus[THEN spec, of "x + i * d"]
      by (simp add:int_distrib ac_simps)
    ultimately have "P x \<longrightarrow> P(x + (i + 1) * d)" by blast}
  thus ?case ..
qed

lemma cppi:
  assumes dp: "0 < D" and p1:"\<exists>z. \<forall> x> z. P x = P' x"
  and nb:"\<forall>x.(\<forall> j\<in> {1..D}. \<forall>(b::int) \<in> A. x \<noteq> b - j) --> P (x) --> P (x + D)"
  and pd: "\<forall> x k. P' x= P' (x-k*D)"
  shows "(\<exists>x. P x) = ((\<exists> j\<in> {1..D} . P' j) | (\<exists> j \<in> {1..D}.\<exists> b\<in> A. P (b - j)))" (is "?L = (?R1 \<or> ?R2)")
proof-
 {assume "?R2" hence "?L"  by blast}
 moreover
 {assume H:"?R1" hence "?L" using plusinfinity[OF dp pd p1] periodic_finite_ex[OF dp pd] by simp}
 moreover
 { fix x
   assume P: "P x" and H: "\<not> ?R2"
   {fix y assume "\<not> (\<exists>j\<in>{1..D}. \<exists>b\<in>A. P (b - j))" and P: "P y"
     hence "~(EX (j::int) : {1..D}. EX (b::int) : A. y = b - j)" by auto
     with nb P  have "P (y + D)" by auto }
   hence "ALL x.~(EX (j::int) : {1..D}. EX (b::int) : A. P(b-j)) --> P (x) --> P (x + D)" by blast
   with H P have th: " \<forall>x. P x \<longrightarrow> P (x + D)" by auto
   from p1 obtain z where z: "ALL x. x > z --> (P x = P' x)" by blast
   let ?y = "x + (\<bar>x - z\<bar> + 1)*D"
   have zp: "0 <= (\<bar>x - z\<bar> + 1)" by arith
   from dp have yz: "?y > z" using incr_lemma[OF dp] by simp
   from z[rule_format, OF yz] incr_mult_lemma[OF dp th zp, rule_format, OF P] have th2: " P' ?y" by auto
   with periodic_finite_ex[OF dp pd]
   have "?R1" by blast}
 ultimately show ?thesis by blast
qed

lemma simp_from_to: "{i..j::int} = (if j < i then {} else insert i {i+1..j})"
apply(simp add:atLeastAtMost_def atLeast_def atMost_def)
apply(fastforce)
done

theorem unity_coeff_ex: "(\<exists>(x::'a::{semiring_0,Rings.dvd}). P (l * x)) \<equiv> (\<exists>x. l dvd (x + 0) \<and> P x)"
  apply (rule eq_reflection [symmetric])
  apply (rule iffI)
  defer
  apply (erule exE)
  apply (rule_tac x = "l * x" in exI)
  apply (simp add: dvd_def)
  apply (rule_tac x = x in exI, simp)
  apply (erule exE)
  apply (erule conjE)
  apply simp
  apply (erule dvdE)
  apply (rule_tac x = k in exI)
  apply simp
  done

lemma zdvd_mono:
  fixes k m t :: int
  assumes "k \<noteq> 0"
  shows "m dvd t \<equiv> k * m dvd k * t"
  using assms by simp

lemma uminus_dvd_conv:
  fixes d t :: int
  shows "d dvd t \<equiv> - d dvd t" and "d dvd t \<equiv> d dvd - t"
  by simp_all

text {* \bigskip Theorems for transforming predicates on nat to predicates on @{text int}*}

lemma zdiff_int_split: "P (int (x - y)) =
  ((y \<le> x \<longrightarrow> P (int x - int y)) \<and> (x < y \<longrightarrow> P 0))"
  by (cases "y \<le> x") (simp_all add: zdiff_int)

text {*
  \medskip Specific instances of congruence rules, to prevent
  simplifier from looping. *}

theorem imp_le_cong:
  "\<lbrakk>x = x'; 0 \<le> x' \<Longrightarrow> P = P'\<rbrakk> \<Longrightarrow> (0 \<le> (x::int) \<longrightarrow> P) = (0 \<le> x' \<longrightarrow> P')"
  by simp

theorem conj_le_cong:
  "\<lbrakk>x = x'; 0 \<le> x' \<Longrightarrow> P = P'\<rbrakk> \<Longrightarrow> (0 \<le> (x::int) \<and> P) = (0 \<le> x' \<and> P')"
  by (simp cong: conj_cong)

ML_file "Tools/Qelim/cooper.ML"

method_setup presburger = {*
  let
    fun keyword k = Scan.lift (Args.$$$ k -- Args.colon) >> K ()
    fun simple_keyword k = Scan.lift (Args.$$$ k) >> K ()
    val addN = "add"
    val delN = "del"
    val elimN = "elim"
    val any_keyword = keyword addN || keyword delN || simple_keyword elimN
    val thms = Scan.repeat (Scan.unless any_keyword Attrib.multi_thm) >> flat;
  in
    Scan.optional (simple_keyword elimN >> K false) true --
    Scan.optional (keyword addN |-- thms) [] --
    Scan.optional (keyword delN |-- thms) [] >>
    (fn ((elim, add_ths), del_ths) => fn ctxt =>
      SIMPLE_METHOD' (Cooper.tac elim add_ths del_ths ctxt))
  end
*} "Cooper's algorithm for Presburger arithmetic"

declare dvd_eq_mod_eq_0 [symmetric, presburger]
declare mod_1 [presburger]
declare mod_0 [presburger]
declare mod_by_1 [presburger]
declare mod_self [presburger]
declare div_by_0 [presburger]
declare mod_by_0 [presburger]
declare mod_div_trivial [presburger]
declare div_mod_equality2 [presburger]
declare div_mod_equality [presburger]
declare mod_div_equality2 [presburger]
declare mod_div_equality [presburger]
declare mod_mult_self1 [presburger]
declare mod_mult_self2 [presburger]
declare mod2_Suc_Suc[presburger]
declare not_mod_2_eq_0_eq_1 [presburger]
declare nat_zero_less_power_iff [presburger]

lemma [presburger, algebra]: "m mod 2 = (1::nat) \<longleftrightarrow> \<not> 2 dvd m " by presburger
lemma [presburger, algebra]: "m mod 2 = Suc 0 \<longleftrightarrow> \<not> 2 dvd m " by presburger
lemma [presburger, algebra]: "m mod (Suc (Suc 0)) = (1::nat) \<longleftrightarrow> \<not> 2 dvd m " by presburger
lemma [presburger, algebra]: "m mod (Suc (Suc 0)) = Suc 0 \<longleftrightarrow> \<not> 2 dvd m " by presburger
lemma [presburger, algebra]: "m mod 2 = (1::int) \<longleftrightarrow> \<not> 2 dvd m " by presburger

context semiring_parity
begin

declare even_times_iff [presburger]

declare even_power [presburger]

lemma [presburger]:
  "even (a + b) \<longleftrightarrow> even a \<and> even b \<or> odd a \<and> odd b"
  by auto

end

context ring_parity
begin

declare even_minus [presburger]

end

context linordered_idom
begin

declare zero_le_power_eq [presburger]

declare zero_less_power_eq [presburger]

declare power_less_zero_eq [presburger]

declare power_le_zero_eq [presburger]

end

declare even_Suc [presburger]

lemma [presburger]:
  "Suc n div Suc (Suc 0) = n div Suc (Suc 0) \<longleftrightarrow> even n"
  by presburger

declare even_diff_nat [presburger]

lemma [presburger]:
  fixes k :: int
  shows "(k + 1) div 2 = k div 2 \<longleftrightarrow> even k"
  by presburger

lemma [presburger]:
  fixes k :: int
  shows "(k + 1) div 2 = k div 2 + 1 \<longleftrightarrow> odd k"
  by presburger

lemma [presburger]:
  "even n \<longleftrightarrow> even (int n)"
  using even_int_iff [of n] by simp

subsection {* Nice facts about division by @{term 4} *}

lemma even_even_mod_4_iff:
  "even (n::nat) \<longleftrightarrow> even (n mod 4)"
  by presburger

lemma odd_mod_4_div_2:
  "n mod 4 = (3::nat) \<Longrightarrow> odd ((n - 1) div 2)"
  by presburger

lemma even_mod_4_div_2:
  "n mod 4 = (1::nat) \<Longrightarrow> even ((n - 1) div 2)"
  by presburger

subsection {* Try0 *}

ML_file "Tools/try0.ML"

end


(*  Title:       BDD
    Author:      Veronika Ortner and Norbert Schirmer, 2004
    Maintainer:  Norbert Schirmer,  norbert.schirmer at web de
    License:     LGPL
*)

(*
BinDag.thy

Copyright (C) 2004-2008 Veronika Ortner and Norbert Schirmer
Some rights reserved, TU Muenchen

This library is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation; either version 2.1 of the
License, or (at your option) any later version.

This library is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
USA
*)

header {* BDD Abstractions *}

theory BinDag
imports "../Simpl/Simpl_Heap"
begin

datatype dag = Tip | Node dag ref dag

lemma [simp]: "lt \<noteq> Node lt a rt"
  by (induct lt) auto

lemma [simp]: "Node lt a rt \<noteq> rt"
  by (induct rt) auto

lemma [simp]: "rt \<noteq> Node lt a rt"
  by (induct rt) auto

primrec set_of:: "dag \<Rightarrow> ref set" where
  set_of_Tip: "set_of Tip = {}"
  | set_of_Node: "set_of (Node lt a rt) = {a} \<union> set_of lt \<union> set_of rt"

primrec DAG:: "dag \<Rightarrow> bool" where
  "DAG Tip = True"
  | "DAG (Node l a r) = (a \<notin> set_of l \<and> a \<notin> set_of r \<and> DAG l \<and> DAG r)"

primrec subdag:: "dag \<Rightarrow> dag \<Rightarrow> bool" where
  "subdag Tip t = False"
  | "subdag (Node l a r) t = (t=l \<or> t=r \<or> subdag l t \<or> subdag r t)"

lemma subdag_size: "subdag t s \<Longrightarrow> size s < size t"
  by  (induct t) auto

lemma subdag_neq: "subdag t s \<Longrightarrow> t\<noteq>s"
by (induct t) (auto dest: subdag_size)

lemma subdag_trans [trans]: "subdag t s \<Longrightarrow> subdag s r \<Longrightarrow> subdag t r"
by (induct t) auto

lemma subdag_NodeD:
  "subdag t (Node lt a rt) \<Longrightarrow> subdag t lt \<and> subdag t rt"
  by (induct t) auto

lemma subdag_not_sym: "\<And>t. \<lbrakk>subdag s t; subdag t s\<rbrakk> \<Longrightarrow> P"
  by (induct s) (auto dest: subdag_NodeD)

instantiation dag :: order
begin

definition
  less_dag_def: "s < (t::dag) \<longleftrightarrow> subdag t s"

definition
  le_dag_def: "s \<le> (t::dag) \<longleftrightarrow> s=t \<or> s < t"

lemma le_dag_refl: "(x::dag) \<le> x"
  by (simp add: le_dag_def)

lemma le_dag_trans:
  fixes x::dag and  y and z
  assumes x_y: "x \<le> y" and y_z: "y \<le> z"
  shows "x \<le> z"
proof (cases "x=y")
  case True with y_z show ?thesis by simp
next
  case False
  note x_neq_y = this
  with x_y have x_less_y: "x < y" by (simp add: le_dag_def)
  show ?thesis
  proof (cases "y=z")
    case True
    with x_y show ?thesis by simp
  next
    case False
    with y_z have "y < z" by (simp add: le_dag_def)
    with x_less_y have "x < z"
      by (auto simp add: less_dag_def intro: subdag_trans)
    thus ?thesis
      by (simp add: le_dag_def)
  qed
qed

lemma le_dag_antisym:
  fixes x::dag and  y
  assumes x_y: "x \<le> y" and y_x: "y \<le> x"
  shows "x = y"
proof (cases "x=y")
  case True thus ?thesis .
next
  case False
  with x_y y_x show ?thesis
    by (auto simp add: less_dag_def le_dag_def intro: subdag_not_sym)
qed

lemma dag_less_le:
  fixes x::dag and y
  shows "(x < y) = (x \<le> y \<and> x \<noteq> y)"
  by (auto simp add: less_dag_def le_dag_def dest: subdag_neq)

instance
  by default (auto simp add: dag_less_le le_dag_refl intro: le_dag_trans dest: le_dag_antisym)

end

lemma less_dag_Tip [simp]: "\<not> (x < Tip)"
  by (simp add: less_dag_def)

lemma less_dag_Node: "x < (Node l a r) =
  (x \<le> l \<or> x \<le> r)"
  by (auto simp add: order_le_less less_dag_def)

lemma less_dag_Node': "x < (Node l a r) =
  (x=l \<or> x=r \<or> x < l \<or> x < r)"
  by (simp add: less_dag_def)

lemma less_Node_dag: "(Node l a r) < x \<Longrightarrow> l < x \<and> r < x"
  by (auto simp add: less_dag_def dest: subdag_NodeD)

lemma less_dag_set_of: "x < y \<Longrightarrow> set_of x \<subseteq> set_of y"
  by (unfold less_dag_def, induct y, auto)

lemma le_dag_set_of: "x \<le> y \<Longrightarrow> set_of x \<subseteq> set_of y"
  apply (unfold le_dag_def)
  apply (erule disjE)
   apply simp
  apply (erule less_dag_set_of)
  done

lemma DAG_less: "DAG y \<Longrightarrow> x < y \<Longrightarrow> DAG x"
  by (induct y) (auto simp add: less_dag_Node')

lemma less_DAG_set_of:
  assumes x_less_y: "x < y"
  assumes DAG_y: "DAG y"
  shows "set_of x \<subset> set_of y"
proof (cases y)
  case Tip with x_less_y show ?thesis by simp
next
  case (Node l a r)
  with DAG_y obtain a: "a \<notin> set_of l" "a \<notin> set_of r"
    by simp
  from Node obtain l_less_y: "l < y" and r_less_y: "r < y"
    by (simp add: less_dag_Node)
  from Node a obtain
    l_subset_y: "set_of l \<subset> set_of y" and
    r_subset_y: "set_of r \<subset> set_of y"
    by auto
  from Node x_less_y have "x=l \<or> x=r \<or> x < l \<or> x < r"
    by (simp add: less_dag_Node')
  thus ?thesis
  proof (elim disjE)
    assume "x=l"
    with l_subset_y show ?thesis by simp
  next
    assume "x=r"
    with r_subset_y show ?thesis by simp
  next
    assume "x < l"
    hence "set_of x \<subseteq> set_of l"
      by (rule less_dag_set_of)
    also note l_subset_y
    finally show ?thesis .
  next
    assume "x < r"
    hence "set_of x \<subseteq> set_of r"
      by (rule less_dag_set_of)
    also note r_subset_y
    finally show ?thesis .
  qed
qed

lemma in_set_of_decomp:
  "p \<in> set_of t = (\<exists>l r. t=(Node l p r) \<or> subdag t (Node l p r))"
  (is "?A = ?B")
proof
  assume "?A" thus "?B"
    by (induct t) auto
next
  assume "?B" thus "?A"
    by (induct t) auto
qed

primrec Dag:: "ref \<Rightarrow> (ref \<Rightarrow> ref) \<Rightarrow> (ref \<Rightarrow> ref) \<Rightarrow> dag \<Rightarrow> bool"
where
"Dag p l r Tip = (p = Null)" |
"Dag p l r (Node lt a rt) = (p = a \<and> p \<noteq> Null \<and>
                              Dag (l p) l r lt \<and> Dag (r p) l r  rt)"

lemma Dag_Null [simp]: "Dag Null l r  t = (t = Tip)"
  by (cases t) simp_all

lemma Dag_Ref [simp]:
  "p\<noteq>Null \<Longrightarrow> Dag p l r  t = (\<exists>lt rt. t=Node lt p rt \<and>
                                Dag (l p) l r lt \<and> Dag (r p) l r rt)"
  by (cases t) auto

lemma Null_notin_Dag [simp, intro]: "\<And>p l r. Dag p l r t \<Longrightarrow> Null \<notin> set_of t"
  by (induct t) auto

theorem notin_Dag_update_l [simp]:
    "\<And> p. q \<notin> set_of t \<Longrightarrow> Dag p (l(q := y)) r  t = Dag p l r t"
  by (induct t) auto

theorem notin_Dag_update_r [simp]:
    "\<And> p. q \<notin> set_of t \<Longrightarrow> Dag p l (r(q := y)) t = Dag p l r t"
  by (induct t) auto

lemma Dag_upd_same_l_lemma: "\<And>p. p\<noteq>Null \<Longrightarrow> \<not> Dag p (l(p:=p)) r t"
  apply (induct t)
   apply simp
  apply (simp (no_asm_simp) del: fun_upd_apply)
  apply (simp (no_asm_simp) only: fun_upd_apply refl if_True)
  apply blast
  done

lemma Dag_upd_same_l [simp]: "Dag p (l(p:=p)) r t = (p=Null \<and> t=Tip)"
  apply (cases "p=Null")
   apply simp
  apply (fast dest: Dag_upd_same_l_lemma)
  done

text {* @{thm[source] Dag_upd_same_l} prevents
@{term "p\<noteq>Null \<Longrightarrow> Dag p (l(p:=p)) r t = X"} from looping, because of
@{thm[source] Dag_Ref} and @{thm[source] fun_upd_apply}.
 *}

lemma Dag_upd_same_r_lemma: "\<And>p. p\<noteq>Null \<Longrightarrow> \<not> Dag p l (r(p:=p)) t"
  apply (induct t)
   apply simp
  apply (simp (no_asm_simp) del: fun_upd_apply)
  apply (simp (no_asm_simp) only: fun_upd_apply refl if_True)
  apply blast
  done

lemma Dag_upd_same_r [simp]: "Dag p l (r(p:=p)) t = (p=Null \<and> t=Tip)"
  apply (cases "p=Null")
   apply simp
  apply (fast dest: Dag_upd_same_r_lemma)
  done

lemma  Dag_update_l_new [simp]: "\<lbrakk>set_of t \<subseteq> set alloc\<rbrakk>
     \<Longrightarrow> Dag p (l(new (set alloc) := x)) r t = Dag p l r t"
  by (rule notin_Dag_update_l) fastforce

lemma  Dag_update_r_new [simp]: "\<lbrakk>set_of t \<subseteq> set alloc\<rbrakk>
     \<Longrightarrow> Dag p l (r(new (set alloc) := x)) t = Dag p l r t"
  by (rule notin_Dag_update_r) fastforce

lemma Dag_update_lI [intro]:
    "\<lbrakk>Dag p l r t; q \<notin> set_of t\<rbrakk> \<Longrightarrow> Dag p (l(q := y)) r t"
  by simp

lemma Dag_update_rI [intro]:
    "\<lbrakk>Dag p l r t; q \<notin> set_of t\<rbrakk> \<Longrightarrow> Dag p l (r(q := y)) t"
  by simp

lemma Dag_unique: "\<And> p t2. Dag p l r t1 \<Longrightarrow> Dag p l r t2 \<Longrightarrow> t1=t2"
  by (induct t1) auto

lemma Dag_unique1: "Dag p l r t \<Longrightarrow> \<exists>!t. Dag p l r t"
  by (blast intro: Dag_unique)

lemma Dag_subdag: "\<And> p. Dag p l r t \<Longrightarrow> subdag t s \<Longrightarrow> \<exists> q. Dag q l r s"
  by (induct t) auto

lemma Dag_root_not_in_subdag_l [simp,intro]:
  assumes "Dag (l p) l r t"
  shows "p \<notin> set_of t"
proof -
  {
    fix lt rt
    assume t: "t = Node lt p rt"
    from assms have "Dag (l p) l r lt"
      by (clarsimp simp only: t Dag.simps)
    with assms have "t=lt"
      by (rule Dag_unique)
    with t have False
      by simp
  }
  moreover
  {
    fix lt rt
    assume subdag: "subdag t (Node lt p rt)"
    with assms obtain q where "Dag q l r (Node lt p rt)"
      by (rule Dag_subdag [elim_format]) iprover
    hence "Dag (l p) l r lt"
      by auto
    with assms have "t=lt"
      by (rule Dag_unique)
    moreover
    have "subdag t lt"
    proof -
      note subdag
      also have "subdag (Node lt p rt) lt" by simp
      finally show ?thesis .
    qed
    ultimately have False
      by (simp add: subdag_neq)
  }
  ultimately show ?thesis
    by (auto simp add: in_set_of_decomp)
qed

lemma Dag_root_not_in_subdag_r [simp, intro]:
  assumes "Dag (r p) l r t"
  shows "p \<notin> set_of t"
proof -
  {
    fix lt rt
    assume t: "t = Node lt p rt"
    from assms have "Dag (r p) l r rt"
      by (clarsimp simp only: t Dag.simps)
    with assms have "t=rt"
      by (rule Dag_unique)
    with t have False
      by simp
  }
  moreover
  {
    fix lt rt
    assume subdag: "subdag t (Node lt p rt)"
    with assms obtain q where "Dag q l r (Node lt p rt)"
      by (rule Dag_subdag [elim_format]) iprover
    hence "Dag (r p) l r rt"
      by auto
    with assms have "t=rt"
      by (rule Dag_unique)
    moreover
    have "subdag t rt"
    proof -
      note subdag
      also have "subdag (Node lt p rt) rt" by simp
      finally show ?thesis .
    qed
    ultimately have False
      by (simp add: subdag_neq)
  }
  ultimately show ?thesis
    by (auto simp add: in_set_of_decomp)
qed

lemma Dag_is_DAG: "\<And>p l r. Dag p l r t \<Longrightarrow> DAG t"
  by (induct t) auto

lemma heaps_eq_Dag_eq:
  "\<And>p. \<forall>x \<in> set_of t. l x = l' x \<and> r x = r' x
    \<Longrightarrow> Dag p l r t = Dag p l' r' t"
  by (induct t) auto

lemma heaps_eq_DagI1:
  "\<lbrakk>Dag p l r t; \<forall>x\<in>set_of t. l x = l' x \<and> r x = r' x\<rbrakk>
    \<Longrightarrow> Dag p l' r' t"
  by (rule heaps_eq_Dag_eq [THEN iffD1])

lemma heaps_eq_DagI2:
  "\<lbrakk>Dag p l' r' t; \<forall>x\<in>set_of t. l x = l' x \<and> r x = r' x\<rbrakk>
    \<Longrightarrow> Dag p l r t"
  by (rule heaps_eq_Dag_eq [THEN iffD2]) auto

lemma  Dag_unique_all_impl_simp [simp]:
  "Dag p l r t \<Longrightarrow> (\<forall>t. Dag p l r t \<longrightarrow> P t) = P t"
  by (auto dest: Dag_unique)

lemma Dag_unique_ex_conj_simp [simp]:
  "Dag p l r t \<Longrightarrow> (\<exists>t. Dag p l r t \<and> P t) = P t"
  by (auto dest: Dag_unique)

lemma Dags_eq_hp_eq:
  "\<And>p p'. \<lbrakk>Dag p l r t; Dag p' l' r' t\<rbrakk> \<Longrightarrow>
    p'=p \<and> (\<forall>no \<in> set_of t. l' no = l no \<and> r' no = r no)"
  by (induct t) auto

definition isDag :: "ref \<Rightarrow> (ref \<Rightarrow> ref) \<Rightarrow> (ref \<Rightarrow> ref) \<Rightarrow> bool"
  where "isDag p l r = (\<exists>t. Dag p l r t)"

definition dag :: "ref \<Rightarrow> (ref \<Rightarrow> ref) \<Rightarrow> (ref \<Rightarrow> ref) \<Rightarrow> dag"
  where "dag p l r = (THE t. Dag p l r t)"

lemma Dag_conv_isDag_dag: "Dag p l r t = (isDag p l r \<and> t=dag p l r)"
  apply (simp add: isDag_def dag_def)
  apply (rule iffI)
   apply (rule conjI)
    apply blast
   apply (subst the1_equality)
     apply (erule Dag_unique1)
    apply assumption
   apply (rule refl)
  apply clarify
  apply (rule theI)
   apply assumption
  apply (erule (1) Dag_unique)
  done

lemma Dag_dag: "Dag p l r t \<Longrightarrow> dag p l r = t"
  by (simp add: Dag_conv_isDag_dag)

end