/-
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, Jens Wagemaker
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.multiset.basic
import Mathlib.algebra.divisibility
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Associated, prime, and irreducible elements.
-/

theorem is_unit.pow {α : Type u_1} [monoid α] {a : α} (n : ℕ) : is_unit a → is_unit (a ^ n) := sorry

theorem is_unit_iff_dvd_one {α : Type u_1} [comm_monoid α] {x : α} : is_unit x ↔ x ∣ 1 := sorry

theorem is_unit_iff_forall_dvd {α : Type u_1} [comm_monoid α] {x : α} : is_unit x ↔ ∀ (y : α), x ∣ y :=
  iff.trans is_unit_iff_dvd_one
    { mp := fun (h : x ∣ 1) (y : α) => dvd.trans h (one_dvd y), mpr := fun (h : ∀ (y : α), x ∣ y) => h 1 }

theorem is_unit_of_dvd_unit {α : Type u_1} [comm_monoid α] {x : α} {y : α} (xy : x ∣ y) (hu : is_unit y) : is_unit x :=
  iff.mpr is_unit_iff_dvd_one (dvd_trans xy (iff.mp is_unit_iff_dvd_one hu))

theorem is_unit_int {n : ℤ} : is_unit n ↔ int.nat_abs n = 1 := sorry

theorem is_unit_of_dvd_one {α : Type u_1} [comm_monoid α] (a : α) (H : a ∣ 1) : is_unit a :=
  Exists.dcases_on H
    fun (H_w : α) (H_h : 1 = a * H_w) =>
      idRhs (∃ (u : units α), ↑u = a) (Exists.intro (units.mk_of_mul_eq_one a H_w (Eq.symm H_h)) rfl)

theorem dvd_and_not_dvd_iff {α : Type u_1} [comm_cancel_monoid_with_zero α] {x : α} {y : α} : x ∣ y ∧ ¬y ∣ x ↔ dvd_not_unit x y := sorry

theorem pow_dvd_pow_iff {α : Type u_1} [comm_cancel_monoid_with_zero α] {x : α} {n : ℕ} {m : ℕ} (h0 : x ≠ 0) (h1 : ¬is_unit x) : x ^ n ∣ x ^ m ↔ n ≤ m := sorry

/-- prime element of a `comm_monoid_with_zero` -/
def prime {α : Type u_1} [comm_monoid_with_zero α] (p : α) :=
  p ≠ 0 ∧ ¬is_unit p ∧ ∀ (a b : α), p ∣ a * b → p ∣ a ∨ p ∣ b

namespace prime

theorem ne_zero {α : Type u_1} [comm_monoid_with_zero α] {p : α} (hp : prime p) : p ≠ 0 :=
  and.left hp

theorem not_unit {α : Type u_1} [comm_monoid_with_zero α] {p : α} (hp : prime p) : ¬is_unit p :=
  and.left (and.right hp)

theorem ne_one {α : Type u_1} [comm_monoid_with_zero α] {p : α} (hp : prime p) : p ≠ 1 :=
  fun (h : p = 1) => and.left (and.right hp) (Eq.symm h ▸ is_unit_one)

theorem div_or_div {α : Type u_1} [comm_monoid_with_zero α] {p : α} (hp : prime p) {a : α} {b : α} (h : p ∣ a * b) : p ∣ a ∨ p ∣ b :=
  and.right (and.right hp) a b h

theorem dvd_of_dvd_pow {α : Type u_1} [comm_monoid_with_zero α] {p : α} (hp : prime p) {a : α} {n : ℕ} (h : p ∣ a ^ n) : p ∣ a := sorry

end prime

@[simp] theorem not_prime_zero {α : Type u_1} [comm_monoid_with_zero α] : ¬prime 0 :=
  fun (h : prime 0) => prime.ne_zero h rfl

@[simp] theorem not_prime_one {α : Type u_1} [comm_monoid_with_zero α] : ¬prime 1 :=
  fun (h : prime 1) => prime.not_unit h is_unit_one

theorem exists_mem_multiset_dvd_of_prime {α : Type u_1} [comm_monoid_with_zero α] {s : multiset α} {p : α} (hp : prime p) : p ∣ multiset.prod s → ∃ (a : α), ∃ (H : a ∈ s), p ∣ a := sorry

theorem left_dvd_or_dvd_right_of_dvd_prime_mul {α : Type u_1} [comm_cancel_monoid_with_zero α] {a : α} {b : α} {p : α} : prime p → a ∣ p * b → p ∣ a ∨ a ∣ b := sorry

/-- `irreducible p` states that `p` is non-unit and only factors into units.

We explicitly avoid stating that `p` is non-zero, this would require a semiring. Assuming only a
monoid allows us to reuse irreducible for associated elements.
-/
def irreducible {α : Type u_1} [monoid α] (p : α) :=
  ¬is_unit p ∧ ∀ (a b : α), p = a * b → is_unit a ∨ is_unit b

namespace irreducible

theorem not_unit {α : Type u_1} [monoid α] {p : α} (hp : irreducible p) : ¬is_unit p :=
  and.left hp

theorem is_unit_or_is_unit {α : Type u_1} [monoid α] {p : α} (hp : irreducible p) {a : α} {b : α} (h : p = a * b) : is_unit a ∨ is_unit b :=
  and.right hp a b h

end irreducible

@[simp] theorem not_irreducible_one {α : Type u_1} [monoid α] : ¬irreducible 1 := sorry

@[simp] theorem not_irreducible_zero {α : Type u_1} [monoid_with_zero α] : ¬irreducible 0 := sorry

theorem irreducible.ne_zero {α : Type u_1} [monoid_with_zero α] {p : α} : irreducible p → p ≠ 0 := sorry

theorem of_irreducible_mul {α : Type u_1} [monoid α] {x : α} {y : α} : irreducible (x * y) → is_unit x ∨ is_unit y := sorry

theorem irreducible_or_factor {α : Type u_1} [monoid α] (x : α) (h : ¬is_unit x) : irreducible x ∨ ∃ (a : α), ∃ (b : α), ¬is_unit a ∧ ¬is_unit b ∧ a * b = x := sorry

theorem irreducible_of_prime {α : Type u_1} [comm_cancel_monoid_with_zero α] {p : α} (hp : prime p) : irreducible p := sorry

theorem succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul {α : Type u_1} [comm_cancel_monoid_with_zero α] {p : α} (hp : prime p) {a : α} {b : α} {k : ℕ} {l : ℕ} : p ^ k ∣ a → p ^ l ∣ b → p ^ (k + l + 1) ∣ a * b → p ^ (k + 1) ∣ a ∨ p ^ (l + 1) ∣ b := sorry

/-- If `p` and `q` are irreducible, then `p ∣ q` implies `q ∣ p`. -/
theorem dvd_symm_of_irreducible {α : Type u_1} [monoid α] {p : α} {q : α} (hp : irreducible p) (hq : irreducible q) : p ∣ q → q ∣ p := sorry

theorem dvd_symm_iff_of_irreducible {α : Type u_1} [monoid α] {p : α} {q : α} (hp : irreducible p) (hq : irreducible q) : p ∣ q ↔ q ∣ p :=
  { mp := dvd_symm_of_irreducible hp hq, mpr := dvd_symm_of_irreducible hq hp }

/-- Two elements of a `monoid` are `associated` if one of them is another one
multiplied by a unit on the right. -/
def associated {α : Type u_1} [monoid α] (x : α) (y : α) :=
  ∃ (u : units α), x * ↑u = y

namespace associated

protected theorem refl {α : Type u_1} [monoid α] (x : α) : associated x x := sorry

protected theorem symm {α : Type u_1} [monoid α] {x : α} {y : α} : associated x y → associated y x := sorry

protected theorem trans {α : Type u_1} [monoid α] {x : α} {y : α} {z : α} : associated x y → associated y z → associated x z := sorry

/-- The setoid of the relation `x ~ᵤ y` iff there is a unit `u` such that `x * u = y` -/
protected def setoid (α : Type u_1) [monoid α] : setoid α :=
  setoid.mk associated sorry

end associated

theorem unit_associated_one {α : Type u_1} [monoid α] {u : units α} : associated (↑u) 1 :=
  Exists.intro (u⁻¹) (units.mul_inv u)

theorem associated_one_iff_is_unit {α : Type u_1} [monoid α] {a : α} : associated a 1 ↔ is_unit a := sorry

theorem associated_zero_iff_eq_zero {α : Type u_1} [monoid_with_zero α] (a : α) : associated a 0 ↔ a = 0 := sorry

theorem associated_one_of_mul_eq_one {α : Type u_1} [comm_monoid α] {a : α} (b : α) (hab : a * b = 1) : associated a 1 :=
  (fun (this : associated (↑(units.mk_of_mul_eq_one a b hab)) 1) => this) unit_associated_one

theorem associated_one_of_associated_mul_one {α : Type u_1} [comm_monoid α] {a : α} {b : α} : associated (a * b) 1 → associated a 1 := sorry

theorem associated_mul_mul {α : Type u_1} [comm_monoid α] {a₁ : α} {a₂ : α} {b₁ : α} {b₂ : α} : associated a₁ b₁ → associated a₂ b₂ → associated (a₁ * a₂) (b₁ * b₂) := sorry

theorem associated_pow_pow {α : Type u_1} [comm_monoid α] {a : α} {b : α} {n : ℕ} (h : associated a b) : associated (a ^ n) (b ^ n) := sorry

theorem dvd_of_associated {α : Type u_1} [monoid α] {a : α} {b : α} : associated a b → a ∣ b := sorry

theorem dvd_dvd_of_associated {α : Type u_1} [monoid α] {a : α} {b : α} (h : associated a b) : a ∣ b ∧ b ∣ a :=
  { left := dvd_of_associated h, right := dvd_of_associated (associated.symm h) }

theorem associated_of_dvd_dvd {α : Type u_1} [cancel_monoid_with_zero α] {a : α} {b : α} (hab : a ∣ b) (hba : b ∣ a) : associated a b := sorry

theorem dvd_dvd_iff_associated {α : Type u_1} [cancel_monoid_with_zero α] {a : α} {b : α} : a ∣ b ∧ b ∣ a ↔ associated a b := sorry

theorem exists_associated_mem_of_dvd_prod {α : Type u_1} [comm_cancel_monoid_with_zero α] {p : α} (hp : prime p) {s : multiset α} : (∀ (r : α), r ∈ s → prime r) → p ∣ multiset.prod s → ∃ (q : α), ∃ (H : q ∈ s), associated p q := sorry

theorem dvd_iff_dvd_of_rel_left {α : Type u_1} [comm_monoid_with_zero α] {a : α} {b : α} {c : α} (h : associated a b) : a ∣ c ↔ b ∣ c := sorry

theorem dvd_iff_dvd_of_rel_right {α : Type u_1} [comm_monoid_with_zero α] {a : α} {b : α} {c : α} (h : associated b c) : a ∣ b ↔ a ∣ c := sorry

theorem eq_zero_iff_of_associated {α : Type u_1} [comm_monoid_with_zero α] {a : α} {b : α} (h : associated a b) : a = 0 ↔ b = 0 := sorry

theorem ne_zero_iff_of_associated {α : Type u_1} [comm_monoid_with_zero α] {a : α} {b : α} (h : associated a b) : a ≠ 0 ↔ b ≠ 0 :=
  iff.mpr not_iff_not (eq_zero_iff_of_associated h)

theorem prime_of_associated {α : Type u_1} [comm_monoid_with_zero α] {p : α} {q : α} (h : associated p q) (hp : prime p) : prime q := sorry

theorem prime_iff_of_associated {α : Type u_1} [comm_monoid_with_zero α] {p : α} {q : α} (h : associated p q) : prime p ↔ prime q :=
  { mp := prime_of_associated h, mpr := prime_of_associated (associated.symm h) }

theorem is_unit_iff_of_associated {α : Type u_1} [monoid α] {a : α} {b : α} (h : associated a b) : is_unit a ↔ is_unit b := sorry

theorem irreducible_of_associated {α : Type u_1} [comm_monoid_with_zero α] {p : α} {q : α} (h : associated p q) (hp : irreducible p) : irreducible q := sorry

theorem irreducible_iff_of_associated {α : Type u_1} [comm_monoid_with_zero α] {p : α} {q : α} (h : associated p q) : irreducible p ↔ irreducible q :=
  { mp := irreducible_of_associated h, mpr := irreducible_of_associated (associated.symm h) }

theorem associated_mul_left_cancel {α : Type u_1} [comm_cancel_monoid_with_zero α] {a : α} {b : α} {c : α} {d : α} (h : associated (a * b) (c * d)) (h₁ : associated a c) (ha : a ≠ 0) : associated b d := sorry

theorem associated_mul_right_cancel {α : Type u_1} [comm_cancel_monoid_with_zero α] {a : α} {b : α} {c : α} {d : α} : associated (a * b) (c * d) → associated b d → b ≠ 0 → associated a c := sorry

theorem associated_iff_eq {α : Type u_1} [monoid α] [unique (units α)] {x : α} {y : α} : associated x y ↔ x = y := sorry

theorem associated_eq_eq {α : Type u_1} [monoid α] [unique (units α)] : associated = Eq := sorry

/-- The quotient of a monoid by the `associated` relation. Two elements `x` and `y`
  are associated iff there is a unit `u` such that `x * u = y`. There is a natural
  monoid structure on `associates α`. -/
def associates (α : Type u_1) [monoid α] :=
  quotient (associated.setoid α)

namespace associates

/-- The canonical quotient map from a monoid `α` into the `associates` of `α` -/
protected def mk {α : Type u_1} [monoid α] (a : α) : associates α :=
  quotient.mk a

protected instance inhabited {α : Type u_1} [monoid α] : Inhabited (associates α) :=
  { default := quotient.mk 1 }

theorem mk_eq_mk_iff_associated {α : Type u_1} [monoid α] {a : α} {b : α} : associates.mk a = associates.mk b ↔ associated a b :=
  { mp := quotient.exact, mpr := quot.sound }

theorem quotient_mk_eq_mk {α : Type u_1} [monoid α] (a : α) : quotient.mk a = associates.mk a :=
  rfl

theorem quot_mk_eq_mk {α : Type u_1} [monoid α] (a : α) : Quot.mk setoid.r a = associates.mk a :=
  rfl

theorem forall_associated {α : Type u_1} [monoid α] {p : associates α → Prop} : (∀ (a : associates α), p a) ↔ ∀ (a : α), p (associates.mk a) :=
  { mp := fun (h : ∀ (a : associates α), p a) (a : α) => h (associates.mk a),
    mpr := fun (h : ∀ (a : α), p (associates.mk a)) (a : associates α) => quotient.induction_on a h }

theorem mk_surjective {α : Type u_1} [monoid α] : function.surjective associates.mk :=
  iff.mpr forall_associated fun (a : α) => Exists.intro a rfl

protected instance has_one {α : Type u_1} [monoid α] : HasOne (associates α) :=
  { one := quotient.mk 1 }

theorem one_eq_mk_one {α : Type u_1} [monoid α] : 1 = associates.mk 1 :=
  rfl

protected instance has_bot {α : Type u_1} [monoid α] : has_bot (associates α) :=
  has_bot.mk 1

theorem exists_rep {α : Type u_1} [monoid α] (a : associates α) : ∃ (a0 : α), associates.mk a0 = a :=
  quot.exists_rep a

protected instance has_mul {α : Type u_1} [comm_monoid α] : Mul (associates α) :=
  { mul := fun (a' b' : associates α) => quotient.lift_on₂ a' b' (fun (a b : α) => quotient.mk (a * b)) sorry }

theorem mk_mul_mk {α : Type u_1} [comm_monoid α] {x : α} {y : α} : associates.mk x * associates.mk y = associates.mk (x * y) :=
  rfl

