/-
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
import measure_theory.measure.open_pos

/-!
# 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 ×ˢ 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 ×ˢ 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 (×ˢ) 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 (×ˢ) C D) :=
begin
  rcases ⟨hC, hD⟩ with ⟨⟨s, h1s, h2s⟩, t, h1t, h2t⟩,
  refine ⟨λ n, (s n.unpair.1) ×ˢ (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]

/-! ### 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 (×ˢ) 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 (×ˢ) 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 ×ˢ t` for sets `s : set α` and
  `t : set β`. -/
lemma generate_from_prod :
  generate_from (image2 (×ˢ) {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 (×ˢ) {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_left (hf.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 ν] ⦃f : α → β → E⦄
  (hf : strongly_measurable (uncurry f)) : measurable_set {x | integrable (f x) ν} :=
begin
  simp_rw [integrable, hf.of_uncurry_left.ae_strongly_measurable, true_and],
  exact measurable_set_lt (measurable.lintegral_prod_right hf.ennnorm) measurable_const
end

section
variables [normed_space ℝ E] [complete_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 measure_theory.strongly_measurable.integral_prod_right [sigma_finite ν] ⦃f : α → β → E⦄
  (hf : strongly_measurable (uncurry f)) : strongly_measurable (λ x, ∫ y, f x y ∂ν) :=
begin
  borelize E,
  haveI : separable_space (range (uncurry f) ∪ {0} : set E) :=
    hf.separable_space_range_union_singleton,
  let s : ℕ → simple_func (α × β) E := simple_func.approx_on _ hf.measurable
    (range (uncurry f) ∪ {0}) 0 (by simp),
  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, strongly_measurable (f' n),
  { intro n, refine strongly_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.strongly_measurable_sum _ (λ x _, _),
    refine (measurable.ennreal_to_real _).strongly_measurable.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).ae_strongly_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_strongly_measurable) (hfx.norm.add hfx.norm) _ _,
      { exact λ n, eventually_of_forall (λ y, simple_func.norm_approx_on_zero_le _ _ (x, y) n) },
      { refine eventually_of_forall (λ y, simple_func.tendsto_approx_on _ _ _),
        apply subset_closure,
        simp [-uncurry_apply_pair], } },
    { simpa [f', hfx, integral_undef] using @tendsto_const_nhds _ _ _ (0 : E) _, } },
  exact strongly_measurable_of_tendsto _ 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 measure_theory.strongly_measurable.integral_prod_right' [sigma_finite ν] ⦃f : α × β → E⦄
  (hf : strongly_measurable f) : strongly_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 measure_theory.strongly_measurable.integral_prod_left [sigma_finite μ] ⦃f : α → β → E⦄
  (hf : strongly_measurable (uncurry f)) : strongly_measurable (λ y, ∫ x, f x y ∂μ) :=
(hf.comp_measurable 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 measure_theory.strongly_measurable.integral_prod_left' [sigma_finite μ] ⦃f : α × β → E⦄
  (hf : strongly_measurable f) : strongly_measurable (λ y, ∫ x, f (x, y) ∂μ) :=
(hf.comp_measurable 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 ×ˢ t) = μ s * ν t :=
begin
  apply le_antisymm,
  { set ST := (to_measurable μ s) ×ˢ (to_measurable ν t),
    have hSTm : measurable_set ST :=
      (measurable_set_to_measurable _ _).prod (measurable_set_to_measurable _ _),
    calc μ.prod ν (s ×ˢ 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 ×ˢ t),
    have hSTm : measurable_set ST := measurable_set_to_measurable _ _,
    have hST : s ×ˢ 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 ×ˢ t)     : measure_to_measurable _ }
end

instance {X Y : Type*} [topological_space X] [topological_space Y]
  {m : measurable_space X} {μ : measure X} [is_open_pos_measure μ]
  {m' : measurable_space Y} {ν : measure Y} [is_open_pos_measure ν] [sigma_finite ν] :
  is_open_pos_measure (μ.prod ν) :=
begin
  constructor,
  rintros U U_open ⟨⟨x, y⟩, hxy⟩,
  rcases is_open_prod_iff.1 U_open x y hxy with ⟨u, v, u_open, v_open, xu, yv, huv⟩,
  refine ne_of_gt (lt_of_lt_of_le _ (measure_mono huv)),
  simp only [prod_prod, canonically_ordered_comm_semiring.mul_pos],
  split,
  { exact u_open.measure_pos μ ⟨x, xu⟩ },
  { exact v_open.measure_pos ν ⟨y, yv⟩ }
end

instance {α β : Type*} {mα : measurable_space α} {mβ : measurable_space β}
  (μ : measure α) (ν : measure β) [is_finite_measure μ] [is_finite_measure ν] :
  is_finite_measure (μ.prod ν) :=
begin
  constructor,
  rw [← univ_prod_univ, prod_prod],
  exact mul_lt_top (measure_lt_top _ _).ne (measure_lt_top _ _).ne,
end

instance {α β : Type*} {mα : measurable_space α} {mβ : measurable_space β}
  (μ : measure α) (ν : measure β) [is_probability_measure μ] [is_probability_measure ν] :
  is_probability_measure (μ.prod ν) :=
⟨by rw [← univ_prod_univ, prod_prod, measure_univ, measure_univ, mul_one]⟩

instance {α β : Type*} [topological_space α] [topological_space β]
  {mα : measurable_space α} {mβ : measurable_space β} (μ : measure α) (ν : measure β)
  [is_finite_measure_on_compacts μ] [is_finite_measure_on_compacts ν] [sigma_finite ν] :
  is_finite_measure_on_compacts (μ.prod ν) :=
begin
  refine ⟨λ K hK, _⟩,
  set L := (prod.fst '' K) ×ˢ (prod.snd '' K) with hL,
  have : K ⊆ L,
  { rintros ⟨x, y⟩ hxy,
    simp only [prod_mk_mem_set_prod_eq, mem_image, prod.exists, exists_and_distrib_right,
      exists_eq_right],
    exact ⟨⟨y, hxy⟩, ⟨x, hxy⟩⟩ },
  apply lt_of_le_of_lt (measure_mono this),
  rw [hL, prod_prod],
  exact mul_lt_top ((is_compact.measure_lt_top ((hK.image continuous_fst))).ne)
                   ((is_compact.measure_lt_top ((hK.image continuous_snd))).ne)
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.ae_strongly_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. -/
noncomputable! 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 (×ˢ) C D) :=
begin
  haveI := hν.sigma_finite,
  refine ⟨λ n, hμ.set n.unpair.1 ×ˢ 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), μν (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 ×ˢ 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 ×ˢ 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 ×ˢ (univ : set β)) :=
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.ae_measurable,
  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

open measure

namespace measure_preserving

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, measure.map_zero, zero_prod],
    exact ⟨this, by simp only [measure.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.ae_measurable (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 ×ˢ 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

namespace quasi_measure_preserving

lemma prod_of_right {f : α × β → γ} {μ : measure α} {ν : measure β} {τ : measure γ}
  (hf : measurable f) [sigma_finite ν]
  (h2f : ∀ᵐ x ∂μ, quasi_measure_preserving (λ y, f (x, y)) ν τ) :
  quasi_measure_preserving f (μ.prod ν) τ :=
begin
  refine ⟨hf, _⟩,
  refine absolutely_continuous.mk (λ s hs h2s, _),
  simp_rw [map_apply hf hs, prod_apply (hf hs), preimage_preimage,
    lintegral_congr_ae (h2f.mono (λ x hx, hx.preimage_null h2s)), lintegral_zero],
end

lemma prod_of_left {α β γ} [measurable_space α] [measurable_space β]
  [measurable_space γ] {f : α × β → γ} {μ : measure α} {ν : measure β} {τ : measure γ}
  (hf : measurable f) [sigma_finite μ] [sigma_finite ν]
  (h2f : ∀ᵐ y ∂ν, quasi_measure_preserving (λ x, f (x, y)) μ τ) :
  quasi_measure_preserving f (μ.prod ν) τ :=
begin
  rw [← prod_swap],
  convert (quasi_measure_preserving.prod_of_right (hf.comp measurable_swap) h2f).comp
    ((measurable_swap.measure_preserving (ν.prod μ)).symm measurable_equiv.prod_comm)
    .quasi_measure_preserving,
  ext ⟨x, y⟩, refl,
end

end quasi_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 measure_theory.ae_strongly_measurable.prod_swap
  {γ : Type*} [topological_space γ] [sigma_finite μ] [sigma_finite ν] {f : β × α → γ}
  (hf : ae_strongly_measurable f (ν.prod μ)) :
  ae_strongly_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

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

lemma measure_theory.ae_strongly_measurable.snd {γ} [topological_space γ] [sigma_finite ν]
  {f : β → γ} (hf : ae_strongly_measurable f ν) :
  ae_strongly_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 measure_theory.ae_strongly_measurable.integral_prod_right' [sigma_finite ν]
  [normed_space ℝ E] [complete_space E]
  ⦃f : α × β → E⦄ (hf : ae_strongly_measurable f (μ.prod ν)) :
  ae_strongly_measurable (λ x, ∫ y, f (x, y) ∂ν) μ :=
⟨λ x, ∫ y, hf.mk f (x, y) ∂ν, hf.strongly_measurable_mk.integral_prod_right',
  by { filter_upwards [ae_ae_of_ae_prod hf.ae_eq_mk] with _ hx using integral_congr_ae hx }⟩

lemma measure_theory.ae_strongly_measurable.prod_mk_left
  {γ : Type*} [sigma_finite ν] [topological_space γ] {f : α × β → γ}
  (hf : ae_strongly_measurable f (μ.prod ν)) : ∀ᵐ x ∂μ, ae_strongly_measurable (λ y, f (x, y)) ν :=
begin
  filter_upwards [ae_ae_of_ae_prod hf.ae_eq_mk] with x hx,
  exact ⟨λ y, hf.mk f (x, y), hf.strongly_measurable_mk.comp_measurable 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.ae_measurable, 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_left, measurable.lintegral_prod_right', hf.comp m, hf, 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] with _ ha using 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

lemma integrable.swap [sigma_finite μ] ⦃f : α × β → E⦄
  (hf : integrable f (μ.prod ν)) : integrable (f ∘ prod.swap) (ν.prod μ) :=
⟨hf.ae_strongly_measurable.prod_swap,
  (lintegral_prod_swap _ hf.ae_strongly_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 : strongly_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 measurable_prod_mk_left).ae_strongly_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_strongly_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.strongly_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] with _ hx
      using 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_strongly_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_strongly_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_strongly_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_strongly_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

lemma integrable_prod_mul {f : α → ℝ} {g : β → ℝ} (hf : integrable f μ) (hg : integrable g ν) :
  integrable (λ (z : α × β), f z.1 * g z.2) (μ.prod ν) :=
begin
  refine (integrable_prod_iff _).2 ⟨_, _⟩,
  { apply ae_strongly_measurable.mul,
    { exact (hf.1.mono' prod_fst_absolutely_continuous).comp_measurable measurable_fst },
    { exact (hg.1.mono' prod_snd_absolutely_continuous).comp_measurable measurable_snd } },
  { exact eventually_of_forall (λ x, hg.const_mul (f x)) },
  { simpa only [norm_mul, integral_mul_left] using hf.norm.mul_const _ }
end

end

variables [normed_space ℝ E] [complete_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_strongly_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_strongly_measurable f (μ.prod ν)) : ∫ z, f z.swap ∂(ν.prod μ) = ∫ z, f z ∂(μ.prod ν) :=
begin
  rw ← prod_swap at hf,
  rw [← integral_map measurable_swap.ae_measurable hf, prod_swap]
end

variables {E' : Type*} [normed_group E'] [complete_space E'] [normed_space ℝ 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] with _ 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] with _ 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] with _ 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, (∥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, ∥i (x, y) - g (x, y)∥₊ ∂ν ∂μ },
  swap, { exact λ i, lintegral_mono (λ x, ennnorm_integral_le_lintegral_ennnorm _) },
  show tendsto (λ (i : α × β →₁[μ.prod ν] E),
    ∫⁻ x, ∫⁻ (y : β), ∥i (x, y) - g (x, y)∥₊ ∂ν ∂μ) (𝓝 g) (𝓝 0),
  have : ∀ (i : α × β →₁[μ.prod ν] E), measurable (λ z, (∥i z - g z∥₊ : ℝ≥0∞)) :=
  λ i, ((Lp.strongly_measurable i).sub (Lp.strongly_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_strongly_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 ×ˢ t) (μ.prod ν)) :
  ∫ z in s ×ˢ 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

lemma integral_prod_mul (f : α → ℝ) (g : β → ℝ) :
  ∫ z, f z.1 * g z.2 ∂(μ.prod ν) = (∫ x, f x ∂μ) * (∫ y, g y ∂ν) :=
begin
  by_cases h : integrable (λ (z : α × β), f z.1 * g z.2) (μ.prod ν),
  { rw integral_prod _ h,
    simp_rw [integral_mul_left, integral_mul_right] },
  have H : ¬(integrable f μ) ∨ ¬(integrable g ν),
  { contrapose! h,
    exact integrable_prod_mul h.1 h.2 },
  cases H;
  simp [integral_undef h, integral_undef H],
end

lemma set_integral_prod_mul (f : α → ℝ) (g : β → ℝ) (s : set α) (t : set β) :
  ∫ z in s ×ˢ t, f z.1 * g z.2 ∂(μ.prod ν) = (∫ x in s, f x ∂μ) * (∫ y in t, g y ∂ν) :=
by simp only [← measure.prod_restrict s t, integrable_on, integral_prod_mul]

end measure_theory


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Stephen Morgan, Scott Morrison
-/
import category_theory.equivalence

/-!
# Opposite categories

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

We provide a category instance on `Cᵒᵖ`.
The morphisms `X ⟶ Y` are defined to be the morphisms `unop Y ⟶ unop X` in `C`.

Here `Cᵒᵖ` is an irreducible typeclass synonym for `C`
(it is the same one used in the algebra library).

We also provide various mechanisms for constructing opposite morphisms, functors,
and natural transformations.

Unfortunately, because we do not have a definitional equality `op (op X) = X`,
there are quite a few variations that are needed in practice.
-/

universes v₁ v₂ u₁ u₂ -- morphism levels before object levels. See note [category_theory universes].

open opposite

variables {C : Type u₁}

section quiver

variables [quiver.{v₁} C]

lemma quiver.hom.op_inj {X Y : C} :
  function.injective (quiver.hom.op : (X ⟶ Y) → (op Y ⟶ op X)) :=
λ _ _ H, congr_arg quiver.hom.unop H

lemma quiver.hom.unop_inj {X Y : Cᵒᵖ} :
  function.injective (quiver.hom.unop : (X ⟶ Y) → (unop Y ⟶ unop X)) :=
λ _ _ H, congr_arg quiver.hom.op H

@[simp] lemma quiver.hom.unop_op {X Y : C} (f : X ⟶ Y) : f.op.unop = f := rfl
@[simp] lemma quiver.hom.op_unop {X Y : Cᵒᵖ} (f : X ⟶ Y) : f.unop.op = f := rfl

end quiver

namespace category_theory

variables [category.{v₁} C]

/--
The opposite category.

See <https://stacks.math.columbia.edu/tag/001M>.
-/
instance category.opposite : category.{v₁} Cᵒᵖ :=
{ comp := λ _ _ _ f g, (g.unop ≫ f.unop).op,
  id   := λ X, (𝟙 (unop X)).op }

@[simp] lemma op_comp {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z} :
  (f ≫ g).op = g.op ≫ f.op := rfl
@[simp] lemma op_id {X : C} : (𝟙 X).op = 𝟙 (op X) := rfl

@[simp] lemma unop_comp {X Y Z : Cᵒᵖ} {f : X ⟶ Y} {g : Y ⟶ Z} :
  (f ≫ g).unop = g.unop ≫ f.unop := rfl
@[simp] lemma unop_id {X : Cᵒᵖ} : (𝟙 X).unop = 𝟙 (unop X) := rfl

@[simp] lemma unop_id_op {X : C} : (𝟙 (op X)).unop = 𝟙 X := rfl
@[simp] lemma op_id_unop {X : Cᵒᵖ} : (𝟙 (unop X)).op = 𝟙 X := rfl

section
variables (C)

/-- The functor from the double-opposite of a category to the underlying category. -/
@[simps]
def op_op : (Cᵒᵖ)ᵒᵖ ⥤ C :=
{ obj := λ X, unop (unop X),
  map := λ X Y f, f.unop.unop }

/-- The functor from a category to its double-opposite.  -/
@[simps]
def unop_unop : C ⥤ Cᵒᵖᵒᵖ :=
{ obj := λ X, op (op X),
  map := λ X Y f, f.op.op }

/-- The double opposite category is equivalent to the original. -/
@[simps]
def op_op_equivalence : Cᵒᵖᵒᵖ ≌ C :=
{ functor := op_op C,
  inverse := unop_unop C,
  unit_iso := iso.refl (𝟭 Cᵒᵖᵒᵖ),
  counit_iso := iso.refl (unop_unop C ⋙ op_op C) }

end

/-- If `f` is an isomorphism, so is `f.op` -/
instance is_iso_op {X Y : C} (f : X ⟶ Y) [is_iso f] : is_iso f.op :=
⟨⟨(inv f).op,
  ⟨quiver.hom.unop_inj (by tidy), quiver.hom.unop_inj (by tidy)⟩⟩⟩

/--
If `f.op` is an isomorphism `f` must be too.
(This cannot be an instance as it would immediately loop!)
-/
lemma is_iso_of_op {X Y : C} (f : X ⟶ Y) [is_iso f.op] : is_iso f :=
⟨⟨(inv (f.op)).unop,
  ⟨quiver.hom.op_inj (by simp), quiver.hom.op_inj (by simp)⟩⟩⟩

lemma is_iso_op_iff {X Y : C} (f : X ⟶ Y) : is_iso f.op ↔ is_iso f :=
⟨λ hf, by exactI is_iso_of_op _, λ hf, by exactI infer_instance⟩

lemma is_iso_unop_iff {X Y : Cᵒᵖ} (f : X ⟶ Y) : is_iso f.unop ↔ is_iso f :=
by rw [← is_iso_op_iff f.unop, quiver.hom.op_unop]

instance is_iso_unop {X Y : Cᵒᵖ} (f : X ⟶ Y) [is_iso f] : is_iso f.unop :=
(is_iso_unop_iff _).2 infer_instance

@[simp] lemma op_inv {X Y : C} (f : X ⟶ Y) [is_iso f] : (inv f).op = inv f.op :=
by { ext, rw [← op_comp, is_iso.inv_hom_id, op_id] }

@[simp] lemma unop_inv {X Y : Cᵒᵖ} (f : X ⟶ Y) [is_iso f] : (inv f).unop = inv f.unop :=
by { ext, rw [← unop_comp, is_iso.inv_hom_id, unop_id] }

namespace functor

section

variables {D : Type u₂} [category.{v₂} D]

variables {C D}

/--
The opposite of a functor, i.e. considering a functor `F : C ⥤ D` as a functor `Cᵒᵖ ⥤ Dᵒᵖ`.
In informal mathematics no distinction is made between these.
-/
@[simps]
protected def op (F : C ⥤ D) : Cᵒᵖ ⥤ Dᵒᵖ :=
{ obj := λ X, op (F.obj (unop X)),
  map := λ X Y f, (F.map f.unop).op }

/--
Given a functor `F : Cᵒᵖ ⥤ Dᵒᵖ` we can take the "unopposite" functor `F : C ⥤ D`.
In informal mathematics no distinction is made between these.
-/
@[simps]
protected def unop (F : Cᵒᵖ ⥤ Dᵒᵖ) : C ⥤ D :=
{ obj := λ X, unop (F.obj (op X)),
  map := λ X Y f, (F.map f.op).unop }

/-- The isomorphism between `F.op.unop` and `F`. -/
@[simps] def op_unop_iso (F : C ⥤ D) : F.op.unop ≅ F :=
nat_iso.of_components (λ X, iso.refl _) (by tidy)

/-- The isomorphism between `F.unop.op` and `F`. -/
@[simps] def unop_op_iso (F : Cᵒᵖ ⥤ Dᵒᵖ) : F.unop.op ≅ F :=
nat_iso.of_components (λ X, iso.refl _) (by tidy)

variables (C D)

/--
Taking the opposite of a functor is functorial.
-/
@[simps]
def op_hom : (C ⥤ D)ᵒᵖ ⥤ (Cᵒᵖ ⥤ Dᵒᵖ) :=
{ obj := λ F, (unop F).op,
  map := λ F G α,
  { app := λ X, (α.unop.app (unop X)).op,
    naturality' := λ X Y f, quiver.hom.unop_inj (α.unop.naturality f.unop).symm } }

/--
Take the "unopposite" of a functor is functorial.
-/
@[simps]
def op_inv : (Cᵒᵖ ⥤ Dᵒᵖ) ⥤ (C ⥤ D)ᵒᵖ :=
{ obj := λ F, op F.unop,
  map := λ F G α, quiver.hom.op
  { app := λ X, (α.app (op X)).unop,
    naturality' := λ X Y f, quiver.hom.op_inj $ (α.naturality f.op).symm } }

variables {C D}

/--
Another variant of the opposite of functor, turning a functor `C ⥤ Dᵒᵖ` into a functor `Cᵒᵖ ⥤ D`.
In informal mathematics no distinction is made.
-/
@[simps]
protected def left_op (F : C ⥤ Dᵒᵖ) : Cᵒᵖ ⥤ D :=
{ obj := λ X, unop (F.obj (unop X)),
  map := λ X Y f, (F.map f.unop).unop }

/--
Another variant of the opposite of functor, turning a functor `Cᵒᵖ ⥤ D` into a functor `C ⥤ Dᵒᵖ`.
In informal mathematics no distinction is made.
-/
@[simps]
protected def right_op (F : Cᵒᵖ ⥤ D) : C ⥤ Dᵒᵖ :=
{ obj := λ X, op (F.obj (op X)),
  map := λ X Y f, (F.map f.op).op }

instance {F : C ⥤ D} [full F] : full F.op :=
{ preimage := λ X Y f, (F.preimage f.unop).op }

instance {F : C ⥤ D} [faithful F] : faithful F.op :=
{ map_injective' := λ X Y f g h,
    quiver.hom.unop_inj $ by simpa using map_injective F (quiver.hom.op_inj h) }

/-- If F is faithful then the right_op of F is also faithful. -/
instance right_op_faithful {F : Cᵒᵖ ⥤ D} [faithful F] : faithful F.right_op :=
{ map_injective' := λ X Y f g h, quiver.hom.op_inj (map_injective F (quiver.hom.op_inj h)) }

/-- If F is faithful then the left_op of F is also faithful. -/
instance left_op_faithful {F : C ⥤ Dᵒᵖ} [faithful F] : faithful F.left_op :=
{ map_injective' := λ X Y f g h, quiver.hom.unop_inj (map_injective F (quiver.hom.unop_inj h)) }

/-- The isomorphism between `F.left_op.right_op` and `F`. -/
@[simps]
def left_op_right_op_iso (F : C ⥤ Dᵒᵖ) : F.left_op.right_op ≅ F :=
nat_iso.of_components (λ X, iso.refl _) (by tidy)

/-- The isomorphism between `F.right_op.left_op` and `F`. -/
@[simps]
def right_op_left_op_iso (F : Cᵒᵖ ⥤ D) : F.right_op.left_op ≅ F :=
nat_iso.of_components (λ X, iso.refl _) (by tidy)

/-- Whenever possible, it is advisable to use the isomorphism `right_op_left_op_iso`
instead of this equality of functors. -/
lemma right_op_left_op_eq (F : Cᵒᵖ ⥤ D) : F.right_op.left_op = F := by { cases F, refl, }

end

end functor

namespace nat_trans

variables {D : Type u₂} [category.{v₂} D]

section
variables {F G : C ⥤ D}

/-- The opposite of a natural transformation. -/
@[simps] protected def op (α : F ⟶ G) : G.op ⟶ F.op :=
{ app         := λ X, (α.app (unop X)).op,
  naturality' := λ X Y f, quiver.hom.unop_inj (by simp) }

@[simp] lemma op_id (F : C ⥤ D) : nat_trans.op (𝟙 F) = 𝟙 (F.op) := rfl

/-- The "unopposite" of a natural transformation. -/
@[simps] protected def unop {F G : Cᵒᵖ ⥤ Dᵒᵖ} (α : F ⟶ G) : G.unop ⟶ F.unop :=
{ app         := λ X, (α.app (op X)).unop,
  naturality' := λ X Y f, quiver.hom.op_inj (by simp) }

@[simp] lemma unop_id (F : Cᵒᵖ ⥤ Dᵒᵖ) : nat_trans.unop (𝟙 F) = 𝟙 (F.unop) := rfl

/--
Given a natural transformation `α : F.op ⟶ G.op`,
we can take the "unopposite" of each component obtaining a natural transformation `G ⟶ F`.
-/
@[simps] protected def remove_op (α : F.op ⟶ G.op) : G ⟶ F :=
{ app         := λ X, (α.app (op X)).unop,
  naturality' := λ X Y f, quiver.hom.op_inj $
    by simpa only [functor.op_map] using (α.naturality f.op).symm }

@[simp] lemma remove_op_id (F : C ⥤ D) : nat_trans.remove_op (𝟙 F.op) = 𝟙 F := rfl

/-- Given a natural transformation `α : F.unop ⟶ G.unop`, we can take the opposite of each
component obtaining a natural transformation `G ⟶ F`. -/
@[simps] protected def remove_unop {F G : Cᵒᵖ ⥤ Dᵒᵖ} (α : F.unop ⟶ G.unop) : G ⟶ F :=
{ app := λ X, (α.app (unop X)).op,
  naturality' := λ X Y f, quiver.hom.unop_inj $
    by simpa only [functor.unop_map] using (α.naturality f.unop).symm }

@[simp] lemma remove_unop_id (F : Cᵒᵖ ⥤ Dᵒᵖ) : nat_trans.remove_unop (𝟙 F.unop) = 𝟙 F := rfl

end

section
variables {F G H : C ⥤ Dᵒᵖ}

/--
Given a natural transformation `α : F ⟶ G`, for `F G : C ⥤ Dᵒᵖ`,
taking `unop` of each component gives a natural transformation `G.left_op ⟶ F.left_op`.
-/
@[simps] protected def left_op (α : F ⟶ G) : G.left_op ⟶ F.left_op :=
{ app         := λ X, (α.app (unop X)).unop,
  naturality' := λ X Y f, quiver.hom.op_inj (by simp) }

@[simp] lemma left_op_id : (𝟙 F : F ⟶ F).left_op = 𝟙 F.left_op := rfl

@[simp] lemma left_op_comp (α : F ⟶ G) (β : G ⟶ H) :
  (α ≫ β).left_op = β.left_op ≫ α.left_op := rfl

/--
Given a natural transformation `α : F.left_op ⟶ G.left_op`, for `F G : C ⥤ Dᵒᵖ`,
taking `op` of each component gives a natural transformation `G ⟶ F`.
-/
@[simps] protected def remove_left_op (α : F.left_op ⟶ G.left_op) : G ⟶ F :=
{ app         := λ X, (α.app (op X)).op,
  naturality' := λ X Y f, quiver.hom.unop_inj $
    by simpa only [functor.left_op_map] using (α.naturality f.op).symm }

@[simp] lemma remove_left_op_id : nat_trans.remove_left_op (𝟙 F.left_op) = 𝟙 F := rfl

end

section
variables {F G H : Cᵒᵖ ⥤ D}

/--
Given a natural transformation `α : F ⟶ G`, for `F G : Cᵒᵖ ⥤ D`,
taking `op` of each component gives a natural transformation `G.right_op ⟶ F.right_op`.
-/
@[simps] protected def right_op (α : F ⟶ G) : G.right_op ⟶ F.right_op :=
{ app := λ X, (α.app _).op,
  naturality' := λ X Y f, quiver.hom.unop_inj (by simp) }

@[simp] lemma right_op_id : (𝟙 F : F ⟶ F).right_op = 𝟙 F.right_op := rfl

@[simp] lemma right_op_comp (α : F ⟶ G) (β : G ⟶ H) :
  (α ≫ β).right_op = β.right_op ≫ α.right_op := rfl

/--
Given a natural transformation `α : F.right_op ⟶ G.right_op`, for `F G : Cᵒᵖ ⥤ D`,
taking `unop` of each component gives a natural transformation `G ⟶ F`.
-/
@[simps] protected def remove_right_op (α : F.right_op ⟶ G.right_op) : G ⟶ F :=
{ app := λ X, (α.app X.unop).unop,
  naturality' := λ X Y f, quiver.hom.op_inj $
    by simpa only [functor.right_op_map] using (α.naturality f.unop).symm }

@[simp] lemma remove_right_op_id : nat_trans.remove_right_op (𝟙 F.right_op) = 𝟙 F := rfl

end
end nat_trans

namespace iso

variables {X Y : C}

/--
The opposite isomorphism.
-/
@[simps]
protected def op (α : X ≅ Y) : op Y ≅ op X :=
{ hom := α.hom.op,
  inv := α.inv.op,
  hom_inv_id' := quiver.hom.unop_inj α.inv_hom_id,
  inv_hom_id' := quiver.hom.unop_inj α.hom_inv_id }

/-- The isomorphism obtained from an isomorphism in the opposite category. -/
@[simps] def unop {X Y : Cᵒᵖ} (f : X ≅ Y) : Y.unop ≅ X.unop :=
{ hom := f.hom.unop,
  inv := f.inv.unop,
  hom_inv_id' := by simp only [← unop_comp, f.inv_hom_id, unop_id],
  inv_hom_id' := by simp only [← unop_comp, f.hom_inv_id, unop_id] }

@[simp] lemma unop_op {X Y : Cᵒᵖ} (f : X ≅ Y) : f.unop.op = f :=
by ext; refl

@[simp] lemma op_unop {X Y : C} (f : X ≅ Y) : f.op.unop = f :=
by ext; refl

end iso

namespace nat_iso

variables {D : Type u₂} [category.{v₂} D]
variables {F G : C ⥤ D}

/-- The natural isomorphism between opposite functors `G.op ≅ F.op` induced by a natural
isomorphism between the original functors `F ≅ G`. -/
@[simps] protected def op (α : F ≅ G) : G.op ≅ F.op :=
{ hom := nat_trans.op α.hom,
  inv := nat_trans.op α.inv,
  hom_inv_id' := begin ext, dsimp, rw ←op_comp, rw α.inv_hom_id_app, refl, end,
  inv_hom_id' := begin ext, dsimp, rw ←op_comp, rw α.hom_inv_id_app, refl, end }

/-- The natural isomorphism between functors `G ≅ F` induced by a natural isomorphism
between the opposite functors `F.op ≅ G.op`. -/
@[simps] protected def remove_op (α : F.op ≅ G.op) : G ≅ F :=
{ hom := nat_trans.remove_op α.hom,
  inv := nat_trans.remove_op α.inv,
  hom_inv_id' := begin ext, dsimp, rw ←unop_comp, rw α.inv_hom_id_app, refl, end,
  inv_hom_id' := begin ext, dsimp, rw ←unop_comp, rw α.hom_inv_id_app, refl, end }

/-- The natural isomorphism between functors `G.unop ≅ F.unop` induced by a natural isomorphism
between the original functors `F ≅ G`. -/
@[simps] protected def unop {F G : Cᵒᵖ ⥤ Dᵒᵖ} (α : F ≅ G) : G.unop ≅ F.unop :=
{ hom := nat_trans.unop α.hom,
  inv := nat_trans.unop α.inv,
  hom_inv_id' := begin ext, dsimp, rw ←unop_comp, rw α.inv_hom_id_app, refl, end,
  inv_hom_id' := begin ext, dsimp, rw ←unop_comp, rw α.hom_inv_id_app, refl, end }

end nat_iso

namespace equivalence

variables {D : Type u₂} [category.{v₂} D]

/--
An equivalence between categories gives an equivalence between the opposite categories.
-/
@[simps]
def op (e : C ≌ D) : Cᵒᵖ ≌ Dᵒᵖ :=
{ functor := e.functor.op,
  inverse := e.inverse.op,
  unit_iso := (nat_iso.op e.unit_iso).symm,
  counit_iso := (nat_iso.op e.counit_iso).symm,
  functor_unit_iso_comp' := λ X, by { apply quiver.hom.unop_inj, dsimp, simp, }, }

/--
An equivalence between opposite categories gives an equivalence between the original categories.
-/
@[simps]
def unop (e : Cᵒᵖ ≌ Dᵒᵖ) : C ≌ D :=
{ functor := e.functor.unop,
  inverse := e.inverse.unop,
  unit_iso := (nat_iso.unop e.unit_iso).symm,
  counit_iso := (nat_iso.unop e.counit_iso).symm,
  functor_unit_iso_comp' := λ X, by { apply quiver.hom.op_inj, dsimp, simp, }, }

end equivalence

/-- The equivalence between arrows of the form `A ⟶ B` and `B.unop ⟶ A.unop`. Useful for building
adjunctions.
Note that this (definitionally) gives variants
```
def op_equiv' (A : C) (B : Cᵒᵖ) : (opposite.op A ⟶ B) ≃ (B.unop ⟶ A) :=
op_equiv _ _

def op_equiv'' (A : Cᵒᵖ) (B : C) : (A ⟶ opposite.op B) ≃ (B ⟶ A.unop) :=
op_equiv _ _

def op_equiv''' (A B : C) : (opposite.op A ⟶ opposite.op B) ≃ (B ⟶ A) :=
op_equiv _ _
```
-/
@[simps] def op_equiv (A B : Cᵒᵖ) : (A ⟶ B) ≃ (B.unop ⟶ A.unop) :=
{ to_fun := λ f, f.unop,
  inv_fun := λ g, g.op,
  left_inv := λ _, rfl,
  right_inv := λ _, rfl }

instance subsingleton_of_unop (A B : Cᵒᵖ) [subsingleton (unop B ⟶ unop A)] : subsingleton (A ⟶ B) :=
(op_equiv A B).subsingleton

instance decidable_eq_of_unop (A B : Cᵒᵖ) [decidable_eq (unop B ⟶ unop A)] : decidable_eq (A ⟶ B) :=
(op_equiv A B).decidable_eq

/--
The equivalence between isomorphisms of the form `A ≅ B` and `B.unop ≅ A.unop`.

Note this is definitionally the same as the other three variants:
* `(opposite.op A ≅ B) ≃ (B.unop ≅ A)`
* `(A ≅ opposite.op B) ≃ (B ≅ A.unop)`
* `(opposite.op A ≅ opposite.op B) ≃ (B ≅ A)`
-/
@[simps] def iso_op_equiv (A B : Cᵒᵖ) : (A ≅ B) ≃ (B.unop ≅ A.unop) :=
{ to_fun := λ f, f.unop,
  inv_fun := λ g, g.op,
  left_inv := λ _, by { ext, refl, },
  right_inv := λ _, by { ext, refl, } }

namespace functor

variables (C)
variables (D : Type u₂) [category.{v₂} D]

/--
The equivalence of functor categories induced by `op` and `unop`.
-/
@[simps]
def op_unop_equiv : (C ⥤ D)ᵒᵖ ≌ Cᵒᵖ ⥤ Dᵒᵖ :=
{ functor := op_hom _ _,
  inverse := op_inv _ _,
  unit_iso := nat_iso.of_components (λ F, F.unop.op_unop_iso.op) begin
    intros F G f,
    dsimp [op_unop_iso],
    rw [(show f = f.unop.op, by simp), ← op_comp, ← op_comp],
    congr' 1,
    tidy,
  end,
  counit_iso := nat_iso.of_components (λ F, F.unop_op_iso) (by tidy) }.

/--
The equivalence of functor categories induced by `left_op` and `right_op`.
-/
@[simps]
def left_op_right_op_equiv : (Cᵒᵖ ⥤ D)ᵒᵖ ≌ (C ⥤ Dᵒᵖ) :=
{ functor :=
  { obj := λ F, F.unop.right_op,
    map := λ F G η, η.unop.right_op },
  inverse :=
  { obj := λ F, op F.left_op,
    map := λ F G η, η.left_op.op },
  unit_iso := nat_iso.of_components (λ F, F.unop.right_op_left_op_iso.op) begin
    intros F G η,
    dsimp,
    rw [(show η = η.unop.op, by simp), ← op_comp, ← op_comp],
    congr' 1,
    tidy,
  end,
  counit_iso := nat_iso.of_components (λ F, F.left_op_right_op_iso) (by tidy) }

end functor

end category_theory


import combinatorics.simple_graph.basic
import combinatorics.simple_graph.subgraph
import data.finset.basic
import data.finset.powerset
import data.fintype.basic
import logic.basic
import simple_graph_aux
import finset_fintype_aux

universe u

variable {V : Type u}

variable G : simple_graph V
variable R : set V
variables R₁ R₂ : set V

namespace simple_graph

def induced_subgraph : G.subgraph :=
{ verts := R,
  adj := λ v w, v ∈ R ∧ w ∈ R ∧ G.adj v w,
  adj_sub := λ _ _ ⟨_, _, G_adj⟩, G_adj,
  edge_vert := λ _ _ ⟨v_in,_ , _⟩, v_in, }

lemma induced_subgraph_adj_eq_of_verts_eq :
  (induced_subgraph G R₁).verts = (induced_subgraph G R₂).verts →
    (induced_subgraph G R₁).adj = (induced_subgraph G R₂).adj :=
begin
  intro h_verts,
  change R₁ = R₂ at h_verts,
  rw h_verts,
end

lemma induced_subgraph_injective :
function.injective (induced_subgraph G) :=
begin
  unfold function.injective,
  intros R₁ R₂,
  rw subgraph.ext_iff,
  rintro ⟨h_verts, _⟩,
  exact h_verts,
end

namespace induced_subgraph_size

variable (k : ℕ)

def set_univ : set G.subgraph := set.image
  (induced_subgraph G)
  {Rₖ : set V | ∃ fin_Rₖ : fintype ↥Rₖ,
    (@set.to_finset _ Rₖ (by assumption)).card = k}

section finite

variable [fintype V]

def finset_univ : finset G.subgraph := finset.map
⟨ (induced_subgraph G) ∘ coe,
  function.injective.comp
    (induced_subgraph_injective G) finset.coe_injective ⟩
  (finset.powerset_len k (finset.univ : finset V))

lemma set_univ_eq_coe : (set_univ G k) = ↑(finset_univ G k) :=
begin
  apply set.ext,
  intro G',
  rw finset.mem_coe,
  unfold set_univ,
  unfold finset_univ,
  rw set.mem_image,
  rw finset.mem_map,
  split,
  { rintro ⟨Rₖ, h_Rₖ, h_G'⟩,
    rw set.mem_set_of_eq at h_Rₖ,
    cases h_Rₖ with fin_Rₖ card_Rₖ,
    use @set.to_finset _ Rₖ (by assumption),
    split,
    { rw finset.mem_powerset_len,
      exact ⟨finset.subset_univ _, card_Rₖ⟩, },
    { rw function.embedding.coe_fn_mk,
      rw function.comp_app,
      rw set.coe_to_finset,
      exact h_G', }, },
  { rintro ⟨Rₖ, Rₖ_in, h_G'⟩,
    rw function.embedding.coe_fn_mk at h_G',
    use ↑Rₖ,
    split,
    { rw set.mem_set_of_eq,
      use (finset_coe.fintype Rₖ),
      rw set.to_finset_card,
      simp_rw [finset.coe_sort_coe],
      rw fintype.card_coe,
      rw finset.mem_powerset_len at Rₖ_in,
      exact Rₖ_in.right, },
    { rw function.comp_app at h_G',
      exact h_G', }, },
end

lemma card_set_univ :
(finset_univ G k).card = (fintype.card V).choose k :=
begin
  unfold finset_univ,
  rw finset.card_map,
  rw finset.card_powerset_len,
  rw finset.card_univ,
end

end finite

end induced_subgraph_size

namespace induced_subgraph

lemma is_induced : subgraph.is_induced (induced_subgraph G R) :=
begin
  unfold subgraph.is_induced,
  unfold induced_subgraph,
  dsimp [induced_subgraph],
  intros v w v_in w_in G_adj,
  exact ⟨v_in, w_in, G_adj⟩,
end

namespace decidable

variable [decidable_eq V]
variable [decidable_rel G.adj]
variable [decidable_pred (∈ R)]

instance adj : decidable_rel (G.induced_subgraph R).adj :=
begin
  unfold decidable_rel,
  intros v w,
  unfold induced_subgraph,
  simp only [],
  apply_instance,
end

instance coe_adj : decidable_rel (G.induced_subgraph R).coe.adj :=
begin
  unfold decidable_rel,
  intros v w,
  unfold subgraph.coe,
  simp only [],
  apply_instance,
end

instance verts_mem : decidable_pred (∈ (G.induced_subgraph R).verts) :=
begin
  unfold induced_subgraph,
  simp only [],
  apply_instance,
end

end decidable

section finite

variables [fintype V]
variables [decidable_pred (∈ R)]

instance verts_fintype : fintype ↥(induced_subgraph G R).verts :=
begin
  unfold induced_subgraph,
  change fintype ↥R,
  apply_instance,
end

variable [decidable_eq V]
variable [decidable_rel G.adj]

def edge_subtype_finset (s : finset (sym2 V)) :
finset ↥((G.induced_subgraph R).edge_finset) :=
finset.subtype _ s

def edge_complement_subtype_finset (s : finset (sym2 V)) :
finset ↥(G.edge_finset \ (G.induced_subgraph R).edge_finset) :=
finset.subtype _ s

end finite

end induced_subgraph

end simple_graph

namespace complete_graph

open simple_graph

namespace induced_subgraph

lemma coe_eq_complete_graph :
((complete_graph V).induced_subgraph R).coe = complete_graph ↥R :=
begin
  rw simple_graph.ext_iff,
  funext,
  rw subgraph.coe_adj,
  unfold induced_subgraph,
  simp only [],
  ext,
  change ↥R at v,
  change ↥R at w,
  rw ← subtype.val_eq_coe,
  rw ← subtype.val_eq_coe,
  rw eq_true_intro v.property,
  rw eq_true_intro w.property,
  rw true_and,
  rw true_and,
  unfold complete_graph,
  simp only [],
  rw ne.def,
  rw subtype.val_inj,
end

section finite

variables [decidable_eq V] [fintype V] [decidable_pred (∈ R)]

def edge_to_finset_powerset_len_two_surj : ∀ s, ∃ e, ∃ e_in,
  ((complete_graph V).induced_subgraph R)
    .edge_to_finset_powerset_len_two e e_in = s :=
begin
  rintro ⟨s, s_in⟩,
  rw finset.mem_powerset_len at s_in,
  cases s_in with s_subset card_s,
  rw finset.card_eq_two at card_s,
  rcases card_s with ⟨v₁, v₂, v₁_ne_v₂, hs⟩,
  use ⟦(v₁, v₂)⟧,
  unfold induced_subgraph,
  simp only [subgraph.mem_edge_set, complete_graph_eq_top, top_adj],
  unfold induced_subgraph at s_subset,
  change s ⊆ R.to_finset at s_subset,
  have v₁_in : v₁ ∈ R,
  { rw ← set.mem_to_finset,
    apply finset.mem_of_subset s_subset,
    rw hs,
    simp only [finset.mem_insert, eq_self_iff_true, true_or], },
  have v₂_in : v₂ ∈ R,
  { rw ← set.mem_to_finset,
    apply finset.mem_of_subset s_subset,
    rw hs,
    simp only [finset.mem_insert, finset.mem_singleton, eq_self_iff_true,
      or_true], },
  use ⟨v₁_in, v₂_in, v₁_ne_v₂⟩,
  unfold subgraph.edge_to_finset_powerset_len_two,
  simp only [sym2.lift_mk, subtype.coe_mk, subtype.mk_eq_mk],
  exact hs.symm,
end

lemma card_edge_finset :
((complete_graph V).induced_subgraph R).edge_finset.card =
  (fintype.card ↥R).choose 2 :=
begin
  suffices : (((complete_graph V).induced_subgraph R).edge_finset).card =
    (finset.powerset_len 2 R.to_finset).card,
  { rw this,
    rw ← set.to_finset_card R,
    exact finset.card_powerset_len _ _, },
  unfold subgraph.edge_finset,
  refine finset.card_congr
    (λ e, λ e_in,
      (((complete_graph V).induced_subgraph R)
        .edge_to_finset_powerset_len_two
        e (by rwa ← set.mem_to_finset)).val) _ _ _,
  { intros e e_in,
    rw subtype.val_eq_coe,
    have h := (((complete_graph V).induced_subgraph R)
      .edge_to_finset_powerset_len_two e _).property,
    rw subtype.val_eq_coe at h,
    unfold induced_subgraph at h,
    exact h, },
  { simp_rw set.mem_to_finset,
    simp_rw subtype.val_inj,
    exact ((complete_graph V).induced_subgraph R)
      .edge_to_finset_powerset_len_two_inj, },
  { intros s s_in,
    have h_surj := edge_to_finset_powerset_len_two_surj R
      ⟨s, by {unfold induced_subgraph, exact s_in}⟩,
    simp_rw ← subtype.val_inj at h_surj,
    simp_rw set.mem_to_finset,
    exact h_surj },
end

end finite

end induced_subgraph

namespace induced_subgraph_size

variables [fintype V] [decidable_eq V]
variable {k : ℕ}
variable Rₖ : ↥(finset.powerset_len k (finset.univ : finset V))

lemma card_Rₖ : (Rₖ : finset V).card = k :=
begin
  cases Rₖ with Rₖ Rₖ_in,
  change Rₖ.card = k,
  rw finset.mem_powerset_len at Rₖ_in,
  rw Rₖ_in.right,
end

instance Rₖ_mem_decidable : decidable_pred (∈ (↑Rₖ : set V)) :=
λ a, finset.decidable_mem a Rₖ

theorem edge_set_nonempty (hk : k ≥ 2) :
(((complete_graph V).induced_subgraph Rₖ).edge_set).nonempty :=
begin
  unfold set.nonempty,
  unfold subgraph.edge_set,
  rw sym2.exists,
  simp_rw [sym2.from_rel_prop],
  unfold induced_subgraph,
  change ∃ (v₁ v₂ : V),
    v₁ ∈ ↑Rₖ ∧ v₂ ∈ ↑Rₖ ∧ (complete_graph V).adj v₁ v₂,
  unfold complete_graph,
  simp only [],
  have hRₖ_card : (Rₖ : finset V).card ≥ 2,
  { rw card_Rₖ,
    exact hk, },
  rcases finset.ex_x_ne_y_of_card_ge_two hRₖ_card with
    ⟨v₁, v₁_in, v₂, v₂_in, v₁_ne_v₂⟩,
  exact ⟨v₁, v₂, v₁_in, v₂_in, v₁_ne_v₂⟩,
end

theorem edge_finset_nonempty (hk : k ≥ 2) :
(((complete_graph V).induced_subgraph Rₖ).edge_finset).nonempty :=
begin
  unfold subgraph.edge_finset,
  rw ← finset.coe_nonempty,
  rw set.coe_to_finset,
  exact edge_set_nonempty Rₖ hk,
end

end induced_subgraph_size

end complete_graph


import data.fintype.basic

import chess.move

/-!

# Legal chess move definitions and theorems

## Summary

Legal chess `move`s are moves which satisfy the legal rules of
chess. This includes both the mathematics of which squares a given
`piece` type can move to and the broader set of `board` conditions that
must be satisfied (e.g. not moving a `king` into check).

Only a subset of these rules are currently implemented below so far.
Currently:

  * knight move math

are what is implemented.

(No chess variants are currently implemented either.)

## Main definitions

1. `move.is_legal`, which can decide whether a given `move` is legal

2. `move.legal`, which represents a `move` along with the above proof
that the `move.is_legal`

3. `board.moves_from`, which given a position on the provided `board`,
produces the set of legal moves which may be performed from that square.

## Implementation notes

1. `moves_from` is currently defined to return a `finset`, even though
in theory topologically one could have boards with infinitely many
immediate next squares. This finiteness assumption will eventually need
fixing in other places, so it seems safe here for now.

2. The requirement of `decidable_eq` on the various types surrounding
`move.legal` means that again `dec_trivial` can automatically infer
proofs for move legality without them being explicitly provided.

-/

namespace chess

variables {m n: Type}

variables [fintype m] [decidable_eq m] [linear_order m]
variables [fintype n] [decidable_eq n] [linear_order n]
variables {ι : Type} [fintype ι] [decidable_eq ι]

variables {b : chess.board m n ι chess.colored_piece}

namespace move

/-- The finite set of (presumably squares) between two elements of `m` (or `n`). -/
def between (left right : m) := {x | left ≤ x ∧ x ≤ right}.to_finset

/-- Two squares `pos` and `pos'` are adjacent (i.e. have no square between them). -/
@[derive decidable_pred]
def adjacent (pos pos' : m) :=
(between pos pos').card = 2 ∨ (between pos' pos).card = 2

/-- Two squares `pos` and `pos'` have exactly one square between them. -/
@[derive decidable_pred]
def one_gap (pos pos' : m) :=
(between pos pos').card = 3 ∨ (between pos' pos).card = 3

/-- A legal knight move moves 2 squares in one direction and 1 in the other. -/
@[derive decidable_pred]
def knight_move (stp enp : m × n) : Prop :=
((adjacent stp.fst enp.fst) ∧ (one_gap stp.snd enp.snd)) ∨
  ((one_gap stp.fst enp.fst) ∧ (adjacent stp.snd enp.snd))

open chess.piece

/-- A legal chess move. -/
def is_legal (f : chess.move b) : Prop :=
match (f.piece : chess.piece) with
| knight := knight_move f.start_square f.end_square
| _ := false
end

/-- A legal knight move. -/
@[simp] lemma is_legal_knight_iff
  {f : chess.move b}
  (h_piece : knight = f.piece) :
    f.is_legal ↔ knight_move f.start_square f.end_square := begin
  unfold move.is_legal,
  rw ←h_piece,
  exact iff.rfl,
end

instance is_legal_decidable {f : chess.move b} : decidable f.is_legal := begin
  unfold is_legal,
  unfold_coes,
  cases f.piece.piece,
  case knight { dsimp [is_legal], exact or.decidable, },
  case bishop { exact decidable.false },
  case king { exact decidable.false },
  case pawn { exact decidable.false },
  case queen { exact decidable.false },
  case rook { exact decidable.false }
end

variable (b)

/--
A legal move is a `move` along with a proof that the move satisfies the
rules of chess.

No inhabited instance because `move` is uninhabited.
-/
@[derive fintype, nolint has_inhabited_instance]
structure legal extends chess.move b :=
(legality: (is_legal to_move) . tactic.exact_dec_trivial)

variables {o : ℕ}

/--
A legal sequence is a move `sequence` along with a proof that all sequential
moves are legal.

No inhabited instance because `sequence` is uninhabited.
-/
@[nolint has_inhabited_instance]
structure sequence.legal extends chess.move.sequence m n ι chess.colored_piece o :=
(legality: ∀ (i : fin o), is_legal (to_sequence.moves i) . tactic.exact_dec_trivial)

end move

namespace board

variable (b)

/-- The `finset` of `legal` moves from a given square. -/
def moves_from (pos : m × n) : finset (move.legal b) :=
{x : move.legal b | x.start_square = pos}.to_finset

/-- The `finset` of `legal` moves from a given square. -/
lemma moves_from_def (pos : m × n) :
  b.moves_from pos = {x : move.legal b | x.start_square = pos}.to_finset := rfl

/-- The `finset` of `legal` moves from a given square. -/
@[simp] lemma mem_moves_from {pos : m × n} (x : move.legal b) :
    x ∈ (b.moves_from pos) ↔ x.to_move.start_square = pos :=
by simp only [moves_from_def, set.mem_to_finset, set.mem_set_of_eq]

end board

section bounds

variable {pos : m × n}

/-- There are 0 `legal` moves from an unoccupied square. -/
lemma moves_from.unoccupied_empty
  (h_empty : ¬ b.contents.occupied_at pos . tactic.exact_dec_trivial) :
    b.moves_from pos = ∅ := begin
    rw finset.eq_empty_iff_forall_not_mem,
    intro x,
    by_contradiction h',
    rw board.mem_moves_from at h',
    rw ←h' at h_empty,
    have h_occ := x.occupied_start,
    contradiction,
end

end bounds

end chess