(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_list_nat_PairEvens
imports "../../Test_Base"
begin

datatype ('a, 'b) pair = pair2 "'a" "'b"

datatype 'a list = nil2 | cons2 "'a" "'a list"

datatype Nat = Z | S "Nat"

fun plus :: "Nat => Nat => Nat" where
"plus (Z) y = y"
| "plus (S z) y = S (plus z y)"

fun pairs :: "'t list => (('t, 't) pair) list" where
"pairs (nil2) = nil2"
| "pairs (cons2 y (nil2)) = nil2"
| "pairs (cons2 y (cons2 y2 xs)) = cons2 (pair2 y y2) (pairs xs)"

fun minus :: "Nat => Nat => Nat" where
"minus (Z) y = Z"
| "minus (S z) (S y2) = minus z y2"

fun map :: "('a => 'b) => 'a list => 'b list" where
"map f (nil2) = nil2"
| "map f (cons2 y xs) = cons2 (f y) (map f xs)"

fun lt :: "Nat => Nat => bool" where
"lt x (Z) = False"
| "lt (Z) (S z) = True"
| "lt (S n) (S z) = lt n z"

fun length :: "'a list => Nat" where
"length (nil2) = Z"
| "length (cons2 y l) = plus (S Z) (length l)"

fun le :: "Nat => Nat => bool" where
"le (Z) y = True"
| "le (S z) (Z) = False"
| "le (S z) (S x2) = le z x2"

(*fun did not finish the proof*)
function imod :: "Nat => Nat => Nat" where
"imod x y = (if lt x y then x else imod (minus x y) y)"
  by pat_completeness auto

function evens :: "'a list => 'a list"
         and odds :: "'a list => 'a list" where
"evens (nil2) = nil2"
| "evens (cons2 y xs) = cons2 y (odds xs)"
| "odds (nil2) = nil2"
| "odds (cons2 y xs) = evens xs"
by pat_completeness auto

theorem property0 :
  "((let eta :: Nat = length xs
     in ((let md :: Nat = imod eta (S (S Z))
          in (if
                ((case eta of
                    Z => Z
                    | S x => (if le eta Z then (case Z of S y => p Z) else S Z) =
                    (if le (S (S Z)) Z then (case Z of S z => minus Z (p Z)) else
                       (case Z of S x2 => p Z))) &
                   (md ~= Z))
                then
                minus md (S (S Z))
                else
                md)) =
           Z)) ==>
      ((map
          (% (x3 :: ('a, 'a) pair) => (case x3 of pair2 y2 z2 => y2))
          (pairs xs)) =
         (evens xs)))"
  oops

end


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

  Various auxiliary material, much of which should probably be moved somewhere else
  eventually.
*)
section \<open>Auxiliary material\<close>
theory Prime_Distribution_Elementary_Library
imports
  Zeta_Function.Zeta_Function
  Prime_Number_Theorem.Prime_Counting_Functions
  Stirling_Formula.Stirling_Formula
begin

lemma divisor_count_pos [intro]: "n > 0 \<Longrightarrow> divisor_count n > 0"
  by (auto simp: divisor_count_def intro!: Nat.gr0I)

lemma divisor_count_eq_0_iff [simp]: "divisor_count n = 0 \<longleftrightarrow> n = 0"
  by (cases "n = 0") auto

lemma divisor_count_pos_iff [simp]: "divisor_count n > 0 \<longleftrightarrow> n > 0"
  by (cases "n = 0") auto

lemma smallest_prime_beyond_eval:
  "prime n \<Longrightarrow> smallest_prime_beyond n = n"
  "\<not>prime n \<Longrightarrow> smallest_prime_beyond n = smallest_prime_beyond (Suc n)"
proof -
  assume "prime n"
  thus "smallest_prime_beyond n = n"
    by (rule smallest_prime_beyond_eq) auto
next
  assume "\<not>prime n"
  show "smallest_prime_beyond n = smallest_prime_beyond (Suc n)"
  proof (rule antisym)
    show "smallest_prime_beyond n \<le> smallest_prime_beyond (Suc n)"
      by (rule smallest_prime_beyond_smallest)
         (auto intro: order.trans[OF _ smallest_prime_beyond_le])
  next
    have "smallest_prime_beyond n \<noteq> n"
      using prime_smallest_prime_beyond[of n] \<open>\<not>prime n\<close> by metis
    hence "smallest_prime_beyond n > n"
      using smallest_prime_beyond_le[of n] by linarith
    thus "smallest_prime_beyond n \<ge> smallest_prime_beyond (Suc n)"
      by (intro smallest_prime_beyond_smallest) auto
  qed
qed

lemma nth_prime_numeral:
  "nth_prime (numeral n) = smallest_prime_beyond (Suc (nth_prime (pred_numeral n)))"
  by (subst nth_prime_Suc[symmetric]) auto

lemmas nth_prime_eval = smallest_prime_beyond_eval nth_prime_Suc nth_prime_numeral

lemma nth_prime_1 [simp]: "nth_prime (Suc 0) = 3"
  by (simp add: nth_prime_eval)

lemma nth_prime_2 [simp]: "nth_prime 2 = 5"
  by (simp add: nth_prime_eval)

lemma nth_prime_3 [simp]: "nth_prime 3 = 7"
  by (simp add: nth_prime_eval)

(* TODO: copied from afp-devel; delete in AFP 2019 *)
lemma strict_mono_sequence_partition:
  assumes "strict_mono (f :: nat \<Rightarrow> 'a :: {linorder, no_top})"
  assumes "x \<ge> f 0"
  assumes "filterlim f at_top at_top"
  shows   "\<exists>k. x \<in> {f k..<f (Suc k)}"
