Theory S_Finite_Measure_Monad.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›

text ‹ 
\begin{itemize}
\item In the previous version:
  \begin{itemize}
  \item A measure on $X$ = $[X,\alpha,\mu]_{\sim}$
     \begin{itemize}
     \item $\alpha \in M_X$
     \item $\mu$ is \underline{an s-finite measure} on $\mathbb{R}$
     \item $(X,\alpha,\mu)\sim (X,\beta,\nu) \iff \alpha_* \mu = \beta_* \nu$
     \end{itemize}
  \item The s-finite measure monad: $\mathscr{M}(X) = \{p\mid \text{$p$ is a measure on $X$} \}$
  \end{itemize}
\item Current version: measures are not restricted to s-finite measures.
  \begin{itemize}
  \item A measure on $X$ = $[X,\alpha,\mu]_{\sim}$
     \begin{itemize}
     \item $\alpha \in M_X$
     \item $\mu$ is \underline{a measure} on $\mathbb{R}$
     \item $(X,\alpha,\mu)\sim (X,\beta,\nu) \iff \alpha_* \mu = \beta_* \nu$
     \end{itemize}
  \item
    The s-finite measure monad: $\mathscr{M}(X) = \{[X,\alpha,\mu]_{\sim}\mid \text{$\mu$ is s-finite} \}$

    The space of all measures: $\mathscr{M}_{\mathrm{all}}(X) = \{p\mid \text{$p$ is a measure on $X$} \}$
  \end{itemize}
\end{itemize}›
subsubsection ‹ Measures on Quasi-Borel spaces ›
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_meas = in_Mx X α
  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_meas_All:
  assumes "α ∈ qbs_Mx X" "measure_kernel M borel k" "x ∈ space M"
  shows "qbs_meas X α (k x)"
proof -
  interpret measure_kernel M borel k by fact
  show ?thesis
    using assms(1,3) by(auto simp: qbs_meas_def in_Mx_def qbs_meas_axioms_def kernel_sets)
qed

locale qbs_s_finite = qbs_meas + s_finite_measure μ

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 kernel_sets qbs_meas_def  qbs_meas_axioms_def)
qed

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

lemma qbs_meas: "qbs_meas X α μ"
  by(auto simp: qbs_meas_def qbs_meas_axioms_def in_Mx_def)

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

sublocale qbs_s_finite by(rule qbs_s_finite)

end

locale pair_qbs_meas' = pq1: qbs_meas X α μ + pq2: qbs_meas 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_meas = pq1: qbs_meas X α μ + pq2: qbs_meas X β ν
  for X :: "'a quasi_borel" and α μ β ν
begin

sublocale pair_qbs_meas' X α μ X β ν
  by standard

end

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

sublocale pair_qbs_meas' X α μ Y β ν
  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

sublocale pair_qbs_meas X α μ β ν
  by standard

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_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

lemma(in qbs_meas) 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)

type_synonym 'a qbs_measure_t = "'a quasi_borel * (real ⇒ 'a) * real measure"
definition qbs_meas_eq :: "['a qbs_measure_t, 'a qbs_measure_t] ⇒ bool" where
  "qbs_meas_eq p1 p2 ≡
   (let (X, α, μ) = p1;
        (Y, β, ν) = p2 in
    qbs_meas X α μ ∧ qbs_meas Y β ν ∧ X = Y ∧
      distr μ (qbs_to_measure X) α = distr ν (qbs_to_measure Y) β)"

lemma qbs_meas_eq_def2:
 "qbs_meas_eq p1 p2 =
   (let (X::'a quasi_borel, α, μ) = p1;
        (Y, β, ν) = p2 in
    qbs_meas X α μ ∧ qbs_meas Y β ν ∧ X = Y ∧
      (∀f∈X →Q (qbs_borel :: ennreal quasi_borel). (∫+x. f (α x) ∂μ) = (∫+x. f (β x) ∂ν)))"
  unfolding qbs_meas_eq_def Let_def
proof safe
  fix X :: "'a quasi_borel" and α μ β ν and f :: "'a ⇒ ennreal"
  assume "qbs_meas X α μ" "qbs_meas X β ν"
    and h: "distr μ (qbs_to_measure X) α = distr ν (qbs_to_measure X) β"
    and "f ∈ X →Q borelQ"
  then have [measurable]: "f ∈ qbs_to_measure X →M borel"
    by(auto dest: qbs_morphism_dest)
  interpret qm1: qbs_meas X α μ by fact
  interpret qm2: qbs_meas X β ν by fact
  show "(∫+ x. f (α x) ∂μ) = (∫+ x. f (β x) ∂ν)"
    by(simp add: nn_integral_distr[symmetric,of _ _ "qbs_to_measure X"] h)
next
  fix X :: "'a quasi_borel" and α μ β ν
  assume "qbs_meas X α μ" "qbs_meas X β ν"
    and h: "∀f ∈ X →Q borelQ. (∫+ x. f (α x) ∂μ) = (∫+ x. f (β x) ∂ν)"
  interpret qm1: qbs_meas X α μ by fact
  interpret qm2: qbs_meas X β ν by fact
  show "distr μ (qbs_to_measure X) α = distr ν (qbs_to_measure X) β"
  proof(rule measure_eqI)
    fix A
    assume A[measurable]:"A ∈ sets (distr μ (qbs_to_measure X) α)"
    show "emeasure (distr μ (qbs_to_measure X) α) A = emeasure (distr ν (qbs_to_measure X) β) A"
      using h[rule_format,of "indicator A"] A
      by(simp add: lr_adjunction_correspondence nn_integral_distr[symmetric,of _ _ "qbs_to_measure X"])
  qed simp
qed

lemma(in qbs_meas) qbs_meas_eq_refl[simp]: "qbs_meas_eq (X,α,μ) (X,α,μ)"
  by(simp_all add: qbs_meas_eq_def qbs_meas_axioms)

lemma (in pair_qbs_meas)
  shows qbs_meas_eq_intro:
   "distr μ (qbs_to_measure X) α = distr ν (qbs_to_measure X) β ⟹ qbs_meas_eq (X,α,μ) (X,β,ν)"
 and qbs_meas_eq_intro2:
   "(⋀f. f ∈ X →Q qbs_borel ⟹ (∫+x. f (α x) ∂ μ) = (∫+x. f (β x) ∂ ν)) ⟹ qbs_meas_eq (X,α,μ) (X,β,ν)"
  by(simp add: pq1.qbs_meas_axioms pq2.qbs_meas_axioms qbs_meas_eq_def)
    (simp add: pq1.qbs_meas_axioms pq2.qbs_meas_axioms qbs_meas_eq_def2)

lemma qbs_meas_eq_dest:
  assumes "qbs_meas_eq (X,α,μ) (Y,β,ν)"
  shows "qbs_meas X α μ" "qbs_meas Y β ν" "Y = X" "distr μ (qbs_to_measure X) α = distr ν (qbs_to_measure X) β" 
  using assms by(auto simp: qbs_meas_eq_def)

lemma qbs_meas_eq_dest2:
  assumes "qbs_meas_eq (X,α,μ) (Y,β,ν)"
  shows "qbs_meas X α μ" "qbs_meas Y β ν" "Y = X" "⋀f. f ∈ X →Q qbs_borel ⟹ (∫+x. f (α x) ∂ μ) = (∫+x. f (β x) ∂ ν)"
  using assms by(auto simp: qbs_meas_eq_def2)

lemma qbs_meas_eq_integral_eq:
  assumes "qbs_meas_eq (X,α,μ) (Y,β,ν)"
    and [measurable]:"f ∈ X →Q (qbs_borel :: 'b::{banach, second_countable_topology} quasi_borel)"
  shows "(∫x. f (α x) ∂μ) = (∫x. f (β x) ∂ν)"
proof -
  interpret pair_qbs_meas X α μ β ν
    using assms by(auto simp: qbs_meas_eq_def pair_qbs_meas_def)
  show ?thesis
    by(simp add: integral_distr[where N="qbs_to_measure X",symmetric] qbs_meas_eq_dest(4)[OF assms(1)])
qed

lemma 
  shows qbs_meas_eq_symp: "symp qbs_meas_eq"
    and qbs_meas_eq_transp: "transp qbs_meas_eq"
  by(simp_all add: qbs_meas_eq_def transp_def symp_def)

quotient_type 'a qbs_measure = "'a qbs_measure_t" / partial: qbs_meas_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_meas (Abs_quasi_borel (?U, ?Uf)) ?f (return borel 0)"
    unfolding qbs_meas_def in_Mx_def qbs_meas_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)
  qed simp_all
  thus "∃x :: 'a qbs_measure_t. qbs_meas_eq x x"
    by(auto simp: qbs_meas_eq_def intro!: exI[where x="(Abs_quasi_borel (?U,?Uf), ?f, return borel 0)"])
qed(simp_all add: qbs_meas_eq_symp qbs_meas_eq_transp)

interpretation qbs_measure : quot_type "qbs_meas_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" ("⟦_,/ _,/ _⟧meas")
syntax_consts
 "_qbs_measure" ⇌ qbs_measure
translations
 "⟦X, α, μ⟧meas" ⇌ "CONST qbs_measure (X, α, μ)"

lemma rep_qbs_measure': "∃X α μ. p = ⟦X, α, μ⟧meas ∧ qbs_meas X α μ"
  by(rule qbs_measure.abs_induct) (auto simp: qbs_meas_eq_def)

lemma rep_qbs_measure:
  obtains X α μ where "p = ⟦X, α, μ⟧meas ∧ qbs_meas X α μ"
  using that rep_qbs_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⟧meas"

lemma qbs_null_measure_meas: "qbs_space X ≠ {} ⟹ qbs_meas X (SOME a. a ∈ qbs_Mx X) (null_measure borel)"
  and  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_meas_def qbs_meas_axioms_def some_in_eq
        intro!: finite_measure.s_finite_measure_finite_measure finite_measureI)


lemma in_Rep_qbs_measure':
  assumes "qbs_meas_eq (X,α,μ) (X',α',μ')"
  shows "(X',α',μ') ∈ Rep_qbs_measure ⟦X, α, μ⟧meas"
  by (metis assms mem_Collect_eq qbs_meas.qbs_meas_eq_refl qbs_meas_eq_dest2(1) qbs_measure.abs_def qbs_measure.abs_inverse qbs_measure_def)

lemmas(in qbs_meas) in_Rep_qbs_measure = in_Rep_qbs_measure'[OF qbs_meas_eq_refl]

lemma(in qbs_meas) in_Rep_qbs_measure_dest:
  assumes "(X',α',μ') ∈ Rep_qbs_measure ⟦X, α, μ⟧meas"
  shows "X' = X"
        "qbs_meas X' α' μ'"
        "qbs_meas_eq (X,α,μ) (X',α',μ')"
proof -
  show h:"X' = X"
    by (metis assms mem_Collect_eq qbs_meas_eq_dest(3) qbs_meas_eq_refl qbs_measure.abs_def qbs_measure.abs_inverse qbs_measure_def)
next
  show "qbs_meas X' α' μ'" 
    using assms qbs_measure.Rep_qbs_measure[of "⟦X, α, μ⟧meas"]
    by(auto simp: qbs_meas_eq_def)
next
  show "qbs_meas_eq (X,α,μ) (X',α',μ')"
    using assms qbs_measure.Rep_qbs_measure[of "⟦X, α, μ⟧meas"]
    by (metis (no_types, lifting) mem_Collect_eq qbs_meas_eq_refl qbs_measure.abs_def qbs_measure.abs_inverse qbs_measure_def)
qed

lemma(in qbs_meas) in_Rep_qbs_measure_dest':
  assumes "p ∈ Rep_qbs_measure ⟦X, α, μ⟧meas"
  obtains α' μ' where "p = (X, α', μ')" "qbs_meas X α' μ'" "qbs_meas_eq (X,α,μ) (X,α',μ')"
  by (metis prod_cases3 in_Rep_qbs_measure_dest assms)

lemma qbs_meas_eqI': "qbs_meas_eq (X,α,μ) (Y,β,ν) ⟹ ⟦X, α, μ⟧meas = ⟦Y, β, ν⟧meas"
  using Quotient3_rel[OF Quotient3_qbs_measure] by blast

