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

end Mathlib


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import topology.sheaves.local_predicate
import topology.sheaves.stalks

/-!
# Sheafification of `Type` valued presheaves

We construct the sheafification of a `Type` valued presheaf,
as the subsheaf of dependent functions into the stalks
consisting of functions which are locally germs.

We show that the stalks of the sheafification are isomorphic to the original stalks,
via `stalk_to_fiber` which evaluates a germ of a dependent function at a point.

We construct a morphism `to_sheafify` from a presheaf to (the underlying presheaf of)
its sheafification, given by sending a section to its collection of germs.

## Future work
Show that the map induced on stalks by `to_sheafify` is the inverse of `stalk_to_fiber`.

Show sheafification is a functor from presheaves to sheaves,
and that it is the left adjoint of the forgetful functor,
following https://stacks.math.columbia.edu/tag/007X.
-/

universes v

noncomputable theory

open Top
open opposite
open topological_space

variables {X : Top.{v}} (F : presheaf (Type v) X)

namespace Top.presheaf

namespace sheafify

/--
The prelocal predicate on functions into the stalks, asserting that the function is equal to a germ.
-/
def is_germ : prelocal_predicate (λ x, F.stalk x) :=
{ pred := λ U f, ∃ (g : F.obj (op U)), ∀ x : U, f x = F.germ x g,
  res := λ V U i f ⟨g, p⟩, ⟨F.map i.op g, λ x, (p (i x)).trans (F.germ_res_apply _ _ _).symm⟩, }

/--
The local predicate on functions into the stalks,
asserting that the function is locally equal to a germ.
-/
def is_locally_germ : local_predicate (λ x, F.stalk x) := (is_germ F).sheafify

end sheafify

/--
The sheafification of a `Type` valued presheaf, defined as the functions into the stalks which
are locally equal to germs.
-/
def sheafify : sheaf (Type v) X :=
subsheaf_to_Types (sheafify.is_locally_germ F)

