Theory Differential_Privacy.Source_and_Sink_Algebras

(*
 Title: Source_and_Sink_Algebras.thy
 Author: Tetsuya Sato
*)

theory Source_and_Sink_Algebras
  imports
    "HOL-Analysis.Sigma_Algebra"
    "HOL-Analysis.Measure_Space"
begin

section ‹Meausrable Spaces form a Topological Concrete Category›

text ‹ This entry is based on the fact that the category Meas of measurable spaces and measurable functions forms a topological concrete category (see also, [Brümmer, Topology Appl. 1983], [Adamek, Herrlich and Strecker,1990]), where (i) for any family of functions from a set X to measurable spaces Y(i), the coarsest ‹σ›-algebra over X retracted from the ones Y(i) (initial lift) exists and (ii) for any family of functions from measurable spaces X(i) to Y, the finest ‹σ›-algebra over Y pushed out from the one of X(i) (called final lift) exists. All limits and colimits are given by initial and final lifts respectively. Due to the type system of Isabelle/HOL, the type of family in the construction of initial and final lifts are restricted. ›

subsection ‹Initial lift: the coarsest ‹σ›-algebra retracted from a family of functions ›

definition✐‹tag important› initial_source :: "'a set ⇒ (('a ⇒ 'b) × 'b measure) set ⇒ 'a measure" where
  "initial_source X F = sigma X {f -` A ∩ X | A f M. (f,M) ∈ F ∧ A ∈ sets M}"

text ‹ Roughly speaking, @{term F} is a structured source @{term"{(f,M) | f M. (f,M) ∈ F}"} having the common domain @{term X}. @{term"initial_source X F"} is the initial lift with respect to the source @{term"{(f,M) | f M. (f,M) ∈ F}"}›

text ‹ It is an extension of @{term vimage_algebra} that accepts a family of functions. ›

lemma vimage_algebra_to_initial_source:
  shows "vimage_algebra X f M = initial_source X {(f, M)}"
  unfolding vimage_algebra_def initial_source_def by auto

lemma space_initial_source [simp]:
  shows "space (initial_source X F) = X"
  unfolding initial_source_def by (rule space_measure_of) auto

lemma sets_initial_source:
  shows "sets (initial_source X F) = sigma_sets X {f -` A ∩ X | A f M. (f,M) ∈ F ∧ A ∈ sets M}"
  unfolding initial_source_def
  by (rule sets_measure_of) auto

lemma sets_initial_source_mono:
  assumes "∀ (f, M) ∈ F. ∀ A ∈ sets M. f -` A ∩ X ∈ (sigma_sets X {g -` A ∩ X | A g N. (g,N) ∈ G ∧ A ∈ sets N})"
  shows "sets (initial_source X F) ⊆ sets (initial_source X G)"
proof-
  have "{f -` A ∩ X | A f M. (f,M) ∈ F ∧ A ∈ sets M} ⊆ (sigma_sets X {g -` A ∩ X | A g N. (g,N) ∈ G ∧ A ∈ sets N})"
    using assms by auto
  hence "sigma_sets X {f -` A ∩ X | A f M. (f,M) ∈ F ∧ A ∈ sets M} ⊆ sigma_sets X {g -` A ∩ X | A g N. (g,N) ∈ G ∧ A ∈ sets N}"
    by (auto simp: sigma_sets_mono sigma_sets_subseteq sigma_sets_sigma_sets_eq)
  thus ?thesis
    by (auto simp: sets_initial_source)
qed

lemma sets_initial_source_cong:
  assumes "∀ (f, M) ∈ F. ∀ A ∈ sets M. f -` A ∩ X ∈ (sigma_sets X {g -` A ∩ X | A g N. (g,N) ∈ G ∧ A ∈ sets N})"
    and "∀ (g, N) ∈ G. ∀ B ∈ sets N. g -` B ∩ X ∈ (sigma_sets X {f -` A ∩ X | A f M. (f,M) ∈ F ∧ A ∈ sets M})"
  shows "sets (initial_source X F) = sets (initial_source X G)"
proof
  show "sets (initial_source X F) ⊆ sets (initial_source X G)"
    by (auto simp: sets_initial_source_mono[where X ="X", OF assms(1)])
  show "sets (initial_source X G) ⊆ sets (initial_source X F)"
    by (auto simp: sets_initial_source_mono[where X ="X", OF assms(2)])
qed