lemma(in pair_qbs_meas) qbs_meas_eqI:
  "distr μ (qbs_to_measure X) α = distr ν (qbs_to_measure X) β ⟹ ⟦X, α, μ⟧meas = ⟦X, β, ν⟧meas"
  by(auto intro!: qbs_meas_eqI' qbs_meas_eq_intro)

lemma(in pair_qbs_meas) qbs_meas_eqI2:
  "(⋀f. f ∈ X →Q qbs_borel ⟹ (∫+x. f (α x) ∂ μ) = (∫+x. f (β x) ∂ ν)) ⟹ ⟦X, α, μ⟧meas = ⟦X, β, ν⟧meas"
  by(auto intro!: qbs_meas_eqI' qbs_meas_eq_intro2)

lemma(in pair_qbs_s_finite) qbs_s_finite_measure_eq_inverse:
  assumes "⟦X, α, μ⟧meas = ⟦X, β, ν⟧meas"
  shows "qbs_meas_eq (X,α,μ) (X,β,ν)"
  using Quotient3_rel[OF Quotient3_qbs_measure,of "(X,α,μ)" "(X,β,ν)",simplified]
  by(simp_all add: assms)


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

lemma (in qbs_meas) qbs_space_of[simp]: "qbs_space_of ⟦X, α, μ⟧meas = X"
  by(simp add: qbs_space_of.abs_eq)

lemma qbs_space_of_non_empty: "qbs_space (qbs_space_of p) ≠ {}"
  by (metis in_Mx.X_not_empty qbs_meas.axioms(1) qbs_meas.qbs_space_of rep_qbs_measure)

subsubsection ‹ The Space of All Measures ›
definition all_meas_qbs :: "'a quasi_borel ⇒ 'a qbs_measure quasi_borel" where
"all_meas_qbs X ≡ Abs_quasi_borel ({s. qbs_space_of s = X}, {λr. ⟦X, α, k r⟧meas |α k. α ∈ qbs_Mx X ∧ measure_kernel borel borel k})"

lemma
  shows all_meas_qbs_space: "qbs_space (all_meas_qbs X) = {s. qbs_space_of s = X}" (is ?g1)
    and all_meas_qbs_Mx: "qbs_Mx (all_meas_qbs X) = {λr. ⟦X, α, k r⟧meas |α k. α ∈ qbs_Mx X ∧ measure_kernel borel borel k}" (is ?g2)
proof -
  have "{λr::real. ⟦X, α, k r⟧meas |α k. α ∈ qbs_Mx X ∧ measure_kernel borel borel k} ⊆ UNIV → {s. qbs_space_of s = X}"
    by(auto intro!: qbs_meas.qbs_space_of simp: qbs_meas_def in_Mx_def qbs_meas_axioms_def measure_kernel.kernel_sets)
  moreover have "qbs_closed1 {λr. ⟦X, α, k r⟧meas |α k. α ∈ qbs_Mx X ∧ measure_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" "measure_kernel borel borel k"
    then show "∃α' ka. (λr. ⟦X, α, k r⟧meas) ∘ f = (λr. ⟦X, α', ka r⟧meas) ∧ α' ∈ qbs_Mx X ∧ measure_kernel borel borel ka"
      by(auto intro!: exI[where x=α] exI[where x="λx. k (f x)"] simp: measure_kernel.measure_kernel_comp[OF h(3,1)])
  qed
  moreover have "qbs_closed2 {s. qbs_space_of s = X} {λr. ⟦X, α, k r⟧meas |α k. α ∈ qbs_Mx X ∧ measure_kernel borel borel k}"
  proof(safe intro!: qbs_closed2I)
    fix p
    assume h:"X = qbs_space_of p"
    obtain X' α μ where p:"p = ⟦X', α, μ⟧meas" "qbs_meas X' α μ"
      using rep_qbs_measure by meson
    then interpret qbs_meas X' α μ
      by simp
    show "∃α k. (λr. p) = (λr. ⟦qbs_space_of p, α, k r⟧meas) ∧ α ∈ qbs_Mx (qbs_space_of p) ∧
                                measure_kernel borel borel k"
      using p by(auto simp: qbs_meas_axioms_def qbs_meas_def h
                    intro!: exI[where x=α] exI[where x="λr. μ"] measure_kernel_const')
  qed
  moreover have "qbs_closed3 {λr. ⟦X, α, k r⟧meas |α k. α ∈ qbs_Mx X ∧ measure_kernel borel borel k}"
  proof(rule qbs_closed3I)
    fix P :: "real ⇒ nat" and Fi
    assume P[measurable]:"P ∈ borel →M count_space UNIV"
      and " ⋀i::nat. Fi i ∈ {λr::real. ⟦X, α, k r⟧meas |α k. α ∈ qbs_Mx X ∧ measure_kernel borel borel k}"
    then obtain αi ki where Fi: "⋀i. Fi i = (λr. ⟦X, αi i, ki i r⟧meas)" "⋀i. αi i ∈ qbs_Mx X"
                                "⋀i. measure_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: measure_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 "measure_kernel borel borel ..."
        unfolding comp_def
        by(rule measure_kernel.measure_kernel_comp[where X="count_space UNIV ⨂M borel"])
          (auto intro!: measure_kernel_pair_countble1 measure_kernel.distr_measure_kernel[OF Fi(3)])
      thus "measure_kernel borel borel k"
        by(simp add: 1)
    qed
    have "(λr. Fi (P r) r) = (λr. ⟦X, α, k r ⟧meas)"
      unfolding Fi(1)
    proof
      fix r
      interpret pq: pair_qbs_meas X "αi (P r)" "ki (P r) r" α "k r"
        by(auto simp: pair_qbs_meas_def qbs_meas_def qbs_meas_axioms_def in_Mx_def sets_ki α Fi(2))
      show "⟦X, αi (P r), ki (P r) r⟧meas = ⟦X, α, k r⟧meas"
        by(intro pq.qbs_meas_eqI) (simp add: k_def distr_distr, simp add: comp_def α_def)
    qed
    thus " (λr. Fi (P r) r) ∈ {λr. ⟦X, α, k r⟧meas |α k. α ∈ qbs_Mx X ∧ measure_kernel borel borel k}"
      by(auto intro!: exI[where x=α] exI[where x=k] simp: α k.measure_kernel_axioms)
  qed
  ultimately have "Rep_quasi_borel (all_meas_qbs X)
    = ({s. qbs_space_of s = X}, {λr. ⟦X, α, k r⟧meas |α k. α ∈ qbs_Mx X ∧ measure_kernel borel borel k})"
    by(auto intro!: Abs_quasi_borel_inverse simp: all_meas_qbs_def is_quasi_borel_def)
  thus ?g1 ?g2
    by(simp_all add: all_meas_qbs_def qbs_space_def qbs_Mx_def)
qed

lemma all_meas_qbs_empty_iff: "qbs_space X = {} ⟷ qbs_space (all_meas_qbs X) = {}"
  by (metis (mono_tags, lifting) qbs_space_of_non_empty all_meas_qbs_space
             empty_Collect_eq qbs_meas.qbs_space_of qbs_null_measure_meas)

lemma(in qbs_meas) in_space_all_meas[qbs]: "⟦X, α, μ⟧meas ∈ qbs_space (all_meas_qbs X)"
  by(simp add: all_meas_qbs_space)

lemma rep_qbs_space_all_meas:
  assumes "s ∈ qbs_space (all_meas_qbs X)"
  obtains α μ where "s = ⟦X, α, μ⟧meas" "qbs_meas X α μ"
  by (metis (mono_tags, lifting) all_meas_qbs_space assms mem_Collect_eq qbs_meas.qbs_space_of rep_qbs_measure')

lemma qbs_space_of_in_all_meas: "s ∈ qbs_space (all_meas_qbs X) ⟹ qbs_space_of s = X"
  by(simp add: all_meas_qbs_space)

lemma in_qbs_space_of_all_meas: "s ∈ qbs_space (all_meas_qbs (qbs_space_of s))"
  by(simp add: all_meas_qbs_space)

subsubsection ‹ $l$ ›
lift_definition qbs_l :: "'a qbs_measure ⇒ 'a measure"
is "λ(X,α,μ). distr μ (qbs_to_measure X) α"
  by(auto simp: qbs_meas_eq_def)

lemma(in qbs_meas) qbs_l: "qbs_l ⟦X, α, μ⟧meas  = distr μ (qbs_to_measure X) α"
  by(simp add: qbs_l.abs_eq)

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_meas_eq_def qbs_meas_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 auto

lemma qbs_null_measure_in_all_meas: "qbs_space X ≠ {} ⟹ qbs_null_measure X ∈ qbs_space (all_meas_qbs X)"
  by(simp add: qbs_meas.in_space_all_meas qbs_null_measure_def qbs_null_measure_meas)

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_meas.qbs_l[OF qbs_null_measure_meas] null_measure_distr)

lemma space_qbs_l_in_all_meas:
  assumes "s ∈ qbs_space (all_meas_qbs X)"
  shows "space (qbs_l s) = qbs_space X"
  by (metis assms qbs_meas.qbs_space_of rep_qbs_space_all_meas space_qbs_l)

lemma sets_qbs_l_all_meaures:
  assumes "s ∈ qbs_space (all_meas_qbs X)"
  shows "sets (qbs_l s) = sets (qbs_to_measure X)"
  using assms qbs_l_sets qbs_space_of_in_all_meas by blast

lemma measurable_qbs_l_all_meas:
  assumes "s ∈ qbs_space (all_meas_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_all_meas[OF assms(1)],symmetric] refl]
                lr_adjunction_correspondence)

lemma measurable_qbs_l_all_meas':
  assumes "s ∈ qbs_space (all_meas_qbs X)"
  shows "qbs_l s →M M = qbs_to_measure X →M M"
  by(simp add: measurable_qbs_l_all_meas[OF assms] lr_adjunction_correspondence)

lemma rep_all_meas_qbs_Mx:
  assumes "γ ∈ qbs_Mx (all_meas_qbs X)"
  obtains α k where "γ = (λr. ⟦X, α, k r⟧meas)" "α ∈ qbs_Mx X" "measure_kernel borel borel k" "⋀r. qbs_meas X α (k r)"
proof -
  obtain α k where "γ = (λr. ⟦X, α, k r⟧meas)" "α ∈ qbs_Mx X" "measure_kernel borel borel k"
    using assms by(auto simp: all_meas_qbs_Mx)
  moreover hence "⋀r. qbs_meas X α (k r)"
    by (simp add: qbs_meas_All)
  ultimately show ?thesis
    using that by blast
qed

lemma qbs_l_measure_kernel_all_meas:
  "measure_kernel (qbs_to_measure (all_meas_qbs X)) (qbs_to_measure X) qbs_l"
proof(cases "qbs_space X = {}")
  case True
  with all_meas_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 (all_meas_qbs X)) ⟹ sets (qbs_l x) = sets (qbs_to_measure X)"
      using qbs_l_sets by(auto simp: space_L all_meas_qbs_space)
  next
    show "space (qbs_to_measure X) ≠ {}"
      by(simp add: space_L 1)
  next
    fix B
    assume [measurable]:"B ∈ sets (qbs_to_measure X)"
    show "(λx. emeasure (qbs_l x) B) ∈ borel_measurable (qbs_to_measure (all_meas_qbs X))"
    proof(rule qbs_morphism_dest[OF qbs_morphismI])
      fix γ
      assume "γ ∈ qbs_Mx (all_meas_qbs X)"
      from rep_all_meas_qbs_Mx[OF this] obtain α k where
        "γ = (λr. ⟦X, α, k r⟧meas)" "α ∈ qbs_Mx X" "measure_kernel borel borel k"  "⋀r. qbs_meas X α (k r)"
        by blast
      then show "(λx. emeasure (qbs_l x) B) ∘ γ ∈ qbs_Mx borelQ"
        by(auto simp: comp_def qbs_meas.qbs_l qbs_Mx_R
              intro!: measure_kernel.distr_measure_kernel measure_kernel.emeasure_measurable)
    qed
  qed
qed

lemma qbs_l_inj_all_meas: "inj_on qbs_l (qbs_space (all_meas_qbs X))"
  by standard (simp add:all_meas_qbs_space, transfer,auto simp: qbs_meas_eq_def)

lemma qbs_l_morphism_all_meas:
  assumes [measurable]:"A ∈ sets (qbs_to_measure X)"
  shows "(λs. qbs_l s A) ∈ all_meas_qbs X →Q qbs_borel"
proof(rule qbs_morphismI)
  fix γ
  assume h:"γ ∈ qbs_Mx (all_meas_qbs X)" 
  hence [qbs]: "γ ∈ qbs_borel →Q all_meas_qbs X"
    by(simp_all add: qbs_Mx_is_morphisms)
  from rep_all_meas_qbs_Mx[OF h(1)] obtain α k where hk:
   "γ = (λr. ⟦X, α, k r⟧meas)" "α ∈ qbs_Mx X" "measure_kernel borel borel k" "⋀r. qbs_meas 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: measure_kernel_def)
  show "(λs. emeasure (qbs_l s) A) ∘ γ ∈ qbs_Mx qbs_borel"
    by(auto simp: hk(1) qbs_meas.qbs_l[OF hk(4)] comp_def qbs_Mx_qbs_borel emeasure_distr sets_eq_imp_space_eq[OF k]
          intro!:  measurable_sets_borel[OF _ assms] measure_kernel.emeasure_measurable[OF hk(3)])
qed

lemma qbs_l_finite_pred_all_meas: "qbs_pred (all_meas_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_all_meas[OF this,qbs]
  have [simp]:"finite_measure (qbs_l s) ⟷ qbs_l s X ≠ ∞" if "s ∈ all_meas_qbs X" for s
    by(auto intro!: finite_measureI dest: finite_measure.emeasure_finite simp: space_qbs_l_in_all_meas[OF that])
  show ?thesis
    by(simp cong: qbs_morphism_cong)
qed

lemma qbs_l_subprob_pred_all_meas: "qbs_pred (all_meas_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_all_meas[OF this,qbs]
  have [simp]:"subprob_space (qbs_l s) ⟷ qbs_l s X ≤ 1" if "s ∈ all_meas_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_all_meas[OF that])
  show ?thesis
    by(simp cong: qbs_morphism_cong)
qed

lemma qbs_l_prob_pred_all_meas: "qbs_pred (all_meas_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_all_meas[OF this,qbs]
  have [simp]:"prob_space (qbs_l s) ⟷ qbs_l s X = 1" if "s ∈ all_meas_qbs X" for s  
    by(auto intro!: prob_spaceI simp: space_qbs_l_ne)
      (auto simp add: space_qbs_l_in_all_meas[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 μ⟧meas"

lemma(in real_distribution)
  assumes "x ∈ qbs_space X"
  shows return_qbs:"return_qbs X x = ⟦X, λr. x, M⟧meas"
    and return_qbs_meas:"qbs_meas X (λr. x) M"
    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⟧meas"
    unfolding return_qbs_def
  proof(rule someI2)
    show "real_distribution (return borel 0)"
      by (auto simp: real_distribution_def real_distribution_axioms_def prob_space_return)
  next
    fix N
    assume "real_distribution N"
    then interpret qs2: qbs_meas X "λr. x" N
      by(auto simp: qbs_meas_def in_Mx_def qbs_meas_axioms_def real_distribution_def real_distribution_axioms_def)
    interpret pair_qbs_meas X "λr. x" N "λr. x" M
      by standard
    show "⟦X, λr. x, N⟧meas = ⟦X, λr. x, M⟧meas"
      by(auto intro!: qbs_meas_eqI 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" "qbs_meas X (λr. x) M"
    by(simp_all add: qs1.qbs_prob_axioms qs1.qbs_s_finite_axioms qs1.qbs_meas_axioms)
qed

lemma return_qbs_comp:
  assumes "α ∈ qbs_Mx X"
  shows "(return_qbs X ∘ α) = (λr. ⟦X, α, return borel r⟧meas)"
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⟧meas"
    by(auto simp: pqp.pq1.return_qbs[OF qbs_Mx_to_X[OF assms]] distr_return intro!: pqp.qbs_meas_eqI)
qed

corollary return_qbs_morphism_all_meas: "return_qbs X ∈ X →Q all_meas_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⟧meas)"
    by(rule return_qbs_comp)
  show "return_qbs X ∘ α ∈ qbs_Mx (all_meas_qbs X)"
    by(auto simp: 1 all_meas_qbs_Mx h prob_kernel_def'
          intro!: exI[where x=α] exI[where x="return borel"] prob_kernel.axioms(1))
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⟧meas) ∧ β ∈ qbs_Mx Y ∧ measure_kernel borel borel k) in
                      ⟦Y, β, μ ⤜k k⟧meas)"

adhoc_overloading Monad_Syntax.bind ⇌ bind_qbs

lemma(in qbs_meas)
  assumes "s = ⟦X, α, μ⟧meas"
          "f ∈ X →Q all_meas_qbs Y"
          "β ∈ qbs_Mx Y"
          "measure_kernel borel borel k"
      and "(f ∘ α) = (λr. ⟦Y, β, k r⟧meas)"
    shows bind_qbs_meas:"qbs_meas Y β (μ ⤜k k)"
      and bind_qbs_all_meas: "s ⤜ f = ⟦Y, β, μ ⤜k k⟧meas"
proof -
  interpret k: measure_kernel borel borel k by fact
  interpret qm: qbs_meas Y β "μ ⤜k k"
    by(auto simp: qbs_meas_def qbs_meas_axioms_def in_Mx_def assms(3) mu_sets k.sets_bind_kernel[OF _ mu_sets])
  {
    fix X' α' μ'
    assume "(X',α',μ') ∈ Rep_qbs_measure ⟦X, α, μ⟧meas"
    then have h: "X' = X" "qbs_meas X' α' μ'" "qbs_meas_eq (X,α,μ) (X',α',μ')"
      by(simp_all add: in_Rep_qbs_measure_dest)
    then interpret pq1: pair_qbs_meas X α μ α' μ'
      by(auto simp: pair_qbs_meas_def qbs_meas_axioms)
    have [simp]: "qbs_space_of (f (α' r)) = Y" for r
      using qbs_Mx_to_X[OF qbs_morphism_Mx[OF assms(2) pq1.pq2.in_Mx],of r]
      by(auto simp: all_meas_qbs_space)
    have "(let Y = qbs_space_of (f (α' undefined))
           in case SOME (β, k). (λr. f (α' r)) = (λr. ⟦Y, β, k r⟧meas) ∧ β ∈ qbs_Mx Y ∧ measure_kernel borel borel k of
             (β, k) ⇒ ⟦Y, β, μ' ⤜k k⟧meas) = ⟦Y, β, μ ⤜k k⟧meas"
    proof -
      have "(case SOME (β, k). (λr. f (α' r)) = (λr. ⟦Y, β, k r⟧meas) ∧ β ∈ qbs_Mx Y ∧ measure_kernel borel borel k of (β, k) ⇒ ⟦Y, β, μ' ⤜k k⟧meas) = ⟦Y, β, μ ⤜k k⟧meas"
      proof(rule someI2_ex)
        show "∃a. case a of (β, k) ⇒ (λr. f (α' r)) = (λr. ⟦Y, β, k r⟧meas) ∧ β ∈ qbs_Mx Y ∧ measure_kernel borel borel k"
          using qbs_morphism_Mx[OF assms(2) pq1.pq2.in_Mx]
          by(auto simp: comp_def all_meas_qbs_Mx)
      next
        show "⋀x. (case x of (β, k) ⇒ (λr. f (α' r)) = (λr. ⟦Y, β, k r⟧meas) ∧ β ∈ qbs_Mx Y ∧ measure_kernel borel borel k) ⟹ (case x of (β, k) ⇒ ⟦Y, β, μ' ⤜k k⟧meas) = ⟦Y, β, μ ⤜k k⟧meas"
        proof safe
          fix β' k'
          assume h':"(λr. f (α' r)) = (λr. ⟦Y, β', k' r⟧meas)" "β' ∈ qbs_Mx Y" "measure_kernel borel borel k'"
          interpret k': measure_kernel borel borel k' by fact
          have "qbs_meas Y β' (μ' ⤜k k')"
            by(auto simp: qbs_meas_def in_Mx_def h'(2) qbs_meas_axioms_def k'.sets_bind_kernel[OF _ pq1.pq2.mu_sets])
          then interpret pq2: pair_qbs_meas Y β' "μ' ⤜k k'" β "μ ⤜k k"
            by(auto simp: pair_qbs_meas_def qm.qbs_meas_axioms)
          show "⟦Y, β', μ' ⤜k k'⟧meas = ⟦Y, β, μ ⤜k k⟧meas"
          proof(rule pq2.qbs_meas_eqI)
            have "distr (μ' ⤜k k') (qbs_to_measure Y) β' = μ' ⤜k (λr. distr (k' r) (qbs_to_measure Y) β')"
              by(simp add: k'.distr_bind_kernel[OF _ pq1.pq2.mu_sets])
            also have "... = μ' ⤜k (λr. qbs_l ⟦Y, β', k' r⟧meas)"
              by(auto intro!: bind_kernel_cong_All qbs_meas.qbs_l[symmetric] qbs_meas_All[where k=k' and M=borel] h')
            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_all_meas set_mp[OF l_preserves_morphisms assms(2)]]]
                           sets_eq_imp_space_eq[OF pq1.pq2.mu_sets])
            also have "... = distr μ (qbs_to_measure X) α ⤜k (λx. qbs_l (f x))"
              by(simp add: qbs_meas_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_all_meas 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⟧meas)"
              by(simp add: fun_cong[OF assms(5),simplified comp_def])
            also have "... = μ ⤜k (λr. distr (k r) (qbs_to_measure Y) β)"
              by(auto intro!: bind_kernel_cong_All qbs_meas.qbs_l qbs_meas_All[where k=k and M=borel] k.measure_kernel_axioms)
            also have "... = distr (μ ⤜k k) (qbs_to_measure Y) β"
              by(simp add: k.distr_bind_kernel[OF _ mu_sets])
            finally show "distr (μ' ⤜k k') (qbs_to_measure Y) β' = distr (μ ⤜k k) (qbs_to_measure Y) β " .
          qed
        qed
      qed
      thus ?thesis by simp
    qed
  }
  note * = this
  show "s ⤜ f = ⟦Y, β, μ ⤜k k⟧meas"
    unfolding bind_qbs_def rep_qbs_measure_def qbs_measure.rep_def assms(1)
    apply(rule someI2)
     apply(rule in_Rep_qbs_measure)
    using * by auto
  show "qbs_meas Y β (μ ⤜k k) "
    by (rule qm.qbs_meas_axioms)