/--
The morphism from a presheaf to its sheafification,
sending each section to its germs.
(This forms the unit of the adjunction.)
-/
def to_sheafify : F ⟶ F.sheafify.presheaf :=
{ app := λ U f, ⟨λ x, F.germ x f, prelocal_predicate.sheafify_of ⟨f, λ x, rfl⟩⟩,
  naturality' := λ U U' f, by { ext x ⟨u, m⟩, apply germ_res_apply', }, }

/--
The natural morphism from the stalk of the sheafification to the original stalk.
In `sheafify_stalk_iso` we show this is an isomorphism.
-/
def stalk_to_fiber (x : X) : F.sheafify.presheaf.stalk x ⟶ F.stalk x :=
stalk_to_fiber (sheafify.is_locally_germ F) x

lemma stalk_to_fiber_surjective (x : X) : function.surjective (F.stalk_to_fiber x) :=
begin
  apply stalk_to_fiber_surjective,
  intro t,
  obtain ⟨U, m, s, rfl⟩ := F.germ_exist _ t,
  { use ⟨U, m⟩,
    fsplit,
    { exact λ y, F.germ y s, },
    { exact ⟨prelocal_predicate.sheafify_of ⟨s, (λ _, rfl)⟩, rfl⟩, }, },
end

lemma stalk_to_fiber_injective (x : X) : function.injective (F.stalk_to_fiber x) :=
begin
  apply stalk_to_fiber_injective,
  intros,
  rcases hU ⟨x, U.2⟩ with ⟨U', mU, iU, gU, wU⟩,
  rcases hV ⟨x, V.2⟩ with ⟨V', mV, iV, gV, wV⟩,
  have wUx := wU ⟨x, mU⟩,
  dsimp at wUx, erw wUx at e, clear wUx,
  have wVx := wV ⟨x, mV⟩,
  dsimp at wVx, erw wVx at e, clear wVx,
  rcases F.germ_eq x mU mV gU gV e with ⟨W, mW, iU', iV', e'⟩,
  use ⟨W ⊓ (U' ⊓ V'), ⟨mW, mU, mV⟩⟩,
  refine ⟨_, _, _⟩,
  { change W ⊓ (U' ⊓ V') ⟶ U.val,
    exact (opens.inf_le_right _ _) ≫ (opens.inf_le_left _ _) ≫ iU, },
  { change W ⊓ (U' ⊓ V') ⟶ V.val,
    exact (opens.inf_le_right _ _) ≫ (opens.inf_le_right _ _) ≫ iV, },
  { intro w,
    dsimp,
    specialize wU ⟨w.1, w.2.2.1⟩,
    dsimp at wU,
    specialize wV ⟨w.1, w.2.2.2⟩,
    dsimp at wV,
    erw [wU, ←F.germ_res_apply iU' ⟨w, w.2.1⟩ gU, e', F.germ_res_apply, ←wV],
    refl, },
end

/--
The isomorphism betweeen a stalk of the sheafification and the original stalk.
-/
def sheafify_stalk_iso (x : X) : F.sheafify.presheaf.stalk x ≅ F.stalk x :=
(equiv.of_bijective _ ⟨stalk_to_fiber_injective _ _, stalk_to_fiber_surjective _ _⟩).to_iso

-- PROJECT functoriality, and that sheafification is the left adjoint of the forgetful functor.

end Top.presheaf


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

! This file was ported from Lean 3 source module data.nat.cast.prod
! leanprover-community/mathlib commit ee0c179cd3c8a45aa5bffbf1b41d8dbede452865
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Nat.Cast.Basic
import Mathlib.Algebra.Group.Prod

/-!
# The product of two `add_monoid_with_one`s.
-/

variable {α β : Type _}

namespace Prod

variable [AddMonoidWithOne α] [AddMonoidWithOne β]

instance : AddMonoidWithOne (α × β) :=
  { Prod.instAddMonoidSum, @instOneProd α β _ _ with
    natCast := fun n => (n, n)
    natCast_zero := congr_arg₂ Prod.mk Nat.cast_zero Nat.cast_zero
    natCast_succ := fun _ => congr_arg₂ Prod.mk (Nat.cast_succ _) (Nat.cast_succ _) }

@[simp]
theorem fst_natCast (n : ℕ) : (n : α × β).fst = n := by induction n <;> simp [*]
#align prod.fst_nat_cast Prod.fst_natCast

@[simp]
theorem snd_natCast (n : ℕ) : (n : α × β).snd = n := by induction n <;> simp [*]
#align prod.snd_nat_cast Prod.snd_natCast

end Prod


/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import topology.homeomorph
/-!
# Compact sets

## Summary

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

## Main Definitions

- `closeds α` is the type of closed subsets of a topological space `α`.
- `compacts α` is the type of compact subsets of a topological space `α`.
- `nonempty_compacts α` is the type of non-empty compact subsets.
- `positive_compacts α` is the type of compact subsets with non-empty interior.
-/
open set

variables (α : Type*) {β : Type*} [topological_space α] [topological_space β]
namespace topological_space

/-- The type of closed subsets of a topological space. -/
def closeds := {s : set α // is_closed s}

/-- The type of closed subsets is inhabited, with default element the empty set. -/
instance : inhabited (closeds α) := ⟨⟨∅, is_closed_empty ⟩⟩

/-- The compact sets of a topological space. See also `nonempty_compacts`. -/
def compacts : Type* := { s : set α // is_compact s }

/-- The type of non-empty compact subsets of a topological space. The
non-emptiness will be useful in metric spaces, as we will be able to put
a distance (and not merely an edistance) on this space. -/
def nonempty_compacts := {s : set α // s.nonempty ∧ is_compact s}

/-- In an inhabited space, the type of nonempty compact subsets is also inhabited, with
default element the singleton set containing the default element. -/
instance nonempty_compacts_inhabited [inhabited α] : inhabited (nonempty_compacts α) :=
⟨⟨{default α}, singleton_nonempty (default α), is_compact_singleton ⟩⟩

/-- The compact sets with nonempty interior of a topological space. See also `compacts` and
  `nonempty_compacts`. -/
@[nolint has_inhabited_instance]
def positive_compacts: Type* := { s : set α // is_compact s ∧ (interior s).nonempty }

/-- In a nonempty compact space, `set.univ` is a member of `positive_compacts`, the compact sets
with nonempty interior. -/
def positive_compacts_univ {α : Type*} [topological_space α] [compact_space α] [nonempty α] :
  positive_compacts α :=
⟨set.univ, compact_univ, by simp⟩

@[simp] lemma positive_compacts_univ_val (α : Type*) [topological_space α] [compact_space α]
  [nonempty α] : (positive_compacts_univ : positive_compacts α).val = univ := rfl

variables {α}

namespace compacts

instance : semilattice_sup (compacts α) :=
subtype.semilattice_sup (λ K₁ K₂, is_compact.union)

instance : order_bot (compacts α) :=
subtype.order_bot is_compact_empty

instance [t2_space α]: semilattice_inf (compacts α) :=
subtype.semilattice_inf (λ K₁ K₂, is_compact.inter)

instance [t2_space α] : lattice (compacts α) :=
subtype.lattice (λ K₁ K₂, is_compact.union) (λ K₁ K₂, is_compact.inter)

@[simp] lemma bot_val : (⊥ : compacts α).1 = ∅ := rfl

@[simp] lemma sup_val {K₁ K₂ : compacts α} : (K₁ ⊔ K₂).1 = K₁.1 ∪ K₂.1 := rfl

@[ext] protected lemma ext {K₁ K₂ : compacts α} (h : K₁.1 = K₂.1) : K₁ = K₂ :=
subtype.eq h

@[simp] lemma finset_sup_val {β} {K : β → compacts α} {s : finset β} :
  (s.sup K).1 = s.sup (λ x, (K x).1) :=
finset.sup_coe _ _

instance : inhabited (compacts α) := ⟨⊥⟩

/-- The image of a compact set under a continuous function. -/
protected def map (f : α → β) (hf : continuous f) (K : compacts α) : compacts β :=
⟨f '' K.1, K.2.image hf⟩

@[simp] lemma map_val {f : α → β} (hf : continuous f) (K : compacts α) :
  (K.map f hf).1 = f '' K.1 := rfl

/-- A homeomorphism induces an equivalence on compact sets, by taking the image. -/
@[simp] protected def equiv (f : α ≃ₜ β) : compacts α ≃ compacts β :=
{ to_fun := compacts.map f f.continuous,
  inv_fun := compacts.map _ f.symm.continuous,
  left_inv := by { intro K, ext1, simp only [map_val, ← image_comp, f.symm_comp_self, image_id] },
  right_inv := by { intro K, ext1,
    simp only [map_val, ← image_comp, f.self_comp_symm, image_id] } }

/-- The image of a compact set under a homeomorphism can also be expressed as a preimage. -/
lemma equiv_to_fun_val (f : α ≃ₜ β) (K : compacts α) :
  (compacts.equiv f K).1 = f.symm ⁻¹' K.1 :=
congr_fun (image_eq_preimage_of_inverse f.left_inv f.right_inv) K.1

end compacts

section nonempty_compacts
open topological_space set
variable {α}

instance nonempty_compacts.to_compact_space {p : nonempty_compacts α} : compact_space p.val :=
⟨is_compact_iff_is_compact_univ.1 p.property.2⟩

instance nonempty_compacts.to_nonempty {p : nonempty_compacts α} : nonempty p.val :=
p.property.1.to_subtype

/-- Associate to a nonempty compact subset the corresponding closed subset -/
def nonempty_compacts.to_closeds [t2_space α] : nonempty_compacts α → closeds α :=
set.inclusion $ λ s hs, hs.2.is_closed

end nonempty_compacts

section positive_compacts

variable (α)
/-- In a nonempty locally compact space, there exists a compact set with nonempty interior. -/
instance nonempty_positive_compacts [locally_compact_space α] [nonempty α] :
  nonempty (positive_compacts α) :=
begin
  inhabit α,
  rcases exists_compact_subset is_open_univ (mem_univ (default α)) with ⟨K, hK⟩,
  exact ⟨⟨K, hK.1, ⟨_, hK.2.1⟩⟩⟩
end

end positive_compacts

end topological_space


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import category_theory.abelian.exact
import category_theory.over
import algebra.category.Module.abelian

/-!
# Pseudoelements in abelian categories

A *pseudoelement* of an object `X` in an abelian category `C` is an equivalence class of arrows
ending in `X`, where two arrows are considered equivalent if we can find two epimorphisms with a
common domain making a commutative square with the two arrows. While the construction shows that
pseudoelements are actually subobjects of `X` rather than "elements", it is possible to chase these
pseudoelements through commutative diagrams in an abelian category to prove exactness properties.
This is done using some "diagram-chasing metatheorems" proved in this file. In many cases, a proof
in the category of abelian groups can more or less directly be converted into a proof using
pseudoelements.

A classic application of pseudoelements are diagram lemmas like the four lemma or the snake lemma.

Pseudoelements are in some ways weaker than actual elements in a concrete category. The most
important limitation is that there is no extensionality principle: If `f g : X ⟶ Y`, then
`∀ x ∈ X, f x = g x` does not necessarily imply that `f = g` (however, if `f = 0` or `g = 0`,
it does). A corollary of this is that we can not define arrows in abelian categories by dictating
their action on pseudoelements. Thus, a usual style of proofs in abelian categories is this:
First, we construct some morphism using universal properties, and then we use diagram chasing
of pseudoelements to verify that is has some desirable property such as exactness.

It should be noted that the Freyd-Mitchell embedding theorem gives a vastly stronger notion of
pseudoelement (in particular one that gives extensionality). However, this theorem is quite
difficult to prove and probably out of reach for a formal proof for the time being.

## Main results

We define the type of pseudoelements of an object and, in particular, the zero pseudoelement.

We prove that every morphism maps the zero pseudoelement to the zero pseudoelement (`apply_zero`)
and that a zero morphism maps every pseudoelement to the zero pseudoelement (`zero_apply`)

Here are the metatheorems we provide:
* A morphism `f` is zero if and only if it is the zero function on pseudoelements.
* A morphism `f` is an epimorphism if and only if it is surjective on pseudoelements.
* A morphism `f` is a monomorphism if and only if it is injective on pseudoelements
  if and only if `∀ a, f a = 0 → f = 0`.
* A sequence `f, g` of morphisms is exact if and only if
  `∀ a, g (f a) = 0` and `∀ b, g b = 0 → ∃ a, f a = b`.
* If `f` is a morphism and `a, a'` are such that `f a = f a'`, then there is some
  pseudoelement `a''` such that `f a'' = 0` and for every `g` we have
  `g a' = 0 → g a = g a''`. We can think of `a''` as `a - a'`, but don't get too carried away
  by that: pseudoelements of an object do not form an abelian group.

## Notations

We introduce coercions from an object of an abelian category to the set of its pseudoelements
and from a morphism to the function it induces on pseudoelements.

These coercions must be explicitly enabled via local instances:
`local attribute [instance] object_to_sort hom_to_fun`

## Implementation notes

It appears that sometimes the coercion from morphisms to functions does not work, i.e.,
writing `g a` raises a "function expected" error. This error can be fixed by writing
`(g : X ⟶ Y) a`.

## References

* [F. Borceux, *Handbook of Categorical Algebra 2*][borceux-vol2]
-/

open category_theory
open category_theory.limits
open category_theory.abelian
open category_theory.preadditive

universes v u

namespace category_theory.abelian

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

local attribute [instance] over.coe_from_hom

/-- This is just composition of morphisms in `C`. Another way to express this would be
    `(over.map f).obj a`, but our definition has nicer definitional properties. -/
def app {P Q : C} (f : P ⟶ Q) (a : over P) : over Q :=
a.hom ≫ f

@[simp] lemma app_hom {P Q : C} (f : P ⟶ Q) (a : over P) : (app f a).hom = a.hom ≫ f := rfl

/-- Two arrows `f : X ⟶ P` and `g : Y ⟶ P` are called pseudo-equal if there is some object
    `R` and epimorphisms `p : R ⟶ X` and `q : R ⟶ Y` such that `p ≫ f = q ≫ g`. -/
def pseudo_equal (P : C) (f g : over P) : Prop :=
∃ (R : C) (p : R ⟶ f.1) (q : R ⟶ g.1) (_ : epi p) (_ : epi q), p ≫ f.hom = q ≫ g.hom

lemma pseudo_equal_refl {P : C} : reflexive (pseudo_equal P) :=
λ f, ⟨f.1, 𝟙 f.1, 𝟙 f.1, by apply_instance, by apply_instance, by simp⟩

lemma pseudo_equal_symm {P : C} : symmetric (pseudo_equal P) :=
λ f g ⟨R, p, q, ep, eq, comm⟩, ⟨R, q, p, eq, ep, comm.symm⟩

variables [abelian.{v} C]

section

/-- Pseudoequality is transitive: Just take the pullback. The pullback morphisms will
    be epimorphisms since in an abelian category, pullbacks of epimorphisms are epimorphisms. -/
lemma pseudo_equal_trans {P : C} : transitive (pseudo_equal P) :=
λ f g h ⟨R, p, q, ep, eq, comm⟩ ⟨R', p', q', ep', eq', comm'⟩,
begin
  refine ⟨pullback q p', pullback.fst ≫ p, pullback.snd ≫ q', _, _, _⟩,
  { resetI, exact epi_comp _ _ },
  { resetI, exact epi_comp _ _ },
  { rw [category.assoc, comm, ←category.assoc, pullback.condition,
      category.assoc, comm', category.assoc] }
end

end

/-- The arrows with codomain `P` equipped with the equivalence relation of being pseudo-equal. -/
def pseudoelement.setoid (P : C) : setoid (over P) :=
⟨_, ⟨pseudo_equal_refl, pseudo_equal_symm, pseudo_equal_trans⟩⟩

local attribute [instance] pseudoelement.setoid

/-- A `pseudoelement` of `P` is just an equivalence class of arrows ending in `P` by being
    pseudo-equal. -/
def pseudoelement (P : C) : Type (max u v) := quotient (pseudoelement.setoid P)

namespace pseudoelement

/-- A coercion from an object of an abelian category to its pseudoelements. -/
def object_to_sort : has_coe_to_sort C (Type (max u v)) :=
⟨λ P, pseudoelement P⟩

local attribute [instance] object_to_sort

localized "attribute [instance] category_theory.abelian.pseudoelement.object_to_sort"
  in pseudoelement

/-- A coercion from an arrow with codomain `P` to its associated pseudoelement. -/
def over_to_sort {P : C} : has_coe (over P) (pseudoelement P) :=
⟨quot.mk (pseudo_equal P)⟩

local attribute [instance] over_to_sort

lemma over_coe_def {P Q : C} (a : Q ⟶ P) : (a : pseudoelement P) = ⟦a⟧ := rfl

/-- If two elements are pseudo-equal, then their composition with a morphism is, too. -/
lemma pseudo_apply_aux {P Q : C} (f : P ⟶ Q) (a b : over P) :
  a ≈ b → app f a ≈ app f b :=
λ ⟨R, p, q, ep, eq, comm⟩,
  ⟨R, p, q, ep, eq, show p ≫ a.hom ≫ f = q ≫ b.hom ≫ f, by rw reassoc_of comm⟩

/-- A morphism `f` induces a function `pseudo_apply f` on pseudoelements. -/
def pseudo_apply {P Q : C} (f : P ⟶ Q) : P → Q :=
quotient.map (λ (g : over P), app f g) (pseudo_apply_aux f)

/-- A coercion from morphisms to functions on pseudoelements -/
def hom_to_fun {P Q : C} : has_coe_to_fun (P ⟶ Q) (λ _, P → Q) := ⟨pseudo_apply⟩

local attribute [instance] hom_to_fun

localized "attribute [instance] category_theory.abelian.pseudoelement.hom_to_fun" in pseudoelement

lemma pseudo_apply_mk {P Q : C} (f : P ⟶ Q) (a : over P) : f ⟦a⟧ = ⟦a.hom ≫ f⟧ :=
rfl

/-- Applying a pseudoelement to a composition of morphisms is the same as composing
    with each morphism. Sadly, this is not a definitional equality, but at least it is
    true. -/
theorem comp_apply {P Q R : C} (f : P ⟶ Q) (g : Q ⟶ R) (a : P) : (f ≫ g) a = g (f a) :=
quotient.induction_on a $ λ x, quotient.sound $
by { unfold app, rw [←category.assoc, over.coe_hom] }

/-- Composition of functions on pseudoelements is composition of morphisms. -/
theorem comp_comp {P Q R : C} (f : P ⟶ Q) (g : Q ⟶ R) : g ∘ f = f ≫ g :=
funext $ λ x, (comp_apply _ _ _).symm

section zero
/-!
In this section we prove that for every `P` there is an equivalence class that contains
precisely all the zero morphisms ending in `P` and use this to define *the* zero
pseudoelement.
-/

section
local attribute [instance] has_binary_biproducts.of_has_binary_products

/-- The arrows pseudo-equal to a zero morphism are precisely the zero morphisms -/
lemma pseudo_zero_aux {P : C} (Q : C) (f : over P) : f ≈ (0 : Q ⟶ P) ↔ f.hom = 0 :=
⟨λ ⟨R, p, q, ep, eq, comm⟩, by exactI zero_of_epi_comp p (by simp [comm]),
  λ hf, ⟨biprod f.1 Q, biprod.fst, biprod.snd, by apply_instance, by apply_instance,
    by rw [hf, over.coe_hom, has_zero_morphisms.comp_zero, has_zero_morphisms.comp_zero]⟩⟩

end

lemma zero_eq_zero' {P Q R : C} :
  ⟦((0 : Q ⟶ P) : over P)⟧ = ⟦((0 : R ⟶ P) : over P)⟧ :=
quotient.sound $ (pseudo_zero_aux R _).2 rfl

/-- The zero pseudoelement is the class of a zero morphism -/
def pseudo_zero {P : C} : P := ⟦(0 : P ⟶ P)⟧

/--
We can not use `pseudo_zero` as a global `has_zero` instance,
as it would trigger on any type class search for `has_zero` applied to a `coe_sort`.
This would be too expensive.
-/
def has_zero {P : C} : has_zero P := ⟨pseudo_zero⟩
localized "attribute [instance] category_theory.abelian.pseudoelement.has_zero" in pseudoelement

instance {P : C} : inhabited (pseudoelement P) := ⟨0⟩

lemma pseudo_zero_def {P : C} : (0 : pseudoelement P) = ⟦(0 : P ⟶ P)⟧ := rfl
@[simp] lemma zero_eq_zero {P Q : C} : ⟦((0 : Q ⟶ P) : over P)⟧ = (0 : pseudoelement P) :=
zero_eq_zero'

/-- The pseudoelement induced by an arrow is zero precisely when that arrow is zero -/
lemma pseudo_zero_iff {P : C} (a : over P) : (a : P) = 0 ↔ a.hom = 0 :=
by { rw ←pseudo_zero_aux P a, exact quotient.eq }

end zero

open_locale pseudoelement

/-- Morphisms map the zero pseudoelement to the zero pseudoelement -/
@[simp] theorem apply_zero {P Q : C} (f : P ⟶ Q) : f 0 = 0 :=
by { rw [pseudo_zero_def, pseudo_apply_mk], simp }

/-- The zero morphism maps every pseudoelement to 0. -/
@[simp] theorem zero_apply {P : C} (Q : C) (a : P) : (0 : P ⟶ Q) a = 0 :=
quotient.induction_on a $ λ a',
  by { rw [pseudo_zero_def, pseudo_apply_mk], simp }

/-- An extensionality lemma for being the zero arrow. -/
theorem zero_morphism_ext {P Q : C} (f : P ⟶ Q) : (∀ a, f a = 0) → f = 0 :=
λ h, by { rw ←category.id_comp f, exact (pseudo_zero_iff ((𝟙 P ≫ f) : over Q)).1 (h (𝟙 P)) }

theorem zero_morphism_ext' {P Q : C} (f : P ⟶ Q) : (∀ a, f a = 0) → 0 = f :=
eq.symm ∘ zero_morphism_ext f

localized "attribute [ext] category_theory.abelian.pseudoelement.zero_morphism_ext
  category_theory.abelian.pseudoelement.zero_morphism_ext'" in pseudoelement

theorem eq_zero_iff {P Q : C} (f : P ⟶ Q) : f = 0 ↔ ∀ a, f a = 0 :=
⟨λ h a, by simp [h], zero_morphism_ext _⟩

/-- A monomorphism is injective on pseudoelements. -/
theorem pseudo_injective_of_mono {P Q : C} (f : P ⟶ Q) [mono f] : function.injective f :=
λ abar abar', quotient.induction_on₂ abar abar' $ λ a a' ha, quotient.sound $
  have ⟦(a.hom ≫ f : over Q)⟧ = ⟦a'.hom ≫ f⟧, by convert ha,
  match quotient.exact this with ⟨R, p, q, ep, eq, comm⟩ :=
    ⟨R, p, q, ep, eq, (cancel_mono f).1 $ by { simp only [category.assoc], exact comm }⟩
  end

/-- A morphism that is injective on pseudoelements only maps the zero element to zero. -/
lemma zero_of_map_zero {P Q : C} (f : P ⟶ Q) : function.injective f → ∀ a, f a = 0 → a = 0 :=
λ h a ha, by { rw ←apply_zero f at ha, exact h ha }

/-- A morphism that only maps the zero pseudoelement to zero is a monomorphism. -/
theorem mono_of_zero_of_map_zero {P Q : C} (f : P ⟶ Q) : (∀ a, f a = 0 → a = 0) → mono f :=
λ h, (mono_iff_cancel_zero _).2 $ λ R g hg, (pseudo_zero_iff (g : over P)).1 $ h _ $
  show f g = 0, from (pseudo_zero_iff (g ≫ f : over Q)).2 hg

section

/-- An epimorphism is surjective on pseudoelements. -/
theorem pseudo_surjective_of_epi {P Q : C} (f : P ⟶ Q) [epi f] : function.surjective f :=
λ qbar, quotient.induction_on qbar $ λ q, ⟨((pullback.fst : pullback f q.hom ⟶ P) : over P),
  quotient.sound $ ⟨pullback f q.hom, 𝟙 (pullback f q.hom), pullback.snd, by apply_instance,
    by apply_instance, by rw [category.id_comp, ←pullback.condition, app_hom, over.coe_hom]⟩⟩

end

/-- A morphism that is surjective on pseudoelements is an epimorphism. -/
theorem epi_of_pseudo_surjective {P Q : C} (f : P ⟶ Q) : function.surjective f → epi f :=
λ h, match h (𝟙 Q) with ⟨pbar, hpbar⟩ :=
  match quotient.exists_rep pbar with ⟨p, hp⟩ :=
    have ⟦(p.hom ≫ f : over Q)⟧ = ⟦𝟙 Q⟧, by { rw ←hp at hpbar, exact hpbar },
    match quotient.exact this with ⟨R, x, y, ex, ey, comm⟩ :=
      @epi_of_epi_fac _ _ _ _ _ (x ≫ p.hom) f y ey $
        by { dsimp at comm, rw [category.assoc, comm], apply category.comp_id }
    end
  end
end

section

/-- Two morphisms in an exact sequence are exact on pseudoelements. -/
theorem pseudo_exact_of_exact {P Q R : C} {f : P ⟶ Q} {g : Q ⟶ R} (h : exact f g) :
  (∀ a, g (f a) = 0) ∧ (∀ b, g b = 0 → ∃ a, f a = b) :=
⟨λ a, by { rw [←comp_apply, h.w], exact zero_apply _ _ },
  λ b', quotient.induction_on b' $ λ b hb,
    have hb' : b.hom ≫ g = 0, from (pseudo_zero_iff _).1 hb,
    begin
      -- By exactness, b factors through im f = ker g via some c
      obtain ⟨c, hc⟩ := kernel_fork.is_limit.lift' (is_limit_image f g h) _ hb',

      -- We compute the pullback of the map into the image and c.
      -- The pseudoelement induced by the first pullback map will be our preimage.
      use (pullback.fst : pullback (abelian.factor_thru_image f) c ⟶ P),

      -- It remains to show that the image of this element under f is pseudo-equal to b.
      apply quotient.sound,

      -- pullback.snd is an epimorphism because the map onto the image is!
      refine ⟨pullback (abelian.factor_thru_image f) c, 𝟙 _, pullback.snd,
        by apply_instance, by apply_instance, _⟩,

      -- Now we can verify that the diagram commutes.
      calc 𝟙 (pullback (abelian.factor_thru_image f) c) ≫ pullback.fst ≫ f = pullback.fst ≫ f
                : category.id_comp _
        ... = pullback.fst ≫ abelian.factor_thru_image f ≫ kernel.ι (cokernel.π f)
                : by rw abelian.image.fac
        ... = (pullback.snd ≫ c) ≫ kernel.ι (cokernel.π f)
                : by rw [←category.assoc, pullback.condition]
        ... = pullback.snd ≫ b.hom
                : by { rw category.assoc, congr' }
    end⟩

end

lemma apply_eq_zero_of_comp_eq_zero {P Q R : C} (f : Q ⟶ R) (a : P ⟶ Q) : a ≫ f = 0 → f a = 0 :=
λ h, by simp [over_coe_def, pseudo_apply_mk, over.coe_hom, h]

section

/-- If two morphisms are exact on pseudoelements, they are exact. -/
theorem exact_of_pseudo_exact {P Q R : C} (f : P ⟶ Q) (g : Q ⟶ R) :
  (∀ a, g (f a) = 0) ∧ (∀ b, g b = 0 → ∃ a, f a = b) → exact f g :=
λ ⟨h₁, h₂⟩, (abelian.exact_iff _ _).2 ⟨zero_morphism_ext _ $ λ a, by rw [comp_apply, h₁ a],
begin
  -- If we apply g to the pseudoelement induced by its kernel, we get 0 (of course!).
  have : g (kernel.ι g) = 0 := apply_eq_zero_of_comp_eq_zero _ _ (kernel.condition _),

  -- By pseudo-exactness, we get a preimage.
  obtain ⟨a', ha⟩ := h₂ _ this,
  obtain ⟨a, ha'⟩ := quotient.exists_rep a',
  rw ←ha' at ha,
  obtain ⟨Z, r, q, er, eq, comm⟩ := quotient.exact ha,

  -- Consider the pullback of kernel.ι (cokernel.π f) and kernel.ι g.
  -- The commutative diagram given by the pseudo-equality f a = b induces
  -- a cone over this pullback, so we get a factorization z.
  obtain ⟨z, hz₁, hz₂⟩ := @pullback.lift' _ _ _ _ _ _ (kernel.ι (cokernel.π f)) (kernel.ι g) _
    (r ≫ a.hom ≫ abelian.factor_thru_image f) q
      (by { simp only [category.assoc, abelian.image.fac], exact comm }),

  -- Let's give a name to the second pullback morphism.
  let j : pullback (kernel.ι (cokernel.π f)) (kernel.ι g) ⟶ kernel g := pullback.snd,

  -- Since q is an epimorphism, in particular this means that j is an epimorphism.
  haveI pe : epi j := by exactI epi_of_epi_fac hz₂,

  -- But is is also a monomorphism, because kernel.ι (cokernel.π f) is: A kernel is
  -- always a monomorphism and the pullback of a monomorphism is a monomorphism.
  -- But mono + epi = iso, so j is an isomorphism.
  haveI : is_iso j := is_iso_of_mono_of_epi _,

  -- But then kernel.ι g can be expressed using all of the maps of the pullback square, and we
  -- are done.
  rw (iso.eq_inv_comp (as_iso j)).2 pullback.condition.symm,
  simp only [category.assoc, kernel.condition, has_zero_morphisms.comp_zero]
end⟩

end

/-- If two pseudoelements `x` and `y` have the same image under some morphism `f`, then we can form
    their "difference" `z`. This pseudoelement has the properties that `f z = 0` and for all
    morphisms `g`, if `g y = 0` then `g z = g x`. -/
theorem sub_of_eq_image {P Q : C} (f : P ⟶ Q) (x y : P) : f x = f y →
  ∃ z, f z = 0 ∧ ∀ (R : C) (g : P ⟶ R), (g : P ⟶ R) y = 0 → g z = g x :=
quotient.induction_on₂ x y $ λ a a' h,
match quotient.exact h with ⟨R, p, q, ep, eq, comm⟩ :=
  let a'' : R ⟶ P := p ≫ a.hom - q ≫ a'.hom in ⟨a'',
    ⟨show ⟦((p ≫ a.hom - q ≫ a'.hom) ≫ f : over Q)⟧ = ⟦(0 : Q ⟶ Q)⟧,
      by { dsimp at comm, simp [sub_eq_zero.2 comm] },
      λ Z g hh,
      begin
        obtain ⟨X, p', q', ep', eq', comm'⟩ := quotient.exact hh,

        have : a'.hom ≫ g = 0,
        { apply (epi_iff_cancel_zero _).1 ep' _ (a'.hom ≫ g),
          simpa using comm' },

        apply quotient.sound,

        -- Can we prevent quotient.sound from giving us this weird `coe_b` thingy?
        change app g (a'' : over P) ≈ app g a,

        exact ⟨R, 𝟙 R, p, by apply_instance, ep, by simp [sub_eq_add_neg, this]⟩
      end⟩⟩
end

variable [limits.has_pullbacks C]
/-- If `f : P ⟶ R` and `g : Q ⟶ R` are morphisms and `p : P` and `q : Q` are pseudoelements such
    that `f p = g q`, then there is some `s : pullback f g` such that `fst s = p` and `snd s = q`.

    Remark: Borceux claims that `s` is unique, but this is false. See
    `counterexamples/pseudoelement` for details. -/
theorem pseudo_pullback {P Q R : C} {f : P ⟶ R} {g : Q ⟶ R} {p : P} {q : Q} : f p = g q →
  ∃ s, (pullback.fst : pullback f g ⟶ P) s = p ∧ (pullback.snd : pullback f g ⟶ Q) s = q :=
quotient.induction_on₂ p q $ λ x y h,
begin
  obtain ⟨Z, a, b, ea, eb, comm⟩ := quotient.exact h,

  obtain ⟨l, hl₁, hl₂⟩ := @pullback.lift' _ _ _ _ _ _ f g _ (a ≫ x.hom) (b ≫ y.hom)
    (by { simp only [category.assoc], exact comm }),

  exact ⟨l, ⟨quotient.sound ⟨Z, 𝟙 Z, a, by apply_instance, ea, by rwa category.id_comp⟩,
    quotient.sound ⟨Z, 𝟙 Z, b, by apply_instance, eb, by rwa category.id_comp⟩⟩⟩
end

section module

local attribute [-instance] hom_to_fun

/-- In the category `Module R`, if `x` and `y` are pseudoequal, then the range of the associated
morphisms is the same. -/
lemma Module.eq_range_of_pseudoequal {R : Type*} [comm_ring R] {G : Module R} {x y : over G}
  (h : pseudo_equal G x y) : x.hom.range = y.hom.range :=
begin
  obtain ⟨P, p, q, hp, hq, H⟩ := h,
  refine submodule.ext (λ a, ⟨λ ha, _, λ ha, _⟩),
  { obtain ⟨a', ha'⟩ := ha,
    obtain ⟨a'', ha''⟩ := (Module.epi_iff_surjective p).1 hp a',
    refine ⟨q a'', _⟩,
    rw [← linear_map.comp_apply, ← Module.comp_def, ← H, Module.comp_def, linear_map.comp_apply,
      ha'', ha'] },
  { obtain ⟨a', ha'⟩ := ha,
    obtain ⟨a'', ha''⟩ := (Module.epi_iff_surjective q).1 hq a',
    refine ⟨p a'', _⟩,
    rw [← linear_map.comp_apply, ← Module.comp_def, H, Module.comp_def, linear_map.comp_apply,
      ha'', ha'] }
end

end module

end pseudoelement
end category_theory.abelian


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

/-!
# Reflexive coequalizers

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

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

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

namespace category_theory

universes v v₂ u u₂

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

namespace limits

variables (C)

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

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

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

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

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

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

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

end limits

open limits

end category_theory


import tactic

noncomputable theory
open_locale classical
open set function

@[protect_proj]
class subset (A : Type*) (B : out_param $ Type*) :=
(mem : B → A → Prop)

namespace subset
-- The following allows us to use the symbol `∈`
instance {A : Type*} {B : Type*} [subset A B] : has_mem B A := ⟨subset.mem⟩

-- This says that two "subset"s are equivalent (written `≈`, type with \approx) when
-- they have the same points.
instance {A : Type*} {B : Type*} [subset A B] : has_equiv A := ⟨λ X Y, ∀ t, t ∈ X ↔ t ∈ Y⟩
@[simp] lemma equiv_iff {A : Type*} {B : Type*} [subset A B] (X Y : A) : X ≈ Y ↔ ∀ t, t ∈ X ↔ t ∈ Y := iff.rfl

-- A "subset" can always be considered as an actual subset, in Lean this is `set B`
instance {A : Type*} {B : Type*} [subset A B] : has_coe_t A (set B) := ⟨λ x p, p ∈ x⟩

@[simp] lemma mem_pts  {A : Type*} {B : Type*} [subset A B] (a : A) (P : B) : P ∈ (a : set B) ↔ P ∈ a
:= iff.rfl

end subset

@[simp] def pts {A : Type*} {B : Type*} [subset A B] : A → set B := λ a, {x : B | x ∈ a}

notation p `xor` q := (p ∧ ¬ q) ∨ (q ∧ ¬ p)
def xor3 (p q r : Prop) : Prop := (p ∧ ¬ q ∧ ¬ r) ∨ (¬ p ∧ q ∧ ¬ r) ∨ (¬ p ∧ ¬ q ∧ r)

/--
We define an incidence plane as having the undefined terms `Point` and `Line`,
a function `distance` that takes every two points to a real number, and a predicate
`belongs` that relates points and lines.

There are essentially two axioms: existence of two distinct points, and the incidence postulate.
-/
class IncidencePlane (Point : Type*) :=
	(Line : Type*)

	-- Belongs is an undefined concept
  (belongs : Point → Line → Prop)
	(infix `∈`:100 := belongs)

	-- I1 postulate is divided into 4 statements
	(line_through' : Point → Point → Line)
	(line_through_left' (P Q : Point) : P ∈ (line_through' P Q))
	(line_through_right' (P Q : Point) : Q ∈ (line_through' P Q))
	(incidence' {P Q : Point} {ℓ : Line} : P ≠ Q → P ∈ ℓ → Q ∈ ℓ → ℓ = line_through' P Q)

	-- I2 postulate
	(line_contains_two_points' (ℓ : Line) : ∃ P Q : Point, P ≠ Q ∧ ℓ = line_through' P Q)

	-- I3 postulate (existence postulate)
	(existence' : ∃ P Q R : Point, P ≠ Q ∧ P ≠ R ∧ Q ≠ R ∧ ¬ R ∈ (line_through' P Q))

	-- Betweenness is an undefined concept
	(between : Point → Point → Point → Prop)
	(notation A `*` B `*` C := between A B C)

	/- Betweenness is symmetric -/
	(between_symmetric' {A B C : Point} : (A * B * C) → (C * B * A))
	/- If A * B * C then the three points are distinct and collinear. -/
	(different_of_between' {A B C : Point} : (A * B * C) → (A ≠ B ∧ A ≠ C ∧ B ≠ C))
	(collinear_of_between' {A B C : Point} : (A * B * C) → ∃ ℓ, A ∈ ℓ ∧ B ∈ ℓ ∧ C ∈ ℓ)

	/- Given two distinct points A, B, there is a third point C such that A * B * C.-/
	(point_on_ray' {A B : Point} (h: A ≠ B) : ∃ C, A * B * C)

	/- Given 3 distinct collinear points A B C, exactly one of them is between the other two.-/
	(between_of_collinear' {A B C : Point} (h: ∃ℓ, A ∈ ℓ ∧ B ∈ ℓ ∧ C ∈ ℓ) : xor3 (A * B * C) ( B * A * C ) (A * C * B))

	/- Pasch -/
	(pasch' {A B C D : Point} {ℓ : Line}
		(hnc: ¬ C ∈ line_through' A B)
		(hnAl: ¬ (A ∈ ℓ)) (hnBl: ¬ B ∈ ℓ) (hnCl: ¬ C ∈ ℓ)
		(hDl: D ∈ ℓ) (hADB: A * D * B) : (∃ E ,  E ∈ ℓ ∧ (A * E * C)) xor (∃ E, E ∈ ℓ ∧ (B * E * C)))

namespace IncidencePlane
variables {Ω Point : Type*} [IncidencePlane Ω] [IncidencePlane Point]

-- From here on, we can use the symbol `∈` for Lines
instance : subset (Line Ω) Ω := {mem := belongs}

notation A `*` B `*` C := IncidencePlane.between A B C

-- Define again everything

-- A1
def line_through (P Q : Ω) : Line Ω := line_through' P Q
@[simp] lemma line_through_left (P Q : Ω) : P ∈ (line_through P Q) := line_through_left' P Q
@[simp] lemma line_through_right (P Q : Ω) : Q ∈ (line_through P Q) := line_through_right' P Q
lemma incidence {P Q : Ω} {ℓ : Line Ω} : P ≠ Q → P ∈ ℓ → Q ∈ ℓ → ℓ = line_through P Q
:= incidence'

-- A2
lemma line_contains_two_points (ℓ : Line Ω) : ∃ P Q : Ω, P ≠ Q ∧ ℓ = line_through P Q
:= line_contains_two_points' ℓ

-- A3
lemma existence (Ω : Type*) [IncidencePlane Ω] : ∃ P Q R : Ω, P ≠ Q ∧ P ≠ R ∧ Q ≠ R ∧
R ∉ (line_through P Q) := existence'

lemma between_symmetric {A B C : Ω} : (A * B * C) → (C * B * A)  := between_symmetric'
lemma different_of_between {A B C : Ω} : (A * B * C) → (A ≠ B ∧ A ≠ C ∧ B ≠ C) := different_of_between'
lemma collinear_of_between {A B C : Ω} : (A * B * C) → ∃ ℓ : Line Ω, A ∈ ℓ ∧ B ∈ ℓ ∧ C ∈ ℓ := collinear_of_between'
lemma point_on_ray {A B : Ω} (h: A ≠ B) : ∃ (C : Ω), A * B * C := point_on_ray' h
lemma between_of_collinear {A B C : Ω} (h: ∃(ℓ : Line Ω), A ∈ ℓ ∧ B ∈ ℓ ∧ C ∈ ℓ) : xor3 (A * B * C) ( B * A * C ) (A * C * B)
:= between_of_collinear' h
lemma pasch {A B C D : Ω} {ℓ : Line Ω} (hnc: ¬ C ∈ line_through A B)
(hnAl: ¬ (A ∈ ℓ)) (hnBl: ¬ B ∈ ℓ) (hnCl: ¬ C ∈ ℓ) (hDl: D ∈ ℓ) (hADB: A * D * B) :
(∃ E ,  E ∈ ℓ ∧ (A * E * C)) xor (∃ E, E ∈ ℓ ∧ (B * E * C)) := pasch' hnc hnAl hnBl hnCl hDl hADB

-- Define collinearity of a set of points to mean that they all lie on some line
def collinear (S : set Ω) : Prop := ∃ (ℓ : Line Ω), ∀ {P : Ω}, P ∈ S → P ∈ ℓ

/--
Two lines intersect if they share a point
-/
def intersect (r s : Line Ω) : Prop := ∃ A, A ∈ r ∧ A ∈ s

/--
Two lines are parallel if they dont intersect (so a line is never parallel to itself)
-/
def parallel (r s : Line Ω) : Prop := ¬ intersect r s

-- Next we introduce the notion of a Segment.

/--
A segment is the giving two points, A and B.
We will use the notation A⬝B to denote the segment denoted by A and B. The segment A⬝B consists
of all the points X such that A * X * B.
-/
structure Segment (Ω : Type*) :=
(A : Ω) (B : Ω)

infix `⬝`:100 := Segment.mk

namespace Segment

-- Declare when P ∈ A⬝B
instance : subset (Segment Ω) Ω := { mem := λ P S, P = S.A ∨ P = S.B ∨ S.A * P * S.B }
@[simp] lemma mem_pts (S : Segment Ω) (P : Ω) : P ∈ S ↔ P = S.A ∨ P = S.B ∨ (S.A * P * S.B) := iff.rfl

end Segment

end IncidencePlane


/-
Copyright (c) 2020 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.equiv.mul_add_aut
import Mathlib.logic.function.basic
import Mathlib.group_theory.subgroup
import Mathlib.PostPort

universes u_1 u_2 l u_3 u_4 u_5

namespace Mathlib

/-!
# Semidirect product

This file defines semidirect products of groups, and the canonical maps in and out of the
semidirect product. The semidirect product of `N` and `G` given a hom `φ` from
`φ` from `G` to the automorphism group of `N` is the product of sets with the group
`⟨n₁, g₁⟩ * ⟨n₂, g₂⟩ = ⟨n₁ * φ g₁ n₂, g₁ * g₂⟩`

## Key definitions

There are two homs into the semidirect product `inl : N →* N ⋊[φ] G` and
`inr : G →* N ⋊[φ] G`, and `lift` can be used to define maps `N ⋊[φ] G →* H`
out of the semidirect product given maps `f₁ : N →* H` and `f₂ : G →* H` that satisfy the
condition `∀ n g, f₁ (φ g n) = f₂ g * f₁ n * f₂ g⁻¹`

## Notation

This file introduces the global notation `N ⋊[φ] G` for `semidirect_product N G φ`

## Tags
group, semidirect product
-/

/-- The semidirect product of groups `N` and `G`, given a map `φ` from `G` to the automorphism
  group of `N`. It the product of sets with the group operation
  `⟨n₁, g₁⟩ * ⟨n₂, g₂⟩ = ⟨n₁ * φ g₁ n₂, g₁ * g₂⟩` -/
structure semidirect_product (N : Type u_1) (G : Type u_2) [group N] [group G] (φ : G →* mul_aut N)
    where
  left : N
  right : G

namespace semidirect_product

protected instance group {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} :
    group (semidirect_product N G φ) :=
  group.mk mul_aux mul_assoc_aux one_aux one_mul_aux mul_one_aux inv_aux
    (div_inv_monoid.div._default mul_aux mul_assoc_aux one_aux one_mul_aux mul_one_aux inv_aux)
    mul_left_inv_aux

protected instance inhabited {N : Type u_1} {G : Type u_2} [group N] [group G]
    {φ : G →* mul_aut N} : Inhabited (semidirect_product N G φ) :=
  { default := 1 }

@[simp] theorem one_left {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} :
    left 1 = 1 :=
  rfl

@[simp] theorem one_right {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} :
    right 1 = 1 :=
  rfl

@[simp] theorem inv_left {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N}
    (a : semidirect_product N G φ) : left (a⁻¹) = coe_fn (coe_fn φ (right a⁻¹)) (left a⁻¹) :=
  rfl

@[simp] theorem inv_right {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N}
    (a : semidirect_product N G φ) : right (a⁻¹) = (right a⁻¹) :=
  rfl

@[simp] theorem mul_left {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N}
    (a : semidirect_product N G φ) (b : semidirect_product N G φ) :
    left (a * b) = left a * coe_fn (coe_fn φ (right a)) (left b) :=
  rfl

@[simp] theorem mul_right {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N}
    (a : semidirect_product N G φ) (b : semidirect_product N G φ) :
    right (a * b) = right a * right b :=
  rfl

/-- The canonical map `N →* N ⋊[φ] G` sending `n` to `⟨n, 1⟩` -/
def inl {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} :
    N →* semidirect_product N G φ :=
  monoid_hom.mk (fun (n : N) => mk n 1) sorry sorry

@[simp] theorem left_inl {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N}
    (n : N) : left (coe_fn inl n) = n :=
  rfl

@[simp] theorem right_inl {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N}
    (n : N) : right (coe_fn inl n) = 1 :=
  rfl

theorem inl_injective {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} :
    function.injective ⇑inl :=
  iff.mpr function.injective_iff_has_left_inverse (Exists.intro left left_inl)

@[simp] theorem inl_inj {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N}
    {n₁ : N} {n₂ : N} : coe_fn inl n₁ = coe_fn inl n₂ ↔ n₁ = n₂ :=
  function.injective.eq_iff inl_injective

/-- The canonical map `G →* N ⋊[φ] G` sending `g` to `⟨1, g⟩` -/
def inr {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} :
    G →* semidirect_product N G φ :=
  monoid_hom.mk (fun (g : G) => mk 1 g) sorry sorry

@[simp] theorem left_inr {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N}
    (g : G) : left (coe_fn inr g) = 1 :=
  rfl

@[simp] theorem right_inr {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N}
    (g : G) : right (coe_fn inr g) = g :=
  rfl

theorem inr_injective {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} :
    function.injective ⇑inr :=
  iff.mpr function.injective_iff_has_left_inverse (Exists.intro right right_inr)

@[simp] theorem inr_inj {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N}
    {g₁ : G} {g₂ : G} : coe_fn inr g₁ = coe_fn inr g₂ ↔ g₁ = g₂ :=
  function.injective.eq_iff inr_injective

theorem inl_aut {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} (g : G)
    (n : N) : coe_fn inl (coe_fn (coe_fn φ g) n) = coe_fn inr g * coe_fn inl n * coe_fn inr (g⁻¹) :=
  sorry

theorem inl_aut_inv {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} (g : G)
    (n : N) :
    coe_fn inl (coe_fn (coe_fn φ g⁻¹) n) = coe_fn inr (g⁻¹) * coe_fn inl n * coe_fn inr g :=
  sorry

@[simp] theorem mk_eq_inl_mul_inr {N : Type u_1} {G : Type u_2} [group N] [group G]
    {φ : G →* mul_aut N} (g : G) (n : N) : mk n g = coe_fn inl n * coe_fn inr g :=
  sorry

@[simp] theorem inl_left_mul_inr_right {N : Type u_1} {G : Type u_2} [group N] [group G]
    {φ : G →* mul_aut N} (x : semidirect_product N G φ) :
    coe_fn inl (left x) * coe_fn inr (right x) = x :=
  sorry

/-- The canonical projection map `N ⋊[φ] G →* G`, as a group hom. -/
def right_hom {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} :
    semidirect_product N G φ →* G :=
  monoid_hom.mk right sorry sorry

@[simp] theorem right_hom_eq_right {N : Type u_1} {G : Type u_2} [group N] [group G]
    {φ : G →* mul_aut N} : ⇑right_hom = right :=
  rfl

@[simp] theorem right_hom_comp_inl {N : Type u_1} {G : Type u_2} [group N] [group G]
    {φ : G →* mul_aut N} : monoid_hom.comp right_hom inl = 1 :=
  sorry

@[simp] theorem right_hom_comp_inr {N : Type u_1} {G : Type u_2} [group N] [group G]
    {φ : G →* mul_aut N} : monoid_hom.comp right_hom inr = monoid_hom.id G :=
  sorry

@[simp] theorem right_hom_inl {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N}
    (n : N) : coe_fn right_hom (coe_fn inl n) = 1 :=
  sorry

@[simp] theorem right_hom_inr {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N}
    (g : G) : coe_fn right_hom (coe_fn inr g) = g :=
  sorry

theorem right_hom_surjective {N : Type u_1} {G : Type u_2} [group N] [group G]
    {φ : G →* mul_aut N} : function.surjective ⇑right_hom :=
  iff.mpr function.surjective_iff_has_right_inverse (Exists.intro (⇑inr) right_hom_inr)

theorem range_inl_eq_ker_right_hom {N : Type u_1} {G : Type u_2} [group N] [group G]
    {φ : G →* mul_aut N} : monoid_hom.range inl = monoid_hom.ker right_hom :=
  sorry

/-- Define a group hom `N ⋊[φ] G →* H`, by defining maps `N →* H` and `G →* H`  -/
def lift {N : Type u_1} {G : Type u_2} {H : Type u_3} [group N] [group G] [group H]
    {φ : G →* mul_aut N} (f₁ : N →* H) (f₂ : G →* H)
    (h :
      ∀ (g : G),
        monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
          monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn mul_aut.conj (coe_fn f₂ g))) f₁) :
    semidirect_product N G φ →* H :=
  monoid_hom.mk (fun (a : semidirect_product N G φ) => coe_fn f₁ (left a) * coe_fn f₂ (right a))
    sorry sorry

@[simp] theorem lift_inl {N : Type u_1} {G : Type u_2} {H : Type u_3} [group N] [group G] [group H]
    {φ : G →* mul_aut N} (f₁ : N →* H) (f₂ : G →* H)
    (h :
      ∀ (g : G),
        monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
          monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn mul_aut.conj (coe_fn f₂ g))) f₁)
    (n : N) : coe_fn (lift f₁ f₂ h) (coe_fn inl n) = coe_fn f₁ n :=
  sorry

@[simp] theorem lift_comp_inl {N : Type u_1} {G : Type u_2} {H : Type u_3} [group N] [group G]
    [group H] {φ : G →* mul_aut N} (f₁ : N →* H) (f₂ : G →* H)
    (h :
      ∀ (g : G),
        monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
          monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn mul_aut.conj (coe_fn f₂ g))) f₁) :
    monoid_hom.comp (lift f₁ f₂ h) inl = f₁ :=
  sorry

@[simp] theorem lift_inr {N : Type u_1} {G : Type u_2} {H : Type u_3} [group N] [group G] [group H]
    {φ : G →* mul_aut N} (f₁ : N →* H) (f₂ : G →* H)
    (h :
      ∀ (g : G),
        monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
          monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn mul_aut.conj (coe_fn f₂ g))) f₁)
    (g : G) : coe_fn (lift f₁ f₂ h) (coe_fn inr g) = coe_fn f₂ g :=
  sorry

@[simp] theorem lift_comp_inr {N : Type u_1} {G : Type u_2} {H : Type u_3} [group N] [group G]
    [group H] {φ : G →* mul_aut N} (f₁ : N →* H) (f₂ : G →* H)
    (h :
      ∀ (g : G),
        monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
          monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn mul_aut.conj (coe_fn f₂ g))) f₁) :
    monoid_hom.comp (lift f₁ f₂ h) inr = f₂ :=
  sorry

theorem lift_unique {N : Type u_1} {G : Type u_2} {H : Type u_3} [group N] [group G] [group H]
    {φ : G →* mul_aut N} (F : semidirect_product N G φ →* H) :
    F =
        lift (monoid_hom.comp F inl) (monoid_hom.comp F inr)
          fun (_x : G) =>
            monoid_hom.ext
              fun (x : N) =>
                eq.mpr
                  (id
                    (Eq.trans
                      (Eq.trans
                        (Eq.trans
                          ((fun (a a_1 : H) (e_1 : a = a_1) (ᾰ ᾰ_1 : H) (e_2 : ᾰ = ᾰ_1) =>
                              congr (congr_arg Eq e_1) e_2)
                            (coe_fn
                              (monoid_hom.comp (monoid_hom.comp F inl)
                                (mul_equiv.to_monoid_hom (coe_fn φ _x)))
                              x)
                            (coe_fn F (coe_fn inr _x) * coe_fn F (coe_fn inl x) *
                              (coe_fn F (coe_fn inr _x)⁻¹))
                            (Eq.trans
                              (Eq.trans
                                (Eq.trans
                                  (Eq.trans
                                    (Eq.trans
                                      (Eq.trans
                                        (congr_fun
                                          (monoid_hom.coe_comp (monoid_hom.comp F inl)
                                            (mul_equiv.to_monoid_hom (coe_fn φ _x)))
                                          x)
                                        ((fun (f f_1 : N → H) (e_1 : f = f_1) (g g_1 : N → N)
                                            (e_2 : g = g_1) (ᾰ ᾰ_1 : N) (e_3 : ᾰ = ᾰ_1) =>
                                            congr (congr (congr_arg function.comp e_1) e_2) e_3)
                                          (⇑(monoid_hom.comp F inl)) (⇑F ∘ ⇑inl)
                                          (monoid_hom.coe_comp F inl)
                                          (⇑(mul_equiv.to_monoid_hom (coe_fn φ _x)))
                                          (⇑(coe_fn φ _x))
                                          (mul_equiv.coe_to_monoid_hom (coe_fn φ _x)) x x
                                          (Eq.refl x)))
                                      (function.comp_app (⇑F ∘ ⇑inl) (⇑(coe_fn φ _x)) x))
                                    (function.comp_app (⇑F) (⇑inl) (coe_fn (coe_fn φ _x) x)))
                                  ((fun (x x_1 : semidirect_product N G φ →* H) (e_1 : x = x_1)
                                      (ᾰ ᾰ_1 : semidirect_product N G φ) (e_2 : ᾰ = ᾰ_1) =>
                                      congr (congr_arg coe_fn e_1) e_2)
                                    F F (Eq.refl F) (coe_fn inl (coe_fn (coe_fn φ _x) x))
                                    (coe_fn inr _x * coe_fn inl x * (coe_fn inr _x⁻¹))
                                    (Eq.trans (inl_aut _x x)
                                      ((fun (ᾰ ᾰ_1 : semidirect_product N G φ) (e_2 : ᾰ = ᾰ_1)
                                          (ᾰ_2 ᾰ_3 : semidirect_product N G φ) (e_3 : ᾰ_2 = ᾰ_3) =>
                                          congr (congr_arg Mul.mul e_2) e_3)
                                        (coe_fn inr _x * coe_fn inl x)
                                        (coe_fn inr _x * coe_fn inl x)
                                        (Eq.refl (coe_fn inr _x * coe_fn inl x)) (coe_fn inr (_x⁻¹))
                                        (coe_fn inr _x⁻¹) (monoid_hom.map_inv inr _x)))))
                                (monoid_hom.map_mul_inv F (coe_fn inr _x * coe_fn inl x)
                                  (coe_fn inr _x)))
                              ((fun (ᾰ ᾰ_1 : H) (e_2 : ᾰ = ᾰ_1) (ᾰ_2 ᾰ_3 : H) (e_3 : ᾰ_2 = ᾰ_3) =>
                                  congr (congr_arg Mul.mul e_2) e_3)
                                (coe_fn F (coe_fn inr _x * coe_fn inl x))
                                (coe_fn F (coe_fn inr _x) * coe_fn F (coe_fn inl x))
                                (monoid_hom.map_mul F (coe_fn inr _x) (coe_fn inl x))
                                (coe_fn F (coe_fn inr _x)⁻¹) (coe_fn F (coe_fn inr _x)⁻¹)
                                (Eq.refl (coe_fn F (coe_fn inr _x)⁻¹))))
                            (coe_fn
                              (monoid_hom.comp
                                (mul_equiv.to_monoid_hom
                                  (coe_fn mul_aut.conj (coe_fn (monoid_hom.comp F inr) _x)))
                                (monoid_hom.comp F inl))
                              x)
                            (coe_fn F (coe_fn inr _x) * coe_fn F (coe_fn inl x) *
                              (coe_fn F (coe_fn inr _x)⁻¹))
                            (Eq.trans
                              (Eq.trans
                                (Eq.trans
                                  (Eq.trans
                                    (Eq.trans
                                      ((fun (x x_1 : N →* H) (e_1 : x = x_1) (ᾰ ᾰ_1 : N)
                                          (e_2 : ᾰ = ᾰ_1) => congr (congr_arg coe_fn e_1) e_2)
                                        (monoid_hom.comp
                                          (mul_equiv.to_monoid_hom
                                            (coe_fn mul_aut.conj
                                              (coe_fn (monoid_hom.comp F inr) _x)))
                                          (monoid_hom.comp F inl))
                                        (monoid_hom.comp
                                          (mul_equiv.to_monoid_hom
                                            (coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x))))
                                          (monoid_hom.comp F inl))
                                        ((fun (hnp hnp_1 : H →* H) (e_1 : hnp = hnp_1)
                                            (hmn hmn_1 : N →* H) (e_2 : hmn = hmn_1) =>
                                            congr (congr_arg monoid_hom.comp e_1) e_2)
                                          (mul_equiv.to_monoid_hom
                                            (coe_fn mul_aut.conj
                                              (coe_fn (monoid_hom.comp F inr) _x)))
                                          (mul_equiv.to_monoid_hom
                                            (coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x))))
                                          ((fun (h h_1 : H ≃* H) (e_1 : h = h_1) =>
                                              congr_arg mul_equiv.to_monoid_hom e_1)
                                            (coe_fn mul_aut.conj
                                              (coe_fn (monoid_hom.comp F inr) _x))
                                            (coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x)))
                                            ((fun (x x_1 : H →* mul_aut H) (e_1 : x = x_1)
                                                (ᾰ ᾰ_1 : H) (e_2 : ᾰ = ᾰ_1) =>
                                                congr (congr_arg coe_fn e_1) e_2)
                                              mul_aut.conj mul_aut.conj (Eq.refl mul_aut.conj)
                                              (coe_fn (monoid_hom.comp F inr) _x)
                                              (coe_fn F (coe_fn inr _x))
                                              (Eq.trans (congr_fun (monoid_hom.coe_comp F inr) _x)
                                                (function.comp_app (⇑F) (⇑inr) _x))))
                                          (monoid_hom.comp F inl) (monoid_hom.comp F inl)
                                          (Eq.refl (monoid_hom.comp F inl)))
                                        x x (Eq.refl x))
                                      (congr_fun
                                        (monoid_hom.coe_comp
                                          (mul_equiv.to_monoid_hom
                                            (coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x))))
                                          (monoid_hom.comp F inl))
                                        x))
                                    ((fun (f f_1 : H → H) (e_1 : f = f_1) (g g_1 : N → H)
                                        (e_2 : g = g_1) (ᾰ ᾰ_1 : N) (e_3 : ᾰ = ᾰ_1) =>
                                        congr (congr (congr_arg function.comp e_1) e_2) e_3)
                                      (⇑(mul_equiv.to_monoid_hom
                                          (coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x)))))
                                      (⇑(coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x))))
                                      (mul_equiv.coe_to_monoid_hom
                                        (coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x))))
                                      (⇑(monoid_hom.comp F inl)) (⇑F ∘ ⇑inl)
                                      (monoid_hom.coe_comp F inl) x x (Eq.refl x)))
                                  (function.comp_app
                                    (⇑(coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x)))) (⇑F ∘ ⇑inl)
                                    x))
                                ((fun (x x_1 : H ≃* H) (e_1 : x = x_1) (ᾰ ᾰ_1 : H)
                                    (e_2 : ᾰ = ᾰ_1) => congr (congr_arg coe_fn e_1) e_2)
                                  (coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x)))
                                  (coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x)))
                                  (Eq.refl (coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x))))
                                  (function.comp (⇑F) (⇑inl) x) (coe_fn F (coe_fn inl x))
                                  (function.comp_app (⇑F) (⇑inl) x)))
                              (mul_aut.conj_apply (coe_fn F (coe_fn inr _x))
                                (coe_fn F (coe_fn inl x)))))
                          (propext (mul_left_inj (coe_fn F (coe_fn inr _x)⁻¹))))
                        (propext (mul_left_inj (coe_fn F (coe_fn inl x)))))
                      (propext (eq_self_iff_true (coe_fn F (coe_fn inr _x))))))
                  trivial :=
  sorry