lemma initial_source_cong:
  assumes "X = Y"
    and "∀ (f, M) ∈ F. ∀ A ∈ sets M. f -` A ∩ X ∈ (sigma_sets X {g -` A ∩ X | A g N. (g,N) ∈ G ∧ A ∈ sets N})"
    and "∀ (g, N) ∈ G. ∀ B ∈ sets N. g -` B ∩ X ∈ (sigma_sets X {f -` A ∩ X | A f M. (f,M) ∈ F ∧ A ∈ sets M})"
  shows "(initial_source X F) = (initial_source Y G)"
proof(rule measure_eqI)
  show "sets (initial_source X F) = sets (initial_source Y G)"
    using sets_initial_source_cong assms by auto
  fix A assume "A ∈ sets (initial_source X F)"
  show "emeasure (initial_source X F) A = emeasure (initial_source Y G) A"
    unfolding initial_source_def by (auto simp: emeasure_sigma)
qed

proposition in_initial_source:
  shows "(f,M) ∈ F ⟹ A ∈ sets M ⟹ f -` A ∩ X ∈ sets (initial_source X F)"
  by (auto simp: initial_source_def)

text‹ Axiom of initial lift I: it makes the family measurable ›

proposition measurable_initial_source1[measurable(raw)]:
  shows "(f,M) ∈ F ⟹ f ∈ X → space M ⟹ f ∈ measurable (initial_source X F) M"
  unfolding measurable_def by (auto intro: in_initial_source)

text‹ Axiom of initial lift II: factorization ›

proposition measurable_initial_source2:
  assumes "g ∈ space N → X"
    and "∀(f,M) ∈ F. f ∈ X → space M"
    and "∀(f,M) ∈ F. (λx. f (g x)) ∈ measurable N M"
  shows "g ∈ measurable N (initial_source X F)"
  unfolding initial_source_def
proof (rule measurableI)
  fix x assume xinN: "x ∈ space N"
  show "g x ∈ space (sigma X {B. ∃A f M. B = f -` A ∩ X ∧ (f, M) ∈ F ∧ A ∈ sets M})"
    using assms(1) xinN space_measure_of_conv by fastforce
next fix B assume "B ∈ sets (sigma X {C. ∃A f M. C = f -` A ∩ X ∧ (f, M) ∈ F ∧ A ∈ sets M})"
  hence "B ∈ sigma_sets X {C. ∃A f M. C = f -` A ∩ X ∧ (f, M) ∈ F ∧ A ∈ sets M}"
    by (metis sets_initial_source initial_source_def)
  thus "g -` B ∩ space N ∈ sets N"
  proof(induction B rule: sigma_sets.induct)
    case (Basic a)
    then obtain A f M where"a = f -` A ∩ X ∧ (f, M) ∈ F ∧ A ∈ sets M"
      by auto
    hence prop1: "a = f -` A ∩ X" "f ∈ X → space M" "(λx. f (g x)) ∈ measurable N M" "A ∈ sets M"
      using assms by auto
    hence "g -` a ∩ space N = (λx. f (g x)) -` A ∩ space N"
      using assms(1) by auto
    also have "... ∈ sets N"
      using prop1 by (auto simp: measurable_sets)
    finally show ?case .
  next
    case Empty
    thus ?case by auto
  next
    case (Compl a)
    have "g -` (X - a) ∩ space N = (g -` X ∩ space N) - (g -` a ∩ space N)"
      by (auto simp: Diff_Int_distrib inf_commute vimage_Diff)
    also have "... = (space N) - (g -` a ∩ space N)"
      using assms(1) by auto
    also have "... ∈ sets N"
      by (auto simp: Compl.IH sets.compl_sets)
    finally show ?case .
  next
    case (Union a)
    have "g -` ⋃ (range a) ∩ space N =⋃ (range (λ i. ((g -` a i) ∩ space N)))"
      by auto
    also have "... ∈ sets N"
      using Union.IH by blast
    finally show ?case .
  qed
qed

text‹ The ‹σ›-algebra of a initial lift is the coarsest one that makes the family measurable. ›

lemma sets_image_in_sets_family:
  assumes N: "space N = X"
    and f: "∀(f, M)∈F. f ∈ N →M M"
  shows "sets (initial_source X F) ⊆ sets N"
  unfolding sets_initial_source N[symmetric]
