/-
Copyright (c) 2014 Robert Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Lewis

Structures with multiplicative and additive components, including division rings and fields.
The development is modeled after Isabelle's library.
-/
import logic.eq logic.connectives data.unit data.sigma data.prod
import algebra.binary algebra.group algebra.ring
open eq eq.ops

variable {A : Type}

structure division_ring [class] (A : Type) extends ring A, has_inv A, zero_ne_one_class A :=
  (mul_inv_cancel : ∀{a}, a ≠ zero → mul a (inv a) = one)
  (inv_mul_cancel : ∀{a}, a ≠ zero → mul (inv a) a = one)

section division_ring
  variables [s : division_ring A] {a b c : A}
  include s

  protected definition algebra.div (a b : A) : A := a * b⁻¹

  definition division_ring_has_div [instance] : has_div A :=
  has_div.mk algebra.div

  lemma division.def [simp] (a b : A) : a / b = a * b⁻¹ :=
  rfl

  theorem mul_inv_cancel [simp] (H : a ≠ 0) : a * a⁻¹ = 1 :=
  division_ring.mul_inv_cancel H

  theorem inv_mul_cancel [simp] (H : a ≠ 0) : a⁻¹ * a = 1 :=
  division_ring.inv_mul_cancel H

  theorem inv_eq_one_div (a : A) : a⁻¹ = 1 / a := !one_mul⁻¹

  theorem div_eq_mul_one_div (a b : A) : a / b = a * (1 / b) :=
  by simp

  theorem mul_one_div_cancel [simp] (H : a ≠ 0) : a * (1 / a) = 1 :=
  by simp

  theorem one_div_mul_cancel [simp] (H : a ≠ 0) : (1 / a) * a = 1 :=
  by simp

  theorem div_self [simp] (H : a ≠ 0) : a / a = 1 :=
  by simp

  theorem one_div_one [simp] : 1 / 1 = (1:A) :=
  div_self (ne.symm zero_ne_one)

  theorem mul_div_assoc (a b : A) : (a * b) / c = a * (b / c) :=
  by simp

  theorem one_div_ne_zero (H : a ≠ 0) : 1 / a ≠ 0 :=
    assume H2 : 1 / a = 0,
    have C1 : 0 = (1:A), from symm (by rewrite [-(mul_one_div_cancel H), H2, mul_zero]),
    absurd C1 zero_ne_one

  theorem one_inv_eq [simp] : 1⁻¹ = (1:A) :=
  by rewrite [-mul_one ((1:A)⁻¹), inv_mul_cancel (ne.symm (@zero_ne_one A _))]

  theorem div_one [simp] (a : A) : a / 1 = a :=
  by simp

  theorem zero_div [simp] (a : A) : 0 / a = 0 :=
  by simp

  -- note: integral domain has a "mul_ne_zero". A commutative division ring is an integral
  -- domain, but let's not define that class for now.
  theorem division_ring.mul_ne_zero (Ha : a ≠ 0) (Hb : b ≠ 0) : a * b ≠ 0 :=
  assume H : a * b = 0,
  have C1 : a = 0, by rewrite [-mul_one a, -(mul_one_div_cancel Hb), -mul.assoc, H, zero_mul],
  absurd C1 Ha

  theorem mul_ne_zero_comm (H : a * b ≠ 0) : b * a ≠ 0 :=
  have H2 : a ≠ 0 ∧ b ≠ 0, from ne_zero_and_ne_zero_of_mul_ne_zero H,
  division_ring.mul_ne_zero (and.right H2) (and.left H2)

  theorem eq_one_div_of_mul_eq_one (H : a * b = 1) : b = 1 / a :=
  have a ≠ 0, from
    suppose a = 0,
    have 0 = (1:A), by inst_simp,
      absurd this zero_ne_one,
  have b = (1 / a) * a * b, by inst_simp,
  show b = 1 / a, by inst_simp

  theorem eq_one_div_of_mul_eq_one_left (H : b * a = 1) : b = 1 / a :=
  have a ≠ 0, from
    suppose a = 0,
    have 0 = (1:A), by inst_simp,
      absurd this zero_ne_one,
  by inst_simp

  theorem division_ring.one_div_mul_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) :
      (1 / a) * (1 / b) = 1 / (b * a) :=
  have (b * a) * ((1 / a) * (1 / b)) = 1, by inst_simp,
  eq_one_div_of_mul_eq_one this

  theorem one_div_neg_one_eq_neg_one : (1:A) / (-1) = -1 :=
  have (-1) * (-1) = (1:A), by inst_simp,
  symm (eq_one_div_of_mul_eq_one this)

  theorem division_ring.one_div_neg_eq_neg_one_div (H : a ≠ 0) : 1 / (- a) = - (1 / a) :=
  have -1 ≠ 0, from
   (suppose -1 = 0, absurd (symm (calc
          1 = -(-1) : neg_neg
        ... = -0    : this
        ... = (0:A) : neg_zero)) zero_ne_one),
    calc
      1 / (- a) = 1 / ((-1) * a)        : neg_eq_neg_one_mul
            ... = (1 / a) * (1 / (- 1)) : division_ring.one_div_mul_one_div H this
            ... = (1 / a) * (-1)        : one_div_neg_one_eq_neg_one
            ... = - (1 / a)             : mul_neg_one_eq_neg

  theorem div_neg_eq_neg_div (b : A) (Ha : a ≠ 0) : b / (- a) = - (b / a) :=
    calc
      b / (- a) = b * (1 / (- a)) : by rewrite -inv_eq_one_div
            ... = b * -(1 / a)    : division_ring.one_div_neg_eq_neg_one_div Ha
            ... = -(b * (1 / a))  : neg_mul_eq_mul_neg
            ... = - (b * a⁻¹)     : inv_eq_one_div

  theorem neg_div (a b : A) : (-b) / a = - (b / a) :=
    by rewrite [neg_eq_neg_one_mul, mul_div_assoc, -neg_eq_neg_one_mul]

  theorem division_ring.neg_div_neg_eq (a : A) {b : A} (Hb : b ≠ 0) : (-a) / (-b) = a / b :=
    by rewrite [(div_neg_eq_neg_div _ Hb), neg_div, neg_neg]

  theorem division_ring.one_div_one_div (H : a ≠ 0) : 1 / (1 / a) = a :=
    symm (eq_one_div_of_mul_eq_one_left (mul_one_div_cancel H))

  theorem division_ring.eq_of_one_div_eq_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) (H : 1 / a = 1 / b) :
      a = b :=
    by rewrite [-(division_ring.one_div_one_div Ha), H, (division_ring.one_div_one_div Hb)]

  theorem mul_inv_eq [simp] (Ha : a ≠ 0) (Hb : b ≠ 0) : (b * a)⁻¹ = a⁻¹ * b⁻¹ :=
    eq.symm (calc
      a⁻¹ * b⁻¹ = (1 / a) * (1 / b) : by inst_simp
      ... = (1 / (b * a))           : division_ring.one_div_mul_one_div Ha Hb
      ... = (b * a)⁻¹               : by simp)

  theorem mul_div_cancel (a : A) {b : A} (Hb : b ≠ 0) : a * b / b = a :=
  by simp

  theorem div_mul_cancel (a : A) {b : A} (Hb : b ≠ 0) : a / b * b = a :=
  by simp

  theorem div_add_div_same (a b c : A) : a / c + b / c = (a + b) / c := !right_distrib⁻¹

  theorem div_sub_div_same (a b c : A) : (a / c) - (b / c) = (a - b) / c :=
  by rewrite [sub_eq_add_neg, -neg_div, div_add_div_same]

  theorem one_div_mul_add_mul_one_div_eq_one_div_add_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) :
          (1 / a) * (a + b) * (1 / b) = 1 / a + 1 / b :=
    by rewrite [(left_distrib (1 / a)), (one_div_mul_cancel Ha), right_distrib, one_mul,
      mul.assoc, (mul_one_div_cancel Hb), mul_one, add.comm]

  theorem one_div_mul_sub_mul_one_div_eq_one_div_add_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) :
          (1 / a) * (b - a) * (1 / b) = 1 / a - 1 / b :=
    by rewrite [(mul_sub_left_distrib (1 / a)), (one_div_mul_cancel Ha), mul_sub_right_distrib,
      one_mul, mul.assoc, (mul_one_div_cancel Hb), mul_one]

  theorem div_eq_one_iff_eq (a : A) {b : A} (Hb : b ≠ 0) : a / b = 1 ↔ a = b :=
    iff.intro
    (suppose a / b = 1, calc
      a   = a / b * b : by inst_simp
      ... = 1 * b     : this
      ... = b         : by simp)
    (suppose a = b, by simp)

  theorem eq_of_div_eq_one (a : A) {b : A} (Hb : b ≠ 0) : a / b = 1 → a = b :=
    iff.mp (!div_eq_one_iff_eq Hb)

  theorem eq_div_iff_mul_eq (a : A) {b : A} (Hc : c ≠ 0) : a = b / c ↔ a * c = b :=
    iff.intro
      (suppose a = b / c, by rewrite [this, (!div_mul_cancel Hc)])
      (suppose a * c = b, by rewrite [-(mul_div_cancel a Hc), this])

  theorem eq_div_of_mul_eq (a b : A) {c : A} (Hc : c ≠ 0) : a * c = b → a = b / c :=
    iff.mpr (!eq_div_iff_mul_eq Hc)

  theorem mul_eq_of_eq_div (a b: A) {c : A} (Hc : c ≠ 0) : a = b / c → a * c = b :=
    iff.mp (!eq_div_iff_mul_eq Hc)

  theorem add_div_eq_mul_add_div (a b : A) {c : A} (Hc : c ≠ 0) : a + b / c = (a * c + b) / c :=
    have (a + b / c) * c = a * c + b, by rewrite [right_distrib, (!div_mul_cancel Hc)],
    (iff.elim_right (!eq_div_iff_mul_eq Hc)) this

  theorem mul_mul_div (a : A) {c : A} (Hc : c ≠ 0) : a = a * c * (1 / c) :=
  by simp

  -- There are many similar rules to these last two in the Isabelle library
  -- that haven't been ported yet. Do as necessary.
end division_ring

structure field [class] (A : Type) extends division_ring A, comm_ring A

section field
  variables [s : field A] {a b c d: A}
  include s

  theorem field.one_div_mul_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) : (1 / a) * (1 / b) =  1 / (a * b) :=
     by rewrite [(division_ring.one_div_mul_one_div Ha Hb), mul.comm b]

  theorem field.div_mul_right (Hb : b ≠ 0) (H : a * b ≠ 0) : a / (a * b) = 1 / b :=
  have a ≠ 0, from and.left (ne_zero_and_ne_zero_of_mul_ne_zero H),
    symm (calc
      1 / b = a * ((1 / a) * (1 / b)) : by inst_simp
        ... = a * (1 / (b * a))       : division_ring.one_div_mul_one_div this Hb
        ... = a * (a * b)⁻¹           : by inst_simp)

  theorem field.div_mul_left (Ha : a ≠ 0) (H : a * b ≠ 0) : b / (a * b) = 1 / a :=
    let H1 : b * a ≠ 0 := mul_ne_zero_comm H in
    by rewrite [mul.comm a, (field.div_mul_right Ha H1)]

  theorem mul_div_cancel_left (Ha : a ≠ 0) : a * b / a = b :=
    by rewrite [mul.comm a, (!mul_div_cancel Ha)]

  theorem mul_div_cancel' (Hb : b ≠ 0) : b * (a / b) = a :=
    by rewrite [mul.comm, (!div_mul_cancel Hb)]

  theorem one_div_add_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) : 1 / a + 1 / b = (a + b) / (a * b) :=
    have a * b ≠ 0, from (division_ring.mul_ne_zero Ha Hb),
    by rewrite [add.comm, -(field.div_mul_left Ha this), -(field.div_mul_right Hb this), *division.def,
                -right_distrib]

  theorem field.div_mul_div (a : A) {b : A} (c : A) {d : A} (Hb : b ≠ 0) (Hd : d ≠ 0) :
      (a / b) * (c / d) = (a * c) / (b * d) :=
  by inst_simp

  theorem mul_div_mul_left (a : A) {b c : A} (Hb : b ≠ 0) (Hc : c ≠ 0) :
      (c * a) / (c * b) = a / b :=
    by rewrite [-(!field.div_mul_div Hc Hb), (div_self Hc), one_mul]

  theorem mul_div_mul_right (a : A) {b c : A} (Hb : b ≠ 0) (Hc : c ≠ 0) :
      (a * c) / (b * c) = a / b :=
    by rewrite [(mul.comm a), (mul.comm b), (!mul_div_mul_left Hb Hc)]

  theorem div_mul_eq_mul_div (a b c : A) : (b / c) * a = (b * a) / c :=
    by rewrite [*division.def, mul.assoc, (mul.comm c⁻¹), -mul.assoc]

  theorem field.div_mul_eq_mul_div_comm (a b : A) {c : A} (Hc : c ≠ 0) :
      (b / c) * a = b * (a / c) :=
    by rewrite [(div_mul_eq_mul_div), -(one_mul c), -(!field.div_mul_div (ne.symm zero_ne_one) Hc),
                div_one, one_mul]

  theorem div_add_div (a : A) {b : A} (c : A) {d : A} (Hb : b ≠ 0) (Hd : d ≠ 0) :
      (a / b) + (c / d) = ((a * d) + (b * c)) / (b * d) :=
    by rewrite [-(!mul_div_mul_right Hb Hd), -(!mul_div_mul_left Hd Hb), div_add_div_same]

  theorem div_sub_div (a : A) {b : A} (c : A) {d : A} (Hb : b ≠ 0) (Hd : d ≠ 0) :
      (a / b) - (c / d) = ((a * d) - (b * c)) / (b * d) :=
      by rewrite [*sub_eq_add_neg, neg_eq_neg_one_mul, -mul_div_assoc, (!div_add_div Hb Hd),
         -mul.assoc, (mul.comm b), mul.assoc, -neg_eq_neg_one_mul]

  theorem mul_eq_mul_of_div_eq_div (a : A) {b : A} (c : A) {d : A} (Hb : b ≠ 0)
      (Hd : d ≠ 0) (H : a / b = c / d) : a * d = c * b :=
    by rewrite [-mul_one (a*d), mul.assoc, (mul.comm d), -mul.assoc, -(div_self Hb),
         -(!field.div_mul_eq_mul_div_comm Hb), H, (div_mul_eq_mul_div), (!div_mul_cancel Hd)]

  theorem field.one_div_div (Ha : a ≠ 0) (Hb : b ≠ 0) : 1 / (a / b) = b / a :=
    have (a / b) * (b / a) = 1, from calc
      (a / b) * (b / a) = (a * b) / (b * a) : !field.div_mul_div Hb Ha
      ... = (a * b) / (a * b) : mul.comm
      ... = 1 : div_self (division_ring.mul_ne_zero Ha Hb),
    symm (eq_one_div_of_mul_eq_one this)

  theorem field.div_div_eq_mul_div (a : A) {b c : A} (Hb : b ≠ 0) (Hc : c ≠ 0) :
      a / (b / c) = (a * c) / b :=
    by rewrite [div_eq_mul_one_div, (field.one_div_div Hb Hc), -mul_div_assoc]

  theorem field.div_div_eq_div_mul (a : A) {b c : A} (Hb : b ≠ 0) (Hc : c ≠ 0) :
      (a / b) / c = a / (b * c) :=
    by rewrite [div_eq_mul_one_div, (!field.div_mul_div Hb Hc), mul_one]

  theorem field.div_div_div_div_eq (a : A) {b c d : A} (Hb : b ≠ 0) (Hc : c ≠ 0) (Hd : d ≠ 0) :
       (a / b) / (c / d) = (a * d) / (b * c) :=
    by rewrite [(!field.div_div_eq_mul_div Hc Hd), (div_mul_eq_mul_div),
                (!field.div_div_eq_div_mul Hb Hc)]

  theorem field.div_mul_eq_div_mul_one_div (a : A) {b c : A} (Hb : b ≠ 0) (Hc : c ≠ 0) :
      a / (b * c) = (a / b) * (1 / c) :=
    by rewrite [-!field.div_div_eq_div_mul Hb Hc, -div_eq_mul_one_div]

  theorem eq_of_mul_eq_mul_of_nonzero_left {a b c : A} (H : a ≠ 0) (H2 : a * b = a * c) : b = c :=
    by rewrite [-one_mul b, -div_self H, div_mul_eq_mul_div, H2, mul_div_cancel_left H]

  theorem eq_of_mul_eq_mul_of_nonzero_right {a b c : A} (H : c ≠ 0) (H2 : a * c = b * c) : a = b :=
    by rewrite [-mul_one a, -div_self H, -mul_div_assoc, H2, mul_div_cancel _ H]