qed


lemma bind_qbs_morphism_all_meas':
  assumes "f ∈ X →Q all_meas_qbs Y"
  shows "(λx. x ⤜ f) ∈ all_meas_qbs X →Q all_meas_qbs Y"
proof(rule qbs_morphismI)
  fix γ
  assume "γ ∈ qbs_Mx (all_meas_qbs X)"
  from rep_all_meas_qbs_Mx[OF this] obtain α k where h:
   "γ = (λr. ⟦X, α, k r⟧meas)" "α ∈ qbs_Mx X" "measure_kernel borel borel k" "⋀r. qbs_meas X α (k r)"
    by metis
  from rep_all_meas_qbs_Mx[OF qbs_morphism_Mx[OF assms this(2)]] obtain α' k' where h':
  "f ∘ α = (λr. ⟦Y, α', k' r⟧meas)" "α' ∈ qbs_Mx Y" "measure_kernel borel borel k'" "⋀r. qbs_meas Y α' (k' r)"
    by metis
  have [simp]:"(λx. x ⤜ f) ∘ γ = (λr. ⟦Y, α', k r ⤜k k'⟧meas)"
    by standard (simp add: h(1) qbs_meas.bind_qbs_all_meas[OF h(4) _ assms h'(2,3,1)])
  show "(λx. x ⤜ f) ∘ γ ∈ qbs_Mx (all_meas_qbs Y)"
    using h'(2) by(auto simp: all_meas_qbs_Mx measure_kernel.bind_kernel_measure_kernel[OF h(3) h'(3)]
                      intro!: exI[where x=α'])
qed

lemma bind_qbs_return_all_meas':
  assumes "x ∈ qbs_space (all_meas_qbs X)"
  shows "x ⤜ return_qbs X = x"
proof -
  obtain α μ where h:"qbs_meas X α μ" "x = ⟦X, α, μ⟧meas"
    using rep_qbs_space_all_meas[OF assms] by blast 
  then interpret qs: qbs_meas X α μ by simp
  note return_qbs_morphism_all_meas[qbs]
  interpret prob_kernel borel borel "return borel"
    by(simp add: prob_kernel_def')
  show ?thesis
    by(simp add: qs.bind_qbs_all_meas[OF h(2) return_qbs_morphism_all_meas _ prob_kernel.axioms(1) return_qbs_comp]
                 prob_kernel_axioms bind_kernel_return''[OF qs.mu_sets] h(2)[symmetric])
qed

lemma bind_qbs_return_all_meas:
  assumes "f ∈ X →Q all_meas_qbs Y"
      and "x ∈ qbs_space X"
    shows "return_qbs X x ⤜ f = f x"
proof -
  from rep_qbs_space_all_meas[OF qbs_morphism_space[OF assms]] obtain α μ where h:
   "f x = ⟦Y, α, μ⟧meas" "qbs_meas Y α μ" by auto
  then interpret qs:qbs_meas Y α μ by simp
  interpret sk: measure_kernel borel borel "λr. μ"
    by(auto intro!: measure_kernel_const' simp: qs.mu_sets)
  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_all_meas[OF rd.return_qbs[OF assms(2)] assms(1) qs.in_Mx sk.measure_kernel_axioms]
    by(simp add: h(1) sk.bind_kernel_return)
qed

text ‹ Associativity seems not to hold for @{term all_meas_qbs}.›

lemma bind_qbs_cong_all_meas:
  assumes [qbs]:"s ∈ qbs_space (all_meas_qbs X)"
          "⋀x. x ∈ qbs_space X ⟹ f x = g x"
      and [qbs]:"f ∈ X →Q all_meas_qbs Y"
    shows "s ⤜ f = s ⤜ g"
proof -
  from rep_qbs_space_all_meas[OF assms(1)] obtain α μ where h:
   "s = ⟦X, α, μ⟧meas" "qbs_meas X α μ" by auto
  interpret qbs_meas X α μ by fact
  from rep_all_meas_qbs_Mx[OF qbs_morphism_Mx[OF assms(3) in_Mx]] obtain β k where h':
  "f ∘ α = (λr. ⟦Y, β, k r⟧meas)" "β ∈ qbs_Mx Y" "measure_kernel borel borel k" by metis
  have g: "g ∈ X →Q all_meas_qbs Y" "g ∘ α = (λr. ⟦Y, β, k r⟧meas)"
    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_all_meas[OF h(1) assms(3) h'(2,3,1)] bind_qbs_all_meas[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_all_meas':
  assumes "f ∈ X →Q Y"
  shows "distr_qbs X Y f ∈ all_meas_qbs X →Q all_meas_qbs Y"
  unfolding distr_qbs_def
  by(rule bind_qbs_morphism_all_meas'[OF qbs_morphism_comp[OF assms return_qbs_morphism_all_meas]])

lemma(in qbs_meas)
  assumes "s = ⟦X, α, μ⟧meas"
      and "f ∈ X →Q Y"
    shows distr_qbs_meas:"qbs_meas Y (f ∘ α) μ"
      and distr_qbs: "distr_qbs X Y f s = ⟦Y, f ∘ α, μ⟧meas"
  by(auto intro!: bind_qbs_all_meas[OF assms(1) qbs_morphism_comp[OF assms(2) return_qbs_morphism_all_meas],of "f ∘ α" "return borel" ,simplified bind_kernel_return''[OF mu_sets]]
                  bind_qbs_meas[OF assms(1) qbs_morphism_comp[OF assms(2) return_qbs_morphism_all_meas],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.axioms(1)[of borel borel "return borel",simplified prob_kernel_def'])

lemma(in qbs_s_finite) distr_qbs_s_finite:
  assumes [qbs]:"f ∈ X →Q Y"
    shows "qbs_s_finite Y (f ∘ α) μ"
  using qbs_s_finite_axioms by(auto simp: qbs_s_finite_def qbs_meas_def in_Mx_def intro!: qbs_morphism_Mx[of _ X])

lemma(in qbs_prob) distr_qbs_prob:
  assumes [qbs]: "f ∈ X →Q Y"
    shows "qbs_prob Y (f ∘ α) μ"
  using qbs_prob_axioms by(auto simp: qbs_prob_def qbs_meas_def in_Mx_def intro!: qbs_morphism_Mx[of _ X])

lemma distr_qbs_id_all_meas:
  assumes "s ∈ qbs_space (all_meas_qbs X)"
  shows "distr_qbs X X id s = s"
  using bind_qbs_return_all_meas'[OF assms] by(simp add: distr_qbs_def)

lemma distr_qbs_comp_all_meas:
  assumes "s ∈ qbs_space (all_meas_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_all_meas[OF assms(1)] obtain α μ where h:
  "qbs_meas X α μ" "s = ⟦X, α, μ⟧meas" by metis
  have "qbs_meas Y (f ∘ α) μ" "distr_qbs X Y f s = ⟦Y, f ∘ α, μ⟧meas"
    by(simp_all add: qbs_meas.distr_qbs_meas[OF h assms(2)] qbs_meas.distr_qbs[OF h assms(2)])
  from qbs_meas.distr_qbs[OF this assms(3)] qbs_meas.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_all_meas: "join_qbs ∈ all_meas_qbs (all_meas_qbs X) →Q all_meas_qbs X"
  by(simp add: join_qbs_def bind_qbs_morphism_all_meas')

lemma
  assumes "qbs_meas (all_meas_qbs X) β μ"
          "ssx = ⟦all_meas_qbs X, β, μ⟧meas"
          "α ∈ qbs_Mx X"
          "measure_kernel borel borel k"
      and "β =(λr. ⟦X, α, k r⟧meas)"
    shows join_qbs_meas: "qbs_meas X α (μ ⤜k k)"
      and join_qbs_all_meas: "join_qbs ssx = ⟦X, α, μ ⤜k k⟧meas"
  using qbs_meas.bind_qbs_all_meas[OF assms(1,2) qbs_morphism_ident assms(3,4)]
        qbs_meas.bind_qbs_meas[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), μ⟧meas)"

lemma(in qbs_meas)
  assumes [qbs]:"w ∈ qbs_space W"
      and "sx = ⟦X, α, μ⟧meas"
    shows strength_qbs_meas: "qbs_meas (W ⨂Q X) (λr. (w,α r)) μ"
      and strength_qbs: "strength_qbs W X (w,sx) = ⟦W ⨂Q X, λr. (w,α r), μ⟧meas"
proof -
  interpret qs: qbs_meas "W ⨂Q X" "λr. (w,α r)" μ
    by(auto simp: qbs_meas_def qbs_meas_axioms_def mu_sets in_Mx_def assms(1) intro!: pair_qbs_MxI)
  show "qbs_meas (W ⨂Q X) (λr. (w,α r)) μ" by (rule qs.qbs_meas_axioms)
  show "strength_qbs W X (w,sx) = ⟦W ⨂Q X, λr. (w,α r), μ⟧meas"
  proof -
    {
      fix X' α' μ'
      assume "(X',α',μ') ∈ Rep_qbs_measure ⟦X, α, μ⟧meas"
      then have h: "X' = X" "qbs_meas X' α' μ'" "qbs_meas_eq (X,α,μ) (X',α',μ')"
        by(simp_all add: in_Rep_qbs_measure_dest)
      then interpret qs': qbs_meas "W ⨂Q X" "λr. (w,α' r)" μ'
        by(auto simp: qbs_meas_def in_Mx_def assms(1) intro!: pair_qbs_MxI)
      interpret pq: pair_qbs_meas "W ⨂Q X" "λr. (w,α r)" μ "λr. (w,α' r)" μ'
        by standard
      have "⟦W ⨂Q X, λr. (w, α' r), μ'⟧meas = ⟦W ⨂Q X, λr. (w, α r), μ⟧meas"
        using h(3) by(auto simp: qbs_meas_eq_def2 h(1) intro!: pq.qbs_meas_eqI2[symmetric])
    }
    note * = this
    show ?thesis
      unfolding strength_qbs_def rep_qbs_measure_def qbs_measure.rep_def assms(2) prod.case
      apply(rule someI2)
       apply(rule in_Rep_qbs_measure)
      using * by auto
  qed
qed

lemma(in qbs_s_finite) strength_qbs_s_finite: "w ∈ qbs_space W ⟹ qbs_s_finite (W ⨂Q X) (λr. (w,α r)) μ"
  using qbs_s_finite_axioms by(auto simp: qbs_s_finite_def qbs_meas_def in_Mx_def intro!: pair_qbs_MxI)

lemma(in qbs_prob) strength_qbs_prob: "w ∈ qbs_space W ⟹ qbs_prob (W ⨂Q X) (λr. (w,α r)) μ"
  using qbs_prob_axioms by(auto simp: qbs_prob_def qbs_meas_def in_Mx_def intro!: pair_qbs_MxI)

lemma strength_qbs_natural_all_meas:
  assumes [qbs]:"f ∈ X →Q X'" "g ∈ Y →Q Y'" "x ∈ qbs_space X" "sy ∈ qbs_space (all_meas_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_all_meas[OF assms(4)] obtain α μ 
    where h:"sy = ⟦Y, α, μ⟧meas" "qbs_meas Y α μ" by metis
  have "?lhs = (distr_qbs (X ⨂Q Y) (X' ⨂Q Y') (map_prod f g)) (⟦X ⨂Q Y, λr. (x,α r), μ⟧meas)"
    by(simp add: qbs_meas.strength_qbs[OF h(2) assms(3) h(1)])
  also have "... = ⟦X' ⨂Q Y', map_prod f g ∘ (λr. (x, α r)), μ⟧meas"
    using assms by(simp add: qbs_meas.distr_qbs[OF qbs_meas.strength_qbs_meas[OF h(2) assms(3) h(1)]])
  also have "... = ⟦X' ⨂Q Y',λr. (f x, (g ∘ α) r), μ⟧meas" by (simp add: comp_def)
  also have "... = ?rhs"
    by(simp add: qbs_meas.strength_qbs[OF qbs_meas.distr_qbs_meas[OF h(2,1) assms(2)] qbs_morphism_space[OF assms(1,3)] qbs_meas.distr_qbs[OF h(2,1) assms(2)]])
  finally show ?thesis .
qed

lemma strength_qbs_law1_all_meas:
  assumes "x ∈ qbs_space (unit_quasi_borel ⨂Q all_meas_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_meas X α μ" "(snd x) = ⟦X, α, μ⟧meas"
    using rep_qbs_space_all_meas[of "snd x" X] assms
    by (metis qbs_morphism_space snd_qbs_morphism) 
  have [simp]: "((),snd x) = x"
    using SigmaE assms by (auto simp: pair_qbs_space)
  show ?thesis
    using qbs_meas.distr_qbs[OF qbs_meas.strength_qbs_meas[OF h(1) _ h(2),of "fst x" unit_quasi_borel]
          qbs_meas.strength_qbs[OF h(1) _ h(2)] snd_qbs_morphism]
    by(auto simp: comp_def,simp add: h(2))
qed

lemma strength_qbs_law2_all_meas:
  assumes "x ∈ qbs_space ((X ⨂Q Y) ⨂Q all_meas_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_meas Z α μ" "snd x = ⟦Z, α, μ⟧meas"
    using rep_qbs_space_all_meas[of "snd x" Z] assms
    by (metis qbs_morphism_space snd_qbs_morphism)
  then have "?lhs = ⟦X ⨂Q Y ⨂Q Z, λr. (fst (fst x), snd (fst x), α r), μ⟧meas"
    using assms qbs_meas.strength_qbs_meas[OF h(1),of "snd (fst x)" Y]
    by(auto intro!: qbs_meas.strength_qbs simp: pair_qbs_space)
  also have "... = ?rhs"
    using qbs_meas.distr_qbs[OF qbs_meas.strength_qbs_meas[OF h(1) _ h(2),of "fst x" "X ⨂Q Y"]
          qbs_meas.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

subsubsection ‹ The s-Finite Measure Monad›
definition monadM_qbs :: "'a quasi_borel ⇒ 'a qbs_measure quasi_borel" where
"monadM_qbs X ≡ Abs_quasi_borel ({⟦X, α, μ⟧meas |α μ. qbs_s_finite X α μ}, {λr. ⟦X, α, k r⟧meas |α k. α ∈ qbs_Mx X ∧ s_finite_kernel borel borel k})"

lemma
  shows monadM_qbs_space: "qbs_space (monadM_qbs X) = {⟦X, α, μ⟧meas |α μ. qbs_s_finite X α μ}"
    and monadM_qbs_Mx: "qbs_Mx (monadM_qbs X) = {λr. ⟦X, α, k r⟧meas |α k. α ∈ qbs_Mx X ∧ s_finite_kernel borel borel k}"
proof -
  have "{λr::real. ⟦X, α, k r⟧meas |α k. α ∈ qbs_Mx X ∧ s_finite_kernel borel borel k}
        ⊆ UNIV → {⟦X, α, μ⟧meas |α μ. qbs_s_finite 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_meas_def qbs_meas_axioms_def k.kernel_sets) 
    show "∃α' μ'.  ⟦X, α, k x⟧meas = ⟦X, α', μ'⟧meas ∧  qbs_s_finite X α' μ'"
      by(auto intro!: exI[where x=α] exI[where x="k x"] qbs_s_finite_axioms)
  qed
  moreover have "qbs_closed1 {λr. ⟦X, α, k r⟧meas |α 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⟧meas) ∘ f = (λr. ⟦X, α', ka r⟧meas) ∧ α' ∈ 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 {⟦X, α, μ⟧meas |α μ. qbs_s_finite X α μ} {λr. ⟦X, α, k r⟧meas |α k. α ∈ qbs_Mx X ∧ s_finite_kernel borel borel k}"
  proof(safe intro!: qbs_closed2I)
    fix α μ
    assume "qbs_s_finite X α μ"
    then interpret qbs_s_finite X α μ .
    show " ∃α' k. (λr. ⟦X, α, μ⟧meas) = (λr. ⟦X, α', k r⟧meas) ∧ α' ∈ qbs_Mx X ∧ s_finite_kernel borel borel k"
      by(auto intro!: exI[where x=α] exI[where x="λr. μ"] s_finite_kernel_const' mu_sets)
  qed
  moreover have "qbs_closed3 {λr. ⟦X, α, k r⟧meas |α 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⟧meas |α 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⟧meas)" "⋀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"])
          (auto intro!: s_finite_kernel_pair_countble1 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 ⟧meas)"
      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_meas_def qbs_meas_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⟧meas = ⟦X, α, k r⟧meas"
        by(intro pq.qbs_meas_eqI) (simp add: k_def distr_distr, simp add: comp_def α_def)
    qed
    thus "∃α k. (λr. Fi (P r) r) = (λr. ⟦X, α, k r⟧meas) ∧ α ∈ 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) = ({⟦X, α, μ⟧meas |α μ. qbs_s_finite X α μ}, {λr. ⟦X, α, k r⟧meas |α 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) ={⟦X, α, μ⟧meas |α μ. qbs_s_finite X α μ}"
       "qbs_Mx (monadM_qbs X) = {λr. ⟦X, α, k r⟧meas |α k. α ∈ qbs_Mx X ∧ s_finite_kernel borel borel k}"
    by(simp_all add: qbs_space_def qbs_Mx_def)
qed

lemma monadM_all_meas_space': "qbs_space (monadM_qbs X) ⊆ qbs_space (all_meas_qbs X)"
  and monadM_all_meas_space: "⋀p. p ∈ qbs_space (monadM_qbs X) ⟹ p ∈ qbs_space (all_meas_qbs X)"
  and monadM_all_meas_Mx: "qbs_Mx (monadM_qbs X) ⊆ qbs_Mx (all_meas_qbs X)"
   by(auto simp: monadM_qbs_space monadM_qbs_Mx all_meas_qbs_space all_meas_qbs_Mx
                 qbs_meas.qbs_space_of[OF qbs_s_finite.axioms(1)] dest: s_finite_kernel.axioms(1))

lemma
  shows qbs_morphism_monadAD: "f ∈ X →Q monadM_qbs Y ⟹ f ∈ X →Q all_meas_qbs Y"
    and qbs_morphism_monadAD': "g ∈ all_meas_qbs X →Q Y ⟹ g ∈ monadM_qbs X →Q Y"
  using monadM_all_meas_Mx by(auto intro!: qbs_morphismI dest: qbs_morphism_Mx)

lemma monadM_qbs_empty_iff: "qbs_space X = {} ⟷ qbs_space (monadM_qbs X) = {}"
  by (metis (mono_tags, lifting) all_meas_qbs_empty_iff monadM_all_meas_space'
             monadM_qbs_space bot.extremum_uniqueI empty_Collect_eq qbs_null_measure_s_finite)

lemma(in qbs_s_finite) in_space_monadM[qbs]: "⟦X, α, μ⟧meas ∈ qbs_space (monadM_qbs X)"
  using qbs_s_finite_axioms by(auto simp add: monadM_qbs_space)

lemma rep_qbs_space_monadM:
  assumes "s ∈ qbs_space (monadM_qbs X)"
  obtains α μ where "s = ⟦X, α, μ⟧meas" "qbs_s_finite X α μ"
  using assms monadM_qbs_space by fastforce

lemma rep_qbs_space_monadM_sigma_finite:
  assumes "s ∈ qbs_space (monadM_qbs X)"
  obtains α μ where "s = ⟦X, α, μ⟧meas" "qbs_s_finite X α μ" "sigma_finite_measure μ"
proof -
  obtain α μ where s:"s = ⟦X, α, μ⟧meas" "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_meas_def qbs_meas_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_meas_def qbs_meas_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_meas_def qbs_meas_axioms_def 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, α, μ⟧meas = ⟦X, α ∘ f, μ'⟧meas"
  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_meas_eqI 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"
  using monadM_all_meas_space qbs_space_of_in_all_meas by blast

lemma qbs_l_s_finite:
  assumes "p ∈ qbs_space (monadM_qbs X)"
  shows "s_finite_measure (qbs_l p)"
proof -
  obtain α μ where p: "p = ⟦X, α, μ⟧meas" "qbs_s_finite X α μ"
    using rep_qbs_space_monadM[OF assms] by blast
  interpret qbs_s_finite X α μ by fact
  show ?thesis
    by(simp add: qbs_l p(1) s_finite_measure_distr)
qed

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 space_qbs_l_in:
  assumes "s ∈ qbs_space (monadM_qbs X)"
  shows "space (qbs_l s) = qbs_space X"
  using space_qbs_l_in_all_meas assms monadM_all_meas_space by blast 

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⟧meas)" "α ∈ qbs_Mx X" "s_finite_kernel borel borel k" "⋀r. qbs_s_finite X α (k r)"
  using assms by(fastforce simp: monadM_qbs_Mx qbs_s_finite_All)

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⟧meas)" "α ∈ 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_meas.qbs_l[OF qbs_s_finite.axioms(1)[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 qbs_space_of_in by(auto simp: space_L)
  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

lemmas qbs_l_inj = inj_on_subset[OF qbs_l_inj_all_meas monadM_all_meas_space']

lemmas qbs_l_morphism = qbs_morphism_monadAD'[OF qbs_l_morphism_all_meas]

lemmas qbs_l_finite_pred = qbs_morphism_monadAD'[OF qbs_l_finite_pred_all_meas]

lemmas qbs_l_subprob_pred = qbs_morphism_monadAD'[OF qbs_l_subprob_pred_all_meas]

lemmas qbs_l_prob_pred = qbs_morphism_monadAD'[OF qbs_l_prob_pred_all_meas]

lemma 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⟧meas)"
    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

lemma(in qbs_s_finite)
  assumes "s = ⟦X, α, μ⟧meas"
          "f ∈ X →Q monadM_qbs Y"
          "β ∈ qbs_Mx Y"
          "s_finite_kernel borel borel k"
      and "(f ∘ α) = (λr. ⟦Y, β, k r⟧meas)"
    shows bind_qbs_s_finite:"qbs_s_finite Y β (μ ⤜k k)"
      and bind_qbs: "s ⤜ f = ⟦Y, β, μ ⤜k k⟧meas"
  using bind_qbs_all_meas[OF assms(1) qbs_morphism_monadAD[OF assms(2)] assms(3) s_finite_kernel.axioms(1)[OF assms(4)] assms(5)]
    bind_qbs_meas[OF assms(1) qbs_morphism_monadAD[OF assms(2)] assms(3) s_finite_kernel.axioms(1)[OF assms(4)] assms(5)]
    assms(4) mu_sets s_finite_measure_axioms
   by(auto intro!: s_finite_kernel.comp_s_finite_measure[of borel borel] simp: qbs_s_finite_def)

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⟧meas)" "α ∈ 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⟧meas)" "α' ∈ 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'⟧meas)"
    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

lemmas bind_qbs_return' = bind_qbs_return_all_meas'[OF monadM_all_meas_space]

lemmas bind_qbs_return = bind_qbs_return_all_meas[OF qbs_morphism_monadAD]

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, α, μ⟧meas" "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⟧meas)" "β ∈ 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⟧meas)" "γ ∈ 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'⟧meas)"
    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')⟧meas"
    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'⟧meas"
    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, α, μ⟧meas" "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⟧meas)" "β ∈ qbs_Mx Y" "s_finite_kernel borel borel k" by metis
  have g: "g ∈ X →Q monadM_qbs Y" "g ∘ α = (λr. ⟦Y, β, k r⟧meas)"
    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

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]])

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 [qbs]:"s ∈ qbs_space (monadM_qbs X)" "f ∈ X →Q Y" "g ∈ Y →Q Z" 
    shows "((distr_qbs Y Z g) ∘ (distr_qbs X Y f)) s = distr_qbs X Z (g ∘ f) s"
  by(intro distr_qbs_comp_all_meas) (auto simp: monadM_all_meas_space)

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')