proof
  fix A assume A: "A ∈ sigma_sets (space N) {f -` A ∩ (space N) | A f M. (f,M) ∈ F ∧ A ∈ sets M}"
  {
    fix A f M assume a0: "(f,M) ∈ F ∧ A ∈ sets M"
    hence "f ∈ measurable N M"using f by auto
    hence "f -` A ∩ (space N) ∈ sets N"using a0
      by (auto simp: measurable_sets)
  }
  hence "{f -` A ∩ (space N) | A f M. (f,M) ∈ F ∧ A ∈ sets M} ⊆ (sets N)"
    by auto
  with A have "A ∈ sigma_sets (space N) (sets N)"
    by (meson in_mono sigma_sets_subseteq)
  also have "... = (sets N)"
    by (auto simp: sets.sigma_sets_eq)
  finally show "A ∈ (sets N)".
qed

proposition initial_source_coarsest:
  assumes "∀(f, M)∈F. f ∈ X → space M"
  shows "sets (initial_source X F) = Inf{ sets N | N. space N = X  ∧ (∀(f, M)∈F. f ∈ N →M M) } "
proof(subst Inf_eqI)
  show "⋀i. i ∈ { sets N | N. space N = X  ∧ (∀(f, M)∈F. f ∈ N →M M) } ⟹ sets (initial_source X F) ⊆ i "
  proof-
    fix i assume " i ∈ { sets N | N. space N = X  ∧ (∀(f, M)∈F. f ∈ N →M M) }"
    then obtain N where i: "i = sets N" and N: "space N = X" and  f: " ∀(f, M)∈F. f ∈ N →M M"
      by auto
    show "sets (initial_source X F) ⊆ i"
      by(auto simp: i sets_image_in_sets_family[OF N f])
  qed
  have "⋀ f M. (f, M)∈F ⟹ f ∈ initial_source X F →M M"
    using assms measurable_initial_source1 by blast
  hence "sets (initial_source X F) ∈ {sets N |N. space N = X ∧ (∀(f, M)∈F. f ∈ N →M M)}"
    by(auto intro!: CollectI exI[of _ "(initial_source X F)" ])
  thus "⋀y. (⋀i. i ∈ {sets N |N. space N = X ∧ (∀(f, M)∈F. f ∈ N →M M)} ⟹ y ⊆ i) ⟹ y ⊆ sets (initial_source X F)" by auto
qed(auto)

text‹ An initial lift of a bundle of initial lifts is flatten to an initial lift. ›

lemma initial_source_initial_source_eq:
  assumes "∀ i ∈ I. G i ∈ Z → (Y i)"
    and "∀ i ∈ I. ∀ j ∈ J i. F i j ∈ Y i → space (M i j)"
  shows "initial_source Z {((G i), (initial_source (Y i) {((F i j),(M i j)) | j. j ∈ (J i)})) | i. i ∈ I} = initial_source Z {(((F i j) o (G i)),(M i j)) | i j. i ∈ I ∧ j ∈ (J i)}"