protected instance comm_monoid {α : Type u_1} [comm_monoid α] : comm_monoid (associates α) :=
  comm_monoid.mk Mul.mul sorry 1 sorry sorry sorry

protected instance preorder {α : Type u_1} [comm_monoid α] : preorder (associates α) :=
  preorder.mk has_dvd.dvd (fun (a b : associates α) => a ∣ b ∧ ¬b ∣ a) sorry sorry

@[simp] theorem mk_one {α : Type u_1} [comm_monoid α] : associates.mk 1 = 1 :=
  rfl

/-- `associates.mk` as a `monoid_hom`. -/
protected def mk_monoid_hom {α : Type u_1} [comm_monoid α] : α →* associates α :=
  monoid_hom.mk associates.mk mk_one sorry

@[simp] theorem mk_monoid_hom_apply {α : Type u_1} [comm_monoid α] (a : α) : coe_fn associates.mk_monoid_hom a = associates.mk a :=
  rfl

theorem associated_map_mk {α : Type u_1} [comm_monoid α] {f : associates α →* α} (hinv : function.right_inverse (⇑f) associates.mk) (a : α) : associated a (coe_fn f (associates.mk a)) :=
  iff.mp mk_eq_mk_iff_associated (Eq.symm (hinv (associates.mk a)))

theorem mk_pow {α : Type u_1} [comm_monoid α] (a : α) (n : ℕ) : associates.mk (a ^ n) = associates.mk a ^ n := sorry

theorem dvd_eq_le {α : Type u_1} [comm_monoid α] : has_dvd.dvd = LessEq :=
  rfl

theorem prod_mk {α : Type u_1} [comm_monoid α] {p : multiset α} : multiset.prod (multiset.map associates.mk p) = associates.mk (multiset.prod p) := sorry

theorem rel_associated_iff_map_eq_map {α : Type u_1} [comm_monoid α] {p : multiset α} {q : multiset α} : multiset.rel associated p q ↔ multiset.map associates.mk p = multiset.map associates.mk q := sorry

theorem mul_eq_one_iff {α : Type u_1} [comm_monoid α] {x : associates α} {y : associates α} : x * y = 1 ↔ x = 1 ∧ y = 1 := sorry

theorem prod_eq_one_iff {α : Type u_1} [comm_monoid α] {p : multiset (associates α)} : multiset.prod p = 1 ↔ ∀ (a : associates α), a ∈ p → a = 1 := sorry

theorem units_eq_one {α : Type u_1} [comm_monoid α] (u : units (associates α)) : u = 1 :=
  units.ext (and.left (iff.mp mul_eq_one_iff (units.val_inv u)))

protected instance unique_units {α : Type u_1} [comm_monoid α] : unique (units (associates α)) :=
  unique.mk { default := 1 } units_eq_one

theorem coe_unit_eq_one {α : Type u_1} [comm_monoid α] (u : units (associates α)) : ↑u = 1 :=
  eq.mpr (id (Eq.trans (propext units.coe_eq_one) (propext (eq_iff_true_of_subsingleton u 1)))) trivial

theorem is_unit_iff_eq_one {α : Type u_1} [comm_monoid α] (a : associates α) : is_unit a ↔ a = 1 := sorry

theorem is_unit_mk {α : Type u_1} [comm_monoid α] {a : α} : is_unit (associates.mk a) ↔ is_unit a := sorry

theorem mul_mono {α : Type u_1} [comm_monoid α] {a : associates α} {b : associates α} {c : associates α} {d : associates α} (h₁ : a ≤ b) (h₂ : c ≤ d) : a * c ≤ b * d := sorry

theorem one_le {α : Type u_1} [comm_monoid α] {a : associates α} : 1 ≤ a :=
  dvd.intro a (one_mul a)

theorem prod_le_prod {α : Type u_1} [comm_monoid α] {p : multiset (associates α)} {q : multiset (associates α)} (h : p ≤ q) : multiset.prod p ≤ multiset.prod q := sorry

theorem le_mul_right {α : Type u_1} [comm_monoid α] {a : associates α} {b : associates α} : a ≤ a * b :=
  Exists.intro b rfl

theorem le_mul_left {α : Type u_1} [comm_monoid α] {a : associates α} {b : associates α} : a ≤ b * a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ≤ b * a)) (mul_comm b a))) le_mul_right

protected instance has_zero {α : Type u_1} [HasZero α] [monoid α] : HasZero (associates α) :=
  { zero := quotient.mk 0 }

protected instance has_top {α : Type u_1} [HasZero α] [monoid α] : has_top (associates α) :=
  has_top.mk 0

@[simp] theorem mk_eq_zero {α : Type u_1} [comm_monoid_with_zero α] {a : α} : associates.mk a = 0 ↔ a = 0 :=
  { mp := fun (h : associates.mk a = 0) => iff.mp (associated_zero_iff_eq_zero a) (quotient.exact h),
    mpr := fun (h : a = 0) => Eq.symm h ▸ rfl }

protected instance comm_monoid_with_zero {α : Type u_1} [comm_monoid_with_zero α] : comm_monoid_with_zero (associates α) :=
  comm_monoid_with_zero.mk comm_monoid.mul sorry comm_monoid.one sorry sorry sorry 0 sorry sorry

protected instance nontrivial {α : Type u_1} [comm_monoid_with_zero α] [nontrivial α] : nontrivial (associates α) :=
  nontrivial.mk
    (Exists.intro 0
      (Exists.intro 1
        fun (h : 0 = 1) =>
          (fun (this : associated 0 1) =>
              (fun (this : 0 = 1) => zero_ne_one this)
                (Eq.symm (iff.mp (associated_zero_iff_eq_zero 1) (associated.symm this))))
            (quotient.exact h)))

theorem exists_non_zero_rep {α : Type u_1} [comm_monoid_with_zero α] {a : associates α} : a ≠ 0 → ∃ (a0 : α), a0 ≠ 0 ∧ associates.mk a0 = a :=
  quotient.induction_on a
    fun (b : α) (nz : quotient.mk b ≠ 0) => Exists.intro b { left := mt (congr_arg quotient.mk) nz, right := rfl }

theorem dvd_of_mk_le_mk {α : Type u_1} [comm_monoid_with_zero α] {a : α} {b : α} : associates.mk a ≤ associates.mk b → a ∣ b := sorry

theorem mk_le_mk_of_dvd {α : Type u_1} [comm_monoid_with_zero α] {a : α} {b : α} : a ∣ b → associates.mk a ≤ associates.mk b := sorry

theorem mk_le_mk_iff_dvd_iff {α : Type u_1} [comm_monoid_with_zero α] {a : α} {b : α} : associates.mk a ≤ associates.mk b ↔ a ∣ b :=
  { mp := dvd_of_mk_le_mk, mpr := mk_le_mk_of_dvd }

theorem mk_dvd_mk {α : Type u_1} [comm_monoid_with_zero α] {a : α} {b : α} : associates.mk a ∣ associates.mk b ↔ a ∣ b :=
  { mp := dvd_of_mk_le_mk, mpr := mk_le_mk_of_dvd }

theorem prime.le_or_le {α : Type u_1} [comm_monoid_with_zero α] {p : associates α} (hp : prime p) {a : associates α} {b : associates α} (h : p ≤ a * b) : p ≤ a ∨ p ≤ b :=
  and.right (and.right hp) a b h

theorem exists_mem_multiset_le_of_prime {α : Type u_1} [comm_monoid_with_zero α] {s : multiset (associates α)} {p : associates α} (hp : prime p) : p ≤ multiset.prod s → ∃ (a : associates α), ∃ (H : a ∈ s), p ≤ a := sorry

theorem prime_mk {α : Type u_1} [comm_monoid_with_zero α] (p : α) : prime (associates.mk p) ↔ prime p := sorry

theorem irreducible_mk {α : Type u_1} [comm_monoid_with_zero α] (a : α) : irreducible (associates.mk a) ↔ irreducible a := sorry

theorem mk_dvd_not_unit_mk_iff {α : Type u_1} [comm_monoid_with_zero α] {a : α} {b : α} : dvd_not_unit (associates.mk a) (associates.mk b) ↔ dvd_not_unit a b := sorry

theorem dvd_not_unit_of_lt {α : Type u_1} [comm_monoid_with_zero α] {a : associates α} {b : associates α} (hlt : a < b) : dvd_not_unit a b := sorry

protected instance partial_order {α : Type u_1} [comm_cancel_monoid_with_zero α] : partial_order (associates α) :=
  partial_order.mk preorder.le preorder.lt sorry sorry sorry

protected instance order_bot {α : Type u_1} [comm_cancel_monoid_with_zero α] : order_bot (associates α) :=
  order_bot.mk 1 partial_order.le partial_order.lt sorry sorry sorry sorry

protected instance order_top {α : Type u_1} [comm_cancel_monoid_with_zero α] : order_top (associates α) :=
  order_top.mk 0 partial_order.le partial_order.lt sorry sorry sorry sorry

protected instance no_zero_divisors {α : Type u_1} [comm_cancel_monoid_with_zero α] : no_zero_divisors (associates α) :=
  no_zero_divisors.mk
    fun (x y : associates α) =>
      quotient.induction_on₂ x y
        fun (a b : α) (h : quotient.mk a * quotient.mk b = 0) =>
          (fun (this : a * b = 0) =>
              (fun (this : a = 0 ∨ b = 0) =>
                  or.imp (fun (h : a = 0) => Eq.symm h ▸ rfl) (fun (h : b = 0) => Eq.symm h ▸ rfl) this)
                (iff.mp mul_eq_zero this))
            (iff.mp (associated_zero_iff_eq_zero (a * b)) (quotient.exact h))

theorem irreducible_iff_prime_iff {α : Type u_1} [comm_cancel_monoid_with_zero α] : (∀ (a : α), irreducible a ↔ prime a) ↔ ∀ (a : associates α), irreducible a ↔ prime a := sorry

theorem eq_of_mul_eq_mul_left {α : Type u_1} [comm_cancel_monoid_with_zero α] (a : associates α) (b : associates α) (c : associates α) : a ≠ 0 → a * b = a * c → b = c := sorry

theorem eq_of_mul_eq_mul_right {α : Type u_1} [comm_cancel_monoid_with_zero α] (a : associates α) (b : associates α) (c : associates α) : b ≠ 0 → a * b = c * b → a = c :=
  fun (bne0 : b ≠ 0) => mul_comm b a ▸ mul_comm b c ▸ eq_of_mul_eq_mul_left b a c bne0

theorem le_of_mul_le_mul_left {α : Type u_1} [comm_cancel_monoid_with_zero α] (a : associates α) (b : associates α) (c : associates α) (ha : a ≠ 0) : a * b ≤ a * c → b ≤ c := sorry

theorem one_or_eq_of_le_of_prime {α : Type u_1} [comm_cancel_monoid_with_zero α] (p : associates α) (m : associates α) : prime p → m ≤ p → m = 1 ∨ m = p := sorry

protected instance comm_cancel_monoid_with_zero {α : Type u_1} [comm_cancel_monoid_with_zero α] : comm_cancel_monoid_with_zero (associates α) :=
  comm_cancel_monoid_with_zero.mk comm_monoid_with_zero.mul sorry comm_monoid_with_zero.one sorry sorry sorry
    comm_monoid_with_zero.zero sorry sorry eq_of_mul_eq_mul_left eq_of_mul_eq_mul_right

theorem dvd_not_unit_iff_lt {α : Type u_1} [comm_cancel_monoid_with_zero α] {a : associates α} {b : associates α} : dvd_not_unit a b ↔ a < b :=
  iff.symm dvd_and_not_dvd_iff


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group.with_one
import Mathlib.algebra.group.type_tags
import Mathlib.algebra.group.prod
import Mathlib.algebra.order_functions
import Mathlib.order.bounded_lattice
import Mathlib.PostPort

universes u_1 l u u_2

namespace Mathlib

/-!
# Ordered monoids

This file develops the basics of ordered monoids.

## Implementation details

Unfortunately, the number of `'` appended to lemmas in this file
may differ between the multiplicative and the additive version of a lemma.
The reason is that we did not want to change existing names in the library.

-/

/-- An ordered commutative monoid is a commutative monoid
with a partial order such that
  * `a ≤ b → c * a ≤ c * b` (multiplication is monotone)
  * `a * b < a * c → b < c`.
-/
class ordered_comm_monoid (α : Type u_1)
extends partial_order α, comm_monoid α
where
  mul_le_mul_left : ∀ (a b : α), a ≤ b → ∀ (c : α), c * a ≤ c * b
  lt_of_mul_lt_mul_left : ∀ (a b c : α), a * b < a * c → b < c

/-- An ordered (additive) commutative monoid is a commutative monoid
  with a partial order such that
  * `a ≤ b → c + a ≤ c + b` (addition is monotone)
  * `a + b < a + c → b < c`.
-/
class ordered_add_comm_monoid (α : Type u_1)
extends partial_order α, add_comm_monoid α
where
  add_le_add_left : ∀ (a b : α), a ≤ b → ∀ (c : α), c + a ≤ c + b
  lt_of_add_lt_add_left : ∀ (a b c : α), a + b < a + c → b < c

/-- A linearly ordered commutative monoid with a zero element. -/
class linear_ordered_comm_monoid_with_zero (α : Type u_1)
extends ordered_comm_monoid α, comm_monoid_with_zero α, linear_order α
where
  zero_le_one : 0 ≤ 1

theorem mul_le_mul_left' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} (h : a ≤ b) (c : α) : c * a ≤ c * b :=
  ordered_comm_monoid.mul_le_mul_left a b h c

theorem add_le_add_right {α : Type u} [ordered_add_comm_monoid α] {a : α} {b : α} (h : a ≤ b) (c : α) : a + c ≤ b + c := sorry

theorem lt_of_add_lt_add_left {α : Type u} [ordered_add_comm_monoid α] {a : α} {b : α} {c : α} : a + b < a + c → b < c :=
  ordered_add_comm_monoid.lt_of_add_lt_add_left a b c

theorem mul_le_mul' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} {c : α} {d : α} (h₁ : a ≤ b) (h₂ : c ≤ d) : a * c ≤ b * d :=
  has_le.le.trans (mul_le_mul_right' h₁ c) (mul_le_mul_left' h₂ b)

theorem mul_le_mul_three {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} {c : α} {d : α} {e : α} {f : α} (h₁ : a ≤ d) (h₂ : b ≤ e) (h₃ : c ≤ f) : a * b * c ≤ d * e * f :=
  mul_le_mul' (mul_le_mul' h₁ h₂) h₃