lemma
  assumes "qbs_s_finite (monadM_qbs X) β μ"
          "ssx = ⟦monadM_qbs X, β, μ⟧meas"
          "α ∈ qbs_Mx X"
          "s_finite_kernel borel borel k"
      and "β =(λr. ⟦X, α, k r⟧meas)"
    shows join_qbs_s_finite: "qbs_s_finite X α (μ ⤜k k)"
      and join_qbs: "join_qbs ssx = ⟦X, α, μ ⤜k k⟧meas"
  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)

lemma strength_qbs_natural:
  assumes [qbs]:"f ∈ X →Q X'" "g ∈ Y →Q Y'" "x ∈ qbs_space X" "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)"
  by(intro strength_qbs_natural_all_meas) (auto simp: monadM_all_meas_space)

context
begin

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

lemma rr_from_real_to_real_id[simp]: "rr.from_real (rr.to_real x) = x" "rr.from_real ∘ rr.to_real = id"
  using rr.from_real_to_real by(auto simp: comp_def space_pair_measure)

lemma
  assumes "α ∈ qbs_Mx X"
          "β ∈ qbs_Mx (monadM_qbs Y)"
          "γ ∈ qbs_Mx Y"
          "s_finite_kernel borel borel k"
      and "β = (λr. ⟦Y, γ, k r⟧meas)"
    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⟧meas" (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 qbs_meas_def in_Mx_def qbs_meas_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_meas_def qbs_meas_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]])
  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_meas_eqI)
    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⟧meas)" "γ ∈ 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 qbs_meas_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[qbs]:"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, α, μ⟧meas" "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⟧meas)" "β ∈ 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"
      unfolding bind_qbs[OF h'(1) h(1) hb(2,3,1)] using hb
      by(intro join_qbs[OF qbs_s_finite.distr_qbs_s_finite[OF  strength_qbs_s_finite[OF h(1)]] qbs_meas.distr_qbs[OF strength_qbs_meas[OF h(1) h'(1)] strength_qbs[OF h(1) h'(1)]]])
        (auto simp: 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:
  "x ∈ qbs_space (unit_quasi_borel ⨂Q monadM_qbs X)
   ⟹ snd x = (distr_qbs (unit_quasi_borel ⨂Q X) X snd ∘ strength_qbs unit_quasi_borel X) x"
  by(intro strength_qbs_law1_all_meas) (auto simp: pair_qbs_space monadM_all_meas_space)

lemma strength_qbs_law2:
  "x ∈ qbs_space ((X ⨂Q Y) ⨂Q monadM_qbs Z)
   ⟹ (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(intro strength_qbs_law2_all_meas) (auto simp: pair_qbs_space monadM_all_meas_space)

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 -
  have [qbs]:"fst x ∈ qbs_space X" "snd x ∈ qbs_space (monadM_qbs (monadM_qbs Y))"
    using assms by(auto simp: pair_qbs_space)
  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, β, μ⟧meas"
    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⟧meas)"
      and h'': "⋀r. qbs_s_finite Y γ (k r)"
    by (metis in_Mx.in_Mx qbs_meas_def qbs_s_finite_def)    
  have "?lhs = ⟦X ⨂Q Y, λr. (fst x, γ r), μ ⤜k k⟧meas"
    using qbs_meas.strength_qbs[OF  qbs_s_finite.axioms(1)[OF join_qbs_s_finite[OF h h']] _ join_qbs[OF h h'],of "fst x" X] assms
    by(auto simp: pair_qbs_space)
  also have "... = ?rhs"
    using qbs_meas.strength_qbs[where W=X,OF qbs_s_finite.axioms(1)[OF h''] _ fun_cong[OF h'(3)]]
    by(auto intro!: qbs_meas.strength_qbs[where w="fst x" and sx ="snd x",simplified] join_qbs[symmetric,where β="strength_qbs X Y ∘ (λr. (fst x, β r))"]
                    qbs_meas.distr_qbs qbs_s_finite.distr_qbs_s_finite[where X="(X ⨂Q monadM_qbs Y)"] qbs_s_finite.strength_qbs_s_finite h
                    qbs_s_finite.axioms(1) pair_qbs_MxI h'(1,2) simp: comp_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⟧meas"
    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⟧meas" (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⟧meas)"
      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_meas_def qbs_meas_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_meas_def qbs_meas_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,β,ν⟧meas ⤜ (λy. ⟦X,α,μ⟧meas ⤜ (λx. return_qbs (X ⨂Q Y) (x,y))) = ⟦X ⨂Q Y, map_prod α β ∘ rr.from_real, distr (μ ⨂M ν) borel rr.to_real⟧meas" (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))⟧meas"
    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,α,μ⟧meas ⤜ (λx. ⟦Y,β,ν⟧meas ⤜ (λy. return_qbs (X ⨂Q Y) (x,y))) = ⟦X ⨂Q Y, map_prod α β ∘ rr.from_real, distr (μ ⨂M ν) borel rr.to_real⟧meas" (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))⟧meas"
    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, α, μ⟧meas" "q = ⟦Y, β, ν⟧meas" "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,α,μ⟧meas ⤜ (λx. ⟦Y,β,ν⟧meas ⤜ (λy. return_qbs Z (f (x,y)))) = ⟦Z, f ∘ (map_prod α β ∘ rr.from_real), distr (μ ⨂M ν) borel rr.to_real⟧meas" (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 qbs_meas_def in_Mx_def qbs_Mx_is_morphisms)
  have "?lhs = ⟦X,α,μ⟧meas ⤜ (λx. ⟦Y,β,ν⟧meas ⤜ (λ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⟧meas ⤜ 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 monadP_qbs_def2: "monadP_qbs X = sub_qbs (all_meas_qbs X) {s. prob_space (qbs_l s)}"
  unfolding monadP_qbs_def
proof(safe intro!: qbs_eqI)
  fix γ
  assume h:"γ ∈ qbs_Mx (sub_qbs (all_meas_qbs X) {s. prob_space (qbs_l s)})"
  then obtain α k where h':"γ = (λr. ⟦X, α, k r⟧meas)" "α ∈ qbs_Mx X" "measure_kernel borel borel k" "⋀r. qbs_meas X α (k r)"
    using rep_all_meas_qbs_Mx[of _ X] by(auto simp: sub_qbs_Mx)
  then interpret qbs_meas X α "k r" for r
    by simp
  have "⋀r. prob_space (k r)"
    using h by(auto simp: sub_qbs_Mx qbs_l qbs_meas_def h'(1) intro!: prob_space_distrD[of α _ "qbs_to_measure X"])
  then interpret prob_kernel borel borel k
    by(auto simp: prob_kernel_def prob_kernel_axioms_def h'(3))
  show "γ ∈ qbs_Mx (sub_qbs (monadM_qbs X) {s. prob_space (qbs_l s)})"
    using h by(auto simp: sub_qbs_Mx monadM_qbs_Mx h'(1) intro!: exI[where x=α] exI[where x=k] s_finite_kernel_axioms)
qed(use monadM_all_meas_Mx in "auto simp: sub_qbs_Mx")

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_def2 sub_qbs_space all_meas_qbs_space)

lemma rep_qbs_space_monadP:
  assumes "s ∈ qbs_space (monadP_qbs X)"
  obtains α μ where "s = ⟦X, α, μ⟧meas" "qbs_prob X α μ"
proof -
  obtain α μ where h:"s = ⟦X, α, μ⟧meas" "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_space_of_non_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⟧meas = X" "prob_space (qbs_l ⟦X, a, return borel 0⟧meas)"
      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, α, μ⟧meas ∈ 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"
  unfolding monadP_qbs_def using assms
  by(auto intro!: qbs_morphism_subsubI simp: monadP_qbs_space qbs_space_of_in)

lemma monadP_qbs_Mx: "qbs_Mx (monadP_qbs X) = {λr. ⟦X, α, k r⟧meas |α 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⟧meas)" "α ∈ qbs_Mx X" "s_finite_kernel borel borel k" "⋀r. qbs_s_finite X α (k r)"
    using rep_qbs_Mx_monadM[of γ X] by(auto simp add: monadP_qbs_def sub_qbs_Mx)
  interpret s_finite_kernel borel borel k by fact
  interpret qs: qbs_s_finite X α "k r" for r
    by fact
  have "⋀r. prob_space (k r)"
    using h by(auto intro!: prob_space_distrD[of α _ "qbs_to_measure X"] simp: h1(1) monadP_qbs_def sub_qbs_Mx qs.qbs_l)
  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⟧meas) ∧ α ∈ 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⟧meas) ∈ qbs_Mx (monadP_qbs X)"
    using h(1) qp
    by(auto simp: monadP_qbs_def sub_qbs_Mx monadM_qbs_space qbs_meas.qbs_l[OF qbs_prob.qbs_meas[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⟧meas)" "α ∈ 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⟧meas)" "α ∈ 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_meas.qbs_l[OF qbs_prob.qbs_meas[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⟧meas)"
    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, α, μ⟧meas"
          "f ∈ X →Q monadP_qbs Y"
          "β ∈ qbs_Mx Y"
      and g[measurable]:"g ∈ borel →M prob_algebra borel"
      and "(f ∘ α) = (λr. ⟦Y, β, g r⟧meas)"
    shows bind_qbs_prob:"qbs_prob Y β (μ ⤜ g)"
      and bind_qbs': "s ⤜ f = ⟦Y, β, μ ⤜ g⟧meas"
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⟧meas"
    using bind_qbs_meas[OF assms(1) qbs_morphism_monadAD[OF qbs_morphism_monadPD[OF assms(2)]] assms(3) prob_kernel.axioms(1) assms(5)]
    by(auto simp: 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] prob_kernel_def' intro!: qbs_meas.qbs_probI)
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, α, μ⟧meas" "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⟧meas)" "β ∈ 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, β, μ⟧meas"
          "α ∈ qbs_Mx X"
          "g ∈ borel →M prob_algebra borel"
      and "β =(λr. ⟦X, α, g r⟧meas)"
    shows qbs_prob_join_qbs_s_finite: "qbs_prob X α (μ ⤜ g)"
      and qbs_prob_join_qbs: "join_qbs ssx = ⟦X, α, μ ⤜ g⟧meas"
  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⟧meas)"
    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_meas.qbs_probI qbs_s_finite.axioms(1) 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⟧meas)" "γ ∈ 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, α, μ⟧meas" "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⟧meas)" "β ∈ 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 h(1)] qbs_morphism_eval]  qbs_meas.distr_qbs[OF strength_qbs_meas[OF h(1) h'(1)] strength_qbs[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'] 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, β, μ⟧meas"
    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⟧meas)"
      and h'': "⋀r. qbs_prob Y γ (g r)"
    by metis
  have "?lhs = ⟦X ⨂Q Y, λr. (fst x, γ r), μ ⤜ g⟧meas"
    using qbs_meas.strength_qbs[OF qbs_prob.qbs_meas[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 "fst x" X] strength_qbs_morphismP] qbs_meas.distr_qbs[OF qp.strength_qbs_meas[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)"] assms
          qbs_meas.strength_qbs[OF qbs_prob.qbs_meas[OF h''] _ fun_cong[OF h'(3)]]
    by(fastforce 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_meas_eq_def) metis


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

syntax_consts
  "_qbs_almost_everywhere" ⇌ qbs_almost_everywhere

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 fastforce

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

lemma(in qbs_meas) AEq_AE: "(AEQ x in ⟦X, α, μ⟧meas . P x) ⟹ (AE x in μ. P (α x))"
  by(auto simp: AEq_def intro!:AE_distrD[of α])

lemma(in qbs_meas) AEq_AE_iff:
  assumes [qbs]:"qbs_pred X P"
  shows "(AEQ x in ⟦X, α, μ⟧meas . 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⟧meas)" "α ∈ 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_meas.AEq_AE_iff[OF hk(4)[THEN qbs_s_finite.axioms(1)]])
     (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 (all_meas_qbs X)" "⋀x. x ∈ qbs_space X ⟹ P x"
  shows "AEQ x in p. P x"
  by(auto simp: space_qbs_l_in_all_meas[OF assms(1)] assms(2) AEq_qbs_l)

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
  shows AEq_Ball_mp_all_meas:
  "s ∈ qbs_space (all_meas_qbs X) ⟹ (⋀x. x∈qbs_space X ⟹ P x) ⟹ AEQ x in s. P x ⟶ Q x ⟹ AEQ x in s. Q x"
  and 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"
  and AEq_cong_all_meas:
  "s ∈ qbs_space (all_meas_qbs X) ⟹ (⋀x. x ∈ qbs_space X ⟹ P x ⟷ Q x) ⟹ (AEQ x in s. P x) ⟷ (AEQ x in s. Q x)"
  and 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
  shows AEq_cong_simp_all_meas: "s ∈ qbs_space (all_meas_qbs X) ⟹ (⋀x. x ∈ qbs_space X =simp=> P x = Q x) ⟹ (AEQ x in s. P x) ⟷ (AEQ x in s. Q x)"
  and 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 AEq_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_meas_eq_def)

lift_definition qbs_integral :: "['a qbs_measure, 'a ⇒ ('b :: {banach,second_countable_topology})] ⇒ 'b"
is "λ(X,α,μ) f. if f ∈ X →Q qbs_borel then (∫x. f (α x) ∂μ) else 0"
  by(fastforce dest: qbs_meas_eq_integral_eq qbs_meas_eq_dest(3))

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

syntax_consts
  "_qbs_nn_integral" ⇌ qbs_nn_integral

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

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

syntax_consts
  "_qbs_integral" ⇌ qbs_integral

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

lemma(in qbs_meas)
  shows qbs_nn_integral_def: "f ∈ X →Q qbs_borel ⟹ (∫+Q x. f x ∂⟦X, α, μ⟧meas) = (∫+x. f (α x) ∂ μ)"
    and qbs_nn_integral_def2:"(∫+Q x. f x ∂⟦X, α, μ⟧meas) = (∫+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_meas) qbs_integral_def:
 "f ∈ X →Q qbs_borel ⟹ (∫Q x. f x ∂⟦X, α, μ⟧meas) = (∫x. f (α x) ∂ μ)"
  by(simp add: qbs_integral.abs_eq)

lemma(in qbs_meas) qbs_integral_def2: "(∫Q x. f x ∂⟦X, α, μ⟧meas) = (∫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, α, μ⟧meas) 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 not_integrable_integral_eq)
  qed(simp add: qbs_integral.abs_eq integral_distr)
qed

lemma qbs_measure_eqI_all_meas:
  assumes [qbs]:"p ∈ qbs_space (all_meas_qbs X)" "q ∈ qbs_space (all_meas_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, α, μ⟧meas" "q = ⟦X, β, ν⟧meas" "qbs_meas X α μ" "qbs_meas X  β ν"
    by (meson assms(1) assms(2) rep_qbs_space_all_meas)
  then interpret pq:pair_qbs_meas X α μ β ν
    by(auto simp: pair_qbs_meas_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_meas_eqI2)
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"
  by(auto intro!: assms qbs_measure_eqI_all_meas monadM_all_meas_space)
 
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 qbs_meas.qbs_integral_def2 qbs_meas.qbs_l rep_qbs_measure')

definition qbs_integrable :: "'a qbs_measure ⇒ ('a ⇒ 'b::{second_countable_topology,real_normed_vector}) ⇒ bool"
where qbs_integrable_iff_integrable: "qbs_integrable p f ⟷ integrable (qbs_l p) f"

lemma(in qbs_meas) qbs_integrable_def:
  fixes f :: "'a ⇒ 'b::{second_countable_topology,banach}"
  shows "qbs_integrable ⟦X, α, μ⟧meas f ⟷ f ∈ X →Q qbs_borel ∧ integrable μ (λx. f (α x))"
proof -
  have "qbs_integrable ⟦X, α, μ⟧meas f ⟷  f ∈ X →Q qbs_borel ∧ integrable (distr μ (qbs_to_measure X) α) f"
    by(auto simp: lr_adjunction_correspondence qbs_integrable_iff_integrable qbs_l)
  also have "... ⟷ f ∈ X →Q qbs_borel ∧ integrable μ (λx. f (α x))"
    by(auto simp: integrable_distr_eq)
  finally show ?thesis .
qed

lemma qbs_integrable_morphism_dest_all_meas:
  assumes "s ∈ qbs_space (all_meas_qbs X)"
      and "qbs_integrable s f"
    shows "f ∈ X →Q qbs_borel"
  using assms(2)
  by(auto simp add: measurable_qbs_l_all_meas[OF assms(1),symmetric] qbs_integrable_iff_integrable)

lemma qbs_integrable_morphism_dest:
  assumes "s ∈ qbs_space (monadM_qbs X)"
      and "qbs_integrable s f"
    shows "f ∈ X →Q qbs_borel"
  by(auto intro!: qbs_integrable_morphism_dest_all_meas assms monadM_all_meas_space)

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,α,μ⟧meas f"
  shows "f ∈ qbs_to_measure X →M borel"
  by(auto intro!: qbs_integrable_morphism_dest assms simp: lr_adjunction_correspondence[symmetric])

corollary(in qbs_meas) qbs_integrable_distr: "qbs_integrable ⟦X, α, μ⟧meas 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⟧meas)" "α ∈ qbs_Mx X" "s_finite_kernel borel borel k" "⋀r. qbs_s_finite X α (k r)"
    by metis
  then interpret qbs_s_finite X α "k r" for r
    by simp
  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 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_integrable_distr integrable_distr_eq qbs_Mx_is_morphisms qbs_pred_iff_measurable_pred
          intro!: s_finite_kernel.integrable_measurable_pred[OF hk(3)])
       (use h(2) in "simp add: 1 qbs_Mx_is_morphisms split_beta'")
qed

lemma(in qbs_meas) qbs_integrable_iff_integrable:
  assumes "f ∈ qbs_to_measure X →M (borel :: _ ::{second_countable_topology,banach} measure)"
  shows "qbs_integrable ⟦X, α, μ⟧meas 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_all_meas:
  fixes f :: "'a ⇒ 'b::{second_countable_topology,banach}"
  assumes "s ∈ qbs_space (all_meas_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_all_meas[OF assms] obtain α μ where hs:
   "qbs_meas X α μ" "s = ⟦X, α, μ⟧meas"
    by metis
  then interpret qs: qbs_meas 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

lemmas qbs_integrable_iff_bounded = qbs_integrable_iff_bounded_all_meas[OF monadM_all_meas_space]

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_all_meas:
  assumes "s ∈ qbs_space (all_meas_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_all_meas[OF assms(1),of f]
            simp: AEq_qbs_l measurable_qbs_l_all_meas[OF assms(1)])

lemmas qbs_integrable_cong_AE = qbs_integrable_cong_AE_all_meas[OF monadM_all_meas_space]

lemma qbs_integrable_cong_all_meas:
  assumes "s ∈ qbs_space (all_meas_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_all_meas[OF assms(1)] assms(2))

lemmas qbs_integrable_cong = qbs_integrable_cong_all_meas[OF monadM_all_meas_space]

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:
  fixes f :: "'a ⇒ 'b::{second_countable_topology,banach}"
  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_all_meas[OF in_qbs_space_of_all_meas 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_all_meas:
  assumes "s ∈ qbs_space (all_meas_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

lemmas qbs_nn_integral_eq_integral = qbs_nn_integral_eq_integral_all_meas[OF monadM_all_meas_space]

lemma qbs_nn_integral_cong_AEq_all_meas:
  assumes "s ∈ qbs_space (all_meas_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_all_meas[OF assms(1)] obtain α μ
    where hs: "s = ⟦X, α, μ⟧meas" "qbs_meas X α μ" by metis
  then interpret qbs_meas X α μ by simp
  show ?thesis
    using assms(2) by(auto simp: qbs_nn_integral_def2 hs(1) AEq_def intro!: nn_integral_cong_AE)
qed

lemmas qbs_nn_integral_cong_AEq = qbs_nn_integral_cong_AEq_all_meas[OF monadM_all_meas_space]

lemma qbs_nn_integral_cong_all_meas:
  assumes "s ∈ qbs_space (all_meas_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_all_meas[OF assms(1) AEq_I2'[OF assms]] by simp

lemmas qbs_nn_integral_cong = qbs_nn_integral_cong_all_meas[OF monadM_all_meas_space]

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_all_meas:
  assumes "s ∈ qbs_space (all_meas_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_all_meas[OF assms(1)] intro!: nn_integral_add measurable_qbs_l)

lemmas qbs_nn_integral_add = qbs_nn_integral_add_all_meas[OF monadM_all_meas_space]

lemma qbs_nn_integral_cmult_all_meas:
  assumes "s ∈ qbs_space (all_meas_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_all_meas[OF assms(1)] intro!: nn_integral_cmult)

lemmas qbs_nn_integral_cmult = qbs_nn_integral_cmult_all_meas[OF monadM_all_meas_space]

lemma qbs_integral_cong_AEq_all_meas:
  assumes [qbs]:"s ∈ qbs_space (all_meas_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_all_meas[OF assms(1)] intro!: integral_cong_AE )

lemmas qbs_integral_cong_AEq = qbs_integral_cong_AEq_all_meas[OF monadM_all_meas_space]

lemma qbs_integral_cong_all_meas:
  assumes "s ∈ qbs_space (all_meas_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_all_meas[OF assms(1)] assms(2) intro!: Bochner_Integration.integral_cong)

lemmas qbs_integral_cong = qbs_integral_cong_all_meas[OF monadM_all_meas_space]

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_all_meas:
  fixes f :: "_ ⇒ real"
  assumes "s ∈ qbs_space (all_meas_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_all_meas[OF assms(1)] assms(2) intro!: Bochner_Integration.integral_nonneg)

lemmas qbs_integral_nonneg = qbs_integral_nonneg_all_meas[OF monadM_all_meas_space]

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_all_meas:
  fixes f :: "_ ⇒ real"
  assumes "s ∈ qbs_space (all_meas_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_all_meas[OF assms(1)] qbs_integrable_iff_integrable[symmetric] assms intro!: integral_mono)

lemmas qbs_integral_mono = qbs_integral_mono_all_meas[OF monadM_all_meas_space]

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_all_meas[OF in_qbs_space_of_all_meas 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_all_meas:
  assumes [qbs]: "s ∈ qbs_space (all_meas_qbs X)" "f ∈ X →Q all_meas_qbs Y"
  shows "qbs_l (s ⤜ f) = qbs_l s ⤜k qbs_l ∘ f" (is "?lhs = ?rhs")
proof -
  from rep_qbs_space_all_meas[OF assms(1)] obtain α μ
    where hs: "s = ⟦X, α, μ⟧meas" "qbs_meas X α μ" by metis
  then interpret qs: qbs_meas X α μ by simp
  from rep_all_meas_qbs_Mx[OF qbs_morphism_Mx[OF assms(2) qs.in_Mx]] obtain β k where
   hk: "f ∘ α =  (λr. ⟦Y, β, k r⟧meas)" "β ∈ qbs_Mx Y" "measure_kernel borel borel k" "⋀r. qbs_meas Y β (k r )"
    by metis
  then interpret sk: measure_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_all_meas[OF hs(1) assms(2) hk(2,3,1)] qbs_meas.qbs_l[OF qs.bind_qbs_meas[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_meas.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 "all_meas_qbs Y"] assms(2)
    by(auto intro!: measure_kernel.bind_kernel_distr[OF measure_kernel.measure_kernel_comp[OF qbs_l_measure_kernel_all_meas],symmetric]
              simp: sets_eq_imp_space_eq[OF qs.mu_sets])
  also have "... = ?rhs"
    by(simp add: hs(1) qs.qbs_l comp_def)
  finally show ?thesis .
qed

lemma qbs_l_bind_qbs:
  assumes "s ∈ qbs_space (monadM_qbs X)" "f ∈ X →Q monadM_qbs Y"
  shows "qbs_l (s ⤜ f) = qbs_l s ⤜k qbs_l ∘ f"
  by(auto intro!: qbs_l_bind_qbs_all_meas assms qbs_morphism_monadAD monadM_all_meas_space)

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

lemma qbs_integrable_return[simp, intro]:
  fixes f :: "'a ⇒ 'b::{second_countable_topology,banach}"
  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)] nn_integral_return space_L intro!: integrableI_bounded)

lemma qbs_integrable_bind_return_all_meas:
  fixes f :: "'a ⇒ 'b::{second_countable_topology,banach}"
  assumes [qbs]:"s ∈ qbs_space (all_meas_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_all_meas[OF assms(1)] obtain α μ
    where hs: "s = ⟦X, α, μ⟧meas" "qbs_meas X α μ" by metis
  then interpret qs: qbs_meas X α μ by simp

  have 1:"return_qbs Y ∘ (g ∘ α) = (λr. ⟦Y, g ∘ α, return borel r⟧meas)"
    by(auto intro!: return_qbs_comp qbs_morphism_Mx[OF assms(3)])
  have hb: "qbs_meas Y (g ∘ α) μ" "s ⤜ (λx. return_qbs Y (g x)) = ⟦Y, g ∘ α, μ⟧meas"
    using qbs_meas.bind_qbs_all_meas[OF hs(2,1) qbs_morphism_comp[OF assms(3) return_qbs_morphism_all_meas] qbs_morphism_Mx[OF assms(3)] prob_kernel.axioms(1) 1[simplified comp_assoc[symmetric]]]
          qbs_meas.bind_qbs_meas[OF hs(2,1) qbs_morphism_comp[OF assms(3) return_qbs_morphism_all_meas] qbs_morphism_Mx[OF assms(3)] prob_kernel.axioms(1) 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 intro!: qbs_meas.qbs_integrable_iff_integrable[OF hb(1),simplified comp_def]
              simp: hb(2) 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_integrable_bind_return:
  fixes f :: "'a ⇒ 'b::{second_countable_topology,banach}"
  assumes "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)"
  by(intro qbs_integrable_bind_return_all_meas[of s X] assms monadM_all_meas_space)

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⟧meas)" "a ∈ qbs_Mx X" "s_finite_kernel borel borel k" "⋀r. qbs_s_finite X a (k r)"
    by metis
  interpret qbs_s_finite X a "k r" for r by fact
  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])
      (use h ak(2) in "auto simp: qbs_nn_integral_def qbs_Mx_is_morphisms ak(1) 1 intro!: s_finite_kernel.nn_integral_measurable_f[OF ak(3)]")
qed

lemma qbs_nn_integral_morphism':
  assumes [qbs,measurable]:"f ∈ X →Q qbs_borel"
  shows "(λx. qbs_nn_integral x f) ∈ all_meas_qbs X →Q qbs_borel"
proof(rule qbs_morphismI)
  fix α
  assume "α ∈ qbs_Mx (all_meas_qbs X)"
  from rep_all_meas_qbs_Mx[OF this] obtain a k
    where ak: "α = (λr. ⟦X, a, k r⟧meas)" "a ∈ qbs_Mx X" "measure_kernel borel borel k" "⋀r. qbs_meas X a (k r)"
    by blast
  interpret qbs_meas X a "k r" for r by fact
  show "(λx. qbs_nn_integral x f) ∘ α ∈ qbs_Mx borelQ"
    by(auto simp: comp_def ak(1) qbs_nn_integral_def qbs_Mx_qbs_borel measurable_compose[OF α_measurable]
              intro!: measure_kernel.nn_integral_measurable_kernel[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_all_meas:
  assumes [qbs]:"s ∈ qbs_space (all_meas_qbs X)"
          "f ∈ X →Q all_meas_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 -
  note [qbs] = qbs_morphism_compose[OF assms(2)  qbs_nn_integral_morphism'[OF assms(3)]]
  from rep_qbs_space_all_meas[OF assms(1)] obtain α μ
    where hs: "s = ⟦X, α, μ⟧meas" "qbs_meas X α μ" by metis
  then interpret qs: qbs_meas X α μ by simp
  from rep_all_meas_qbs_Mx[OF qbs_morphism_Mx[OF assms(2) qs.in_Mx]] obtain β k
    where hk: "f ∘ α = (λr. ⟦Y, β, k r⟧meas)" "β ∈ qbs_Mx Y" "measure_kernel borel borel k" "⋀r. qbs_meas Y β (k r)"
    by metis
  interpret hk: qbs_meas Y β "k r" for r by fact
  interpret sf: qbs_meas Y β "μ ⤜k k"
    by(rule qs.bind_qbs_meas[OF hs(1) assms(2) hk(2,3,1)])
  note sf = qs.bind_qbs_all_meas[OF hs(1) assms(2) hk(2,3,1)]
  have "?lhs = (∫+ x. g (β x) ∂(μ ⤜k k))"
    by(simp add: sf sf.qbs_nn_integral_def)
  also have "... = (∫+ r. (∫+ y. g (β y) ∂(k r)) ∂μ)"
    using assms(3) hk(2)
    by(auto intro!: measure_kernel.nn_integral_bind_kernel[OF hk(3)] qs.mu_sets
              simp: lr_adjunction_correspondence)
  also have "... = ?rhs"
    using fun_cong[OF hk(1)] by(auto simp: hs(1) qs.qbs_nn_integral_def hk.qbs_nn_integral_def[symmetric] intro!: nn_integral_cong)
  finally show ?thesis .
qed

lemmas qbs_nn_integral_bind = qbs_nn_integral_bind_all_meas[OF monadM_all_meas_space qbs_morphism_monadAD]

lemma qbs_nn_integral_bind_return_all_meas:
  assumes [qbs]:"s ∈ qbs_space (all_meas_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)"
proof -
  note return_qbs_morphism_all_meas[qbs]
  show ?thesis
    by(auto simp: qbs_nn_integral_bind_all_meas[OF assms(1) _ assms(2)] qbs_nn_integral_return intro!: qbs_nn_integral_cong_all_meas[OF assms(1)])
qed

lemmas qbs_nn_integral_bind_return = qbs_nn_integral_bind_return_all_meas[OF monadM_all_meas_space]

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⟧meas)" "β ∈ qbs_Mx X" "s_finite_kernel borel borel k" "⋀r. qbs_s_finite X β (k r)"
    by metis
  interpret qbs_s_finite X β "k r" for r by fact
  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_integral_def qbs_Mx_is_morphisms hk(1) 1 intro!: s_finite_kernel.integral_measurable_f[OF hk(3)])
qed

lemma qbs_integral_morphism':
  assumes [qbs,measurable]:"f ∈ X →Q qbs_borel"
  shows "(λx. qbs_integral x f) ∈ all_meas_qbs X →Q qbs_borel"
proof(rule qbs_morphismI)
  fix α
  assume "α ∈ qbs_Mx (all_meas_qbs X)"
  from rep_all_meas_qbs_Mx[OF this] obtain a k
    where ak: "α = (λr. ⟦X, a, k r⟧meas)" "a ∈ qbs_Mx X" "measure_kernel borel borel k" "⋀r. qbs_meas X a (k r)"
    by blast
  interpret qbs_meas X a "k r" for r by fact
  show "(λx. qbs_integral x f) ∘ α ∈ qbs_Mx borelQ"
    by(auto simp: comp_def ak(1) qbs_integral_def qbs_Mx_qbs_borel measurable_compose[OF α_measurable]
          intro!: measure_kernel.integral_measurable_kernel[OF ak(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 (all_meas_qbs X)" "f ∈ X →Q all_meas_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_all_meas: "qbs_integrable (s ⤜ f) g" (is ?goal1)
      and qbs_integral_bind_all_meas:"(∫Q y. g y ∂(s ⤜ f)) = (∫Q x. ∫Q y. g y ∂f x ∂s)" (is "?lhs = ?rhs")
proof -
  from rep_qbs_space_all_meas[OF assms(1)] obtain α μ
    where hs: "s = ⟦X, α, μ⟧meas" "qbs_meas X α μ" by metis
  then interpret qs: qbs_meas X α μ by simp
  from rep_all_meas_qbs_Mx[OF qbs_morphism_Mx[OF assms(2) qs.in_Mx]] obtain β k
    where hk: "f ∘ α = (λr. ⟦Y, β, k r⟧meas)" "β ∈ qbs_Mx Y" "measure_kernel borel borel k" "⋀r. qbs_meas Y β (k r)"
    by metis
  interpret hk: qbs_meas Y β "k r" for r by fact
  note sf = qs.bind_qbs_all_meas[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_meas Y β "μ ⤜k k"
    by(rule qs.bind_qbs_meas[OF hs(1) assms(2) hk(2,3,1)])
  show ?goal1
    by(auto simp: sf qs2.qbs_integrable_def intro!: measure_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] hk.qbs_integrable_def] assms(4)[simplified hs(1) qs.qbs_integrable_def fun_cong[OF hk(1),simplified]],auto simp: hs(1) qs.qbs_integrable_def hk.qbs_integral_def)
  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] hk.qbs_integrable_def] assms(4)[simplified hs(1) qs.qbs_integrable_def fun_cong[OF hk(1),simplified]]
    by(auto intro!: measure_kernel.integral_bind_kernel[OF hk(3) qs.mu_sets] simp: hk.qbs_integral_def)
  also have "... = (∫r. (∫Q y. g y∂⟦Y, β, k r⟧meas) ∂μ)"
    by(auto intro!: Bochner_Integration.integral_cong simp: hk.qbs_integral_def)
  also have "... = ?rhs"
    using qbs_morphism_compose[OF assms(2) qbs_integral_morphism'[OF assms(3)]]
    by(auto simp: hs(1) qs.qbs_integral_def fun_cong[OF hk(1),simplified comp_def])
  finally show "?lhs = ?rhs" .
qed

lemmas qbs_integrable_bind = qbs_integrable_bind_all_meas[OF monadM_all_meas_space qbs_morphism_monadAD]
lemmas qbs_integral_bind = qbs_integral_bind_all_meas[OF monadM_all_meas_space qbs_morphism_monadAD]

lemma qbs_integral_bind_return_all_meas:
  assumes [qbs]:"s ∈ qbs_space (all_meas_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_all_meas[OF assms(1)] obtain α μ
    where hs: "s = ⟦Y, α, μ⟧meas" "qbs_meas Y α μ" by metis
  then interpret qs: qbs_meas Y α μ by simp
  note [qbs] = qbs_morphism_compose[OF assms(3) return_qbs_morphism_all_meas]
  have hb: "qbs_meas Z (g ∘ α) μ" "s ⤜ (λy. return_qbs Z (g y)) = ⟦Z, g ∘ α, μ⟧meas"
    using qs.bind_qbs_meas[OF hs(1) _ qbs_morphism_Mx[OF assms(3) qs.in_Mx] prob_kernel.axioms(1) 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_all_meas[OF hs(1) _ qbs_morphism_Mx[OF assms(3) qs.in_Mx] prob_kernel.axioms(1) 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_meas.qbs_integral_def[OF hb(1)] qs.qbs_integral_def[simplified hs(1)[symmetric]])
qed

lemmas qbs_integral_bind_return = qbs_integral_bind_return_all_meas[OF monadM_all_meas_space]

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, α, μ⟧meas ⨂Qmes ⟦Y, β, ν⟧meas = ⟦X ⨂Q Y, map_prod α β ∘ rr.from_real, distr (μ ⨂M ν) borel rr.to_real⟧meas"
    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, α, μ⟧meas ⨂Qmes ⟦Y, β, ν⟧meas) = distr (μ ⨂M ν) (qbs_to_measure (X ⨂Q Y)) (map_prod α β)"
  by(simp add: qbs_pair_measure qbs_l 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, α, μ⟧meas ⨂Qmes ⟦Y, β, ν⟧meas)) = (∫+ 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, α, μ⟧meas ⨂Qmes ⟦Y, β, ν⟧meas)) = (∫ 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:
  fixes f :: "_ ⇒ _::{second_countable_topology,banach}"
  shows "qbs_integrable (⟦X, α, μ⟧meas ⨂Qmes ⟦Y, β, ν⟧meas) 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, α, μ⟧meas" "qbs_s_finite X α μ"
      and hq: "q = ⟦Y, β, ν⟧meas" "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 assms)
  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[OF 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[OF 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, β, ν⟧meas" "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, α, μ⟧meas" "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:
  fixes f :: "_ ⇒ _::{second_countable_topology,banach}"
  assumes "p ∈ qbs_space (monadM_qbs X)" "q ∈ qbs_space (monadM_qbs Y)"
    and "qbs_integrable (p ⨂Qmes q) f"
  shows "qbs_integrable (q ⨂Qmes p) (λ(x,y). f (y,x))"
proof -
  obtain α μ β ν
    where hp: "p = ⟦X, α, μ⟧meas" "qbs_s_finite X α μ"
      and hq: "q = ⟦Y, β, ν⟧meas" "qbs_s_finite Y β ν" 
    using rep_qbs_space_monadM assms 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)
  have *:"((λ(y, x). f (x, y)) ∘ map_prod β α) = (λ(y,x). (λ(a, b). f (α a, β b)) (x,y))"
    by auto
  show ?thesis
    using assms(3) integrable_product_swap_s_finite[OF p1.pq1.s_finite_measure_axioms p1.pq2.s_finite_measure_axioms,of "f ∘ map_prod α β"]
    by(auto simp: p1.qbs_pair_measure_integrable_eq p2.qbs_pair_measure_integrable_eq hp hq *)
qed

lemma qbs_integrable_pair1':
  fixes f :: "_ ⇒ _::{second_countable_topology,banach}"
  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, α, μ⟧meas" "qbs_s_finite X α μ"
      and hq: "q = ⟦Y, β, ν⟧meas" "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: 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 "p ∈ qbs_space (monadM_qbs X)" "q ∈ qbs_space (monadM_qbs Y)"
  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 α μ β ν
    where hp: "p = ⟦X, α, μ⟧meas" "qbs_s_finite X α μ"
      and hq: "q = ⟦Y, β, ν⟧meas" "qbs_s_finite Y β ν"
    using rep_qbs_space_monadM assms by meson
  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(3)])   
  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, β,  ν⟧meas" and f="λx. ∫ y. f (α x, β y) ∂ν" and N0=μ,THEN iffD1] Bochner_Integration.integrable_cong[where g="λr. ∫Q x. f (x, β r) ∂⟦X, α, μ⟧meas" 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:"p ∈ qbs_space (monadM_qbs X)" "q ∈ qbs_space (monadM_qbs Y)" "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':
  fixes f :: "_ ⇒ _::{second_countable_topology,banach}"
  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 assms(2,1) qbs_integrable_pair1'[OF assms(2,1) qbs_morphism_pair_swap[OF assms(3)]]] assms(4,5)
  by simp

lemma qbs_integrable_indep_mult:
  fixes f :: "_ ⇒ _::{real_normed_div_algebra,second_countable_topology, banach}"
  assumes [qbs]:"p ∈ qbs_space (monadM_qbs X)" "q ∈ qbs_space (monadM_qbs Y)"
    and "qbs_integrable p f" "qbs_integrable q g"
  shows "qbs_integrable (p ⨂Qmes q) (λx. f (fst x) * g (snd x))"
proof -
  obtain α μ β ν
    where hp: "p = ⟦X, α, μ⟧meas" "qbs_s_finite X α μ"
      and hq: "q = ⟦Y, β, ν⟧meas" "qbs_s_finite Y β ν"
    using assms rep_qbs_space_monadM by meson
  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"
    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(3) AEq_I2[of _ X]
              simp: norm_mult qbs_integrable_mult_right[OF assms(4)])