proof (rule measure_eqI)
  show "⋀A. A ∈ sets (initial_source Z {(G i, initial_source (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I}) ⟹ emeasure (initial_source Z {(G i, initial_source (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I}) A = emeasure (initial_source Z {(F i j ∘ G i, M i j) |i j. i ∈ I ∧ j ∈ J i}) A"
    by (auto simp: emeasure_sigma initial_source_def)
  show "sets (initial_source Z {(G i, initial_source (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I}) =
 sets (initial_source Z {(F i j ∘ G i, M i j) |i j. i ∈ I ∧ j ∈ J i})"
  proof
    show "sets (initial_source Z {(G i, initial_source (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I}) ⊆ sets (initial_source Z {(F i j ∘ G i, M i j) |i j. i ∈ I ∧ j ∈ J i})"
    proof(rule sets_image_in_sets_family)
      show "space (initial_source Z {(F i j ∘ G i, M i j) |i j. i ∈ I ∧ j ∈ J i}) = Z"
        by auto
      {
        fix i assume i: "i ∈ I"
        hence "G i ∈ initial_source Z {(F i j ∘ G i, M i j) |i j. i ∈ I ∧ j ∈ J i} →M initial_source (Y i) {(F i j, M i j) |j. j ∈ J i}"
        proof(intro measurable_initial_source2)
          show "G i ∈ space (initial_source Z {(F i j ∘ G i, M i j) |i j. i ∈ I ∧ j ∈ J i}) → Y i"
            using i assms(1) by auto
          show "∀(f, M)∈{(F i j, M i j) |j. j ∈ J i}. f ∈ Y i → space M"
            using assms(2) i by auto
          show "∀(f, N)∈{(F i j, M i j) |j. j ∈ J i}. (λx. f (G i x)) ∈ initial_source Z {(F i j ∘ G i, M i j) |i j. i ∈ I ∧ j ∈ J i} →M N"
          proof
            {
              fix j assume j: "j ∈ J i"
              hence "(λx. F i j(G i x)) ∈ initial_source Z {(F i j ∘ G i, M i j) |i j. i ∈ I ∧ j ∈ J i} →M M i j"
              proof(intro measurable_initial_source1)
                have "(F i j ∘ G i, M i j) ∈ {(F i j ∘ G i, M i j) |i j. i ∈ I ∧ j ∈ J i}"
                  using i j by blast
                thus "(λx. F i j (G i x), M i j) ∈ {(F i j ∘ G i, M i j) |i j. i ∈ I ∧ j ∈ J i}"
                  by(auto simp: comp_def)
                show "(λx. F i j (G i x)) ∈ Z → space (M i j)"
                  using assms by (auto simp: Pi_iff i j)
              qed
            }
            thus "⋀x. x ∈ {(F i j, M i j) |j. j ∈ J i} ⟹ case x of (f, N) ⇒ (λx. f (G i x)) ∈ initial_source Z {(F i j ∘ G i, M i j) |i j. i ∈ I ∧ j ∈ J i} →M N"
              by auto
          qed
        qed
      }
      thus "∀(f, N)∈{(G i, initial_source (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I}. f ∈ initial_source Z {(F i j ∘ G i, M i j) |i j. i ∈ I ∧ j ∈ J i} →M N"
        by force
    qed
    show "sets (initial_source Z {(F i j ∘ G i, M i j) |i j. i ∈ I ∧ j ∈ J i}) ⊆ sets (initial_source Z {(G i, initial_source (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I})"
    proof(rule sets_image_in_sets_family)
      show "space (initial_source Z {(G i, initial_source (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I}) = Z"
        by auto
      {
        fix i j assume ij: "i ∈ I ∧ j ∈ J i"
        have measFij: "(F i j) ∈ initial_source (Y i) {(F i j, M i j) |j. j ∈ J i} →M M i j"
        proof(intro measurable_initial_source1)
          show "(F i j, M i j) ∈ {(F i j, M i j) |j. j ∈ J i}"
            using ij by auto
          show "F i j ∈ Y i → space (M i j)"
            using ij assms(2) by auto
        qed
        have measGi: "G i ∈ initial_source Z {(G i, initial_source (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I} →M initial_source (Y i) {(F i j, M i j) |j. j ∈ J i}"
        proof(intro measurable_initial_source1)
          show "(G i, initial_source (Y i) {(F i j, M i j) |j. j ∈ J i}) ∈ {(G i, initial_source (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I}"
            using ij by auto
          show "G i ∈ Z → space (initial_source (Y i) {(F i j, M i j) |j. j ∈ J i})"
            using ij assms(1) by auto
        qed
        from measFij measGi
        have "F i j ∘ G i ∈ initial_source Z {(G i, initial_source (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I} →M M i j"
          by(auto simp: measurable_comp)
      }
      thus "∀(f, N)∈{(F i j ∘ G i, M i j) |i j. i ∈ I ∧ j ∈ J i}. f ∈ initial_source Z {(G i, initial_source (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I} →M N"
        by blast
    qed
  qed
qed

subsection ‹Final lift: the finest ‹σ›-algebra pushed out from a family of functions›

definition✐‹tag important› final_sink :: "'b set ⇒ (('a ⇒ 'b) × 'a measure) set ⇒ 'b measure" where
  "final_sink Y G = sigma Y {A | A. A ∈ Pow Y ∧ (∀ (g,N) ∈ G. (g -` A ∩ (space N) ∈ sets N))}"

text ‹ Roughly speaking, @{term G} is a structured sink @{term"{(g,N) | g N. (g,N) ∈ G}"} having the common codomain @{term Y}. @{term"final_sink Y G"} is the final lift with respect to the sink @{term"{(g,N) | g N. (g,N) ∈ G}"}.›

lemma space_final_sink [simp]:
  shows "space (final_sink Y G) = Y"
  unfolding final_sink_def by (auto simp: space_measure_of_conv)

lemma sets_final_sink:
  shows "sets (final_sink Y G) = sigma_sets Y {A | A. A ∈ Pow Y ∧ (∀ (g,N) ∈ G. (g -` A ∩ (space N)∈ sets N))}"
  unfolding final_sink_def by (auto simp: subset_eq)

