import analysis.inner_product_space.projection

noncomputable theory

open_locale real_inner_product_space topology
open submodule function set filter

section general_stuff
-- Things in this section go to other files

lemma eq_zero_of_mem_disjoint {R : Type*} [comm_ring R] {M : Type*} [add_comm_group M] [module R M]
  {F G : submodule R M} (h : F ⊓ G = ⊥) {x : M} (hx : x ∈ F) (hx' : x ∈ G) : x = 0 :=
begin
  have := submodule.mem_inf.mpr ⟨hx, hx'⟩,
  rw h at this,
  simpa
end

@[simp] lemma forall_mem_span_singleton {R : Type*} [comm_ring R] {M : Type*} [add_comm_group M] [module R M]
  (P : M → Prop) (u : M) : (∀ x ∈ span R ({u} : set M), P x) ↔ ∀ t : R, P (t•u) :=
by simp [mem_span_singleton]

open_locale pointwise

@[simp] lemma field.exists_unit {𝕜 : Type*} [field 𝕜] (P : 𝕜 → Prop) :
  (∃ u : 𝕜ˣ, P u) ↔ ∃ u ≠ 0, P u :=
begin
  split,
  { rintros ⟨u, hu⟩,
    exact ⟨u, u.ne_zero, hu⟩ },
  { rintros ⟨u, u_ne, hu⟩,
    exact ⟨units.mk0 u u_ne, hu⟩ }
end

lemma span_singleton_eq_span_singleton_of_ne {𝕜 : Type*} [field 𝕜]{M : Type*} [add_comm_group M] [module 𝕜 M]
{u v : M} (hu : u ≠ 0) (hu' : u ∈ span 𝕜 ({v} : set M)) :
span 𝕜 ({u} : set M) = span 𝕜 ({v} : set M) :=
begin
  rcases mem_span_singleton.mp hu' with ⟨a, rfl⟩,
  by_cases hv : v = 0,
  { subst hv,
    simp },
  have : a ≠ 0,
  { rintro rfl,
    exact hu (zero_smul 𝕜 v) },
  symmetry,
  erw [submodule.span_singleton_eq_span_singleton, field.exists_unit (λ z : 𝕜, z • v = a • v)],
  use [a, this, rfl]
end

end general_stuff

variables {E : Type*} [normed_add_comm_group E] [inner_product_space ℝ E] [complete_space E]

lemma linear_isometry_equiv.apply_ne_zero
  {E : Type*} [normed_add_comm_group E] [normed_space ℝ E]
  {F : Type*} [normed_add_comm_group F] [normed_space ℝ F] [complete_space F]
  (φ : E ≃ₗᵢ⋆[ℝ] F) {x : E} (hx : x ≠ 0) : φ x ≠ 0 :=
begin
  intro H,
  apply hx,
  rw [← φ.symm_apply_apply x, H, φ.symm.map_zero]
end

-- ignore the next line which is fixing a pretty-printer bug
local notation (name := line_printing_only) `Δ` v:55 := submodule.span ℝ {v}
local notation `Δ` v:55 := submodule.span ℝ ({v} : set E)
-- ignore the next line which is fixing a pretty-printer bug
local notation (name := module_span_printing_only) `{.` x `}ᗮ` := (submodule.span ℝ {x})ᗮ
local notation `{.` x `}ᗮ` := (submodule.span ℝ ({x} : set E))ᗮ
local notation `pr[`x`]ᗮ` := orthogonal_projection (submodule.span ℝ {x})ᗮ

lemma orthogonal_projection_orthogonal {U : submodule ℝ E} {x : E}
  [complete_space (U : set E)] :
  (orthogonal_projection Uᗮ x : E) = x - orthogonal_projection U x :=
by rw [eq_sub_iff_add_eq, add_comm, ← eq_sum_orthogonal_projection_self_orthogonal_complement]

lemma orthogonal_line_inf {u v : E} : {.u}ᗮ ⊓ {.v}ᗮ = {.pr[v]ᗮ u}ᗮ ⊓ {.v}ᗮ :=
begin
  rw [inf_orthogonal, inf_orthogonal],
  refine congr_arg _ (le_antisymm (sup_le _ le_sup_right) (sup_le _ le_sup_right));
  rw [span_singleton_le_iff_mem],
  { nth_rewrite 0 eq_sum_orthogonal_projection_self_orthogonal_complement (Δ v) u,
    exact add_mem (mem_sup_right $ coe_mem _) (mem_sup_left $ mem_span_singleton_self _) },
  { rw [orthogonal_projection_orthogonal],
    refine sub_mem (mem_sup_left $ mem_span_singleton_self _) (mem_sup_right $ coe_mem _) }
end

lemma orthogonal_line_inf_sup_line (u v : E) : {.u}ᗮ ⊓ {.v}ᗮ  ⊔ Δ (pr[v]ᗮ u) = {.v}ᗮ :=
begin
  rw [orthogonal_line_inf, sup_comm, sup_orthogonal_inf_of_complete_space],
  rw span_singleton_le_iff_mem,
  exact coe_mem _
end

lemma orthogonal_projection_eq_zero_of_mem {F : submodule ℝ E} [complete_space F]
  {x : E} (h : x ∈ Fᗮ) : orthogonal_projection F x = 0 :=
begin
  refine subtype.coe_injective (eq_orthogonal_projection_of_mem_of_inner_eq_zero F.zero_mem _),
  simp only [coe_zero, sub_zero],
  exact (mem_orthogonal' F x).mp h,
end

lemma inner_projection_self_eq_zero_iff {F : submodule ℝ E} [complete_space F] {x : E} :
 ⟪x, orthogonal_projection F x⟫ = 0 ↔ x ∈ Fᗮ :=
begin
  obtain ⟨y, hy, z, hz, rfl⟩ := F.exists_sum_mem_mem_orthogonal x,
  rw [inner_add_left, map_add, coe_add, inner_add_right, inner_add_right],
  suffices : y = 0 ↔ y + z ∈ Fᗮ,
  { simpa [orthogonal_projection_eq_zero_of_mem hz, orthogonal_projection_eq_self_iff.mpr hy,
           inner_eq_zero_symm.mp (hz y hy)] },
  rw add_mem_cancel_right hz,
  split,
  { rintro rfl,
    exact Fᗮ.zero_mem },
  { exact eq_zero_of_mem_disjoint (inf_orthogonal_eq_bot F) hy },
end

variables {x₀ x : E}

@[simp] lemma mem_orthogonal_span_singleton_iff {x₀ x : E} :
  x ∈ {.x₀}ᗮ ↔ ⟪x₀, x⟫ = 0 :=
begin
  simp only [mem_orthogonal, forall_mem_span_singleton, inner_smul_left,
             is_R_or_C.conj_to_real, mul_eq_zero],
  split,
  { intros h,
    simpa using h 1 },
  { intros h t,
    exact or.inr h }
end

@[simp] lemma orthogonal_projection_orthogonal_singleton {x y : E} :
  pr[x]ᗮ y = ⟨y - (⟪x, y⟫/⟪x, x⟫) • x, begin
    rcases eq_or_ne x 0 with rfl|hx,
    { simp },
    simp [mem_orthogonal_span_singleton_iff],
    rw [inner_sub_right, inner_smul_right],
    field_simp [inner_self_ne_zero.mpr hx]
  end⟩ :=
begin
  apply subtype.ext,
  have := eq_sum_orthogonal_projection_self_orthogonal_complement (span ℝ ({x} : set E)) y,
  simp [eq_sub_of_add_eq' this.symm, orthogonal_projection_singleton, real_inner_self_eq_norm_sq]
end

lemma coe_orthogonal_projection_orthogonal_singleton {x y : E} :
  (pr[x]ᗮ y : E) = y - (⟪x, y⟫/⟪x, x⟫) • x :=
begin
  rw orthogonal_projection_orthogonal_singleton,
  refl
end

lemma foo {x₀ x : E}
  (h : ⟪x₀, x⟫ ≠ 0)
  (y : E)
  (hy : y ∈ {.x₀}ᗮ) :
  (pr[x]ᗮ y : E) - (⟪x₀, pr[x]ᗮ y⟫ / ⟪x₀, x⟫) • x =  y :=
begin

  conv_rhs{rw eq_sum_orthogonal_projection_self_orthogonal_complement (Δ x) y},
  rw orthogonal_projection_singleton,
  rw [sub_eq_add_neg, add_comm, ← neg_smul],
  congr' 2,
  have := eq_sum_orthogonal_projection_self_orthogonal_complement (Δ x) y,
  rw orthogonal_projection_singleton at this,
  apply_fun (λ z, ⟪x₀, z⟫) at this,
  rw [mem_orthogonal_span_singleton_iff.mp hy, inner_add_right, inner_smul_right, eq_comm] at this,
  symmetry,
  apply eq_of_sub_eq_zero,
  rw sub_neg_eq_add,
  apply mul_left_injective₀ h,
  dsimp only,
  rwa [add_mul, zero_mul, div_mul_cancel _ h],
end

/-- Given two non-orthogonal vectors in an inner product space,
`orthogonal_projection_orthogonal_line_iso` is the continuous linear equivalence between their
orthogonal complements obtained from orthogonal projection. -/
def orthogonal_projection_orthogonal_line_iso {x₀ x : E} (h : ⟪x₀, x⟫ ≠ 0) :
{.x₀}ᗮ ≃L[ℝ] {.x}ᗮ :=
{ inv_fun := λ y, ⟨y - (⟪x₀, y⟫/⟪x₀, x⟫) • x, begin
    rw [mem_orthogonal_span_singleton_iff, inner_sub_right, inner_smul_right],
    field_simp [h]
  end⟩,
  left_inv := begin
    rintros ⟨y, hy⟩,
    ext,
    exact foo h y hy
  end,
  right_inv := begin
    rintros ⟨y, hy⟩,
    ext,
    dsimp,
    rw [map_sub, pr[x]ᗮ.map_smul, orthogonal_projection_orthogonal_complement_singleton_eq_zero,
        smul_zero, sub_zero, orthogonal_projection_eq_self_iff.mpr hy]
  end,
  continuous_to_fun := (pr[x]ᗮ.comp (subtypeL {.x₀}ᗮ)).continuous,
  continuous_inv_fun := by continuity,
  ..pr[x]ᗮ.comp (subtypeL {.x₀}ᗮ) }

lemma orthogonal_projection_comp_coe (K : submodule ℝ E) [complete_space K] :
  orthogonal_projection K ∘ (coe : K → E) = id :=
begin
  ext1 x,
  exact orthogonal_projection_mem_subspace_eq_self x
end

variable (E)

-- Is this really missing??
lemma normed_space.continuous_at_iff {E F : Type*}
  [seminormed_add_comm_group E] [seminormed_add_comm_group F] (f : E → F) (x : E) :
  continuous_at f x ↔ ∀ ε > 0, ∃ δ > 0, ∀ y, ‖y - x‖ < δ → ‖f y - f x‖ < ε :=
by simp_rw [metric.continuous_at_iff, dist_eq_norm]

lemma normed_space.continuous_at_iff' {E F : Type*}
  [seminormed_add_comm_group E] [seminormed_add_comm_group F] (f : E → F) (x : E) :
  continuous_at f x ↔ ∀ ε > 0, ∃ δ > 0, ∀ y, ‖y - x‖ ≤ δ → ‖f y - f x‖ ≤ ε :=
begin
  rw normed_space.continuous_at_iff,
  split ; intros h ε ε_pos,
  { rcases h ε ε_pos with ⟨η, η_pos, hη⟩,
    use [η/2, half_pos η_pos],
    intros h hy,
    apply le_of_lt,
    apply hη,
    linarith },
  { rcases h (ε/2) (half_pos ε_pos) with ⟨δ, δ_pos, hδ⟩,
    use [δ, δ_pos],
    intros y hy,
    linarith [hδ y (by linarith)] },
end

-- Is this really missing??
lemma normed_space.continuous_iff {E F : Type*}
  [seminormed_add_comm_group E] [seminormed_add_comm_group F] (f : E → F) :
  continuous f ↔ ∀ x, ∀ ε > 0, ∃ δ > 0, ∀ y, ‖y - x‖ < δ → ‖f y - f x‖ < ε :=
by simp_rw [metric.continuous_iff, dist_eq_norm]

lemma normed_space.continuous_iff' {E F : Type*}
  [seminormed_add_comm_group E] [seminormed_add_comm_group F] (f : E → F) :
  continuous f ↔ ∀ x, ∀ ε > 0, ∃ δ > 0, ∀ y, ‖y - x‖ ≤ δ → ‖f y - f x‖ ≤ ε :=
by simp_rw [continuous_iff_continuous_at, normed_space.continuous_at_iff']

lemma continuous_linear_map.op_norm_le_iff {𝕜 : Type*} {𝕜₂ : Type*} {E : Type*} {F : Type*}
  [seminormed_add_comm_group E] [seminormed_add_comm_group F] [nontrivially_normed_field 𝕜]
  [nontrivially_normed_field 𝕜₂] [normed_space 𝕜 E] [normed_space 𝕜₂ F]
  {σ₁₂ : 𝕜 →+* 𝕜₂} [ring_hom_isometric σ₁₂] {M : ℝ} (hM : 0 ≤ M) (f : E →SL[σ₁₂] F) :
  ‖f‖ ≤ M ↔ ∀ x, ‖f x‖ ≤ M * ‖x‖:=
⟨f.le_of_op_norm_le, f.op_norm_le_bound hM⟩

variable {E}

@[continuity]
lemma continuous_at_orthogonal_projection_orthogonal {x₀ : E} (hx₀ : x₀ ≠ 0) :
  continuous_at (λ x : E, {.x}ᗮ.subtypeL.comp pr[x]ᗮ) x₀ :=
begin
  rw normed_space.continuous_at_iff',
  intros ε ε_pos,
  have hNx₀ : 0 < ‖x₀‖,
  { exact norm_pos_iff.mpr hx₀ },
  have hNx₀2 : 0 < ‖x₀‖^2,
  { apply pow_pos hNx₀ },
  suffices : ∃ δ > 0, ∀ y, ‖y - x₀‖ ≤ δ → ∀ x, ‖(⟪x₀, x⟫ / ⟪x₀, x₀⟫) • x₀ - (⟪y, x⟫ / ⟪y, y⟫) • y‖ ≤ ε * ‖x‖,
  by simpa only [continuous_linear_map.op_norm_le_iff (le_of_lt ε_pos),
    orthogonal_projection_orthogonal_singleton, continuous_linear_map.coe_sub',
    continuous_linear_map.coe_comp', coe_subtypeL', submodule.coe_subtype, pi.sub_apply,
    comp_app, coe_mk, sub_sub_sub_cancel_left],
  let N : E → E := λ x, ⟪x, x⟫⁻¹ • x,
  have hNx₀ : 0 < ‖N x₀‖,
  { dsimp [N], -- and now let's suffer
    rw [norm_smul, real_inner_self_eq_norm_sq, norm_inv],
    apply mul_pos,
    apply inv_pos_of_pos,
    apply norm_pos_iff.mpr hNx₀2.ne',
    exact hNx₀ },
  have cont : continuous_at N x₀,
  { dsimp [N],
    simp_rw real_inner_self_eq_norm_sq,
    exact ((continuous_norm.pow 2).continuous_at.inv₀ hNx₀2.ne').smul continuous_at_id },
  have lim : tendsto (λ y, ‖N x₀ - N y‖ * ‖y‖) (𝓝 x₀) (𝓝 0),
  { rw [← zero_mul ‖x₀‖],
    apply tendsto.mul,
    rw ← show ‖N x₀ - N x₀‖ = 0, by simp,
    exact (tendsto_const_nhds.sub cont).norm,
    exact continuous_norm.continuous_at },
  have key : ∀ x y, (⟪x₀, x⟫ / ⟪x₀, x₀⟫) • x₀ - (⟪y, x⟫ / ⟪y, y⟫) • y =
    ⟪N x₀, x⟫ • (x₀ - y) + ⟪N x₀ - N y, x⟫ • y,
  { intros x y,
    dsimp only [N],
    simp only [inner_smul_left, inner_sub_left, is_R_or_C.conj_to_real, smul_sub, sub_smul],
    field_simp },
  simp only [key],
  simp_rw [metric.tendsto_nhds_nhds, real.dist_0_eq_abs, dist_eq_norm] at lim,
  rcases lim (ε/2) (half_pos ε_pos) with ⟨η, η_pos, hη⟩,
  refine ⟨min ((ε/2)/ ‖N x₀‖) (η/2), _, _⟩,
  { apply lt_min, positivity, exact half_pos η_pos },
  intros y hy x,
  have hy₁ := hy.trans (min_le_left _ _), have hy₂ := hy.trans (min_le_right _ _), clear hy,
  specialize hη (by linarith : ‖y - x₀‖ < η),
  rw abs_of_nonneg at hη,
  calc ‖⟪N x₀, x⟫ • (x₀ - y) + ⟪N x₀ - N y, x⟫ • y‖ ≤
     ‖⟪N x₀, x⟫ • (x₀ - y)‖ + ‖⟪N x₀ - N y, x⟫ • y‖ : norm_add_le _ _
  ... ≤ ‖N x₀‖*‖x‖ * ‖x₀ - y‖ + ‖N x₀ - N y‖ * ‖x‖ * ‖y‖ : add_le_add _ _
  ... ≤ (ε/2) * ‖x‖ + (ε/2) * ‖x‖ : add_le_add _ _
  ... = ε * ‖x‖ : by linarith,
  { rw norm_smul,
    exact mul_le_mul_of_nonneg_right (norm_inner_le_norm _ _) (norm_nonneg _) },
  { rw norm_smul,
    exact mul_le_mul_of_nonneg_right (norm_inner_le_norm _ _) (norm_nonneg _) },
  { rw [mul_comm, ← mul_assoc, norm_sub_rev],
    exact mul_le_mul_of_nonneg_right ((_root_.le_div_iff hNx₀).mp hy₁) (norm_nonneg x) },
  { rw [mul_comm, ← mul_assoc, mul_comm ‖y‖],
    exact  mul_le_mul_of_nonneg_right hη.le (norm_nonneg x) },
  { positivity },
end


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import measure_theory.measure.measure_space

/-!
# Unsigned Hahn decomposition theorem

This file proves the unsigned version of the Hahn decomposition theorem.

## Main statements

* `hahn_decomposition` : Given two finite measures `μ` and `ν`, there exists a measurable set `s`
    such that any measurable set `t` included in `s` satisfies `ν t ≤ μ t`, and any
    measurable set `u` included in the complement of `s` satisfies `μ u ≤ ν u`.

## Tags

Hahn decomposition
-/

open set filter
open_locale classical topological_space ennreal

namespace measure_theory

variables {α : Type*} [measurable_space α] {μ ν : measure α}

-- suddenly this is necessary?!
private lemma aux {m : ℕ} {γ d : ℝ} (h : γ - (1 / 2) ^ m < d) :
  γ - 2 * (1 / 2) ^ m + (1 / 2) ^ m ≤ d :=
by linarith

/-- **Hahn decomposition theorem** -/
lemma hahn_decomposition [is_finite_measure μ] [is_finite_measure ν] :
  ∃s, measurable_set s ∧
    (∀t, measurable_set t → t ⊆ s → ν t ≤ μ t) ∧
    (∀t, measurable_set t → t ⊆ sᶜ → μ t ≤ ν t) :=
begin
  let d : set α → ℝ := λs, ((μ s).to_nnreal : ℝ) - (ν s).to_nnreal,
  let c : set ℝ := d '' {s | measurable_set s },
  let γ : ℝ := Sup c,

  have hμ : ∀ s, μ s ≠ ∞ := measure_ne_top μ,
  have hν : ∀ s, ν s ≠ ∞ := measure_ne_top ν,
  have to_nnreal_μ : ∀s, ((μ s).to_nnreal : ℝ≥0∞) = μ s :=
    (assume s, ennreal.coe_to_nnreal $ hμ _),
  have to_nnreal_ν : ∀s, ((ν s).to_nnreal : ℝ≥0∞) = ν s :=
    (assume s, ennreal.coe_to_nnreal $ hν _),

  have d_empty : d ∅ = 0,
  { change _ - _ = _, rw [measure_empty, measure_empty, sub_self] },

  have d_split : ∀s t, measurable_set s → measurable_set t →
    d s = d (s \ t) + d (s ∩ t),
  { assume s t hs ht,
    simp only [d],
    rw [← measure_inter_add_diff s ht, ← measure_inter_add_diff s ht,
      ennreal.to_nnreal_add (hμ _) (hμ _), ennreal.to_nnreal_add (hν _) (hν _),
      nnreal.coe_add, nnreal.coe_add],
    simp only [sub_eq_add_neg, neg_add],
    ac_refl },

  have d_Union : ∀(s : ℕ → set α), (∀n, measurable_set (s n)) → monotone s →
    tendsto (λn, d (s n)) at_top (𝓝 (d (⋃n, s n))),
  { assume s hs hm,
    refine tendsto.sub _ _;
      refine (nnreal.tendsto_coe.2 $ (ennreal.tendsto_to_nnreal _).comp $
        tendsto_measure_Union hs hm),
    exact hμ _,
    exact hν _ },

  have d_Inter : ∀(s : ℕ → set α), (∀n, measurable_set (s n)) → (∀n m, n ≤ m → s m ⊆ s n) →
    tendsto (λn, d (s n)) at_top (𝓝 (d (⋂n, s n))),
  { assume s hs hm,
    refine tendsto.sub _ _;
      refine (nnreal.tendsto_coe.2 $ (ennreal.tendsto_to_nnreal $ _).comp $
        tendsto_measure_Inter hs hm _),
    exacts [hμ _, ⟨0, hμ _⟩, hν _, ⟨0, hν _⟩] },

  have bdd_c : bdd_above c,
  { use (μ univ).to_nnreal,
    rintros r ⟨s, hs, rfl⟩,
    refine le_trans (sub_le_self _ $ nnreal.coe_nonneg _) _,
    rw [nnreal.coe_le_coe, ← ennreal.coe_le_coe, to_nnreal_μ, to_nnreal_μ],
    exact measure_mono (subset_univ _) },

  have c_nonempty : c.nonempty := nonempty.image _ ⟨_, measurable_set.empty⟩,

  have d_le_γ : ∀s, measurable_set s → d s ≤ γ := assume s hs, le_cSup bdd_c ⟨s, hs, rfl⟩,

  have : ∀n:ℕ, ∃s : set α, measurable_set s ∧ γ - (1/2)^n < d s,
  { assume n,
    have : γ - (1/2)^n < γ := sub_lt_self γ (pow_pos (half_pos zero_lt_one) n),
    rcases exists_lt_of_lt_cSup c_nonempty this with ⟨r, ⟨s, hs, rfl⟩, hlt⟩,
    exact ⟨s, hs, hlt⟩ },
  rcases classical.axiom_of_choice this with ⟨e, he⟩,
  change ℕ → set α at e,
  have he₁ : ∀n, measurable_set (e n) := assume n, (he n).1,
  have he₂ : ∀n, γ - (1/2)^n < d (e n) := assume n, (he n).2,

  let f : ℕ → ℕ → set α := λn m, (finset.Ico n (m + 1)).inf e,

  have hf : ∀n m, measurable_set (f n m),
  { assume n m,
    simp only [f, finset.inf_eq_infi],
    exact measurable_set.bInter (countable_encodable _) (assume i _, he₁ _) },

  have f_subset_f : ∀{a b c d}, a ≤ b → c ≤ d → f a d ⊆ f b c,
  { assume a b c d hab hcd,
    dsimp only [f],
    rw [finset.inf_eq_infi, finset.inf_eq_infi],
    exact bInter_subset_bInter_left (finset.Ico_subset_Ico hab $ nat.succ_le_succ hcd) },

  have f_succ : ∀n m, n ≤ m → f n (m + 1) = f n m ∩ e (m + 1),
  { assume n m hnm,
    have : n ≤ m + 1 := le_of_lt (nat.succ_le_succ hnm),
    simp only [f],
    rw [nat.Ico_succ_right_eq_insert_Ico this, finset.inf_insert, set.inter_comm],
    refl },

  have le_d_f : ∀n m, m ≤ n → γ - 2 * ((1 / 2) ^ m) + (1 / 2) ^ n ≤ d (f m n),
  { assume n m h,
    refine nat.le_induction _ _ n h,
    { have := he₂ m,
      simp only [f],
      rw [nat.Ico_succ_singleton, finset.inf_singleton],
      exact aux this },
    { assume n (hmn : m ≤ n) ih,
      have : γ + (γ - 2 * (1 / 2)^m + (1 / 2) ^ (n + 1)) ≤ γ + d (f m (n + 1)),
      { calc γ + (γ - 2 * (1 / 2)^m + (1 / 2) ^ (n+1)) ≤
            γ + (γ - 2 * (1 / 2)^m + ((1 / 2) ^ n - (1/2)^(n+1))) :
          begin
            refine add_le_add_left (add_le_add_left _ _) γ,
            simp only [pow_add, pow_one, le_sub_iff_add_le],
            linarith
          end
          ... = (γ - (1 / 2)^(n+1)) + (γ - 2 * (1 / 2)^m + (1 / 2)^n) :
            by simp only [sub_eq_add_neg]; ac_refl
          ... ≤ d (e (n + 1)) + d (f m n) : add_le_add (le_of_lt $ he₂ _) ih
          ... ≤ d (e (n + 1)) + d (f m n \ e (n + 1)) + d (f m (n + 1)) :
            by rw [f_succ _ _ hmn, d_split (f m n) (e (n + 1)) (hf _ _) (he₁ _), add_assoc]
          ... = d (e (n + 1) ∪ f m n) + d (f m (n + 1)) :
            begin
              rw [d_split (e (n + 1) ∪ f m n) (e (n + 1)),
                union_diff_left, union_inter_cancel_left],
              ac_refl,
              exact (he₁ _).union (hf _ _),
              exact (he₁ _)
            end
          ... ≤ γ + d (f m (n + 1)) :
            add_le_add_right (d_le_γ _ $ (he₁ _).union (hf _ _)) _ },
      exact (add_le_add_iff_left γ).1 this } },

  let s := ⋃ m, ⋂n, f m n,
  have γ_le_d_s : γ ≤ d s,
  { have hγ : tendsto (λm:ℕ, γ - 2 * (1/2)^m) at_top (𝓝 γ),
    { suffices : tendsto (λm:ℕ, γ - 2 * (1/2)^m) at_top (𝓝 (γ - 2 * 0)), { simpa },
      exact (tendsto_const_nhds.sub $ tendsto_const_nhds.mul $
        tendsto_pow_at_top_nhds_0_of_lt_1
          (le_of_lt $ half_pos $ zero_lt_one) (half_lt_self zero_lt_one)) },
    have hd : tendsto (λm, d (⋂n, f m n)) at_top (𝓝 (d (⋃ m, ⋂ n, f m n))),
    { refine d_Union _ _ _,
      { assume n, exact measurable_set.Inter (assume m, hf _ _) },
      { exact assume n m hnm, subset_Inter
          (assume i, subset.trans (Inter_subset (f n) i) $ f_subset_f hnm $ le_refl _) } },
    refine le_of_tendsto_of_tendsto' hγ hd (assume m, _),
    have : tendsto (λn, d (f m n)) at_top (𝓝 (d (⋂ n, f m n))),
    { refine d_Inter _ _ _,
      { assume n, exact hf _ _ },
      { assume n m hnm, exact f_subset_f (le_refl _) hnm } },
    refine ge_of_tendsto this (eventually_at_top.2 ⟨m, assume n hmn, _⟩),
    change γ - 2 * (1 / 2) ^ m ≤ d (f m n),
    refine le_trans _ (le_d_f _ _ hmn),
    exact le_add_of_le_of_nonneg (le_refl _) (pow_nonneg (le_of_lt $ half_pos $ zero_lt_one) _) },

  have hs : measurable_set s :=
    measurable_set.Union (assume n, measurable_set.Inter (assume m, hf _ _)),
  refine ⟨s, hs, _, _⟩,
  { assume t ht hts,
    have : 0 ≤ d t := ((add_le_add_iff_left γ).1 $
      calc γ + 0 ≤ d s : by rw [add_zero]; exact γ_le_d_s
        ... = d (s \ t) + d t : by rw [d_split _ _ hs ht, inter_eq_self_of_subset_right hts]
        ... ≤ γ + d t : add_le_add (d_le_γ _ (hs.diff ht)) (le_refl _)),
    rw [← to_nnreal_μ, ← to_nnreal_ν, ennreal.coe_le_coe, ← nnreal.coe_le_coe],
    simpa only [d, le_sub_iff_add_le, zero_add] using this },
  { assume t ht hts,
    have : d t ≤ 0,
    exact ((add_le_add_iff_left γ).1 $
      calc γ + d t ≤ d s + d t : add_le_add γ_le_d_s (le_refl _)
        ... = d (s ∪ t) :
        begin
          rw [d_split _ _ (hs.union ht) ht, union_diff_right, union_inter_cancel_right,
            diff_eq_self.2],
          exact assume a ⟨hat, has⟩, hts hat has
        end
        ... ≤ γ + 0 : by rw [add_zero]; exact d_le_γ _ (hs.union ht)),
    rw [← to_nnreal_μ, ← to_nnreal_ν, ennreal.coe_le_coe, ← nnreal.coe_le_coe],
    simpa only [d, sub_le_iff_le_add, zero_add] using this }
end

end measure_theory


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group_ring_action
import Mathlib.group_theory.group_action.default
import Mathlib.PostPort

universes u_1 u_2 u_3 l u_4 u_16 u_5 u_6 u_8 u_7 u_9 u_10 u_11 u_13 u_12 u_14 u_15

namespace Mathlib

/-!
# Equivariant homomorphisms

## Main definitions

* `mul_action_hom M X Y`, the type of equivariant functions from `X` to `Y`, where `M` is a monoid
  that acts on the types `X` and `Y`.
* `distrib_mul_action_hom M A B`, the type of equivariant additive monoid homomorphisms
  from `A` to `B`, where `M` is a monoid that acts on the additive monoids `A` and `B`.
* `mul_semiring_action_hom M R S`, the type of equivariant ring homomorphisms
  from `R` to `S`, where `M` is a monoid that acts on the rings `R` and `S`.

## Notations

* `X →[M] Y` is `mul_action_hom M X Y`.
* `A →+[M] B` is `distrib_mul_action_hom M X Y`.
* `R →+*[M] S` is `mul_semiring_action_hom M X Y`.

-/

/-- Equivariant functions. -/
structure mul_action_hom (M' : Type u_1) (X : Type u_2) [has_scalar M' X] (Y : Type u_3) [has_scalar M' Y]
where
  to_fun : X → Y
  map_smul' : ∀ (m : M') (x : X), to_fun (m • x) = m • to_fun x

namespace mul_action_hom

protected instance has_coe_to_fun (M' : Type u_1) (X : Type u_2) [has_scalar M' X] (Y : Type u_3) [has_scalar M' Y] : has_coe_to_fun (mul_action_hom M' X Y) :=
  has_coe_to_fun.mk (fun (c : mul_action_hom M' X Y) => X → Y) fun (c : mul_action_hom M' X Y) => to_fun c

@[simp] theorem map_smul {M' : Type u_1} {X : Type u_2} [has_scalar M' X] {Y : Type u_3} [has_scalar M' Y] (f : mul_action_hom M' X Y) (m : M') (x : X) : coe_fn f (m • x) = m • coe_fn f x :=
  map_smul' f m x

theorem ext {M' : Type u_1} {X : Type u_2} [has_scalar M' X] {Y : Type u_3} [has_scalar M' Y] {f : mul_action_hom M' X Y} {g : mul_action_hom M' X Y} : (∀ (x : X), coe_fn f x = coe_fn g x) → f = g := sorry

theorem ext_iff {M' : Type u_1} {X : Type u_2} [has_scalar M' X] {Y : Type u_3} [has_scalar M' Y] {f : mul_action_hom M' X Y} {g : mul_action_hom M' X Y} : f = g ↔ ∀ (x : X), coe_fn f x = coe_fn g x :=
  { mp :=
      fun (H : f = g) (x : X) => eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn f x = coe_fn g x)) H)) (Eq.refl (coe_fn g x)),
    mpr := ext }

/-- The identity map as an equivariant map. -/
protected def id (M' : Type u_1) {X : Type u_2} [has_scalar M' X] : mul_action_hom M' X X :=
  mk id sorry

@[simp] theorem id_apply (M' : Type u_1) {X : Type u_2} [has_scalar M' X] (x : X) : coe_fn (mul_action_hom.id M') x = x :=
  rfl

/-- Composition of two equivariant maps. -/
def comp {M' : Type u_1} {X : Type u_2} [has_scalar M' X] {Y : Type u_3} [has_scalar M' Y] {Z : Type u_4} [has_scalar M' Z] (g : mul_action_hom M' Y Z) (f : mul_action_hom M' X Y) : mul_action_hom M' X Z :=
  mk (⇑g ∘ ⇑f) sorry

@[simp] theorem comp_apply {M' : Type u_1} {X : Type u_2} [has_scalar M' X] {Y : Type u_3} [has_scalar M' Y] {Z : Type u_4} [has_scalar M' Z] (g : mul_action_hom M' Y Z) (f : mul_action_hom M' X Y) (x : X) : coe_fn (comp g f) x = coe_fn g (coe_fn f x) :=
  rfl

@[simp] theorem id_comp {M' : Type u_1} {X : Type u_2} [has_scalar M' X] {Y : Type u_3} [has_scalar M' Y] (f : mul_action_hom M' X Y) : comp (mul_action_hom.id M') f = f := sorry

@[simp] theorem comp_id {M' : Type u_1} {X : Type u_2} [has_scalar M' X] {Y : Type u_3} [has_scalar M' Y] (f : mul_action_hom M' X Y) : comp f (mul_action_hom.id M') = f := sorry

/-- The canonical map to the left cosets. -/
def to_quotient {G : Type u_16} [group G] (H : subgroup G) : mul_action_hom G G (quotient_group.quotient H) :=
  mk coe sorry

@[simp] theorem to_quotient_apply {G : Type u_16} [group G] (H : subgroup G) (g : G) : coe_fn (to_quotient H) g = ↑g :=
  rfl

end mul_action_hom

/-- Equivariant additive monoid homomorphisms. -/
structure distrib_mul_action_hom (M : Type u_5) [monoid M] (A : Type u_6) [add_monoid A] [distrib_mul_action M A] (B : Type u_8) [add_monoid B] [distrib_mul_action M B]
extends A →+ B, mul_action_hom M A B
where

/-- Reinterpret an equivariant additive monoid homomorphism as an additive monoid homomorphism. -/
/-- Reinterpret an equivariant additive monoid homomorphism as an equivariant function. -/
namespace distrib_mul_action_hom

protected instance has_coe (M : Type u_5) [monoid M] (A : Type u_6) [add_monoid A] [distrib_mul_action M A] (B : Type u_8) [add_monoid B] [distrib_mul_action M B] : has_coe (distrib_mul_action_hom M A B) (A →+ B) :=
  has_coe.mk to_add_monoid_hom

protected instance has_coe' (M : Type u_5) [monoid M] (A : Type u_6) [add_monoid A] [distrib_mul_action M A] (B : Type u_8) [add_monoid B] [distrib_mul_action M B] : has_coe (distrib_mul_action_hom M A B) (mul_action_hom M A B) :=
  has_coe.mk to_mul_action_hom

protected instance has_coe_to_fun (M : Type u_5) [monoid M] (A : Type u_6) [add_monoid A] [distrib_mul_action M A] (B : Type u_8) [add_monoid B] [distrib_mul_action M B] : has_coe_to_fun (distrib_mul_action_hom M A B) :=
  has_coe_to_fun.mk (fun (c : distrib_mul_action_hom M A B) => A → B) fun (c : distrib_mul_action_hom M A B) => to_fun c

theorem coe_fn_coe {M : Type u_5} [monoid M] {A : Type u_6} [add_monoid A] [distrib_mul_action M A] {B : Type u_8} [add_monoid B] [distrib_mul_action M B] (f : distrib_mul_action_hom M A B) : ⇑↑f = ⇑f :=
  rfl

theorem coe_fn_coe' {M : Type u_5} [monoid M] {A : Type u_6} [add_monoid A] [distrib_mul_action M A] {B : Type u_8} [add_monoid B] [distrib_mul_action M B] (f : distrib_mul_action_hom M A B) : ⇑↑f = ⇑f :=
  rfl

theorem ext {M : Type u_5} [monoid M] {A : Type u_6} [add_monoid A] [distrib_mul_action M A] {B : Type u_8} [add_monoid B] [distrib_mul_action M B] {f : distrib_mul_action_hom M A B} {g : distrib_mul_action_hom M A B} : (∀ (x : A), coe_fn f x = coe_fn g x) → f = g := sorry

theorem ext_iff {M : Type u_5} [monoid M] {A : Type u_6} [add_monoid A] [distrib_mul_action M A] {B : Type u_8} [add_monoid B] [distrib_mul_action M B] {f : distrib_mul_action_hom M A B} {g : distrib_mul_action_hom M A B} : f = g ↔ ∀ (x : A), coe_fn f x = coe_fn g x :=
  { mp :=
      fun (H : f = g) (x : A) => eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn f x = coe_fn g x)) H)) (Eq.refl (coe_fn g x)),
    mpr := ext }

@[simp] theorem map_zero {M : Type u_5} [monoid M] {A : Type u_6} [add_monoid A] [distrib_mul_action M A] {B : Type u_8} [add_monoid B] [distrib_mul_action M B] (f : distrib_mul_action_hom M A B) : coe_fn f 0 = 0 :=
  map_zero' f

@[simp] theorem map_add {M : Type u_5} [monoid M] {A : Type u_6} [add_monoid A] [distrib_mul_action M A] {B : Type u_8} [add_monoid B] [distrib_mul_action M B] (f : distrib_mul_action_hom M A B) (x : A) (y : A) : coe_fn f (x + y) = coe_fn f x + coe_fn f y :=
  map_add' f x y

@[simp] theorem map_neg {M : Type u_5} [monoid M] (A' : Type u_7) [add_group A'] [distrib_mul_action M A'] (B' : Type u_9) [add_group B'] [distrib_mul_action M B'] (f : distrib_mul_action_hom M A' B') (x : A') : coe_fn f (-x) = -coe_fn f x :=
  add_monoid_hom.map_neg (↑f) x

@[simp] theorem map_sub {M : Type u_5} [monoid M] (A' : Type u_7) [add_group A'] [distrib_mul_action M A'] (B' : Type u_9) [add_group B'] [distrib_mul_action M B'] (f : distrib_mul_action_hom M A' B') (x : A') (y : A') : coe_fn f (x - y) = coe_fn f x - coe_fn f y :=
  add_monoid_hom.map_sub (↑f) x y

@[simp] theorem map_smul {M : Type u_5} [monoid M] {A : Type u_6} [add_monoid A] [distrib_mul_action M A] {B : Type u_8} [add_monoid B] [distrib_mul_action M B] (f : distrib_mul_action_hom M A B) (m : M) (x : A) : coe_fn f (m • x) = m • coe_fn f x :=
  map_smul' f m x

/-- The identity map as an equivariant additive monoid homomorphism. -/
protected def id (M : Type u_5) [monoid M] {A : Type u_6} [add_monoid A] [distrib_mul_action M A] : distrib_mul_action_hom M A A :=
  mk id sorry sorry sorry

@[simp] theorem id_apply (M : Type u_5) [monoid M] {A : Type u_6} [add_monoid A] [distrib_mul_action M A] (x : A) : coe_fn (distrib_mul_action_hom.id M) x = x :=
  rfl

/-- Composition of two equivariant additive monoid homomorphisms. -/
def comp {M : Type u_5} [monoid M] {A : Type u_6} [add_monoid A] [distrib_mul_action M A] {B : Type u_8} [add_monoid B] [distrib_mul_action M B] {C : Type u_10} [add_monoid C] [distrib_mul_action M C] (g : distrib_mul_action_hom M B C) (f : distrib_mul_action_hom M A B) : distrib_mul_action_hom M A C :=
  mk (mul_action_hom.to_fun (mul_action_hom.comp ↑g ↑f)) sorry sorry sorry

@[simp] theorem comp_apply {M : Type u_5} [monoid M] {A : Type u_6} [add_monoid A] [distrib_mul_action M A] {B : Type u_8} [add_monoid B] [distrib_mul_action M B] {C : Type u_10} [add_monoid C] [distrib_mul_action M C] (g : distrib_mul_action_hom M B C) (f : distrib_mul_action_hom M A B) (x : A) : coe_fn (comp g f) x = coe_fn g (coe_fn f x) :=
  rfl

@[simp] theorem id_comp {M : Type u_5} [monoid M] {A : Type u_6} [add_monoid A] [distrib_mul_action M A] {B : Type u_8} [add_monoid B] [distrib_mul_action M B] (f : distrib_mul_action_hom M A B) : comp (distrib_mul_action_hom.id M) f = f := sorry

@[simp] theorem comp_id {M : Type u_5} [monoid M] {A : Type u_6} [add_monoid A] [distrib_mul_action M A] {B : Type u_8} [add_monoid B] [distrib_mul_action M B] (f : distrib_mul_action_hom M A B) : comp f (distrib_mul_action_hom.id M) = f := sorry

end distrib_mul_action_hom

/-- Equivariant ring homomorphisms. -/
structure mul_semiring_action_hom (M : Type u_5) [monoid M] (R : Type u_11) [semiring R] [mul_semiring_action M R] (S : Type u_13) [semiring S] [mul_semiring_action M S]
extends distrib_mul_action_hom M R S, R →+* S
where

/-- Reinterpret an equivariant ring homomorphism as a ring homomorphism. -/
/-- Reinterpret an equivariant ring homomorphism as an equivariant additive monoid homomorphism. -/
namespace mul_semiring_action_hom

protected instance has_coe (M : Type u_5) [monoid M] (R : Type u_11) [semiring R] [mul_semiring_action M R] (S : Type u_13) [semiring S] [mul_semiring_action M S] : has_coe (mul_semiring_action_hom M R S) (R →+* S) :=
  has_coe.mk to_ring_hom

protected instance has_coe' (M : Type u_5) [monoid M] (R : Type u_11) [semiring R] [mul_semiring_action M R] (S : Type u_13) [semiring S] [mul_semiring_action M S] : has_coe (mul_semiring_action_hom M R S) (distrib_mul_action_hom M R S) :=
  has_coe.mk to_distrib_mul_action_hom

protected instance has_coe_to_fun (M : Type u_5) [monoid M] (R : Type u_11) [semiring R] [mul_semiring_action M R] (S : Type u_13) [semiring S] [mul_semiring_action M S] : has_coe_to_fun (mul_semiring_action_hom M R S) :=
  has_coe_to_fun.mk (fun (c : mul_semiring_action_hom M R S) => R → S) fun (c : mul_semiring_action_hom M R S) => to_fun c

theorem coe_fn_coe {M : Type u_5} [monoid M] {R : Type u_11} [semiring R] [mul_semiring_action M R] {S : Type u_13} [semiring S] [mul_semiring_action M S] (f : mul_semiring_action_hom M R S) : ⇑↑f = ⇑f :=
  rfl

theorem coe_fn_coe' {M : Type u_5} [monoid M] {R : Type u_11} [semiring R] [mul_semiring_action M R] {S : Type u_13} [semiring S] [mul_semiring_action M S] (f : mul_semiring_action_hom M R S) : ⇑↑f = ⇑f :=
  rfl

theorem ext {M : Type u_5} [monoid M] {R : Type u_11} [semiring R] [mul_semiring_action M R] {S : Type u_13} [semiring S] [mul_semiring_action M S] {f : mul_semiring_action_hom M R S} {g : mul_semiring_action_hom M R S} : (∀ (x : R), coe_fn f x = coe_fn g x) → f = g := sorry

theorem ext_iff {M : Type u_5} [monoid M] {R : Type u_11} [semiring R] [mul_semiring_action M R] {S : Type u_13} [semiring S] [mul_semiring_action M S] {f : mul_semiring_action_hom M R S} {g : mul_semiring_action_hom M R S} : f = g ↔ ∀ (x : R), coe_fn f x = coe_fn g x :=
  { mp :=
      fun (H : f = g) (x : R) => eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn f x = coe_fn g x)) H)) (Eq.refl (coe_fn g x)),
    mpr := ext }

@[simp] theorem map_zero {M : Type u_5} [monoid M] {R : Type u_11} [semiring R] [mul_semiring_action M R] {S : Type u_13} [semiring S] [mul_semiring_action M S] (f : mul_semiring_action_hom M R S) : coe_fn f 0 = 0 :=
  map_zero' f

@[simp] theorem map_add {M : Type u_5} [monoid M] {R : Type u_11} [semiring R] [mul_semiring_action M R] {S : Type u_13} [semiring S] [mul_semiring_action M S] (f : mul_semiring_action_hom M R S) (x : R) (y : R) : coe_fn f (x + y) = coe_fn f x + coe_fn f y :=
  map_add' f x y

@[simp] theorem map_neg {M : Type u_5} [monoid M] (R' : Type u_12) [ring R'] [mul_semiring_action M R'] (S' : Type u_14) [ring S'] [mul_semiring_action M S'] (f : mul_semiring_action_hom M R' S') (x : R') : coe_fn f (-x) = -coe_fn f x :=
  ring_hom.map_neg (↑f) x

@[simp] theorem map_sub {M : Type u_5} [monoid M] (R' : Type u_12) [ring R'] [mul_semiring_action M R'] (S' : Type u_14) [ring S'] [mul_semiring_action M S'] (f : mul_semiring_action_hom M R' S') (x : R') (y : R') : coe_fn f (x - y) = coe_fn f x - coe_fn f y :=
  ring_hom.map_sub (↑f) x y

@[simp] theorem map_one {M : Type u_5} [monoid M] {R : Type u_11} [semiring R] [mul_semiring_action M R] {S : Type u_13} [semiring S] [mul_semiring_action M S] (f : mul_semiring_action_hom M R S) : coe_fn f 1 = 1 :=
  map_one' f

@[simp] theorem map_mul {M : Type u_5} [monoid M] {R : Type u_11} [semiring R] [mul_semiring_action M R] {S : Type u_13} [semiring S] [mul_semiring_action M S] (f : mul_semiring_action_hom M R S) (x : R) (y : R) : coe_fn f (x * y) = coe_fn f x * coe_fn f y :=
  map_mul' f x y

@[simp] theorem map_smul {M : Type u_5} [monoid M] {R : Type u_11} [semiring R] [mul_semiring_action M R] {S : Type u_13} [semiring S] [mul_semiring_action M S] (f : mul_semiring_action_hom M R S) (m : M) (x : R) : coe_fn f (m • x) = m • coe_fn f x :=
  map_smul' f m x

/-- The identity map as an equivariant ring homomorphism. -/
protected def id (M : Type u_5) [monoid M] {R : Type u_11} [semiring R] [mul_semiring_action M R] : mul_semiring_action_hom M R R :=
  mk id sorry sorry sorry sorry sorry

@[simp] theorem id_apply (M : Type u_5) [monoid M] {R : Type u_11} [semiring R] [mul_semiring_action M R] (x : R) : coe_fn (mul_semiring_action_hom.id M) x = x :=
  rfl

/-- Composition of two equivariant additive monoid homomorphisms. -/
def comp {M : Type u_5} [monoid M] {R : Type u_11} [semiring R] [mul_semiring_action M R] {S : Type u_13} [semiring S] [mul_semiring_action M S] {T : Type u_15} [semiring T] [mul_semiring_action M T] (g : mul_semiring_action_hom M S T) (f : mul_semiring_action_hom M R S) : mul_semiring_action_hom M R T :=
  mk (distrib_mul_action_hom.to_fun (distrib_mul_action_hom.comp ↑g ↑f)) sorry sorry sorry sorry sorry

@[simp] theorem comp_apply {M : Type u_5} [monoid M] {R : Type u_11} [semiring R] [mul_semiring_action M R] {S : Type u_13} [semiring S] [mul_semiring_action M S] {T : Type u_15} [semiring T] [mul_semiring_action M T] (g : mul_semiring_action_hom M S T) (f : mul_semiring_action_hom M R S) (x : R) : coe_fn (comp g f) x = coe_fn g (coe_fn f x) :=
  rfl

@[simp] theorem id_comp {M : Type u_5} [monoid M] {R : Type u_11} [semiring R] [mul_semiring_action M R] {S : Type u_13} [semiring S] [mul_semiring_action M S] (f : mul_semiring_action_hom M R S) : comp (mul_semiring_action_hom.id M) f = f := sorry

@[simp] theorem comp_id {M : Type u_5} [monoid M] {R : Type u_11} [semiring R] [mul_semiring_action M R] {S : Type u_13} [semiring S] [mul_semiring_action M S] (f : mul_semiring_action_hom M R S) : comp f (mul_semiring_action_hom.id M) = f := sorry

end mul_semiring_action_hom

/-- The canonical inclusion from an invariant subring. -/
def is_invariant_subring.subtype_hom (M : Type u_5) [monoid M] {R' : Type u_12} [ring R'] [mul_semiring_action M R'] (U : set R') [is_subring U] [is_invariant_subring M U] : mul_semiring_action_hom M (↥U) R' :=
  mul_semiring_action_hom.mk (ring_hom.to_fun (is_subring.subtype U)) sorry sorry sorry sorry sorry

@[simp] theorem is_invariant_subring.coe_subtype_hom (M : Type u_5) [monoid M] {R' : Type u_12} [ring R'] [mul_semiring_action M R'] (U : set R') [is_subring U] [is_invariant_subring M U] : ⇑(is_invariant_subring.subtype_hom M U) = coe :=
  rfl

@[simp] theorem is_invariant_subring.coe_subtype_hom' (M : Type u_5) [monoid M] {R' : Type u_12} [ring R'] [mul_semiring_action M R'] (U : set R') [is_subring U] [is_invariant_subring M U] : ↑(is_invariant_subring.subtype_hom M U) = is_subring.subtype U :=
  rfl


/-
Copyright (c) 2020 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann

! This file was ported from Lean 3 source module algebra.continued_fractions.computation.terminates_iff_rat
! leanprover-community/mathlib commit a7e36e48519ab281320c4d192da6a7b348ce40ad
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.ContinuedFractions.Computation.Approximations
import Mathbin.Algebra.ContinuedFractions.Computation.CorrectnessTerminating
import Mathbin.Data.Rat.Floor

/-!
# Termination of Continued Fraction Computations (`gcf.of`)

## Summary
We show that the continued fraction for a value `v`, as defined in
`algebra.continued_fractions.computation.basic`, terminates if and only if `v` corresponds to a
rational number, that is `↑v = q` for some `q : ℚ`.

## Main Theorems

- `generalized_continued_fraction.coe_of_rat` shows that
  `generalized_continued_fraction.of v = generalized_continued_fraction.of q` for `v : α` given that
  `↑v = q` and `q : ℚ`.
- `generalized_continued_fraction.terminates_iff_rat` shows that
  `generalized_continued_fraction.of v` terminates if and only if `↑v = q` for some `q : ℚ`.

## Tags

rational, continued fraction, termination
-/

namespace GeneralizedContinuedFraction

/- ./././Mathport/Syntax/Translate/Command.lean:224:11: unsupported: unusual advanced open style -/
open GeneralizedContinuedFraction (of)

variable {K : Type _} [LinearOrderedField K] [FloorRing K]

/-
We will have to constantly coerce along our structures in the following proofs using their provided
map functions.
-/
attribute [local simp] pair.map int_fract_pair.mapFr

section RatOfTerminates

/-!
### Terminating Continued Fractions Are Rational

We want to show that the computation of a continued fraction `generalized_continued_fraction.of v`
terminates if and only if `v ∈ ℚ`. In this section, we show the implication from left to right.

We first show that every finite convergent corresponds to a rational number `q` and then use the
finite correctness proof (`of_correctness_of_terminates`) of `generalized_continued_fraction.of` to
show that `v = ↑q`.
-/

variable (v : K) (n : ℕ)

theorem exists_gcf_pair_rat_eq_of_nth_conts_aux :
    ∃ conts : Pair ℚ, (of v).continuantsAux n = (conts.map coe : Pair K) :=
  Nat.strong_induction_on n
    (by
      clear n
      let g := of v
      intro n IH
      rcases n with (_ | _ | n)
      -- n = 0
      · suffices ∃ gp : pair ℚ, pair.mk (1 : K) 0 = gp.map coe by simpa [continuants_aux]
        use pair.mk 1 0
        simp
      -- n = 1
      · suffices ∃ conts : pair ℚ, pair.mk g.h 1 = conts.map coe by simpa [continuants_aux]
        use pair.mk ⌊v⌋ 1
        simp
      -- 2 ≤ n
      · cases' IH (n + 1) <| lt_add_one (n + 1) with pred_conts pred_conts_eq
        -- invoke the IH
        cases' s_ppred_nth_eq : g.s.nth n with gp_n
        -- option.none
        · use pred_conts
          have : g.continuants_aux (n + 2) = g.continuants_aux (n + 1) :=
            continuants_aux_stable_of_terminated (n + 1).le_succ s_ppred_nth_eq
          simp only [this, pred_conts_eq]
        -- option.some
        · -- invoke the IH a second time
          cases' IH n <| lt_of_le_of_lt n.le_succ <| lt_add_one <| n + 1 with
            ppred_conts ppred_conts_eq
          obtain ⟨a_eq_one, z, b_eq_z⟩ : gp_n.a = 1 ∧ ∃ z : ℤ, gp_n.b = (z : K)
          exact of_part_num_eq_one_and_exists_int_part_denom_eq s_ppred_nth_eq
          -- finally, unfold the recurrence to obtain the required rational value.
          simp only [a_eq_one, b_eq_z,
            continuants_aux_recurrence s_ppred_nth_eq ppred_conts_eq pred_conts_eq]
          use next_continuants 1 (z : ℚ) ppred_conts pred_conts
          cases ppred_conts
          cases pred_conts
          simp [next_continuants, next_numerator, next_denominator])
#align generalized_continued_fraction.exists_gcf_pair_rat_eq_of_nth_conts_aux GeneralizedContinuedFraction.exists_gcf_pair_rat_eq_of_nth_conts_aux

theorem exists_gcf_pair_rat_eq_nth_conts :
    ∃ conts : Pair ℚ, (of v).continuants n = (conts.map coe : Pair K) :=
  by
  rw [nth_cont_eq_succ_nth_cont_aux]
  exact exists_gcf_pair_rat_eq_of_nth_conts_aux v <| n + 1
#align generalized_continued_fraction.exists_gcf_pair_rat_eq_nth_conts GeneralizedContinuedFraction.exists_gcf_pair_rat_eq_nth_conts

theorem exists_rat_eq_nth_numerator : ∃ q : ℚ, (of v).numerators n = (q : K) :=
  by
  rcases exists_gcf_pair_rat_eq_nth_conts v n with ⟨⟨a, _⟩, nth_cont_eq⟩
  use a
  simp [num_eq_conts_a, nth_cont_eq]
#align generalized_continued_fraction.exists_rat_eq_nth_numerator GeneralizedContinuedFraction.exists_rat_eq_nth_numerator

theorem exists_rat_eq_nth_denominator : ∃ q : ℚ, (of v).denominators n = (q : K) :=
  by
  rcases exists_gcf_pair_rat_eq_nth_conts v n with ⟨⟨_, b⟩, nth_cont_eq⟩
  use b
  simp [denom_eq_conts_b, nth_cont_eq]
#align generalized_continued_fraction.exists_rat_eq_nth_denominator GeneralizedContinuedFraction.exists_rat_eq_nth_denominator

/-- Every finite convergent corresponds to a rational number. -/
theorem exists_rat_eq_nth_convergent : ∃ q : ℚ, (of v).convergents n = (q : K) :=
  by
  rcases exists_rat_eq_nth_numerator v n with ⟨Aₙ, nth_num_eq⟩
  rcases exists_rat_eq_nth_denominator v n with ⟨Bₙ, nth_denom_eq⟩
  use Aₙ / Bₙ
  simp [nth_num_eq, nth_denom_eq, convergent_eq_num_div_denom]
#align generalized_continued_fraction.exists_rat_eq_nth_convergent GeneralizedContinuedFraction.exists_rat_eq_nth_convergent

variable {v}

/-- Every terminating continued fraction corresponds to a rational number. -/
theorem exists_rat_eq_of_terminates (terminates : (of v).Terminates) : ∃ q : ℚ, v = ↑q :=
  by
  obtain ⟨n, v_eq_conv⟩ : ∃ n, v = (of v).convergents n
  exact of_correctness_of_terminates terminates
  obtain ⟨q, conv_eq_q⟩ : ∃ q : ℚ, (of v).convergents n = (↑q : K)
  exact exists_rat_eq_nth_convergent v n
  have : v = (↑q : K) := Eq.trans v_eq_conv conv_eq_q
  use q, this
#align generalized_continued_fraction.exists_rat_eq_of_terminates GeneralizedContinuedFraction.exists_rat_eq_of_terminates

end RatOfTerminates

section RatTranslation

/-!
### Technical Translation Lemmas

Before we can show that the continued fraction of a rational number terminates, we have to prove
some technical translation lemmas. More precisely, in this section, we show that, given a rational
number `q : ℚ` and value `v : K` with `v = ↑q`, the continued fraction of `q` and `v` coincide.
In particular, we show that
```lean
    (↑(generalized_continued_fraction.of q : generalized_continued_fraction ℚ)
      : generalized_continued_fraction K)
  = generalized_continued_fraction.of v`
```
in `generalized_continued_fraction.coe_of_rat`.

To do this, we proceed bottom-up, showing the correspondence between the basic functions involved in
the computation first and then lift the results step-by-step.
-/

-- The lifting works for arbitrary linear ordered fields with a floor function.
variable {v : K} {q : ℚ} (v_eq_q : v = (↑q : K)) (n : ℕ)

include v_eq_q

/-! First, we show the correspondence for the very basic functions in
`generalized_continued_fraction.int_fract_pair`. -/

namespace IntFractPair

theorem coe_of_rat_eq : ((IntFractPair.of q).mapFr coe : IntFractPair K) = IntFractPair.of v := by
  simp [int_fract_pair.of, v_eq_q]
#align generalized_continued_fraction.int_fract_pair.coe_of_rat_eq GeneralizedContinuedFraction.IntFractPair.coe_of_rat_eq

theorem coe_stream_nth_rat_eq :
    ((IntFractPair.stream q n).map (mapFr coe) : Option <| IntFractPair K) =
      IntFractPair.stream v n :=
  by
  induction' n with n IH
  case zero => simp [int_fract_pair.stream, coe_of_rat_eq v_eq_q]
  case succ =>
    rw [v_eq_q] at IH
    cases' stream_q_nth_eq : int_fract_pair.stream q n with ifp_n
    case none => simp [int_fract_pair.stream, IH.symm, v_eq_q, stream_q_nth_eq]
    case some =>
      cases' ifp_n with b fr
      cases' Decidable.em (fr = 0) with fr_zero fr_ne_zero
      · simp [int_fract_pair.stream, IH.symm, v_eq_q, stream_q_nth_eq, fr_zero]
      · replace IH : some (int_fract_pair.mk b ↑fr) = int_fract_pair.stream (↑q) n
        · rwa [stream_q_nth_eq] at IH
        have : (fr : K)⁻¹ = ((fr⁻¹ : ℚ) : K) := by norm_cast
        have coe_of_fr := coe_of_rat_eq this
        simpa [int_fract_pair.stream, IH.symm, v_eq_q, stream_q_nth_eq, fr_ne_zero]
#align generalized_continued_fraction.int_fract_pair.coe_stream_nth_rat_eq GeneralizedContinuedFraction.IntFractPair.coe_stream_nth_rat_eq

theorem coe_stream'_rat_eq :
    ((IntFractPair.stream q).map (Option.map (mapFr coe)) : Stream' <| Option <| IntFractPair K) =
      IntFractPair.stream v :=
  by
  funext n
  exact int_fract_pair.coe_stream_nth_rat_eq v_eq_q n
#align generalized_continued_fraction.int_fract_pair.coe_stream_rat_eq GeneralizedContinuedFraction.IntFractPair.coe_stream'_rat_eq

end IntFractPair

/-! Now we lift the coercion results to the continued fraction computation. -/

theorem coe_of_h_rat_eq : (↑((of q).h : ℚ) : K) = (of v).h :=
  by
  unfold of int_fract_pair.seq1
  rw [← int_fract_pair.coe_of_rat_eq v_eq_q]
  simp
#align generalized_continued_fraction.coe_of_h_rat_eq GeneralizedContinuedFraction.coe_of_h_rat_eq

theorem coe_of_s_nth_rat_eq :
    (((of q).s.get? n).map (Pair.map coe) : Option <| Pair K) = (of v).s.get? n :=
  by
  simp only [of, int_fract_pair.seq1, seq.map_nth, seq.nth_tail]
  simp only [seq.nth]
  rw [← int_fract_pair.coe_stream_rat_eq v_eq_q]
  rcases succ_nth_stream_eq : int_fract_pair.stream q (n + 1) with (_ | ⟨_, _⟩) <;>
    simp [Stream'.map, Stream'.nth, succ_nth_stream_eq]
#align generalized_continued_fraction.coe_of_s_nth_rat_eq GeneralizedContinuedFraction.coe_of_s_nth_rat_eq

theorem coe_of_s_rat_eq : ((of q).s.map (Pair.map coe) : Seq <| Pair K) = (of v).s :=
  by
  ext n
  rw [← coe_of_s_nth_rat_eq v_eq_q]
  rfl
#align generalized_continued_fraction.coe_of_s_rat_eq GeneralizedContinuedFraction.coe_of_s_rat_eq

/-- Given `(v : K), (q : ℚ), and v = q`, we have that `gcf.of q = gcf.of v` -/
theorem coe_of_rat_eq :
    (⟨(of q).h, (of q).s.map (Pair.map coe)⟩ : GeneralizedContinuedFraction K) = of v :=
  by
  cases' gcf_v_eq : of v with h s
  subst v
  obtain rfl : ↑⌊↑q⌋ = h := by injection gcf_v_eq
  simp [coe_of_h_rat_eq rfl, coe_of_s_rat_eq rfl, gcf_v_eq]
#align generalized_continued_fraction.coe_of_rat_eq GeneralizedContinuedFraction.coe_of_rat_eq

theorem of_terminates_iff_of_rat_terminates {v : K} {q : ℚ} (v_eq_q : v = (q : K)) :
    (of v).Terminates ↔ (of q).Terminates := by
  constructor <;> intro h <;> cases' h with n h <;> use n <;>
        simp only [seq.terminated_at, (coe_of_s_nth_rat_eq v_eq_q n).symm] at h⊢ <;>
      cases (of q).s.get? n <;>
    trivial
#align generalized_continued_fraction.of_terminates_iff_of_rat_terminates GeneralizedContinuedFraction.of_terminates_iff_of_rat_terminates

end RatTranslation

section TerminatesOfRat

/-!
### Continued Fractions of Rationals Terminate

Finally, we show that the continued fraction of a rational number terminates.

The crucial insight is that, given any `q : ℚ` with `0 < q < 1`, the numerator of `int.fract q` is
smaller than the numerator of `q`. As the continued fraction computation recursively operates on
the fractional part of a value `v` and `0 ≤ int.fract v < 1`, we infer that the numerator of the
fractional part in the computation decreases by at least one in each step. As `0 ≤ int.fract v`,
this process must stop after finite number of steps, and the computation hence terminates.
-/

namespace IntFractPair

variable {q : ℚ} {n : ℕ}

/-- Shows that for any `q : ℚ` with `0 < q < 1`, the numerator of the fractional part of
`int_fract_pair.of q⁻¹` is smaller than the numerator of `q`.
-/
theorem of_inv_fr_num_lt_num_of_pos (q_pos : 0 < q) : (IntFractPair.of q⁻¹).fr.num < q.num :=
  Rat.fract_inv_num_lt_num_of_pos q_pos
#align generalized_continued_fraction.int_fract_pair.of_inv_fr_num_lt_num_of_pos GeneralizedContinuedFraction.IntFractPair.of_inv_fr_num_lt_num_of_pos

/-- Shows that the sequence of numerators of the fractional parts of the stream is strictly
antitone. -/
theorem stream_succ_nth_fr_num_lt_nth_fr_num_rat {ifp_n ifp_succ_n : IntFractPair ℚ}
    (stream_nth_eq : IntFractPair.stream q n = some ifp_n)
    (stream_succ_nth_eq : IntFractPair.stream q (n + 1) = some ifp_succ_n) :
    ifp_succ_n.fr.num < ifp_n.fr.num :=
  by
  obtain ⟨ifp_n', stream_nth_eq', ifp_n_fract_ne_zero, int_fract_pair.of_eq_ifp_succ_n⟩ :
    ∃ ifp_n',
      int_fract_pair.stream q n = some ifp_n' ∧
        ifp_n'.fr ≠ 0 ∧ int_fract_pair.of ifp_n'.fr⁻¹ = ifp_succ_n
  exact succ_nth_stream_eq_some_iff.elim_left stream_succ_nth_eq
  have : ifp_n = ifp_n' := by injection Eq.trans stream_nth_eq.symm stream_nth_eq'
  cases this
  rw [← int_fract_pair.of_eq_ifp_succ_n]
  cases' nth_stream_fr_nonneg_lt_one stream_nth_eq with zero_le_ifp_n_fract ifp_n_fract_lt_one
  have : 0 < ifp_n.fr := lt_of_le_of_ne zero_le_ifp_n_fract <| ifp_n_fract_ne_zero.symm
  exact of_inv_fr_num_lt_num_of_pos this
#align generalized_continued_fraction.int_fract_pair.stream_succ_nth_fr_num_lt_nth_fr_num_rat GeneralizedContinuedFraction.IntFractPair.stream_succ_nth_fr_num_lt_nth_fr_num_rat

theorem stream_nth_fr_num_le_fr_num_sub_n_rat :
    ∀ {ifp_n : IntFractPair ℚ},
      IntFractPair.stream q n = some ifp_n → ifp_n.fr.num ≤ (IntFractPair.of q).fr.num - n :=
  by
  induction' n with n IH
  case zero =>
    intro ifp_zero stream_zero_eq
    have : int_fract_pair.of q = ifp_zero := by injection stream_zero_eq
    simp [le_refl, this.symm]
  case succ =>
    intro ifp_succ_n stream_succ_nth_eq
    suffices ifp_succ_n.fr.num + 1 ≤ (int_fract_pair.of q).fr.num - n
      by
      rw [Int.ofNat_succ, sub_add_eq_sub_sub]
      solve_by_elim [le_sub_right_of_add_le]
    rcases succ_nth_stream_eq_some_iff.elim_left stream_succ_nth_eq with ⟨ifp_n, stream_nth_eq, -⟩
    have : ifp_succ_n.fr.num < ifp_n.fr.num :=
      stream_succ_nth_fr_num_lt_nth_fr_num_rat stream_nth_eq stream_succ_nth_eq
    have : ifp_succ_n.fr.num + 1 ≤ ifp_n.fr.num := Int.add_one_le_of_lt this
    exact le_trans this (IH stream_nth_eq)
#align generalized_continued_fraction.int_fract_pair.stream_nth_fr_num_le_fr_num_sub_n_rat GeneralizedContinuedFraction.IntFractPair.stream_nth_fr_num_le_fr_num_sub_n_rat

theorem exists_nth_stream_eq_none_of_rat (q : ℚ) : ∃ n : ℕ, IntFractPair.stream q n = none :=
  by
  let fract_q_num := (Int.fract q).num; let n := fract_q_num.nat_abs + 1
  cases' stream_nth_eq : int_fract_pair.stream q n with ifp
  · use n
    exact stream_nth_eq
  · -- arrive at a contradiction since the numerator decreased num + 1 times but every fractional
    -- value is nonnegative.
    have ifp_fr_num_le_q_fr_num_sub_n : ifp.fr.num ≤ fract_q_num - n :=
      stream_nth_fr_num_le_fr_num_sub_n_rat stream_nth_eq
    have : fract_q_num - n = -1 :=
      by
      have : 0 ≤ fract_q_num := rat.num_nonneg_iff_zero_le.elim_right (Int.fract_nonneg q)
      simp [Int.natAbs_of_nonneg this, sub_add_eq_sub_sub_swap, sub_right_comm]
    have : ifp.fr.num ≤ -1 := by rwa [this] at ifp_fr_num_le_q_fr_num_sub_n
    have : 0 ≤ ifp.fr := (nth_stream_fr_nonneg_lt_one stream_nth_eq).left
    have : 0 ≤ ifp.fr.num := rat.num_nonneg_iff_zero_le.elim_right this
    linarith
#align generalized_continued_fraction.int_fract_pair.exists_nth_stream_eq_none_of_rat GeneralizedContinuedFraction.IntFractPair.exists_nth_stream_eq_none_of_rat

end IntFractPair

/-- The continued fraction of a rational number terminates. -/
theorem terminates_of_rat (q : ℚ) : (of q).Terminates :=
  Exists.elim (IntFractPair.exists_nth_stream_eq_none_of_rat q) fun n stream_nth_eq_none =>
    Exists.intro n
      (have : IntFractPair.stream q (n + 1) = none := IntFractPair.stream_isSeq q stream_nth_eq_none
      of_terminatedAt_n_iff_succ_nth_intFractPair_stream_eq_none.right this)
#align generalized_continued_fraction.terminates_of_rat GeneralizedContinuedFraction.terminates_of_rat

end TerminatesOfRat

/-- The continued fraction `generalized_continued_fraction.of v` terminates if and only if `v ∈ ℚ`.
-/
theorem terminates_iff_rat (v : K) : (of v).Terminates ↔ ∃ q : ℚ, v = (q : K) :=
  Iff.intro
    (fun terminates_v : (of v).Terminates =>
      show ∃ q : ℚ, v = (q : K) from exists_rat_eq_of_terminates terminates_v)
    fun exists_q_eq_v : ∃ q : ℚ, v = (↑q : K) =>
    Exists.elim exists_q_eq_v fun q => fun v_eq_q : v = ↑q =>
      have : (of q).Terminates := terminates_of_rat q
      (of_terminates_iff_of_rat_terminates v_eq_q).right this
#align generalized_continued_fraction.terminates_iff_rat GeneralizedContinuedFraction.terminates_iff_rat

end GeneralizedContinuedFraction


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.logic
import Mathlib.Lean3Lib.init.classical
import Mathlib.Lean3Lib.init.meta.name
import Mathlib.Lean3Lib.init.algebra.classes

universes u l u_1

namespace Mathlib

/- Make sure instances defined in this file have lower priority than the ones
   defined for concrete structures -/

/-!
### Definition of `preorder` and lemmas about types with a `preorder`
-/

/-- A preorder is a reflexive, transitive relation `≤` with `a < b` defined in the obvious way. -/
class preorder (α : Type u)
extends HasLess α, HasLessEq α
where
  le : α → α → Prop
  lt : α → α → Prop
  le_refl : ∀ (a : α), a ≤ a
  le_trans : ∀ (a b c : α), a ≤ b → b ≤ c → a ≤ c
  lt_iff_le_not_le : autoParam (∀ (a b : α), a < b ↔ a ≤ b ∧ ¬b ≤ a)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.order_laws_tac")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "order_laws_tac") [])

/-- The relation `≤` on a preorder is reflexive. -/
theorem le_refl {α : Type u} [preorder α] (a : α) : a ≤ a :=
  preorder.le_refl

/-- The relation `≤` on a preorder is transitive. -/
theorem le_trans {α : Type u} [preorder α] {a : α} {b : α} {c : α} : a ≤ b → b ≤ c → a ≤ c :=
  preorder.le_trans

theorem lt_iff_le_not_le {α : Type u} [preorder α] {a : α} {b : α} : a < b ↔ a ≤ b ∧ ¬b ≤ a :=
  preorder.lt_iff_le_not_le

theorem lt_of_le_not_le {α : Type u} [preorder α] {a : α} {b : α} : a ≤ b → ¬b ≤ a → a < b :=
  fun (ᾰ : a ≤ b) (ᾰ_1 : ¬b ≤ a) => idRhs (a < b) (iff.mpr lt_iff_le_not_le { left := ᾰ, right := ᾰ_1 })

theorem le_not_le_of_lt {α : Type u} [preorder α] {a : α} {b : α} : a < b → a ≤ b ∧ ¬b ≤ a :=
  fun (ᾰ : a < b) => idRhs (a ≤ b ∧ ¬b ≤ a) (iff.mp lt_iff_le_not_le ᾰ)

theorem le_of_eq {α : Type u} [preorder α] {a : α} {b : α} : a = b → a ≤ b :=
  fun (h : a = b) => h ▸ le_refl a

theorem ge_trans {α : Type u} [preorder α] {a : α} {b : α} {c : α} : a ≥ b → b ≥ c → a ≥ c :=
  fun (h₁ : a ≥ b) (h₂ : b ≥ c) => le_trans h₂ h₁

theorem lt_irrefl {α : Type u} [preorder α] (a : α) : ¬a < a := sorry

theorem gt_irrefl {α : Type u} [preorder α] (a : α) : ¬a > a :=
  lt_irrefl

theorem lt_trans {α : Type u} [preorder α] {a : α} {b : α} {c : α} : a < b → b < c → a < c := sorry

theorem gt_trans {α : Type u} [preorder α] {a : α} {b : α} {c : α} : a > b → b > c → a > c :=
  fun (h₁ : a > b) (h₂ : b > c) => lt_trans h₂ h₁

theorem ne_of_lt {α : Type u} [preorder α] {a : α} {b : α} (h : a < b) : a ≠ b :=
  fun (he : a = b) => absurd h (he ▸ lt_irrefl a)

theorem ne_of_gt {α : Type u} [preorder α] {a : α} {b : α} (h : a > b) : a ≠ b :=
  fun (he : a = b) => absurd h (he ▸ lt_irrefl a)

theorem lt_asymm {α : Type u} [preorder α] {a : α} {b : α} (h : a < b) : ¬b < a :=
  fun (h1 : b < a) => lt_irrefl a (lt_trans h h1)

theorem le_of_lt {α : Type u} [preorder α] {a : α} {b : α} : a < b → a ≤ b :=
  fun (ᾰ : a < b) => idRhs (a ≤ b) (and.left (le_not_le_of_lt ᾰ))

theorem lt_of_lt_of_le {α : Type u} [preorder α] {a : α} {b : α} {c : α} : a < b → b ≤ c → a < c := sorry

theorem lt_of_le_of_lt {α : Type u} [preorder α] {a : α} {b : α} {c : α} : a ≤ b → b < c → a < c := sorry

theorem gt_of_gt_of_ge {α : Type u} [preorder α] {a : α} {b : α} {c : α} (h₁ : a > b) (h₂ : b ≥ c) : a > c :=
  lt_of_le_of_lt h₂ h₁

theorem gt_of_ge_of_gt {α : Type u} [preorder α] {a : α} {b : α} {c : α} (h₁ : a ≥ b) (h₂ : b > c) : a > c :=
  lt_of_lt_of_le h₂ h₁

theorem not_le_of_gt {α : Type u} [preorder α] {a : α} {b : α} (h : a > b) : ¬a ≤ b :=
  and.right (le_not_le_of_lt h)

theorem not_lt_of_ge {α : Type u} [preorder α] {a : α} {b : α} (h : a ≥ b) : ¬a < b :=
  fun (hab : a < b) => not_le_of_gt hab h

theorem le_of_lt_or_eq {α : Type u} [preorder α] {a : α} {b : α} : a < b ∨ a = b → a ≤ b :=
  fun (ᾰ : a < b ∨ a = b) =>
    or.dcases_on ᾰ (fun (ᾰ : a < b) => idRhs (a ≤ b) (le_of_lt ᾰ))
      fun (ᾰ : a = b) => idRhs ((fun (_x : α) => a ≤ _x) b) (ᾰ ▸ le_refl a)

theorem le_of_eq_or_lt {α : Type u} [preorder α] {a : α} {b : α} (h : a = b ∨ a < b) : a ≤ b :=
  or.elim h le_of_eq le_of_lt

protected instance decidable_lt_of_decidable_le {α : Type u} [preorder α] [DecidableRel LessEq] : DecidableRel Less :=
  sorry

/-!
### Definition of `partial_order` and lemmas about types with a partial order
-/

/-- A partial order is a reflexive, transitive, antisymmetric relation `≤`. -/
class partial_order (α : Type u)
extends preorder α
where
  le_antisymm : ∀ (a b : α), a ≤ b → b ≤ a → a = b

theorem le_antisymm {α : Type u} [partial_order α] {a : α} {b : α} : a ≤ b → b ≤ a → a = b :=
  partial_order.le_antisymm

theorem le_antisymm_iff {α : Type u} [partial_order α] {a : α} {b : α} : a = b ↔ a ≤ b ∧ b ≤ a := sorry

theorem lt_or_eq_of_le {α : Type u} [partial_order α] {a : α} {b : α} : a ≤ b → a < b ∨ a = b := sorry

theorem le_iff_lt_or_eq {α : Type u} [partial_order α] {a : α} {b : α} : a ≤ b ↔ a < b ∨ a = b :=
  idRhs (a ≤ b ↔ a < b ∨ a = b) { mp := lt_or_eq_of_le, mpr := le_of_lt_or_eq }

theorem lt_of_le_of_ne {α : Type u} [partial_order α] {a : α} {b : α} : a ≤ b → a ≠ b → a < b :=
  fun (h₁ : a ≤ b) (h₂ : a ≠ b) => lt_of_le_not_le h₁ (mt (le_antisymm h₁) h₂)

protected instance decidable_eq_of_decidable_le {α : Type u} [partial_order α] [DecidableRel LessEq] : DecidableEq α :=
  sorry

/-!
### Definition of `linear_order` and lemmas about types with a linear order
-/

/-- A linear order is reflexive, transitive, antisymmetric and total relation `≤`.
We assume that every linear ordered type has decidable `(≤)`, `(<)`, and `(=)`. -/
class linear_order (α : Type u)
extends partial_order α
where
  le_total : ∀ (a b : α), a ≤ b ∨ b ≤ a
  decidable_le : DecidableRel LessEq
  decidable_eq : DecidableEq α
  decidable_lt : DecidableRel Less

theorem le_total {α : Type u} [linear_order α] (a : α) (b : α) : a ≤ b ∨ b ≤ a :=
  linear_order.le_total

theorem le_of_not_ge {α : Type u} [linear_order α] {a : α} {b : α} : ¬a ≥ b → a ≤ b :=
  or.resolve_left (le_total b a)

theorem le_of_not_le {α : Type u} [linear_order α] {a : α} {b : α} : ¬a ≤ b → b ≤ a :=
  or.resolve_left (le_total a b)

theorem not_lt_of_gt {α : Type u} [linear_order α] {a : α} {b : α} (h : a > b) : ¬a < b :=
  lt_asymm h

theorem lt_trichotomy {α : Type u} [linear_order α] (a : α) (b : α) : a < b ∨ a = b ∨ b < a := sorry

theorem le_of_not_gt {α : Type u} [linear_order α] {a : α} {b : α} (h : ¬a > b) : a ≤ b := sorry

theorem lt_of_not_ge {α : Type u} [linear_order α] {a : α} {b : α} (h : ¬a ≥ b) : a < b :=
  lt_of_le_not_le (or.resolve_right (le_total a b) h) h

theorem lt_or_ge {α : Type u} [linear_order α] (a : α) (b : α) : a < b ∨ a ≥ b := sorry

theorem le_or_gt {α : Type u} [linear_order α] (a : α) (b : α) : a ≤ b ∨ a > b :=
  or.swap (lt_or_ge b a)

theorem lt_or_gt_of_ne {α : Type u} [linear_order α] {a : α} {b : α} (h : a ≠ b) : a < b ∨ a > b := sorry

theorem ne_iff_lt_or_gt {α : Type u} [linear_order α] {a : α} {b : α} : a ≠ b ↔ a < b ∨ a > b :=
  { mp := lt_or_gt_of_ne, mpr := fun (o : a < b ∨ a > b) => or.elim o ne_of_lt ne_of_gt }

theorem lt_iff_not_ge {α : Type u} [linear_order α] (x : α) (y : α) : x < y ↔ ¬x ≥ y :=
  { mp := not_le_of_gt, mpr := lt_of_not_ge }

@[simp] theorem not_lt {α : Type u} [linear_order α] {a : α} {b : α} : ¬a < b ↔ b ≤ a :=
  { mp := le_of_not_gt, mpr := not_lt_of_ge }

@[simp] theorem not_le {α : Type u} [linear_order α] {a : α} {b : α} : ¬a ≤ b ↔ b < a :=
  iff.symm (lt_iff_not_ge b a)

protected instance has_lt.lt.decidable {α : Type u} [linear_order α] (a : α) (b : α) : Decidable (a < b) :=
  linear_order.decidable_lt a b

protected instance has_le.le.decidable {α : Type u} [linear_order α] (a : α) (b : α) : Decidable (a ≤ b) :=
  linear_order.decidable_le a b

protected instance eq.decidable {α : Type u} [linear_order α] (a : α) (b : α) : Decidable (a = b) :=
  linear_order.decidable_eq a b

theorem eq_or_lt_of_not_lt {α : Type u} [linear_order α] {a : α} {b : α} (h : ¬a < b) : a = b ∨ b < a :=
  dite (a = b) (fun (h₁ : a = b) => Or.inl h₁)
    fun (h₁ : ¬a = b) => Or.inr (lt_of_not_ge fun (hge : b ≥ a) => h (lt_of_le_of_ne hge h₁))

protected instance has_le.le.is_total_preorder {α : Type u} [linear_order α] : is_total_preorder α LessEq :=
  is_total_preorder.mk

/- TODO(Leo): decide whether we should keep this instance or not -/

protected instance is_strict_weak_order_of_linear_order {α : Type u} [linear_order α] : is_strict_weak_order α Less :=
  is_strict_weak_order_of_is_total_preorder lt_iff_not_ge

/- TODO(Leo): decide whether we should keep this instance or not -/

protected instance is_strict_total_order_of_linear_order {α : Type u} [linear_order α] : is_strict_total_order α Less :=
  is_strict_total_order.mk

namespace decidable

theorem lt_or_eq_of_le {α : Type u} [partial_order α] [DecidableRel LessEq] {a : α} {b : α} (hab : a ≤ b) : a < b ∨ a = b :=
  dite (b ≤ a) (fun (hba : b ≤ a) => Or.inr (le_antisymm hab hba)) fun (hba : ¬b ≤ a) => Or.inl (lt_of_le_not_le hab hba)

theorem eq_or_lt_of_le {α : Type u} [partial_order α] [DecidableRel LessEq] {a : α} {b : α} (hab : a ≤ b) : a = b ∨ a < b :=
  or.swap (lt_or_eq_of_le hab)

theorem le_iff_lt_or_eq {α : Type u} [partial_order α] [DecidableRel LessEq] {a : α} {b : α} : a ≤ b ↔ a < b ∨ a = b :=
  { mp := lt_or_eq_of_le, mpr := le_of_lt_or_eq }

theorem le_of_not_lt {α : Type u} [linear_order α] {a : α} {b : α} (h : ¬b < a) : a ≤ b :=
  by_contradiction fun (h' : ¬a ≤ b) => h (lt_of_le_not_le (or.resolve_right (le_total b a) h') h')

theorem not_lt {α : Type u} [linear_order α] {a : α} {b : α} : ¬a < b ↔ b ≤ a :=
  { mp := le_of_not_lt, mpr := not_lt_of_ge }

theorem lt_or_le {α : Type u} [linear_order α] (a : α) (b : α) : a < b ∨ b ≤ a :=
  dite (b ≤ a) (fun (hba : b ≤ a) => Or.inr hba) fun (hba : ¬b ≤ a) => Or.inl (lt_of_not_ge hba)

theorem le_or_lt {α : Type u} [linear_order α] (a : α) (b : α) : a ≤ b ∨ b < a :=
  or.swap (lt_or_le b a)

theorem lt_trichotomy {α : Type u} [linear_order α] (a : α) (b : α) : a < b ∨ a = b ∨ b < a :=
  or.imp_right (fun (h : b ≤ a) => or.imp_left Eq.symm (eq_or_lt_of_le h)) (lt_or_le a b)

theorem lt_or_gt_of_ne {α : Type u} [linear_order α] {a : α} {b : α} (h : a ≠ b) : a < b ∨ b < a :=
  or.imp_right (fun (h' : a = b ∨ b < a) => or.resolve_left h' h) (lt_trichotomy a b)

/-- Perform a case-split on the ordering of `x` and `y` in a decidable linear order. -/
def lt_by_cases {α : Type u} [linear_order α] (x : α) (y : α) {P : Sort u_1} (h₁ : x < y → P) (h₂ : x = y → P) (h₃ : y < x → P) : P :=
  dite (x < y) (fun (h : x < y) => h₁ h)
    fun (h : ¬x < y) => dite (y < x) (fun (h' : y < x) => h₃ h') fun (h' : ¬y < x) => h₂ sorry

theorem ne_iff_lt_or_gt {α : Type u} [linear_order α] {a : α} {b : α} : a ≠ b ↔ a < b ∨ b < a :=
  { mp := lt_or_gt_of_ne, mpr := fun (o : a < b ∨ b < a) => or.elim o ne_of_lt ne_of_gt }

theorem le_imp_le_of_lt_imp_lt {α : Type u} {β : Type u_1} [preorder α] [linear_order β] {a : α} {b : α} {c : β} {d : β} (H : d < c → b < a) (h : a ≤ b) : c ≤ d :=
  le_of_not_lt fun (h' : d < c) => not_le_of_gt (H h') h


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.fin.fin2
import tactic.localized

/-!
# Alternate definition of `vector` in terms of `fin2`

This file provides a locale `vector3` which overrides the `[a, b, c]` notation to create a `vector3`
instead of a `list`.

The `::` notation is also overloaded by this file to mean `vector3.cons`.
-/

open fin2 nat

universes u
variables {α : Type*} {m n : ℕ}

/-- Alternate definition of `vector` based on `fin2`. -/
def vector3 (α : Type u) (n : ℕ) : Type u := fin2 n → α

instance [inhabited α] : inhabited (vector3 α n) := pi.inhabited _

namespace vector3

/-- The empty vector -/
@[pattern] def nil : vector3 α 0.

/-- The vector cons operation -/
@[pattern] def cons (a : α) (v : vector3 α n) : vector3 α (succ n) :=
λ i, by { refine i.cases' _ _, exact a, exact v }

/- We do not want to make the following notation global, because then these expressions will be
overloaded, and only the expected type will be able to disambiguate the meaning. Worse: Lean will
try to insert a coercion from `vector3 α _` to `list α`, if a list is expected. -/
localized "notation (name := vector.list)
  `[` l:(foldr `, ` (h t, vector3.cons h t) vector3.nil `]`) := l" in vector3
notation (name := vector.cons) a :: b := cons a b

@[simp] lemma cons_fz (a : α) (v : vector3 α n) : (a :: v) fz = a := rfl
@[simp] lemma cons_fs (a : α) (v : vector3 α n) (i) : (a :: v) (fs i) = v i := rfl

/-- Get the `i`th element of a vector -/
@[reducible] def nth (i : fin2 n) (v : vector3 α n) : α := v i

/-- Construct a vector from a function on `fin2`. -/
@[reducible] def of_fn (f : fin2 n → α) : vector3 α n := f

/-- Get the head of a nonempty vector. -/
def head (v : vector3 α (succ n)) : α := v fz

/-- Get the tail of a nonempty vector. -/
def tail (v : vector3 α (succ n)) : vector3 α n := λ i, v (fs i)

lemma eq_nil (v : vector3 α 0) : v = [] := funext $ λ i, match i with end

lemma cons_head_tail (v : vector3 α (succ n)) : head v :: tail v = v :=
funext $ λ i, fin2.cases' rfl (λ _, rfl) i

/-- Eliminator for an empty vector. -/
def nil_elim {C : vector3 α 0 → Sort u} (H : C []) (v : vector3 α 0) : C v :=
by rw eq_nil v; apply H

/-- Recursion principle for a nonempty vector. -/
def cons_elim {C : vector3 α (succ n) → Sort u} (H : Π (a : α) (t : vector3 α n), C (a :: t))
  (v : vector3 α (succ n)) : C v :=
by rw ← (cons_head_tail v); apply H

@[simp] lemma cons_elim_cons {C H a t} : @cons_elim α n C H (a :: t) = H a t := rfl

/-- Recursion principle with the vector as first argument. -/
@[elab_as_eliminator]
protected def rec_on {C : Π {n}, vector3 α n → Sort u} {n} (v : vector3 α n)
  (H0 : C [])
  (Hs : Π {n} (a) (w : vector3 α n), C w → C (a :: w)) : C v :=
nat.rec_on n
  (λ v, v.nil_elim H0)
  (λ n IH v, v.cons_elim (λ a t, Hs _ _ (IH _))) v

@[simp] lemma rec_on_nil {C H0 Hs} : @vector3.rec_on α @C 0 [] H0 @Hs = H0 := rfl

@[simp] lemma rec_on_cons {C H0 Hs n a v} :
  @vector3.rec_on α @C (succ n) (a :: v) H0 @Hs = Hs a v (@vector3.rec_on α @C n v H0 @Hs) :=
rfl

/-- Append two vectors -/
def append (v : vector3 α m) (w : vector3 α n) : vector3 α (n+m) :=
nat.rec_on m (λ _, w) (λ m IH v, v.cons_elim $ λ a t, @fin2.cases' (n+m) (λ _, α) a (IH t)) v

local infix ` +-+ `:65 := vector3.append

@[simp] lemma append_nil (w : vector3 α n) : [] +-+ w = w := rfl

@[simp] lemma append_cons (a : α) (v : vector3 α m) (w : vector3 α n) :
  (a :: v) +-+ w = a :: (v +-+ w) := rfl

@[simp] lemma append_left : ∀ {m} (i : fin2 m) (v : vector3 α m) {n} (w : vector3 α n),
  (v +-+ w) (left n i) = v i
| ._ (@fz m)   v n w := v.cons_elim (λ a t, by simp [*, left])
| ._ (@fs m i) v n w := v.cons_elim (λ a t, by simp [*, left])

@[simp] lemma append_add : ∀ {m} (v : vector3 α m) {n} (w : vector3 α n) (i : fin2 n),
  (v +-+ w) (add i m) = w i
| 0        v n w i := rfl
| (succ m) v n w i := v.cons_elim (λ a t, by simp [*, add])

/-- Insert `a` into `v` at index `i`. -/
def insert (a : α) (v : vector3 α n) (i : fin2 (succ n)) : vector3 α (succ n) :=
λ j, (a :: v) (insert_perm i j)

@[simp] lemma insert_fz (a : α) (v : vector3 α n) : insert a v fz = a :: v :=
by refine funext (λ j, j.cases' _ _); intros; refl

@[simp] lemma insert_fs (a : α) (b : α) (v : vector3 α n) (i : fin2 (succ n)) :
  insert a (b :: v) (fs i) = b :: insert a v i :=
funext $ λ j, by
{ refine j.cases' _ (λ j, _); simp [insert, insert_perm],
  refine fin2.cases' _ _ (insert_perm i j); simp [insert_perm] }

lemma append_insert (a : α) (t : vector3 α m) (v : vector3 α n) (i : fin2 (succ n))
  (e : succ n + m = succ (n + m)) :
  insert a (t +-+ v) (eq.rec_on e (i.add m)) = eq.rec_on e (t +-+ insert a v i) :=
begin
  refine vector3.rec_on t (λ e, _) (λ k b t IH e, _) e, refl,
  have e' := succ_add n k,
  change insert a (b :: (t +-+ v)) (eq.rec_on (congr_arg succ e') (fs (add i k)))
    = eq.rec_on (congr_arg succ e') (b :: (t +-+ insert a v i)),
  rw ← (eq.drec_on e' rfl : fs (eq.rec_on e' (i.add k) : fin2 (succ (n + k))) = eq.rec_on
    (congr_arg succ e') (fs (i.add k))),
  simp, rw IH, exact eq.drec_on e' rfl
end

end vector3

section vector3
open vector3
open_locale vector3

/-- "Curried" exists, i.e. `∃ x₁ ... xₙ, f [x₁, ..., xₙ]`. -/
def vector_ex : Π k, (vector3 α k → Prop) → Prop
| 0        f := f []
| (succ k) f := ∃x : α, vector_ex k (λ v, f (x :: v))

/-- "Curried" forall, i.e. `∀ x₁ ... xₙ, f [x₁, ..., xₙ]`. -/
def vector_all : Π k, (vector3 α k → Prop) → Prop
| 0        f := f []
| (succ k) f := ∀ x : α, vector_all k (λ v, f (x :: v))

lemma exists_vector_zero (f : vector3 α 0 → Prop) : Exists f ↔ f [] :=
⟨λ ⟨v, fv⟩, by rw ← (eq_nil v); exact fv, λ f0, ⟨[], f0⟩⟩

lemma exists_vector_succ (f : vector3 α (succ n) → Prop) : Exists f ↔ ∃x v, f (x :: v) :=
⟨λ ⟨v, fv⟩, ⟨_, _, by rw cons_head_tail v; exact fv⟩, λ ⟨x, v, fxv⟩, ⟨_, fxv⟩⟩

lemma vector_ex_iff_exists : ∀ {n} (f : vector3 α n → Prop), vector_ex n f ↔ Exists f
| 0        f := (exists_vector_zero f).symm
| (succ n) f := iff.trans (exists_congr (λ x, vector_ex_iff_exists _)) (exists_vector_succ f).symm

lemma vector_all_iff_forall : ∀ {n} (f : vector3 α n → Prop), vector_all n f ↔ ∀ v, f v
| 0        f := ⟨λ f0 v, v.nil_elim f0, λ al, al []⟩
| (succ n) f := (forall_congr (λ x, vector_all_iff_forall (λ v, f (x :: v)))).trans
  ⟨λ al v, v.cons_elim al, λ al x v, al (x :: v)⟩

/-- `vector_allp p v` is equivalent to `∀ i, p (v i)`, but unfolds directly to a conjunction,
  i.e. `vector_allp p [0, 1, 2] = p 0 ∧ p 1 ∧ p 2`. -/
def vector_allp (p : α → Prop) (v : vector3 α n) : Prop :=
vector3.rec_on v true (λ n a v IH, @vector3.rec_on _ (λ n v, Prop) _ v (p a) (λ n b v' _, p a ∧ IH))

@[simp] lemma vector_allp_nil (p : α → Prop) : vector_allp p [] = true := rfl
@[simp] lemma vector_allp_singleton (p : α → Prop) (x : α) : vector_allp p [x] = p x := rfl
@[simp] lemma vector_allp_cons (p : α → Prop) (x : α) (v : vector3 α n) :
  vector_allp p (x :: v) ↔ p x ∧ vector_allp p v :=
vector3.rec_on v (and_true _).symm (λ n a v IH, iff.rfl)

lemma vector_allp_iff_forall (p : α → Prop) (v : vector3 α n) : vector_allp p v ↔ ∀ i, p (v i) :=
begin
  refine v.rec_on _ _,
  { exact ⟨λ _, fin2.elim0, λ _, trivial⟩ },
  { simp, refine λ n a v IH, (and_congr_right (λ _, IH)).trans
      ⟨λ ⟨pa, h⟩ i, by {refine i.cases' _ _, exacts [pa, h]}, λ h, ⟨_, λ i, _⟩⟩,
    { have h0 := h fz, simp at h0, exact h0 },
    { have hs := h (fs i), simp at hs, exact hs } }
end

lemma vector_allp.imp {p q : α → Prop} (h : ∀ x, p x → q x) {v : vector3 α n}
  (al : vector_allp p v) : vector_allp q v :=
(vector_allp_iff_forall _ _).2 (λ i, h _ $ (vector_allp_iff_forall _ _).1 al _)

end vector3


/-
Copyright (c) 2021 Aaron Anderson, Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Kevin Buzzard, Yaël Dillies, Eric Wieser
-/
import data.finset.pairwise
import data.set.finite

/-!
# Supremum independence

In this file, we define supremum independence of indexed sets. An indexed family `f : ι → α` is
sup-independent if, for all `a`, `f a` and the supremum of the rest are disjoint.

## Main definitions

* `finset.sup_indep s f`: a family of elements `f` are supremum independent on the finite set `s`.
* `complete_lattice.set_independent s`: a set of elements are supremum independent.
* `complete_lattice.independent f`: a family of elements are supremum independent.

## Main statements

* In a distributive lattice, supremum independence is equivalent to pairwise disjointness:
  * `finset.sup_indep_iff_pairwise_disjoint`
  * `complete_lattice.set_independent_iff_pairwise_disjoint`
  * `complete_lattice.independent_iff_pairwise_disjoint`
* Otherwise, supremum independence is stronger than pairwise disjointness:
  * `finset.sup_indep.pairwise_disjoint`
  * `complete_lattice.set_independent.pairwise_disjoint`
  * `complete_lattice.independent.pairwise_disjoint`

## Implementation notes

For the finite version, we avoid the "obvious" definition
`∀ i ∈ s, disjoint (f i) ((s.erase i).sup f)` because `erase` would require decidable equality on
`ι`.
-/

variables {α β ι ι' : Type*}

/-! ### On lattices with a bottom element, via `finset.sup` -/

namespace finset
section lattice
variables [lattice α] [order_bot α]

/-- Supremum independence of finite sets. We avoid the "obvious" definition using `s.erase i`
because `erase` would require decidable equality on `ι`. -/
def sup_indep (s : finset ι) (f : ι → α) : Prop :=
∀ ⦃t⦄, t ⊆ s → ∀ ⦃i⦄, i ∈ s → i ∉ t → disjoint (f i) (t.sup f)

variables {s t : finset ι} {f : ι → α} {i : ι}

instance [decidable_eq ι] [decidable_eq α] : decidable (sup_indep s f) :=
begin
  apply @finset.decidable_forall_of_decidable_subsets _ _ _ _,
  intros t ht,
  apply @finset.decidable_dforall_finset _ _ _ _,
  exact λ i hi, @implies.decidable _ _ _ (decidable_of_iff' (_ = ⊥) disjoint_iff),
end

lemma sup_indep.subset (ht : t.sup_indep f) (h : s ⊆ t) : s.sup_indep f :=
λ u hu i hi, ht (hu.trans h) (h hi)

lemma sup_indep_empty (f : ι → α) : (∅ : finset ι).sup_indep f := λ _ _ a ha, ha.elim

lemma sup_indep_singleton (i : ι) (f : ι → α) : ({i} : finset ι).sup_indep f :=
λ s hs j hji hj, begin
  rw [eq_empty_of_ssubset_singleton ⟨hs, λ h, hj (h hji)⟩, sup_empty],
  exact disjoint_bot_right,
end

lemma sup_indep.pairwise_disjoint (hs : s.sup_indep f) : (s : set ι).pairwise_disjoint f :=
λ a ha b hb hab, sup_singleton.subst $ hs (singleton_subset_iff.2 hb) ha $ not_mem_singleton.2 hab

/-- The RHS looks like the definition of `complete_lattice.independent`. -/
lemma sup_indep_iff_disjoint_erase [decidable_eq ι] :
  s.sup_indep f ↔ ∀ i ∈ s, disjoint (f i) ((s.erase i).sup f) :=
⟨λ hs i hi, hs (erase_subset _ _) hi (not_mem_erase _ _), λ hs t ht i hi hit,
  (hs i hi).mono_right (sup_mono $ λ j hj, mem_erase.2 ⟨ne_of_mem_of_not_mem hj hit, ht hj⟩)⟩

@[simp] lemma sup_indep_pair [decidable_eq ι] {i j : ι} (hij : i ≠ j) :
  ({i, j} : finset ι).sup_indep f ↔ disjoint (f i) (f j) :=
⟨λ h, h.pairwise_disjoint (by simp) (by simp) hij, λ h, begin
  rw sup_indep_iff_disjoint_erase,
  intros k hk,
  rw [finset.mem_insert, finset.mem_singleton] at hk,
  obtain rfl | rfl := hk,
  { convert h using 1,
    rw [finset.erase_insert, finset.sup_singleton],
    simpa using hij },
  { convert h.symm using 1,
    have : ({i, k} : finset ι).erase k = {i},
    { ext,
      rw [mem_erase, mem_insert, mem_singleton, mem_singleton, and_or_distrib_left,
        ne.def, not_and_self, or_false, and_iff_right_of_imp],
      rintro rfl,
      exact hij },
    rw [this, finset.sup_singleton] }
end⟩

lemma sup_indep_univ_bool (f : bool → α) :
  (finset.univ : finset bool).sup_indep f ↔ disjoint (f ff) (f tt) :=
begin
  have : tt ≠ ff := by simp only [ne.def, not_false_iff],
  exact (sup_indep_pair this).trans disjoint.comm,
end

@[simp] lemma sup_indep_univ_fin_two (f : fin 2 → α) :
  (finset.univ : finset (fin 2)).sup_indep f ↔ disjoint (f 0) (f 1) :=
begin
  have : (0 : fin 2) ≠ 1 := by simp,
  exact sup_indep_pair this,
end

lemma sup_indep.attach (hs : s.sup_indep f) : s.attach.sup_indep (f ∘ subtype.val) :=
begin
  intros t ht i _ hi,
  classical,
  rw ←finset.sup_image,
  refine hs (image_subset_iff.2 $ λ (j : {x // x ∈ s}) _, j.2) i.2 (λ hi', hi _),
  rw mem_image at hi',
  obtain ⟨j, hj, hji⟩ := hi',
  rwa subtype.ext hji at hj,
end

end lattice

section distrib_lattice
variables [distrib_lattice α] [order_bot α] {s : finset ι} {f : ι → α}

lemma sup_indep_iff_pairwise_disjoint : s.sup_indep f ↔ (s : set ι).pairwise_disjoint f :=
⟨sup_indep.pairwise_disjoint, λ hs t ht i hi hit,
  disjoint_sup_right.2 $ λ j hj, hs hi (ht hj) (ne_of_mem_of_not_mem hj hit).symm⟩

alias sup_indep_iff_pairwise_disjoint ↔ finset.sup_indep.pairwise_disjoint
  set.pairwise_disjoint.sup_indep

/-- Bind operation for `sup_indep`. -/
lemma sup_indep.sup [decidable_eq ι] {s : finset ι'} {g : ι' → finset ι} {f : ι → α}
  (hs : s.sup_indep (λ i, (g i).sup f)) (hg : ∀ i' ∈ s, (g i').sup_indep f) :
  (s.sup g).sup_indep f :=
begin
  simp_rw sup_indep_iff_pairwise_disjoint at ⊢ hs hg,
  rw [sup_eq_bUnion, coe_bUnion],
  exact hs.bUnion_finset hg,
end

/-- Bind operation for `sup_indep`. -/
lemma sup_indep.bUnion [decidable_eq ι] {s : finset ι'} {g : ι' → finset ι} {f : ι → α}
  (hs : s.sup_indep (λ i, (g i).sup f)) (hg : ∀ i' ∈ s, (g i').sup_indep f) :
  (s.bUnion g).sup_indep f :=
by { rw ←sup_eq_bUnion, exact hs.sup hg }

end distrib_lattice
end finset

/-! ### On complete lattices via `has_Sup.Sup` -/

namespace complete_lattice
variables [complete_lattice α]

open set

/-- An independent set of elements in a complete lattice is one in which every element is disjoint
  from the `Sup` of the rest. -/
def set_independent (s : set α) : Prop := ∀ ⦃a⦄, a ∈ s → disjoint a (Sup (s \ {a}))

variables {s : set α} (hs : set_independent s)

@[simp]
lemma set_independent_empty : set_independent (∅ : set α) :=
λ x hx, (set.not_mem_empty x hx).elim

theorem set_independent.mono {t : set α} (hst : t ⊆ s) :
  set_independent t :=
λ a ha, (hs (hst ha)).mono_right (Sup_le_Sup (diff_subset_diff_left hst))

/-- If the elements of a set are independent, then any pair within that set is disjoint. -/
lemma set_independent.pairwise_disjoint : s.pairwise_disjoint id :=
λ x hx y hy h, disjoint_Sup_right (hs hx) ((mem_diff y).mpr ⟨hy, h.symm⟩)

lemma set_independent_pair {a b : α} (hab : a ≠ b) :
  set_independent ({a, b} : set α) ↔ disjoint a b :=
begin
  split,
  { intro h,
    exact h.pairwise_disjoint (mem_insert _ _) (mem_insert_of_mem _ (mem_singleton _)) hab, },
  { rintros h c ((rfl : c = a) | (rfl : c = b)),
    { convert h using 1,
      simp [hab, Sup_singleton] },
    { convert h.symm using 1,
      simp [hab, Sup_singleton] }, },
end

include hs

/-- If the elements of a set are independent, then any element is disjoint from the `Sup` of some
subset of the rest. -/
lemma set_independent.disjoint_Sup {x : α} {y : set α} (hx : x ∈ s) (hy : y ⊆ s) (hxy : x ∉ y) :
  disjoint x (Sup y) :=
begin
  have := (hs.mono $ insert_subset.mpr ⟨hx, hy⟩) (mem_insert x _),
  rw [insert_diff_of_mem _ (mem_singleton _), diff_singleton_eq_self hxy] at this,
  exact this,
end

omit hs

/-- An independent indexed family of elements in a complete lattice is one in which every element
  is disjoint from the `supr` of the rest.

  Example: an indexed family of non-zero elements in a
  vector space is linearly independent iff the indexed family of subspaces they generate is
  independent in this sense.

  Example: an indexed family of submodules of a module is independent in this sense if
  and only the natural map from the direct sum of the submodules to the module is injective. -/
def independent {ι : Sort*} {α : Type*} [complete_lattice α] (t : ι → α) : Prop :=
∀ i : ι, disjoint (t i) (⨆ (j ≠ i), t j)

lemma set_independent_iff {α : Type*} [complete_lattice α] (s : set α) :
  set_independent s ↔ independent (coe : s → α) :=
begin
  simp_rw [independent, set_independent, set_coe.forall, Sup_eq_supr],
  refine forall₂_congr (λ a ha, _),
  congr' 2,
  convert supr_subtype.symm,
  simp [supr_and],
end

variables {t : ι → α} (ht : independent t)

theorem independent_def : independent t ↔ ∀ i : ι, disjoint (t i) (⨆ (j ≠ i), t j) :=
iff.rfl

theorem independent_def' {ι : Type*} {t : ι → α} :
  independent t ↔ ∀ i, disjoint (t i) (Sup (t '' {j | j ≠ i})) :=
by {simp_rw Sup_image, refl}

theorem independent_def'' {ι : Type*} {t : ι → α} :
  independent t ↔ ∀ i, disjoint (t i) (Sup {a | ∃ j ≠ i, t j = a}) :=
by {rw independent_def', tidy}

@[simp]
lemma independent_empty (t : empty → α) : independent t.

@[simp]
lemma independent_pempty (t : pempty → α) : independent t.

/-- If the elements of a set are independent, then any pair within that set is disjoint. -/
lemma independent.pairwise_disjoint : pairwise (disjoint on t) :=
λ x y h, disjoint_Sup_right (ht x) ⟨y, supr_pos h.symm⟩

lemma independent.mono {ι : Type*} {α : Type*} [complete_lattice α]
  {s t : ι → α} (hs : independent s) (hst : t ≤ s) :
  independent t :=
λ i, (hs i).mono (hst i) $ supr₂_mono $ λ j _, hst j

/-- Composing an independent indexed family with an injective function on the index results in
another indepedendent indexed family. -/
lemma independent.comp {ι ι' : Sort*} {α : Type*} [complete_lattice α]
  {s : ι → α} (hs : independent s) (f : ι' → ι) (hf : function.injective f) :
  independent (s ∘ f) :=
λ i, (hs (f i)).mono_right $ begin
  refine (supr_mono $ λ i, _).trans (supr_comp_le _ f),
  exact supr_const_mono hf.ne,
end

lemma independent_pair {i j : ι} (hij : i ≠ j) (huniv : ∀ k, k = i ∨ k = j):
  independent t ↔ disjoint (t i) (t j) :=
begin
  split,
  { intro h,
    exact h.pairwise_disjoint _ _ hij, },
  { rintros h k,
    obtain rfl | rfl := huniv k,
    { refine h.mono_right (supr_le $ λ i, supr_le $ λ hi, eq.le _),
      rw (huniv i).resolve_left hi },
    { refine h.symm.mono_right (supr_le $ λ j, supr_le $ λ hj, eq.le _),
      rw (huniv j).resolve_right hj } },
end

/-- Composing an indepedent indexed family with an order isomorphism on the elements results in
another indepedendent indexed family. -/
lemma independent.map_order_iso {ι : Sort*} {α β : Type*}
  [complete_lattice α] [complete_lattice β] (f : α ≃o β) {a : ι → α} (ha : independent a) :
  independent (f ∘ a) :=
λ i, ((ha i).map_order_iso f).mono_right (f.monotone.le_map_supr₂ _)

@[simp] lemma independent_map_order_iso_iff {ι : Sort*} {α β : Type*}
  [complete_lattice α] [complete_lattice β] (f : α ≃o β) {a : ι → α} :
  independent (f ∘ a) ↔ independent a :=
⟨ λ h, have hf : f.symm ∘ f ∘ a = a := congr_arg (∘ a) f.left_inv.comp_eq_id,
      hf ▸ h.map_order_iso f.symm,
  λ h, h.map_order_iso f⟩

/-- If the elements of a set are independent, then any element is disjoint from the `supr` of some
subset of the rest. -/
lemma independent.disjoint_bsupr {ι : Type*} {α : Type*} [complete_lattice α]
  {t : ι → α} (ht : independent t) {x : ι} {y : set ι} (hx : x ∉ y) :
  disjoint (t x) (⨆ i ∈ y, t i) :=
disjoint.mono_right (bsupr_mono $ λ i hi, (ne_of_mem_of_not_mem hi hx : _)) (ht x)

end complete_lattice

lemma complete_lattice.independent_iff_sup_indep [complete_lattice α] {s : finset ι} {f : ι → α} :
  complete_lattice.independent (f ∘ (coe : s → ι)) ↔ s.sup_indep f :=
begin
  classical,
  rw finset.sup_indep_iff_disjoint_erase,
  refine subtype.forall.trans (forall₂_congr $ λ a b, _),
  rw finset.sup_eq_supr,
  congr' 2,
  refine supr_subtype.trans _,
  congr' 1 with x,
  simp [supr_and, @supr_comm _ (x ∈ s)],
end

alias complete_lattice.independent_iff_sup_indep ↔ complete_lattice.independent.sup_indep
  finset.sup_indep.independent

/-- A variant of `complete_lattice.independent_iff_sup_indep` for `fintype`s. -/
lemma complete_lattice.independent_iff_sup_indep_univ [complete_lattice α] [fintype ι] {f : ι → α} :
  complete_lattice.independent f ↔ finset.univ.sup_indep f :=
begin
  classical,
  simp [finset.sup_indep_iff_disjoint_erase, complete_lattice.independent, finset.sup_eq_supr],
end

alias complete_lattice.independent_iff_sup_indep_univ ↔ complete_lattice.independent.sup_indep_univ
  finset.sup_indep.independent_of_univ

section frame

namespace complete_lattice
variables [order.frame α]

lemma set_independent_iff_pairwise_disjoint {s : set α} :
  set_independent s ↔ s.pairwise_disjoint id :=
⟨set_independent.pairwise_disjoint, λ hs i hi, disjoint_Sup_iff.2 $ λ j hj,
  hs hi hj.1 $ ne.symm hj.2⟩

alias set_independent_iff_pairwise_disjoint ↔ _ set.pairwise_disjoint.set_independent

lemma independent_iff_pairwise_disjoint {f : ι → α} : independent f ↔ pairwise (disjoint on f) :=
⟨independent.pairwise_disjoint, λ hs i, disjoint_supr_iff.2 $ λ j, disjoint_supr_iff.2 $ λ hij,
  hs _ _ hij.symm⟩

end complete_lattice

end frame


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.limits.shapes.equalizers
import category_theory.limits.shapes.kernel_pair

/-!
# Reflexive coequalizers

We define reflexive pairs as a pair of morphisms which have a common section. We say a category has
reflexive coequalizers if it has coequalizers of all reflexive pairs.
Reflexive coequalizers often enjoy nicer properties than general coequalizers, and feature heavily
in some versions of the monadicity theorem.

We also give some examples of reflexive pairs: for an adjunction `F ⊣ G` with counit `ε`, the pair
`(FGε_B, ε_FGB)` is reflexive. If a pair `f,g` is a kernel pair for some morphism, then it is
reflexive.

# TODO
* If `C` has binary coproducts and reflexive coequalizers, then it has all coequalizers.
* If `T` is a monad on cocomplete category `C`, then `algebra T` is cocomplete iff it has reflexive
  coequalizers.
* If `C` is locally cartesian closed and has reflexive coequalizers, then it has images: in fact
  regular epi (and hence strong epi) images.
-/

namespace category_theory

universes v v₂ u u₂

variables {C : Type u} [category.{v} C]
variables {D : Type u₂} [category.{v₂} D]
variables {A B : C} {f g : A ⟶ B}

/--
The pair `f g : A ⟶ B` is reflexive if there is a morphism `B ⟶ A` which is a section for both.
-/
class is_reflexive_pair (f g : A ⟶ B) : Prop :=
(common_section [] : ∃ (s : B ⟶ A), s ≫ f = 𝟙 B ∧ s ≫ g = 𝟙 B)

/--
The pair `f g : A ⟶ B` is coreflexive if there is a morphism `B ⟶ A` which is a retraction for both.
-/
class is_coreflexive_pair (f g : A ⟶ B) : Prop :=
(common_retraction [] : ∃ (s : B ⟶ A), f ≫ s = 𝟙 A ∧ g ≫ s = 𝟙 A)

lemma is_reflexive_pair.mk' (s : B ⟶ A) (sf : s ≫ f = 𝟙 B) (sg : s ≫ g = 𝟙 B) :
  is_reflexive_pair f g :=
⟨⟨s, sf, sg⟩⟩

lemma is_coreflexive_pair.mk' (s : B ⟶ A) (fs : f ≫ s = 𝟙 A) (gs : g ≫ s = 𝟙 A) :
  is_coreflexive_pair f g :=
⟨⟨s, fs, gs⟩⟩

/-- Get the common section for a reflexive pair. -/
noncomputable def common_section (f g : A ⟶ B) [is_reflexive_pair f g] : B ⟶ A :=
(is_reflexive_pair.common_section f g).some

@[simp, reassoc]
lemma section_comp_left (f g : A ⟶ B) [is_reflexive_pair f g] :
  common_section f g ≫ f = 𝟙 B :=
(is_reflexive_pair.common_section f g).some_spec.1

@[simp, reassoc]
lemma section_comp_right (f g : A ⟶ B) [is_reflexive_pair f g] :
  common_section f g ≫ g = 𝟙 B :=
(is_reflexive_pair.common_section f g).some_spec.2

/-- Get the common retraction for a coreflexive pair. -/
noncomputable def common_retraction (f g : A ⟶ B) [is_coreflexive_pair f g] :
  B ⟶ A :=
(is_coreflexive_pair.common_retraction f g).some

@[simp, reassoc]
lemma left_comp_retraction (f g : A ⟶ B) [is_coreflexive_pair f g] :
  f ≫ common_retraction f g = 𝟙 A :=
(is_coreflexive_pair.common_retraction f g).some_spec.1

@[simp, reassoc]
lemma right_comp_retraction (f g : A ⟶ B) [is_coreflexive_pair f g] :
  g ≫ common_retraction f g = 𝟙 A :=
(is_coreflexive_pair.common_retraction f g).some_spec.2

/-- If `f,g` is a kernel pair for some morphism `q`, then it is reflexive. -/
lemma is_kernel_pair.is_reflexive_pair {R : C} {f g : R ⟶ A} {q : A ⟶ B}
  (h : is_kernel_pair q f g) :
  is_reflexive_pair f g :=
is_reflexive_pair.mk' _ (h.lift' _ _ rfl).2.1 (h.lift' _ _ _).2.2

/-- If `f,g` is reflexive, then `g,f` is reflexive. -/
-- This shouldn't be an instance as it would instantly loop.
lemma is_reflexive_pair.swap [is_reflexive_pair f g] :
  is_reflexive_pair g f :=
is_reflexive_pair.mk' _ (section_comp_right f g) (section_comp_left f g)

/-- If `f,g` is coreflexive, then `g,f` is coreflexive. -/
-- This shouldn't be an instance as it would instantly loop.
lemma is_coreflexive_pair.swap [is_coreflexive_pair f g] :
  is_coreflexive_pair g f :=
is_coreflexive_pair.mk' _ (right_comp_retraction f g) (left_comp_retraction f g)

variables {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G)

/-- For an adjunction `F ⊣ G` with counit `ε`, the pair `(FGε_B, ε_FGB)` is reflexive. -/
instance (B : D) :
  is_reflexive_pair (F.map (G.map (adj.counit.app B))) (adj.counit.app (F.obj (G.obj B))) :=
is_reflexive_pair.mk'
  (F.map (adj.unit.app (G.obj B)))
  (by { rw [← F.map_comp, adj.right_triangle_components], apply F.map_id })
  adj.left_triangle_components

namespace limits

variables (C)

/-- `C` has reflexive coequalizers if it has coequalizers for every reflexive pair. -/
class has_reflexive_coequalizers : Prop :=
(has_coeq : ∀ ⦃A B : C⦄ (f g : A ⟶ B) [is_reflexive_pair f g], has_coequalizer f g)

/-- `C` has coreflexive equalizers if it has equalizers for every coreflexive pair. -/
class has_coreflexive_equalizers : Prop :=
(has_eq : ∀ ⦃A B : C⦄ (f g : A ⟶ B) [is_coreflexive_pair f g], has_equalizer f g)

attribute [instance, priority 1] has_reflexive_coequalizers.has_coeq
attribute [instance, priority 1] has_coreflexive_equalizers.has_eq

lemma has_coequalizer_of_common_section [has_reflexive_coequalizers C]
  {A B : C} {f g : A ⟶ B} (r : B ⟶ A)
  (rf : r ≫ f = 𝟙 _) (rg : r ≫ g = 𝟙 _) :
  has_coequalizer f g :=
begin
  letI := is_reflexive_pair.mk' r rf rg,
  apply_instance
end

lemma has_equalizer_of_common_retraction [has_coreflexive_equalizers C]
  {A B : C} {f g : A ⟶ B} (r : B ⟶ A)
  (fr : f ≫ r = 𝟙 _) (gr : g ≫ r = 𝟙 _) :
  has_equalizer f g :=
begin
  letI := is_coreflexive_pair.mk' r fr gr,
  apply_instance
end

/-- If `C` has coequalizers, then it has reflexive coequalizers. -/
@[priority 100]
instance has_reflexive_coequalizers_of_has_coequalizers [has_coequalizers C] :
  has_reflexive_coequalizers C :=
{ has_coeq := λ A B f g i, by apply_instance }

/-- If `C` has equalizers, then it has coreflexive equalizers. -/
@[priority 100]
instance has_coreflexive_equalizers_of_has_equalizers [has_equalizers C] :
  has_coreflexive_equalizers C :=
{ has_eq := λ A B f g i, by apply_instance }

end limits

open limits

end category_theory