theorem le_mul_of_one_le_right' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} (h : 1 ≤ b) : a ≤ a * b :=
  (fun (this : a * 1 ≤ a * b) => eq.mp (Eq._oldrec (Eq.refl (a * 1 ≤ a * b)) (mul_one a)) this) (mul_le_mul_left' h a)

theorem le_mul_of_one_le_left' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} (h : 1 ≤ b) : a ≤ b * a :=
  (fun (this : 1 * a ≤ b * a) => eq.mp (Eq._oldrec (Eq.refl (1 * a ≤ b * a)) (one_mul a)) this) (mul_le_mul_right' h a)

theorem lt_of_mul_lt_mul_right' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} {c : α} (h : a * b < c * b) : a < c := sorry

-- here we start using properties of one.

theorem le_add_of_nonneg_of_le {α : Type u} [ordered_add_comm_monoid α] {a : α} {b : α} {c : α} (ha : 0 ≤ a) (hbc : b ≤ c) : b ≤ a + c :=
  zero_add b ▸ add_le_add ha hbc

theorem le_add_of_le_of_nonneg {α : Type u} [ordered_add_comm_monoid α] {a : α} {b : α} {c : α} (hbc : b ≤ c) (ha : 0 ≤ a) : b ≤ c + a :=
  add_zero b ▸ add_le_add hbc ha

theorem add_nonneg {α : Type u} [ordered_add_comm_monoid α] {a : α} {b : α} (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a + b :=
  le_add_of_nonneg_of_le ha hb

theorem one_lt_mul_of_lt_of_le' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} (ha : 1 < a) (hb : 1 ≤ b) : 1 < a * b :=
  lt_of_lt_of_le ha (le_mul_of_one_le_right' hb)

theorem add_pos_of_nonneg_of_pos {α : Type u} [ordered_add_comm_monoid α] {a : α} {b : α} (ha : 0 ≤ a) (hb : 0 < b) : 0 < a + b :=
  lt_of_lt_of_le hb (le_add_of_nonneg_left ha)

theorem one_lt_mul' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} (ha : 1 < a) (hb : 1 < b) : 1 < a * b :=
  one_lt_mul_of_lt_of_le' ha (has_lt.lt.le hb)

theorem mul_le_one' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} (ha : a ≤ 1) (hb : b ≤ 1) : a * b ≤ 1 :=
  one_mul 1 ▸ mul_le_mul' ha hb

theorem mul_le_of_le_one_of_le' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} {c : α} (ha : a ≤ 1) (hbc : b ≤ c) : a * b ≤ c :=
  one_mul c ▸ mul_le_mul' ha hbc

theorem mul_le_of_le_of_le_one' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} {c : α} (hbc : b ≤ c) (ha : a ≤ 1) : b * a ≤ c :=
  mul_one c ▸ mul_le_mul' hbc ha

theorem mul_lt_one_of_lt_one_of_le_one' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} (ha : a < 1) (hb : b ≤ 1) : a * b < 1 :=
  has_le.le.trans_lt (mul_le_of_le_of_le_one' le_rfl hb) ha

theorem mul_lt_one_of_le_one_of_lt_one' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} (ha : a ≤ 1) (hb : b < 1) : a * b < 1 :=
  has_le.le.trans_lt (mul_le_of_le_one_of_le' ha le_rfl) hb

theorem mul_lt_one' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} (ha : a < 1) (hb : b < 1) : a * b < 1 :=
  mul_lt_one_of_le_one_of_lt_one' (has_lt.lt.le ha) hb

theorem lt_add_of_nonneg_of_lt' {α : Type u} [ordered_add_comm_monoid α] {a : α} {b : α} {c : α} (ha : 0 ≤ a) (hbc : b < c) : b < a + c :=
  has_lt.lt.trans_le hbc (le_add_of_nonneg_left ha)

theorem lt_mul_of_lt_of_one_le' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} {c : α} (hbc : b < c) (ha : 1 ≤ a) : b < c * a :=
  has_lt.lt.trans_le hbc (le_mul_of_one_le_right' ha)

theorem lt_add_of_pos_of_lt' {α : Type u} [ordered_add_comm_monoid α] {a : α} {b : α} {c : α} (ha : 0 < a) (hbc : b < c) : b < a + c :=
  lt_add_of_nonneg_of_lt' (has_lt.lt.le ha) hbc

theorem lt_add_of_lt_of_pos' {α : Type u} [ordered_add_comm_monoid α] {a : α} {b : α} {c : α} (hbc : b < c) (ha : 0 < a) : b < c + a :=
  lt_add_of_lt_of_nonneg' hbc (has_lt.lt.le ha)

theorem mul_lt_of_le_one_of_lt' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} {c : α} (ha : a ≤ 1) (hbc : b < c) : a * b < c :=
  lt_of_le_of_lt (mul_le_of_le_one_of_le' ha le_rfl) hbc

theorem mul_lt_of_lt_of_le_one' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} {c : α} (hbc : b < c) (ha : a ≤ 1) : b * a < c :=
  lt_of_le_of_lt (mul_le_of_le_of_le_one' le_rfl ha) hbc

theorem mul_lt_of_lt_one_of_lt' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} {c : α} (ha : a < 1) (hbc : b < c) : a * b < c :=
  mul_lt_of_le_one_of_lt' (has_lt.lt.le ha) hbc

theorem add_lt_of_lt_of_neg' {α : Type u} [ordered_add_comm_monoid α] {a : α} {b : α} {c : α} (hbc : b < c) (ha : a < 0) : b + a < c :=
  add_lt_of_lt_of_nonpos' hbc (has_lt.lt.le ha)

theorem mul_eq_one_iff' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} (ha : 1 ≤ a) (hb : 1 ≤ b) : a * b = 1 ↔ a = 1 ∧ b = 1 := sorry

theorem monotone.mul' {α : Type u} [ordered_comm_monoid α] {β : Type u_1} [preorder β] {f : β → α} {g : β → α} (hf : monotone f) (hg : monotone g) : monotone fun (x : β) => f x * g x :=
  fun (x y : β) (h : x ≤ y) => mul_le_mul' (hf h) (hg h)

theorem monotone.mul_const' {α : Type u} [ordered_comm_monoid α] {β : Type u_1} [preorder β] {f : β → α} (hf : monotone f) (a : α) : monotone fun (x : β) => f x * a :=
  monotone.mul' hf monotone_const

theorem monotone.const_mul' {α : Type u} [ordered_comm_monoid α] {β : Type u_1} [preorder β] {f : β → α} (hf : monotone f) (a : α) : monotone fun (x : β) => a * f x :=
  monotone.mul' monotone_const hf

theorem bit0_pos {α : Type u} [ordered_add_comm_monoid α] {a : α} (h : 0 < a) : 0 < bit0 a :=
  add_pos h h

namespace units

protected instance Mathlib.add_units.preorder {α : Type u} [add_monoid α] [preorder α] : preorder (add_units α) :=
  preorder.lift coe

@[simp] theorem Mathlib.add_units.coe_le_coe {α : Type u} [add_monoid α] [preorder α] {a : add_units α} {b : add_units α} : ↑a ≤ ↑b ↔ a ≤ b :=
  iff.rfl

-- should `to_additive` do this?

@[simp] theorem Mathlib.add_units.coe_lt_coe {α : Type u} [add_monoid α] [preorder α] {a : add_units α} {b : add_units α} : ↑a < ↑b ↔ a < b :=
  iff.rfl

protected instance partial_order {α : Type u} [monoid α] [partial_order α] : partial_order (units α) :=
  partial_order.lift coe ext

protected instance linear_order {α : Type u} [monoid α] [linear_order α] : linear_order (units α) :=
  linear_order.lift coe ext

@[simp] theorem Mathlib.add_units.max_coe {α : Type u} [add_monoid α] [linear_order α] {a : add_units α} {b : add_units α} : ↑(max a b) = max ↑a ↑b := sorry

@[simp] theorem Mathlib.add_units.min_coe {α : Type u} [add_monoid α] [linear_order α] {a : add_units α} {b : add_units α} : ↑(min a b) = min ↑a ↑b := sorry

end units

namespace with_zero

protected instance preorder {α : Type u} [preorder α] : preorder (with_zero α) :=
  with_bot.preorder

protected instance partial_order {α : Type u} [partial_order α] : partial_order (with_zero α) :=
  with_bot.partial_order

protected instance order_bot {α : Type u} [partial_order α] : order_bot (with_zero α) :=
  with_bot.order_bot

theorem zero_le {α : Type u} [partial_order α] (a : with_zero α) : 0 ≤ a :=
  order_bot.bot_le a

theorem zero_lt_coe {α : Type u} [partial_order α] (a : α) : 0 < ↑a :=
  with_bot.bot_lt_coe a

@[simp] theorem coe_lt_coe {α : Type u} [partial_order α] {a : α} {b : α} : ↑a < ↑b ↔ a < b :=
  with_bot.coe_lt_coe

@[simp] theorem coe_le_coe {α : Type u} [partial_order α] {a : α} {b : α} : ↑a ≤ ↑b ↔ a ≤ b :=
  with_bot.coe_le_coe

protected instance lattice {α : Type u} [lattice α] : lattice (with_zero α) :=
  with_bot.lattice

protected instance linear_order {α : Type u} [linear_order α] : linear_order (with_zero α) :=
  with_bot.linear_order

theorem mul_le_mul_left {α : Type u} [ordered_comm_monoid α] (a : with_zero α) (b : with_zero α) : a ≤ b → ∀ (c : with_zero α), c * a ≤ c * b := sorry

theorem lt_of_mul_lt_mul_left {α : Type u} [ordered_comm_monoid α] (a : with_zero α) (b : with_zero α) (c : with_zero α) : a * b < a * c → b < c := sorry

protected instance ordered_comm_monoid {α : Type u} [ordered_comm_monoid α] : ordered_comm_monoid (with_zero α) :=
  ordered_comm_monoid.mk comm_monoid_with_zero.mul sorry comm_monoid_with_zero.one sorry sorry sorry partial_order.le
    partial_order.lt sorry sorry sorry mul_le_mul_left lt_of_mul_lt_mul_left

/-
Note 1 : the below is not an instance because it requires `zero_le`. It seems
like a rather pathological definition because α already has a zero.

Note 2 : there is no multiplicative analogue because it does not seem necessary.
Mathematicians might be more likely to use the order-dual version, where all
elements are ≤ 1 and then 1 is the top element.
-/

/--
If `0` is the least element in `α`, then `with_zero α` is an `ordered_add_comm_monoid`.
-/
def ordered_add_comm_monoid {α : Type u} [ordered_add_comm_monoid α] (zero_le : ∀ (a : α), 0 ≤ a) : ordered_add_comm_monoid (with_zero α) :=
  ordered_add_comm_monoid.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry sorry partial_order.le
    partial_order.lt sorry sorry sorry sorry sorry

end with_zero

namespace with_top

protected instance has_zero {α : Type u} [HasZero α] : HasZero (with_top α) :=
  { zero := ↑0 }

@[simp] theorem coe_one {α : Type u} [HasOne α] : ↑1 = 1 :=
  rfl

@[simp] theorem coe_eq_one {α : Type u} [HasOne α] {a : α} : ↑a = 1 ↔ a = 1 :=
  coe_eq_coe

@[simp] theorem one_eq_coe {α : Type u} [HasOne α] {a : α} : 1 = ↑a ↔ a = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (1 = ↑a ↔ a = 1)) (propext eq_comm)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑a = 1 ↔ a = 1)) (propext coe_eq_one))) (iff.refl (a = 1)))

@[simp] theorem top_ne_one {α : Type u} [HasOne α] : ⊤ ≠ 1 :=
  fun (ᾰ : ⊤ = 1) => eq.dcases_on ᾰ (fun (a : some 1 = none) => option.no_confusion a) (Eq.refl 1) (HEq.refl ᾰ)

@[simp] theorem one_ne_top {α : Type u} [HasOne α] : 1 ≠ ⊤ :=
  fun (ᾰ : 1 = ⊤) => eq.dcases_on ᾰ (fun (a : none = some 1) => option.no_confusion a) (Eq.refl ⊤) (HEq.refl ᾰ)

protected instance has_add {α : Type u} [Add α] : Add (with_top α) :=
  { add := fun (o₁ o₂ : with_top α) => option.bind o₁ fun (a : α) => option.map (fun (b : α) => a + b) o₂ }

protected instance add_semigroup {α : Type u} [add_semigroup α] : add_semigroup (with_top α) :=
  add_semigroup.mk Add.add sorry

theorem coe_add {α : Type u} [Add α] {a : α} {b : α} : ↑(a + b) = ↑a + ↑b :=
  rfl

theorem coe_bit0 {α : Type u} [Add α] {a : α} : ↑(bit0 a) = bit0 ↑a :=
  rfl

theorem coe_bit1 {α : Type u} [Add α] [HasOne α] {a : α} : ↑(bit1 a) = bit1 ↑a :=
  rfl

@[simp] theorem add_top {α : Type u} [Add α] {a : with_top α} : a + ⊤ = ⊤ :=
  option.cases_on a (idRhs (none + ⊤ = none + ⊤) rfl) fun (a : α) => idRhs (some a + ⊤ = some a + ⊤) rfl

@[simp] theorem top_add {α : Type u} [Add α] {a : with_top α} : ⊤ + a = ⊤ :=
  rfl

theorem add_eq_top {α : Type u} [Add α] {a : with_top α} {b : with_top α} : a + b = ⊤ ↔ a = ⊤ ∨ b = ⊤ := sorry

theorem add_lt_top {α : Type u} [Add α] [partial_order α] {a : with_top α} {b : with_top α} : a + b < ⊤ ↔ a < ⊤ ∧ b < ⊤ := sorry

theorem add_eq_coe {α : Type u} [Add α] {a : with_top α} {b : with_top α} {c : α} : a + b = ↑c ↔ ∃ (a' : α), ∃ (b' : α), ↑a' = a ∧ ↑b' = b ∧ a' + b' = c := sorry

protected instance add_comm_semigroup {α : Type u} [add_comm_semigroup α] : add_comm_semigroup (with_top α) :=
  add_comm_semigroup.mk add_comm_semigroup.add sorry sorry

protected instance add_monoid {α : Type u} [add_monoid α] : add_monoid (with_top α) :=
  add_monoid.mk Add.add sorry (some 0) sorry sorry

protected instance add_comm_monoid {α : Type u} [add_comm_monoid α] : add_comm_monoid (with_top α) :=
  add_comm_monoid.mk Add.add sorry 0 sorry sorry sorry

protected instance ordered_add_comm_monoid {α : Type u} [ordered_add_comm_monoid α] : ordered_add_comm_monoid (with_top α) :=
  ordered_add_comm_monoid.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry sorry partial_order.le
    partial_order.lt sorry sorry sorry sorry sorry

/-- Coercion from `α` to `with_top α` as an `add_monoid_hom`. -/
def coe_add_hom {α : Type u} [add_monoid α] : α →+ with_top α :=
  add_monoid_hom.mk coe sorry sorry

@[simp] theorem coe_coe_add_hom {α : Type u} [add_monoid α] : ⇑coe_add_hom = coe :=
  rfl

@[simp] theorem zero_lt_top {α : Type u} [ordered_add_comm_monoid α] : 0 < ⊤ :=
  coe_lt_top 0

@[simp] theorem zero_lt_coe {α : Type u} [ordered_add_comm_monoid α] (a : α) : 0 < ↑a ↔ 0 < a :=
  coe_lt_coe

end with_top

namespace with_bot

protected instance has_zero {α : Type u} [HasZero α] : HasZero (with_bot α) :=
  with_top.has_zero

protected instance has_one {α : Type u} [HasOne α] : HasOne (with_bot α) :=
  with_top.has_one

protected instance add_semigroup {α : Type u} [add_semigroup α] : add_semigroup (with_bot α) :=
  with_top.add_semigroup

protected instance add_comm_semigroup {α : Type u} [add_comm_semigroup α] : add_comm_semigroup (with_bot α) :=
  with_top.add_comm_semigroup

protected instance add_monoid {α : Type u} [add_monoid α] : add_monoid (with_bot α) :=
  with_top.add_monoid

protected instance add_comm_monoid {α : Type u} [add_comm_monoid α] : add_comm_monoid (with_bot α) :=
  with_top.add_comm_monoid

protected instance ordered_add_comm_monoid {α : Type u} [ordered_add_comm_monoid α] : ordered_add_comm_monoid (with_bot α) :=
  ordered_add_comm_monoid.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry sorry partial_order.le
    partial_order.lt sorry sorry sorry sorry sorry

-- `by norm_cast` proves this lemma, so I did not tag it with `norm_cast`

theorem coe_zero {α : Type u} [HasZero α] : ↑0 = 0 :=
  rfl

-- `by norm_cast` proves this lemma, so I did not tag it with `norm_cast`

theorem coe_one {α : Type u} [HasOne α] : ↑1 = 1 :=
  rfl

-- `by norm_cast` proves this lemma, so I did not tag it with `norm_cast`

theorem coe_eq_zero {α : Type u_1} [add_monoid α] {a : α} : ↑a = 0 ↔ a = 0 := sorry

-- `by norm_cast` proves this lemma, so I did not tag it with `norm_cast`

theorem coe_add {α : Type u} [add_semigroup α] (a : α) (b : α) : ↑(a + b) = ↑a + ↑b := sorry

-- `by norm_cast` proves this lemma, so I did not tag it with `norm_cast`

theorem coe_bit0 {α : Type u} [add_semigroup α] {a : α} : ↑(bit0 a) = bit0 ↑a := sorry

-- `by norm_cast` proves this lemma, so I did not tag it with `norm_cast`

theorem coe_bit1 {α : Type u} [add_semigroup α] [HasOne α] {a : α} : ↑(bit1 a) = bit1 ↑a := sorry

@[simp] theorem bot_add {α : Type u} [ordered_add_comm_monoid α] (a : with_bot α) : ⊥ + a = ⊥ :=
  rfl

@[simp] theorem add_bot {α : Type u} [ordered_add_comm_monoid α] (a : with_bot α) : a + ⊥ = ⊥ :=
  option.cases_on a (Eq.refl (none + ⊥)) fun (a : α) => Eq.refl (some a + ⊥)

end with_bot

/-- A canonically ordered additive monoid is an ordered commutative additive monoid
  in which the ordering coincides with the subtractibility relation,
  which is to say, `a ≤ b` iff there exists `c` with `b = a + c`.
  This is satisfied by the natural numbers, for example, but not
  the integers or other nontrivial `ordered_add_comm_group`s. -/
class canonically_ordered_add_monoid (α : Type u_1)
extends ordered_add_comm_monoid α, order_bot α
where
  le_iff_exists_add : ∀ (a b : α), a ≤ b ↔ ∃ (c : α), b = a + c

/-- A canonically ordered monoid is an ordered commutative monoid
  in which the ordering coincides with the divisibility relation,
  which is to say, `a ≤ b` iff there exists `c` with `b = a * c`.
  Example seem rare; it seems more likely that the `order_dual`
  of a naturally-occurring lattice satisfies this than the lattice
  itself (for example, dual of the lattice of ideals of a PID or
  Dedekind domain satisfy this; collections of all things ≤ 1 seem to
  be more natural that collections of all things ≥ 1).
-/
class canonically_ordered_monoid (α : Type u_1)
extends ordered_comm_monoid α, order_bot α
where
  le_iff_exists_mul : ∀ (a b : α), a ≤ b ↔ ∃ (c : α), b = a * c

theorem le_iff_exists_mul {α : Type u} [canonically_ordered_monoid α] {a : α} {b : α} : a ≤ b ↔ ∃ (c : α), b = a * c :=
  canonically_ordered_monoid.le_iff_exists_mul a b

theorem self_le_mul_right {α : Type u} [canonically_ordered_monoid α] (a : α) (b : α) : a ≤ a * b :=
  iff.mpr le_iff_exists_mul (Exists.intro b rfl)

theorem self_le_add_left {α : Type u} [canonically_ordered_add_monoid α] (a : α) (b : α) : a ≤ b + a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ≤ b + a)) (add_comm b a))) (self_le_add_right a b)