proof -
  define k where "k = (LEAST k. f (Suc k) > x)"
  {
    obtain n where "x \<le> f n"
      using assms by (auto simp: filterlim_at_top eventually_at_top_linorder)
    also have "f n < f (Suc n)"
      using assms by (auto simp: strict_mono_Suc_iff)
    finally have "\<exists>n. f (Suc n) > x" by auto
  }
  from LeastI_ex[OF this] have "x < f (Suc k)"
    by (simp add: k_def)
  moreover have "f k \<le> x"
  proof (cases k)
    case (Suc k')
    have "k \<le> k'" if "f (Suc k') > x"
      using that unfolding k_def by (rule Least_le)
    with Suc show "f k \<le> x" by (cases "f k \<le> x") (auto simp: not_le)
  qed (use assms in auto)
  ultimately show ?thesis by auto
qed

lemma nth_prime_partition:
  assumes "x \<ge> 2"
  shows   "\<exists>k. x \<in> {nth_prime k..<nth_prime (Suc k)}"
  using strict_mono_sequence_partition[OF strict_mono_nth_prime, of x] assms nth_prime_at_top
  by simp

lemma nth_prime_partition':
  assumes "x \<ge> 2"
  shows   "\<exists>k. x \<in> {real (nth_prime k)..<real (nth_prime (Suc k))}"
  by (rule strict_mono_sequence_partition)
     (auto simp: strict_mono_Suc_iff assms
           intro!: filterlim_real_sequentially filterlim_compose[OF _ nth_prime_at_top])

lemma between_nth_primes_imp_nonprime:
  assumes "n > nth_prime k" "n < nth_prime (Suc k)"
  shows   "\<not>prime n"
  using assms by (metis Suc_leI not_le nth_prime_Suc smallest_prime_beyond_smallest)

lemma nth_prime_partition'':
  includes prime_counting_notation
  assumes "x \<ge> (2 :: real)"
  shows "x \<in> {real (nth_prime (nat \<lfloor>\<pi> x\<rfloor> - 1))..<real (nth_prime (nat \<lfloor>\<pi> x\<rfloor>))}"
proof -
  obtain n where n: "x \<in> {nth_prime n..<nth_prime (Suc n)}"
    using nth_prime_partition' assms by auto
  have "\<pi> (nth_prime n) = \<pi> x"
    unfolding \<pi>_def using between_nth_primes_imp_nonprime n
    by (intro prime_sum_upto_eqI) (auto simp: le_nat_iff le_floor_iff)
  hence "real n = \<pi> x - 1"
    by simp
  hence n_eq: "n = nat \<lfloor>\<pi> x\<rfloor> - 1" "Suc n = nat \<lfloor>\<pi> x\<rfloor>"
    by linarith+
  with n show ?thesis
    by simp
qed
(* END TODO *)

(* TODO: Move *)
lemma asymp_equivD_strong:
  assumes "f \<sim>[F] g" "eventually (\<lambda>x. f x \<noteq> 0 \<or> g x \<noteq> 0) F"
  shows   "((\<lambda>x. f x / g x) \<longlongrightarrow> 1) F"
proof -
  from assms(1) have "((\<lambda>x. if f x = 0 \<and> g x = 0 then 1 else f x / g x) \<longlongrightarrow> 1) F"
    by (rule asymp_equivD)
  also have "?this \<longleftrightarrow> ?thesis"
    by (intro filterlim_cong eventually_mono[OF assms(2)]) auto
  finally show ?thesis .
qed

lemma hurwitz_zeta_shift:
  fixes s :: complex
  assumes "a > 0" and "s \<noteq> 1"
  shows   "hurwitz_zeta (a + real n) s = hurwitz_zeta a s - (\<Sum>k<n. (a + real k) powr -s)"
proof (rule analytic_continuation_open[where f = "\<lambda>s. hurwitz_zeta (a + real n) s"])
  fix s assume s: "s \<in> {s. Re s > 1}"
  have "(\<lambda>k. (a + of_nat (k + n)) powr -s) sums hurwitz_zeta (a + real n) s"
    using sums_hurwitz_zeta[of "a + real n" s] s assms by (simp add: add_ac)
  moreover have "(\<lambda>k. (a + of_nat k) powr -s) sums hurwitz_zeta a s"
    using sums_hurwitz_zeta[of a s] s assms by (simp add: add_ac)
  hence "(\<lambda>k. (a + of_nat (k + n)) powr -s) sums
            (hurwitz_zeta a s - (\<Sum>k<n. (a + of_nat k) powr -s))"
    by (rule sums_split_initial_segment)
  ultimately show "hurwitz_zeta (a + real n) s = hurwitz_zeta a s - (\<Sum>k<n. (a + real k) powr -s)"
    by (simp add: sums_iff)
next
  show "connected (-{1::complex})"
    by (rule connected_punctured_universe) auto
qed (use assms in \<open>auto intro!: holomorphic_intros open_halfspace_Re_gt exI[of _ 2]\<close>)

lemma pbernpoly_bigo: "pbernpoly n \<in> O(\<lambda>_. 1)"
proof -
  from bounded_pbernpoly[of n] obtain c where "\<And>x. norm (pbernpoly n x) \<le> c"
    by auto
  thus ?thesis by (intro bigoI[of _ c]) auto
qed

lemma harm_le: "n \<ge> 1 \<Longrightarrow> harm n \<le> ln n + 1"
  using euler_mascheroni_sequence_decreasing[of 1 n]
  by (simp add: harm_expand)

lemma sum_upto_1 [simp]: "sum_upto f 1 = f 1"
proof -
  have "{0<..Suc 0} = {1}" by auto
  thus ?thesis by (simp add: sum_upto_altdef)
qed

(* TODO: replace original *)
lemma sum_upto_cong' [cong]:
  "(\<And>n. n > 0 \<Longrightarrow> real n \<le> x \<Longrightarrow> f n = f' n) \<Longrightarrow> x = x' \<Longrightarrow> sum_upto f x = sum_upto f' x'"
  unfolding sum_upto_def by (intro sum.cong) auto

lemma finite_primes_le: "finite {p. prime p \<and> real p \<le> x}"
  by (rule finite_subset[of _ "{..nat \<lfloor>x\<rfloor>}"]) (auto simp: le_nat_iff le_floor_iff)

lemma frequently_filtermap: "frequently P (filtermap f F) = frequently (\<lambda>n. P (f n)) F"
  by (auto simp: frequently_def eventually_filtermap)

lemma frequently_mono_filter: "frequently P F \<Longrightarrow> F \<le> F' \<Longrightarrow> frequently P F'"
  using filter_leD[of F F' "\<lambda>x. \<not>P x"] by (auto simp: frequently_def)

lemma \<pi>_at_top: "filterlim primes_pi at_top at_top"
  unfolding filterlim_at_top
proof safe
  fix C :: real
  define x0 where "x0 = real (nth_prime (nat \<lceil>max 0 C\<rceil>))"
  show "eventually (\<lambda>x. primes_pi x \<ge> C) at_top"
    using eventually_ge_at_top
  proof eventually_elim
    fix x assume "x \<ge> x0"
    have "C \<le> real (nat \<lceil>max 0 C\<rceil> + 1)" by linarith
    also have "real (nat \<lceil>max 0 C\<rceil> + 1) = primes_pi x0"
      unfolding x0_def by simp
    also have "\<dots> \<le> primes_pi x" by (rule \<pi>_mono) fact
    finally show "primes_pi x \<ge> C" .
  qed
qed

lemma sum_upto_ln_stirling_weak_bigo: "(\<lambda>x. sum_upto ln x - x * ln x + x) \<in> O(ln)"
proof -
  let ?f = "\<lambda>x. x * ln x - x + ln (2 * pi * x) / 2"
  have "ln (fact n) - (n * ln n - n + ln (2 * pi * n) / 2) \<in> {0..1/(12*n)}" if "n > 0" for n :: nat
    using ln_fact_bounds[OF that] by (auto simp: algebra_simps)
  hence "(\<lambda>n. ln (fact n) - ?f n) \<in> O(\<lambda>n. 1 / real n)"
    by (intro bigoI[of _ "1/12"] eventually_mono[OF eventually_gt_at_top[of 0]]) auto
  hence "(\<lambda>x. ln (fact (nat \<lfloor>x\<rfloor>)) - ?f (nat \<lfloor>x\<rfloor>)) \<in> O(\<lambda>x. 1 / real (nat \<lfloor>x\<rfloor>))"
    by (rule landau_o.big.compose)
       (intro filterlim_compose[OF filterlim_nat_sequentially] filterlim_floor_sequentially)
  also have "(\<lambda>x. 1 / real (nat \<lfloor>x\<rfloor>)) \<in> O(\<lambda>x::real. ln x)" by real_asymp
  finally have "(\<lambda>x. ln (fact (nat \<lfloor>x\<rfloor>)) - ?f (nat \<lfloor>x\<rfloor>) + (?f (nat \<lfloor>x\<rfloor>) - ?f x)) \<in> O(\<lambda>x. ln x)"
    by (rule sum_in_bigo) real_asymp
  hence "(\<lambda>x. ln (fact (nat \<lfloor>x\<rfloor>)) - ?f x) \<in> O(\<lambda>x. ln x)"
    by (simp add: algebra_simps)
  hence "(\<lambda>x. ln (fact (nat \<lfloor>x\<rfloor>)) - ?f x + ln (2 * pi * x) / 2) \<in> O(\<lambda>x. ln x)"
    by (rule sum_in_bigo) real_asymp
  thus ?thesis by (simp add: sum_upto_ln_conv_ln_fact algebra_simps)
qed

subsection \<open>Various facts about Dirichlet series\<close>

lemma fds_mangoldt':
  "fds mangoldt = fds_zeta * fds_deriv (fds moebius_mu)"
proof -
  have "fds mangoldt = (fds moebius_mu * fds (\<lambda>n. of_real (ln (real n)) :: 'a))"
    (is "_ = ?f") by (subst fds_mangoldt) auto
  also have "\<dots> = fds_zeta * fds_deriv (fds moebius_mu)"
  proof (intro fds_eqI)
    fix n :: nat assume n: "n > 0"
    have "fds_nth ?f n = (\<Sum>d | d dvd n. moebius_mu d * of_real (ln (real (n div d))))"
      by (auto simp: fds_eq_iff fds_nth_mult dirichlet_prod_def)
    also have "\<dots> = (\<Sum>d | d dvd n. moebius_mu d * of_real (ln (real n / real d)))"
      by (intro sum.cong) (auto elim!: dvdE simp: ln_mult split: if_splits)
    also have "\<dots> = (\<Sum>d | d dvd n. moebius_mu d * of_real (ln n - ln d))"
      using n by (intro sum.cong refl) (subst ln_div, auto elim!: dvdE)
    also have "\<dots> = of_real (ln n) * (\<Sum>d | d dvd n. moebius_mu d) -
                      (\<Sum>d | d dvd n. of_real (ln d) * moebius_mu d)"
      by (simp add: sum_subtractf sum_distrib_left sum_distrib_right algebra_simps)
    also have "of_real (ln n) * (\<Sum>d | d dvd n. moebius_mu d) = 0"
      by (subst sum_moebius_mu_divisors') auto
    finally show "fds_nth ?f n = fds_nth (fds_zeta * fds_deriv (fds moebius_mu) :: 'a fds) n"
      by (simp add: fds_nth_mult dirichlet_prod_altdef1 fds_nth_deriv sum_negf scaleR_conv_of_real)
  qed
  finally show ?thesis .
qed

lemma sum_upto_divisor_sum1:
  "sum_upto (\<lambda>n. \<Sum>d | d dvd n. f d :: real) x = sum_upto (\<lambda>n. f n * floor (x / n)) x"
proof -
  have "sum_upto (\<lambda>n. \<Sum>d | d dvd n. f d :: real) x =
          sum_upto (\<lambda>n. f n * real (nat (floor (x / n)))) x"
    using sum_upto_dirichlet_prod[of f "\<lambda>_. 1" x]
    by (simp add: dirichlet_prod_def sum_upto_altdef)
  also have "\<dots> = sum_upto (\<lambda>n. f n * floor (x / n)) x"
    unfolding sum_upto_def by (intro sum.cong) auto
  finally show ?thesis .
qed

lemma sum_upto_divisor_sum2:
  "sum_upto (\<lambda>n. \<Sum>d | d dvd n. f d :: real) x = sum_upto (\<lambda>n. sum_upto f (x / n)) x"
  using sum_upto_dirichlet_prod[of "\<lambda>_. 1" f x] by (simp add: dirichlet_prod_altdef1)

lemma sum_upto_moebius_times_floor_linear:
  "sum_upto (\<lambda>n. moebius_mu n * \<lfloor>x / real n\<rfloor>) x = (if x \<ge> 1 then 1 else 0)"
proof -
  have "real_of_int (sum_upto (\<lambda>n. moebius_mu n * \<lfloor>x / real n\<rfloor>) x) =
          sum_upto (\<lambda>n. moebius_mu n * of_int \<lfloor>x / real n\<rfloor>) x"
    by (simp add: sum_upto_def)
  also have "\<dots> = sum_upto (\<lambda>n. \<Sum>d | d dvd n. moebius_mu d :: real) x"
    using sum_upto_divisor_sum1[of moebius_mu x] by auto
  also have "\<dots> = sum_upto (\<lambda>n. if n = 1 then 1 else 0) x"
    by (intro sum_upto_cong sum_moebius_mu_divisors' refl)
  also have "\<dots> = real_of_int (if x \<ge> 1 then 1 else 0)"
    by (auto simp: sum_upto_def)
  finally show ?thesis unfolding of_int_eq_iff .
qed

lemma ln_fact_conv_sum_mangoldt:
  "sum_upto (\<lambda>n. mangoldt n * \<lfloor>x / real n\<rfloor>) x = ln (fact (nat \<lfloor>x\<rfloor>))"
proof -
  have "sum_upto (\<lambda>n. mangoldt n * of_int \<lfloor>x / real n\<rfloor>) x =
          sum_upto (\<lambda>n. \<Sum>d | d dvd n. mangoldt d :: real) x"
    using sum_upto_divisor_sum1[of mangoldt x] by auto
  also have "\<dots> = sum_upto (\<lambda>n. of_real (ln (real n))) x"
    by (intro sum_upto_cong mangoldt_sum refl) auto
  also have "\<dots> = (\<Sum>n\<in>{0<..nat \<lfloor>x\<rfloor>}. ln n)"
    by (simp add: sum_upto_altdef)
  also have "\<dots> = ln (\<Prod>{0<..nat \<lfloor>x\<rfloor>})"
    unfolding of_nat_prod by (subst ln_prod) auto
  also have "{0<..nat \<lfloor>x\<rfloor>} = {1..nat \<lfloor>x\<rfloor>}" by auto
  also have "\<Prod>\<dots> = fact (nat \<lfloor>x\<rfloor>)"
    by (simp add: fact_prod)
  finally show ?thesis by simp
qed

subsection \<open>Facts about prime-counting functions\<close>

lemma abs_\<pi> [simp]: "\<bar>primes_pi x\<bar> = primes_pi x"
  by (subst abs_of_nonneg) auto

lemma \<pi>_less_self:
  includes prime_counting_notation
  assumes "x > 0"
  shows   "\<pi> x < x"
proof -
  have "\<pi> x \<le> (\<Sum>n\<in>{1<..nat \<lfloor>x\<rfloor>}. 1)"
    unfolding \<pi>_def prime_sum_upto_altdef2 by (intro sum_mono2) (auto dest: prime_gt_1_nat)
  also have "\<dots> = real (nat \<lfloor>x\<rfloor> - 1)"
    using assms by simp
  also have "\<dots> < x" using assms by linarith
  finally show ?thesis .
qed

lemma \<pi>_le_self':
  includes prime_counting_notation
  assumes "x \<ge> 1"
  shows   "\<pi> x \<le> x - 1"
proof -
  have "\<pi> x \<le> (\<Sum>n\<in>{1<..nat \<lfloor>x\<rfloor>}. 1)"
    unfolding \<pi>_def prime_sum_upto_altdef2 by (intro sum_mono2) (auto dest: prime_gt_1_nat)
  also have "\<dots> = real (nat \<lfloor>x\<rfloor> - 1)"
    using assms by simp
  also have "\<dots> \<le> x - 1" using assms by linarith
  finally show ?thesis .
qed

lemma \<pi>_le_self:
  includes prime_counting_notation
  assumes "x \<ge> 0"
  shows   "\<pi> x \<le> x"
  using \<pi>_less_self[of x] assms by (cases "x = 0") auto

subsection \<open>Strengthening `Big-O' bounds\<close>

text \<open>
  The following two statements are crucial: They allow us to strengthen a `Big-O' statement
  for $n\to\infty$ or $x\to\infty$ to a bound for \<^emph>\<open>all\<close> $n\geq n_0$ or all $x\geq x_0$ under
  some mild conditions.

  This allows us to use all the machinery of asymptotics in Isabelle and still get a bound
  that is applicable over the full domain of the function in the end. This is important because
  Newman often shows that $f(x) \in O(g(x))$ and then writes
  \[\sum_{n\leq x} f(\frac{x}{n}) = \sum_{n\leq x} O(g(\frac{x}{n}))\]
  which is not easy to justify otherwise.
\<close>
lemma natfun_bigoE:
  fixes f :: "nat \<Rightarrow> _"
  assumes bigo: "f \<in> O(g)" and nz: "\<And>n. n \<ge> n0 \<Longrightarrow> g n \<noteq> 0"
  obtains c where "c > 0" "\<And>n. n \<ge> n0 \<Longrightarrow> norm (f n) \<le> c * norm (g n)"
proof -
  from bigo obtain c where c: "c > 0" "eventually (\<lambda>n. norm (f n) \<le> c * norm (g n)) at_top"
    by (auto elim: landau_o.bigE)
  then obtain n0' where n0': "\<And>n. n \<ge> n0' \<Longrightarrow> norm (f n) \<le> c * norm (g n)"
    by (auto simp: eventually_at_top_linorder)
  define c' where "c' = Max ((\<lambda>n. norm (f n) / norm (g n)) ` (insert n0 {n0..<n0'}))"
  have "norm (f n) \<le> max 1 (max c c') * norm (g n)" if "n \<ge> n0" for n
  proof (cases "n \<ge> n0'")
    case False
    with that have "norm (f n) / norm (g n) \<le> c'"
      unfolding c'_def by (intro Max.coboundedI) auto
    also have "\<dots> \<le> max 1 (max c c')" by simp
    finally show ?thesis using nz[of n] that by (simp add: field_simps)
  next
    case True
    hence "norm (f n) \<le> c * norm (g n)" by (rule n0')
    also have "\<dots> \<le> max 1 (max c c') * norm (g n)"
      by (intro mult_right_mono) auto
    finally show ?thesis .
  qed
  with that[of "max 1 (max c c')"] show ?thesis by auto
qed

lemma bigoE_bounded_real_fun:
  fixes f g :: "real \<Rightarrow> real"
  assumes "f \<in> O(g)"
  assumes "\<And>x. x \<ge> x0 \<Longrightarrow> \<bar>g x\<bar> \<ge> cg" "cg > 0"
  assumes "\<And>b. b \<ge> x0 \<Longrightarrow> bounded (f ` {x0..b})"
  shows   "\<exists>c>0. \<forall>x\<ge>x0. \<bar>f x\<bar> \<le> c * \<bar>g x\<bar>"
proof -
  from assms(1) obtain c where c: "c > 0" "eventually (\<lambda>x. \<bar>f x\<bar> \<le> c * \<bar>g x\<bar>) at_top"
    by (elim landau_o.bigE) auto
  then obtain b where b: "\<And>x. x \<ge> b \<Longrightarrow> \<bar>f x\<bar> \<le> c * \<bar>g x\<bar>"
    by (auto simp: eventually_at_top_linorder)
  have "bounded (f ` {x0..max x0 b})" by (intro assms) auto
  then obtain C where C: "\<And>x. x \<in> {x0..max x0 b} \<Longrightarrow> \<bar>f x\<bar> \<le> C"
    unfolding bounded_iff by fastforce

  define c' where "c' = max c (C / cg)"
  have "\<bar>f x\<bar> \<le> c' * \<bar>g x\<bar>" if "x \<ge> x0" for x
  proof (cases "x \<ge> b")
    case False
    hence "\<bar>f x\<bar> / \<bar>g x\<bar> \<le> C / cg"
      using that by (intro frac_le assms C) auto
    also have "\<dots> \<le> c'" by (simp add: c'_def)
    finally show "\<bar>f x\<bar> \<le> c' * \<bar>g x\<bar>"
      using that False assms(2)[of x] assms(3) by (auto simp add: divide_simps split: if_splits)
  next
    case True
    hence "\<bar>f x\<bar> \<le> c * \<bar>g x\<bar>" by (intro b) auto
    also have "\<dots> \<le> c' * \<bar>g x\<bar>" by (intro mult_right_mono) (auto simp: c'_def)
    finally show ?thesis .
  qed
  moreover from c(1) have "c' > 0" by (auto simp: c'_def)
  ultimately show ?thesis by blast
qed

lemma sum_upto_asymptotics_lift_nat_real_aux:
  fixes f :: "nat \<Rightarrow> real" and g :: "real \<Rightarrow> real"
  assumes bigo: "(\<lambda>n. (\<Sum>k=1..n. f k) - g (real n)) \<in> O(\<lambda>n. h (real n))"
  assumes g_bigo_self: "(\<lambda>n. g (real n) - g (real (Suc n))) \<in> O(\<lambda>n. h (real n))"
  assumes h_bigo_self: "(\<lambda>n. h (real n)) \<in> O(\<lambda>n. h (real (Suc n)))"
  assumes h_pos: "\<And>x. x \<ge> 1 \<Longrightarrow> h x > 0"
  assumes mono_g: "mono_on g {1..} \<or> mono_on (\<lambda>x. - g x) {1..}"
  assumes mono_h: "mono_on h {1..} \<or> mono_on (\<lambda>x. - h x) {1..}"
  shows   "\<exists>c>0. \<forall>x\<ge>1. sum_upto f x - g x \<le> c * h x"
proof -
  have h_nz: "h (real n) \<noteq> 0" if "n \<ge> 1" for n
    using h_pos[of n] that by simp

  from natfun_bigoE[OF bigo h_nz] obtain c1 where
    c1: "c1 > 0" "\<And>n. n \<ge> 1 \<Longrightarrow> norm ((\<Sum>k=1..n. f k) - g (real n)) \<le> c1 * norm (h (real n))"
    by auto
  from natfun_bigoE[OF g_bigo_self h_nz] obtain c2 where
    c2: "c2 > 0" "\<And>n. n \<ge> 1 \<Longrightarrow> norm (g (real n) - g (real (Suc n))) \<le> c2 * norm (h (real n))"
    by auto
  from natfun_bigoE[OF h_bigo_self h_nz] obtain c3 where
    c3: "c3 > 0" "\<And>n. n \<ge> 1 \<Longrightarrow> norm (h (real n)) \<le> c3 * norm (h (real (Suc n)))"
    by auto

  {
    fix x :: real assume x: "x \<ge> 1"
    define n where "n = nat \<lfloor>x\<rfloor>"
    from x have n: "n \<ge> 1" unfolding n_def by linarith

    have "(\<Sum>k = 1..n. f k) - g x \<le> (c1 + c2) * h (real n)" using mono_g
    proof
      assume mono: "mono_on (\<lambda>x. -g x) {1..}"
      from x have "x \<le> real (Suc n)"
        unfolding n_def by linarith
      hence "(\<Sum>k=1..n. f k) - g x \<le> (\<Sum>k=1..n. f k) - g n + (g n - g (Suc n))"
        using mono_onD[OF mono, of x "real (Suc n)"] x by auto
      also have "\<dots> \<le> norm ((\<Sum>k=1..n. f k) - g n) + norm (g n - g (Suc n))"
        by simp
      also have "\<dots> \<le> c1 * norm (h n) + c2 * norm (h n)"
        using n by (intro add_mono c1 c2) auto
      also have "\<dots> = (c1 + c2) * h n"
        using h_pos[of "real n"] n by (simp add: algebra_simps)
      finally show ?thesis .
    next
      assume mono: "mono_on g {1..}"
      have "(\<Sum>k=1..n. f k) - g x \<le> (\<Sum>k=1..n. f k) - g n"
        using x by (intro diff_mono mono_onD[OF mono]) (auto simp: n_def)
      also have "\<dots> \<le> c1 * h (real n)"
        using c1(2)[of n] n h_pos[of n] by simp
      also have "\<dots> \<le> (c1 + c2) * h (real n)"
        using c2 h_pos[of n] n by (intro mult_right_mono) auto
      finally show ?thesis .
    qed
    also have "(c1 + c2) * h (real n) \<le> (c1 + c2) * (1 + c3) * h x"
      using mono_h
    proof
      assume mono: "mono_on (\<lambda>x. -h x) {1..}"
      have "(c1 + c2) * h (real n) \<le> (c1 + c2) * (c3 * h (real (Suc n)))"
        using c3(2)[of n] n h_pos[of n] h_pos[of "Suc n"] c1(1) c2(1)
        by (intro mult_left_mono) (auto)
      also have "\<dots> = (c1 + c2) * c3 * h (real (Suc n))"
        by (simp add: mult_ac)
      also have "\<dots> \<le> (c1 + c2) * (1 + c3) * h (real (Suc n))"
        using c1(1) c2(1) c3(1) h_pos[of "Suc n"] by (intro mult_left_mono mult_right_mono) auto
      also from x have "x \<le> real (Suc n)"
        unfolding n_def by linarith
      hence "(c1 + c2) * (1 + c3) * h (real (Suc n)) \<le> (c1 + c2) * (1 + c3) * h x"
        using c1(1) c2(1) c3(1) mono_onD[OF mono, of x "real (Suc n)"] x
        by (intro mult_left_mono) (auto simp: n_def)
      finally show "(c1 + c2) * h (real n) \<le> (c1 + c2) * (1 + c3) * h x" .
    next
      assume mono: "mono_on h {1..}"
      have "(c1 + c2) * h (real n) = 1 * ((c1 + c2) * h (real n))" by simp
      also have "\<dots> \<le> (1 + c3) * ((c1 + c2) * h (real n))"
        using c1(1) c2(1) c3(1) h_pos[of n] x n by (intro mult_right_mono) auto
      also have "\<dots> = (1 + c3) * (c1 + c2) * h (real n)"
        by (simp add: mult_ac)
      also have "\<dots> \<le> (1 + c3) * (c1 + c2) * h x"
        using x c1(1) c2(1) c3(1) h_pos[of n] n
        by (intro mult_left_mono mono_onD[OF mono]) (auto simp: n_def)
      finally show "(c1 + c2) * h (real n) \<le> (c1 + c2) * (1 + c3) * h x"
        by (simp add: mult_ac)
    qed
    also have "(\<Sum>k = 1..n. f k) = sum_upto f x"
      unfolding sum_upto_altdef n_def by (intro sum.cong) auto
    finally have "sum_upto f x - g x \<le> (c1 + c2) * (1 + c3) * h x" .
  }
  moreover have "(c1 + c2) * (1 + c3) > 0"
    using c1(1) c2(1) c3(1) by (intro mult_pos_pos add_pos_pos) auto
  ultimately show ?thesis by blast
qed

lemma sum_upto_asymptotics_lift_nat_real:
  fixes f :: "nat \<Rightarrow> real" and g :: "real \<Rightarrow> real"
  assumes bigo: "(\<lambda>n. (\<Sum>k=1..n. f k) - g (real n)) \<in> O(\<lambda>n. h (real n))"
  assumes g_bigo_self: "(\<lambda>n. g (real n) - g (real (Suc n))) \<in> O(\<lambda>n. h (real n))"
  assumes h_bigo_self: "(\<lambda>n. h (real n)) \<in> O(\<lambda>n. h (real (Suc n)))"
  assumes h_pos: "\<And>x. x \<ge> 1 \<Longrightarrow> h x > 0"
  assumes mono_g: "mono_on g {1..} \<or> mono_on (\<lambda>x. - g x) {1..}"
  assumes mono_h: "mono_on h {1..} \<or> mono_on (\<lambda>x. - h x) {1..}"
  shows   "\<exists>c>0. \<forall>x\<ge>1. \<bar>sum_upto f x - g x\<bar> \<le> c * h x"
proof -
  have "\<exists>c>0. \<forall>x\<ge>1. sum_upto f x - g x \<le> c * h x"
    by (intro sum_upto_asymptotics_lift_nat_real_aux assms)
  then obtain c1 where c1: "c1 > 0" "\<And>x. x \<ge> 1 \<Longrightarrow> sum_upto f x - g x \<le> c1 * h x"
    by auto

  have "(\<lambda>n. -(g (real n) - g (real (Suc n)))) \<in> O(\<lambda>n. h (real n))"
    by (subst landau_o.big.uminus_in_iff) fact
  also have "(\<lambda>n. -(g (real n) - g (real (Suc n)))) = (\<lambda>n. g (real (Suc n)) - g (real n))"
    by simp
  finally have "(\<lambda>n. g (real (Suc n)) - g (real n)) \<in> O(\<lambda>n. h (real n))" .
  moreover {
    have "(\<lambda>n. -((\<Sum>k=1..n. f k) - g (real n))) \<in> O(\<lambda>n. h (real n))"
      by (subst landau_o.big.uminus_in_iff) fact
    also have "(\<lambda>n. -((\<Sum>k=1..n. f k) - g (real n))) =
                 (\<lambda>n. (\<Sum>k=1..n. -f k) + g (real n))" by (simp add: sum_negf)
    finally have "(\<lambda>n. (\<Sum>k=1..n. - f k) + g (real n)) \<in> O(\<lambda>n. h (real n))" .
  }
  ultimately have "\<exists>c>0. \<forall>x\<ge>1. sum_upto (\<lambda>n. -f n) x - (-g x) \<le> c * h x" using mono_g
    by (intro sum_upto_asymptotics_lift_nat_real_aux assms) (simp_all add: disj_commute)
  then obtain c2 where c2: "c2 > 0" "\<And>x. x \<ge> 1 \<Longrightarrow> sum_upto (\<lambda>n. - f n) x + g x \<le> c2 * h x"
    by auto

  {
    fix x :: real assume x: "x \<ge> 1"
    have "sum_upto f x - g x \<le> max c1 c2 * h x"
      using h_pos[of x] x by (intro order.trans[OF c1(2)] mult_right_mono) auto
    moreover have "sum_upto (\<lambda>n. -f n) x + g x \<le> max c1 c2 * h x"
      using h_pos[of x] x by (intro order.trans[OF c2(2)] mult_right_mono) auto
    hence "-(sum_upto f x - g x) \<le> max c1 c2 * h x"
      by (simp add: sum_upto_def sum_negf)
    ultimately have "\<bar>sum_upto f x - g x\<bar> \<le> max c1 c2 * h x" by linarith
  }
  moreover from c1(1) c2(1) have "max c1 c2 > 0" by simp
  ultimately show ?thesis by blast
qed

lemma (in factorial_semiring) primepow_divisors_induct [case_names zero unit factor]:
  assumes "P 0" "\<And>x. is_unit x \<Longrightarrow> P x"
          "\<And>p k x. prime p \<Longrightarrow> k > 0 \<Longrightarrow> \<not>p dvd x \<Longrightarrow> P x \<Longrightarrow> P (p ^ k * x)"
  shows   "P x"
proof -
  have "finite (prime_factors x)" by simp
  thus ?thesis
  proof (induction "prime_factors x" arbitrary: x rule: finite_induct)
    case empty
    hence "prime_factors x = {}" by metis
    hence "prime_factorization x = {#}" by simp
    thus ?case using assms(1,2) by (auto simp: prime_factorization_empty_iff)
  next
    case (insert p A x)
    define k where "k = multiplicity p x"
    have "k > 0" using insert.hyps
      by (auto simp: prime_factors_multiplicity k_def)
    have p: "p \<in> prime_factors x" using insert.hyps by auto
    from p have "x \<noteq> 0" "\<not>is_unit p" by (auto simp: in_prime_factors_iff)

    from multiplicity_decompose'[OF this] obtain y where y: "x = p ^ k * y" "\<not>p dvd y"
      by (auto simp: k_def)
    have "prime_factorization x = replicate_mset k p + prime_factorization y"
      using p \<open>k > 0\<close> y unfolding y
      by (subst prime_factorization_mult)
         (auto simp: prime_factorization_prime_power in_prime_factors_iff)
    moreover from y p have "p \<notin> prime_factors y"
      by (auto simp: in_prime_factors_iff)
    ultimately have "prime_factors y = prime_factors x - {p}"
      by auto
    also have "\<dots> = A"
      using insert.hyps by auto
    finally have "P y" using insert by auto
    thus "P x"
      unfolding y using y \<open>k > 0\<close> p by (intro assms(3)) (auto simp: in_prime_factors_iff)
  qed
qed

end


(* Author: Gerwin Klein, 2012
   Maintainers: Gerwin Klein <kleing at cse.unsw.edu.au>
                Rafal Kolanski <rafal.kolanski at nicta.com.au>
*)

section "Abstract Separation Logic, Alternative Definition"

theory Separation_Algebra_Alt
imports Main
begin

text \<open>
  This theory contains an alternative definition of speration algebra,
  following Calcagno et al very closely. While some of the abstract
  development is more algebraic, it is cumbersome to instantiate.
  We only use it to prove equivalence and to give an impression of how
  it would look like.
\<close>

(* The @{text "++"} notation is a horrible choice, but this theory is
   only intended to show how the development would look like, not to
   actually use it. We remove the notation for map-add so it doesn't
   conflict.
*)
no_notation map_add (infixl "++" 100)

definition
  lift2 :: "('a => 'b => 'c option) \<Rightarrow> 'a option => 'b option => 'c option"
where
  "lift2 f a b \<equiv> case (a,b) of (Some a, Some b) \<Rightarrow> f a b | _ \<Rightarrow> None"

class sep_algebra_alt = zero +
  fixes add :: "'a => 'a => 'a option" (infixr "\<oplus>" 65)

  assumes add_zero [simp]: "x \<oplus> 0 = Some x"
  assumes add_comm: "x \<oplus> y = y \<oplus> x"
  assumes add_assoc: "lift2 add a (lift2 add b c) = lift2 add (lift2 add a b) c"

begin

definition
  disjoint :: "'a => 'a => bool" (infix "##" 60)
where
  "a ## b \<equiv> a \<oplus> b \<noteq> None"

lemma disj_com: "x ## y = y ## x"
  by (auto simp: disjoint_def add_comm)

lemma disj_zero [simp]: "x ## 0"
  by (auto simp: disjoint_def)

lemma disj_zero2 [simp]: "0 ## x"
  by (subst disj_com) simp

lemma add_zero2 [simp]: "0 \<oplus> x = Some x"
  by (subst add_comm) auto

definition
  substate :: "'a => 'a => bool" (infix "\<preceq>" 60) where
  "a \<preceq> b \<equiv> \<exists>c. a \<oplus> c = Some b"

definition
  sep_conj :: "('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> bool)" (infixl "**" 61)
  where
  "P ** Q \<equiv> \<lambda>s. \<exists>p q. p \<oplus> q = Some s \<and> P p \<and> Q q"

definition emp :: "'a \<Rightarrow> bool" ("\<box>") where
  "\<box> \<equiv> \<lambda>s. s = 0"

definition
  sep_impl :: "('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> bool)" (infixr "\<longrightarrow>\<^sup>*" 25)
  where
  "P \<longrightarrow>\<^sup>* Q \<equiv> \<lambda>h. \<forall>h' h''. h \<oplus> h' = Some h'' \<and> P h' \<longrightarrow> Q h''"

definition (in -)
  "sep_true \<equiv> \<lambda>s. True"

definition (in -)
  "sep_false \<equiv> \<lambda>s. False"

abbreviation
  add2 :: "'a option => 'a option => 'a option" (infixr "++" 65)
where
  "add2 == lift2 add"

lemma add2_None [simp]:
  "x ++ None = None"
  by (simp add: lift2_def split: option.splits)

lemma None_add2 [simp]:
  "None ++ x = None"
  by (simp add: lift2_def split: option.splits)

lemma add2_Some_Some:
  "Some x ++ Some y = x \<oplus> y"
  by (simp add: lift2_def)

lemma add2_zero [simp]:
  "Some x ++ Some 0 = Some x"
  by (simp add: add2_Some_Some)

lemma zero_add2 [simp]:
  "Some 0 ++ Some x = Some x"
  by (simp add: add2_Some_Some)

lemma sep_conjE:
  "\<lbrakk> (P ** Q) s; \<And>p q. \<lbrakk> P p; Q q; p \<oplus> q = Some s \<rbrakk> \<Longrightarrow> X \<rbrakk> \<Longrightarrow> X"
  by (auto simp: sep_conj_def)

lemma sep_conjI:
  "\<lbrakk> P p; Q q; p \<oplus> q = Some s \<rbrakk> \<Longrightarrow> (P ** Q) s"
  by (auto simp: sep_conj_def)

lemma sep_conj_comI:
  "(P ** Q) s \<Longrightarrow> (Q ** P) s"
  by (auto intro!: sep_conjI elim!: sep_conjE simp: add_comm)

lemma sep_conj_com:
  "P ** Q = Q ** P"
  by (auto intro: sep_conj_comI intro!: ext)

lemma lift_to_add2:
  "\<lbrakk>z \<oplus> q = Some s; x \<oplus> y = Some q\<rbrakk> \<Longrightarrow> Some z ++ Some x ++ Some y = Some s"
  by (simp add: add2_Some_Some)

lemma lift_to_add2':
  "\<lbrakk>q \<oplus> z = Some s; x \<oplus> y = Some q\<rbrakk> \<Longrightarrow> (Some x ++ Some y) ++ Some z = Some s"
  by (simp add: add2_Some_Some)

lemma add2_Some:
  "(x ++ Some y = Some z) = (\<exists>x'. x = Some x' \<and> x' \<oplus> y = Some z)"
  by (simp add: lift2_def split: option.splits)

lemma Some_add2:
  "(Some x ++ y = Some z) = (\<exists>y'. y = Some y' \<and> x \<oplus> y' = Some z)"
  by (simp add: lift2_def split: option.splits)

lemma sep_conj_assoc:
  "P ** (Q ** R) = (P ** Q) ** R"
  unfolding sep_conj_def
  apply (rule ext)
  apply (rule iffI)
   apply clarsimp
   apply (drule (1) lift_to_add2)
   apply (subst (asm) add_assoc)
   apply (fastforce simp: add2_Some_Some add2_Some)
  apply clarsimp
  apply (drule (1) lift_to_add2')
  apply (subst (asm) add_assoc [symmetric])
  apply (fastforce simp: add2_Some_Some Some_add2)
  done

lemma (in -) sep_true[simp]: "sep_true s" by (simp add: sep_true_def)
lemma (in -) sep_false[simp]: "\<not>sep_false x" by (simp add: sep_false_def)

lemma sep_conj_sep_true:
  "P s \<Longrightarrow> (P ** sep_true) s"
  by (auto simp: sep_conjI [where q=0])

lemma sep_conj_sep_true':
  "P s \<Longrightarrow> (sep_true ** P) s"
  by (auto simp: sep_conjI [where p=0])

lemma disjoint_submaps_exist:
  "\<exists>h\<^sub>0 h\<^sub>1. h\<^sub>0 \<oplus> h\<^sub>1 = Some h"
  by (rule_tac x=0 in exI, auto)

lemma sep_conj_true[simp]:
  "(sep_true ** sep_true) = sep_true"
  unfolding sep_conj_def
  by (auto intro!: ext intro: disjoint_submaps_exist)

lemma sep_conj_false_right[simp]:
  "(P ** sep_false) = sep_false"
  by (force elim: sep_conjE intro!: ext)

lemma sep_conj_false_left[simp]:
  "(sep_false ** P) = sep_false"
  by (subst sep_conj_com) (rule sep_conj_false_right)

lemma sep_conj_left_com:
  "(P ** (Q ** R)) = (Q ** (P ** R))" (is "?x = ?y")
proof -
  have "?x = ((Q ** R) ** P)" by (simp add: sep_conj_com)
  also have "\<dots> = (Q ** (R ** P))" by (subst sep_conj_assoc, simp)
  finally show ?thesis by (simp add: sep_conj_com)
qed

lemmas sep_conj_ac = sep_conj_com sep_conj_assoc sep_conj_left_com

lemma empty_empty[simp]: "\<box> 0"
  by (simp add: emp_def)

lemma sep_conj_empty[simp]:
  "(P ** \<box>) = P"
  by (simp add: sep_conj_def emp_def)

  lemma sep_conj_empty'[simp]:
  "(\<box> ** P) = P"
  by (subst sep_conj_com, rule sep_conj_empty)

lemma sep_conj_sep_emptyI:
  "P s \<Longrightarrow> (P ** \<box>) s"
  by simp

lemma sep_conj_true_P[simp]:
  "(sep_true ** (sep_true ** P)) = (sep_true ** P)"
  by (simp add: sep_conj_assoc)

lemma sep_conj_disj:
  "((\<lambda>s. P s \<or> Q s) ** R) s = ((P ** R) s \<or> (Q ** R) s)" (is "?x = (?y \<or> ?z)")
  by (auto simp: sep_conj_def)

lemma sep_conj_conj:
  "((\<lambda>s. P s \<and> Q s) ** R) s \<Longrightarrow> (P ** R) s \<and> (Q ** R) s"
  by (force intro: sep_conjI elim!: sep_conjE)

lemma sep_conj_exists1:
  "((\<lambda>s. \<exists>x. P x s) ** Q) s = (\<exists>x. (P x ** Q) s)"
  by (force intro: sep_conjI elim: sep_conjE)

lemma sep_conj_exists2:
  "(P ** (\<lambda>s. \<exists>x. Q x s)) = (\<lambda>s. (\<exists>x. (P ** Q x) s))"
  by (force intro!: sep_conjI ext elim!: sep_conjE)

lemmas sep_conj_exists = sep_conj_exists1 sep_conj_exists2

lemma sep_conj_forall:
  "((\<lambda>s. \<forall>x. P x s) ** Q) s \<Longrightarrow> (P x ** Q) s"
  by (force intro: sep_conjI elim: sep_conjE)

lemma sep_conj_impl:
  "\<lbrakk> (P ** Q) s; \<And>s. P s \<Longrightarrow> P' s; \<And>s. Q s \<Longrightarrow> Q' s \<rbrakk> \<Longrightarrow> (P' ** Q') s"
  by (erule sep_conjE, auto intro!: sep_conjI)

lemma sep_conj_impl1:
  assumes P: "\<And>s. P s \<Longrightarrow> I s"
  shows "(P ** R) s \<Longrightarrow> (I ** R) s"
  by (auto intro: sep_conj_impl P)

lemma sep_conj_sep_true_left:
  "(P ** Q) s \<Longrightarrow> (sep_true ** Q) s"
  by (erule sep_conj_impl, simp+)

lemma sep_conj_sep_true_right:
  "(P ** Q) s \<Longrightarrow> (P ** sep_true) s"
  by (subst (asm) sep_conj_com, drule sep_conj_sep_true_left,
      simp add: sep_conj_ac)

lemma sep_globalise:
  "\<lbrakk> (P ** R) s; (\<And>s. P s \<Longrightarrow> Q s) \<rbrakk> \<Longrightarrow> (Q ** R) s"
  by (fast elim: sep_conj_impl)

lemma sep_implI:
  assumes a: "\<And>h' h''. \<lbrakk> h \<oplus> h' = Some h''; P h' \<rbrakk> \<Longrightarrow> Q h''"
  shows "(P \<longrightarrow>\<^sup>* Q) h"
  unfolding sep_impl_def by (auto elim: a)

lemma sep_implD:
  "(x \<longrightarrow>\<^sup>* y) h \<Longrightarrow> \<forall>h' h''. h \<oplus> h' = Some h'' \<and> x h' \<longrightarrow> y h''"
  by (force simp: sep_impl_def)

lemma sep_impl_sep_true[simp]:
  "(P \<longrightarrow>\<^sup>* sep_true) = sep_true"
  by (force intro!: sep_implI ext)

lemma sep_impl_sep_false[simp]:
  "(sep_false \<longrightarrow>\<^sup>* P) = sep_true"
  by (force intro!: sep_implI ext)

lemma sep_impl_sep_true_P:
  "(sep_true \<longrightarrow>\<^sup>* P) s \<Longrightarrow> P s"
  apply (drule sep_implD)
  apply (erule_tac x=0 in allE)
  apply simp
  done

lemma sep_impl_sep_true_false[simp]:
  "(sep_true \<longrightarrow>\<^sup>* sep_false) = sep_false"
  by (force intro!: ext dest: sep_impl_sep_true_P)

lemma sep_conj_sep_impl:
  "\<lbrakk> P s; \<And>s. (P ** Q) s \<Longrightarrow> R s \<rbrakk> \<Longrightarrow> (Q \<longrightarrow>\<^sup>* R) s"
proof (rule sep_implI)
  fix h' h h''
  assume "P h" and "h \<oplus> h' = Some h''" and "Q h'"
  hence "(P ** Q) h''" by (force intro: sep_conjI)
  moreover assume "\<And>s. (P ** Q) s \<Longrightarrow> R s"
  ultimately show "R h''" by simp
qed

lemma sep_conj_sep_impl2:
  "\<lbrakk> (P ** Q) s; \<And>s. P s \<Longrightarrow> (Q \<longrightarrow>\<^sup>* R) s \<rbrakk> \<Longrightarrow> R s"
  by (force dest: sep_implD elim: sep_conjE)

lemma sep_conj_sep_impl_sep_conj2:
  "(P ** R) s \<Longrightarrow> (P ** (Q \<longrightarrow>\<^sup>* (Q ** R))) s"
  by (erule (1) sep_conj_impl, erule sep_conj_sep_impl, simp add: sep_conj_ac)

lemma sep_conj_triv_strip2:
  "Q = R \<Longrightarrow> (Q ** P) = (R ** P)" by simp

end

end


(*  Title:   Pair_QuasiBorel_Measure.thy
    Author:  Michikazu Hirata, Tokyo Institute of Technology
*)

subsection \<open>Binary Product Measure\<close>

theory Pair_QuasiBorel_Measure
  imports "Monad_QuasiBorel"
begin

subsubsection \<open> Binary Product Measure\<close>
text \<open> Special case of \cite{Heunen_2017} Proposition 23 where $\Omega = \mathbb{R}\times \mathbb{R}$ and $X = X \times Y$.
      Let $[\alpha,\mu ] \in P(X)$ and $[\beta ,\nu] \in P(Y)$. $\alpha\times\beta$ is the $\alpha$ in Proposition 23. \<close>
definition qbs_prob_pair_measure_t :: "['a qbs_prob_t, 'b qbs_prob_t] \<Rightarrow> ('a \<times> 'b) qbs_prob_t" where
"qbs_prob_pair_measure_t p q  \<equiv> (let (X,\<alpha>,\<mu>) = p;
                                     (Y,\<beta>,\<nu>) = q in
                                 (X \<Otimes>\<^sub>Q Y, map_prod \<alpha> \<beta> \<circ> real_real.g, distr (\<mu> \<Otimes>\<^sub>M \<nu>) real_borel real_real.f))"

lift_definition qbs_prob_pair_measure :: "['a qbs_prob_space, 'b qbs_prob_space] \<Rightarrow> ('a \<times> 'b) qbs_prob_space" (infix "\<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s" 80)
is qbs_prob_pair_measure_t
  unfolding qbs_prob_pair_measure_t_def
proof auto
  fix X X' :: "'a quasi_borel"
  fix Y Y' :: "'b quasi_borel"
  fix \<alpha> \<alpha>' \<mu> \<mu>' \<beta> \<beta>' \<nu> \<nu>'
  assume h:"qbs_prob_eq (X,\<alpha>,\<mu>) (X',\<alpha>',\<mu>')"
           "qbs_prob_eq (Y,\<beta>,\<nu>) (Y',\<beta>',\<nu>')"
  then have 1: "X = X'" "Y = Y'"
    by(auto simp: qbs_prob_eq_def)
  interpret pqp1: pair_qbs_probs X \<alpha> \<mu> Y \<beta> \<nu>
    by(simp add: pair_qbs_probs_def qbs_prob_eq_dest(1)[OF h(1)] qbs_prob_eq_dest(1)[OF h(2)])
  interpret pqp2: pair_qbs_probs X' \<alpha>' \<mu>' Y' \<beta>' \<nu>'
    by(simp add: pair_qbs_probs_def qbs_prob_eq_dest(2)[OF h(1)] qbs_prob_eq_dest(2)[OF h(2)])
  interpret pqp: pair_qbs_prob "X \<Otimes>\<^sub>Q Y" "map_prod \<alpha> \<beta> \<circ> real_real.g" "distr (\<mu> \<Otimes>\<^sub>M \<nu>) real_borel real_real.f" "X' \<Otimes>\<^sub>Q Y'" "map_prod \<alpha>' \<beta>' \<circ> real_real.g" "distr (\<mu>' \<Otimes>\<^sub>M \<nu>') real_borel real_real.f"
    by(auto intro!: qbs_probI pqp1.P.prob_space_distr pqp2.P.prob_space_distr simp: pair_qbs_prob_def)

  show "qbs_prob_eq (X \<Otimes>\<^sub>Q Y, map_prod \<alpha> \<beta> \<circ> real_real.g, distr (\<mu> \<Otimes>\<^sub>M \<nu>) real_borel real_real.f) (X' \<Otimes>\<^sub>Q Y', map_prod \<alpha>' \<beta>' \<circ> real_real.g, distr (\<mu>' \<Otimes>\<^sub>M \<nu>') real_borel real_real.f)"
  proof(rule pqp.qbs_prob_space_eq_inverse(1))
    show "qbs_prob_space (X \<Otimes>\<^sub>Q Y, map_prod \<alpha> \<beta> \<circ> real_real.g, distr (\<mu> \<Otimes>\<^sub>M \<nu>) real_borel real_real.f)
           = qbs_prob_space (X' \<Otimes>\<^sub>Q Y', map_prod \<alpha>' \<beta>' \<circ> real_real.g, distr (\<mu>' \<Otimes>\<^sub>M \<nu>') real_borel real_real.f)"
         (is "?lhs = ?rhs")
    proof -
      have "?lhs = qbs_prob_space (X, \<alpha>, \<mu>) \<bind> (\<lambda>x. qbs_prob_space (Y, \<beta>, \<nu>) \<bind> (\<lambda>y. qbs_return (X \<Otimes>\<^sub>Q Y) (x, y)))"
        by(simp add: pqp1.qbs_bind_return_pq)
      also have "... = qbs_prob_space (X', \<alpha>', \<mu>') \<bind> (\<lambda>x. qbs_prob_space (Y', \<beta>', \<nu>') \<bind> (\<lambda>y. qbs_return (X' \<Otimes>\<^sub>Q Y') (x, y)))"
        using h by(simp add: qbs_prob_space_eq 1)
      also have "... = ?rhs"
        by(simp add: pqp2.qbs_bind_return_pq)
      finally show ?thesis .
    qed
  qed
qed

lemma(in pair_qbs_probs) qbs_prob_pair_measure_computation:
  "(qbs_prob_space (X,\<alpha>,\<mu>)) \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s (qbs_prob_space (Y,\<beta>,\<nu>)) = qbs_prob_space (X \<Otimes>\<^sub>Q Y, map_prod \<alpha> \<beta> \<circ> real_real.g , distr (\<mu> \<Otimes>\<^sub>M \<nu>) real_borel real_real.f)"
  "qbs_prob (X \<Otimes>\<^sub>Q Y) (map_prod \<alpha> \<beta> \<circ> real_real.g) (distr (\<mu> \<Otimes>\<^sub>M \<nu>) real_borel real_real.f)"
  by(simp_all add: qbs_prob_pair_measure.abs_eq qbs_prob_pair_measure_t_def qbs_bind_return_pq)

lemma qbs_prob_pair_measure_qbs:
  "qbs_prob_space_qbs (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) = qbs_prob_space_qbs p \<Otimes>\<^sub>Q qbs_prob_space_qbs q"
  by(transfer,simp add: qbs_prob_pair_measure_t_def Let_def prod.case_eq_if)

lemma(in pair_qbs_probs) qbs_prob_pair_measure_measure:
    shows "qbs_prob_measure (qbs_prob_space (X,\<alpha>,\<mu>) \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s qbs_prob_space (Y,\<beta>,\<nu>)) = distr (\<mu> \<Otimes>\<^sub>M \<nu>) (qbs_to_measure (X \<Otimes>\<^sub>Q Y)) (map_prod \<alpha> \<beta>)"
  by(simp add: qbs_prob_pair_measure_computation distr_distr comp_assoc)

lemma qbs_prob_pair_measure_morphism:
 "case_prod qbs_prob_pair_measure \<in> monadP_qbs X \<Otimes>\<^sub>Q monadP_qbs Y \<rightarrow>\<^sub>Q monadP_qbs (X \<Otimes>\<^sub>Q Y)"
proof(rule pair_qbs_morphismI)
  fix \<beta>x \<beta>y
  assume h: "\<beta>x \<in> qbs_Mx (monadP_qbs X)" " \<beta>y \<in> qbs_Mx (monadP_qbs Y)"
  then obtain \<alpha>x \<alpha>y gx gy where ha:
   "\<alpha>x \<in> qbs_Mx X" "gx \<in> real_borel \<rightarrow>\<^sub>M prob_algebra real_borel" "\<beta>x = (\<lambda>r. qbs_prob_space (X, \<alpha>x, gx r))"
   "\<alpha>y \<in> qbs_Mx Y" "gy \<in> real_borel \<rightarrow>\<^sub>M prob_algebra real_borel" "\<beta>y = (\<lambda>r. qbs_prob_space (Y, \<alpha>y, gy r))"
    using rep_monadP_qbs_MPx[of \<beta>x X] rep_monadP_qbs_MPx[of \<beta>y Y] by auto
  note [measurable] = ha(2,5)
  have "(\<lambda>(x, y). x \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s y) \<circ> (\<lambda>r. (\<beta>x r, \<beta>y r)) = (\<lambda>r. qbs_prob_space (X \<Otimes>\<^sub>Q Y, map_prod \<alpha>x \<alpha>y \<circ> real_real.g, distr (gx r \<Otimes>\<^sub>M gy r) real_borel real_real.f))"
    apply standard
    using qbs_prob_MPx[OF ha(1,2)] qbs_prob_MPx[OF ha(4,5)] pair_qbs_probs.qbs_prob_pair_measure_computation[of X \<alpha>x _ Y \<alpha>y]
    by (auto simp: ha pair_qbs_probs_def)
  also have "... \<in> qbs_Mx (monadP_qbs (X \<Otimes>\<^sub>Q Y))"
    using qbs_prob_MPx[OF ha(1,2)] qbs_prob_MPx[OF ha(4,5)] pair_qbs_probs.ab_g_in_Mx[of X \<alpha>x _ Y \<alpha>y]
    by(auto intro!: bexI[where x="map_prod \<alpha>x \<alpha>y \<circ> real_real.g"] bexI[where x="\<lambda>r. distr (gx r \<Otimes>\<^sub>M gy r) real_borel real_real.f"]
         simp: monadP_qbs_MPx_def in_MPx_def pair_qbs_probs_def)
  finally show "(\<lambda>(x, y). x \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s y) \<circ> (\<lambda>r. (\<beta>x r, \<beta>y r)) \<in> qbs_Mx (monadP_qbs (X \<Otimes>\<^sub>Q Y))" .
qed

lemma(in pair_qbs_probs) qbs_prob_pair_measure_nnintegral:
  assumes "f \<in> X \<Otimes>\<^sub>Q Y \<rightarrow>\<^sub>Q \<real>\<^sub>Q\<^sub>\<ge>\<^sub>0"
  shows "(\<integral>\<^sup>+\<^sub>Q z. f z \<partial>(qbs_prob_space (X,\<alpha>,\<mu>) \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s qbs_prob_space (Y,\<beta>,\<nu>))) = (\<integral>\<^sup>+ z. (f \<circ> map_prod \<alpha> \<beta>) z \<partial>(\<mu> \<Otimes>\<^sub>M \<nu>))"
        (is "?lhs = ?rhs")
proof -
  have "?lhs = (\<integral>\<^sup>+ x. ((f \<circ> map_prod \<alpha> \<beta>) \<circ> real_real.g) x \<partial>distr (\<mu> \<Otimes>\<^sub>M \<nu>) real_borel real_real.f)"
    by(simp add: qbs_prob_ennintegral_def[OF assms] qbs_prob_pair_measure_computation)
  also have "... = (\<integral>\<^sup>+ x. ((f \<circ> map_prod \<alpha> \<beta>) \<circ> real_real.g) (real_real.f x) \<partial>(\<mu> \<Otimes>\<^sub>M \<nu>))"
    using assms by(intro nn_integral_distr) auto
  also have "... = ?rhs" by simp
  finally show ?thesis .
qed

lemma(in pair_qbs_probs) qbs_prob_pair_measure_integral:
  assumes "f \<in> X \<Otimes>\<^sub>Q Y \<rightarrow>\<^sub>Q \<real>\<^sub>Q"
    shows "(\<integral>\<^sub>Q z. f z \<partial>(qbs_prob_space (X,\<alpha>,\<mu>) \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s qbs_prob_space (Y,\<beta>,\<nu>))) = (\<integral>z. (f \<circ> map_prod \<alpha> \<beta>) z \<partial>(\<mu> \<Otimes>\<^sub>M \<nu>))"
          (is "?lhs = ?rhs")
proof -
  have "?lhs = (\<integral>x. ((f \<circ> map_prod \<alpha> \<beta>) \<circ> real_real.g) x \<partial>distr (\<mu> \<Otimes>\<^sub>M \<nu>) real_borel real_real.f)"
    by(simp add: qbs_prob_integral_def[OF assms] qbs_prob_pair_measure_computation)
  also have "... = (\<integral> x. ((f \<circ> map_prod \<alpha> \<beta>) \<circ> real_real.g) (real_real.f x) \<partial>(\<mu> \<Otimes>\<^sub>M \<nu>))"
    using assms by(intro integral_distr) auto
  also have "... = ?rhs" by simp
  finally show ?thesis .
qed

lemma qbs_prob_pair_measure_eq_bind:
  assumes "p \<in> monadP_qbs_Px X"
      and "q \<in> monadP_qbs_Px Y"
    shows "p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q = p \<bind> (\<lambda>x. q \<bind> (\<lambda>y. qbs_return (X \<Otimes>\<^sub>Q Y) (x,y)))"
proof -
  obtain \<alpha> \<mu> where hp:
    "p = qbs_prob_space (X, \<alpha>, \<mu>)" "qbs_prob X \<alpha> \<mu>"
    using rep_monadP_qbs_Px[OF assms(1)] by auto
  obtain \<beta> \<nu> where hq:
   "q = qbs_prob_space (Y, \<beta>, \<nu>)" "qbs_prob Y \<beta> \<nu>"
    using rep_monadP_qbs_Px[OF assms(2)] by auto
  interpret pqp: pair_qbs_probs X \<alpha> \<mu> Y \<beta> \<nu>
    by(simp add: pair_qbs_probs_def hp hq)
  show ?thesis
    by(simp add: hp(1) hq(1) pqp.qbs_prob_pair_measure_computation(1) pqp.qbs_bind_return_pq(1))
qed

subsubsection \<open>Fubini Theorem\<close>
lemma qbs_prob_ennintegral_Fubini_fst:
  assumes "p \<in> monadP_qbs_Px X"
          "q \<in> monadP_qbs_Px Y"
      and "f \<in> X \<Otimes>\<^sub>Q Y \<rightarrow>\<^sub>Q \<real>\<^sub>Q\<^sub>\<ge>\<^sub>0"
    shows "(\<integral>\<^sup>+\<^sub>Q x. \<integral>\<^sup>+\<^sub>Q y. f (x,y) \<partial>q \<partial>p) = (\<integral>\<^sup>+\<^sub>Q z. f z \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q))"
          (is "?lhs = ?rhs")
proof -
  note [simp] = qbs_bind_morphism[OF qbs_morphism_const[of _ "monadP_qbs Y",simplified,OF assms(2)] curry_preserves_morphisms[OF qbs_return_morphism[of "X \<Otimes>\<^sub>Q Y"]],simplified curry_def,simplified]
                qbs_morphism_Pair1'[OF _ qbs_return_morphism[of "X \<Otimes>\<^sub>Q Y"]]
                assms(1)[simplified monadP_qbs_Px_def,simplified] assms(2)[simplified monadP_qbs_Px_def,simplified]
  have "?rhs = (\<integral>\<^sup>+\<^sub>Q z. f z \<partial>(p \<bind> (\<lambda>x. q \<bind> (\<lambda>y. qbs_return (X \<Otimes>\<^sub>Q Y) (x,y)))))"
    by(simp add: qbs_prob_pair_measure_eq_bind[OF assms(1,2)])
  also have "... = (\<integral>\<^sup>+\<^sub>Q x. qbs_prob_ennintegral (q \<bind> (\<lambda>y. qbs_return (X \<Otimes>\<^sub>Q Y) (x, y))) f \<partial>p)"
    by(auto intro!: qbs_prob_ennintegral_bind[OF assms(1) _ assms(3)])
  also have "... =  (\<integral>\<^sup>+\<^sub>Q x. \<integral>\<^sup>+\<^sub>Q y. qbs_prob_ennintegral (qbs_return (X \<Otimes>\<^sub>Q Y) (x, y)) f \<partial>q \<partial>p)"
    by(auto intro!: qbs_prob_ennintegral_cong qbs_prob_ennintegral_bind[OF assms(2) _ assms(3)])
  also have "... = ?lhs"
    using assms(3) by(auto intro!: qbs_prob_ennintegral_cong qbs_prob_ennintegral_return)
  finally show ?thesis by simp
qed

lemma qbs_prob_ennintegral_Fubini_snd:
  assumes "p \<in> monadP_qbs_Px X"
          "q \<in> monadP_qbs_Px Y"
      and "f \<in> X \<Otimes>\<^sub>Q Y \<rightarrow>\<^sub>Q \<real>\<^sub>Q\<^sub>\<ge>\<^sub>0"
    shows "(\<integral>\<^sup>+\<^sub>Q y. \<integral>\<^sup>+\<^sub>Q x. f (x,y) \<partial>p \<partial>q) = (\<integral>\<^sup>+\<^sub>Q x. f x \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q))"
          (is "?lhs = ?rhs")
proof -
  note [simp] = qbs_bind_morphism[OF qbs_morphism_const[of _ "monadP_qbs X",simplified,OF assms(1)] curry_preserves_morphisms[OF qbs_morphism_pair_swap[OF qbs_return_morphism[of "X \<Otimes>\<^sub>Q Y"]],simplified curry_def,simplified]]
                qbs_morphism_Pair2'[OF _ qbs_return_morphism[of "X \<Otimes>\<^sub>Q Y"]]
                assms(1)[simplified monadP_qbs_Px_def,simplified] assms(2)[simplified monadP_qbs_Px_def,simplified]
  have "?rhs = (\<integral>\<^sup>+\<^sub>Q z. f z \<partial>(q \<bind> (\<lambda>y. p \<bind> (\<lambda>x. qbs_return (X \<Otimes>\<^sub>Q Y) (x,y)))))"
    by(simp add: qbs_prob_pair_measure_eq_bind[OF assms(1,2)] qbs_bind_return_rotate[OF assms(1,2)])
  also have "... = (\<integral>\<^sup>+\<^sub>Q y. qbs_prob_ennintegral (p \<bind> (\<lambda>x. qbs_return (X \<Otimes>\<^sub>Q Y) (x, y))) f \<partial>q)"
    by(auto intro!: qbs_prob_ennintegral_bind[OF assms(2) _ assms(3)])
  also have "... =  (\<integral>\<^sup>+\<^sub>Q y. \<integral>\<^sup>+\<^sub>Q x. qbs_prob_ennintegral (qbs_return (X \<Otimes>\<^sub>Q Y) (x, y)) f \<partial>p \<partial>q)"
    by(auto intro!: qbs_prob_ennintegral_cong qbs_prob_ennintegral_bind[OF assms(1) _ assms(3)])
  also have "... = ?lhs"
    using assms(3) by(auto intro!: qbs_prob_ennintegral_cong qbs_prob_ennintegral_return)
  finally show ?thesis by simp
qed

lemma qbs_prob_ennintegral_indep1:
  assumes "p \<in> monadP_qbs_Px X"
      and "f \<in> X \<rightarrow>\<^sub>Q \<real>\<^sub>Q\<^sub>\<ge>\<^sub>0"
    shows "(\<integral>\<^sup>+\<^sub>Q z. f (fst z) \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)) = (\<integral>\<^sup>+\<^sub>Q x. f x \<partial>p)"
          (is "?lhs = _")
proof -
 obtain Y \<beta> \<nu> where hq:
   "q = qbs_prob_space (Y, \<beta>, \<nu>)" "qbs_prob Y \<beta> \<nu>"
    using rep_qbs_prob_space[of q] by auto
  have "?lhs = (\<integral>\<^sup>+\<^sub>Q y. \<integral>\<^sup>+\<^sub>Q x. f x \<partial>p \<partial>q)"
    using qbs_prob_ennintegral_Fubini_snd[OF assms(1) qbs_prob.qbs_prob_space_in_Px[OF hq(2)] qbs_morphism_fst''[OF assms(2)]]
    by(simp add: hq(1))
  thus ?thesis
    by(simp add: qbs_prob_ennintegral_const)
qed

lemma qbs_prob_ennintegral_indep2:
  assumes "q \<in> monadP_qbs_Px Y"
      and "f \<in> Y \<rightarrow>\<^sub>Q \<real>\<^sub>Q\<^sub>\<ge>\<^sub>0"
    shows "(\<integral>\<^sup>+\<^sub>Q z. f (snd z) \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)) = (\<integral>\<^sup>+\<^sub>Q y. f y \<partial>q)"
          (is "?lhs = _")
proof -
  obtain X \<alpha> \<mu> where hp:
    "p = qbs_prob_space (X, \<alpha>, \<mu>)" "qbs_prob X \<alpha> \<mu>"
    using rep_qbs_prob_space[of p] by auto
  have "?lhs = (\<integral>\<^sup>+\<^sub>Q x. \<integral>\<^sup>+\<^sub>Q y. f y \<partial>q \<partial>p)"
    using qbs_prob_ennintegral_Fubini_fst[OF qbs_prob.qbs_prob_space_in_Px[OF hp(2)] assms(1) qbs_morphism_snd''[OF assms(2)]]
    by(simp add: hp(1))
  thus ?thesis
    by(simp add: qbs_prob_ennintegral_const)
qed

lemma qbs_ennintegral_indep_mult:
  assumes "p \<in> monadP_qbs_Px X"
          "q \<in> monadP_qbs_Px Y"
          "f \<in> X \<rightarrow>\<^sub>Q \<real>\<^sub>Q\<^sub>\<ge>\<^sub>0"
      and "g \<in> Y \<rightarrow>\<^sub>Q \<real>\<^sub>Q\<^sub>\<ge>\<^sub>0"
    shows "(\<integral>\<^sup>+\<^sub>Q z. f (fst z) * g (snd z) \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)) = (\<integral>\<^sup>+\<^sub>Q x. f x \<partial>p) * (\<integral>\<^sup>+\<^sub>Q y. g y \<partial>q)"
          (is "?lhs = ?rhs")
proof -
  have h:"(\<lambda>z. f (fst z) * g (snd z)) \<in> X \<Otimes>\<^sub>Q Y \<rightarrow>\<^sub>Q \<real>\<^sub>Q\<^sub>\<ge>\<^sub>0"
    using assms(4,3)
    by(auto intro!: borel_measurable_subalgebra[OF l_product_sets[of X Y]] simp: space_pair_measure lr_adjunction_correspondence)

  have "?lhs = (\<integral>\<^sup>+\<^sub>Q x. \<integral>\<^sup>+\<^sub>Q y .f x * g y \<partial>q \<partial>p)"
    using qbs_prob_ennintegral_Fubini_fst[OF assms(1,2) h] by simp
  also have "... = (\<integral>\<^sup>+\<^sub>Q x. f x * \<integral>\<^sup>+\<^sub>Q y . g y \<partial>q \<partial>p)"
    using qbs_prob_ennintegral_cmult[of q,OF _ assms(4)] assms(2)
    by(simp add: monadP_qbs_Px_def)
  also have "... = ?rhs"
    using qbs_prob_ennintegral_cmult[of p,OF _ assms(3)] assms(1)
    by(simp add: ab_semigroup_mult_class.mult.commute[where b="qbs_prob_ennintegral q g"] monadP_qbs_Px_def)
  finally show ?thesis .
qed

lemma(in pair_qbs_probs) qbs_prob_pair_measure_integrable:
  assumes "qbs_integrable (qbs_prob_space (X,\<alpha>,\<mu>) \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s qbs_prob_space (Y,\<beta>,\<nu>)) f"
    shows "f \<in> X \<Otimes>\<^sub>Q Y \<rightarrow>\<^sub>Q \<real>\<^sub>Q"
          "integrable (\<mu> \<Otimes>\<^sub>M \<nu>) (f \<circ> (map_prod \<alpha> \<beta>))"
proof -
  show "f \<in> X \<Otimes>\<^sub>Q Y \<rightarrow>\<^sub>Q \<real>\<^sub>Q"
    using qbs_integrable_morphism[OF qbs_prob_pair_measure_qbs assms]
    by simp
next
  have 1:"integrable (distr (\<mu> \<Otimes>\<^sub>M \<nu>) real_borel real_real.f) (f \<circ> (map_prod \<alpha> \<beta> \<circ> real_real.g))"
    using assms[simplified qbs_prob_pair_measure_computation] qbs_integrable_def[of f]
    by simp
  have "integrable (\<mu> \<Otimes>\<^sub>M \<nu>) (\<lambda>x. (f \<circ> (map_prod \<alpha> \<beta> \<circ> real_real.g)) (real_real.f x))"
    by(intro integrable_distr[OF _ 1]) simp
  thus "integrable (\<mu> \<Otimes>\<^sub>M \<nu>) (f \<circ> map_prod \<alpha> \<beta>)"
    by(simp add: comp_def)
qed

lemma(in pair_qbs_probs) qbs_prob_pair_measure_integrable':
  assumes "f \<in> X \<Otimes>\<^sub>Q Y \<rightarrow>\<^sub>Q \<real>\<^sub>Q"
      and "integrable (\<mu> \<Otimes>\<^sub>M \<nu>) (f \<circ> (map_prod \<alpha> \<beta>))"
    shows "qbs_integrable (qbs_prob_space (X,\<alpha>,\<mu>) \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s qbs_prob_space (Y,\<beta>,\<nu>)) f"
proof -
  have "integrable (distr (\<mu> \<Otimes>\<^sub>M \<nu>) real_borel real_real.f) (f \<circ> (map_prod \<alpha> \<beta> \<circ> real_real.g)) = integrable (\<mu> \<Otimes>\<^sub>M \<nu>) (\<lambda>x. (f \<circ> (map_prod \<alpha> \<beta> \<circ> real_real.g)) (real_real.f x))"
    by(intro integrable_distr_eq) (use assms(1) in auto)
  thus ?thesis
    using assms qbs_integrable_def
    by(simp add: comp_def qbs_prob_pair_measure_computation)
qed

lemma qbs_integrable_pair_swap:
  assumes "qbs_integrable (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) f"
  shows "qbs_integrable (q \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s p) (\<lambda>(x,y). f (y,x))"
proof -
  obtain X \<alpha> \<mu> where hp:
    "p = qbs_prob_space (X, \<alpha>, \<mu>)" "qbs_prob X \<alpha> \<mu>"
    using rep_qbs_prob_space[of p] by auto
  obtain Y \<beta> \<nu> where hq:
   "q = qbs_prob_space (Y, \<beta>, \<nu>)" "qbs_prob Y \<beta> \<nu>"
    using rep_qbs_prob_space[of q] by auto
  interpret pqp: pair_qbs_probs X \<alpha> \<mu> Y \<beta> \<nu>
    by(simp add: pair_qbs_probs_def hp hq)
  interpret pqp2: pair_qbs_probs Y \<beta> \<nu> X \<alpha> \<mu>
    by(simp add: pair_qbs_probs_def hp hq)

  have "f \<in> X \<Otimes>\<^sub>Q Y \<rightarrow>\<^sub>Q \<real>\<^sub>Q"
       "integrable (\<mu> \<Otimes>\<^sub>M \<nu>) (f \<circ> map_prod \<alpha> \<beta>)"
    by(auto simp: pqp.qbs_prob_pair_measure_integrable[OF assms[simplified hp(1) hq(1)]])
  from qbs_morphism_pair_swap[OF this(1)] pqp.integrable_product_swap[OF this(2)]
  have "(\<lambda>(x,y). f (y,x)) \<in> Y \<Otimes>\<^sub>Q X \<rightarrow>\<^sub>Q \<real>\<^sub>Q"
        "integrable (\<nu> \<Otimes>\<^sub>M \<mu>) ((\<lambda>(x,y). f (y,x)) \<circ> map_prod \<beta> \<alpha>)"
    by(simp_all add: map_prod_def comp_def split_beta')
  from pqp2.qbs_prob_pair_measure_integrable' [OF this]
  show ?thesis by(simp add: hp(1) hq(1))
qed

lemma qbs_integrable_pair1:
  assumes "p \<in> monadP_qbs_Px X"
          "q \<in> monadP_qbs_Px Y"
          "f \<in> X \<Otimes>\<^sub>Q Y \<rightarrow>\<^sub>Q \<real>\<^sub>Q"
          "qbs_integrable p (\<lambda>x. \<integral>\<^sub>Q y. \<bar>f (x,y)\<bar> \<partial>q)"
      and "\<And>x. x \<in> qbs_space X \<Longrightarrow> qbs_integrable q (\<lambda>y. f (x,y))"
    shows "qbs_integrable (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) f"
proof -
  obtain \<alpha> \<mu> where hp:
    "p = qbs_prob_space (X, \<alpha>, \<mu>)" "qbs_prob X \<alpha> \<mu>"
    using rep_monadP_qbs_Px[OF assms(1)] by auto
  obtain \<beta> \<nu> where hq:
   "q = qbs_prob_space (Y, \<beta>, \<nu>)" "qbs_prob Y \<beta> \<nu>"
    using rep_monadP_qbs_Px[OF assms(2)] by auto
  interpret pqp: pair_qbs_probs X \<alpha> \<mu> Y \<beta> \<nu>
    by(simp add: pair_qbs_probs_def hp hq)

  have "integrable (\<mu> \<Otimes>\<^sub>M \<nu>) (f \<circ> map_prod \<alpha> \<beta>)"
  proof(rule pqp.Fubini_integrable)
    show "f \<circ> map_prod \<alpha> \<beta> \<in> borel_measurable (\<mu> \<Otimes>\<^sub>M \<nu>)"
      using assms(3) by auto
  next
    have "(\<lambda>x. LINT y|\<nu>. norm ((f \<circ> map_prod \<alpha> \<beta>) (x, y))) = (\<lambda>x. \<integral>\<^sub>Q y. \<bar>f (x,y)\<bar> \<partial>q) \<circ> \<alpha>"
      apply standard subgoal for x
        using qbs_morphism_Pair1'[OF qbs_Mx_to_X(2)[OF pqp.qp1.in_Mx,of x] assms(3)]
        by(auto intro!: pqp.qp2.qbs_prob_integral_def[symmetric] simp: hq(1))
      done
    moreover have "integrable \<mu> ..."
      using assms(4) pqp.qp1.qbs_integrable_def
      by (simp add: hp(1))
    ultimately show "integrable \<mu> (\<lambda>x. LINT y|\<nu>. norm ((f \<circ> map_prod \<alpha> \<beta>) (x, y)))"
      by simp
  next
    have "\<And>x. integrable \<nu> (\<lambda>y. (f \<circ> map_prod \<alpha> \<beta>) (x, y))"
    proof-
      fix x
      have "(\<lambda>y. (f \<circ> map_prod \<alpha> \<beta>) (x, y)) = (\<lambda>y. f (\<alpha> x,y)) \<circ> \<beta>"
        by auto
      moreover have "qbs_integrable (qbs_prob_space (Y, \<beta>, \<nu>)) (\<lambda>y. f (\<alpha> x, y))"
        by(auto intro!: assms(5)[simplified hq(1)] simp: qbs_Mx_to_X)
      ultimately show "integrable \<nu> (\<lambda>y. (f \<circ> map_prod \<alpha> \<beta>) (x, y))"
        by(simp add: pqp.qp2.qbs_integrable_def)
    qed
    thus "AE x in \<mu>. integrable \<nu> (\<lambda>y. (f \<circ> map_prod \<alpha> \<beta>) (x, y))"
      by simp
  qed
  thus ?thesis
    using pqp.qbs_prob_pair_measure_integrable'[OF assms(3)]
    by(simp add: hp(1) hq(1))
qed

lemma qbs_integrable_pair2:
  assumes "p \<in> monadP_qbs_Px X"
          "q \<in> monadP_qbs_Px Y"
          "f \<in> X \<Otimes>\<^sub>Q Y \<rightarrow>\<^sub>Q \<real>\<^sub>Q"
          "qbs_integrable q (\<lambda>y. \<integral>\<^sub>Q x. \<bar>f (x,y)\<bar> \<partial>p)"
      and "\<And>y. y \<in> qbs_space Y \<Longrightarrow> qbs_integrable p (\<lambda>x. f (x,y))"
    shows "qbs_integrable (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) f"
  using qbs_integrable_pair_swap[OF qbs_integrable_pair1[OF assms(2,1) qbs_morphism_pair_swap[OF assms(3)],simplified,OF assms(4,5)]]
  by simp

lemma qbs_integrable_fst:
  assumes "qbs_integrable (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) f"
  shows "qbs_integrable p (\<lambda>x. \<integral>\<^sub>Q y. f (x,y) \<partial>q)"
proof -
  obtain X \<alpha> \<mu> where hp:
    "p = qbs_prob_space (X, \<alpha>, \<mu>)" "qbs_prob X \<alpha> \<mu>"
    using rep_qbs_prob_space[of p] by auto
  obtain Y \<beta> \<nu> where hq:
   "q = qbs_prob_space (Y, \<beta>, \<nu>)" "qbs_prob Y \<beta> \<nu>"
    using rep_qbs_prob_space[of q] by auto
  interpret pqp: pair_qbs_probs X \<alpha> \<mu> Y \<beta> \<nu>
    by(simp add: hp hq  pair_qbs_probs_def)
  have h0: "p \<in> monadP_qbs_Px X" "q \<in> monadP_qbs_Px Y" "f \<in> X \<Otimes>\<^sub>Q Y \<rightarrow>\<^sub>Q \<real>\<^sub>Q"
    using qbs_integrable_morphism[OF _ assms,simplified qbs_prob_pair_measure_qbs]
    by(simp_all add: monadP_qbs_Px_def hp(1) hq(1))

  show "qbs_integrable p (\<lambda>x. \<integral>\<^sub>Q y. f (x, y) \<partial>q)"
  proof(auto simp add: pqp.qp1.qbs_integrable_def hp(1))
    show "(\<lambda>x. \<integral>\<^sub>Q y. f (x, y) \<partial>q) \<in> borel_measurable (qbs_to_measure X)"
      using qbs_morphism_integral_fst[OF h0(2,3)] by auto
  next
    have "integrable \<mu> (\<lambda>x. LINT y|\<nu>. (f \<circ> map_prod \<alpha> \<beta>) (x, y))"
      by(intro pqp.integrable_fst') (rule pqp.qbs_prob_pair_measure_integrable(2)[OF assms[simplified hp(1) hq(1)]])
    moreover have "\<And>x. ((\<lambda>x. \<integral>\<^sub>Q y. f (x, y) \<partial>q) \<circ> \<alpha>) x = LINT y|\<nu>. (f \<circ> map_prod \<alpha> \<beta>) (x, y)"
     by(auto intro!: pqp.qp2.qbs_prob_integral_def qbs_morphism_Pair1'[OF qbs_Mx_to_X(2)[OF pqp.qp1.in_Mx] h0(3)] simp: hq)
    ultimately show "integrable \<mu> ((\<lambda>x. \<integral>\<^sub>Q y. f (x, y) \<partial>q) \<circ> \<alpha>)"
      using Bochner_Integration.integrable_cong[of \<mu> \<mu> "(\<lambda>x. \<integral>\<^sub>Q y. f (x, y) \<partial>q) \<circ> \<alpha>" " (\<lambda>x. LINT y|\<nu>. (f \<circ> map_prod \<alpha> \<beta>) (x, y))"]
      by simp
  qed
qed

lemma qbs_integrable_snd:
  assumes "qbs_integrable (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) f"
  shows "qbs_integrable q (\<lambda>y. \<integral>\<^sub>Q x. f (x,y) \<partial>p)"
  using qbs_integrable_fst[OF qbs_integrable_pair_swap[OF assms]]
  by simp

lemma qbs_integrable_indep_mult:
  assumes "qbs_integrable p f"
      and "qbs_integrable q g"
    shows "qbs_integrable (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) (\<lambda>x. f (fst x) * g (snd x))"
proof -
  obtain X \<alpha> \<mu> where hp:
    "p = qbs_prob_space (X, \<alpha>, \<mu>)" "qbs_prob X \<alpha> \<mu>"
    using rep_qbs_prob_space[of p] by auto
  obtain Y \<beta> \<nu> where hq:
   "q = qbs_prob_space (Y, \<beta>, \<nu>)" "qbs_prob Y \<beta> \<nu>"
    using rep_qbs_prob_space[of q] by auto
  interpret pqp: pair_qbs_probs X \<alpha> \<mu> Y \<beta> \<nu>
    by(simp add: hp hq  pair_qbs_probs_def)
  have h0: "p \<in> monadP_qbs_Px X" "q \<in> monadP_qbs_Px Y" "f \<in> X \<rightarrow>\<^sub>Q \<real>\<^sub>Q" "g \<in> Y \<rightarrow>\<^sub>Q \<real>\<^sub>Q"
    using qbs_integrable_morphism[OF _ assms(1)] qbs_integrable_morphism[OF _ assms(2)]
    by(simp_all add: monadP_qbs_Px_def hp(1) hq(1))

  show ?thesis
  proof(rule qbs_integrable_pair1[OF h0(1,2)],simp_all add: assms(2))
    show "(\<lambda>z. f (fst z) * g (snd z)) \<in>  X \<Otimes>\<^sub>Q Y \<rightarrow>\<^sub>Q \<real>\<^sub>Q"
      using h0(3,4) by(auto intro!: borel_measurable_subalgebra[OF l_product_sets[of X Y]] simp: space_pair_measure lr_adjunction_correspondence)
  next
    show "qbs_integrable p (\<lambda>x. \<integral>\<^sub>Q y. \<bar>f x * g y\<bar> \<partial>q)"
      by(auto intro!: qbs_integrable_mult[OF qbs_integrable_abs[OF assms(1)]]
           simp only: idom_abs_sgn_class.abs_mult qbs_prob_integral_cmult ab_semigroup_mult_class.mult.commute[where b="\<integral>\<^sub>Q y. \<bar>g y\<bar> \<partial>q"])
  qed
qed

lemma qbs_integrable_indep1:
  assumes "qbs_integrable p f"
  shows "qbs_integrable (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) (\<lambda>x. f (fst x))"
  using qbs_integrable_indep_mult[OF assms qbs_integrable_const[of q 1]]
  by simp

lemma qbs_integrable_indep2:
  assumes "qbs_integrable q g"
  shows "qbs_integrable (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) (\<lambda>x. g (snd x))"
  using qbs_integrable_pair_swap[OF qbs_integrable_indep1[OF assms],of p]
  by(simp add: split_beta')

lemma qbs_prob_integral_Fubini_fst:
  assumes "qbs_integrable (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) f"
    shows "(\<integral>\<^sub>Q x. \<integral>\<^sub>Q y. f (x,y) \<partial>q \<partial>p) = (\<integral>\<^sub>Q z. f z \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q))"
          (is "?lhs = ?rhs")
proof -
  obtain X \<alpha> \<mu> where hp:
    "p = qbs_prob_space (X, \<alpha>, \<mu>)" "qbs_prob X \<alpha> \<mu>"
    using rep_qbs_prob_space[of p] by auto
  obtain Y \<beta> \<nu> where hq:
   "q = qbs_prob_space (Y, \<beta>, \<nu>)" "qbs_prob Y \<beta> \<nu>"
    using rep_qbs_prob_space[of q] by auto
  interpret pqp: pair_qbs_probs X \<alpha> \<mu> Y \<beta> \<nu>
    by(simp add: hp hq  pair_qbs_probs_def)
  have h0: "p \<in> monadP_qbs_Px X" "q \<in> monadP_qbs_Px Y" "f \<in> X \<Otimes>\<^sub>Q Y \<rightarrow>\<^sub>Q \<real>\<^sub>Q"
    using qbs_integrable_morphism[OF _ assms,simplified qbs_prob_pair_measure_qbs]
    by(simp_all add: monadP_qbs_Px_def hp(1) hq(1))

  have "?lhs = (\<integral> x. \<integral>\<^sub>Q y. f (\<alpha> x, y) \<partial>q \<partial>\<mu>)"
    using qbs_morphism_integral_fst[OF h0(2) h0(3)]
    by(auto intro!: pqp.qp1.qbs_prob_integral_def simp: hp(1))
  also have "... = (\<integral>x. \<integral>y. f (\<alpha> x, \<beta> y) \<partial>\<nu> \<partial>\<mu>)"
    using qbs_morphism_Pair1'[OF qbs_Mx_to_X(2)[OF pqp.qp1.in_Mx] h0(3)]
    by(auto intro!: Bochner_Integration.integral_cong pqp.qp2.qbs_prob_integral_def
              simp: hq(1))
  also have "... = (\<integral>z. (f \<circ> map_prod \<alpha> \<beta>) z \<partial>(\<mu> \<Otimes>\<^sub>M \<nu>))"
    using pqp.integral_fst'[OF pqp.qbs_prob_pair_measure_integrable(2)[OF assms[simplified hp(1) hq(1)]]]
    by(simp add: map_prod_def comp_def)
  also have "... = ?rhs"
    by(simp add: pqp.qbs_prob_pair_measure_integral[OF h0(3)] hp(1) hq(1))
  finally show ?thesis .
qed

lemma qbs_prob_integral_Fubini_snd:
  assumes "qbs_integrable (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) f"
    shows "(\<integral>\<^sub>Q y. \<integral>\<^sub>Q x. f (x,y) \<partial>p \<partial>q) = (\<integral>\<^sub>Q z. f z \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q))"
          (is "?lhs = ?rhs")
proof -
  obtain X \<alpha> \<mu> where hp:
    "p = qbs_prob_space (X, \<alpha>, \<mu>)" "qbs_prob X \<alpha> \<mu>"
    using rep_qbs_prob_space[of p] by auto
  obtain Y \<beta> \<nu> where hq:
   "q = qbs_prob_space (Y, \<beta>, \<nu>)" "qbs_prob Y \<beta> \<nu>"
    using rep_qbs_prob_space[of q] by auto
  interpret pqp: pair_qbs_probs X \<alpha> \<mu> Y \<beta> \<nu>
    by(simp add: hp hq  pair_qbs_probs_def)
  have h0: "p \<in> monadP_qbs_Px X" "q \<in> monadP_qbs_Px Y" "f \<in> X \<Otimes>\<^sub>Q Y \<rightarrow>\<^sub>Q \<real>\<^sub>Q"
    using qbs_integrable_morphism[OF _ assms,simplified qbs_prob_pair_measure_qbs]
    by(simp_all add: monadP_qbs_Px_def hp(1) hq(1))

  have "?lhs = (\<integral> y. \<integral>\<^sub>Q x. f (x,\<beta> y) \<partial>p \<partial>\<nu>)"
    using qbs_morphism_integral_snd[OF h0(1) h0(3)]
    by(auto intro!: pqp.qp2.qbs_prob_integral_def simp: hq(1))
  also have "... = (\<integral>y. \<integral>x. f (\<alpha> x, \<beta> y) \<partial>\<mu> \<partial>\<nu>)"
    using qbs_morphism_Pair2'[OF qbs_Mx_to_X(2)[OF pqp.qp2.in_Mx] h0(3)]
    by(auto intro!: Bochner_Integration.integral_cong pqp.qp1.qbs_prob_integral_def
              simp: hp(1))
  also have "... = (\<integral>z. (f \<circ> map_prod \<alpha> \<beta>) z \<partial>(\<mu> \<Otimes>\<^sub>M \<nu>))"
    using pqp.integral_snd[of "curry (f \<circ> map_prod \<alpha> \<beta>)"] pqp.qbs_prob_pair_measure_integrable(2)[OF assms[simplified hp(1) hq(1)]]
    by(simp add: map_prod_def comp_def split_beta')
  also have "... = ?rhs"
    by(simp add: pqp.qbs_prob_pair_measure_integral[OF h0(3)] hp(1) hq(1))
  finally show ?thesis .
qed

lemma qbs_prob_integral_indep1:
  assumes "qbs_integrable p f"
  shows "(\<integral>\<^sub>Q z. f (fst z) \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)) = (\<integral>\<^sub>Q x. f x \<partial>p)"
  using qbs_prob_integral_Fubini_snd[OF qbs_integrable_indep1[OF assms],of q]
  by(simp add: qbs_prob_integral_const)

lemma qbs_prob_integral_indep2:
  assumes "qbs_integrable q g"
  shows "(\<integral>\<^sub>Q z. g (snd z) \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)) = (\<integral>\<^sub>Q y. g y \<partial>q)"
  using qbs_prob_integral_Fubini_fst[OF qbs_integrable_indep2[OF assms],of p]
  by(simp add: qbs_prob_integral_const)

lemma qbs_prob_integral_indep_mult:
  assumes "qbs_integrable p f"
      and "qbs_integrable q g"
    shows "(\<integral>\<^sub>Q z. f (fst z) * g (snd z) \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)) = (\<integral>\<^sub>Q x. f x \<partial>p) * (\<integral>\<^sub>Q y. g y \<partial>q)"
          (is "?lhs = ?rhs")
proof -
  have "?lhs = (\<integral>\<^sub>Q x. \<integral>\<^sub>Q y. f x * g y \<partial>q \<partial>p)"
    using qbs_prob_integral_Fubini_fst[OF qbs_integrable_indep_mult[OF assms]]
    by simp
  also have "... = (\<integral>\<^sub>Q x. f x * (\<integral>\<^sub>Q y.  g y \<partial>q) \<partial>p)"
    by(simp add: qbs_prob_integral_cmult)
  also have "... = ?rhs"
    by(simp add: qbs_prob_integral_cmult ab_semigroup_mult_class.mult.commute[where b="\<integral>\<^sub>Q y.  g y \<partial>q"])
  finally show ?thesis .
qed

lemma qbs_prob_var_indep_plus:
  assumes "qbs_integrable (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) f"
          "qbs_integrable (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) (\<lambda>z. (f z)\<^sup>2)"
          "qbs_integrable (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) g"
          "qbs_integrable (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) (\<lambda>z. (g z)\<^sup>2)"
          "qbs_integrable (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) (\<lambda>z. (f z) * (g z))"
      and "(\<integral>\<^sub>Q z. f z * g z \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)) = (\<integral>\<^sub>Q z. f z \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)) * (\<integral>\<^sub>Q z. g z \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q))"
    shows "qbs_prob_var (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) (\<lambda>z. f z + g z) = qbs_prob_var (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) f + qbs_prob_var (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) g"
  unfolding qbs_prob_var_def
proof -
  show "(\<integral>\<^sub>Q z. (f z + g z - \<integral>\<^sub>Q w. f w + g w \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q))\<^sup>2 \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)) = (\<integral>\<^sub>Q z. (f z - qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) f)\<^sup>2 \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)) + (\<integral>\<^sub>Q z. (g z - qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) g)\<^sup>2 \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q))"
       (is "?lhs = ?rhs")
  proof -
    have "?lhs = (\<integral>\<^sub>Q z. ((f z - (\<integral>\<^sub>Q w. f w \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q))) + (g z - (\<integral>\<^sub>Q w. g w \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q))))\<^sup>2 \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q))"
      by(simp add: qbs_prob_integral_add[OF assms(1,3)] add_diff_add)
    also have "... = (\<integral>\<^sub>Q z. (f z - (\<integral>\<^sub>Q w. f w \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)))\<^sup>2 + (g z - (\<integral>\<^sub>Q w. g w \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)))\<^sup>2 + (2 * f z * g z - 2 * (\<integral>\<^sub>Q w. f w \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)) * g z - (2 * f z * (\<integral>\<^sub>Q w. g w \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)) - 2 * (\<integral>\<^sub>Q w. f w \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)) * (\<integral>\<^sub>Q w. g w \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)))) \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q))"
      by(simp add: comm_semiring_1_class.power2_sum comm_semiring_1_cancel_class.left_diff_distrib' ring_class.right_diff_distrib)
    also have "... = ?rhs"
      using qbs_prob_integral_add[OF qbs_integrable_add[OF qbs_integrable_sq[OF assms(1,2)] qbs_integrable_sq[OF assms(3,4)]] qbs_integrable_diff[OF qbs_integrable_diff[OF qbs_integrable_mult[OF assms(5),of 2,simplified comm_semiring_1_class.semiring_normalization_rules(18)] qbs_integrable_mult[OF assms(3),of "2 * qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) f"]] qbs_integrable_diff[OF qbs_integrable_mult[OF assms(1),of "2 * qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) g",simplified ab_semigroup_mult_class.mult_ac(1)[where b="qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) g"] ab_semigroup_mult_class.mult.commute[where a="qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) g"] comm_semiring_1_class.semiring_normalization_rules(18)[of _ _ "qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) g"]] qbs_integrable_const[of _ "2 * qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) f * qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) g"]]]]
            qbs_prob_integral_add[OF qbs_integrable_sq[OF assms(1,2)] qbs_integrable_sq[OF assms(3,4)]]
            qbs_prob_integral_diff[OF qbs_integrable_diff[OF qbs_integrable_mult[OF assms(5),of 2,simplified comm_semiring_1_class.semiring_normalization_rules(18)] qbs_integrable_mult[OF assms(3),of "2 * qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) f"]] qbs_integrable_diff[OF qbs_integrable_mult[OF assms(1),of "2 * qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) g",simplified ab_semigroup_mult_class.mult_ac(1)[where b="qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) g"] ab_semigroup_mult_class.mult.commute[where a="qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) g"] comm_semiring_1_class.semiring_normalization_rules(18)[of _ _ "qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) g"]] qbs_integrable_const[of _ "2 * qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) f * qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) g"]]]
            qbs_prob_integral_diff[OF qbs_integrable_mult[OF assms(5),of 2,simplified comm_semiring_1_class.semiring_normalization_rules(18)] qbs_integrable_mult[OF assms(3),of "2 * qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) f"]]
            qbs_prob_integral_diff[OF qbs_integrable_mult[OF assms(1),of "2 * qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) g",simplified ab_semigroup_mult_class.mult_ac(1)[where b="qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) g"] ab_semigroup_mult_class.mult.commute[where a="qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) g"] comm_semiring_1_class.semiring_normalization_rules(18)[of _ _ "qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) g"]] qbs_integrable_const[of _ "2 * qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) f * qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) g"]]
            qbs_prob_integral_cmult[of "p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q" 2 "\<lambda>z. f z * g z",simplified assms(6) comm_semiring_1_class.semiring_normalization_rules(18)]
            qbs_prob_integral_cmult[of "p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q" "2 * (\<integral>\<^sub>Q w. f w \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q))" g]
            qbs_prob_integral_cmult[of "p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q" "2 * (\<integral>\<^sub>Q w. g w \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q))" f,simplified semigroup_mult_class.mult.assoc[of 2 "\<integral>\<^sub>Q w. g w \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)"] ab_semigroup_mult_class.mult.commute[where a="qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) g"] comm_semiring_1_class.semiring_normalization_rules(18)[of 2 _ "\<integral>\<^sub>Q w. g w \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)"]]
            qbs_prob_integral_const[of "p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q" "2 * qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) f * qbs_prob_integral (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) g"]
      by simp
    finally show ?thesis .
  qed
qed

lemma qbs_prob_var_indep_plus':
  assumes "qbs_integrable p f"
          "qbs_integrable p (\<lambda>x. (f x)\<^sup>2)"
          "qbs_integrable q g"
      and "qbs_integrable q (\<lambda>x. (g x)\<^sup>2)"
    shows "qbs_prob_var (p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q) (\<lambda>z. f (fst z) + g (snd z)) = qbs_prob_var p f + qbs_prob_var q g"
  using qbs_prob_var_indep_plus[OF qbs_integrable_indep1[OF assms(1)] qbs_integrable_indep1[OF assms(2)] qbs_integrable_indep2[OF assms(3)] qbs_integrable_indep2[OF assms(4)] qbs_integrable_indep_mult[OF assms(1) assms(3)] qbs_prob_integral_indep_mult[OF assms(1) assms(3),simplified  qbs_prob_integral_indep1[OF assms(1),of q,symmetric] qbs_prob_integral_indep2[OF assms(3),of p,symmetric]]]
        qbs_prob_integral_indep1[OF qbs_integrable_sq[OF assms(1,2)],of q "\<integral>\<^sub>Q z. f (fst z) \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)"] qbs_prob_integral_indep2[OF qbs_integrable_sq[OF assms(3,4)],of p "\<integral>\<^sub>Q z. g (snd z) \<partial>(p \<Otimes>\<^sub>Q\<^sub>m\<^sub>e\<^sub>s q)"]
  by(simp add: qbs_prob_var_def qbs_prob_integral_indep1[OF assms(1)] qbs_prob_integral_indep2[OF assms(3)])

end