qed 

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

lemma qbs_integral_indep1:
  fixes f :: "_ ⇒ _::{real_normed_div_algebra,second_countable_topology,banach}"
  assumes "p ∈ qbs_space (monadM_qbs X)" "q ∈ qbs_space (monadP_qbs Y)" "qbs_integrable p f" 
  shows "(∫Q z. f (fst z) ∂(p ⨂Qmes q)) = (∫Q x. f x ∂p)"
  using qbs_integral_Fubini_snd'[OF assms(1) qbs_space_monadPM[OF assms(2)] 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, banach}"
  assumes "p ∈ qbs_space (monadP_qbs X)" "q ∈ qbs_space (monadM_qbs Y)" "qbs_integrable q g"
  shows "qbs_integrable (p ⨂Qmes q) (λx. g (snd x))"
  using qbs_integrable_pair_swap[OF assms(2) qbs_space_monadPM[OF assms(1)] qbs_integrable_indep1[OF assms(2,1,3)]] 
  by(simp add: split_beta')

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

lemma qbs_integral_indep_mult1:
  fixes f and g:: "_ ⇒ _::{real_normed_field,second_countable_topology, banach}"
  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_space_monadPM[OF assms(1)] qbs_space_monadPM[OF assms(2)]
                                    qbs_integrable_indep_mult[OF qbs_space_monadPM[OF assms(1)] qbs_space_monadPM[OF assms(2)] 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)⟧meas"

context standard_borel_ne
begin

lemma qbs_l_inverse_def2:
  assumes [measurable_cong]: "sets μ = sets M"
    shows "qbs_l_inverse μ = ⟦measure_to_qbs M, from_real, distr μ borel to_real⟧meas"
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
  interpret p: pair_qbs_meas "measure_to_qbs M" s.from_real "distr μ borel s.to_real" from_real "distr μ borel to_real"
    by(auto simp: pair_qbs_meas_def qbs_meas_def in_Mx_def qbs_Mx_R qbs_meas_axioms_def)
  have "distr μ (qbs_to_measure (measure_to_qbs M)) (s.from_real ∘ s.to_real) = distr μ (qbs_to_measure (measure_to_qbs M)) (from_real ∘ to_real)"
    by(auto intro!: distr_cong simp: sets_eq_imp_space_eq[OF assms(1)])
  thus ?thesis
    by(auto simp: distr_distr qbs_l_inverse_def intro!: p.qbs_meas_eqI cong: measure_to_qbs_cong_sets[OF assms(1)])
qed

lemma
  assumes [measurable_cong]:"sets μ = sets M"
  shows qbs_l_inverse_meas: "qbs_meas (measure_to_qbs M) from_real (distr μ borel to_real)"
    and 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_meas_axioms_def qbs_meas_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 "sets μ = sets M"
  shows qbs_l_inverse_in_space_all_meas:"qbs_l_inverse μ ∈ qbs_space (all_meas_qbs M)"
    and 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)] assms
        intro!: qbs_meas.in_space_all_meas[OF qbs_l_inverse_meas] 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"
  shows "qbs_l (qbs_l_inverse μ) = μ"
