/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import measure_theory.measure.giry_monad
import dynamics.ergodic.measure_preserving
import measure_theory.integral.set_integral

/-!
# The product measure

In this file we define and prove properties about the binary product measure. If `α` and `β` have
σ-finite measures `μ` resp. `ν` then `α × β` can be equipped with a σ-finite measure `μ.prod ν` that
satisfies `(μ.prod ν) s = ∫⁻ x, ν {y | (x, y) ∈ s} ∂μ`.
We also have `(μ.prod ν) (s.prod t) = μ s * ν t`, i.e. the measure of a rectangle is the product of
the measures of the sides.

We also prove Tonelli's theorem and Fubini's theorem.

## Main definition

* `measure_theory.measure.prod`: The product of two measures.

## Main results

* `measure_theory.measure.prod_apply` states `μ.prod ν s = ∫⁻ x, ν {y | (x, y) ∈ s} ∂μ`
  for measurable `s`. `measure_theory.measure.prod_apply_symm` is the reversed version.
* `measure_theory.measure.prod_prod` states `μ.prod ν (s.prod t) = μ s * ν t` for measurable sets
  `s` and `t`.
* `measure_theory.lintegral_prod`: Tonelli's theorem. It states that for a measurable function
  `α × β → ℝ≥0∞` we have `∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ x, ∫⁻ y, f (x, y) ∂ν ∂μ`. The version
  for functions `α → β → ℝ≥0∞` is reversed, and called `lintegral_lintegral`. Both versions have
  a variant with `_symm` appended, where the order of integration is reversed.
  The lemma `measurable.lintegral_prod_right'` states that the inner integral of the right-hand side
  is measurable.
* `measure_theory.integrable_prod_iff` states that a binary function is integrable iff both
  * `y ↦ f (x, y)` is integrable for almost every `x`, and
  * the function `x ↦ ∫ ∥f (x, y)∥ dy` is integrable.
* `measure_theory.integral_prod`: Fubini's theorem. It states that for a integrable function
  `α × β → E` (where `E` is a second countable Banach space) we have
  `∫ z, f z ∂(μ.prod ν) = ∫ x, ∫ y, f (x, y) ∂ν ∂μ`. This theorem has the same variants as
  Tonelli's theorem. The lemma `measure_theory.integrable.integral_prod_right` states that the
  inner integral of the right-hand side is integrable.

## Implementation Notes

Many results are proven twice, once for functions in curried form (`α → β → γ`) and one for
functions in uncurried form (`α × β → γ`). The former often has an assumption
`measurable (uncurry f)`, which could be inconvenient to discharge, but for the latter it is more
common that the function has to be given explicitly, since Lean cannot synthesize the function by
itself. We name the lemmas about the uncurried form with a prime.
Tonelli's theorem and Fubini's theorem have a different naming scheme, since the version for the
uncurried version is reversed.

## Tags

product measure, Fubini's theorem, Tonelli's theorem, Fubini-Tonelli theorem
-/

noncomputable theory
open_locale classical topological_space ennreal measure_theory
open set function real ennreal
open measure_theory measurable_space measure_theory.measure
open topological_space (hiding generate_from)
open filter (hiding prod_eq map)

variables {α α' β β' γ E : Type*}

/-- Rectangles formed by π-systems form a π-system. -/
lemma is_pi_system.prod {C : set (set α)} {D : set (set β)} (hC : is_pi_system C)
  (hD : is_pi_system D) : is_pi_system (image2 set.prod C D) :=
begin
  rintro _ _ ⟨s₁, t₁, hs₁, ht₁, rfl⟩ ⟨s₂, t₂, hs₂, ht₂, rfl⟩ hst,
  rw [prod_inter_prod] at hst ⊢, rw [prod_nonempty_iff] at hst,
  exact mem_image2_of_mem (hC _ _ hs₁ hs₂ hst.1) (hD _ _ ht₁ ht₂ hst.2)
end

/-- Rectangles of countably spanning sets are countably spanning. -/
lemma is_countably_spanning.prod {C : set (set α)} {D : set (set β)}
  (hC : is_countably_spanning C) (hD : is_countably_spanning D) :
  is_countably_spanning (image2 set.prod C D) :=
begin
  rcases ⟨hC, hD⟩ with ⟨⟨s, h1s, h2s⟩, t, h1t, h2t⟩,
  refine ⟨λ n, (s n.unpair.1).prod (t n.unpair.2), λ n, mem_image2_of_mem (h1s _) (h1t _), _⟩,
  rw [Union_unpair_prod, h2s, h2t, univ_prod_univ]
end

variables [measurable_space α] [measurable_space α'] [measurable_space β] [measurable_space β']
variables [measurable_space γ]
variables {μ : measure α} {ν : measure β} {τ : measure γ}
variables [normed_group E] [measurable_space E]

/-! ### Measurability

Before we define the product measure, we can talk about the measurability of operations on binary
functions. We show that if `f` is a binary measurable function, then the function that integrates
along one of the variables (using either the Lebesgue or Bochner integral) is measurable.
-/

/-- The product of generated σ-algebras is the one generated by rectangles, if both generating sets
  are countably spanning. -/
lemma generate_from_prod_eq {α β} {C : set (set α)} {D : set (set β)}
  (hC : is_countably_spanning C) (hD : is_countably_spanning D) :
  @prod.measurable_space _ _ (generate_from C) (generate_from D) =
    generate_from (image2 set.prod C D) :=
begin
  apply le_antisymm,
  { refine sup_le _ _; rw [comap_generate_from];
      apply generate_from_le; rintro _ ⟨s, hs, rfl⟩,
    { rcases hD with ⟨t, h1t, h2t⟩,
      rw [← prod_univ, ← h2t, prod_Union],
      apply measurable_set.Union,
      intro n, apply measurable_set_generate_from,
      exact ⟨s, t n, hs, h1t n, rfl⟩ },
    { rcases hC with ⟨t, h1t, h2t⟩,
      rw [← univ_prod, ← h2t, Union_prod_const],
      apply measurable_set.Union,
      rintro n, apply measurable_set_generate_from,
      exact mem_image2_of_mem (h1t n) hs } },
  { apply generate_from_le, rintro _ ⟨s, t, hs, ht, rfl⟩, rw [prod_eq],
    apply (measurable_fst _).inter (measurable_snd _),
    { exact measurable_set_generate_from hs },
    { exact measurable_set_generate_from ht } }
end

/-- If `C` and `D` generate the σ-algebras on `α` resp. `β`, then rectangles formed by `C` and `D`
  generate the σ-algebra on `α × β`. -/
lemma generate_from_eq_prod {C : set (set α)} {D : set (set β)} (hC : generate_from C = ‹_›)
  (hD : generate_from D = ‹_›) (h2C : is_countably_spanning C) (h2D : is_countably_spanning D) :
    generate_from (image2 set.prod C D) = prod.measurable_space :=
by rw [← hC, ← hD, generate_from_prod_eq h2C h2D]

/-- The product σ-algebra is generated from boxes, i.e. `s.prod t` for sets `s : set α` and
  `t : set β`. -/
lemma generate_from_prod :
  generate_from (image2 set.prod {s : set α | measurable_set s} {t : set β | measurable_set t}) =
  prod.measurable_space :=
generate_from_eq_prod generate_from_measurable_set generate_from_measurable_set
  is_countably_spanning_measurable_set is_countably_spanning_measurable_set

/-- Rectangles form a π-system. -/
lemma is_pi_system_prod :
  is_pi_system (image2 set.prod {s : set α | measurable_set s} {t : set β | measurable_set t}) :=
is_pi_system_measurable_set.prod is_pi_system_measurable_set

/-- If `ν` is a finite measure, and `s ⊆ α × β` is measurable, then `x ↦ ν { y | (x, y) ∈ s }` is
  a measurable function. `measurable_measure_prod_mk_left` is strictly more general. -/