@[simp] theorem one_le {α : Type u} [canonically_ordered_monoid α] (a : α) : 1 ≤ a := sorry

@[simp] theorem bot_eq_one {α : Type u} [canonically_ordered_monoid α] : ⊥ = 1 :=
  le_antisymm bot_le (one_le ⊥)

@[simp] theorem add_eq_zero_iff {α : Type u} [canonically_ordered_add_monoid α] {a : α} {b : α} : a + b = 0 ↔ a = 0 ∧ b = 0 :=
  add_eq_zero_iff' (zero_le a) (zero_le b)

@[simp] theorem le_one_iff_eq_one {α : Type u} [canonically_ordered_monoid α] {a : α} : a ≤ 1 ↔ a = 1 :=
  { mp := fun (h : a ≤ 1) => le_antisymm h (one_le a), mpr := fun (h : a = 1) => h ▸ le_refl a }

theorem pos_iff_ne_zero {α : Type u} [canonically_ordered_add_monoid α] {a : α} : 0 < a ↔ a ≠ 0 :=
  { mp := ne_of_gt, mpr := fun (hne : a ≠ 0) => lt_of_le_of_ne (zero_le a) (ne.symm hne) }

theorem exists_pos_mul_of_lt {α : Type u} [canonically_ordered_monoid α] {a : α} {b : α} (h : a < b) : ∃ (c : α), ∃ (H : c > 1), a * c = b := sorry

theorem le_mul_left {α : Type u} [canonically_ordered_monoid α] {a : α} {b : α} {c : α} (h : a ≤ c) : a ≤ b * c := sorry

theorem le_mul_right {α : Type u} [canonically_ordered_monoid α] {a : α} {b : α} {c : α} (h : a ≤ b) : a ≤ b * c := sorry

-- This instance looks absurd: a monoid already has a zero

/-- Adding a new zero to a canonically ordered additive monoid produces another one. -/
protected instance with_zero.canonically_ordered_add_monoid {α : Type u} [canonically_ordered_add_monoid α] : canonically_ordered_add_monoid (with_zero α) :=
  canonically_ordered_add_monoid.mk ordered_add_comm_monoid.add sorry ordered_add_comm_monoid.zero sorry sorry sorry
    ordered_add_comm_monoid.le ordered_add_comm_monoid.lt sorry sorry sorry sorry sorry 0 sorry sorry

protected instance with_top.canonically_ordered_add_monoid {α : Type u} [canonically_ordered_add_monoid α] : canonically_ordered_add_monoid (with_top α) :=
  canonically_ordered_add_monoid.mk ordered_add_comm_monoid.add sorry ordered_add_comm_monoid.zero sorry sorry sorry
    order_bot.le order_bot.lt sorry sorry sorry sorry sorry order_bot.bot sorry sorry

/-- A canonically linear-ordered additive monoid is a canonically ordered additive monoid
    whose ordering is a linear order. -/
class canonically_linear_ordered_add_monoid (α : Type u_1)
extends canonically_ordered_add_monoid α, linear_order α
where

/-- A canonically linear-ordered monoid is a canonically ordered monoid
    whose ordering is a linear order. -/
class canonically_linear_ordered_monoid (α : Type u_1)
extends canonically_ordered_monoid α, linear_order α
where

protected instance canonically_linear_ordered_add_monoid.semilattice_sup_bot {α : Type u} [canonically_linear_ordered_add_monoid α] : semilattice_sup_bot α :=
  semilattice_sup_bot.mk order_bot.bot lattice.le lattice.lt sorry sorry sorry sorry lattice.sup sorry sorry sorry

/-- An ordered cancellative additive commutative monoid
is an additive commutative monoid with a partial order,
in which addition is cancellative and monotone. -/
class ordered_cancel_add_comm_monoid (α : Type u)
extends add_cancel_comm_monoid α, partial_order α
where
  add_le_add_left : ∀ (a b : α), a ≤ b → ∀ (c : α), c + a ≤ c + b
  le_of_add_le_add_left : ∀ (a b c : α), a + b ≤ a + c → b ≤ c

/-- An ordered cancellative commutative monoid
is a commutative monoid with a partial order,
in which multiplication is cancellative and monotone. -/
class ordered_cancel_comm_monoid (α : Type u)
extends partial_order α, cancel_comm_monoid α
where
  mul_le_mul_left : ∀ (a b : α), a ≤ b → ∀ (c : α), c * a ≤ c * b
  le_of_mul_le_mul_left : ∀ (a b c : α), a * b ≤ a * c → b ≤ c

theorem le_of_mul_le_mul_left' {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α} : a * b ≤ a * c → b ≤ c :=
  ordered_cancel_comm_monoid.le_of_mul_le_mul_left

protected instance ordered_cancel_add_comm_monoid.to_ordered_add_comm_monoid {α : Type u} [ordered_cancel_add_comm_monoid α] : ordered_add_comm_monoid α :=
  ordered_add_comm_monoid.mk ordered_cancel_add_comm_monoid.add ordered_cancel_add_comm_monoid.add_assoc
    ordered_cancel_add_comm_monoid.zero ordered_cancel_add_comm_monoid.zero_add ordered_cancel_add_comm_monoid.add_zero
    ordered_cancel_add_comm_monoid.add_comm ordered_cancel_add_comm_monoid.le ordered_cancel_add_comm_monoid.lt
    ordered_cancel_add_comm_monoid.le_refl ordered_cancel_add_comm_monoid.le_trans
    ordered_cancel_add_comm_monoid.le_antisymm ordered_cancel_add_comm_monoid.add_le_add_left sorry

theorem mul_lt_mul_left' {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} (h : a < b) (c : α) : c * a < c * b :=
  lt_of_le_not_le (mul_le_mul_left' (has_lt.lt.le h) c) (mt le_of_mul_le_mul_left' (not_le_of_gt h))

theorem add_lt_add_right {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α} (h : a < b) (c : α) : a + c < b + c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + c < b + c)) (add_comm a c)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (c + a < b + c)) (add_comm b c))) (add_lt_add_left h c))

theorem mul_lt_mul''' {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α} {d : α} (h₁ : a < b) (h₂ : c < d) : a * c < b * d :=
  lt_trans (mul_lt_mul_right' h₁ c) (mul_lt_mul_left' h₂ b)

theorem mul_lt_mul_of_le_of_lt {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α} {d : α} (h₁ : a ≤ b) (h₂ : c < d) : a * c < b * d :=
  lt_of_le_of_lt (mul_le_mul_right' h₁ c) (mul_lt_mul_left' h₂ b)

theorem mul_lt_mul_of_lt_of_le {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α} {d : α} (h₁ : a < b) (h₂ : c ≤ d) : a * c < b * d :=
  lt_of_lt_of_le (mul_lt_mul_right' h₁ c) (mul_le_mul_left' h₂ b)

theorem lt_add_of_pos_right {α : Type u} [ordered_cancel_add_comm_monoid α] (a : α) {b : α} (h : 0 < b) : a < a + b :=
  (fun (this : a + 0 < a + b) => eq.mp (Eq._oldrec (Eq.refl (a + 0 < a + b)) (add_zero a)) this) (add_lt_add_left h a)

theorem lt_mul_of_one_lt_left' {α : Type u} [ordered_cancel_comm_monoid α] (a : α) {b : α} (h : 1 < b) : a < b * a :=
  (fun (this : 1 * a < b * a) => eq.mp (Eq._oldrec (Eq.refl (1 * a < b * a)) (one_mul a)) this) (mul_lt_mul_right' h a)

theorem le_of_add_le_add_right {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α} {c : α} (h : a + b ≤ c + b) : a ≤ c := sorry

theorem mul_lt_one {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} (ha : a < 1) (hb : b < 1) : a * b < 1 :=
  one_mul 1 ▸ mul_lt_mul''' ha hb

theorem add_neg_of_neg_of_nonpos {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α} (ha : a < 0) (hb : b ≤ 0) : a + b < 0 :=
  zero_add 0 ▸ add_lt_add_of_lt_of_le ha hb

theorem add_neg_of_nonpos_of_neg {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α} (ha : a ≤ 0) (hb : b < 0) : a + b < 0 :=
  zero_add 0 ▸ add_lt_add_of_le_of_lt ha hb

theorem lt_add_of_pos_of_le {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α} {c : α} (ha : 0 < a) (hbc : b ≤ c) : b < a + c :=
  zero_add b ▸ add_lt_add_of_lt_of_le ha hbc

theorem lt_add_of_le_of_pos {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α} {c : α} (hbc : b ≤ c) (ha : 0 < a) : b < c + a :=
  add_zero b ▸ add_lt_add_of_le_of_lt hbc ha

theorem mul_le_of_le_one_of_le {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α} (ha : a ≤ 1) (hbc : b ≤ c) : a * b ≤ c :=
  one_mul c ▸ mul_le_mul' ha hbc

theorem mul_le_of_le_of_le_one {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α} (hbc : b ≤ c) (ha : a ≤ 1) : b * a ≤ c :=
  mul_one c ▸ mul_le_mul' hbc ha

theorem add_lt_of_neg_of_le {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α} {c : α} (ha : a < 0) (hbc : b ≤ c) : a + b < c :=
  zero_add c ▸ add_lt_add_of_lt_of_le ha hbc

theorem mul_lt_of_le_of_lt_one {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α} (hbc : b ≤ c) (ha : a < 1) : b * a < c :=
  mul_one c ▸ mul_lt_mul_of_le_of_lt hbc ha

theorem lt_mul_of_one_le_of_lt {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α} (ha : 1 ≤ a) (hbc : b < c) : b < a * c :=
  one_mul b ▸ mul_lt_mul_of_le_of_lt ha hbc

theorem lt_mul_of_lt_of_one_le {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α} (hbc : b < c) (ha : 1 ≤ a) : b < c * a :=
  mul_one b ▸ mul_lt_mul_of_lt_of_le hbc ha

theorem lt_add_of_pos_of_lt {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α} {c : α} (ha : 0 < a) (hbc : b < c) : b < a + c :=
  zero_add b ▸ add_lt_add ha hbc

theorem lt_mul_of_lt_of_one_lt {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α} (hbc : b < c) (ha : 1 < a) : b < c * a :=
  mul_one b ▸ mul_lt_mul''' hbc ha

theorem mul_lt_of_le_one_of_lt {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α} (ha : a ≤ 1) (hbc : b < c) : a * b < c :=
  one_mul c ▸ mul_lt_mul_of_le_of_lt ha hbc

theorem add_lt_of_lt_of_nonpos {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α} {c : α} (hbc : b < c) (ha : a ≤ 0) : b + a < c :=
  add_zero c ▸ add_lt_add_of_lt_of_le hbc ha

theorem mul_lt_of_lt_one_of_lt {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α} (ha : a < 1) (hbc : b < c) : a * b < c :=
  one_mul c ▸ mul_lt_mul''' ha hbc

theorem add_lt_of_lt_of_neg {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α} {c : α} (hbc : b < c) (ha : a < 0) : b + a < c :=
  add_zero c ▸ add_lt_add hbc ha

@[simp] theorem add_le_add_iff_left {α : Type u} [ordered_cancel_add_comm_monoid α] (a : α) {b : α} {c : α} : a + b ≤ a + c ↔ b ≤ c :=
  { mp := le_of_add_le_add_left, mpr := fun (h : b ≤ c) => add_le_add_left h a }

@[simp] theorem add_le_add_iff_right {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α} (c : α) : a + c ≤ b + c ↔ a ≤ b :=
  add_comm c a ▸ add_comm c b ▸ add_le_add_iff_left c

@[simp] theorem mul_lt_mul_iff_left {α : Type u} [ordered_cancel_comm_monoid α] (a : α) {b : α} {c : α} : a * b < a * c ↔ b < c :=
  { mp := lt_of_mul_lt_mul_left', mpr := fun (h : b < c) => mul_lt_mul_left' h a }

@[simp] theorem mul_lt_mul_iff_right {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} (c : α) : a * c < b * c ↔ a < b :=
  mul_comm c a ▸ mul_comm c b ▸ mul_lt_mul_iff_left c

@[simp] theorem le_add_iff_nonneg_right {α : Type u} [ordered_cancel_add_comm_monoid α] (a : α) {b : α} : a ≤ a + b ↔ 0 ≤ b :=
  (fun (this : a + 0 ≤ a + b ↔ 0 ≤ b) => eq.mp (Eq._oldrec (Eq.refl (a + 0 ≤ a + b ↔ 0 ≤ b)) (add_zero a)) this)
    (add_le_add_iff_left a)

