/-
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 data.sigma.order
! leanprover-community/mathlib commit 1fc36cc9c8264e6e81253f88be7fb2cb6c92d76a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Sigma.Lex
import Mathlib.Order.BoundedOrder
import Mathlib.Mathport.Notation

/-!
# Orders on a sigma type

This file defines two orders on a sigma type:
* The disjoint sum of orders. `a` is less `b` iff `a` and `b` are in the same summand and `a` is
  less than `b` there.
* The lexicographical order. `a` is less than `b` if its summand is strictly less than the summand
  of `b` or they are in the same summand and `a` is less than `b` there.

We make the disjoint sum of orders the default set of instances. The lexicographic order goes on a
type synonym.

## Notation

* `_root_.Lex (Sigma α)`: Sigma type equipped with the lexicographic order.
Type synonym of `Σ i, α i`.

## See also

Related files are:
* `Data.Finset.CoLex`: Colexicographic order on finite sets.
* `Data.List.Lex`: Lexicographic order on lists.
* `Data.Pi.Lex`: Lexicographic order on `Πₗ i, α i`.
* `Data.PSigma.Order`: Lexicographic order on `Σₗ' i, α i`. Basically a twin of this file.
* `Data.Prod.Lex`: Lexicographic order on `α × β`.

## TODO

Upgrade `Equiv.sigma_congr_left`, `Equiv.sigma_congr`, `Equiv.sigma_assoc`,
`Equiv.sigma_prod_of_equiv`, `Equiv.sigma_equiv_prod`, ... to order isomorphisms.
-/

namespace Sigma

variable {ι : Type _} {α : ι → Type _}

/-! ### Disjoint sum of orders on `Sigma` -/

-- porting note: I made this `le` instead of `LE` because the output type is `Prop`
/-- Disjoint sum of orders. `⟨i, a⟩ ≤ ⟨j, b⟩` iff `i = j` and `a ≤ b`. -/
protected inductive le [∀ i, LE (α i)] : ∀ _a _b : Σ i, α i, Prop
  | fiber (i : ι) (a b : α i) : a ≤ b → Sigma.le ⟨i, a⟩ ⟨i, b⟩
#align sigma.le Sigma.le

/-- Disjoint sum of orders. `⟨i, a⟩ < ⟨j, b⟩` iff `i = j` and `a < b`. -/
protected inductive lt [∀ i, LT (α i)] : ∀ _a _b : Σi, α i, Prop
  | fiber (i : ι) (a b : α i) : a < b → Sigma.lt ⟨i, a⟩ ⟨i, b⟩
#align sigma.lt Sigma.lt

protected instance LE [∀ i, LE (α i)] : LE (Σi, α i) where
  le := Sigma.le

protected instance LT [∀ i, LT (α i)] : LT (Σi, α i) where
  lt := Sigma.lt

@[simp]
theorem mk_le_mk_iff [∀ i, LE (α i)] {i : ι} {a b : α i} : (⟨i, a⟩ : Sigma α) ≤ ⟨i, b⟩ ↔ a ≤ b :=
  ⟨fun ⟨_, _, _, h⟩ => h, Sigma.le.fiber _ _ _⟩
#align sigma.mk_le_mk_iff Sigma.mk_le_mk_iff

@[simp]
theorem mk_lt_mk_iff [∀ i, LT (α i)] {i : ι} {a b : α i} : (⟨i, a⟩ : Sigma α) < ⟨i, b⟩ ↔ a < b :=
  ⟨fun ⟨_, _, _, h⟩ => h, Sigma.lt.fiber _ _ _⟩
#align sigma.mk_lt_mk_iff Sigma.mk_lt_mk_iff

theorem le_def [∀ i, LE (α i)] {a b : Σi, α i} : a ≤ b ↔ ∃ h : a.1 = b.1, h.rec a.2 ≤ b.2 := by
  constructor
  · rintro ⟨i, a, b, h⟩
    exact ⟨rfl, h⟩
  · obtain ⟨i, a⟩ := a
    obtain ⟨j, b⟩ := b
    rintro ⟨rfl : i = j, h⟩
    exact le.fiber _ _ _ h
#align sigma.le_def Sigma.le_def

theorem lt_def [∀ i, LT (α i)] {a b : Σi, α i} : a < b ↔ ∃ h : a.1 = b.1, h.rec a.2 < b.2 := by
  constructor
  · rintro ⟨i, a, b, h⟩
    exact ⟨rfl, h⟩
  · obtain ⟨i, a⟩ := a
    obtain ⟨j, b⟩ := b
    rintro ⟨rfl : i = j, h⟩
    exact lt.fiber _ _ _ h
#align sigma.lt_def Sigma.lt_def

protected instance preorder [∀ i, Preorder (α i)] : Preorder (Σi, α i) :=
  { Sigma.LE, Sigma.LT with
    le_refl := fun ⟨i, a⟩ => Sigma.le.fiber i a a le_rfl,
    le_trans := by
      rintro _ _ _ ⟨i, a, b, hab⟩ ⟨_, _, c, hbc⟩
      exact le.fiber i a c (hab.trans hbc),
    lt_iff_le_not_le := fun _ _ => by
      constructor
      · rintro ⟨i, a, b, hab⟩
        rwa [mk_le_mk_iff, mk_le_mk_iff, ← lt_iff_le_not_le]
      · rintro ⟨⟨i, a, b, hab⟩, h⟩
        rw [mk_le_mk_iff] at h
        exact mk_lt_mk_iff.2 (hab.lt_of_not_le h) }

instance [∀ i, PartialOrder (α i)] : PartialOrder (Σi, α i) :=
  { Sigma.preorder with
    le_antisymm := by
      rintro _ _ ⟨i, a, b, hab⟩ ⟨_, _, _, hba⟩
      exact ext rfl (heq_of_eq <| hab.antisymm hba) }

instance [∀ i, Preorder (α i)] [∀ i, DenselyOrdered (α i)] : DenselyOrdered (Σi, α i) where
  dense := by
    rintro ⟨i, a⟩ ⟨_, _⟩ ⟨_, _, b, h⟩
    obtain ⟨c, ha, hb⟩ := exists_between h
    exact ⟨⟨i, c⟩, lt.fiber i a c ha, lt.fiber i c b hb⟩

/-! ### Lexicographical order on `Sigma` -/

namespace Lex
-- mathport name: «exprΣₗ , »
/-- The notation `Σₗ i, α i` refers to a sigma type equipped with the lexicographic order. -/
notation3 "Σₗ "(...)", "r:(scoped p => _root_.Lex (Sigma p)) => r

/-- The lexicographical `≤` on a sigma type. -/
protected instance LE [LT ι] [∀ i, LE (α i)] : LE (Σₗ i, α i) where
  le := Lex (· < ·) fun _ => (· ≤ ·)
#align sigma.lex.has_le Sigma.Lex.LE

/-- The lexicographical `<` on a sigma type. -/
protected instance LT [LT ι] [∀ i, LT (α i)] : LT (Σₗ i, α i) where
  lt := Lex (· < ·) fun _ => (· < ·)
#align sigma.lex.has_lt Sigma.Lex.LT

theorem le_def [LT ι] [∀ i, LE (α i)] {a b : Σₗ i, α i} :
    a ≤ b ↔ a.1 < b.1 ∨ ∃ h : a.1 = b.1, h.rec a.2 ≤ b.2 :=
  Sigma.lex_iff
#align sigma.lex.le_def Sigma.Lex.le_def

theorem lt_def [LT ι] [∀ i, LT (α i)] {a b : Σₗ i, α i} :
    a < b ↔ a.1 < b.1 ∨ ∃ h : a.1 = b.1, h.rec a.2 < b.2 :=
  Sigma.lex_iff
#align sigma.lex.lt_def Sigma.Lex.lt_def

/-- The lexicographical preorder on a sigma type. -/
instance preorder [Preorder ι] [∀ i, Preorder (α i)] : Preorder (Σₗ i, α i) :=
  { Sigma.Lex.LE, Sigma.Lex.LT with
    le_refl := fun ⟨i, a⟩ => Lex.right a a le_rfl,
    le_trans := fun _ _ _ => trans_of ((Lex (· < ·)) fun _ => (· ≤ ·)),
    lt_iff_le_not_le := by
      refine' fun a b => ⟨fun hab => ⟨hab.mono_right fun i a b => le_of_lt, _⟩, _⟩
      · rintro (⟨b, a, hji⟩ | ⟨b, a, hba⟩) <;> obtain ⟨_, _, hij⟩ | ⟨_, _, hab⟩ := hab
        · exact hij.not_lt hji
        · exact lt_irrefl _ hji
        · exact lt_irrefl _ hij
        · exact hab.not_le hba
      · rintro ⟨⟨a, b, hij⟩ | ⟨a, b, hab⟩, hba⟩
        · exact Sigma.Lex.left _ _ hij
        · exact Sigma.Lex.right _ _ (hab.lt_of_not_le fun h => hba <| Sigma.Lex.right _ _ h) }
#align sigma.lex.preorder Sigma.Lex.preorder

/-- The lexicographical partial order on a sigma type. -/
instance partialOrder [Preorder ι] [∀ i, PartialOrder (α i)] :
    PartialOrder (Σₗ i, α i) :=
  { Lex.preorder with
    le_antisymm := fun _ _ => antisymm_of ((Lex (· < ·)) fun _ => (· ≤ ·)) }
#align sigma.lex.partial_order Sigma.Lex.partialOrder

/-- The lexicographical linear order on a sigma type. -/
instance linearOrder [LinearOrder ι] [∀ i, LinearOrder (α i)] :
    LinearOrder (Σₗ i, α i) :=
  { Lex.partialOrder with
    le_total := total_of ((Lex (· < ·)) fun _ => (· ≤ ·)),
    decidable_eq := Sigma.instDecidableEqSigma,
    decidable_le := Lex.decidable _ _ }
#align sigma.lex.linear_order Sigma.Lex.linearOrder