end field

structure discrete_field [class] (A : Type) extends field A :=
  (has_decidable_eq : decidable_eq A)
  (inv_zero : inv zero = zero)

attribute discrete_field.has_decidable_eq [instance]

section discrete_field
  variable [s : discrete_field A]
  include s
  variables {a b c d : A}

  -- many of the theorems in discrete_field are the same as theorems in field or division ring,
  -- but with fewer hypotheses since 0⁻¹ = 0 and equality is decidable.

  theorem discrete_field.eq_zero_or_eq_zero_of_mul_eq_zero
    (x y : A) (H : x * y = 0) : x = 0 ∨ y = 0 :=
  decidable.by_cases
    (suppose x = 0, or.inl this)
    (suppose x ≠ 0,
      or.inr (by rewrite [-one_mul y, -(inv_mul_cancel this), mul.assoc, H, mul_zero]))

  definition discrete_field.to_integral_domain [trans_instance] :
    integral_domain A :=
  ⦃ integral_domain, s,
    eq_zero_or_eq_zero_of_mul_eq_zero := discrete_field.eq_zero_or_eq_zero_of_mul_eq_zero⦄

  theorem inv_zero : 0⁻¹ = (0:A) := !discrete_field.inv_zero

  theorem one_div_zero : 1 / 0 = (0:A) :=
    calc
      1 / 0 = 1 * 0⁻¹ : refl
        ... = 1 * 0   : inv_zero
        ... = 0 : mul_zero

  theorem div_zero (a : A) : a / 0 = 0 := by rewrite [div_eq_mul_one_div, one_div_zero, mul_zero]

  theorem ne_zero_of_one_div_ne_zero (H : 1 / a ≠ 0) : a ≠ 0 :=
    assume Ha : a = 0, absurd (Ha⁻¹ ▸ one_div_zero) H

  theorem eq_zero_of_one_div_eq_zero (H : 1 / a = 0) : a = 0 :=
    decidable.by_cases
      (assume Ha, Ha)
      (assume Ha, false.elim ((one_div_ne_zero Ha) H))

  variables (a b)
  theorem one_div_mul_one_div' : (1 / a) * (1 / b) = 1 / (b * a) :=
    decidable.by_cases
      (suppose a = 0,
        by rewrite [this, div_zero, zero_mul, -(@div_zero A s 1), mul_zero b])
      (assume Ha : a ≠ 0,
        decidable.by_cases
          (suppose b = 0,
            by rewrite [this, div_zero, mul_zero, -(@div_zero A s 1), zero_mul a])
          (suppose b ≠ 0, division_ring.one_div_mul_one_div Ha this))

  theorem one_div_neg_eq_neg_one_div : 1 / (- a) = - (1 / a) :=
    decidable.by_cases
      (suppose a = 0, by rewrite [this, neg_zero, 2 div_zero, neg_zero])
      (suppose a ≠ 0, division_ring.one_div_neg_eq_neg_one_div this)

  theorem neg_div_neg_eq : (-a) / (-b) = a / b :=
    decidable.by_cases
      (assume Hb : b = 0, by rewrite [Hb, neg_zero, 2 div_zero])
      (assume Hb : b ≠ 0, !division_ring.neg_div_neg_eq Hb)

  theorem one_div_one_div : 1 / (1 / a) = a :=
    decidable.by_cases
      (assume Ha : a = 0, by rewrite [Ha, 2 div_zero])
      (assume Ha : a ≠ 0, division_ring.one_div_one_div Ha)

  variables {a b}
  theorem eq_of_one_div_eq_one_div (H : 1 / a = 1 / b) : a = b :=
    decidable.by_cases
      (assume Ha : a = 0,
      have Hb : b = 0, from eq_zero_of_one_div_eq_zero (by rewrite [-H, Ha, div_zero]),
      Hb⁻¹ ▸ Ha)
      (assume Ha : a ≠ 0,
      have Hb : b ≠ 0, from ne_zero_of_one_div_ne_zero (H ▸ (one_div_ne_zero Ha)),
      division_ring.eq_of_one_div_eq_one_div Ha Hb H)

  variables (a b)
  theorem mul_inv' : (b * a)⁻¹ = a⁻¹ * b⁻¹ :=
    decidable.by_cases
      (assume Ha : a = 0, by rewrite [Ha, mul_zero, 2 inv_zero, zero_mul])
      (assume Ha : a ≠ 0,
        decidable.by_cases
          (assume Hb : b = 0, by rewrite [Hb, zero_mul, 2 inv_zero, mul_zero])
          (assume Hb : b ≠ 0, mul_inv_eq Ha Hb))