lemma sets_final_sink2:
  assumes g: "∀(g,N) ∈ G . g ∈ space N → Y"
  shows "sigma_sets Y {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)} = {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)}"
proof-
  have "sigma_algebra Y {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)}"
  proof
    show inclfam: "{A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)} ⊆ Pow Y"
      by auto
    show empty: "{} ∈ {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)}"
      by auto
    {
      fix g N assume "(g, N)∈G"
      hence "g ∈ space N → Y"using g
        by auto
      hence "g -` Y ∩ space N = space N"
        by auto
      hence "g -` Y ∩ space N ∈ sets N"
        by auto
    }
    thus "Y ∈ {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)}"
      by auto
    fix A B assume ABgN: "A ∈ {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)}"
      "B ∈ {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)}"
    hence AB: "A ∈ Pow Y" "B ∈ Pow Y" "⋀g N .(g, N)∈G ⟹ g -` A ∩ space N ∈ sets N ∧ g -` B ∩ space N ∈ sets N"
      by auto
    {
      fix g N assume G: "(g, N)∈G"
      from AB G have IntinN: "g -` (A ∩ B) ∩ space N ∈ sets N"
        by (metis Int_assoc imageI sets_restrict_space sets_restrict_space_iff vimage_Int)
      from AB G have UnioninN: "g -` (A ∪ B) ∩ space N ∈ sets N"
        by (auto simp: boolean_algebra.conj_disj_distrib2 sets.Un)
      from AB G have MinusinN: "g -` (A - B) ∩ space N ∈ sets N"
        by (auto simp: Diff_Int_distrib2 sets.Diff vimage_Diff)
      note IntinN UnioninN MinusinN
    } note ABbinary = this
    show "A ∩ B ∈ {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)}"
      using AB(1,2) ABbinary(1) by auto
    show "A ∪ B ∈ {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)}"
      using AB(1,2) ABbinary(2) by auto
    have "A - B ∈ {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)}"
      using AB(1,2) ABbinary(3) by auto
    hence "{A - B,{}}⊆ {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)} ∧ finite {A - B,{}} ∧ disjoint {A - B,{}} ∧ A - B = ⋃ {A - B,{}}"
      by (auto simp: inclfam empty pairwise_insert)
    thus "∃C ⊆ {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)}. finite C ∧ disjoint C ∧ A - B = ⋃ C"
      by(intro exI)
  next fix W :: "nat ⇒ _" assume W: "range W ⊆ {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)}"
    {
      fix g N assume G: "(g, N)∈G"
      have Wi: "∀ i. W i ∈ Pow Y ∧ W i ∈ {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)}"
        using W by blast
      hence UWPow: "(⋃ (range W)) ∈ Pow Y"by auto
      from Wi have Wimeas: "∀ i. W i ∈ Pow Y ∧ g -` (W i) ∩ space N ∈ sets N"
        using G by blast
      have "g -` (⋃ (range W)) ∩ space N = ⋃(range (λ i. g -` (W i) ∩ space N))"
        by auto
      hence "g -` (⋃ (range W)) ∩ space N = ⋃(range (λ i. g -` (W i) ∩ space N))"
        by auto
      also have "... ∈ sets N"
        using Wimeas by blast
      finally have UWg: "g -` (⋃ (range W)) ∩ space N ∈ sets N".
      note * = UWPow UWg
    } note WiUnion = this
    thus "⋃ (range W) ∈ {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)}"
      using Collect_mono_iff Pow_def W by auto
  qed
  thus "sigma_sets Y {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)} = {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)}"
    by (auto simp: sigma_algebra.sigma_sets_eq)
qed

lemma ✐‹tag important› sets_final_sink':
  assumes g: "∀(g,N) ∈ G . g ∈ space N → Y"
  shows "sets (final_sink Y G) = {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)}"
  using sets_final_sink sets_final_sink2[OF assms] by auto

lemma set_final_sink_mono:
  assumes "⋀A. A ∈ Pow Y ⟹ (∀ (f, M) ∈ F. (f -` A ∩ (space M)∈ sets M)) ⟹ A ∈ sigma_sets Y {A | A. A ∈ Pow Y ∧ (∀ (g,N) ∈ G. (g -` A ∩ (space N)∈ sets N))}"
  shows "sets (final_sink Y F) ⊆ sets (final_sink Y G)"
