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

! This file was ported from Lean 3 source module analysis.p_series
! leanprover-community/mathlib commit 38f16f960f5006c6c0c2bac7b0aba5273188f4e5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecialFunctions.Pow

/-!
# Convergence of `p`-series

In this file we prove that the series `∑' k in ℕ, 1 / k ^ p` converges if and only if `p > 1`.
The proof is based on the
[Cauchy condensation test](https://en.wikipedia.org/wiki/Cauchy_condensation_test): `∑ k, f k`
converges if and only if so does `∑ k, 2 ^ k f (2 ^ k)`. We prove this test in
`nnreal.summable_condensed_iff` and `summable_condensed_iff_of_nonneg`, then use it to prove
`summable_one_div_rpow`. After this transformation, a `p`-series turns into a geometric series.

## TODO

It should be easy to generalize arguments to Schlömilch's generalization of the Cauchy condensation
test once we need it.

## Tags

p-series, Cauchy condensation test
-/

open Filter

open BigOperators ENNReal NNReal Topology

/-!
### Cauchy condensation test

In this section we prove the Cauchy condensation test: for `f : ℕ → ℝ≥0` or `f : ℕ → ℝ`,
`∑ k, f k` converges if and only if so does `∑ k, 2 ^ k f (2 ^ k)`. Instead of giving a monolithic
proof, we split it into a series of lemmas with explicit estimates of partial sums of each series in
terms of the partial sums of the other series.
-/

namespace Finset

variable {M : Type _} [OrderedAddCommMonoid M] {f : ℕ → M}

theorem le_sum_condensed' (hf : ∀ ⦃m n⦄, 0 < m → m ≤ n → f n ≤ f m) (n : ℕ) :
    (∑ k in Ico 1 (2 ^ n), f k) ≤ ∑ k in range n, 2 ^ k • f (2 ^ k) :=
  by
  induction' n with n ihn
  · simp
  suffices (∑ k in Ico (2 ^ n) (2 ^ (n + 1)), f k) ≤ 2 ^ n • f (2 ^ n)
    by
    rw [sum_range_succ, ← sum_Ico_consecutive]
    exact add_le_add ihn this
    exacts[n.one_le_two_pow, Nat.pow_le_pow_of_le_right zero_lt_two n.le_succ]
  have : ∀ k ∈ Ico (2 ^ n) (2 ^ (n + 1)), f k ≤ f (2 ^ n) := fun k hk =>
    hf (pow_pos zero_lt_two _) (mem_Ico.mp hk).1
  convert sum_le_sum this
  simp [pow_succ, two_mul]
#align finset.le_sum_condensed' Finset.le_sum_condensed'

theorem le_sum_condensed (hf : ∀ ⦃m n⦄, 0 < m → m ≤ n → f n ≤ f m) (n : ℕ) :
    (∑ k in range (2 ^ n), f k) ≤ f 0 + ∑ k in range n, 2 ^ k • f (2 ^ k) :=
  by
  convert add_le_add_left (le_sum_condensed' hf n) (f 0)
  rw [← sum_range_add_sum_Ico _ n.one_le_two_pow, sum_range_succ, sum_range_zero, zero_add]
#align finset.le_sum_condensed Finset.le_sum_condensed

theorem sum_condensed_le' (hf : ∀ ⦃m n⦄, 1 < m → m ≤ n → f n ≤ f m) (n : ℕ) :
    (∑ k in range n, 2 ^ k • f (2 ^ (k + 1))) ≤ ∑ k in Ico 2 (2 ^ n + 1), f k :=
  by
  induction' n with n ihn
  · simp
  suffices 2 ^ n • f (2 ^ (n + 1)) ≤ ∑ k in Ico (2 ^ n + 1) (2 ^ (n + 1) + 1), f k
    by
    rw [sum_range_succ, ← sum_Ico_consecutive]
    exact add_le_add ihn this
    exacts[add_le_add_right n.one_le_two_pow _,
      add_le_add_right (Nat.pow_le_pow_of_le_right zero_lt_two n.le_succ) _]
  have : ∀ k ∈ Ico (2 ^ n + 1) (2 ^ (n + 1) + 1), f (2 ^ (n + 1)) ≤ f k := fun k hk =>
    hf (n.one_le_two_pow.trans_lt <| (Nat.lt_succ_of_le le_rfl).trans_le (mem_Ico.mp hk).1)
      (Nat.le_of_lt_succ <| (mem_Ico.mp hk).2)
  convert sum_le_sum this
  simp [pow_succ, two_mul]
#align finset.sum_condensed_le' Finset.sum_condensed_le'

theorem sum_condensed_le (hf : ∀ ⦃m n⦄, 1 < m → m ≤ n → f n ≤ f m) (n : ℕ) :
    (∑ k in range (n + 1), 2 ^ k • f (2 ^ k)) ≤ f 1 + 2 • ∑ k in Ico 2 (2 ^ n + 1), f k :=
  by
  convert add_le_add_left (nsmul_le_nsmul_of_le_right (sum_condensed_le' hf n) 2) (f 1)
  simp [sum_range_succ', add_comm, pow_succ, mul_nsmul', sum_nsmul]
#align finset.sum_condensed_le Finset.sum_condensed_le

end Finset

namespace ENNReal

variable {f : ℕ → ℝ≥0∞}

theorem le_tsum_condensed (hf : ∀ ⦃m n⦄, 0 < m → m ≤ n → f n ≤ f m) :
    (∑' k, f k) ≤ f 0 + ∑' k : ℕ, 2 ^ k * f (2 ^ k) :=
  by
  rw [ENNReal.tsum_eq_supᵢ_nat' (Nat.tendsto_pow_atTop_atTop_of_one_lt _root_.one_lt_two)]
  refine' supᵢ_le fun n => (Finset.le_sum_condensed hf n).trans (add_le_add_left _ _)
  simp only [nsmul_eq_mul, Nat.cast_pow, Nat.cast_two]
  apply ENNReal.sum_le_tsum
#align ennreal.le_tsum_condensed ENNReal.le_tsum_condensed

theorem tsum_condensed_le (hf : ∀ ⦃m n⦄, 1 < m → m ≤ n → f n ≤ f m) :
    (∑' k : ℕ, 2 ^ k * f (2 ^ k)) ≤ f 1 + 2 * ∑' k, f k :=
  by
  rw [ENNReal.tsum_eq_supᵢ_nat' (tendsto_at_top_mono Nat.le_succ tendsto_id), two_mul, ← two_nsmul]
  refine'
    supᵢ_le fun n =>
      le_trans _
        (add_le_add_left
          (nsmul_le_nsmul_of_le_right (ENNReal.sum_le_tsum <| Finset.Ico 2 (2 ^ n + 1)) _) _)
  simpa using Finset.sum_condensed_le hf n
#align ennreal.tsum_condensed_le ENNReal.tsum_condensed_le

end ENNReal

namespace NNReal

/-- Cauchy condensation test for a series of `nnreal` version. -/
theorem summable_condensed_iff {f : ℕ → ℝ≥0} (hf : ∀ ⦃m n⦄, 0 < m → m ≤ n → f n ≤ f m) :
    (Summable fun k : ℕ => 2 ^ k * f (2 ^ k)) ↔ Summable f :=
  by
  simp only [← ENNReal.tsum_coe_ne_top_iff_summable, Ne.def, not_iff_not, ENNReal.coe_mul,
    ENNReal.coe_pow, ENNReal.coe_two]
  constructor <;> intro h
  · replace hf : ∀ m n, 1 < m → m ≤ n → (f n : ℝ≥0∞) ≤ f m := fun m n hm hmn =>
      ENNReal.coe_le_coe.2 (hf (zero_lt_one.trans hm) hmn)
    simpa [h, ENNReal.add_eq_top, ENNReal.mul_eq_top] using ENNReal.tsum_condensed_le hf
  · replace hf : ∀ m n, 0 < m → m ≤ n → (f n : ℝ≥0∞) ≤ f m := fun m n hm hmn =>
      ENNReal.coe_le_coe.2 (hf hm hmn)
    simpa [h, ENNReal.add_eq_top] using ENNReal.le_tsum_condensed hf
#align nnreal.summable_condensed_iff NNReal.summable_condensed_iff

end NNReal

/-- Cauchy condensation test for series of nonnegative real numbers. -/
theorem summable_condensed_iff_of_nonneg {f : ℕ → ℝ} (h_nonneg : ∀ n, 0 ≤ f n)
    (h_mono : ∀ ⦃m n⦄, 0 < m → m ≤ n → f n ≤ f m) :
    (Summable fun k : ℕ => 2 ^ k * f (2 ^ k)) ↔ Summable f :=
  by
  lift f to ℕ → ℝ≥0 using h_nonneg
  simp only [NNReal.coe_le_coe] at *
  exact_mod_cast NNReal.summable_condensed_iff h_mono
#align summable_condensed_iff_of_nonneg summable_condensed_iff_of_nonneg

open Real

/-!
### Convergence of the `p`-series

In this section we prove that for a real number `p`, the series `∑' n : ℕ, 1 / (n ^ p)` converges if
and only if `1 < p`. There are many different proofs of this fact. The proof in this file uses the
Cauchy condensation test we formalized above. This test implies that `∑ n, 1 / (n ^ p)` converges if
and only if `∑ n, 2 ^ n / ((2 ^ n) ^ p)` converges, and the latter series is a geometric series with
common ratio `2 ^ {1 - p}`. -/

/-- Test for convergence of the `p`-series: the real-valued series `∑' n : ℕ, (n ^ p)⁻¹` converges
if and only if `1 < p`. -/
@[simp]
theorem Real.summable_nat_rpow_inv {p : ℝ} : Summable (fun n => (n ^ p)⁻¹ : ℕ → ℝ) ↔ 1 < p :=
  by
  cases' le_or_lt 0 p with hp hp
  /- Cauchy condensation test applies only to antitone sequences, so we consider the
    cases `0 ≤ p` and `p < 0` separately. -/
  · rw [← summable_condensed_iff_of_nonneg]
    · simp_rw [Nat.cast_pow, Nat.cast_two, ← rpow_nat_cast, ← rpow_mul zero_lt_two.le, mul_comm _ p,
        rpow_mul zero_lt_two.le, rpow_nat_cast, ← inv_pow, ← mul_pow,
        summable_geometric_iff_norm_lt_1]
      nth_rw 1 [← rpow_one 2]
      rw [← division_def, ← rpow_sub zero_lt_two, norm_eq_abs,
        abs_of_pos (rpow_pos_of_pos zero_lt_two _), rpow_lt_one_iff zero_lt_two.le]
      norm_num
    · intro n
      exact inv_nonneg.2 (rpow_nonneg_of_nonneg n.cast_nonneg _)
    · intro m n hm hmn
      exact
        inv_le_inv_of_le (rpow_pos_of_pos (Nat.cast_pos.2 hm) _)
          (rpow_le_rpow m.cast_nonneg (Nat.cast_le.2 hmn) hp)
  -- If `p < 0`, then `1 / n ^ p` tends to infinity, thus the series diverges.
  · suffices ¬Summable (fun n => (n ^ p)⁻¹ : ℕ → ℝ)
      by
      have : ¬1 < p := fun hp₁ => hp.not_le (zero_le_one.trans hp₁.le)
      simpa [this, -one_div]
    · intro h
      obtain ⟨k : ℕ, hk₁ : ((k ^ p)⁻¹ : ℝ) < 1, hk₀ : k ≠ 0⟩ :=
        ((h.tendsto_cofinite_zero.eventually (gt_mem_nhds zero_lt_one)).And
            (eventually_cofinite_ne 0)).exists
      apply hk₀
      rw [← pos_iff_ne_zero, ← @Nat.cast_pos ℝ] at hk₀
      simpa [inv_lt_one_iff_of_pos (rpow_pos_of_pos hk₀ _), one_lt_rpow_iff_of_pos hk₀, hp,
        hp.not_lt, hk₀] using hk₁
#align real.summable_nat_rpow_inv Real.summable_nat_rpow_inv

@[simp]
theorem Real.summable_nat_rpow {p : ℝ} : Summable (fun n => n ^ p : ℕ → ℝ) ↔ p < -1 :=
  by
  rcases neg_surjective p with ⟨p, rfl⟩
  simp [rpow_neg]
#align real.summable_nat_rpow Real.summable_nat_rpow

/-- Test for convergence of the `p`-series: the real-valued series `∑' n : ℕ, 1 / n ^ p` converges
if and only if `1 < p`. -/
theorem Real.summable_one_div_nat_rpow {p : ℝ} : Summable (fun n => 1 / n ^ p : ℕ → ℝ) ↔ 1 < p := by
  simp
#align real.summable_one_div_nat_rpow Real.summable_one_div_nat_rpow

/-- Test for convergence of the `p`-series: the real-valued series `∑' n : ℕ, (n ^ p)⁻¹` converges
if and only if `1 < p`. -/
@[simp]
theorem Real.summable_nat_pow_inv {p : ℕ} : Summable (fun n => (n ^ p)⁻¹ : ℕ → ℝ) ↔ 1 < p := by
  simp only [← rpow_nat_cast, Real.summable_nat_rpow_inv, Nat.one_lt_cast]
#align real.summable_nat_pow_inv Real.summable_nat_pow_inv

/-- Test for convergence of the `p`-series: the real-valued series `∑' n : ℕ, 1 / n ^ p` converges
if and only if `1 < p`. -/
theorem Real.summable_one_div_nat_pow {p : ℕ} : Summable (fun n => 1 / n ^ p : ℕ → ℝ) ↔ 1 < p := by
  simp
#align real.summable_one_div_nat_pow Real.summable_one_div_nat_pow

/-- Summability of the `p`-series over `ℤ`. -/
theorem Real.summable_one_div_int_pow {p : ℕ} : (Summable fun n : ℤ => 1 / (n : ℝ) ^ p) ↔ 1 < p :=
  by
  refine'
    ⟨fun h => real.summable_one_div_nat_pow.mp (h.comp_injective Nat.cast_injective), fun h =>
      summable_int_of_summable_nat (real.summable_one_div_nat_pow.mpr h)
        (((real.summable_one_div_nat_pow.mpr h).mul_left <| 1 / (-1) ^ p).congr fun n => _)⟩
  conv_rhs => rw [Int.cast_neg, neg_eq_neg_one_mul, mul_pow, ← div_div]
  conv_lhs => rw [mul_div, mul_one]
  rfl
#align real.summable_one_div_int_pow Real.summable_one_div_int_pow

theorem Real.summable_abs_int_rpow {b : ℝ} (hb : 1 < b) : Summable fun n : ℤ => |(n : ℝ)| ^ (-b) :=
  by
  refine'
    summable_int_of_summable_nat (_ : Summable fun n : ℕ => |(n : ℝ)| ^ _)
      (_ : Summable fun n : ℕ => |((-n : ℤ) : ℝ)| ^ _)
  on_goal 2 => simp_rw [Int.cast_neg, Int.cast_ofNat, abs_neg]
  all_goals
    simp_rw [fun n : ℕ => abs_of_nonneg (n.cast_nonneg : 0 ≤ (n : ℝ))]
    rwa [Real.summable_nat_rpow, neg_lt_neg_iff]
#align real.summable_abs_int_rpow Real.summable_abs_int_rpow

/-- Harmonic series is not unconditionally summable. -/
theorem Real.not_summable_nat_cast_inv : ¬Summable (fun n => n⁻¹ : ℕ → ℝ) :=
  by
  have : ¬Summable (fun n => (n ^ 1)⁻¹ : ℕ → ℝ) := mt Real.summable_nat_pow_inv.1 (lt_irrefl 1)
  simpa
#align real.not_summable_nat_cast_inv Real.not_summable_nat_cast_inv

/-- Harmonic series is not unconditionally summable. -/
theorem Real.not_summable_one_div_nat_cast : ¬Summable (fun n => 1 / n : ℕ → ℝ) := by
  simpa only [inv_eq_one_div] using Real.not_summable_nat_cast_inv
#align real.not_summable_one_div_nat_cast Real.not_summable_one_div_nat_cast

/-- **Divergence of the Harmonic Series** -/
theorem Real.tendsto_sum_range_one_div_nat_succ_atTop :
    Tendsto (fun n => ∑ i in Finset.range n, (1 / (i + 1) : ℝ)) atTop atTop :=
  by
  rw [← not_summable_iff_tendsto_nat_atTop_of_nonneg]
  · exact_mod_cast mt (summable_nat_add_iff 1).1 Real.not_summable_one_div_nat_cast
  · exact fun i => div_nonneg zero_le_one i.cast_add_one_pos.le
#align real.tendsto_sum_range_one_div_nat_succ_at_top Real.tendsto_sum_range_one_div_nat_succ_atTop

@[simp]
theorem NNReal.summable_rpow_inv {p : ℝ} : Summable (fun n => (n ^ p)⁻¹ : ℕ → ℝ≥0) ↔ 1 < p := by
  simp [← NNReal.summable_coe]
#align nnreal.summable_rpow_inv NNReal.summable_rpow_inv

@[simp]
theorem NNReal.summable_rpow {p : ℝ} : Summable (fun n => n ^ p : ℕ → ℝ≥0) ↔ p < -1 := by
  simp [← NNReal.summable_coe]
#align nnreal.summable_rpow NNReal.summable_rpow

theorem NNReal.summable_one_div_rpow {p : ℝ} : Summable (fun n => 1 / n ^ p : ℕ → ℝ≥0) ↔ 1 < p := by
  simp
#align nnreal.summable_one_div_rpow NNReal.summable_one_div_rpow

section

open Finset

variable {α : Type _} [LinearOrderedField α]

theorem sum_Ioc_inv_sq_le_sub {k n : ℕ} (hk : k ≠ 0) (h : k ≤ n) :
    (∑ i in Ioc k n, ((i ^ 2)⁻¹ : α)) ≤ k⁻¹ - n⁻¹ :=
  by
  refine' Nat.le_induction _ _ n h
  · simp only [Ioc_self, sum_empty, sub_self]
  intro n hn IH
  rw [sum_Ioc_succ_top hn]
  apply (add_le_add IH le_rfl).trans
  simp only [sub_eq_add_neg, add_assoc, Nat.cast_add, Nat.cast_one, le_add_neg_iff_add_le,
    add_le_iff_nonpos_right, neg_add_le_iff_le_add, add_zero]
  have A : 0 < (n : α) := by simpa using hk.bot_lt.trans_le hn
  have B : 0 < (n : α) + 1 := by linarith
  field_simp [B.ne']
  rw [div_le_div_iff _ A, ← sub_nonneg]
  · ring_nf
    exact B.le
  · nlinarith
#align sum_Ioc_inv_sq_le_sub sum_Ioc_inv_sq_le_sub

theorem sum_Ioo_inv_sq_le (k n : ℕ) : (∑ i in Ioo k n, ((i ^ 2)⁻¹ : α)) ≤ 2 / (k + 1) :=
  calc
    (∑ i in Ioo k n, ((i ^ 2)⁻¹ : α)) ≤ ∑ i in Ioc k (max (k + 1) n), (i ^ 2)⁻¹ :=
      by
      apply sum_le_sum_of_subset_of_nonneg
      · intro x hx
        simp only [mem_Ioo] at hx
        simp only [hx, hx.2.le, mem_Ioc, le_max_iff, or_true_iff, and_self_iff]
      · intro i hi hident
        exact inv_nonneg.2 (sq_nonneg _)
    _ ≤ ((k + 1) ^ 2)⁻¹ + ∑ i in Ioc k.succ (max (k + 1) n), (i ^ 2)⁻¹ :=
      by
      rw [← Nat.Icc_succ_left, ← Nat.Ico_succ_right, sum_eq_sum_Ico_succ_bot]
      swap; · exact Nat.succ_lt_succ ((Nat.lt_succ_self k).trans_le (le_max_left _ _))
      rw [Nat.Ico_succ_right, Nat.Icc_succ_left, Nat.cast_succ]
    _ ≤ ((k + 1) ^ 2)⁻¹ + (k + 1)⁻¹ :=
      by
      refine' add_le_add le_rfl ((sum_Ioc_inv_sq_le_sub _ (le_max_left _ _)).trans _)
      · simp only [Ne.def, Nat.succ_ne_zero, not_false_iff]
      · simp only [Nat.cast_succ, one_div, sub_le_self_iff, inv_nonneg, Nat.cast_nonneg]
    _ ≤ 1 / (k + 1) + 1 / (k + 1) :=
      by
      have A : (1 : α) ≤ k + 1 := by simp only [le_add_iff_nonneg_left, Nat.cast_nonneg]
      simp_rw [← one_div]
      apply add_le_add_right
      refine' div_le_div zero_le_one le_rfl (zero_lt_one.trans_le A) _
      simpa using pow_le_pow A one_le_two
    _ = 2 / (k + 1) := by ring

#align sum_Ioo_inv_sq_le sum_Ioo_inv_sq_le

end


import ..int ..simp_omega ..term ..logic

namespace int

@[derive has_reflect]
inductive preterm : Type
| cst : int → preterm
| var : int → nat → preterm
| add : preterm → preterm → preterm

notation `&` k := preterm.cst k
infix `**` : 300 := preterm.var
notation t `+*` s := preterm.add t s

-- | (& i) := sorry
-- | (i ** n) := sorry
-- | (t1 +* t2) := sorry

namespace preterm

@[omega] def val (v : nat → int) : preterm → int
| (& i) := i
| (i ** n) :=
  if i = 1
  then v n
  else if i = -1
       then -(v n)
       else (v n) * i
| (t1 +* t2) := t1.val + t2.val

def fresh_idx : preterm → nat
| (& _) := 0
| (i ** n) := n + 1
| (t1 +* t2) := max t1.fresh_idx t2.fresh_idx

@[omega] def succ (t : preterm) : preterm := t +* (&1)

def repr : preterm → string
| (& i) := i.repr
| (i ** n) := i.repr ++ "*x" ++ n.repr
| (t1 +* t2) := "(" ++ t1.repr ++ " + " ++ t2.repr ++ ")"

end preterm

@[omega] def canonize : preterm → term
| (& i)      := ⟨i,[]⟩
| (i ** n)   := ⟨0,[]{n ↦ i}⟩
| (t1 +* t2) := term.add (canonize t1) (canonize t2)

@[omega] lemma val_canonize {v} : ∀ {t}, (canonize t).val v = t.val v
| (& i)      := by simp_omega
| (i ** n)   :=
  begin
    simp_omega, apply ite.rec; intro h1,
    { simp only [one_mul, h1] },
    { apply ite.rec; intro h2,
      { rw h2, simp },
      { rw mul_comm } }
  end
| (t1 +* t2) := by simp_omega [@val_canonize t1, @val_canonize t2]

end int


/-
Copyright (c) 2022 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Floris van Doorn
-/
import global.one_jet_bundle

/-!
# Sections of 1-jet bundles

In this file we study sections of 1-jet bundles. This is the direct continuation
of `one_jet_bundle.lean` but it imports more files, hence the cut.

## Main definitions

In this file we consider two manifolds `M` and `M'` with models `I` and `I'`

* `one_jet_sec I M I' M'`: smooth sections of `one_jet_bundle I M I' M' → M`
-/

noncomputable theory

open set function filter charted_space smooth_manifold_with_corners
open_locale topology manifold

section general

variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
-- declare a smooth manifold `M` over the pair `(E, H)`.
{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
{H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
{M : Type*} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
-- declare a smooth manifold `M'` over the pair `(E', H')`.
{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
{H' : Type*} [topological_space H'] (I' : model_with_corners 𝕜 E' H')
{M' : Type*} [topological_space M'] [charted_space H' M'] [smooth_manifold_with_corners I' M']

variables (I M I' M')

/-- A section of a 1-jet bundle seen as a bundle over the source manifold. -/
@[ext] structure one_jet_sec :=
(bs : M → M')
(ϕ : ∀ x : M, tangent_space I x →L[𝕜] tangent_space I' (bs x))
(smooth' : smooth I ((I.prod I').prod 𝓘(𝕜, E →L[𝕜] E')) (λ x, one_jet_bundle.mk x (bs x) (ϕ x)))

instance : has_coe_to_fun (one_jet_sec I M I' M') (λ S, M → one_jet_bundle I M I' M') :=
⟨λ S x, one_jet_bundle.mk x (S.bs x) (S.ϕ x)⟩

variables {I M I' M'}

namespace one_jet_sec

protected def mk' (F : M → one_jet_bundle I M I' M') (hF : ∀ m, (F m).1.1 = m)
  (h2F : smooth I ((I.prod I').prod 𝓘(𝕜, E →L[𝕜] E')) F) : one_jet_sec I M I' M' :=
⟨λ x, (F x).1.2, λ x, (F x).2, by { convert h2F, ext m, exact (hF m).symm, refl, refl }⟩

lemma coe_apply (F : one_jet_sec I M I' M') (x : M) : F x = ⟨(x, F.bs x), (F.ϕ x)⟩ := rfl
lemma fst_eq (F : one_jet_sec I M I' M') (x : M) : (F x).1 = (x, F.bs x) := rfl
lemma snd_eq (F : one_jet_sec I M I' M') (x : M) : (F x).2 = F.ϕ x := rfl
lemma is_sec (F : one_jet_sec I M I' M') (x : M) : (F x).1.1 = x := rfl
lemma bs_eq (F : one_jet_sec I M I' M') (x : M) : F.bs x = (F x).1.2 := rfl

protected lemma smooth (F : one_jet_sec I M I' M') :
  smooth I ((I.prod I').prod 𝓘(𝕜, E →L[𝕜] E')) F :=
F.smooth'

lemma smooth_eta (F : one_jet_sec I M I' M') : smooth I ((I.prod I').prod 𝓘(𝕜, E →L[𝕜] E'))
  (λ x, one_jet_bundle.mk x (F.bs x) (F x).2 : M → one_jet_bundle I M I' M') :=
F.smooth

lemma smooth_bs (F : one_jet_sec I M I' M') : smooth I I' F.bs :=
smooth_one_jet_bundle_proj.snd.comp F.smooth

/-- A section of J¹(M, M') is holonomic at (x : M) if its linear map part is the derivative
of its base map at x. -/
def is_holonomic_at (F : one_jet_sec I M I' M') (x : M) : Prop :=
mfderiv I I' (F.bs) x = (F x).2

/-- A section of J¹(M, M') is holonomic at (x : M) iff it coincides with the 1-jet extension of
its base map at x. -/
lemma is_holonomic_at_iff {F : one_jet_sec I M I' M'} {x : M} :
  F.is_holonomic_at x ↔ one_jet_ext I I' F.bs x = F x :=
by simp_rw [is_holonomic_at, one_jet_ext, sigma.ext_iff, heq_iff_eq, F.fst_eq,
  one_jet_bundle_mk_fst, eq_self_iff_true, true_and, one_jet_bundle_mk_snd]

lemma is_holonomic_at_congr {F F' : one_jet_sec I M I' M'} {x : M}
  (h : F =ᶠ[𝓝 x] F') : F.is_holonomic_at x ↔ F'.is_holonomic_at x :=
begin
  simp_rw [is_holonomic_at],
  rw [← h.self_of_nhds],
  congr' 2,
  exact (h.fun_comp (λ x, x.1.2)).mfderiv_eq
end

lemma is_holonomic_at.congr {F F' : one_jet_sec I M I' M'} {x : M}
  (hF : F.is_holonomic_at x) (h : F =ᶠ[𝓝 x] F') : F'.is_holonomic_at x :=
(is_holonomic_at_congr h).mp hF

/-- A map from M to J¹(M, M') is holonomic if its linear map part is the derivative
of its base map at every point. -/
def is_holonomic (F : one_jet_sec I M I' M') : Prop :=
∀ x, F.is_holonomic_at x

end one_jet_sec

def is_holonomic_germ {x : M} (φ : germ (𝓝 x) (one_jet_bundle I M I' M')) : Prop :=
quotient.lift_on' φ (λ F, mfderiv I I' (λ x', (F x').1.2) x  = (F x).2)
begin
  letI : setoid (M → one_jet_bundle I M I' M') := (𝓝 x).germ_setoid (one_jet_bundle I M I' M'),
  have key : ∀ f g, f ≈ g → (λ (F : M → one_jet_bundle I M I' M'), mfderiv I I' (λ (x' : M), (F x').fst.snd) x = (F x).snd) f →
  (λ (F : M → one_jet_bundle I M I' M'), mfderiv I I' (λ (x' : M), (F x').fst.snd) x = (F x).snd) g,
  { intros f g hfg hf,
    have hfg' : (λ x', (f x').1.2) =ᶠ[𝓝 x] (λ x', (g x').1.2),
      from hfg.fun_comp (λ s, s.1.2),
    rw [← hfg'.mfderiv_eq, hf, hfg.self_of_nhds] },
  exact λ f g H, propext ⟨key f g H, key g f H.symm⟩,
end

/-- The one-jet extension of a function, seen as a section of the 1-jet bundle. -/
def one_jet_ext_sec (f : C^∞⟮I, M; I', M'⟯) : one_jet_sec I M I' M' :=
⟨f, mfderiv I I' f, f.smooth.one_jet_ext⟩

end general

section real
variables
{E : Type*} [normed_add_comm_group E] [normed_space ℝ E]
{H : Type*} [topological_space H] (I : model_with_corners ℝ E H)
(M : Type*) [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
{E' : Type*} [normed_add_comm_group E'] [normed_space ℝ E']
{H' : Type*} [topological_space H'] (I' : model_with_corners ℝ E' H')
(M' : Type*) [topological_space M'] [charted_space H' M'] [smooth_manifold_with_corners I' M']
{F : Type*} [normed_add_comm_group F] [normed_space ℝ F]
{G : Type*} [topological_space G] (J : model_with_corners ℝ F G)
(N : Type*) [topological_space N] [charted_space G N] [smooth_manifold_with_corners J N]
{F' : Type*} [normed_add_comm_group F'] [normed_space ℝ F']
{G' : Type*} [topological_space G'] (J' : model_with_corners ℝ F' G')
(N' : Type*) [topological_space N'] [charted_space G' N'] [smooth_manifold_with_corners J' N']
{EP : Type*} [normed_add_comm_group EP] [normed_space ℝ EP]
{HP : Type*} [topological_space HP] {IP : model_with_corners ℝ EP HP}
{P : Type*} [topological_space P] [charted_space HP P] [smooth_manifold_with_corners IP P]

/-- A family of jet sections indexed by manifold `N` is a function from `N` into jet sections
  in such a way that the function is smooth as a function of all arguments. -/
structure family_one_jet_sec :=
(bs : N → M → M')
(ϕ : ∀ (n : N) (m : M), tangent_space I m →L[ℝ] tangent_space I' (bs n m))
(smooth' : smooth (J.prod I) ((I.prod I').prod 𝓘(ℝ, E →L[ℝ] E'))
  (λ p : N × M, one_jet_bundle.mk p.2 (bs p.1 p.2) (ϕ p.1 p.2)))

instance : has_coe_to_fun (family_one_jet_sec I M I' M' J N) (λ S, N → one_jet_sec I M I' M') :=
⟨λ S t,
 { bs := S.bs t,
   ϕ := S.ϕ t,
   smooth' := λ x, (S.smooth' (t, x)).comp x $ smooth_at_const.prod_mk smooth_at_id }⟩

namespace family_one_jet_sec

variables {I M I' M' J N J' N'}

protected def mk' (FF : N → M → one_jet_bundle I M I' M') (hF : ∀ n m, (FF n m).1.1 = m)
  (h2F : smooth (J.prod I) ((I.prod I').prod 𝓘(ℝ, E →L[ℝ] E')) (uncurry FF)) :
  family_one_jet_sec I M I' M' J N :=
⟨λ s x, (FF s x).1.2, λ s x, (FF s x).2,
  by { convert h2F, ext ⟨s, m⟩, exact (hF s m).symm, refl, refl }⟩

lemma coe_mk' (FF : N → M → one_jet_bundle I M I' M') (hF : ∀ n m, (FF n m).1.1 = m)
  (h2F : smooth (J.prod I) ((I.prod I').prod 𝓘(ℝ, E →L[ℝ] E')) (uncurry FF)) (x : N) :
  family_one_jet_sec.mk' FF hF h2F x =
  one_jet_sec.mk' (FF x) (hF x) (h2F.comp (smooth_const.prod_mk smooth_id)) :=
rfl

@[simp] lemma bs_eq_coe_bs (S : family_one_jet_sec I M I' M' J N) (s : N) : S.bs s = (S s).bs :=
rfl
lemma bs_eq (S : family_one_jet_sec I M I' M' J N) (s : N) (x : M) : S.bs s x = (S s x).1.2 := rfl
@[simp] lemma coe_ϕ (S : family_one_jet_sec I M I' M' J N) (s : N) : (S s).ϕ = S.ϕ s := rfl

protected lemma smooth (S : family_one_jet_sec I M I' M' J N) :
  smooth (J.prod I) ((I.prod I').prod 𝓘(ℝ, E →L[ℝ] E')) (λ p : N × M, S p.1 p.2) := S.smooth'

lemma smooth_bs (S : family_one_jet_sec I M I' M' J N) :
  smooth (J.prod I) I' (λ p : N × M, S.bs p.1 p.2) :=
smooth_one_jet_bundle_proj.snd.comp S.smooth

lemma smooth_coe_bs (S : family_one_jet_sec I M I' M' J N) {p : N} : smooth I I' (S.bs p) :=
(S p).smooth_bs

/-- Reindex a family along a smooth function `f`. -/
def reindex (S : family_one_jet_sec I M I' M' J' N') (f : C^∞⟮J, N; J', N'⟯) :
  family_one_jet_sec I M I' M' J N :=
{ bs := λ t, S.bs (f t),
  ϕ := λ t, S.ϕ (f t),
  smooth' := λ x, (S.smooth' (f x.1, x.2)).comp x $ (f.smooth.smooth_at).prod_map' smooth_at_id }

/-- Turn a family of sections of `J¹(M, M')` parametrized by `N` into a section of `J¹(N × M, M')`.
-/
@[simps]
def uncurry (S : family_one_jet_sec I M I' M' IP P) : one_jet_sec (IP.prod I) (P × M) I' M' :=
{ bs := λ p, S.bs p.1 p.2,
  ϕ := λ p, (show EP × E →L[ℝ] E', from mfderiv (IP.prod I) I' (λ z : P × M, S.bs z.1 p.2) p) +
    S.ϕ p.1 p.2 ∘L mfderiv (IP.prod I) I prod.snd p,
  smooth' := begin
    refine smooth.one_jet_add _ _,
    { intro y,
      refine smooth_at_id.one_jet_bundle_mk (S.smooth_bs y) _,
      have : smooth_at ((IP.prod I).prod (IP.prod I)) I'
        (function.uncurry (λ x z : P × M, S.bs z.1 x.2)) (y, y),
      { exact S.smooth_bs.comp (smooth_snd.fst.prod_mk smooth_fst.snd) (y, y) },
      apply cont_mdiff_at.mfderiv'' (λ x z : P × M, S.bs z.1 x.2) this le_top },
    { refine smooth.one_jet_comp I (λ p, p.2) S.smooth smooth_snd.one_jet_ext }
  end }

lemma uncurry_ϕ' (S : family_one_jet_sec I M I' M' IP P) (p : P × M) :
  (S.uncurry).ϕ p = mfderiv IP I' (λ z, S.bs z p.2) p.1 ∘L continuous_linear_map.fst ℝ EP E +
  S.ϕ p.1 p.2 ∘L continuous_linear_map.snd ℝ EP E :=
begin
  simp_rw [S.uncurry_ϕ, mfderiv_snd],
  congr' 1,
  convert mfderiv_comp p
    ((S.smooth_bs.comp (smooth_id.prod_mk smooth_const)).mdifferentiable p.1)
    (smooth_fst.mdifferentiable p),
  simp_rw [mfderiv_fst],
end

lemma is_holonomic_uncurry (S : family_one_jet_sec I M I' M' IP P) {p : P × M} :
  S.uncurry.is_holonomic_at p ↔ (S p.1).is_holonomic_at p.2 :=
begin
  simp_rw [one_jet_sec.is_holonomic_at, one_jet_sec.snd_eq, S.uncurry_ϕ],
  rw [show S.uncurry.bs = λ x, S.uncurry.bs x, from rfl, funext S.uncurry_bs],
  simp_rw [mfderiv_prod_eq_add (S.smooth_bs.mdifferentiable _), mfderiv_snd, add_right_inj],
  dsimp only,
  rw [mfderiv_comp p S.smooth_coe_bs.mdifferentiable_at smooth_snd.mdifferentiable_at, mfderiv_snd,
    (show surjective (continuous_linear_map.snd ℝ EP E), from prod.snd_surjective)
      .clm_comp_injective.eq_iff],
  refl
end

end family_one_jet_sec

/-- A homotopy of 1-jet sections is a family of 1-jet sections indexed by `ℝ` -/
@[reducible] def htpy_one_jet_sec := family_one_jet_sec I M I' M' 𝓘(ℝ, ℝ) ℝ

example : has_coe_to_fun (htpy_one_jet_sec I M I' M') (λ S, ℝ → one_jet_sec I M I' M') :=
by apply_instance

end real


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import group_theory.submonoid.operations
import algebra.pointwise

/-! # Pointwise instances on `submonoid`s and `add_submonoid`s

This file provides:

* `submonoid.has_inv`
* `add_submonoid.has_neg`

and the actions

* `submonoid.pointwise_mul_action`
* `add_submonoid.pointwise_mul_action`

which matches the action of `mul_action_set`.

These are all available in the `pointwise` locale.

Additionally, it provides `add_submonoid.has_mul`, which is available globally to match
`submodule.has_mul`.

## Implementation notes

Most of the lemmas in this file are direct copies of lemmas from `algebra/pointwise.lean`.
While the statements of these lemmas are defeq, we repeat them here due to them not being
syntactically equal. Before adding new lemmas here, consider if they would also apply to the action
on `set`s.

-/

variables {α : Type*} {G : Type*} {M : Type*} {R : Type*} {A : Type*}
variables [monoid M] [add_monoid A]

namespace submonoid

variables [group G]

open_locale pointwise

/-- The submonoid with every element inverted. -/
@[to_additive /-" The additive submonoid with every element negated. "-/]
protected def has_inv : has_inv (submonoid G):=
{ inv := λ S,
  { carrier := (S : set G)⁻¹,
    one_mem' := show (1 : G)⁻¹ ∈ S, by { rw one_inv, exact S.one_mem },
    mul_mem' := λ a b (ha : a⁻¹ ∈ S) (hb : b⁻¹ ∈ S), show (a * b)⁻¹ ∈ S,
      by { rw mul_inv_rev, exact S.mul_mem hb ha } } }

localized "attribute [instance] submonoid.has_inv" in pointwise
open_locale pointwise

@[simp, to_additive] lemma coe_inv (S : submonoid G) : ↑(S⁻¹) = (S : set G)⁻¹ := rfl

@[simp, to_additive] lemma mem_inv {g : G} {S : submonoid G} : g ∈ S⁻¹ ↔ g⁻¹ ∈ S := iff.rfl

@[simp, to_additive] protected lemma inv_inv (S : submonoid G) : S⁻¹⁻¹ = S :=
set_like.coe_injective set.inv_inv

@[simp, to_additive] lemma inv_le_inv (S T : submonoid G) : S⁻¹ ≤ T⁻¹ ↔ S ≤ T :=
set_like.coe_subset_coe.symm.trans set.inv_subset_inv

@[to_additive] lemma inv_le (S T : submonoid G) : S⁻¹ ≤ T ↔ S ≤ T⁻¹ :=
set_like.coe_subset_coe.symm.trans set.inv_subset

/-- `submonoid.has_inv` as an order isomorphism. -/
@[to_additive /-" `add_submonoid.has_neg` as an order isomorphism "-/, simps]
def inv_order_iso : submonoid G ≃o submonoid G :=
{ to_fun := has_inv.inv,
  inv_fun := has_inv.inv,
  left_inv := submonoid.inv_inv,
  right_inv := submonoid.inv_inv,
  map_rel_iff' := inv_le_inv }

@[to_additive] lemma closure_inv (s : set G) : closure s⁻¹ = (closure s)⁻¹ :=
begin
  apply le_antisymm,
  { rw [closure_le, coe_inv, ←set.inv_subset, set.inv_inv],
    exact subset_closure },
  { rw [inv_le, closure_le, coe_inv, ←set.inv_subset],
    exact subset_closure }
end

@[simp, to_additive]
lemma inv_inf (S T : submonoid G) : (S ⊓ T)⁻¹ = S⁻¹ ⊓ T⁻¹ :=
set_like.coe_injective set.inter_inv

@[simp, to_additive]
lemma inv_sup (S T : submonoid G) : (S ⊔ T)⁻¹ = S⁻¹ ⊔ T⁻¹ :=
(inv_order_iso : submonoid G ≃o submonoid G).map_sup S T

@[simp, to_additive]
lemma inv_bot : (⊥ : submonoid G)⁻¹ = ⊥ :=
set_like.coe_injective $ (set.inv_singleton 1).trans $ congr_arg _ one_inv

@[simp, to_additive]
lemma inv_top : (⊤ : submonoid G)⁻¹ = ⊤ :=
set_like.coe_injective $ set.inv_univ

@[simp, to_additive]
lemma inv_infi {ι : Sort*} (S : ι → submonoid G) : (⨅ i, S i)⁻¹ = ⨅ i, (S i)⁻¹ :=
(inv_order_iso : submonoid G ≃o submonoid G).map_infi _

@[simp, to_additive]
lemma inv_supr {ι : Sort*} (S : ι → submonoid G) : (⨆ i, S i)⁻¹ = ⨆ i, (S i)⁻¹ :=
(inv_order_iso : submonoid G ≃o submonoid G).map_supr _

end submonoid

namespace submonoid

section monoid
variables [monoid α] [mul_distrib_mul_action α M]

/-- The action on a submonoid corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
protected def pointwise_mul_action : mul_action α (submonoid M) :=
{ smul := λ a S, S.map (mul_distrib_mul_action.to_monoid_End _ _ a),
  one_smul := λ S, (congr_arg (λ f, S.map f) (monoid_hom.map_one _)).trans S.map_id,
  mul_smul := λ a₁ a₂ S,
    (congr_arg (λ f, S.map f) (monoid_hom.map_mul _ _ _)).trans (S.map_map _ _).symm,}

localized "attribute [instance] submonoid.pointwise_mul_action" in pointwise
open_locale pointwise

@[simp] lemma coe_pointwise_smul (a : α) (S : submonoid M) : ↑(a • S) = a • (S : set M) := rfl

lemma smul_mem_pointwise_smul (m : M) (a : α) (S : submonoid M) : m ∈ S → a • m ∈ a • S :=
(set.smul_mem_smul_set : _ → _ ∈ a • (S : set M))

lemma mem_smul_pointwise_iff_exists (m : M) (a : α) (S : submonoid M) :
  m ∈ a • S ↔ ∃ (s : M), s ∈ S ∧ a • s = m :=
(set.mem_smul_set : m ∈ a • (S : set M) ↔ _)

instance pointwise_central_scalar [mul_distrib_mul_action αᵐᵒᵖ M] [is_central_scalar α M] :
  is_central_scalar α (submonoid M) :=
⟨λ a S, congr_arg (λ f, S.map f) $ monoid_hom.ext $ by exact op_smul_eq_smul _⟩

end monoid

section group
variables [group α] [mul_distrib_mul_action α M]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff {a : α} {S : submonoid M} {x : M} :
  a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff

lemma mem_pointwise_smul_iff_inv_smul_mem {a : α} {S : submonoid M} {x : M} :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem

lemma mem_inv_pointwise_smul_iff {a : α} {S : submonoid M} {x : M} : x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff

@[simp] lemma pointwise_smul_le_pointwise_smul_iff {a : α} {S T : submonoid M} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff

lemma pointwise_smul_subset_iff {a : α} {S T : submonoid M} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff

lemma subset_pointwise_smul_iff {a : α} {S T : submonoid M} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff

end group

section group_with_zero
variables [group_with_zero α] [mul_distrib_mul_action α M]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : submonoid M)
  (x : M) : a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff₀ ha (S : set M) x

lemma mem_inv_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : submonoid M) (x : M) :
  x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff₀ ha (S : set M) x

@[simp] lemma pointwise_smul_le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : submonoid M} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff₀ ha

lemma pointwise_smul_le_iff₀ {a : α} (ha : a ≠ 0) {S T : submonoid M} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff₀ ha

lemma le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : submonoid M} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff₀ ha

end group_with_zero

open_locale pointwise

@[to_additive]
lemma mem_closure_inv {G : Type*} [group G] (S : set G) (x : G) :
  x ∈ submonoid.closure S⁻¹ ↔ x⁻¹ ∈ submonoid.closure S :=
by rw [closure_inv, mem_inv]

end submonoid

namespace add_submonoid

section monoid
variables [monoid α] [distrib_mul_action α A]

/-- The action on an additive submonoid corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
protected def pointwise_mul_action : mul_action α (add_submonoid A) :=
{ smul := λ a S, S.map (distrib_mul_action.to_add_monoid_End _ _ a),
  one_smul := λ S, (congr_arg (λ f, S.map f) (monoid_hom.map_one _)).trans S.map_id,
  mul_smul := λ a₁ a₂ S,
    (congr_arg (λ f, S.map f) (monoid_hom.map_mul _ _ _)).trans (S.map_map _ _).symm,}

localized "attribute [instance] add_submonoid.pointwise_mul_action" in pointwise
open_locale pointwise

@[simp] lemma coe_pointwise_smul (a : α) (S : add_submonoid A) : ↑(a • S) = a • (S : set A) := rfl

lemma smul_mem_pointwise_smul (m : A) (a : α) (S : add_submonoid A) : m ∈ S → a • m ∈ a • S :=
(set.smul_mem_smul_set : _ → _ ∈ a • (S : set A))

instance pointwise_central_scalar [distrib_mul_action αᵐᵒᵖ A] [is_central_scalar α A] :
  is_central_scalar α (add_submonoid A) :=
⟨λ a S, congr_arg (λ f, S.map f) $ add_monoid_hom.ext $ by exact op_smul_eq_smul _⟩

end monoid

section group
variables [group α] [distrib_mul_action α A]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff {a : α} {S : add_submonoid A} {x : A} :
  a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff

lemma mem_pointwise_smul_iff_inv_smul_mem {a : α} {S : add_submonoid A} {x : A} :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem

lemma mem_smul_pointwise_iff_exists (m : A) (a : α) (S : add_submonoid A) :
  m ∈ a • S ↔ ∃ (s : A), s ∈ S ∧ a • s = m :=
(set.mem_smul_set : m ∈ a • (S : set A) ↔ _)

lemma mem_inv_pointwise_smul_iff {a : α} {S : add_submonoid A} {x : A} : x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff

@[simp] lemma pointwise_smul_le_pointwise_smul_iff {a : α} {S T : add_submonoid A} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff

lemma pointwise_smul_le_iff {a : α} {S T : add_submonoid A} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff

lemma le_pointwise_smul_iff {a : α} {S T : add_submonoid A} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff

end group

section group_with_zero
variables [group_with_zero α] [distrib_mul_action α A]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : add_submonoid A)
  (x : A) : a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff₀ ha (S : set A) x

lemma mem_pointwise_smul_iff_inv_smul_mem₀ {a : α} (ha : a ≠ 0) (S : add_submonoid A) (x : A) :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem₀ ha (S : set A) x

lemma mem_inv_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : add_submonoid A) (x : A) :
  x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff₀ ha (S : set A) x

@[simp] lemma pointwise_smul_le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : add_submonoid A} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff₀ ha

lemma pointwise_smul_le_iff₀ {a : α} (ha : a ≠ 0) {S T : add_submonoid A} :
  a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff₀ ha

lemma le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : add_submonoid A} :
  S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff₀ ha

end group_with_zero

open_locale pointwise

end add_submonoid

/-! ### Elementwise multiplication of two additive submonoids

These definitions are a cut-down versions of the ones around `submodule.has_mul`, as that API is
usually more useful. -/
namespace add_submonoid

variables [non_unital_non_assoc_semiring R]

/-- Multiplication of additive submonoids of a semiring R. The additive submonoid `S * T` is the
smallest R-submodule of `R` containing the elements `s * t` for `s ∈ S` and `t ∈ T`. -/
instance : has_mul (add_submonoid R) :=
⟨λ M N, ⨆ s : M, N.map $ add_monoid_hom.mul s.1⟩

theorem mul_mem_mul {M N : add_submonoid R} {m n : R} (hm : m ∈ M) (hn : n ∈ N) : m * n ∈ M * N :=
(le_supr _ ⟨m, hm⟩ : _ ≤ M * N) ⟨n, hn, rfl⟩

theorem mul_le {M N P : add_submonoid R} : M * N ≤ P ↔ ∀ (m ∈ M) (n ∈ N), m * n ∈ P :=
⟨λ H m hm n hn, H $ mul_mem_mul hm hn,
λ H, supr_le $ λ ⟨m, hm⟩, map_le_iff_le_comap.2 $ λ n hn, H m hm n hn⟩

@[elab_as_eliminator] protected theorem mul_induction_on
  {M N : add_submonoid R}
  {C : R → Prop} {r : R} (hr : r ∈ M * N)
  (hm : ∀ (m ∈ M) (n ∈ N), C (m * n))
  (ha : ∀ x y, C x → C y → C (x + y)) : C r :=
(@mul_le _ _ _ _ ⟨C, by simpa only [zero_mul] using hm _ (zero_mem _) _ (zero_mem _), ha⟩).2 hm hr

open_locale pointwise

variables R
-- this proof is copied directly from `submodule.span_mul_span`
theorem closure_mul_closure (S T : set R) : closure S * closure T = closure (S * T) :=
begin
  apply le_antisymm,
  { rw mul_le, intros a ha b hb,
    apply closure_induction ha,
    work_on_goal 0 { intros, apply closure_induction hb,
      work_on_goal 0 { intros, exact subset_closure ⟨_, _, ‹_›, ‹_›, rfl⟩ } },
    all_goals { intros, simp only [mul_zero, zero_mul, zero_mem,
        left_distrib, right_distrib, mul_smul_comm, smul_mul_assoc],
      try {apply add_mem _ _ _}, try {apply smul_mem _ _ _} }, assumption' },
  { rw closure_le, rintros _ ⟨a, b, ha, hb, rfl⟩,
    exact mul_mem_mul (subset_closure ha) (subset_closure hb) }
end
variables {R}

@[simp] theorem mul_bot (S : add_submonoid R) : S * ⊥ = ⊥ :=
eq_bot_iff.2 $ mul_le.2 $ λ m hm n hn, by rw [add_submonoid.mem_bot] at hn ⊢; rw [hn, mul_zero]

@[simp] theorem bot_mul (S : add_submonoid R) : ⊥ * S = ⊥ :=
eq_bot_iff.2 $ mul_le.2 $ λ m hm n hn, by rw [add_submonoid.mem_bot] at hm ⊢; rw [hm, zero_mul]

@[mono] theorem mul_le_mul {M N P Q : add_submonoid R} (hmp : M ≤ P) (hnq : N ≤ Q) :
  M * N ≤ P * Q :=
mul_le.2 $ λ m hm n hn, mul_mem_mul (hmp hm) (hnq hn)

theorem mul_le_mul_left {M N P : add_submonoid R} (h : M ≤ N) : M * P ≤ N * P :=
mul_le_mul h (le_refl P)

theorem mul_le_mul_right {M N P : add_submonoid R} (h : N ≤ P) : M * N ≤ M * P :=
mul_le_mul (le_refl M) h

lemma mul_subset_mul {M N : add_submonoid R} : (↑M : set R) * (↑N : set R) ⊆ (↑(M * N) : set R) :=
by { rintros _ ⟨i, j, hi, hj, rfl⟩, exact mul_mem_mul hi hj }

end add_submonoid


variables {α : Type} [comm_ring α]

local attribute [simp] mul_comm mul_assoc mul_left_comm

example (x y z : α) : (x - x) * y + z = z :=
begin
  simp [sub_eq_add_neg]
end
-- lean 3.6 removes simp attributes from sub_eq_add_neg
-- i.e., now it is required to provide that lemma to solve this example.

example (x y z w : α) : x * y + z * w  * x = x * w * z + y * x :=
  by simp [add_comm]
-- lean 3.6 removes simp attributes from add_comm
-- i.e., now it is required to provide that lemma to solve this example.


/-
Copyright (c) 2022 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import group_theory.group_action.group
import group_theory.group_action.pi

/-!
# Group actions on embeddings

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

This file provides a `mul_action G (α ↪ β)` instance that agrees with the `mul_action G (α → β)`
instances defined by `pi.mul_action`.

Note that unlike the `pi` instance, this requires `G` to be a group.
-/

universes u v w
variables {G G' α β : Type*}

namespace function.embedding

@[to_additive function.embedding.has_vadd]
instance [group G] [mul_action G β] : has_smul G (α ↪ β) :=
⟨λ g f, f.trans (mul_action.to_perm g).to_embedding⟩

@[to_additive]
lemma smul_def [group G] [mul_action G β] (g : G) (f : α ↪ β) :
  g • f = f.trans (mul_action.to_perm g).to_embedding := rfl
@[simp, to_additive]
lemma smul_apply [group G] [mul_action G β] (g : G) (f : α ↪ β) (a : α) : (g • f) a = g • f a :=
rfl
@[to_additive]
lemma coe_smul [group G] [mul_action G β] (g : G) (f : α ↪ β) : ⇑(g • f) = g • f := rfl

instance [group G] [group G'] [has_smul G G'] [mul_action G β] [mul_action G' β]
  [is_scalar_tower G G' β] : is_scalar_tower G G' (α ↪ β) :=
⟨λ x y z, function.embedding.ext $ λ i, smul_assoc x y (z i)⟩

@[to_additive]
instance [group G] [group G'] [mul_action G β] [mul_action G' β] [smul_comm_class G G' β] :
  smul_comm_class G G' (α ↪ β) :=
⟨λ x y z, function.embedding.ext $ λ i, smul_comm x y (z i)⟩

instance [group G] [mul_action G β] [mul_action Gᵐᵒᵖ β] [is_central_scalar G β] :
  is_central_scalar G (α ↪ β) :=
⟨λ r m, function.embedding.ext $ λ i, op_smul_eq_smul _ _⟩

@[to_additive]
instance [group G] [mul_action G β] : mul_action G (α ↪ β) :=
fun_like.coe_injective.mul_action _ coe_smul

end function.embedding


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Markus Himmel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.epi_mono
import Mathlib.category_theory.limits.limits
import Mathlib.PostPort

universes v l u_1 u u₂

namespace Mathlib

/-!
# Equalizers and coequalizers

This file defines (co)equalizers as special cases of (co)limits.

An equalizer is the categorical generalization of the subobject {a ∈ A | f(a) = g(a)} known
from abelian groups or modules. It is a limit cone over the diagram formed by `f` and `g`.

A coequalizer is the dual concept.

## Main definitions

* `walking_parallel_pair` is the indexing category used for (co)equalizer_diagrams
* `parallel_pair` is a functor from `walking_parallel_pair` to our category `C`.
* a `fork` is a cone over a parallel pair.
  * there is really only one interesting morphism in a fork: the arrow from the vertex of the fork
    to the domain of f and g. It is called `fork.ι`.
* an `equalizer` is now just a `limit (parallel_pair f g)`

Each of these has a dual.

## Main statements

* `equalizer.ι_mono` states that every equalizer map is a monomorphism
* `is_iso_limit_cone_parallel_pair_of_self` states that the identity on the domain of `f` is an
  equalizer of `f` and `f`.

## Implementation notes
As with the other special shapes in the limits library, all the definitions here are given as
`abbreviation`s of the general statements for limits, so all the `simp` lemmas and theorems about
general limits can be used.

## References

* [F. Borceux, *Handbook of Categorical Algebra 1*][borceux-vol1]
-/

namespace category_theory.limits

/-- The type of objects for the diagram indexing a (co)equalizer. -/
inductive walking_parallel_pair where
| zero : walking_parallel_pair
| one : walking_parallel_pair

/-- The type family of morphisms for the diagram indexing a (co)equalizer. -/
inductive walking_parallel_pair_hom : walking_parallel_pair → walking_parallel_pair → Type v where
| left : walking_parallel_pair_hom walking_parallel_pair.zero walking_parallel_pair.one
| right : walking_parallel_pair_hom walking_parallel_pair.zero walking_parallel_pair.one
| id : (X : walking_parallel_pair) → walking_parallel_pair_hom X X

/-- Satisfying the inhabited linter -/
protected instance walking_parallel_pair_hom.inhabited :
    Inhabited (walking_parallel_pair_hom walking_parallel_pair.zero walking_parallel_pair.one) :=
  { default := walking_parallel_pair_hom.left }

/-- Composition of morphisms in the indexing diagram for (co)equalizers. -/
def walking_parallel_pair_hom.comp (X : walking_parallel_pair) (Y : walking_parallel_pair)
    (Z : walking_parallel_pair) (f : walking_parallel_pair_hom X Y)
    (g : walking_parallel_pair_hom Y Z) : walking_parallel_pair_hom X Z :=
  sorry

protected instance walking_parallel_pair_hom_category : small_category walking_parallel_pair :=
  category.mk

@[simp] theorem walking_parallel_pair_hom_id (X : walking_parallel_pair) :
    walking_parallel_pair_hom.id X = 𝟙 :=
  rfl

/-- `parallel_pair f g` is the diagram in `C` consisting of the two morphisms `f` and `g` with
    common domain and codomain. -/
def parallel_pair {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) :
    walking_parallel_pair ⥤ C :=
  functor.mk (fun (x : walking_parallel_pair) => sorry)
    fun (x y : walking_parallel_pair) (h : x ⟶ y) => sorry

@[simp] theorem parallel_pair_obj_zero {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) : functor.obj (parallel_pair f g) walking_parallel_pair.zero = X :=
  rfl

@[simp] theorem parallel_pair_obj_one {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) : functor.obj (parallel_pair f g) walking_parallel_pair.one = Y :=
  rfl

@[simp] theorem parallel_pair_map_left {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) : functor.map (parallel_pair f g) walking_parallel_pair_hom.left = f :=
  rfl

@[simp] theorem parallel_pair_map_right {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) : functor.map (parallel_pair f g) walking_parallel_pair_hom.right = g :=
  rfl

@[simp] theorem parallel_pair_functor_obj {C : Type u} [category C] {F : walking_parallel_pair ⥤ C}
    (j : walking_parallel_pair) :
    functor.obj
          (parallel_pair (functor.map F walking_parallel_pair_hom.left)
            (functor.map F walking_parallel_pair_hom.right))
          j =
        functor.obj F j :=
  sorry

/-- Every functor indexing a (co)equalizer is naturally isomorphic (actually, equal) to a
    `parallel_pair` -/
def diagram_iso_parallel_pair {C : Type u} [category C] (F : walking_parallel_pair ⥤ C) :
    F ≅
        parallel_pair (functor.map F walking_parallel_pair_hom.left)
          (functor.map F walking_parallel_pair_hom.right) :=
  nat_iso.of_components (fun (j : walking_parallel_pair) => eq_to_iso sorry) sorry

/-- A fork on `f` and `g` is just a `cone (parallel_pair f g)`. -/
def fork {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) :=
  cone (parallel_pair f g)

/-- A cofork on `f` and `g` is just a `cocone (parallel_pair f g)`. -/
def cofork {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) :=
  cocone (parallel_pair f g)

/-- A fork `t` on the parallel pair `f g : X ⟶ Y` consists of two morphisms `t.π.app zero : t.X ⟶ X`
    and `t.π.app one : t.X ⟶ Y`. Of these, only the first one is interesting, and we give it the
    shorter name `fork.ι t`. -/
def fork.ι {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} (t : fork f g) :
    functor.obj (functor.obj (functor.const walking_parallel_pair) (cone.X t))
          walking_parallel_pair.zero ⟶
        functor.obj (parallel_pair f g) walking_parallel_pair.zero :=
  nat_trans.app (cone.π t) walking_parallel_pair.zero

/-- A cofork `t` on the parallel_pair `f g : X ⟶ Y` consists of two morphisms
    `t.ι.app zero : X ⟶ t.X` and `t.ι.app one : Y ⟶ t.X`. Of these, only the second one is
    interesting, and we give it the shorter name `cofork.π t`. -/
def cofork.π {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} (t : cofork f g) :
    functor.obj (parallel_pair f g) walking_parallel_pair.one ⟶
        functor.obj (functor.obj (functor.const walking_parallel_pair) (cocone.X t))
          walking_parallel_pair.one :=
  nat_trans.app (cocone.ι t) walking_parallel_pair.one

@[simp] theorem fork.ι_eq_app_zero {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (t : fork f g) : fork.ι t = nat_trans.app (cone.π t) walking_parallel_pair.zero :=
  rfl

@[simp] theorem cofork.π_eq_app_one {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} (t : cofork f g) :
    cofork.π t = nat_trans.app (cocone.ι t) walking_parallel_pair.one :=
  rfl

@[simp] theorem fork.app_zero_left {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (s : fork f g) :
    nat_trans.app (cone.π s) walking_parallel_pair.zero ≫ f =
        nat_trans.app (cone.π s) walking_parallel_pair.one :=
  sorry

@[simp] theorem fork.app_zero_right {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} (s : fork f g) :
    nat_trans.app (cone.π s) walking_parallel_pair.zero ≫ g =
        nat_trans.app (cone.π s) walking_parallel_pair.one :=
  sorry

@[simp] theorem cofork.left_app_one_assoc {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} (s : cofork f g) {X' : C}
    (f' :
      functor.obj (functor.obj (functor.const walking_parallel_pair) (cocone.X s))
          walking_parallel_pair.one ⟶
        X') :
    f ≫ nat_trans.app (cocone.ι s) walking_parallel_pair.one ≫ f' =
        nat_trans.app (cocone.ι s) walking_parallel_pair.zero ≫ f' :=
  sorry

@[simp] theorem cofork.right_app_one_assoc {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} (s : cofork f g) {X' : C}
    (f' :
      functor.obj (functor.obj (functor.const walking_parallel_pair) (cocone.X s))
          walking_parallel_pair.one ⟶
        X') :
    g ≫ nat_trans.app (cocone.ι s) walking_parallel_pair.one ≫ f' =
        nat_trans.app (cocone.ι s) walking_parallel_pair.zero ≫ f' :=
  sorry

/-- A fork on `f g : X ⟶ Y` is determined by the morphism `ι : P ⟶ X` satisfying `ι ≫ f = ι ≫ g`.
-/
@[simp] theorem fork.of_ι_X {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {P : C} (ι : P ⟶ X) (w : ι ≫ f = ι ≫ g) : cone.X (fork.of_ι ι w) = P :=
  Eq.refl (cone.X (fork.of_ι ι w))

/-- A cofork on `f g : X ⟶ Y` is determined by the morphism `π : Y ⟶ P` satisfying
    `f ≫ π = g ≫ π`. -/
@[simp] theorem cofork.of_π_ι_app {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {P : C} (π : Y ⟶ P) (w : f ≫ π = g ≫ π) :
    ∀ (X_1 : walking_parallel_pair),
        nat_trans.app (cocone.ι (cofork.of_π π w)) X_1 =
          walking_parallel_pair.cases_on X_1 (f ≫ π) π :=
  fun (X_1 : walking_parallel_pair) => Eq.refl (nat_trans.app (cocone.ι (cofork.of_π π w)) X_1)

theorem fork.ι_of_ι {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} {P : C}
    (ι : P ⟶ X) (w : ι ≫ f = ι ≫ g) : fork.ι (fork.of_ι ι w) = ι :=
  rfl

theorem cofork.π_of_π {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} {P : C}
    (π : Y ⟶ P) (w : f ≫ π = g ≫ π) : cofork.π (cofork.of_π π w) = π :=
  rfl

theorem fork.condition {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (t : fork f g) : fork.ι t ≫ f = fork.ι t ≫ g :=
  sorry

theorem cofork.condition {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (t : cofork f g) : f ≫ cofork.π t = g ≫ cofork.π t :=
  sorry

/-- To check whether two maps are equalized by both maps of a fork, it suffices to check it for the
    first map -/
theorem fork.equalizer_ext {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (s : fork f g) {W : C} {k : W ⟶ cone.X s} {l : W ⟶ cone.X s} (h : k ≫ fork.ι s = l ≫ fork.ι s)
    (j : walking_parallel_pair) : k ≫ nat_trans.app (cone.π s) j = l ≫ nat_trans.app (cone.π s) j :=
  sorry

/-- To check whether two maps are coequalized by both maps of a cofork, it suffices to check it for
    the second map -/
theorem cofork.coequalizer_ext {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (s : cofork f g) {W : C} {k : cocone.X s ⟶ W} {l : cocone.X s ⟶ W}
    (h : cofork.π s ≫ k = cofork.π s ≫ l) (j : walking_parallel_pair) :
    nat_trans.app (cocone.ι s) j ≫ k = nat_trans.app (cocone.ι s) j ≫ l :=
  sorry

theorem fork.is_limit.hom_ext {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {s : fork f g} (hs : is_limit s) {W : C} {k : W ⟶ cone.X s} {l : W ⟶ cone.X s}
    (h : k ≫ fork.ι s = l ≫ fork.ι s) : k = l :=
  is_limit.hom_ext hs (fork.equalizer_ext s h)

theorem cofork.is_colimit.hom_ext {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {s : cofork f g} (hs : is_colimit s) {W : C} {k : cocone.X s ⟶ W} {l : cocone.X s ⟶ W}
    (h : cofork.π s ≫ k = cofork.π s ≫ l) : k = l :=
  is_colimit.hom_ext hs (cofork.coequalizer_ext s h)

/-- If `s` is a limit fork over `f` and `g`, then a morphism `k : W ⟶ X` satisfying
    `k ≫ f = k ≫ g` induces a morphism `l : W ⟶ s.X` such that `l ≫ fork.ι s = k`. -/
def fork.is_limit.lift' {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {s : fork f g} (hs : is_limit s) {W : C} (k : W ⟶ X) (h : k ≫ f = k ≫ g) :
    Subtype fun (l : W ⟶ cone.X s) => l ≫ fork.ι s = k :=
  { val := is_limit.lift hs (fork.of_ι k h), property := sorry }

/-- If `s` is a colimit cofork over `f` and `g`, then a morphism `k : Y ⟶ W` satisfying
    `f ≫ k = g ≫ k` induces a morphism `l : s.X ⟶ W` such that `cofork.π s ≫ l = k`. -/
def cofork.is_colimit.desc' {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {s : cofork f g} (hs : is_colimit s) {W : C} (k : Y ⟶ W) (h : f ≫ k = g ≫ k) :
    Subtype fun (l : cocone.X s ⟶ W) => cofork.π s ≫ l = k :=
  { val := is_colimit.desc hs (cofork.of_π k h), property := sorry }

/-- This is a slightly more convenient method to verify that a fork is a limit cone. It
    only asks for a proof of facts that carry any mathematical content -/
def fork.is_limit.mk {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (t : fork f g) (lift : (s : fork f g) → cone.X s ⟶ cone.X t)
    (fac : ∀ (s : fork f g), lift s ≫ fork.ι t = fork.ι s)
    (uniq :
      ∀ (s : fork f g) (m : cone.X s ⟶ cone.X t),
        (∀ (j : walking_parallel_pair),
            m ≫ nat_trans.app (cone.π t) j = nat_trans.app (cone.π s) j) →
          m = lift s) :
    is_limit t :=
  is_limit.mk lift

/-- This is another convenient method to verify that a fork is a limit cone. It
    only asks for a proof of facts that carry any mathematical content, and allows access to the
    same `s` for all parts. -/
def fork.is_limit.mk' {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (t : fork f g)
    (create :
      (s : fork f g) →
        Subtype
          fun
            (l :
            functor.obj (functor.obj (functor.const walking_parallel_pair) (cone.X s))
                walking_parallel_pair.zero ⟶
              functor.obj (functor.obj (functor.const walking_parallel_pair) (cone.X t))
                walking_parallel_pair.zero) =>
            l ≫ fork.ι t = fork.ι s ∧
              ∀
                {m :
                  functor.obj (functor.obj (functor.const walking_parallel_pair) (cone.X s))
                      walking_parallel_pair.zero ⟶
                    functor.obj (functor.obj (functor.const walking_parallel_pair) (cone.X t))
                      walking_parallel_pair.zero},
                m ≫ fork.ι t = fork.ι s → m = l) :
    is_limit t :=
  fork.is_limit.mk t (fun (s : fork f g) => subtype.val (create s)) sorry sorry

/-- This is a slightly more convenient method to verify that a cofork is a colimit cocone. It
    only asks for a proof of facts that carry any mathematical content -/
def cofork.is_colimit.mk {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (t : cofork f g) (desc : (s : cofork f g) → cocone.X t ⟶ cocone.X s)
    (fac : ∀ (s : cofork f g), cofork.π t ≫ desc s = cofork.π s)
    (uniq :
      ∀ (s : cofork f g) (m : cocone.X t ⟶ cocone.X s),
        (∀ (j : walking_parallel_pair),
            nat_trans.app (cocone.ι t) j ≫ m = nat_trans.app (cocone.ι s) j) →
          m = desc s) :
    is_colimit t :=
  is_colimit.mk desc

/-- This is another convenient method to verify that a fork is a limit cone. It
    only asks for a proof of facts that carry any mathematical content, and allows access to the
    same `s` for all parts. -/
def cofork.is_colimit.mk' {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (t : cofork f g)
    (create :
      (s : cofork f g) →
        Subtype
          fun (l : cocone.X t ⟶ cocone.X s) =>
            cofork.π t ≫ l = cofork.π s ∧
              ∀
                {m :
                  functor.obj (functor.obj (functor.const walking_parallel_pair) (cocone.X t))
                      walking_parallel_pair.one ⟶
                    functor.obj (functor.obj (functor.const walking_parallel_pair) (cocone.X s))
                      walking_parallel_pair.one},
                cofork.π t ≫ m = cofork.π s → m = l) :
    is_colimit t :=
  cofork.is_colimit.mk t (fun (s : cofork f g) => subtype.val (create s)) sorry sorry

/--
Given a limit cone for the pair `f g : X ⟶ Y`, for any `Z`, morphisms from `Z` to its point are in
bijection with morphisms `h : Z ⟶ X` such that `h ≫ f = h ≫ g`.
Further, this bijection is natural in `Z`: see `fork.is_limit.hom_iso_natural`.
This is a special case of `is_limit.hom_iso'`, often useful to construct adjunctions.
-/
def fork.is_limit.hom_iso {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {t : fork f g} (ht : is_limit t) (Z : C) :
    (Z ⟶ cone.X t) ≃ Subtype fun (h : Z ⟶ X) => h ≫ f = h ≫ g :=
  equiv.mk (fun (k : Z ⟶ cone.X t) => { val := k ≫ fork.ι t, property := sorry })
    (fun (h : Subtype fun (h : Z ⟶ X) => h ≫ f = h ≫ g) =>
      subtype.val (fork.is_limit.lift' ht ↑h sorry))
    sorry sorry

/-- The bijection of `fork.is_limit.hom_iso` is natural in `Z`. -/
theorem fork.is_limit.hom_iso_natural {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} {t : fork f g} (ht : is_limit t) {Z : C} {Z' : C} (q : Z' ⟶ Z) (k : Z ⟶ cone.X t) :
    ↑(coe_fn (fork.is_limit.hom_iso ht Z') (q ≫ k)) =
        q ≫ ↑(coe_fn (fork.is_limit.hom_iso ht Z) k) :=
  category.assoc q k (fork.ι t)

/--
Given a colimit cocone for the pair `f g : X ⟶ Y`, for any `Z`, morphisms from the cocone point
to `Z` are in bijection with morphisms `h : Y ⟶ Z` such that `f ≫ h = g ≫ h`.
Further, this bijection is natural in `Z`: see `cofork.is_colimit.hom_iso_natural`.
This is a special case of `is_colimit.hom_iso'`, often useful to construct adjunctions.
-/
def cofork.is_colimit.hom_iso {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {t : cofork f g} (ht : is_colimit t) (Z : C) :
    (cocone.X t ⟶ Z) ≃ Subtype fun (h : Y ⟶ Z) => f ≫ h = g ≫ h :=
  equiv.mk (fun (k : cocone.X t ⟶ Z) => { val := cofork.π t ≫ k, property := sorry })
    (fun (h : Subtype fun (h : Y ⟶ Z) => f ≫ h = g ≫ h) =>
      subtype.val (cofork.is_colimit.desc' ht ↑h sorry))
    sorry sorry

/-- The bijection of `cofork.is_colimit.hom_iso` is natural in `Z`. -/
theorem cofork.is_colimit.hom_iso_natural {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} {t : cofork f g} {Z : C} {Z' : C} (q : Z ⟶ Z') (ht : is_colimit t)
    (k : cocone.X t ⟶ Z) :
    ↑(coe_fn (cofork.is_colimit.hom_iso ht Z') (k ≫ q)) =
        ↑(coe_fn (cofork.is_colimit.hom_iso ht Z) k) ≫ q :=
  Eq.symm (category.assoc (cofork.π t) k q)

/-- This is a helper construction that can be useful when verifying that a category has all
    equalizers. Given `F : walking_parallel_pair ⥤ C`, which is really the same as
    `parallel_pair (F.map left) (F.map right)`, and a fork on `F.map left` and `F.map right`,
    we get a cone on `F`.

    If you're thinking about using this, have a look at `has_equalizers_of_has_limit_parallel_pair`,
    which you may find to be an easier way of achieving your goal. -/
def cone.of_fork {C : Type u} [category C] {F : walking_parallel_pair ⥤ C}
    (t :
      fork (functor.map F walking_parallel_pair_hom.left)
        (functor.map F walking_parallel_pair_hom.right)) :
    cone F :=
  cone.mk (cone.X t)
    (nat_trans.mk fun (X : walking_parallel_pair) => nat_trans.app (cone.π t) X ≫ eq_to_hom sorry)

/-- This is a helper construction that can be useful when verifying that a category has all
    coequalizers. Given `F : walking_parallel_pair ⥤ C`, which is really the same as
    `parallel_pair (F.map left) (F.map right)`, and a cofork on `F.map left` and `F.map right`,
    we get a cocone on `F`.

    If you're thinking about using this, have a look at
    `has_coequalizers_of_has_colimit_parallel_pair`, which you may find to be an easier way of
    achieving your goal. -/
def cocone.of_cofork {C : Type u} [category C] {F : walking_parallel_pair ⥤ C}
    (t :
      cofork (functor.map F walking_parallel_pair_hom.left)
        (functor.map F walking_parallel_pair_hom.right)) :
    cocone F :=
  cocone.mk (cocone.X t)
    (nat_trans.mk fun (X : walking_parallel_pair) => eq_to_hom sorry ≫ nat_trans.app (cocone.ι t) X)

@[simp] theorem cone.of_fork_π {C : Type u} [category C] {F : walking_parallel_pair ⥤ C}
    (t :
      fork (functor.map F walking_parallel_pair_hom.left)
        (functor.map F walking_parallel_pair_hom.right))
    (j : walking_parallel_pair) :
    nat_trans.app (cone.π (cone.of_fork t)) j =
        nat_trans.app (cone.π t) j ≫
          eq_to_hom
            (eq.mpr
              (id
                (Eq.trans
                  ((fun (a a_1 : C) (e_1 : a = a_1) (ᾰ ᾰ_1 : C) (e_2 : ᾰ = ᾰ_1) =>
                      congr (congr_arg Eq e_1) e_2)
                    (functor.obj
                      (parallel_pair (functor.map F walking_parallel_pair_hom.left)
                        (functor.map F walking_parallel_pair_hom.right))
                      j)
                    (functor.obj F j) (parallel_pair_functor_obj j) (functor.obj F j)
                    (functor.obj F j) (Eq.refl (functor.obj F j)))
                  (propext (eq_self_iff_true (functor.obj F j)))))
              trivial) :=
  rfl

@[simp] theorem cocone.of_cofork_ι {C : Type u} [category C] {F : walking_parallel_pair ⥤ C}
    (t :
      cofork (functor.map F walking_parallel_pair_hom.left)
        (functor.map F walking_parallel_pair_hom.right))
    (j : walking_parallel_pair) :
    nat_trans.app (cocone.ι (cocone.of_cofork t)) j =
        eq_to_hom
            (eq.mpr
              (id
                (Eq.trans
                  ((fun (a a_1 : C) (e_1 : a = a_1) (ᾰ ᾰ_1 : C) (e_2 : ᾰ = ᾰ_1) =>
                      congr (congr_arg Eq e_1) e_2)
                    (functor.obj F j) (functor.obj F j) (Eq.refl (functor.obj F j))
                    (functor.obj
                      (parallel_pair (functor.map F walking_parallel_pair_hom.left)
                        (functor.map F walking_parallel_pair_hom.right))
                      j)
                    (functor.obj F j) (parallel_pair_functor_obj j))
                  (propext (eq_self_iff_true (functor.obj F j)))))
              trivial) ≫
          nat_trans.app (cocone.ι t) j :=
  rfl

/-- Given `F : walking_parallel_pair ⥤ C`, which is really the same as
    `parallel_pair (F.map left) (F.map right)` and a cone on `F`, we get a fork on
    `F.map left` and `F.map right`. -/
def fork.of_cone {C : Type u} [category C] {F : walking_parallel_pair ⥤ C} (t : cone F) :
    fork (functor.map F walking_parallel_pair_hom.left)
        (functor.map F walking_parallel_pair_hom.right) :=
  cone.mk (cone.X t)
    (nat_trans.mk fun (X : walking_parallel_pair) => nat_trans.app (cone.π t) X ≫ eq_to_hom sorry)

/-- Given `F : walking_parallel_pair ⥤ C`, which is really the same as
    `parallel_pair (F.map left) (F.map right)` and a cocone on `F`, we get a cofork on
    `F.map left` and `F.map right`. -/
def cofork.of_cocone {C : Type u} [category C] {F : walking_parallel_pair ⥤ C} (t : cocone F) :
    cofork (functor.map F walking_parallel_pair_hom.left)
        (functor.map F walking_parallel_pair_hom.right) :=
  cocone.mk (cocone.X t)
    (nat_trans.mk fun (X : walking_parallel_pair) => eq_to_hom sorry ≫ nat_trans.app (cocone.ι t) X)

@[simp] theorem fork.of_cone_π {C : Type u} [category C] {F : walking_parallel_pair ⥤ C}
    (t : cone F) (j : walking_parallel_pair) :
    nat_trans.app (cone.π (fork.of_cone t)) j =
        nat_trans.app (cone.π t) j ≫
          eq_to_hom
            (eq.mpr
              (id
                (Eq.trans
                  ((fun (a a_1 : C) (e_1 : a = a_1) (ᾰ ᾰ_1 : C) (e_2 : ᾰ = ᾰ_1) =>
                      congr (congr_arg Eq e_1) e_2)
                    (functor.obj F j) (functor.obj F j) (Eq.refl (functor.obj F j))
                    (functor.obj
                      (parallel_pair (functor.map F walking_parallel_pair_hom.left)
                        (functor.map F walking_parallel_pair_hom.right))
                      j)
                    (functor.obj F j) (parallel_pair_functor_obj j))
                  (propext (eq_self_iff_true (functor.obj F j)))))
              trivial) :=
  rfl

@[simp] theorem cofork.of_cocone_ι {C : Type u} [category C] {F : walking_parallel_pair ⥤ C}
    (t : cocone F) (j : walking_parallel_pair) :
    nat_trans.app (cocone.ι (cofork.of_cocone t)) j =
        eq_to_hom
            (eq.mpr
              (id
                (Eq.trans
                  ((fun (a a_1 : C) (e_1 : a = a_1) (ᾰ ᾰ_1 : C) (e_2 : ᾰ = ᾰ_1) =>
                      congr (congr_arg Eq e_1) e_2)
                    (functor.obj
                      (parallel_pair (functor.map F walking_parallel_pair_hom.left)
                        (functor.map F walking_parallel_pair_hom.right))
                      j)
                    (functor.obj F j) (parallel_pair_functor_obj j) (functor.obj F j)
                    (functor.obj F j) (Eq.refl (functor.obj F j)))
                  (propext (eq_self_iff_true (functor.obj F j)))))
              trivial) ≫
          nat_trans.app (cocone.ι t) j :=
  rfl

/--
Helper function for constructing morphisms between equalizer forks.
-/
@[simp] theorem fork.mk_hom_hom {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {s : fork f g} {t : fork f g} (k : cone.X s ⟶ cone.X t) (w : k ≫ fork.ι t = fork.ι s) :
    cone_morphism.hom (fork.mk_hom k w) = k :=
  Eq.refl (cone_morphism.hom (fork.mk_hom k w))

/--
To construct an isomorphism between forks,
it suffices to give an isomorphism between the cone points
and check that it commutes with the `ι` morphisms.
-/
@[simp] theorem fork.ext_hom {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {s : fork f g} {t : fork f g} (i : cone.X s ≅ cone.X t) (w : iso.hom i ≫ fork.ι t = fork.ι s) :
    iso.hom (fork.ext i w) = fork.mk_hom (iso.hom i) w :=
  Eq.refl (iso.hom (fork.ext i w))

/--
Helper function for constructing morphisms between coequalizer coforks.
-/
@[simp] theorem cofork.mk_hom_hom {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    {s : cofork f g} {t : cofork f g} (k : cocone.X s ⟶ cocone.X t)
    (w : cofork.π s ≫ k = cofork.π t) : cocone_morphism.hom (cofork.mk_hom k w) = k :=
  Eq.refl (cocone_morphism.hom (cofork.mk_hom k w))

/--
To construct an isomorphism between coforks,
it suffices to give an isomorphism between the cocone points
and check that it commutes with the `π` morphisms.
-/
def cofork.ext {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} {s : cofork f g}
    {t : cofork f g} (i : cocone.X s ≅ cocone.X t) (w : cofork.π s ≫ iso.hom i = cofork.π t) :
    s ≅ t :=
  iso.mk (cofork.mk_hom (iso.hom i) w) (cofork.mk_hom (iso.inv i) sorry)

/--
`has_equalizer f g` represents a particular choice of limiting cone
for the parallel pair of morphisms `f` and `g`.
-/
def has_equalizer {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) :=
  has_limit (parallel_pair f g)

/-- If an equalizer of `f` and `g` exists, we can access an arbitrary choice of such by
    saying `equalizer f g`. -/
def equalizer {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_equalizer f g] : C :=
  limit (parallel_pair f g)

/-- If an equalizer of `f` and `g` exists, we can access the inclusion
    `equalizer f g ⟶ X` by saying `equalizer.ι f g`. -/
def equalizer.ι {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_equalizer f g] : equalizer f g ⟶ X :=
  limit.π (parallel_pair f g) walking_parallel_pair.zero

/--
An equalizer cone for a parallel pair `f` and `g`.
-/
def equalizer.fork {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_equalizer f g] : fork f g :=
  limit.cone (parallel_pair f g)

@[simp] theorem equalizer.fork_ι {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_equalizer f g] : fork.ι (equalizer.fork f g) = equalizer.ι f g :=
  rfl

@[simp] theorem equalizer.fork_π_app_zero {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) [has_equalizer f g] :
    nat_trans.app (cone.π (equalizer.fork f g)) walking_parallel_pair.zero = equalizer.ι f g :=
  rfl

theorem equalizer.condition {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_equalizer f g] : equalizer.ι f g ≫ f = equalizer.ι f g ≫ g :=
  fork.condition (limit.cone (parallel_pair f g))

/-- The equalizer built from `equalizer.ι f g` is limiting. -/
def equalizer_is_equalizer {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_equalizer f g] : is_limit (fork.of_ι (equalizer.ι f g) (equalizer.condition f g)) :=
  is_limit.of_iso_limit (limit.is_limit (parallel_pair f g))
    (fork.ext (iso.refl (cone.X (limit.cone (parallel_pair f g)))) sorry)

/-- A morphism `k : W ⟶ X` satisfying `k ≫ f = k ≫ g` factors through the equalizer of `f` and `g`
    via `equalizer.lift : W ⟶ equalizer f g`. -/
def equalizer.lift {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    [has_equalizer f g] {W : C} (k : W ⟶ X) (h : k ≫ f = k ≫ g) : W ⟶ equalizer f g :=
  limit.lift (parallel_pair f g) (fork.of_ι k h)

@[simp] theorem equalizer.lift_ι_assoc {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} [has_equalizer f g] {W : C} (k : W ⟶ X) (h : k ≫ f = k ≫ g) {X' : C} (f' : X ⟶ X') :
    equalizer.lift k h ≫ equalizer.ι f g ≫ f' = k ≫ f' :=
  sorry

/-- A morphism `k : W ⟶ X` satisfying `k ≫ f = k ≫ g` induces a morphism `l : W ⟶ equalizer f g`
    satisfying `l ≫ equalizer.ι f g = k`. -/
def equalizer.lift' {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    [has_equalizer f g] {W : C} (k : W ⟶ X) (h : k ≫ f = k ≫ g) :
    Subtype fun (l : W ⟶ equalizer f g) => l ≫ equalizer.ι f g = k :=
  { val := equalizer.lift k h, property := equalizer.lift_ι k h }

/-- Two maps into an equalizer are equal if they are are equal when composed with the equalizer
    map. -/
theorem equalizer.hom_ext {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    [has_equalizer f g] {W : C} {k : W ⟶ equalizer f g} {l : W ⟶ equalizer f g}
    (h : k ≫ equalizer.ι f g = l ≫ equalizer.ι f g) : k = l :=
  fork.is_limit.hom_ext (limit.is_limit (parallel_pair f g)) h

/-- An equalizer morphism is a monomorphism -/
protected instance equalizer.ι_mono {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} [has_equalizer f g] : mono (equalizer.ι f g) :=
  mono.mk
    fun (Z : C) (h k : Z ⟶ equalizer f g) (w : h ≫ equalizer.ι f g = k ≫ equalizer.ι f g) =>
      equalizer.hom_ext w

/-- The equalizer morphism in any limit cone is a monomorphism. -/
theorem mono_of_is_limit_parallel_pair {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} {c : cone (parallel_pair f g)} (i : is_limit c) : mono (fork.ι c) :=
  sorry

/-- The identity determines a cone on the equalizer diagram of `f` and `g` if `f = g`. -/
def id_fork {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} (h : f = g) :
    fork f g :=
  fork.of_ι 𝟙 sorry

/-- The identity on `X` is an equalizer of `(f, g)`, if `f = g`. -/
def is_limit_id_fork {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} (h : f = g) :
    is_limit (id_fork h) :=
  fork.is_limit.mk (id_fork h) (fun (s : fork f g) => fork.ι s) sorry sorry

/-- Every equalizer of `(f, g)`, where `f = g`, is an isomorphism. -/
def is_iso_limit_cone_parallel_pair_of_eq {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} (h₀ : f = g) {c : cone (parallel_pair f g)} (h : is_limit c) :
    is_iso (nat_trans.app (cone.π c) walking_parallel_pair.zero) :=
  is_iso.of_iso (is_limit.cone_point_unique_up_to_iso h (is_limit_id_fork h₀))

/-- The equalizer of `(f, g)`, where `f = g`, is an isomorphism. -/
def equalizer.ι_of_eq {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    [has_equalizer f g] (h : f = g) : is_iso (equalizer.ι f g) :=
  is_iso_limit_cone_parallel_pair_of_eq h (limit.is_limit (parallel_pair f g))

/-- Every equalizer of `(f, f)` is an isomorphism. -/
def is_iso_limit_cone_parallel_pair_of_self {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {c : cone (parallel_pair f f)} (h : is_limit c) :
    is_iso (nat_trans.app (cone.π c) walking_parallel_pair.zero) :=
  is_iso_limit_cone_parallel_pair_of_eq sorry h

/-- An equalizer that is an epimorphism is an isomorphism. -/
def is_iso_limit_cone_parallel_pair_of_epi {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} {c : cone (parallel_pair f g)} (h : is_limit c)
    [epi (nat_trans.app (cone.π c) walking_parallel_pair.zero)] :
    is_iso (nat_trans.app (cone.π c) walking_parallel_pair.zero) :=
  is_iso_limit_cone_parallel_pair_of_eq sorry h

protected instance has_equalizer_of_self {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) :
    has_equalizer f f :=
  has_limit.mk (limit_cone.mk (id_fork rfl) (is_limit_id_fork rfl))

/-- The equalizer inclusion for `(f, f)` is an isomorphism. -/
protected instance equalizer.ι_of_self {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) :
    is_iso (equalizer.ι f f) :=
  equalizer.ι_of_eq sorry

/-- The equalizer of a morphism with itself is isomorphic to the source. -/
def equalizer.iso_source_of_self {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) :
    equalizer f f ≅ X :=
  as_iso (equalizer.ι f f)

@[simp] theorem equalizer.iso_source_of_self_hom {C : Type u} [category C] {X : C} {Y : C}
    (f : X ⟶ Y) : iso.hom (equalizer.iso_source_of_self f) = equalizer.ι f f :=
  rfl

@[simp] theorem equalizer.iso_source_of_self_inv {C : Type u} [category C] {X : C} {Y : C}
    (f : X ⟶ Y) :
    iso.inv (equalizer.iso_source_of_self f) =
        equalizer.lift 𝟙
          (eq.mpr
            (id
              (Eq.trans
                ((fun (a a_1 : X ⟶ Y) (e_1 : a = a_1) (ᾰ ᾰ_1 : X ⟶ Y) (e_2 : ᾰ = ᾰ_1) =>
                    congr (congr_arg Eq e_1) e_2)
                  (𝟙 ≫ f) f (category.id_comp f) (𝟙 ≫ f) f (category.id_comp f))
                (propext (eq_self_iff_true f))))
            trivial) :=
  rfl

/--
`has_coequalizer f g` represents a particular choice of colimiting cocone
for the parallel pair of morphisms `f` and `g`.
-/
def has_coequalizer {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) :=
  has_colimit (parallel_pair f g)

/-- If a coequalizer of `f` and `g` exists, we can access an arbitrary choice of such by
    saying `coequalizer f g`. -/
def coequalizer {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_coequalizer f g] : C :=
  colimit (parallel_pair f g)

/--  If a coequalizer of `f` and `g` exists, we can access the corresponding projection by
    saying `coequalizer.π f g`. -/
def coequalizer.π {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_coequalizer f g] : Y ⟶ coequalizer f g :=
  colimit.ι (parallel_pair f g) walking_parallel_pair.one

/--
An arbitrary choice of coequalizer cocone for a parallel pair `f` and `g`.
-/
def coequalizer.cofork {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_coequalizer f g] : cofork f g :=
  colimit.cocone (parallel_pair f g)

@[simp] theorem coequalizer.cofork_π {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) [has_coequalizer f g] : cofork.π (coequalizer.cofork f g) = coequalizer.π f g :=
  rfl

@[simp] theorem coequalizer.cofork_ι_app_one {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) [has_coequalizer f g] :
    nat_trans.app (cocone.ι (coequalizer.cofork f g)) walking_parallel_pair.one =
        coequalizer.π f g :=
  rfl

theorem coequalizer.condition_assoc {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) [has_coequalizer f g] {X' : C} (f' : coequalizer f g ⟶ X') :
    f ≫ coequalizer.π f g ≫ f' = g ≫ coequalizer.π f g ≫ f' :=
  sorry

/-- The cofork built from `coequalizer.π f g` is colimiting. -/
def coequalizer_is_coequalizer {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_coequalizer f g] :
    is_colimit (cofork.of_π (coequalizer.π f g) (coequalizer.condition f g)) :=
  is_colimit.of_iso_colimit (colimit.is_colimit (parallel_pair f g))
    (cofork.ext (iso.refl (cocone.X (colimit.cocone (parallel_pair f g)))) sorry)

/-- Any morphism `k : Y ⟶ W` satisfying `f ≫ k = g ≫ k` factors through the coequalizer of `f`
    and `g` via `coequalizer.desc : coequalizer f g ⟶ W`. -/
def coequalizer.desc {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    [has_coequalizer f g] {W : C} (k : Y ⟶ W) (h : f ≫ k = g ≫ k) : coequalizer f g ⟶ W :=
  colimit.desc (parallel_pair f g) (cofork.of_π k h)

@[simp] theorem coequalizer.π_desc_assoc {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} [has_coequalizer f g] {W : C} (k : Y ⟶ W) (h : f ≫ k = g ≫ k) {X' : C}
    (f' : W ⟶ X') : coequalizer.π f g ≫ coequalizer.desc k h ≫ f' = k ≫ f' :=
  sorry

/-- Any morphism `k : Y ⟶ W` satisfying `f ≫ k = g ≫ k` induces a morphism
    `l : coequalizer f g ⟶ W` satisfying `coequalizer.π ≫ g = l`. -/
def coequalizer.desc' {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    [has_coequalizer f g] {W : C} (k : Y ⟶ W) (h : f ≫ k = g ≫ k) :
    Subtype fun (l : coequalizer f g ⟶ W) => coequalizer.π f g ≫ l = k :=
  { val := coequalizer.desc k h, property := coequalizer.π_desc k h }

/-- Two maps from a coequalizer are equal if they are equal when composed with the coequalizer
    map -/
theorem coequalizer.hom_ext {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    [has_coequalizer f g] {W : C} {k : coequalizer f g ⟶ W} {l : coequalizer f g ⟶ W}
    (h : coequalizer.π f g ≫ k = coequalizer.π f g ≫ l) : k = l :=
  cofork.is_colimit.hom_ext (colimit.is_colimit (parallel_pair f g)) h

/-- A coequalizer morphism is an epimorphism -/
protected instance coequalizer.π_epi {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} [has_coequalizer f g] : epi (coequalizer.π f g) :=
  epi.mk
    fun (Z : C) (h k : coequalizer f g ⟶ Z) (w : coequalizer.π f g ≫ h = coequalizer.π f g ≫ k) =>
      coequalizer.hom_ext w

/-- The coequalizer morphism in any colimit cocone is an epimorphism. -/
theorem epi_of_is_colimit_parallel_pair {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} {c : cocone (parallel_pair f g)} (i : is_colimit c) :
    epi (nat_trans.app (cocone.ι c) walking_parallel_pair.one) :=
  sorry

/-- The identity determines a cocone on the coequalizer diagram of `f` and `g`, if `f = g`. -/
def id_cofork {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y} (h : f = g) :
    cofork f g :=
  cofork.of_π 𝟙 sorry

/-- The identity on `Y` is a coequalizer of `(f, g)`, where `f = g`.  -/
def is_colimit_id_cofork {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    (h : f = g) : is_colimit (id_cofork h) :=
  cofork.is_colimit.mk (id_cofork h) (fun (s : cofork f g) => cofork.π s) sorry sorry

/-- Every coequalizer of `(f, g)`, where `f = g`, is an isomorphism. -/
def is_iso_colimit_cocone_parallel_pair_of_eq {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} (h₀ : f = g) {c : cocone (parallel_pair f g)} (h : is_colimit c) :
    is_iso (nat_trans.app (cocone.ι c) walking_parallel_pair.one) :=
  is_iso.of_iso (is_colimit.cocone_point_unique_up_to_iso (is_colimit_id_cofork h₀) h)

/-- The coequalizer of `(f, g)`, where `f = g`, is an isomorphism. -/
def coequalizer.π_of_eq {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y} {g : X ⟶ Y}
    [has_coequalizer f g] (h : f = g) : is_iso (coequalizer.π f g) :=
  is_iso_colimit_cocone_parallel_pair_of_eq h (colimit.is_colimit (parallel_pair f g))

/-- Every coequalizer of `(f, f)` is an isomorphism. -/
def is_iso_colimit_cocone_parallel_pair_of_self {C : Type u} [category C] {X : C} {Y : C}
    {f : X ⟶ Y} {c : cocone (parallel_pair f f)} (h : is_colimit c) :
    is_iso (nat_trans.app (cocone.ι c) walking_parallel_pair.one) :=
  is_iso_colimit_cocone_parallel_pair_of_eq sorry h

/-- A coequalizer that is a monomorphism is an isomorphism. -/
def is_iso_limit_cocone_parallel_pair_of_epi {C : Type u} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    {g : X ⟶ Y} {c : cocone (parallel_pair f g)} (h : is_colimit c)
    [mono (nat_trans.app (cocone.ι c) walking_parallel_pair.one)] :
    is_iso (nat_trans.app (cocone.ι c) walking_parallel_pair.one) :=
  is_iso_colimit_cocone_parallel_pair_of_eq sorry h

protected instance has_coequalizer_of_self {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) :
    has_coequalizer f f :=
  has_colimit.mk (colimit_cocone.mk (id_cofork rfl) (is_colimit_id_cofork rfl))

/-- The coequalizer projection for `(f, f)` is an isomorphism. -/
protected instance coequalizer.π_of_self {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) :
    is_iso (coequalizer.π f f) :=
  coequalizer.π_of_eq sorry

/-- The coequalizer of a morphism with itself is isomorphic to the target. -/
def coequalizer.iso_target_of_self {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) :
    coequalizer f f ≅ Y :=
  iso.symm (as_iso (coequalizer.π f f))

@[simp] theorem coequalizer.iso_target_of_self_hom {C : Type u} [category C] {X : C} {Y : C}
    (f : X ⟶ Y) :
    iso.hom (coequalizer.iso_target_of_self f) =
        coequalizer.desc 𝟙
          (eq.mpr
            (id
              (Eq.trans
                ((fun (a a_1 : X ⟶ Y) (e_1 : a = a_1) (ᾰ ᾰ_1 : X ⟶ Y) (e_2 : ᾰ = ᾰ_1) =>
                    congr (congr_arg Eq e_1) e_2)
                  (f ≫ 𝟙) f (category.comp_id f) (f ≫ 𝟙) f (category.comp_id f))
                (propext (eq_self_iff_true f))))
            trivial) :=
  rfl

@[simp] theorem coequalizer.iso_target_of_self_inv {C : Type u} [category C] {X : C} {Y : C}
    (f : X ⟶ Y) : iso.inv (coequalizer.iso_target_of_self f) = coequalizer.π f f :=
  rfl

/--
The comparison morphism for the equalizer of `f,g`.
This is an isomorphism iff `G` preserves the equalizer of `f,g`; see
`category_theory/limits/preserves/shapes/equalizers.lean`
-/
def equalizer_comparison {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    {D : Type u₂} [category D] (G : C ⥤ D) [has_equalizer f g]
    [has_equalizer (functor.map G f) (functor.map G g)] :
    functor.obj G (equalizer f g) ⟶ equalizer (functor.map G f) (functor.map G g) :=
  equalizer.lift (functor.map G (equalizer.ι f g)) sorry

@[simp] theorem equalizer_comparison_comp_π_assoc {C : Type u} [category C] {X : C} {Y : C}
    (f : X ⟶ Y) (g : X ⟶ Y) {D : Type u₂} [category D] (G : C ⥤ D) [has_equalizer f g]
    [has_equalizer (functor.map G f) (functor.map G g)] {X' : D} (f' : functor.obj G X ⟶ X') :
    equalizer_comparison f g G ≫ equalizer.ι (functor.map G f) (functor.map G g) ≫ f' =
        functor.map G (equalizer.ι f g) ≫ f' :=
  sorry

@[simp] theorem map_lift_equalizer_comparison {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) {D : Type u₂} [category D] (G : C ⥤ D) [has_equalizer f g]
    [has_equalizer (functor.map G f) (functor.map G g)] {Z : C} {h : Z ⟶ X} (w : h ≫ f = h ≫ g) :
    functor.map G (equalizer.lift h w) ≫ equalizer_comparison f g G =
        equalizer.lift (functor.map G h)
          (eq.mpr
            (id
              ((fun (a a_1 : functor.obj G Z ⟶ functor.obj G Y) (e_1 : a = a_1)
                  (ᾰ ᾰ_1 : functor.obj G Z ⟶ functor.obj G Y) (e_2 : ᾰ = ᾰ_1) =>
                  congr (congr_arg Eq e_1) e_2)
                (functor.map G h ≫ functor.map G f) (functor.map G (h ≫ g))
                (Eq.trans (Eq.symm (functor.map_comp G h f))
                  ((fun (c : C ⥤ D) {X Y : C} (ᾰ ᾰ_1 : X ⟶ Y) (e_4 : ᾰ = ᾰ_1) =>
                      congr_arg (functor.map c) e_4)
                    G (h ≫ f) (h ≫ g) w))
                (functor.map G h ≫ functor.map G g) (functor.map G (h ≫ g))
                (Eq.symm (functor.map_comp G h g))))
            (Eq.refl (functor.map G (h ≫ g)))) :=
  sorry

/-- The comparison morphism for the coequalizer of `f,g`. -/
def coequalizer_comparison {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    {D : Type u₂} [category D] (G : C ⥤ D) [has_coequalizer f g]
    [has_coequalizer (functor.map G f) (functor.map G g)] :
    coequalizer (functor.map G f) (functor.map G g) ⟶ functor.obj G (coequalizer f g) :=
  coequalizer.desc (functor.map G (coequalizer.π f g)) sorry

@[simp] theorem ι_comp_coequalizer_comparison {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (g : X ⟶ Y) {D : Type u₂} [category D] (G : C ⥤ D) [has_coequalizer f g]
    [has_coequalizer (functor.map G f) (functor.map G g)] :
    coequalizer.π (functor.map G f) (functor.map G g) ≫ coequalizer_comparison f g G =
        functor.map G (coequalizer.π f g) :=
  coequalizer.π_desc (functor.map G (coequalizer.π f g)) (coequalizer_comparison._proof_1 f g G)

@[simp] theorem coequalizer_comparison_map_desc_assoc {C : Type u} [category C] {X : C} {Y : C}
    (f : X ⟶ Y) (g : X ⟶ Y) {D : Type u₂} [category D] (G : C ⥤ D) [has_coequalizer f g]
    [has_coequalizer (functor.map G f) (functor.map G g)] {Z : C} {h : Y ⟶ Z} (w : f ≫ h = g ≫ h)
    {X' : D} (f' : functor.obj G Z ⟶ X') :
    coequalizer_comparison f g G ≫ functor.map G (coequalizer.desc h w) ≫ f' =
        coequalizer.desc (functor.map G h)
            (eq.mpr
              (id
                ((fun (a a_1 : functor.obj G X ⟶ functor.obj G Z) (e_1 : a = a_1)
                    (ᾰ ᾰ_1 : functor.obj G X ⟶ functor.obj G Z) (e_2 : ᾰ = ᾰ_1) =>
                    congr (congr_arg Eq e_1) e_2)
                  (functor.map G f ≫ functor.map G h) (functor.map G (g ≫ h))
                  (Eq.trans (Eq.symm (functor.map_comp G f h))
                    ((fun (c : C ⥤ D) {X Y : C} (ᾰ ᾰ_1 : X ⟶ Y) (e_4 : ᾰ = ᾰ_1) =>
                        congr_arg (functor.map c) e_4)
                      G (f ≫ h) (g ≫ h) w))
                  (functor.map G g ≫ functor.map G h) (functor.map G (g ≫ h))
                  (Eq.symm (functor.map_comp G g h))))
              (Eq.refl (functor.map G (g ≫ h)))) ≫
          f' :=
  sorry

/-- `has_equalizers` represents a choice of equalizer for every pair of morphisms -/
def has_equalizers (C : Type u) [category C] := has_limits_of_shape walking_parallel_pair C

/-- `has_coequalizers` represents a choice of coequalizer for every pair of morphisms -/
def has_coequalizers (C : Type u) [category C] := has_colimits_of_shape walking_parallel_pair C

/-- If `C` has all limits of diagrams `parallel_pair f g`, then it has all equalizers -/
theorem has_equalizers_of_has_limit_parallel_pair (C : Type u) [category C]
    [∀ {X Y : C} {f g : X ⟶ Y}, has_limit (parallel_pair f g)] : has_equalizers C :=
  has_limits_of_shape.mk
    fun (F : walking_parallel_pair ⥤ C) => has_limit_of_iso (iso.symm (diagram_iso_parallel_pair F))

/-- If `C` has all colimits of diagrams `parallel_pair f g`, then it has all coequalizers -/
theorem has_coequalizers_of_has_colimit_parallel_pair (C : Type u) [category C]
    [∀ {X Y : C} {f g : X ⟶ Y}, has_colimit (parallel_pair f g)] : has_coequalizers C :=
  has_colimits_of_shape.mk
    fun (F : walking_parallel_pair ⥤ C) => has_colimit_of_iso (diagram_iso_parallel_pair F)

-- In this section we show that a split mono `f` equalizes `(retraction f ≫ f)` and `(𝟙 Y)`.

/--
A split mono `f` equalizes `(retraction f ≫ f)` and `(𝟙 Y)`.
Here we build the cone, and show in `split_mono_equalizes` that it is a limit cone.
-/
@[simp] theorem cone_of_split_mono_X {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    [split_mono f] : cone.X (cone_of_split_mono f) = X :=
  Eq.refl (cone.X (cone_of_split_mono f))

/--
A split mono `f` equalizes `(retraction f ≫ f)` and `(𝟙 Y)`.
-/
def split_mono_equalizes {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) [split_mono f] :
    is_limit (cone_of_split_mono f) :=
  fork.is_limit.mk' (cone_of_split_mono f)
    fun (s : fork 𝟙 (retraction f ≫ f)) => { val := fork.ι s ≫ retraction f, property := sorry }

-- In this section we show that a split epi `f` coequalizes `(f ≫ section_ f)` and `(𝟙 X)`.

/--
A split epi `f` coequalizes `(f ≫ section_ f)` and `(𝟙 X)`.
Here we build the cocone, and show in `split_epi_coequalizes` that it is a colimit cocone.
-/
def cocone_of_split_epi {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) [split_epi f] :
    cocone (parallel_pair 𝟙 (f ≫ section_ f)) :=
  cofork.of_π f sorry

/--
A split epi `f` coequalizes `(f ≫ section_ f)` and `(𝟙 X)`.
-/
def split_epi_coequalizes {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) [split_epi f] :
    is_colimit (cocone_of_split_epi f) :=
  cofork.is_colimit.mk' (cocone_of_split_epi f)
    fun (s : cofork 𝟙 (f ≫ section_ f)) => { val := section_ f ≫ cofork.π s, property := sorry }

end Mathlib


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Floris van Doorn
-/
import order.hom.complete_lattice
import topology.bases
import topology.homeomorph
import topology.continuous_function.basic

/-!
# Open sets

## Summary

We define the subtype of open sets in a topological space.

## Main Definitions

- `opens α` is the type of open subsets of a topological space `α`.
- `open_nhds_of x` is the type of open subsets of a topological space `α` containing `x : α`.
-/

open filter function order set

variables {α β γ : Type*} [topological_space α] [topological_space β] [topological_space γ]

namespace topological_space
variable (α)
/-- The type of open subsets of a topological space. -/
def opens := {s : set α // is_open s}

variable {α}
namespace opens
instance : has_coe (opens α) (set α) := { coe := subtype.val }

lemma val_eq_coe (U : opens α) : U.1 = ↑U := rfl

/-- the coercion `opens α → set α` applied to a pair is the same as taking the first component -/
lemma coe_mk {α : Type*} [topological_space α] {U : set α} {hU : is_open U} :
  ↑(⟨U, hU⟩ : opens α) = U := rfl

instance : has_subset (opens α) :=
{ subset := λ U V, (U : set α) ⊆ V }

instance : has_mem α (opens α) :=
{ mem := λ a U, a ∈ (U : set α) }

@[simp] lemma subset_coe {U V : opens α} : ((U : set α) ⊆ (V : set α)) = (U ⊆ V) := rfl

@[simp] lemma mem_coe {x : α} {U : opens α} : (x ∈ (U : set α)) = (x ∈ U) := rfl

@[ext] lemma ext {U V : opens α} (h : (U : set α) = V) : U = V := subtype.ext h
@[ext] lemma ext_iff {U V : opens α} : (U : set α) = V ↔ U = V := subtype.ext_iff.symm

instance : partial_order (opens α) := subtype.partial_order _

/-- The interior of a set, as an element of `opens`. -/
def interior (s : set α) : opens α := ⟨interior s, is_open_interior⟩

lemma gc : galois_connection (coe : opens α → set α) interior :=
λ U s, ⟨λ h, interior_maximal h U.property, λ h, le_trans h interior_subset⟩

open order_dual (of_dual to_dual)

/-- The galois coinsertion between sets and opens. -/
def gi : galois_coinsertion subtype.val (@interior α _) :=
{ choice := λ s hs, ⟨s, interior_eq_iff_open.mp $ le_antisymm interior_subset hs⟩,
  gc := gc,
  u_l_le := λ _, interior_subset,
  choice_eq := λ s hs, le_antisymm hs interior_subset }

instance : complete_lattice (opens α) :=
complete_lattice.copy (galois_coinsertion.lift_complete_lattice gi)
/- le  -/ (λ U V, U ⊆ V) rfl
/- top -/ ⟨univ, is_open_univ⟩ (ext interior_univ.symm)
/- bot -/ ⟨∅, is_open_empty⟩ rfl
/- sup -/ (λ U V, ⟨↑U ∪ ↑V, U.2.union V.2⟩) rfl
/- inf -/ (λ U V, ⟨↑U ∩ ↑V, U.2.inter V.2⟩)
  (funext $ λ U, funext $ λ V, ext (U.2.inter V.2).interior_eq.symm)
/- Sup -/ _ rfl
/- Inf -/ _ rfl

lemma le_def {U V : opens α} : U ≤ V ↔ (U : set α) ≤ (V : set α) := iff.rfl

@[simp] lemma mk_inf_mk {U V : set α} {hU : is_open U} {hV : is_open V} :
  (⟨U, hU⟩ ⊓ ⟨V, hV⟩ : opens α) = ⟨U ⊓ V, is_open.inter hU hV⟩ := rfl
@[simp, norm_cast] lemma coe_inf {U V : opens α} : ((U ⊓ V : opens α) : set α) = U ∩ V := rfl
@[simp] lemma coe_bot : ((⊥ : opens α) : set α) = ∅ := rfl
@[simp] lemma coe_top : ((⊤ : opens α) : set α) = set.univ := rfl
@[simp] lemma coe_Sup {S : set (opens α)} : (↑(Sup S) : set α) = ⋃ i ∈ S, ↑i := (@gc α _).l_Sup

instance : has_inter (opens α) := ⟨λ U V, U ⊓ V⟩
instance : has_union (opens α) := ⟨λ U V, U ⊔ V⟩
instance : has_emptyc (opens α) := ⟨⊥⟩
instance : inhabited (opens α) := ⟨∅⟩

@[simp] lemma inter_eq (U V : opens α) : U ∩ V = U ⊓ V := rfl
@[simp] lemma union_eq (U V : opens α) : U ∪ V = U ⊔ V := rfl
@[simp] lemma empty_eq : (∅ : opens α) = ⊥ := rfl

lemma supr_def {ι} (s : ι → opens α) : (⨆ i, s i) = ⟨⋃ i, s i, is_open_Union $ λ i, (s i).2⟩ :=
by { ext, simp only [supr, coe_Sup, bUnion_range], refl }

@[simp] lemma supr_mk {ι} (s : ι → set α) (h : Π i, is_open (s i)) :
  (⨆ i, ⟨s i, h i⟩ : opens α) = ⟨⋃ i, s i, is_open_Union h⟩ :=
by { rw supr_def, simp }

@[simp] lemma supr_s {ι} (s : ι → opens α) : ((⨆ i, s i : opens α) : set α) = ⋃ i, s i :=
by simp [supr_def]

@[simp] theorem mem_supr {ι} {x : α} {s : ι → opens α} : x ∈ supr s ↔ ∃ i, x ∈ s i :=
by { rw [←mem_coe], simp, }

@[simp] lemma mem_Sup {Us : set (opens α)} {x : α} : x ∈ Sup Us ↔ ∃ u ∈ Us, x ∈ u :=
by simp_rw [Sup_eq_supr, mem_supr]

instance : frame (opens α) :=
{ Sup := Sup,
  inf_Sup_le_supr_inf := λ a s,
    (ext $ by simp only [coe_inf, supr_s, coe_Sup, set.inter_Union₂]).le,
  ..opens.complete_lattice }

lemma open_embedding_of_le {U V : opens α} (i : U ≤ V) :
  open_embedding (set.inclusion i) :=
{ inj := set.inclusion_injective i,
  induced := (@induced_compose _ _ _ _ (set.inclusion i) coe).symm,
  open_range :=
  begin
    rw set.range_inclusion i,
    exact U.property.preimage continuous_subtype_val
  end, }

lemma not_nonempty_iff_eq_bot (U : opens α) : ¬ set.nonempty (U : set α) ↔ U = ⊥ :=
by rw [← subtype.coe_injective.eq_iff, opens.coe_bot, ← set.not_nonempty_iff_eq_empty]

lemma ne_bot_iff_nonempty (U : opens α) : U ≠ ⊥ ↔ set.nonempty (U : set α) :=
by rw [ne.def, ← opens.not_nonempty_iff_eq_bot, not_not]

/-- A set of `opens α` is a basis if the set of corresponding sets is a topological basis. -/
def is_basis (B : set (opens α)) : Prop := is_topological_basis ((coe : _ → set α) '' B)

lemma is_basis_iff_nbhd {B : set (opens α)} :
  is_basis B ↔ ∀ {U : opens α} {x}, x ∈ U → ∃ U' ∈ B, x ∈ U' ∧ U' ⊆ U :=
begin
  split; intro h,
  { rintros ⟨sU, hU⟩ x hx,
    rcases h.mem_nhds_iff.mp (is_open.mem_nhds hU hx)
      with ⟨sV, ⟨⟨V, H₁, H₂⟩, hsV⟩⟩,
    refine ⟨V, H₁, _⟩,
    cases V, dsimp at H₂, subst H₂, exact hsV },
  { refine is_topological_basis_of_open_of_nhds _ _,
    { rintros sU ⟨U, ⟨H₁, H₂⟩⟩, subst H₂, exact U.property },
    { intros x sU hx hsU,
      rcases @h (⟨sU, hsU⟩ : opens α) x hx with ⟨V, hV, H⟩,
      exact ⟨V, ⟨V, hV, rfl⟩, H⟩ } }
end

lemma is_basis_iff_cover {B : set (opens α)} :
  is_basis B ↔ ∀ U : opens α, ∃ Us ⊆ B, U = Sup Us :=
begin
  split,
  { intros hB U,
    refine ⟨{V : opens α | V ∈ B ∧ V ⊆ U}, λ U hU, hU.left, _⟩,
    apply ext,
    rw [coe_Sup, hB.open_eq_sUnion' U.prop],
    simp_rw [sUnion_eq_bUnion, Union, supr_and, supr_image],
    refl },
  { intro h,
    rw is_basis_iff_nbhd,
    intros U x hx,
    rcases h U with ⟨Us, hUs, rfl⟩,
    rcases mem_Sup.1 hx with ⟨U, Us, xU⟩,
    exact ⟨U, hUs Us, xU, le_Sup Us⟩ }
end

/-- The preimage of an open set, as an open set. -/
def comap (f : C(α, β)) : frame_hom (opens β) (opens α) :=
{ to_fun := λ s, ⟨f ⁻¹' s, s.2.preimage f.continuous⟩,
  map_Sup' := λ s, ext $ by simp only [coe_Sup, preimage_Union, coe_mk, mem_image, Union_exists,
    bUnion_and', Union_Union_eq_right],
  map_inf' := λ a b, rfl,
  map_top' := rfl }

@[simp] lemma comap_id : comap (continuous_map.id α) = frame_hom.id _ :=
frame_hom.ext $ λ a, ext rfl

lemma comap_mono (f : C(α, β)) {s t : opens β} (h : s ≤ t) : comap f s ≤ comap f t :=
order_hom_class.mono (comap f) h

@[simp] lemma coe_comap (f : C(α, β)) (U : opens β) : ↑(comap f U) = f ⁻¹' U := rfl

@[simp] lemma comap_val (f : C(α, β)) (U : opens β) : (comap f U).1 = f ⁻¹' U := rfl

protected lemma comap_comp (g : C(β, γ)) (f : C(α, β)) :
  comap (g.comp f) = (comap f).comp (comap g) := rfl

protected lemma comap_comap (g : C(β, γ)) (f : C(α, β)) (U : opens γ) :
  comap f (comap g U) = comap (g.comp f) U := rfl

lemma comap_injective [t0_space β] : injective (comap : C(α, β) → frame_hom (opens β) (opens α)) :=
λ f g h, continuous_map.ext $ λ a, indistinguishable.eq $ λ s hs, begin
  simp_rw ←mem_preimage,
  congr' 2,
  have := fun_like.congr_fun h ⟨_, hs⟩,
  exact congr_arg (coe : opens α → set α) this,
end

/-- A homeomorphism induces an equivalence on open sets, by taking comaps. -/
@[simp] protected def equiv (f : α ≃ₜ β) : opens α ≃ opens β :=
{ to_fun := opens.comap f.symm.to_continuous_map,
  inv_fun := opens.comap f.to_continuous_map,
  left_inv := by { intro U, ext1, exact f.to_equiv.preimage_symm_preimage _ },
  right_inv := by { intro U, ext1, exact f.to_equiv.symm_preimage_preimage _ } }

/-- A homeomorphism induces an order isomorphism on open sets, by taking comaps. -/
@[simp] protected def order_iso (f : α ≃ₜ β) : opens α ≃o opens β :=
{ to_equiv := opens.equiv f,
  map_rel_iff' := λ U V, f.symm.surjective.preimage_subset_preimage_iff }

end opens

/-- The open neighborhoods of a point. See also `opens` or `nhds`. -/
def open_nhds_of (x : α) : Type* := { s : set α // is_open s ∧ x ∈ s }

instance open_nhds_of.inhabited {α : Type*} [topological_space α] (x : α) :
  inhabited (open_nhds_of x) := ⟨⟨set.univ, is_open_univ, set.mem_univ _⟩⟩

end topological_space