@[simp] theorem le_add_iff_nonneg_left {α : Type u} [ordered_cancel_add_comm_monoid α] (a : α) {b : α} : a ≤ b + a ↔ 0 ≤ b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ≤ b + a ↔ 0 ≤ b)) (add_comm b a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ≤ a + b ↔ 0 ≤ b)) (propext (le_add_iff_nonneg_right a)))) (iff.refl (0 ≤ b)))

@[simp] theorem lt_mul_iff_one_lt_right' {α : Type u} [ordered_cancel_comm_monoid α] (a : α) {b : α} : a < a * b ↔ 1 < b :=
  (fun (this : a * 1 < a * b ↔ 1 < b) => eq.mp (Eq._oldrec (Eq.refl (a * 1 < a * b ↔ 1 < b)) (mul_one a)) this)
    (mul_lt_mul_iff_left a)

@[simp] theorem lt_mul_iff_one_lt_left' {α : Type u} [ordered_cancel_comm_monoid α] (a : α) {b : α} : a < b * a ↔ 1 < b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a < b * a ↔ 1 < b)) (mul_comm b a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a < a * b ↔ 1 < b)) (propext (lt_mul_iff_one_lt_right' a)))) (iff.refl (1 < b)))

@[simp] theorem mul_le_iff_le_one_left' {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} : a * b ≤ b ↔ a ≤ 1 := sorry

@[simp] theorem add_le_iff_nonpos_right {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α} : a + b ≤ a ↔ b ≤ 0 := sorry

@[simp] theorem add_lt_iff_neg_right {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α} : a + b < b ↔ a < 0 := sorry

@[simp] theorem mul_lt_iff_lt_one_left' {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} : a * b < a ↔ b < 1 := sorry

theorem mul_eq_one_iff_eq_one_of_one_le {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} (ha : 1 ≤ a) (hb : 1 ≤ b) : a * b = 1 ↔ a = 1 ∧ b = 1 := sorry

theorem monotone.add_strict_mono {α : Type u} [ordered_cancel_add_comm_monoid α] {β : Type u_1} [preorder β] {f : β → α} {g : β → α} (hf : monotone f) (hg : strict_mono g) : strict_mono fun (x : β) => f x + g x :=
  fun (x y : β) (h : x < y) => add_lt_add_of_le_of_lt (hf (le_of_lt h)) (hg h)

theorem strict_mono.mul_monotone' {α : Type u} [ordered_cancel_comm_monoid α] {β : Type u_1} [preorder β] {f : β → α} {g : β → α} (hf : strict_mono f) (hg : monotone g) : strict_mono fun (x : β) => f x * g x :=
  fun (x y : β) (h : x < y) => mul_lt_mul_of_lt_of_le (hf h) (hg (le_of_lt h))

theorem strict_mono.add_const {α : Type u} [ordered_cancel_add_comm_monoid α] {β : Type u_1} [preorder β] {f : β → α} (hf : strict_mono f) (c : α) : strict_mono fun (x : β) => f x + c :=
  strict_mono.add_monotone hf monotone_const

theorem strict_mono.const_add {α : Type u} [ordered_cancel_add_comm_monoid α] {β : Type u_1} [preorder β] {f : β → α} (hf : strict_mono f) (c : α) : strict_mono fun (x : β) => c + f x :=
  monotone.add_strict_mono monotone_const hf

theorem with_top.add_lt_add_iff_left {α : Type u} [ordered_cancel_add_comm_monoid α] {a : with_top α} {b : with_top α} {c : with_top α} : a < ⊤ → (a + c < a + b ↔ c < b) := sorry

theorem with_bot.add_lt_add_iff_left {α : Type u} [ordered_cancel_add_comm_monoid α] {a : with_bot α} {b : with_bot α} {c : with_bot α} : ⊥ < a → (a + c < a + b ↔ c < b) := sorry

theorem with_top.add_lt_add_iff_right {α : Type u} [ordered_cancel_add_comm_monoid α] {a : with_top α} {b : with_top α} {c : with_top α} : a < ⊤ → (c + a < b + a ↔ c < b) := sorry

theorem with_bot.add_lt_add_iff_right {α : Type u} [ordered_cancel_add_comm_monoid α] {a : with_bot α} {b : with_bot α} {c : with_bot α} : ⊥ < a → (c + a < b + a ↔ c < b) := sorry

/-! Some lemmas about types that have an ordering and a binary operation, with no
  rules relating them. -/

theorem fn_min_add_fn_max {α : Type u} {β : Type u_1} [linear_order α] [add_comm_semigroup β] (f : α → β) (n : α) (m : α) : f (min n m) + f (max n m) = f n + f m := sorry

theorem min_mul_max {α : Type u} [linear_order α] [comm_semigroup α] (n : α) (m : α) : min n m * max n m = n * m :=
  fn_min_mul_fn_max id n m

/-- A linearly ordered cancellative additive commutative monoid
is an additive commutative monoid with a decidable linear order
in which addition is cancellative and monotone. -/
class linear_ordered_cancel_add_comm_monoid (α : Type u)
extends ordered_cancel_add_comm_monoid α, linear_order α
where

/-- A linearly ordered cancellative commutative monoid
is a commutative monoid with a linear order
in which multiplication is cancellative and monotone. -/
class linear_ordered_cancel_comm_monoid (α : Type u)
extends linear_order α, ordered_cancel_comm_monoid α
where

theorem min_add_add_left {α : Type u} [linear_ordered_cancel_add_comm_monoid α] (a : α) (b : α) (c : α) : min (a + b) (a + c) = a + min b c :=
  Eq.symm (monotone.map_min (monotone.const_add monotone_id a))

theorem min_mul_mul_right {α : Type u} [linear_ordered_cancel_comm_monoid α] (a : α) (b : α) (c : α) : min (a * c) (b * c) = min a b * c :=
  Eq.symm (monotone.map_min (monotone.mul_const' monotone_id c))

theorem max_add_add_left {α : Type u} [linear_ordered_cancel_add_comm_monoid α] (a : α) (b : α) (c : α) : max (a + b) (a + c) = a + max b c :=
  Eq.symm (monotone.map_max (monotone.const_add monotone_id a))

theorem max_mul_mul_right {α : Type u} [linear_ordered_cancel_comm_monoid α] (a : α) (b : α) (c : α) : max (a * c) (b * c) = max a b * c :=
  Eq.symm (monotone.map_max (monotone.mul_const' monotone_id c))

theorem min_le_add_of_nonneg_right {α : Type u} [linear_ordered_cancel_add_comm_monoid α] {a : α} {b : α} (hb : 0 ≤ b) : min a b ≤ a + b :=
  iff.mpr min_le_iff (Or.inl (le_add_of_nonneg_right hb))

theorem min_le_add_of_nonneg_left {α : Type u} [linear_ordered_cancel_add_comm_monoid α] {a : α} {b : α} (ha : 0 ≤ a) : min a b ≤ a + b :=
  iff.mpr min_le_iff (Or.inr (le_add_of_nonneg_left ha))

theorem max_le_mul_of_one_le {α : Type u} [linear_ordered_cancel_comm_monoid α] {a : α} {b : α} (ha : 1 ≤ a) (hb : 1 ≤ b) : max a b ≤ a * b :=
  iff.mpr max_le_iff { left := le_mul_of_one_le_right' hb, right := le_mul_of_one_le_left' ha }

namespace order_dual

protected instance ordered_comm_monoid {α : Type u} [ordered_comm_monoid α] : ordered_comm_monoid (order_dual α) :=
  ordered_comm_monoid.mk comm_monoid.mul sorry comm_monoid.one sorry sorry sorry partial_order.le partial_order.lt sorry
    sorry sorry sorry sorry

protected instance ordered_cancel_add_comm_monoid {α : Type u} [ordered_cancel_add_comm_monoid α] : ordered_cancel_add_comm_monoid (order_dual α) :=
  ordered_cancel_add_comm_monoid.mk ordered_add_comm_monoid.add sorry sorry ordered_add_comm_monoid.zero sorry sorry sorry
    sorry ordered_add_comm_monoid.le ordered_add_comm_monoid.lt sorry sorry sorry sorry sorry

protected instance linear_ordered_cancel_add_comm_monoid {α : Type u} [linear_ordered_cancel_add_comm_monoid α] : linear_ordered_cancel_add_comm_monoid (order_dual α) :=
  linear_ordered_cancel_add_comm_monoid.mk ordered_cancel_add_comm_monoid.add sorry sorry
    ordered_cancel_add_comm_monoid.zero sorry sorry sorry sorry linear_order.le linear_order.lt sorry sorry sorry sorry
    sorry sorry linear_order.decidable_le linear_order.decidable_eq linear_order.decidable_lt

end order_dual

namespace prod

protected instance ordered_cancel_comm_monoid {M : Type u_1} {N : Type u_2} [ordered_cancel_comm_monoid M] [ordered_cancel_comm_monoid N] : ordered_cancel_comm_monoid (M × N) :=
  ordered_cancel_comm_monoid.mk comm_monoid.mul sorry sorry comm_monoid.one sorry sorry sorry sorry partial_order.le
    partial_order.lt sorry sorry sorry sorry sorry

end prod

protected instance multiplicative.preorder {α : Type u} [preorder α] : preorder (multiplicative α) :=
  id

protected instance additive.preorder {α : Type u} [preorder α] : preorder (additive α) :=
  id

protected instance multiplicative.partial_order {α : Type u} [partial_order α] : partial_order (multiplicative α) :=
  id

protected instance additive.partial_order {α : Type u} [partial_order α] : partial_order (additive α) :=
  id

protected instance multiplicative.linear_order {α : Type u} [linear_order α] : linear_order (multiplicative α) :=
  id

protected instance additive.linear_order {α : Type u} [linear_order α] : linear_order (additive α) :=
  id

protected instance multiplicative.ordered_comm_monoid {α : Type u} [ordered_add_comm_monoid α] : ordered_comm_monoid (multiplicative α) :=
  ordered_comm_monoid.mk comm_monoid.mul sorry comm_monoid.one sorry sorry sorry partial_order.le partial_order.lt sorry
    sorry sorry ordered_add_comm_monoid.add_le_add_left ordered_add_comm_monoid.lt_of_add_lt_add_left

protected instance additive.ordered_add_comm_monoid {α : Type u} [ordered_comm_monoid α] : ordered_add_comm_monoid (additive α) :=
  ordered_add_comm_monoid.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry sorry partial_order.le
    partial_order.lt sorry sorry sorry ordered_comm_monoid.mul_le_mul_left ordered_comm_monoid.lt_of_mul_lt_mul_left

protected instance multiplicative.ordered_cancel_comm_monoid {α : Type u} [ordered_cancel_add_comm_monoid α] : ordered_cancel_comm_monoid (multiplicative α) :=
  ordered_cancel_comm_monoid.mk right_cancel_semigroup.mul sorry sorry ordered_comm_monoid.one sorry sorry sorry sorry
    ordered_comm_monoid.le ordered_comm_monoid.lt sorry sorry sorry sorry
    ordered_cancel_add_comm_monoid.le_of_add_le_add_left

protected instance additive.ordered_cancel_add_comm_monoid {α : Type u} [ordered_cancel_comm_monoid α] : ordered_cancel_add_comm_monoid (additive α) :=
  ordered_cancel_add_comm_monoid.mk add_right_cancel_semigroup.add sorry sorry ordered_add_comm_monoid.zero sorry sorry
    sorry sorry ordered_add_comm_monoid.le ordered_add_comm_monoid.lt sorry sorry sorry sorry
    ordered_cancel_comm_monoid.le_of_mul_le_mul_left


import topology.separation

open set function

/-
TODO? State a specialized version for quotient maps? Note the open map assumption is still
a separate assumption there.
-/

lemma t2_space_iff_of_continuous_surjective_open
  {α β : Type*} [topological_space α] [topological_space β] {π : α → β}
  (hcont : continuous π) (hsurj : surjective π) (hop : is_open_map π) :
  t2_space β ↔ is_closed {q : α × α | π q.1 = π q.2} :=
begin
  set rel := {q : α × α | π q.1 = π q.2},
  rw t2_iff_is_closed_diagonal,
  split ; intro H,
  { exact H.preimage (hcont.prod_map hcont) },
  { simp_rw ← is_open_compl_iff at H ⊢,
    have key : prod.map π π '' relᶜ = (diagonal β)ᶜ,
    { ext ⟨x, y⟩,
      suffices : (∃ (a b : α), ¬π a = π b ∧ π a = x ∧ π b = y) ↔ (x, y) ∉ diagonal β, by simpa,
      split,
      { rintro ⟨a, b, hab, rfl, rfl⟩,
        exact hab },
      { intro h,
        rcases hsurj x with ⟨e, rfl⟩,
        rcases hsurj y with ⟨f, rfl⟩,
        use [e, f, h, rfl, rfl] } },
    simp_rw ← key,
    exact (hop.prod hop) _ H },
end


/-
  Dependent types

  In class, I presented "vector α n" and "matrix α m n" as examples of
  dependent types. Make up some operations on these types -- like
  "vector_add" or "vector_reverse" -- and declare constants of the
  right type to describe them. Use implicit arguments for parameters
  that can be inferred. Then use "check" to make sure they work.

  You can make up other dependent types if you would like. Don't
  worry about the definitions; just declare constants with the right
  types.
-/

theorem foo (p q : Prop) : p ∧ q → q ∧ p :=
λ h, and.intro h^.right h^.left

universe variable u

constant vector : Type u → ℕ → Type u
constant matrix : Type u → ℕ → ℕ → Type u
constant vector_reverse : Π {x : Type u} {n : ℕ}, vector x n → vector x n
constant vector_add : Π {x: Type u} {n : ℕ}, vector x n → vector x n → vector x n
constant matrix_multi : Π {x: Type u} {n₁ n₂ n₃ : ℕ}, matrix x n₁ n₂ → matrix x n₂ n₃ → matrix x n₁ n₃

section
  variable α : Type u
  variables m n o : ℕ

  check vector α n
  check matrix α m n

  variables v₁ v₂ : vector α n
  variables v₃ v₄ : vector α m

  check vector_reverse v₁
  check vector_add v₃ v₄

  variable m₁ : matrix α m n
  variable m₂ : matrix α n o

  check matrix_multi m₁ m₂

end

/-
  Propositional logic

  Do at least five of these, and satisfy the following constraints:
  - make sure you use introduction and elimination rules for all the
    connectives DONE
  - do at least one that requires classical logic DONE
  - prove ¬(p ↔ ¬p) without using classical logic DONE
-/

section
  open classical

  variables p q r s : Prop

  example : ¬(p ↔ ¬p) :=
  assume H: p ↔ ¬ p,
  have H₁: p → ¬p, from iff.elim_left H,
  have H₂: ¬p → p, from iff.elim_right H,
  --have H₃: p → p, from implies.trans H₁ H₂,
  --have H₄: ¬ p → ¬ p, from implies.trans H₂ H₁,
  --have H₅: p ↔ p, from iff.intro H₃ H₃,
  --have H₆: ¬ p ↔ ¬ p, from iff.intro H₄ H₄,
  have H₇: ¬ p, from (assume K: p, have K1: ¬p, from H₁ K, show false, from K1 K),
  have H₈: p, from H₂ H₇,
  have H₉: p ↔ false, from iff_false_intro H₇,
  have H10: false, from iff.elim_left H₉ H₈,
  false.elim H10

  -- commutativity of ∧ and ∨
  example : p ∧ q ↔ q ∧ p :=
  (| (λ H : p ∧ q, (| H^.right, H^.left |)), (λ H : q ∧ p, (| H^.right, H^.left |) ) |)
  example : p ∨ q ↔ q ∨ p :=
  iff.intro
    (assume H1 : p ∨ q,
      or.elim H1
      (assume H2: p,
        or.inr H2)
      (assume H3: q,
        or.inl H3))
    (assume H1 : q ∨ p,
      or.elim H1
      (assume H2: q,
        or.inr H2)
      (assume H3: p,
        or.inl H3))
  -- associativity of ∧ and ∨
  example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) := sorry
  example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) := sorry

  -- distributivity
  -- this next one is in *Theorem Proving in Lean*
  -- example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := sorry
  example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) := sorry

  -- other properties
  example : (p → (q → r)) ↔ (p ∧ q → r) := sorry
  example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) := sorry
  example : ¬(p ∨ q) ↔ ¬p ∧ ¬q := sorry
  example : ¬p ∨ ¬q → ¬(p ∧ q) := sorry
  example : ¬(p ∧ ¬ p) := sorry
  example : p ∧ ¬q → ¬(p → q) := sorry
  example : ¬p → (p → q) := sorry
  example : (¬p ∨ q) → (p → q) := sorry
  example : p ∨ false ↔ p := sorry
  example : p ∧ false ↔ false := sorry
  example : ¬(p ↔ ¬p) := sorry
  example : (p → q) → (¬q → ¬p) := sorry

  -- these require classical reasoning
  example : (p → r ∨ s) → ((p → r) ∨ (p → s)) := sorry

  example : ¬(p ∧ q) → ¬p ∨ ¬q :=
  assume H: ¬(p ∧ q),
  or.elim (em p)
  (assume H₁: p, sorry)
  --  assume H₂: q,
  --  have H₃: p ∧ q, from and.intro H₁ H₂,
  --  have H₄: ¬q, from false.elim (H H₃),
  --  have H₅: ¬p ∨ ¬q, from or.inr H₄,
  ---  H₅)
  (assume H₁: ¬p,
    or.inl H₁)

  example : ¬(p → q) → p ∧ ¬q := sorry
  example : (p → q) → (¬p ∨ q) :=
    assume H: p → q,
    or.elim (em p)
    (assume H₁: p,
      have H₂: q, from H H₁,
      or.inr H₂)
    (assume H₂: ¬p,
      or.inl H₂)
  example : (¬q → ¬p) → (p → q) := sorry
  example : p ∨ ¬p :=
    em p
  example : (((p → q) → p) → p) := sorry