proof-
  have "{A | A. A ∈ Pow Y ∧ (∀ (f,M) ∈ F. (f -` A ∩ (space M)∈ sets M))} ⊆ sigma_sets Y {A | A. A ∈ Pow Y ∧ (∀ (g,N) ∈ G. (g -` A ∩ (space N)∈ sets N))}"
    using assms by auto
  hence "sigma_sets Y{A | A. A ∈ Pow Y ∧ (∀ (f,M) ∈ F. (f -` A ∩ (space M)∈ sets M))} ⊆ sigma_sets Y {A | A. A ∈ Pow Y ∧ (∀ (g,N) ∈ G. (g -` A ∩ (space N)∈ sets N))}"
    by (meson sigma_sets_mono)
  thus "sets (final_sink Y F) ⊆ sets (final_sink Y G)"
    unfolding final_sink_def
    by (metis sets_final_sink final_sink_def)
qed

lemma set_final_sink_cong:
  assumes "⋀A. A ∈ Pow Y ⟹ (∀ (g, N) ∈ G. (g -` A ∩ (space N)∈ sets N))⟹ A ∈ sigma_sets Y{A | A. A ∈ Pow Y ∧ (∀ (f,M) ∈ F. (f -` A ∩ (space M)∈ sets M))}"
    and "⋀A. A ∈ Pow Y ⟹ (∀ (f, M) ∈ F. (f -` A ∩ (space M)∈ sets M)) ⟹ A ∈ sigma_sets Y {A | A. A ∈ Pow Y ∧ (∀ (g,N) ∈ G. (g -` A ∩ (space N)∈ sets N))}"
  shows "sets (final_sink Y G) = sets (final_sink Y F)"
proof
  show "sets (final_sink Y G) ⊆ sets (final_sink Y F)"
    using set_final_sink_mono assms(1) by auto
  show "sets (final_sink Y F) ⊆ sets (final_sink Y G)"
    using set_final_sink_mono assms(2) by auto
qed

lemma final_sink_cong:
  assumes "X = Y"
    and "⋀A. A ∈ Pow Y ⟹ (∀ (g, N) ∈ G. (g -` A ∩ (space N)∈ sets N))⟹ A ∈ sigma_sets Y{A | A. A ∈ Pow Y ∧ (∀ (f,M) ∈ F. (f -` A ∩ (space M)∈ sets M))}"
    and "⋀A. A ∈ Pow Y ⟹ (∀ (f, M) ∈ F. (f -` A ∩ (space M)∈ sets M)) ⟹ A ∈ sigma_sets Y {A | A. A ∈ Pow Y ∧ (∀ (g,N) ∈ G. (g -` A ∩ (space N)∈ sets N))}"
  shows "(final_sink Y G) = (final_sink X F)"
proof(rule measure_eqI)
  show "sets (final_sink Y G) = sets (final_sink X F)"
    unfolding assms(1) by(subst set_final_sink_cong[OF assms(2,3)],auto)
  fix A assume "A ∈ sets (final_sink Y G)"
  show "emeasure (final_sink Y G) A = emeasure (final_sink X F) A"
    unfolding final_sink_def
    by (auto simp: emeasure_sigma)
qed

lemma in_final_sink:
  shows "∀(g,N) ∈ G . g ∈ space N → Y ⟹ (g,N) ∈ G ⟹ A ∈ sets (final_sink Y G) ⟹ ((g -` A ∩ (space N))∈ sets N)"
  by (metis (mono_tags, lifting) case_prodD mem_Collect_eq sets_final_sink sets_final_sink2)

text ‹ Axiom of final lift I: it makes the family measurable ›

lemma measurable_final_sink1[measurable(raw)]:
  shows "∀(g,N) ∈ G . g ∈ space N → Y ⟹ (g,N) ∈ G ⟹ g ∈ N →M (final_sink Y G)"
  unfolding measurable_def by (auto intro: in_final_sink)

text ‹ Axiom of final lift II: factorization ›

lemma measurable_final_sink2:
  assumes "f ∈ Y → space M"
    and "∀(g,N) ∈ G . g ∈ space N → Y"
    and "∀(g,N) ∈ G . (λx. f (g x)) ∈ N →M M"
  shows "f ∈ (final_sink Y G) →M M"
  unfolding final_sink_def
