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 ∧
      (∀f∈X →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 borel⟧sfin"

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 r⟧sfin |α 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 r⟧sfin |α k. α ∈ qbs_Mx X ∧ s_finite_kernel borel borel k}"
proof -
  have "{λr::real. ⟦X, α, k r⟧sfin |α 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 x⟧sfin = X"
      by simp
  qed
  moreover have "qbs_closed1 {λr. ⟦X, α, k r⟧sfin |α 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 r⟧sfin) ∘ f = (λr. ⟦X, α', ka r⟧sfin) ∧ α' ∈ 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 r⟧sfin |α 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 r⟧sfin) ∧ α ∈ 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 r⟧sfin |α 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 r⟧sfin |α 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 r⟧sfin)" "⋀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) r⟧sfin = ⟦X, α, k r⟧sfin"
        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 r⟧sfin) ∧ α ∈ 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 r⟧sfin |α 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 r⟧sfin |α 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 r⟧sfin)" "α ∈ 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 r⟧sfin)" "α ∈ 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 r⟧sfin)" "α ∈ 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, M⟧sfin"
    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, M⟧sfin"
    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, N⟧sfin = ⟦X, λr. x, M⟧sfin"
      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 r⟧sfin)"
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 r⟧sfin"
    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 r⟧sfin)"
    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 r⟧sfin) ∧ β ∈ qbs_Mx Y ∧ s_finite_kernel borel borel k) in
                      ⟦Y, β, μ ⤜k k⟧sfin)"

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 r⟧sfin)"
    shows bind_qbs_s_finite:"qbs_s_finite Y β (μ ⤜k k)"
      and bind_qbs: "s ⤜ f = ⟦Y, β, μ ⤜k k⟧sfin"
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 k⟧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 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 r⟧sfin) ∧ β ∈ qbs_Mx Y ∧ s_finite_kernel borel borel k of
             (β, k) ⇒ ⟦Y, β, μ' ⤜k k⟧sfin) = ⟦Y, β, μ ⤜k k⟧sfin"
      proof -
        have "(case SOME (β, k). (λr. f (α' r)) = (λr. ⟦Y, β, k r⟧sfin) ∧ β ∈ qbs_Mx Y ∧ s_finite_kernel borel borel k of (β, k) ⇒ ⟦Y, β, μ' ⤜k k⟧sfin) = ⟦Y, β, μ ⤜k k⟧sfin"
        proof(rule someI2_ex)
          show "∃a. case a of (β, k) ⇒ (λr. f (α' r)) = (λr. ⟦Y, β, k r⟧sfin) ∧ β ∈ 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 r⟧sfin) ∧ β ∈ qbs_Mx Y ∧ s_finite_kernel borel borel k) ⟹ (case x of (β, k) ⇒ ⟦Y, β, μ' ⤜k k⟧sfin) = ⟦Y, β, μ ⤜k k⟧sfin"
          proof safe
            fix β' k'
            assume h':"(λr. f (α' r)) = (λr. ⟦Y, β', k' r⟧sfin)" "β' ∈ 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 k⟧sfin"
            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' r⟧sfin)"
                  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 r⟧sfin)"
                  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 r⟧sfin)" "α ∈ 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' r⟧sfin)" "α' ∈ 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 r⟧sfin)" "β ∈ 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' r⟧sfin)" "γ ∈ 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 r⟧sfin)" "β ∈ qbs_Mx Y" "s_finite_kernel borel borel k" by metis
  have g: "g ∈ X →Q monadM_qbs Y" "g ∘ α = (λr. ⟦Y, β, k r⟧sfin)"
    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 r⟧sfin)"
    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 k⟧sfin"
  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 r⟧sfin)"
    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_real⟧sfin" (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 r⟧sfin)" "γ ∈ 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 r⟧sfin)" "β ∈ 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 r⟧sfin)"
      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 k⟧sfin"
    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_real⟧sfin"
    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_real⟧sfin" (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 k⟧sfin)"
      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_real⟧sfin" (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_real⟧sfin" (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_real⟧sfin" (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_real⟧sfin ⤜ 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 0⟧sfin = X" "prob_space (qbs_l ⟦X, a, return borel 0⟧sfin)"
      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 r⟧sfin |α 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 r⟧sfin)" "α ∈ 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 r⟧sfin) ∧ α ∈ 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 r⟧sfin) ∈ 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 r⟧sfin)" "α ∈ 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 r⟧sfin)" "α ∈ 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 r⟧sfin)"
    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 r⟧sfin)"
    shows bind_qbs_prob:"qbs_prob Y β (μ ⤜ g)"
      and bind_qbs': "s ⤜ f = ⟦Y, β, μ ⤜ g⟧sfin"
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, β, μ ⤜ g⟧sfin"
    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 r⟧sfin)" "β ∈ 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 r⟧sfin)"
    shows qbs_prob_join_qbs_s_finite: "qbs_prob X α (μ ⤜ g)"
      and qbs_prob_join_qbs: "join_qbs ssx = ⟦X, α, μ ⤜ g⟧sfin"
  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 r⟧sfin)"
    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 r⟧sfin)" "γ ∈ 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 r⟧sfin)" "β ∈ 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 r⟧sfin)"
      and h'': "⋀r. qbs_prob Y γ (g r)"
    by metis
  have "?lhs = ⟦X ⨂Q Y, λr. (fst x, γ r), μ ⤜ g⟧sfin"
    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 r⟧sfin)" "α ∈ 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. x∈qbs_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. ∀y∈X. P x y) ⟷ (∀y∈X. 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. ∀i∈S. P i x) ⟷ (∀i∈S. 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. ∀s∈S. 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 r⟧sfin)" "α ∈ 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. ∑i∈I. 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 r⟧sfin)" "β ∈ 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_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 r⟧sfin)"
    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 r⟧sfin)" "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 r⟧sfin)" "β ∈ 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 r⟧sfin)" "β ∈ 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 r⟧sfin)" "β ∈ 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 y∂⟦Y, β, k r⟧sfin) ∂μ)"
    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_real⟧sfin"
    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_real⟧sfin"
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_real⟧sfin = 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_real⟧sfin) ∈ 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_real⟧sfin) ∘ α ∈ 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_real⟧sfin)"
  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_real⟧sfin "
      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_real⟧sfin"
    by(simp add: qbs_l_inverse_def)
  also have "... = ⟦measure_to_qbs N, s.from_real, distr (M ⤜k k) borel s.to_real⟧sfin"
    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 {x∈qbs_space X. P x})) (qbs_space X) = qbs_l s {x∈qbs_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 {x∈space (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 r⟧sfin)" "α ∈ 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 (∀i∈I. ∃Mi. standard_borel_ne Mi ∧ si i ∈ qbs_space (monadM_qbs (measure_to_qbs Mi)))
                        then if countable I ∧ (∀i∈I. prob_space (qbs_l (si i))) then qbs_l_inverse (ΠM i∈I. qbs_l (si i))
                             else if finite I ∧ (∀i∈I. sigma_finite_measure (qbs_l (si i))) then qbs_l_inverse (ΠM i∈I. qbs_l (si i))
                             else qbs_null_measure (ΠQ i∈I. qbs_space_of (si i))
                        else qbs_null_measure (ΠQ i∈I. qbs_space_of (si i)))"

syntax
  "_PiQ_measure" :: "pttrn ⇒ 'i set ⇒ 'a qbs_measure ⇒ ('i => 'a) qbs_measure"  ("(3ΠQmeas _∈_./ _)"  10)
translations
  "ΠQmeas x∈I. 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 i∈I. (borel :: real measure)"
  by (simp add: countableI product_standard_borel_ne)

interpretation sbM: standard_borel_ne "ΠM i∈I. 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, μ i⟧sfin" "⋀i. i ∈ I ⟹ qbs_prob (measure_to_qbs (Mi i)) (α i) (μ i)"
    shows PiQ_measure_prob_eq:  "(ΠQmeas i∈I. si i) = ⟦measure_to_qbs (ΠM i∈I. Mi i), sbM.from_real, distr (ΠM i∈I. qbs_l (si i)) borel sbM.to_real⟧sfin"  (is "_ = ?rhs")
      and PiQ_measure_qbs_prob: "qbs_prob (measure_to_qbs (ΠM i∈I. Mi i)) sbM.from_real (distr (ΠM i∈I. qbs_l (si i)) borel sbM.to_real)" (is "?qbsprob")
proof -
  have [measurable_cong,simp]: "prob_space (ΠM i∈I. qbs_l (si i))" "sets (ΠM i∈I. qbs_l (si i)) = sets (ΠM i∈I. 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 i∈I. si i) = qbs_l_inverse (ΠM i∈I. 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 i∈I. 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 i∈I. si i) = (ΠM i∈I. qbs_l (si i))"
proof -
  have "qbs_l (ΠQmeas i∈I. si i) = qbs_l (qbs_l_inverse (ΠM i∈I. 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 i∈I. 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 i∈I. (borel :: real measure)"
  by (simp add: finI product_standard_borel_ne countable_finite)

interpretation sbM: standard_borel_ne "ΠM i∈I. 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 i∈I. si i) = (ΠM i∈I. qbs_l (si i))"
proof -
  have [simp]: "s_finite_measure (ΠM i∈I. qbs_l (si i))"
  proof -
    have "(ΠM i∈I. qbs_l (si i)) = (ΠM i∈I. 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 i∈I. si i) = qbs_l (qbs_l_inverse (ΠM i∈I. qbs_l (si i)))"
    using finI assms(1) assms(2) standard_borel_ne by(fastforce simp: PiQ_measure_def)
  also have "... = (ΠM i∈I. 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