/-- Two maps out of the semidirect product are equal if they're equal after composition
  with both `inl` and `inr` -/
theorem hom_ext {N : Type u_1} {G : Type u_2} {H : Type u_3} [group N] [group G] [group H]
    {φ : G →* mul_aut N} {f : semidirect_product N G φ →* H} {g : semidirect_product N G φ →* H}
    (hl : monoid_hom.comp f inl = monoid_hom.comp g inl)
    (hr : monoid_hom.comp f inr = monoid_hom.comp g inr) : f = g :=
  sorry

/-- Define a map from `N ⋊[φ] G` to `N₁ ⋊[φ₁] G₁` given maps `N →* N₁` and `G →* G₁` that
  satisfy a commutativity condition `∀ n g, f₁ (φ g n) = φ₁ (f₂ g) (f₁ n)`.  -/
def map {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} {N₁ : Type u_4}
    {G₁ : Type u_5} [group N₁] [group G₁] {φ₁ : G₁ →* mul_aut N₁} (f₁ : N →* N₁) (f₂ : G →* G₁)
    (h :
      ∀ (g : G),
        monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
          monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn φ₁ (coe_fn f₂ g))) f₁) :
    semidirect_product N G φ →* semidirect_product N₁ G₁ φ₁ :=
  monoid_hom.mk
    (fun (x : semidirect_product N G φ) => mk (coe_fn f₁ (left x)) (coe_fn f₂ (right x))) sorry
    sorry