proof (rule measurableI)
  have Ysp: "space (sigma Y {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)}) = Y"
    by (auto simp: space_measure_of_conv)
  show "⋀x. x ∈ space (sigma Y {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)}) ⟹ f x ∈ space M"
    using assms Ysp by auto
  fix A assume A: "A ∈ sets M"
  {
    fix g N assume gN: "(g,N) ∈ G"
    hence *: "g ∈ space N → Y" "(λx. f (g x)) ∈ N →M M"
      using assms(2,3) by auto
    hence eq1: "g -` Y ∩ space N = space N"
      by auto
    from * A have "g -`(f -` A ∩ Y) = (λx. f (g x))-` A ∩g -`Y"
      by auto
    with eq1 have "g -`(f -` A ∩ Y) ∩ space N = (λx. f (g x))-` A ∩ space N"
      by (auto simp: inf_assoc)
  }note ** = this

  hence "f -` A ∩ Y ∈ {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)}"
    using A assms(3) measurable_sets by fastforce
  also have "... ⊆ sets (sigma Y {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)})"
    by auto
  finally have eq2: "f -` A ∩ Y ∈ sets (sigma Y {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)})".

  have eq3: "f -` A ∩ space (sigma Y {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)}) = f -` A ∩ Y"
    using Ysp by auto
  from eq2 eq3 show "f -` A ∩ space (sigma Y {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)}) ∈ sets (sigma Y {A |A. A ∈ Pow Y ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)})"
    by auto
qed

text‹ The ‹σ›-algebra of a final lift is finest one that it makes the family measurable. ›

lemma sets_vimage_in_set_family:
  assumes M: "space M = Y"
    and g: "∀(g,N) ∈ G . g ∈ N →M M"
  shows "sets M ⊆ sets (final_sink Y G)"
  unfolding sets_final_sink M[symmetric]
proof
  fix B assume "B ∈ sets M"
  with g M have "B ∈ Pow (space M) ∧ (∀(g, N)∈G. g -` B ∩ space N ∈ sets N)"
    by (metis (no_types, lifting) Pow_iff case_prodD case_prodI2 measurable_sets sets.sets_into_space)
  thus "B ∈ sigma_sets (space M) {A |A. A ∈ Pow (space M) ∧ (∀(g, N)∈G. g -` A ∩ space N ∈ sets N)}"
    by auto
qed

proposition final_sink_finest:
  assumes "∀(g, N)∈G. g ∈ space N → Y"
  shows "sets (final_sink Y G) = Sup{ sets M | M. space M = Y ∧ (∀(g, N)∈G. g ∈ N →M M ) } "
proof(subst Sup_eqI)
  show " ⋀y. y ∈ {sets M |M. space M = Y ∧ (∀(g, N)∈G. g ∈ N →M M)} ⟹ y ⊆  sets  (final_sink Y G)"
  proof-
    fix y assume " y ∈ {sets M |M. space M = Y ∧ (∀(g, N)∈G. g ∈ N →M M)}"
    then obtain M where y: "y = sets M" and M: "space M = Y" and g: "∀(g, N)∈G. g ∈ N →M M"
      by auto
    show "y ⊆  sets  (final_sink Y G)"
      by(auto simp: y sets_vimage_in_set_family[OF M g])
  qed
  have "∀(g, N)∈G. g ∈ N →M (final_sink Y G)"
    using measurable_final_sink1 assms by blast
  hence "(sets (final_sink Y G)) ∈ {sets M |M. space M = Y ∧ (∀(g, N)∈G. g ∈ N →M M)}"
    by(intro CollectI exI[of _ "(final_sink Y G)"],auto)
  thus "⋀y. (⋀z. z ∈ {sets M |M. space M = Y ∧ (∀(g, N)∈G. g ∈ N →M M)} ⟹ z ⊆ y) ⟹ sets (final_sink Y G) ⊆ y"
    by auto
qed(auto)

text‹ A final lift of a bundle of final lifts is flatten to a final lift. ›

lemma final_sink_final_sink_eq:
  assumes "∀ i ∈ I. G i ∈ (Y i) → Z"
    and "∀ i ∈ I. ∀ j ∈ J i. F i j ∈ space (M i j) → (Y i)"
  shows "final_sink Z {((G i), (final_sink (Y i) {((F i j),(M i j)) | j. j ∈ (J i)})) | i. i ∈ I} = final_sink Z {((G i) o (F i j), (M i j)) | i j. i ∈ I ∧ j ∈ (J i)}"