/-- The lexicographical linear order on a sigma type. -/
instance orderBot [PartialOrder ι] [OrderBot ι] [∀ i, Preorder (α i)] [OrderBot (α ⊥)] :
    OrderBot (Σₗ i, α i) where
  bot := ⟨⊥, ⊥⟩
  bot_le := fun ⟨a, b⟩ => by
    obtain rfl | ha := eq_bot_or_bot_lt a
    · exact Lex.right _ _ bot_le
    · exact Lex.left _ _ ha

#align sigma.lex.order_bot Sigma.Lex.orderBot

/-- The lexicographical linear order on a sigma type. -/
instance orderTop [PartialOrder ι] [OrderTop ι] [∀ i, Preorder (α i)] [OrderTop (α ⊤)] :
    OrderTop (Σₗ i, α i) where
  top := ⟨⊤, ⊤⟩
  le_top := fun ⟨a, b⟩ => by
    obtain rfl | ha := eq_top_or_lt_top a
    · exact Lex.right _ _ le_top
    · exact Lex.left _ _ ha

#align sigma.lex.order_top Sigma.Lex.orderTop

/-- The lexicographical linear order on a sigma type. -/
instance boundedOrder [PartialOrder ι] [BoundedOrder ι] [∀ i, Preorder (α i)] [OrderBot (α ⊥)]
    [OrderTop (α ⊤)] : BoundedOrder (Σₗ i, α i) :=
  { Lex.orderBot, Lex.orderTop with }
#align sigma.lex.bounded_order Sigma.Lex.boundedOrder

instance denselyOrdered [Preorder ι] [DenselyOrdered ι] [∀ i, Nonempty (α i)] [∀ i, Preorder (α i)]
    [∀ i, DenselyOrdered (α i)] : DenselyOrdered (Σₗ i, α i) where
  dense := by
    rintro ⟨i, a⟩ ⟨j, b⟩ (⟨_, _, h⟩ | ⟨_, b, h⟩)
    · obtain ⟨k, hi, hj⟩ := exists_between h
      obtain ⟨c⟩ : Nonempty (α k) := inferInstance
      exact ⟨⟨k, c⟩, left _ _ hi, left _ _ hj⟩
    · obtain ⟨c, ha, hb⟩ := exists_between h
      exact ⟨⟨i, c⟩, right _ _ ha, right _ _ hb⟩
#align sigma.lex.densely_ordered Sigma.Lex.denselyOrdered

instance denselyOrdered_of_noMaxOrder [Preorder ι] [∀ i, Preorder (α i)]
    [∀ i, DenselyOrdered (α i)] [∀ i, NoMaxOrder (α i)] :
    DenselyOrdered (Σₗ i, α i) where
  dense := by
    rintro ⟨i, a⟩ ⟨j, b⟩ (⟨_, _, h⟩ | ⟨_, b, h⟩)
    · obtain ⟨c, ha⟩ := exists_gt a
      exact ⟨⟨i, c⟩, right _ _ ha, left _ _ h⟩
    · obtain ⟨c, ha, hb⟩ := exists_between h
      exact ⟨⟨i, c⟩, right _ _ ha, right _ _ hb⟩
#align sigma.lex.densely_ordered_of_no_max_order Sigma.Lex.denselyOrdered_of_noMaxOrder

instance denselyOrdered_of_noMinOrder [Preorder ι] [∀ i, Preorder (α i)]
    [∀ i, DenselyOrdered (α i)] [∀ i, NoMinOrder (α i)] :
    DenselyOrdered (Σₗ i, α i) where
  dense := by
    rintro ⟨i, a⟩ ⟨j, b⟩ (⟨_, _, h⟩ | ⟨_, b, h⟩)
    · obtain ⟨c, hb⟩ := exists_lt b
      exact ⟨⟨j, c⟩, left _ _ h, right _ _ hb⟩
    · obtain ⟨c, ha, hb⟩ := exists_between h
      exact ⟨⟨i, c⟩, right _ _ ha, right _ _ hb⟩
#align sigma.lex.densely_ordered_of_no_min_order Sigma.Lex.denselyOrdered_of_noMinOrder

instance noMaxOrder_of_nonempty [Preorder ι] [∀ i, Preorder (α i)] [NoMaxOrder ι]
    [∀ i, Nonempty (α i)] : NoMaxOrder (Σₗ i, α i) where
  exists_gt := by
    rintro ⟨i, a⟩
    obtain ⟨j, h⟩ := exists_gt i
    obtain ⟨b⟩ : Nonempty (α j) := inferInstance
    exact ⟨⟨j, b⟩, left _ _ h⟩
#align sigma.lex.no_max_order_of_nonempty Sigma.Lex.noMaxOrder_of_nonempty

-- porting note: this statement was incorrect in mathlib3, hence the `#noalign`.
instance noMinOrder_of_nonempty [Preorder ι] [∀ i, Preorder (α i)] [NoMinOrder ι]
    [∀ i, Nonempty (α i)] : NoMinOrder (Σₗ i, α i) where
  exists_lt := by
    rintro ⟨i, a⟩
    obtain ⟨j, h⟩ := exists_lt i
    obtain ⟨b⟩ : Nonempty (α j) := inferInstance
    exact ⟨⟨j, b⟩, left _ _ h⟩
#noalign sigma.lex.no_min_order_of_nonempty

instance noMaxOrder [Preorder ι] [∀ i, Preorder (α i)] [∀ i, NoMaxOrder (α i)] :
    NoMaxOrder (Σₗ i, α i) where
  exists_gt := by
    rintro ⟨i, a⟩
    obtain ⟨b, h⟩ := exists_gt a
    exact ⟨⟨i, b⟩, right _ _ h⟩
#align sigma.lex.no_max_order Sigma.Lex.noMaxOrder

instance noMinOrder [Preorder ι] [∀ i, Preorder (α i)] [∀ i, NoMinOrder (α i)] :
    NoMinOrder (Σₗ i, α i) where
  exists_lt := by
    rintro ⟨i, a⟩
    obtain ⟨b, h⟩ := exists_lt a
    exact ⟨⟨i, b⟩, right _ _ h⟩
#align sigma.lex.no_min_order Sigma.Lex.noMinOrder

end Lex

end Sigma


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

/-!
# Unbundled semiring and ring homomorphisms (deprecated)

This file defines structures for unbundled semiring and ring homomorphisms. Though bundled
morphisms are now preferred, the unbundled structures are still occasionally used in mathlib,
and probably will not go away before Lean 4 because Lean 3 often fails to coerce a bundled
homomorphism to a function.

## Main Definitions

`is_semiring_hom` (deprecated), `is_ring_hom` (deprecated)

## Tags

is_semiring_hom, is_ring_hom

-/

universes u v w

variable {α : Type u}

/-- Predicate for semiring homomorphisms (deprecated -- use the bundled `ring_hom` version). -/
structure is_semiring_hom {α : Type u} {β : Type v} [semiring α] [semiring β] (f : α → β) : Prop :=
(map_zero [] : f 0 = 0)
(map_one [] : f 1 = 1)
(map_add [] : ∀ {x y}, f (x + y) = f x + f y)
(map_mul [] : ∀ {x y}, f (x * y) = f x * f y)

namespace is_semiring_hom

variables {β : Type v} [semiring α] [semiring β]
variables {f : α → β} (hf : is_semiring_hom f) {x y : α}

/-- The identity map is a semiring homomorphism. -/
lemma id : is_semiring_hom (@id α) := by refine {..}; intros; refl

/-- The composition of two semiring homomorphisms is a semiring homomorphism. -/
lemma comp (hf : is_semiring_hom f) {γ} [semiring γ] {g : β → γ} (hg : is_semiring_hom g) :
  is_semiring_hom (g ∘ f) :=
{ map_zero := by simpa [map_zero hf] using map_zero hg,
  map_one := by simpa [map_one hf] using map_one hg,
  map_add := λ x y, by simp [map_add hf, map_add hg],
  map_mul := λ x y, by simp [map_mul hf, map_mul hg] }

/-- A semiring homomorphism is an additive monoid homomorphism. -/
lemma to_is_add_monoid_hom (hf : is_semiring_hom f) : is_add_monoid_hom f :=
{ ..‹is_semiring_hom f› }

/-- A semiring homomorphism is a monoid homomorphism. -/
lemma to_is_monoid_hom (hf : is_semiring_hom f) : is_monoid_hom f :=
{ ..‹is_semiring_hom f› }

end is_semiring_hom

/-- Predicate for ring homomorphisms (deprecated -- use the bundled `ring_hom` version). -/
structure is_ring_hom {α : Type u} {β : Type v} [ring α] [ring β] (f : α → β) : Prop :=
(map_one [] : f 1 = 1)
(map_mul [] : ∀ {x y}, f (x * y) = f x * f y)
(map_add [] : ∀ {x y}, f (x + y) = f x + f y)

namespace is_ring_hom

variables {β : Type v} [ring α] [ring β]

/-- A map of rings that is a semiring homomorphism is also a ring homomorphism. -/
lemma of_semiring {f : α → β} (H : is_semiring_hom f) : is_ring_hom f := {..H}

variables {f : α → β} (hf : is_ring_hom f) {x y : α}

/-- Ring homomorphisms map zero to zero. -/
lemma map_zero (hf : is_ring_hom f) : f 0 = 0 :=
calc f 0 = f (0 + 0) - f 0 : by rw [hf.map_add]; simp
     ... = 0 : by simp

/-- Ring homomorphisms preserve additive inverses. -/
lemma map_neg (hf : is_ring_hom f) : f (-x) = -f x :=
calc f (-x) = f (-x + x) - f x : by rw [hf.map_add]; simp
        ... = -f x : by simp [hf.map_zero]

/-- Ring homomorphisms preserve subtraction. -/
lemma map_sub (hf : is_ring_hom f) : f (x - y) = f x - f y :=
by simp [sub_eq_add_neg, hf.map_add, hf.map_neg]