@[simp] theorem map_left {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N}
    {N₁ : Type u_4} {G₁ : Type u_5} [group N₁] [group G₁] {φ₁ : G₁ →* mul_aut N₁} (f₁ : N →* N₁)
    (f₂ : G →* G₁)
    (h :
      ∀ (g : G),
        monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
          monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn φ₁ (coe_fn f₂ g))) f₁)
    (g : semidirect_product N G φ) : left (coe_fn (map f₁ f₂ h) g) = coe_fn f₁ (left g) :=
  rfl

@[simp] theorem map_right {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N}
    {N₁ : Type u_4} {G₁ : Type u_5} [group N₁] [group G₁] {φ₁ : G₁ →* mul_aut N₁} (f₁ : N →* N₁)
    (f₂ : G →* G₁)
    (h :
      ∀ (g : G),
        monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
          monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn φ₁ (coe_fn f₂ g))) f₁)
    (g : semidirect_product N G φ) : right (coe_fn (map f₁ f₂ h) g) = coe_fn f₂ (right g) :=
  rfl

@[simp] theorem right_hom_comp_map {N : Type u_1} {G : Type u_2} [group N] [group G]
    {φ : G →* mul_aut N} {N₁ : Type u_4} {G₁ : Type u_5} [group N₁] [group G₁]
    {φ₁ : G₁ →* mul_aut N₁} (f₁ : N →* N₁) (f₂ : G →* G₁)
    (h :
      ∀ (g : G),
        monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
          monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn φ₁ (coe_fn f₂ g))) f₁) :
    monoid_hom.comp right_hom (map f₁ f₂ h) = monoid_hom.comp f₂ right_hom :=
  rfl