proof (rule measure_eqI)
  show "⋀A. A ∈ sets (final_sink Z {(G i, final_sink (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I}) ⟹ emeasure (final_sink Z {(G i, final_sink (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I}) A = emeasure (final_sink Z {(G i ∘ F i j, M i j) |i j. i ∈ I ∧ j ∈ J i}) A"
    unfolding final_sink_def by (auto simp: emeasure_sigma)
  show "sets (final_sink Z {(G i, final_sink (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I}) = sets (final_sink Z {(G i ∘ F i j, M i j) |i j. i ∈ I ∧ j ∈ J i})"
  proof
    show "sets (final_sink Z {(G i, final_sink (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I}) ⊆ sets (final_sink Z {(G i ∘ F i j, M i j) |i j. i ∈ I ∧ j ∈ J i})"
    proof(rule sets_vimage_in_set_family)
      show "space (final_sink Z {(G i, final_sink (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I}) = Z"
        by auto
      {
        fix i j assume i: "i ∈ I" and j: "j ∈ J i"
        hence measFij: "F i j ∈ M i j →M final_sink (Y i) {(F i j, M i j) |j. j ∈ J i}"
        proof(intro measurable_final_sink1)
          show "∀(g, N)∈{(F i j, M i j) |j. j ∈ J i}. g ∈ space N → Y i"
            using assms(2) i by blast
          show "(F i j, M i j) ∈ {(F i j, M i j) |j. j ∈ J i}"
            using j by auto
        qed
        from i j have measGi: "G i ∈ final_sink (Y i) {(F i j, M i j) |j. j ∈ J i} →M final_sink Z {(G i, final_sink (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I}"
        proof(intro measurable_final_sink1)
          show "∀(g, N)∈{(G i, final_sink (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I}. g ∈ space N → Z"
          proof
            show "⋀x. x ∈ {(G i, final_sink (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I} ⟹ case x of (g, N) ⇒ g ∈ space N → Z"
              using assms(1) by fastforce
          qed
          show "(G i, final_sink (Y i) {(F i j, M i j) |j. j ∈ J i}) ∈ {(G i, final_sink (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I}"
            using i by auto
        qed
        from measFij measGi
        have "G i ∘ F i j ∈ M i j →M final_sink Z {(G i, final_sink (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I}"
          by (auto simp: measurable_comp)
      }
      thus "∀(g, N)∈{(G i ∘ F i j, M i j) |i j. i ∈ I ∧ j ∈ J i}. g ∈ N →M final_sink Z {(G i, final_sink (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I}"
        by blast
    qed
    show "sets (final_sink Z {(G i ∘ F i j, M i j) |i j. i ∈ I ∧ j ∈ J i}) ⊆ sets (final_sink Z {(G i, final_sink (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I})"
    proof(rule sets_vimage_in_set_family)
      show "space (final_sink Z {(G i ∘ F i j, M i j) |i j. i ∈ I ∧ j ∈ J i}) = Z"
        by auto
      {
        fix i assume i: "i ∈ I"
        have "G i ∈ final_sink (Y i) {(F i j, M i j) |j. j ∈ J i} →M final_sink Z {(G i ∘ F i j, M i j) |i j. i ∈ I ∧ j ∈ J i}"
        proof(rule measurable_final_sink2)
          show "G i ∈ Y i → space (final_sink Z {(G i ∘ F i j, M i j) |i j. i ∈ I ∧ j ∈ J i})"
            using i assms(1) by auto
          show "∀(g, N)∈{(F i j, M i j) |j. j ∈ J i}. g ∈ space N → Y i"
            using assms(2) i by blast
          show "∀(g, N)∈{(F i j, M i j) |j. j ∈ J i}. (λx. G i (g x)) ∈ N →M final_sink Z {(G i ∘ F i j, M i j) |i j. i ∈ I ∧ j ∈ J i}"
          proof(clarify)
            fix j assume j: "j ∈ J i"
            thus "(λx. G i (F i j x)) ∈ M i j →M final_sink Z {(G i ∘ F i j, M i j) |i j. i ∈ I ∧ j ∈ J i}"
            proof(intro measurable_final_sink1)
              show "∀(g, N)∈{(G i ∘ F i j, M i j) |i j. i ∈ I ∧ j ∈ J i}. g ∈ space N → Z"
                using assms by fastforce
              show "(λx. G i (F i j x), M i j) ∈ {(G i ∘ F i j, M i j) |i j. i ∈ I ∧ j ∈ J i}"
                using i j comp_def[THEN sym] by blast
            qed
          qed
        qed
      }
      thus "∀(g, N)∈{(G i, final_sink (Y i) {(F i j, M i j) |j. j ∈ J i}) |i. i ∈ I}. g ∈ N →M final_sink Z {(G i ∘ F i j, M i j) |i j. i ∈ I ∧ j ∈ J i}"
        by blast
    qed
  qed
qed

end