lemma measurable_measure_prod_mk_left_finite [is_finite_measure ν] {s : set (α × β)}
  (hs : measurable_set s) : measurable (λ x, ν (prod.mk x ⁻¹' s)) :=
begin
  refine induction_on_inter generate_from_prod.symm is_pi_system_prod _ _ _ _ hs,
  { simp [measurable_zero, const_def] },
  { rintro _ ⟨s, t, hs, ht, rfl⟩, simp only [mk_preimage_prod_right_eq_if, measure_if],
    exact measurable_const.indicator hs },
  { intros t ht h2t,
    simp_rw [preimage_compl, measure_compl (measurable_prod_mk_left ht) (measure_ne_top ν _)],
    exact h2t.const_sub _ },
  { intros f h1f h2f h3f, simp_rw [preimage_Union],
    have : ∀ b, ν (⋃ i, prod.mk b ⁻¹' f i) = ∑' i, ν (prod.mk b ⁻¹' f i) :=
      λ b, measure_Union (λ i j hij, disjoint.preimage _ (h1f i j hij))
        (λ i, measurable_prod_mk_left (h2f i)),
    simp_rw [this], apply measurable.ennreal_tsum h3f },
end

/-- If `ν` is a σ-finite measure, and `s ⊆ α × β` is measurable, then `x ↦ ν { y | (x, y) ∈ s }` is
  a measurable function. -/
lemma measurable_measure_prod_mk_left [sigma_finite ν] {s : set (α × β)}
  (hs : measurable_set s) : measurable (λ x, ν (prod.mk x ⁻¹' s)) :=
begin
  have : ∀ x, measurable_set (prod.mk x ⁻¹' s) := λ x, measurable_prod_mk_left hs,
  simp only [← @supr_restrict_spanning_sets _ _ ν, this],
  apply measurable_supr, intro i,
  haveI := fact.mk (measure_spanning_sets_lt_top ν i),
  exact measurable_measure_prod_mk_left_finite hs
end

/-- If `μ` is a σ-finite measure, and `s ⊆ α × β` is measurable, then `y ↦ μ { x | (x, y) ∈ s }` is
  a measurable function. -/
lemma measurable_measure_prod_mk_right {μ : measure α} [sigma_finite μ] {s : set (α × β)}
  (hs : measurable_set s) : measurable (λ y, μ ((λ x, (x, y)) ⁻¹' s)) :=
measurable_measure_prod_mk_left (measurable_set_swap_iff.mpr hs)

lemma measurable.map_prod_mk_left [sigma_finite ν] : measurable (λ x : α, map (prod.mk x) ν) :=
begin
  apply measurable_of_measurable_coe, intros s hs,
  simp_rw [map_apply measurable_prod_mk_left hs],
  exact measurable_measure_prod_mk_left hs
end

lemma measurable.map_prod_mk_right {μ : measure α} [sigma_finite μ] :
  measurable (λ y : β, map (λ x : α, (x, y)) μ) :=
begin
  apply measurable_of_measurable_coe, intros s hs,
  simp_rw [map_apply measurable_prod_mk_right hs],
  exact measurable_measure_prod_mk_right hs
end

/-- The Lebesgue integral is measurable. This shows that the integrand of (the right-hand-side of)
  Tonelli's theorem is measurable. -/
lemma measurable.lintegral_prod_right' [sigma_finite ν] :
  ∀ {f : α × β → ℝ≥0∞} (hf : measurable f), measurable (λ x, ∫⁻ y, f (x, y) ∂ν) :=
begin
  have m := @measurable_prod_mk_left,
  refine measurable.ennreal_induction _ _ _,
  { intros c s hs, simp only [← indicator_comp_right],
    suffices : measurable (λ x, c * ν (prod.mk x ⁻¹' s)),
    { simpa [lintegral_indicator _ (m hs)] },
    exact (measurable_measure_prod_mk_left hs).const_mul _ },
  { rintro f g - hf hg h2f h2g, simp_rw [pi.add_apply, lintegral_add (hf.comp m) (hg.comp m)],
    exact h2f.add h2g },
  { intros f hf h2f h3f,
    have := measurable_supr h3f,
    have : ∀ x, monotone (λ n y, f n (x, y)) := λ x i j hij y, h2f hij (x, y),
    simpa [lintegral_supr (λ n, (hf n).comp m), this] }
end

/-- The Lebesgue integral is measurable. This shows that the integrand of (the right-hand-side of)
  Tonelli's theorem is measurable.
  This version has the argument `f` in curried form. -/
lemma measurable.lintegral_prod_right [sigma_finite ν] {f : α → β → ℝ≥0∞}
  (hf : measurable (uncurry f)) : measurable (λ x, ∫⁻ y, f x y ∂ν) :=
hf.lintegral_prod_right'

/-- The Lebesgue integral is measurable. This shows that the integrand of (the right-hand-side of)
  the symmetric version of Tonelli's theorem is measurable. -/
lemma measurable.lintegral_prod_left' [sigma_finite μ] {f : α × β → ℝ≥0∞}
  (hf : measurable f) : measurable (λ y, ∫⁻ x, f (x, y) ∂μ) :=
(measurable_swap_iff.mpr hf).lintegral_prod_right'

/-- The Lebesgue integral is measurable. This shows that the integrand of (the right-hand-side of)
  the symmetric version of Tonelli's theorem is measurable.
  This version has the argument `f` in curried form. -/
lemma measurable.lintegral_prod_left [sigma_finite μ] {f : α → β → ℝ≥0∞}
  (hf : measurable (uncurry f)) : measurable (λ y, ∫⁻ x, f x y ∂μ) :=
hf.lintegral_prod_left'

lemma measurable_set_integrable [sigma_finite ν] [opens_measurable_space E] ⦃f : α → β → E⦄
  (hf : measurable (uncurry f)) : measurable_set { x | integrable (f x) ν } :=
begin
  simp_rw [integrable, hf.of_uncurry_left.ae_measurable, true_and],
  exact measurable_set_lt (measurable.lintegral_prod_right hf.ennnorm) measurable_const
end

section
variables [second_countable_topology E] [normed_space ℝ E]
  [complete_space E] [borel_space E]

/-- The Bochner integral is measurable. This shows that the integrand of (the right-hand-side of)
  Fubini's theorem is measurable.
  This version has `f` in curried form. -/
lemma measurable.integral_prod_right [sigma_finite ν] ⦃f : α → β → E⦄
  (hf : measurable (uncurry f)) : measurable (λ x, ∫ y, f x y ∂ν) :=
begin
  let s : ℕ → simple_func (α × β) E := simple_func.approx_on _ hf univ _ (mem_univ 0),
  let s' : ℕ → α → simple_func β E := λ n x, (s n).comp (prod.mk x) measurable_prod_mk_left,
  let f' : ℕ → α → E := λ n, {x | integrable (f x) ν}.indicator
    (λ x, (s' n x).integral ν),
  have hf' : ∀ n, measurable (f' n),
  { intro n, refine measurable.indicator _ (measurable_set_integrable hf),
    have : ∀ x, (s' n x).range.filter (λ x, x ≠ 0) ⊆ (s n).range,
    { intros x, refine finset.subset.trans (finset.filter_subset _ _) _, intro y,
      simp_rw [simple_func.mem_range], rintro ⟨z, rfl⟩, exact ⟨(x, z), rfl⟩ },
    simp only [simple_func.integral_eq_sum_of_subset (this _)],
    refine finset.measurable_sum _ (λ x _, _),
    refine (measurable.ennreal_to_real _).smul_const _,
    simp only [simple_func.coe_comp, preimage_comp] {single_pass := tt},
    apply measurable_measure_prod_mk_left,
    exact (s n).measurable_set_fiber x },
  have h2f' : tendsto f' at_top (𝓝 (λ (x : α), ∫ (y : β), f x y ∂ν)),
  { rw [tendsto_pi_nhds], intro x,
    by_cases hfx : integrable (f x) ν,
    { have : ∀ n, integrable (s' n x) ν,
      { intro n, apply (hfx.norm.add hfx.norm).mono' (s' n x).measurable.ae_measurable,
        apply eventually_of_forall, intro y,
        simp_rw [s', simple_func.coe_comp], exact simple_func.norm_approx_on_zero_le _ _ (x, y) n },
      simp only [f', hfx, simple_func.integral_eq_integral _ (this _), indicator_of_mem,
        mem_set_of_eq],
      refine tendsto_integral_of_dominated_convergence (λ y, ∥f x y∥ + ∥f x y∥)
        (λ n, (s' n x).ae_measurable) (hfx.norm.add hfx.norm) _ _,
      { exact λ n, eventually_of_forall (λ y, simple_func.norm_approx_on_zero_le _ _ (x, y) n) },
      { exact eventually_of_forall (λ y, simple_func.tendsto_approx_on _ _ (by simp)) } },
    { simpa [f', hfx, integral_undef] using @tendsto_const_nhds _ _ _ (0 : E) _, } },
  exact measurable_of_tendsto_metric hf' h2f'
end

/-- The Bochner integral is measurable. This shows that the integrand of (the right-hand-side of)
  Fubini's theorem is measurable. -/
lemma measurable.integral_prod_right' [sigma_finite ν] ⦃f : α × β → E⦄
  (hf : measurable f) : measurable (λ x, ∫ y, f (x, y) ∂ν) :=
by { rw [← uncurry_curry f] at hf, exact hf.integral_prod_right }

/-- The Bochner integral is measurable. This shows that the integrand of (the right-hand-side of)
  the symmetric version of Fubini's theorem is measurable.
  This version has `f` in curried form. -/
lemma measurable.integral_prod_left [sigma_finite μ] ⦃f : α → β → E⦄
  (hf : measurable (uncurry f)) : measurable (λ y, ∫ x, f x y ∂μ) :=
(hf.comp measurable_swap).integral_prod_right'

/-- The Bochner integral is measurable. This shows that the integrand of (the right-hand-side of)
  the symmetric version of Fubini's theorem is measurable. -/
lemma measurable.integral_prod_left' [sigma_finite μ] ⦃f : α × β → E⦄
  (hf : measurable f) : measurable (λ y, ∫ x, f (x, y) ∂μ) :=
(hf.comp measurable_swap).integral_prod_right'

end

/-! ### The product measure -/

namespace measure_theory

namespace measure

/-- The binary product of measures. They are defined for arbitrary measures, but we basically
  prove all properties under the assumption that at least one of them is σ-finite. -/
@[irreducible] protected def prod (μ : measure α) (ν : measure β) : measure (α × β) :=
bind μ $ λ x : α, map (prod.mk x) ν

instance prod.measure_space {α β} [measure_space α] [measure_space β] : measure_space (α × β) :=
{ volume := volume.prod volume }

variables {μ ν} [sigma_finite ν]

lemma volume_eq_prod (α β) [measure_space α] [measure_space β] :
  (volume : measure (α × β)) = (volume : measure α).prod (volume : measure β) :=
rfl

lemma prod_apply {s : set (α × β)} (hs : measurable_set s) :
  μ.prod ν s = ∫⁻ x, ν (prod.mk x ⁻¹' s) ∂μ :=
by simp_rw [measure.prod, bind_apply hs measurable.map_prod_mk_left,
  map_apply measurable_prod_mk_left hs]

/-- The product measure of the product of two sets is the product of their measures. Note that we
do not need the sets to be measurable. -/
@[simp] lemma prod_prod (s : set α) (t : set β) : μ.prod ν (s.prod t) = μ s * ν t :=
begin
  apply le_antisymm,
  { set ST := (to_measurable μ s).prod (to_measurable ν t),
    have hSTm : measurable_set ST :=
      (measurable_set_to_measurable _ _).prod (measurable_set_to_measurable _ _),
    calc μ.prod ν (s.prod t) ≤ μ.prod ν ST :
      measure_mono $ set.prod_mono (subset_to_measurable _ _) (subset_to_measurable _ _)
    ... = μ (to_measurable μ s) * ν (to_measurable ν t) :
      by simp_rw [prod_apply hSTm, mk_preimage_prod_right_eq_if, measure_if,
        lintegral_indicator _ (measurable_set_to_measurable _ _), lintegral_const,
        restrict_apply_univ, mul_comm]
    ... = μ s * ν t : by rw [measure_to_measurable, measure_to_measurable] },
  { /- Formalization is based on https://mathoverflow.net/a/254134/136589 -/
    set ST := to_measurable (μ.prod ν) (s.prod t),
    have hSTm : measurable_set ST := measurable_set_to_measurable _ _,
    have hST : s.prod t ⊆ ST := subset_to_measurable _ _,
    set f : α → ℝ≥0∞ := λ x, ν (prod.mk x ⁻¹' ST),
    have hfm : measurable f := measurable_measure_prod_mk_left hSTm,
    set s' : set α := {x | ν t ≤ f x},
    have hss' : s ⊆ s' := λ x hx, measure_mono (λ y hy, hST $ mk_mem_prod hx hy),
    calc μ s * ν t ≤ μ s' * ν t : mul_le_mul_right' (measure_mono hss') _
    ... = ∫⁻ x in s', ν t ∂μ    : by rw [set_lintegral_const, mul_comm]
    ... ≤ ∫⁻ x in s', f x ∂μ    : set_lintegral_mono measurable_const hfm (λ x, id)
    ... ≤ ∫⁻ x, f x ∂μ          : lintegral_mono' restrict_le_self le_rfl
    ... = μ.prod ν ST           : (prod_apply hSTm).symm
    ... = μ.prod ν (s.prod t)   : measure_to_measurable _ }
end

lemma ae_measure_lt_top {s : set (α × β)} (hs : measurable_set s)
  (h2s : (μ.prod ν) s ≠ ∞) : ∀ᵐ x ∂μ, ν (prod.mk x ⁻¹' s) < ∞ :=
by { simp_rw [prod_apply hs] at h2s, refine ae_lt_top (measurable_measure_prod_mk_left hs) h2s }

lemma integrable_measure_prod_mk_left {s : set (α × β)}
  (hs : measurable_set s) (h2s : (μ.prod ν) s ≠ ∞) :
  integrable (λ x, (ν (prod.mk x ⁻¹' s)).to_real) μ :=
begin
  refine ⟨(measurable_measure_prod_mk_left hs).ennreal_to_real.ae_measurable, _⟩,
  simp_rw [has_finite_integral, ennnorm_eq_of_real to_real_nonneg],
  convert h2s.lt_top using 1, simp_rw [prod_apply hs], apply lintegral_congr_ae,
  refine (ae_measure_lt_top hs h2s).mp _, apply eventually_of_forall, intros x hx,
  rw [lt_top_iff_ne_top] at hx, simp [of_real_to_real, hx],
end

/-- Note: the assumption `hs` cannot be dropped. For a counterexample, see
  Walter Rudin *Real and Complex Analysis*, example (c) in section 8.9. -/
lemma measure_prod_null {s : set (α × β)}
  (hs : measurable_set s) : μ.prod ν s = 0 ↔ (λ x, ν (prod.mk x ⁻¹' s)) =ᵐ[μ] 0 :=
by simp_rw [prod_apply hs, lintegral_eq_zero_iff (measurable_measure_prod_mk_left hs)]

/-- Note: the converse is not true without assuming that `s` is measurable. For a counterexample,
  see Walter Rudin *Real and Complex Analysis*, example (c) in section 8.9. -/
lemma measure_ae_null_of_prod_null {s : set (α × β)}
  (h : μ.prod ν s = 0) : (λ x, ν (prod.mk x ⁻¹' s)) =ᵐ[μ] 0 :=
begin
  obtain ⟨t, hst, mt, ht⟩ := exists_measurable_superset_of_null h,
  simp_rw [measure_prod_null mt] at ht,
  rw [eventually_le_antisymm_iff],
  exact ⟨eventually_le.trans_eq
    (eventually_of_forall $ λ x, (measure_mono (preimage_mono hst) : _)) ht,
    eventually_of_forall $ λ x, zero_le _⟩
end

/-- Note: the converse is not true. For a counterexample, see
  Walter Rudin *Real and Complex Analysis*, example (c) in section 8.9. -/
lemma ae_ae_of_ae_prod {p : α × β → Prop} (h : ∀ᵐ z ∂μ.prod ν, p z) :
  ∀ᵐ x ∂ μ, ∀ᵐ y ∂ ν, p (x, y) :=
measure_ae_null_of_prod_null h

/-- `μ.prod ν` has finite spanning sets in rectangles of finite spanning sets. -/
def finite_spanning_sets_in.prod {ν : measure β} {C : set (set α)} {D : set (set β)}
  (hμ : μ.finite_spanning_sets_in C) (hν : ν.finite_spanning_sets_in D) :
  (μ.prod ν).finite_spanning_sets_in (image2 set.prod C D) :=
begin
  haveI := hν.sigma_finite,
  refine ⟨λ n, (hμ.set n.unpair.1).prod (hν.set n.unpair.2),
    λ n, mem_image2_of_mem (hμ.set_mem _) (hν.set_mem _), λ n, _, _⟩,
  { rw [prod_prod],
    exact mul_lt_top (hμ.finite _).ne (hν.finite _).ne },
  { simp_rw [Union_unpair_prod, hμ.spanning, hν.spanning, univ_prod_univ] }
end

lemma prod_fst_absolutely_continuous : map prod.fst (μ.prod ν) ≪ μ :=
begin
  refine absolutely_continuous.mk (λ s hs h2s, _),
  rw [map_apply measurable_fst hs, ← prod_univ, prod_prod, h2s, zero_mul],
end

lemma prod_snd_absolutely_continuous : map prod.snd (μ.prod ν) ≪ ν :=
begin
  refine absolutely_continuous.mk (λ s hs h2s, _),
  rw [map_apply measurable_snd hs, ← univ_prod, prod_prod, h2s, mul_zero]
end

variables [sigma_finite μ]

instance prod.sigma_finite : sigma_finite (μ.prod ν) :=
(μ.to_finite_spanning_sets_in.prod ν.to_finite_spanning_sets_in).sigma_finite

/-- A measure on a product space equals the product measure if they are equal on rectangles
  with as sides sets that generate the corresponding σ-algebras. -/
lemma prod_eq_generate_from {μ : measure α} {ν : measure β} {C : set (set α)}
  {D : set (set β)} (hC : generate_from C = ‹_›)
  (hD : generate_from D = ‹_›) (h2C : is_pi_system C) (h2D : is_pi_system D)
  (h3C : μ.finite_spanning_sets_in C) (h3D : ν.finite_spanning_sets_in D)
  {μν : measure (α × β)}
  (h₁ : ∀ (s ∈ C) (t ∈ D), μν (set.prod s t) = μ s * ν t) : μ.prod ν = μν :=
begin
  refine (h3C.prod h3D).ext
    (generate_from_eq_prod hC hD h3C.is_countably_spanning h3D.is_countably_spanning).symm
    (h2C.prod h2D) _,
  { rintro _ ⟨s, t, hs, ht, rfl⟩, haveI := h3D.sigma_finite,
    rw [h₁ s hs t ht, prod_prod] }
end

/-- A measure on a product space equals the product measure if they are equal on rectangles. -/
lemma prod_eq {μν : measure (α × β)}
  (h : ∀ s t, measurable_set s → measurable_set t → μν (s.prod t) = μ s * ν t) : μ.prod ν = μν :=
prod_eq_generate_from generate_from_measurable_set generate_from_measurable_set
  is_pi_system_measurable_set is_pi_system_measurable_set
  μ.to_finite_spanning_sets_in ν.to_finite_spanning_sets_in (λ s hs t ht, h s t hs ht)

lemma prod_swap : map prod.swap (μ.prod ν) = ν.prod μ :=
begin
  refine (prod_eq _).symm,
  intros s t hs ht,
  simp_rw [map_apply measurable_swap (hs.prod ht), preimage_swap_prod, prod_prod, mul_comm]
end

lemma prod_apply_symm {s : set (α × β)} (hs : measurable_set s) :
  μ.prod ν s = ∫⁻ y, μ ((λ x, (x, y)) ⁻¹' s) ∂ν :=
by { rw [← prod_swap, map_apply measurable_swap hs],
     simp only [prod_apply (measurable_swap hs)], refl }

lemma prod_assoc_prod [sigma_finite τ] :
  map measurable_equiv.prod_assoc ((μ.prod ν).prod τ) = μ.prod (ν.prod τ) :=
begin
  refine (prod_eq_generate_from generate_from_measurable_set generate_from_prod
    is_pi_system_measurable_set is_pi_system_prod μ.to_finite_spanning_sets_in
    (ν.to_finite_spanning_sets_in.prod τ.to_finite_spanning_sets_in) _).symm,
  rintro s hs _ ⟨t, u, ht, hu, rfl⟩, rw [mem_set_of_eq] at hs ht hu,
  simp_rw [map_apply (measurable_equiv.measurable _) (hs.prod (ht.prod hu)),
    measurable_equiv.prod_assoc, measurable_equiv.coe_mk, equiv.prod_assoc_preimage,
    prod_prod, mul_assoc]
end

/-! ### The product of specific measures -/

lemma prod_restrict (s : set α) (t : set β) :
  (μ.restrict s).prod (ν.restrict t) = (μ.prod ν).restrict (s.prod t) :=
begin
  refine prod_eq (λ s' t' hs' ht', _),
  rw [restrict_apply (hs'.prod ht'), prod_inter_prod, prod_prod, restrict_apply hs',
    restrict_apply ht']
end

lemma restrict_prod_eq_prod_univ (s : set α) :
  (μ.restrict s).prod ν = (μ.prod ν).restrict (s.prod univ) :=
begin
  have : ν = ν.restrict set.univ := measure.restrict_univ.symm,
  rwa [this, measure.prod_restrict, ← this],
end

lemma prod_dirac (y : β) : μ.prod (dirac y) = map (λ x, (x, y)) μ :=
begin
  refine prod_eq (λ s t hs ht, _),
  simp_rw [map_apply measurable_prod_mk_right (hs.prod ht), mk_preimage_prod_left_eq_if, measure_if,
    dirac_apply' _ ht, ← indicator_mul_right _ (λ x, μ s), pi.one_apply, mul_one]
end

lemma dirac_prod (x : α) : (dirac x).prod ν = map (prod.mk x) ν :=
begin
  refine prod_eq (λ s t hs ht, _),
  simp_rw [map_apply measurable_prod_mk_left (hs.prod ht), mk_preimage_prod_right_eq_if, measure_if,
    dirac_apply' _ hs, ← indicator_mul_left _ _ (λ x, ν t), pi.one_apply, one_mul]
end

lemma dirac_prod_dirac {x : α} {y : β} : (dirac x).prod (dirac y) = dirac (x, y) :=
by rw [prod_dirac, map_dirac measurable_prod_mk_right]

lemma prod_sum {ι : Type*} [fintype ι] (ν : ι → measure β) [∀ i, sigma_finite (ν i)] :
  μ.prod (sum ν) = sum (λ i, μ.prod (ν i)) :=
begin
  refine prod_eq (λ s t hs ht, _),
  simp_rw [sum_apply _ (hs.prod ht), sum_apply _ ht, prod_prod, ennreal.tsum_mul_left]
end

lemma sum_prod {ι : Type*} [fintype ι] (μ : ι → measure α) [∀ i, sigma_finite (μ i)] :
  (sum μ).prod ν = sum (λ i, (μ i).prod ν) :=
begin
  refine prod_eq (λ s t hs ht, _),
  simp_rw [sum_apply _ (hs.prod ht), sum_apply _ hs, prod_prod, ennreal.tsum_mul_right]
end

lemma prod_add (ν' : measure β) [sigma_finite ν'] : μ.prod (ν + ν') = μ.prod ν + μ.prod ν' :=
by { refine prod_eq (λ s t hs ht, _), simp_rw [add_apply, prod_prod, left_distrib] }

lemma add_prod (μ' : measure α) [sigma_finite μ'] : (μ + μ').prod ν = μ.prod ν + μ'.prod ν :=
by { refine prod_eq (λ s t hs ht, _), simp_rw [add_apply, prod_prod, right_distrib] }

@[simp] lemma zero_prod (ν : measure β) : (0 : measure α).prod ν = 0 :=
by { rw measure.prod, exact bind_zero_left _ }

@[simp] lemma prod_zero (μ : measure α) : μ.prod (0 : measure β) = 0 :=
by simp [measure.prod]

lemma map_prod_map {δ} [measurable_space δ] {f : α → β} {g : γ → δ}
  {μa : measure α} {μc : measure γ} (hfa : sigma_finite (map f μa))
  (hgc : sigma_finite (map g μc)) (hf : measurable f) (hg : measurable g) :
  (map f μa).prod (map g μc) = map (prod.map f g) (μa.prod μc) :=
begin
  haveI := hgc.of_map μc hg,
  refine prod_eq (λ s t hs ht, _),
  rw [map_apply (hf.prod_map hg) (hs.prod ht), map_apply hf hs, map_apply hg ht],
  exact prod_prod (f ⁻¹' s) (g ⁻¹' t)
end

end measure

namespace measure_preserving

open measure

variables {δ : Type*} [measurable_space δ] {μa : measure α} {μb : measure β}
  {μc : measure γ} {μd : measure δ}

lemma skew_product [sigma_finite μb] [sigma_finite μd]
  {f : α → β} (hf : measure_preserving f μa μb) {g : α → γ → δ}
  (hgm : measurable (uncurry g)) (hg : ∀ᵐ x ∂μa, map (g x) μc = μd) :
  measure_preserving (λ p : α × γ, (f p.1, g p.1 p.2)) (μa.prod μc) (μb.prod μd) :=
begin
  classical,
  have : measurable (λ p : α × γ, (f p.1, g p.1 p.2)) := (hf.1.comp measurable_fst).prod_mk hgm,
  /- if `μa = 0`, then the lemma is trivial, otherwise we can use `hg`
  to deduce `sigma_finite μc`. -/
  rcases eq_or_ne μa 0 with (rfl|ha),
  { rw [← hf.map_eq, zero_prod, (map f).map_zero, zero_prod],
    exact ⟨this, (map _).map_zero⟩ },
  haveI : sigma_finite μc,
  { rcases (ae_ne_bot.2 ha).nonempty_of_mem hg with ⟨x, hx : map (g x) μc = μd⟩,
    exact sigma_finite.of_map _ hgm.of_uncurry_left (by rwa hx) },
  -- Thus we can apply `measure.prod_eq` to prove equality of measures.
  refine ⟨this, (prod_eq $ λ s t hs ht, _).symm⟩,
  rw [map_apply this (hs.prod ht)],
  refine (prod_apply (this $ hs.prod ht)).trans _,
  have : ∀ᵐ x ∂μa, μc ((λ y, (f x, g x y)) ⁻¹' s.prod t) = indicator (f ⁻¹' s) (λ y, μd t) x,
  { refine hg.mono (λ x hx, _), unfreezingI { subst hx },
    simp only [mk_preimage_prod_right_fn_eq_if, indicator_apply, mem_preimage],
    split_ifs,
    exacts [(map_apply hgm.of_uncurry_left ht).symm, measure_empty] },
  simp only [preimage_preimage],
  rw [lintegral_congr_ae this, lintegral_indicator _ (hf.1 hs),
    set_lintegral_const, hf.measure_preimage hs, mul_comm]
end

/-- If `f : α → β` sends the measure `μa` to `μb` and `g : γ → δ` sends the measure `μc` to `μd`,
then `prod.map f g` sends `μa.prod μc` to `μb.prod μd`. -/
protected lemma prod [sigma_finite μb] [sigma_finite μd] {f : α → β} {g : γ → δ}
  (hf : measure_preserving f μa μb) (hg : measure_preserving g μc μd) :
  measure_preserving (prod.map f g) (μa.prod μc) (μb.prod μd) :=
have measurable (uncurry $ λ _ : α, g), from (hg.1.comp measurable_snd),
hf.skew_product this $ filter.eventually_of_forall $ λ _, hg.map_eq

end measure_preserving

end measure_theory

open measure_theory.measure

section

lemma ae_measurable.prod_swap [sigma_finite μ] [sigma_finite ν] {f : β × α → γ}
  (hf : ae_measurable f (ν.prod μ)) : ae_measurable (λ (z : α × β), f z.swap) (μ.prod ν) :=
by { rw ← prod_swap at hf, exact hf.comp_measurable measurable_swap }

lemma ae_measurable.fst [sigma_finite ν] {f : α → γ}
  (hf : ae_measurable f μ) : ae_measurable (λ (z : α × β), f z.1) (μ.prod ν) :=
hf.comp_measurable' measurable_fst prod_fst_absolutely_continuous

lemma ae_measurable.snd [sigma_finite ν] {f : β → γ}
  (hf : ae_measurable f ν) : ae_measurable (λ (z : α × β), f z.2) (μ.prod ν) :=
hf.comp_measurable' measurable_snd prod_snd_absolutely_continuous

/-- The Bochner integral is a.e.-measurable.
  This shows that the integrand of (the right-hand-side of) Fubini's theorem is a.e.-measurable. -/
lemma ae_measurable.integral_prod_right' [sigma_finite ν]
  [second_countable_topology E] [normed_space ℝ E] [borel_space E] [complete_space E]
  ⦃f : α × β → E⦄ (hf : ae_measurable f (μ.prod ν)) : ae_measurable (λ x, ∫ y, f (x, y) ∂ν) μ :=
⟨λ x, ∫ y, hf.mk f (x, y) ∂ν, hf.measurable_mk.integral_prod_right', begin
  filter_upwards [ae_ae_of_ae_prod hf.ae_eq_mk],
  assume x hx,
  exact integral_congr_ae hx
end⟩

lemma ae_measurable.prod_mk_left [sigma_finite ν] {f : α × β → γ}
  (hf : ae_measurable f (μ.prod ν)) : ∀ᵐ x ∂μ, ae_measurable (λ y, f (x, y)) ν :=
begin
  filter_upwards [ae_ae_of_ae_prod hf.ae_eq_mk],
  intros x hx,
  exact ⟨λ y, hf.mk f (x, y), hf.measurable_mk.comp measurable_prod_mk_left, hx⟩
end

end

namespace measure_theory

/-! ### The Lebesgue integral on a product -/

variables [sigma_finite ν]

lemma lintegral_prod_swap [sigma_finite μ] (f : α × β → ℝ≥0∞)
  (hf : ae_measurable f (μ.prod ν)) : ∫⁻ z, f z.swap ∂(ν.prod μ) = ∫⁻ z, f z ∂(μ.prod ν) :=
by { rw ← prod_swap at hf, rw [← lintegral_map' hf measurable_swap, prod_swap] }

/-- **Tonelli's Theorem**: For `ℝ≥0∞`-valued measurable functions on `α × β`,
  the integral of `f` is equal to the iterated integral. -/
lemma lintegral_prod_of_measurable :
  ∀ (f : α × β → ℝ≥0∞) (hf : measurable f), ∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ x, ∫⁻ y, f (x, y) ∂ν ∂μ :=
begin
  have m := @measurable_prod_mk_left,
  refine measurable.ennreal_induction _ _ _,
  { intros c s hs, simp only [← indicator_comp_right],
    simp [lintegral_indicator, m hs, hs, lintegral_const_mul, measurable_measure_prod_mk_left hs,
      prod_apply] },
  { rintro f g - hf hg h2f h2g,
    simp [lintegral_add, measurable.lintegral_prod_right', hf.comp m, hg.comp m,
      hf, hg, h2f, h2g] },
  { intros f hf h2f h3f,
    have kf : ∀ x n, measurable (λ y, f n (x, y)) := λ x n, (hf n).comp m,
    have k2f : ∀ x, monotone (λ n y, f n (x, y)) := λ x i j hij y, h2f hij (x, y),
    have lf : ∀ n, measurable (λ x, ∫⁻ y, f n (x, y) ∂ν) := λ n, (hf n).lintegral_prod_right',
    have l2f : monotone (λ n x, ∫⁻ y, f n (x, y) ∂ν) := λ i j hij x, lintegral_mono (k2f x hij),
    simp only [lintegral_supr hf h2f, lintegral_supr (kf _), k2f, lintegral_supr lf l2f, h3f] },
end

/-- **Tonelli's Theorem**: For `ℝ≥0∞`-valued almost everywhere measurable functions on `α × β`,
  the integral of `f` is equal to the iterated integral. -/
lemma lintegral_prod (f : α × β → ℝ≥0∞) (hf : ae_measurable f (μ.prod ν)) :
  ∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ x, ∫⁻ y, f (x, y) ∂ν ∂μ :=
begin
  have A : ∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ z, hf.mk f z ∂(μ.prod ν) :=
    lintegral_congr_ae hf.ae_eq_mk,
  have B : ∫⁻ x, ∫⁻ y, f (x, y) ∂ν ∂μ = ∫⁻ x, ∫⁻ y, hf.mk f (x, y) ∂ν ∂μ,
  { apply lintegral_congr_ae,
    filter_upwards [ae_ae_of_ae_prod hf.ae_eq_mk],
    assume a ha,
    exact lintegral_congr_ae ha },
  rw [A, B, lintegral_prod_of_measurable _ hf.measurable_mk],
  apply_instance
end

/-- The symmetric verion of Tonelli's Theorem: For `ℝ≥0∞`-valued almost everywhere measurable
functions on `α × β`,  the integral of `f` is equal to the iterated integral, in reverse order. -/
lemma lintegral_prod_symm [sigma_finite μ] (f : α × β → ℝ≥0∞)
  (hf : ae_measurable f (μ.prod ν)) : ∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ y, ∫⁻ x, f (x, y) ∂μ ∂ν :=
by { simp_rw [← lintegral_prod_swap f hf], exact lintegral_prod _ hf.prod_swap }

/-- The symmetric verion of Tonelli's Theorem: For `ℝ≥0∞`-valued measurable
functions on `α × β`,  the integral of `f` is equal to the iterated integral, in reverse order. -/
lemma lintegral_prod_symm' [sigma_finite μ] (f : α × β → ℝ≥0∞)
  (hf : measurable f) : ∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ y, ∫⁻ x, f (x, y) ∂μ ∂ν :=
lintegral_prod_symm f hf.ae_measurable

/-- The reversed version of **Tonelli's Theorem**. In this version `f` is in curried form, which
makes it easier for the elaborator to figure out `f` automatically. -/
lemma lintegral_lintegral ⦃f : α → β → ℝ≥0∞⦄
  (hf : ae_measurable (uncurry f) (μ.prod ν)) :
  ∫⁻ x, ∫⁻ y, f x y ∂ν ∂μ = ∫⁻ z, f z.1 z.2 ∂(μ.prod ν) :=
(lintegral_prod _ hf).symm

/-- The reversed version of **Tonelli's Theorem** (symmetric version). In this version `f` is in
curried form, which makes it easier for the elaborator to figure out `f` automatically. -/
lemma lintegral_lintegral_symm [sigma_finite μ] ⦃f : α → β → ℝ≥0∞⦄
  (hf : ae_measurable (uncurry f) (μ.prod ν)) :
  ∫⁻ x, ∫⁻ y, f x y ∂ν ∂μ = ∫⁻ z, f z.2 z.1 ∂(ν.prod μ) :=
(lintegral_prod_symm _ hf.prod_swap).symm

/-- Change the order of Lebesgue integration. -/
lemma lintegral_lintegral_swap [sigma_finite μ] ⦃f : α → β → ℝ≥0∞⦄
  (hf : ae_measurable (uncurry f) (μ.prod ν)) :
  ∫⁻ x, ∫⁻ y, f x y ∂ν ∂μ = ∫⁻ y, ∫⁻ x, f x y ∂μ ∂ν :=
(lintegral_lintegral hf).trans (lintegral_prod_symm _ hf)

lemma lintegral_prod_mul {f : α → ℝ≥0∞} {g : β → ℝ≥0∞}
  (hf : ae_measurable f μ) (hg : ae_measurable g ν) :
  ∫⁻ z, f z.1 * g z.2 ∂(μ.prod ν) = ∫⁻ x, f x ∂μ * ∫⁻ y, g y ∂ν :=
by simp [lintegral_prod _ (hf.fst.mul hg.snd), lintegral_lintegral_mul hf hg]

/-! ### Integrability on a product -/
section

variables [opens_measurable_space E]

lemma integrable.swap [sigma_finite μ] ⦃f : α × β → E⦄
  (hf : integrable f (μ.prod ν)) : integrable (f ∘ prod.swap) (ν.prod μ) :=
⟨hf.ae_measurable.prod_swap,
  (lintegral_prod_swap _ hf.ae_measurable.ennnorm : _).le.trans_lt hf.has_finite_integral⟩

lemma integrable_swap_iff [sigma_finite μ] ⦃f : α × β → E⦄ :
  integrable (f ∘ prod.swap) (ν.prod μ) ↔ integrable f (μ.prod ν) :=
⟨λ hf, by { convert hf.swap, ext ⟨x, y⟩, refl }, λ hf, hf.swap⟩

lemma has_finite_integral_prod_iff ⦃f : α × β → E⦄ (h1f : measurable f) :
  has_finite_integral f (μ.prod ν) ↔ (∀ᵐ x ∂ μ, has_finite_integral (λ y, f (x, y)) ν) ∧
    has_finite_integral (λ x, ∫ y, ∥f (x, y)∥ ∂ν) μ :=
begin
  simp only [has_finite_integral, lintegral_prod_of_measurable _ h1f.ennnorm],
  have : ∀ x, ∀ᵐ y ∂ν, 0 ≤ ∥f (x, y)∥ := λ x, eventually_of_forall (λ y, norm_nonneg _),
  simp_rw [integral_eq_lintegral_of_nonneg_ae (this _)
    (h1f.norm.comp measurable_prod_mk_left).ae_measurable,
    ennnorm_eq_of_real to_real_nonneg, of_real_norm_eq_coe_nnnorm],
  -- this fact is probably too specialized to be its own lemma
  have : ∀ {p q r : Prop} (h1 : r → p), (r ↔ p ∧ q) ↔ (p → (r ↔ q)) :=
  λ p q r h1, by rw [← and.congr_right_iff, and_iff_right_of_imp h1],
  rw [this],
  { intro h2f, rw lintegral_congr_ae,
    refine h2f.mp _, apply eventually_of_forall, intros x hx, dsimp only,
    rw [of_real_to_real], rw [← lt_top_iff_ne_top], exact hx },
  { intro h2f, refine ae_lt_top _ h2f.ne, exact h1f.ennnorm.lintegral_prod_right' },
end

lemma has_finite_integral_prod_iff' ⦃f : α × β → E⦄ (h1f : ae_measurable f (μ.prod ν)) :
  has_finite_integral f (μ.prod ν) ↔ (∀ᵐ x ∂ μ, has_finite_integral (λ y, f (x, y)) ν) ∧
    has_finite_integral (λ x, ∫ y, ∥f (x, y)∥ ∂ν) μ :=
begin
  rw [has_finite_integral_congr h1f.ae_eq_mk, has_finite_integral_prod_iff h1f.measurable_mk],
  apply and_congr,
  { apply eventually_congr,
    filter_upwards [ae_ae_of_ae_prod h1f.ae_eq_mk.symm],
    assume x hx,
    exact has_finite_integral_congr hx },
  { apply has_finite_integral_congr,
    filter_upwards [ae_ae_of_ae_prod h1f.ae_eq_mk.symm],
    assume x hx,
    exact integral_congr_ae (eventually_eq.fun_comp hx _) },
  { apply_instance }
end

/-- A binary function is integrable if the function `y ↦ f (x, y)` is integrable for almost every
  `x` and the function `x ↦ ∫ ∥f (x, y)∥ dy` is integrable. -/
lemma integrable_prod_iff ⦃f : α × β → E⦄ (h1f : ae_measurable f (μ.prod ν)) :
  integrable f (μ.prod ν) ↔
    (∀ᵐ x ∂ μ, integrable (λ y, f (x, y)) ν) ∧ integrable (λ x, ∫ y, ∥f (x, y)∥ ∂ν) μ :=
by simp [integrable, h1f, has_finite_integral_prod_iff', h1f.norm.integral_prod_right',
         h1f.prod_mk_left]

/-- A binary function is integrable if the function `x ↦ f (x, y)` is integrable for almost every
  `y` and the function `y ↦ ∫ ∥f (x, y)∥ dx` is integrable. -/
lemma integrable_prod_iff' [sigma_finite μ] ⦃f : α × β → E⦄ (h1f : ae_measurable f (μ.prod ν)) :
  integrable f (μ.prod ν) ↔
    (∀ᵐ y ∂ ν, integrable (λ x, f (x, y)) μ) ∧ integrable (λ y, ∫ x, ∥f (x, y)∥ ∂μ) ν :=
by { convert integrable_prod_iff (h1f.prod_swap) using 1, rw [integrable_swap_iff] }

lemma integrable.prod_left_ae [sigma_finite μ] ⦃f : α × β → E⦄
  (hf : integrable f (μ.prod ν)) : ∀ᵐ y ∂ ν, integrable (λ x, f (x, y)) μ :=
((integrable_prod_iff' hf.ae_measurable).mp hf).1

lemma integrable.prod_right_ae [sigma_finite μ] ⦃f : α × β → E⦄
  (hf : integrable f (μ.prod ν)) : ∀ᵐ x ∂ μ, integrable (λ y, f (x, y)) ν :=
hf.swap.prod_left_ae

lemma integrable.integral_norm_prod_left ⦃f : α × β → E⦄
  (hf : integrable f (μ.prod ν)) : integrable (λ x, ∫ y, ∥f (x, y)∥ ∂ν) μ :=
((integrable_prod_iff hf.ae_measurable).mp hf).2

lemma integrable.integral_norm_prod_right [sigma_finite μ] ⦃f : α × β → E⦄
  (hf : integrable f (μ.prod ν)) : integrable (λ y, ∫ x, ∥f (x, y)∥ ∂μ) ν :=
hf.swap.integral_norm_prod_left

end

variables [second_countable_topology E] [normed_space ℝ E]
  [complete_space E] [borel_space E]

lemma integrable.integral_prod_left ⦃f : α × β → E⦄
  (hf : integrable f (μ.prod ν)) : integrable (λ x, ∫ y, f (x, y) ∂ν) μ :=
integrable.mono hf.integral_norm_prod_left hf.ae_measurable.integral_prod_right' $
  eventually_of_forall $ λ x, (norm_integral_le_integral_norm _).trans_eq $
  (norm_of_nonneg $ integral_nonneg_of_ae $ eventually_of_forall $
  λ y, (norm_nonneg (f (x, y)) : _)).symm

lemma integrable.integral_prod_right [sigma_finite μ] ⦃f : α × β → E⦄
  (hf : integrable f (μ.prod ν)) : integrable (λ y, ∫ x, f (x, y) ∂μ) ν :=
hf.swap.integral_prod_left

/-! ### The Bochner integral on a product -/

variables [sigma_finite μ]

lemma integral_prod_swap (f : α × β → E)
  (hf : ae_measurable f (μ.prod ν)) : ∫ z, f z.swap ∂(ν.prod μ) = ∫ z, f z ∂(μ.prod ν) :=
begin
  rw ← prod_swap at hf,
  rw [← integral_map measurable_swap hf, prod_swap]
end

variables {E' : Type*} [measurable_space E'] [normed_group E'] [borel_space E'] [complete_space E']
  [normed_space ℝ E'] [second_countable_topology E']

/-! Some rules about the sum/difference of double integrals. They follow from `integral_add`, but
  we separate them out as separate lemmas, because they involve quite some steps. -/

/-- Integrals commute with addition inside another integral. `F` can be any function. -/
lemma integral_fn_integral_add ⦃f g : α × β → E⦄ (F : E → E')
  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
  ∫ x, F (∫ y, f (x, y) + g (x, y) ∂ν) ∂μ = ∫ x, F (∫ y, f (x, y) ∂ν + ∫ y, g (x, y) ∂ν) ∂μ :=
begin
  refine integral_congr_ae _,
  filter_upwards [hf.prod_right_ae, hg.prod_right_ae],
  intros x h2f h2g, simp [integral_add h2f h2g],
end

/-- Integrals commute with subtraction inside another integral.
  `F` can be any measurable function. -/
lemma integral_fn_integral_sub ⦃f g : α × β → E⦄ (F : E → E')
  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
  ∫ x, F (∫ y, f (x, y) - g (x, y) ∂ν) ∂μ = ∫ x, F (∫ y, f (x, y) ∂ν - ∫ y, g (x, y) ∂ν) ∂μ :=
begin
  refine integral_congr_ae _,
  filter_upwards [hf.prod_right_ae, hg.prod_right_ae],
  intros x h2f h2g, simp [integral_sub h2f h2g]
end

/-- Integrals commute with subtraction inside a lower Lebesgue integral.
  `F` can be any function. -/
lemma lintegral_fn_integral_sub ⦃f g : α × β → E⦄
  (F : E → ℝ≥0∞) (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
  ∫⁻ x, F (∫ y, f (x, y) - g (x, y) ∂ν) ∂μ = ∫⁻ x, F (∫ y, f (x, y) ∂ν - ∫ y, g (x, y) ∂ν) ∂μ :=
begin
  refine lintegral_congr_ae _,
  filter_upwards [hf.prod_right_ae, hg.prod_right_ae],
  intros x h2f h2g, simp [integral_sub h2f h2g]
end

/-- Double integrals commute with addition. -/
lemma integral_integral_add ⦃f g : α × β → E⦄
  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
  ∫ x, ∫ y, f (x, y) + g (x, y) ∂ν ∂μ = ∫ x, ∫ y, f (x, y) ∂ν ∂μ + ∫ x, ∫ y, g (x, y) ∂ν ∂μ :=
(integral_fn_integral_add id hf hg).trans $
  integral_add hf.integral_prod_left hg.integral_prod_left

/-- Double integrals commute with addition. This is the version with `(f + g) (x, y)`
  (instead of `f (x, y) + g (x, y)`) in the LHS. -/
lemma integral_integral_add' ⦃f g : α × β → E⦄
  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
  ∫ x, ∫ y, (f + g) (x, y) ∂ν ∂μ = ∫ x, ∫ y, f (x, y) ∂ν ∂μ + ∫ x, ∫ y, g (x, y) ∂ν ∂μ :=
integral_integral_add hf hg

/-- Double integrals commute with subtraction. -/
lemma integral_integral_sub ⦃f g : α × β → E⦄
  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
  ∫ x, ∫ y, f (x, y) - g (x, y) ∂ν ∂μ = ∫ x, ∫ y, f (x, y) ∂ν ∂μ - ∫ x, ∫ y, g (x, y) ∂ν ∂μ :=
(integral_fn_integral_sub id hf hg).trans $
  integral_sub hf.integral_prod_left hg.integral_prod_left

/-- Double integrals commute with subtraction. This is the version with `(f - g) (x, y)`
  (instead of `f (x, y) - g (x, y)`) in the LHS. -/
lemma integral_integral_sub' ⦃f g : α × β → E⦄
  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
  ∫ x, ∫ y, (f - g) (x, y) ∂ν ∂μ = ∫ x, ∫ y, f (x, y) ∂ν ∂μ - ∫ x, ∫ y, g (x, y) ∂ν ∂μ :=
integral_integral_sub hf hg

/-- The map that sends an L¹-function `f : α × β → E` to `∫∫f` is continuous. -/
lemma continuous_integral_integral :
  continuous (λ (f : α × β →₁[μ.prod ν] E), ∫ x, ∫ y, f (x, y) ∂ν ∂μ) :=
begin
  rw [continuous_iff_continuous_at], intro g,
  refine tendsto_integral_of_L1 _ (L1.integrable_coe_fn g).integral_prod_left
    (eventually_of_forall $ λ h, (L1.integrable_coe_fn h).integral_prod_left) _,
  simp_rw [← lintegral_fn_integral_sub (λ x, (nnnorm x : ℝ≥0∞)) (L1.integrable_coe_fn _)
    (L1.integrable_coe_fn g)],
  refine tendsto_of_tendsto_of_tendsto_of_le_of_le tendsto_const_nhds _ (λ i, zero_le _) _,
  { exact λ i, ∫⁻ x, ∫⁻ y, nnnorm (i (x, y) - g (x, y)) ∂ν ∂μ },
  swap, { exact λ i, lintegral_mono (λ x, ennnorm_integral_le_lintegral_ennnorm _) },
  show tendsto (λ (i : α × β →₁[μ.prod ν] E),
    ∫⁻ x, ∫⁻ (y : β), nnnorm (i (x, y) - g (x, y)) ∂ν ∂μ) (𝓝 g) (𝓝 0),
  have : ∀ (i : α × β →₁[μ.prod ν] E), measurable (λ z, (nnnorm (i z - g z) : ℝ≥0∞)) :=
  λ i, ((Lp.measurable i).sub (Lp.measurable g)).ennnorm,
  simp_rw [← lintegral_prod_of_measurable _ (this _), ← L1.of_real_norm_sub_eq_lintegral,
    ← of_real_zero],
  refine (continuous_of_real.tendsto 0).comp _,
  rw [← tendsto_iff_norm_tendsto_zero], exact tendsto_id
end

/-- **Fubini's Theorem**: For integrable functions on `α × β`,
  the Bochner integral of `f` is equal to the iterated Bochner integral.
  `integrable_prod_iff` can be useful to show that the function in question in integrable.
  `measure_theory.integrable.integral_prod_right` is useful to show that the inner integral
  of the right-hand side is integrable. -/
lemma integral_prod : ∀ (f : α × β → E) (hf : integrable f (μ.prod ν)),
  ∫ z, f z ∂(μ.prod ν) = ∫ x, ∫ y, f (x, y) ∂ν ∂μ :=
begin
  apply integrable.induction,
  { intros c s hs h2s,
    simp_rw [integral_indicator hs, ← indicator_comp_right,
      function.comp, integral_indicator (measurable_prod_mk_left hs),
      set_integral_const, integral_smul_const,
      integral_to_real (measurable_measure_prod_mk_left hs).ae_measurable
      (ae_measure_lt_top hs h2s.ne), prod_apply hs] },
  { intros f g hfg i_f i_g hf hg,
    simp_rw [integral_add' i_f i_g, integral_integral_add' i_f i_g, hf, hg] },
  { exact is_closed_eq continuous_integral continuous_integral_integral },
  { intros f g hfg i_f hf, convert hf using 1,
    { exact integral_congr_ae hfg.symm },
    { refine integral_congr_ae _,
      refine (ae_ae_of_ae_prod hfg).mp _,
      apply eventually_of_forall, intros x hfgx,
      exact integral_congr_ae (ae_eq_symm hfgx) } }
end

/-- Symmetric version of **Fubini's Theorem**: For integrable functions on `α × β`,
  the Bochner integral of `f` is equal to the iterated Bochner integral.
  This version has the integrals on the right-hand side in the other order. -/
lemma integral_prod_symm (f : α × β → E) (hf : integrable f (μ.prod ν)) :
  ∫ z, f z ∂(μ.prod ν) = ∫ y, ∫ x, f (x, y) ∂μ ∂ν :=
by { simp_rw [← integral_prod_swap f hf.ae_measurable], exact integral_prod _ hf.swap }

/-- Reversed version of **Fubini's Theorem**. -/
lemma integral_integral {f : α → β → E} (hf : integrable (uncurry f) (μ.prod ν)) :
  ∫ x, ∫ y, f x y ∂ν ∂μ = ∫ z, f z.1 z.2 ∂(μ.prod ν) :=
(integral_prod _ hf).symm

/-- Reversed version of **Fubini's Theorem** (symmetric version). -/
lemma integral_integral_symm {f : α → β → E} (hf : integrable (uncurry f) (μ.prod ν)) :
  ∫ x, ∫ y, f x y ∂ν ∂μ = ∫ z, f z.2 z.1 ∂(ν.prod μ) :=
(integral_prod_symm _ hf.swap).symm

/-- Change the order of Bochner integration. -/
lemma integral_integral_swap ⦃f : α → β → E⦄ (hf : integrable (uncurry f) (μ.prod ν)) :
  ∫ x, ∫ y, f x y ∂ν ∂μ = ∫ y, ∫ x, f x y ∂μ ∂ν :=
(integral_integral hf).trans (integral_prod_symm _ hf)

/-- **Fubini's Theorem** for set integrals. -/
lemma set_integral_prod (f : α × β → E) {s : set α} {t : set β}
  (hf : integrable_on f (s.prod t) (μ.prod ν)) :
  ∫ z in s.prod t, f z ∂(μ.prod ν) = ∫ x in s, ∫ y in t, f (x, y) ∂ν ∂μ :=
begin
  simp only [← measure.prod_restrict s t, integrable_on] at hf ⊢,
  exact integral_prod f hf
end

end measure_theory


-- tyring to port ideas from https://arxiv.org/pdf/2107.12144.pdf

import tactic.basic
import tactic.omega

inductive base : Type
  | zero : base
  | one : base
  | add : base -> base -> base
  | mul : base -> base -> base

instance : has_one base := ⟨base.one⟩
@[simp]
lemma base.one_is_one : base.one = 1 := rfl

instance : has_zero base := ⟨base.zero⟩
@[simp]
lemma base.zero_is_zero : base.zero = 0 := rfl

instance : has_add base := ⟨base.add⟩

@[simp]
lemma base.add_is_add {A B : base} : A.add B = A + B := rfl

instance : has_mul base := ⟨base.mul⟩

@[simp]
lemma base.mul_is_mul {A B : base} : A.mul B = A * B := rfl

open base
instance : decidable_eq base := by {
  intros x,
  induction x with x₀ x₁ x₀_ih x₁_ih x₀ x₁ x₀_ih x₁_ih
    ; intro y; cases y with y₀ y₁ y₀ y₁,
  all_goals {try {right, refl}},
  all_goals {try {left, cc}},
  all_goals {
    have x₀_ih_y₀ := x₀_ih y₀,
    cases x₀_ih_y₀,
    {left, intros h, injection h, apply x₀_ih_y₀, assumption},
    have x₁_ih_y₁ := x₁_ih y₁,
    cases x₁_ih_y₁,
    {left, intros h, injection h, apply x₁_ih_y₁, assumption},
    rw [x₁_ih_y₁, x₀_ih_y₀],
    right, refl,
  }
}

inductive subatomic : Type
  | id : subatomic
  | swap_add: subatomic
  | zero_add : subatomic
  | assoc_add : subatomic
  | swap_mul: subatomic
  | one_mul : subatomic
  | assoc_mul : subatomic
  | distrib : subatomic
  | distrib0 : subatomic

open subatomic

inductive subatomic.typed : subatomic → base → base → Type
  | id : ∀ b, subatomic.typed id b b
  | swap_add: ∀ a b : base, subatomic.typed swap_add (a + b) (b + a)
  | zero_add : ∀ a, subatomic.typed zero_add (0 + a) a
  | assoc_add : ∀ a b c, subatomic.typed assoc_add (a + b + c) (a + (b + c))
  | swap_mul: ∀ a b, subatomic.typed swap_mul (a * b) (b * a)
  | one_mul : ∀ a, subatomic.typed one_mul (1 * a) a
  | assoc_mul : ∀ a b c, subatomic.typed assoc_mul (a * b * c) (a * (b * c))
  | distrib : ∀ a b c, subatomic.typed distrib (a * (b + c)) (a * b + a * c)
  | distrib0 : ∀ a, subatomic.typed distrib0 (a * 0) 0

inductive atomic : Type
  | forward : subatomic → atomic
  | backward : subatomic → atomic

open atomic

inductive atomic.typed : atomic → base → base → Type
  | forward {s : subatomic} {A B : base} : s.typed A B → atomic.typed (forward s) A B
  | backward {s : subatomic} {A B : base} : s.typed B A → atomic.typed (backward s) A B

def atomic.inv : atomic → atomic
  | (atomic.forward sa) := atomic.backward sa
  | (atomic.backward sa) := atomic.forward sa

inductive pie : Type
  | atomic : atomic → pie
  | comp_list : pie → list pie → pie → pie
  | add :  pie → pie → pie
  | mul :  pie → pie → pie

def pie.left (x : pie) : pie :=
  match x with
  | (pie.comp_list l _ _) := l
  | _ := x
  end

def pie.right : pie → pie
  | (pie.comp_list _ _ r) := r
  | x := x

def pie.lefts : pie → list pie
  | (pie.comp_list _ ls r) := ls ++ [r]
  | _ := list.nil

def pie.rights : pie → list pie
  | (pie.comp_list l rs _) := l :: rs
  | _ := list.nil

def pie.comp (x y : pie) : pie :=
  pie.comp_list x.left (x.lefts ++ y.rights) y.right

mutual def pie.inv , list.inv
  with pie.inv : pie → pie
  | (pie.atomic atom) := pie.atomic atom.inv
  | (pie.comp_list left (xs : list pie) right) := pie.comp_list right.inv xs.inv.reverse left.inv
  | (pie.add f g) := f.inv.add g.inv
  | (pie.mul f g) := f.inv.mul g.inv
  with list.inv : list pie → list pie
    | list.nil := list.nil
    | (x :: xs) := x.inv :: xs.inv

@[simp]
lemma list.inv_nil : [].inv = ([] : list pie) := by {unfold list.inv}

@[simp]
lemma list.inv_cons (x : pie) (xs : list pie) : (x::xs).inv = (x.inv :: xs.inv) := by {unfold list.inv}

@[simp]
lemma list.inv_append (l₀ l₁ : list pie) : (l₀ ++ l₁).inv = l₀.inv ++ l₁.inv := by {
  induction l₀; simp,
  apply l₀_ih,
}

@[simp]
lemma atomic.inv_inv {a : atomic} : a.inv.inv = a := by {
  cases a; unfold atomic.inv,
}

@[simp]
mutual lemma pie.inv_inv, list.inv_inv
  with pie.inv_inv : ∀ {p : pie}, p.inv.inv = p
  | (pie.atomic atom) := by {unfold pie.inv, congr, exact atomic.inv_inv}
  | (pie.add l r) := by {unfold pie.inv, congr; exact pie.inv_inv}
  | (pie.mul l r) := by {unfold pie.inv, congr; exact pie.inv_inv}
  | (pie.comp_list left xs right) :=by {
    unfold pie.inv,
    simp_rw pie.inv_inv,
    split,
    refl,
    split,
    have : ∀ l : list pie, l.inv.reverse = l.reverse.inv := by {
      clear_except,
      intros l,
      induction l,
      rw list.reverse_nil,
      have : list.nil.inv = list.nil := by {unfold list.inv},
      simp_rw this,
      {simp},
      simp,
      congr,
      exact l_ih,
    },
    rw this,
    rw list.reverse_reverse,
    exact list.inv_inv,
    refl,
  }
  with list.inv_inv : ∀ {xs : list pie}, xs.inv.inv = xs
  | [] := by {simp}
  | (x :: xs) := by {simp; split, exact pie.inv_inv, exact list.inv_inv}

mutual inductive pie.typed, list.typed
  with pie.typed : pie → base → base → Type
  | atomic (atom : atomic) {a b} : atom.typed a b → pie.typed (pie.atomic atom) a b
  | comp_list (a b c d) {left : pie} {xs : list pie} {right : pie} :
    pie.typed left a b →
    list.typed xs b c →
    pie.typed right c d →
    pie.typed (pie.comp_list left xs right) a d
  | add (a b c d) (f g : pie) :
    pie.typed f a b →
    pie.typed g c d →
    pie.typed (f.add g) (a + c) (b + d)
  | mul (a b c d) (f g : pie) :
    pie.typed f a b →
    pie.typed g c d →
    pie.typed (f.mul g) (a * c) (b * d)

  with list.typed : list pie → base → base → Type
  | nil (a) : list.typed [] a a
  | cons {a b c} (x : pie) (xs : list pie) :
    pie.typed x a b →
    list.typed xs b c →
    list.typed (x :: xs) a c

lemma list.typed.append {xs ys : list pie}
  {a b : base} (x_hyp : list.typed xs a b)
  {c : base} (y_hyp : list.typed ys b c) :
  list.typed (xs ++ ys) a c := by {
    induction x_hyp with b₀ b₁ b₂ b₃ x xs x_hyp xs_hyp ih,
    exact y_hyp,
    exact list.typed.cons x (xs ++ ys) x_hyp (ih y_hyp)
  }

lemma list.typed.singleton {p : pie} {a b} : p.typed a b → list.typed [p] a b :=
  λ h, list.typed.cons p [] h (list.typed.nil _)

lemma pie.comp_typed (f : pie) {a b c : base} :
  (f.typed a b) →
  ∀ g : pie,
  (g.typed b c) →
  ((f.comp g).typed a c) := by {
    intros f_hyp g g_hyp,
    cases f_hyp with
        f b' c' f_hyp
        f_a f_b f_c f_d f_left f_list f_right f_left_h f_list_h f_right_h
        f_a f_b f_c f_d f_left f_right f_left_h f_right_h
        f_a f_b f_c f_d f_left f_right f_left_h f_right_h;
      unfold pie.comp pie.left pie.lefts,
    {
      cases f_hyp with f_s _ _ f_s_hyp,
      all_goals {
        rw list.nil_append,
        cases g_hyp with
          g_atom g_a g_b g_hyp
          g_a g_b g_c g_d g_left g_list g_right g_left_h g_list_h g_right_h
          g_a g_b g_c g_d gf gg gf_h gg_h
          g_a g_b g_c g_d gf gg gf_h gg_h;
          unfold pie.rights; unfold pie.right,
        all_goals {
          apply pie.typed.comp_list,
          {apply pie.typed.atomic, constructor, assumption},
        },
        all_goals{ try {apply list.typed.nil}},
        {
          cases g_hyp with s _ _ s_hyp,
          {apply pie.typed.atomic, apply atomic.typed.forward, assumption},
          {apply pie.typed.atomic, apply atomic.typed.backward, assumption},
        },
        apply list.typed.cons; assumption,
        exact g_right_h,
        apply typed.add; assumption,
        apply typed.mul; assumption,
      },
    },
    {
      have f_list_right_h : (f_list ++ [f_right]).typed f_b b,
      {
        apply list.typed.append,
        exact f_list_h,
        apply list.typed.singleton,
        exact f_right_h,
      },
      cases g_hyp with
        g_atom g_a g_b g_hyp
        g_a g_b g_c g_d g_left g_list g_right g_left_h g_list_h g_right_h
        g_a g_b g_c g_d gf gg gf_h gg_h
        g_a g_b g_c g_d gf gg gf_h gg_h;
        unfold pie.rights; unfold pie.right,
      all_goals { try{
        rw list.append_nil,
        apply typed.comp_list; try {assumption},
      }},
      exact pie.typed.atomic g_atom g_hyp,
      {
        apply typed.comp_list; try {assumption},
        apply list.typed.append,
        exact f_list_right_h,
        apply list.typed.cons; assumption,
      },
      exact typed.add g_a g_b g_c g_d gf gg gf_h gg_h,
      exact typed.mul g_a g_b g_c g_d gf gg gf_h gg_h,
    },
    all_goals {
      rw list.nil_append,
      cases g_hyp with
        g_atom g_a g_b g_atom_h
        g_a g_b g_c g_d g_left g_list g_right g_left_h g_list_h g_right_h
        g_a g_b g_c g_d gf gg gf_h gg_h
        g_a g_b g_c g_d gf gg gf_h gg_h;
        unfold pie.rights; unfold pie.right,
      all_goals {
        apply typed.comp_list,
        constructor; assumption,
      },
      all_goals {try {apply typed.nil}},
      exact pie.typed.atomic g_atom g_atom_h,
      apply typed.cons; assumption,
      assumption,
      constructor; assumption,
    },
  }

def T (α) := option (α × α)

def T.map {α β} : T α → (α → β) → T β
  | none _ := none
  | (some (left, right)) f := some (f left, f right)

instance : functor T := {map := λ α β (f : α → β) (x : T α), x.map f}

instance : applicative T :=
  {
    pure := λ α x, some (x, x),
    seq := λ α β tf tx,
      match tf, tx with
      | (some (f, g)), (some (a, b)) := some (f a, g b)
      | _, _ := none
      end
  }

section abstract_machine

inductive pie_context : Type
  | add_left : pie → pie_context
  | mul_left : pie → pie_context
  | add_right : pie → pie_context
  | mul_right : pie → pie_context
  | comp_left : list pie → pie → pie_context
  | comp_list : pie → list pie → list pie → pie → pie_context
  | comp_right : pie → list pie → pie_context

open pie_context

def plug_in : pie_context → pie → pie
| (add_left right) left := pie.add left right
| (mul_left right) left := pie.mul left right
| (add_right left) right := pie.add left right
| (mul_right left) right := pie.mul left right
| (comp_left list right) left := pie.comp_list left list right
| (comp_list left list_left list_right right) mid :=
  pie.comp_list left (list_left ++ [mid] ++ list_right) right
| (comp_right left list) right := pie.comp_list left list right

@[simp]
lemma plug_in.add_left (left right) :
  plug_in (add_left right) left = pie.add left right :=
  rfl

@[simp]
lemma plug_in.mul_left (left right) :
  plug_in (mul_left right) left = pie.mul left right :=
  rfl

@[simp]
lemma plug_in.add_right (left right) :
  plug_in (add_right left) right = pie.add left right :=
  rfl

@[simp]
lemma plug_in.mul_right (left right) :
  plug_in (mul_right left) right = pie.mul left right :=
  rfl

@[simp]
lemma plug_in.comp_left (left list right) :
  plug_in (comp_left list right) left = pie.comp_list left list right :=
  rfl

@[simp]
lemma plug_in.comp_list (left list_left mid list_right right)
  : plug_in (comp_list left list_left list_right right) mid =
    pie.comp_list left (list_left ++ [mid] ++ list_right) right := rfl

@[simp]
lemma plug_in.comp_right (left list right) : plug_in (comp_right left list) right = pie.comp_list left list right :=
  rfl

def list.typed.append_midtype {C right} : ∀ {A} {left},
  list.typed (left ++ right) A C →
  Σ B : base, list.typed left A B × list.typed right B C
  | A [] p := ⟨A, ⟨typed.nil _, by {rw list.nil_append at p, exact p}⟩⟩
  | A (x :: xs) (typed.cons .(x) .(xs ++ right) x_typed xs_right_typed) :=
    match list.typed.append_midtype xs_right_typed with
    | ⟨B, p⟩ := ⟨B, ⟨typed.cons x xs x_typed p.1, p.2⟩ ⟩
    end

mutual def pie.depth, list.depth
  with pie.depth : pie -> ℕ
  | (pie.atomic atom) := 1
  | (pie.add l r) := (max l.depth r.depth) + 1
  | (pie.mul l r) := (max l.depth r.depth) + 1
  | (pie.comp_list left list_pie right) := (max left.depth (max list_pie.depth right.depth)) + 1
  with list.depth : list pie → ℕ
  | [] := 1
  | (x :: xs) := (x.depth + xs.depth) + 1

inductive emptyt

def base.to_type : base → Type
  | base.zero := emptyt
  | base.one := unit
  | (base.add l r) := l.to_type ⊕ r.to_type
  | (base.mul l r) := l.to_type  × r.to_type

@[simp]lemma base.to_type.zero : (0:base).to_type = emptyt := rfl
@[simp]lemma base.to_type.one : (1:base).to_type = unit := rfl
@[simp]lemma base.to_type.add (l r : base) : (l + r).to_type = (l.to_type ⊕ r.to_type) := rfl
@[simp]lemma base.to_type.mul (l r : base) : (l * r).to_type = (l.to_type  × r.to_type) := rfl

instance : has_coe_to_sort base :=
  {
    S := Type,
    coe := base.to_type
  }

@[simp]lemma base.coe_to_sort.zero : ↥(base.zero) = emptyt := rfl
@[simp]lemma base.coe_to_sort.one : ↥(base.one) = unit := rfl
@[simp]lemma base.coe_to_sort.add (l r : base) : ↥(l + r) = (↥l ⊕ ↥r) := rfl
@[simp]lemma base.coe_to_sort.mul (l r : base) : ↥(l * r) = (↥l  × ↥r) := rfl
@[simp]lemma base.coe_to_sort.to_to_type (b : base) : b.to_type = ↥b := rfl

def list.plug_in : pie → list pie_context → pie :=
  (list.foldl (flip plug_in))

structure am_state :=
  (focus_left : base)
  (focus_right : base)
  (focus : pie)
  (focus_typed : focus.typed focus_left focus_right)
  (board : list pie_context)
  (value : focus_left ⊕ focus_right)

def am_state.typed (state : am_state) : base → base → Type :=
  (state.board.plug_in state.focus).typed

open sum

def assoc_mul_run {A B C : Type} : ((A × B) × C) → (A × (B × C))
  | ((a, b), c) := (a, (b, c))

@[simp]
lemma assoc_mul_run_def {A B C : Type} (a : A) (b : B) (c : C) :
  assoc_mul_run ((a, b), c) = (a, (b, c)) := rfl

def zero_add_run {B : base} : (0 + B) → B
  | (inl z) := z.cases_on (λ _, B)
  | (inr b) := b

@[simp]
lemma zero_add_run.inl (z : (0 : base)) {B} :
  zero_add_run (inl z : (0 + B : base)) = z.cases_on (λ _, B) := rfl

@[simp]
lemma zero_add_run.inr {B : base} (b : B) :
  zero_add_run (inr b : (0 + B : base)) = b := rfl

def assoc_add_run {A B C : base} : (A + B + C) → (A + (B + C))
  | (inl (inl a)) := sum.inl a
  | (inl (inr b)) := sum.inr (inl b)
  | (inr c) := sum.inr (inr c)

@[simp]
def assoc_add_run.inl_inl {A B C : base} {a : A} :
  @assoc_add_run A B C (inl (inl a)) = inl a := rfl

@[simp]
def assoc_add_run.inl_inr {A B C : base} {b : B} :
  @assoc_add_run A B C (inl (inr b)) = inr (inl b) := rfl

@[simp]
def assoc_add_run.inr {A B C : base} {c : C} :
  @assoc_add_run A B C (inr c) = inr (inr c) := rfl

def distrib_run {A B C : base} : (A * (B + C)) → A * B + A * C
  | ⟨a, inl b⟩ := inl ⟨a, b⟩
  | ⟨a, inr c⟩ := inr ⟨a, c⟩

@[simp]
def distrib_run.inl {A B C : base} {a : A} {b : B} :
  @distrib_run A B C ⟨a, inl b⟩ = inl ⟨a, b⟩ := rfl

@[simp]
def distrib_run.inr {A B C : base} {a : A} {c : C} :
  @distrib_run A B C ⟨a, inr c⟩ = inr ⟨a, c⟩ := rfl

def subatomic.run : ∀ (s : subatomic) {A B : base}, s.typed A B → (A → B)
| subatomic.id := λ A B p, by {cases p, exact id}
| swap_add := λ A B p, by {cases p, exact sum.swap}
| subatomic.zero_add := λ A B p, by {cases p, exact zero_add_run}
| assoc_add := λ A B p, by {cases p, exact assoc_add_run}
| swap_mul := λ A B p, by {cases p, exact prod.swap}
| subatomic.one_mul := λ A B p, by {cases p, exact prod.snd}
| assoc_mul := λ A B p, by {cases p, exact assoc_mul_run}
| subatomic.distrib := λ A B p, by {cases p, exact distrib_run}
| distrib0 := λ A B p, by {cases p, exact prod.snd}

def assoc_mul_backrun {A B C : Type} : (A × B × C) → ((A × B) × C)
  | (a, (b, c)) := ((a, b), c)

@[simp]
lemma assoc_mul_backrun_def {A B C : Type} (a : A) (b : B) (c : C) :
  assoc_mul_backrun (a, (b, c)) = ((a, b), c) := rfl

def assoc_add_backrun {A B C : base} : (A + (B + C)) → (A + B + C)
  | (inl a) := inl (inl a)
  | (inr (inl b)) := inl (inr b)
  | (inr (inr c)) := (inr c)

@[simp]
def assoc_add_backrun.inl {A B C : base} {a : A} :
  @assoc_add_backrun A B C (inl a) = inl (inl a) := rfl

@[simp]
def assoc_add_backrun.inr_inl {A B C : base} {b : B} :
  @assoc_add_backrun A B C (inr (inl b)) = inl (inr b) := rfl

@[simp]
def assoc_add_backrun.inr_inr {A B C : base} {c : C} :
  @assoc_add_backrun A B C (inr (inr c)) = inr c := rfl

def one_mul_backrun {A : base} : A → (1 * A)
  | a := ⟨(), a⟩

@[simp]
lemma one_mul_backrun.def {A : base} (a : A) : one_mul_backrun a = ⟨(), a⟩ := rfl

def distrib_backrun {A B C : base} : A * B + A * C → A * (B + C)
  | (inl ⟨a, b⟩) := ⟨a, inl b⟩
  | (inr ⟨a, c⟩) := ⟨a, inr c⟩

@[simp]
def distrib_backrun.inl {A B C : base} {a : A} {b : B} :
  @distrib_backrun A B C (inl ⟨a, b⟩) = ⟨a, inl b⟩ := rfl

@[simp]
def distrib_backrun.inr {A B C : base} {a : A} {c : C} :
  @distrib_backrun A B C (inr ⟨a, c⟩) = ⟨a, inr c⟩ := rfl

def distrib0_backrun (A : base) : (0 : base) → A * 0
  | z := ⟨z.cases_on (λ _, A), z⟩

@[simp]
def distrib0_backrun.def (A : base) (z : (0 : base)) :
  distrib0_backrun A z = (⟨z.cases_on (λ _, A), z⟩ : A * 0) := rfl

def subatomic.backrun : ∀ (s : subatomic) {A B : base}, s.typed A B → (B → A)
| subatomic.id := λ A B p, by {cases p, exact id}
| swap_add := λ A B p, by {cases p, exact sum.swap}
| subatomic.zero_add := λ A B p, by {cases p, exact inr}
| assoc_add := λ A B p, by {cases p, exact assoc_add_backrun}
| swap_mul := λ A B p, by {cases p, exact prod.swap}
| subatomic.one_mul := λ A B p, by {cases p, exact one_mul_backrun}
| assoc_mul := λ A B p, by {cases p, exact assoc_mul_backrun}
| subatomic.distrib := λ A B p, by {cases p, exact distrib_backrun}
| distrib0 := λ A B p, by {cases p, exact distrib0_backrun _}

universe u

def base.card : base → ℕ
  | zero := 0
  | one := 1
  | (base.add l r) := l.card + r.card
  | (base.mul l r) := l.card * r.card

def base.to_fin : ∀ {A : base} (v : A), fin (A.card)
  | zero e := e.cases_on _
  | one _ := ⟨0, by {unfold base.card, exact nat.one_pos}⟩
  | (base.add l r) (inl v) :=
    let ⟨n, p⟩ := (base.to_fin v) in
    ⟨n, nat.lt_add_right n _ _ p⟩
  | (base.add l r) (inr v) :=
    let ⟨n, p⟩ := (base.to_fin v) in
    ⟨l.card + n, add_lt_add_left p (base.card l)⟩
  | (base.mul l r) ⟨vₗ, vᵣ⟩ :=
    let ⟨nₗ, pₗ⟩ := base.to_fin vₗ in
    let ⟨nᵣ, pᵣ⟩ := base.to_fin vᵣ in
    ⟨nₗ * r.card + nᵣ, by {
      unfold base.card,
      calc
        nₗ * r.card + nᵣ < nₗ * r.card + r.card : add_lt_add_left pᵣ (nₗ * base.card r)
        ... = (nₗ + 1) * r.card : by {rw add_mul, rw _root_.one_mul}
        ... ≤ l.card * r.card : mul_le_mul_right' (nat.succ_le_iff.mpr pₗ) (base.card r)
    }⟩

@[simp]
lemma sum.swap_inl {α β} {a : α} : (sum.inl a : α ⊕ β).swap = inr a := rfl
@[simp]
lemma sum.swap_inr {α β} {b : β} : (sum.inr b : α ⊕ β).swap = inl b := rfl

@[simp]
lemma prod.swap_def {α β} (a : α) (b : β) : (⟨a,b⟩ : α × β).swap = ⟨b,a⟩ := rfl

instance base.one.subsingleton : subsingleton (1 : base) := punit.subsingleton

def subatomic.run' : ∀ (s : subatomic) {A B}, s.typed A B → (A ≃ B) :=
  λ s A B p, ⟨s.run p, s.backrun p, by {
    intros a,
    cases p; unfold subatomic.run subatomic.backrun,
    {simp_rw id.def},
    {cases a; simp},
    {cases a, cases a, simp},
    {cases a, cases a, all_goals {simp}},
    {cases a; simp},
    {cases a; simp at *},
    {cases a, cases a_fst, simp},
    {cases a, cases a_snd,
      {rw distrib_run.inl, rw distrib_backrun.inl},
      {rw distrib_run.inr, rw distrib_backrun.inr},
    },
    {cases a, cases a_snd}
  },
  by {
    intros a,
    cases p; unfold subatomic.run subatomic.backrun,
    {simp_rw id.def},
    {cases a; simp},
    {simp},
    {cases a, simp, cases a; simp},
    {cases a; simp},
    {simp},
    {cases a, cases a_snd, simp},
    {cases a, cases a,
      {rw distrib_backrun.inl, rw distrib_run.inl},
      {cases a, rw distrib_backrun.inr, rw distrib_run.inr}
    },
    {cases a}
  }
  ⟩

def atomic.run {A B : base} : ∀ (a : atomic), a.typed A B → A → B
| (atomic.forward s) p :=  by {cases p, apply s.run, assumption}
| (atomic.backward s) p := by {cases p, apply s.backrun, assumption}

inductive pie.down.result (A B : base)
  | done : B → pie.down.result
  | left_context (f p : pie) (A' B' : base) :
    p.typed A' B' →
    (plug_in (add_left f) p).typed A B →
    A' →
    pie.down.result
  | right_context (p g : pie) (A' B' : base) :
    p.typed A' B' →
    (plug_in (add_right g) p).typed A B →
    A' →
    pie.down.result
  | mul_contexts (f g : pie) (A' B' C' D' : base) :
    f.typed A' B' →
    g.typed C' D' →
    (plug_in (mul_left f) g).typed A B →
    (plug_in (mul_right g) f).typed A B →
    A' →
    C' →
    pie.down.result
  | entering_comp (p : pie) (list : list pie) (right : pie) (A' B' : base) :
    p.typed A A' →
    list.typed A' B' →
    right.typed B' B →
    (plug_in (comp_left list right) p).typed A B →
    A →
    pie.down.result

open pie.down.result

def pie.down :
  ∀ (p : pie) {A B} (p_typed : p.typed A B), A → pie.down.result A B
  | (pie.atomic p_atom) A B (pie.typed.atomic .(p_atom) p_atom_typed) left_value :=
    done (p_atom.run p_atom_typed left_value)
  | (pie.add f g)
    (.(A) + .(C)) (.(B) + .(D))
    (pie.typed.add A B C D .(f) .(g) f_typed g_typed)
    left_value :=
      match left_value with
      | inl f_arg :=
        left_context g f A B f_typed (typed.add A B C D f g f_typed g_typed) f_arg
      | inr g_arg :=
        right_context g f C D g_typed (typed.add A B C D f g f_typed g_typed) g_arg
      end
  | (pie.mul f g)
    (.(A) * .(C)) (.(B) * .(D))
    (pie.typed.mul A B C D .(f) .(g) f_typed g_typed)
    left_value :=
      let h := typed.mul A B C D f g f_typed g_typed in
        mul_contexts g f C D A B g_typed f_typed h h left_value.snd left_value.fst
  | (pie.comp_list left list right)
    .(A) .(B)
    (pie.typed.comp_list A A' B' B left_typed list_typed right_typed)
    left_value := by {
      apply entering_comp left list right; try {assumption},
      apply pie.typed.comp_list; try {assumption},
    }

def am_state.step (now : am_state) : am_state ⊕ now.focus_right :=
  match now.value with
  | (inl left_value) :=
    match now.focus.run now.focus_typed left_value with
    |
  | (inr right_value) := _

-- end abstract_machine

end


/-
Copyright (c) 2022 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel

! This file was ported from Lean 3 source module category_theory.limits.exact_functor
! leanprover-community/mathlib commit 9fc53308a90fac244ac715308e1f9c969e6843a4
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Limits.Preserves.Finite

/-!
# Bundled exact functors

We say that a functor `F` is left exact if it preserves finite limits, it is right exact if it
preserves finite colimits, and it is exact if it is both left exact and right exact.

In this file, we define the categories of bundled left exact, right exact and exact functors.

-/

universe v₁ v₂ u₁ u₂

open CategoryTheory.Limits

namespace CategoryTheory

variable {C : Type u₁} [Category.{v₁} C] {D : Type u₂} [Category.{v₂} D]

section

variable (C) (D)

-- porting note: removed @[nolint has_nonempty_instance]
/-- Bundled left-exact functors. -/
def LeftExactFunctor :=
  FullSubcategory fun F : C ⥤ D => Nonempty (PreservesFiniteLimits F)
set_option linter.uppercaseLean3 false in
#align category_theory.LeftExactFunctor CategoryTheory.LeftExactFunctor

instance : Category (LeftExactFunctor C D) :=
  FullSubcategory.category _

/-- `C ⥤ₗ D` denotes left exact functors `C ⥤ D` -/
infixr:26 " ⥤ₗ " => LeftExactFunctor

/-- A left exact functor is in particular a functor. -/
def LeftExactFunctor.forget : (C ⥤ₗ D) ⥤ C ⥤ D :=
  fullSubcategoryInclusion _
set_option linter.uppercaseLean3 false in
#align category_theory.LeftExactFunctor.forget CategoryTheory.LeftExactFunctor.forget

instance : Full (LeftExactFunctor.forget C D) :=
  FullSubcategory.full _

instance : Faithful (LeftExactFunctor.forget C D) :=
  FullSubcategory.faithful _

-- porting note: removed @[nolint has_nonempty_instance]
/-- Bundled right-exact functors. -/
def RightExactFunctor :=
  FullSubcategory fun F : C ⥤ D => Nonempty (PreservesFiniteColimits F)
set_option linter.uppercaseLean3 false in
#align category_theory.RightExactFunctor CategoryTheory.RightExactFunctor

instance : Category (RightExactFunctor C D) :=
  FullSubcategory.category _

/-- `C ⥤ᵣ D` denotes right exact functors `C ⥤ D` -/
infixr:26 " ⥤ᵣ " => RightExactFunctor

/-- A right exact functor is in particular a functor. -/
def RightExactFunctor.forget : (C ⥤ᵣ D) ⥤ C ⥤ D :=
  fullSubcategoryInclusion _
set_option linter.uppercaseLean3 false in
#align category_theory.RightExactFunctor.forget CategoryTheory.RightExactFunctor.forget

instance : Full (RightExactFunctor.forget C D) :=
  FullSubcategory.full _

instance : Faithful (RightExactFunctor.forget C D) :=
  FullSubcategory.faithful _

-- porting note: removed @[nolint has_nonempty_instance]
/-- Bundled exact functors. -/
def ExactFunctor :=
  FullSubcategory fun F : C ⥤ D =>
    Nonempty (PreservesFiniteLimits F) ∧ Nonempty (PreservesFiniteColimits F)
set_option linter.uppercaseLean3 false in
#align category_theory.ExactFunctor CategoryTheory.ExactFunctor

instance : Category (ExactFunctor C D) :=
  FullSubcategory.category _

-- mathport name: «expr ⥤ₑ »
/-- `C ⥤ₑ D` denotes exact functors `C ⥤ D` -/
infixr:26 " ⥤ₑ " => ExactFunctor

/-- An exact functor is in particular a functor. -/
def ExactFunctor.forget : (C ⥤ₑ D) ⥤ C ⥤ D :=
  fullSubcategoryInclusion _
set_option linter.uppercaseLean3 false in
#align category_theory.ExactFunctor.forget CategoryTheory.ExactFunctor.forget

instance : Full (ExactFunctor.forget C D) :=
  FullSubcategory.full _

instance : Faithful (ExactFunctor.forget C D) :=
  FullSubcategory.faithful _

/-- Turn an exact functor into a left exact functor. -/
def LeftExactFunctor.ofExact : (C ⥤ₑ D) ⥤ C ⥤ₗ D :=
  FullSubcategory.map fun _ => And.left
set_option linter.uppercaseLean3 false in
#align category_theory.LeftExactFunctor.of_exact CategoryTheory.LeftExactFunctor.ofExact

instance : Full (LeftExactFunctor.ofExact C D) :=
  FullSubcategory.full_map _

instance : Faithful (LeftExactFunctor.ofExact C D) :=
  FullSubcategory.faithful_map _

/-- Turn an exact functor into a left exact functor. -/
def RightExactFunctor.ofExact : (C ⥤ₑ D) ⥤ C ⥤ᵣ D :=
  FullSubcategory.map fun _ => And.right
set_option linter.uppercaseLean3 false in
#align category_theory.RightExactFunctor.of_exact CategoryTheory.RightExactFunctor.ofExact

instance : Full (RightExactFunctor.ofExact C D) :=
  FullSubcategory.full_map _

instance : Faithful (RightExactFunctor.ofExact C D) :=
  FullSubcategory.faithful_map _

variable {C D}

@[simp]
theorem LeftExactFunctor.ofExact_obj (F : C ⥤ₑ D) :
    (LeftExactFunctor.ofExact C D).obj F = ⟨F.1, F.2.1⟩ :=
  rfl
set_option linter.uppercaseLean3 false in
#align category_theory.LeftExactFunctor.of_exact_obj CategoryTheory.LeftExactFunctor.ofExact_obj

@[simp]
theorem RightExactFunctor.ofExact_obj (F : C ⥤ₑ D) :
    (RightExactFunctor.ofExact C D).obj F = ⟨F.1, F.2.2⟩ :=
  rfl
set_option linter.uppercaseLean3 false in
#align category_theory.RightExactFunctor.of_exact_obj CategoryTheory.RightExactFunctor.ofExact_obj

@[simp]
theorem LeftExactFunctor.ofExact_map {F G : C ⥤ₑ D} (α : F ⟶ G) :
    (LeftExactFunctor.ofExact C D).map α = α :=
  rfl
set_option linter.uppercaseLean3 false in
#align category_theory.LeftExactFunctor.of_exact_map CategoryTheory.LeftExactFunctor.ofExact_map

@[simp]
theorem RightExactFunctor.ofExact_map {F G : C ⥤ₑ D} (α : F ⟶ G) :
    (RightExactFunctor.ofExact C D).map α = α :=
  rfl
set_option linter.uppercaseLean3 false in
#align category_theory.RightExactFunctor.of_exact_map CategoryTheory.RightExactFunctor.ofExact_map

@[simp]
theorem LeftExactFunctor.forget_obj (F : C ⥤ₗ D) : (LeftExactFunctor.forget C D).obj F = F.1 :=
  rfl
set_option linter.uppercaseLean3 false in
#align category_theory.LeftExactFunctor.forget_obj CategoryTheory.LeftExactFunctor.forget_obj

@[simp]
theorem RightExactFunctor.forget_obj (F : C ⥤ᵣ D) : (RightExactFunctor.forget C D).obj F = F.1 :=
  rfl
set_option linter.uppercaseLean3 false in
#align category_theory.RightExactFunctor.forget_obj CategoryTheory.RightExactFunctor.forget_obj

@[simp]
theorem ExactFunctor.forget_obj (F : C ⥤ₑ D) : (ExactFunctor.forget C D).obj F = F.1 :=
  rfl
set_option linter.uppercaseLean3 false in
#align category_theory.ExactFunctor.forget_obj CategoryTheory.ExactFunctor.forget_obj

@[simp]
theorem LeftExactFunctor.forget_map {F G : C ⥤ₗ D} (α : F ⟶ G) :
    (LeftExactFunctor.forget C D).map α = α :=
  rfl
set_option linter.uppercaseLean3 false in
#align category_theory.LeftExactFunctor.forget_map CategoryTheory.LeftExactFunctor.forget_map

@[simp]
theorem RightExactFunctor.forget_map {F G : C ⥤ᵣ D} (α : F ⟶ G) :
    (RightExactFunctor.forget C D).map α = α :=
  rfl
set_option linter.uppercaseLean3 false in
#align category_theory.RightExactFunctor.forget_map CategoryTheory.RightExactFunctor.forget_map

@[simp]
theorem ExactFunctor.forget_map {F G : C ⥤ₑ D} (α : F ⟶ G) : (ExactFunctor.forget C D).map α = α :=
  rfl
set_option linter.uppercaseLean3 false in
#align category_theory.ExactFunctor.forget_map CategoryTheory.ExactFunctor.forget_map

/-- Turn a left exact functor into an object of the category `LeftExactFunctor C D`. -/
def LeftExactFunctor.of (F : C ⥤ D) [PreservesFiniteLimits F] : C ⥤ₗ D :=
  ⟨F, ⟨inferInstance⟩⟩
set_option linter.uppercaseLean3 false in
#align category_theory.LeftExactFunctor.of CategoryTheory.LeftExactFunctor.of

/-- Turn a right exact functor into an object of the category `RightExactFunctor C D`. -/
def RightExactFunctor.of (F : C ⥤ D) [PreservesFiniteColimits F] : C ⥤ᵣ D :=
  ⟨F, ⟨inferInstance⟩⟩
set_option linter.uppercaseLean3 false in
#align category_theory.RightExactFunctor.of CategoryTheory.RightExactFunctor.of

/-- Turn an exact functor into an object of the category `ExactFunctor C D`. -/
def ExactFunctor.of (F : C ⥤ D) [PreservesFiniteLimits F] [PreservesFiniteColimits F] : C ⥤ₑ D :=
  ⟨F, ⟨⟨inferInstance⟩, ⟨inferInstance⟩⟩⟩
set_option linter.uppercaseLean3 false in
#align category_theory.ExactFunctor.of CategoryTheory.ExactFunctor.of

@[simp]
theorem LeftExactFunctor.of_fst (F : C ⥤ D) [PreservesFiniteLimits F] :
    (LeftExactFunctor.of F).obj = F :=
  rfl
set_option linter.uppercaseLean3 false in
#align category_theory.LeftExactFunctor.of_fst CategoryTheory.LeftExactFunctor.of_fst

@[simp]
theorem RightExactFunctor.of_fst (F : C ⥤ D) [PreservesFiniteColimits F] :
    (RightExactFunctor.of F).obj = F :=
  rfl
set_option linter.uppercaseLean3 false in
#align category_theory.RightExactFunctor.of_fst CategoryTheory.RightExactFunctor.of_fst

@[simp]
theorem ExactFunctor.of_fst (F : C ⥤ D) [PreservesFiniteLimits F] [PreservesFiniteColimits F] :
    (ExactFunctor.of F).obj = F :=
  rfl
set_option linter.uppercaseLean3 false in
#align category_theory.ExactFunctor.of_fst CategoryTheory.ExactFunctor.of_fst

theorem LeftExactFunctor.forget_obj_of (F : C ⥤ D) [PreservesFiniteLimits F] :
    (LeftExactFunctor.forget C D).obj (LeftExactFunctor.of F) = F :=
  rfl
set_option linter.uppercaseLean3 false in
#align category_theory.LeftExactFunctor.forget_obj_of CategoryTheory.LeftExactFunctor.forget_obj_of

theorem RightExactFunctor.forget_obj_of (F : C ⥤ D) [PreservesFiniteColimits F] :
    (RightExactFunctor.forget C D).obj (RightExactFunctor.of F) = F :=
  rfl
set_option linter.uppercaseLean3 false in
#align category_theory.RightExactFunctor.forget_obj_of CategoryTheory.RightExactFunctor.forget_obj_of

theorem ExactFunctor.forget_obj_of (F : C ⥤ D) [PreservesFiniteLimits F]
    [PreservesFiniteColimits F] : (ExactFunctor.forget C D).obj (ExactFunctor.of F) = F :=
  rfl
set_option linter.uppercaseLean3 false in
#align category_theory.ExactFunctor.forget_obj_of CategoryTheory.ExactFunctor.forget_obj_of

noncomputable instance (F : C ⥤ₗ D) : PreservesFiniteLimits F.obj :=
  F.property.some

noncomputable instance (F : C ⥤ᵣ D) : PreservesFiniteColimits F.obj :=
  F.property.some

noncomputable instance (F : C ⥤ₑ D) : PreservesFiniteLimits F.obj :=
  F.property.1.some

noncomputable instance (F : C ⥤ₑ D) : PreservesFiniteColimits F.obj :=
  F.property.2.some

end

end CategoryTheory


import tutorial_world.level13_leftright --hide
open IncidencePlane --hide
/- Tactic : apply

## Summary

If `h : P → Q` is a hypothesis, and the goal is `⊢ Q` then
`apply h` changes the goal to `⊢ P`.

## Details

If you have a function `h : P → Q` and your goal is `⊢ Q`
then `apply h` changes the goal to `⊢ P`. The logic is
simple: if you are trying to create a term of type `Q`,
but `h` is a function which turns terms of type `P` into
terms of type `Q`, then it will suffice to construct a
term of type `P`. A mathematician might say: "we need
to construct an element of $Q$, but we have a function $h:P\to Q$
so it suffices to construct an element of $P$". Or alternatively
"we need to prove $Q$, but we have a proof $h$ that $P\implies Q$
so it suffices to prove $P$".

-/

/-
# Tutorial World

## Level 14: the `apply` tactic.

In this level, we introduce the new tactic `apply`. Suppose you are asked to prove a goal of the form `⊢ R` and you have a theorem statement called `h` which
ensures that `h : P → Q → R`. Then, `apply h` will change your goal into proving `⊢ Q` and `⊢ P`. Now, read the lemma and do a drawing of the situation. Once,
you're done, delete the 'sorry' and try to look for a theorem statement that ends with the form of the goal shown for this level: `⊢ line_through Q P = line_through P Q`.
Can you see that `incidence` is the right theorem statement to use? Type `apply incidence,` and make an effort to finish the proof by your own.

-/

/- Hint : Click here for a hint, in case you get stuck.
The tactic that comes handy for solving the three remaining goals is `exact`. You may need to use a theorem statement to
close two of the goals. Bewildered? Click on "View source" (located on the top right corner of the game screen) to see the solution.
-/

variables {Ω : Type} [IncidencePlane Ω] -- hide
variables {P Q : Ω} -- hide

/- Lemma :
The line through two points is a symmetrical concept.
-/
lemma line_through_symmetrical (h : P ≠ Q) : line_through Q P = line_through P Q :=
begin
  apply incidence,
  {
    exact h,
  },
  {
    exact line_through_right Q P,
  },
  {
    exact line_through_left Q P,
  },

end