@[simp] theorem map_inl {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N}
    {N₁ : Type u_4} {G₁ : Type u_5} [group N₁] [group G₁] {φ₁ : G₁ →* mul_aut N₁} (f₁ : N →* N₁)
    (f₂ : G →* G₁)
    (h :
      ∀ (g : G),
        monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
          monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn φ₁ (coe_fn f₂ g))) f₁)
    (n : N) : coe_fn (map f₁ f₂ h) (coe_fn inl n) = coe_fn inl (coe_fn f₁ n) :=
  sorry

@[simp] theorem map_comp_inl {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N}
    {N₁ : Type u_4} {G₁ : Type u_5} [group N₁] [group G₁] {φ₁ : G₁ →* mul_aut N₁} (f₁ : N →* N₁)
    (f₂ : G →* G₁)
    (h :
      ∀ (g : G),
        monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
          monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn φ₁ (coe_fn f₂ g))) f₁) :
    monoid_hom.comp (map f₁ f₂ h) inl = monoid_hom.comp inl f₁ :=
  sorry

@[simp] theorem map_inr {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N}
    {N₁ : Type u_4} {G₁ : Type u_5} [group N₁] [group G₁] {φ₁ : G₁ →* mul_aut N₁} (f₁ : N →* N₁)
    (f₂ : G →* G₁)
    (h :
      ∀ (g : G),
        monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
          monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn φ₁ (coe_fn f₂ g))) f₁)
    (g : G) : coe_fn (map f₁ f₂ h) (coe_fn inr g) = coe_fn inr (coe_fn f₂ g) :=
  sorry