-- the following are specifically for fields
  theorem one_div_mul_one_div : (1 / a) * (1 / b) =  1 / (a * b) :=
     by rewrite [one_div_mul_one_div', mul.comm b]

  variable {a}
  theorem div_mul_right (Ha : a ≠ 0) : a / (a * b) = 1 / b :=
    decidable.by_cases
      (assume Hb : b = 0, by rewrite [Hb, mul_zero, 2 div_zero])
      (assume Hb : b ≠ 0, field.div_mul_right Hb (mul_ne_zero Ha Hb))

  variables (a) {b}
  theorem div_mul_left (Hb : b ≠ 0) : b / (a * b) = 1 / a :=
    by rewrite [mul.comm a, div_mul_right _ Hb]

  variables (a b c)
  theorem div_mul_div : (a / b) * (c / d) = (a * c) / (b * d) :=
    decidable.by_cases
      (assume Hb : b = 0, by rewrite [Hb, div_zero, zero_mul, -(@div_zero A s (a * c)), zero_mul])
      (assume Hb : b ≠ 0,
        decidable.by_cases
          (assume Hd : d = 0, by rewrite [Hd, div_zero, mul_zero, -(@div_zero A s (a * c)),
                                          mul_zero])
          (assume Hd : d ≠ 0, !field.div_mul_div Hb Hd))

  variable {c}
  theorem mul_div_mul_left' (Hc : c ≠ 0) : (c * a) / (c * b) = a / b :=
    decidable.by_cases
      (assume Hb : b = 0, by rewrite [Hb, mul_zero, 2 div_zero])
      (assume Hb : b ≠ 0, !mul_div_mul_left Hb Hc)

  theorem mul_div_mul_right' (Hc : c ≠ 0) : (a * c) / (b * c) = a / b :=
    by rewrite [(mul.comm a), (mul.comm b), (!mul_div_mul_left' Hc)]

  variables (a b c d)
  theorem div_mul_eq_mul_div_comm : (b / c) * a = b * (a / c) :=
    decidable.by_cases
      (assume Hc : c = 0, by rewrite [Hc, div_zero, zero_mul, -(mul_zero b), -(@div_zero A s a)])
      (assume Hc : c ≠ 0, !field.div_mul_eq_mul_div_comm Hc)

  theorem one_div_div : 1 / (a / b) = b / a :=
    decidable.by_cases
      (assume Ha : a = 0, by rewrite [Ha, zero_div, 2 div_zero])
      (assume Ha : a ≠ 0,
      decidable.by_cases
        (assume Hb : b = 0, by rewrite [Hb, 2 div_zero, zero_div])
        (assume Hb : b ≠ 0, field.one_div_div Ha Hb))

  theorem div_div_eq_mul_div : a / (b / c) = (a * c) / b :=
    by rewrite [div_eq_mul_one_div, one_div_div, -mul_div_assoc]

  theorem div_div_eq_div_mul : (a / b) / c = a / (b * c) :=
    by rewrite [div_eq_mul_one_div, div_mul_div, mul_one]

  theorem div_div_div_div_eq : (a / b) / (c / d) = (a * d) / (b * c) :=
    by rewrite [div_div_eq_mul_div, div_mul_eq_mul_div, div_div_eq_div_mul]

  variable {a}
  theorem div_helper (H : a ≠ 0) : (1 / (a * b)) * a = 1 / b :=
    by rewrite [div_mul_eq_mul_div, one_mul, !div_mul_right H]

  variable (a)
  theorem div_mul_eq_div_mul_one_div : a / (b * c) = (a / b) * (1 / c) :=
    by rewrite [-div_div_eq_div_mul, -div_eq_mul_one_div]

end discrete_field

namespace norm_num

theorem div_add_helper [s : field A] (n d b c val : A) (Hd : d ≠ 0) (H : n + b * d = val)
        (H2 : c * d = val) : n / d + b = c :=
  begin
    apply eq_of_mul_eq_mul_of_nonzero_right Hd,
    rewrite [H2, -H, right_distrib, div_mul_cancel _ Hd]
 end

theorem add_div_helper [s : field A] (n d b c val : A) (Hd : d ≠ 0) (H : d * b + n = val)
        (H2 : d * c = val) : b + n / d = c :=
  begin
    apply eq_of_mul_eq_mul_of_nonzero_left Hd,
    rewrite [H2, -H, left_distrib, mul_div_cancel' Hd]
 end

theorem div_mul_helper [s : field A] (n d c v : A) (Hd : d ≠ 0) (H : (n * c) / d = v) :
        (n / d) * c = v :=
  by rewrite [-H, field.div_mul_eq_mul_div_comm _ _ Hd, mul_div_assoc]

theorem mul_div_helper [s : field A] (a n d v : A) (Hd : d ≠ 0) (H : (a * n) / d = v) :
        a * (n / d) = v :=
  by rewrite [-H, mul_div_assoc]

theorem nonzero_of_div_helper [s : field A] (a b : A) (Ha : a ≠ 0) (Hb : b ≠ 0) : a / b ≠ 0 :=
  begin
    intro Hab,
    have Habb : (a / b) * b = 0, by rewrite [Hab, zero_mul],
    rewrite [div_mul_cancel _ Hb at Habb],
    exact Ha Habb
  end

theorem div_helper [s : field A] (n d v : A) (Hd : d ≠ 0) (H : v * d = n) : n / d = v :=
  begin
    apply eq_of_mul_eq_mul_of_nonzero_right Hd,
    rewrite (div_mul_cancel _ Hd),
    exact eq.symm H
  end

theorem div_eq_div_helper [s : field A] (a b c d v : A) (H1 : a * d = v) (H2 : c * b = v)
        (Hb : b ≠ 0) (Hd : d ≠ 0) : a / b = c / d :=
  begin
    apply eq_div_of_mul_eq,
    exact Hd,
    rewrite div_mul_eq_mul_div,
    apply eq.symm,
    apply eq_div_of_mul_eq,
    exact Hb,
    rewrite [H1, H2]
  end

theorem subst_into_div [s : has_div A] (a₁ b₁ a₂ b₂ v : A) (H : a₁ / b₁ = v) (H1 : a₂ = a₁)
        (H2 : b₂ = b₁) : a₂ / b₂ = v :=
  by rewrite [H1, H2, H]

end norm_num


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Sébastien Gouëzel

Construction of a good coupling between nonempty compact metric spaces, minimizing
their Hausdorff distance. This construction is instrumental to study the Gromov-Hausdorff
distance between nonempty compact metric spaces -/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.metric_space.gluing
import Mathlib.topology.metric_space.hausdorff_distance
import Mathlib.PostPort

universes u v

namespace Mathlib

namespace Gromov_Hausdorff

/- This section shows that the Gromov-Hausdorff distance
is realized. For this, we consider candidate distances on the disjoint union
α ⊕ β of two compact nonempty metric spaces, almost realizing the Gromov-Hausdorff
distance, and show that they form a compact family by applying Arzela-Ascoli
theorem. The existence of a minimizer follows. -/

/-- The set of functions on α ⊕ β that are candidates distances to realize the
minimum of the Hausdorff distances between α and β in a coupling -/
def candidates (α : Type u) (β : Type v) [metric_space α] [compact_space α] [Nonempty α]
    [metric_space β] [compact_space β] [Nonempty β] : set (prod_space_fun α β) :=
  set_of
    fun (f : prod_space_fun α β) =>
      (((((∀ (x y : α), f (sum.inl x, sum.inl y) = dist x y) ∧
                ∀ (x y : β), f (sum.inr x, sum.inr y) = dist x y) ∧
              ∀ (x y : α ⊕ β), f (x, y) = f (y, x)) ∧
            ∀ (x y z : α ⊕ β), f (x, z) ≤ f (x, y) + f (y, z)) ∧
          ∀ (x : α ⊕ β), f (x, x) = 0) ∧
        ∀ (x y : α ⊕ β), f (x, y) ≤ ↑(max_var α β)

/-- Version of the set of candidates in bounded_continuous_functions, to apply
Arzela-Ascoli -/
/-- candidates are bounded by max_var α β -/
/-- Technical lemma to prove that candidates are Lipschitz -/
/-- Candidates are Lipschitz -/
/-- candidates give rise to elements of bounded_continuous_functions -/
def candidates_b_of_candidates {α : Type u} {β : Type v} [metric_space α] [compact_space α]
    [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] (f : prod_space_fun α β)
    (fA : f ∈ candidates α β) : Cb α β :=
  bounded_continuous_function.mk_of_compact f sorry

theorem candidates_b_of_candidates_mem {α : Type u} {β : Type v} [metric_space α] [compact_space α]
    [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] (f : prod_space_fun α β)
    (fA : f ∈ candidates α β) : candidates_b_of_candidates f fA ∈ candidates_b α β :=
  fA

/-- The distance on α ⊕ β is a candidate -/
def candidates_b_dist (α : Type u) (β : Type v) [metric_space α] [compact_space α] [Inhabited α]
    [metric_space β] [compact_space β] [Inhabited β] : Cb α β :=
  candidates_b_of_candidates (fun (p : (α ⊕ β) × (α ⊕ β)) => dist (prod.fst p) (prod.snd p)) sorry

theorem candidates_b_dist_mem_candidates_b {α : Type u} {β : Type v} [metric_space α]
    [compact_space α] [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] :
    candidates_b_dist α β ∈ candidates_b α β :=
  candidates_b_of_candidates_mem (fun (p : (α ⊕ β) × (α ⊕ β)) => dist (prod.fst p) (prod.snd p))
    (candidates_b_dist._proof_1 α β)

/-- To apply Arzela-Ascoli, we need to check that the set of candidates is closed and equicontinuous.
Equicontinuity follows from the Lipschitz control, we check closedness -/
/-- Compactness of candidates (in bounded_continuous_functions) follows -/
/-- We will then choose the candidate minimizing the Hausdorff distance. Except that we are not
in a metric space setting, so we need to define our custom version of Hausdorff distance,
called HD, and prove its basic properties. -/
def HD {α : Type u} {β : Type v} [metric_space α] [compact_space α] [Nonempty α] [metric_space β]
    [compact_space β] [Nonempty β] (f : Cb α β) : ℝ :=
  max (supr fun (x : α) => infi fun (y : β) => coe_fn f (sum.inl x, sum.inr y))
    (supr fun (y : β) => infi fun (x : α) => coe_fn f (sum.inl x, sum.inr y))

/- We will show that HD is continuous on bounded_continuous_functions, to deduce that its
minimum on the compact set candidates_b is attained. Since it is defined in terms of
infimum and supremum on ℝ, which is only conditionnally complete, we will need all the time
to check that the defining sets are bounded below or above. This is done in the next few
technical lemmas -/

theorem HD_below_aux1 {α : Type u} {β : Type v} [metric_space α] [compact_space α] [Nonempty α]
    [metric_space β] [compact_space β] [Nonempty β] {f : Cb α β} (C : ℝ) {x : α} :
    bdd_below (set.range fun (y : β) => coe_fn f (sum.inl x, sum.inr y) + C) :=
  sorry

theorem HD_below_aux2 {α : Type u} {β : Type v} [metric_space α] [compact_space α] [Nonempty α]
    [metric_space β] [compact_space β] [Nonempty β] {f : Cb α β} (C : ℝ) {y : β} :
    bdd_below (set.range fun (x : α) => coe_fn f (sum.inl x, sum.inr y) + C) :=
  sorry

/-- Explicit bound on HD (dist). This means that when looking for minimizers it will
be sufficient to look for functions with HD(f) bounded by this bound. -/
theorem HD_candidates_b_dist_le {α : Type u} {β : Type v} [metric_space α] [compact_space α]
    [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] :
    HD (candidates_b_dist α β) ≤ metric.diam set.univ + 1 + metric.diam set.univ :=
  sorry

/- To check that HD is continuous, we check that it is Lipschitz. As HD is a max, we
prove separately inequalities controlling the two terms (relying too heavily on copy-paste...) -/

/-- Conclude that HD, being Lipschitz, is continuous -/
/- Now that we have proved that the set of candidates is compact, and that HD is continuous,
we can finally select a candidate minimizing HD. This will be the candidate realizing the
optimal coupling. -/

/-- With the optimal candidate, construct a premetric space structure on α ⊕ β, on which the
predistance is given by the candidate. Then, we will identify points at 0 predistance
to obtain a genuine metric space -/
def premetric_optimal_GH_dist (α : Type u) (β : Type v) [metric_space α] [compact_space α]
    [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] : premetric_space (α ⊕ β) :=
  premetric_space.mk sorry sorry sorry

/-- A metric space which realizes the optimal coupling between α and β -/
def optimal_GH_coupling (α : Type u) (β : Type v) [metric_space α] [compact_space α] [Nonempty α]
    [metric_space β] [compact_space β] [Nonempty β] :=
  premetric.metric_quot (α ⊕ β)

/-- Injection of α in the optimal coupling between α and β -/
def optimal_GH_injl (α : Type u) (β : Type v) [metric_space α] [compact_space α] [Nonempty α]
    [metric_space β] [compact_space β] [Nonempty β] (x : α) : optimal_GH_coupling α β :=
  quotient.mk (sum.inl x)

/-- The injection of α in the optimal coupling between α and β is an isometry. -/
theorem isometry_optimal_GH_injl (α : Type u) (β : Type v) [metric_space α] [compact_space α]
    [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] : isometry (optimal_GH_injl α β) :=
  iff.mpr isometry_emetric_iff_metric
    fun (x y : α) => id (candidates_dist_inl (optimal_GH_dist_mem_candidates_b α β) x y)

/-- Injection of β  in the optimal coupling between α and β -/
def optimal_GH_injr (α : Type u) (β : Type v) [metric_space α] [compact_space α] [Nonempty α]
    [metric_space β] [compact_space β] [Nonempty β] (y : β) : optimal_GH_coupling α β :=
  quotient.mk (sum.inr y)

/-- The injection of β in the optimal coupling between α and β is an isometry. -/
theorem isometry_optimal_GH_injr (α : Type u) (β : Type v) [metric_space α] [compact_space α]
    [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] : isometry (optimal_GH_injr α β) :=
  iff.mpr isometry_emetric_iff_metric
    fun (x y : β) => id (candidates_dist_inr (optimal_GH_dist_mem_candidates_b α β) x y)

/-- The optimal coupling between two compact spaces α and β is still a compact space -/
protected instance compact_space_optimal_GH_coupling (α : Type u) (β : Type v) [metric_space α]
    [compact_space α] [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] :
    compact_space (optimal_GH_coupling α β) :=
  sorry

/-- For any candidate f, HD(f) is larger than or equal to the Hausdorff distance in the
optimal coupling. This follows from the fact that HD of the optimal candidate is exactly
the Hausdorff distance in the optimal coupling, although we only prove here the inequality
we need. -/
theorem Hausdorff_dist_optimal_le_HD (α : Type u) (β : Type v) [metric_space α] [compact_space α]
    [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] {f : Cb α β}
    (h : f ∈ candidates_b α β) :
    metric.Hausdorff_dist (set.range (optimal_GH_injl α β)) (set.range (optimal_GH_injr α β)) ≤
        HD f :=
  sorry

end Mathlib


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Floris van Doorn, Gabriel Ebner, Yury Kudryashov
-/
import order.conditionally_complete_lattice.finset

/-!
# Conditionally complete linear order structure on `ℕ`

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

In this file we

* define a `conditionally_complete_linear_order_bot` structure on `ℕ`;
* prove a few lemmas about `supr`/`infi`/`set.Union`/`set.Inter` and natural numbers.
-/

open set

namespace nat

open_locale classical

noncomputable instance : has_Inf ℕ :=
⟨λs, if h : ∃n, n ∈ s then @nat.find (λn, n ∈ s) _ h else 0⟩

noncomputable instance : has_Sup ℕ :=
⟨λs, if h : ∃n, ∀a∈s, a ≤ n then @nat.find (λn, ∀a∈s, a ≤ n) _ h else 0⟩

lemma Inf_def {s : set ℕ} (h : s.nonempty) : Inf s = @nat.find (λn, n ∈ s) _ h :=
dif_pos _

lemma Sup_def {s : set ℕ} (h : ∃n, ∀a∈s, a ≤ n) :
  Sup s = @nat.find (λn, ∀a∈s, a ≤ n) _ h :=
dif_pos _

lemma _root_.set.infinite.nat.Sup_eq_zero {s : set ℕ} (h : s.infinite) : Sup s = 0 :=
dif_neg $ λ ⟨n, hn⟩, let ⟨k, hks, hk⟩ := h.exists_nat_lt n in (hn k hks).not_lt hk

@[simp] lemma Inf_eq_zero {s : set ℕ} : Inf s = 0 ↔ 0 ∈ s ∨ s = ∅ :=
begin
  cases eq_empty_or_nonempty s,
  { subst h, simp only [or_true, eq_self_iff_true, iff_true, Inf, has_Inf.Inf,
      mem_empty_iff_false, exists_false, dif_neg, not_false_iff] },
  { simp only [h.ne_empty, or_false, nat.Inf_def, h, nat.find_eq_zero] }
end

@[simp] lemma Inf_empty : Inf ∅ = 0 :=
by { rw Inf_eq_zero, right, refl }

@[simp] lemma infi_of_empty {ι : Sort*} [is_empty ι] (f : ι → ℕ) : infi f = 0 :=
by rw [infi_of_empty', Inf_empty]

lemma Inf_mem {s : set ℕ} (h : s.nonempty) : Inf s ∈ s :=
by { rw [nat.Inf_def h], exact nat.find_spec h }

lemma not_mem_of_lt_Inf {s : set ℕ} {m : ℕ} (hm : m < Inf s) : m ∉ s :=
begin
  cases eq_empty_or_nonempty s,
  { subst h, apply not_mem_empty },
  { rw [nat.Inf_def h] at hm, exact nat.find_min h hm }
end

protected lemma Inf_le {s : set ℕ} {m : ℕ} (hm : m ∈ s) : Inf s ≤ m :=
by { rw [nat.Inf_def ⟨m, hm⟩], exact nat.find_min' ⟨m, hm⟩ hm }

lemma nonempty_of_pos_Inf {s : set ℕ} (h : 0 < Inf s) : s.nonempty :=
begin
  by_contradiction contra, rw set.not_nonempty_iff_eq_empty at contra,
  have h' : Inf s ≠ 0, { exact ne_of_gt h, }, apply h',
  rw nat.Inf_eq_zero, right, assumption,
end

lemma nonempty_of_Inf_eq_succ {s : set ℕ} {k : ℕ} (h : Inf s = k + 1) : s.nonempty :=
nonempty_of_pos_Inf (h.symm ▸ (succ_pos k) : Inf s > 0)

lemma eq_Ici_of_nonempty_of_upward_closed {s : set ℕ} (hs : s.nonempty)
  (hs' : ∀ (k₁ k₂ : ℕ), k₁ ≤ k₂ → k₁ ∈ s → k₂ ∈ s) : s = Ici (Inf s) :=
ext (λ n, ⟨λ H, nat.Inf_le H, λ H, hs' (Inf s) n H (Inf_mem hs)⟩)

lemma Inf_upward_closed_eq_succ_iff {s : set ℕ}
  (hs : ∀ (k₁ k₂ : ℕ), k₁ ≤ k₂ → k₁ ∈ s → k₂ ∈ s) (k : ℕ) :
  Inf s = k + 1 ↔ k + 1 ∈ s ∧ k ∉ s :=
begin
  split,
  { intro H,
    rw [eq_Ici_of_nonempty_of_upward_closed (nonempty_of_Inf_eq_succ H) hs, H, mem_Ici, mem_Ici],
    exact ⟨le_rfl, k.not_succ_le_self⟩, },
  { rintro ⟨H, H'⟩,
    rw [Inf_def (⟨_, H⟩ : s.nonempty), find_eq_iff],
    exact ⟨H, λ n hnk hns, H' $ hs n k (lt_succ_iff.mp hnk) hns⟩, },
end

/-- This instance is necessary, otherwise the lattice operations would be derived via
conditionally_complete_linear_order_bot and marked as noncomputable. -/
instance : lattice ℕ := linear_order.to_lattice

noncomputable instance : conditionally_complete_linear_order_bot ℕ :=
{ Sup := Sup, Inf := Inf,
  le_cSup    := assume s a hb ha, by rw [Sup_def hb]; revert a ha; exact @nat.find_spec _ _ hb,
  cSup_le    := assume s a hs ha, by rw [Sup_def ⟨a, ha⟩]; exact nat.find_min' _ ha,
  le_cInf    := assume s a hs hb,
    by rw [Inf_def hs]; exact hb (@nat.find_spec (λn, n ∈ s) _ _),
  cInf_le    := assume s a hb ha, by rw [Inf_def ⟨a, ha⟩]; exact nat.find_min' _ ha,
  cSup_empty :=
  begin
    simp only [Sup_def, set.mem_empty_iff_false, forall_const, forall_prop_of_false, not_false_iff,
      exists_const],
    apply bot_unique (nat.find_min' _ _),
    trivial
  end,
  .. (infer_instance : order_bot ℕ), .. (linear_order.to_lattice : lattice ℕ),
  .. (infer_instance : linear_order ℕ) }

lemma Sup_mem {s : set ℕ} (h₁ : s.nonempty) (h₂ : bdd_above s) : Sup s ∈ s :=
let ⟨k, hk⟩ := h₂ in h₁.cSup_mem ((finite_le_nat k).subset hk)

lemma Inf_add {n : ℕ} {p : ℕ → Prop} (hn : n ≤ Inf {m | p m}) :
  Inf {m | p (m + n)} + n = Inf {m | p m} :=
begin
  obtain h | ⟨m, hm⟩ := {m | p (m + n)}.eq_empty_or_nonempty,
  { rw [h, nat.Inf_empty, zero_add],
    obtain hnp | hnp := hn.eq_or_lt,
    { exact hnp },
    suffices hp : p (Inf {m | p m} - n + n),
    { exact (h.subset hp).elim },
    rw tsub_add_cancel_of_le hn,
    exact Inf_mem (nonempty_of_pos_Inf $ n.zero_le.trans_lt hnp) },
  { have hp : ∃ n, n ∈ {m | p m} := ⟨_, hm⟩,
    rw [nat.Inf_def ⟨m, hm⟩, nat.Inf_def hp],
    rw [nat.Inf_def hp] at hn,
    exact find_add hn }
end

section

variables {α : Type*} [complete_lattice α]

lemma supr_lt_succ (u : ℕ → α) (n : ℕ) : (⨆ k < n + 1, u k) = (⨆ k < n, u k) ⊔ u n :=
by simp [nat.lt_succ_iff_lt_or_eq, supr_or, supr_sup_eq]

lemma supr_lt_succ' (u : ℕ → α) (n : ℕ) : (⨆ k < n + 1, u k) = u 0 ⊔ (⨆ k < n, u (k + 1)) :=
by { rw ← sup_supr_nat_succ, simp }

lemma infi_lt_succ (u : ℕ → α) (n : ℕ) : (⨅ k < n + 1, u k) = (⨅ k < n, u k) ⊓ u n :=
@supr_lt_succ αᵒᵈ _ _ _

lemma infi_lt_succ' (u : ℕ → α) (n : ℕ) : (⨅ k < n + 1, u k) = u 0 ⊓ (⨅ k < n, u (k + 1)) :=
@supr_lt_succ' αᵒᵈ _ _ _

end

end nat

namespace set

variable {α : Type*}

lemma bUnion_lt_succ (u : ℕ → set α) (n : ℕ) : (⋃ k < n + 1, u k) = (⋃ k < n, u k) ∪ u n :=
nat.supr_lt_succ u n

lemma bUnion_lt_succ' (u : ℕ → set α) (n : ℕ) : (⋃ k < n + 1, u k) = u 0 ∪ (⋃ k < n, u (k + 1)) :=
nat.supr_lt_succ' u n

lemma bInter_lt_succ (u : ℕ → set α) (n : ℕ) : (⋂ k < n + 1, u k) = (⋂ k < n, u k) ∩ u n :=
nat.infi_lt_succ u n

lemma bInter_lt_succ' (u : ℕ → set α) (n : ℕ) : (⋂ k < n + 1, u k) = u 0 ∩ (⋂ k < n, u (k + 1)) :=
nat.infi_lt_succ' u n

end set


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

import category_theory.sites.pretopology
import category_theory.limits.shapes.types

/-!
# Sheaves of types on a Grothendieck topology

Defines the notion of a sheaf of types (usually called a sheaf of sets by mathematicians)
on a category equipped with a Grothendieck topology, as well as a range of equivalent
conditions useful in different situations.

First define what it means for a presheaf `P : Cᵒᵖ ⥤ Type v` to be a sheaf *for* a particular
presieve `R` on `X`:
* A *family of elements* `x` for `P` at `R` is an element `x_f` of `P Y` for every `f : Y ⟶ X` in
  `R`. See `family_of_elements`.
* The family `x` is *compatible* if, for any `f₁ : Y₁ ⟶ X` and `f₂ : Y₂ ⟶ X` both in `R`,
  and any `g₁ : Z ⟶ Y₁` and `g₂ : Z ⟶ Y₂` such that `g₁ ≫ f₁ = g₂ ≫ f₂`, the restriction of
  `x_f₁` along `g₁` agrees with the restriction of `x_f₂` along `g₂`.
  See `family_of_elements.compatible`.
* An *amalgamation* `t` for the family is an element of `P X` such that for every `f : Y ⟶ X` in
  `R`, the restriction of `t` on `f` is `x_f`.
  See `family_of_elements.is_amalgamation`.
We then say `P` is *separated* for `R` if every compatible family has at most one amalgamation,
and it is a *sheaf* for `R` if every compatible family has a unique amalgamation.
See `is_separated_for` and `is_sheaf_for`.

In the special case where `R` is a sieve, the compatibility condition can be simplified:
* The family `x` is *compatible* if, for any `f : Y ⟶ X` in `R` and `g : Z ⟶ Y`, the restriction of
  `x_f` along `g` agrees with `x_(g ≫ f)` (which is well defined since `g ≫ f` is in `R`).
See `family_of_elements.sieve_compatible` and `compatible_iff_sieve_compatible`.

In the special case where `C` has pullbacks, the compatibility condition can be simplified:
* The family `x` is *compatible* if, for any `f : Y ⟶ X` and `g : Z ⟶ X` both in `R`,
  the restriction of `x_f` along `π₁ : pullback f g ⟶ Y` agrees with the restriction of `x_g`
  along `π₂ : pullback f g ⟶ Z`.
See `family_of_elements.pullback_compatible` and `pullback_compatible_iff`.

Now given a Grothendieck topology `J`, `P` is a sheaf if it is a sheaf for every sieve in the
topology. See `is_sheaf`.

In the case where the topology is generated by a basis, it suffices to check `P` is a sheaf for
every presieve in the pretopology. See `is_sheaf_pretopology`.

We also provide equivalent conditions to satisfy alternate definitions given in the literature.

* Stacks: In `equalizer.presieve.sheaf_condition`, the sheaf condition at a presieve is shown to be
  equivalent to that of https://stacks.math.columbia.edu/tag/00VM (and combined with
  `is_sheaf_pretopology`, this shows the notions of `is_sheaf` are exactly equivalent.)

  The condition of https://stacks.math.columbia.edu/tag/00Z8 is virtually identical to the
  statement of `yoneda_condition_iff_sheaf_condition` (since the bijection described there carries
  the same information as the unique existence.)

* Maclane-Moerdijk [MM92]: Using `compatible_iff_sieve_compatible`, the definitions of `is_sheaf`
  are equivalent. There are also alternate definitions given:
  - Yoneda condition: Defined in `yoneda_sheaf_condition` and equivalence in
    `yoneda_condition_iff_sheaf_condition`.
  - Equalizer condition (Equation 3): Defined in the `equalizer.sieve` namespace, and equivalence
    in `equalizer.sieve.sheaf_condition`.
  - Matching family for presieves with pullback: `pullback_compatible_iff`.
  - Sheaf for a pretopology (Prop 1): `is_sheaf_pretopology` combined with the previous.
  - Sheaf for a pretopology as equalizer (Prop 1, bis): `equalizer.presieve.sheaf_condition`
    combined with the previous.

## Implementation

The sheaf condition is given as a proposition, rather than a subsingleton in `Type (max u₁ v)`.
This doesn't seem to make a big difference, other than making a couple of definitions noncomputable,
but it means that equivalent conditions can be given as `↔` statements rather than `≃` statements,
which can be convenient.

## References

* [MM92]: *Sheaves in geometry and logic*, Saunders MacLane, and Ieke Moerdijk:
  Chapter III, Section 4.
* [Elephant]: *Sketches of an Elephant*, P. T. Johnstone: C2.1.
* https://stacks.math.columbia.edu/tag/00VL (sheaves on a pretopology or site)
* https://stacks.math.columbia.edu/tag/00ZB (sheaves on a topology)

-/

universes w v₁ v₂ u₁ u₂
namespace category_theory

open opposite category_theory category limits sieve

namespace presieve

variables {C : Type u₁} [category.{v₁} C]

variables {P Q U : Cᵒᵖ ⥤ Type w}
variables {X Y : C} {S : sieve X} {R : presieve X}
variables (J J₂ : grothendieck_topology C)

/--
A family of elements for a presheaf `P` given a collection of arrows `R` with fixed codomain `X`
consists of an element of `P Y` for every `f : Y ⟶ X` in `R`.
A presheaf is a sheaf (resp, separated) if every *compatible* family of elements has exactly one
(resp, at most one) amalgamation.

This data is referred to as a `family` in [MM92], Chapter III, Section 4. It is also a concrete
version of the elements of the middle object in https://stacks.math.columbia.edu/tag/00VM which is
more useful for direct calculations. It is also used implicitly in Definition C2.1.2 in [Elephant].
-/
def family_of_elements (P : Cᵒᵖ ⥤ Type w) (R : presieve X) :=
Π ⦃Y : C⦄ (f : Y ⟶ X), R f → P.obj (op Y)

instance : inhabited (family_of_elements P (⊥ : presieve X)) := ⟨λ Y f, false.elim⟩

/--
A family of elements for a presheaf on the presieve `R₂` can be restricted to a smaller presieve
`R₁`.
-/
def family_of_elements.restrict {R₁ R₂ : presieve X} (h : R₁ ≤ R₂) :
  family_of_elements P R₂ → family_of_elements P R₁ :=
λ x Y f hf, x f (h _ hf)

/--
A family of elements for the arrow set `R` is *compatible* if for any `f₁ : Y₁ ⟶ X` and
`f₂ : Y₂ ⟶ X` in `R`, and any `g₁ : Z ⟶ Y₁` and `g₂ : Z ⟶ Y₂`, if the square `g₁ ≫ f₁ = g₂ ≫ f₂`
commutes then the elements of `P Z` obtained by restricting the element of `P Y₁` along `g₁` and
restricting the element of `P Y₂` along `g₂` are the same.

In special cases, this condition can be simplified, see `pullback_compatible_iff` and
`compatible_iff_sieve_compatible`.

This is referred to as a "compatible family" in Definition C2.1.2 of [Elephant], and on nlab:
https://ncatlab.org/nlab/show/sheaf#GeneralDefinitionInComponents
-/
def family_of_elements.compatible (x : family_of_elements P R) : Prop :=
∀ ⦃Y₁ Y₂ Z⦄ (g₁ : Z ⟶ Y₁) (g₂ : Z ⟶ Y₂) ⦃f₁ : Y₁ ⟶ X⦄ ⦃f₂ : Y₂ ⟶ X⦄
  (h₁ : R f₁) (h₂ : R f₂), g₁ ≫ f₁ = g₂ ≫ f₂ → P.map g₁.op (x f₁ h₁) = P.map g₂.op (x f₂ h₂)

/--
If the category `C` has pullbacks, this is an alternative condition for a family of elements to be
compatible: For any `f : Y ⟶ X` and `g : Z ⟶ X` in the presieve `R`, the restriction of the
given elements for `f` and `g` to the pullback agree.
This is equivalent to being compatible (provided `C` has pullbacks), shown in
`pullback_compatible_iff`.

This is the definition for a "matching" family given in [MM92], Chapter III, Section 4,
Equation (5). Viewing the type `family_of_elements` as the middle object of the fork in
https://stacks.math.columbia.edu/tag/00VM, this condition expresses that `pr₀* (x) = pr₁* (x)`,
using the notation defined there.
-/
def family_of_elements.pullback_compatible (x : family_of_elements P R) [has_pullbacks C] : Prop :=
∀ ⦃Y₁ Y₂⦄ ⦃f₁ : Y₁ ⟶ X⦄ ⦃f₂ : Y₂ ⟶ X⦄ (h₁ : R f₁) (h₂ : R f₂),
  P.map (pullback.fst : pullback f₁ f₂ ⟶ _).op (x f₁ h₁) = P.map pullback.snd.op (x f₂ h₂)

lemma pullback_compatible_iff (x : family_of_elements P R) [has_pullbacks C] :
  x.compatible ↔ x.pullback_compatible :=
begin
  split,
  { intros t Y₁ Y₂ f₁ f₂ hf₁ hf₂,
    apply t,
    apply pullback.condition },
  { intros t Y₁ Y₂ Z g₁ g₂ f₁ f₂ hf₁ hf₂ comm,
    rw [←pullback.lift_fst _ _ comm, op_comp, functor_to_types.map_comp_apply, t hf₁ hf₂,
        ←functor_to_types.map_comp_apply, ←op_comp, pullback.lift_snd] }
end

/-- The restriction of a compatible family is compatible. -/
lemma family_of_elements.compatible.restrict {R₁ R₂ : presieve X} (h : R₁ ≤ R₂)
  {x : family_of_elements P R₂} : x.compatible → (x.restrict h).compatible :=
λ q Y₁ Y₂ Z g₁ g₂ f₁ f₂ h₁ h₂ comm, q g₁ g₂ (h _ h₁) (h _ h₂) comm

/--
Extend a family of elements to the sieve generated by an arrow set.
This is the construction described as "easy" in Lemma C2.1.3 of [Elephant].
-/
noncomputable def family_of_elements.sieve_extend (x : family_of_elements P R) :
  family_of_elements P (generate R) :=
λ Z f hf, P.map hf.some_spec.some.op (x _ hf.some_spec.some_spec.some_spec.1)

/-- The extension of a compatible family to the generated sieve is compatible. -/
lemma family_of_elements.compatible.sieve_extend {x : family_of_elements P R} (hx : x.compatible) :
  x.sieve_extend.compatible :=
begin
  intros _ _ _ _ _ _ _ h₁ h₂ comm,
  iterate 2 { erw ← functor_to_types.map_comp_apply, rw ← op_comp }, apply hx,
  simp [comm, h₁.some_spec.some_spec.some_spec.2, h₂.some_spec.some_spec.some_spec.2],
end

/-- The extension of a family agrees with the original family. -/
lemma extend_agrees {x : family_of_elements P R} (t : x.compatible) {f : Y ⟶ X} (hf : R f) :
  x.sieve_extend f (le_generate R Y hf) = x f hf :=
begin
  have h := (le_generate R Y hf).some_spec,
  unfold family_of_elements.sieve_extend,
  rw t h.some (𝟙 _) _ hf _,
  { simp }, { rw id_comp, exact h.some_spec.some_spec.2 },
end

/-- The restriction of an extension is the original. -/
@[simp]
lemma restrict_extend {x : family_of_elements P R} (t : x.compatible) :
  x.sieve_extend.restrict (le_generate R) = x :=
begin
  ext Y f hf,
  exact extend_agrees t hf,
end

/--
If the arrow set for a family of elements is actually a sieve (i.e. it is downward closed) then the
consistency condition can be simplified.
This is an equivalent condition, see `compatible_iff_sieve_compatible`.

This is the notion of "matching" given for families on sieves given in [MM92], Chapter III,
Section 4, Equation 1, and nlab: https://ncatlab.org/nlab/show/matching+family.
See also the discussion before Lemma C2.1.4 of [Elephant].
-/
def family_of_elements.sieve_compatible (x : family_of_elements P S) : Prop :=
∀ ⦃Y Z⦄ (f : Y ⟶ X) (g : Z ⟶ Y) (hf), x (g ≫ f) (S.downward_closed hf g) = P.map g.op (x f hf)

lemma compatible_iff_sieve_compatible (x : family_of_elements P S) :
  x.compatible ↔ x.sieve_compatible :=
begin
  split,
  { intros h Y Z f g hf,
    simpa using h (𝟙 _) g (S.downward_closed hf g) hf (id_comp _) },
  { intros h Y₁ Y₂ Z g₁ g₂ f₁ f₂ h₁ h₂ k,
    simp_rw [← h f₁ g₁ h₁, k, h f₂ g₂ h₂] }
end

lemma family_of_elements.compatible.to_sieve_compatible {x : family_of_elements P S}
  (t : x.compatible) : x.sieve_compatible :=
(compatible_iff_sieve_compatible x).1 t

/--
Given a family of elements `x` for the sieve `S` generated by a presieve `R`, if `x` is restricted
to `R` and then extended back up to `S`, the resulting extension equals `x`.
-/
@[simp]
lemma extend_restrict {x : family_of_elements P (generate R)} (t : x.compatible) :
  (x.restrict (le_generate R)).sieve_extend = x :=
begin
  rw compatible_iff_sieve_compatible at t,
  ext _ _ h, apply (t _ _ _).symm.trans, congr,
  exact h.some_spec.some_spec.some_spec.2,
end

/--
Two compatible families on the sieve generated by a presieve `R` are equal if and only if they are
equal when restricted to `R`.
-/

/-- Compatible families of elements for a presheaf of types `P` and a presieve `R`
    are in 1-1 correspondence with compatible families for the same presheaf and
    the sieve generated by `R`, through extension and restriction. -/
@[simps] noncomputable def compatible_equiv_generate_sieve_compatible :
  {x : family_of_elements P R // x.compatible} ≃
  {x : family_of_elements P (generate R) // x.compatible} :=
{ to_fun := λ x, ⟨x.1.sieve_extend, x.2.sieve_extend⟩,
  inv_fun := λ x, ⟨x.1.restrict (le_generate R), x.2.restrict _⟩,
  left_inv := λ x, subtype.ext (restrict_extend x.2),
  right_inv := λ x, subtype.ext (extend_restrict x.2) }

lemma family_of_elements.comp_of_compatible (S : sieve X) {x : family_of_elements P S}
  (t : x.compatible) {f : Y ⟶ X} (hf : S f) {Z} (g : Z ⟶ Y) :
  x (g ≫ f) (S.downward_closed hf g) = P.map g.op (x f hf) :=
by simpa using t (𝟙 _) g (S.downward_closed hf g) hf (id_comp _)

section functor_pullback
variables {D : Type u₂} [category.{v₂} D] (F : D ⥤ C) {Z : D}
variables {T : presieve (F.obj Z)} {x : family_of_elements P T}

/--
Given a family of elements of a sieve `S` on `F(X)`, we can realize it as a family of elements of
`S.functor_pullback F`.
-/
def family_of_elements.functor_pullback (x : family_of_elements P T) :
  family_of_elements (F.op ⋙ P) (T.functor_pullback F) := λ Y f hf, x (F.map f) hf

lemma family_of_elements.compatible.functor_pullback (h : x.compatible) :
  (x.functor_pullback F).compatible :=
begin
  intros Z₁ Z₂ W g₁ g₂ f₁ f₂ h₁ h₂ eq,
  exact h (F.map g₁) (F.map g₂) h₁ h₂ (by simp only [← F.map_comp, eq])
end

end functor_pullback

/--
Given a family of elements of a sieve `S` on `X` whose values factors through `F`, we can
realize it as a family of elements of `S.functor_pushforward F`. Since the preimage is obtained by
choice, this is not well-defined generally.
-/
noncomputable
def family_of_elements.functor_pushforward {D : Type u₂} [category.{v₂} D] (F : D ⥤ C) {X : D}
  {T : presieve X} (x : family_of_elements (F.op ⋙ P) T) :
    family_of_elements P (T.functor_pushforward F) := λ Y f h,
by { obtain ⟨Z, g, h, h₁, _⟩ := get_functor_pushforward_structure h, exact P.map h.op (x g h₁) }

section pullback

/--
Given a family of elements of a sieve `S` on `X`, and a map `Y ⟶ X`, we can obtain a
family of elements of `S.pullback f` by taking the same elements.
-/
def family_of_elements.pullback (f : Y ⟶ X)  (x : family_of_elements P S) :
  family_of_elements P (S.pullback f) := λ _ g hg, x (g ≫ f) hg

lemma family_of_elements.compatible.pullback (f : Y ⟶ X) {x : family_of_elements P S}
  (h : x.compatible) : (x.pullback f).compatible :=
begin
  simp only [compatible_iff_sieve_compatible] at h ⊢,
  intros W Z f₁ f₂ hf,
  unfold family_of_elements.pullback,
  rw ← (h (f₁ ≫ f) f₂ hf),
  simp only [assoc],
end

end pullback

/--
Given a morphism of presheaves `f : P ⟶ Q`, we can take a family of elements valued in `P` to a
family of elements valued in `Q` by composing with `f`.
-/
def family_of_elements.comp_presheaf_map (f : P ⟶ Q) (x : family_of_elements P R) :
  family_of_elements Q R := λ Y g hg, f.app (op Y) (x g hg)

@[simp]
lemma family_of_elements.comp_presheaf_map_id (x : family_of_elements P R) :
  x.comp_presheaf_map (𝟙 P) = x := rfl

@[simp]
lemma family_of_elements.comp_prersheaf_map_comp (x : family_of_elements P R)
  (f : P ⟶ Q) (g : Q ⟶ U) :
  (x.comp_presheaf_map f).comp_presheaf_map g = x.comp_presheaf_map (f ≫ g) := rfl

lemma family_of_elements.compatible.comp_presheaf_map (f : P ⟶ Q) {x : family_of_elements P R}
  (h : x.compatible) : (x.comp_presheaf_map f).compatible :=
begin
  intros Z₁ Z₂ W g₁ g₂ f₁ f₂ h₁ h₂ eq,
  unfold family_of_elements.comp_presheaf_map,
  rwa [← functor_to_types.naturality, ← functor_to_types.naturality, h],
end

/--
The given element `t` of `P.obj (op X)` is an *amalgamation* for the family of elements `x` if every
restriction `P.map f.op t = x_f` for every arrow `f` in the presieve `R`.

This is the definition given in  https://ncatlab.org/nlab/show/sheaf#GeneralDefinitionInComponents,
and https://ncatlab.org/nlab/show/matching+family, as well as [MM92], Chapter III, Section 4,
equation (2).
-/
def family_of_elements.is_amalgamation (x : family_of_elements P R)
  (t : P.obj (op X)) : Prop :=
∀ ⦃Y : C⦄ (f : Y ⟶ X) (h : R f), P.map f.op t = x f h

lemma family_of_elements.is_amalgamation.comp_presheaf_map
  {x : family_of_elements P R} {t} (f : P ⟶ Q) (h : x.is_amalgamation t) :
  (x.comp_presheaf_map f).is_amalgamation (f.app (op X) t) :=
begin
  intros Y g hg,
  dsimp [family_of_elements.comp_presheaf_map],
  change (f.app _ ≫ Q.map _) _ = _,
  simp [← f.naturality, h g hg],
end

lemma is_compatible_of_exists_amalgamation (x : family_of_elements P R)
  (h : ∃ t, x.is_amalgamation t) : x.compatible :=
begin
  cases h with t ht,
  intros Y₁ Y₂ Z g₁ g₂ f₁ f₂ h₁ h₂ comm,
  rw [←ht _ h₁, ←ht _ h₂, ←functor_to_types.map_comp_apply, ←op_comp, comm],
  simp,
end

lemma is_amalgamation_restrict {R₁ R₂ : presieve X} (h : R₁ ≤ R₂)
  (x : family_of_elements P R₂) (t : P.obj (op X)) (ht : x.is_amalgamation t) :
  (x.restrict h).is_amalgamation t :=
λ Y f hf, ht f (h Y hf)

lemma is_amalgamation_sieve_extend {R : presieve X}
  (x : family_of_elements P R) (t : P.obj (op X)) (ht : x.is_amalgamation t) :
  x.sieve_extend.is_amalgamation t :=
begin
  intros Y f hf,
  dsimp [family_of_elements.sieve_extend],
  rw [←ht _, ←functor_to_types.map_comp_apply, ←op_comp, hf.some_spec.some_spec.some_spec.2],
end

/-- A presheaf is separated for a presieve if there is at most one amalgamation. -/
def is_separated_for (P : Cᵒᵖ ⥤ Type w) (R : presieve X) : Prop :=
∀ (x : family_of_elements P R) (t₁ t₂),
  x.is_amalgamation t₁ → x.is_amalgamation t₂ → t₁ = t₂

lemma is_separated_for.ext {R : presieve X} (hR : is_separated_for P R)
  {t₁ t₂ : P.obj (op X)} (h : ∀ ⦃Y⦄ ⦃f : Y ⟶ X⦄ (hf : R f), P.map f.op t₁ = P.map f.op t₂) :
t₁ = t₂ :=
hR (λ Y f hf, P.map f.op t₂) t₁ t₂ (λ Y f hf, h hf) (λ Y f hf, rfl)

lemma is_separated_for_iff_generate :
  is_separated_for P R ↔ is_separated_for P (generate R) :=
begin
  split,
  { intros h x t₁ t₂ ht₁ ht₂,
    apply h (x.restrict (le_generate R)) t₁ t₂ _ _,
    { exact is_amalgamation_restrict _ x t₁ ht₁ },
    { exact is_amalgamation_restrict _ x t₂ ht₂ } },
  { intros h x t₁ t₂ ht₁ ht₂,
    apply h (x.sieve_extend),
    { exact is_amalgamation_sieve_extend x t₁ ht₁ },
    { exact is_amalgamation_sieve_extend x t₂ ht₂ } }
end

lemma is_separated_for_top (P : Cᵒᵖ ⥤ Type w) : is_separated_for P (⊤ : presieve X) :=
λ x t₁ t₂ h₁ h₂,
begin
  have q₁ := h₁ (𝟙 X) (by simp),
  have q₂ := h₂ (𝟙 X) (by simp),
  simp only [op_id, functor_to_types.map_id_apply] at q₁ q₂,
  rw [q₁, q₂],
end

/--
We define `P` to be a sheaf for the presieve `R` if every compatible family has a unique
amalgamation.

This is the definition of a sheaf for the given presieve given in C2.1.2 of [Elephant], and
https://ncatlab.org/nlab/show/sheaf#GeneralDefinitionInComponents.
Using `compatible_iff_sieve_compatible`,
this is equivalent to the definition of a sheaf in [MM92], Chapter III, Section 4.
-/
def is_sheaf_for (P : Cᵒᵖ ⥤ Type w) (R : presieve X) : Prop :=
∀ (x : family_of_elements P R), x.compatible → ∃! t, x.is_amalgamation t

/--
This is an equivalent condition to be a sheaf, which is useful for the abstraction to local
operators on elementary toposes. However this definition is defined only for sieves, not presieves.
The equivalence between this and `is_sheaf_for` is given in `yoneda_condition_iff_sheaf_condition`.
This version is also useful to establish that being a sheaf is preserved under isomorphism of
presheaves.

See the discussion before Equation (3) of [MM92], Chapter III, Section 4. See also C2.1.4 of
[Elephant]. This is also a direct reformulation of <https://stacks.math.columbia.edu/tag/00Z8>.
-/
def yoneda_sheaf_condition (P : Cᵒᵖ ⥤ Type v₁) (S : sieve X) : Prop :=
∀ (f : S.functor ⟶ P), ∃! g, S.functor_inclusion ≫ g = f

-- TODO: We can generalize the universe parameter v₁ above by composing with
-- appropriate `ulift_functor`s.

/--
(Implementation). This is a (primarily internal) equivalence between natural transformations
and compatible families.

Cf the discussion after Lemma 7.47.10 in <https://stacks.math.columbia.edu/tag/00YW>. See also
the proof of C2.1.4 of [Elephant], and the discussion in [MM92], Chapter III, Section 4.
-/
def nat_trans_equiv_compatible_family {P : Cᵒᵖ ⥤ Type v₁} :
  (S.functor ⟶ P) ≃ {x : family_of_elements P S // x.compatible} :=
{ to_fun := λ α,
  begin
    refine ⟨λ Y f hf, _, _⟩,
    { apply α.app (op Y) ⟨_, hf⟩ },
    { rw compatible_iff_sieve_compatible,
      intros Y Z f g hf,
      dsimp,
      rw ← functor_to_types.naturality _ _ α g.op,
      refl }
  end,
  inv_fun := λ t,
  { app := λ Y f, t.1 _ f.2,
    naturality' := λ Y Z g,
    begin
      ext ⟨f, hf⟩,
      apply t.2.to_sieve_compatible _,
    end },
  left_inv := λ α,
  begin
    ext X ⟨_, _⟩,
    refl
  end,
  right_inv :=
  begin
    rintro ⟨x, hx⟩,
    refl,
  end }

/-- (Implementation). A lemma useful to prove `yoneda_condition_iff_sheaf_condition`. -/
lemma extension_iff_amalgamation {P : Cᵒᵖ ⥤ Type v₁} (x : S.functor ⟶ P) (g : yoneda.obj X ⟶ P) :
  S.functor_inclusion ≫ g = x ↔
  (nat_trans_equiv_compatible_family x).1.is_amalgamation (yoneda_equiv g) :=
begin
  change _ ↔ ∀ ⦃Y : C⦄ (f : Y ⟶ X) (h : S f), P.map f.op (yoneda_equiv g) = x.app (op Y) ⟨f, h⟩,
  split,
  { rintro rfl Y f hf,
    rw yoneda_equiv_naturality,
    dsimp,
    simp },  -- See note [dsimp, simp].
  { intro h,
    ext Y ⟨f, hf⟩,
    have : _ = x.app Y _ := h f hf,
    rw yoneda_equiv_naturality at this,
    rw ← this,
    dsimp,
    simp }, -- See note [dsimp, simp].
end

/--
The yoneda version of the sheaf condition is equivalent to the sheaf condition.

C2.1.4 of [Elephant].
-/
lemma is_sheaf_for_iff_yoneda_sheaf_condition {P : Cᵒᵖ ⥤ Type v₁} :
  is_sheaf_for P S ↔ yoneda_sheaf_condition P S :=
begin
  rw [is_sheaf_for, yoneda_sheaf_condition],
  simp_rw [extension_iff_amalgamation],
  rw equiv.forall_congr_left' nat_trans_equiv_compatible_family,
  rw subtype.forall,
  apply ball_congr,
  intros x hx,
  rw equiv.exists_unique_congr_left _,
  simp,
end

/--
If `P` is a sheaf for the sieve `S` on `X`, a natural transformation from `S` (viewed as a functor)
to `P` can be (uniquely) extended to all of `yoneda.obj X`.

      f
   S  →  P
   ↓  ↗
   yX

-/
noncomputable def is_sheaf_for.extend {P : Cᵒᵖ ⥤ Type v₁} (h : is_sheaf_for P S)
  (f : S.functor ⟶ P) : yoneda.obj X ⟶ P :=
(is_sheaf_for_iff_yoneda_sheaf_condition.1 h f).exists.some

/--
Show that the extension of `f : S.functor ⟶ P` to all of `yoneda.obj X` is in fact an extension, ie
that the triangle below commutes, provided `P` is a sheaf for `S`

      f
   S  →  P
   ↓  ↗
   yX

-/
@[simp, reassoc]
lemma is_sheaf_for.functor_inclusion_comp_extend {P : Cᵒᵖ ⥤ Type v₁} (h : is_sheaf_for P S)
  (f : S.functor ⟶ P) : S.functor_inclusion ≫ h.extend f = f :=
(is_sheaf_for_iff_yoneda_sheaf_condition.1 h f).exists.some_spec

/-- The extension of `f` to `yoneda.obj X` is unique. -/
lemma is_sheaf_for.unique_extend {P : Cᵒᵖ ⥤ Type v₁} (h : is_sheaf_for P S) {f : S.functor ⟶ P}
  (t : yoneda.obj X ⟶ P) (ht : S.functor_inclusion ≫ t = f) :
  t = h.extend f :=
((is_sheaf_for_iff_yoneda_sheaf_condition.1 h f).unique ht (h.functor_inclusion_comp_extend f))

/--
If `P` is a sheaf for the sieve `S` on `X`, then if two natural transformations from `yoneda.obj X`
to `P` agree when restricted to the subfunctor given by `S`, they are equal.
-/
lemma is_sheaf_for.hom_ext {P : Cᵒᵖ ⥤ Type v₁} (h : is_sheaf_for P S) (t₁ t₂ : yoneda.obj X ⟶ P)
  (ht : S.functor_inclusion ≫ t₁ = S.functor_inclusion ≫ t₂) :
  t₁ = t₂ :=
(h.unique_extend t₁ ht).trans (h.unique_extend t₂ rfl).symm

/-- `P` is a sheaf for `R` iff it is separated for `R` and there exists an amalgamation. -/
lemma is_separated_for_and_exists_is_amalgamation_iff_sheaf_for :
  is_separated_for P R ∧ (∀ (x : family_of_elements P R), x.compatible → ∃ t, x.is_amalgamation t) ↔
  is_sheaf_for P R :=
begin
  rw [is_separated_for, ←forall_and_distrib],
  apply forall_congr,
  intro x,
  split,
  { intros z hx, exact exists_unique_of_exists_of_unique (z.2 hx) z.1 },
  { intros h,
    refine ⟨_, (exists_of_exists_unique ∘ h)⟩,
    intros t₁ t₂ ht₁ ht₂,
    apply (h _).unique ht₁ ht₂,
    exact is_compatible_of_exists_amalgamation x ⟨_, ht₂⟩ }
end

/--
If `P` is separated for `R` and every family has an amalgamation, then `P` is a sheaf for `R`.
-/
lemma is_separated_for.is_sheaf_for (t : is_separated_for P R) :
  (∀ (x : family_of_elements P R), x.compatible → ∃ t, x.is_amalgamation t) →
  is_sheaf_for P R :=
begin
  rw ← is_separated_for_and_exists_is_amalgamation_iff_sheaf_for,
  exact and.intro t,
end

/-- If `P` is a sheaf for `R`, it is separated for `R`. -/
lemma is_sheaf_for.is_separated_for : is_sheaf_for P R → is_separated_for P R :=
λ q, (is_separated_for_and_exists_is_amalgamation_iff_sheaf_for.2 q).1

/-- Get the amalgamation of the given compatible family, provided we have a sheaf. -/
noncomputable def is_sheaf_for.amalgamate
  (t : is_sheaf_for P R) (x : family_of_elements P R) (hx : x.compatible) :
  P.obj (op X) :=
(t x hx).exists.some

lemma is_sheaf_for.is_amalgamation
  (t : is_sheaf_for P R) {x : family_of_elements P R} (hx : x.compatible) :
  x.is_amalgamation (t.amalgamate x hx) :=
(t x hx).exists.some_spec

@[simp]
lemma is_sheaf_for.valid_glue
  (t : is_sheaf_for P R) {x : family_of_elements P R} (hx : x.compatible) (f : Y ⟶ X) (Hf : R f) :
  P.map f.op (t.amalgamate x hx) = x f Hf :=
t.is_amalgamation hx f Hf

/-- C2.1.3 in [Elephant] -/
lemma is_sheaf_for_iff_generate (R : presieve X) :
  is_sheaf_for P R ↔ is_sheaf_for P (generate R) :=
begin
  rw ← is_separated_for_and_exists_is_amalgamation_iff_sheaf_for,
  rw ← is_separated_for_and_exists_is_amalgamation_iff_sheaf_for,
  rw ← is_separated_for_iff_generate,
  apply and_congr (iff.refl _),
  split,
  { intros q x hx,
    apply exists_imp_exists _ (q _ (hx.restrict (le_generate R))),
    intros t ht,
    simpa [hx] using is_amalgamation_sieve_extend _ _ ht },
  { intros q x hx,
    apply exists_imp_exists _ (q _ hx.sieve_extend),
    intros t ht,
    simpa [hx] using is_amalgamation_restrict (le_generate R) _ _ ht },
end

/--
Every presheaf is a sheaf for the family {𝟙 X}.

[Elephant] C2.1.5(i)
-/
lemma is_sheaf_for_singleton_iso (P : Cᵒᵖ ⥤ Type w) :
  is_sheaf_for P (presieve.singleton (𝟙 X)) :=
begin
  intros x hx,
  refine ⟨x _ (presieve.singleton_self _), _, _⟩,
  { rintro _ _ ⟨rfl, rfl⟩,
    simp },
  { intros t ht,
    simpa using ht _ (presieve.singleton_self _) }
end

/--
Every presheaf is a sheaf for the maximal sieve.

[Elephant] C2.1.5(ii)
-/
lemma is_sheaf_for_top_sieve (P : Cᵒᵖ ⥤ Type w) :
  is_sheaf_for P ((⊤ : sieve X) : presieve X) :=
begin
  rw ← generate_of_singleton_is_split_epi (𝟙 X),
  rw ← is_sheaf_for_iff_generate,
  apply is_sheaf_for_singleton_iso,
end

/--
If `P` is a sheaf for `S`, and it is iso to `P'`, then `P'` is a sheaf for `S`. This shows that
"being a sheaf for a presieve" is a mathematical or hygenic property.
-/
lemma is_sheaf_for_iso {P' : Cᵒᵖ ⥤ Type w} (i : P ≅ P') : is_sheaf_for P R → is_sheaf_for P' R :=
begin
  intros h x hx,
  let x' := x.comp_presheaf_map i.inv,
  have : x'.compatible := family_of_elements.compatible.comp_presheaf_map i.inv hx,
  obtain ⟨t, ht1, ht2⟩ := h x' this,
  use i.hom.app _ t,
  fsplit,
  { convert family_of_elements.is_amalgamation.comp_presheaf_map i.hom ht1,
    dsimp [x'],
    simp },
  { intros y hy,
    rw (show y = (i.inv.app (op X) ≫ i.hom.app (op X)) y, by simp),
    simp [ ht2 (i.inv.app _ y) (family_of_elements.is_amalgamation.comp_presheaf_map i.inv hy)] }
end

/--
If a presieve `R` on `X` has a subsieve `S` such that:

* `P` is a sheaf for `S`.
* For every `f` in `R`, `P` is separated for the pullback of `S` along `f`,

then `P` is a sheaf for `R`.

This is closely related to [Elephant] C2.1.6(i).
-/
lemma is_sheaf_for_subsieve_aux (P : Cᵒᵖ ⥤ Type w) {S : sieve X} {R : presieve X}
  (h : (S : presieve X) ≤ R)
  (hS : is_sheaf_for P S)
  (trans : ∀ ⦃Y⦄ ⦃f : Y ⟶ X⦄, R f → is_separated_for P (S.pullback f)) :
  is_sheaf_for P R :=
begin
  rw ← is_separated_for_and_exists_is_amalgamation_iff_sheaf_for,
  split,
  { intros x t₁ t₂ ht₁ ht₂,
    exact hS.is_separated_for _ _ _ (is_amalgamation_restrict h x t₁ ht₁)
                                    (is_amalgamation_restrict h x t₂ ht₂) },
  { intros x hx,
    use hS.amalgamate _ (hx.restrict h),
    intros W j hj,
    apply (trans hj).ext,
    intros Y f hf,
    rw [←functor_to_types.map_comp_apply, ←op_comp,
        hS.valid_glue (hx.restrict h) _ hf, family_of_elements.restrict,
        ←hx (𝟙 _) f _ _ (id_comp _)],
    simp },
end

/--
If `P` is a sheaf for every pullback of the sieve `S`, then `P` is a sheaf for any presieve which
contains `S`.
This is closely related to [Elephant] C2.1.6.
-/
lemma is_sheaf_for_subsieve (P : Cᵒᵖ ⥤ Type w) {S : sieve X} {R : presieve X}
  (h : (S : presieve X) ≤ R)
  (trans : Π ⦃Y⦄ (f : Y ⟶ X), is_sheaf_for P (S.pullback f)) :
  is_sheaf_for P R :=
is_sheaf_for_subsieve_aux P h (by simpa using trans (𝟙 _)) (λ Y f hf, (trans f).is_separated_for)

/-- A presheaf is separated for a topology if it is separated for every sieve in the topology. -/
def is_separated (P : Cᵒᵖ ⥤ Type w) : Prop :=
∀ {X} (S : sieve X), S ∈ J X → is_separated_for P S

/--
A presheaf is a sheaf for a topology if it is a sheaf for every sieve in the topology.

If the given topology is given by a pretopology, `is_sheaf_for_pretopology` shows it suffices to
check the sheaf condition at presieves in the pretopology.
-/
def is_sheaf (P : Cᵒᵖ ⥤ Type w) : Prop :=
∀ ⦃X⦄ (S : sieve X), S ∈ J X → is_sheaf_for P S

lemma is_sheaf.is_sheaf_for {P : Cᵒᵖ ⥤ Type w} (hp : is_sheaf J P)
  (R : presieve X) (hr : generate R ∈ J X) : is_sheaf_for P R :=
(is_sheaf_for_iff_generate R).2 $ hp _ hr

lemma is_sheaf_of_le (P : Cᵒᵖ ⥤ Type w) {J₁ J₂ : grothendieck_topology C} :
  J₁ ≤ J₂ → is_sheaf J₂ P → is_sheaf J₁ P :=
λ h t X S hS, t S (h _ hS)

lemma is_separated_of_is_sheaf (P : Cᵒᵖ ⥤ Type w) (h : is_sheaf J P) : is_separated J P :=
λ X S hS, (h S hS).is_separated_for

/-- The property of being a sheaf is preserved by isomorphism. -/
lemma is_sheaf_iso {P' : Cᵒᵖ ⥤ Type w} (i : P ≅ P') (h : is_sheaf J P) : is_sheaf J P' :=
λ X S hS, is_sheaf_for_iso i (h S hS)

lemma is_sheaf_of_yoneda {P : Cᵒᵖ ⥤ Type v₁}
  (h : ∀ {X} (S : sieve X), S ∈ J X → yoneda_sheaf_condition P S) : is_sheaf J P :=
λ X S hS, is_sheaf_for_iff_yoneda_sheaf_condition.2 (h _ hS)

/--
For a topology generated by a basis, it suffices to check the sheaf condition on the basis
presieves only.
-/
lemma is_sheaf_pretopology [has_pullbacks C] (K : pretopology C) :
  is_sheaf (K.to_grothendieck C) P ↔ (∀ {X : C} (R : presieve X), R ∈ K X → is_sheaf_for P R) :=
begin
  split,
  { intros PJ X R hR,
    rw is_sheaf_for_iff_generate,
    apply PJ (sieve.generate R) ⟨_, hR, le_generate R⟩ },
  { rintro PK X S ⟨R, hR, RS⟩,
    have gRS : ⇑(generate R) ≤ S,
    { apply gi_generate.gc.monotone_u,
      rwa sets_iff_generate },
    apply is_sheaf_for_subsieve P gRS _,
    intros Y f,
    rw [← pullback_arrows_comm, ← is_sheaf_for_iff_generate],
    exact PK (pullback_arrows f R) (K.pullbacks f R hR) }
end

/-- Any presheaf is a sheaf for the bottom (trivial) grothendieck topology. -/
lemma is_sheaf_bot : is_sheaf (⊥ : grothendieck_topology C) P :=
λ X, by simp [is_sheaf_for_top_sieve]

end presieve

namespace equalizer

variables {C : Type u₁} [category.{v₁} C] (P : Cᵒᵖ ⥤ Type (max v₁ u₁))
  {X : C} (R : presieve X) (S : sieve X)

noncomputable theory

/--
The middle object of the fork diagram given in Equation (3) of [MM92], as well as the fork diagram
of <https://stacks.math.columbia.edu/tag/00VM>.
-/
def first_obj : Type (max v₁ u₁) :=
∏ (λ (f : Σ Y, {f : Y ⟶ X // R f}), P.obj (op f.1))

/-- Show that `first_obj` is isomorphic to `family_of_elements`. -/
@[simps]
def first_obj_eq_family : first_obj P R ≅ R.family_of_elements P :=
{ hom := λ t Y f hf, pi.π (λ (f : Σ Y, {f : Y ⟶ X // R f}), P.obj (op f.1)) ⟨_, _, hf⟩ t,
  inv := pi.lift (λ f x, x _ f.2.2),
  hom_inv_id' :=
  begin
    ext ⟨Y, f, hf⟩ p,
    simpa,
  end,
  inv_hom_id' :=
  begin
    ext x Y f hf,
    apply limits.types.limit.lift_π_apply',
  end }

instance : inhabited (first_obj P (⊥ : presieve X)) :=
((first_obj_eq_family P _).to_equiv).inhabited

/--
The left morphism of the fork diagram given in Equation (3) of [MM92], as well as the fork diagram
of <https://stacks.math.columbia.edu/tag/00VM>.
-/
def fork_map : P.obj (op X) ⟶ first_obj P R :=
pi.lift (λ f, P.map f.2.1.op)

/-!
This section establishes the equivalence between the sheaf condition of Equation (3) [MM92] and
the definition of `is_sheaf_for`.
-/
namespace sieve

/--
The rightmost object of the fork diagram of Equation (3) [MM92], which contains the data used
to check a family is compatible.
-/
def second_obj : Type (max v₁ u₁) :=
∏ (λ (f : Σ Y Z (g : Z ⟶ Y), {f' : Y ⟶ X // S f'}), P.obj (op f.2.1))

/-- The map `p` of Equations (3,4) [MM92]. -/
def first_map : first_obj P S ⟶ second_obj P S :=
pi.lift (λ fg, pi.π _ (⟨_, _, S.downward_closed fg.2.2.2.2 fg.2.2.1⟩ : Σ Y, {f : Y ⟶ X // S f}))

instance : inhabited (second_obj P (⊥ : sieve X)) := ⟨first_map _ _ default⟩

/-- The map `a` of Equations (3,4) [MM92]. -/
def second_map : first_obj P S ⟶ second_obj P S :=
pi.lift (λ fg, pi.π _ ⟨_, fg.2.2.2⟩ ≫ P.map fg.2.2.1.op)

lemma w : fork_map P S ≫ first_map P S = fork_map P S ≫ second_map P S :=
begin
  apply limit.hom_ext,
  rintro ⟨Y, Z, g, f, hf⟩,
  simp [first_map, second_map, fork_map],
end

/--
The family of elements given by `x : first_obj P S` is compatible iff `first_map` and `second_map`
map it to the same point.
-/
lemma compatible_iff (x : first_obj P S) :
  ((first_obj_eq_family P S).hom x).compatible ↔ first_map P S x = second_map P S x :=
begin
  rw presieve.compatible_iff_sieve_compatible,
  split,
  { intro t,
    ext ⟨Y, Z, g, f, hf⟩,
    simpa [first_map, second_map] using t _ g hf },
  { intros t Y Z f g hf,
    rw types.limit_ext_iff' at t,
    simpa [first_map, second_map] using t ⟨⟨Y, Z, g, f, hf⟩⟩ }
end

/-- `P` is a sheaf for `S`, iff the fork given by `w` is an equalizer. -/
lemma equalizer_sheaf_condition :
  presieve.is_sheaf_for P S ↔ nonempty (is_limit (fork.of_ι _ (w P S))) :=
begin
  rw [types.type_equalizer_iff_unique,
      ← equiv.forall_congr_left (first_obj_eq_family P S).to_equiv.symm],
  simp_rw ← compatible_iff,
  simp only [inv_hom_id_apply, iso.to_equiv_symm_fun],
  apply ball_congr,
  intros x tx,
  apply exists_unique_congr,
  intro t,
  rw ← iso.to_equiv_symm_fun,
  rw equiv.eq_symm_apply,
  split,
  { intros q,
    ext Y f hf,
    simpa [first_obj_eq_family, fork_map] using q _ _ },
  { intros q Y f hf,
    rw ← q,
    simp [first_obj_eq_family, fork_map] }
end

end sieve

/-!
This section establishes the equivalence between the sheaf condition of
https://stacks.math.columbia.edu/tag/00VM and the definition of `is_sheaf_for`.
-/
namespace presieve

variables [has_pullbacks C]

/--
The rightmost object of the fork diagram of https://stacks.math.columbia.edu/tag/00VM, which
contains the data used to check a family of elements for a presieve is compatible.
-/
def second_obj : Type (max v₁ u₁) :=
∏ (λ (fg : (Σ Y, {f : Y ⟶ X // R f}) × (Σ Z, {g : Z ⟶ X // R g})),
  P.obj (op (pullback fg.1.2.1 fg.2.2.1)))

/-- The map `pr₀*` of <https://stacks.math.columbia.edu/tag/00VL>. -/
def first_map : first_obj P R ⟶ second_obj P R :=
pi.lift (λ fg, pi.π _ _ ≫ P.map pullback.fst.op)

instance : inhabited (second_obj P (⊥ : presieve X)) := ⟨first_map _ _ default⟩

/-- The map `pr₁*` of <https://stacks.math.columbia.edu/tag/00VL>. -/
def second_map : first_obj P R ⟶ second_obj P R :=
pi.lift (λ fg, pi.π _ _ ≫ P.map pullback.snd.op)

lemma w : fork_map P R ≫ first_map P R = fork_map P R ≫ second_map P R :=
begin
  apply limit.hom_ext,
  rintro ⟨⟨Y, f, hf⟩, ⟨Z, g, hg⟩⟩,
  simp only [first_map, second_map, fork_map],
  simp only [limit.lift_π, limit.lift_π_assoc, assoc, fan.mk_π_app, subtype.coe_mk,
             subtype.val_eq_coe],
  rw [← P.map_comp, ← op_comp, pullback.condition],
  simp,
end

/--
The family of elements given by `x : first_obj P S` is compatible iff `first_map` and `second_map`
map it to the same point.
-/
lemma compatible_iff (x : first_obj P R) :
  ((first_obj_eq_family P R).hom x).compatible ↔ first_map P R x = second_map P R x :=
begin
  rw presieve.pullback_compatible_iff,
  split,
  { intro t,
    ext ⟨⟨Y, f, hf⟩, Z, g, hg⟩,
    simpa [first_map, second_map] using t hf hg },
  { intros t Y Z f g hf hg,
    rw types.limit_ext_iff' at t,
    simpa [first_map, second_map] using t ⟨⟨⟨Y, f, hf⟩, Z, g, hg⟩⟩ }
end

/--
`P` is a sheaf for `R`, iff the fork given by `w` is an equalizer.
See <https://stacks.math.columbia.edu/tag/00VM>.
-/
lemma sheaf_condition :
  R.is_sheaf_for P ↔ nonempty (is_limit (fork.of_ι _ (w P R))) :=
begin
  rw types.type_equalizer_iff_unique,
  erw ← equiv.forall_congr_left (first_obj_eq_family P R).to_equiv.symm,
  simp_rw [← compatible_iff, ← iso.to_equiv_fun, equiv.apply_symm_apply],
  apply ball_congr,
  intros x hx,
  apply exists_unique_congr,
  intros t,
  rw equiv.eq_symm_apply,
  split,
  { intros q,
    ext Y f hf,
    simpa [fork_map] using q _ _ },
  { intros q Y f hf,
    rw ← q,
    simp [fork_map] }
end

end presieve
end equalizer

variables {C : Type u₁} [category.{v₁} C]
variables (J : grothendieck_topology C)

/-- The category of sheaves on a grothendieck topology. -/
structure SheafOfTypes (J : grothendieck_topology C) : Type (max u₁ v₁ (w+1)) :=
(val : Cᵒᵖ ⥤ Type w)
(cond : presieve.is_sheaf J val)

namespace SheafOfTypes

variable {J}

/-- Morphisms between sheaves of types are just morphisms between the underlying presheaves. -/
@[ext]
structure hom (X Y : SheafOfTypes J) :=
(val : X.val ⟶ Y.val)

@[simps]
instance : category (SheafOfTypes J) :=
{ hom := hom,
  id := λ X, ⟨𝟙 _⟩,
  comp := λ X Y Z f g, ⟨f.val ≫ g.val⟩,
  id_comp' := λ X Y f, hom.ext _ _ $ id_comp _,
  comp_id' := λ X Y f, hom.ext _ _ $ comp_id _,
  assoc' := λ X Y Z W f g h, hom.ext _ _ $ assoc _ _ _ }

-- Let's make the inhabited linter happy...
instance (X : SheafOfTypes J) : inhabited (hom X X) := ⟨𝟙 X⟩

end SheafOfTypes

/-- The inclusion functor from sheaves to presheaves. -/
@[simps]
def SheafOfTypes_to_presheaf : SheafOfTypes J ⥤ (Cᵒᵖ ⥤ Type w) :=
{ obj := SheafOfTypes.val,
  map := λ X Y f, f.val,
  map_id' := λ X, rfl,
  map_comp' := λ X Y Z f g, rfl }

instance : full (SheafOfTypes_to_presheaf J) := { preimage := λ X Y f, ⟨f⟩ }
instance : faithful (SheafOfTypes_to_presheaf J) := {}

/--
The category of sheaves on the bottom (trivial) grothendieck topology is equivalent to the category
of presheaves.
-/
@[simps]
def SheafOfTypes_bot_equiv : SheafOfTypes (⊥ : grothendieck_topology C) ≌ (Cᵒᵖ ⥤ Type w) :=
{ functor := SheafOfTypes_to_presheaf _,
  inverse :=
  { obj := λ P, ⟨P, presieve.is_sheaf_bot⟩,
    map := λ P₁ P₂ f, (SheafOfTypes_to_presheaf _).preimage f },
  unit_iso :=
  { hom := { app := λ _, ⟨𝟙 _⟩ },
    inv := { app := λ _, ⟨𝟙 _⟩ } },
  counit_iso := iso.refl _ }

instance : inhabited (SheafOfTypes (⊥ : grothendieck_topology C)) :=
⟨SheafOfTypes_bot_equiv.inverse.obj ((functor.const _).obj punit)⟩

end category_theory


/-
Copyright (c) 2022 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import category_theory.balanced
import category_theory.limits.opposites
import data.set.opposite

/-!
# Separating and detecting sets

There are several non-equivalent notions of a generator of a category. Here, we consider two of
them:

* We say that `𝒢` is a separating set if the functors `C(G, -)` for `G ∈ 𝒢` are collectively
    faithful, i.e., if `h ≫ f = h ≫ g` for all `h` with domain in `𝒢` implies `f = g`.
* We say that `𝒢` is a detecting set if the functors `C(G, -)` collectively reflect isomorphisms,
    i.e., if any `h` with domain in `𝒢` uniquely factors through `f`, then `f` is an isomorphism.

There are, of course, also the dual notions of coseparating and codetecting sets.

## Main results

We
* define predicates `is_separating`, `is_coseparating`, `is_detecting` and `is_codetecting` on
  sets of objects;
* show that separating and coseparating are dual notions;
* show that detecting and codetecting are dual notions;
* show that if `C` has equalizers, then detecting implies separating;
* show that if `C` has coequalizers, then codetecting implies separating;
* show that if `C` is balanced, then separating implies detecting and coseparating implies
  codetecting;
* show that `∅` is separating if and only if `∅` is coseparating if and only if `C` is thin;
* show that `∅` is detecting if and only if `∅` is codetecting if and only if `C` is a groupoid;
* define predicates `is_separator`, `is_coseparator`, `is_detector` and `is_codetector` as the
  singleton counterparts to the definitions for sets above and restate the above results in this
  situation;
* show that `G` is a separator if and only if `coyoneda.obj (op G)` is faithful (and the dual);
* show that `G` is a detector if and only if `coyoneda.obj (op G)` reflects isomorphisms (and the
  dual).

## Future work

* We currently don't have any examples yet.
* We will want typeclasses `has_separator C` and similar.
* To state the Special Adjoint Functor Theorem, we will need to be able to talk about *small*
  separating sets.

-/

universes v u

open category_theory.limits opposite

namespace category_theory
variables {C : Type u} [category.{v} C]

/-- We say that `𝒢` is a separating set if the functors `C(G, -)` for `G ∈ 𝒢` are collectively
    faithful, i.e., if `h ≫ f = h ≫ g` for all `h` with domain in `𝒢` implies `f = g`. -/
def is_separating (𝒢 : set C) : Prop :=
∀ ⦃X Y : C⦄ (f g : X ⟶ Y), (∀ (G ∈ 𝒢) (h : G ⟶ X), h ≫ f = h ≫ g) → f = g

/-- We say that `𝒢` is a coseparating set if the functors `C(-, G)` for `G ∈ 𝒢` are collectively
    faithful, i.e., if `f ≫ h = g ≫ h` for all `h` with codomain in `𝒢` implies `f = g`. -/
def is_coseparating (𝒢 : set C) : Prop :=
∀ ⦃X Y : C⦄ (f g : X ⟶ Y), (∀ (G ∈ 𝒢) (h : Y ⟶ G), f ≫ h = g ≫ h) → f = g

/-- We say that `𝒢` is a detecting set if the functors `C(G, -)` collectively reflect isomorphisms,
    i.e., if any `h` with domain in `𝒢` uniquely factors through `f`, then `f` is an isomorphism. -/
def is_detecting (𝒢 : set C) : Prop :=
∀ ⦃X Y : C⦄ (f : X ⟶ Y), (∀ (G ∈ 𝒢) (h : G ⟶ Y), ∃! (h' : G ⟶ X), h' ≫ f = h) → is_iso f

/-- We say that `𝒢` is a codetecting set if the functors `C(-, G)` collectively reflect
    isomorphisms, i.e., if any `h` with codomain in `G` uniquely factors through `f`, then `f` is
    an isomorphism. -/
def is_codetecting (𝒢 : set C) : Prop :=
∀ ⦃X Y : C⦄ (f : X ⟶ Y), (∀ (G ∈ 𝒢) (h : X ⟶ G), ∃! (h' : Y ⟶ G), f ≫ h' = h) → is_iso f

section dual

lemma is_separating_op_iff (𝒢 : set C) : is_separating 𝒢.op ↔ is_coseparating 𝒢 :=
begin
  refine ⟨λ h𝒢 X Y f g hfg, _, λ h𝒢 X Y f g hfg, _⟩,
  { refine quiver.hom.op_inj (h𝒢 _ _ (λ G hG h, quiver.hom.unop_inj _)),
    simpa only [unop_comp, quiver.hom.unop_op] using hfg _ (set.mem_op.1 hG) _ },
  { refine quiver.hom.unop_inj (h𝒢 _ _ (λ G hG h, quiver.hom.op_inj _)),
    simpa only [op_comp, quiver.hom.op_unop] using hfg _ (set.op_mem_op.2 hG) _ }
end

lemma is_coseparating_op_iff (𝒢 : set C) : is_coseparating 𝒢.op ↔ is_separating 𝒢 :=
begin
  refine ⟨λ h𝒢 X Y f g hfg, _, λ h𝒢 X Y f g hfg, _⟩,
  { refine quiver.hom.op_inj (h𝒢 _ _ (λ G hG h, quiver.hom.unop_inj _)),
    simpa only [unop_comp, quiver.hom.unop_op] using hfg _ (set.mem_op.1 hG) _ },
  { refine quiver.hom.unop_inj (h𝒢 _ _ (λ G hG h, quiver.hom.op_inj _)),
    simpa only [op_comp, quiver.hom.op_unop] using hfg _ (set.op_mem_op.2 hG) _ }
end

lemma is_coseparating_unop_iff (𝒢 : set Cᵒᵖ) : is_coseparating 𝒢.unop ↔ is_separating 𝒢 :=
by rw [← is_separating_op_iff, set.unop_op]

lemma is_separating_unop_iff (𝒢 : set Cᵒᵖ) : is_separating 𝒢.unop ↔ is_coseparating 𝒢 :=
by rw [← is_coseparating_op_iff, set.unop_op]

lemma is_detecting_op_iff (𝒢 : set C) : is_detecting 𝒢.op ↔ is_codetecting 𝒢 :=
begin
  refine ⟨λ h𝒢 X Y f hf, _, λ h𝒢 X Y f hf, _⟩,
  { refine (is_iso_op_iff _).1 (h𝒢 _ (λ G hG h, _)),
    obtain ⟨t, ht, ht'⟩ := hf (unop G) (set.mem_op.1 hG) h.unop,
    exact ⟨t.op, quiver.hom.unop_inj ht, λ y hy,
      quiver.hom.unop_inj (ht' _ (quiver.hom.op_inj hy))⟩ },
  { refine (is_iso_unop_iff _).1 (h𝒢 _ (λ G hG h, _)),
    obtain ⟨t, ht, ht'⟩ := hf (op G) (set.op_mem_op.2 hG) h.op,
    refine ⟨t.unop, quiver.hom.op_inj ht, λ y hy, quiver.hom.op_inj (ht' _ _)⟩,
    exact quiver.hom.unop_inj (by simpa only using hy) }
end

lemma is_codetecting_op_iff (𝒢 : set C) : is_codetecting 𝒢.op ↔ is_detecting 𝒢 :=
begin
  refine ⟨λ h𝒢 X Y f hf, _, λ h𝒢 X Y f hf, _⟩,
  { refine (is_iso_op_iff _).1 (h𝒢 _ (λ G hG h, _)),
    obtain ⟨t, ht, ht'⟩ := hf (unop G) (set.mem_op.1 hG) h.unop,
    exact ⟨t.op, quiver.hom.unop_inj ht, λ y hy,
      quiver.hom.unop_inj (ht' _ (quiver.hom.op_inj hy))⟩ },
  { refine (is_iso_unop_iff _).1 (h𝒢 _ (λ G hG h, _)),
    obtain ⟨t, ht, ht'⟩ := hf (op G) (set.op_mem_op.2 hG) h.op,
    refine ⟨t.unop, quiver.hom.op_inj ht, λ y hy, quiver.hom.op_inj (ht' _ _)⟩,
    exact quiver.hom.unop_inj (by simpa only using hy) }
end

lemma is_detecting_unop_iff (𝒢 : set Cᵒᵖ) : is_detecting 𝒢.unop ↔ is_codetecting 𝒢 :=
by rw [← is_codetecting_op_iff, set.unop_op]

lemma is_codetecting_unop_iff {𝒢 : set Cᵒᵖ} : is_codetecting 𝒢.unop ↔ is_detecting 𝒢 :=
by rw [← is_detecting_op_iff, set.unop_op]

end dual

lemma is_detecting.is_separating [has_equalizers C] {𝒢 : set C} (h𝒢 : is_detecting 𝒢) :
  is_separating 𝒢 :=
λ X Y f g hfg,
  have is_iso (equalizer.ι f g), from h𝒢 _ (λ G hG h, equalizer.exists_unique _ (hfg _ hG _)),
  by exactI eq_of_epi_equalizer

section
local attribute [instance] has_equalizers_opposite

lemma is_codetecting.is_coseparating [has_coequalizers C] {𝒢 : set C} :
  is_codetecting 𝒢 → is_coseparating 𝒢 :=
by simpa only [← is_separating_op_iff, ← is_detecting_op_iff] using is_detecting.is_separating

end

lemma is_separating.is_detecting [balanced C] {𝒢 : set C} (h𝒢 : is_separating 𝒢) :
  is_detecting 𝒢 :=
begin
  intros X Y f hf,
  refine (is_iso_iff_mono_and_epi _).2 ⟨⟨λ Z g h hgh, h𝒢 _ _ (λ G hG i, _)⟩, ⟨λ Z g h hgh, _⟩⟩,
  { obtain ⟨t, -, ht⟩ := hf G hG (i ≫ g ≫ f),
    rw [ht (i ≫ g) (category.assoc _ _ _), ht (i ≫ h) (hgh.symm ▸ category.assoc _ _ _)] },
  { refine h𝒢 _ _ (λ G hG i, _),
    obtain ⟨t, rfl, -⟩ := hf G hG i,
    rw [category.assoc, hgh, category.assoc] }
end

section
local attribute [instance] balanced_opposite

lemma is_coseparating.is_codetecting [balanced C] {𝒢 : set C} :
  is_coseparating 𝒢 → is_codetecting 𝒢 :=
by simpa only [← is_detecting_op_iff, ← is_separating_op_iff] using is_separating.is_detecting

end

lemma is_detecting_iff_is_separating [has_equalizers C] [balanced C] (𝒢 : set C) :
  is_detecting 𝒢 ↔ is_separating 𝒢 :=
⟨is_detecting.is_separating, is_separating.is_detecting⟩

lemma is_codetecting_iff_is_coseparating [has_coequalizers C] [balanced C] {𝒢 : set C} :
  is_codetecting 𝒢 ↔ is_coseparating 𝒢 :=
⟨is_codetecting.is_coseparating, is_coseparating.is_codetecting⟩

section mono

lemma is_separating.mono {𝒢 : set C} (h𝒢 : is_separating 𝒢) {ℋ : set C} (h𝒢ℋ : 𝒢 ⊆ ℋ) :
  is_separating ℋ :=
λ X Y f g hfg, h𝒢 _ _ $ λ G hG h, hfg _ (h𝒢ℋ hG) _

lemma is_coseparating.mono {𝒢 : set C} (h𝒢 : is_coseparating 𝒢) {ℋ : set C} (h𝒢ℋ : 𝒢 ⊆ ℋ) :
  is_coseparating ℋ :=
λ X Y f g hfg, h𝒢 _ _ $ λ G hG h, hfg _ (h𝒢ℋ hG) _

lemma is_detecting.mono {𝒢 : set C} (h𝒢 : is_detecting 𝒢) {ℋ : set C} (h𝒢ℋ : 𝒢 ⊆ ℋ) :
  is_detecting ℋ :=
λ X Y f hf, h𝒢 _ $ λ G hG h, hf _ (h𝒢ℋ hG) _

lemma is_codetecting.mono {𝒢 : set C} (h𝒢 : is_codetecting 𝒢) {ℋ : set C} (h𝒢ℋ : 𝒢 ⊆ ℋ) :
  is_codetecting ℋ :=
λ X Y f hf, h𝒢 _ $ λ G hG h, hf _ (h𝒢ℋ hG) _

end mono

section empty

lemma thin_of_is_separating_empty (h : is_separating (∅ : set C)) (X Y : C) :
  subsingleton (X ⟶ Y) :=
⟨λ f g, h _ _ $ λ G, false.elim⟩

lemma is_separating_empty_of_thin [∀ X Y : C, subsingleton (X ⟶ Y)] : is_separating (∅ : set C) :=
λ X Y f g hfg, subsingleton.elim _ _

lemma is_coseparating_empty_of_thin [∀ X Y : C, subsingleton (X ⟶ Y)] :
  is_coseparating (∅ : set C) :=
λ X Y f g hfg, subsingleton.elim _ _

lemma groupoid_of_is_detecting_empty (h : is_detecting (∅ : set C)) {X Y : C} (f : X ⟶ Y) :
  is_iso f :=
h _ $ λ G, false.elim

lemma is_detecting_empty_of_groupoid [∀ {X Y : C} (f : X ⟶ Y), is_iso f] :
  is_detecting (∅ : set C) :=
λ X Y f hf, infer_instance

lemma groupoid_of_is_codetecting_empty (h : is_codetecting (∅ : set C)) {X Y : C} (f : X ⟶ Y) :
  is_iso f :=
h _ $ λ G, false.elim

lemma is_codetecting_empty_of_groupoid [∀ {X Y : C} (f : X ⟶ Y), is_iso f] :
  is_codetecting (∅ : set C) :=
λ X Y f hf, infer_instance

end empty

/-- We say that `G` is a separator if the functor `C(G, -)` is faithful. -/
def is_separator (G : C) : Prop :=
is_separating ({G} : set C)

/-- We say that `G` is a coseparator if the functor `C(-, G)` is faithful. -/
def is_coseparator (G : C) : Prop :=
is_coseparating ({G} : set C)

/-- We say that `G` is a detector if the functor `C(G, -)` reflects isomorphisms. -/
def is_detector (G : C) : Prop :=
is_detecting ({G} : set C)

/-- We say that `G` is a codetector if the functor `C(-, G)` reflects isomorphisms. -/
def is_codetector (G : C) : Prop :=
is_codetecting ({G} : set C)

section dual

lemma is_separator_op_iff (G : C) : is_separator (op G) ↔ is_coseparator G :=
by rw [is_separator, is_coseparator, ← is_separating_op_iff, set.singleton_op]

lemma is_coseparator_op_iff (G : C) : is_coseparator (op G) ↔ is_separator G :=
by rw [is_separator, is_coseparator, ← is_coseparating_op_iff, set.singleton_op]

lemma is_coseparator_unop_iff (G : Cᵒᵖ) : is_coseparator (unop G) ↔ is_separator G :=
by rw [is_separator, is_coseparator, ← is_coseparating_unop_iff, set.singleton_unop]

lemma is_separator_unop_iff (G : Cᵒᵖ) : is_separator (unop G) ↔ is_coseparator G :=
by rw [is_separator, is_coseparator, ← is_separating_unop_iff, set.singleton_unop]

lemma is_detector_op_iff (G : C) : is_detector (op G) ↔ is_codetector G :=
by rw [is_detector, is_codetector, ← is_detecting_op_iff, set.singleton_op]

lemma is_codetector_op_iff (G : C) : is_codetector (op G) ↔ is_detector G :=
by rw [is_detector, is_codetector, ← is_codetecting_op_iff, set.singleton_op]

lemma is_codetector_unop_iff (G : Cᵒᵖ) : is_codetector (unop G) ↔ is_detector G :=
by rw [is_detector, is_codetector, ← is_codetecting_unop_iff, set.singleton_unop]

lemma is_detector_unop_iff (G : Cᵒᵖ) : is_detector (unop G) ↔ is_codetector G :=
by rw [is_detector, is_codetector, ← is_detecting_unop_iff, set.singleton_unop]

end dual

lemma is_detector.is_separator [has_equalizers C] {G : C} : is_detector G → is_separator G :=
is_detecting.is_separating

lemma is_codetector.is_coseparator [has_coequalizers C] {G : C} :
  is_codetector G → is_coseparator G :=
is_codetecting.is_coseparating

lemma is_separator.is_detector [balanced C] {G : C} : is_separator G → is_detector G :=
is_separating.is_detecting

lemma is_cospearator.is_codetector [balanced C] {G : C} : is_coseparator G → is_codetector G :=
is_coseparating.is_codetecting

lemma is_separator_def (G : C) :
  is_separator G ↔ ∀ ⦃X Y : C⦄ (f g : X ⟶ Y), (∀ h : G ⟶ X, h ≫ f = h ≫ g) → f = g :=
⟨λ hG X Y f g hfg, hG _ _ $ λ H hH h, by { obtain rfl := set.mem_singleton_iff.1 hH, exact hfg h },
 λ hG X Y f g hfg, hG _ _ $ λ h, hfg _ (set.mem_singleton _) _⟩

lemma is_separator.def {G : C} :
  is_separator G → ∀ ⦃X Y : C⦄ (f g : X ⟶ Y), (∀ h : G ⟶ X, h ≫ f = h ≫ g) → f = g :=
(is_separator_def _).1

lemma is_coseparator_def (G : C) :
  is_coseparator G ↔ ∀ ⦃X Y : C⦄ (f g : X ⟶ Y), (∀ h : Y ⟶ G, f ≫ h = g ≫ h) → f = g :=
⟨λ hG X Y f g hfg, hG _ _ $ λ H hH h, by { obtain rfl := set.mem_singleton_iff.1 hH, exact hfg h },
 λ hG X Y f g hfg, hG _ _ $ λ h, hfg _ (set.mem_singleton _) _⟩

lemma is_coseparator.def {G : C} :
  is_coseparator G → ∀ ⦃X Y : C⦄ (f g : X ⟶ Y), (∀ h : Y ⟶ G, f ≫ h = g ≫ h) → f = g :=
(is_coseparator_def _).1

lemma is_detector_def (G : C) :
  is_detector G ↔ ∀ ⦃X Y : C⦄ (f : X ⟶ Y), (∀ h : G ⟶ Y, ∃! h', h' ≫ f = h) → is_iso f :=
⟨λ hG X Y f hf, hG _ $ λ H hH h, by { obtain rfl := set.mem_singleton_iff.1 hH, exact hf h },
 λ hG X Y f hf, hG _ $ λ h, hf _ (set.mem_singleton _) _⟩

lemma is_detector.def {G : C} :
  is_detector G → ∀ ⦃X Y : C⦄ (f : X ⟶ Y), (∀ h : G ⟶ Y, ∃! h', h' ≫ f = h) → is_iso f :=
(is_detector_def _).1

lemma is_codetector_def (G : C) :
  is_codetector G ↔ ∀ ⦃X Y : C⦄ (f : X ⟶ Y), (∀ h : X ⟶ G, ∃! h', f ≫ h' = h) → is_iso f :=
⟨λ hG X Y f hf, hG _ $ λ H hH h, by { obtain rfl := set.mem_singleton_iff.1 hH, exact hf h },
 λ hG X Y f hf, hG _ $ λ h, hf _ (set.mem_singleton _) _⟩

lemma is_codetector.def {G : C} :
  is_codetector G → ∀ ⦃X Y : C⦄ (f : X ⟶ Y), (∀ h : X ⟶ G, ∃! h', f ≫ h' = h) → is_iso f :=
(is_codetector_def _).1

lemma is_separator_iff_faithful_coyoneda_obj (G : C) :
  is_separator G ↔ faithful (coyoneda.obj (op G)) :=
⟨λ hG, ⟨λ X Y f g hfg, hG.def _ _ (congr_fun hfg)⟩,
 λ h, (is_separator_def _).2 $ λ X Y f g hfg,
  by exactI (coyoneda.obj (op G)).map_injective (funext hfg)⟩

lemma is_coseparator_iff_faithful_yoneda_obj (G : C) :
  is_coseparator G ↔ faithful (yoneda.obj G) :=
⟨λ hG, ⟨λ X Y f g hfg, quiver.hom.unop_inj (hG.def _ _ (congr_fun hfg))⟩,
 λ h, (is_coseparator_def _).2 $ λ X Y f g hfg, quiver.hom.op_inj $
  by exactI (yoneda.obj G).map_injective (funext hfg)⟩

lemma is_detector_iff_reflects_isomorphisms_coyoneda_obj (G : C) :
  is_detector G ↔ reflects_isomorphisms (coyoneda.obj (op G)) :=
begin
  refine ⟨λ hG, ⟨λ X Y f hf, hG.def _ (λ h, _)⟩, λ h, (is_detector_def _).2 (λ X Y f hf, _)⟩,
  { rw [is_iso_iff_bijective, function.bijective_iff_exists_unique] at hf,
    exact hf h },
  { suffices : is_iso ((coyoneda.obj (op G)).map f),
    { exactI @is_iso_of_reflects_iso _ _ _ _ _ _ _ (coyoneda.obj (op G)) _ h },
    rwa [is_iso_iff_bijective, function.bijective_iff_exists_unique] }
end

lemma is_codetector_iff_reflects_isomorphisms_yoneda_obj (G : C) :
  is_codetector G ↔ reflects_isomorphisms (yoneda.obj G) :=
begin
  refine ⟨λ hG, ⟨λ X Y f hf, _ ⟩, λ h, (is_codetector_def _).2 (λ X Y f hf, _)⟩,
  { refine (is_iso_unop_iff _).1 (hG.def _ _),
    rwa [is_iso_iff_bijective, function.bijective_iff_exists_unique] at hf },
  { rw ← is_iso_op_iff,
    suffices : is_iso ((yoneda.obj G).map f.op),
    { exactI @is_iso_of_reflects_iso _ _ _ _ _ _ _ (yoneda.obj G) _ h },
    rwa [is_iso_iff_bijective, function.bijective_iff_exists_unique] }
end

end category_theory


/-
Copyright (c) 2021 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot

! This file was ported from Lean 3 source module topology.algebra.valuation
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Algebra.Nonarchimedean.Bases
import Mathbin.Topology.Algebra.UniformFilterBasis
import Mathbin.RingTheory.Valuation.Basic

/-!
# The topology on a valued ring

In this file, we define the non archimedean topology induced by a valuation on a ring.
The main definition is a `valued` type class which equips a ring with a valuation taking
values in a group with zero. Other instances are then deduced from this.
-/

open Classical Topology uniformity

open Set Valuation

noncomputable section

universe v u

variable {R : Type u} [Ring R] {Γ₀ : Type v} [LinearOrderedCommGroupWithZero Γ₀]

namespace Valuation

variable (v : Valuation R Γ₀)

/-- The basis of open subgroups for the topology on a ring determined by a valuation. -/
theorem subgroups_basis : RingSubgroupsBasis fun γ : Γ₀ˣ => (v.ltAddSubgroup γ : AddSubgroup R) :=
  { inter := by
      rintro γ₀ γ₁
      use min γ₀ γ₁
      simp [Valuation.ltAddSubgroup] <;> tauto
    mul := by
      rintro γ
      cases' exists_square_le γ with γ₀ h
      use γ₀
      rintro - ⟨r, s, r_in, s_in, rfl⟩
      calc
        (v (r * s) : Γ₀) = v r * v s := Valuation.map_mul _ _ _
        _ < γ₀ * γ₀ := (mul_lt_mul₀ r_in s_in)
        _ ≤ γ := by exact_mod_cast h

    leftMul := by
      rintro x γ
      rcases GroupWithZero.eq_zero_or_unit (v x) with (Hx | ⟨γx, Hx⟩)
      · use (1 : Γ₀ˣ)
        rintro y (y_in : (v y : Γ₀) < 1)
        change v (x * y) < _
        rw [Valuation.map_mul, Hx, MulZeroClass.zero_mul]
        exact Units.zero_lt γ
      · simp only [image_subset_iff, set_of_subset_set_of, preimage_set_of_eq, Valuation.map_mul]
        use γx⁻¹ * γ
        rintro y (vy_lt : v y < ↑(γx⁻¹ * γ))
        change (v (x * y) : Γ₀) < γ
        rw [Valuation.map_mul, Hx, mul_comm]
        rw [Units.val_mul, mul_comm] at vy_lt
        simpa using mul_inv_lt_of_lt_mul₀ vy_lt
    rightMul := by
      rintro x γ
      rcases GroupWithZero.eq_zero_or_unit (v x) with (Hx | ⟨γx, Hx⟩)
      · use 1
        rintro y (y_in : (v y : Γ₀) < 1)
        change v (y * x) < _
        rw [Valuation.map_mul, Hx, MulZeroClass.mul_zero]
        exact Units.zero_lt γ
      · use γx⁻¹ * γ
        rintro y (vy_lt : v y < ↑(γx⁻¹ * γ))
        change (v (y * x) : Γ₀) < γ
        rw [Valuation.map_mul, Hx]
        rw [Units.val_mul, mul_comm] at vy_lt
        simpa using mul_inv_lt_of_lt_mul₀ vy_lt }
#align valuation.subgroups_basis Valuation.subgroups_basis

end Valuation

/-- A valued ring is a ring that comes equipped with a distinguished valuation. The class `valued`
is designed for the situation that there is a canonical valuation on the ring.

TODO: show that there always exists an equivalent valuation taking values in a type belonging to
the same universe as the ring.

See Note [forgetful inheritance] for why we extend `uniform_space`, `uniform_add_group`. -/
class Valued (R : Type u) [Ring R] (Γ₀ : outParam (Type v))
  [LinearOrderedCommGroupWithZero Γ₀] extends UniformSpace R, UniformAddGroup R where
  V : Valuation R Γ₀
  is_topological_valuation : ∀ s, s ∈ 𝓝 (0 : R) ↔ ∃ γ : Γ₀ˣ, { x : R | v x < γ } ⊆ s
#align valued Valued

attribute [nolint dangerous_instance] Valued.toUniformSpace

namespace Valued

/-- Alternative `valued` constructor for use when there is no preferred `uniform_space`
structure. -/
def mk' (v : Valuation R Γ₀) : Valued R Γ₀ :=
  { V
    toUniformSpace := @TopologicalAddGroup.toUniformSpace R _ v.subgroups_basis.topology _
    to_uniformAddGroup := @comm_topologicalAddGroup_is_uniform _ _ v.subgroups_basis.topology _
    is_topological_valuation :=
      by
      letI := @TopologicalAddGroup.toUniformSpace R _ v.subgroups_basis.topology _
      intro s
      rw [filter.has_basis_iff.mp v.subgroups_basis.has_basis_nhds_zero s]
      exact exists_congr fun γ => by simpa }
#align valued.mk' Valued.mk'

variable (R Γ₀) [_i : Valued R Γ₀]

include _i

theorem hasBasis_nhds_zero :
    (𝓝 (0 : R)).HasBasis (fun _ => True) fun γ : Γ₀ˣ => { x | v x < (γ : Γ₀) } := by
  simp [Filter.hasBasis_iff, is_topological_valuation]
#align valued.has_basis_nhds_zero Valued.hasBasis_nhds_zero

theorem hasBasis_uniformity :
    (𝓤 R).HasBasis (fun _ => True) fun γ : Γ₀ˣ => { p : R × R | v (p.2 - p.1) < (γ : Γ₀) } :=
  by
  rw [uniformity_eq_comap_nhds_zero]
  exact (has_basis_nhds_zero R Γ₀).comap _
#align valued.has_basis_uniformity Valued.hasBasis_uniformity

theorem toUniformSpace_eq :
    toUniformSpace = @TopologicalAddGroup.toUniformSpace R _ v.subgroups_basis.topology _ :=
  uniformSpace_eq
    ((hasBasis_uniformity R Γ₀).eq_of_same_basis <| v.subgroups_basis.hasBasis_nhds_zero.comap _)
#align valued.to_uniform_space_eq Valued.toUniformSpace_eq

variable {R Γ₀}

theorem mem_nhds {s : Set R} {x : R} : s ∈ 𝓝 x ↔ ∃ γ : Γ₀ˣ, { y | (v (y - x) : Γ₀) < γ } ⊆ s := by
  simp only [← nhds_translation_add_neg x, ← sub_eq_add_neg, preimage_set_of_eq, exists_true_left,
    ((has_basis_nhds_zero R Γ₀).comap fun y => y - x).mem_iff]
#align valued.mem_nhds Valued.mem_nhds

theorem mem_nhds_zero {s : Set R} : s ∈ 𝓝 (0 : R) ↔ ∃ γ : Γ₀ˣ, { x | v x < (γ : Γ₀) } ⊆ s := by
  simp only [mem_nhds, sub_zero]
#align valued.mem_nhds_zero Valued.mem_nhds_zero

theorem loc_const {x : R} (h : (v x : Γ₀) ≠ 0) : { y : R | v y = v x } ∈ 𝓝 x :=
  by
  rw [mem_nhds]
  rcases units.exists_iff_ne_zero.mpr h with ⟨γ, hx⟩
  use γ
  rw [hx]
  intro y y_in
  exact Valuation.map_eq_of_sub_lt _ y_in
#align valued.loc_const Valued.loc_const

instance (priority := 100) : TopologicalRing R :=
  (toUniformSpace_eq R Γ₀).symm ▸ v.subgroups_basis.toRingFilterBasis.is_topologicalRing

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (x y «expr ∈ » M) -/
theorem cauchy_iff {F : Filter R} :
    Cauchy F ↔
      F.ne_bot ∧ ∀ γ : Γ₀ˣ, ∃ M ∈ F, ∀ (x) (_ : x ∈ M) (y) (_ : y ∈ M), (v (y - x) : Γ₀) < γ :=
  by
  rw [to_uniform_space_eq, AddGroupFilterBasis.cauchy_iff]
  apply and_congr Iff.rfl
  simp_rw [valued.v.subgroups_basis.mem_add_group_filter_basis_iff]
  constructor
  · intro h γ
    exact h _ (valued.v.subgroups_basis.mem_add_group_filter_basis _)
  · rintro h - ⟨γ, rfl⟩
    exact h γ
#align valued.cauchy_iff Valued.cauchy_iff

end Valued