proof -
  interpret qbs_meas "measure_to_qbs M" from_real "distr μ borel to_real"
    by(auto intro!: qbs_l_inverse_meas 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

lemma qbs_l_inverse_qbs_l_all_meas:
  assumes "s ∈ qbs_space (all_meas_qbs (measure_to_qbs M))"
  shows "qbs_l_inverse (qbs_l s) = s"
proof -
  from rep_qbs_space_all_meas[OF assms] obtain α μ where h:
   "s = ⟦measure_to_qbs M, α, μ⟧meas" "qbs_meas (measure_to_qbs M) α μ"
    by metis
  then interpret qm:qbs_meas "measure_to_qbs M" α μ by simp
  interpret s: standard_borel_ne "distr μ M α"
    by(rule standard_borel_ne_sets[of M]) (auto simp: standard_borel_ne_axioms)
  have "s.from_real ∘ (s.to_real ∘ α) = α"
    by standard (metis o_apply qbs_Mx_to_X qbs_space_R qm.in_Mx s.from_real_to_real space_distr)
  hence [simp]:"distr μ (qbs_to_measure (measure_to_qbs M)) (s.from_real ∘ (s.to_real ∘ α)) = distr μ M α"
               "distr μ (qbs_to_measure (measure_to_qbs M)) α = distr μ M α"
    by(simp_all cong: distr_cong)
  have [measurable]: "s.from_real ∈ borel →M M" "α ∈ μ →M M"
    using qm.α_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_meas "measure_to_qbs M" s.from_real "distr μ borel (s.to_real ∘ α)" α μ
    using h by(auto simp: pair_qbs_meas_def qbs_meas_def in_Mx_def qbs_Mx_R qbs_meas_axioms_def)
  show ?thesis
    by(auto simp add: qm.qbs_l h qbs_l_inverse_def distr_distr cong: measure_to_qbs_cong_sets intro!: pqs.qbs_meas_eqI)
qed

lemmas qbs_l_inverse_qbs_l = qbs_l_inverse_qbs_l_all_meas[OF monadM_all_meas_space]

lemmas qbs_l_inverse_qbs_l_monadP = qbs_l_inverse_qbs_l[OF qbs_space_monadPM]

lemma qbs_l_inverse_morphism_kernel:
  assumes "measure_kernel N M k"
  shows "(λx. qbs_l_inverse (k x)) ∈ measure_to_qbs N →Q all_meas_qbs (measure_to_qbs M)"
proof -
  interpret ms:measure_kernel N M k by fact
  have "⟦measure_to_qbs M, from_real, distr (k x) borel to_real⟧meas = qbs_l_inverse (k x)" if x:"x ∈ space N" for x
  proof -
    note ms.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_meas "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 ms.kernel_sets[OF x]]]
      by(auto simp: pair_qbs_meas_def qbs_meas_def qbs_meas_axioms_def in_Mx_def qbs_Mx_R)
    have "distr (k x) (qbs_to_measure (measure_to_qbs M)) (from_real ∘ to_real)
          = distr (k x) (qbs_to_measure (measure_to_qbs M)) (skx.from_real ∘ skx.to_real)"
      by(auto intro!: distr_cong simp: ms.kernel_space[OF x])
    thus ?thesis
      by(auto simp: qbs_l_inverse_def distr_distr cong: measure_to_qbs_cong_sets intro!: pqs.qbs_meas_eqI)
  qed
  moreover have "(λx. ⟦measure_to_qbs M, from_real, distr (k x) borel to_real⟧meas) ∈ measure_to_qbs N →Q all_meas_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⟧meas) ∘ α ∈ qbs_Mx (all_meas_qbs (measure_to_qbs M))"
      by(auto simp: all_meas_qbs_Mx qbs_Mx_R intro!: exI[where x=from_real] exI[where x="λx. distr (k (α x)) borel to_real"] measure_kernel.distr_measure_kernel[OF ms.measure_kernel_comp])
  qed
  ultimately show ?thesis
    by(rule qbs_morphism_cong'[of "measure_to_qbs N",simplified qbs_space_R])
qed

lemma qbs_l_inverse_morphism_s_finite:
  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⟧meas = 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_meas_def qbs_meas_axioms_def sfin.image_s_finite_measure[OF x] intro!: s_finite_measure.s_finite_measure_distr)
    have "distr (k x) (qbs_to_measure (measure_to_qbs M)) (from_real ∘ to_real)
          = distr (k x) (qbs_to_measure (measure_to_qbs M)) (skx.from_real ∘ skx.to_real)"
      by(auto intro!: distr_cong simp: sfin.kernel_space[OF x])
    thus ?thesis
      by(auto simp: qbs_l_inverse_def distr_distr cong: measure_to_qbs_cong_sets intro!: pqs.qbs_meas_eqI)
  qed
  moreover have "(λx. ⟦measure_to_qbs M, from_real, distr (k x) borel to_real⟧meas) ∈ 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⟧meas) ∘ α ∈ 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 qbs_l_inverse_qbs_morphism_prob:
  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' qbs_l_inverse_morphism_s_finite 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[OF refl] 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" "measure_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 ms: measure_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: ms.kernel_sets)
  then interpret s2: standard_borel_ne "M ⤜k k"
    using s.standard_borel_ne_axioms standard_borel_ne_sets by blast
  have eq1:"distr (M ⤜k k) (qbs_to_measure (measure_to_qbs N)) (s2.from_real ∘ s2.to_real)
        = distr (M ⤜k k) (qbs_to_measure (measure_to_qbs N)) (s.from_real ∘ s.to_real)"
    by(auto intro!: distr_cong cong: sets_eq_imp_space_eq)
  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⟧meas)"
  proof
    fix r
    have setskfr[measurable_cong, simp]: "sets (k (from_real r)) = sets N"
      by(auto intro!: ms.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
    have "distr (k (from_real r)) (qbs_to_measure (measure_to_qbs N)) (s3.from_real ∘ s3.to_real)
          = distr (k (from_real r)) (qbs_to_measure (measure_to_qbs N)) (s.from_real ∘ s.to_real)"
      by(auto intro!: distr_cong simp: sets_eq_imp_space_eq[OF setskfr])
    thus "((λ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⟧meas "
      by(auto simp: pair_qbs_meas_def qbs_meas_def qbs_l_inverse_def qbs_meas_eq_def qbs_s_finite_def in_Mx_def qbs_meas_axioms_def qbs_Mx_R distr_distr measurable_space[OF from_real_measurable] cong: measure_to_qbs_cong_sets intro!:  s_finite_measure.s_finite_measure_distr pair_qbs_meas.qbs_meas_eqI)
  qed
  have "?lhs = ⟦measure_to_qbs (M ⤜k k), s2.from_real, distr (M ⤜k k) borel s2.to_real⟧meas"
    by(simp add: qbs_l_inverse_def)
  also have "... = ⟦measure_to_qbs N, s.from_real, distr (M ⤜k k) borel s.to_real⟧meas"
    by(auto cong: measure_to_qbs_cong_sets intro!: pair_qbs_meas.qbs_meas_eqI simp: pair_qbs_meas_def qbs_meas_def qbs_meas_axioms_def in_Mx_def qbs_Mx_R distr_distr eq1)
  also have "... = ⟦measure_to_qbs N, s.from_real, M ⤜k (λx. distr (k x) borel s.to_real)⟧meas"
    by(simp add: ms.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)⟧meas"
  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] ms.measure_kernel_comp)
    finally show ?thesis by simp
  qed
  also have "... = ?rhs"
    by(intro qbs_meas.bind_qbs_all_meas[OF qbs_l_inverse_meas[OF refl],symmetric]
             s.qbs_l_inverse_morphism_kernel[OF assms(2)] comp1
             measure_kernel.distr_measure_kernel[OF ms.measure_kernel_comp])
      (auto simp: qbs_Mx_R 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.axioms(1))

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_meas_eq (X, α, μ) (Y, β, ν)"
  then interpret qs: pair_qbs_meas X α μ β ν
    using qbs_meas_eq_dest[OF 1] by(simp add: pair_qbs_meas_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_meas_eq_dest[OF 1]) blast+
  {
    assume "f ∈ X →Q qbs_borel"
    then have "qbs_meas_eq (X, α, density μ (f ∘ α)) (Y, β, density ν (f ∘ β))"
      by(auto simp: qbs_meas_eq_def lr_adjunction_correspondence density_distr[symmetric] comp_def
          qbs_meas_eq_dest[OF 1] qbs_meas_def in_Mx_def qbs_meas_axioms_def qs.pq1.mu_sets qs.pq2.mu_sets AE_distr_iff)
  }
  moreover have "f ∈ X →Q qbs_borel ⟹ f ∉ Y →Q qbs_borel ⟹ qbs_meas_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_meas_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_meas_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_meas_eq_dest[OF 1] qbs_meas_eq_def qbs_meas_def in_Mx_def qbs_meas_axioms_def distr_return null_measure_distr)
  ultimately show "qbs_meas_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_meas) density_qbs:
  shows "f ∈ X →Q qbs_borel ⟹ density_qbs ⟦X,α, μ⟧meas f = ⟦X, α, density μ (f ∘ α)⟧meas"
  by (simp add: density_qbs.abs_eq)

