Theory Monad_QuasiBorel

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


section ‹The S-Finite Measure Monad›

theory Monad_QuasiBorel
  imports
 "Measure_QuasiBorel_Adjunction"
 "Kernels"

begin
subsection ‹ The S-Finite Measure Monad›
subsubsection ‹ Space of S-Finite Measures›
locale in_Mx =
  fixes X :: "'a quasi_borel"
    and α :: "real  'a"
  assumes in_Mx[simp]:"α  qbs_Mx X"
begin

lemma α_measurable[measurable]: "α  borel M qbs_to_measure X"
  using in_Mx qbs_Mx_subset_of_measurable by blast

lemma α_qbs_morphism[qbs]: "α  qbs_borel Q X"
  using in_Mx by(simp only: qbs_Mx_is_morphisms)

lemma X_not_empty: "qbs_space X  {}"
  using in_Mx by(auto simp: qbs_empty_equiv simp del: in_Mx)

lemma inverse_UNIV[simp]: "α -` (qbs_space X) = UNIV"
  by fastforce

end

locale qbs_s_finite = in_Mx X α + s_finite_measure μ 
  for X :: "'a quasi_borel" and α and μ :: "real measure" +
  assumes mu_sets[measurable_cong]: "sets μ = sets borel"
begin

lemma mu_not_empty: "space μ  {}"
  by(simp add: sets_eq_imp_space_eq[OF mu_sets])

end

lemma qbs_s_finite_All:
  assumes "α  qbs_Mx X" "s_finite_kernel M borel k" "x  space M"
  shows "qbs_s_finite X α (k x)"
proof -
  interpret s_finite_kernel M borel k by fact
  show ?thesis
    using assms(1,3) image_s_finite_measure[OF assms(3)] by(auto simp: qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def kernel_sets)
qed

locale qbs_prob = in_Mx X α + real_distribution μ
  for X :: "'a quasi_borel" and α μ
begin

lemma qbs_s_finite: "qbs_s_finite X α μ"
  by(auto simp: qbs_s_finite_def qbs_s_finite_axioms_def in_Mx_def s_finite_measure_prob)

sublocale qbs_s_finite by(rule qbs_s_finite)

end

lemma(in qbs_s_finite) qbs_probI: "prob_space μ  qbs_prob X α μ"
  by(auto simp: qbs_prob_def in_Mx_def real_distribution_def real_distribution_axioms_def mu_sets)

locale pair_qbs_s_finites = pq1: qbs_s_finite X α μ + pq2: qbs_s_finite Y β ν
  for X :: "'a quasi_borel" and α μ and Y :: "'b quasi_borel" and β ν
begin

lemma ab_measurable[measurable]: "map_prod α β  borel M borel M qbs_to_measure (X Q Y)"
proof -
  have "map_prod α β  qbs_to_measure (measure_to_qbs (borel M borel)) M qbs_to_measure (X Q Y)"
    by(auto intro!: set_mp[OF l_preserves_morphisms] simp: r_preserves_product)
  moreover have "sets (qbs_to_measure (measure_to_qbs (borel M borel))) = sets ((borel M borel) :: (real × real) measure)"
    by(auto intro!: standard_borel.lr_sets_ident pair_standard_borel_ne standard_borel_ne.standard_borel)
  ultimately show ?thesis by simp
qed

end

locale pair_qbs_probs = pq1: qbs_prob X α μ + pq2: qbs_prob Y β ν
  for X :: "'a quasi_borel" and α μ and Y :: "'b quasi_borel" and β ν
begin
sublocale pair_qbs_s_finites
  by standard
end

locale pair_qbs_s_finite = pq1: qbs_s_finite X α μ + pq2: qbs_s_finite X β ν
  for X :: "'a quasi_borel" and α μ and β ν
begin
sublocale pair_qbs_s_finites X α μ X β ν
  by standard
end

locale pair_qbs_prob = pq1: qbs_prob X α μ + pq2: qbs_prob X β ν
  for X :: "'a quasi_borel" and α μ and β ν
begin

sublocale pair_qbs_s_finite X α μ β ν
  by standard

sublocale pair_qbs_probs X α μ X β μ
  by standard

end

