/-
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 ×ˢ 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] [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 (×ˢ) 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 (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 ×ˢ 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

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 (×ˢ) 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,
  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 ×ˢ 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',
  by { filter_upwards [ae_ae_of_ae_prod hf.ae_eq_mk] with _ hx using integral_congr_ae hx }⟩

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

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

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] 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_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] 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, (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 ×ˢ 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

end measure_theory


/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import category_theory.endomorphism
import category_theory.category.Cat
import algebra.category.Mon.basic
import combinatorics.quiver.single_obj

/-!
# Single-object category

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

Single object category with a given monoid of endomorphisms.
It is defined to facilitate transfering some definitions and lemmas (e.g., conjugacy etc.)
from category theory to monoids and groups.

## Main definitions

Given a type `α` with a monoid structure, `single_obj α` is `unit` type with `category` structure
such that `End (single_obj α).star` is the monoid `α`.  This can be extended to a functor `Mon ⥤
Cat`.

If `α` is a group, then `single_obj α` is a groupoid.

An element `x : α` can be reinterpreted as an element of `End (single_obj.star α)` using
`single_obj.to_End`.

## Implementation notes

- `category_struct.comp` on `End (single_obj.star α)` is `flip (*)`, not `(*)`. This way
  multiplication on `End` agrees with the multiplication on `α`.

- By default, Lean puts instances into `category_theory` namespace instead of
  `category_theory.single_obj`, so we give all names explicitly.
-/

universes u v w

namespace category_theory

/--
Abbreviation that allows writing `category_theory.single_obj` rather than `quiver.single_obj`.
-/
abbreviation single_obj := quiver.single_obj

namespace single_obj

variables (α : Type u)

/-- One and `flip (*)` become `id` and `comp` for morphisms of the single object category. -/
instance category_struct [has_one α] [has_mul α] : category_struct (single_obj α) :=
{ hom := λ _ _, α,
  comp := λ _ _ _ x y, y * x,
  id := λ _, 1 }

/-- Monoid laws become category laws for the single object category. -/
instance category [monoid α] : category (single_obj α) :=
{ comp_id' := λ _ _, one_mul,
  id_comp' := λ _ _, mul_one,
  assoc' := λ _ _ _ _ x y z, (mul_assoc z y x).symm }

lemma id_as_one [monoid α] (x : single_obj α) : 𝟙 x = 1 := rfl

lemma comp_as_mul [monoid α] {x y z : single_obj α} (f : x ⟶ y) (g : y ⟶ z) :
  f ≫ g = g * f := rfl

/--
Groupoid structure on `single_obj α`.

See <https://stacks.math.columbia.edu/tag/0019>.
-/
instance groupoid [group α] : groupoid (single_obj α) :=
{ inv := λ _ _ x, x⁻¹,
  inv_comp' := λ _ _, mul_right_inv,
  comp_inv' := λ _ _, mul_left_inv }

/--
Abbreviation that allows writing `category_theory.single_obj.star` rather than
`quiver.single_obj.star`.
-/
abbreviation star : single_obj α := quiver.single_obj.star α

/-- The endomorphisms monoid of the only object in `single_obj α` is equivalent to the original
     monoid α. -/
def to_End [monoid α] : α ≃* End (single_obj.star α) :=
{ map_mul' := λ x y, rfl,
  .. equiv.refl α }

lemma to_End_def [monoid α] (x : α) : to_End α x = x := rfl

/-- There is a 1-1 correspondence between monoid homomorphisms `α → β` and functors between the
    corresponding single-object categories. It means that `single_obj` is a fully faithful
    functor.

See <https://stacks.math.columbia.edu/tag/001F> --
although we do not characterize when the functor is full or faithful.
-/
def map_hom (α : Type u) (β : Type v) [monoid α] [monoid β] :
  (α →* β) ≃ (single_obj α) ⥤ (single_obj β) :=
{ to_fun := λ f,
  { obj := id,
    map := λ _ _, ⇑f,
    map_id' := λ _, f.map_one,
    map_comp' := λ _ _ _ x y, f.map_mul y x },
  inv_fun := λ f,
    { to_fun := @functor.map _ _ _ _ f (single_obj.star α) (single_obj.star α),
      map_one' := f.map_id _,
      map_mul' := λ x y, f.map_comp y x },
  left_inv := λ ⟨f, h₁, h₂⟩, rfl,
  right_inv := λ f, by cases f; obviously }

lemma map_hom_id (α : Type u) [monoid α] : map_hom α α (monoid_hom.id α) = 𝟭 _ := rfl

lemma map_hom_comp {α : Type u} {β : Type v} [monoid α] [monoid β] (f : α →* β)
  {γ : Type w} [monoid γ] (g : β →* γ) :
  map_hom α γ (g.comp f) = map_hom α β f ⋙ map_hom β γ g :=
rfl

/-- Given a function `f : C → G` from a category to a group, we get a functor
    `C ⥤ G` sending any morphism `x ⟶ y` to `f y * (f x)⁻¹`. -/
@[simps] def difference_functor {C G} [category C] [group G] (f : C → G) : C ⥤ single_obj G :=
{ obj := λ _, (),
  map := λ x y _, f y * (f x)⁻¹,
  map_id' := by { intro, rw [single_obj.id_as_one, mul_right_inv] },
  map_comp' := by { intros, rw [single_obj.comp_as_mul, ←mul_assoc,
    mul_left_inj, mul_assoc, inv_mul_self, mul_one] } }

end single_obj

end category_theory

open category_theory

namespace monoid_hom

/-- Reinterpret a monoid homomorphism `f : α → β` as a functor `(single_obj α) ⥤ (single_obj β)`.
See also `category_theory.single_obj.map_hom` for an equivalence between these types. -/
@[reducible] def to_functor {α : Type u} {β : Type v} [monoid α] [monoid β] (f : α →* β) :
  (single_obj α) ⥤ (single_obj β) :=
single_obj.map_hom α β f

@[simp] lemma id_to_functor (α : Type u) [monoid α] : (id α).to_functor = 𝟭 _ := rfl
@[simp] lemma comp_to_functor {α : Type u} {β : Type v} [monoid α] [monoid β] (f : α →* β)
  {γ : Type w} [monoid γ] (g : β →* γ) :
  (g.comp f).to_functor = f.to_functor ⋙ g.to_functor :=
rfl

end monoid_hom

namespace units

variables (α : Type u) [monoid α]

/--
The units in a monoid are (multiplicatively) equivalent to
the automorphisms of `star` when we think of the monoid as a single-object category. -/
def to_Aut : αˣ ≃* Aut (single_obj.star α) :=
(units.map_equiv (single_obj.to_End α)).trans $
  Aut.units_End_equiv_Aut _

@[simp] lemma to_Aut_hom (x : αˣ) : (to_Aut α x).hom = single_obj.to_End α x := rfl
@[simp] lemma to_Aut_inv (x : αˣ) :
  (to_Aut α x).inv = single_obj.to_End α (x⁻¹ : αˣ) :=
rfl
end units

namespace Mon

open category_theory

/-- The fully faithful functor from `Mon` to `Cat`. -/
def to_Cat : Mon ⥤ Cat :=
{ obj := λ x, Cat.of (single_obj x),
  map := λ x y f, single_obj.map_hom x y f }

instance to_Cat_full : full to_Cat :=
{ preimage := λ x y, (single_obj.map_hom x y).inv_fun,
  witness' := λ x y, by apply equiv.right_inv }

instance to_Cat_faithful : faithful to_Cat :=
{ map_injective' := λ x y, by apply equiv.injective }

end Mon


import ..library.src_real_field_lemmas
import ..library.src_ordered_field_lemmas
import data.set.basic
import tactic

/-
There are no explicit exercises in this file, though you may choose to prove examples yourself.
The aim of this file is to prove that there is a real number whose square is 2.
-/

namespace mth1001

namespace myreal

section auxiliary

open myreal_field classical myordered_field

open_locale classical

variables {R : Type} [myreal_field R]

lemma difference_of_two_squares (x y : R) : x*x - y*y = (x - y)*(x+y) :=
begin
  rw mul_add,
  repeat { rw sub_eq_add_neg' <|> rw add_mul },
  rw [←neg_neg (x*y), neg_mul_eq_mul_neg x y, mul_comm x (-y), add_assoc, ←add_assoc (-y*x) _ _],
  rw [add_neg', zero_add, neg_mul_eq_mul_neg, mul_comm y (-y)],
end

lemma square_le_square_iff_le_of_non_neg_of_non_neg (a b : R) (h₁ : 0 ≤ a) (h₂ : 0 ≤ b)
: a*a ≤ b*b ↔ a ≤ b :=
begin
  split,
  { intro aalebb,
    have h₃ : 0 ≤ b*b - a*a, linarith,
    rw difference_of_two_squares b a at h₃,
    rw non_neg_mul_iff_non_neg_and_non_neg_or_non_pos_and_non_pos at h₃,
    cases h₃; linarith },
  { intro aleb,
    exact mul_le_mul aleb aleb h₁ h₂, },
end

lemma pos_mul_iff_pos_and_pos_or_neg_and_neg (a b : R)
  : 0 < a * b ↔ (0 < a ∧ 0 < b) ∨ (a < 0 ∧ b < 0) :=
begin
  split,
  { intro h,
    by_cases h₂ : 0 ≤ a,
    { by_cases h₃ : a = 0,
      { rw h₃ at h, linarith, },
      { have h₄ : 0 < a, from or.elim h₂ id (λ aeq0, absurd aeq0.symm h₃),
        have h₅ : 0 < b, from (zero_lt_mul_left h₄).mp h,
        exact or.inl ⟨h₄, h₅⟩, }, },
    { have h₄ : a < 0, linarith,
      have h₅ : b < 0,
      { by_contra p,
        rw not_lt_iff_le at p,
        rw ←neg_pos at h₄,
        have h₅ : 0 ≤ (-a) * b, from (zero_le_mul_left h₄).mpr p,
        have h₆ : -a * b = -(a*b),
        { rw [mul_comm (-a), ←neg_mul_eq_mul_neg, mul_comm], },
        rw h₆ at h₅,
        linarith, },
        exact or.inr ⟨h₄, h₅⟩, }, },
  { rintro (⟨apos, bpos⟩ | ⟨aneg, bneg⟩),
    { exact gt_zero_mul_of_gt_zero_of_gt_zero apos bpos },
    { rw ←neg_mul_neg a b,
      rw ←neg_pos at aneg bneg,
      exact gt_zero_mul_of_gt_zero_of_gt_zero aneg bneg, }, },
end

lemma square_lt_square_iff_lt_of_pos_of_pos (a b : R) (h₁ : 0 < a) (h₂ : 0 < b)
: a*a < b*b ↔ a < b :=
begin
  split,
  { intro aalebb,
    have h₃ : 0 < b*b - a*a, linarith,
    rw difference_of_two_squares b a at h₃,
    rw pos_mul_iff_pos_and_pos_or_neg_and_neg at h₃,
    rcases h₃ with ⟨h₃_left, h₃_right⟩ | ⟨h₃_left, h₃_right⟩,
    { linarith, },
    { have h₄ : a < -b, linarith,
      have h₅ : -b < 0, linarith,
      have h₆ : a < 0, from lt_trans h₄ h₅,
      have : (0 : R) < 0, from lt_trans h₁ h₆,
      linarith, }, },
  { intro aleb,
    apply mul_lt_mul,
    { exact aleb, },
    { exact le_of_lt aleb, },
    { exact h₁ },
    { exact le_of_lt h₂ }, },
end

lemma zero_eq_zero : (0 : R) = ↑0 := rfl

lemma one_eq_one : ↑1 = (1 : R) :=
by rw [coe_nat_succ, ←zero_eq_zero, zero_add]

lemma pos_iff_gt_zero (x : R) : pos x ↔ 0 < x :=
by rw [lt_iff_pos_sub, sub_zero]

lemma non_zero_of_pos {x : R} (h : 0 < x) : x ≠ 0 :=
begin
  intro k,
  rw k at h,
  exact lt_irrefl h,
end

lemma coe_zero_inj {m : ℕ} (h : (m : R) = 0) : m = 0 :=
begin
  by_contra k,
  have h₂ : pos(m : R), from pos_nat m k,
  rw [h, pos_iff_gt_zero (0 : R)] at h₂,
  exact lt_irrefl h₂,
end

lemma coe_non_zero_of_non_zero {m : ℕ} (h : m ≠ 0) : (m : R) ≠ 0 :=
begin
  contrapose! h,
  exact coe_zero_inj h,
end

lemma gt_zero_of_ne_zero_nat (n : ℕ) (h : n ≠ 0) : (0 : R) < n :=
begin
  rw [←pos_iff_gt_zero],
  exact pos_nat n h,
end

lemma coe_pred (n : ℕ) (h : n ≠ 0) : (↑(n-1) : R) = ↑n - 1 :=
begin
  induction n with k hk,
  { exfalso, apply h, refl, },
  { have : nat.succ k - 1 = k := rfl,
    rw [this, coe_nat_succ, sub_eq_add_neg', add_assoc, add_neg', add_zero ], },
end

lemma coe_pred_eq_of_coe_succ_eq {x k : ℕ} (h : ↑x = ↑k + (1 : R)) : (↑(x-1) : R)= ↑k :=
begin
  by_cases xeq0 : x = 0,
  { exfalso, rw xeq0 at h,
    change 0 = ↑k + (1:R) at h,
    have h₂ : ↑k = -(1 : R),
    { rw [←zero_add (-1: R), h, add_assoc, add_neg', add_zero], },
    have h₃ : (0 : R) ≤ ↑k,
    { rw le_iff_lt_or_eq,
      by_cases h₄ : k = 0,
      { rw h₄, right, refl, },
      { left, rw ←pos_iff_gt_zero, exact pos_nat k h₄, }, },
    rw h₂ at h₃,
    linarith, },
  { change x ≠ 0 at xeq0,
    rw coe_pred _ xeq0,
    linarith, }
end

lemma coe_inj (m n : ℕ) (h : (m : R) = (n : R)) : m = n :=
begin
  revert m,
  induction n with k hk,
  { intro m, exact coe_zero_inj, },
  { intros x hx,
    rw coe_nat_succ at hx,
    specialize hk (x-1),
    by_cases h₂ : x = 0,
    { rw [h₂, ←zero_eq_zero] at hx,
      have h₂ : ↑k = -(1 : R),
      { rw [←zero_add (-1: R), hx, add_assoc, add_neg', add_zero], },
      have h₃ : (0 : R) ≤ ↑k,
      { rw le_iff_lt_or_eq,
        by_cases h₄ : k = 0,
        { rw h₄, right, refl, },
        { left, rw ←pos_iff_gt_zero, exact pos_nat k h₄, }, },
      rw h₂ at h₃,
      linarith, },
    { rw coe_pred x h₂ at hk,
      have h₃ : ↑x - (1 : R) = ↑k, linarith,
      have h₄ : x - 1 = k, from hk h₃,
      rw ←h₄,
      cases nat.eq_zero_or_eq_succ_pred x with x0 xsp,
      { exact absurd x0 h₂, },
      { assumption, }, }, },
end

lemma coe_monotone (m n : ℕ) (h : m ≤ n) : (m : R) ≤ (n : R) :=
begin
  revert n,
  induction m with k hk,
  { intros n h,
    rw [←zero_eq_zero,le_iff_lt_or_eq],
    by_cases h₂ : n = 0,
    { right, rw [h₂, zero_eq_zero], },
    { left, exact gt_zero_of_ne_zero_nat n h₂, }, },
  { intros x hx,
    specialize hk (x-1),
    by_cases h₂ : x = 0,
    { exfalso,
      rw [h₂, ←not_lt] at hx,
      exact hx (nat.succ_pos k), },
    { rcases nat.exists_eq_succ_of_ne_zero h₂ with ⟨w, h⟩,
      rw coe_nat_succ,
      rw coe_pred x h₂ at hk,
      rw h at hx hk,
      suffices h₃ : ↑k ≤ ↑(nat.succ w) - (1 : R),
      { rw h, linarith, },
      have h₃ : nat.succ w - 1 = w := rfl,
      rw h₃ at hk,
      rw ←nat.pred_le_iff at hx,
      change k ≤ w at hx,
      exact hk hx, }, },
end

lemma coe_monotone' (m n : ℕ) (h : m < n) : (m : R) < (n : R) :=
begin
  have h₂ : m ≤ n, linarith,
  have h₃ : (m : R) ≤ n, from coe_monotone _ _ h₂,
  rw le_iff_lt_or_eq at h₃,
  cases h₃ with mltn meqn,
  { exact mltn, },
  { have h₃ : m = n, from coe_inj m n meqn,
    linarith, },
end

lemma non_neg_of_non_neg (n : ℕ) (h : 0 ≤ n) : (0 : R) ≤ ↑n :=
begin
  rw le_iff_lt_or_eq,
  by_cases h₂ : n = 0,
  { right, rw [h₂, zero_eq_zero], },
  { left, exact gt_zero_of_ne_zero_nat n h₂, }
end

lemma ge_one_of_non_zero (k : ℕ) (h : k ≠ 0): (1 : R) ≤ k :=
begin
  induction k with m hm,
  { exfalso,
    apply h, refl, },
  { rw coe_nat_succ m,
    conv {to_lhs, rw ←add_zero (1 : R)},
    by_cases h₂ : m = 1,
    { rw [h₂, add_zero, one_eq_one],
      change (1 : R) ≤ 2,
      rw le_iff_lt_or_eq,
      left,
      linarith, },
    { rw add_comm,
      apply add_le_add,
      { rw le_iff_lt_or_eq,
        by_cases h₃ : m = 0,
        { right, rw h₃, refl, },
        { left, exact gt_zero_of_ne_zero_nat m h₃, }, },
      { exact le_refl 1, }, }, },
end

lemma pos_inv_nat_of_non_zero {n : ℕ} (h : n ≠ 0) : (0 : R) < (↑n)⁻¹ :=
begin
  have h₂ : (0 : R) < ↑n, from gt_zero_of_ne_zero_nat n h,
  have h₃ : ↑n ≠ (0 : R), from non_zero_of_pos h₂,
  rwa inv_pos h₃,
end

theorem inv_le_inv {a b : R} (h₁ : 0 < a) (h₂ : 0 < b) : a⁻¹ ≤ b⁻¹ ↔ b ≤ a :=
begin
  have k₁ : a ≠ (0 : R), from non_zero_of_pos h₁,
  have k₂ : b ≠ 0, from non_zero_of_pos h₂,
  repeat {rw le_iff_lt_or_eq },
  split,
  { rintro (hlt | heq),
    { left,
      rwa ←inv_lt_inv h₁ h₂, },
    { right,
      rw [←inv_inv' a k₁, ←inv_inv' b k₂, heq], }, },
  { rintro (hlt | heq),
    { left,
      rwa inv_lt_inv h₁ h₂, },
    { rw heq, right, refl, }, },
end

lemma pos_add_inv_nat_of_pos {u : R} {n : ℕ} (h : (0 : R) < u) (h₂ : n ≠ 0)
: (0 : R) < u + (↑n)⁻¹ :=
begin
  rw ←add_zero (0 : R),
  apply add_lt_add h,
  rw inv_pos (coe_non_zero_of_non_zero h₂),
  exact gt_zero_of_ne_zero_nat n h₂,
end

lemma pos_sub_inv_nat_of_pos {u : R} {n : ℕ} (k₄ : (0 : R) < u) (ne0 : n ≠ 0) (k₅ : 2 < u*u)
: (0 : R) < u - (↑n)⁻¹ :=
begin
  by_contra p,
  have : u ≤ (↑n)⁻¹, linarith,
  have h₂ : (1 : R) ≤ (↑n), from ge_one_of_non_zero n ne0,
  have h₃ : (0 : R) < ↑n, {rw ←pos_iff_gt_zero, exact pos_nat n ne0},
  have h₄ : (↑n)⁻¹ ≤ (1 : R)⁻¹, { rwa inv_le_inv h₃ zero_lt_one, },
  have h₅ : u ≤ (1 : R)⁻¹, linarith,
  rw one_inv at h₅,
  have : u * u ≤ 1 * 1, from mul_le_mul h₅ h₅ (le_of_lt k₄) zero_le_one,
  linarith,
end

lemma lt_sub_inv_nat {u : R} {n : ℕ} (h₂ : n ≠ 0)
: u - (↑n)⁻¹ < u:=
begin
  rw [sub_eq_add_neg', add_lt_iff_neg_left, neg_lt_zero, inv_pos (coe_non_zero_of_non_zero h₂)],
  exact gt_zero_of_ne_zero_nat n h₂,
end

end auxiliary

namespace sqrt_two

open myreal_field classical myordered_field

open_locale classical

variables {R : Type} [myreal_field R]

lemma has_upper_bound_S : has_upper_bound ({x : R | (0 < x) ∧ (x*x < 2)} : set R) :=
begin
  use (2 : R),
  intros s hs,
  cases hs with h₁ h₂, -- `h₁ : 0 < s`, `h₂ : s * s < 2`,
  have h₄ : (2 : R) < 2 * 2, linarith,
  have h₅ : s * s < 2*2,
  { apply lt_trans h₂ h₄, },
  have : s * s ≤ 2*2, from le_of_lt h₅,
  have h₆ : 0 < (2 : R), linarith,
  have h₇ : 0 ≤ (2 : R), from le_of_lt h₆,
  rwa ←square_le_square_iff_le_of_non_neg_of_non_neg _ _ (le_of_lt h₁) h₇,
end

lemma one_in_S : (1 : R) ∈ {x : R | (0 < x) ∧ (x*x < 2)} :=
⟨by linarith, by linarith⟩

lemma non_empty_S : ({x : R | (0 < x) ∧ (x*x < 2)} : set R) ≠ ∅ :=
begin
  have h : (1 : R) ∈ {x : R | (0 < x) ∧ (x*x < 2)}, from one_in_S,
  intro h₂,
  rw h₂ at h,
  exact h,
end

lemma not_upper_bound_of_exists_nat {u : R} {S : set R} (h : ∃ n : ℕ, n ≠ 0 ∧ (u + (↑n)⁻¹ ∈ S))
: ¬(upper_bound u S) :=
begin
  rcases h with ⟨n, ne0, hn⟩,
  unfold upper_bound,
  push_neg,
  use (u + (↑n)⁻¹),
  apply and.intro hn,
  suffices h : (0 : R) + u< (↑n)⁻¹ + u,
  { rwa [zero_add, add_comm] at h,},
  apply add_lt_add_iff_right_mpr,
  have h₂ : (0 : R) < n, from gt_zero_of_ne_zero_nat n ne0,
  rwa inv_pos (coe_non_zero_of_non_zero ne0),
end

lemma not_lub_of_exists_nat {u : R} {S : set R} (h : ∃ n : ℕ, n ≠ 0 ∧ (upper_bound (u - (↑n)⁻¹) S))
: ¬(∀ v : R, upper_bound v S → u ≤ v) :=
begin
  rcases h with ⟨n, ne0, hn⟩,
  push_neg,
  use (u - (↑n)⁻¹),
  exact and.intro hn (lt_sub_inv_nat ne0),
end

def S : set R := {x : R | (0 < x) ∧ (x*x < 2)}

section lemmas_for_ub_contra

lemma pos_sub_inv_nat_of_pos {u : R} {n : ℕ} (k₄ : (0 : R) < u) (ne0 : n ≠ 0) (k₅ : 2 < u*u)
: (0 : R) < u - (↑n)⁻¹ :=
begin
  by_contra p,
  have : u ≤ (↑n)⁻¹, linarith,
  have h₂ : (1 : R) ≤ (↑n), from ge_one_of_non_zero n ne0,
  have h₃ : (0 : R) < ↑n, {rw ←pos_iff_gt_zero, exact pos_nat n ne0},
  have h₄ : (↑n)⁻¹ ≤ (1 : R)⁻¹, { rwa inv_le_inv h₃ zero_lt_one, },
  have h₅ : u ≤ (1 : R)⁻¹, linarith,
  rw one_inv at h₅,
  have : u * u ≤ 1 * 1, from mul_le_mul h₅ h₅ (le_of_lt k₄) zero_le_one,
  linarith,
end

lemma sq_add_inv_ub {u : R} {k : ℕ} (h : k ≠ 0)
: (u + (↑k)⁻¹)*(u + (↑k)⁻¹) ≤ u*u + (2*u+1)*(↑k)⁻¹ :=
begin
  rw [add_mul, add_mul, mul_add, mul_add, mul_comm (↑k)⁻¹ u, one_mul, add_assoc],
  apply add_le_add (le_refl (u* u)),
  rw [←add_assoc, ←two_mul, ←mul_assoc],
  apply add_le_add (le_refl _),
  have h₂ : (k : R) ≠ 0, from coe_non_zero_of_non_zero h,
  suffices h : (↑k)⁻¹ * (↑k)⁻¹ ≤ (↑k)⁻¹ * (1 : R),
  { rwa mul_one at h, },
  have h₃ : (1 : R) ≤ (↑k), from ge_one_of_non_zero k h,
  have h₄ : (↑k)⁻¹ ≤ (1 : R),
  { rwa [←one_inv, inv_le_inv (gt_zero_of_ne_zero_nat k h) (zero_lt_one : (0 : R) < 1)], },
  have h₅ : (0 : R) < (↑k)⁻¹, from pos_inv_nat_of_non_zero h,
  exact mul_le_mul (le_refl (↑k)⁻¹) h₄ (le_of_lt h₅) (le_of_lt h₅),
end

lemma inequ1 {u : R} (h₁ : 0 < u) (h₂ : u*u < 2) : (0 : R) < (2*u + 1)⁻¹ * (2 - u*u) :=
begin
  have h₃ : 0 < 2 - u * u, linarith,
  have h₄ : 0 < 2 * u + 1, from add_pos (by linarith) (by linarith),
  have h₅ : 2*u+ 1 ≠ 0, linarith,
  have h₆ : 0 < (2*u + 1)⁻¹, from (inv_pos h₅).mpr h₄,
  exact mul_pos _ _ h₆ h₃,
end

lemma inequ2 {u : R} {n : ℕ} (h₁ : 0 < u) (h₂ : (↑n)⁻¹ < (2 * u + 1)⁻¹ * (2 - u * u))
: u * u +  (2 * u + 1) * (↑n)⁻¹ < 2:=
begin
  suffices h : ((2 : R)*u+1) * (↑n)⁻¹ < (2- u * u), linarith,
  have h₄ : 0 < 2 * u + 1, from add_pos (by linarith) (by linarith),
  have h₅ : 2*u+ 1 ≠ 0, linarith,
  suffices h : (2 * u + 1) * (↑n)⁻¹ < (2 * u + 1) * ((2*u + 1)⁻¹ * (2 - u * u)),
  { rwa [←mul_assoc, mul_inv _ h₅, one_mul] at h, },
  exact mul_lt_mul_left_mpr h₄ h₂,
end

lemma ub_contra {u : R} (k₃ : upper_bound u S) (k₄ : (0 : R) < u) (k₅ : u * u < 2) : u * u = 2 :=
begin
  suffices h : ¬(upper_bound u S), from absurd k₃ h,
  suffices h : ∃ n : ℕ, (n ≠ 0) ∧ u + (↑n)⁻¹ ∈ S, from not_upper_bound_of_exists_nat h,
  suffices h : ∃ n : ℕ, (n ≠ 0) ∧ ((u + (n : R)⁻¹) * (u + (↑n)⁻¹) < 2),
  { rcases h with ⟨n, ne0, hn⟩,
    exact ⟨n, ne0, pos_add_inv_nat_of_pos k₄ ne0, hn⟩, },
  suffices h : ∃ n : ℕ, n ≠ 0 ∧ (u*u + ((2 : R)*u + 1)*(↑n)⁻¹) < 2,
  { rcases h with ⟨n, ne0, hn⟩,
    exact ⟨n, ne0, (lt_of_le_of_lt) (sq_add_inv_ub ne0) hn⟩, },
  have k₆ : (0 : R) < (2*u + 1)⁻¹ * (2 - u*u) := inequ1 k₄ k₅,
  rcases (inv_lt_of_pos _ k₆) with ⟨n, ne0, h₂⟩,
  exact ⟨n, ne0, (inequ2 k₄ h₂)⟩,
end

end  lemmas_for_ub_contra

section lemmas_for_lub_contra

lemma sq_sub_inv_ub {u : R} {k : ℕ} (h₁ : 0 < u) (h₂ : k ≠ 0)
: (u - (↑k)⁻¹) * (u - (↑k)⁻¹) > u*u - 2*u*(↑k)⁻¹ :=
begin
  repeat {rw sub_eq_add_neg},
  rw [mul_add, add_mul, add_mul, mul_comm (-(↑k)⁻¹) u, add_assoc],
  apply add_lt_add_of_le_of_lt(le_refl (u* u)),
  rw [←add_assoc, ←two_mul, neg_mul_eq_mul_neg, mul_assoc, lt_add_iff_pos_right, neg_mul_neg_self],
  exact mul_pos _ _ (pos_inv_nat_of_non_zero h₂) (pos_inv_nat_of_non_zero h₂),
end

lemma lub_contra_subproof1 {u : R} (k₄ : (0 : R) < u) (k₅ : 2 < u * u)
(h : ∃ n : ℕ, (n ≠ 0) ∧ (2 < (u - (n : R)⁻¹) * (u - (↑n)⁻¹)))
: ∃ (n : ℕ), n ≠ 0 ∧ upper_bound (u - (↑n)⁻¹) S :=
begin
  rcases h with ⟨n, ne0, hn⟩,
  use n,
  apply and.intro ne0,
  intros x hx,
  cases hx with xpos xsqlt2,
  have h₃ : x * x < (u - (n : R)⁻¹) * (u - (↑n)⁻¹), from lt_trans xsqlt2 hn,
  rw le_iff_lt_or_eq,
  left,
  exact (square_lt_square_iff_lt_of_pos_of_pos _ _ xpos (pos_sub_inv_nat_of_pos k₄ ne0 k₅)).mp h₃,
end

lemma inequ3 {u : R} {n : ℕ} (h₁ : 0 < u) (h₂ : (↑n)⁻¹ < (2*u)⁻¹ * (u*u - 2))
: 2 < u * u - 2 * u * (↑n)⁻¹ :=
begin
  suffices h : 2 * u * (↑n)⁻¹  < u * u - 2, linarith,
  have h₄ : 0 < (2 * u), linarith,
  have h₅ : 2 * u ≠ 0, linarith,
  suffices h : (2 * u) * (↑n)⁻¹ < (2 * u) * ( (2*u)⁻¹ *(u*u -2)),
  { rwa [←mul_assoc, mul_inv _ h₅, one_mul] at h, },
  exact mul_lt_mul_left_mpr h₄ h₂,
end

lemma inequ4 {u : R} (h₁ : 0 < u) (h₂ : 2 < u * u) : 0 < (2*u)⁻¹ * (u * u - 2):=
begin
  have h₃ : 0 < u * u - 2, linarith,
  have h₄ : 0 < 2 * u, linarith,
  have h₅ : 2*u  ≠ 0, linarith,
  have h₆ : 0 < (2*u)⁻¹, from (inv_pos h₅).mpr h₄,
  exact mul_pos _ _ h₆ h₃,
end

lemma lub_contra {u : R} (k₃ : ∀ v : R, upper_bound v S → u ≤ v) (k₄ : (0 : R) < u)
(k₅ : 2 < u * u)
: u * u = 2 :=
begin
  suffices h : ¬(∀ v : R, upper_bound v S → u ≤ v), from absurd k₃ h,
  suffices h : ∃ n : ℕ, n ≠ 0 ∧ (upper_bound (u - (↑n)⁻¹) S), from not_lub_of_exists_nat h,
  suffices h : ∃ n : ℕ, (n ≠ 0) ∧ (2 < (u - (n : R)⁻¹) * (u - (↑n)⁻¹)),
  from lub_contra_subproof1 k₄ k₅ h,
  suffices h : ∃ n : ℕ, n ≠ 0 ∧ 2  < u * u - 2 * u * (↑n)⁻¹,
  { rcases h with ⟨n, ne0, hn⟩,
    exact ⟨n, ne0, lt_trans hn (sq_sub_inv_ub k₄ ne0)⟩ },
  suffices h : ∃ n : ℕ, n ≠ 0 ∧ (↑n)⁻¹ < (2*u)⁻¹ * (u*u - 2),
  { rcases h with ⟨n, ne0, hn⟩,
    exact ⟨n, ne0, inequ3 k₄ hn⟩, },
  have k₆ : 0 < (2*u)⁻¹ * (u * u - 2):= inequ4 k₄ k₅,
  exact inv_lt_of_pos _ k₆,
end

end lemmas_for_lub_contra

lemma sqrt_two_exists : (sup S)*(sup S) = (2 : R) :=
begin
  have k₂ : ({x : R | (0 < x) ∧ (x*x < 2)} : set R) ≠ ∅, from non_empty_S,
  have k₃ : is_sup (sup S) S, from  sup_is_sup has_upper_bound_S k₂,
  have k₄ : ↑0 < sup S,
  { suffices h : (1 : R) ≤ sup S,
    { change (0 : R) < sup S,
      exact lt_of_lt_of_le zero_lt_one h, },
    exact k₃.left (1 : R) one_in_S, },
  rcases trichotomy' ((sup S)*(sup S)) (2 : R) with ub | sq_eq | lub,
  { exact ub_contra k₃.left k₄ ub.left, },
  { exact sq_eq.right.left, },
  { exact lub_contra k₃.right k₄ lub.right.right, },
end

end sqrt_two

end myreal

end mth1001


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

-- NOTE: This file contains examples for, and therefore should be kept in sync
-- with, the README.

import Aesop

set_option aesop.check.all true

inductive MyList (α : Type _)
  | nil
  | cons (hd : α) (tl : MyList α)

namespace MyList

protected def append : (_ _ : MyList α) → MyList α
  | nil, ys => ys
  | cons x xs, ys => cons x (MyList.append xs ys)

instance : Append (MyList α) :=
  ⟨MyList.append⟩

@[simp]
theorem nil_append : nil ++ xs = xs := rfl

@[simp]
theorem cons_append : cons x xs ++ ys = cons x (xs ++ ys) := rfl

@[aesop safe [constructors, cases]]
inductive NonEmpty : MyList α → Prop
  | cons : NonEmpty (cons x xs)

@[aesop 50%]
theorem nonEmpty_append₁ {xs : MyList α} ys :
    NonEmpty xs → NonEmpty (xs ++ ys) := by
  aesop

theorem nonEmpty_append₁' {xs : MyList α} ys :
    NonEmpty xs → NonEmpty (xs ++ ys) := by
  -- This is the script generated by aesop?.
  intro a
  unhygienic aesop_cases a
  simp_all only [cons_append]
  apply MyList.NonEmpty.cons

example {α : Type _} {xs : MyList α} ys zs :
    NonEmpty xs → NonEmpty (xs ++ ys ++ zs) := by
  aesop

theorem nil_not_nonEmpty (xs : MyList α) : xs = nil → ¬ NonEmpty xs := by
  aesop (add unsafe 10% cases MyList, norm simp Not)

@[simp]
theorem append_nil {xs : MyList α} :
    xs ++ nil = xs := by
  induction xs <;> aesop

theorem append_assoc {xs ys zs : MyList α} :
    (xs ++ ys) ++ zs = xs ++ (ys ++ zs) := by
  induction xs <;> aesop

end MyList


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.finset.locally_finite
import data.dfinsupp.order

/-!
# Finite intervals of finitely supported functions

This file provides the `locally_finite_order` instance for `Π₀ i, α i` when `α` itself is locally
finite and calculates the cardinality of its finite intervals.
-/

open dfinsupp finset
open_locale big_operators pointwise

variables {ι : Type*} {α : ι → Type*}

namespace finset
variables [decidable_eq ι] [Π i, has_zero (α i)] {s : finset ι} {f : Π₀ i, α i}
  {t : Π i, finset (α i)}

/-- Finitely supported product of finsets. -/
def dfinsupp (s : finset ι) (t : Π i, finset (α i)) : finset (Π₀ i, α i) :=
(s.pi t).map ⟨λ f, dfinsupp.mk s $ λ i, f i i.2, begin
  refine (mk_injective _).comp (λ f g h, _),
  ext i hi,
  convert congr_fun h ⟨i, hi⟩,
  end⟩

@[simp] lemma card_dfinsupp (s : finset ι) (t : Π i, finset (α i)) :
  (s.dfinsupp t).card = ∏ i in s, (t i).card :=
(card_map _).trans $ card_pi _ _

variables [Π i, decidable_eq (α i)]

lemma mem_dfinsupp_iff : f ∈ s.dfinsupp t ↔ f.support ⊆ s ∧ ∀ i ∈ s, f i ∈ t i :=
begin
  refine mem_map.trans ⟨_, _⟩,
  { rintro ⟨f, hf, rfl⟩,
    refine ⟨support_mk_subset, λ i hi, _⟩,
    convert mem_pi.1 hf i hi,
    exact mk_of_mem hi },
  { refine λ h, ⟨λ i _, f i, mem_pi.2 h.2, _⟩,
    ext i,
    dsimp,
    exact ite_eq_left_iff.2 (λ hi, (not_mem_support_iff.1 $ λ H, hi $ h.1 H).symm) }
end

/-- When `t` is supported on `s`, `f ∈ s.dfinsupp t` precisely means that `f` is pointwise in `t`.
-/
@[simp] lemma mem_dfinsupp_iff_of_support_subset {t : Π₀ i, finset (α i)} (ht : t.support ⊆ s) :
  f ∈ s.dfinsupp t ↔ ∀ i, f i ∈ t i :=
begin
  refine mem_dfinsupp_iff.trans (forall_and_distrib.symm.trans $ forall_congr $ λ i, ⟨λ h, _,
    λ h, ⟨λ hi, ht $ mem_support_iff.2 $ λ H, mem_support_iff.1 hi _, λ _, h⟩⟩),
  { by_cases hi : i ∈ s,
    { exact h.2 hi },
    { rw [not_mem_support_iff.1 (mt h.1 hi), not_mem_support_iff.1 (not_mem_mono ht hi)],
      exact zero_mem_zero } },
  { rwa [H, mem_zero] at h }
end

end finset

open finset

namespace dfinsupp
variables [decidable_eq ι] [Π i, decidable_eq (α i)]

section bundled_singleton
variables [Π i, has_zero (α i)] {f : Π₀ i, α i} {i : ι} {a : α i}

/-- Pointwise `finset.singleton` bundled as a `dfinsupp`. -/
def singleton (f : Π₀ i, α i) : Π₀ i, finset (α i) :=
⟦{ to_fun := λ i, {f i},
  pre_support := f.support.1,
  zero := λ i, (ne_or_eq (f i) 0).imp mem_support_iff.2 (congr_arg _) }⟧

lemma mem_singleton_apply_iff : a ∈ f.singleton i ↔ a = f i := mem_singleton

end bundled_singleton

section bundled_Icc
variables [Π i, has_zero (α i)] [Π i, partial_order (α i)] [Π i, locally_finite_order (α i)]
  {f g : Π₀ i, α i} {i : ι} {a : α i}

/-- Pointwise `finset.Icc` bundled as a `dfinsupp`. -/
def range_Icc (f g : Π₀ i, α i) : Π₀ i, finset (α i) :=
⟦{ to_fun := λ i, Icc (f i) (g i),
  pre_support := f.support.1 + g.support.1,
  zero := λ i, begin
    refine or_iff_not_imp_left.2 (λ h, _),
    rw [not_mem_support_iff.1 (multiset.not_mem_mono (multiset.le_add_right _ _).subset h),
      not_mem_support_iff.1 (multiset.not_mem_mono (multiset.le_add_left _ _).subset h)],
    exact Icc_self _,
  end }⟧

@[simp] lemma range_Icc_apply (f g : Π₀ i, α i) (i : ι) : f.range_Icc g i = Icc (f i) (g i) := rfl

lemma mem_range_Icc_apply_iff : a ∈ f.range_Icc g i ↔ f i ≤ a ∧ a ≤ g i := mem_Icc

lemma support_range_Icc_subset : (f.range_Icc g).support ⊆ f.support ∪ g.support :=
begin
  refine λ x hx, _,
  by_contra,
  refine not_mem_support_iff.2 _ hx,
  rw [range_Icc_apply,
    not_mem_support_iff.1 (not_mem_mono (subset_union_left _ _) h),
      not_mem_support_iff.1 (not_mem_mono (subset_union_right _ _) h)],
  exact Icc_self _,
end

end bundled_Icc

section pi
variables [Π i, has_zero (α i)]

/-- Given a finitely supported function `f : Π₀ i, finset (α i)`, one can define the finset
`f.pi` of all finitely supported functions whose value at `i` is in `f i` for all `i`. -/
def pi (f : Π₀ i, finset (α i)) : finset (Π₀ i, α i) := f.support.dfinsupp f

@[simp] lemma mem_pi {f : Π₀ i, finset (α i)} {g : Π₀ i, α i} : g ∈ f.pi ↔ ∀ i, g i ∈ f i :=
mem_dfinsupp_iff_of_support_subset $ subset.refl _

@[simp] lemma card_pi (f : Π₀ i, finset (α i)) : f.pi.card = f.prod (λ i, (f i).card) :=
begin
  rw [pi, card_dfinsupp],
  exact finset.prod_congr rfl (λ i _, by simp only [pi.nat_apply, nat.cast_id]),
end

end pi

section locally_finite
variables [Π i, partial_order (α i)] [Π i, has_zero (α i)] [Π i, locally_finite_order (α i)]

instance : locally_finite_order (Π₀ i, α i) :=
locally_finite_order.of_Icc (Π₀ i, α i)
  (λ f g, (f.support ∪ g.support).dfinsupp $ f.range_Icc g)
  (λ f g x, begin
    refine (mem_dfinsupp_iff_of_support_subset $ support_range_Icc_subset).trans _,
    simp_rw [mem_range_Icc_apply_iff, forall_and_distrib],
    refl,
  end)

variables (f g : Π₀ i, α i)

lemma card_Icc : (Icc f g).card = ∏ i in f.support ∪ g.support, (Icc (f i) (g i)).card :=
card_dfinsupp _ _

lemma card_Ico : (Ico f g).card = ∏ i in f.support ∪ g.support, (Icc (f i) (g i)).card - 1 :=
by rw [card_Ico_eq_card_Icc_sub_one, card_Icc]

lemma card_Ioc : (Ioc f g).card = ∏ i in f.support ∪ g.support, (Icc (f i) (g i)).card - 1 :=
by rw [card_Ioc_eq_card_Icc_sub_one, card_Icc]

end locally_finite
end dfinsupp


/-  An alternative take on the definition of a minor, where we take a quotient. Very much WIP. -/

import ftype.basic set_tactic.solver
import .rankfun .dual

--noncomputable theory
open_locale classical
noncomputable theory

open ftype

variables {U₀ U V W: ftype}--[nonempty U₀]

--def img (emb : U₀ ↪ U) :=
--  λ (X : set U₀), emb.to_fun '' X

/- given an injection emb, and a set equal to the range of emb, outputs an equivalence between the
domain and the subtype corresponding to the range.
def subtype_inv_inj (emb : U₀ ↪ U){E : set U} (hE : E = set.range emb) : E ≃ U₀ :=
let h : Π (y : E), (∃ x : U₀, emb x = y) :=
  by {rintros ⟨y,hy⟩, rw [hE, set.mem_range] at hy, cases hy with x hx, from ⟨x, by simp [hx]⟩},
 desc : Π (y : E), {x : U₀ // emb x = y} :=
  λ y, classical.indefinite_description _ (h y) in
{
  to_fun := λ y, (desc y).val,
  inv_fun := λ x, ⟨emb x, by {rw [hE, set.mem_range], from ⟨x, rfl⟩} ⟩,
  left_inv := by {intros y, simp_rw (desc y).property, simp},
  right_inv := λ x, by {cases emb with f h_inj, from h_inj (desc ⟨f x,_⟩).property},
}
-/

def subset_embed (X : set U) : X ↪ U :=
{ to_fun := λ x, x.val,
  inj' := λ x y hxy, subtype.ext hxy}

def subset_to_subtype {X Y : set U} (hXY : X ⊆ Y) : set Y :=
  λ y, y.val ∈ X

/-- (invisible) equivalence between the class of subsets of R and the class of
 sets in the ftype corresponding to R -/
def subset_equiv {R : set U} : {X : set U // X ⊆ R} ≃ set (⟨R⟩ : ftype) :=
{ to_fun := λ X, {y | y.val ∈ X.val},
  inv_fun := λ Y, ⟨coe '' Y,by {intros y hy, cases hy with x hx, rw ←hx.2, exact x.2,} ⟩,
  left_inv := begin
    intro X, ext x, simp only [set.mem_image, subtype.coe_mk],
    refine ⟨λ h, _, λ h, ⟨⟨x,_⟩,⟨_,_⟩⟩⟩,
    { rcases h with ⟨x',h₁,h₂⟩, rw ←h₂, convert h₁,},
    { cases X, tauto, },
    { tauto, },
    simp,
  end,
  right_inv := begin
    intro X, ext x, cases x with x xp,  simp only [set.mem_set_of_eq],
    refine ⟨λ h, _, λ h, _⟩,
    {unfold_projs at h, rcases h with ⟨a,h1,h2⟩, simp_rw ←h2, convert h1, simp},
    exact ⟨⟨x,xp⟩, ⟨h,by simp⟩⟩,
  end, }

/-- bundled isomorphism between two matroids -/
structure isom (M : matroid U) (N : matroid V) :=
  (bij: U ≃ V)
  (rank_preserving : M.r =  N.r ∘ (set.image bij))

instance coe_iso_to_fun {M : matroid U} {N : matroid V} : has_coe_to_fun (isom M N) :=
{F := λ (i : isom M N), (U → V), coe := λ i, i.bij}

/-- inverse of a matroid isomorphism -/
def inv{M: matroid U} {N: matroid V} (iso : isom M N) : isom N M :=
{
  bij := iso.bij.symm,
  rank_preserving :=
  by {rw iso.rank_preserving, ext X, convert rfl, convert rfl, ext x, simp},
}

def compose {M : matroid U} {N : matroid V} {O : matroid W} (i₁ : isom M N) (i₂ : isom N O) : isom M O :=
{
  bij := equiv.trans i₁.bij i₂.bij,
  rank_preserving :=
  begin
    ext X, rw [i₁.rank_preserving, i₂.rank_preserving],
    simp only [equiv.to_fun_as_coe, ftype.ftype_coe, function.comp_app, equiv.coe_trans],
    apply congr_arg, ext x,  simp,
  end
}

-- making a hash of this one!
@[simp] lemma compose_inv_on_set {M: matroid U} {N: matroid V} (iso : isom M N) (X : set U) :
  ((inv iso).bij '' (iso.bij '' X)) = X :=
begin
  --unfold equiv.img,
  convert rfl, ext,
  rw set.mem_image,
  refine ⟨λ h, ⟨iso.bij x,⟨_,_⟩⟩,λ h, _⟩,
    {simp only [equiv.to_fun_as_coe, equiv.apply_eq_iff_eq, set.mem_image, exists_eq_right], from h },
    {simp[inv]},
    {rcases h with ⟨y,h1,h2⟩, rw set.mem_image at h1, rcases h1 with ⟨x', ⟨hx'1, hx'2⟩⟩, rw [←h2,←hx'2] , convert hx'1, rw inv, simp,}
end

variable {M : matroid U}

/-- structure describing a matroid and an embedding of its elements into U -/
@[ext] structure emb_mat (U : ftype) :=
  {U₀ : ftype}
  (mat : matroid U₀)
  (emb : U₀ ↪ U)

namespace emb_mat

def groundset (N : emb_mat U) : set U :=
  set.range N.emb

def strongly_iso (N₁ N₂ : emb_mat U) : Prop :=
  (∃ (φ : isom (N₁.mat) (N₂.mat)), ∀ x, N₁.emb x = N₂.emb (φ x))

lemma strong_iso_equiv :
  equivalence (λ (N₁ N₂ : emb_mat U), strongly_iso N₁ N₂) :=
begin
  refine ⟨λ N, _, λ N₁ N₂ hab, _, λ N₁ N₂ N₃ hab hbc, _⟩,
    {refine ⟨⟨equiv.refl _,_⟩,λ X, _⟩,
      {ext X, simp,},
      {apply congr_arg, unfold_coes, simp} },
    {cases hab with φ, refine ⟨inv φ, λ X, _⟩, rw [hab_h ((inv φ) X), inv], unfold_coes, simp},
  cases hab with i₁ h₁, cases hbc with i₂ h₂,
  from ⟨compose i₁ i₂, λ X, by {unfold_coes at *, simp [h₁,h₂,congr_arg, compose]}⟩,
end

lemma strong_iso_same_groundset (N N' : emb_mat U) :
  strongly_iso N N' → N.groundset = N'.groundset  :=
begin
  rintros ⟨h₁,h₂⟩, ext,
  simp only [groundset, set.mem_range],
  simp_rw h₂,
  refine ⟨λ h, _, λ h, _⟩,
    {cases h with y hy, from ⟨_, hy⟩},
  cases h with y hy, use h₁.bij.inv_fun y, unfold_coes, simp [hy],
end

--def pullback_r (N : emb_mat U) : set (N.ground) → ℤ :=
--  λ X, N.mat.r ((N.emb.subtype_inv_inj (rfl : N.ground = set.range N.emb))'' X)

/-- mapped rank function of N, but defined on all subsets of U (elements not in image are ignored)-/
def pullback_r (N : emb_mat U) : set U → ℤ :=
  λ X, N.mat.r ({x : N.U₀ | N.emb x ∈ X })

lemma pullback_r_eq (N : emb_mat U) (X : set N.U₀) :
  N.mat.r X = N.pullback_r (N.emb.to_fun '' X) :=
begin
  unfold pullback_r, congr', ext x,
  simp only [set.mem_image, function.embedding.to_fun_eq_coe, set.mem_set_of_eq],
  refine ⟨λ h, _, λ h, _⟩,
    {use x, simp, from h},
  cases h with x' hx',
  convert hx'.1,
  from (N.emb.inj' hx'.2).symm,
end
  --ite (X ⊆ N.ground) (some 0 : option ℤ) (none : option ℤ)

  --N.mat.r ((N.emb.subtype_inv_inj (rfl : N.ground = set.range N.emb))'' X)

lemma strong_iso_same_pullback_r (N N' : emb_mat U) :
  strongly_iso N N' → N.pullback_r = N'.pullback_r :=
begin
  rintros ⟨⟨φ,hφ₁⟩, hφ₂⟩, ext X,
  unfold pullback_r, rw hφ₁,
  dsimp, congr', ext x',
  simp only [set.mem_image, set.mem_set_of_eq],
  simp_rw hφ₂,
  refine ⟨λ h, _, λ h, ⟨φ.inv_fun x',⟨_,by simp⟩⟩⟩,
    {rcases h with ⟨x, ⟨hx₁,hx₂⟩⟩, rw ←hx₂, from hx₁,},
  rw ←hφ₂,
  convert h,
  rw hφ₂,
  congr', unfold_coes, simp,
end

/-- if E is equal to the groundset of N, then there is a natural equivalence between E and U₀ -/
def groundset_equiv (N : emb_mat U){E : set U} (hE : N.groundset = E) :
  N.U₀ ≃ (⟨E⟩ : ftype) :=
  ((equiv.set.range N.emb N.emb.inj').trans (equiv.set.of_eq hE))

--def pullback_r' (N : emb_mat U){E : set U} (hE : N.ground = E) : set E → ℤ :=

instance strong_iso_setoid (U : ftype) : setoid (emb_mat U) := ⟨strongly_iso, strong_iso_equiv⟩

end emb_mat

/-- a matroid_in U is a matroid embedded into some set of ements of U, modulo the range of the embedding-/
def matroid_in (U : ftype) := quot (λ (N N' : emb_mat U), N.strongly_iso N')

namespace matroid_in

/-- the groundset of N, viewed as a (set U)-/
def groundset : matroid_in U → set U := quotient.lift
  (λ (N : emb_mat U), N.groundset) emb_mat.strong_iso_same_groundset

/-- the groundset of N, viewed as an ftype -/
def ground (N : matroid_in U) : ftype := ⟨N.groundset⟩

/-- the rank function of N as a function on set U (elements outside the groundset of N
are ignored)-/
def r : matroid_in U → (set U → ℤ) := quotient.lift
  (λ (N : emb_mat U), N.pullback_r) emb_mat.strong_iso_same_pullback_r

/-- the rank function of N as a function on sets of the ground ftype of N-/
def r_ftype (N : matroid_in U) : (set N.ground → ℤ) :=
  λ X, N.r ((λ x : N.ground, x.val)'' X )

/-- an equivalence class representative for N -/
def rep_spec (N : matroid_in U) : {N₀ : emb_mat U // ⟦N₀⟧ = N} :=
  classical.indefinite_description _ (quot.exists_rep N)

/-- the ground set of a representative is the ground set of a matroid_in -/
lemma ground_rep {N : matroid_in U} {N₀ : emb_mat U} (h : ⟦N₀⟧ = N) :
   N₀.groundset = N.groundset  :=
by {dsimp only [quotient.mk] at h, rw ←h, refl}

lemma r_eq_r_inter_groundset (N : matroid_in U) (X : set U) :
  N.r X = N.r (X ∩ N.groundset) :=
begin
  unfold matroid_in.groundset r emb_mat.pullback_r emb_mat.groundset,
  rcases rep_spec N with ⟨N₀,h⟩,
  simp [←h],
end

section preimages

variables {N : matroid_in U} {N₀ : emb_mat U}

/-- given an equivalence class representative N₀, pulls a set X back to the
ftype on which N₀ is defined -/
def rep_preimage (hN : ⟦N₀⟧ = N) (X : set N.ground) :=
  N₀.groundset_equiv (ground_rep hN) ⁻¹' X

lemma rep_preimage_on_size (hN : ⟦N₀⟧ = N) (X : set N.ground) :
  size (rep_preimage hN X) = size X :=
by {apply size_preimage_equiv}

lemma rep_preimage_on_subset (hN : ⟦N₀⟧ = N){X Y : set N.ground} :
  X ⊆ Y → rep_preimage hN X ⊆ rep_preimage hN Y :=
λ h, set.preimage_mono h

lemma r_rep (hN : ⟦N₀⟧ = N) (X : set N.ground) :
  r_ftype N X = N₀.mat.r (rep_preimage hN X) :=
begin
  unfold r_ftype r,
  simp_rw ←hN,
  simp only [quotient.lift_mk],
  unfold emb_mat.pullback_r, apply congr_arg, ext x,
  rw [rep_preimage],
  simp only [set.mem_set_of_eq, emb_mat.groundset_equiv ], simp,
  refine ⟨λ h, _, λ h, _⟩,
  { rcases h with ⟨y,h,h'⟩, simp_rw ←h', convert h, simp,},
  use N₀.emb x,
  { unfold matroid_in.groundset, rw ←hN, simp only [quotient.lift_mk], unfold emb_mat.groundset, simp,},
  exact ⟨h, by simp⟩,
end

end preimages

def as_matroid (N : matroid_in U) : matroid N.ground :=
{
  r := N.r_ftype,
  R0 := λ X, let ⟨N₀,h⟩ := rep_spec N in by
  {rw r_rep h X, apply N₀.mat.R0, },
  R1 := λ X, let ⟨N₀,h⟩ := rep_spec N in by
  {rw [r_rep h X, ←rep_preimage_on_size h], apply N₀.mat.R1,},
  R2 := λ X Y hXY, let ⟨N₀,h⟩ := rep_spec N in by
  {repeat {rw r_rep h}, apply N₀.mat.R2, exact (rep_preimage_on_subset _ hXY),} ,
  R3 := λ X Y, let ⟨N₀,h⟩ := rep_spec N in by
  {repeat {rw r_rep h}, apply N₀.mat.R3,  }
}

lemma as_matroid_r_eq (N : matroid_in U) :
  ∀ X, N.r X = N.as_matroid.r (subset_equiv ⟨X ∩ N.groundset, by tidy⟩) :=
begin
  intro X,
  unfold matroid_in.as_matroid matroid_in.r_ftype subset_equiv,
  simp only [equiv.coe_fn_mk, subtype.coe_mk],
  rw r_eq_r_inter_groundset, congr',
  ext x, simp only [set.mem_image, set.mem_inter_eq,set.mem_set_of_eq,subtype.coe_mk],
  refine ⟨λ h, ⟨⟨x,h.2⟩,⟨⟨h.1,h.2⟩,by simp⟩⟩, λ h, _⟩,
  rcases h with ⟨x',⟨h,rfl⟩⟩,
  exact h,
end

/-- as_matroid is the canonical representative for a matroid_in -/
lemma as_matroid_is_rep (M : matroid_in U) :
  M = ⟦{mat := M.as_matroid, emb := function.embedding.subtype _ }⟧ :=
begin
  rcases M.rep_spec with ⟨M₀,h⟩, rw ←h, apply quotient.sound,

  simp only [has_equiv.equiv, setoid.r, emb_mat.strongly_iso, as_matroid, r_ftype],
  dsimp only [ftype.ftype_coe],
  refine ⟨⟨_,_⟩,λ x, _⟩,
  { refine emb_mat.groundset_equiv _ _, refl, },
  begin
    ext X, simp only [function.comp_app, r, emb_mat.pullback_r], unfold emb_mat.groundset_equiv, congr', ext x,
    simp only [set.mem_set_of_eq, set.image_congr, set.mem_image, exists_exists_and_eq_and, subtype.val_eq_coe],
    refine ⟨λ h, ⟨x,h, by simp⟩, λ h, _⟩,
    rcases h with ⟨a,ha,h⟩, simp at h,
    rw ←M₀.emb.inj' h, exact ha,
  end,
  refl,
end

/- lemma as_matroid_r_eq_subset (N : matroid_in U) :
  ∀ X : {X : set U // X ⊆ N.groundset}, N.r X.val = N.as_matroid.r (subset_equiv X) :=
begin
  intro X,
  convert as_matroid_r_eq N X.val,

end -/

--lemma iso_to (M₀ : emb_mat U) :

def as_matroid_in (M : matroid U) : matroid_in U :=
  ⟦{U₀ := U, emb := function.embedding.refl U, mat := M}⟧

instance coe_to_matroid_in : has_coe (matroid U) (matroid_in U) := ⟨λ M, as_matroid_in M⟩

def embed (M : matroid_in U) : M.ground ↪ U := subset_embed M.groundset

def subset_embed {M : matroid_in U} {R : set U} (hR : R ⊆ M.groundset) : R ↪ M.ground :=
{to_fun  := λ x, ⟨x.val, by {cases x, tauto}⟩,
 inj'    := λ x y hxy, by {simp only [subtype.mk_eq_mk] at hxy, exact subtype.eq hxy, } }

def nested_embed (M' M : matroid_in U) (hMM' : M'.groundset ⊆ M.groundset) : M'.ground ↪ M'.ground :=
{to_fun  := λ x, ⟨x.val, by simp⟩,
 inj'    := λ x y hxy, by {convert hxy; simp,} }

--set_option pp.proofs true

def matroid_in_ext (M M' : matroid_in U) :
  M.groundset = M'.groundset → M.r = M'.r → M = M' :=
begin
  intros h h',
  rw [as_matroid_is_rep M, as_matroid_is_rep M', quotient.sound],
  refine ⟨⟨_,_⟩,λ x, _⟩,
  {exact {to_fun := λ x, ⟨x.val, by {rw ←h, exact x.property,}⟩ ,
          inv_fun := λ x, ⟨x.val, by {rw h, exact x.property,}⟩,
          left_inv := λ x, by {dsimp only, simp,},
          right_inv := λ x, by {dsimp only, simp,}}, },
  begin
    simp_rw h',
    simp only [as_matroid, r_ftype], --simp_rw h',
    ext X, simp only [set.image_congr, function.comp_app, subtype.val_eq_coe], rw h',
    apply congr_arg, ext x, dsimp only [ftype.ftype_coe],
    simp only [set.image_congr, set.mem_image, exists_exists_and_eq_and, subtype.val_eq_coe],
    refine ⟨λ hx,_, λ hx, _⟩,
    { rcases hx with ⟨y,h₁,rfl⟩, exact ⟨y,h₁, by simp⟩,  },
    rcases hx with ⟨⟨y, hy⟩, hy', rfl⟩, refine ⟨⟨y,hy⟩,⟨hy',_⟩⟩, simp,
  end,
  refl,
end

def from_matroid_on_subtype {E : set U} (M : matroid ⟨E⟩) :  matroid_in U :=
⟦{mat := M, emb := function.embedding.subtype _}⟧

lemma groundset_correct {E : set U} (M : matroid ⟨E⟩) :
  (from_matroid_on_subtype M).groundset = E :=
by {unfold from_matroid_on_subtype groundset emb_mat.groundset, simp}

lemma rank_correct {E : set U} (M : matroid ⟨E⟩) (X : set U) :
  (from_matroid_on_subtype M).r X = M.r ((λ x, x.val) '' X) ∩ {e}   :=
by {unfold from_matroid_on_subtype groundset emb_mat.groundset, simp}

end matroid_in

section minor

/-- minor relation between two matroid_in U-/
def is_minor (N M : matroid_in U) : Prop :=
  (N.groundset ⊆ M.groundset) ∧
  ∃ C ⊆ M.groundset \ N.groundset, (∀ X ⊆ N.groundset, N.r X = M.r (X ∪ C) - M.r C)

/-- minor relation between a matroid_in U and a matroid U -/
def is_minor_of (N : matroid_in U) (M : matroid U) :=
  is_minor N M

/-- N is isomorphic to a minor of M -/
def is_emb_minor (N : matroid U₀) (M : matroid U) :=
  ∃ emb : U₀ ↪ U, is_minor_of ⟦(⟨N,emb⟩:emb_mat U)⟧ M

lemma minor_trans: transitive (λ (M₁ M₂ : matroid_in U), is_minor M₁ M₂) :=
begin
  rintros M₁ M₂ M₃ ⟨h1,⟨C₁,hC₁,h1'⟩⟩ ⟨h2,⟨C₂,hC₂,h2'⟩⟩,
  refine ⟨subset.trans h1 h2,⟨C₁ ∪ C₂,⟨_,λ X hX, _⟩⟩⟩,
  ----
  { convert set.union_subset_union hC₁ hC₂, ext,
    simp only [ftype.diff_eq, set.mem_inter_eq, set.mem_union_eq, set.mem_compl_eq],
    tauto, },
  -- set_solver should work for the goal above, but it is glacial
  have hC₁M₂: C₁ ⊆ M₂.groundset := by
  { intros x hx, simp only [ftype.diff_eq, set.subset_inter_iff] at hC₁, tauto,},
  rw [h1' X hX, h2' (X ∪ C₁) _, h2' C₁ hC₁M₂, ←union_assoc],  ring,
  exact union_of_subsets (subset.trans hX h1) hC₁M₂,
end

 def contract_to_matroid (M : matroid_in U) (C : set U) : matroid ⟨(M.groundset \ C : set U)⟩ :=
let mtype : ftype := ⟨(M.groundset \ C : set U)⟩,
φ : mtype → U := λ x, x.val  in
{ r := λ X, M.r (φ '' X ∪ C) - M.r C,
  R0 :=
  begin
    intro X, dsimp only,
    repeat {rw matroid_in.as_matroid_r_eq},
    simp only [sub_nonneg],
    apply M.as_matroid.R2,
    unfold subset_equiv,
    simp, tauto,
  end,
  R1 :=
  begin
    sorry,
  end,
  R2 := sorry,
  R3 := sorry }

def contract_to_matroid_in (M : matroid_in U) (C : set U) : matroid_in U :=
  matroid_in_from_matroid_on_subtype (contract_to_matroid M C)

def delete_to_matroid (M: matroid_in U) (D : set U) : matroid ⟨(M.groundset \ D : set U)⟩  :=
let mtype : ftype := ⟨(M.groundset \ D : set U)⟩,
φ : mtype → U := λ x, x.val  in
{ r := λ X, M.r (φ '' X),
  R0 := sorry,
  R1 :=
  begin
    sorry,
  end,
  R2 := sorry,
  R3 := sorry }

def delete_to_matroid_in (M : matroid_in U) (D : set U) : matroid_in U :=
  matroid_in_from_matroid_on_subtype (delete_to_matroid M D)

lemma foo (M : matroid_in U){C D : set U} (hi : C ∩ D = ∅) (hu : C ∪ D ⊆ M.groundset) :
  delete_to_matroid_in (contract_to_matroid_in M C) D =  contract_to_matroid_in (delete_to_matroid_in M D) C :=
begin
  apply matroid_in.matroid_in_ext,
  unfold delete_to_matroid_in contract_to_matroid_in, repeat {rw groundset_correct}, set_solver,
  --simp, sorry,
end

/-- returns the contraction of C in M as a minor on a subtype-/
def contract_to_emb (M : matroid_in U) (C : set M.ground) : emb_mat U :=
{
  U₀ := ⟨(Cᶜ : set M.ground)⟩,
  mat := sorry,
  emb := (function.embedding.subtype (λ x, x ∈ Cᶜ)).trans M.embed,
}

end minor

/- the rank function given by N when applied to a subset of the embedded ground set of N.  -/

--def is_minor (N : emb_mat U) (M : matroid U) :=
  --∃ C, C ∩ N.ground = ∅ ∧ ∀ X : set U₀, N.mat.r

--def is_minor {U : ftype} (N : emb_mat U) (M : matroid U) :=
--  ∃ C : set U, C ∩ N.ground = ∅ ∧ ∀

/-structure emb_minor' (M : matroid U) :=
  {U₀ : ftype}
  (mat : matroid U₀)
  (emb : U₀ ↪ U)
  (C : set U)
  (C_disj : C ∩ set.range emb = ∅)
  (minor_rank : mat.r = λ X, M.r (emb '' X ∪ C) - M.r C)-/

/-

/- the ground set of an emb_minor, expressed as a set of elements of M -/
def ground (N : emb_minor M) : set U := set.range N.emb

--def C (N : emb_minor M) : set U := classical.some N.minor_rank

def D (N : emb_minor M) : set U := (N.ground ∪ N.C)ᶜ

lemma def_ground (N : emb_minor M) : N.ground = set.range N.emb  := rfl

lemma C_ground_inter_empty (N : emb_minor M) :
  N.C ∩ N.ground = ∅ :=
by {rw ground, from N.C_disj,}

lemma D_ground_inter_empty (N : emb_minor M) :
  N.D ∩ N.ground = ∅ :=
by {rw [D], have := C_ground_inter_empty N, set_solver,}

lemma C_D_inter_empty (N : emb_minor M) :
  N.C ∩ N.D = ∅ :=
by {rw D, have := C_ground_inter_empty N, set_solver,}

lemma C_union_D_eq_ground_compl (N : emb_minor M) :
  (N.C ∪ N.D) = N.groundᶜ :=
by {rw [D], have := N.C_ground_inter_empty, set_solver,}

lemma emb_minor_r (N : emb_minor M) (X : set N.U₀) :
  N.mat.r X = M.r (N.emb '' X ∪ N.C) - M.r N.C :=
by rw N.minor_rank

/- the rank function given by N when applied to a subset of the embedded ground set of N.  -/
def pullback_r (N : emb_minor M) : set (N.ground) → ℤ :=
  λ X, N.mat.r ((N.emb.subtype_inv_inj (rfl : N.ground = set.range N.emb))'' X)

/- two embedded minors of M are strongly isomorphic if the associated matroids are related
by an isomorphism that commutes with the respective embeddings into M. -/
def strongly_iso (N₁ N₂ : emb_minor M) : Prop :=
  (∃ (φ : isom (N₁.mat) (N₂.mat)), ∀ x, N₁.emb x = N₂.emb (φ x))

/- existence of a strong isomorphism is an equivalence relation on embedded minors of M.
    Equivalence classes of this relation correspond to actual 'labelled' minors of M    -/
lemma strong_iso_equiv :
  equivalence (λ (N₁ N₂ : emb_minor M), strongly_iso N₁ N₂) :=
begin
  refine ⟨λ N, _, λ N₁ N₂ hab, _, λ N₁ N₂ N₃ hab hbc, _⟩,
    {refine ⟨⟨equiv.refl _,_⟩,λ X, _⟩,
      {simp [equiv.img], },
      {apply congr_arg, unfold_coes, simp} },
    {cases hab with φ, refine ⟨inv φ, λ X, _⟩, rw [hab_h ((inv φ) X), inv], unfold_coes, simp},
  cases hab with i₁ h₁, cases hbc with i₂ h₂,
  from ⟨compose i₁ i₂, λ X, by {unfold_coes at *, simp [h₁,h₂,congr_arg, compose]}⟩,
end

/- the ground set is an invariant of equivalence classes under strong isomorphism -/
lemma strong_iso_same_groundset (N N' : emb_minor M) :
  strongly_iso N N' → N.ground = N'.ground  :=
begin
  rintros ⟨h₁,h₂⟩, ext,
  simp only [ground, set.mem_range],
  simp_rw h₂,
  refine ⟨λ h, _, λ h, _⟩,
    {cases h with y hy, from ⟨_, hy⟩},
  cases h with y hy, use h₁.bij.inv_fun y, unfold_coes, simp [hy],
end

instance strong_iso_setoid : setoid (emb_minor M) := ⟨strongly_iso, strong_iso_equiv⟩

end emb_minor

--variables {M : matroid U} [setoid (emb_minor_of M)]
def minor (M : matroid U) := quot (λ (N N' : emb_minor M), N.strongly_iso N')

namespace minor

def emb_to_minor (M : matroid U) := @quotient.mk (emb_minor M) _

/- returns the ground set of a minor of M (as a subset of the ftype for M) -/
def ground {M : matroid U} : minor M → set U := quotient.lift
  (λ (N : emb_minor M), N.ground )
  (λ N N' hNN', emb_minor.strong_iso_same_groundset N N' hNN' )

end minor

-/