/-- The identity map is a ring homomorphism. -/
lemma id : is_ring_hom (@id α) := by refine {..}; intros; refl

/-- The composition of two ring homomorphisms is a ring homomorphism. -/
-- see Note [no instance on morphisms]
lemma comp (hf : is_ring_hom f) {γ} [ring γ] {g : β → γ} (hg : is_ring_hom g) :
  is_ring_hom (g ∘ f) :=
{ map_add := λ x y, by simp [map_add hf]; rw map_add hg; refl,
  map_mul := λ x y, by simp [map_mul hf]; rw map_mul hg; refl,
  map_one := by simp [map_one hf]; exact map_one hg }

/-- A ring homomorphism is also a semiring homomorphism. -/
lemma to_is_semiring_hom (hf : is_ring_hom f) : is_semiring_hom f :=
{ map_zero := map_zero hf, ..‹is_ring_hom f› }

lemma to_is_add_group_hom (hf : is_ring_hom f) : is_add_group_hom f := { map_add := hf.map_add }

end is_ring_hom

variables {β : Type v} {γ : Type w} [rα : semiring α] [rβ : semiring β]

namespace ring_hom

section
include rα rβ

/-- Interpret `f : α → β` with `is_semiring_hom f` as a ring homomorphism. -/
def of {f : α → β} (hf : is_semiring_hom f) : α →+* β :=
{ to_fun := f,
  .. monoid_hom.of hf.to_is_monoid_hom,
  .. add_monoid_hom.of hf.to_is_add_monoid_hom }

@[simp] lemma coe_of {f : α → β} (hf : is_semiring_hom f) : ⇑(of hf) = f := rfl

lemma to_is_semiring_hom (f : α →+* β) : is_semiring_hom f :=
{ map_zero := f.map_zero,
  map_one := f.map_one,
  map_add := f.map_add,
  map_mul := f.map_mul }

end

lemma to_is_ring_hom {α γ} [ring α] [ring γ] (g : α →+* γ) : is_ring_hom g :=
is_ring_hom.of_semiring g.to_is_semiring_hom

end ring_hom


import pq_induction_principles
import minimal_sub_pq_gen_group
import sub_pq_normal
import pq_like

universe u

section pq_like_equalizer

-- Idea: Eq(eta, L(eta)) is normal. Useful for proving injectivity?

variables {Q : Type u} [power_quandle Q]

def eta_equalizer (Q : Type u) [power_quandle Q] : sub_power_quandle (pq_group Q) := {
  carrier := λ x, of x = (L_of_morph of of_is_pq_morphism) x,
  closed_rhd := begin
    intros x y hx hy,
    rw set.mem_def at *,
    rw ←rhd_of_eq_of_rhd,
    rw rhd_def_group x y,
    simp only [monoid_hom.map_mul, monoid_hom.map_mul_inv],
    rw ←rhd_def_group,
    apply congr_arg2,
    assumption,
    assumption,
  end,
  closed_pow := begin
    intros x n hx,
    rw set.mem_def at *,
    rw of_pow_eq_pow_of,
    rw monoid_hom.map_gpow,
    rw hx,
  end,
  closed_one := begin
    rw set.mem_def,
    rw of_one,
    simp only [monoid_hom.map_one],
  end }

lemma eta_equalizer_mem_def (x : pq_group Q) (hx : x ∈ (eta_equalizer Q : set (pq_group Q))) : of x = ((L_of_morph of of_is_pq_morphism) : pq_group Q →* pq_group (pq_group Q)) x :=
begin
  exact hx,
end

lemma eta_equalizer_mem_iff (x : pq_group Q) : (x ∈ (eta_equalizer Q : set (pq_group Q))) ↔ of x = ((L_of_morph of of_is_pq_morphism) : pq_group Q →* pq_group (pq_group Q)) x :=
begin
  split,
  exact id,
  exact id,
end

lemma eta_equalizer_normal : sub_pq_normal (eta_equalizer Q) :=
begin
  intros x y,
  cases y with y hy,
  simp only [subtype.coe_mk],
  show of (x ▷ y) = (L_of_morph of of_is_pq_morphism) (x ▷ y),
  have hy1 : of (y) = (L_of_morph of of_is_pq_morphism) (y) := hy,
  rw ←rhd_of_eq_of_rhd,
  conv {
    to_rhs,
    rw rhd_def_group,
  },
  simp only [monoid_hom.map_mul, monoid_hom.map_mul_inv],
  rw ←rhd_def_group,
  rw ←hy1,
  conv {
    to_rhs,
    rw inner_aut_eq,
  },
  rw counit_L_of,
end

def eta_equalizer_iso_forward : pq_group (eta_equalizer Q) →* pq_group Q :=
begin
  fapply pq_morph_to_L_morph_adj,
  {
    intro x,
    cases x with x hx,
    exact x,
  },
  {
    split,
    {
      intros a b,
      cases a with a ha,
      cases b with b hb,
      simp only,
      have subtype_rhd : (⟨a, ha⟩ ▷ ⟨b, hb⟩ : eta_equalizer Q) = ⟨a ▷ b, _⟩ := rfl,
      rw subtype_rhd,
    },
    {
      intros a n,
      cases a with a ha,
      simp only,
      have subtype_pow : (⟨a, ha⟩ ^ n : eta_equalizer Q) = ⟨a ^ n, _⟩ := rfl,
      rw subtype_pow,
    },
  },
end

lemma eta_equalizer_iso_forward_of (x : eta_equalizer Q) : eta_equalizer_iso_forward (of x) = (x.1) :=
begin
  unfold eta_equalizer_iso_forward,
  rw pq_morph_to_L_morph_adj_comm_of,
  cases x,
  refl,
end

def eta_equalizer_iso_backward : pq_group Q →* pq_group (eta_equalizer Q) :=
begin
  fapply pq_morph_to_L_morph_adj,
  {
    intro q,
    apply of,
    fconstructor,
    exact (of q),
    fconstructor,
  },
  {
    split,
    {
      intros a b,
      rw rhd_of_eq_of_rhd,
      apply congr_arg,
      simp_rw ←rhd_of_eq_of_rhd,
      refl,
    },
    {
      intros a n,
      rw ←of_pow_eq_pow_of,
      apply congr_arg,
      simp_rw of_pow_eq_pow_of,
      refl,
    },
  },
end

lemma eta_equalizer_iso_backward_of (x : Q) : eta_equalizer_iso_backward (of x) = of (⟨of x, by fconstructor⟩ : eta_equalizer Q) :=
begin
  refl,
end

def pq_group_eta_equalizer_inclusion : pq_group (eta_equalizer Q) →* pq_group (pq_group Q) :=
begin
  fapply L_of_morph,
  {
    intro x,
    cases x with x hx,
    exact x,
  },
  {
    split,
    {
      intros a b,
      cases a with a ha,
      cases b with b hb,
      refl,
    },
    {
      intros a n,
      cases a with a ha,
      refl,
    },
  },
end

lemma eta_equalizer_in_sub_pq (x : pq_group Q) (hx : x ∈ (eta_equalizer Q : set (pq_group Q)))
: pq_group_eta_equalizer_inclusion (of ⟨x, hx⟩ : pq_group (eta_equalizer Q)) = (L_of_morph of of_is_pq_morphism) (x) :=
begin
  rw spq_coe_is_carrier at hx,
  unfold eta_equalizer at hx,
  simp only at hx,
  rw set.mem_def at hx,
  rw ←hx,
  refl,
end

lemma inclusion_eq_L_of_of_forward (x : pq_group (eta_equalizer Q)) : pq_group_eta_equalizer_inclusion x = (L_of_morph of of_is_pq_morphism) (eta_equalizer_iso_forward x) :=
begin
  revert x,
  refine pq_group_word_induction _ _,
  {
    simp only [monoid_hom.map_one],
  },
  {
    intros x y hx,
    simp only [monoid_hom.map_mul, hx],
    congr,
    cases y with y hy,
    rw eta_equalizer_in_sub_pq,
    congr,
  },
end

lemma inclusion_counit_L_of_morph_of (x : pq_group (eta_equalizer Q)) : pq_group_eta_equalizer_inclusion x = (L_of_morph of of_is_pq_morphism) (counit (pq_group_eta_equalizer_inclusion x)) :=
begin
  rw inclusion_eq_L_of_of_forward,
  rw counit_L_of,
end

lemma eta_equalizer_iso_forward_of_backward (x : pq_group Q) : eta_equalizer_iso_forward (eta_equalizer_iso_backward x) = x :=
begin
  revert x,
  refine pq_group_word_induction _ _,
  {
    simp only [monoid_hom.map_one],
  },
  {
    intros x y hx,
    simp only [monoid_hom.map_mul, hx],
    refl,
  },
end

end pq_like_equalizer


import Lean
import Std
import Mathlib.Tactic.LeftRight

theorem problem_3 : ((p ∨ q) ∧ (p → r) ∧ (q → s)) → (r ∨ s) := by
  intro ⟨pq, f, g⟩
  cases pq
  . left
    apply f
    assumption
  . right
    apply g
    assumption


import pseudo_normed_group.FP
import system_of_complexes.basic
import prop819
import pseudo_normed_group.sum_hom
import pseudo_normed_group.splittable

noncomputable theory

open_locale nnreal big_operators
open category_theory opposite simplex_category

local attribute [instance] type_pow

universe variables u v u₀ uₘ
-- set_option pp.universes true

namespace system_of_complexes

variables (C : system_of_complexes)

def norm_exact_complex (D : cochain_complex SemiNormedGroup ℕ) : Prop :=
∀ (m : ℕ) (ε : ℝ≥0) (hε : 0 < ε) (x : D.X m) (hx : D.d _ (m+1) x = 0),
  ∃ y : D.X (m-1), D.d _ _ y = x ∧ ∥y∥₊ ≤ (1 + ε) * ∥x∥₊