lemma (in qbs_meas) density_qbs_meas: "qbs_meas X α (density μ (f ∘ α))"
  by (simp_all add: in_Mx_axioms mu_sets qbs_meas.intro qbs_meas_axioms_def)

lemma(in qbs_s_finite) density_qbs_s_finite:
  "f ∈ X →Q qbs_borel ⟹ qbs_s_finite X α (density μ (f ∘ α))"
  by(auto simp add: qbs_s_finite_def qbs_meas_def in_Mx_def qbs_meas_axioms_def mu_sets intro!: s_finite_measure_density)

lemma density_qbs_density_qbs_eq_all_meas:
  assumes [qbs]:"s ∈ qbs_space (all_meas_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_all_meas[OF assms(1)] obtain α μ
    where hs: "s = ⟦X, α, μ⟧meas" "qbs_meas X α μ" by metis
  then interpret qbs_meas X α μ by simp
  have "(λx. f (α x) * g (α x)) = (λx. f x * g x) ∘ α" by auto
  with assms(2,3) show ?thesis
    by(simp add: hs(1) density_qbs[OF assms(2)] qbs_meas.density_qbs[OF density_qbs_meas assms(3)]
                 density_qbs lr_adjunction_correspondence density_density_eq)
qed

lemmas density_qbs_density_qbs_eq = density_qbs_density_qbs_eq_all_meas[OF monadM_all_meas_space]