@[simp] theorem map_comp_inr {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N}
    {N₁ : Type u_4} {G₁ : Type u_5} [group N₁] [group G₁] {φ₁ : G₁ →* mul_aut N₁} (f₁ : N →* N₁)
    (f₂ : G →* G₁)
    (h :
      ∀ (g : G),
        monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
          monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn φ₁ (coe_fn f₂ g))) f₁) :
    monoid_hom.comp (map f₁ f₂ h) inr = monoid_hom.comp inr f₂ :=
  sorry

end Mathlib


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

! This file was ported from Lean 3 source module analysis.convex.quasiconvex
! leanprover-community/mathlib commit 9003f28797c0664a49e4179487267c494477d853
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Convex.Function

/-!
# Quasiconvex and quasiconcave functions

This file defines quasiconvexity, quasiconcavity and quasilinearity of functions, which are
generalizations of unimodality and monotonicity. Convexity implies quasiconvexity, concavity implies
quasiconcavity, and monotonicity implies quasilinearity.

## Main declarations

* `quasiconvex_on 𝕜 s f`: Quasiconvexity of the function `f` on the set `s` with scalars `𝕜`. This
  means that, for all `r`, `{x ∈ s | f x ≤ r}` is `𝕜`-convex.
* `quasiconcave_on 𝕜 s f`: Quasiconcavity of the function `f` on the set `s` with scalars `𝕜`. This
  means that, for all `r`, `{x ∈ s | r ≤ f x}` is `𝕜`-convex.