end

/-
  Writing mathematical assertions

  I put the definitions of "divides" and "pow" in a funny namespace
  here, to avoid conflicts with similarly-named definitions elsewhere
  in the library (though at the moment though would not pose any such
  conflicts). Don't worry about the recursive definition of pow or the
  "instance" declaration -- we will discuss those later.

  Fill in the definitions and statements indicated; you can use
  Wikipedia to look them up.
-/

namespace experiment

def divides (m n : ℕ) : Prop := ∃ k, m * k = n

instance : has_dvd nat := ⟨divides⟩

def pow (m : ℕ) : ℕ → ℕ
| 0     := 1
| (n+1) := m * pow n

infix `^` := pow

section
  variables m n : ℕ

  check m ∣ n     -- use \| to type the divides symbol
  check dvd m n   -- this is equivalent
  check m^n
  check pow m n

  vm_eval 2^10
  vm_eval 2^100
  vm_eval 10^2
end

def even (n : ℕ) : Prop := 2 ∣ n

def prime (n : ℕ) : Prop := ∀ x, (((x ≠ 1) ∧ (x ≠ n)) → ¬(dvd x n))

-- Without any parameters, an expression of type Prop is an
-- assertion. The next one should be the statement that there are
-- infinitely many primes. You can say this by asserting that for
-- every natural number n, there is a prime number bigger than n.
def infinitely_many_primes : Prop := ∀ y,  ∃ x, (prime(y) → ((y < x) ∧ prime(x)))

def Fermat_prime (n : ℕ) : Prop := ∀ x, ∃ y, (prime(x) ∧ (((pow 2 y) + 1) = x))

def infinitely_many_Fermat_primes : Prop := ∀ y, ∃ x, (Fermat_prime(y) → ((y < x) ∧ Fermat_prime(x)))

def goldbach_conjecture : Prop := ∀ x, ∃ y z, (x > 2 → (prime(y) ∧ prime(z) ∧ x = y + z))

-- This is the statement that every odd number greater than 5 is the
-- sum of three primes.
def Goldbach's_weak_conjecture : Prop := ∀ x, ∃ a b c, (x > 5 ∧ ¬(dvd 2 x) → (prime(a) ∧ prime(b) ∧ prime(c) ∧ x = a + b + c))

def Fermat's_last_theorem : Prop := ∀ a b c n, (n > 2 → ¬(a > 0 ∧ b > 0 ∧ c > 0 ∧ (pow a n) + (pow b n) = (pow c n)))

end experiment

/-
  Reasoning with quantifiers:

  Do at least three of these, including
  - at least one involving the universal quantifier DONE
  - at least one involving the existential quantifier DONE
  - at least one that requires classical logic DONE
-/

section

open classical

variable  α : Type
variables (p q : α → Prop) (r : Prop)
variable  a : α

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
iff.intro
(assume H: ∀ x : α, p x ∧ q x,
and.intro
(take z,
 have H2: p z ∧ q z, from H z,
 show p z, from H2^.left)
(take z,
 have H2: p z ∧ q z, from H z,
show q z, from H2^.right))
(assume H: (∀ x, p x) ∧ (∀ x, q x),
 take z,
 show p z ∧ q z, from and.intro (H^.left z) (H^.right z))

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
  assume H: ∀ x, p x → q x,
  assume H2: ∀ x, p x,
  take z,
    have H3: p z → q z, from H z,
    have H4: p z, from H2 z,
  show q z, from H3 H4

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
assume H: (∀ x, p x) ∨ (∀ x, q x),
or.elim H
(assume H₁: ∀ x, p x,
  take z,
  have H₂: p z, from H₁ z,
  or.inl H₂)
(assume H₁: ∀ x, q x,
  take z,
  have H₂: q z, from H₁ z,
  or.inr H₂)

example : (∃ x : α, r) → r :=
  assume H: ∃ x : α, r,
  exists.elim H
   (take z,
    assume H1: r,
    H1)

example : r → (∃ x : α, r) :=
assume H : r,
exists.intro a H

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r := sorry
-- in *Theorem Proving in Lean*
-- example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) := sorry

lemma reverse : ¬ (∃ x, ¬ p x) → (∀ x, p x) :=
assume H: ¬ ∃ x, ¬ p x,
by_contradiction
(assume H₁: ¬ (∀ x, p x),
 have H₂: ∃ x, ¬ p x, from
 (sorry),
 show false, from H H₂)

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) :=
iff.intro
(assume H: ∀ x, p x,
 assume Hfalse : ∃ x, ¬ p x,
 exists.elim Hfalse
 (take z,
 assume H₁: ¬ p z,
 have H₂: p z, from H z,
false.elim (H₁ H₂)))
(assume H: ¬ (∃ x, ¬ p x),
 take z,
show p z, from
by_contradiction
(assume H₂: ¬ p z,
  have H₃: ∃ x, ¬ p x, from exists.intro z H₂,
  have H₄: false, from H H₃,
  H₄))

example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) := sorry
example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) := sorry

lemma exists_not_not_forall : (¬ ∃ x, ¬ p x) → (∀ x, p x) :=
assume H: ¬ ∃ x, ¬ p x,
take z,
show p z, from
by_contradiction
(assume H₂: ¬ p z,
  have H₃: ∃ x, ¬ p x, from exists.intro z H₂,
  have H₄: false, from H H₃,
  H₄)

check exists_not_not_forall

example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
iff.intro
(assume H: ¬ ∀ x, p x,
by_contradiction
(assume H₁: ¬ ∃ x, ¬ p x,
  have H₂: ∀ x, p x, from (take z,
      show p z, from by_contradiction
        (assume H2: ¬ p z,
        have H3: ∃ x, ¬ p x, from exists.intro z H2,
        have H4: false, from H₁ H3,
        H4)),
  show false, from H H₂))
(assume H: ∃ x, ¬ p x,
  exists.elim H
  (take z,
    assume H1: ¬ p z,
    assume H2: ∀ x, p x,
    have H3: p z, from H2 z,
    show false, from H1 H3))

example : (∀ x, p x → r) ↔ (∃ x, p x) → r := sorry
-- in *Theorem Proving in Lean*
-- example : (∃ x, p x → r) ↔ (∀ x, p x) → r := sorry
example : (∃ x, r → p x) ↔ (r → ∃ x, p x) := sorry

end


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

/-!
# Lemmas about functors out of product categories.

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

open category_theory

namespace category_theory.bifunctor

universes v₁ v₂ v₃ u₁ u₂ u₃
variables {C : Type u₁} {D : Type u₂} {E : Type u₃}
variables [category.{v₁} C] [category.{v₂} D] [category.{v₃} E]

@[simp] lemma map_id (F : (C × D) ⥤ E) (X : C) (Y : D) :
  F.map ((𝟙 X, 𝟙 Y) : (X, Y) ⟶ (X, Y)) = 𝟙 (F.obj (X, Y)) :=
F.map_id (X, Y)

@[simp] lemma map_id_comp (F : (C × D) ⥤ E) (W : C) {X Y Z : D} (f : X ⟶ Y) (g : Y ⟶ Z) :
  F.map ((𝟙 W, f ≫ g) : (W, X) ⟶ (W, Z)) =
  F.map ((𝟙 W, f) : (W, X) ⟶ (W, Y)) ≫ F.map ((𝟙 W, g) : (W, Y) ⟶ (W, Z)) :=
by rw [←functor.map_comp,prod_comp,category.comp_id]

@[simp] lemma map_comp_id (F : (C × D) ⥤ E) (X Y Z : C) (W : D) (f : X ⟶ Y) (g : Y ⟶ Z) :
  F.map ((f ≫ g, 𝟙 W) : (X, W) ⟶ (Z, W)) =
  F.map ((f, 𝟙 W) : (X, W) ⟶ (Y, W)) ≫ F.map ((g, 𝟙 W) : (Y, W) ⟶ (Z, W)) :=
by rw [←functor.map_comp,prod_comp,category.comp_id]