lemma qbs_l_density_qbs_all_meas:
  assumes [qbs,measurable]:"s ∈ qbs_space (all_meas_qbs X)" "f ∈ X →Q qbs_borel"
  shows "qbs_l (density_qbs s f) = density (qbs_l s) f"
proof -
  from rep_qbs_space_all_meas[OF assms(1)]
  obtain α μ where s: "s = ⟦X, α, μ⟧meas" "qbs_meas X α μ"
    by metis
  then interpret qbs_meas X α μ by simp
  have "(λx. f (α x)) = f ∘ α" by auto
  thus ?thesis
    by(simp add: s(1) qbs_l density_qbs qbs_meas.qbs_l[OF density_qbs_meas] density_distr)
qed

lemmas qbs_l_density_qbs = qbs_l_density_qbs_all_meas[OF monadM_all_meas_space]

corollary qbs_l_density_qbs_indicator_all_meas:
  assumes [qbs,measurable]:"s ∈ qbs_space (all_meas_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 (no_types, lifting) Collect_cong assms(2) qbs_pred_iff_sets space_L)
  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_all_meas[of _ X]
                  emeasure_density[of "indicator {x∈space (qbs_to_measure X). P x}" "qbs_l s",OF _ sets.top,simplified measurable_qbs_l_all_meas'[OF assms(1)],OF borel_measurable_indicator[OF predE],simplified space_L space_qbs_l_in_all_meas[OF assms(1)]]
                  qbs_pred_iff_measurable_pred nn_set_integral_space[of "qbs_l s",simplified space_qbs_l_in_all_meas[OF assms(1)]]
                  nn_integral_indicator[of _ "qbs_l s",simplified sets_qbs_l_all_meaures[OF assms(1)]])
qed

lemmas qbs_l_density_qbs_indicator = qbs_l_density_qbs_indicator_all_meas[OF monadM_all_meas_space]

lemma qbs_nn_integral_density_qbs_all_meas:
  assumes [qbs,measurable]:"s ∈ qbs_space (all_meas_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_all_meas[of _ X] measurable_qbs_l_all_meas'[OF assms(1)]  intro!: nn_integral_density)

lemmas qbs_nn_integral_density_qbs = qbs_nn_integral_density_qbs_all_meas[OF monadM_all_meas_space]

lemma qbs_integral_density_qbs_all_meas:
  fixes g :: "'a ⇒ 'b::{banach, second_countable_topology}" and f :: "'a ⇒ real"
  assumes [qbs,measurable]:"s ∈ qbs_space (all_meas_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_all_meas[of _ X] measurable_qbs_l_all_meas'[OF assms(1)]
                AEq_qbs_l intro!: integral_density)

lemmas qbs_integral_density_qbs = qbs_integral_density_qbs_all_meas[OF monadM_all_meas_space]

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⟧meas)" "α ∈ qbs_Mx X" "s_finite_kernel borel borel k" "⋀r. qbs_s_finite X α (k r)"
    by metis
  interpret qs: qbs_s_finite X α "k r" for r by fact
  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 ∘ α)⟧meas " for r
    using hk(4) by(auto simp add: hk(1) density_qbs.abs_eq)
  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_morphism':
  assumes [qbs,measurable]: "f ∈ X ⇒Q qbs_borel"
  shows "(λp. density_qbs p f) ∈ all_meas_qbs X ⇒Q all_meas_qbs X"
proof(rule qbs_morphismI)
  fix γ
  assume "γ ∈ qbs_Mx (all_meas_qbs X)"
  from rep_all_meas_qbs_Mx[OF this] obtain α k where ak:
    "γ = (λr. ⟦X, α, k r⟧meas)" "α ∈ qbs_Mx X" "measure_kernel borel borel k" "⋀r. qbs_meas X α (k r)"
    by blast
  interpret qbs_meas X α "k r" for r by fact
  show "(λp. density_qbs p f) ∘ γ ∈ qbs_Mx (all_meas_qbs X)"
   by(auto simp: all_meas_qbs_Mx density_qbs comp_def ak(1,3)
       intro!: exI[where x=α] exI[where x="λx. density (k x) (λr. f (α r))"] measure_kernel.density_measure_kernel' measurable_compose[OF α_measurable])
qed

lemma density_qbs_cong_AE_all_meas:
  assumes [qbs]: "s ∈ qbs_space (all_meas_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_all_meas[of X]])
  from assms(4) show "qbs_l (density_qbs s f) = qbs_l (density_qbs s g)"
    by(auto simp: qbs_l_density_qbs_all_meas[of _ X] measurable_qbs_l_all_meas'[OF assms(1)]
                  AEq_qbs_l lr_adjunction_correspondence[symmetric] intro!: density_cong)
qed(auto intro!: qbs_morphism_space[OF density_qbs_morphism'[OF assms(2)]] qbs_morphism_space[OF density_qbs_morphism'[OF assms(3)]])

lemmas density_qbs_cong_AE = density_qbs_cong_AE_all_meas[OF monadM_all_meas_space]

corollary density_qbs_cong_all_meas:
  assumes [qbs]: "s ∈ qbs_space (all_meas_qbs X)" "f ∈ 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_all_meas[of _ X] AEq_I2'[of _ X] cong: assms(3) qbs_morphism_cong[where g=f])

lemmas density_qbs_cong = density_qbs_cong_all_meas[OF monadM_all_meas_space]

lemma density_qbs_1[simp]: "density_qbs s (λx. 1) = s"
proof -
  obtain X where s[qbs]: "s ∈ qbs_space (all_meas_qbs X)"
    using in_qbs_space_of_all_meas by blast
  show ?thesis
    by(auto intro!: inj_onD[OF qbs_l_inj_all_meas _ _ s] qbs_morphism_space[OF density_qbs_morphism']
              simp: qbs_l_density_qbs_all_meas[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 (all_meas_qbs X)"
  shows normalize_qbs_all_meas: "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_all_meas: "qbs_l s (qbs_space X) = 0 ⟹ normalize_qbs s = qbs_null_measure X"
    and normalize_qbsinfty_all_meas: "qbs_l s (qbs_space X) = ∞ ⟹ normalize_qbs s = qbs_null_measure X"
  by(auto simp: qbs_space_of_in_all_meas[OF assms(1)] normalize_qbs_def)

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_all_meas:
  assumes "s ∈ qbs_space (all_meas_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_all_meas[OF assms]
proof -
  obtain α μ
    where hs: "s = ⟦X, α, μ⟧meas" "qbs_meas X α μ"
    using rep_qbs_space_all_meas assms(1) by meson
  interpret qs: qbs_meas X α μ by fact
  have "1 / emeasure μ (space μ) * emeasure μ (space μ) = 1"
    using assms(2,3) by(auto simp: hs(1) qs.qbs_l emeasure_distr[of _ _ "qbs_to_measure X",OF _ sets.top,simplified space_L] divide_eq_1_ennreal ennreal_divide_times)
  hence *: "prob_space (density μ (λx. 1 / emeasure (qbs_l s) (qbs_space X)))"
    by(auto intro!: prob_spaceI simp: emeasure_density hs(1) qs.qbs_l emeasure_distr[of _ _ "qbs_to_measure X",OF _ sets.top,simplified space_L] )
  have "density_qbs s (λx. 1 / emeasure (qbs_l s) (qbs_space X)) = density_qbs ⟦X, α, μ⟧meas (λx. 1 / emeasure (qbs_l s) (qbs_space X))"
    by(simp add: hs)
  also have "... ∈ qbs_space (monadP_qbs X)"
    using *
    by(auto simp: qs.density_qbs monadP_qbs_space
           qbs_meas.qbs_l[OF qs.density_qbs_meas,of "λx. 1 / emeasure (qbs_l s) (qbs_space X)",simplified]
           qbs_meas.qbs_space_of[OF qs.density_qbs_meas,of "λx. 1 / emeasure (qbs_l s) (qbs_space X)",simplified]
          intro!: prob_space.prob_space_distr)
  finally show "density_qbs s (λx. 1 / emeasure (qbs_l s) (qbs_space X)) ∈ qbs_space (monadP_qbs X)" .
qed

lemmas normalize_qbs_prob = normalize_qbs_prob_all_meas[OF monadM_all_meas_space]

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"
      and "⋀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 (all_meas_qbs X)"
    using in_qbs_space_of_all_meas by blast
  then have X: "qbs_space X ≠ {}"
    using all_meas_qbs_empty_iff by blast
  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_all_meas[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_all_meas[OF s] qbs_null_measure_null_measure[OF X])
  next
    case 3
    have "normalize_qbs s ∈ qbs_space (monadP_qbs X)"
      by(intro normalize_qbs_prob_all_meas) (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)
syntax_consts
  "_PiQ_measure" ⇌ PiQ_measure
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⟧meas" "⋀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⟧meas"  (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_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(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)"
  using measurable_space[OF assms]
  by(intro qbs_morphism_monadPI'[OF _ measure_with_args_morphism])
    (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] 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" "μ 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)] uniform_qbs_def)
  also have "... = ?rhs"
    by(rule qbs_l_qbs_l_inverse) (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] assms(2),symmetric] qbs_l_inverse_qbs_l assms)

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