* `quasilinear_on 𝕜 s f`: Quasilinearity of the function `f` on the set `s` with scalars `𝕜`. This
  means that `f` is both quasiconvex and quasiconcave.

## References

* https://en.wikipedia.org/wiki/Quasiconvex_function
-/

open Function OrderDual Set

variable {𝕜 E F β : Type _}

section OrderedSemiring

variable [OrderedSemiring 𝕜]

section AddCommMonoid

variable [AddCommMonoid E] [AddCommMonoid F]

section OrderedAddCommMonoid

variable (𝕜) [OrderedAddCommMonoid β] [SMul 𝕜 E] (s : Set E) (f : E → β)

/-- A function is quasiconvex if all its sublevels are convex.
This means that, for all `r`, `{x ∈ s | f x ≤ r}` is `𝕜`-convex. -/
def QuasiconvexOn : Prop :=
  ∀ r, Convex 𝕜 ({ x ∈ s | f x ≤ r })
#align quasiconvex_on QuasiconvexOn

/-- A function is quasiconcave if all its superlevels are convex.
This means that, for all `r`, `{x ∈ s | r ≤ f x}` is `𝕜`-convex. -/
def QuasiconcaveOn : Prop :=
  ∀ r, Convex 𝕜 ({ x ∈ s | r ≤ f x })
#align quasiconcave_on QuasiconcaveOn

/-- A function is quasilinear if it is both quasiconvex and quasiconcave.
This means that, for all `r`,
the sets `{x ∈ s | f x ≤ r}` and `{x ∈ s | r ≤ f x}` are `𝕜`-convex. -/
def QuasilinearOn : Prop :=
  QuasiconvexOn 𝕜 s f ∧ QuasiconcaveOn 𝕜 s f
#align quasilinear_on QuasilinearOn

variable {𝕜 s f}

theorem QuasiconvexOn.dual : QuasiconvexOn 𝕜 s f → QuasiconcaveOn 𝕜 s (toDual ∘ f) :=
  id
#align quasiconvex_on.dual QuasiconvexOn.dual

theorem QuasiconcaveOn.dual : QuasiconcaveOn 𝕜 s f → QuasiconvexOn 𝕜 s (toDual ∘ f) :=
  id
#align quasiconcave_on.dual QuasiconcaveOn.dual

theorem QuasilinearOn.dual : QuasilinearOn 𝕜 s f → QuasilinearOn 𝕜 s (toDual ∘ f) :=
  And.symm
#align quasilinear_on.dual QuasilinearOn.dual

theorem Convex.quasiconvexOn_of_convex_le (hs : Convex 𝕜 s) (h : ∀ r, Convex 𝕜 { x | f x ≤ r }) :
    QuasiconvexOn 𝕜 s f := fun r => hs.inter (h r)
#align convex.quasiconvex_on_of_convex_le Convex.quasiconvexOn_of_convex_le

theorem Convex.quasiconcaveOn_of_convex_ge (hs : Convex 𝕜 s) (h : ∀ r, Convex 𝕜 { x | r ≤ f x }) :
    QuasiconcaveOn 𝕜 s f :=
  @Convex.quasiconvexOn_of_convex_le 𝕜 E βᵒᵈ _ _ _ _ _ _ hs h
#align convex.quasiconcave_on_of_convex_ge Convex.quasiconcaveOn_of_convex_ge