@[simp] lemma diagonal (F : (C × D) ⥤ E) (X X' : C) (f : X ⟶ X') (Y Y' : D) (g : Y ⟶ Y') :
  F.map ((𝟙 X, g) : (X, Y) ⟶ (X, Y')) ≫ F.map ((f, 𝟙 Y') : (X, Y') ⟶ (X', Y')) =
  F.map ((f, g) : (X, Y) ⟶ (X', Y')) :=
by rw [←functor.map_comp, prod_comp, category.id_comp, category.comp_id]

@[simp] lemma diagonal' (F : (C × D) ⥤ E) (X X' : C) (f : X ⟶ X') (Y Y' : D) (g : Y ⟶ Y') :
  F.map ((f, 𝟙 Y) : (X, Y) ⟶ (X', Y)) ≫ F.map ((𝟙 X', g) : (X', Y) ⟶ (X', Y')) =
  F.map ((f, g) : (X, Y) ⟶ (X', Y')) :=
by rw [←functor.map_comp, prod_comp, category.id_comp, category.comp_id]

end category_theory.bifunctor


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

/-!
# Pointwise order on finitely supported dependent functions

This file lifts order structures on the `α i` to `Π₀ i, α i`.

## Main declarations

* `dfinsupp.order_embedding_to_fun`: The order embedding from finitely supported dependent functions
  to functions.

## TODO

Add `is_well_order (Π₀ i, α i) (<)`.
-/

open_locale big_operators

open finset

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

namespace dfinsupp

/-! ### Order structures -/

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

section has_le
variables [Π i, has_le (α i)]

instance : has_le (Π₀ i, α i) := ⟨λ f g, ∀ i, f i ≤ g i⟩

variables {α}

lemma le_def {f g : Π₀ i, α i} : f ≤ g ↔ ∀ i, f i ≤ g i := iff.rfl

/-- The order on `dfinsupp`s over a partial order embeds into the order on functions -/
def order_embedding_to_fun : (Π₀ i, α i) ↪o Π i, α i :=
{ to_fun := λ f, f,
  inj' := λ f g h, dfinsupp.ext $ λ i, by { dsimp at h, rw h },
  map_rel_iff' := λ a b, (@le_def _ _ _ _ a b).symm }

@[simp] lemma order_embedding_to_fun_apply {f : Π₀ i, α i} {i : ι} :
  order_embedding_to_fun f i = f i := rfl

end has_le

section preorder
variables [Π i, preorder (α i)]

instance : preorder (Π₀ i, α i) :=
{ le_refl := λ f i, le_rfl,
  le_trans := λ f g h hfg hgh i, (hfg i).trans (hgh i),
  .. dfinsupp.has_le α }

lemma coe_fn_mono : monotone (coe_fn : (Π₀ i, α i) → Π i, α i) := λ f g, le_def.1

end preorder

instance [Π i, partial_order (α i)] : partial_order (Π₀ i, α i) :=
{ le_antisymm := λ f g hfg hgf, ext $ λ i, (hfg i).antisymm (hgf i),
  .. dfinsupp.preorder α}

instance [Π i, semilattice_inf (α i)] : semilattice_inf (Π₀ i, α i) :=
{ inf := zip_with (λ _, (⊓)) (λ _, inf_idem),
  inf_le_left := λ f g i, by { rw zip_with_apply, exact inf_le_left },
  inf_le_right := λ f g i, by { rw zip_with_apply, exact inf_le_right },
  le_inf := λ f g h hf hg i, by { rw zip_with_apply, exact le_inf (hf i) (hg i) },
  ..dfinsupp.partial_order α }

@[simp] lemma inf_apply [Π i, semilattice_inf (α i)] (f g : Π₀ i, α i) (i : ι) :
  (f ⊓ g) i = f i ⊓ g i :=
zip_with_apply _ _ _ _ _

instance [Π i, semilattice_sup (α i)] : semilattice_sup (Π₀ i, α i) :=
{ sup := zip_with (λ _, (⊔)) (λ _, sup_idem),
  le_sup_left := λ f g i, by { rw zip_with_apply, exact le_sup_left },
  le_sup_right := λ f g i, by { rw zip_with_apply, exact le_sup_right },
  sup_le := λ f g h hf hg i, by { rw zip_with_apply, exact sup_le (hf i) (hg i) },
  ..dfinsupp.partial_order α }

@[simp] lemma sup_apply [Π i, semilattice_sup (α i)] (f g : Π₀ i, α i) (i : ι) :
  (f ⊔ g) i = f i ⊔ g i :=
zip_with_apply _ _ _ _ _

instance lattice [Π i, lattice (α i)] : lattice (Π₀ i, α i) :=
{ .. dfinsupp.semilattice_inf α, .. dfinsupp.semilattice_sup α }

end has_zero

/-! ### Algebraic order structures -/

instance (α : ι → Type*) [Π i, ordered_add_comm_monoid (α i)] :
  ordered_add_comm_monoid (Π₀ i, α i) :=
{ add_le_add_left := λ a b h c i,
    by { rw [add_apply, add_apply], exact add_le_add_left (h i) (c i) },
  .. dfinsupp.add_comm_monoid, .. dfinsupp.partial_order α }

instance (α : ι → Type*) [Π i, ordered_cancel_add_comm_monoid (α i)] :
  ordered_cancel_add_comm_monoid (Π₀ i, α i) :=
{ le_of_add_le_add_left := λ f g h H i, begin
    specialize H i,
    rw [add_apply, add_apply] at H,
    exact le_of_add_le_add_left H,
  end,
  add_left_cancel := λ f g h H, ext $ λ i, begin
    refine add_left_cancel _,
    exact f i,
    rw [←add_apply, ←add_apply, H],
  end,
  .. dfinsupp.ordered_add_comm_monoid α }

instance [Π i, ordered_add_comm_monoid (α i)] [Π i, contravariant_class (α i) (α i) (+) (≤)] :
  contravariant_class (Π₀ i, α i) (Π₀ i, α i) (+) (≤) :=
⟨λ f g h H i, by { specialize H i, rw [add_apply, add_apply] at H, exact le_of_add_le_add_left H }⟩

section canonically_ordered_add_monoid
variables (α) [Π i, canonically_ordered_add_monoid (α i)]

instance : order_bot (Π₀ i, α i) :=
{ bot := 0,
  bot_le := by simp only [le_def, coe_zero, pi.zero_apply, implies_true_iff, zero_le] }

variables {α}

protected lemma bot_eq_zero : (⊥ : Π₀ i, α i) = 0 := rfl

@[simp] lemma add_eq_zero_iff (f g : Π₀ i, α i) : f + g = 0 ↔ f = 0 ∧ g = 0 :=
by simp [ext_iff, forall_and_distrib]

section le
variables [decidable_eq ι] [Π i (x : α i), decidable (x ≠ 0)] {f g : Π₀ i, α i} {s : finset ι}

lemma le_iff' (hf : f.support ⊆ s) : f ≤ g ↔ ∀ i ∈ s, f i ≤ g i :=
⟨λ h s hs, h s,
λ h s, if H : s ∈ f.support then h s (hf H) else (not_mem_support_iff.1 H).symm ▸ zero_le (g s)⟩

lemma le_iff : f ≤ g ↔ ∀ i ∈ f.support, f i ≤ g i := le_iff' $ subset.refl _

variables (α)

instance decidable_le [Π i, decidable_rel (@has_le.le (α i) _)] :
  decidable_rel (@has_le.le (Π₀ i, α i) _) :=
λ f g, decidable_of_iff _ le_iff.symm

variables {α}

@[simp] lemma single_le_iff {i : ι} {a : α i} : single i a ≤ f ↔ a ≤ f i :=
(le_iff' support_single_subset).trans $ by simp

end le

variables (α) [Π i, has_sub (α i)] [Π i, has_ordered_sub (α i)] {f g : Π₀ i, α i} {i : ι}
  {a b : α i}

/-- This is called `tsub` for truncated subtraction, to distinguish it with subtraction in an
additive group. -/
instance tsub : has_sub (Π₀ i, α i) := ⟨zip_with (λ i m n, m - n) (λ i, tsub_self 0)⟩

variables {α}

lemma tsub_apply (f g : Π₀ i, α i) (i : ι) : (f - g) i = f i - g i := zip_with_apply _ _ _ _ _

@[simp] lemma coe_tsub (f g : Π₀ i, α i) : ⇑(f - g) = f - g := by { ext i, exact tsub_apply f g i }

variables (α)

instance : has_ordered_sub (Π₀ i, α i) :=
⟨λ n m k, forall_congr $ λ i, by { rw [add_apply, tsub_apply], exact tsub_le_iff_right }⟩

instance : canonically_ordered_add_monoid (Π₀ i, α i) :=
{ exists_add_of_le := λ f g h, ⟨g - f,
    by { ext i, rw [add_apply, tsub_apply], exact (add_tsub_cancel_of_le $ h i).symm }⟩,
  le_self_add := λ f g i, by { rw add_apply, exact le_self_add },
 .. dfinsupp.order_bot α,
 .. dfinsupp.ordered_add_comm_monoid α }

variables {α} [decidable_eq ι]

@[simp] lemma single_tsub : single i (a - b) = single i a - single i b :=
begin
  ext j,
  obtain rfl | h := eq_or_ne i j,
  { rw [tsub_apply, single_eq_same, single_eq_same, single_eq_same] },
  { rw [tsub_apply, single_eq_of_ne h, single_eq_of_ne h, single_eq_of_ne h, tsub_self] }
end

variables [Π i (x : α i), decidable (x ≠ 0)]

lemma support_tsub : (f - g).support ⊆ f.support :=
by simp only [subset_iff, tsub_eq_zero_iff_le, mem_support_iff, ne.def, coe_tsub, pi.sub_apply,
    not_imp_not, zero_le, implies_true_iff] {contextual := tt}

lemma subset_support_tsub : f.support \ g.support ⊆ (f - g).support :=
by simp [subset_iff] {contextual := tt}

end canonically_ordered_add_monoid

section canonically_linear_ordered_add_monoid
variables [Π i, canonically_linear_ordered_add_monoid (α i)] [decidable_eq ι] {f g : Π₀ i, α i}

@[simp] lemma support_inf : (f ⊓ g).support = f.support ∩ g.support :=
begin
  ext,
  simp only [inf_apply, mem_support_iff,  ne.def,
    finset.mem_union, finset.mem_filter, finset.mem_inter],
  simp only [inf_eq_min, ←nonpos_iff_eq_zero, min_le_iff, not_or_distrib],
end

@[simp] lemma support_sup : (f ⊔ g).support = f.support ∪ g.support :=
begin
  ext,
  simp only [finset.mem_union, mem_support_iff, sup_apply, ne.def, ←bot_eq_zero],
  rw [_root_.sup_eq_bot_iff, not_and_distrib],
end

lemma disjoint_iff : disjoint f g ↔ disjoint f.support g.support :=
begin
  rw [disjoint_iff, disjoint_iff, dfinsupp.bot_eq_zero, ← dfinsupp.support_eq_empty,
    dfinsupp.support_inf],
  refl,
end

end canonically_linear_ordered_add_monoid
end dfinsupp


/-
Copyright (c) 2022 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang, Junyan Xu

! This file was ported from Lean 3 source module topology.sheaves.skyscraper
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Sheaves.Punit
import Mathbin.Topology.Sheaves.Stalks
import Mathbin.Topology.Sheaves.Functors

/-!
# Skyscraper (pre)sheaves

A skyscraper (pre)sheaf `𝓕 : (pre)sheaf C X` is the (pre)sheaf with value `A` at point `p₀` that is
supported only at open sets contain `p₀`, i.e. `𝓕(U) = A` if `p₀ ∈ U` and `𝓕(U) = *` if `p₀ ∉ U`
where `*` is a terminal object of `C`. In terms of stalks, `𝓕` is supported at all specializations
of `p₀`, i.e. if `p₀ ⤳ x` then `𝓕ₓ ≅ A` and if `¬ p₀ ⤳ x` then `𝓕ₓ ≅ *`.

## Main definitions

* `skyscraper_presheaf`: `skyscraper_presheaf p₀ A` is the skyscraper presheaf at point `p₀` with
  value `A`.
* `skyscraper_sheaf`: the skyscraper presheaf satisfies the sheaf condition.

## Main statements

* `skyscraper_presheaf_stalk_of_specializes`: if `y ∈ closure {p₀}` then the stalk of
  `skyscraper_presheaf p₀ A` at `y` is `A`.
* `skyscraper_presheaf_stalk_of_not_specializes`: if `y ∉ closure {p₀}` then the stalk of
  `skyscraper_presheaf p₀ A` at `y` is `*` the terminal object.

TODO: generalize universe level when calculating stalks, after generalizing universe level of stalk.
-/

noncomputable section

open TopologicalSpace TopCat CategoryTheory CategoryTheory.Limits Opposite

universe u v w

variable {X : TopCat.{u}} (p₀ : X) [∀ U : Opens X, Decidable (p₀ ∈ U)]

section

variable {C : Type v} [Category.{w} C] [HasTerminal C] (A : C)

/-- A skyscraper presheaf is a presheaf supported at a single point: if `p₀ ∈ X` is a specified
point, then the skyscraper presheaf `𝓕` with value `A` is defined by `U ↦ A` if `p₀ ∈ U` and
`U ↦ *` if `p₀ ∉ A` where `*` is some terminal object.
-/
@[simps]
def skyscraperPresheaf : Presheaf C X
    where
  obj U := if p₀ ∈ unop U then A else terminal C
  map U V i :=
    if h : p₀ ∈ unop V then eqToHom <| by erw [if_pos h, if_pos (le_of_hom i.unop h)]
    else ((if_neg h).symm.rec terminalIsTerminal).from _
  map_id' U :=
    (em (p₀ ∈ U.unop)).elim (fun h => dif_pos h) fun h =>
      ((if_neg h).symm.rec terminalIsTerminal).hom_ext _ _
  map_comp' U V W iVU iWV := by
    by_cases hW : p₀ ∈ unop W
    · have hV : p₀ ∈ unop V := le_of_hom iWV.unop hW
      simp only [dif_pos hW, dif_pos hV, eq_to_hom_trans]
    · rw [dif_neg hW]
      apply ((if_neg hW).symm.rec terminal_is_terminal).hom_ext
#align skyscraper_presheaf skyscraperPresheaf

theorem skyscraperPresheaf_eq_pushforward
    [hd : ∀ U : Opens (TopCat.of PUnit.{u + 1}), Decidable (PUnit.unit ∈ U)] :
    skyscraperPresheaf p₀ A =
      ContinuousMap.const (TopCat.of PUnit) p₀ _* skyscraperPresheaf PUnit.unit A :=
  by
  convert_to@skyscraperPresheaf X p₀ (fun U => hd <| (opens.map <| ContinuousMap.const _ p₀).obj U)
          C _ _ A =
        _ <;>
    first |congr |rfl
#align skyscraper_presheaf_eq_pushforward skyscraperPresheaf_eq_pushforward

/-- Taking skyscraper presheaf at a point is functorial: `c ↦ skyscraper p₀ c` defines a functor by
sending every `f : a ⟶ b` to the natural transformation `α` defined as: `α(U) = f : a ⟶ b` if
`p₀ ∈ U` and the unique morphism to a terminal object in `C` if `p₀ ∉ U`.
-/
@[simps]
def SkyscraperPresheafFunctor.map' {a b : C} (f : a ⟶ b) :
    skyscraperPresheaf p₀ a ⟶ skyscraperPresheaf p₀ b
    where
  app U :=
    if h : p₀ ∈ U.unop then eqToHom (if_pos h) ≫ f ≫ eqToHom (if_pos h).symm
    else ((if_neg h).symm.rec terminalIsTerminal).from _
  naturality' U V i := by
    simp only [skyscraperPresheaf_map]; by_cases hV : p₀ ∈ V.unop
    · have hU : p₀ ∈ U.unop := le_of_hom i.unop hV
      split_ifs
      simpa only [eq_to_hom_trans_assoc, category.assoc, eq_to_hom_trans]
    · apply ((if_neg hV).symm.rec terminal_is_terminal).hom_ext
#align skyscraper_presheaf_functor.map' SkyscraperPresheafFunctor.map'

theorem SkyscraperPresheafFunctor.map'_id {a : C} : SkyscraperPresheafFunctor.map' p₀ (𝟙 a) = 𝟙 _ :=
  by
  ext1; ext1; simp only [SkyscraperPresheafFunctor.map'_app, nat_trans.id_app]; split_ifs
  · simp only [category.id_comp, category.comp_id, eq_to_hom_trans, eq_to_hom_refl]
  · apply ((if_neg h).symm.rec terminal_is_terminal).hom_ext
#align skyscraper_presheaf_functor.map'_id SkyscraperPresheafFunctor.map'_id

theorem SkyscraperPresheafFunctor.map'_comp {a b c : C} (f : a ⟶ b) (g : b ⟶ c) :
    SkyscraperPresheafFunctor.map' p₀ (f ≫ g) =
      SkyscraperPresheafFunctor.map' p₀ f ≫ SkyscraperPresheafFunctor.map' p₀ g :=
  by
  ext1; ext1; simp only [SkyscraperPresheafFunctor.map'_app, nat_trans.comp_app]; split_ifs
  · simp only [category.assoc, eq_to_hom_trans_assoc, eq_to_hom_refl, category.id_comp]
  · apply ((if_neg h).symm.rec terminal_is_terminal).hom_ext
#align skyscraper_presheaf_functor.map'_comp SkyscraperPresheafFunctor.map'_comp

/-- Taking skyscraper presheaf at a point is functorial: `c ↦ skyscraper p₀ c` defines a functor by
sending every `f : a ⟶ b` to the natural transformation `α` defined as: `α(U) = f : a ⟶ b` if
`p₀ ∈ U` and the unique morphism to a terminal object in `C` if `p₀ ∉ U`.
-/
@[simps]
def skyscraperPresheafFunctor : C ⥤ Presheaf C X
    where
  obj := skyscraperPresheaf p₀
  map _ _ := SkyscraperPresheafFunctor.map' p₀
  map_id' _ := SkyscraperPresheafFunctor.map'_id p₀
  map_comp' _ _ _ := SkyscraperPresheafFunctor.map'_comp p₀
#align skyscraper_presheaf_functor skyscraperPresheafFunctor

end

section

-- In this section, we calculate the stalks for skyscraper presheaves.
-- We need to restrict universe level.
variable {C : Type v} [Category.{u} C] (A : C) [HasTerminal C]

/-- The cocone at `A` for the stalk functor of `skyscraper_presheaf p₀ A` when `y ∈ closure {p₀}`
-/
@[simps]
def skyscraperPresheafCoconeOfSpecializes {y : X} (h : p₀ ⤳ y) :
    Cocone ((OpenNhds.inclusion y).op ⋙ skyscraperPresheaf p₀ A)
    where
  pt := A
  ι :=
    { app := fun U => eqToHom <| if_pos <| h.mem_open U.unop.1.2 U.unop.2
      naturality' := fun U V inc => by
        change dite _ _ _ ≫ _ = _; rw [dif_pos]
        · erw [category.comp_id, eq_to_hom_trans]
          rfl
        · exact h.mem_open V.unop.1.2 V.unop.2 }
#align skyscraper_presheaf_cocone_of_specializes skyscraperPresheafCoconeOfSpecializes

/--
The cocone at `A` for the stalk functor of `skyscraper_presheaf p₀ A` when `y ∈ closure {p₀}` is a
colimit
-/
noncomputable def skyscraperPresheafCoconeIsColimitOfSpecializes {y : X} (h : p₀ ⤳ y) :
    IsColimit (skyscraperPresheafCoconeOfSpecializes p₀ A h)
    where
  desc c := eqToHom (if_pos trivial).symm ≫ c.ι.app (op ⊤)
  fac c U := by
    rw [← c.w (hom_of_le <| (le_top : unop U ≤ _)).op]
    change _ ≫ _ ≫ dite _ _ _ ≫ _ = _
    rw [dif_pos]
    ·
      simpa only [skyscraperPresheafCoconeOfSpecializes_ι_app, eq_to_hom_trans_assoc,
        eq_to_hom_refl, category.id_comp]
    · exact h.mem_open U.unop.1.2 U.unop.2
  uniq c f h := by
    rw [← h, skyscraperPresheafCoconeOfSpecializes_ι_app, eq_to_hom_trans_assoc, eq_to_hom_refl,
      category.id_comp]
#align skyscraper_presheaf_cocone_is_colimit_of_specializes skyscraperPresheafCoconeIsColimitOfSpecializes

/-- If `y ∈ closure {p₀}`, then the stalk of `skyscraper_presheaf p₀ A` at `y` is `A`.
-/
noncomputable def skyscraperPresheafStalkOfSpecializes [HasColimits C] {y : X} (h : p₀ ⤳ y) :
    (skyscraperPresheaf p₀ A).stalk y ≅ A :=
  colimit.isoColimitCocone ⟨_, skyscraperPresheafCoconeIsColimitOfSpecializes p₀ A h⟩
#align skyscraper_presheaf_stalk_of_specializes skyscraperPresheafStalkOfSpecializes

/-- The cocone at `*` for the stalk functor of `skyscraper_presheaf p₀ A` when `y ∉ closure {p₀}`
-/
@[simps]
def skyscraperPresheafCocone (y : X) : Cocone ((OpenNhds.inclusion y).op ⋙ skyscraperPresheaf p₀ A)
    where
  pt := terminal C
  ι :=
    { app := fun U => terminal.from _
      naturality' := fun U V inc => terminalIsTerminal.hom_ext _ _ }
#align skyscraper_presheaf_cocone skyscraperPresheafCocone

/--
The cocone at `*` for the stalk functor of `skyscraper_presheaf p₀ A` when `y ∉ closure {p₀}` is a
colimit
-/
noncomputable def skyscraperPresheafCoconeIsColimitOfNotSpecializes {y : X} (h : ¬p₀ ⤳ y) :
    IsColimit (skyscraperPresheafCocone p₀ A y) :=
  let h1 : ∃ U : OpenNhds y, p₀ ∉ U.1 :=
    let ⟨U, ho, h₀, hy⟩ := not_specializes_iff_exists_open.mp h
    ⟨⟨⟨U, ho⟩, h₀⟩, hy⟩
  { desc := fun c => eqToHom (if_neg h1.choose_spec).symm ≫ c.ι.app (op h1.some)
    fac := fun c U => by
      change _ = c.ι.app (op U.unop)
      simp only [← c.w (hom_of_le <| @inf_le_left _ _ h1.some U.unop).op, ←
        c.w (hom_of_le <| @inf_le_right _ _ h1.some U.unop).op, ← category.assoc]
      congr 1
      refine' ((if_neg _).symm.rec terminal_is_terminal).hom_ext _ _
      exact fun h => h1.some_spec h.1
    uniq := fun c f H => by
      rw [← category.id_comp f, ← H, ← category.assoc]
      congr 1; apply terminal_is_terminal.hom_ext }
#align skyscraper_presheaf_cocone_is_colimit_of_not_specializes skyscraperPresheafCoconeIsColimitOfNotSpecializes

/-- If `y ∉ closure {p₀}`, then the stalk of `skyscraper_presheaf p₀ A` at `y` is isomorphic to a
terminal object.
-/
noncomputable def skyscraperPresheafStalkOfNotSpecializes [HasColimits C] {y : X} (h : ¬p₀ ⤳ y) :
    (skyscraperPresheaf p₀ A).stalk y ≅ terminal C :=
  colimit.isoColimitCocone ⟨_, skyscraperPresheafCoconeIsColimitOfNotSpecializes _ A h⟩
#align skyscraper_presheaf_stalk_of_not_specializes skyscraperPresheafStalkOfNotSpecializes

/-- If `y ∉ closure {p₀}`, then the stalk of `skyscraper_presheaf p₀ A` at `y` is a terminal object
-/
def skyscraperPresheafStalkOfNotSpecializesIsTerminal [HasColimits C] {y : X} (h : ¬p₀ ⤳ y) :
    IsTerminal ((skyscraperPresheaf p₀ A).stalk y) :=
  IsTerminal.ofIso terminalIsTerminal <| (skyscraperPresheafStalkOfNotSpecializes _ _ h).symm
#align skyscraper_presheaf_stalk_of_not_specializes_is_terminal skyscraperPresheafStalkOfNotSpecializesIsTerminal

theorem skyscraperPresheaf_isSheaf : (skyscraperPresheaf p₀ A).IsSheaf := by
  classical exact
      (presheaf.is_sheaf_iso_iff (eq_to_iso <| skyscraperPresheaf_eq_pushforward p₀ A)).mpr
        (sheaf.pushforward_sheaf_of_sheaf _
          (presheaf.is_sheaf_on_punit_of_is_terminal _
            (by
              dsimp
              rw [if_neg]
              exact terminal_is_terminal
              exact Set.not_mem_empty PUnit.unit)))
#align skyscraper_presheaf_is_sheaf skyscraperPresheaf_isSheaf

/--
The skyscraper presheaf supported at `p₀` with value `A` is the sheaf that assigns `A` to all opens
`U` that contain `p₀` and assigns `*` otherwise.
-/
def skyscraperSheaf : Sheaf C X :=
  ⟨skyscraperPresheaf p₀ A, skyscraperPresheaf_isSheaf _ _⟩
#align skyscraper_sheaf skyscraperSheaf

/-- Taking skyscraper sheaf at a point is functorial: `c ↦ skyscraper p₀ c` defines a functor by
sending every `f : a ⟶ b` to the natural transformation `α` defined as: `α(U) = f : a ⟶ b` if
`p₀ ∈ U` and the unique morphism to a terminal object in `C` if `p₀ ∉ U`.
-/
def skyscraperSheafFunctor : C ⥤ Sheaf C X
    where
  obj c := skyscraperSheaf p₀ c
  map a b f := Sheaf.Hom.mk <| (skyscraperPresheafFunctor p₀).map f
  map_id' c := Sheaf.Hom.ext _ _ <| (skyscraperPresheafFunctor p₀).map_id _
  map_comp' _ _ _ f g := Sheaf.Hom.ext _ _ <| (skyscraperPresheafFunctor p₀).map_comp _ _
#align skyscraper_sheaf_functor skyscraperSheafFunctor

namespace StalkSkyscraperPresheafAdjunctionAuxs

variable [HasColimits C]

/-- If `f : 𝓕.stalk p₀ ⟶ c`, then a natural transformation `𝓕 ⟶ skyscraper_presheaf p₀ c` can be
defined by: `𝓕.germ p₀ ≫ f : 𝓕(U) ⟶ c` if `p₀ ∈ U` and the unique morphism to a terminal object
if `p₀ ∉ U`.
-/
@[simps]
def toSkyscraperPresheaf {𝓕 : Presheaf C X} {c : C} (f : 𝓕.stalk p₀ ⟶ c) :
    𝓕 ⟶ skyscraperPresheaf p₀ c
    where
  app U :=
    if h : p₀ ∈ U.unop then 𝓕.germ ⟨p₀, h⟩ ≫ f ≫ eqToHom (if_pos h).symm
    else ((if_neg h).symm.rec terminalIsTerminal).from _
  naturality' U V inc := by
    dsimp; by_cases hV : p₀ ∈ V.unop
    · have hU : p₀ ∈ U.unop := le_of_hom inc.unop hV
      split_ifs
      erw [← category.assoc, 𝓕.germ_res inc.unop, category.assoc, category.assoc, eq_to_hom_trans]
      rfl
    · split_ifs
      apply ((if_neg hV).symm.rec terminal_is_terminal).hom_ext
#align stalk_skyscraper_presheaf_adjunction_auxs.to_skyscraper_presheaf StalkSkyscraperPresheafAdjunctionAuxs.toSkyscraperPresheaf

/-- If `f : 𝓕 ⟶ skyscraper_presheaf p₀ c` is a natural transformation, then there is a morphism
`𝓕.stalk p₀ ⟶ c` defined as the morphism from colimit to cocone at `c`.
-/
def fromStalk {𝓕 : Presheaf C X} {c : C} (f : 𝓕 ⟶ skyscraperPresheaf p₀ c) : 𝓕.stalk p₀ ⟶ c :=
  let χ : Cocone ((OpenNhds.inclusion p₀).op ⋙ 𝓕) :=
    Cocone.mk c <|
      { app := fun U => f.app (op U.unop.1) ≫ eqToHom (if_pos U.unop.2)
        naturality' := fun U V inc => by
          dsimp;
          erw [category.comp_id, ← category.assoc, comp_eq_to_hom_iff, category.assoc,
            eq_to_hom_trans, f.naturality, skyscraperPresheaf_map]
          have hV : p₀ ∈ (open_nhds.inclusion p₀).obj V.unop := V.unop.2; split_ifs
          simpa only [comp_eq_to_hom_iff, category.assoc, eq_to_hom_trans, eq_to_hom_refl,
            category.comp_id] }
  colimit.desc _ χ
#align stalk_skyscraper_presheaf_adjunction_auxs.from_stalk StalkSkyscraperPresheafAdjunctionAuxs.fromStalk

theorem to_skyscraper_fromStalk {𝓕 : Presheaf C X} {c : C} (f : 𝓕 ⟶ skyscraperPresheaf p₀ c) :
    toSkyscraperPresheaf p₀ (fromStalk _ f) = f :=
  NatTrans.ext _ _ <|
    funext fun U =>
      (em (p₀ ∈ U.unop)).elim
        (fun h => by
          dsimp
          split_ifs
          erw [← category.assoc, colimit.ι_desc, category.assoc, eq_to_hom_trans, eq_to_hom_refl,
            category.comp_id]
          rfl)
        fun h => by
        dsimp
        split_ifs
        apply ((if_neg h).symm.rec terminal_is_terminal).hom_ext
#align stalk_skyscraper_presheaf_adjunction_auxs.to_skyscraper_from_stalk StalkSkyscraperPresheafAdjunctionAuxs.to_skyscraper_fromStalk

theorem fromStalk_to_skyscraper {𝓕 : Presheaf C X} {c : C} (f : 𝓕.stalk p₀ ⟶ c) :
    fromStalk p₀ (toSkyscraperPresheaf _ f) = f :=
  colimit.hom_ext fun U => by
    erw [colimit.ι_desc]
    dsimp
    rw [dif_pos U.unop.2]
    rw [category.assoc, category.assoc, eq_to_hom_trans, eq_to_hom_refl, category.comp_id,
      presheaf.germ]
    congr 3
    apply_fun Opposite.unop using unop_injective
    rw [unop_op]
    ext
    rfl
#align stalk_skyscraper_presheaf_adjunction_auxs.from_stalk_to_skyscraper StalkSkyscraperPresheafAdjunctionAuxs.fromStalk_to_skyscraper

/-- The unit in `presheaf.stalk ⊣ skyscraper_presheaf_functor`
-/
@[simps]
protected def unit : 𝟭 (Presheaf C X) ⟶ Presheaf.stalkFunctor C p₀ ⋙ skyscraperPresheafFunctor p₀
    where
  app 𝓕 := toSkyscraperPresheaf _ <| 𝟙 _
  naturality' 𝓕 𝓖 f := by
    ext U; dsimp; split_ifs
    · simp only [category.id_comp, ← category.assoc]
      rw [comp_eq_to_hom_iff]
      simp only [category.assoc, eq_to_hom_trans, eq_to_hom_refl, category.comp_id]
      erw [colimit.ι_map]
      rfl
    · apply ((if_neg h).symm.rec terminal_is_terminal).hom_ext
#align stalk_skyscraper_presheaf_adjunction_auxs.unit StalkSkyscraperPresheafAdjunctionAuxs.unit

/-- The counit in `presheaf.stalk ⊣ skyscraper_presheaf_functor`
-/
@[simps]
protected def counit :
    skyscraperPresheafFunctor p₀ ⋙ (Presheaf.stalkFunctor C p₀ : Presheaf C X ⥤ C) ⟶ 𝟭 C
    where
  app c := (skyscraperPresheafStalkOfSpecializes p₀ c specializes_rfl).Hom
  naturality' x y f :=
    colimit.hom_ext fun U => by
      erw [← category.assoc, colimit.ι_map, colimit.iso_colimit_cocone_ι_hom_assoc,
        skyscraperPresheafCoconeOfSpecializes_ι_app, category.assoc, colimit.ι_desc,
        whiskering_left_obj_map, whisker_left_app, SkyscraperPresheafFunctor.map'_app,
        dif_pos U.unop.2, skyscraperPresheafCoconeOfSpecializes_ι_app, comp_eq_to_hom_iff,
        category.assoc, eq_to_hom_comp_iff, ← category.assoc, eq_to_hom_trans, eq_to_hom_refl,
        category.id_comp, comp_eq_to_hom_iff, category.assoc, eq_to_hom_trans, eq_to_hom_refl,
        category.comp_id, CategoryTheory.Functor.id_map]
#align stalk_skyscraper_presheaf_adjunction_auxs.counit StalkSkyscraperPresheafAdjunctionAuxs.counit

end StalkSkyscraperPresheafAdjunctionAuxs

section

open StalkSkyscraperPresheafAdjunctionAuxs

/-- `skyscraper_presheaf_functor` is the right adjoint of `presheaf.stalk_functor`
-/
def skyscraperPresheafStalkAdjunction [HasColimits C] :
    (Presheaf.stalkFunctor C p₀ : Presheaf C X ⥤ C) ⊣ skyscraperPresheafFunctor p₀
    where
  homEquiv c 𝓕 :=
    { toFun := toSkyscraperPresheaf _
      invFun := fromStalk _
      left_inv := fromStalk_to_skyscraper _
      right_inv := to_skyscraper_fromStalk _ }
  Unit := StalkSkyscraperPresheafAdjunctionAuxs.unit _
  counit := StalkSkyscraperPresheafAdjunctionAuxs.counit _
  homEquiv_unit 𝓕 c α := by
    ext U;
    simp only [Equiv.coe_fn_mk, to_skyscraper_presheaf_app, nat_trans.comp_app,
      SkyscraperPresheafFunctor.map'_app, skyscraperPresheafFunctor_map, unit_app]
    split_ifs
    ·
      erw [category.id_comp, ← category.assoc, comp_eq_to_hom_iff, category.assoc, category.assoc,
        category.assoc, category.assoc, eq_to_hom_trans, eq_to_hom_refl, category.comp_id, ←
        category.assoc _ _ α, eq_to_hom_trans, eq_to_hom_refl, category.id_comp]
    · apply ((if_neg h).symm.rec terminal_is_terminal).hom_ext
  homEquiv_counit 𝓕 c α := by
    ext U; simp only [Equiv.coe_fn_symm_mk, counit_app]
    erw [colimit.ι_desc, ← category.assoc, colimit.ι_map, whisker_left_app, category.assoc,
      colimit.ι_desc]
    rfl
#align skyscraper_presheaf_stalk_adjunction skyscraperPresheafStalkAdjunction

instance [HasColimits C] : IsRightAdjoint (skyscraperPresheafFunctor p₀ : C ⥤ Presheaf C X) :=
  ⟨_, skyscraperPresheafStalkAdjunction _⟩

instance [HasColimits C] : IsLeftAdjoint (Presheaf.stalkFunctor C p₀) :=
  ⟨_, skyscraperPresheafStalkAdjunction _⟩

/-- Taking stalks of a sheaf is the left adjoint functor to `skyscraper_sheaf_functor`
-/
def stalkSkyscraperSheafAdjunction [HasColimits C] :
    Sheaf.forget C X ⋙ Presheaf.stalkFunctor _ p₀ ⊣ skyscraperSheafFunctor p₀
    where
  homEquiv 𝓕 c :=
    ⟨fun f => ⟨toSkyscraperPresheaf p₀ f⟩, fun g => fromStalk p₀ g.1, fromStalk_to_skyscraper p₀,
      fun g => by
      ext1
      apply to_skyscraper_from_stalk⟩
  Unit :=
    { app := fun 𝓕 => ⟨(StalkSkyscraperPresheafAdjunctionAuxs.unit p₀).app 𝓕.1⟩
      naturality' := fun 𝓐 𝓑 ⟨f⟩ => by
        ext1
        apply (StalkSkyscraperPresheafAdjunctionAuxs.unit p₀).naturality }
  counit := StalkSkyscraperPresheafAdjunctionAuxs.counit p₀
  homEquiv_unit 𝓐 c f := by
    ext1
    exact (skyscraperPresheafStalkAdjunction p₀).homEquiv_unit
  homEquiv_counit 𝓐 c f := (skyscraperPresheafStalkAdjunction p₀).homEquiv_counit
#align stalk_skyscraper_sheaf_adjunction stalkSkyscraperSheafAdjunction

instance [HasColimits C] : IsRightAdjoint (skyscraperSheafFunctor p₀ : C ⥤ Sheaf C X) :=
  ⟨_, stalkSkyscraperSheafAdjunction _⟩

end

end