lemma weak_exact_of_factor_exact (k : ℝ≥0) [fact (1 ≤ k)] (m : ℕ) (c₀ : ℝ≥0)
  (D : ℝ≥0 → cochain_complex SemiNormedGroup ℕ)
  (hD : ∀ c, c₀ ≤ c → norm_exact_complex (D c))
  (f : Π c, C.obj (op $ k * c) ⟶ D c)
  (g : Π c, D c ⟶ C.obj (op c))
  (hf : ∀ c i, ((f c).f i).norm_noninc)
  (hg : ∀ c i, ((g c).f i).norm_noninc)
  (hfg : ∀ c, c₀ ≤ c → f c ≫ g c = C.map (hom_of_le (fact.out _ : c ≤ k * c)).op) :
  C.is_weak_bounded_exact k 1 m c₀ :=
begin
  intros c hc i hi x ε' hε',
  let dx := C.d _ (i+1) x,
  let fx := (f _).f _ x,
  let fdx := (f c).f _ dx,
  let dfx := (D _).d _ (i+1) fx,
  have fdx_dfx : fdx = dfx,
  { simp only [fdx, dfx, fx, ← comp_apply], congr' 1, exact ((f _).comm _ _).symm },
  have hfdx : (D _).d _ (i+2) fdx = 0,
  { calc (D _).d _ (i+2) fdx = (D _).d _ (i+2) ((D _).d _ (i+1) (fx)) : congr_arg _ fdx_dfx
    ... = ((D _).d _ (i+1) ≫ (D _).d _ (i+2)) (fx) : rfl
    ... = 0 : by { rw (D c).d_comp_d _ _ _, refl } },
  let ε : ℝ≥0 := ⟨ε', hε'.le⟩,
  have hε : 0 < ε := hε',
  let δ : ℝ≥0 := ε / (∥dx∥₊ + 1),
  have hδ : 0 < δ,
  { rw [← nnreal.coe_lt_coe],
    exact div_pos hε (lt_of_le_of_lt (nnreal.coe_nonneg _) (lt_add_one _)), },
  obtain ⟨(x' : (D c).X i), (hdx' : (D c).d i (i+1) x' = fdx), hnorm_x'⟩ :=
    (hD _ hc.1) _ δ hδ _ hfdx,
  let gx' := (g _).f _ x',
  have hdfxx' : (D _).d _ (i+1) (fx - x') = 0,
  { rw [normed_group_hom.map_sub, hdx', fdx_dfx], exact sub_self _ },
  obtain ⟨y, hdy, -⟩ := (hD _ hc.1) _ δ hδ _ hdfxx',
  let gy := (g _).f _ y,
  let dgy := C.d _ i gy,
  let gdy := (g _).f _ ((D _).d _ i y),
  have gdy_dgy : gdy = dgy,
  { simp only [gdy, dgy, gy, ← comp_apply], congr' 1, exact ((g _).comm _ _).symm },
  refine ⟨i-1, i+1, rfl, rfl, gy, _⟩,
  simp only [nnreal.coe_one, one_mul],
  have hxdgy : res x - C.d _ _ gy = gx',
  { calc res x - dgy
        = (g _).f _ ((f _).f _ x) - gdy : _
    ... = gx' : by rw [← normed_group_hom.map_sub, hdy, sub_sub_cancel],
    rw [gdy_dgy, ← comp_apply, ← homological_complex.comp_f, hfg _ hc.1], refl },
  rw hxdgy,
  change (∥gx'∥₊ : ℝ) ≤ ∥dx∥₊ + ε,
  simp only [← nnreal.coe_add, nnreal.coe_le_coe],
  calc ∥gx'∥₊
      ≤ ∥x'∥₊ : hg _ _ _
  ... ≤ (1 + δ) * ∥fdx∥₊ : hnorm_x'
  ... ≤ (1 + δ) * ∥dx∥₊ : mul_le_mul' le_rfl (hf _ _ _)
  ... ≤ ∥dx∥₊ + δ * ∥dx∥₊ : by rw [add_mul, one_mul]
  ... ≤ ∥dx∥₊ + ε * 1 : add_le_add le_rfl _
  ... ≤ ∥dx∥₊ + ε : by rw [mul_one],
  dsimp only [δ],
  rw [div_eq_mul_inv, mul_assoc],
  refine mul_le_mul' le_rfl _,
  rw [nnreal.mul_le_iff_le_inv, inv_inv, mul_one],
  { exact (lt_add_one _).le },
  { refine inv_ne_zero (lt_of_le_of_lt _ (lt_add_one _)).ne',
    exact zero_le' }
end

end system_of_complexes

namespace thm95

variables (r' : ℝ) (V : SemiNormedGroup.{v}) (M : Type u) {M₁ M₂ : Type u} (N : ℕ) (d : ℝ≥0)
variables [profinitely_filtered_pseudo_normed_group M] [pseudo_normed_group.splittable M N d]
variables [profinitely_filtered_pseudo_normed_group M₁]
variables [profinitely_filtered_pseudo_normed_group M₂]
variables (f : comphaus_filtered_pseudo_normed_group_hom M₁ M₂) (hf : f.strict)

section open Profinite pseudo_normed_group profinitely_filtered_pseudo_normed_group

@[simps left right]
def FLC_complex_arrow (c : ℝ≥0) : arrow Profinite :=
@arrow.mk _ _ (filtration_obj M₁ c) (filtration_obj M₂ c) $
{ to_fun := pseudo_normed_group.level f hf c,
  continuous_to_fun := f.continuous _ (λ _, rfl) }

end

section open profinitely_filtered_pseudo_normed_group
  comphaus_filtered_pseudo_normed_group

@[simps obj map]
def FLC_complex : system_of_complexes :=
{ obj := λ c, (FLC_functor V).obj (op $ FLC_complex_arrow f hf c.unop),
  map := λ c₁ c₂ h, (FLC_functor V).map $ quiver.hom.op $
    @arrow.hom_mk _ _ (FLC_complex_arrow f hf c₂.unop) (FLC_complex_arrow f hf c₁.unop)
      (⟨_, (@embedding_cast_le _ _ _ _ ⟨le_of_hom h.unop⟩).continuous⟩)
      (⟨_, (@embedding_cast_le _ _ _ _ ⟨le_of_hom h.unop⟩).continuous⟩)
      (by { ext, refl }),
  map_id' := λ c,
  begin
    convert (FLC_functor V).map_id _,
    simp only [unop_id, ←op_id, quiver.hom.op_inj.eq_iff, nat_trans.id_app],
    ext; refl,
  end,
  map_comp' := λ c₁ c₂ c₃ h1 h2,
  begin
    convert (FLC_functor V).map_comp _ _,
    simp only [← op_comp, quiver.hom.op_inj.eq_iff, nat_trans.comp_app],
    ext; refl,
  end, }
.

end

namespace FLC_complex
open pseudo_normed_group

variables (c₁ c₂ : ℝ≥0) [fact (c₁ ≤ c₂)]

def aux_space (c₁ c₂ : ℝ≥0) [fact (c₁ ≤ c₂)] :=
{ p : filtration M₂ c₁ × filtration M₁ c₂ // cast_le p.1 = level f hf c₂ p.2 }

namespace aux_space
open profinitely_filtered_pseudo_normed_group comphaus_filtered_pseudo_normed_group

instance : topological_space (aux_space f hf c₁ c₂) :=
by { delta aux_space, apply_instance }

instance : t2_space (aux_space f hf c₁ c₂) :=
by { delta aux_space, apply_instance }

instance : totally_disconnected_space (aux_space f hf c₁ c₂) :=
subtype.totally_disconnected_space

instance : compact_space (aux_space f hf c₁ c₂) :=
{ compact_univ :=
  begin
    rw embedding_subtype_coe.is_compact_iff_is_compact_image,
    simp only [set.image_univ, subtype.range_coe_subtype],
    refine is_closed.is_compact _,
    refine is_closed_eq
      ((embedding_cast_le _ _).continuous.comp continuous_fst)
      ((f.continuous _ _).comp continuous_snd),
    intro, refl
  end }

end aux_space

def AuxSpace : Profinite := Profinite.of (aux_space f hf c₁ c₂)

namespace AuxSpace

open profinitely_filtered_pseudo_normed_group

@[simps] def ι : filtration_obj M₁ c₁ ⟶ AuxSpace f hf c₁ c₂ :=
{ to_fun := λ x, ⟨⟨level f hf c₁ x, Filtration.cast_le M₁ c₁ c₂ x⟩, rfl⟩,
  continuous_to_fun :=
  begin
    apply continuous_induced_rng,
    refine continuous.prod_mk (f.continuous _ (λ _, rfl)) (Filtration.cast_le M₁ c₁ c₂).continuous,
  end }

@[simps] def fst : AuxSpace f hf c₁ c₂ ⟶ filtration_obj M₂ c₁ :=
{ to_fun := _,
  continuous_to_fun := continuous_fst.comp continuous_subtype_coe }

@[simps] def snd : AuxSpace f hf c₁ c₂ ⟶ filtration_obj M₁ c₂ :=
{ to_fun := _,
  continuous_to_fun := continuous_snd.comp continuous_subtype_coe }

@[simps left right]
def fstₐ : arrow Profinite := arrow.mk (fst f hf c₁ c₂)

include d

lemma fst_surjective [fact (0 < N)] (h : c₁ / N + d ≤ c₂ * N⁻¹) :
  function.surjective (fst _ (sum_hom_strict M N) c₁ c₂) :=
begin
  intros y,
  dsimp at y,
  obtain ⟨x, hx1, hx2⟩ := exists_sum N d _ _ y.2,
  simp only [fst_to_fun, function.comp_app],
  refine ⟨⟨⟨y, ⟨x, _⟩⟩, _⟩, rfl⟩,
  { erw rescale.mem_filtration, refine filtration_mono h hx2 },
  { simp only [pseudo_normed_group.level, sum_hom_apply, subtype.coe_mk, ← hx1], refl },
end

end AuxSpace

open AuxSpace profinitely_filtered_pseudo_normed_group

@[simps]
def sum_hom₀ [fact (0 < N)] (c : ℝ≥0) : filtration_obj (rescale N (M^N)) c ⟶ filtration_obj M c :=
⟨pseudo_normed_group.level (sum_hom M N) (sum_hom_strict M N) c,
  (sum_hom M N).continuous _ (λ _, rfl)⟩

@[simps left right hom]
def sum_homₐ [fact (0 < N)] (c : ℝ≥0) : arrow Profinite := arrow.mk (sum_hom₀ M N c)

def sum_homₐ_fstₐ [fact (0 < N)] : sum_homₐ M N c₁ ⟶ fstₐ _ (sum_hom_strict M N) c₁ c₂ :=
{ left := AuxSpace.ι _ _ _ _,
  right := 𝟙 _, }

def fstₐ_sum_homₐ [fact (0 < N)] : fstₐ _ (sum_hom_strict M N) c₁ c₂ ⟶ sum_homₐ M N c₂ :=
{ left := snd _ _ _ _,
  right := Filtration.cast_le _ _ _,
  w' := by { ext1 ⟨x, h⟩, exact h.symm } }

include d

lemma weak_bounded_exact (k : ℝ≥0) [hk : fact (1 ≤ k)] (m : ℕ) (c₀ : ℝ≥0) [fact (0 < N)]
  (hdkc₀N : d ≤ (k - 1) * c₀ / N) :
  (FLC_complex V _ (sum_hom_strict M N)).is_weak_bounded_exact k 1 m c₀ :=
begin
  let D := λ c, (FLC_functor V).obj (op $ fstₐ _ (sum_hom_strict M N) c (k * c)),
  let f := λ c, (FLC_functor V).map (fstₐ_sum_homₐ M N c (k * c)).op,
  let g := λ c, (FLC_functor V).map (sum_homₐ_fstₐ M N c (k * c)).op,
  refine system_of_complexes.weak_exact_of_factor_exact _ k m c₀ D _ f g _ _ _,
  { intros c hc,
    suffices : function.surjective ((unop (op (fstₐ (sum_hom M N) _ c (k * c)))).hom),
    { intros i ε hε x hx, cases i,
      { simp only [nat.one_ne_zero, homological_complex.shape, complex_shape.up_rel,
          exists_and_distrib_left, not_false_iff, normed_group_hom.zero_apply],
        refine ⟨(prop819_degree_zero _ this _ x hx).symm, 0, _⟩,
        simp only [nnnorm_zero, zero_le'] },
      exact prop819 _ this _ ε hε x hx },
    refine fst_surjective M N d c (k * c) _,
    calc c / N + d
        ≤ c / N + (k - 1) * c₀ / N : add_le_add le_rfl hdkc₀N
    ... ≤ c / N + (k - 1) * c / N : add_le_add le_rfl _
    ... ≤ 1 * c / N + (k - 1) * c / N : by rw one_mul
    ... = k * c / N : _,
    { simp only [div_eq_mul_inv],
      refine mul_le_mul' (mul_le_mul' le_rfl hc) le_rfl, },
    { simp only [div_eq_mul_inv, mul_assoc],
      rw ← add_mul, congr,
      rw [← nnreal.eq_iff, nnreal.coe_add, nnreal.coe_sub hk.1, add_sub_cancel'_right], } },
  { intros c i, exact FLC_functor_map_norm_noninc _ _ _ },
  { intros c i, exact FLC_functor_map_norm_noninc _ _ _ },
  { intros c hc,
    dsimp only [f, g, FLC_complex_map],
    rw [← category_theory.functor.map_comp, ← op_comp],
    refl }
end

end FLC_complex

end thm95


def pt_in_ball (p q : point) (c : ℕ⁺) (qs : list point) : Prop :=
  q ∈ qs ∧
  q ≠ p ∧
  ∥q - p∥ ≤ c
lemma range_in_hypercube :
  ∀ (i j : ℤ) (n : ℕ),
    ((-(↑n) ≤ i) ∧ (i ≤ n) ∧
     (-(↑n) ≤ j) ∧ (j ≤ n))
    ↔
    (i, j) ∈ (get_hypercube n) := sorry
lemma norm_bd_on_coords :
  ∀ (a b : ℤ) (c : ℕ),
    ∥(a, b)∥ ≤ c →
    a*a ≤ c ∧ b*b ≤ c := sorry
lemma sq_neg_lt :
  ∀ (a b : ℤ),
    a ≤ 0 →
    b ≤ 0 →
    a < b →
    b*b < a*a := begin
  intros a b h1 h2 h3,
  sorry
end
lemma sq_nonneg_lt :
  ∀ (a b : ℤ),
    a ≥ 0 →
    b ≥ 0 →
    a < b →
    a*a < b*b := begin
  intros a b h1 h2 h3,
  exact mul_lt_mul'' h3 h3 h1 h1,
end
lemma nat_ge_zero :
  ∀ (n : ℕ), n ≥ 0 := begin
  intros n,
  linarith,
end
lemma ge_neg_le :
  ∀ (n : ℤ),
    n ≥ 0 →
    -n ≤ 0 := begin
  intros n h,
  linarith,
end
lemma coe_nat_int_ge :
  ∀ (n : ℕ),
  n ≥ 0 →
  (↑n : ℤ) ≥ 0 := begin
  intros n h,
  simp [h],
end
lemma lt_to_le :
  ∀ (a b : ℤ),
    a < b → a ≤ b := begin
  intros a b h,
  linarith,
end
lemma neg_sq_sq :
  ∀ (a : ℤ),
    (-a)*(-a) = a*a := begin
  intros a,
  ring,
end
lemma succ_sqrt_sq_gt_orig :
  ∀ (c : ℕ),
    ((nat.sqrt c) + 1) * ((nat.sqrt c) + 1) > c := begin
  intros c,
  exact nat.lt_succ_sqrt c,
end
lemma coe_preserves_lt :
  ∀ (a b : ℕ),
    a < b →
    (↑a : ℤ) < ↑b := begin
  intros a b h,
  simp [h],
end
lemma coe_preserves_ge :
  ∀ (a b : ℕ),
    a ≥ b →
    (↑a : ℤ) ≥ ↑b := begin
  intros a b h,
  linarith,
end
lemma coe_nat_nat_nop :
  ∀ (n : ℕ),
    (↑n : ℕ) = n := begin
  intros n,
  simp,
end
lemma in_ball_exists_idx :
  ∀ (p q : point) (c : ℕ⁺) (qs : list point),
    pt_in_ball p q c qs →
    (∃ (a b : ℤ),
      (∥(a, b)∥ ≤ c) ∧ (p + (a, b) = q)) := sorry
lemma q_in_ball_means_grid_idx_in_get_idxs :
  ∀ (p q : point) (c : ℕ⁺) (qs : list point),
  pt_in_ball p q c qs →
  (get_grid_idx q) ∈ (get_idxs p c) := begin
  intros p q c qs q_in_p_ball,
  have exists_idx : (∃ (a b : ℤ), (∥(a, b)∥ ≤ c) ∧ (p + (a, b) = q)) := begin
    apply in_ball_exists_idx,
    assumption,
  end,
  cases exists_idx with a exists_idx,
  cases exists_idx with b exists_idx,
  unfold pt_in_ball at q_in_p_ball,
  cases q_in_p_ball with q_in_qs q_ne_p_and_bded_norm,
  cases q_ne_p_and_bded_norm with q_ne_p q_bded_norm,
  simp [point_norm] at q_bded_norm,
  simp [get_idxs, get_grid_idx],
  fapply exists.intro,
  exact a,
  fapply exists.intro,
  exact b,
  split,
  {
    apply bounded_norm_in_hypercube,
    exact exists_idx.left,
  },
  {
    exact exists_idx.right,
  }
end
lemma x_in_some_l_x_in_join_ls :
  ∀ (x : point) (ls : list (list point)),
    (∃ (l : list point), x ∈ l ∧ l ∈ ls) →
    x ∈ ls.join := sorry
lemma x_in_grid_idxs_x_in_find_res :
  ∀ (p x : point) (g : grid_2D),
    (get_grid_idx x ∈ get_idxs p g.c) →
    (∃ l, (in_opt_list x l) ∧ (l ∈ (get_idxs p g.c).map g.data.find)) := sorry
lemma some_l_in_ls_l_in_lift :
  ∀ {α} (l : list α) (ls : list (option (list α))),
    some l ∈ ls →
    l ∈ list.map lift_option_list ls := begin
  sorry
end
lemma get_neighbs_gets_neighbs :
  ∀ (p : point) (g : grid_2D),
    ∀ (x : point),
      (pt_in_ball p x g.c g.ps) →
      (x ∈ get_neighbs p g) := begin
  intros p g x x_in_ball,
  simp only [get_neighbs],
  have grid_idx_x_in_idxs : (get_grid_idx x) ∈ (get_idxs p g.c) := begin
    apply q_in_ball_means_grid_idx_in_get_idxs,
    assumption,
  end,
  apply (list.mem_filter.mpr),
  split,
  {
    apply x_in_some_l_x_in_join_ls,
    have x_in_opt_list : (∃ l, (in_opt_list x l) ∧ (l ∈ (get_idxs p g.c).map g.data.find)) := begin
      apply x_in_grid_idxs_x_in_find_res,
      assumption,
    end,
    cases x_in_opt_list with l x_in_opt_list,
    cases x_in_opt_list with x_in_opt_list l_in_res,
    cases l,
    { cases x_in_opt_list, },
    fapply exists.intro,
    exact l,
    split,
    unfold in_opt_list at x_in_opt_list,
    assumption,
    apply some_l_in_ls_l_in_lift,
    assumption,
  },
  {
    unfold pt_in_ball at x_in_ball,
    exact x_in_ball.right.left,
  },
end
lemma min_dist_pair_closest :
  ∀ (p : point) (ps : list point),
    ∀ (x : point),
      (x ∈ ps) →
      (min_dist_pair p ps ≤ some (p, x)) :=
begin
  sorry
end
lemma get_min_dist_pair_correct :
  ∀ (p : point) (g : grid_2D),
    ∀ (x : point),
      (pt_in_ball p x g.c g.ps) →
      ((mdp_with p g) ≤ some (p, x)) := begin
  intros p g x x_in_ball,
  simp [mdp_with],
  apply min_dist_pair_closest,
  apply get_neighbs_gets_neighbs,
  assumption,
end
def closest_pair (p q : point) (ps : list point) : Prop :=
  (p ∈ ps) ∧
  (q ∈ ps) ∧
  (p ≠ q) ∧
  (∀ (r s : point), r ≠ s → ∥p - q∥ ≤ ∥r - s∥)
def cp_with_help (p q : point) (ps : list point) (c : ℕ⁺) : Prop :=
  (closest_pair p q ps) ∧ (1 < ∥ p - q ∥) ∧ (∥ p - q ∥ ≤ c)
inductive closest_pair_in_ball_union (c : ℕ⁺) (qs : list point) : option (point × point) → list point → Prop
| no_ball : closest_pair_in_ball_union none []
| cons_ball_no_update (xy : option (point × point)) (p : point) (ps' : list point) :
    closest_pair_in_ball_union xy ps' →
    (∀ (q : point),
      pt_in_ball p q c qs →
      (xy ≤ some (p, q))) →
    closest_pair_in_ball_union xy (p :: ps')
| cons_ball_update
    (xy : option (point × point))
    (p : point)
    (ps' : list point)
    (q : point) :
    (
      pt_in_ball p q c qs ∧
      (∀ (x : point), (pt_in_ball p x c qs) → ∥q - p∥ ≤ ∥x - p∥) ∧
      some (p, q) < xy
    ) →
    closest_pair_in_ball_union xy ps' →
    closest_pair_in_ball_union (some (p, q)) (p :: ps')
lemma point_lt_iff_point_lt'_eq_true :
  ∀ (xy zw : option (point × point)),
    xy < zw ↔ (point_lt' xy zw = true) := begin
  intros xy zw,
  constructor,
  sorry,
  sorry,
end
lemma opt_point_le_some_implies_is_some :
  ∀ (xy : option (point × point)) (z w : point),
    xy ≤ some (z, w) ↔ (∃ (x y : point), xy = some (x, y)) := begin
  sorry,
end
lemma get_mdp_includes_center_pt :
  ∀ (p : point) (g : grid_2D),
    (∃ (q : point), (mdp_with p g) = some (p, q)) ∨
    (mdp_with p g) = none := begin
  sorry
end
lemma closer_than_pt_in_ball_is_in_ball :
  ∀ (p x y : point) (c : ℕ⁺) (qs : list point),
    pt_in_ball p y c qs →
    some (p, x) ≤ some (p, y) →
    pt_in_ball p x c qs := begin
  sorry
end
lemma aux_monotonic_in_pt_list :
  ∀ (c : ℕ⁺) (g : grid_2D) (p : point) (ps' : list point),
    (aux g (p :: ps')) ≤ (aux g ps')
     := begin
  intros c qs ps' p,
  sorry,
end
lemma cp_in_ball_union_downward_closed :
  ∀ (c : ℕ⁺) (xy zw : option (point × point)) (qs ps : list point),
    closest_pair_in_ball_union c qs zw ps →
    xy ≤ zw →
    closest_pair_in_ball_union c qs xy ps
     := begin
  sorry,
end
lemma pt_in_ball_subset_to_pt_in_ball :
  ∀ (ps' ps : list point) (p q : point) (c : ℕ⁺),
    pt_in_ball p q c ps' →
    ps' ⊆ ps →
    pt_in_ball p q c ps := sorry
lemma some_cp_in_balls_in_pt_list_and_neq :
  ∀ (c : ℕ⁺) (x y : point) (xy : option (point × point)) (ps : list point),
    xy = some (x, y) →
    closest_pair_in_ball_union c ps xy ps →
    x ∈ ps ∧ y ∈ ps ∧ x ≠ y := sorry
lemma grid_pts_dot_c_with_c_eq_c :
  ∀ (c : ℕ⁺) (ps : list point),
    (grid_points c ps).c = c := sorry
lemma grid_pts_dot_ps_with_ps_eq_ps :
  ∀ (c : ℕ⁺) (ps : list point),
    (grid_points c ps).ps = ps := sorry
def in_opt_list {α : Type} (x : α) : option (list α) → Prop
| none := false
| (some xs') := x ∈ xs'
def point_le (xy zw : option (point × point)) : Prop :=
  match (xy, zw) with
  | (none, none) := true
  | (none, some _) := false
  | (some _, none) := true
  | (some (x, y), some (z, w)) := ∥ x - y ∥ ≤ ∥ z - w ∥
  end
instance : has_le (option (point × point)) := ⟨point_le⟩
def point_lt (xy zw : option (point × point)) : Prop :=
  match (xy, zw) with
  | (none, none) := false
  | (none, some _) := false
  | (some _, none) := true
  | (some (x, y), some (z, w)) := ∥ x - y ∥ < ∥ z - w ∥
  end
instance : has_lt (option (point × point)) := ⟨point_lt⟩
lemma point_lt_iff_point_lt' :
  ∀ (xy zw : option (point × point)),
    point_lt xy zw ↔ ↥(point_lt' xy zw) := sorry
lemma point_norm_symm :
  ∀ (x y : point),
    ∥x - y∥ = ∥y - x∥ := begin
  sorry
end
lemma le_iff_neg_lt :
  ∀ (xy zw : option (point × point)),
    xy ≤ zw ↔ ¬(xy > zw) := sorry
lemma neg_le_iff_lt :
  ∀ (xy zw : option (point × point)),
    ¬(xy ≤ zw) ↔ zw < xy := sorry
lemma option_pt_lt_trans :
  ∀ (pq xy zw : option (point × point)),
    pq < xy →
    xy < zw →
    pq < zw := begin
  intros pq xy zw h1 h2,
  sorry,
end
lemma option_pt_le_trans :
  ∀ (pq xy zw : option (point × point)),
    pq ≤ xy →
    xy ≤ zw →
    pq ≤ zw := sorry
lemma option_pt_le_symm :
  ∀ (pq : option (point × point)) (x y : point),
    pq ≤ some (x, y) →
    pq ≤ some (y, x) := sorry
lemma option_pt_le_lt_trans :
  ∀ (pq xy zw : option (point × point)),
    pq ≤ xy →
    xy < zw →
    pq < zw := sorry
lemma option_pt_lt_le_trans :
  ∀ (pq xy zw : option (point × point)),
    pq < xy →
    xy ≤ zw →
    pq < zw := sorry
lemma option_pt_lt_to_le :
  ∀ (xy zw : option (point × point)),
    xy < zw →
    xy ≤ zw := sorry
lemma not_x_le_y_and_gt_y :
  ∀ (x y : option (point × point)),
    x ≤ y →
    y < x →
    false
    := begin
  sorry
end
lemma int_le_trans :
  ∀ (x y z : ℤ),
    x ≤ y →
    y ≤ z →
    x ≤ z := begin
  intros x y z h1 h2,
  linarith,
end
lemma point_lt'_iff_point_lt :
  ∀ (xy zw : option (point × point)),
    ↥(point_lt' xy zw) ↔ xy < zw := sorry
lemma option_pt_le_some_eq_some :
  ∀ (xy : option (point × point)) (z w : point),
    xy ≤ some (z, w) → ∃ (x y : point), xy = some (x, y) := sorry
lemma int_nonneg_add :
  ∀ (x y : ℤ), int.nonneg x → int.nonneg y → int.nonneg (x + y) := begin
  intros x y h1 h2,
  sorry
end
lemma int_x_times_x_nonneg :
  ∀ (x : ℤ), int.nonneg (x * x) := begin
    intros x,
    sorry
end
lemma nonneg_iff_leq_zero :
  ∀ (x : ℤ), int.nonneg x ↔ 0 ≤ x := begin
    sorry
  end
lemma a_nonneg_times_b_nonneq_means_a_times_b_nonneg :
  ∀ (a b : ℤ), int.nonneg a → int.nonneg b → int.nonneg (a * b) := begin
    sorry
end
lemma lift_nat_nonneg :
  ∀ (n : ℕ), int.nonneg ↑n := begin
    sorry
end
lemma x_div_plus_y_div_eq_x_plus_y_div_minus_sum_mod_div :
  ∀ (x y z : ℤ), x/z + y/z = (x + y)/z - (x % z + y % z) := begin
    sorry
  end
lemma x_div_y_times_y :
  ∀ (x y : ℤ), (x / y) * y = x - x % y := begin
    sorry
end
lemma point_norm_nonneg :
  ∀ (p : point), int.nonneg (∥ p ∥) := begin
    intros p,
    unfold point_norm,
    apply int_nonneg_add,
    apply int_x_times_x_nonneg,
    apply int_x_times_x_nonneg
end
lemma point_norm_add_comm :
  ∀ (p q : point), ∥ p + q ∥ = ∥ q + p ∥ := begin
    sorry
end
lemma point_norm_sub_comm :
  ∀ (p q : point), ∥ p - q ∥ = ∥ q - p ∥ := begin
    sorry
end
lemma not_leq_and_gt : ∀ (p : point) (n : ℤ),
  ¬((∥p∥ ≤ n) ∧ (n < ∥p∥)) := begin
    sorry
end
lemma not_x_lt_y_and_gt_y :
  ∀ (x y : ℤ),
    ¬(x < y ∧ y < x) := begin
  sorry
end
lemma not_le_and_gt :
  ∀ (x y : ℤ),
    ¬(x ≤ y ∧ y < x) := begin
  sorry
end
lemma not_lt_and_not_gt_implies_eq :
  ∀ (x y : ℤ),
    ¬(x < y) →
    ¬(y < x) →
    x = y := begin
  sorry
end
lemma coe_to_ℕ_then_ℤ_eq_coe_to_ℤ :
  ∀ (n : ℕ⁺),
    (↑(↑n : ℕ) : ℤ) = (↑n : ℤ) := begin
  intros n,
  simp,
end
instance : has_one ℕ⁺ := ⟨⟨1, by simp⟩⟩
lemma add_nonzero_nonzero :
  ∀ (m n : ℕ),
    m > 0 →
    n > 0 →
    m + n > 0 := begin
  intros m n h1 h2,
  linarith,
end
instance : has_mul ℕ⁺ := ⟨λ m n,
 ⟨m.val + n.val, by simp [add_nonzero_nonzero, m.val_nonzero, n.val_nonzero]⟩⟩


/-
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
-/
import data.finset.basic
import data.multiset.pi

/-!
# The cartesian product of finsets
-/

namespace finset
open multiset

/-! ### pi -/
section pi
variables {α : Type*}

/-- The empty dependent product function, defined on the empty set. The assumption `a ∈ ∅` is never
satisfied. -/
def pi.empty (β : α → Sort*) (a : α) (h : a ∈ (∅ : finset α)) : β a :=
multiset.pi.empty β a h

variables {δ : α → Type*} [decidable_eq α]

/-- Given a finset `s` of `α` and for all `a : α` a finset `t a` of `δ a`, then one can define the
finset `s.pi t` of all functions defined on elements of `s` taking values in `t a` for `a ∈ s`.
Note that the elements of `s.pi t` are only partially defined, on `s`. -/
def pi (s : finset α) (t : Πa, finset (δ a)) : finset (Πa∈s, δ a) :=
⟨s.1.pi (λ a, (t a).1), nodup_pi s.2 (λ a _, (t a).2)⟩

@[simp] lemma pi_val (s : finset α) (t : Πa, finset (δ a)) :
  (s.pi t).1 = s.1.pi (λ a, (t a).1) := rfl

@[simp] lemma mem_pi {s : finset α} {t : Πa, finset (δ a)} {f : Πa∈s, δ a} :
  f ∈ s.pi t ↔ (∀a (h : a ∈ s), f a h ∈ t a) :=
mem_pi _ _ _

/-- Given a function `f` defined on a finset `s`, define a new function on the finset `s ∪ {a}`,
equal to `f` on `s` and sending `a` to a given value `b`. This function is denoted
`s.pi.cons a b f`. If `a` already belongs to `s`, the new function takes the value `b` at `a`
anyway. -/
def pi.cons (s : finset α) (a : α) (b : δ a) (f : Πa, a ∈ s → δ a) (a' : α) (h : a' ∈ insert a s) :
  δ a' :=
multiset.pi.cons s.1 a b f _ (multiset.mem_cons.2 $ mem_insert.symm.2 h)

@[simp]
lemma pi.cons_same (s : finset α) (a : α) (b : δ a) (f : Πa, a ∈ s → δ a) (h : a ∈ insert a s) :
  pi.cons s a b f a h = b :=
multiset.pi.cons_same _

lemma pi.cons_ne {s : finset α} {a a' : α} {b : δ a} {f : Πa, a ∈ s → δ a} {h : a' ∈ insert a s}
  (ha : a ≠ a') :
  pi.cons s a b f a' h = f a' ((mem_insert.1 h).resolve_left ha.symm) :=
multiset.pi.cons_ne _ _

lemma pi_cons_injective  {a : α} {b : δ a} {s : finset α} (hs : a ∉ s) :
  function.injective (pi.cons s a b) :=
assume e₁ e₂ eq,
@multiset.pi_cons_injective α _ δ a b s.1 hs _ _ $
  funext $ assume e, funext $ assume h,
  have pi.cons s a b e₁ e (by simpa only [multiset.mem_cons, mem_insert] using h) =
    pi.cons s a b e₂ e (by simpa only [multiset.mem_cons, mem_insert] using h),
  { rw [eq] },
  this

@[simp] lemma pi_empty {t : Πa:α, finset (δ a)} :
  pi (∅ : finset α) t = singleton (pi.empty δ) := rfl

@[simp] lemma pi_insert [∀a, decidable_eq (δ a)]
  {s : finset α} {t : Πa:α, finset (δ a)} {a : α} (ha : a ∉ s) :
  pi (insert a s) t = (t a).bUnion (λb, (pi s t).image (pi.cons s a b)) :=
begin
  apply eq_of_veq,
  rw ← multiset.erase_dup_eq_self.2 (pi (insert a s) t).2,
  refine (λ s' (h : s' = a ::ₘ s.1), (_ : erase_dup (multiset.pi s' (λ a, (t a).1)) =
    erase_dup ((t a).1.bind $ λ b,
    erase_dup $ (multiset.pi s.1 (λ (a : α), (t a).val)).map $
      λ f a' h', multiset.pi.cons s.1 a b f a' (h ▸ h')))) _ (insert_val_of_not_mem ha),
  subst s', rw pi_cons,
  congr, funext b,
  rw multiset.erase_dup_eq_self.2,
  exact multiset.nodup_map (multiset.pi_cons_injective ha) (pi s t).2,
end

lemma pi_singletons {β : Type*} (s : finset α) (f : α → β) :
  s.pi (λ a, ({f a} : finset β)) = {λ a _, f a} :=
begin
  rw eq_singleton_iff_unique_mem,
  split,
  { simp },
  intros a ha,
  ext i hi,
  rw [mem_pi] at ha,
  simpa using ha i hi,
end

lemma pi_const_singleton {β : Type*} (s : finset α) (i : β) :
  s.pi (λ _, ({i} : finset β)) = {λ _ _, i} :=
pi_singletons s (λ _, i)

lemma pi_subset {s : finset α} (t₁ t₂ : Πa, finset (δ a)) (h : ∀ a ∈ s, t₁ a ⊆ t₂ a) :
  s.pi t₁ ⊆ s.pi t₂ :=
λ g hg, mem_pi.2 $ λ a ha, h a ha (mem_pi.mp hg a ha)

lemma pi_disjoint_of_disjoint {δ : α → Type*} [∀a, decidable_eq (δ a)]
  {s : finset α} [decidable_eq (Πa∈s, δ a)]
  (t₁ t₂ : Πa, finset (δ a)) {a : α} (ha : a ∈ s) (h : disjoint (t₁ a) (t₂ a)) :
  disjoint (s.pi t₁) (s.pi t₂) :=
disjoint_iff_ne.2 $ λ f₁ hf₁ f₂ hf₂ eq₁₂,
  disjoint_iff_ne.1 h (f₁ a ha) (mem_pi.mp hf₁ a ha) (f₂ a ha) (mem_pi.mp hf₂ a ha)
  $ congr_fun (congr_fun eq₁₂ a) ha

end pi
end finset


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Johan Commelin, Bhavik Mehta

! This file was ported from Lean 3 source module category_theory.comma
! leanprover-community/mathlib commit dc6c365e751e34d100e80fe6e314c3c3e0fd2988
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Iso
import Mathlib.CategoryTheory.Functor.Category
import Mathlib.CategoryTheory.EqToHom

/-!
# Comma categories

A comma category is a construction in category theory, which builds a category out of two functors
with a common codomain. Specifically, for functors `L : A ⥤ T` and `R : B ⥤ T`, an object in
`Comma L R` is a morphism `hom : L.obj left ⟶ R.obj right` for some objects `left : A` and
`right : B`, and a morphism in `Comma L R` between `hom : L.obj left ⟶ R.obj right` and
`hom' : L.obj left' ⟶ R.obj right'` is a commutative square

```
L.obj left   ⟶   L.obj left'
      |               |
  hom |               | hom'
      ↓               ↓
R.obj right  ⟶   R.obj right',
```

where the top and bottom morphism come from morphisms `left ⟶ left'` and `right ⟶ right'`,
respectively.

## Main definitions

* `Comma L R`: the comma category of the functors `L` and `R`.
* `Over X`: the over category of the object `X` (developed in `Over.lean`).
* `Under X`: the under category of the object `X` (also developed in `Over.lean`).
* `Arrow T`: the arrow category of the category `T` (developed in `Arrow.lean`).

## References

* <https://ncatlab.org/nlab/show/comma+category>

## Tags

comma, slice, coslice, over, under, arrow
-/

namespace CategoryTheory

-- declare the `v`'s first; see `category_theory.category` for an explanation
universe v₁ v₂ v₃ v₄ v₅ u₁ u₂ u₃ u₄ u₅

variable {A : Type u₁} [Category.{v₁} A]

variable {B : Type u₂} [Category.{v₂} B]

variable {T : Type u₃} [Category.{v₃} T]

/-- The objects of the comma category are triples of an object `left : A`, an object
   `right : B` and a morphism `hom : L.obj left ⟶ R.obj right`.  -/
structure Comma (L : A ⥤ T) (R : B ⥤ T) : Type max u₁ u₂ v₃ where
  left : A := by aesop_cat
  right : B := by aesop_cat
  hom : L.obj left ⟶ R.obj right
#align category_theory.comma CategoryTheory.Comma

-- Satisfying the inhabited linter
instance Comma.inhabited [Inhabited T] : Inhabited (Comma (𝟭 T) (𝟭 T))
    where default :=
    { left := default
      right := default
      hom := 𝟙 default }
#align category_theory.comma.inhabited CategoryTheory.Comma.inhabited

variable {L : A ⥤ T} {R : B ⥤ T}

/-- A morphism between two objects in the comma category is a commutative square connecting the
    morphisms coming from the two objects using morphisms in the image of the functors `L` and `R`.
-/
@[ext]
structure CommaMorphism (X Y : Comma L R) where
  left : X.left ⟶ Y.left := by aesop_cat
  right : X.right ⟶ Y.right := by aesop_cat
  w : L.map left ≫ Y.hom = X.hom ≫ R.map right := by aesop_cat
#align category_theory.comma_morphism CategoryTheory.CommaMorphism

-- Satisfying the inhabited linter
instance CommaMorphism.inhabited [Inhabited (Comma L R)] :
    Inhabited (CommaMorphism (default : Comma L R) default) :=
    ⟨{ left := 𝟙 _, right := 𝟙 _}⟩
#align category_theory.comma_morphism.inhabited CategoryTheory.CommaMorphism.inhabited

attribute [reassoc (attr := simp)] CommaMorphism.w

instance commaCategory : Category (Comma L R)
    where
  Hom X Y := CommaMorphism X Y
  id X :=
    { left := 𝟙 X.left
      right := 𝟙 X.right }
  comp f g :=
    { left := f.left ≫ g.left
      right := f.right ≫ g.right }
#align category_theory.comma_category CategoryTheory.commaCategory

namespace Comma

section

variable {X Y Z : Comma L R} {f : X ⟶ Y} {g : Y ⟶ Z}

-- porting note: this lemma was added because `CommaMorphism.ext`
-- was not triggered automatically
@[ext]
lemma hom_ext (f g : X ⟶ Y) (h₁ : f.left = g.left) (h₂ : f.right = g.right) : f = g :=
  CommaMorphism.ext _ _ h₁ h₂

@[simp]
theorem id_left : (𝟙 X : CommaMorphism X X).left = 𝟙 X.left :=
  rfl
#align category_theory.comma.id_left CategoryTheory.Comma.id_left

@[simp]
theorem id_right : (𝟙 X : CommaMorphism X X).right = 𝟙 X.right :=
  rfl
#align category_theory.comma.id_right CategoryTheory.Comma.id_right

@[simp]
theorem comp_left : (f ≫ g).left = f.left ≫ g.left :=
  rfl
#align category_theory.comma.comp_left CategoryTheory.Comma.comp_left

@[simp]
theorem comp_right : (f ≫ g).right = f.right ≫ g.right :=
  rfl
#align category_theory.comma.comp_right CategoryTheory.Comma.comp_right

end

variable (L) (R)

/-- The functor sending an object `X` in the comma category to `X.left`. -/
@[simps]
def fst : Comma L R ⥤ A where
  obj X := X.left
  map f := f.left
#align category_theory.comma.fst CategoryTheory.Comma.fst

/-- The functor sending an object `X` in the comma category to `X.right`. -/
@[simps]
def snd : Comma L R ⥤ B where
  obj X := X.right
  map f := f.right
#align category_theory.comma.snd CategoryTheory.Comma.snd

/-- We can interpret the commutative square constituting a morphism in the comma category as a
    natural transformation between the functors `fst ⋙ L` and `snd ⋙ R` from the comma category
    to `T`, where the components are given by the morphism that constitutes an object of the comma
    category. -/
@[simps]
def natTrans : fst L R ⋙ L ⟶ snd L R ⋙ R where app X := X.hom
#align category_theory.comma.nat_trans CategoryTheory.Comma.natTrans

@[simp]
theorem eqToHom_left (X Y : Comma L R) (H : X = Y) :
    CommaMorphism.left (eqToHom H) =
      eqToHom
        (by
          cases H
          rfl) :=
  by
  cases H
  rfl
#align category_theory.comma.eq_to_hom_left CategoryTheory.Comma.eqToHom_left

@[simp]
theorem eqToHom_right (X Y : Comma L R) (H : X = Y) :
    CommaMorphism.right (eqToHom H) =
      eqToHom
        (by
          cases H
          rfl) :=
  by
  cases H
  rfl
#align category_theory.comma.eq_to_hom_right CategoryTheory.Comma.eqToHom_right

section

variable {L₁ L₂ L₃ : A ⥤ T} {R₁ R₂ R₃ : B ⥤ T}

/-- Construct an isomorphism in the comma category given isomorphisms of the objects whose forward
directions give a commutative square.
-/
@[simps]
def isoMk {X Y : Comma L₁ R₁} (l : X.left ≅ Y.left) (r : X.right ≅ Y.right)
    (h : L₁.map l.hom ≫ Y.hom = X.hom ≫ R₁.map r.hom) : X ≅ Y
    where
  hom :=
    { left := l.hom
      right := r.hom
      w := h }
  inv :=
    { left := l.inv
      right := r.inv
      w :=
        by
        rw [← L₁.mapIso_inv l, Iso.inv_comp_eq, L₁.mapIso_hom, ← Category.assoc, h,
          Category.assoc, ← R₁.map_comp]
        simp }
#align category_theory.comma.iso_mk CategoryTheory.Comma.isoMk

/-- A natural transformation `L₁ ⟶ L₂` induces a functor `Comma L₂ R ⥤ Comma L₁ R`. -/
@[simps]
def mapLeft (l : L₁ ⟶ L₂) : Comma L₂ R ⥤ Comma L₁ R
    where
  obj X :=
    { left := X.left
      right := X.right
      hom := l.app X.left ≫ X.hom }
  map f :=
    { left := f.left
      right := f.right }
#align category_theory.comma.map_left CategoryTheory.Comma.mapLeft

/-- The functor `Comma L R ⥤ Comma L R` induced by the identity natural transformation on `L` is
    naturally isomorphic to the identity functor. -/
@[simps]
def mapLeftId : mapLeft R (𝟙 L) ≅ 𝟭 _
    where
  hom :=
    { app := fun X =>
        { left := 𝟙 _
          right := 𝟙 _ } }
  inv :=
    { app := fun X =>
        { left := 𝟙 _
          right := 𝟙 _ } }
#align category_theory.comma.map_left_id CategoryTheory.Comma.mapLeftId

/-- The functor `Comma L₁ R ⥤ Comma L₃ R` induced by the composition of two natural transformations
    `l : L₁ ⟶ L₂` and `l' : L₂ ⟶ L₃` is naturally isomorphic to the composition of the two functors
    induced by these natural transformations. -/
@[simps]
def mapLeftComp (l : L₁ ⟶ L₂) (l' : L₂ ⟶ L₃) : mapLeft R (l ≫ l') ≅ mapLeft R l' ⋙ mapLeft R l
    where
  hom :=
    { app := fun X =>
        { left := 𝟙 _
          right := 𝟙 _ } }
  inv :=
    { app := fun X =>
        { left := 𝟙 _
          right := 𝟙 _ } }
#align category_theory.comma.map_left_comp CategoryTheory.Comma.mapLeftComp

/-- A natural transformation `R₁ ⟶ R₂` induces a functor `Comma L R₁ ⥤ Comma L R₂`. -/
@[simps]
def mapRight (r : R₁ ⟶ R₂) : Comma L R₁ ⥤ Comma L R₂
    where
  obj X :=
    { left := X.left
      right := X.right
      hom := X.hom ≫ r.app X.right }
  map f :=
    { left := f.left
      right := f.right }
#align category_theory.comma.map_right CategoryTheory.Comma.mapRight

/-- The functor `Comma L R ⥤ Comma L R` induced by the identity natural transformation on `R` is
    naturally isomorphic to the identity functor. -/
@[simps]
def mapRightId : mapRight L (𝟙 R) ≅ 𝟭 _
    where
  hom :=
    { app := fun X =>
        { left := 𝟙 _
          right := 𝟙 _ } }
  inv :=
    { app := fun X =>
        { left := 𝟙 _
          right := 𝟙 _ } }
#align category_theory.comma.map_right_id CategoryTheory.Comma.mapRightId

/-- The functor `Comma L R₁ ⥤ Comma L R₃` induced by the composition of the natural transformations
    `r : R₁ ⟶ R₂` and `r' : R₂ ⟶ R₃` is naturally isomorphic to the composition of the functors
    induced by these natural transformations. -/
@[simps]
def mapRightComp (r : R₁ ⟶ R₂) (r' : R₂ ⟶ R₃) : mapRight L (r ≫ r') ≅ mapRight L r ⋙ mapRight L r'
    where
  hom :=
    { app := fun X =>
        { left := 𝟙 _
          right := 𝟙 _ } }
  inv :=
    { app := fun X =>
        { left := 𝟙 _
          right := 𝟙 _ } }
#align category_theory.comma.map_right_comp CategoryTheory.Comma.mapRightComp

end

section

variable {C : Type u₄} [Category.{v₄} C] {D : Type u₅} [Category.{v₅} D]

/-- The functor `(F ⋙ L, R) ⥤ (L, R)` -/
@[simps]
def preLeft (F : C ⥤ A) (L : A ⥤ T) (R : B ⥤ T) : Comma (F ⋙ L) R ⥤ Comma L R
    where
  obj X :=
    { left := F.obj X.left
      right := X.right
      hom := X.hom }
  map f :=
    { left := F.map f.left
      right := f.right
      w := by simpa using f.w }
#align category_theory.comma.pre_left CategoryTheory.Comma.preLeft

/-- The functor `(F ⋙ L, R) ⥤ (L, R)` -/
@[simps]
def preRight (L : A ⥤ T) (F : C ⥤ B) (R : B ⥤ T) : Comma L (F ⋙ R) ⥤ Comma L R
    where
  obj X :=
    { left := X.left
      right := F.obj X.right
      hom := X.hom }
  map f :=
    { left := f.left
      right := F.map f.right }
#align category_theory.comma.pre_right CategoryTheory.Comma.preRight

/-- The functor `(L, R) ⥤ (L ⋙ F, R ⋙ F)` -/
@[simps]
def post (L : A ⥤ T) (R : B ⥤ T) (F : T ⥤ C) : Comma L R ⥤ Comma (L ⋙ F) (R ⋙ F)
    where
  obj X :=
    { left := X.left
      right := X.right
      hom := F.map X.hom }
  map f :=
    { left := f.left
      right := f.right
      w := by simp only [Functor.comp_map, ← F.map_comp, f.w] }
#align category_theory.comma.post CategoryTheory.Comma.post

end

end Comma

end CategoryTheory