theorem QuasiconvexOn.convex [IsDirected β (· ≤ ·)] (hf : QuasiconvexOn 𝕜 s f) : Convex 𝕜 s :=
  fun x hx y hy a b ha hb hab =>
  let ⟨z, hxz, hyz⟩ := exists_ge_ge (f x) (f y)
  (hf _ ⟨hx, hxz⟩ ⟨hy, hyz⟩ ha hb hab).1
#align quasiconvex_on.convex QuasiconvexOn.convex

theorem QuasiconcaveOn.convex [IsDirected β (· ≥ ·)] (hf : QuasiconcaveOn 𝕜 s f) : Convex 𝕜 s :=
  hf.dual.Convex
#align quasiconcave_on.convex QuasiconcaveOn.convex

end OrderedAddCommMonoid

section LinearOrderedAddCommMonoid

variable [LinearOrderedAddCommMonoid β]

section SMul

variable [SMul 𝕜 E] {s : Set E} {f g : E → β}

theorem QuasiconvexOn.sup (hf : QuasiconvexOn 𝕜 s f) (hg : QuasiconvexOn 𝕜 s g) :
    QuasiconvexOn 𝕜 s (f ⊔ g) := by
  intro r
  simp_rw [Pi.sup_def, sup_le_iff, Set.sep_and]
  exact (hf r).inter (hg r)
#align quasiconvex_on.sup QuasiconvexOn.sup

theorem QuasiconcaveOn.inf (hf : QuasiconcaveOn 𝕜 s f) (hg : QuasiconcaveOn 𝕜 s g) :
    QuasiconcaveOn 𝕜 s (f ⊓ g) :=
  hf.dual.sup hg
#align quasiconcave_on.inf QuasiconcaveOn.inf

theorem quasiconvexOn_iff_le_max :
    QuasiconvexOn 𝕜 s f ↔
      Convex 𝕜 s ∧
        ∀ ⦃x⦄,
          x ∈ s →
            ∀ ⦃y⦄,
              y ∈ s →
                ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 → f (a • x + b • y) ≤ max (f x) (f y) :=
  ⟨fun hf =>
    ⟨hf.Convex, fun x hx y hy a b ha hb hab =>
      (hf _ ⟨hx, le_max_left _ _⟩ ⟨hy, le_max_right _ _⟩ ha hb hab).2⟩,
    fun hf r x hx y hy a b ha hb hab =>
    ⟨hf.1 hx.1 hy.1 ha hb hab, (hf.2 hx.1 hy.1 ha hb hab).trans <| max_le hx.2 hy.2⟩⟩
#align quasiconvex_on_iff_le_max quasiconvexOn_iff_le_max

theorem quasiconcaveOn_iff_min_le :
    QuasiconcaveOn 𝕜 s f ↔
      Convex 𝕜 s ∧
        ∀ ⦃x⦄,
          x ∈ s →
            ∀ ⦃y⦄,
              y ∈ s →
                ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 → min (f x) (f y) ≤ f (a • x + b • y) :=
  @quasiconvexOn_iff_le_max 𝕜 E βᵒᵈ _ _ _ _ _ _
#align quasiconcave_on_iff_min_le quasiconcaveOn_iff_min_le

theorem quasilinearOn_iff_mem_uIcc :
    QuasilinearOn 𝕜 s f ↔
      Convex 𝕜 s ∧
        ∀ ⦃x⦄,
          x ∈ s →
            ∀ ⦃y⦄,
              y ∈ s →
                ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 → f (a • x + b • y) ∈ uIcc (f x) (f y) :=
  by
  rw [QuasilinearOn, quasiconvexOn_iff_le_max, quasiconcaveOn_iff_min_le, and_and_and_comm,
    and_self_iff]
  apply and_congr_right'
  simp_rw [← forall_and, ← Icc_min_max, mem_Icc, and_comm']
#align quasilinear_on_iff_mem_uIcc quasilinearOn_iff_mem_uIcc

theorem QuasiconvexOn.convex_lt (hf : QuasiconvexOn 𝕜 s f) (r : β) :
    Convex 𝕜 ({ x ∈ s | f x < r }) :=
  by
  refine' fun x hx y hy a b ha hb hab => _
  have h := hf _ ⟨hx.1, le_max_left _ _⟩ ⟨hy.1, le_max_right _ _⟩ ha hb hab
  exact ⟨h.1, h.2.trans_lt <| max_lt hx.2 hy.2⟩
#align quasiconvex_on.convex_lt QuasiconvexOn.convex_lt

theorem QuasiconcaveOn.convex_gt (hf : QuasiconcaveOn 𝕜 s f) (r : β) :
    Convex 𝕜 ({ x ∈ s | r < f x }) :=
  hf.dual.convex_lt r
#align quasiconcave_on.convex_gt QuasiconcaveOn.convex_gt

end SMul

section OrderedSMul

variable [SMul 𝕜 E] [Module 𝕜 β] [OrderedSMul 𝕜 β] {s : Set E} {f : E → β}

theorem ConvexOn.quasiconvexOn (hf : ConvexOn 𝕜 s f) : QuasiconvexOn 𝕜 s f :=
  hf.convex_le
#align convex_on.quasiconvex_on ConvexOn.quasiconvexOn

theorem ConcaveOn.quasiconcaveOn (hf : ConcaveOn 𝕜 s f) : QuasiconcaveOn 𝕜 s f :=
  hf.convex_ge
#align concave_on.quasiconcave_on ConcaveOn.quasiconcaveOn

end OrderedSMul

end LinearOrderedAddCommMonoid

end AddCommMonoid

section LinearOrderedAddCommMonoid

variable [LinearOrderedAddCommMonoid E] [OrderedAddCommMonoid β] [Module 𝕜 E] [OrderedSMul 𝕜 E]
  {s : Set E} {f : E → β}

theorem MonotoneOn.quasiconvexOn (hf : MonotoneOn f s) (hs : Convex 𝕜 s) : QuasiconvexOn 𝕜 s f :=
  hf.convex_le hs
#align monotone_on.quasiconvex_on MonotoneOn.quasiconvexOn

theorem MonotoneOn.quasiconcaveOn (hf : MonotoneOn f s) (hs : Convex 𝕜 s) : QuasiconcaveOn 𝕜 s f :=
  hf.convex_ge hs
#align monotone_on.quasiconcave_on MonotoneOn.quasiconcaveOn

theorem MonotoneOn.quasilinearOn (hf : MonotoneOn f s) (hs : Convex 𝕜 s) : QuasilinearOn 𝕜 s f :=
  ⟨hf.QuasiconvexOn hs, hf.QuasiconcaveOn hs⟩
#align monotone_on.quasilinear_on MonotoneOn.quasilinearOn

theorem AntitoneOn.quasiconvexOn (hf : AntitoneOn f s) (hs : Convex 𝕜 s) : QuasiconvexOn 𝕜 s f :=
  hf.convex_le hs
#align antitone_on.quasiconvex_on AntitoneOn.quasiconvexOn

theorem AntitoneOn.quasiconcaveOn (hf : AntitoneOn f s) (hs : Convex 𝕜 s) : QuasiconcaveOn 𝕜 s f :=
  hf.convex_ge hs
#align antitone_on.quasiconcave_on AntitoneOn.quasiconcaveOn

theorem AntitoneOn.quasilinearOn (hf : AntitoneOn f s) (hs : Convex 𝕜 s) : QuasilinearOn 𝕜 s f :=
  ⟨hf.QuasiconvexOn hs, hf.QuasiconcaveOn hs⟩
#align antitone_on.quasilinear_on AntitoneOn.quasilinearOn

theorem Monotone.quasiconvexOn (hf : Monotone f) : QuasiconvexOn 𝕜 univ f :=
  (hf.MonotoneOn _).QuasiconvexOn convex_univ
#align monotone.quasiconvex_on Monotone.quasiconvexOn

theorem Monotone.quasiconcaveOn (hf : Monotone f) : QuasiconcaveOn 𝕜 univ f :=
  (hf.MonotoneOn _).QuasiconcaveOn convex_univ
#align monotone.quasiconcave_on Monotone.quasiconcaveOn

theorem Monotone.quasilinearOn (hf : Monotone f) : QuasilinearOn 𝕜 univ f :=
  ⟨hf.QuasiconvexOn, hf.QuasiconcaveOn⟩
#align monotone.quasilinear_on Monotone.quasilinearOn

theorem Antitone.quasiconvexOn (hf : Antitone f) : QuasiconvexOn 𝕜 univ f :=
  (hf.AntitoneOn _).QuasiconvexOn convex_univ
#align antitone.quasiconvex_on Antitone.quasiconvexOn

theorem Antitone.quasiconcaveOn (hf : Antitone f) : QuasiconcaveOn 𝕜 univ f :=
  (hf.AntitoneOn _).QuasiconcaveOn convex_univ
#align antitone.quasiconcave_on Antitone.quasiconcaveOn

theorem Antitone.quasilinearOn (hf : Antitone f) : QuasilinearOn 𝕜 univ f :=
  ⟨hf.QuasiconvexOn, hf.QuasiconcaveOn⟩
#align antitone.quasilinear_on Antitone.quasilinearOn

end LinearOrderedAddCommMonoid

end OrderedSemiring

section LinearOrderedField

variable [LinearOrderedField 𝕜] [LinearOrderedAddCommMonoid β] {s : Set 𝕜} {f : 𝕜 → β}

theorem QuasilinearOn.monotoneOn_or_antitoneOn (hf : QuasilinearOn 𝕜 s f) :
    MonotoneOn f s ∨ AntitoneOn f s :=
  by
  simp_rw [monotone_on_or_antitone_on_iff_uIcc, ← segment_eq_uIcc]
  rintro a ha b hb c hc h
  refine' ⟨((hf.2 _).segment_subset _ _ h).2, ((hf.1 _).segment_subset _ _ h).2⟩ <;> simp [*]
#align quasilinear_on.monotone_on_or_antitone_on QuasilinearOn.monotoneOn_or_antitoneOn

theorem quasilinearOn_iff_monotoneOn_or_antitoneOn (hs : Convex 𝕜 s) :
    QuasilinearOn 𝕜 s f ↔ MonotoneOn f s ∨ AntitoneOn f s :=
  ⟨fun h => h.monotoneOn_or_antitoneOn, fun h =>
    h.elim (fun h => h.QuasilinearOn hs) fun h => h.QuasilinearOn hs⟩
#align quasilinear_on_iff_monotone_on_or_antitone_on quasilinearOn_iff_monotoneOn_or_antitoneOn

end LinearOrderedField