type_synonym 'a qbs_s_finite_t = "'a quasi_borel * (real  'a) * real measure"
definition qbs_s_finite_eq :: "['a qbs_s_finite_t, 'a qbs_s_finite_t]  bool" where
  "qbs_s_finite_eq p1 p2 
   (let (X, α, μ) = p1;
        (Y, β, ν) = p2 in
    qbs_s_finite X α μ  qbs_s_finite Y β ν  X = Y 
      distr μ (qbs_to_measure X) α = distr ν (qbs_to_measure Y) β)"

definition qbs_s_finite_eq' :: "['a qbs_s_finite_t, 'a qbs_s_finite_t]  bool" where
  "qbs_s_finite_eq' p1 p2 
   (let (X, α, μ) = p1;
        (Y, β, ν) = p2 in
    qbs_s_finite X α μ  qbs_s_finite Y β ν  X = Y 
      (fX Q (qbs_borel :: ennreal quasi_borel). (+x. f (α x) μ) = (+x. f (β x) ν)))"

lemma(in qbs_s_finite)
  shows qbs_s_finite_eq_refl[simp]: "qbs_s_finite_eq (X,α,μ) (X,α,μ)"
    and qbs_s_finite_eq'_refl[simp]: "qbs_s_finite_eq' (X,α,μ) (X,α,μ)"
  by(simp_all add: qbs_s_finite_eq_def qbs_s_finite_eq'_def qbs_s_finite_axioms)

lemma(in pair_qbs_s_finite) 
  shows qbs_s_finite_eq_intro: "distr μ (qbs_to_measure X) α = distr ν (qbs_to_measure X) β  qbs_s_finite_eq (X,α,μ) (X,β,ν)"
    and qbs_s_finite_eq'_intro: "(f. f  X Q qbs_borel  (+x. f (α x)  μ) = (+x. f (β x)  ν))  qbs_s_finite_eq' (X,α,μ) (X,β,ν)"
  by(simp_all add: qbs_s_finite_eq_def qbs_s_finite_eq'_def pq1.qbs_s_finite_axioms pq2.qbs_s_finite_axioms)

lemma qbs_s_finite_eq_dest:
  assumes "qbs_s_finite_eq (X,α,μ) (Y,β,ν)"
  shows "qbs_s_finite X α μ" "qbs_s_finite Y β ν" "Y = X" "distr μ (qbs_to_measure X) α = distr ν (qbs_to_measure X) β" 
  using assms by(auto simp: qbs_s_finite_eq_def)

lemma qbs_s_finite_eq'_dest:
  assumes "qbs_s_finite_eq' (X,α,μ) (Y,β,ν)"
  shows "qbs_s_finite X α μ" "qbs_s_finite Y β ν" "Y = X" "f. f  X Q qbs_borel  (+x. f (α x)  μ) = (+x. f (β x)  ν)"
  using assms by(auto simp: qbs_s_finite_eq'_def)

lemma(in qbs_prob) qbs_s_finite_eq_qbs_prob_cong:
  assumes "qbs_s_finite_eq (X,α,μ) (Y,β,ν)"
  shows "qbs_prob Y β ν"
proof -
  interpret qs: pair_qbs_s_finites X α μ Y β ν
    using assms(1) by(auto simp: qbs_s_finite_eq_def pair_qbs_s_finites_def)
  show ?thesis
    by(auto intro!: qs.pq2.qbs_probI prob_space_distrD[of β _ "qbs_to_measure Y"]) (auto simp: qbs_s_finite_eq_dest(3)[OF assms] qbs_s_finite_eq_dest(4)[OF assms,symmetric] intro!: prob_space_distr)
qed

lemma 
  shows qbs_s_finite_eq_symp: "symp qbs_s_finite_eq"
    and qbs_s_finite_eq_transp: "transp qbs_s_finite_eq"
  by(simp_all add: qbs_s_finite_eq_def transp_def symp_def)

quotient_type 'a qbs_measure = "'a qbs_s_finite_t" / partial: qbs_s_finite_eq
  morphisms rep_qbs_measure qbs_measure
proof(rule part_equivpI)
  let ?U = "UNIV :: 'a set"
  let ?Uf = "UNIV :: (real  'a) set"
  let ?f = "(λ_. undefined) :: real  'a"
  have "qbs_s_finite (Abs_quasi_borel (?U, ?Uf)) ?f (return borel 0)"
    unfolding qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def
  proof safe
    have "Rep_quasi_borel (Abs_quasi_borel (?U,?Uf)) = (?U, ?Uf)"
      using Abs_quasi_borel_inverse by (auto simp add: qbs_closed1_def qbs_closed2_def qbs_closed3_def is_quasi_borel_def)
    thus "(λ_. undefined)  qbs_Mx (Abs_quasi_borel (?U, ?Uf))"
      by(simp add: qbs_Mx_def)
  next
    show "s_finite_measure (return borel 0)"
      by(auto intro!: sigma_finite_measure.s_finite_measure prob_space_imp_sigma_finite prob_space_return)
  qed simp_all
  thus "x :: 'a qbs_s_finite_t. qbs_s_finite_eq x x"
    by(auto simp: qbs_s_finite_eq_def intro!: exI[where x="(Abs_quasi_borel (?U,?Uf), ?f, return borel 0)"])
qed(simp_all add: qbs_s_finite_eq_symp qbs_s_finite_eq_transp)

interpretation qbs_measure : quot_type "qbs_s_finite_eq" "Abs_qbs_measure" "Rep_qbs_measure"
  using Abs_qbs_measure_inverse Rep_qbs_measure
  by(simp add: quot_type_def equivp_implies_part_equivp qbs_measure_equivp Rep_qbs_measure_inverse Rep_qbs_measure_inject) blast

syntax
 "_qbs_measure" :: "'a quasi_borel  (real  'a)  real measure  'a qbs_measure" ("_,/ _,/ _sfin")
translations
 "X, α, μsfin"  "CONST qbs_measure (X, α, μ)"

lemma rep_qbs_s_finite_measure': "X α μ. p = X, α, μsfin  qbs_s_finite X α μ"
  by(rule qbs_measure.abs_induct,auto simp add: qbs_s_finite_eq_def)

lemma rep_qbs_s_finite_measure:
  obtains X α μ where "p = X, α, μsfin" "qbs_s_finite X α μ"
  using that rep_qbs_s_finite_measure' by blast

definition qbs_null_measure :: "'a quasi_borel  'a qbs_measure" where
"qbs_null_measure X  X, SOME a. a  qbs_Mx X, null_measure borelsfin"

lemma qbs_null_measure_s_finite: "qbs_space X  {}  qbs_s_finite X (SOME a. a  qbs_Mx X) (null_measure borel)"
  by(auto simp: qbs_empty_equiv qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def some_in_eq intro!: finite_measure.s_finite_measure_finite_measure finite_measureI)

lemma(in qbs_s_finite) in_Rep_qbs_measure':
  assumes "qbs_s_finite_eq (X,α,μ) (X',α',μ')"
  shows "(X',α',μ')  Rep_qbs_measure X, α, μsfin"
  by (metis assms mem_Collect_eq qbs_s_finite_eq_refl qbs_measure_def qbs_measure.abs_def qbs_measure.abs_inverse)

lemmas(in qbs_s_finite) in_Rep_qbs_measure = in_Rep_qbs_measure'[OF qbs_s_finite_eq_refl]

lemma(in qbs_s_finite) if_in_Rep_qbs_measure:
  assumes "(X',α',μ')  Rep_qbs_measure X, α, μsfin"
  shows "X' = X"
        "qbs_s_finite X' α' μ'"
        "qbs_s_finite_eq (X,α,μ) (X',α',μ')"
proof -
  show h:"X' = X"
    using assms qbs_measure.Rep_qbs_measure[of "X, α, μsfin"]
    by auto (metis mem_Collect_eq qbs_s_finite_eq_dest(3) qbs_s_finite_eq_refl qbs_measure_def qbs_measure.abs_def qbs_measure.abs_inverse)
next
  show "qbs_s_finite X' α' μ'"
    using assms qbs_measure.Rep_qbs_measure[of "X, α, μsfin"]
    by (auto simp: qbs_s_finite_eq_dest(2))
next
  show "qbs_s_finite_eq (X,α,μ) (X',α',μ')"
    using assms qbs_measure.Rep_qbs_measure[of "X, α, μsfin"]
    by auto (metis mem_Collect_eq qbs_s_finite_eq_dest(3) qbs_s_finite_eq_refl qbs_measure_def qbs_measure.abs_def qbs_measure.abs_inverse)
qed

lemma qbs_s_finite_eq_1_imp_2:
  assumes "qbs_s_finite_eq (X,α,μ) (Y,β,ν)" "f  X Q (qbs_borel :: (_ :: {banach}) quasi_borel)"
  shows "(x. f (α x) μ) = (x. f (β x) ν)" (is "?lhs = ?rhs")
proof -
 interpret pq : pair_qbs_s_finite X α μ β ν
   using assms by(auto intro!: pair_qbs_s_finite.intro simp: qbs_s_finite_eq_def)
  have [measurable]: "f  qbs_to_measure X M borel"
    using assms  by(simp add: lr_adjunction_correspondence)
  have "?lhs = (x. f x (distr μ (qbs_to_measure X) α))"
    by(simp add: integral_distr)
  also have "... = (x. f x (distr ν (qbs_to_measure X) β))"
    by(simp add: qbs_s_finite_eq_dest(4)[OF assms(1)])
  also have "... = ?rhs"
    by(simp add: integral_distr)
  finally show ?thesis .
qed

lemma qbs_s_finite_eq_equiv: "qbs_s_finite_eq = qbs_s_finite_eq'"
proof(rule ext[OF ext])
  show "a b :: 'a qbs_s_finite_t. qbs_s_finite_eq a b = qbs_s_finite_eq' a b"
  proof safe
    fix X Y :: "'a quasi_borel" and α β μ ν
    {
      assume h:"qbs_s_finite_eq (X,α,μ) (Y,β,ν)"
      then interpret pq : pair_qbs_s_finite X α μ β ν
        by(auto intro!: pair_qbs_s_finite.intro simp: qbs_s_finite_eq_def)
      show "qbs_s_finite_eq' (X,α,μ) (Y,β,ν)"
        unfolding qbs_s_finite_eq_dest(3)[OF h]
      proof(rule pq.qbs_s_finite_eq'_intro)
        fix f :: "'a  ennreal"
        assume f:"f  X Q qbs_borel"
        show "(+ x. f (α x) μ) = (+ x. f (β x) ν)" (is "?lhs = ?rhs")
        proof -
          have "?lhs = (+ x. f x (distr μ (qbs_to_measure X) α))"
            by(rule nn_integral_distr[symmetric]) (use f lr_adjunction_correspondence in auto)
          also have "... = (+ x. f x (distr ν (qbs_to_measure X) β))"
            by(simp add: qbs_s_finite_eq_dest(4)[OF h])
          also have "... = ?rhs"
            by(rule nn_integral_distr) (use f lr_adjunction_correspondence in auto)
          finally show ?thesis .
        qed
      qed
    }
    {
      assume h:"qbs_s_finite_eq' (X,α,μ) (Y,β,ν)"
      then interpret pq : pair_qbs_s_finite X α μ β ν
        by(auto intro!: pair_qbs_s_finite.intro simp: qbs_s_finite_eq'_def)
      show "qbs_s_finite_eq (X,α,μ) (Y,β,ν)"
        unfolding qbs_s_finite_eq'_dest(3)[OF h]
      proof(rule pq.qbs_s_finite_eq_intro[OF measure_eqI])
        fix U
        assume hu[measurable]:"U  sets (distr μ (qbs_to_measure X) α)"
        show "emeasure (distr μ (qbs_to_measure X) α) U = emeasure (distr ν (qbs_to_measure X) β) U"
             (is "?lhs = ?rhs")
        proof -
          have "?lhs = (+ x. indicator U x  (distr μ (qbs_to_measure X) α))"
            using hu by simp
          also have "... = (+ x. indicator U (α x) μ)"
            by(rule nn_integral_distr) (use hu in auto)
          also have "... = (+ x. indicator U (β x) ν)"
            by(auto intro!: qbs_s_finite_eq'_dest(4)[OF h] simp: lr_adjunction_correspondence)
          also have "... = (+ x. indicator U x  (distr ν (qbs_to_measure X) β))"
            by(rule nn_integral_distr[symmetric]) (use hu in auto)
          also have "... = ?rhs"
            using hu by simp
          finally show ?thesis .
        qed
      qed simp
    }
  qed
qed

lemma qbs_s_finite_measure_eq: "qbs_s_finite_eq (X,α,μ) (Y,β,ν)  X, α, μsfin = Y, β, νsfin"
  using Quotient3_rel[OF Quotient3_qbs_measure] by blast

lemma(in pair_qbs_s_finite) qbs_s_finite_measure_eq:
  "distr μ (qbs_to_measure X) α = distr ν (qbs_to_measure X) β  X, α, μsfin = X, β, νsfin"
  by(auto intro!: qbs_s_finite_measure_eq qbs_s_finite_eq_intro)

lemma(in pair_qbs_s_finite) qbs_s_finite_measure_eq':
  "(f. f  X Q qbs_borel  (+x. f (α x)  μ) = (+x. f (β x)  ν))  X, α, μsfin = X, β, νsfin"
  using qbs_s_finite_eq'_intro[simplified qbs_s_finite_eq_equiv[symmetric]] by(auto intro!: qbs_s_finite_measure_eq simp: qbs_s_finite_eq_def)

lemma(in pair_qbs_s_finite) qbs_s_finite_measure_eq_inverse:
  assumes "X, α, μsfin = X, β, νsfin"
  shows "qbs_s_finite_eq (X,α,μ) (X,β,ν)" "qbs_s_finite_eq' (X,α,μ) (X,β,ν)"
  using Quotient3_rel[OF Quotient3_qbs_measure,of "(X,α,μ)" "(X,β,ν)",simplified]
  by(simp_all add: assms qbs_s_finite_eq_equiv)

lift_definition qbs_space_of :: "'a qbs_measure  'a quasi_borel"
is fst by(auto simp: qbs_s_finite_eq_def)

lemma(in qbs_s_finite) qbs_space_of[simp]:
 "qbs_space_of X, α, μsfin = X" by(simp add: qbs_space_of.abs_eq)

lemma rep_qbs_space_of:
  assumes "qbs_space_of s = X"
  shows "α μ. s = X, α, μsfin  qbs_s_finite X α μ"
proof -
  obtain X' α μ where hs:
   "s =  X', α, μsfin" "qbs_s_finite X' α μ"
    using rep_qbs_s_finite_measure'[of s] by auto
  then interpret qs:qbs_s_finite X' α μ
    by simp
  show ?thesis
    using assms hs(2) by(auto simp add: hs(1))
qed

corollary qbs_s_space_of_not_empty: "qbs_space (qbs_space_of X)  {}"
  by transfer (auto simp: qbs_s_finite_eq_def qbs_s_finite_def in_Mx_def qbs_empty_equiv)


subsubsection ‹ The S-Finite Measure Monad›
definition monadM_qbs :: "'a quasi_borel  'a qbs_measure quasi_borel" where
"monadM_qbs X  Abs_quasi_borel ({s. qbs_space_of s = X}, {λr. X, α, k rsfin |α k. α  qbs_Mx X  s_finite_kernel borel borel k})"

lemma
  shows monadM_qbs_space: "qbs_space (monadM_qbs X) = {s. qbs_space_of s = X}"
    and monadM_qbs_Mx: "qbs_Mx (monadM_qbs X) = {λr. X, α, k rsfin |α k. α  qbs_Mx X  s_finite_kernel borel borel k}"
proof -
  have "{λr::real. X, α, k rsfin |α k. α  qbs_Mx X  s_finite_kernel borel borel k}  UNIV  {s. qbs_space_of s = X}"
  proof safe
    fix x α and k :: "real  real measure"
    assume h:"α  qbs_Mx X" "s_finite_kernel borel borel k"
    interpret k:s_finite_kernel borel borel k by fact
    interpret qbs_s_finite X α "k x"
      using k.image_s_finite_measure h(1) by(auto simp: qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def k.kernel_sets) 
    show "qbs_space_of X, α, k xsfin = X"
      by simp
  qed
  moreover have "qbs_closed1 {λr. X, α, k rsfin |α k. α  qbs_Mx X  s_finite_kernel borel borel k}"
  proof(safe intro!: qbs_closed1I)
    fix α and f :: "real  real" and k :: "real real measure"
    assume h:"f  borel_measurable borel" "α  qbs_Mx X" "s_finite_kernel borel borel k"
    then show "α' ka. (λr. X, α, k rsfin)  f = (λr. X, α', ka rsfin)  α'  qbs_Mx X  s_finite_kernel borel borel ka"
      by(auto intro!: exI[where x=α] exI[where x="λx. k (f x)"] simp: s_finite_kernel.comp_measurable[OF h(3,1)])
  qed
  moreover have "qbs_closed2 {s. qbs_space_of s = X} {λr. X, α, k rsfin |α k. α  qbs_Mx X  s_finite_kernel borel borel k}"
  proof(safe intro!: qbs_closed2I)
    fix s
    assume h:"X = qbs_space_of s"
    from rep_qbs_space_of[OF this[symmetric]] obtain α μ where s:"s = X, α, μsfin" "qbs_s_finite X α μ"
      by auto
    then interpret qbs_s_finite X α μ by simp
    show "α k. (λr. s) = (λr. qbs_space_of s, α, k rsfin)  α  qbs_Mx (qbs_space_of s)  s_finite_kernel borel borel k"
      by(auto intro!: exI[where x=α] exI[where x="λr. μ"] s_finite_kernel_const simp: s(1) s_finite_kernel_cong_sets[OF _ mu_sets[symmetric]] sets_eq_imp_space_eq[OF mu_sets])
  qed
  moreover have "qbs_closed3 {λr. X, α, k rsfin |α k. α  qbs_Mx X  s_finite_kernel borel borel k}"
  proof(safe intro!: qbs_closed3I)
    fix P :: "real  nat" and Fi :: "nat  _"
    assume P[measurable]: "P  borel M count_space UNIV"
       and "i. Fi i  {λr::real. X, α, k rsfin |α k. α  qbs_Mx X  s_finite_kernel borel borel k}"
    then obtain αi ki where Fi: "i. Fi i = (λr. X, αi i, ki i rsfin)" "i. αi i  qbs_Mx X" "i. s_finite_kernel borel borel (ki i)"
      by auto metis
    interpret nat_real: standard_borel_ne "count_space (UNIV :: nat set) M (borel :: real measure)"
      by(auto intro!: pair_standard_borel_ne)
    note [simp] = nat_real.from_real_to_real[simplified space_pair_measure, simplified]
    define α where "α  (λr. case_prod αi (nat_real.from_real r))"
    define k where "k  (λr. distr (distr (ki (P r) r) (count_space UNIV M borel) (λr'. (P r, r'))) borel nat_real.to_real)"
    have α: "α  qbs_Mx X"
      unfolding α_def qbs_Mx_is_morphisms
    proof(rule qbs_morphism_compose[where g=nat_real.from_real and Y="qbs_count_space UNIV Q qbs_borel"])
      show "nat_real.from_real  qbs_borel Q qbs_count_space UNIV Q qbs_borel"
        by(simp add: r_preserves_product[symmetric] standard_borel.standard_borel_r_full_faithful[of "borel :: real measure",simplified,symmetric] standard_borel_ne.standard_borel)
    next
      show "case_prod αi  qbs_count_space UNIV Q qbs_borel Q X"
        using Fi(2) by(auto intro!: qbs_morphism_pair_count_space1 simp: qbs_Mx_is_morphisms)
    qed
    have sets_ki[measurable_cong]: "sets (ki i r) = sets borel" "sets (k r) = sets borel" for i r
      using Fi(3) by(auto simp: s_finite_kernel_def measure_kernel_def k_def)
    interpret k:s_finite_kernel borel borel k
    proof -
      have 1:"k = (λ(i,r). distr (ki i r) borel (λr'. nat_real.to_real (i, r')))  (λr. (P r, r))"
        by standard (auto simp: k_def distr_distr comp_def)
      have "s_finite_kernel borel borel ..."
        unfolding comp_def
        by(rule s_finite_kernel.comp_measurable[where X="count_space UNIV M borel"],rule s_finite_kernel_pair_countble1, auto intro!: s_finite_kernel.distr_s_finite_kernel[OF Fi(3)])
      thus "s_finite_kernel borel borel k" by(simp add: 1)
    qed
    have "(λr. Fi (P r) r) = (λr. X, α, k r sfin)"
      unfolding Fi(1)
    proof
      fix r
      interpret pq:pair_qbs_s_finite X "αi (P r)" "ki (P r) r" α "k r"
        by(auto simp: pair_qbs_s_finite_def qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def k.image_s_finite_measure s_finite_kernel.image_s_finite_measure[OF Fi(3)] sets_ki α Fi(2))
      show "X, αi (P r), ki (P r) rsfin = X, α, k rsfin"
        by(rule pq.qbs_s_finite_measure_eq, simp add: k_def distr_distr comp_def,simp add: α_def)
    qed
    thus "α k. (λr. Fi (P r) r) = (λr. X, α, k rsfin)  α  qbs_Mx X  s_finite_kernel borel borel k"
      by(auto intro!: exI[where x=α] exI[where x=k] simp: α k.s_finite_kernel_axioms)
  qed
  ultimately have "Rep_quasi_borel (monadM_qbs X) = ({s. qbs_space_of s = X}, {λr. X, α, k rsfin |α k. α  qbs_Mx X  s_finite_kernel borel borel k})"
    by(auto intro!: Abs_quasi_borel_inverse  simp: monadM_qbs_def is_quasi_borel_def)
  thus "qbs_space (monadM_qbs X) = {s. qbs_space_of s = X}" "qbs_Mx (monadM_qbs X) = {λr. X, α, k rsfin |α k. α  qbs_Mx X  s_finite_kernel borel borel k}"
    by(simp_all add: qbs_space_def qbs_Mx_def)
qed

lemma monadM_qbs_empty_iff: "qbs_space X = {}  qbs_space (monadM_qbs X) = {}"
  by(auto simp: monadM_qbs_space qbs_s_space_of_not_empty) (meson in_Mx.intro qbs_closed2_dest qbs_s_finite.qbs_space_of qbs_s_finite_def rep_qbs_s_finite_measure')

lemma(in qbs_s_finite) in_space_monadM[qbs]: "X, α, μsfin  qbs_space (monadM_qbs X)"
  by(simp add: monadM_qbs_space)

lemma rep_qbs_space_monadM:
  assumes "s  qbs_space (monadM_qbs X)"
  obtains α μ where "s = X, α, μsfin" "qbs_s_finite X α μ"
  using rep_qbs_space_of assms that by(auto simp: monadM_qbs_space)

lemma rep_qbs_space_monadM_sigma_finite:
  assumes "s  qbs_space (monadM_qbs X)"
  obtains α μ where "s = X, α, μsfin" "qbs_s_finite X α μ" "sigma_finite_measure μ"
proof -
  obtain α μ where s:"s = X, α, μsfin" "qbs_s_finite X α μ"
    by(metis rep_qbs_space_monadM assms)
  hence "standard_borel_ne μ""s_finite_measure μ"
    by(auto intro!: standard_borel_ne_sets[of borel μ] simp: qbs_s_finite_def qbs_s_finite_axioms_def)
  from exists_push_forward[OF this] obtain μ' f where f:
    "f  (borel :: real measure) M μ" "sets μ' = sets borel" "sigma_finite_measure μ'" "distr μ' μ f = μ"
    by metis
  hence [measurable]: "f  borel_measurable borel"
    using s(2) by(auto simp: qbs_s_finite_def qbs_s_finite_axioms_def cong: measurable_cong_sets)
  interpret pair_qbs_s_finite X α μ "α  f" μ'
  proof -
    have "qbs_s_finite X (α  f) μ'"
      using s(2) by(auto simp: qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def[of μ'] f(2,3) sigma_finite_measure.s_finite_measure)
    thus "pair_qbs_s_finite X α μ (α  f) μ'"
      by(auto simp: pair_qbs_s_finite_def s(2))
  qed
  have "X, α, μsfin = X, α  f, μ'sfin"
  proof -
    have [simp]:" distr μ (qbs_to_measure X) α = distr (distr μ' μ f) (qbs_to_measure X) α"
      by(simp add: f(4))
    show ?thesis
      by(auto intro!: qbs_s_finite_measure_eq simp: distr_distr)
  qed
  with s(1) pq2.qbs_s_finite_axioms f(3) that
  show ?thesis by metis
qed

lemma qbs_space_of_in: "s  qbs_space (monadM_qbs X)  qbs_space_of s = X"
  by(simp add: monadM_qbs_space)

lemma in_qbs_space_of: "s  qbs_space (monadM_qbs (qbs_space_of s))"
  by(simp add: monadM_qbs_space)

subsubsection ‹ $l$ ›
lift_definition qbs_l :: "'a qbs_measure  'a measure"
is "λp. distr (snd (snd p)) (qbs_to_measure (fst p)) (fst (snd p))"
  by(auto simp: qbs_s_finite_eq_def)

lemma(in qbs_s_finite) qbs_l: "qbs_l X, α, μsfin  = distr μ (qbs_to_measure X) α"
  by(simp add: qbs_l.abs_eq)

interpretation qbs_l_s_finite: s_finite_measure "qbs_l (s :: 'a qbs_measure)"
proof(transfer)
  show "s:: 'a qbs_s_finite_t. qbs_s_finite_eq s s  s_finite_measure (distr (snd (snd s)) (qbs_to_measure (fst s)) (fst (snd s)))"
  proof safe
    fix X :: "'a quasi_borel"
    fix α μ
    assume "qbs_s_finite_eq (X,α,μ) (X,α,μ)"
    then interpret qbs_s_finite X α μ
      by(simp add: qbs_s_finite_eq_def)
    show "s_finite_measure (distr (snd (snd (X,α,μ))) (qbs_to_measure (fst (X,α,μ))) (fst (snd (X,α,μ))))"
      by(auto intro!: s_finite_measure.s_finite_measure_distr simp: s_finite_measure_axioms)
  qed
qed

lemma space_qbs_l: "qbs_space (qbs_space_of s) = space (qbs_l s)"
  by(transfer, auto simp: space_L)

lemma space_qbs_l_ne: "space (qbs_l s)  {}"
  by transfer (auto simp: qbs_s_finite_eq_def qbs_s_finite_def in_Mx_def space_L qbs_empty_equiv)

lemma qbs_l_sets: "sets (qbs_to_measure (qbs_space_of s)) = sets (qbs_l s)"
  by(transfer,simp)

lemma qbs_null_measure_in_Mx: "qbs_space X  {}  qbs_null_measure X  qbs_space (monadM_qbs X)"
  by(simp add: qbs_s_finite.in_space_monadM[OF qbs_null_measure_s_finite] qbs_null_measure_def)

lemma qbs_null_measure_null_measure:"qbs_space X  {}  qbs_l (qbs_null_measure X) = null_measure (qbs_to_measure X)"
  by(auto simp: qbs_null_measure_def qbs_s_finite.qbs_l[OF qbs_null_measure_s_finite] null_measure_distr)

lemma space_qbs_l_in:
  assumes "s  qbs_space (monadM_qbs X)"
  shows "space (qbs_l s) = qbs_space X"
  by (metis assms qbs_s_finite.qbs_space_of rep_qbs_space_monadM space_qbs_l)

lemma sets_qbs_l:
  assumes "s  qbs_space (monadM_qbs X)"
  shows "sets (qbs_l s) = sets (qbs_to_measure X)"
  using assms qbs_l_sets qbs_space_of_in by blast

lemma measurable_qbs_l:
  assumes "s  qbs_space (monadM_qbs X)"
  shows "qbs_l s M M = X Q measure_to_qbs M"
  by(auto simp: measurable_cong_sets[OF qbs_l_sets[of s,simplified qbs_space_of_in[OF assms(1)],symmetric] refl] lr_adjunction_correspondence)

lemma measurable_qbs_l':
  assumes "s  qbs_space (monadM_qbs X)"
  shows "qbs_l s M M = qbs_to_measure X M M"
  by(simp add: measurable_qbs_l[OF assms] lr_adjunction_correspondence)

lemma rep_qbs_Mx_monadM:
  assumes "γ  qbs_Mx (monadM_qbs X)"
  obtains α k where "γ = (λr. X, α, k rsfin)" "α  qbs_Mx X" "s_finite_kernel borel borel k" "r. qbs_s_finite X α (k r)"
proof -
  have "α r k. α  qbs_Mx X  s_finite_kernel borel borel k  qbs_s_finite X α (k r)"
    by(auto simp: qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def s_finite_kernel.image_s_finite_measure) (auto simp: s_finite_kernel_def measure_kernel_def)
  thus ?thesis
    using that assms by(fastforce simp: monadM_qbs_Mx)
qed

lemma qbs_l_measurable[measurable]:"qbs_l  qbs_to_measure (monadM_qbs X) M s_finite_measure_algebra (qbs_to_measure X)"
proof(rule qbs_morphism_dest[OF qbs_morphismI])
  fix γ
  assume "γ  qbs_Mx (monadM_qbs X)"
  from rep_qbs_Mx_monadM[OF this] obtain α k where h:
  "γ = (λr. X, α, k rsfin)" "α  qbs_Mx X" "s_finite_kernel borel borel k" "r. qbs_s_finite X α (k r)"
    by metis
  show "qbs_l  γ  qbs_Mx (measure_to_qbs (s_finite_measure_algebra (qbs_to_measure X)))"
    by(auto simp add: qbs_Mx_R comp_def h(1) qbs_s_finite.qbs_l[OF h(4)] h(2,3) intro!: s_finite_kernel.kernel_measurable_s_finite s_finite_kernel.distr_s_finite_kernel[where Y=borel])
qed

lemma qbs_l_measure_kernel: "measure_kernel (qbs_to_measure (monadM_qbs X)) (qbs_to_measure X) qbs_l"
proof(cases "qbs_space X = {}")
  case True
  with monadM_qbs_empty_iff[of X,simplified this] show ?thesis
    by(auto intro!: measure_kernel_empty_trivial simp: space_L) 
next
  case 1:False
  show ?thesis
  proof
    show "x. x  space (qbs_to_measure (monadM_qbs X))  sets (qbs_l x) = sets (qbs_to_measure X)"
      using qbs_l_sets by(auto simp: space_L monadM_qbs_space)
  next
    show "space (qbs_to_measure X)  {}"
      by(simp add: space_L 1)
  qed (rule measurable_emeasure_kernel_s_finite_measure_algebra[OF qbs_l_measurable])
qed

lemma qbs_l_inj: "inj_on qbs_l (qbs_space (monadM_qbs X))"
  by standard (auto simp: monadM_qbs_space, transfer,auto simp: qbs_s_finite_eq_def)

lemma qbs_l_morphism:
  assumes [measurable]:"A  sets (qbs_to_measure X)"
  shows "(λs. qbs_l s A)  monadM_qbs X Q qbs_borel"
proof(rule qbs_morphismI)
  fix γ
  assume h:"γ  qbs_Mx (monadM_qbs X)" 
  hence [qbs]: "γ  qbs_borel Q monadM_qbs X"
    by(simp_all add: qbs_Mx_is_morphisms)
  from rep_qbs_Mx_monadM[OF h(1)] obtain α k where hk:
   "γ = (λr. X, α, k rsfin)" "α  qbs_Mx X" "s_finite_kernel borel borel k" "r. qbs_s_finite X α (k r)"
    by metis
  then interpret a: in_Mx X α by(simp add: in_Mx_def)
  have k[measurable_cong]:"sets (k r) = sets borel" for r
    using hk(3) by(auto simp: s_finite_kernel_def measure_kernel_def)
  show "(λs. emeasure (qbs_l s) A)  γ  qbs_Mx qbs_borel"
    by(auto simp: hk(1) qbs_s_finite.qbs_l[OF hk(4)] comp_def qbs_Mx_qbs_borel emeasure_distr sets_eq_imp_space_eq[OF k] intro!: s_finite_kernel.emeasure_measurable'[OF hk(3)] measurable_sets_borel[OF _ assms])
qed

lemma qbs_l_finite_pred: "qbs_pred (monadM_qbs X) (λs. finite_measure (qbs_l s))"
proof -
  have "qbs_space X  sets (qbs_to_measure X)"
    by (metis sets.top space_L)
  note qbs_l_morphism[OF this,qbs]
  have [simp]:"finite_measure (qbs_l s)  qbs_l s X  " if "s  monadM_qbs X" for s
    by(auto intro!: finite_measureI dest: finite_measure.emeasure_finite simp: space_qbs_l_in[OF that])
  show ?thesis
    by(simp cong: qbs_morphism_cong)
qed

lemma qbs_l_subprob_pred: "qbs_pred (monadM_qbs X) (λs. subprob_space (qbs_l s))"
proof -
  have "qbs_space X  sets (qbs_to_measure X)"
    by (metis sets.top space_L)
  note qbs_l_morphism[OF this,qbs]
  have [simp]:"subprob_space (qbs_l s)  qbs_l s X  1" if "s  monadM_qbs X" for s  
    by(auto intro!: subprob_spaceI dest: subprob_space.subprob_emeasure_le_1 simp: space_qbs_l_ne) (simp add: space_qbs_l_in[OF that])
  show ?thesis
    by(simp cong: qbs_morphism_cong)
qed

lemma qbs_l_prob_pred: "qbs_pred (monadM_qbs X) (λs. prob_space (qbs_l s))"
proof -
  have "qbs_space X  sets (qbs_to_measure X)"
    by (metis sets.top space_L)
  note qbs_l_morphism[OF this,qbs]
  have [simp]:"prob_space (qbs_l s)  qbs_l s X = 1" if "s  monadM_qbs X" for s  
    by(auto intro!: prob_spaceI simp: space_qbs_l_ne) (auto simp add: space_qbs_l_in[OF that] dest: prob_space.emeasure_space_1)
  show ?thesis
    by(simp cong: qbs_morphism_cong)
qed

subsubsection ‹ Return ›
definition return_qbs :: "'a quasi_borel  'a  'a qbs_measure" where
"return_qbs X x  X, λr. x, SOME μ. real_distribution μsfin"

lemma(in real_distribution)
  assumes "x  qbs_space X"
  shows return_qbs:"return_qbs X x = X, λr. x, Msfin"
    and return_qbs_prob:"qbs_prob X (λr. x) M"
    and return_qbs_s_finite:"qbs_s_finite X (λr. x) M"
proof -
  interpret qs1: qbs_prob X "λr. x" M
    by(auto simp: qbs_prob_def in_Mx_def real_distribution_axioms intro!: qbs_closed2_dest assms)
  show "return_qbs X x = X, λr. x, Msfin"
    unfolding return_qbs_def
  proof(rule someI2)
    show "real_distribution (return borel 0)" by (auto simp: real_distribution_def real_distribution_axioms_def,rule prob_space_return) simp
  next
    fix N
    assume "real_distribution N"
    then interpret qs2: qbs_s_finite X "λr. x" N
      by(auto simp: qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def real_distribution_def  real_distribution_axioms_def intro!: qbs_closed2_dest assms sigma_finite_measure.s_finite_measure prob_space_imp_sigma_finite)
    interpret pair_qbs_s_finite X "λr. x" N "λr. x" M
      by standard
    show "X, λr. x, Nsfin = X, λr. x, Msfin"
      by(auto intro!: qbs_s_finite_measure_eq measure_eqI simp: emeasure_distr) (metis real_distribution N emeasure_space_1 prob_space.emeasure_space_1 qs2.mu_sets real_distribution.axioms(1) sets_eq_imp_space_eq space_borel space_eq_univ)
  qed
  show "qbs_prob X (λr. x) M" "qbs_s_finite X (λr. x) M"
    by(simp_all add: qs1.qbs_prob_axioms qs1.qbs_s_finite_axioms)
qed

lemma return_qbs_comp:
  assumes "α  qbs_Mx X"
  shows "(return_qbs X  α) = (λr. X, α, return borel rsfin)"
proof
  fix r
  interpret pqp: pair_qbs_prob X "λk. α r" "return borel 0" α "return borel r"
    by(simp add: assms qbs_Mx_to_X[OF assms] pair_qbs_prob_def qbs_prob_def in_Mx_def real_distribution_def real_distribution_axioms_def prob_space_return)
  show "(return_qbs X  α) r = X, α, return borel rsfin"
    by(auto simp: pqp.pq1.return_qbs[OF qbs_Mx_to_X[OF assms]] distr_return intro!: pqp.qbs_s_finite_measure_eq)
qed

corollary return_qbs_morphism[qbs]: "return_qbs X  X Q monadM_qbs X"
proof(rule qbs_morphismI)
  interpret rr : real_distribution "return borel 0"
    by(simp add: real_distribution_def real_distribution_axioms_def prob_space_return)
  fix α
  assume h:"α  qbs_Mx X"
  then have 1:"return_qbs X  α = (λr. X, α, return borel rsfin)"
    by(rule return_qbs_comp)
  show "return_qbs X  α  qbs_Mx (monadM_qbs X)"
    by(auto simp: 1 monadM_qbs_Mx h prob_kernel_def' intro!: exI[where x=α] exI[where x="return borel"] prob_kernel.s_finite_kernel_prob_kernel)
qed

subsubsection ‹Bind›
definition bind_qbs :: "['a qbs_measure, 'a  'b qbs_measure]  'b qbs_measure" where
"bind_qbs s f  (let (X, α, μ) = rep_qbs_measure s;
                      Y = qbs_space_of (f (α undefined));
                      (β, k) = (SOME (β, k). f  α = (λr. Y, β, k rsfin)  β  qbs_Mx Y  s_finite_kernel borel borel k) in
                      Y, β, μ k ksfin)"

adhoc_overloading Monad_Syntax.bind bind_qbs

lemma(in qbs_s_finite)
  assumes "s = X, α, μsfin"
          "f  X Q monadM_qbs Y"
          "β  qbs_Mx Y"
          "s_finite_kernel borel borel k"
      and "(f  α) = (λr. Y, β, k rsfin)"
    shows bind_qbs_s_finite:"qbs_s_finite Y β (μ k k)"
      and bind_qbs: "s  f = Y, β, μ k ksfin"
proof -
  interpret k: s_finite_kernel borel borel k by fact
  interpret s_fin: qbs_s_finite Y β "μ k k"
    by(auto simp: qbs_s_finite_def in_Mx_def assms(3) mu_sets qbs_s_finite_axioms_def k.sets_bind_kernel[OF _ mu_sets] intro!:k.comp_s_finite_measure s_finite_measure_axioms)
  show "s  f = Y, β, μ k ksfin"
  proof -
    {
      fix X' α' μ'
      assume "(X',α',μ')  Rep_qbs_measure X, α, μsfin"
      then have h: "X' = X" "qbs_s_finite X' α' μ'" "qbs_s_finite_eq (X,α,μ) (X',α',μ')"
        by(simp_all add: if_in_Rep_qbs_measure)
      then interpret s_fin_pq1: pair_qbs_s_finite X α μ α' μ'
        by(auto simp: pair_qbs_s_finite_def qbs_s_finite_axioms)
      have [simp]: "qbs_space_of (f (α' r)) = Y" for r
        using qbs_Mx_to_X[OF qbs_morphism_Mx[OF assms(2) s_fin_pq1.pq2.in_Mx],of r]
        by(auto simp: monadM_qbs_space)
      have "(let Y = qbs_space_of (f (α' undefined)) in case SOME (β, k). (λr. f (α' r)) = (λr. Y, β, k rsfin)  β  qbs_Mx Y  s_finite_kernel borel borel k of
             (β, k)  Y, β, μ' k ksfin) = Y, β, μ k ksfin"
      proof -
        have "(case SOME (β, k). (λr. f (α' r)) = (λr. Y, β, k rsfin)  β  qbs_Mx Y  s_finite_kernel borel borel k of (β, k)  Y, β, μ' k ksfin) = Y, β, μ k ksfin"
        proof(rule someI2_ex)
          show "a. case a of (β, k)  (λr. f (α' r)) = (λr. Y, β, k rsfin)  β  qbs_Mx Y  s_finite_kernel borel borel k"
            using qbs_morphism_Mx[OF assms(2) s_fin_pq1.pq2.in_Mx]
            by(auto simp: comp_def monadM_qbs_Mx)
        next
          show "x. (case x of (β, k)  (λr. f (α' r)) = (λr. Y, β, k rsfin)  β  qbs_Mx Y  s_finite_kernel borel borel k)  (case x of (β, k)  Y, β, μ' k ksfin) = Y, β, μ k ksfin"
          proof safe
            fix β' k'
            assume h':"(λr. f (α' r)) = (λr. Y, β', k' rsfin)" "β'  qbs_Mx Y" "s_finite_kernel borel borel k'"
            interpret k': s_finite_kernel borel borel k' by fact
            have "qbs_s_finite Y β' (μ' k k')"
              by(auto simp: qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def h'(2) k'.sets_bind_kernel[OF _ s_fin_pq1.pq2.mu_sets] s_fin_pq1.pq2.mu_sets intro!:k'.comp_s_finite_measure s_fin_pq1.pq2.s_finite_measure_axioms)
            then interpret s_fin_pq2: pair_qbs_s_finite Y β' "μ' k k'" β "μ k k"
              by(auto simp: pair_qbs_s_finite_def s_fin.qbs_s_finite_axioms)
            show "Y, β', μ' k k'sfin = Y, β, μ k ksfin"
            proof(rule s_fin_pq2.qbs_s_finite_measure_eq)
              show "distr (μ' k k') (qbs_to_measure Y) β' = distr (μ k k) (qbs_to_measure Y) β" (is "?lhs = ?rhs")
              proof -
                have "?lhs = μ' k (λr. distr (k' r) (qbs_to_measure Y) β')"
                  by(simp add: k'.distr_bind_kernel[OF _ s_fin_pq1.pq2.mu_sets])
                also have "... = μ' k (λr. qbs_l Y, β', k' rsfin)"
                  by(rule bind_kernel_cong_All,rule qbs_s_finite.qbs_l[symmetric,OF qbs_s_finite_All[where k=k' and M=borel]]) (auto simp: k'.s_finite_kernel_axioms)
                also have "... = μ' k (λr. qbs_l (f (α' r)))"
                  by(auto simp: fun_cong[OF h'(1)])
                also have "... = distr μ' (qbs_to_measure X) α' k (λx. qbs_l (f x))"
                  by(simp add: measure_kernel.bind_kernel_distr[OF measure_kernel.measure_kernel_comp[OF qbs_l_measure_kernel set_mp[OF l_preserves_morphisms assms(2)]]] sets_eq_imp_space_eq[OF s_fin_pq1.pq2.mu_sets])
                also have "... = distr μ (qbs_to_measure X) α k (λx. qbs_l (f x))"
                  by(simp add: qbs_s_finite_eq_dest(4)[OF h(3)])
                also have "... = μ k (λr. qbs_l (f (α r)))"
                  by(simp add: measure_kernel.bind_kernel_distr[OF measure_kernel.measure_kernel_comp[OF qbs_l_measure_kernel set_mp[OF l_preserves_morphisms assms(2)]]] sets_eq_imp_space_eq[OF mu_sets])
                also have "... = μ k (λr. qbs_l Y, β, k rsfin)"
                  by(simp add: fun_cong[OF assms(5),simplified comp_def])
                also have "... = μ k (λr. distr (k r) (qbs_to_measure Y) β)"
                  by(rule bind_kernel_cong_All,rule qbs_s_finite.qbs_l[OF qbs_s_finite_All[where k=k and M=borel]]) (auto simp: k.s_finite_kernel_axioms)
                also have "... = ?rhs"
                  by(simp add: k.distr_bind_kernel[OF _ mu_sets])
                finally show ?thesis .
              qed
            qed
          qed
        qed
        thus ?thesis by simp
      qed
    }
    show ?thesis
     unfolding bind_qbs_def rep_qbs_measure_def qbs_measure.rep_def assms(1)
     by(rule someI2, rule in_Rep_qbs_measure, auto) fact
  qed
  show "qbs_s_finite Y β (μ k k)"
    by(rule s_fin.qbs_s_finite_axioms)
qed


lemma bind_qbs_morphism':
  assumes "f  X Q monadM_qbs Y"
  shows "(λx. x  f)  monadM_qbs X Q monadM_qbs Y"
proof(rule qbs_morphismI)
  fix γ
  assume "γ  qbs_Mx (monadM_qbs X)"
  from rep_qbs_Mx_monadM[OF this] obtain α k where h:
   "γ = (λr. X, α, k rsfin)" "α  qbs_Mx X" "s_finite_kernel borel borel k" "r. qbs_s_finite X α (k r)"
    by metis
  from rep_qbs_Mx_monadM[OF qbs_morphism_Mx[OF assms this(2)]] obtain α' k' where h':
  "f  α = (λr. Y, α', k' rsfin)" "α'  qbs_Mx Y" "s_finite_kernel borel borel k'" "r. qbs_s_finite Y α' (k' r)"
    by metis
  have [simp]:"(λx. x  f)  γ = (λr. Y, α', k r k k'sfin)"
    by standard (simp add: h(1) qbs_s_finite.bind_qbs[OF h(4) _ assms h'(2,3,1)])
  show "(λx. x  f)  γ  qbs_Mx (monadM_qbs Y)"
    using h'(2) by(auto simp: s_finite_kernel.bind_kernel_s_finite_kernel[OF h(3) h'(3)] monadM_qbs_Mx intro!: exI[where x=α'])
qed

lemma bind_qbs_return':
  assumes "x  qbs_space (monadM_qbs X)"
  shows "x  return_qbs X = x"
proof -
  obtain α μ where h:"qbs_s_finite X α μ" "x = X, α, μsfin"
    using rep_qbs_space_monadM[OF assms] by blast 
  then interpret qs: qbs_s_finite X α μ by simp
  interpret prob_kernel borel borel "return borel"
    by(simp add: prob_kernel_def')
  show ?thesis
    by(simp add: qs.bind_qbs[OF h(2) return_qbs_morphism _ _ return_qbs_comp] s_finite_kernel_axioms bind_kernel_return''[OF qs.mu_sets] h(2)[symmetric])
qed

lemma bind_qbs_return:
  assumes "f  X Q monadM_qbs Y"
      and "x  qbs_space X"
    shows "return_qbs X x  f = f x"
proof -
  from rep_qbs_space_monadM[OF qbs_morphism_space[OF assms]] obtain α μ where h:
   "f x = Y, α, μsfin" "qbs_s_finite Y α μ" by auto
  then interpret qs:qbs_s_finite Y α μ by simp
  interpret sk: s_finite_kernel borel borel "λr. μ"
    by(auto intro!: s_finite_measure.s_finite_kernel_const simp: s_finite_kernel_cong_sets[OF refl qs.mu_sets[symmetric]] qs.s_finite_measure_axioms qs.mu_not_empty)
  interpret rd: real_distribution "return borel 0"
    by(simp add: real_distribution_def prob_space_return real_distribution_axioms_def)
  interpret qbs_prob X "λr. x" "return borel 0"
    by(rule rd.return_qbs_prob[OF assms(2)])
  show ?thesis
    using bind_qbs[OF rd.return_qbs[OF assms(2)] assms(1) qs.in_Mx sk.s_finite_kernel_axioms]
    by(simp add: h(1) sk.bind_kernel_return)
qed

lemma bind_qbs_assoc:
  assumes "s  qbs_space (monadM_qbs X)"
          "f  X Q monadM_qbs Y"
      and "g  Y Q monadM_qbs Z"
   shows "s  (λx. f x  g) = (s  f)  g" (is "?lhs = ?rhs")
proof -
  obtain α μ where h:"s = X, α, μsfin" "qbs_s_finite X α μ"
    using rep_qbs_space_monadM[OF assms(1)] by blast
  then interpret qs: qbs_s_finite X α μ by simp
  from rep_qbs_Mx_monadM[OF qbs_morphism_Mx[OF assms(2) qs.in_Mx]] obtain β k where h':
   "f  α = (λr. Y, β, k rsfin)" "β  qbs_Mx Y" "s_finite_kernel borel borel k" "r. qbs_s_finite Y β (k r)"
    by metis
  from rep_qbs_Mx_monadM[OF qbs_morphism_Mx[OF assms(3) h'(2)]] obtain γ k' where h'':
   "g  β = (λr. Z, γ, k' rsfin)" "γ  qbs_Mx Z" "s_finite_kernel borel borel k'" "r. qbs_s_finite Z γ (k' r)"
    by metis
  have 1:"(λx. f x  g)  α = (λr. Z, γ, k r k k'sfin)"
    by standard (simp add: qbs_s_finite.bind_qbs[OF h'(4) fun_cong[OF h'(1),simplified] assms(3) h''(2,3,1)])

  have "?lhs =  Z, γ, μ k (λr. k r k k')sfin"
    by(rule qs.bind_qbs[OF h(1) qbs_morphism_compose[OF assms(2) bind_qbs_morphism'[OF assms(3)]] h''(2) s_finite_kernel.bind_kernel_s_finite_kernel[OF h'(3) h''(3)] 1])
  also have "... = Z, γ, μ k k k k'sfin"
    by(simp add: s_finite_kernel.bind_kernel_assoc[OF h'(3) h''(3) qs.mu_sets])
  also have "... = ?rhs"
    by(simp add: qbs_s_finite.bind_qbs[OF qs.bind_qbs_s_finite[OF h(1) assms(2) h'(2,3,1)] qs.bind_qbs[OF h(1) assms(2) h'(2,3,1)] assms(3) h''(2,3,1)])
  finally show ?thesis .
qed

lemma bind_qbs_cong:
  assumes [qbs]:"s  qbs_space (monadM_qbs X)"
          "x. x  qbs_space X  f x = g x"
      and [qbs]:"f  X Q monadM_qbs Y"
    shows "s  f = s  g"
proof -
  from rep_qbs_space_monadM[OF assms(1)] obtain α μ where h:
   "s = X, α, μsfin" "qbs_s_finite X α μ" by auto
  interpret qbs_s_finite X α μ by fact
  from rep_qbs_Mx_monadM[OF qbs_morphism_Mx[OF assms(3) in_Mx]] obtain β k where h':
  "f  α = (λr. Y, β, k rsfin)" "β  qbs_Mx Y" "s_finite_kernel borel borel k" by metis
  have g: "g  X Q monadM_qbs Y" "g  α = (λr. Y, β, k rsfin)"
    using qbs_Mx_to_X[OF in_Mx] assms(2) fun_cong[OF h'(1)]
    by(auto simp: assms(2)[symmetric] cong: qbs_morphism_cong)
  show ?thesis
    by(simp add: bind_qbs[OF h(1) assms(3) h'(2,3,1)] bind_qbs[OF h(1) g(1) h'(2,3) g(2)])
qed

subsubsection ‹ The Functorial Action ›
definition distr_qbs :: "['a quasi_borel, 'b quasi_borel,'a  'b,'a qbs_measure]  'b qbs_measure" where
"distr_qbs _ Y f sx  sx  return_qbs Y  f"

lemma distr_qbs_morphism':
  assumes "f  X Q Y"
  shows "distr_qbs X Y f  monadM_qbs X Q monadM_qbs Y"
  unfolding distr_qbs_def
  by(rule bind_qbs_morphism'[OF qbs_morphism_comp[OF assms return_qbs_morphism]])

lemma(in qbs_s_finite)
  assumes "s = X, α, μsfin"
      and "f  X Q Y"
    shows distr_qbs_s_finite:"qbs_s_finite Y (f  α) μ"
      and distr_qbs: "distr_qbs X Y f s = Y, f  α, μsfin"
   by(auto intro!: bind_qbs[OF assms(1) qbs_morphism_comp[OF assms(2) return_qbs_morphism],of "f  α" "return borel" ,simplified bind_kernel_return''[OF mu_sets]] bind_qbs_s_finite[OF assms(1) qbs_morphism_comp[OF assms(2) return_qbs_morphism],of "f  α" "return borel" ,simplified bind_kernel_return''[OF mu_sets]]
             simp: distr_qbs_def return_qbs_comp[OF qbs_morphism_Mx[OF assms(2) in_Mx],simplified comp_assoc[symmetric]] qbs_morphism_Mx[OF assms(2) in_Mx] prob_kernel.s_finite_kernel_prob_kernel[of borel borel "return borel",simplified prob_kernel_def'])

lemma(in qbs_prob)
  assumes "s = X, α, μsfin"
      and "f  X Q Y"
    shows distr_qbs_prob:"qbs_prob Y (f  α) μ"
  by(auto simp: distr_qbs_def prob_space_axioms intro!: qbs_s_finite.qbs_probI[OF distr_qbs_s_finite[OF assms]])

text ‹ We show that $M$ is a functor i.e. $M$ preserve identity and composition.›
lemma distr_qbs_id:
  assumes "s  qbs_space (monadM_qbs X)"
  shows "distr_qbs X X id s = s"
  using bind_qbs_return'[OF assms] by(simp add: distr_qbs_def)

lemma distr_qbs_comp:
  assumes "s  qbs_space (monadM_qbs X)"
          "f  X Q Y"
      and "g  Y Q Z" 
    shows "((distr_qbs Y Z g)  (distr_qbs X Y f)) s = distr_qbs X Z (g  f) s"
proof -
  from rep_qbs_space_monadM[OF assms(1)] obtain α μ where h:
  "qbs_s_finite X α μ" "s = X, α, μsfin" by metis
  have "qbs_s_finite Y (f  α) μ" "distr_qbs X Y f s = Y, f  α, μsfin"
    by(simp_all add: qbs_s_finite.distr_qbs_s_finite[OF h assms(2)] qbs_s_finite.distr_qbs[OF h assms(2)])
  from qbs_s_finite.distr_qbs[OF this assms(3)] qbs_s_finite.distr_qbs[OF h qbs_morphism_comp[OF assms(2,3)]]
  show ?thesis
    by(simp add: comp_assoc)
qed

subsubsection ‹ Join ›
definition join_qbs :: "'a qbs_measure qbs_measure  'a qbs_measure" where
"join_qbs  (λsst. sst  id)"

lemma join_qbs_morphism[qbs]: "join_qbs  monadM_qbs (monadM_qbs X) Q monadM_qbs X"
  by(simp add: join_qbs_def bind_qbs_morphism'[OF qbs_morphism_ident])

lemma
  assumes "qbs_s_finite (monadM_qbs X) β μ"
          "ssx = monadM_qbs X, β, μsfin"
          "α  qbs_Mx X"
          "s_finite_kernel borel borel k"
      and "β =(λr. X, α, k rsfin)"
    shows qbs_s_finite_join_qbs_s_finite: "qbs_s_finite X α (μ k k)"
      and qbs_s_finite_join_qbs: "join_qbs ssx = X, α, μ k ksfin"
  using qbs_s_finite.bind_qbs[OF assms(1,2) qbs_morphism_ident assms(3,4)] qbs_s_finite.bind_qbs_s_finite[OF assms(1,2) qbs_morphism_ident assms(3,4)]
  by(auto simp: assms(5) join_qbs_def)

subsubsection ‹ Strength ›
definition strength_qbs :: "['a quasi_borel,'b quasi_borel,'a × 'b qbs_measure]  ('a × 'b) qbs_measure" where
"strength_qbs W X = (λ(w,sx). let (_,α,μ) = rep_qbs_measure sx
                         in W Q X, λr. (w,α r), μsfin)"

lemma(in qbs_s_finite)
  assumes "w  qbs_space W"
      and "sx = X, α, μsfin"
    shows strength_qbs_s_finite: "qbs_s_finite (W Q X) (λr. (w,α r)) μ"
      and strength_qbs: "strength_qbs W X (w,sx) = W Q X, λr. (w,α r), μsfin"
proof -
  interpret qs: qbs_s_finite "W Q X" "λr. (w,α r)" μ
    by(auto simp: qbs_s_finite_def s_finite_measure_axioms qbs_s_finite_axioms_def mu_sets in_Mx_def assms(1) intro!: pair_qbs_MxI)
  show "qbs_s_finite (W Q X) (λr. (w,α r)) μ" by (rule qs.qbs_s_finite_axioms)
  show "strength_qbs W X (w,sx) = W Q X, λr. (w,α r), μsfin"
  proof -
    {
      fix X' α' μ'
      assume "(X',α',μ')  Rep_qbs_measure X, α, μsfin"
      then have h: "X' = X" "qbs_s_finite X' α' μ'" "qbs_s_finite_eq (X,α,μ) (X',α',μ')"
        by(simp_all add: if_in_Rep_qbs_measure)
      then interpret qs': qbs_s_finite "W Q X" "λr. (w,α' r)" μ'
        by(auto simp: qbs_s_finite_def in_Mx_def assms(1) intro!: pair_qbs_MxI)
      interpret pq: pair_qbs_s_finite "W Q X" "λr. (w,α r)" μ "λr. (w,α' r)" μ'
        by(auto simp: qs.qbs_s_finite_axioms qs'.qbs_s_finite_axioms pair_qbs_s_finite_def)
      have "W Q X, λr. (w, α' r), μ'sfin = W Q X, λr. (w, α r), μsfin"
      proof(rule pq.qbs_s_finite_measure_eq'[symmetric])
        fix f :: "_  ennreal"
        assume "f  W Q X Q qbs_borel"
        then have f: "curry f w  X Q qbs_borel"
          by (metis assms(1) qbs_morphism_curry qbs_morphism_space)
        show "(+ x. f (w, α x) μ) = (+ x. f (w, α' x) μ')" (is "?lhs = ?rhs")
        proof -
          have "?lhs = (+ x. curry f w (α x) μ)" by simp
          also have "... = (+ x. curry f w (α' x) μ')"
            using h(3) f by(auto simp: qbs_s_finite_eq_equiv qbs_s_finite_eq'_def h(1))
          also have "... = ?rhs" by simp
          finally show ?thesis .
        qed
      qed
    }
    show ?thesis
      by(simp add: strength_qbs_def rep_qbs_measure_def qbs_measure.rep_def assms(2)) (rule someI2, rule in_Rep_qbs_measure, auto, fact)
  qed
qed

lemma(in qbs_prob)
  assumes "w  qbs_space W"
      and "sx = X, α, μsfin"
    shows strength_qbs_prob: "qbs_prob (W Q X) (λr. (w,α r)) μ"
  by(auto intro!: qbs_s_finite.qbs_probI[OF strength_qbs_s_finite[OF assms]] prob_space_axioms)

lemma strength_qbs_natural:
  assumes "f  X Q X'"
          "g  Y Q Y'"
          "x  qbs_space X"
      and "sy  qbs_space (monadM_qbs Y)"
    shows "(distr_qbs (X Q Y) (X' Q Y') (map_prod f g)  strength_qbs X Y) (x,sy) = (strength_qbs X' Y'  map_prod f (distr_qbs Y Y' g)) (x,sy)"
          (is "?lhs = ?rhs")
proof -
  from rep_qbs_space_monadM[OF assms(4)] obtain α μ 
    where h:"sy = Y, α, μsfin" "qbs_s_finite Y α μ" by metis
  have "?lhs = (distr_qbs (X Q Y) (X' Q Y') (map_prod f g)) (X Q Y, λr. (x,α r), μsfin)"
    by(simp add: qbs_s_finite.strength_qbs[OF h(2) assms(3) h(1)])
  also have "... = X' Q Y', map_prod f g  (λr. (x, α r)), μsfin"
    using assms by(simp add: qbs_s_finite.distr_qbs[OF qbs_s_finite.strength_qbs_s_finite[OF h(2) assms(3) h(1)] refl ])
  also have "... = X' Q Y',λr. (f x, (g  α) r), μsfin" by (simp add: comp_def)
  also have "... = ?rhs"
    by(simp add: qbs_s_finite.strength_qbs[OF qbs_s_finite.distr_qbs_s_finite[OF h(2,1) assms(2)] qbs_morphism_space[OF assms(1,3)] qbs_s_finite.distr_qbs[OF h(2,1) assms(2)]])
  finally show ?thesis .
qed

context
begin

interpretation rr : standard_borel_ne "borel M borel :: (real × real) measure"
  by(auto intro!: pair_standard_borel_ne)

declare rr.from_real_to_real[simplified space_pair_measure,simplified,simp]

lemma rr_from_real_to_real_id[simp]: "rr.from_real  rr.to_real = id"
  by(auto simp: comp_def)

lemma
  assumes "α  qbs_Mx X"
          "β  qbs_Mx (monadM_qbs Y)"
          "γ  qbs_Mx Y"
          "s_finite_kernel borel borel k"
      and "β = (λr. Y, γ, k rsfin)"
    shows strength_qbs_ab_r_s_finite: "qbs_s_finite (X Q Y) (map_prod α γ  rr.from_real) (distr (return borel r M k r) borel rr.to_real)"
      and strength_qbs_ab_r: "strength_qbs X Y (α r, β r) = X Q Y, map_prod α γ  rr.from_real, distr (return borel r M k r) borel rr.to_realsfin" (is ?goal2)
proof -
  interpret k: s_finite_kernel borel borel k by fact
  note 1[measurable_cong] = sets_return[of borel r] k.kernel_sets[of r,simplified]
  show "qbs_s_finite (X Q Y) (map_prod α γ  rr.from_real) (distr (return borel r M k r) borel rr.to_real)"
    using assms(1,3) by(auto simp: qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def qbs_Mx_is_morphisms r_preserves_product[symmetric] standard_borel_ne.standard_borel intro!: s_finite_measure.s_finite_measure_distr[OF pair_measure_s_finite_measure[OF prob_space.s_finite_measure_prob[OF prob_space_return[of r borel]] k.image_s_finite_measure[of r]]] qbs_morphism_comp[where Y="qbs_borel Q qbs_borel"] qbs_morphism_space[OF qbs_morphism_space[OF qbs_morphism_map_prod]] standard_borel.qbs_morphism_measurable_intro[of "borel :: real measure"])
  then interpret qs: qbs_s_finite "X Q Y" "map_prod α γ  rr.from_real" "distr (return borel r M k r) borel rr.to_real" .
  interpret qs2: qbs_s_finite Y γ "k r"
    by(auto simp: qbs_s_finite_def k.image_s_finite_measure in_Mx_def assms qbs_s_finite_axioms_def k.kernel_sets)
  interpret pq: pair_qbs_s_finite "X Q Y" "λl. (α r, γ l)" "k r" "map_prod α γ  rr.from_real" "distr (return borel r M k r) borel rr.to_real"
    by (auto simp: pair_qbs_s_finite_def qs.qbs_s_finite_axioms qs2.strength_qbs_s_finite[OF qbs_Mx_to_X[OF assms(1),of r] fun_cong[OF assms(5)]])
  have [measurable]: "map_prod α γ  borel M borel M qbs_to_measure (X Q Y)"
  proof -
    have "map_prod α γ  qbs_borel Q qbs_borel Q X Q Y"
      using assms by(auto intro!: qbs_morphism_map_prod simp: qbs_Mx_is_morphisms)
    also have "...  qbs_to_measure (qbs_borel Q qbs_borel) M qbs_to_measure (X Q Y)"
      by(rule l_preserves_morphisms)
    also have "... = borel M borel M qbs_to_measure (X Q Y)"
      using rr.lr_sets_ident l_preserves_morphisms by(auto simp add: r_preserves_product[symmetric])
    finally show ?thesis .
  qed
  show ?goal2
    unfolding qs2.strength_qbs[OF qbs_Mx_to_X[OF assms(1),of r] fun_cong[OF assms(5)]]
  proof(rule pq.qbs_s_finite_measure_eq)
    show "distr (k r) (qbs_to_measure (X Q Y)) (λl. (α r, γ l)) = distr (distr (return borel r M k r) borel rr.to_real) (qbs_to_measure (X Q Y)) (map_prod α γ  rr.from_real)"
         (is "?lhs = ?rhs")
    proof -
      have "?lhs = distr (k r) (qbs_to_measure (X Q Y)) (map_prod α γ  Pair r)"
        by(simp add: comp_def)
      also have "... = distr (distr (k r) (borel M borel) (Pair r)) (qbs_to_measure (X Q Y)) (map_prod α γ)"
        by(auto intro!: distr_distr[symmetric])
      also have "... = distr (return borel r M k r) (qbs_to_measure (X Q Y)) (map_prod α γ)"
      proof -
        have "return borel r M k r = distr (k r) (borel M borel) (λl. (r,l))"
          by(auto intro!: measure_eqI simp: sets_pair_measure_cong[OF refl 1(2)] qs2.emeasure_pair_measure_alt' emeasure_distr nn_integral_return[OF _  qs2.measurable_emeasure_Pair'])
        thus ?thesis by simp
      qed
      also have "... = ?rhs"
        by(simp add: distr_distr comp_def)
      finally show ?thesis .
    qed
  qed
qed

lemma strength_qbs_morphism[qbs]: "strength_qbs X Y  X Q monadM_qbs Y Q monadM_qbs (X Q Y)"
proof(rule pair_qbs_morphismI)
  fix α β
  assume h:"α  qbs_Mx X"
           "β  qbs_Mx (monadM_qbs Y)"
  from rep_qbs_Mx_monadM[OF this(2)] obtain γ k where hb:
    "β = (λr. Y, γ,  k rsfin)" "γ  qbs_Mx Y" "s_finite_kernel borel borel k"
    by metis
  have "s_finite_kernel borel borel (λr. distr (return borel r M k r) borel rr.to_real)"
    by(auto intro!: s_finite_kernel.distr_s_finite_kernel[where Y="borel M borel"] s_finite_kernel_pair_measure[OF prob_kernel.s_finite_kernel_prob_kernel] simp:hb prob_kernel_def')
  thus "(λr. strength_qbs X Y (α r, β r))  qbs_Mx (monadM_qbs (X Q Y))"
    using strength_qbs_ab_r[OF h hb(2,3,1)] strength_qbs_ab_r_s_finite[OF h hb(2,3,1)]
    by(auto simp: monadM_qbs_Mx qbs_s_finite_def in_Mx_def intro!: exI[where x="map_prod α γ  rr.from_real"] exI[where x="λr. distr (return borel r M k r) borel rr.to_real"])
qed

lemma bind_qbs_morphism[qbs]: "(⤜)  monadM_qbs X Q (X Q monadM_qbs Y) Q monadM_qbs Y"
proof -
  {
    fix f s
    assume h:"f  X Q monadM_qbs Y" "s  qbs_space (monadM_qbs X)"
    from rep_qbs_space_monadM[OF this(2)] obtain α μ where h':
     "s = X, α, μsfin" "qbs_s_finite X α μ" by metis
    then interpret qbs_s_finite X α μ by simp
    from rep_qbs_Mx_monadM[OF qbs_morphism_Mx[OF h(1) in_Mx]] obtain β k
      where hb:"f  α = (λr. Y, β, k rsfin)" "β  qbs_Mx Y" "s_finite_kernel borel borel k" by metis
    have "join_qbs (distr_qbs ((X Q monadM_qbs Y) Q X) (monadM_qbs Y) (λfx. fst fx (snd fx)) (strength_qbs (X Q monadM_qbs Y) X (f, s))) = s  f"
      using qbs_s_finite_join_qbs[OF qbs_s_finite.distr_qbs_s_finite[OF strength_qbs_s_finite[of f "X Q monadM_qbs Y",OF h(1) h'(1)] strength_qbs[of f "X Q monadM_qbs Y",OF h(1) h'(1)] qbs_morphism_eval] qbs_s_finite.distr_qbs[OF strength_qbs_s_finite[of f "X Q monadM_qbs Y",OF h(1) h'(1)] strength_qbs[of f "X Q monadM_qbs Y",OF h(1) h'(1)] qbs_morphism_eval] hb(2,3)] hb(1)
      by(simp add: bind_qbs[OF h'(1) h(1) hb(2,3,1)] comp_def)
  }
  thus ?thesis
    by(auto intro!: arg_swap_morphism[OF curry_preserves_morphisms[OF qbs_morphism_cong'[of _ "join_qbs  (distr_qbs (exp_qbs X (monadM_qbs Y) Q X) (monadM_qbs Y) (λfx. (fst fx) (snd fx)))  (strength_qbs (exp_qbs X (monadM_qbs Y)) X)"]]] qbs_morphism_comp distr_qbs_morphism' strength_qbs_morphism join_qbs_morphism qbs_morphism_eval simp: pair_qbs_space)
qed

lemma strength_qbs_law1:
  assumes "x  qbs_space (unit_quasi_borel Q monadM_qbs X)"
  shows "snd x = (distr_qbs (unit_quasi_borel Q X) X snd  strength_qbs unit_quasi_borel X) x"
proof -
  obtain α μ where h:
   "qbs_s_finite X α μ" "(snd x) = X, α, μsfin"
    using rep_qbs_space_monadM[of "snd x" X] assms by (auto simp: pair_qbs_space) metis
  have [simp]: "((),snd x) = x"
    using SigmaE assms by (auto simp: pair_qbs_space)
  show ?thesis
    using qbs_s_finite.distr_qbs[OF qbs_s_finite.strength_qbs_s_finite[OF h(1) _ h(2),of "fst x" unit_quasi_borel] qbs_s_finite.strength_qbs[OF h(1) _ h(2)] snd_qbs_morphism]
    by(auto simp: comp_def,simp add: h(2))
qed

lemma strength_qbs_law2:
  assumes "x  qbs_space ((X Q Y) Q monadM_qbs Z)"
  shows "(strength_qbs X (Y Q Z)  (map_prod id (strength_qbs Y Z))  (λ((x,y),z). (x,(y,z)))) x =
         (distr_qbs ((X Q Y) Q Z) (X Q (Y Q Z)) (λ((x,y),z). (x,(y,z)))  strength_qbs (X Q Y) Z) x"
         (is "?lhs = ?rhs")
proof -
  obtain α μ where h:
   "qbs_s_finite Z α μ" "snd x = Z, α, μsfin"
    using rep_qbs_space_monadM[of "snd x" Z] assms by (auto simp: pair_qbs_space) metis
  then have "?lhs = X Q Y Q Z, λr. (fst (fst x), snd (fst x), α r), μsfin"
    using assms qbs_s_finite.strength_qbs_s_finite[OF h(1) _ h(2),of "snd (fst x)" Y]
    by(auto intro!: qbs_s_finite.strength_qbs simp: pair_qbs_space)
  also have "... = ?rhs"
    using qbs_s_finite.distr_qbs[OF qbs_s_finite.strength_qbs_s_finite[OF h(1) _ h(2),of "fst x" "X Q Y"] qbs_s_finite.strength_qbs[OF h(1) _ h(2),of "fst x" "X Q Y"] qbs_morphism_pair_assoc1] assms
    by(auto simp: comp_def pair_qbs_space)
  finally show ?thesis .
qed

lemma strength_qbs_law3:
  assumes "x  qbs_space (X Q Y)"
  shows "return_qbs (X Q Y) x = (strength_qbs X Y  (map_prod id (return_qbs Y))) x"
proof -
  interpret qp: qbs_prob Y "λr. snd x" "return borel 0"
    using assms by(auto simp: prob_space_return pair_qbs_space qbs_prob_def in_Mx_def real_distribution_def real_distribution_axioms_def)
  show ?thesis
    using qp.strength_qbs[OF _ qp.return_qbs[of "snd x" Y],of "fst x" X] qp.return_qbs[OF assms] assms
    by(auto simp: pair_qbs_space)
qed

lemma strength_qbs_law4:
  assumes "x  qbs_space (X Q monadM_qbs (monadM_qbs Y))"
  shows "(strength_qbs X Y  map_prod id join_qbs) x = (join_qbs  distr_qbs (X Q monadM_qbs Y) (monadM_qbs (X Q Y)) (strength_qbs X Y)  strength_qbs X (monadM_qbs Y)) x"
        (is "?lhs = ?rhs")
proof -
  from assms rep_qbs_space_monadM[of "snd x" "monadM_qbs Y"] obtain β μ
    where h:"qbs_s_finite (monadM_qbs Y) β μ" "snd x = monadM_qbs Y, β, μsfin"
    by (auto simp: pair_qbs_space) metis
  with rep_qbs_Mx_monadM[of β Y] obtain γ k
    where h': "γ  qbs_Mx Y" "s_finite_kernel borel borel k" "β = (λr. Y, γ, k rsfin)"
      and h'': "r. qbs_s_finite Y γ (k r)"
    by(auto simp: qbs_s_finite_def in_Mx_def) metis
  have "?lhs = X Q Y, λr. (fst x, γ r), μ k ksfin"
    using qbs_s_finite.strength_qbs[OF qbs_s_finite_join_qbs_s_finite[OF h h'] _ qbs_s_finite_join_qbs[OF h h'],of "fst x" X] assms
    by(auto simp: pair_qbs_space)
  also have "... = ?rhs"
    using qbs_s_finite_join_qbs[OF qbs_s_finite.distr_qbs_s_finite[OF qbs_s_finite.strength_qbs_s_finite[OF h(1) _ h(2),of "fst x" X] qbs_s_finite.strength_qbs[OF h(1) _ h(2),of "fst x"] strength_qbs_morphism] qbs_s_finite.distr_qbs[OF qbs_s_finite.strength_qbs_s_finite[OF h(1) _ h(2),of "fst x" X] qbs_s_finite.strength_qbs[OF h(1) _ h(2),of "fst x"] strength_qbs_morphism] pair_qbs_MxI h'(2),of "λr. (fst x, γ r)",simplified comp_def qbs_s_finite.strength_qbs[OF h'' _ fun_cong[OF h'(3)],of "fst x" X]] assms h'(1)
    by(auto simp: pair_qbs_space qbs_s_finite_def in_Mx_def)
  finally show ?thesis .
qed

lemma distr_qbs_morphism[qbs]: "distr_qbs X Y  (X Q Y) Q (monadM_qbs X Q monadM_qbs Y)"
proof -
  have [simp]: "distr_qbs X Y = (λf sx. sx  return_qbs Y  f)"
    by standard+ (auto simp: distr_qbs_def)
  show ?thesis
    by simp
qed

lemma
  assumes "α  qbs_Mx X" "β  qbs_Mx Y"
  shows return_qbs_pair_Mx: "return_qbs (X Q Y) (α r, β k) = X Q Y,map_prod α β  rr.from_real, distr (return borel r M return borel k) borel rr.to_realsfin"
    and return_qbs_pair_Mx_prob: "qbs_prob (X Q Y) (map_prod α β  rr.from_real) (distr (return borel r M return borel k) borel rr.to_real)"
proof -
  note [measurable_cong] = sets_return[of borel]
  interpret qp: qbs_prob "X Q Y" "map_prod α β  rr.from_real" "distr (return borel r M return borel k) borel rr.to_real"
    using qbs_closed1_dest[OF assms(1)] qbs_closed1_dest[OF assms(2)]
    by(auto intro!: prob_space.prob_space_distr prob_space_pair simp: comp_def prob_space_return pair_qbs_Mx qbs_prob_def in_Mx_def real_distribution_def real_distribution_axioms_def)
  show "qbs_prob (X Q Y) (map_prod α β  rr.from_real) (distr (return borel r M return borel k) borel rr.to_real)"
    by standard
  show "return_qbs (X Q Y) (α r, β k) = X Q Y,map_prod α β  rr.from_real, distr (return borel r M return borel k) borel rr.to_realsfin" (is "?lhs = ?rhs")
  proof -
    have "?lhs = (strength_qbs X Y  map_prod id (return_qbs Y)) (α r, β k)"
      by(rule strength_qbs_law3[of "(α r, β k)" X Y], insert assms) (auto simp: qbs_Mx_to_X pair_qbs_space)
    also have "... = strength_qbs X Y (α r, Y, β, return borel ksfin)"
      using fun_cong[OF return_qbs_comp[OF assms(2)]] by simp
    also have "... = ?rhs"
      by(rule strength_qbs_ab_r[OF assms(1) _ assms(2)]) (auto intro!: qbs_closed2_dest qbs_s_finite.in_space_monadM s_finite_measure.s_finite_kernel_const[of "return borel k",simplified s_finite_kernel_cong_sets[OF _ sets_return]] prob_space.s_finite_measure_prob simp: qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def assms(2) prob_space_return)
    finally show ?thesis .
  qed
qed

lemma bind_bind_return_distr:
  assumes "s_finite_measure μ"
      and "s_finite_measure ν"
      and [measurable_cong]: "sets μ = sets borel" "sets ν = sets borel"
    shows "μ k (λr. ν k (λl. distr (return borel r M return borel l) borel rr.to_real))
           = distr (μ M ν) borel rr.to_real"
    (is "?lhs = ?rhs")
proof -
  interpret rd1: s_finite_measure μ by fact
  interpret rd2: s_finite_measure ν by fact
  have ne: "space μ  {}" "space ν  {}"
    by(auto simp: sets_eq_imp_space_eq assms(3,4))

  have "?lhs = μ k (λr. ν k (λl. distr (return (borel M borel) (r,l)) borel rr.to_real))"
    by(simp add: pair_measure_return)
  also have "... = μ k (λr. ν k (λl. distr (return (μ M ν) (r, l)) borel rr.to_real))"
  proof -
    have "return (borel M borel) = return (μ M ν)"
      by(auto intro!: return_sets_cong sets_pair_measure_cong simp: assms(3,4))
    thus ?thesis by simp
  qed
  also have "... = μ k (λr. distr (ν k (λl. (return (μ M ν) (r, l)))) borel rr.to_real)"
    by(auto intro!: bind_kernel_cong_All measure_kernel.distr_bind_kernel[of ν "μ M ν",symmetric] simp: ne measure_kernel_def space_pair_measure)
  also have "... = distr (μ k (λr. ν k (λl. return (μ M ν) (r, l)))) borel rr.to_real"
    by(auto intro!: measure_kernel.distr_bind_kernel[of μ "μ M ν",symmetric] s_finite_kernel.axioms(1) s_finite_kernel.bind_kernel_s_finite_kernel'[where Y=ν] s_finite_measure.s_finite_kernel_const[OF assms(2)] prob_kernel.s_finite_kernel_prob_kernel[of "μ M ν"] simp: ne prob_kernel_def')
  also have "... = ?rhs"
    by(simp add: pair_measure_eq_bind_s_finite[OF assms(1,2),symmetric])
  finally show ?thesis .
qed

end

context
begin
interpretation rr : standard_borel_ne "borel M borel :: (real × real) measure"
  by(auto intro!: pair_standard_borel_ne)

lemma from_real_rr_qbs_morphism[qbs]: "rr.from_real  qbs_borel Q qbs_borel Q qbs_borel"
  by (metis borel_prod qbs_Mx_R qbs_Mx_is_morphisms qbs_borel_prod rr.from_real_measurable)

end

context pair_qbs_s_finites
begin

interpretation rr : standard_borel_ne "borel M borel :: (real × real) measure"
  by(auto intro!: pair_standard_borel_ne)

sublocale qbs_s_finite "X Q Y" "map_prod α β  rr.from_real" "distr (μ M ν) borel rr.to_real"
  by(auto simp: qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def qbs_Mx_is_morphisms pq1.s_finite_measure_axioms pq2.s_finite_measure_axioms intro!: s_finite_measure.s_finite_measure_distr[OF pair_measure_s_finite_measure])

lemma qbs_bind_bind_return_qp:
 "Y,β,νsfin  (λy. X,α,μsfin  (λx. return_qbs (X Q Y) (x,y))) = X Q Y, map_prod α β  rr.from_real, distr (μ M ν) borel rr.to_realsfin" (is "?lhs = ?rhs")
proof -
  have "?lhs = X Q Y, map_prod α β  rr.from_real, ν k (λl. μ k (λr. distr (return borel r M return borel l) borel rr.to_real))sfin"
    by(auto intro!: pq2.bind_qbs[OF refl] s_finite_kernel.bind_kernel_s_finite_kernel'[where Y=μ] s_finite_measure.s_finite_kernel_const s_finite_kernel.distr_s_finite_kernel[where Y="borel M borel"] prob_kernel.s_finite_kernel_prob_kernel[of "borel M μ"] simp: sets_eq_imp_space_eq[OF pq1.mu_sets] pq1.s_finite_measure_axioms split_beta' pair_measure_return[of _ "snd _"] prob_kernel_def')
      (auto intro!: pq1.bind_qbs prob_kernel.s_finite_kernel_prob_kernel simp: comp_def return_qbs_pair_Mx qbs_Mx_is_morphisms prob_kernel_def')
  also have "... = ?rhs"
  proof -
    have "ν k (λl. μ k (λr. distr (return borel r M return borel l) borel rr.to_real)) = distr (μ M ν) borel rr.to_real" 
      by(auto simp: bind_bind_return_distr[OF pq1.s_finite_measure_axioms pq2.s_finite_measure_axioms pq1.mu_sets pq2.mu_sets,symmetric] pq1.s_finite_measure_axioms pq2.s_finite_measure_axioms prob_kernel_def' intro!: bind_kernel_rotate[where Z=borel] prob_kernel.s_finite_kernel_prob_kernel)
    thus ?thesis by simp
  qed
  finally show ?thesis .
qed

lemma qbs_bind_bind_return_pq:
 "X,α,μsfin  (λx. Y,β,νsfin  (λy. return_qbs (X Q Y) (x,y))) = X Q Y, map_prod α β  rr.from_real, distr (μ M ν) borel rr.to_realsfin" (is "?lhs = ?rhs")
proof -
  have "?lhs = X Q Y, map_prod α β  rr.from_real, μ k (λr. ν k (λl. distr (return borel r M return borel l) borel rr.to_real))sfin"
    by(auto intro!: pq1.bind_qbs[OF refl]s_finite_kernel.bind_kernel_s_finite_kernel'[where Y=ν] s_finite_measure.s_finite_kernel_const s_finite_kernel.distr_s_finite_kernel[where Y="borel M borel"] prob_kernel.s_finite_kernel_prob_kernel[of "borel M ν"] simp: sets_eq_imp_space_eq[OF pq2.mu_sets] pq2.s_finite_measure_axioms split_beta' pair_measure_return[of _ "fst _"] prob_kernel_def')
      (auto intro!: pq2.bind_qbs prob_kernel.s_finite_kernel_prob_kernel simp: comp_def return_qbs_pair_Mx qbs_Mx_is_morphisms prob_kernel_def')
  also have "... = ?rhs"
    by(simp add: bind_bind_return_distr[OF pq1.s_finite_measure_axioms pq2.s_finite_measure_axioms pq1.mu_sets pq2.mu_sets])
  finally show ?thesis .
qed

end

lemma bind_qbs_return_rotate:
  assumes "p  qbs_space (monadM_qbs X)"
      and "q  qbs_space (monadM_qbs Y)"
    shows "q  (λy. p  (λx. return_qbs (X Q Y) (x,y))) = p  (λx. q  (λy. return_qbs (X Q Y) (x,y)))"
proof -
  from rep_qbs_space_monadM[OF assms(1)] rep_qbs_space_monadM[OF assms(2)]
  obtain α μ β ν where h: "p = X, α, μsfin" "q = Y, β, νsfin" "qbs_s_finite X α μ" "qbs_s_finite Y β ν"
    by metis
  then interpret pair_qbs_s_finites X α μ Y β ν
    by(simp add: pair_qbs_s_finites_def)
  show ?thesis
    by(simp add: h(1,2) qbs_bind_bind_return_pq qbs_bind_bind_return_qp)
qed

lemma qbs_bind_bind_return1:
  assumes [qbs]: "f   X Q Y Q monadM_qbs Z"
          "p  qbs_space (monadM_qbs X)"
          "q  qbs_space (monadM_qbs Y)"
    shows "q  (λy. p  (λx. f (x,y))) = (q  (λy. p  (λx. return_qbs (X Q Y) (x,y))))  f"
          (is "?lhs = ?rhs")
proof -
  have "?lhs = q  (λy. p  (λx. return_qbs (X Q Y) (x,y)  f))"
    by(auto intro!: bind_qbs_cong[OF assms(3),where Y=Z] bind_qbs_cong[OF assms(2),where Y=Z] simp: bind_qbs_return[OF assms(1),simplified pair_qbs_space])
  also have "... = q  (λy. (p  (λx. return_qbs (X Q Y) (x,y)))  f)"
    by(auto intro!: bind_qbs_cong[OF assms(3),where Y=Z] bind_qbs_assoc[OF assms(2) _ assms(1)] simp: )
  also have "... = ?rhs"
    by(simp add: bind_qbs_assoc[OF assms(3) _ assms(1)])
  finally show ?thesis .
qed

lemma qbs_bind_bind_return2:
  assumes [qbs]:"f   X Q Y Q monadM_qbs Z"
          "p  qbs_space (monadM_qbs X)" "q  qbs_space (monadM_qbs Y)"
    shows "p  (λx. q  (λy. f (x,y))) = (p  (λx. q  (λy. return_qbs (X Q Y) (x,y))))  f"
          (is "?lhs = ?rhs")      
proof -
  have "?lhs = p  (λx. q  (λy. return_qbs (X Q Y) (x,y)  f))"
    by(auto intro!: bind_qbs_cong[OF assms(2),where Y=Z] bind_qbs_cong[OF assms(3),where Y=Z] simp: bind_qbs_return[OF assms(1),simplified pair_qbs_space])
  also have "... = p  (λx. (q  (λy. return_qbs (X Q Y) (x,y)))  f)"
    by(auto intro!: bind_qbs_cong[OF assms(2),where Y=Z] bind_qbs_assoc[OF assms(3) _ assms(1)])
  also have "... = ?rhs"
    by(simp add: bind_qbs_assoc[OF assms(2) _ assms(1)])
  finally show ?thesis .
qed

corollary bind_qbs_rotate:
  assumes "f   X Q Y Q monadM_qbs Z"
          "p  qbs_space (monadM_qbs X)"
      and "q  qbs_space (monadM_qbs Y)"
    shows "q  (λy. p  (λx. f (x,y))) = p  (λx. q  (λy. f (x,y)))"
  by(simp add: qbs_bind_bind_return1[OF assms] qbs_bind_bind_return2[OF assms] bind_qbs_return_rotate assms)

context pair_qbs_s_finites
begin

interpretation rr : standard_borel_ne "borel M borel :: (real × real) measure"
  by(auto intro!: pair_standard_borel_ne)

lemma
  assumes [qbs]:"f  X Q Y Q Z"
  shows qbs_bind_bind_return:"X,α,μsfin  (λx. Y,β,νsfin  (λy. return_qbs Z (f (x,y)))) = Z, f  (map_prod α β  rr.from_real), distr (μ M ν) borel rr.to_realsfin" (is "?lhs = ?rhs")
    and qbs_bind_bind_return_s_finite: "qbs_s_finite Z (f  (map_prod α β  rr.from_real)) (distr (μ M ν) borel rr.to_real)"
proof -
  show "qbs_s_finite Z (f  (map_prod α β  rr.from_real)) (distr (μ M ν) borel rr.to_real)"
    using qbs_s_finite_axioms by(auto simp: qbs_s_finite_def in_Mx_def qbs_Mx_is_morphisms)
  have "?lhs = X,α,μsfin  (λx. Y,β,νsfin  (λy. return_qbs (X Q Y) (x,y)))  return_qbs Z  f"
    by(auto simp: comp_def intro!: qbs_bind_bind_return2[of "return_qbs Z  f" _ _ Z,simplified comp_def])
  also have "... = X Q Y, map_prod α β  rr.from_real, distr (μ M ν) borel rr.to_realsfin  return_qbs Z  f"
    by(simp add: qbs_bind_bind_return_pq)
  also have "... = ?rhs"
    by(rule distr_qbs[OF refl assms,simplified distr_qbs_def])
  finally show "?lhs = ?rhs" .
qed

end

subsubsection ‹The Probability Monad›

definition "monadP_qbs X  sub_qbs (monadM_qbs X) {s. prob_space (qbs_l s)}"

lemma
  shows qbs_space_monadPM: "s  qbs_space (monadP_qbs X)  s  qbs_space (monadM_qbs X)"
    and qbs_Mx_monadPM: "f  qbs_Mx (monadP_qbs X)  f  qbs_Mx (monadM_qbs X)"
  by(simp_all add: monadP_qbs_def sub_qbs_space sub_qbs_Mx)

lemma monadP_qbs_space: "qbs_space (monadP_qbs X) = {s. qbs_space_of s = X  prob_space (qbs_l s)}"
  by(auto simp: monadP_qbs_def sub_qbs_space monadM_qbs_space)

lemma rep_qbs_space_monadP:
  assumes "s  qbs_space (monadP_qbs X)"
  obtains α μ where "s = X, α, μsfin" "qbs_prob X α μ"
proof -
  obtain α μ where h:"s = X, α, μsfin" "qbs_s_finite X α μ"
    using assms rep_qbs_space_monadM[of s X] by(auto simp: monadP_qbs_def sub_qbs_space)
  interpret qbs_s_finite X α μ by fact
  have "prob_space μ"
    by(rule prob_space_distrD[of α _ "qbs_to_measure X"]) (insert assms, auto simp: qbs_l[symmetric] h(1)[symmetric] monadP_qbs_space)
  thus ?thesis
    by (simp add: h(1) in_Mx_axioms mu_sets qbs_prob.intro real_distribution_axioms_def real_distribution_def that)
qed

lemma qbs_l_prob_space:
  "s  qbs_space (monadP_qbs X)  prob_space (qbs_l s)"
  by(auto simp: monadP_qbs_space)

lemma monadP_qbs_empty_iff:
 "(qbs_space X = {}) = (qbs_space (monadP_qbs X) = {})"
proof
  show "qbs_space X = {}  qbs_space (monadP_qbs X) = {}"
  using qbs_s_space_of_not_empty by(auto simp add: monadP_qbs_space)
next
  assume "qbs_space (monadP_qbs X) = {}"
  then have h:"s. qbs_space_of s = X  ¬ prob_space (qbs_l s)"
    by(simp add: monadP_qbs_space)
  show "qbs_space X = {}"
  proof(rule ccontr)
    assume "qbs_space X  {}"
    then obtain a where a:"a  qbs_Mx X" by (auto simp: qbs_empty_equiv)
    then interpret qbs_prob X a "return borel 0"
      by(auto simp: qbs_prob_def in_Mx_def real_distribution_axioms_def real_distribution_def prob_space_return)
    have "qbs_space_of X, a, return borel 0sfin = X" "prob_space (qbs_l X, a, return borel 0sfin)"
      by(auto simp: qbs_l intro!: prob_space_distr)
    with h show False by simp
  qed
qed

lemma in_space_monadP_qbs_pred: "qbs_pred (monadM_qbs X) (λs. s  monadP_qbs X)"
  by(rule qbs_morphism_cong'[where f="λs. prob_space (qbs_l s)"],auto simp: qbs_l_prob_pred)
    (auto simp: monadP_qbs_def sub_qbs_space)

lemma(in qbs_prob) in_space_monadP[qbs]: "X, α, μsfin  qbs_space (monadP_qbs X)"
  by(auto simp: monadP_qbs_space qbs_l prob_space_distr)

lemma qbs_morphism_monadPD: "f  X Q monadP_qbs Y  f  X Q monadM_qbs Y"
  unfolding monadP_qbs_def by(rule qbs_morphism_subD)

lemma qbs_morphism_monadPD': "f  monadM_qbs X Q Y  f  monadP_qbs X Q Y"
  unfolding monadP_qbs_def by(rule qbs_morphism_subI2)

lemma qbs_morphism_monadPI:
  assumes "x. x  qbs_space X  prob_space (qbs_l (f x))" "f  X Q monadM_qbs Y"
  shows "f  X Q monadP_qbs Y"
  using assms by(auto simp: monadP_qbs_def intro!:qbs_morphism_subI1)

lemma qbs_morphism_monadPI':
  assumes "x. x  qbs_space X  f x  qbs_space (monadP_qbs Y)" "f  X Q monadM_qbs Y"
  shows "f  X Q monadP_qbs Y"
  using assms by(auto intro!: qbs_morphism_monadPI simp: monadP_qbs_space)

lemma qbs_morphism_monadPI'':
  assumes "f  monadM_qbs X Q monadM_qbs Y" "s. s  qbs_space (monadP_qbs X)  f s  qbs_space (monadP_qbs Y)"
  shows "f  monadP_qbs X Q monadP_qbs Y"
proof -
  have 1:"X. monadP_qbs X = sub_qbs (monadM_qbs X) {s. qbs_space_of s = X  prob_space (qbs_l s)}" (is "X. ?l X = ?r X")
  proof -
    fix X
    have "?l X = sub_qbs (sub_qbs (monadM_qbs X) (qbs_space (monadM_qbs X))) {s. prob_space (qbs_l s)}"
      by(simp add: sub_qbs_ident monadP_qbs_def)
    also have "... = ?r X"
      by(auto simp: sub_qbs_sub_qbs monadM_qbs_space Collect_conj_eq)
    finally show "?l X = ?r X" .
  qed
  show ?thesis
    unfolding 1 using assms(2) by(auto intro!: qbs_morphism_subsubI[OF assms(1),of " {s. qbs_space_of s = X  prob_space (qbs_l s)}" " {s. qbs_space_of s = Y  prob_space (qbs_l s)}"] simp: 1 sub_qbs_space monadM_qbs_space)
qed

lemma monadP_qbs_Mx: "qbs_Mx (monadP_qbs X) = {λr. X, α, k rsfin |α k. α  qbs_Mx X  k  borel M prob_algebra borel}"
proof safe
  fix γ
  assume h:"γ  qbs_Mx (monadP_qbs X)"
  then obtain α k where h1:
   "γ = (λr. X, α, k rsfin)" "α  qbs_Mx X" "s_finite_kernel borel borel k" "r. qbs_s_finite X α (k r)"
    using rep_qbs_Mx_monadM[of γ X] by(simp add: monadP_qbs_def sub_qbs_Mx) metis
  interpret s_finite_kernel borel borel k by fact
  have "γ  UNIV  {s. qbs_space_of s = X  prob_space (qbs_l s)}"
    using h qbs_Mx_to_X[OF h] by(auto simp: monadP_qbs_def sub_qbs_Mx monadM_qbs_space sub_qbs_space)
  hence "r. prob_space (k r)"
    using h1(2) by(auto simp add: h1(1) Pi_iff qbs_s_finite.qbs_l[OF h1(4)] intro!: prob_space_distrD[of α _ "qbs_to_measure X"])
  hence "prob_kernel borel borel k"
    by(auto simp: prob_kernel_def prob_kernel_axioms_def measure_kernel_axioms)
  with h1(1,2) show "α k. γ = (λr. X, α, k rsfin)  α  qbs_Mx X  k  borel M prob_algebra borel"
    by(auto intro!: exI[where x=α] exI[where x=k] simp: prob_kernel_def')
next
  fix α and k :: "real  real measure"
  assume h:"α  qbs_Mx X" "k  borel M prob_algebra borel"
  then interpret pk: prob_kernel borel borel k
    by(simp add: prob_kernel_def'[symmetric])
  have qp: "qbs_prob X α (k r)" for r
    using h by(auto simp: qbs_prob_def in_Mx_def pk.kernel_sets pk.prob_spaces real_distribution_axioms_def real_distribution_def)
  show "(λr. X, α, k rsfin)  qbs_Mx (monadP_qbs X)"
    using h(1) qp by(auto simp: monadP_qbs_def sub_qbs_Mx monadM_qbs_space qbs_s_finite.qbs_l[OF qbs_prob.qbs_s_finite[OF qp]] qbs_s_finite.qbs_space_of[OF qbs_prob.qbs_s_finite[OF qp]] monadM_qbs_Mx qbs_prob_def  real_distribution_def intro!: exI[where x=α] exI[where x=k] h pk.s_finite_kernel_axioms prob_space.prob_space_distr)
qed

lemma rep_qbs_Mx_monadP:
  assumes "γ  qbs_Mx (monadP_qbs X)"
  obtains α k where "γ = (λr. X, α, k rsfin)" "α  qbs_Mx X" "k  borel M prob_algebra borel" "r. qbs_prob X α (k r)"
proof -
  have "α r k. α  qbs_Mx X  k  borel M prob_algebra borel  qbs_prob X α (k r)"
    by(auto simp: qbs_prob_def in_Mx_def real_distribution_def real_distribution_axioms_def prob_kernel_def'[symmetric] prob_kernel_def prob_kernel_axioms_def measure_kernel_def)
  thus ?thesis
    using assms that by(fastforce simp: monadP_qbs_Mx)
qed

lemma qbs_l_monadP_le1:"s  qbs_space (monadP_qbs X)  qbs_l s A  1"
  by(auto simp: monadP_qbs_space intro!: prob_space.emeasure_le_1)

lemma qbs_l_inj_P: "inj_on qbs_l (qbs_space (monadP_qbs X))"
  by(auto intro!: inj_on_subset[OF qbs_l_inj] simp: monadP_qbs_def sub_qbs_space)

lemma qbs_l_measurable_prob[measurable]:"qbs_l  qbs_to_measure (monadP_qbs X) M prob_algebra (qbs_to_measure X)"
proof(rule qbs_morphism_dest[OF qbs_morphismI])
  fix γ
  assume "γ  qbs_Mx (monadP_qbs X)"
  from rep_qbs_Mx_monadP[OF this] obtain α k where h[measurable]:
   "γ = (λr. X, α, k rsfin)" "α  qbs_Mx X" "k  borel M prob_algebra borel" "r. qbs_prob X α (k r)"
    by metis
  show "qbs_l  γ  qbs_Mx (measure_to_qbs (prob_algebra (qbs_to_measure X)))"
    by(auto simp: qbs_Mx_R comp_def h(1) qbs_s_finite.qbs_l[OF qbs_prob.qbs_s_finite[OF h(4)]])
qed

lemma return_qbs_morphismP: "return_qbs X  X Q monadP_qbs X"
proof(rule qbs_morphismI)
  interpret rr : real_distribution "return borel 0"
    by(simp add: real_distribution_def real_distribution_axioms_def prob_space_return)
  fix α
  assume h:"α  qbs_Mx X"
  then have 1:"return_qbs X  α = (λr. X, α, return borel rsfin)"
    by(rule return_qbs_comp)
  show "return_qbs X  α  qbs_Mx (monadP_qbs X)"
    by(auto simp: 1 monadP_qbs_Mx h intro!: exI[where x=α] exI[where x="return borel"])
qed

lemma(in qbs_prob)
  assumes "s = X, α, μsfin"
          "f  X Q monadP_qbs Y"
          "β  qbs_Mx Y"
      and g[measurable]:"g  borel M prob_algebra borel"
      and "(f  α) = (λr. Y, β, g rsfin)"
    shows bind_qbs_prob:"qbs_prob Y β (μ  g)"
      and bind_qbs': "s  f = Y, β, μ  gsfin"
proof -
  interpret prob_kernel borel borel g
    using assms(4) by(simp add: prob_kernel_def')
  have "prob_space (μ  g)"
    by(auto intro!: prob_space_bind'[OF _ g] simp: space_prob_algebra prob_space_axioms)
  thus "qbs_prob Y β (μ  g)" "s  f = Y, β, μ  gsfin"
    using qbs_s_finite.qbs_probI[OF bind_qbs_s_finite[OF assms(1) qbs_morphism_monadPD[OF assms(2)] assms(3) s_finite_kernel_axioms assms(5)]]
    by(simp_all add: bind_qbs[OF assms(1) qbs_morphism_monadPD[OF assms(2)] assms(3) s_finite_kernel_axioms assms(5)] bind_kernel_bind[of g μ borel])
qed

lemma bind_qbs_morphism'P:
  assumes "f  X Q monadP_qbs Y"
  shows "(λx. x  f)  monadP_qbs X Q monadP_qbs Y"
proof(safe intro!: qbs_morphism_monadPI')
  fix x
  assume "x  qbs_space (monadP_qbs X)"
  from rep_qbs_space_monadP[OF this] obtain α μ where h:"x = X, α, μsfin" "qbs_prob X α μ"
    by metis
  then interpret qbs_prob X α μ by simp
  from rep_qbs_Mx_monadP[OF qbs_morphism_Mx[OF assms in_Mx]] obtain β g where h'[measurable]:
  "f  α = (λr. Y, β, g rsfin)" "β  qbs_Mx Y" "g  borel M prob_algebra borel" by metis
  show "x  f  qbs_space (monadP_qbs Y)"
    using sets_bind[of μ g] measurable_space[OF h'(3),simplified space_prob_algebra]
    by(auto simp: qbs_prob.bind_qbs'[OF h(2,1) assms h'(2,3,1)] qbs_prob_def in_Mx_def h'(2) real_distribution_def real_distribution_axioms_def intro!: qbs_prob.in_space_monadP prob_space_bind[where S=borel] measurable_prob_algebraD)
qed(auto intro!: qbs_morphism_monadPD' bind_qbs_morphism'[OF qbs_morphism_monadPD[OF assms]])

lemma distr_qbs_morphismP':
  assumes "f  X Q Y"
  shows "distr_qbs X Y f  monadP_qbs X Q monadP_qbs Y"
  unfolding distr_qbs_def
  by(rule bind_qbs_morphism'P[OF qbs_morphism_comp[OF assms return_qbs_morphismP]])

lemma join_qbs_morphismP: "join_qbs  monadP_qbs (monadP_qbs X) Q monadP_qbs X"
  by(simp add: join_qbs_def bind_qbs_morphism'P[OF qbs_morphism_ident])

lemma
  assumes "qbs_prob (monadP_qbs X) β μ"
          "ssx = monadP_qbs X, β, μsfin"
          "α  qbs_Mx X"
          "g  borel M prob_algebra borel"
      and "β =(λr. X, α, g rsfin)"
    shows qbs_prob_join_qbs_s_finite: "qbs_prob X α (μ  g)"
      and qbs_prob_join_qbs: "join_qbs ssx = X, α, μ  gsfin"
  using qbs_prob.bind_qbs'[OF assms(1,2) qbs_morphism_ident assms(3,4)] qbs_prob.bind_qbs_prob[OF assms(1,2) qbs_morphism_ident assms(3,4)]
  by(auto simp: assms(5) join_qbs_def)

context
begin

interpretation rr : standard_borel_ne "borel M borel :: (real × real) measure"
  by(auto intro!: pair_standard_borel_ne)

lemma strength_qbs_ab_r_prob:
  assumes "α  qbs_Mx X"
          "β  qbs_Mx (monadP_qbs Y)"
          "γ  qbs_Mx Y"
      and [measurable]:"g  borel M prob_algebra borel"
      and "β = (λr. Y, γ, g rsfin)"
    shows "qbs_prob (X Q Y) (map_prod α γ  rr.from_real) (distr (return borel r M g r) borel rr.to_real)"
  using measurable_space[OF assms(4),of r] sets_return[of borel r]
  by(auto intro!: qbs_s_finite.qbs_probI strength_qbs_ab_r_s_finite[OF assms(1) qbs_Mx_monadPM[OF assms(2)] assms(3) prob_kernel.s_finite_kernel_prob_kernel assms(5),simplified prob_kernel_def',OF assms(4)] prob_space.prob_space_distr prob_space_pair prob_space_return simp: space_prob_algebra simp del: sets_return)

lemma strength_qbs_morphismP: "strength_qbs X Y  X Q monadP_qbs Y Q monadP_qbs (X Q Y)"
proof(rule pair_qbs_morphismI)
  fix α β
  assume h:"α  qbs_Mx X"
           "β  qbs_Mx (monadP_qbs Y)"
  from rep_qbs_Mx_monadP[OF this(2)] obtain γ g where hb[measurable]:
   "β = (λr. Y, γ, g rsfin)" "γ  qbs_Mx Y" "g  borel M prob_algebra borel"
    by metis
  show "(λr. strength_qbs X Y (α r, β r))  qbs_Mx (monadP_qbs (X Q Y))"
    using strength_qbs_ab_r_prob[OF h hb(2,3,1)] strength_qbs_ab_r[OF h(1) qbs_Mx_monadPM[OF h(2)] hb(2) prob_kernel.s_finite_kernel_prob_kernel hb(1),simplified prob_kernel_def',OF hb(3)]
    by(auto simp: monadP_qbs_Mx qbs_prob_def in_Mx_def intro!: exI[where x="map_prod α γ  rr.from_real"] exI[where x="λr. distr (return borel r M g r) borel rr.to_real"])
qed

end

lemma bind_qbs_morphismP: "(⤜)  monadP_qbs X Q (X Q monadP_qbs Y) Q monadP_qbs Y"
proof -
  {
    fix f s
    assume h:"f  X Q monadP_qbs Y" "s  qbs_space (monadP_qbs X)"
    from rep_qbs_space_monadP[OF this(2)] obtain α μ where h':
     "s = X, α, μsfin" "qbs_prob X α μ" by metis
    then interpret qbs_prob X α μ by simp
    from rep_qbs_Mx_monadP[OF qbs_morphism_Mx[OF h(1) in_Mx]] obtain β g
      where hb[measurable]:"f  α = (λr. Y, β, g rsfin)" "β  qbs_Mx Y" "g  borel M prob_algebra borel" by metis
    have "join_qbs (distr_qbs ((X Q monadP_qbs Y) Q X) (monadP_qbs Y) (λfx. fst fx (snd fx)) (strength_qbs (X Q monadP_qbs Y) X (f, s))) = s  f"
      using qbs_prob_join_qbs[OF qbs_prob.distr_qbs_prob[OF strength_qbs_prob[of f "X Q monadP_qbs Y",OF h(1) h'(1)] strength_qbs[of f "X Q monadP_qbs Y",OF h(1) h'(1)] qbs_morphism_eval] qbs_s_finite.distr_qbs[OF strength_qbs_s_finite[of f "X Q monadP_qbs Y",OF h(1) h'(1)] strength_qbs[of f "X Q monadP_qbs Y",OF h(1) h'(1)] qbs_morphism_eval] hb(2,3)] hb(1)
      by(simp add: bind_qbs[OF h'(1)  qbs_morphism_monadPD[OF h(1)] hb(2) prob_kernel.s_finite_kernel_prob_kernel hb(1),simplified prob_kernel_def',OF hb(3)] comp_def bind_kernel_bind[of g μ borel,OF measurable_prob_algebraD])
  }
  thus ?thesis
    by(auto intro!: arg_swap_morphism[OF curry_preserves_morphisms [OF qbs_morphism_cong'[of _ "join_qbs  (distr_qbs (exp_qbs X (monadP_qbs Y) Q X) (monadP_qbs Y) (λfx. (fst fx) (snd fx)))  (strength_qbs (exp_qbs X (monadP_qbs Y)) X)"]]] qbs_morphism_comp distr_qbs_morphismP' strength_qbs_morphismP join_qbs_morphismP qbs_morphism_eval simp: pair_qbs_space)
qed

corollary strength_qbs_law1P:
  assumes "x  qbs_space (unit_quasi_borel Q monadP_qbs X)"
  shows "snd x = (distr_qbs (unit_quasi_borel Q X) X snd  strength_qbs unit_quasi_borel X) x"
  by(rule strength_qbs_law1, insert assms) (auto simp: pair_qbs_space qbs_space_monadPM)

corollary strength_qbs_law2P:
  assumes "x  qbs_space ((X Q Y) Q monadP_qbs Z)"
  shows "(strength_qbs X (Y Q Z)  (map_prod id (strength_qbs Y Z))  (λ((x,y),z). (x,(y,z)))) x =
         (distr_qbs ((X Q Y) Q Z) (X Q (Y Q Z)) (λ((x,y),z). (x,(y,z)))  strength_qbs (X Q Y) Z) x"
  by(rule strength_qbs_law2, insert assms) (auto simp: pair_qbs_space qbs_space_monadPM)

lemma strength_qbs_law4P:
  assumes "x  qbs_space (X Q monadP_qbs (monadP_qbs Y))"
  shows "(strength_qbs X Y  map_prod id join_qbs) x = (join_qbs  distr_qbs (X Q monadP_qbs Y) (monadP_qbs (X Q Y)) (strength_qbs X Y)  strength_qbs X (monadP_qbs Y)) x"
        (is "?lhs = ?rhs")
proof -
  from assms rep_qbs_space_monadP[of "snd x" "monadP_qbs Y"] obtain β μ
    where h:"qbs_prob (monadP_qbs Y) β μ" "snd x = monadP_qbs Y, β, μsfin"
    by (auto simp: pair_qbs_space) metis
  then interpret qp: qbs_prob "monadP_qbs Y" β μ by simp
  from rep_qbs_Mx_monadP[OF qp.in_Mx] obtain γ g
    where h': "γ  qbs_Mx Y" "g  borel M prob_algebra borel" "β = (λr. Y, γ, g rsfin)"
      and h'': "r. qbs_prob Y γ (g r)"
    by metis
  have "?lhs = X Q Y, λr. (fst x, γ r), μ  gsfin"
    using qbs_s_finite.strength_qbs[OF qbs_prob.qbs_s_finite[OF qbs_prob_join_qbs_s_finite[OF h h']] _ qbs_prob_join_qbs[OF h h'],of "fst x" X] assms
    by (auto simp: pair_qbs_space)
  also have "... = ?rhs"
    using qbs_prob_join_qbs[OF qbs_prob.distr_qbs_prob[OF qp.strength_qbs_prob[OF _ h(2),of "fst x" X] qp.strength_qbs[OF _ h(2)] strength_qbs_morphismP] qbs_s_finite.distr_qbs[OF qp.strength_qbs_s_finite[OF _ h(2),of "fst x" X] qp.strength_qbs[OF _ h(2)] strength_qbs_morphismP] pair_qbs_MxI h'(2),of "λr. (fst x, γ r)",simplified comp_def qbs_s_finite.strength_qbs[OF qbs_prob.qbs_s_finite[OF h''] _ fun_cong[OF h'(3)]]] assms
    by(auto simp: pair_qbs_space h')
  finally show ?thesis .
qed

lemma distr_qbs_morphismP: "distr_qbs X Y  X Q Y Q monadP_qbs X Q monadP_qbs Y"
proof -
  note [qbs] = bind_qbs_morphismP return_qbs_morphismP
  have [simp]: "distr_qbs X Y = (λf sx. sx  return_qbs Y  f)"
    by standard+ (auto simp: distr_qbs_def)
  show ?thesis
    by simp
qed

lemma bind_qbs_return_rotateP:
  assumes "p  qbs_space (monadP_qbs X)"
      and "q  qbs_space (monadP_qbs Y)"
    shows "q  (λy. p  (λx. return_qbs (X Q Y) (x,y))) = p  (λx. q  (λy. return_qbs (X Q Y) (x,y)))"
  by(auto intro!: bind_qbs_return_rotate qbs_space_monadPM assms)

lemma qbs_bind_bind_return1P:
  assumes "f   X Q Y Q monadP_qbs Z"
          "p  qbs_space (monadP_qbs X)"
          "q  qbs_space (monadP_qbs Y)"
    shows "q  (λy. p  (λx. f (x,y))) = (q  (λy. p  (λx. return_qbs (X Q Y) (x,y))))  f"
  by(auto intro!: qbs_bind_bind_return1 assms qbs_space_monadPM qbs_morphism_monadPD)

corollary qbs_bind_bind_return1P':
  assumes [qbs]:"f  qbs_space (X Q Y Q monadP_qbs Z)"
          "p  qbs_space (monadP_qbs X)"
          "q  qbs_space (monadP_qbs Y)"
    shows "q  (λy. p  (λx. f x y)) = (q  (λy. p  (λx. return_qbs (X Q Y) (x,y))))  (case_prod f)"
  by(auto intro!: qbs_bind_bind_return1P[where f="case_prod f" and Z=Z,simplified])

lemma qbs_bind_bind_return2P:
  assumes "f   X Q Y Q monadP_qbs Z"
          "p  qbs_space (monadP_qbs X)" "q  qbs_space (monadP_qbs Y)"
    shows "p  (λx. q  (λy. f (x,y))) = (p  (λx. q  (λy. return_qbs (X Q Y) (x,y))))  f"
  by(auto intro!: qbs_bind_bind_return2 assms qbs_space_monadPM qbs_morphism_monadPD)

corollary qbs_bind_bind_return2P':
  assumes [qbs]:"f  qbs_space (X Q Y Q monadP_qbs Z)"
          "p  qbs_space (monadP_qbs X)"
          "q  qbs_space (monadP_qbs Y)"
    shows "p  (λx. q  (λy. f x y)) = (p  (λx. q  (λy. return_qbs (X Q Y) (x,y))))  (case_prod f)"
  by(auto intro!: qbs_bind_bind_return2P[where f="case_prod f" and Z=Z,simplified])

corollary bind_qbs_rotateP:
  assumes "f   X Q Y Q monadP_qbs Z"
          "p  qbs_space (monadP_qbs X)"
      and "q  qbs_space (monadP_qbs Y)"
    shows "q  (λy. p  (λx. f (x,y))) = p  (λx. q  (λy. f (x,y)))"
  by(auto intro!: bind_qbs_rotate assms qbs_space_monadPM qbs_morphism_monadPD)

context pair_qbs_probs
begin

interpretation rr : standard_borel_ne "borel M borel :: (real × real) measure"
  by(auto intro!: pair_standard_borel_ne)

sublocale qbs_prob "X Q Y" "map_prod α β  rr.from_real" "distr (μ M ν) borel rr.to_real"
  by(auto simp: qbs_prob_def in_Mx_def real_distribution_def qbs_Mx_is_morphisms real_distribution_axioms_def pq1.prob_space_axioms pq2.prob_space_axioms intro!: prob_space.prob_space_distr prob_space_pair)

lemma  qbs_bind_bind_return_prob:
  assumes [qbs]:"f  X Q Y Q Z"
  shows "qbs_prob Z (f  (map_prod α β  rr.from_real)) (distr (μ M ν) borel rr.to_real)"
  using qbs_prob_axioms by(auto simp: qbs_prob_def in_Mx_def qbs_Mx_is_morphisms)

end

subsubsection ‹ Almost Everywhere ›
lift_definition qbs_almost_everywhere :: "['a qbs_measure, 'a  bool]  bool"
is "λ(X,α,μ). almost_everywhere (distr μ (qbs_to_measure X) α)"
  by(auto simp: qbs_s_finite_eq_def) metis

syntax
  "_qbs_almost_everywhere" :: "pttrn  'a  bool  bool" ("AEQ _ in _. _" [0,0,10] 10)

translations
  "AEQ x in p. P"  "CONST qbs_almost_everywhere p (λx. P)"

lemma AEq_qbs_l: "(AEQ x in p. P x) = (AE x in qbs_l p. P x)"
  by transfer (simp add: case_prod_beta')

lemma(in qbs_s_finite) AEq_def:
 "(AEQ x in X, α, μsfin . P x) = (AE x in (distr μ (qbs_to_measure X) α). P x)"
  by(simp add: qbs_almost_everywhere.abs_eq)

lemma(in qbs_s_finite) AEq_AE: "(AEQ x in X, α, μsfin . P x)  (AE x in μ. P (α x))"
  by(auto simp: AEq_def intro!:AE_distrD[of α])

lemma(in qbs_s_finite) AEq_AE_iff:
  assumes [qbs]:"qbs_pred X P"
  shows "(AEQ x in X, α, μsfin . P x)  (AE x in μ. P (α x))"
  by(auto simp: AEq_AE AEq_def qbs_pred_iff_sets intro!: AE_distr_iff[THEN iffD2])

lemma AEq_qbs_pred[qbs]: "qbs_almost_everywhere  monadM_qbs X Q (X Q qbs_count_space UNIV) Q qbs_count_space UNIV"
proof(rule curry_preserves_morphisms[OF pair_qbs_morphismI])
  fix γ β
  assume h:"γ  qbs_Mx (monadM_qbs X)"  "β  qbs_Mx (X Q qbs_count_space (UNIV :: bool set))"
  from rep_qbs_Mx_monadM[OF h(1)] obtain α k where hk:
   "γ = (λr. X, α, k rsfin)" "α  qbs_Mx X" "s_finite_kernel borel borel k" "r. qbs_s_finite X α (k r)"
    by metis
  interpret s:standard_borel_ne "borel :: real measure" by simp
  interpret s2: standard_borel_ne "borel M borel :: (real × real) measure" by(simp add: borel_prod)
  have [measurable]:"Measurable.pred (borel M borel) (λ(x, y). β x (α y))"
    using h(2) hk(2) by(simp add: s2.qbs_pred_iff_measurable_pred[symmetric] r_preserves_product qbs_Mx_is_morphisms)
  show "(λr. qbs_almost_everywhere (fst (γ r, β r)) (snd (γ r, β r)))  qbs_Mx (qbs_count_space UNIV)"
    using h(2) hk(2) by(simp add: hk(1) qbs_Mx_is_morphisms qbs_s_finite.AEq_AE_iff[OF hk(4)])
    (auto simp add: s.qbs_pred_iff_measurable_pred intro!: s_finite_kernel.AE_pred[OF hk(3)])    
qed

lemma AEq_I2[simp]:
  assumes "p  qbs_space (monadM_qbs X)" "x. x  qbs_space X  P x"
  shows "AEQ x in p. P x"
  by(auto simp: space_qbs_l_in[OF assms(1)] assms(2) AEq_qbs_l)

lemma AEq_mp[elim!]:
  assumes "AEQ x in s. P x" "AEQ x in s. P x  Q x"
  shows "AEQ x in s. Q x"
  using assms by(auto simp: AEq_qbs_l)

lemma
  shows AEq_iffI: "AEQ x in s. P x  AEQ x in s. P x  Q x  AEQ x in s. Q x"
    and AEq_disjI1: "AEQ x in s. P x  AEQ x in s. P x  Q x"
    and AEq_disjI2: "AEQ x in s. Q x  AEQ x in s. P x  Q x"
    and AEq_conjI: "AEQ x in s. P x  AEQ x in s. Q x  AEQ x in s. P x  Q x"
    and AEq_conj_iff[simp]: "(AEQ x in s. P x  Q x)  (AEQ x in s. P x)  (AEQ x in s. Q x)"
  by(auto simp: AEq_qbs_l)

lemma AEq_symmetric:
  assumes "AEQ x in s. P x = Q x"
  shows "AEQ x in s. Q x = P x"
  using assms by(auto simp: AEq_qbs_l)

lemma AEq_impI: "(P  AEQ x in M. Q x)  AEQ x in M. P  Q x"
  by(auto simp: AEq_qbs_l AE_impI)

lemma AEq_Ball_mp:
  "s  qbs_space (monadM_qbs X)  (x. xqbs_space X  P x)  AEQ x in s. P x  Q x  AEQ x in s. Q x"
  by auto

lemma AEq_cong:
  "s  qbs_space (monadM_qbs X)  (x. x  qbs_space X  P x  Q x)  (AEQ x in s. P x)  (AEQ x in s. Q x)"
  by auto

lemma AEq_cong_simp: "s  qbs_space (monadM_qbs X)  (x. x  qbs_space X =simp=> P x = Q x)  (AEQ x in s. P x)  (AEQ x in s. Q x)"
  by (auto simp: simp_implies_def)

lemma AEq_all_countable: "(AEQ x in s. i. P i x)  (i::'i::countable. AEQ x in s. P i x)"
  by(simp add: AEq_qbs_l AE_all_countable)

lemma AEq_ball_countable: "countable X  (AEQ x in s. yX. P x y)  (yX. AEQ x in s. P x y)"
  by(simp add: AEq_qbs_l AE_ball_countable)

lemma AEq_ball_countable': "(N. N  I  AEQ x in s. P N x)  countable I  AEQ x in s. N  I. P N x"
  unfolding AEq_ball_countable by simp

lemma AEq_pairwise: "countable F  pairwise (λA B. AEQ x in s. R x A B) F  (AEQ x in s. pairwise (R x) F)"
  unfolding pairwise_alt by (simp add: AEq_ball_countable)

lemma AEq_finite_all: "finite S  (AEQ x in s. iS. P i x)  (iS. AEQ x in s. P i x)"
  by(simp add: AEq_qbs_l AE_finite_all)

lemma AE_finite_allI:"finite S  (s. s  S  AEQ x in M. Q s x)  AEQ x in M. sS. Q s x"
  by(simp add: AEq_qbs_l AE_finite_all)

subsubsection ‹ Integral ›
lift_definition qbs_nn_integral :: "['a qbs_measure, 'a  ennreal]  ennreal"
is "λ(X,α,μ) f.(+x. f x distr μ (qbs_to_measure X) α)"
  by(auto simp: qbs_s_finite_eq_def)

lift_definition qbs_integral :: "['a qbs_measure, 'a  ('b :: {banach,second_countable_topology})]  'b"
is "λp f. if f  (fst p) Q qbs_borel then (x. f (fst (snd p) x)  (snd (snd p))) else 0"
  using qbs_s_finite_eq_dest(3) qbs_s_finite_eq_1_imp_2 by fastforce

syntax
  "_qbs_nn_integral" :: "pttrn  ennreal  'a qbs_measure  ennreal" ("+Q((2 _./ _)/ _)" [60,61] 110)

translations
 "+Q x. f p"  "CONST qbs_nn_integral p (λx. f)"

syntax
  "_qbs_integral" :: "pttrn  _  'a qbs_measure  _" ("Q((2 _./ _)/ _)" [60,61] 110)

translations
 "Q x. f p"  "CONST qbs_integral p (λx. f)"

lemma(in qbs_s_finite)
  shows qbs_nn_integral_def: "f  X Q qbs_borel  (+Q x. f x X, α, μsfin) = (+x. f (α x)  μ)"
    and qbs_nn_integral_def2:"(+Q x. f x X, α, μsfin) = (+x. f x (distr μ (qbs_to_measure X) α))"
  by(simp_all add: qbs_nn_integral.abs_eq nn_integral_distr lr_adjunction_correspondence)

lemma(in qbs_s_finite) qbs_integral_def:
 "f  X Q qbs_borel  (Q x. f x X, α, μsfin) = (x. f (α x)  μ)"
  by(simp add: qbs_integral.abs_eq)

lemma(in qbs_s_finite) qbs_integral_def2: "(Q x. f x X, α, μsfin) = (x. f x (distr μ (qbs_to_measure X) α))"
proof -
 consider "f  X Q qbs_borel" | "f  X Q qbs_borel" by auto
  thus ?thesis
  proof cases
    case h:2
    then have "¬ integrable (qbs_l X, α, μsfin) f"
      by (metis borel_measurable_integrable measurable_distr_eq1 qbs_l qbs_morphism_measurable_intro)
    thus ?thesis
      using h by(simp add: qbs_l qbs_integral.abs_eq lr_adjunction_correspondence not_integrable_integral_eq)
  qed(simp add: qbs_integral.abs_eq lr_adjunction_correspondence integral_distr)
qed

lemma qbs_measure_eqI:
  assumes [qbs]:"p  qbs_space (monadM_qbs X)" "q  qbs_space (monadM_qbs X)"
      and "f. f  X Q qbs_borel  (+Q x. f x p) = (+Q x. f x q)"
    shows "p = q"
proof -
  obtain α μ β ν where h:"p = X, α, μsfin" "q = X, β, νsfin" "qbs_s_finite X α μ" "qbs_s_finite X  β ν"
    by (metis rep_qbs_space_monadM assms(1,2))
  then interpret pq:pair_qbs_s_finite X α μ β ν
    by(auto simp: pair_qbs_s_finite_def)
  show ?thesis
    using assms(3) by(auto simp: h(1,2) pq.pq1.qbs_nn_integral_def pq.pq2.qbs_nn_integral_def intro!: pq.qbs_s_finite_measure_eq')
qed

lemma qbs_nn_integral_def2_l: "qbs_nn_integral s f = integralN (qbs_l s) f"
  by transfer auto

lemma qbs_integral_def2_l: "qbs_integral s f = integralL (qbs_l s) f"
  by (metis in_qbs_space_of qbs_s_finite.qbs_integral_def2 qbs_s_finite.qbs_l rep_qbs_space_monadM)

lift_definition qbs_integrable :: "'a qbs_measure  ('a  'b::{second_countable_topology,banach})  bool"
is "λp f. f  fst p Q qbs_borel  integrable (snd (snd p)) (f  (fst (snd p)))"
proof safe
  have 0:"f  Y Q qbs_borel" "integrable ν (λx. f (β x))" if "qbs_s_finite_eq (X,α,μ) (Y,β,ν)" "f  X Q qbs_borel" "integrable μ (λx. f (α x))" for X :: "'a quasi_borel" and  Y α β μ ν and f :: "_  'b"
  proof -
    interpret pair_qbs_s_finite X α μ β ν
      using qbs_s_finite_eq_dest[OF that(1)] by(auto simp: pair_qbs_s_finite_def)
    show "f  Y Q qbs_borel" "integrable ν (λx. f (β x))"
      using that qbs_s_finite_eq_dest(3)[OF that(1)] by(simp_all add: integrable_distr_eq[symmetric,of α μ "qbs_to_measure X" f] integrable_distr_eq[symmetric,of β ν "qbs_to_measure X" f] lr_adjunction_correspondence qbs_s_finite_eq_dest(4)[OF that(1)])
  qed
  {
    fix X Y :: "'a quasi_borel"
    fix α β μ ν and f :: "_  'b"
    assume 1:"qbs_s_finite_eq (X, α, μ) (Y, β, ν)"
    then have 2:"qbs_s_finite_eq (Y, β, ν) (X, α, μ)" by(auto simp: qbs_s_finite_eq_def)
    have "f  X Q qbs_borel  integrable μ (f  α)  f  Y Q qbs_borel  integrable ν (f  β)"
      unfolding comp_def using 0[OF 1,of f] 0[OF 2,of f] by blast
  }
  thus "prod1 prod2 :: 'a qbs_s_finite_t. qbs_s_finite_eq prod1 prod2  (λf:: _  'b. f  fst prod1 Q borelQ  integrable (snd (snd prod1)) (f  fst (snd prod1))) = (λf. f  fst prod2 Q borelQ  integrable (snd (snd prod2)) (f  fst (snd prod2)))"
    by fastforce
qed

lemma(in qbs_s_finite) qbs_integrable_def:
 "qbs_integrable X, α, μsfin f  f  X Q qbs_borel  integrable μ (λx. f (α x))"
  by(simp add: qbs_integrable.abs_eq comp_def)

lemma qbs_integrable_morphism_dest:
  assumes "s  qbs_space (monadM_qbs X)"
      and "qbs_integrable s f"
    shows "f  X Q qbs_borel"
  by (metis assms qbs_s_finite.qbs_integrable_def rep_qbs_space_monadM)

lemma qbs_integrable_morphismP:
  assumes "s  qbs_space (monadP_qbs X)"
      and "qbs_integrable s f"
    shows "f  X Q qbs_borel"
  by(auto intro!: qbs_integrable_morphism_dest assms qbs_space_monadPM)

lemma(in qbs_s_finite) qbs_integrable_measurable[simp]:
  assumes "qbs_integrable X,α,μsfin f"
  shows "f  qbs_to_measure X M borel"
  by(auto intro!: qbs_integrable_morphism_dest assms simp: lr_adjunction_correspondence[symmetric])

lemma qbs_integrable_iff_integrable:
  "(qbs_integrable (s::'a qbs_measure) (f :: 'a  'b::{second_countable_topology,banach})) = (integrable (qbs_l s) f)"
proof transfer
  fix f ::" 'a  'b::{second_countable_topology,banach}"
  show "qbs_s_finite_eq s s  (f  fst s Q borelQ  integrable (snd (snd s)) (f  fst (snd s))) = integrable (distr (snd (snd s)) (qbs_to_measure (fst s)) (fst (snd s))) f" for s
  proof(rule prod_cases3[of s])
    fix X :: "'a quasi_borel"
    fix α μ
    assume "qbs_s_finite_eq s s" and s: "s = (X,α,μ)"
    then interpret qbs_s_finite X α μ by(simp add: qbs_s_finite_eq_def)
    show "f  fst s Q qbs_borel  integrable (snd (snd s)) (λx. (f  fst (snd s)) x)  integrable (distr (snd (snd s)) (qbs_to_measure (fst s)) (fst (snd s))) f"
      using integrable_distr_eq[of α μ "qbs_to_measure X" f,simplified]
      by(auto simp add: lr_adjunction_correspondence s)
  qed
qed

corollary(in qbs_s_finite) qbs_integrable_distr: "qbs_integrable X, α, μsfin f = integrable (distr μ (qbs_to_measure X) α) f"
  by(simp add: qbs_integrable_iff_integrable qbs_l)

lemma qbs_integrable_morphism[qbs]: "qbs_integrable  monadM_qbs X Q (X Q (qbs_borel :: ('a :: {banach, second_countable_topology}) quasi_borel)) Q qbs_count_space UNIV"
proof(rule curry_preserves_morphisms[OF pair_qbs_morphismI])
  fix γ β
  assume h:"γ  qbs_Mx (monadM_qbs X)" "β  qbs_Mx (X Q (qbs_borel :: 'a quasi_borel))"
  from rep_qbs_Mx_monadM[OF this(1)] obtain α k
    where hk:"γ = (λr. X, α, k rsfin)" "α  qbs_Mx X" "s_finite_kernel borel borel k" "r. qbs_s_finite X α (k r)"
    by metis
  then interpret ina: in_Mx X α by (simp add: in_Mx_def)
  interpret standard_borel_ne "borel :: real measure" by simp
  have [measurable]: "β r  qbs_to_measure X M borel" for r
    using h(2) by(simp add: qbs_Mx_is_morphisms lr_adjunction_correspondence[symmetric])
  have [measurable_cong]: "sets (k r) = sets borel" for r
    using hk(4) qbs_s_finite.mu_sets by blast
  have 1: "borel_measurable (borel M borel) = (qbs_borel Q qbs_borel Q qbs_borel :: (real × real  'a) set)"
    by (metis borel_prod pair_standard_borel qbs_borel_prod standard_borel.standard_borel_r_full_faithful standard_borel_axioms)
  show "(λr. qbs_integrable (fst (γ r, β r)) (snd (γ r, β r)))  qbs_Mx (qbs_count_space UNIV)"
    by(auto simp: fun_cong[OF hk(1)] qbs_s_finite.qbs_integrable_distr[OF hk(4)] integrable_distr_eq qbs_Mx_is_morphisms qbs_pred_iff_measurable_pred  intro!: s_finite_kernel.integrable_measurable_pred[OF hk(3)]) (insert h(2), simp add: 1 qbs_Mx_is_morphisms split_beta')
qed

lemma(in qbs_s_finite) qbs_integrable_iff_integrable:
  assumes "f  qbs_to_measure X M borel"
  shows "qbs_integrable X, α, μsfin f = integrable μ (λx. f (α x))"
  by(auto intro!: integrable_distr_eq[of α μ "qbs_to_measure X" f] simp: assms qbs_integrable_distr)

lemma qbs_integrable_iff_bounded:
  assumes "s  qbs_space (monadM_qbs X)"
  shows "qbs_integrable s f  f  X Q qbs_borel  (+Q x. ennreal (norm (f x)) s) < "
        (is "?lhs = ?rhs")
proof -
  from rep_qbs_space_monadM[OF assms] obtain α μ where hs:
   "qbs_s_finite X α μ" "s = X, α, μsfin"
    by metis
  then interpret qs:qbs_s_finite X α μ by simp
  have "?lhs = integrable (distr μ (qbs_to_measure X) α) f"
    by (simp add: hs(2) qbs_integrable_iff_integrable qs.qbs_l)
  also have "... = (f  borel_measurable (distr μ (qbs_to_measure X) α)  ((+ x. ennreal (norm (f x)) (distr μ (qbs_to_measure X) α)) < ))"
    by(rule integrable_iff_bounded)
  also have "... = ?rhs"
    by(auto simp add: hs(2) qs.qbs_nn_integral_def2 lr_adjunction_correspondence)
  finally show ?thesis .
qed

lemma not_qbs_integrable_qbs_integral: "¬ qbs_integrable s f  qbs_integral s f = 0"
  by(simp add: qbs_integral_def2_l qbs_integrable_iff_integrable not_integrable_integral_eq)

lemma qbs_integrable_cong_AE:
  assumes "s  qbs_space (monadM_qbs X)"
          "AEQ x in s. f x = g x"
      and "qbs_integrable s f" "g  X Q qbs_borel"
    shows "qbs_integrable s g"
  using assms(2,4) by(auto intro!: qbs_integrable_iff_integrable[THEN iffD2] Bochner_Integration.integrable_cong_AE[of g _ f,THEN iffD2] qbs_integrable_iff_integrable[THEN iffD1,OF assms(3)] qbs_integrable_morphism_dest[OF assms(1),of f] simp:  AEq_qbs_l measurable_qbs_l[OF assms(1)])

lemma qbs_integrable_cong:
  assumes "s  qbs_space (monadM_qbs X)"
          "x. x  qbs_space X  f x = g x"
      and "qbs_integrable s f"
    shows "qbs_integrable s g"
  by(auto intro!: qbs_integrable_iff_integrable[THEN iffD2] Bochner_Integration.integrable_cong[OF refl,of _ g f,THEN iffD2] qbs_integrable_iff_integrable[THEN iffD1,OF assms(3)] simp: space_qbs_l_in[OF assms(1)] assms(2))

lemma qbs_integrable_zero[simp, intro]: "qbs_integrable s (λx. 0)"
  by(simp add: qbs_integrable_iff_integrable)

lemma qbs_integrable_const:
  assumes "s  qbs_space (monadP_qbs X)"
  shows "qbs_integrable s (λx. c)"
  using assms by(auto intro!: qbs_integrable_iff_integrable[THEN iffD2] finite_measure.integrable_const simp: monadP_qbs_space prob_space_def)

lemma qbs_integrable_add[simp,intro!]:
  assumes "qbs_integrable s f"
      and "qbs_integrable s g"
    shows "qbs_integrable s (λx. f x + g x)"
  by(rule qbs_integrable_iff_integrable[THEN iffD2,OF Bochner_Integration.integrable_add[OF qbs_integrable_iff_integrable[THEN iffD1,OF assms(1)] qbs_integrable_iff_integrable[THEN iffD1,OF assms(2)]]])

lemma qbs_integrable_diff[simp,intro!]:
  assumes "qbs_integrable s f"
      and "qbs_integrable s g"
    shows "qbs_integrable s (λx. f x - g x)"
  by(rule qbs_integrable_iff_integrable[THEN iffD2,OF Bochner_Integration.integrable_diff[OF qbs_integrable_iff_integrable[THEN iffD1,OF assms(1)] qbs_integrable_iff_integrable[THEN iffD1,OF assms(2)]]])

lemma qbs_integrable_sum[simp, intro!]: "(i. i  I  qbs_integrable s (f i))  qbs_integrable s (λx. iI. f i x)"
  by(simp add: qbs_integrable_iff_integrable)

lemma qbs_integrable_scaleR_left[simp, intro!]: "qbs_integrable s f  qbs_integrable s (λx. f x *R (c :: 'a :: {second_countable_topology,banach}))"
  by(simp add: qbs_integrable_iff_integrable)

lemma qbs_integrable_scaleR_right[simp, intro!]: "qbs_integrable s f  qbs_integrable s (λx. c *R (f x :: 'a :: {second_countable_topology,banach}) )"
  by(simp add: qbs_integrable_iff_integrable)

lemma qbs_integrable_mult_iff:
  fixes f :: "'a  real"
  shows "(qbs_integrable s (λx. c * f x)) = (c = 0  qbs_integrable s f)"
  using qbs_integrable_iff_integrable[of s "λx. c * f x"] integrable_mult_left_iff[of _ c f] qbs_integrable_iff_integrable[of s f] 
  by simp

lemma
  fixes c :: "_::{real_normed_algebra,second_countable_topology}"
  assumes "qbs_integrable s f"
  shows qbs_integrable_mult_right:"qbs_integrable s (λx. c * f x)"
    and qbs_integrable_mult_left: "qbs_integrable s (λx. f x * c)"
  using assms by(auto simp: qbs_integrable_iff_integrable)

lemma qbs_integrable_divide_zero[simp, intro!]:
  fixes c :: "_::{real_normed_field, field, second_countable_topology}"
  shows "qbs_integrable s f  qbs_integrable s (λx. f x / c)"
  by(simp add: qbs_integrable_iff_integrable)

lemma qbs_integrable_inner_left[simp, intro!]:
  "qbs_integrable s f  qbs_integrable s (λx. f x  c)"
  by(simp add: qbs_integrable_iff_integrable)

lemma qbs_integrable_inner_right[simp, intro!]:
  "qbs_integrable s f  qbs_integrable s (λx. c  f x)"
  by(simp add: qbs_integrable_iff_integrable)

lemma qbs_integrable_minus[simp, intro!]:
 "qbs_integrable s f  qbs_integrable s (λx. - f x)"
  by(simp add: qbs_integrable_iff_integrable)

lemma [simp, intro]:
  assumes "qbs_integrable s f"
  shows qbs_integrable_Re: "qbs_integrable s (λx. Re (f x))"
    and qbs_integrable_Im: "qbs_integrable s (λx. Im (f x))"
    and qbs_integrable_cnj: "qbs_integrable s (λx. cnj (f x))"
  using assms by(simp_all add: qbs_integrable_iff_integrable)

lemma qbs_integrable_of_real[simp, intro!]:
 "qbs_integrable s f  qbs_integrable s (λx. of_real (f x))"
  by(simp_all add: qbs_integrable_iff_integrable)

lemma [simp, intro]:
  assumes "qbs_integrable s f"
  shows qbs_integrable_fst: "qbs_integrable s (λx. fst (f x))"
    and qbs_integrable_snd: "qbs_integrable s (λx. snd (f x))"
  using assms by(simp_all add: qbs_integrable_iff_integrable)

lemma qbs_integrable_norm:
  assumes "qbs_integrable s f"
  shows "qbs_integrable s (λx. norm (f x))"
  by(rule qbs_integrable_iff_integrable[THEN iffD2,OF integrable_norm[OF qbs_integrable_iff_integrable[THEN iffD1,OF assms]]])

lemma qbs_integrable_abs:
  fixes f :: "_  real"
  assumes "qbs_integrable s f"
  shows "qbs_integrable s (λx. ¦f x¦)"
  by(rule qbs_integrable_iff_integrable[THEN iffD2,OF integrable_abs[OF qbs_integrable_iff_integrable[THEN iffD1,OF assms]]])

lemma qbs_integrable_sq:
  fixes c :: "_::{real_normed_field,second_countable_topology}"
  assumes "qbs_integrable s (λx. c)" "qbs_integrable s f"
      and "qbs_integrable s (λx. (f x)2)"
    shows "qbs_integrable s (λx. (f x - c)2)"
  by(simp add: comm_ring_1_class.power2_diff,rule qbs_integrable_diff,rule qbs_integrable_add)
    (simp_all add: comm_semiring_1_class.semiring_normalization_rules(16)[of 2] assms qbs_integrable_mult_right power2_eq_square[of c])

lemma qbs_nn_integral_eq_integral_AEq:
  assumes "qbs_integrable s f" "AEQ x in s. 0  f x"
    shows "(+Q x. ennreal (f x) s) = ennreal (Q x. f x s)"
  using nn_integral_eq_integral[OF qbs_integrable_iff_integrable[THEN iffD1,OF assms(1)] ] qbs_integrable_morphism_dest[OF in_qbs_space_of assms(1)] assms(2)
  by(simp add: qbs_integral_def2_l qbs_nn_integral_def2_l AEq_qbs_l)

lemma qbs_nn_integral_eq_integral:
  assumes "s  qbs_space (monadM_qbs X)" "qbs_integrable s f"
      and "x. x  qbs_space X  0  f x"
    shows "(+Q x. ennreal (f x) s) = ennreal (Q x. f x s)"
  using qbs_nn_integral_eq_integral_AEq[OF assms(2) AEq_I2[OF assms(1,3)]] by simp

lemma qbs_nn_integral_cong_AEq:
  assumes "s  qbs_space (monadM_qbs X)" "AEQ x in s. f x = g x"
  shows "qbs_nn_integral s f = qbs_nn_integral s g"
proof -
  from rep_qbs_space_monadM[OF assms(1)] obtain α μ
    where hs: "s = X, α, μsfin" "qbs_s_finite X α μ" by metis
  then interpret qs: qbs_s_finite X α μ by simp
  show ?thesis
    using assms(2) by(auto simp: qs.qbs_nn_integral_def2 hs(1) qs.AEq_def intro!: nn_integral_cong_AE)
qed

lemma qbs_nn_integral_cong:
  assumes "s  qbs_space (monadM_qbs X)" "x. x  qbs_space X  f x = g x"
  shows "qbs_nn_integral s f = qbs_nn_integral s g"
  using qbs_nn_integral_cong_AEq[OF assms(1) AEq_I2[OF assms]] by simp

lemma qbs_nn_integral_const:
 "(+Q x. c s) = c * qbs_l s (qbs_space (qbs_space_of s))"
  by(simp add: qbs_nn_integral_def2_l space_qbs_l)

lemma qbs_nn_integral_const_prob:
  assumes "s  qbs_space (monadP_qbs X)"
  shows "(+Q x. c s) = c"
  using assms by(simp add: qbs_nn_integral_const prob_space.emeasure_space_1 qbs_l_prob_space space_qbs_l)

lemma qbs_nn_integral_add:
  assumes "s  qbs_space (monadM_qbs X)"
      and [qbs]:"f  X Q qbs_borel" "g  X Q qbs_borel"
    shows "(+Q x. f x + g x s) = (+Q x. f x s) + (+Q x. g x s)"
  by(auto simp: qbs_nn_integral_def2_l measurable_qbs_l[OF assms(1)] intro!: nn_integral_add measurable_qbs_l)

lemma qbs_nn_integral_cmult:
  assumes "s  qbs_space (monadM_qbs X)" and [qbs]:"f  X Q qbs_borel"
  shows "(+Q x. c * f x s) = c * (+Q x. f x s)"
  by(auto simp: qbs_nn_integral_def2_l measurable_qbs_l[OF assms(1)] intro!: nn_integral_cmult)

lemma qbs_integral_cong_AEq:
  assumes [qbs]:"s  qbs_space (monadM_qbs X)" "f  X Q qbs_borel" "g  X Q qbs_borel"
      and "AEQ x in s. f x = g x"
    shows "qbs_integral s f = qbs_integral s g"
  using assms(4) by(auto simp: qbs_integral_def2_l AEq_qbs_l measurable_qbs_l[OF assms(1)] intro!: integral_cong_AE )

lemma qbs_integral_cong:
  assumes "s  qbs_space (monadM_qbs X)" "x. x  qbs_space X  f x = g x"
  shows "qbs_integral s f = qbs_integral s g"
  by(auto simp: qbs_integral_def2_l space_qbs_l_in[OF assms(1)] assms(2) intro!: Bochner_Integration.integral_cong)

lemma qbs_integral_nonneg_AEq:
  fixes f :: "_  real"
  shows "AEQ x in s. 0  f x  0  qbs_integral s f"
  by(auto simp: qbs_integral_def2_l AEq_qbs_l intro!: integral_nonneg_AE )

lemma qbs_integral_nonneg:
  fixes f :: "_  real"
  assumes "s  qbs_space (monadM_qbs X)" "x. x  qbs_space X  0  f x"
  shows "0  qbs_integral s f"
  by(auto simp: qbs_integral_def2_l space_qbs_l_in[OF assms(1)] assms(2) intro!: Bochner_Integration.integral_nonneg)

lemma qbs_integral_mono_AEq:
  fixes f :: "_  real"
  assumes "qbs_integrable s f" "qbs_integrable s g" "AEQ x in s. f x  g x"
    shows "qbs_integral s f  qbs_integral s g"
  using assms by(auto simp: qbs_integral_def2_l AEq_qbs_l qbs_integrable_iff_integrable intro!: integral_mono_AE)

lemma qbs_integral_mono:
  fixes f :: "_  real"
  assumes "s  qbs_space (monadM_qbs X)"
      and "qbs_integrable s f" "qbs_integrable s g" "x. x  qbs_space X  f x  g x"
    shows "qbs_integral s f  qbs_integral s g"
  by(auto simp: qbs_integral_def2_l space_qbs_l_in[OF assms(1)] qbs_integrable_iff_integrable[symmetric] assms intro!: integral_mono)

lemma qbs_integral_const_prob:
  assumes "s  qbs_space (monadP_qbs X)"
  shows "(Q x. c s) = c"
  using assms by(simp add: qbs_integral_def2_l monadP_qbs_space prob_space.prob_space)

lemma
  assumes "qbs_integrable s f" "qbs_integrable s g"
  shows qbs_integral_add:"(Q x. f x + g x s) = (Q x. f x s) + (Q x. g x s)"
    and qbs_integral_diff: "(Q x. f x - g x s) = (Q x. f x s) - (Q x. g x s)"
  using assms by(auto simp: qbs_integral_def2_l qbs_integrable_iff_integrable[symmetric] intro!: Bochner_Integration.integral_add Bochner_Integration.integral_diff)

lemma [simp]:
  fixes c :: "_::{real_normed_field,second_countable_topology}"
  shows qbs_integral_mult_right_zero:"(Q x. c * f x s) = c * (Q x. f x s)"
    and qbs_integral_mult_left_zero:"(Q x. f x * c s) = (Q x. f x s) * c"
    and qbs_integral_divide_zero: "(Q x. f x / c s) = (Q x. f x s) / c"
   by(auto simp: qbs_integral_def2_l)

lemma qbs_integral_minus[simp]: "(Q x. - f x s) = - (Q x. f x s)"
   by(auto simp: qbs_integral_def2_l)

lemma [simp]:
  shows qbs_integral_scaleR_right:"(Q x. c *R f x s) = c *R (Q x. f x s)"
    and qbs_integral_scaleR_left: "(Q x. f x *R c s) = (Q x. f x s) *R c"
  by(auto simp: qbs_integral_def2_l)

lemma [simp]:
  shows qbs_integral_inner_left: "qbs_integrable s f  (Q x. f x  c s) = (Q x. f x s)  c"
    and qbs_integral_inner_right: "qbs_integrable s f   (Q x. c  f x s) = c  (Q x. f x s) "
  by(auto simp: qbs_integral_def2_l qbs_integrable_iff_integrable)

lemma integral_complex_of_real[simp]: "(Q x. complex_of_real (f x) s)= of_real (Q x. f x s)"
  by(simp add: qbs_integral_def2_l)

lemma integral_cnj[simp]: "(Q x. cnj (f x) s) = cnj (Q x. f x s)"
  by(simp add: qbs_integral_def2_l)

lemma [simp]:
  assumes "qbs_integrable s f"
  shows qbs_integral_Im: "(Q x. Im (f x) s) = Im (Q x. f x s)"
    and qbs_integral_Re: "(Q x. Re (f x) s) = Re (Q x. f x s)"
  using assms by(auto simp: qbs_integral_def2_l qbs_integrable_iff_integrable)

lemma qbs_integral_of_real[simp]:"qbs_integrable s f  (Q x. of_real (f x) s) = of_real (Q x. f x s)"
  by(auto simp: qbs_integral_def2_l qbs_integrable_iff_integrable)

lemma [simp]:
  assumes "qbs_integrable s f"
  shows qbs_integral_fst: "(Q x. fst (f x) s) = fst (Q x. f x s)"
    and qbs_integral_snd: "(Q x. snd (f x) s) = snd (Q x. f x s)"
  using assms by(auto simp: qbs_integral_def2_l qbs_integrable_iff_integrable)

lemma real_qbs_integral_def:
  assumes "qbs_integrable s f"
  shows "qbs_integral s f = enn2real (+Q x. ennreal (f x) s) - enn2real (+Q x. ennreal (- f x) s)"
  using qbs_integrable_morphism_dest[OF in_qbs_space_of assms] assms
  by(auto simp: qbs_integral_def2_l qbs_nn_integral_def2_l qbs_integrable_iff_integrable[symmetric] intro!: real_lebesgue_integral_def)

lemma Markov_inequality_qbs_prob:
 "qbs_integrable s f  AEQ x in s. 0  f x  0 < c  𝒫(x in qbs_l s. c  f x)  (Q x. f x s) / c"
  by(auto simp: qbs_integral_def2_l AEq_qbs_l qbs_integrable_iff_integrable intro!: integral_Markov_inequality_measure[where A="{}"])

lemma Chebyshev_inequality_qbs_prob:
  assumes "s  qbs_space (monadP_qbs X)"
      and "f  X Q qbs_borel" "qbs_integrable s (λx. (f x)2)"
      and "0 < e"
    shows "𝒫(x in qbs_l s. e  ¦f x - (Q x. f x s)¦)  (Q x. (f x - (Q x. f x s))2 s) / e2"
  using prob_space.Chebyshev_inequality[OF qbs_l_prob_space[OF assms(1)] _ _ assms(4),of f] assms(2,3)
  by(simp add: qbs_integral_def2_l qbs_integrable_iff_integrable lr_adjunction_correspondence measurable_qbs_l'[OF qbs_space_monadPM[OF assms(1)]])

lemma qbs_l_return_qbs:
  assumes "x  qbs_space X"
  shows "qbs_l (return_qbs X x) = return (qbs_to_measure X) x"
proof -
  interpret qp: qbs_prob X "λr. x" "return borel 0"
    by(auto simp: qbs_prob_def prob_space_return assms in_Mx_def real_distribution_def real_distribution_axioms_def)
  show ?thesis
    by(simp add: qp.return_qbs[OF assms] distr_return qp.qbs_l)
qed

lemma qbs_l_bind_qbs:
  assumes [qbs]: "s  qbs_space (monadM_qbs X)" "f  X Q monadM_qbs Y"
  shows "qbs_l (s  f) = qbs_l s k qbs_l  f" (is "?lhs = ?rhs")
proof -
  from rep_qbs_space_monadM[OF assms(1)] obtain α μ
    where hs: "s = X, α, μsfin" "qbs_s_finite X α μ" by metis
  then interpret qs: qbs_s_finite X α μ by simp
  from rep_qbs_Mx_monadM[OF qbs_morphism_Mx[OF assms(2) qs.in_Mx]] obtain β k where
   hk: "f  α =  (λr. Y, β, k rsfin)" "β  qbs_Mx Y" "s_finite_kernel borel borel k" "r. qbs_s_finite Y β (k r )"
    by metis
  then interpret sk: s_finite_kernel borel borel k by simp
  interpret im: in_Mx Y β using hk(2) by(simp add: in_Mx_def)

  have "?lhs = distr (μ k k) (qbs_to_measure Y) β"
    by(simp add: qs.bind_qbs[OF hs(1) assms(2) hk(2,3,1)] qbs_s_finite.qbs_l[OF qs.bind_qbs_s_finite[OF hs(1) assms(2) hk(2,3,1)]])
  also have "... = μ k (λx. distr (k x) (qbs_to_measure Y) β)"
    by(auto intro!: sk.distr_bind_kernel simp: qs.mu_sets)
  also have "... = μ k (λr. qbs_l ((f  α) r))"
    by(simp add: qbs_s_finite.qbs_l[OF hk(4)] hk(1))
  also have "... = μ k (λr. (λx. qbs_l (f x)) (α r))" by simp
  also have "... = distr μ (qbs_to_measure X) α k (λx. qbs_l (f x))"
    using l_preserves_morphisms[of X "monadM_qbs Y"] assms(2)
    by(auto intro!: measure_kernel.bind_kernel_distr[OF measure_kernel.measure_kernel_comp[OF qbs_l_measure_kernel],symmetric] simp: sets_eq_imp_space_eq[OF qs.mu_sets])
  also have "... = ?rhs"
    by(simp add: hs(1) qs.qbs_l comp_def)
  finally show ?thesis .
qed

lemma qbs_l_bind_qbsP:
  assumes [qbs]: "s  qbs_space (monadP_qbs X)" "f  X Q monadP_qbs Y"
  shows "qbs_l (s  f) = qbs_l s  qbs_l  f"
proof -
  have "qbs_l (s  f) = qbs_l s k qbs_l  f"
    by(auto intro!: qbs_l_bind_qbs[where X=X and Y=Y] qbs_space_monadPM qbs_morphism_monadPD)
  also have "... = qbs_l s  qbs_l  f"
    using qbs_l_measurable_prob qbs_morphism_imp_measurable[OF assms(2)]
    by(auto intro!: bind_kernel_bind[where N="qbs_to_measure Y"] measurable_prob_algebraD simp: measurable_qbs_l'[OF qbs_space_monadPM[OF assms(1)]])
  finally show ?thesis .
qed

lemma qbs_integrable_return[simp, intro]:
  assumes "x  qbs_space X" "f  X Q qbs_borel"
  shows "qbs_integrable (return_qbs X x) f"
  using assms by(auto simp: qbs_integrable_iff_integrable qbs_l_return_qbs[OF assms(1)] lr_adjunction_correspondence nn_integral_return space_L intro!: integrableI_bounded)

lemma qbs_integrable_bind_return:
  assumes [qbs]:"s  qbs_space (monadM_qbs X)" "f  Y Q qbs_borel" "g  X Q Y"
  shows "qbs_integrable (s  (λx. return_qbs Y (g x))) f = qbs_integrable s (f  g)" (is "?lhs = ?rhs")
proof -
  from rep_qbs_space_monadM[OF assms(1)] obtain α μ
    where hs: "s = X, α, μsfin" "qbs_s_finite X α μ" by metis
  then interpret qs: qbs_s_finite X α μ by simp

  have 1:"return_qbs Y  (g  α) = (λr. Y, g  α, return borel rsfin)"
    by(auto intro!: return_qbs_comp qbs_morphism_Mx[OF assms(3)])
  have hb: "qbs_s_finite Y (g  α) μ" "s  (λx. return_qbs Y (g x)) = Y, g  α, μsfin"
    using qbs_s_finite.bind_qbs[OF hs(2,1) qbs_morphism_comp[OF assms(3) return_qbs_morphism] qbs_morphism_Mx[OF assms(3)] prob_kernel.s_finite_kernel_prob_kernel 1[simplified comp_assoc[symmetric]]]
          qbs_s_finite.bind_qbs_s_finite[OF hs(2,1) qbs_morphism_comp[OF assms(3) return_qbs_morphism] qbs_morphism_Mx[OF assms(3)] prob_kernel.s_finite_kernel_prob_kernel 1[simplified comp_assoc[symmetric]]]
    by(auto simp: prob_kernel_def' comp_def bind_kernel_return''[OF qs.mu_sets])
  have "?lhs = integrable μ (f  (g  α))"
    by(auto simp: hb(2) intro!: qbs_s_finite.qbs_integrable_iff_integrable[OF hb(1),simplified comp_def] simp: comp_def lr_adjunction_correspondence[symmetric])
  also have "... = ?rhs"
    by(auto simp: hs(1) comp_def lr_adjunction_correspondence[symmetric] intro!: qs.qbs_integrable_iff_integrable[symmetric])
  finally show ?thesis .
qed

lemma qbs_nn_integral_morphism[qbs]: "qbs_nn_integral  monadM_qbs X Q (X Q qbs_borel) Q qbs_borel"
proof(rule curry_preserves_morphisms[OF pair_qbs_morphismI])
  fix α β
  assume h:"α  qbs_Mx (monadM_qbs X)" "β  qbs_Mx (X Q (qbs_borel :: ennreal quasi_borel))"
  from rep_qbs_Mx_monadM[OF h(1)] obtain a k
    where ak: "α = (λr. X, a, k rsfin)" "a  qbs_Mx X" "s_finite_kernel borel borel k" "r. qbs_s_finite X a (k r)"
    by metis
  have 1:"borel_measurable ((borel :: real measure) M (borel :: real measure)) = qbs_borel Q qbs_borel Q (qbs_borel :: ennreal quasi_borel)"
    by (metis borel_prod qbs_borel_prod standard_borel.standard_borel_r_full_faithful standard_borel_ne_borel standard_borel_ne_def)
  show "(λr. qbs_nn_integral (fst (α r, β r)) (snd (α r, β r)))  qbs_Mx qbs_borel"
    unfolding qbs_Mx_qbs_borel
    by(rule measurable_cong[where f="λr. + x. β r (a x) k r",THEN iffD1], insert h ak(2))
      (auto simp: qbs_s_finite.qbs_nn_integral_def[OF ak(4)] qbs_Mx_is_morphisms ak(1) 1 intro!: s_finite_kernel.nn_integral_measurable_f[OF ak(3)])
qed

lemma qbs_nn_integral_return:
  assumes "f  X Q qbs_borel"
      and "x  qbs_space X"
    shows "qbs_nn_integral (return_qbs X x) f = f x"
  using assms by(auto intro!: nn_integral_return simp: qbs_nn_integral_def2_l qbs_l_return_qbs space_L lr_adjunction_correspondence)

lemma qbs_nn_integral_bind:
  assumes [qbs]:"s  qbs_space (monadM_qbs X)"
          "f  X Q monadM_qbs Y" "g  Y Q qbs_borel"
    shows "qbs_nn_integral (s  f) g = qbs_nn_integral s (λy. (qbs_nn_integral (f y) g))" (is "?lhs = ?rhs")
proof -
  from rep_qbs_space_monadM[OF assms(1)] obtain α μ
    where hs: "s = X, α, μsfin" "qbs_s_finite X α μ" by metis
  then interpret qs: qbs_s_finite X α μ by simp
  from rep_qbs_Mx_monadM[OF qbs_morphism_Mx[OF assms(2) qs.in_Mx]] obtain β k
    where hk: "f  α = (λr. Y, β, k rsfin)" "β  qbs_Mx Y" "s_finite_kernel borel borel k" "r. qbs_s_finite Y β (k r)"
    by metis
  note sf = qs.bind_qbs[OF hs(1) assms(2) hk(2,3,1)] qs.bind_qbs_s_finite[OF hs(1) assms(2) hk(2,3,1)]
  have "?lhs = (+ x. g (β x) (μ k k))"
    by(simp add: sf(1) qbs_s_finite.qbs_nn_integral_def[OF sf(2)])
  also have "... = (+ r. (+ y. g (β y) (k r)) μ)"
    using assms(3) hk(2) by(auto intro!: s_finite_kernel.nn_integral_bind_kernel[OF hk(3)] qs.mu_sets simp: s_finite_kernel_cong_sets[OF qs.mu_sets] lr_adjunction_correspondence)
  also have "... = ?rhs"
    using fun_cong[OF hk(1)] by(auto simp: hs(1) qs.qbs_nn_integral_def qbs_s_finite.qbs_nn_integral_def[OF hk(4),symmetric] intro!: nn_integral_cong)
  finally show ?thesis .
qed

lemma qbs_nn_integral_bind_return:
  assumes [qbs]:"s  qbs_space (monadM_qbs Y)" "f  Z Q qbs_borel" "g  Y Q Z"
  shows "qbs_nn_integral (s  (λy. return_qbs Z (g y))) f = qbs_nn_integral s (f  g)"
  by(auto simp: qbs_nn_integral_bind[OF assms(1) _ assms(2)] qbs_nn_integral_return intro!: qbs_nn_integral_cong[OF assms(1)])

lemma qbs_integral_morphism[qbs]:
 "qbs_integral  monadM_qbs X Q (X Q qbs_borel) Q (qbs_borel :: ('b :: {second_countable_topology,banach}) quasi_borel)"
proof(rule curry_preserves_morphisms[OF pair_qbs_morphismI])
  fix α and γ :: "_  _  'b"
  assume h:"α  qbs_Mx (monadM_qbs X)" "γ  qbs_Mx (X Q qbs_borel)"
  from rep_qbs_Mx_monadM[OF this(1)] obtain β k
    where hk: "α = (λr. X, β, k rsfin)" "β  qbs_Mx X" "s_finite_kernel borel borel k" "r. qbs_s_finite X β (k r)"
    by metis
  have 1:"borel_measurable ((borel :: real measure) M (borel :: real measure)) = qbs_borel Q qbs_borel Q (qbs_borel :: (_ :: {second_countable_topology,banach}) quasi_borel)"
    by (metis borel_prod qbs_borel_prod standard_borel.standard_borel_r_full_faithful standard_borel_ne_borel standard_borel_ne_def)
  show "(λr. qbs_integral (fst (α r,γ r)) (snd (α r,γ r)))  qbs_Mx borelQ"
    unfolding qbs_Mx_R
    by(rule measurable_cong[where f="λr.  x. γ r (β x) k r",THEN iffD1], insert h hk(2))
      (auto simp: qbs_s_finite.qbs_integral_def[OF hk(4)] qbs_Mx_is_morphisms hk(1) 1 intro!: s_finite_kernel.integral_measurable_f[OF hk(3)])
qed

lemma qbs_integral_return:
  assumes [qbs]:"f  X Q qbs_borel" "x  qbs_space X"
  shows "qbs_integral (return_qbs X x) f = f x"
  by(auto simp: qbs_integral_def2_l qbs_l_return_qbs lr_adjunction_correspondence[symmetric] space_L integral_return)

lemma
  assumes [qbs]: "s  qbs_space (monadM_qbs X)" "f  X Q monadM_qbs Y" "g  Y Q qbs_borel"
      and "qbs_integrable s (λx. Q y. norm (g y) f x)" "AEQ x in s. qbs_integrable (f x) g"
    shows qbs_integrable_bind: "qbs_integrable (s  f) g" (is ?goal1)
      and qbs_integral_bind:"(Q y. g y (s  f)) = (Q x. Q y. g y f x s)" (is "?lhs = ?rhs")
proof -
  from rep_qbs_space_monadM[OF assms(1)] obtain α μ
    where hs: "s = X, α, μsfin" "qbs_s_finite X α μ" by metis
  then interpret qs: qbs_s_finite X α μ by simp
  from rep_qbs_Mx_monadM[OF qbs_morphism_Mx[OF assms(2) qs.in_Mx]] obtain β k
    where hk: "f  α = (λr. Y, β, k rsfin)" "β  qbs_Mx Y" "s_finite_kernel borel borel k" "r. qbs_s_finite Y β (k r)"
    by metis
  note sf = qs.bind_qbs[OF hs(1) assms(2) hk(2,3,1)]
  have g[measurable]: "h M. h  M M qbs_to_measure Y  (λx. g (h x))  M M borel"
    using assms(3) by(auto simp: lr_adjunction_correspondence)
  interpret qs2: qbs_s_finite Y β "μ k k"
    by(rule qs.bind_qbs_s_finite[OF hs(1) assms(2) hk(2,3,1)])
  show ?goal1
    by(auto simp: sf qs2.qbs_integrable_def intro!: s_finite_kernel.integrable_bind_kernel[OF hk(3) qs.mu_sets])
      (insert qs.AEq_AE[OF assms(5)[simplified hs(1)],simplified fun_cong[OF hk(1),simplified] qbs_s_finite.qbs_integrable_def[OF hk(4)]] assms(4)[simplified hs(1) qs.qbs_integrable_def fun_cong[OF hk(1),simplified]],auto simp: hs(1) qs.qbs_integrable_def qbs_s_finite.qbs_integral_def[OF hk(4)])
  have "?lhs = (r. g (β r) (μ k k))"
    by(simp add: sf qs2.qbs_integral_def)
  also have "... = (r. (l. g (β l)k r) μ)"
    using qs.AEq_AE[OF assms(5)[simplified hs(1)],simplified fun_cong[OF hk(1),simplified] qbs_s_finite.qbs_integrable_def[OF hk(4)]] assms(4)[simplified hs(1) qs.qbs_integrable_def fun_cong[OF hk(1),simplified]]
    by(auto intro!: s_finite_kernel.integral_bind_kernel[OF hk(3) qs.mu_sets] simp: qbs_s_finite.qbs_integral_def[OF hk(4)])
  also have "... = (r. (Q y. g yY, β, k rsfin) μ)"
    by(auto intro!: Bochner_Integration.integral_cong simp: qbs_s_finite.qbs_integral_def[OF hk(4)])
  also have "... = ?rhs"
    by(auto simp: hs(1) qs.qbs_integral_def fun_cong[OF hk(1),simplified comp_def])
  finally show "?lhs = ?rhs" .
qed

lemma qbs_integral_bind_return:
  assumes [qbs]:"s  qbs_space (monadM_qbs Y)" "f  Z Q qbs_borel" "g  Y Q Z"
  shows "qbs_integral (s  (λy. return_qbs Z (g y))) f = qbs_integral s (f  g)"
proof -
  from rep_qbs_space_monadM[OF assms(1)] obtain α μ
    where hs: "s = Y, α, μsfin" "qbs_s_finite Y α μ" by metis
  then interpret qs: qbs_s_finite Y α μ by simp

  have hb: "qbs_s_finite Z (g  α) μ" "s  (λy. return_qbs Z (g y)) = Z, g  α, μsfin"
    using qs.bind_qbs_s_finite[OF hs(1) _ qbs_morphism_Mx[OF assms(3) qs.in_Mx] prob_kernel.s_finite_kernel_prob_kernel return_qbs_comp[OF qbs_morphism_Mx[OF assms(3) qs.in_Mx],simplified comp_assoc[symmetric] comp_def[of _ g]],simplified prob_kernel_def']
    by(auto simp: qs.bind_qbs[OF hs(1) _ qbs_morphism_Mx[OF assms(3) qs.in_Mx] prob_kernel.s_finite_kernel_prob_kernel return_qbs_comp[OF qbs_morphism_Mx[OF assms(3) qs.in_Mx],simplified comp_assoc[symmetric] comp_def[of _ g]],simplified prob_kernel_def']  bind_kernel_return''[OF qs.mu_sets])
  show ?thesis
    by(simp add: hb(2) qbs_s_finite.qbs_integral_def[OF hb(1)] qs.qbs_integral_def[simplified hs(1)[symmetric]])
qed

subsubsection ‹ Binary Product Measures›
definition qbs_pair_measure :: "['a qbs_measure, 'b qbs_measure]  ('a × 'b) qbs_measure" (infix "Qmes" 80) where
qbs_pair_measure_def':"qbs_pair_measure p q  (p  (λx. q  (λy. return_qbs (qbs_space_of p Q qbs_space_of q) (x, y))))"


context pair_qbs_s_finites
begin

interpretation rr : standard_borel_ne "borel M borel :: (real × real) measure"
  by(auto intro!: pair_standard_borel_ne)

lemma
  shows qbs_pair_measure: "X, α, μsfin Qmes Y, β, νsfin = X Q Y, map_prod α β  rr.from_real, distr (μ M ν) borel rr.to_realsfin"
    and qbs_pair_measure_s_finite: "qbs_s_finite (X Q Y) (map_prod α β  rr.from_real) (distr (μ M ν) borel rr.to_real)"
  by(simp_all add: qbs_pair_measure_def' pq1.qbs_l pq2.qbs_l qbs_bind_bind_return_pq qbs_s_finite_axioms)

lemma qbs_l_qbs_pair_measure:
  "qbs_l (X, α, μsfin Qmes Y, β, νsfin) = distr (μ M ν) (qbs_to_measure (X Q Y)) (map_prod α β)"
  by(simp add: qbs_pair_measure qbs_s_finite.qbs_l[OF qbs_pair_measure_s_finite] distr_distr comp_assoc)

lemma qbs_nn_integral_pair_measure:
  assumes [qbs]:"f  X Q Y Q qbs_borel"
  shows "(+Q z. f z (X, α, μsfin Qmes Y, β, νsfin)) = (+ z. (f  map_prod α β) z (μ M ν))"
  using assms by(simp add: qbs_nn_integral_def2 qbs_pair_measure distr_distr comp_assoc nn_integral_distr lr_adjunction_correspondence)

lemma qbs_integral_pair_measure:
  assumes [qbs]:"f  X Q Y Q qbs_borel"
  shows "(Q z. f z (X, α, μsfin Qmes Y, β, νsfin)) = ( z. (f  map_prod α β) z (μ M ν))"
  using assms by(simp add: qbs_integral_def2 qbs_pair_measure distr_distr comp_assoc integral_distr lr_adjunction_correspondence)

lemma qbs_pair_measure_integrable_eq:
 "qbs_integrable (X, α, μsfin Qmes Y, β, νsfin) f  f  X Q Y Q qbs_borel  integrable (μ M ν) (f  (map_prod α β))" (is "?h  ?h1  ?h2")
proof safe
  assume h: ?h
  show ?h1
    by(auto intro!: qbs_integrable_morphism_dest[OF _ h] simp: qbs_pair_measure_def')
  have 1:"integrable (distr (μ M ν) borel (to_real_on (borel M borel))) (f  (map_prod α β  from_real_into (borel M borel)))"
    using h[simplified qbs_pair_measure] by(simp add: qbs_integrable_def[of f] comp_def[of f])
  have "integrable (μ M ν) (λx. (f  (map_prod α β  from_real_into (borel M borel))) (to_real_on (borel M borel) x))"
    by(intro integrable_distr[OF _ 1]) simp
  thus ?h2
    by(simp add: comp_def)
next
  assume h: ?h1 ?h2
  then show ?h
    by(simp add: qbs_pair_measure qbs_integrable_def) (simp add: lr_adjunction_correspondence integrable_distr_eq[of rr.to_real "μ M ν" borel "λx. f (map_prod α β (rr.from_real x))"] comp_def)
qed

end

lemmas(in pair_qbs_probs) qbs_pair_measure_prob = qbs_prob_axioms

context
  fixes X Y p q
  assumes p[qbs]:"p  qbs_space (monadM_qbs X)" and q[qbs]:"q  qbs_space (monadM_qbs Y)"
begin

lemma qbs_pair_measure_def: "p Qmes q = p  (λx. q  (λy. return_qbs (X Q Y) (x,y)))"
  by(simp add: qbs_space_of_in[OF p] qbs_space_of_in[OF q] qbs_pair_measure_def')

lemma qbs_pair_measure_def2: "p Qmes q = q  (λy. p  (λx. return_qbs (X Q Y) (x,y)))"
  by(simp add: bind_qbs_return_rotate qbs_pair_measure_def)

lemma
  assumes "f   X Q Y Q monadM_qbs Z"
  shows qbs_pair_bind_bind_return1':"q  (λy. p  (λx. f (x,y))) = p Qmes q  f"
    and qbs_pair_bind_bind_return2':"p  (λx. q  (λy. f (x,y))) = p Qmes q  f"
  by(simp_all add: qbs_bind_bind_return1[OF assms] qbs_bind_bind_return2[OF assms] bind_qbs_return_rotate qbs_pair_measure_def)

lemma
  assumes [qbs]:"f   X Q exp_qbs Y (monadM_qbs Z)"
  shows qbs_pair_bind_bind_return1'': "q  (λy. p  (λx. f x y)) = p Qmes q  (λx. f (fst x) (snd x))"
    and qbs_pair_bind_bind_return2'': "p  (λx. q  (λy. f x y)) = p Qmes q  (λx. f (fst x) (snd x))"
   by(auto intro!: qbs_pair_bind_bind_return1'[where f="λx. f (fst x) (snd x)",simplified] qbs_pair_bind_bind_return2'[where f="λx. f (fst x) (snd x)",simplified] uncurry_preserves_morphisms) qbs

lemma qbs_nn_integral_Fubini_fst:
  assumes [qbs]:"f  X Q Y Q qbs_borel"
    shows "(+Q x. +Q y. f (x,y) q p) = (+Q z. f z (p Qmes q))"
          (is "?lhs = ?rhs")
proof -
  have "?lhs = (+Q x. +Q y. qbs_nn_integral (return_qbs (X Q Y) (x, y)) f q p)"
    by(auto intro!: qbs_nn_integral_cong p q simp: qbs_nn_integral_return)
  also have "... = ?rhs"
    by(auto intro!: qbs_nn_integral_cong[OF p] simp:qbs_nn_integral_bind[OF q _ assms] qbs_nn_integral_bind[OF p _ assms] qbs_pair_measure_def)
  finally show ?thesis .
qed

lemma qbs_nn_integral_Fubini_snd:
  assumes [qbs]:"f  X Q Y Q qbs_borel"
    shows "(+Q y. +Q x. f (x,y) p q) = (+Q z. f z (p Qmes q))" (is "?lhs = ?rhs")
proof -
  have "?lhs = (+Q y. +Q x. qbs_nn_integral (return_qbs (X Q Y) (x, y)) f p q)"
    by(auto intro!: qbs_nn_integral_cong p q simp: qbs_nn_integral_return)
  also have "... = ?rhs"
    by(auto intro!: qbs_nn_integral_cong[OF q] simp:qbs_nn_integral_bind[OF q _ assms] qbs_nn_integral_bind[OF p _ assms] qbs_pair_measure_def2)
  finally show ?thesis .
qed

lemma qbs_ennintegral_indep_mult:
  assumes [qbs]: "f  X Q qbs_borel" "g  Y Q qbs_borel"
    shows "(+Q z. f (fst z) * g (snd z) (p Qmes q)) = (+Q x. f x p) * (+Q y. g y q)" (is "?lhs = ?rhs")
proof -
  have "?lhs = (+Q x. +Q y .f x * g y q p)"
    using qbs_nn_integral_Fubini_fst[where f="λz. f (fst z) * g (snd z)"] by simp
  also have "... = (+Q x. f x * +Q y . g y q p)"
    by(simp add: qbs_nn_integral_cmult[OF q])
  also have "... = ?rhs"
    by(simp add: qbs_nn_integral_cmult[OF p] ab_semigroup_mult_class.mult.commute[where b="qbs_nn_integral q g"])
  finally show ?thesis .
qed

end

lemma qbs_l_qbs_pair_measure:
  assumes "standard_borel M" "standard_borel N"
  defines "X  measure_to_qbs M" and "Y  measure_to_qbs N"
  assumes [qbs]: "p  qbs_space (monadM_qbs X)" "q  qbs_space (monadM_qbs Y)"
  shows "qbs_l (p Qmes q) = qbs_l p M qbs_l q"
proof -
  obtain α μ β ν
    where hp: "p = X, α, μsfin" "qbs_s_finite X α μ"
      and hq: "q = Y, β, νsfin" "qbs_s_finite Y β ν" 
    using rep_qbs_space_monadM assms(5,6) by meson
  have 1:"sets (qbs_to_measure (X Q Y)) = sets (M M N)"
    by(auto simp: r_preserves_product[symmetric] X_def Y_def intro!: standard_borel.lr_sets_ident pair_standard_borel assms)
  have "qbs_l (p Qmes q) = qbs_l p k qbs_l  (λx. q  (λy. return_qbs (X Q Y) (x,y)))"
    by(auto simp: qbs_pair_measure_def[of p X q Y] intro!: qbs_l_bind_qbs[of _ X _ "X Q Y"])
  also have "... = qbs_l p k (λx. qbs_l (q  (λy. return_qbs (X Q Y) (x, y))))"
    by(simp add: comp_def)
  also have "... = qbs_l p k (λx. qbs_l q k qbs_l  (λy.  return_qbs (X Q Y) (x, y)))"
    by(auto intro!: bind_kernel_cong_All qbs_l_bind_qbs[of _ "Y" _ "X Q Y"] simp: space_qbs_l_in[OF assms(5)])
  also have "... = qbs_l p k (λx. qbs_l q k (λy. return (qbs_to_measure (X Q Y)) (x, y)))"
    by(auto simp: comp_def space_qbs_l_in[OF assms(6)] space_qbs_l_in[OF assms(5)] qbs_l_return_qbs intro!: bind_kernel_cong_All)
  also have "... = qbs_l p k (λx. qbs_l q k (λy. return (M M N) (x, y)))"
    by(simp add: return_cong[OF 1])
  also have "... = qbs_l p k (λx. qbs_l q k (λy. return (qbs_l p M qbs_l q) (x, y)))"
    by(auto cong: return_cong sets_pair_measure_cong simp: sets_qbs_l[OF assms(5)] standard_borel.lr_sets_ident[OF assms(1)] sets_qbs_l[OF assms(6)] standard_borel.lr_sets_ident[OF assms(2)] X_def Y_def)
  also have "... = qbs_l p M qbs_l q"
    by(auto intro!: pair_measure_eq_bind_s_finite[symmetric] qbs_l_s_finite.s_finite_measure_axioms)
  finally show ?thesis .
qed

lemma qbs_pair_measure_morphism[qbs]: "qbs_pair_measure  monadM_qbs X Q monadM_qbs Y Q monadM_qbs (X Q Y)"
  by(rule curry_preserves_morphisms,rule qbs_morphism_cong'[where f="(λ(p,q). (p  (λx. q  (λy. return_qbs (X Q Y) (x, y)))))"]) (auto simp: pair_qbs_space qbs_pair_measure_def)

lemma qbs_pair_measure_morphismP:
 "qbs_pair_measure  monadP_qbs X Q monadP_qbs Y Q monadP_qbs (X Q Y)"
proof -
  note [qbs] = return_qbs_morphismP bind_qbs_morphismP
  show ?thesis
    by(rule curry_preserves_morphisms,rule qbs_morphism_cong'[where f="(λ(p,q). (p  (λx. q  (λy. return_qbs (X Q Y) (x, y)))))"]) (auto simp: pair_qbs_space qbs_pair_measure_def[OF qbs_space_monadPM qbs_space_monadPM])
qed

lemma qbs_nn_integral_indep1:
  assumes [qbs]:"p  qbs_space (monadM_qbs X)" "q  qbs_space (monadP_qbs X)" "f  X Q qbs_borel"
    shows "(+Q z. f (fst z) (p Qmes q)) = (+Q x. f x p)"
proof -
  obtain Y β ν where hq:
   "q = Y, β, νsfin" "qbs_prob Y β ν"
    using rep_qbs_space_monadP[OF assms(2)] by blast 
  then interpret qbs_prob Y β ν by simp
  show ?thesis
    by(simp add: qbs_nn_integral_const_prob[OF in_space_monadP] qbs_nn_integral_Fubini_snd[OF assms(1) in_space_monadM,symmetric] hq(1))
qed

lemma qbs_nn_integral_indep2:
  assumes [qbs]:"q  qbs_space (monadM_qbs Y)" "p  qbs_space (monadP_qbs X)" "f  Y Q qbs_borel"
  shows "(+Q z. f (snd z) (p Qmes q)) = (+Q y. f y q)"
proof -
  obtain  X α μ where hp:
    "p = X, α, μsfin" "qbs_prob X α μ"
    using rep_qbs_space_monadP[OF assms(2)] by metis
  then interpret qbs_prob X α μ by simp
  show ?thesis
    by(simp add: qbs_nn_integral_const_prob[OF in_space_monadP] qbs_nn_integral_Fubini_snd[OF in_space_monadM assms(1),symmetric] hp(1))
qed

context
begin

interpretation rr : standard_borel_ne "borel M borel :: (real × real) measure"
  by(auto intro!: pair_standard_borel_ne)

lemma qbs_integrable_pair_swap:
  assumes "qbs_integrable (p Qmes q) f"
  shows "qbs_integrable (q Qmes p) (λ(x,y). f (y,x))"
proof -
  obtain X α μ Y β ν
    where hp: "p = X, α, μsfin" "qbs_s_finite X α μ"
      and hq: "q = Y, β, νsfin" "qbs_s_finite Y β ν" 
    using rep_qbs_s_finite_measure by meson
  interpret p1: pair_qbs_s_finites X α μ Y β ν
    by(simp add: pair_qbs_s_finites_def hq hp)
  interpret p2: pair_qbs_s_finites Y β ν X α μ
    by(simp add: pair_qbs_s_finites_def hq hp)
  show ?thesis
    using assms by(auto simp: hp(1) hq(1) p1.qbs_pair_measure p2.qbs_pair_measure p1.qbs_integrable_def p2.qbs_integrable_def)
    (auto simp add: integrable_distr_eq lr_adjunction_correspondence qbs_Mx_is_morphisms map_prod_def split_beta' intro!:integrable_product_swap_iff_s_finite[OF p1.pq2.s_finite_measure_axioms p1.pq1.s_finite_measure_axioms,THEN iffD1])
qed

lemma qbs_integrable_pair1':
  assumes [qbs]:"p  qbs_space (monadM_qbs X)"
          "q  qbs_space (monadM_qbs Y)"
          "f  X Q Y Q qbs_borel"
          "qbs_integrable p (λx. Q y. norm (f (x,y)) q)"
      and "AEQ x in p. qbs_integrable q (λy. f (x,y))"
    shows "qbs_integrable (p Qmes q) f"
proof -
  obtain α μ β ν
    where hp: "p = X, α, μsfin" "qbs_s_finite X α μ"
      and hq: "q = Y, β, νsfin" "qbs_s_finite Y β ν" 
    using rep_qbs_space_monadM assms(1,2) by meson
  then interpret pqs: pair_qbs_s_finites X α μ Y β ν
    by(simp add: pair_qbs_s_finites_def)
  have [measurable]: "f  borel_measurable (qbs_to_measure (X Q Y))"
    by(simp add: lr_adjunction_correspondence[symmetric])
  show ?thesis
    using assms(4) pqs.pq1.AEq_AE[OF assms(5)[simplified hp(1)]]
    by(auto simp add: pqs.qbs_integrable_def pqs.qbs_pair_measure hp(1) hq(1) integrable_distr_eq pqs.pq2.qbs_integrable_def pqs.pq1.qbs_integrable_def pqs.pq2.qbs_integral_def intro!: s_finite_measure.Fubini_integrable' pqs.pq2.s_finite_measure_axioms)
qed

lemma 
  assumes "qbs_integrable (p Qmes q) f"
  shows qbs_integrable_pair1D1': "qbs_integrable p (λx. Q y. f (x,y) q)"             (is ?g1)
    and qbs_integrable_pair1D1_norm': "qbs_integrable p (λx. Q y. norm (f (x,y)) q)" (is ?g2)
    and qbs_integrable_pair1D2': "AEQ x in p. qbs_integrable q (λy. f (x,y))"          (is ?g3)
    and qbs_integrable_pair2D1': "qbs_integrable q (λy. Q x. f (x,y) p)"             (is ?g4)
    and qbs_integrable_pair2D1_norm': "qbs_integrable q (λy. Q x. norm (f (x,y)) p)" (is ?g5)
    and qbs_integrable_pair2D2': "AEQ y in q. qbs_integrable p (λx. f (x,y))"          (is ?g6)
    and qbs_integral_Fubini_fst': "(Q x. Q y. f (x,y) q p) = (Q z. f z (p Qmes q))" (is ?g7)
    and qbs_integral_Fubini_snd': "(Q y. Q x. f (x,y) p q) = (Q z. f z (p Qmes q))" (is ?g8)
proof -
  obtain X α μ Y β ν
    where hp: "p = X, α, μsfin" "qbs_s_finite X α μ"
      and hq: "q = Y, β, νsfin" "qbs_s_finite Y β ν"
    by (meson rep_qbs_space_of)
  then interpret pqs: pair_qbs_s_finites X α μ Y β ν
    by(simp add: pair_qbs_s_finites_def)
  have [qbs]:"p  qbs_space (monadM_qbs X)" "q  qbs_space (monadM_qbs Y)"
    by(simp_all add: hp hq)
  note qbs_pair_measure_morphism[qbs]
  have f[qbs]:"f  X Q Y Q qbs_borel"
    by(auto intro!: qbs_integrable_morphism_dest[OF _ assms])   
  have [measurable]: "f  borel_measurable (qbs_to_measure (X Q Y))"
    by(simp add: lr_adjunction_correspondence[symmetric])
  show ?g1 ?g2 ?g4 ?g5
    using assms
    by(auto simp: hp(1) hq(1) pqs.qbs_integrable_def pqs.qbs_pair_measure integrable_distr_eq pqs.pq1.qbs_integrable_def pqs.pq2.qbs_integrable_def pqs.pq2.qbs_integral_def pqs.pq1.qbs_integral_def intro!: Bochner_Integration.integrable_cong[where g="λr. Q y. f (α r, y) Y, β,  νsfin" and f="λx.  y. f (α x, β y) ν" and N0=μ,THEN iffD1] Bochner_Integration.integrable_cong[where g="λr. Q x. f (x, β r) X, α, μsfin" and f="λy.  x. f (α x, β y) μ" and N0=ν,THEN iffD1])
      (auto intro!: pqs.pq2.integrable_fst''[of μ] integrable_snd_s_finite[OF pqs.pq1.s_finite_measure_axioms pqs.pq2.s_finite_measure_axioms] simp: map_prod_def split_beta')
  show ?g3 ?g6
    using assms
    by(auto simp: hp(1) pqs.pq1.AEq_AE_iff hq(1) pqs.pq2.AEq_AE_iff pqs.qbs_integrable_def pqs.qbs_pair_measure integrable_distr_eq)
      (auto simp: pqs.pq1.qbs_integrable_def pqs.pq2.qbs_integrable_def map_prod_def split_beta' intro!: pqs.pq2.AE_integrable_fst'' AE_integrable_snd_s_finite[OF pqs.pq1.s_finite_measure_axioms pqs.pq2.s_finite_measure_axioms])
  show ?g7 ?g8
    using assms
    by(auto simp: hp(1) hq(1) pqs.qbs_integrable_def pqs.qbs_pair_measure pqs.qbs_integral_def pqs.pq1.qbs_integral_def pqs.pq2.qbs_integral_def integral_distr integrable_distr_eq)
      (auto simp: map_prod_def split_beta' intro!: pqs.pq2.integral_fst'''[of μ "λx. f (α (fst x),β (snd x))",simplified] integral_snd_s_finite[OF pqs.pq1.s_finite_measure_axioms pqs.pq2.s_finite_measure_axioms,of "λx y. f (α x, β y)",simplified split_beta'])
qed

end

lemma 
  assumes h:"qbs_integrable (p Qmes q) (case_prod f)"
  shows qbs_integrable_pair1D1: "qbs_integrable p (λx. Q y. f x y q)"
    and qbs_integrable_pair1D1_norm: "qbs_integrable p (λx. Q y. norm (f x y) q)"
    and qbs_integrable_pair1D2:  "AEQ x in p. qbs_integrable q (λy. f x y)"
    and qbs_integrable_pair2D1: "qbs_integrable q (λy. Q x. f x y p)"
    and qbs_integrable_pair2D1_norm: "qbs_integrable q (λy. Q x. norm (f x y) p)"
    and qbs_integrable_pair2D2:  "AEQ y in q. qbs_integrable p (λx. f x y)"
    and qbs_integral_Fubini_fst: "(Q x. Q y. f x y q p) = (Q (x,y). f x y (p Qmes q))" (is ?g7)
    and qbs_integral_Fubini_snd: "(Q y. Q x. f x y p q) = (Q (x,y). f x y (p Qmes q))" (is ?g8)
  using qbs_integrable_pair1D1'[OF h] qbs_integrable_pair1D1_norm'[OF h] qbs_integrable_pair1D2'[OF h] qbs_integral_Fubini_fst'[OF h]
        qbs_integrable_pair2D1'[OF h] qbs_integrable_pair2D1_norm'[OF h] qbs_integrable_pair2D2'[OF h] qbs_integral_Fubini_snd'[OF h]
  by simp_all

lemma qbs_integrable_pair2':
  assumes "p  qbs_space (monadM_qbs X)"
          "q  qbs_space (monadM_qbs Y)"
          "f  X Q Y Q qbs_borel"
          "qbs_integrable q (λy. Q x. norm (f (x,y)) p)"
      and "AEQ y in q. qbs_integrable p (λx. f (x,y))"
    shows "qbs_integrable (p Qmes 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_indep_mult:
  fixes f :: "_  _::{real_normed_div_algebra,second_countable_topology}"
  assumes "qbs_integrable p f" "qbs_integrable q g"
  shows "qbs_integrable (p Qmes q) (λx. f (fst x) * g (snd x))"
proof -
  obtain X α μ Y β ν
    where hp: "p = X, α, μsfin" "qbs_s_finite X α μ"
      and hq: "q = Y, β, νsfin" "qbs_s_finite Y β ν"
    by (meson rep_qbs_space_of)
  then interpret pqs: pair_qbs_s_finites X α μ Y β ν
    by(simp add: pair_qbs_s_finites_def)
  have [qbs]:"f  X Q qbs_borel" "g  Y Q qbs_borel" "p  qbs_space (monadM_qbs X)" "q  qbs_space (monadM_qbs Y)"
    by(auto intro!: qbs_integrable_morphism_dest assms simp:hp hq)
  show ?thesis
    by(auto intro!: qbs_integrable_pair1'[of _ X _ Y] qbs_integrable_mult_left qbs_integrable_norm assms(1) AEq_I2[of _ X] simp: norm_mult qbs_integrable_mult_right[OF assms(2)])
qed 

lemma qbs_integrable_indep1:
  fixes f :: "_  _::{real_normed_div_algebra,second_countable_topology}"
  assumes "qbs_integrable p f" "q  qbs_space (monadP_qbs Y)"
  shows "qbs_integrable (p Qmes q) (λx. f (fst x))"
  using qbs_integrable_indep_mult[OF assms(1) qbs_integrable_const[OF assms(2),of 1]] by simp

lemma qbs_integral_indep1:
  fixes f :: "_  _::{real_normed_div_algebra,second_countable_topology}"
  assumes "qbs_integrable p f" "q  qbs_space (monadP_qbs Y)"
  shows "(Q z. f (fst z) (p Qmes q)) = (Q x. f x p)"
  using qbs_integral_Fubini_snd'[OF qbs_integrable_indep1[OF assms]]
  by(simp add: qbs_integral_const_prob[OF assms(2)])

lemma qbs_integrable_indep2:
  fixes g :: "_  _::{real_normed_div_algebra,second_countable_topology}"
  assumes "qbs_integrable q g" "p  qbs_space (monadP_qbs X)"
  shows "qbs_integrable (p Qmes q) (λx. g (snd x))"
  using qbs_integrable_pair_swap[OF qbs_integrable_indep1[OF assms]]
  by(simp add: split_beta')

lemma qbs_integral_indep2:
  fixes g :: "_  _::{real_normed_div_algebra,second_countable_topology}"
  assumes "qbs_integrable q g" "p  qbs_space (monadP_qbs X)"
  shows "(Q z. g (snd z) (p Qmes q)) = (Q y. g y q)"
  using qbs_integral_Fubini_fst'[OF qbs_integrable_indep2[OF assms]]
  by(simp add: qbs_integral_const_prob[OF assms(2)])

lemma qbs_integral_indep_mult1:
  fixes f and g:: "_  _::{real_normed_field,second_countable_topology}"
  assumes "p  qbs_space (monadP_qbs X)" "q  qbs_space (monadP_qbs Y)"
      and "qbs_integrable p f" "qbs_integrable q g"
    shows "(Q z. f (fst z) * g (snd z) (p Qmes q)) = (Q x. f x p) * (Q y. g y q)"
  using qbs_integral_Fubini_fst'[OF qbs_integrable_indep_mult[OF assms(3,4)]]
  by simp

lemma qbs_integral_indep_mult2:
  fixes f and g:: "_  _::{real_normed_field,second_countable_topology}"
  assumes "p  qbs_space (monadP_qbs X)" "q  qbs_space (monadP_qbs Y)"
      and "qbs_integrable p f" "qbs_integrable q g"
    shows "(Q z. g (snd z) * f (fst z) (p Qmes q)) = (Q y. g y q) * (Q x. f x p)"
  using qbs_integral_indep_mult1[OF assms] by(simp add: mult.commute)

subsubsection ‹ The Inverse Function of $l$›
definition qbs_l_inverse :: "'a measure  'a qbs_measure" where
 "qbs_l_inverse M  measure_to_qbs M, from_real_into M, distr M borel (to_real_on M)sfin"

context standard_borel_ne
begin

lemma qbs_l_inverse_def2:
  assumes [measurable_cong]: "sets μ = sets M"
      and "s_finite_measure μ"
    shows "qbs_l_inverse μ = measure_to_qbs M, from_real, distr μ borel to_realsfin"
proof -
  interpret s: standard_borel_ne μ
    using assms standard_borel_ne_axioms standard_borel_ne_sets by blast
  have [measurable]: "s.from_real  borel M M"
    using assms(1) measurable_cong_sets s.from_real_measurable by blast
  show ?thesis
    by(auto simp: distr_distr qbs_l_inverse_def qbs_s_finite_eq_def qbs_s_finite_def in_Mx_def qbs_Mx_R qbs_s_finite_axioms_def intro!: qbs_s_finite_measure_eq s_finite_measure.s_finite_measure_distr assms cong: measure_to_qbs_cong_sets[OF assms(1)]) (auto intro!: distr_cong simp: sets_eq_imp_space_eq[OF assms(1)])
qed

lemma
  assumes [measurable_cong]:"sets μ = sets M"
  shows qbs_l_inverse_s_finite: "s_finite_measure μ  qbs_s_finite (measure_to_qbs M) from_real (distr μ borel to_real)"
    and qbs_l_inverse_qbs_prob: "prob_space μ  qbs_prob (measure_to_qbs M) from_real (distr μ borel to_real)"
   by(auto simp: qbs_s_finite_def qbs_prob_def in_Mx_def  qbs_s_finite_axioms_def real_distribution_def real_distribution_axioms_def qbs_Mx_R intro!: s_finite_measure.s_finite_measure_distr prob_space.prob_space_distr)

corollary
  assumes [measurable_cong]:"sets μ = sets M"
  shows qbs_l_inverse_in_space_monadM: "s_finite_measure μ  qbs_l_inverse μ  qbs_space (monadM_qbs M)"
    and qbs_l_inverse_in_space_monadP: "prob_space μ  qbs_l_inverse μ  qbs_space (monadP_qbs M)"
  by(auto simp: qbs_l_inverse_def2[OF assms(1)] qbs_l_inverse_def2[OF assms(1) prob_space.s_finite_measure_prob] assms intro!: qbs_s_finite.in_space_monadM[OF qbs_l_inverse_s_finite] qbs_prob.in_space_monadP[OF qbs_l_inverse_qbs_prob])

lemma qbs_l_qbs_l_inverse:
  assumes [measurable_cong]: "sets μ = sets M" "s_finite_measure μ"
  shows "qbs_l (qbs_l_inverse μ) = μ"
proof -
  interpret qbs_s_finite "measure_to_qbs M" from_real "distr μ borel to_real"
    by(auto intro!: qbs_l_inverse_s_finite assms)
  show ?thesis
    using distr_id'[OF assms(1),simplified sets_eq_imp_space_eq[OF assms(1)]]
    by(auto simp: qbs_l qbs_l_inverse_def2[OF assms] distr_distr cong: distr_cong)
qed

corollary qbs_l_qbs_l_inverse_prob:
  "sets μ = sets M  prob_space μ  qbs_l (qbs_l_inverse μ) = μ"
  by(auto intro!: qbs_l_qbs_l_inverse prob_space.s_finite_measure_prob)

lemma qbs_l_inverse_qbs_l:
  assumes "s  qbs_space (monadM_qbs (measure_to_qbs M))"
  shows "qbs_l_inverse (qbs_l s) = s"
proof -
  from rep_qbs_space_monadM[OF assms] obtain α μ where h:
   "s = measure_to_qbs M, α, μsfin" "qbs_s_finite (measure_to_qbs M) α μ"
    by metis
  then interpret qs:qbs_s_finite "measure_to_qbs M" α μ by simp
  have [simp]: "distr μ (qbs_to_measure (measure_to_qbs M)) α = distr μ M α"
    by(simp cong: distr_cong)
  interpret s: standard_borel_ne "distr μ M α"
    by(rule standard_borel_ne_sets[of M]) (auto simp: standard_borel_ne_axioms)
  have [measurable]: "s.from_real  borel M M" "α  μ M M"
    using qs.α_measurable[simplified measurable_cong_sets[OF refl lr_sets_ident]]
    by(auto simp: s.from_real_measurable[simplified measurable_cong_sets[OF refl sets_distr]])
  interpret pqs:pair_qbs_s_finite "measure_to_qbs M" s.from_real "distr μ borel (s.to_real  α)" α μ
    by(auto simp: pair_qbs_s_finite_def h) (auto simp: qbs_s_finite_def in_Mx_def qs.s_finite_measure_axioms qbs_s_finite_axioms_def qbs_Mx_R  intro!: s_finite_measure.s_finite_measure_distr)
  show ?thesis
    by(auto simp add: h(1) qs.qbs_l qbs_l_inverse_def distr_distr cong: measure_to_qbs_cong_sets intro!: pqs.qbs_s_finite_measure_eq)
      (insert qbs_Mx_to_X[of _ "measure_to_qbs M"], auto simp: comp_def qbs_space_R)
qed

corollary qbs_l_inverse_qbs_l_prob:
  assumes "s  qbs_space (monadP_qbs (measure_to_qbs M))"
  shows "qbs_l_inverse (qbs_l s) = s"
  by(auto intro!: qbs_l_inverse_qbs_l qbs_space_monadPM assms)

lemma s_finite_kernel_qbs_morphism:
  assumes "s_finite_kernel N M k"
  shows "(λx. qbs_l_inverse (k x))  measure_to_qbs N Q monadM_qbs (measure_to_qbs M)"
proof -
  interpret sfin: s_finite_kernel N M k by fact
  have "measure_to_qbs M, from_real, distr (k x) borel to_realsfin = qbs_l_inverse (k x)" if x:"x  space N" for x
  proof -
    note sfin.kernel_sets[OF x,simp, measurable_cong]
    then interpret skx: standard_borel_ne "k x"
      using standard_borel_ne_axioms standard_borel_ne_sets by blast
    interpret pqs: pair_qbs_s_finite "measure_to_qbs M" from_real "distr (k x) borel to_real" skx.from_real "distr (k x) borel skx.to_real"
      using skx.from_real_measurable[simplified measurable_cong_sets[OF refl sfin.kernel_sets[OF x]]]
      by(auto simp: pair_qbs_s_finite_def qbs_s_finite_def in_Mx_def qbs_Mx_R qbs_s_finite_axioms_def sfin.image_s_finite_measure[OF x] intro!: s_finite_measure.s_finite_measure_distr)
    show ?thesis
      by(auto simp: qbs_l_inverse_def distr_distr cong: measure_to_qbs_cong_sets  intro!: pqs.qbs_s_finite_measure_eq) (auto intro!: distr_cong simp: sfin.kernel_space[OF x])
  qed
  moreover have "(λx. measure_to_qbs M, from_real, distr (k x) borel to_realsfin)  measure_to_qbs N Q monadM_qbs (measure_to_qbs M)"
  proof(rule qbs_morphismI)
    fix α :: "real  _"
    assume "α  qbs_Mx (measure_to_qbs N)"
    then have [measurable]: "α  borel M N"
      by(simp add: qbs_Mx_R)
    show "(λx. measure_to_qbs M, from_real, distr (k x) borel to_realsfin)  α  qbs_Mx (monadM_qbs (measure_to_qbs M))"
      by(auto simp: monadM_qbs_Mx qbs_Mx_R intro!: exI[where x=from_real] exI[where x="λx. distr (k (α x)) borel to_real"] s_finite_kernel.comp_measurable[OF sfin.distr_s_finite_kernel])
  qed
  ultimately show ?thesis
    by(rule qbs_morphism_cong'[of "measure_to_qbs N",simplified qbs_space_R])
qed

lemma prob_kernel_qbs_morphism:
  assumes [measurable]:"k  N  M prob_algebra M"
  shows "(λx. qbs_l_inverse (k x))  measure_to_qbs N Q monadP_qbs (measure_to_qbs M)"
proof(safe intro!: qbs_morphism_monadPI' s_finite_kernel_qbs_morphism prob_kernel.s_finite_kernel_prob_kernel)
  fix x
  assume "x  qbs_space (measure_to_qbs N)"
  then have "x  space N" by(simp add: qbs_space_R)
  from measurable_space[OF assms this]
  have [measurable_cong, simp]: "sets (k x) = sets M" and p:"prob_space (k x)"
    by(auto simp: space_prob_algebra)
  then interpret s: standard_borel_ne "k x"
    using standard_borel_ne_axioms standard_borel_ne_sets by blast
  show "qbs_l_inverse (k x)  qbs_space (monadP_qbs (measure_to_qbs M))"
    using s.qbs_l_inverse_in_space_monadP[OF refl p] by(simp cong: measure_to_qbs_cong_sets)
qed(simp add: prob_kernel_def')

lemma qbs_l_inverse_return:
  assumes "x  space M"
  shows "qbs_l_inverse (return M x) = return_qbs (measure_to_qbs M) x"
proof -
  interpret s: standard_borel_ne "return M x"
    by(rule standard_borel_ne_sets[of M]) (auto simp: standard_borel_ne_axioms)
  show ?thesis
    using s.qbs_l_inverse_in_space_monadP[OF refl prob_space_return[OF assms]]
    by(auto intro!: inj_onD[OF qbs_l_inj_P[of "measure_to_qbs M"]] return_cong qbs_l_inverse_in_space_monadP qbs_morphism_space[OF return_qbs_morphismP[of "measure_to_qbs M"]] assms simp: s.qbs_l_qbs_l_inverse_prob[OF refl prob_space_return[OF assms]] qbs_l_return_qbs[of _ M,simplified qbs_space_R,OF assms] qbs_space_R cong: measure_to_qbs_cong_sets)
qed

lemma qbs_l_inverse_bind_kernel:
  assumes "standard_borel_ne N" "s_finite_measure M" "s_finite_kernel M N k"
    shows "qbs_l_inverse (M k k) = qbs_l_inverse M  (λx. qbs_l_inverse (k x))" (is "?lhs = ?rhs")
proof -
  interpret sfin: s_finite_kernel M N k by fact
  interpret s: standard_borel_ne N by fact
  have sets[simp,measurable_cong]:"sets (M k k) = sets N"
    by(auto intro!: sets_bind_kernel[OF _ space_ne] simp: sfin.kernel_sets)
  then interpret s2: standard_borel_ne "M k k"
    using s.standard_borel_ne_axioms standard_borel_ne_sets by blast
  have [measurable]: "s2.from_real  borel M N"
    using measurable_cong_sets s2.from_real_measurable sets by blast
  have comp1:"(λx. qbs_l_inverse (k x))  from_real = (λr. measure_to_qbs N, s.from_real, distr (k (from_real r)) borel s.to_realsfin)"
  proof
    fix r
    have setskfr[measurable_cong, simp]: "sets (k (from_real r)) = sets N"
      by(auto intro!: sfin.kernel_sets measurable_space[OF from_real_measurable])
    then interpret s3: standard_borel_ne "k (from_real r)"
      using s.standard_borel_ne_axioms standard_borel_ne_sets by blast
    have [measurable]: "s3.from_real  borel M N"
      using measurable_cong_sets s3.from_real_measurable setskfr by blast
    show "((λx. qbs_l_inverse (k x))  from_real) r = measure_to_qbs N, s.from_real, distr (k (from_real r)) borel s.to_realsfin "
      by(auto simp: qbs_l_inverse_def qbs_s_finite_eq_def qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def qbs_Mx_R distr_distr measurable_space[OF from_real_measurable] cong: measure_to_qbs_cong_sets intro!: sfin.image_s_finite_measure s_finite_measure.s_finite_measure_distr qbs_s_finite_measure_eq) (auto intro!: distr_cong simp: sets_eq_imp_space_eq[OF setskfr])
  qed
  have "?lhs = measure_to_qbs (M k k), s2.from_real, distr (M k k) borel s2.to_realsfin"
    by(simp add: qbs_l_inverse_def)
  also have "... = measure_to_qbs N, s.from_real, distr (M k k) borel s.to_realsfin"
    by(auto cong: measure_to_qbs_cong_sets intro!: qbs_s_finite_measure_eq distr_cong s_finite_measure.s_finite_measure_distr sfin.comp_s_finite_measure assms(2) simp: qbs_s_finite_eq_def qbs_s_finite_def qbs_s_finite_axioms_def in_Mx_def qbs_Mx_R distr_distr sets_eq_imp_space_eq[OF sets])
  also have "... = measure_to_qbs N, s.from_real, M k (λx. distr (k x) borel s.to_real)sfin"
    by(simp add: sfin.distr_bind_kernel[OF space_ne refl])
  also have "... = measure_to_qbs N, s.from_real, distr M borel to_real k (λr. distr (k (from_real r)) borel s.to_real)sfin"
  proof -
    have "M k (λx. distr (k x) borel s.to_real) = M k (λx. distr (k (from_real (to_real x))) borel s.to_real)"
      by(auto intro!: bind_kernel_cong_All)
    also have "... = distr M borel to_real k (λr. distr (k (from_real r)) borel s.to_real)"
      by(auto intro!: measure_kernel.bind_kernel_distr[symmetric,where Y=borel] space_ne measure_kernel.distr_measure_kernel[where Y=N] sfin.measure_kernel_comp)
    finally show ?thesis by simp
  qed
  also have "... = ?rhs"
    by(auto intro!: qbs_s_finite.bind_qbs[OF qbs_l_inverse_s_finite[OF refl assms(2)] _ s.s_finite_kernel_qbs_morphism[OF assms(3)] _  _ comp1,symmetric] s_finite_kernel.distr_s_finite_kernel[OF sfin.comp_measurable] simp: qbs_Mx_R) (simp add: qbs_l_inverse_def)
  finally show ?thesis .
qed

lemma qbs_l_inverse_bind:
  assumes "standard_borel_ne N" "s_finite_measure M" "k  M  M prob_algebra N"
  shows "qbs_l_inverse (M  k) = qbs_l_inverse M  (λx. qbs_l_inverse (k x))"
  by(auto simp: bind_kernel_bind[OF measurable_prob_algebraD[OF assms(3)],symmetric] prob_kernel_def' intro!: qbs_l_inverse_bind_kernel assms prob_kernel.s_finite_kernel_prob_kernel)

end

subsubsection ‹ PMF and SPMF ›
definition "qbs_pmf  (λp. qbs_l_inverse (measure_pmf p))"
definition "qbs_spmf  (λp. qbs_l_inverse (measure_spmf p))"

declare [[coercion qbs_pmf]]

lemma qbs_pmf_qbsP:
  fixes p :: "(_ :: countable) pmf"
  shows "qbs_pmf p  qbs_space (monadP_qbs (count_spaceQ UNIV))"
  by(auto simp: qbs_pmf_def measure_to_qbs_cong_sets[of "count_space UNIV" "measure_pmf p",simplified] intro!: standard_borel_ne.qbs_l_inverse_in_space_monadP measure_pmf.prob_space_axioms)

lemma qbs_pmf_qbs[qbs]:
  fixes p :: "(_ :: countable) pmf"
  shows "qbs_pmf p  qbs_space (monadM_qbs (count_spaceQ UNIV))"
  by (simp add: qbs_pmf_qbsP qbs_space_monadPM)

lemma qbs_spmf_qbs[qbs]:
  fixes q :: "(_ :: countable) spmf"
  shows "qbs_spmf q  qbs_space (monadM_qbs (count_spaceQ UNIV))"
  by(auto simp: qbs_spmf_def measure_to_qbs_cong_sets[of "count_space UNIV" "measure_spmf q",simplified] intro!: standard_borel_ne.qbs_l_inverse_in_space_monadM subprob_space.s_finite_measure_subprob)

lemma [simp]:
  fixes p :: "(_ :: countable) pmf" and q :: "(_ :: countable) spmf"
  shows qbs_l_qbs_pmf:  "qbs_l (qbs_pmf p)  = measure_pmf p"
    and qbs_l_qbs_spmf: "qbs_l (qbs_spmf q) = measure_spmf q"
  by(auto simp: qbs_pmf_def qbs_spmf_def intro!: standard_borel_ne.qbs_l_qbs_l_inverse subprob_space.s_finite_measure_subprob measure_pmf.subprob_space_axioms)

lemma qbs_pmf_return_pmf:
  fixes x :: "_ :: countable"
  shows "qbs_pmf (return_pmf x) = return_qbs (count_spaceQ UNIV) x"
proof -
  note return_qbs_morphismP[qbs]
  show ?thesis
    by(auto intro!: inj_onD[OF qbs_l_inj_P[where X="count_spaceQ UNIV"]] return_cong qbs_pmf_qbsP simp: qbs_l_return_qbs return_pmf.rep_eq)
qed

lemma qbs_pmf_bind_pmf:
  fixes p :: "('a :: countable) pmf" and f :: "'a  ('b :: countable) pmf"
  shows "qbs_pmf (p  f) = qbs_pmf p  (λx. qbs_pmf (f x))"
  by(auto simp: measure_pmf_bind qbs_pmf_def space_prob_algebra measure_pmf.prob_space_axioms intro!: standard_borel_ne.qbs_l_inverse_bind[where N="count_space UNIV"] prob_space.s_finite_measure_prob)

lemma qbs_pair_pmf:
  fixes p :: "('a :: countable) pmf" and q :: "('b :: countable) pmf"
  shows "qbs_pmf p Qmes qbs_pmf q = qbs_pmf (pair_pmf p q)"
proof(rule inj_onD[OF qbs_l_inj_P[of "count_spaceQ UNIV Q count_spaceQ UNIV"]])
  show "qbs_l (qbs_pmf p Qmes qbs_pmf q) = qbs_l (qbs_pmf (pair_pmf p q))"
    by(simp add: measure_pair_pmf qbs_l_qbs_pair_measure[OF standard_borel_ne.standard_borel standard_borel_ne.standard_borel,of "count_space UNIV" "count_space UNIV"])
next
  note [qbs] = qbs_pmf_qbsP qbs_pair_measure_morphismP
  show "qbs_pmf p Qmes qbs_pmf q  qbs_space (monadP_qbs (count_spaceQ UNIV Q count_spaceQ UNIV))" "qbs_pmf (pair_pmf p q)  qbs_space (monadP_qbs (count_spaceQ UNIV Q count_spaceQ UNIV))"
    by auto (simp add: qbs_count_space_prod)
qed

subsubsection ‹ Density ›
lift_definition density_qbs :: "['a qbs_measure, 'a  ennreal]  'a qbs_measure"
is "λ(X,α,μ) f. if f  X Q qbs_borel then (X, α, density μ (f  α)) else (X, SOME a. a  qbs_Mx X, null_measure borel)"
proof safe
  fix X Y :: "'a quasi_borel"
  fix α β μ ν and f :: "_  ennreal"
  assume 1:"qbs_s_finite_eq (X, α, μ) (Y, β, ν)"
  then interpret qs: pair_qbs_s_finite X α μ β ν
    using qbs_s_finite_eq_dest[OF 1] by(simp add: pair_qbs_s_finite_def)
  have [simp]:"(SOME a. a  qbs_Mx X)  qbs_Mx X" "(SOME a. a  qbs_Mx Y)  qbs_Mx X"
    using qs.pq1.in_Mx by(simp_all only: some_in_eq qbs_s_finite_eq_dest[OF 1]) blast+
  {
    assume "f  X Q qbs_borel"
    then have "qbs_s_finite_eq (X, α, density μ (f  α)) (Y, β, density ν (f  β))"
      by(auto simp: qbs_s_finite_eq_def lr_adjunction_correspondence density_distr[symmetric] comp_def qbs_s_finite_eq_dest[OF 1] qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def qs.pq1.mu_sets qs.pq2.mu_sets AE_distr_iff intro!: qs.pq1.s_finite_measure_density qs.pq2.s_finite_measure_density)
  }
  moreover have "f  X Q qbs_borel  f  Y Q qbs_borel  qbs_s_finite_eq (X, α, density μ (f  α)) (Y, (SOME a. a  qbs_Mx Y), null_measure borel)"
       "f  X Q qbs_borel  f  Y Q qbs_borel  qbs_s_finite_eq (X, (SOME a. a  qbs_Mx X), null_measure borel) (Y, β, density ν (f  β))"
       "f  X Q qbs_borel  f  Y Q qbs_borel  qbs_s_finite_eq (X, (SOME a. a  qbs_Mx X), null_measure borel) (Y, (SOME a. a  qbs_Mx Y), null_measure borel)"
    by(auto simp: qbs_s_finite_eq_dest[OF 1] qbs_s_finite_eq_def qbs_s_finite_def in_Mx_def qbs_s_finite_axioms_def distr_return null_measure_distr intro!: subprob_space.s_finite_measure_subprob subprob_spaceI)
  ultimately show "qbs_s_finite_eq (if f  X Q borelQ then (X, α, density μ (f  α)) else (X, SOME aa. aa  qbs_Mx X, null_measure borel)) (if f  Y Q borelQ then (Y, β, density ν (f  β)) else (Y, SOME a. a  qbs_Mx Y, null_measure borel))"
    by auto
qed

lemma(in qbs_s_finite)
  assumes "f  X Q qbs_borel"
  shows density_qbs:"density_qbs X,α, μsfin f = X, α, density μ (f  α)sfin"
    and density_qbs_s_finite: "qbs_s_finite X α (density μ (f  α))"
  using assms by(auto simp: density_qbs.abs_eq  qbs_s_finite_def in_Mx_def lr_adjunction_correspondence qbs_s_finite_axioms_def mu_sets AE_distr_iff intro!: s_finite_measure_density)

lemma density_qbs_density_qbs_eq:
  assumes [qbs]:"s  qbs_space (monadM_qbs X)" "f   X Q qbs_borel" "g  X Q qbs_borel"
  shows "density_qbs (density_qbs s f) g = density_qbs s (λx. f x * g x)"
proof -
  from rep_qbs_space_monadM[OF assms(1)] obtain α μ
    where hs: "s = X, α, μsfin" "qbs_s_finite X α μ" by metis
  then interpret qbs_s_finite X α μ by simp
  show ?thesis
    using assms(2,3) by(simp add: hs(1) density_qbs[OF assms(2)] qbs_s_finite.density_qbs[OF density_qbs_s_finite[OF assms(2)] assms(3)] density_qbs lr_adjunction_correspondence density_density_eq) (simp add: comp_def)
qed

lemma qbs_l_density_qbs:
  assumes "s  qbs_space (monadM_qbs X)" "f  X Q qbs_borel"
  shows "qbs_l (density_qbs s f) = density (qbs_l s) f"
proof -
  from rep_qbs_space_monadM[OF assms(1)]
  obtain α μ where s: "s = X, α, μsfin" "qbs_s_finite X α μ"
    by metis
  then interpret qbs_s_finite X α μ by simp
  show ?thesis
    using assms(2) by(simp add: s(1) qbs_l qbs_s_finite.density_qbs[OF s(2) assms(2)] qbs_s_finite.qbs_l[OF qbs_s_finite.density_qbs_s_finite[OF s(2) assms(2)]] density_distr lr_adjunction_correspondence) (simp add: comp_def)
qed

corollary qbs_l_density_qbs_indicator:
  assumes [qbs]:"s  qbs_space (monadM_qbs X)" "qbs_pred X P"
  shows "qbs_l (density_qbs s (indicator {xqbs_space X. P x})) (qbs_space X) = qbs_l s {xqbs_space X. P x} "
proof -
  have 1[measurable]: "{x  qbs_space X. P x}  sets (qbs_to_measure X)"
    by (metis qbs_pred_iff_sets space_L assms(2))
  have 2[qbs]: "indicator {x  qbs_space X. P x}  X Q qbs_borel"
    by(rule indicator_qbs_morphism'') qbs
  show ?thesis
    using assms(2) by(auto simp: qbs_l_density_qbs[of _ X] emeasure_density[of "indicator {xspace (qbs_to_measure X). P x}" "qbs_l s",OF _ sets.top,simplified measurable_qbs_l'[OF assms(1)],OF borel_measurable_indicator[OF predE],simplified space_L space_qbs_l_in[OF assms(1)]] qbs_pred_iff_measurable_pred nn_set_integral_space[of "qbs_l s",simplified space_qbs_l_in[OF assms(1)]] nn_integral_indicator[of _ "qbs_l s",simplified sets_qbs_l[OF assms(1)]])
qed

lemma qbs_nn_integral_density_qbs:
  assumes [qbs]:"s  qbs_space (monadM_qbs X)" "f  X Q qbs_borel" "g  X Q qbs_borel"
  shows "(+Q x. g x (density_qbs s f)) = (+Q x. f x * g x s)"
  by(auto simp: qbs_nn_integral_def2_l qbs_l_density_qbs[of _ X] measurable_qbs_l'[OF assms(1)] lr_adjunction_correspondence[symmetric] intro!:nn_integral_density)

lemma qbs_integral_density_qbs:
  fixes g :: "'a  'b::{banach, second_countable_topology}" and f :: "'a  real"
  assumes [qbs]:"s  qbs_space (monadM_qbs X)" "f  X Q qbs_borel" "g  X Q qbs_borel"
      and "AEQ x in s. f x  0"
    shows "(Q x. g x (density_qbs s f)) = (Q x. f x *R g x s)"
  using assms(4) by(auto simp: qbs_integral_def2_l qbs_l_density_qbs[of _ X] measurable_qbs_l'[OF assms(1)] lr_adjunction_correspondence[symmetric] AEq_qbs_l intro!: integral_density)

lemma density_qbs_morphism[qbs]: "density_qbs  monadM_qbs X Q (X Q qbs_borel) Q monadM_qbs X"
proof(rule curry_preserves_morphisms[OF pair_qbs_morphismI])
  fix γ and β :: "_  _  ennreal"
  assume h:"γ  qbs_Mx (monadM_qbs X)"  "β  qbs_Mx (X Q qbs_borel)"
  hence [qbs]: "γ  qbs_borel Q monadM_qbs X" "β  qbs_borel Q X Q qbs_borel"
    by(simp_all add: qbs_Mx_is_morphisms)
  from rep_qbs_Mx_monadM[OF h(1)] obtain α k where hk:
   "γ = (λr. X, α, k rsfin)" "α  qbs_Mx X" "s_finite_kernel borel borel k" "r. qbs_s_finite X α (k r)"
    by metis
  then interpret a: in_Mx X α by(simp add: in_Mx_def)
  have [measurable]: "(λ(x, y). β x (α y))  borel_measurable (borel M borel)"
  proof -
    have "(λ(x, y). β x (α y))  qbs_borel Q qbs_borel Q qbs_borel"
      by simp
    thus ?thesis
      by(simp add: lr_adjunction_correspondence qbs_borel_prod borel_prod)
  qed
  have [simp]:"density_qbs (γ r) (β r) = X, α, density (k r) (β r  α)sfin " for r
    using hk(4) by(auto simp add: hk(1) density_qbs.abs_eq[OF qbs_s_finite.qbs_s_finite_eq_refl[OF hk(4)]])
  show "(λr. density_qbs (fst (γ r,β r)) (snd (γ r,β r)))  qbs_Mx (monadM_qbs X)"
    by(auto simp: monadM_qbs_Mx comp_def intro!: exI[where x=α] exI[where x="λr. density (k r) (β r  α)"] s_finite_kernel.density_s_finite_kernel[OF hk(3)])
qed

lemma density_qbs_cong_AE:
  assumes [qbs]: "s  qbs_space (monadM_qbs X)" "f  X Q qbs_borel" "g  X Q qbs_borel"
      and "AEQ x in s. f x = g x"
    shows "density_qbs s f = density_qbs s g"
proof(rule inj_onD[OF qbs_l_inj[of X]])
  show "qbs_l (density_qbs s f) = qbs_l (density_qbs s g)"
    using assms(4) by(auto simp: qbs_l_density_qbs[of _ X] measurable_qbs_l'[OF assms(1)] AEq_qbs_l lr_adjunction_correspondence[symmetric] intro!: density_cong)
qed simp_all

corollary density_qbs_cong:
  assumes [qbs]: "s  qbs_space (monadM_qbs X)" "f  X Q qbs_borel" "g  X Q qbs_borel"
      and "x. x  qbs_space X  f x = g x"
    shows "density_qbs s f = density_qbs s g"
  by(auto intro!: density_qbs_cong_AE[of _ X] AEq_I2[of _ X] assms(4))

lemma density_qbs_1[simp]: "density_qbs s (λx. 1) = s"
proof -
  obtain X where s[qbs]: "s  qbs_space (monadM_qbs X)"
    using in_qbs_space_of by blast
  show ?thesis
    by(auto intro!: inj_onD[OF qbs_l_inj _ _ s] simp: qbs_l_density_qbs[of _ X] density_1)
qed

lemma pair_density_qbs:
  assumes [qbs]: "p  qbs_space (monadM_qbs X)" "q  qbs_space (monadM_qbs Y)"
      and [qbs]: "f  X Q qbs_borel" "g  Y Q qbs_borel"
    shows "density_qbs p f Qmes density_qbs q g = density_qbs (p Qmes q) (λ(x,y). f x * g y)"
proof(safe intro!: qbs_measure_eqI[of _ "X Q Y"])
  fix h :: "_  ennreal"
  assume h[qbs]:"h  X Q Y Q borelQ"
  show "(+Q z. h z (density_qbs p f Qmes density_qbs q g)) = (+Q z. h z (density_qbs (p Qmes q) (λ(x, y). f x * g y)))" (is "?lhs = ?rhs")
  proof -
    have "?lhs = (+Q x. +Q y. h (x, y) density_qbs q g density_qbs p f)"
      by(simp add: qbs_nn_integral_Fubini_fst[of _ X _ Y])
    also have "... = (+Q x. +Q y. g y * h (x, y) q density_qbs p f)"
      by(auto intro!: qbs_nn_integral_cong[of _ X] simp: qbs_nn_integral_density_qbs[of _ Y])
    also have "... = ?rhs"
      by(auto simp add: qbs_nn_integral_density_qbs[of _ X] qbs_nn_integral_density_qbs[of _ "X Q Y"] split_beta' qbs_nn_integral_Fubini_fst[of _ X _ Y,symmetric] qbs_nn_integral_cmult[of _ Y] mult.assoc intro!: qbs_nn_integral_cong[of _ X])
    finally show ?thesis .
  qed
qed simp_all

subsubsection ‹ Normalization ›
definition normalize_qbs :: "'a qbs_measure  'a qbs_measure" where
"normalize_qbs s  (let X = qbs_space_of s;
                        r = qbs_l s (qbs_space X) in
                    if r  0  r   then density_qbs s (λx. 1 / r)
                    else qbs_null_measure X)"

lemma
  assumes "s  qbs_space (monadM_qbs X)"
  shows normalize_qbs: "qbs_l s (qbs_space X)  0  qbs_l s (qbs_space X)    normalize_qbs s = density_qbs s (λx. 1 /  emeasure (qbs_l s) (qbs_space X))"
    and normalize_qbs0: "qbs_l s (qbs_space X) = 0  normalize_qbs s = qbs_null_measure X"
    and normalize_qbsinfty: "qbs_l s (qbs_space X) =   normalize_qbs s = qbs_null_measure X"
  by(auto simp: qbs_space_of_in[OF assms(1)] normalize_qbs_def)

lemma normalize_qbs_prob:
  assumes "s  qbs_space (monadM_qbs X)" "qbs_l s (qbs_space X)  0" "qbs_l s (qbs_space X)  "
  shows "normalize_qbs s  qbs_space (monadP_qbs X)"
  unfolding normalize_qbs[OF assms]
proof -
  obtain α μ
    where hs: "s = X, α, μsfin" "qbs_s_finite X α μ"
    using rep_qbs_space_monadM assms(1) by meson
  interpret qs: qbs_s_finite X α μ by fact
  have "density_qbs s (λx. 1 / emeasure (qbs_l s) (qbs_space X)) = density_qbs X, α, μsfin (λx. 1 / emeasure (qbs_l s) (qbs_space X))"
    by(simp add: hs)
  also have "...  qbs_space (monadP_qbs X)"
    by(auto simp add: qs.density_qbs monadP_qbs_space qbs_s_finite.qbs_l[OF qs.density_qbs_s_finite,of "λx. 1 / emeasure (qbs_l s) (qbs_space X)",simplified] qbs_s_finite.qbs_space_of[OF qs.density_qbs_s_finite,of "λx. 1 / emeasure (qbs_l s) (qbs_space X)",simplified] intro!: prob_space.prob_space_distr, auto intro!: prob_spaceI simp: emeasure_density)
      (insert assms(2,3),auto simp: hs qs.qbs_l emeasure_distr emeasure_distr[of _ _ "qbs_to_measure X",OF _ sets.top,simplified space_L] divide_eq_1_ennreal ennreal_divide_times)
  finally show "density_qbs s (λx. 1 / emeasure (qbs_l s) (qbs_space X))  qbs_space (monadP_qbs X)" .
qed

lemma normalize_qbs_morphism[qbs]: "normalize_qbs  monadM_qbs X Q monadM_qbs X"
proof -
  have "(if emeasure (qbs_l s) (qbs_space X)  0  emeasure (qbs_l s) (qbs_space X)   then density_qbs s (λx. 1 / emeasure (qbs_l s) (qbs_space X)) else qbs_null_measure X) = normalize_qbs s"  (is "?f s = _") if s:"s  qbs_space (monadM_qbs X)" for s
    by(simp add: qbs_space_of_in[OF s] normalize_qbs_def)
  moreover have "(λs. ?f s)  monadM_qbs X Q monadM_qbs X"
  proof(cases "qbs_space X = {}")
    case True
    then show ?thesis
      by(simp add: qbs_morphism_from_empty  monadM_qbs_empty_iff[of X])
  next
    case X:False
    have [qbs]:"(λs. emeasure (qbs_l s) (qbs_space X))  monadM_qbs X Q qbs_borel"
      by(rule qbs_l_morphism[OF sets.top[of "qbs_to_measure X",simplified space_L]])
    have [qbs]: "qbs_null_measure X  qbs_space (monadM_qbs X)"
      by(auto intro!: qbs_null_measure_in_Mx X)
    have [qbs]: "(λs x. 1 / emeasure (qbs_l s) (qbs_space X))  monadM_qbs X Q X Q qbs_borel"
      by(rule arg_swap_morphism) simp
    show ?thesis
      by qbs
  qed
  ultimately show ?thesis
    by(simp cong: qbs_morphism_cong)
qed

lemma normalize_qbs_morphismP:
  assumes [qbs]:"s  X Q monadM_qbs Y"
      and "x. x  qbs_space X  qbs_l (s x) (qbs_space Y)  0" "x. x  qbs_space X  qbs_l (s x) (qbs_space Y)  "
    shows "(λx. normalize_qbs (s x))  X Q monadP_qbs Y"
  by(rule qbs_morphism_monadPI'[OF normalize_qbs_prob]) (use assms(2,3) qbs_morphism_space[OF assms(1)] in auto)

lemma normalize_qbs_monadP_ident:
  assumes "s  qbs_space (monadP_qbs X)"
  shows "normalize_qbs s = s"
  using normalize_qbs[OF qbs_space_monadPM[OF assms]] prob_space.emeasure_space_1[OF qbs_l_prob_space[OF assms]]
  by(auto simp: space_qbs_l_in[OF qbs_space_monadPM[OF assms]] intro!: inj_onD[OF qbs_l_inj_P _ _ assms])

corollary normalize_qbs_idenpotent: "normalize_qbs (normalize_qbs s) = normalize_qbs s"
proof -
  obtain X where s[qbs]: "s  qbs_space (monadM_qbs X)"
    using in_qbs_space_of by blast
  then have X: "qbs_space X  {}"
    by (metis qbs_s_space_of_not_empty qbs_space_of_in)
  then obtain x where x:"x  qbs_space X" by auto
  consider "qbs_l s (qbs_space X) = 0" | "qbs_l s (qbs_space X) = " | "qbs_l s (qbs_space X)  0"  "qbs_l s (qbs_space X)  "
    by auto
  then show ?thesis
  proof cases
    case 1
    then show ?thesis
      using normalize_qbs0[OF qbs_null_measure_in_Mx[OF X]]
      by(simp add: normalize_qbs0[OF s] qbs_null_measure_null_measure[OF X])
  next
    case 2
    then show ?thesis
      using normalize_qbs0[OF qbs_null_measure_in_Mx[OF X]]
      by(simp add: normalize_qbsinfty[OF s] qbs_null_measure_null_measure[OF X])
  next
    case 3
    have "normalize_qbs s  qbs_space (monadP_qbs X)"
      by(rule qbs_morphism_space[OF normalize_qbs_morphismP[of "λx. s"],of X X x]) (auto simp: 3 x)
    then show ?thesis
      by(simp add: normalize_qbs_monadP_ident)
  qed
qed

subsubsection ‹ Product Measures ›
definition PiQ_measure :: "['a set, 'a  'b qbs_measure]  ('a  'b) qbs_measure" where
"PiQ_measure  (λI si. if (iI. Mi. standard_borel_ne Mi  si i  qbs_space (monadM_qbs (measure_to_qbs Mi)))
                        then if countable I  (iI. prob_space (qbs_l (si i))) then qbs_l_inverse (ΠM iI. qbs_l (si i))
                             else if finite I  (iI. sigma_finite_measure (qbs_l (si i))) then qbs_l_inverse (ΠM iI. qbs_l (si i))
                             else qbs_null_measure (ΠQ iI. qbs_space_of (si i))
                        else qbs_null_measure (ΠQ iI. qbs_space_of (si i)))"

syntax
  "_PiQ_measure" :: "pttrn  'i set  'a qbs_measure  ('i => 'a) qbs_measure"  ("(3ΠQmeas __./ _)"  10)
translations
  "ΠQmeas xI. X" == "CONST PiQ_measure I (λx. X)"

context
  fixes I and Mi
  assumes standard_borel_ne:"i. i  I  standard_borel_ne (Mi i)"
begin

context
  assumes countableI:"countable I"
begin

interpretation sb:standard_borel_ne "ΠM iI. (borel :: real measure)"
  by (simp add: countableI product_standard_borel_ne)

interpretation sbM: standard_borel_ne "ΠM iI. Mi i"
  by (simp add: countableI standard_borel_ne product_standard_borel_ne)

lemma
  assumes "i. i  I  si i  qbs_space (monadP_qbs (measure_to_qbs (Mi i)))"
      and "i. i  I  si i = measure_to_qbs (Mi i), α i, μ isfin" "i. i  I  qbs_prob (measure_to_qbs (Mi i)) (α i) (μ i)"
    shows PiQ_measure_prob_eq:  "(ΠQmeas iI. si i) = measure_to_qbs (ΠM iI. Mi i), sbM.from_real, distr (ΠM iI. qbs_l (si i)) borel sbM.to_realsfin"  (is "_ = ?rhs")
      and PiQ_measure_qbs_prob: "qbs_prob (measure_to_qbs (ΠM iI. Mi i)) sbM.from_real (distr (ΠM iI. qbs_l (si i)) borel sbM.to_real)" (is "?qbsprob")
proof -
  have [measurable_cong,simp]: "prob_space (ΠM iI. qbs_l (si i))" "sets (ΠM iI. qbs_l (si i)) = sets (ΠM iI. Mi i)"
    using sets_qbs_l[OF assms(1)[THEN qbs_space_monadPM]] standard_borel.lr_sets_ident[OF standard_borel_ne.standard_borel[OF standard_borel_ne]]
    by(auto cong: sets_PiM_cong intro!: prob_space_PiM qbs_l_prob_space assms(1))
  show ?qbsprob
    by(auto simp: pair_qbs_s_finite_def intro!: qbs_prob.qbs_s_finite sbM.qbs_l_inverse_qbs_prob)
  have "(ΠQmeas iI. si i) = qbs_l_inverse (ΠM iI. qbs_l (si i))"
    using countableI assms(1)[THEN qbs_space_monadPM] qbs_l_prob_space[OF assms(1)] standard_borel_ne by(auto simp: PiQ_measure_def)
  also have "... = ?rhs"
    by(auto intro!: sbM.qbs_l_inverse_def2 prob_space.s_finite_measure_prob cong: sets_PiM_cong[OF refl])
  finally show "(ΠQmeas iI. si i) = ?rhs" .
qed

lemma qbs_l_PiQ_measure_prob:
  assumes "i. i  I  si i  qbs_space (monadP_qbs (measure_to_qbs (Mi i)))"
  shows "qbs_l (ΠQmeas iI. si i) = (ΠM iI. qbs_l (si i))"
proof -
  have "qbs_l (ΠQmeas iI. si i) = qbs_l (qbs_l_inverse (ΠM iI. qbs_l (si i)))"
    using countableI assms(1)[THEN qbs_space_monadPM] qbs_l_prob_space[OF assms(1)] standard_borel_ne by(auto simp: PiQ_measure_def)
  also have "... = (ΠM iI. qbs_l (si i))"
    using sets_qbs_l[OF assms(1)[THEN qbs_space_monadPM]] standard_borel.lr_sets_ident[OF standard_borel_ne.standard_borel[OF standard_borel_ne]]
    by(auto intro!: sbM.qbs_l_qbs_l_inverse_prob prob_space_PiM qbs_l_prob_space[OF assms(1)] cong: sets_PiM_cong)
  finally show ?thesis .
qed

end

context
  assumes finI: "finite I"
begin

interpretation sb:standard_borel_ne "ΠM iI. (borel :: real measure)"
  by (simp add: finI product_standard_borel_ne countable_finite)

interpretation sbM: standard_borel_ne "ΠM iI. Mi i"
  by (simp add: countable_finite finI standard_borel_ne product_standard_borel_ne)

lemma qbs_l_PiQ_measure:
  assumes "i. i  I  si i  qbs_space (monadM_qbs (measure_to_qbs (Mi i)))"
      and "i. i  I  sigma_finite_measure (qbs_l (si i))"
    shows "qbs_l (ΠQmeas iI. si i) = (ΠM iI. qbs_l (si i))"
proof -
  have [simp]: "s_finite_measure (ΠM iI. qbs_l (si i))"
  proof -
    have "(ΠM iI. qbs_l (si i)) = (ΠM iI. if i  I then qbs_l (si i) else null_measure (count_space UNIV))"
      by(simp cong: PiM_cong)
    also have "s_finite_measure ..."
      by(auto intro!: sigma_finite_measure.s_finite_measure product_sigma_finite.sigma_finite finI simp: product_sigma_finite_def assms(2)) (auto intro!: finite_measure.sigma_finite_measure finite_measureI)
    finally show ?thesis .
  qed
  have "qbs_l (ΠQmeas iI. si i) = qbs_l (qbs_l_inverse (ΠM iI. qbs_l (si i)))"
    using finI assms(1) assms(2) standard_borel_ne by(fastforce simp: PiQ_measure_def)
  also have "... = (ΠM iI. qbs_l (si i))"
    using sets_qbs_l[OF assms(1)] standard_borel.lr_sets_ident[OF standard_borel_ne.standard_borel[OF standard_borel_ne]]
    by(auto intro!: sbM.qbs_l_qbs_l_inverse  prob_space_PiM cong: sets_PiM_cong)
  finally show ?thesis .
qed


end

end
subsection ‹Measures›
subsubsection ‹ The Lebesgue Measure ›
definition lborel_qbs ("lborelQ") where "lborel_qbs  qbs_l_inverse lborel"

lemma lborel_qbs_qbs[qbs]: "lborel_qbs  qbs_space (monadM_qbs qbs_borel)"
  by(auto simp: lborel_qbs_def measure_to_qbs_cong_sets[OF sets_lborel,symmetric] intro!: standard_borel_ne.qbs_l_inverse_in_space_monadM lborel.s_finite_measure_axioms)

lemma qbs_l_lborel_qbs[simp]: "qbs_l lborelQ = lborel"
  by(auto intro!: standard_borel_ne.qbs_l_qbs_l_inverse lborel.s_finite_measure_axioms simp: lborel_qbs_def)

corollary
  shows qbs_integral_lborel: "(Q x. f x lborel_qbs) = (x. f x lborel)"
    and qbs_nn_integral_lborel: "(+Q x. f x lborel_qbs) = (+x. f x lborel)"
  by(simp_all add: qbs_integral_def2_l qbs_nn_integral_def2_l)


lemma(in standard_borel_ne) measure_with_args_morphism:
  assumes "s_finite_kernel X M k"
  shows "qbs_l_inverse  k  measure_to_qbs X Q monadM_qbs (measure_to_qbs M)"
proof(safe intro!: qbs_morphismI)
  fix α :: "real  _"
  assume "α  qbs_Mx (measure_to_qbs X)"
  then have h[measurable]:"α  borel M X"
    by(simp add: qbs_Mx_R)
  interpret s:s_finite_kernel X M k by fact
  have 1: "r. sets (k (α r)) = sets M" "r. s_finite_measure (k (α r))"
    using measurable_space[OF h] s.kernel_sets by(auto intro!: s.image_s_finite_measure)
  show "qbs_l_inverse  k  α  qbs_Mx (monadM_qbs (measure_to_qbs M))"
    by(auto intro!: exI[where x=from_real] exI[where x="(λr. distr (k (α r)) borel to_real)"] s_finite_kernel.comp_measurable[OF s_finite_kernel.distr_s_finite_kernel[OF assms]] simp: monadM_qbs_Mx qbs_Mx_R qbs_l_inverse_def2[OF 1] comp_def)
qed

lemma(in standard_borel_ne) measure_with_args_morphismP:
  assumes [measurable]:"μ  X M prob_algebra M"
  shows "qbs_l_inverse  μ  measure_to_qbs X Q monadP_qbs (measure_to_qbs M)"
  by(rule qbs_morphism_monadPI'[OF _ measure_with_args_morphism])
    (insert measurable_space[OF assms], auto simp: qbs_space_R space_prob_algebra prob_kernel_def' intro!: qbs_l_inverse_in_space_monadP prob_kernel.s_finite_kernel_prob_kernel)

subsubsection ‹ Counting Measure ›
abbreviation "counting_measure_qbs A  qbs_l_inverse (count_space A)"

lemma qbs_nn_integral_count_space_nat:
  fixes f :: "nat  ennreal"
  shows "(+Q i. f i counting_measure_qbs UNIV) = (i. f i)"
  by(simp add: standard_borel_ne.qbs_l_qbs_l_inverse[OF _ refl sigma_finite_measure.s_finite_measure[OF sigma_finite_measure_count_space]] qbs_nn_integral_def2_l nn_integral_count_space_nat)

subsubsection ‹ Normal Distribution ›
lemma qbs_normal_distribution_qbs: "(λμ σ. density_qbs lborelQ (normal_density μ σ))  qbs_borel Q qbs_borel Q monadM_qbs qbs_borel"
  by simp

lemma qbs_l_qbs_normal_distribution[simp]: "qbs_l (density_qbs lborelQ (normal_density μ σ)) = density lborel (normal_density μ σ)"
  by(auto simp: qbs_l_density_qbs[of _ qbs_borel])

lemma qbs_normal_distribution_P: "σ > 0  density_qbs lborelQ (normal_density μ σ)  qbs_space (monadP_qbs qbs_borel)"
  by(auto simp: monadP_qbs_def sub_qbs_space prob_space_normal_density)

lemma qbs_normal_distribution_integral:
 "(Q x. f x  (density_qbs lborelQ (normal_density μ σ))) = ( x. f x  (density lborel (λx. ennreal (normal_density μ σ x))))"
  by(auto simp: qbs_integral_def2_l)

lemma qbs_normal_distribution_expectation:
  assumes [measurable]:"f  borel_measurable borel" and [arith]: "σ > 0"
  shows "(Q x. f x  (density_qbs lborelQ (normal_density μ σ))) = ( x. normal_density μ σ x * f x  lborel)"
  by(simp add: qbs_normal_distribution_integral integral_real_density integral_density)

lemma qbs_normal_posterior:
  assumes [arith]: "σ > 0" "σ' > 0"
  shows "normalize_qbs (density_qbs (density_qbs lborelQ (normal_density μ σ)) (normal_density μ' σ')) = density_qbs lborelQ (normal_density ((μ * σ'2 + μ' * σ2) / (σ2 + σ'2)) (σ * σ' / sqrt (σ2 + σ'2)))" (is "?lhs = ?rhs")
proof -
  have 0: "σ * σ' / sqrt (σ2 + σ'2) > 0" "sqrt (2 * pi * (σ2 + σ'2)) > 0"
    by (simp_all add: power2_eq_square sum_squares_gt_zero_iff)
  have 1:"qbs_l (density_qbs lborelQ (λx. ennreal (1 / sqrt (2 * pi * (σ2 + σ'2)) * exp (- ((μ - μ')2 / (2 * σ2 + 2 * σ'2))) * normal_density ((μ * σ'2 + μ' * σ2) / (σ2 + σ'2)) (σ * σ' / sqrt (σ2 + σ'2)) x))) UNIV = ennreal (exp (- ((μ - μ')2 / (2 * σ2 + 2 * σ'2))) / sqrt (2 * pi * (σ2 + σ'2)))"
    using prob_space.emeasure_space_1[OF prob_space_normal_density[OF 0(1)]] by(auto simp add: qbs_l_density_qbs[of _ qbs_borel] emeasure_density ennreal_mult' nn_integral_cmult simp del: times_divide_eq_left) (simp add: ennreal_mult'[symmetric])
  have "?lhs = normalize_qbs (density_qbs lborelQ (λx. ennreal (1 / sqrt (2 * pi * (σ2 + σ'2)) * exp (- ((μ - μ')2 / (2 * σ2 + 2 * σ'2))) * normal_density ((μ * σ'2 + μ' * σ2) / (σ2 + σ'2)) (σ * σ' / sqrt (σ2 + σ'2)) x)))"
    by(simp add: density_qbs_density_qbs_eq[of _ qbs_borel] ennreal_mult'[symmetric] normal_density_times del: times_divide_eq_left)
  also have "... = density_qbs (density_qbs lborelQ (λx. ennreal (1 / sqrt (2 * pi * (σ2 + σ'2)) * exp (- ((μ - μ')2 / (2 * σ2 + 2 * σ'2))) * normal_density ((μ * σ'2 + μ' * σ2) / (σ2 + σ'2)) (σ * σ' / sqrt (σ2 + σ'2)) x))) (λx. 1 / emeasure (qbs_l (density_qbs lborelQ (λx. ennreal (1 / sqrt (2 * pi * (σ2 + σ'2)) * exp (- ((μ - μ')2 / (2 * σ2 + 2 * σ'2))) * normal_density ((μ * σ'2 + μ' * σ2) / (σ2 + σ'2)) (σ * σ' / sqrt (σ2 + σ'2)) x)))) (qbs_space borelQ))"
    by(rule normalize_qbs) (simp_all add: 1 del: times_divide_eq_left)
  also have "... = ?rhs"
    by(simp add: 1 density_qbs_density_qbs_eq[of _ qbs_borel] del: times_divide_eq_left, auto intro!: density_qbs_cong[of _ qbs_borel])
      (insert 0, auto simp: ennreal_1[symmetric] ennreal_mult'[symmetric] divide_ennreal normal_density_def  simp del: ennreal_1)
  finally show ?thesis .
qed

subsubsection ‹ Uniform Distribution ›
definition uniform_qbs :: "'a qbs_measure  'a set  'a qbs_measure" where
"uniform_qbs  (λs A. qbs_l_inverse (uniform_measure (qbs_l s) A))"

lemma(in standard_borel_ne) qbs_l_uniform_qbs':
  assumes "sets μ = sets M" "s_finite_measure μ" "μ A  0"
  shows "qbs_l (uniform_qbs (qbs_l_inverse μ) A) = uniform_measure μ A" (is "?lhs = ?rhs")
proof -
  have "?lhs = qbs_l (qbs_l_inverse (uniform_measure μ A))"
    by(simp add: qbs_l_qbs_l_inverse[OF assms(1,2)] uniform_qbs_def)
  also have "... = ?rhs"
  proof(rule qbs_l_qbs_l_inverse)
    consider "μ A = " | "μ A  " by auto
    then show "s_finite_measure (uniform_measure μ A)"
    proof cases
      case 1
      have A[measurable]: "A  sets μ"
        using assms(3) emeasure_notin_sets by blast
      have "uniform_measure μ A = density μ (λx. 0)"
        by(auto simp: uniform_measure_def 1 intro!: density_cong)
      also have "... = null_measure μ"
        by(simp add: null_measure_eq_density)
      finally show ?thesis
        by(auto intro!: finite_measure.s_finite_measure_finite_measure finite_measureI)
    next
      case 2
      show ?thesis
        by(rule prob_space.s_finite_measure_prob[OF prob_space_uniform_measure[OF assms(3) 2]])
    qed
  qed(simp add: assms)
  finally show ?thesis .
qed

corollary(in standard_borel_ne) qbs_l_uniform_qbs:
  assumes "s  qbs_space (monadM_qbs (measure_to_qbs M))" "qbs_l s A  0" 
  shows "qbs_l (uniform_qbs s A) = uniform_measure (qbs_l s) A"
  by(simp add: qbs_l_uniform_qbs'[OF sets_qbs_l[OF assms(1),simplified lr_sets_ident] qbs_l_s_finite.s_finite_measure_axioms assms(2),symmetric] qbs_l_inverse_qbs_l[OF assms(1)])

lemma interval_uniform_qbs: "(λa b. uniform_qbs lborelQ {a<..<b::real})  borelQ Q borelQ Q monadM_qbs borelQ"
proof(rule curry_preserves_morphisms)
  have "(λxy. uniform_qbs lborelQ {fst xy<..<snd xy::real}) = qbs_l_inverse  (λxy. uniform_measure lborel {fst xy<..<snd xy})"
    by(auto simp: uniform_qbs_def)
  also have "...  measure_to_qbs (borel M borel) Q monadM_qbs borelQ"
  proof(safe intro!: standard_borel_ne.measure_with_args_morphism measure_kernel.s_finite_kernel_finite_bounded)
    show "measure_kernel (borel M borel) borel (λxy. uniform_measure lborel {fst xy<..<snd xy :: real})"
    proof
      fix B :: "real set"
      assume [measurable]:"B  sets borel"
      have [simp]:"emeasure lborel ({fst x<..<snd x}  B) / emeasure lborel {fst x<..<snd x} = (if fst x  snd x then emeasure lborel ({fst x<..<snd x}  B) / ennreal (snd x - fst x) else 0)" for x
        by auto
      show "(λx. emeasure (uniform_measure lborel {fst x<..<snd x}) B)  borel_measurable (borel M borel)"
        by (simp, measurable) auto
    qed auto
  next
    show "(a, b)  space (borel M borel)  emeasure (uniform_measure lborel {fst (a, b)<..<snd (a, b)}) (space borel) < " for a b :: real
      by(cases "a  b") (use ennreal_divide_eq_top_iff top.not_eq_extremum in auto)
  qed simp
  finally show "(λxy. uniform_qbs lborelQ {fst xy<..<snd xy::real})  borelQ Q borelQ Q monadM_qbs borelQ"
    by (simp add: borel_prod qbs_borel_prod)
qed

context
  fixes a b :: real
  assumes [arith]:"a < b"
begin

lemma qbs_uniform_distribution_expectation:
  assumes "f  qbs_borel Q qbs_borel"
  shows "(+Q x. f x uniform_qbs lborelQ {a<..<b}) = (+x  {a<..<b}. f x lborel) / (b - a)"
proof -
  have [measurable]: "f  borel_measurable borel"
    using assms qbs_Mx_is_morphisms qbs_Mx_qbs_borel by blast
  show ?thesis
    by(auto simp: qbs_nn_integral_def2_l standard_borel_ne.qbs_l_uniform_qbs[of borel lborel_qbs] nn_integral_uniform_measure)
qed

end

subsubsection ‹ Bernoulli Distribution ›
abbreviation qbs_bernoulli :: "real  bool qbs_measure" where
"qbs_bernoulli  (λx. qbs_pmf (bernoulli_pmf x))"

lemma bernoulli_measurable:
 "(λx. measure_pmf (bernoulli_pmf x))  borel M prob_algebra (count_space UNIV)"
proof(rule measurable_prob_algebra_generated[where Ω=UNIV and G=UNIV])
  fix A :: "bool set"
  have "A  {True,False}"
    by auto
  then consider "A = {}" | "A = {True}" | "A = {False}" | "A = {False,True}"
    by auto
  thus "(λa. emeasure (measure_pmf (bernoulli_pmf a)) A)  borel_measurable borel"
    by(cases,simp_all add: emeasure_measure_pmf_finite bernoulli_pmf.rep_eq UNIV_bool[symmetric])
qed (auto simp add: sets_borel_eq_count_space Int_stable_def measure_pmf.prob_space_axioms)

lemma qbs_bernoulli_morphism: "qbs_bernoulli  qbs_borel Q monadP_qbs (qbs_count_space UNIV)"
  using standard_borel_ne.measure_with_args_morphismP[OF _ bernoulli_measurable]
  by (simp add: qbs_pmf_def comp_def)

lemma qbs_bernoulli_expectation:
  assumes [simp]: "0  p" "p  1"
  shows "(Q x. f x qbs_bernoulli p) = f True * p + f False * (1 - p)"
  by(simp add: qbs_integral_def2_l)

end