/-
Copyright (c) 2023 Wojciech Nawrocki. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Wojciech Nawrocki
-/

import Std.Classes.BEq

import Mathlib.Tactic.Linarith
import Mathlib.Data.List.Lemmas
import Mathlib.Data.List.Perm

/-! Std.Logic or Std.Bool? -/

@[simp] theorem Bool.bnot_eq_to_not_eq (a b : Bool) :
  ((!a) = b) = ¬(a = b) := by cases a <;> cases b <;> decide
@[simp] theorem Bool.eq_bnot_to_not_eq (a b : Bool) :
  (a = (!b)) = ¬(a = b) := by cases a <;> cases b <;> decide
@[simp] theorem Bool.eq_true_iff_eq_true_to_eq (a b : Bool) :
  (a = true ↔ b = true) = (a = b) := by cases a <;> cases b <;> decide
@[simp] theorem Bool.eq_false_iff_eq_false_to_eq (a b : Bool) :
  (a = false ↔ b = false) = (a = b) := by cases a <;> cases b <;> decide

/-! Std.Logic -/

theorem Bool.not_eq_true_iff_ne_true {b : Bool} : (!b) = true ↔ ¬(b = true) := by
  cases b <;> decide

theorem Bool.bne_iff_not_beq [BEq α] {a a' : α} : a != a' ↔ ¬(a == a') :=
  Bool.not_eq_true_iff_ne_true

theorem Bool.beq_or_bne [BEq α] (a a' : α) : a == a' ∨ a != a' :=
  by
    cases h : a == a'
    . apply Or.inr
      simp [bne_iff_not_beq, h]
    . exact Or.inl rfl

@[simp]
theorem Bool.bne_eq_false [BEq α] {a a' : α} : (a != a') = false ↔ a == a' := by
  dsimp [bne]
  cases (a == a') <;> simp

/-! Std.Classes.BEq -/

instance [BEq α] [LawfulBEq α] : PartialEquivBEq α where
  symm h := by cases (beq_iff_eq _ _).mp h; exact h
  trans h₁ h₂ := by cases (beq_iff_eq _ _).mp h₁; cases (beq_iff_eq _ _).mp h₂; exact h₁

theorem bne_symm [BEq α] [PartialEquivBEq α] {a b : α} : a != b → b != a :=
  fun h => Bool.not_eq_true_iff_ne_true.mpr fun h' =>
    Bool.bne_iff_not_beq.mp h (PartialEquivBEq.symm h')

@[simp]
theorem bne_iff_ne [BEq α] [LawfulBEq α] (a b : α) : a != b ↔ a ≠ b := by
  simp [Bool.bne_iff_not_beq]

/-! Maybe Std.Notation -/

/-- Notation typeclass for semantic entailment `⊨`. -/
class SemanticEntails (α : Type u) (β : outParam $ Type v) where
  entails : α → β → Prop

infix:51 " ⊨ " => SemanticEntails.entails
infix:51 " ⊭ " => fun M φ => ¬(M ⊨ φ)

/-! Data.List.Extra or something -/

@[specialize]
def List.foldlDep {α : Type u} {β : Type v} : (l : List β) → (f : α → (b : β) → b ∈ l → α) →
    (init : α) → α
  | nil,      _, init => init
  | cons b l, f, init => foldlDep l (fun a b h => f a b (.tail _ h)) (f init b (.head l))

@[specialize]
def List.mapDep {α : Type u} {β : Type v} : (l : List α) → (f : (a : α) → a ∈ l → β) → List β
  | nil,      _ => []
  | cons a l, f => f a (.head l) :: mapDep l fun a h => f a (.tail _ h)

@[simp]
theorem List.map_mapDep {γ : Type u} : (l : List α) → (f : (a : α) → a ∈ l → β) → (g : β → γ) →
    (l.mapDep f).map g = l.mapDep (fun a h => g (f a h))
  | nil,      _, _ => rfl
  | cons a l, f, g => by
    -- https://www.youtube.com/watch?v=Hd2JgADY9d8
    simp [map, mapDep, map_mapDep]

/-! Data.List.Lemmas -/

namespace List

/-! drop -/

theorem drop_eq_cons_get (l : List α) (i : Nat) (h : i < l.length)
    : l.drop i = l.get ⟨i, h⟩ :: l.drop (i + 1) :=
  go i l h
where go : (i : Nat) → (l : List α) → (h : i < l.length) → l.drop i = l[i] :: l.drop (i + 1)
  | 0,   _::_,  _ => by simp
  | n+1, _::as, h => by
    have : n < length as := Nat.lt_of_succ_lt_succ h
    have ih := go n as this
    simp [ih]

theorem drop_ext (l₁ l₂ : List α) (j : Nat)
    : (∀ i ≥ j, l₁.get? i = l₂.get? i) → l₁.drop j = l₂.drop j := by
  intro H
  apply ext fun k => ?_
  rw [get?_drop, get?_drop]
  apply H _ (Nat.le_add_right _ _)

/-! find? -/

theorem find?_filter (l : List α) (p q : α → Bool) (h : ∀ a, p a → q a) :
    (l.filter q).find? p = l.find? p := by
  induction l with
  | nil => rfl
  | cons x xs ih =>
    dsimp [filter]
    split <;> split <;> simp [*] at *

theorem find?_filter' (l : List α) (p q : α → Bool) (h : ∀ a, p a → !q a) :
    (l.filter q).find? p = none := by
  induction l with
  | nil => rfl
  | cons x xs ih =>
    dsimp [filter]
    split
    next _ hQ => rw [find?_cons_of_neg _ (fun hP => by aesop), ih]
    next => exact ih

-- theorem find?_eraseP (l : List α) (p q : α → Bool) (h : ∀ a, p a → !q a) :
--     (l.eraseP q).find? p = l.find? p := by
--   induction l with
--   | nil => rfl
--   | cons x xs ih =>
--     dsimp [filter, eraseP]
--     split
--     next _ hP => aesop
--     next _ hP =>
--       cases (q x : Bool) with -- `split_ifs` doesn't work on `bif`
--       | false => rw [cond_false, find?_cons_of_neg _ (by simp [hP]), ih]
--       | true => rw [cond_true]

/-! foldl -/

theorem foldl_cons_fn (l₁ l₂ : List α) :
    l₁.foldl (init := l₂) (fun acc x => x :: acc) = l₁.reverse ++ l₂ := by
  induction l₁ generalizing l₂ <;> simp [*]

theorem foldl_append_fn (l₁ : List α) (l₂ : List β) (f : α → List β) :
    l₁.foldl (init := l₂) (fun acc x => acc ++ f x) = l₂ ++ l₁.bind f := by
  induction l₁ generalizing l₂ <;> simp [*]

end List

/-! Data.Array.Lemmas -/

theorem Array.get_of_mem_data {as : Array α} {a : α} : a ∈ as.data → ∃ (i : Fin as.size), as[i] = a :=
  List.get_of_mem

theorem Array.get_mem_data (as : Array α) (i : Fin as.size) : as[i] ∈ as.data := by
  simp [getElem_mem_data]

/-! Data.List.Perm -/

namespace List

/-- The way Lean 4 computes the motive with `elab_as_elim` has changed
relative to the behaviour of `elab_as_eliminator` in Lean 3.
See
https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Potential.20elaboration.20bug.20with.20.60elabAsElim.60/near/299573172
for an explanation of the change made here relative to mathlib3.
-/
@[elab_as_elim]
theorem perm_induction_on'
    {P : (l₁ : List α) → (l₂ : List α) → l₁ ~ l₂ → Prop} {l₁ l₂ : List α} (p : l₁ ~ l₂)
    (nil : P [] [] .nil)
    (cons : ∀ x l₁ l₂, (h : l₁ ~ l₂) → P l₁ l₂ h → P (x :: l₁) (x :: l₂) (.cons x h))
    (swap : ∀ x y l₁ l₂, (h : l₁ ~ l₂) → P l₁ l₂ h →
      P (y :: x :: l₁) (x :: y :: l₂) (.trans (.swap x y _) (.cons _ (.cons _ h))))
    (trans : ∀ l₁ l₂ l₃, (h₁ : l₁ ~ l₂) → (h₂ : l₂ ~ l₃) → P l₁ l₂ h₁ → P l₂ l₃ h₂ →
      P l₁ l₃ (.trans h₁ h₂)) : P l₁ l₂ p :=
  have P_refl l : P l l (.refl l) :=
    List.recOn l nil fun x xs ih ↦ cons x xs xs (Perm.refl xs) ih
  Perm.recOn p nil cons (fun x y l ↦ swap x y l l (Perm.refl l) (P_refl l)) @trans

end List

/-! Maybe Data.List.Unique -/

namespace List

/-- There is at most one element satisfying `p` in `l`. -/
-- TODO Move the other `of_unique` lemmas to this formulation
-- and move `pairwise'` lemmas below to `unique`
def unique (p : α → Prop) (l : List α) : Prop :=
  l.Pairwise (p · → ¬p ·)

def unique_cons_of_true {x : α} {l : List α} {p : α → Prop} :
    (x :: l).unique p → p x → ∀ y ∈ l, ¬p y :=
  fun h hP _ hY => rel_of_pairwise_cons h hY hP

theorem unique.sublist {l₁ l₂ : List α} {p : α → Prop} : l₁ <+ l₂ → l₂.unique p → l₁.unique p :=
  Pairwise.sublist

example {x y : α} {p : α → Prop} : (p x → ¬p y) → (p y → ¬p x) :=
  fun h hY hX => h hX hY

def unique.perm {l₁ l₂ : List α} {p : α → Prop} : l₁ ~ l₂ → l₁.unique p → l₂.unique p :=
  fun h h₁ => h.pairwise h₁ fun _ _ H hB hA => H hA hB

theorem find?_eq_of_perm_of_unique {l₁ l₂ : List α} {p : α → Bool} :
    l₁ ~ l₂ → l₁.unique (p ·) → l₁.find? p = l₂.find? p := by
  intro h hUniq
  induction h using perm_induction_on' with
  | nil => rfl
  | cons x l₁ _ _ ih =>
    have := ih (hUniq.sublist (sublist_cons x l₁))
    simp [find?, this]
  | swap x y l₁ l₂ _ ih =>
    dsimp [find?]
    split <;> split <;> try rfl
    next hY _ hX =>
      have : ¬p x := unique_cons_of_true hUniq hY x (mem_cons_self _ _)
      contradiction
    next => exact ih <| hUniq.sublist <| sublist_of_cons_sublist <| sublist_cons y (x :: l₁)
  | trans l₁ l₂ l₃ h₁₂ _ h₁ h₂ =>
    simp [h₁ hUniq, h₂ (hUniq.perm h₁₂)]

/-- If there is at most one element with the property `p`, finding that one element is the same
as finding any. -/
theorem find?_eq_some_of_unique {l : List α} {a : α} {p : α → Bool}
    : l.Pairwise (p · → !p ·) → (l.find? p = some a ↔ (a ∈ l ∧ p a)) := by
  refine fun h => ⟨fun h' => ⟨find?_mem h', find?_some h'⟩, ?_⟩
  induction l with
  | nil => simp
  | cons x xs ih =>
    intro ⟨hMem, hP⟩
    cases mem_cons.mp hMem with
    | inl hX => simp [find?, ← hX, hP]
    | inr hXs =>
      unfold find?
      cases hPX : (p x) with
      | false =>
        apply ih (Pairwise.sublist (sublist_cons x xs) h) ⟨hXs, hP⟩
      | true =>
        cases hP ▸ (pairwise_cons.mp h |>.left a hXs hPX)

/-- If there is at most one element with the property `p`, erasing one such element is the same
as filtering out all of them. -/
theorem eraseP_eq_filter_of_unique (l : List α) (p : α → Bool)
    : l.Pairwise (p · → !p ·) → l.eraseP p = l.filter (!p ·) := by
  intro h
  induction l with
  | nil => rfl
  | cons x xs ih =>
    specialize ih (Pairwise.sublist (sublist_cons x xs) h)
    cases hP : p x with
    | true =>
      rw [pairwise_cons] at h
      have : ∀ a ∈ xs, !p a := fun a hA => h.left a hA hP
      simp [eraseP, filter, hP, filter_eq_self.mpr this]
    | false => simp [eraseP_cons, filter, hP, ih]

theorem replaceF_of_unique {a b : α} {l : List α} (f : α → Option α) :
    a ∈ l → f a = some b → l.Pairwise (fun a₁ a₂ => (f a₁).isSome → ¬(f a₂).isSome) →
    l.replaceF f ~ b :: l.eraseP (f · |>.isSome) := by
  intro hMem hF hPws
  induction l with
  | nil => cases hMem
  | cons x xs ih =>
    unfold replaceF eraseP
    cases mem_cons.mp hMem with
    | inl hMem => simp [← hMem, hF, Perm.refl]
    | inr hMem =>
      have : f x = none := by
        have .cons hPws _ := hPws
        exact Option.eq_none_iff_forall_not_mem.mpr fun b hB' =>
          hPws a hMem (hB' ▸ rfl) (hF ▸ rfl)
      simp only [this, Option.isSome_none, cond_false]
      have := ih hMem (hPws.sublist <| sublist_cons _ _)
      exact .trans (.cons x this) (.swap b x _)

end List

/-! Int -/

theorem Int.eq_zero_of_lt_neg_iff_lt (i : Int) : (0 < -i ↔ 0 < i) → i = 0 := by
  intro h
  by_cases hLt : 0 < i
  . have := h.mpr hLt; linarith
  . have : ¬ 0 < -i := fun h₂ => hLt (h.mp h₂); linarith

/-! Loop -/

def loopM_with_invariant [Monad m] {State : Type _} (n : Nat)
    (invariant : Nat → State → Prop)
    (start_state : { st // invariant 0 st })
    (step : (i : Fin n) → { st // invariant i st } → m { st // invariant (i+1) st }) :
    m { st // invariant n st } :=
  go n 0 (by rw [add_zero]) start_state
where
  go : (b : Nat) → (i : Nat) → b + i = n → { st // invariant i st } → m { st // invariant n st }
    | 0, i, h, state =>
      have : i = n := Nat.zero_add i ▸ h
      return this ▸ state
    | (b + 1), i, h, state => do
      let v ← step ⟨i, by rw [← h]; linarith⟩ state
      go b (i + 1) (by rw [← h]; ac_rfl) v


import data.fintype.basic
import category_theory.Fintype

open_locale classical

universe u

-- This is an awkward hybrid: we should state the induction principle for unbundled fintype
-- and then if it is necessary provide an interface for using it with `Fintype`.

lemma Fintype.induction_empty_sum {P : Fintype.{u} → Prop}
  (of_equiv : ∀ {α β : Fintype.{u}}, α ≃ β → P α → P β)
  (h_empty : P (Fintype.of pempty))
  (h_option : ∀ {α : Fintype.{u}}, P α → P (Fintype.of (α ⊕ (punit : Type u))))
  (α : Fintype.{u}) : P α :=
begin
  let Q : Π (α : Type u) [fintype α], Prop := λ a h, P ⟨a,h⟩,
  have H := @fintype.induction_empty_option Q _ _ _ α α.str,
  { cases α, exact H },
  { introsI α β _ e h,
    haveI : fintype α := fintype.of_equiv _ e.symm,
    let e' : Fintype.of α ≃ Fintype.of β := e,
    apply of_equiv e',
    convert h },
  { assumption },
  { introsI α _ h,
    let e : option α ≃ α ⊕ (punit : Type u) := equiv.option_equiv_sum_punit _,
    let e' : Fintype.of (option α) ≃ Fintype.of (α ⊕ punit) := e,
    apply of_equiv e'.symm,
    exact h_option h }
end


/-
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, Kenny Lau, Johan Commelin, Mario Carneiro, Kevin Buzzard
-/
import group_theory.submonoid.basic
import algebra.big_operators.basic
import deprecated.group

/-!
# Unbundled submonoids

This file defines unbundled multiplicative and additive submonoids `is_submonoid` and
`is_add_submonoid`. These are not the preferred way to talk about submonoids and should
not be used for any new projects. The preferred way in mathlib are the bundled
versions `submonoid G` and `add_submonoid G`.

## Main definitions

`is_add_submonoid (S : set G)` : the predicate that `S` is the underlying subset of an additive
submonoid of `G`. The bundled variant `add_subgroup G` should be used in preference to this.

`is_submonoid (S : set G)` : the predicate that `S` is the underlying subset of a submonoid
of `G`. The bundled variant `submonoid G` should be used in preference to this.

## Tags

subgroup, subgroups, is_subgroup

## Tags
submonoid, submonoids, is_submonoid
-/

open_locale big_operators

variables {M : Type*} [monoid M] {s : set M}
variables {A : Type*} [add_monoid A] {t : set A}

/-- `s` is an additive submonoid: a set containing 0 and closed under addition.
Note that this structure is deprecated, and the bundled variant `add_submonoid A` should be
preferred. -/
structure is_add_submonoid (s : set A) : Prop :=
(zero_mem : (0:A) ∈ s)
(add_mem {a b} : a ∈ s → b ∈ s → a + b ∈ s)

/-- `s` is a submonoid: a set containing 1 and closed under multiplication.
Note that this structure is deprecated, and the bundled variant `submonoid M` should be
preferred. -/
@[to_additive]
structure is_submonoid (s : set M) : Prop :=
(one_mem : (1:M) ∈ s)
(mul_mem {a b} : a ∈ s → b ∈ s → a * b ∈ s)

lemma additive.is_add_submonoid
  {s : set M} : ∀ (is : is_submonoid s), @is_add_submonoid (additive M) _ s
| ⟨h₁, h₂⟩ := ⟨h₁, @h₂⟩

theorem additive.is_add_submonoid_iff
  {s : set M} : @is_add_submonoid (additive M) _ s ↔ is_submonoid s :=
⟨λ ⟨h₁, h₂⟩, ⟨h₁, @h₂⟩, additive.is_add_submonoid⟩

lemma multiplicative.is_submonoid
  {s : set A} : ∀ (is : is_add_submonoid s), @is_submonoid (multiplicative A) _ s
| ⟨h₁, h₂⟩ := ⟨h₁, @h₂⟩

theorem multiplicative.is_submonoid_iff
  {s : set A} : @is_submonoid (multiplicative A) _ s ↔ is_add_submonoid s :=
⟨λ ⟨h₁, h₂⟩, ⟨h₁, @h₂⟩, multiplicative.is_submonoid⟩

/-- The intersection of two submonoids of a monoid `M` is a submonoid of `M`. -/
@[to_additive "The intersection of two `add_submonoid`s of an `add_monoid` `M` is
an `add_submonoid` of M."]
lemma is_submonoid.inter {s₁ s₂ : set M} (is₁ : is_submonoid s₁) (is₂ : is_submonoid s₂) :
  is_submonoid (s₁ ∩ s₂) :=
{ one_mem := ⟨is₁.one_mem, is₂.one_mem⟩,
  mul_mem := λ x y hx hy,
    ⟨is₁.mul_mem hx.1 hy.1, is₂.mul_mem hx.2 hy.2⟩ }

/-- The intersection of an indexed set of submonoids of a monoid `M` is a submonoid of `M`. -/
@[to_additive "The intersection of an indexed set of `add_submonoid`s of an `add_monoid` `M` is
an `add_submonoid` of `M`."]
lemma is_submonoid.Inter {ι : Sort*} {s : ι → set M} (h : ∀ y : ι, is_submonoid (s y)) :
  is_submonoid (set.Inter s) :=
{ one_mem := set.mem_Inter.2 $ λ y, (h y).one_mem,
  mul_mem := λ x₁ x₂ h₁ h₂, set.mem_Inter.2 $
    λ y, (h y).mul_mem (set.mem_Inter.1 h₁ y) (set.mem_Inter.1 h₂ y) }

/-- The union of an indexed, directed, nonempty set of submonoids of a monoid `M` is a submonoid
    of `M`. -/
@[to_additive "The union of an indexed, directed, nonempty set
of `add_submonoid`s of an `add_monoid` `M` is an `add_submonoid` of `M`. "]
lemma is_submonoid_Union_of_directed {ι : Type*} [hι : nonempty ι]
  {s : ι → set M} (hs : ∀ i, is_submonoid (s i))
  (directed : ∀ i j, ∃ k, s i ⊆ s k ∧ s j ⊆ s k) :
  is_submonoid (⋃i, s i) :=
{ one_mem := let ⟨i⟩ := hι in set.mem_Union.2 ⟨i, (hs i).one_mem⟩,
  mul_mem := λ a b ha hb,
    let ⟨i, hi⟩ := set.mem_Union.1 ha in
    let ⟨j, hj⟩ := set.mem_Union.1 hb in
    let ⟨k, hk⟩ := directed i j in
    set.mem_Union.2 ⟨k, (hs k).mul_mem (hk.1 hi) (hk.2 hj)⟩ }

section powers

/-- The set of natural number powers `1, x, x², ...` of an element `x` of a monoid. -/
@[to_additive multiples
"The set of natural number multiples `0, x, 2x, ...` of an element `x` of an `add_monoid`."]
def powers (x : M) : set M := {y | ∃ n:ℕ, x^n = y}

/-- 1 is in the set of natural number powers of an element of a monoid. -/
@[to_additive "0 is in the set of natural number multiples of an element of an `add_monoid`."]
lemma powers.one_mem {x : M} : (1 : M) ∈ powers x := ⟨0, pow_zero _⟩

/-- An element of a monoid is in the set of that element's natural number powers. -/
@[to_additive
"An element of an `add_monoid` is in the set of that element's natural number multiples."]
lemma powers.self_mem {x : M} : x ∈ powers x := ⟨1, pow_one _⟩

/-- The set of natural number powers of an element of a monoid is closed under multiplication. -/
@[to_additive
"The set of natural number multiples of an element of an `add_monoid` is closed under addition."]
lemma powers.mul_mem {x y z : M} : (y ∈ powers x) → (z ∈ powers x) → (y * z ∈ powers x) :=
λ ⟨n₁, h₁⟩ ⟨n₂, h₂⟩, ⟨n₁ + n₂, by simp only [pow_add, *]⟩

/-- The set of natural number powers of an element of a monoid `M` is a submonoid of `M`. -/
@[to_additive "The set of natural number multiples of an element of
an `add_monoid` `M` is an `add_submonoid` of `M`."]
lemma powers.is_submonoid (x : M) : is_submonoid (powers x) :=
{ one_mem := powers.one_mem,
  mul_mem := λ y z, powers.mul_mem }

/-- A monoid is a submonoid of itself. -/
@[to_additive "An `add_monoid` is an `add_submonoid` of itself."]
lemma univ.is_submonoid : is_submonoid (@set.univ M) := by split; simp

/-- The preimage of a submonoid under a monoid hom is a submonoid of the domain. -/
@[to_additive "The preimage of an `add_submonoid` under an `add_monoid` hom is
an `add_submonoid` of the domain."]
lemma is_submonoid.preimage {N : Type*} [monoid N] {f : M → N} (hf : is_monoid_hom f)
  {s : set N} (hs : is_submonoid s) : is_submonoid (f ⁻¹' s) :=
{ one_mem := show f 1 ∈ s, by rw is_monoid_hom.map_one hf; exact hs.one_mem,
  mul_mem := λ a b (ha : f a ∈ s) (hb : f b ∈ s),
    show f (a * b) ∈ s, by rw is_monoid_hom.map_mul hf; exact hs.mul_mem ha hb }

/-- The image of a submonoid under a monoid hom is a submonoid of the codomain. -/
@[to_additive "The image of an `add_submonoid` under an `add_monoid`
hom is an `add_submonoid` of the codomain."]
lemma is_submonoid.image {γ : Type*} [monoid γ] {f : M → γ} (hf : is_monoid_hom f)
  {s : set M} (hs : is_submonoid s) : is_submonoid (f '' s) :=
{ one_mem := ⟨1, hs.one_mem, hf.map_one⟩,
  mul_mem := λ a b ⟨x, hx⟩ ⟨y, hy⟩, ⟨x * y, hs.mul_mem hx.1 hy.1,
    by rw [hf.map_mul, hx.2, hy.2]⟩ }

/-- The image of a monoid hom is a submonoid of the codomain. -/
@[to_additive "The image of an `add_monoid` hom is an `add_submonoid`
of the codomain."]
lemma range.is_submonoid {γ : Type*} [monoid γ] {f : M → γ} (hf : is_monoid_hom f) :
  is_submonoid (set.range f) :=
by { rw ← set.image_univ, exact univ.is_submonoid.image hf }

/-- Submonoids are closed under natural powers. -/
@[to_additive is_add_submonoid.smul_mem
"An `add_submonoid` is closed under multiplication by naturals."]
lemma is_submonoid.pow_mem {a : M} (hs : is_submonoid s) (h : a ∈ s) : ∀ {n : ℕ}, a ^ n ∈ s
| 0 := by { rw pow_zero, exact hs.one_mem }
| (n + 1) := by { rw pow_succ, exact hs.mul_mem h is_submonoid.pow_mem }

/-- The set of natural number powers of an element of a submonoid is a subset of the submonoid. -/
@[to_additive is_add_submonoid.multiples_subset "The set of natural number multiples of an element
of an `add_submonoid` is a subset of the `add_submonoid`."]
lemma is_submonoid.power_subset {a : M} (hs : is_submonoid s) (h : a ∈ s) : powers a ⊆ s :=
assume x ⟨n, hx⟩, hx ▸ hs.pow_mem h

end powers

namespace is_submonoid

/-- The product of a list of elements of a submonoid is an element of the submonoid. -/
@[to_additive "The sum of a list of elements of an `add_submonoid` is an element of the
`add_submonoid`."]
lemma list_prod_mem (hs : is_submonoid s) : ∀{l : list M}, (∀x∈l, x ∈ s) → l.prod ∈ s
| []     h := hs.one_mem
| (a::l) h :=
  suffices a * l.prod ∈ s, by simpa,
  have a ∈ s ∧ (∀x∈l, x ∈ s), by simpa using h,
  hs.mul_mem this.1 (list_prod_mem this.2)

/-- The product of a multiset of elements of a submonoid of a `comm_monoid` is an element of
the submonoid. -/
@[to_additive "The sum of a multiset of elements of an `add_submonoid` of an `add_comm_monoid`
is an element of the `add_submonoid`. "]
lemma multiset_prod_mem {M} [comm_monoid M] {s : set M} (hs : is_submonoid s) (m : multiset M) :
  (∀a∈m, a ∈ s) → m.prod ∈ s :=
begin
  refine quotient.induction_on m (assume l hl, _),
  rw [multiset.quot_mk_to_coe, multiset.coe_prod],
  exact list_prod_mem hs hl
end

/-- The product of elements of a submonoid of a `comm_monoid` indexed by a `finset` is an element
of the submonoid. -/
@[to_additive "The sum of elements of an `add_submonoid` of an `add_comm_monoid` indexed by
a `finset` is an element of the `add_submonoid`."]
lemma finset_prod_mem {M A} [comm_monoid M] {s : set M} (hs : is_submonoid s) (f : A → M) :
  ∀(t : finset A), (∀b∈t, f b ∈ s) → ∏ b in t, f b ∈ s
| ⟨m, hm⟩ _ := multiset_prod_mem hs _ (by simpa)

end is_submonoid

namespace add_monoid

/-- The inductively defined membership predicate for the submonoid generated by a subset of a
    monoid. -/
inductive in_closure (s : set A) : A → Prop
| basic {a : A} : a ∈ s → in_closure a
| zero : in_closure 0
| add {a b : A} : in_closure a → in_closure b → in_closure (a + b)

end add_monoid

namespace monoid

/-- The inductively defined membership predicate for the `submonoid` generated by a subset of an
    monoid. -/
@[to_additive]
inductive in_closure (s : set M) : M → Prop
| basic {a : M} : a ∈ s → in_closure a
| one : in_closure 1
| mul {a b : M} : in_closure a → in_closure b → in_closure (a * b)

/-- The inductively defined submonoid generated by a subset of a monoid. -/
@[to_additive "The inductively defined `add_submonoid` genrated by a subset of an `add_monoid`."]
def closure (s : set M) : set M := {a | in_closure s a }

@[to_additive]
lemma closure.is_submonoid (s : set M) : is_submonoid (closure s) :=
{ one_mem := in_closure.one, mul_mem := assume a b, in_closure.mul }

/-- A subset of a monoid is contained in the submonoid it generates. -/
@[to_additive "A subset of an `add_monoid` is contained in the `add_submonoid` it generates."]
theorem subset_closure {s : set M} : s ⊆ closure s :=
assume a, in_closure.basic

/-- The submonoid generated by a set is contained in any submonoid that contains the set. -/
@[to_additive "The `add_submonoid` generated by a set is contained in any `add_submonoid` that
contains the set."]
theorem closure_subset {s t : set M} (ht : is_submonoid t) (h : s ⊆ t) : closure s ⊆ t :=
assume a ha, by induction ha; simp [h _, *, is_submonoid.one_mem, is_submonoid.mul_mem]

/-- Given subsets `t` and `s` of a monoid `M`, if `s ⊆ t`, the submonoid of `M` generated by `s` is
    contained in the submonoid generated by `t`. -/
@[to_additive "Given subsets `t` and `s` of an `add_monoid M`, if `s ⊆ t`, the `add_submonoid`
of `M` generated by `s` is contained in the `add_submonoid` generated by `t`."]
theorem closure_mono {s t : set M} (h : s ⊆ t) : closure s ⊆ closure t :=
closure_subset (closure.is_submonoid t) $ set.subset.trans h subset_closure

/-- The submonoid generated by an element of a monoid equals the set of natural number powers of
    the element. -/
@[to_additive "The `add_submonoid` generated by an element of an `add_monoid` equals the set of
natural number multiples of the element."]
theorem closure_singleton {x : M} : closure ({x} : set M) = powers x :=
set.eq_of_subset_of_subset (closure_subset (powers.is_submonoid x) $ set.singleton_subset_iff.2 $
  powers.self_mem) $ is_submonoid.power_subset (closure.is_submonoid _) $
  set.singleton_subset_iff.1 $ subset_closure

/-- The image under a monoid hom of the submonoid generated by a set equals the submonoid generated
    by the image of the set under the monoid hom. -/
@[to_additive "The image under an `add_monoid` hom of the `add_submonoid` generated by a set equals
the `add_submonoid` generated by the image of the set under the `add_monoid` hom."]
lemma image_closure {A : Type*} [monoid A] {f : M → A} (hf : is_monoid_hom f) (s : set M) :
  f '' closure s = closure (f '' s) :=
le_antisymm
  begin
    rintros _ ⟨x, hx, rfl⟩,
    apply in_closure.rec_on hx; intros,
    { solve_by_elim [subset_closure, set.mem_image_of_mem] },
    { rw [hf.map_one], apply is_submonoid.one_mem (closure.is_submonoid (f '' s))},
    { rw [hf.map_mul], solve_by_elim [(closure.is_submonoid _).mul_mem] }
  end
  (closure_subset (is_submonoid.image hf (closure.is_submonoid _)) $
    set.image_subset _ subset_closure)

/-- Given an element `a` of the submonoid of a monoid `M` generated by a set `s`, there exists
a list of elements of `s` whose product is `a`. -/
@[to_additive "Given an element `a` of the `add_submonoid` of an `add_monoid M` generated by
a set `s`, there exists a list of elements of `s` whose sum is `a`."]
theorem exists_list_of_mem_closure {s : set M} {a : M} (h : a ∈ closure s) :
  (∃l:list M, (∀x∈l, x ∈ s) ∧ l.prod = a) :=
begin
  induction h,
  case in_closure.basic : a ha { existsi ([a]), simp [ha] },
  case in_closure.one { existsi ([]), simp },
  case in_closure.mul : a b _ _ ha hb
  { rcases ha with ⟨la, ha, eqa⟩,
    rcases hb with ⟨lb, hb, eqb⟩,
    existsi (la ++ lb),
    simp [eqa.symm, eqb.symm, or_imp_distrib],
    exact assume a, ⟨ha a, hb a⟩ }
end

/-- Given sets `s, t` of a commutative monoid `M`, `x ∈ M` is in the submonoid of `M` generated by
    `s ∪ t` iff there exists an element of the submonoid generated by `s` and an element of the
    submonoid generated by `t` whose product is `x`. -/
@[to_additive "Given sets `s, t` of a commutative `add_monoid M`, `x ∈ M` is in the `add_submonoid`
of `M` generated by `s ∪ t` iff there exists an element of the `add_submonoid` generated by `s`
and an element of the `add_submonoid` generated by `t` whose sum is `x`."]
theorem mem_closure_union_iff {M : Type*} [comm_monoid M] {s t : set M} {x : M} :
  x ∈ closure (s ∪ t) ↔ ∃ y ∈ closure s, ∃ z ∈ closure t, y * z = x :=
⟨λ hx, let ⟨L, HL1, HL2⟩ := exists_list_of_mem_closure hx in HL2 ▸
  list.rec_on L (λ _, ⟨1, (closure.is_submonoid _).one_mem, 1,
    (closure.is_submonoid _).one_mem, mul_one _⟩)
    (λ hd tl ih HL1, let ⟨y, hy, z, hz, hyzx⟩ := ih (list.forall_mem_of_forall_mem_cons HL1) in
      or.cases_on (HL1 hd $ list.mem_cons_self _ _)
        (λ hs, ⟨hd * y, (closure.is_submonoid _).mul_mem (subset_closure hs) hy, z, hz,
          by rw [mul_assoc, list.prod_cons, ← hyzx]; refl⟩)
        (λ ht, ⟨y, hy, z * hd, (closure.is_submonoid _).mul_mem hz (subset_closure ht),
          by rw [← mul_assoc, list.prod_cons, ← hyzx, mul_comm hd]; refl⟩)) HL1,
λ ⟨y, hy, z, hz, hyzx⟩, hyzx ▸ (closure.is_submonoid _).mul_mem
  (closure_mono (set.subset_union_left _ _) hy)
  (closure_mono (set.subset_union_right _ _) hz)⟩

end monoid

/-- Create a bundled submonoid from a set `s` and `[is_submonoid s]`. -/
@[to_additive "Create a bundled additive submonoid from a set `s` and `[is_add_submonoid s]`."]
def submonoid.of {s : set M} (h : is_submonoid s) : submonoid M := ⟨s, h.1, h.2⟩

@[to_additive]
lemma submonoid.is_submonoid (S : submonoid M) : is_submonoid (S : set M) := ⟨S.2, S.3⟩


/-
Copyright (c) 2018 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Reid Barton, Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.over
import Mathlib.category_theory.limits.shapes.pullbacks
import Mathlib.category_theory.limits.shapes.wide_pullbacks
import Mathlib.category_theory.limits.shapes.finite_products
import Mathlib.PostPort

universes v u

namespace Mathlib

/-!
# Products in the over category

Shows that products in the over category can be derived from wide pullbacks in the base category.
The main result is `over_product_of_wide_pullback`, which says that if `C` has `J`-indexed wide
pullbacks, then `over B` has `J`-indexed products.
-/

namespace category_theory.over

namespace construct_products

/--
(Implementation)
Given a product diagram in `C/B`, construct the corresponding wide pullback diagram
in `C`.
-/
def wide_pullback_diagram_of_diagram_over {C : Type u} [category C] (B : C) {J : Type v} (F : discrete J ⥤ over B) : limits.wide_pullback_shape J ⥤ C :=
  limits.wide_pullback_shape.wide_cospan B (fun (j : J) => comma.left (functor.obj F j))
    fun (j : J) => comma.hom (functor.obj F j)

/-- (Impl) A preliminary definition to avoid timeouts. -/
def cones_equiv_inverse_obj {C : Type u} [category C] (B : C) {J : Type v} (F : discrete J ⥤ over B) (c : limits.cone F) : limits.cone (wide_pullback_diagram_of_diagram_over B F) :=
  limits.cone.mk (comma.left (limits.cone.X c))
    (nat_trans.mk
      fun (X : limits.wide_pullback_shape J) =>
        option.cases_on X (comma.hom (limits.cone.X c))
          fun (j : J) => comma_morphism.left (nat_trans.app (limits.cone.π c) j))

/-- (Impl) A preliminary definition to avoid timeouts. -/
def cones_equiv_inverse {C : Type u} [category C] (B : C) {J : Type v} (F : discrete J ⥤ over B) : limits.cone F ⥤ limits.cone (wide_pullback_diagram_of_diagram_over B F) :=
  functor.mk (cones_equiv_inverse_obj B F)
    fun (c₁ c₂ : limits.cone F) (f : c₁ ⟶ c₂) =>
      limits.cone_morphism.mk (comma_morphism.left (limits.cone_morphism.hom f))

/-- (Impl) A preliminary definition to avoid timeouts. -/
@[simp] theorem cones_equiv_functor_map_hom {C : Type u} [category C] (B : C) {J : Type v} (F : discrete J ⥤ over B) (c₁ : limits.cone (wide_pullback_diagram_of_diagram_over B F)) (c₂ : limits.cone (wide_pullback_diagram_of_diagram_over B F)) (f : c₁ ⟶ c₂) : limits.cone_morphism.hom (functor.map (cones_equiv_functor B F) f) = hom_mk (limits.cone_morphism.hom f) :=
  Eq.refl (limits.cone_morphism.hom (functor.map (cones_equiv_functor B F) f))

/-- (Impl) A preliminary definition to avoid timeouts. -/
@[simp] def cones_equiv_unit_iso {J : Type v} {C : Type u} [category C] (B : C) (F : discrete J ⥤ over B) : 𝟭 ≅ cones_equiv_functor B F ⋙ cones_equiv_inverse B F :=
  nat_iso.of_components
    (fun (_x : limits.cone (wide_pullback_diagram_of_diagram_over B F)) => limits.cones.ext (iso.mk 𝟙 𝟙) sorry) sorry

/-- (Impl) A preliminary definition to avoid timeouts. -/
@[simp] def cones_equiv_counit_iso {J : Type v} {C : Type u} [category C] (B : C) (F : discrete J ⥤ over B) : cones_equiv_inverse B F ⋙ cones_equiv_functor B F ≅ 𝟭 :=
  nat_iso.of_components (fun (_x : limits.cone F) => limits.cones.ext (iso.mk (hom_mk 𝟙) (hom_mk 𝟙)) sorry) sorry

-- TODO: Can we add `. obviously` to the second arguments of `nat_iso.of_components` and

--       `cones.ext`?

/--
(Impl) Establish an equivalence between the category of cones for `F` and for the "grown" `F`.
-/
@[simp] theorem cones_equiv_unit_iso_2 {J : Type v} {C : Type u} [category C] (B : C) (F : discrete J ⥤ over B) : equivalence.unit_iso (cones_equiv B F) = cones_equiv_unit_iso B F :=
  Eq.refl (equivalence.unit_iso (cones_equiv B F))

/-- Use the above equivalence to prove we have a limit. -/
theorem has_over_limit_discrete_of_wide_pullback_limit {J : Type v} {C : Type u} [category C] {B : C} (F : discrete J ⥤ over B) [limits.has_limit (wide_pullback_diagram_of_diagram_over B F)] : limits.has_limit F := sorry

/-- Given a wide pullback in `C`, construct a product in `C/B`. -/
theorem over_product_of_wide_pullback {J : Type v} {C : Type u} [category C] [limits.has_limits_of_shape (limits.wide_pullback_shape J) C] {B : C} : limits.has_limits_of_shape (discrete J) (over B) :=
  limits.has_limits_of_shape.mk fun (F : discrete J ⥤ over B) => has_over_limit_discrete_of_wide_pullback_limit F

/-- Given a pullback in `C`, construct a binary product in `C/B`. -/
theorem over_binary_product_of_pullback {C : Type u} [category C] [limits.has_pullbacks C] {B : C} : limits.has_binary_products (over B) :=
  over_product_of_wide_pullback

/-- Given all wide pullbacks in `C`, construct products in `C/B`. -/
theorem over_products_of_wide_pullbacks {C : Type u} [category C] [limits.has_wide_pullbacks C] {B : C} : limits.has_products (over B) :=
  fun (J : Type v) => over_product_of_wide_pullback

/-- Given all finite wide pullbacks in `C`, construct finite products in `C/B`. -/
theorem over_finite_products_of_finite_wide_pullbacks {C : Type u} [category C] [limits.has_finite_wide_pullbacks C] {B : C} : limits.has_finite_products (over B) :=
  fun (J : Type v) (𝒥₁ : DecidableEq J) (𝒥₂ : fintype J) => over_product_of_wide_pullback

end construct_products

/--
Construct terminal object in the over category. This isn't an instance as it's not typically the
way we want to define terminal objects.
(For instance, this gives a terminal object which is different from the generic one given by
`over_product_of_wide_pullback` above.)
-/
theorem over_has_terminal {C : Type u} [category C] (B : C) : limits.has_terminal (over B) := sorry


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Andrew Yang
-/
import category_theory.limits.shapes.equalizers
import category_theory.limits.shapes.binary_products
import category_theory.limits.shapes.pullbacks
import category_theory.limits.preserves.shapes.pullbacks
import category_theory.limits.preserves.shapes.binary_products

/-!
# Constructing equalizers from pullbacks and binary products.

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

If a category has pullbacks and binary products, then it has equalizers.

TODO: generalize universe
-/

noncomputable theory

universes v v' u u'

open category_theory category_theory.category

namespace category_theory.limits

variables {C : Type u} [category.{v} C]
variables {D : Type u'} [category.{v'} D] (G : C ⥤ D)

-- We hide the "implementation details" inside a namespace
namespace has_equalizers_of_has_pullbacks_and_binary_products

variables [has_binary_products C] [has_pullbacks C]

/-- Define the equalizing object -/
@[reducible]
def construct_equalizer (F : walking_parallel_pair ⥤ C) : C :=
pullback (prod.lift (𝟙 _) (F.map walking_parallel_pair_hom.left))
         (prod.lift (𝟙 _) (F.map walking_parallel_pair_hom.right))

/-- Define the equalizing morphism -/
abbreviation pullback_fst (F : walking_parallel_pair ⥤ C) :
  construct_equalizer F ⟶ F.obj walking_parallel_pair.zero :=
pullback.fst

lemma pullback_fst_eq_pullback_snd (F : walking_parallel_pair ⥤ C) :
  pullback_fst F = pullback.snd :=
by convert pullback.condition =≫ limits.prod.fst; simp

/-- Define the equalizing cone -/
@[reducible]
def equalizer_cone (F : walking_parallel_pair ⥤ C) : cone F :=
cone.of_fork
  (fork.of_ι (pullback_fst F)
    (begin
      conv_rhs { rw pullback_fst_eq_pullback_snd, },
      convert pullback.condition =≫ limits.prod.snd using 1; simp
     end))

/-- Show the equalizing cone is a limit -/
def equalizer_cone_is_limit (F : walking_parallel_pair ⥤ C) : is_limit (equalizer_cone F) :=
{ lift :=
  begin
    intro c, apply pullback.lift (c.π.app _) (c.π.app _),
    apply limit.hom_ext,
    rintro (_ | _); simp
  end,
  fac' := by rintros c (_ | _); simp,
  uniq' :=
  begin
    intros c _ J,
    have J0 := J walking_parallel_pair.zero, simp at J0,
    apply pullback.hom_ext,
    { rwa limit.lift_π },
    { erw [limit.lift_π, ← J0, pullback_fst_eq_pullback_snd] }
  end }

end has_equalizers_of_has_pullbacks_and_binary_products

open has_equalizers_of_has_pullbacks_and_binary_products
/-- Any category with pullbacks and binary products, has equalizers. -/
-- This is not an instance, as it is not always how one wants to construct equalizers!
lemma has_equalizers_of_has_pullbacks_and_binary_products
  [has_binary_products C] [has_pullbacks C] :
  has_equalizers C :=
{ has_limit := λ F, has_limit.mk
  { cone := equalizer_cone F,
    is_limit := equalizer_cone_is_limit F } }

local attribute[instance] has_pullback_of_preserves_pullback

/-- A functor that preserves pullbacks and binary products also presrves equalizers. -/
def preserves_equalizers_of_preserves_pullbacks_and_binary_products
    [has_binary_products C] [has_pullbacks C]
    [preserves_limits_of_shape (discrete walking_pair) G]
    [preserves_limits_of_shape walking_cospan G] :
  preserves_limits_of_shape walking_parallel_pair G :=
⟨λ K, preserves_limit_of_preserves_limit_cone (equalizer_cone_is_limit K) $
{ lift := λ c, begin
    refine pullback.lift _ _ _ ≫ (@@preserves_pullback.iso _ _ _ _ _ _ _ _).inv,
    { exact c.π.app walking_parallel_pair.zero },
    { exact c.π.app walking_parallel_pair.zero },
    apply (map_is_limit_of_preserves_of_is_limit G _ _ (prod_is_prod _ _)).hom_ext,
    swap, apply_instance,
    rintro (_|_),
    { simp only [category.assoc, ← G.map_comp, prod.lift_fst,
        binary_fan.π_app_left, binary_fan.mk_fst], },
    { simp only [binary_fan.π_app_right, binary_fan.mk_snd,
        category.assoc, ← G.map_comp, prod.lift_snd],
      exact (c.π.naturality (walking_parallel_pair_hom.left)).symm.trans
        (c.π.naturality (walking_parallel_pair_hom.right)) },
  end,
  fac' := λ c j, begin
    rcases j with (_|_);
      simp only [category.comp_id, preserves_pullback.iso_inv_fst, cone.of_fork_π, G.map_comp,
        preserves_pullback.iso_inv_fst_assoc, functor.map_cone_π_app, eq_to_hom_refl,
        category.assoc, fork.of_ι_π_app, pullback.lift_fst, pullback.lift_fst_assoc],
      exact (c.π.naturality (walking_parallel_pair_hom.left)).symm.trans (category.id_comp _)
  end,
  uniq' := λ s m h, begin
    rw iso.eq_comp_inv,
    have := h walking_parallel_pair.zero,
    dsimp [equalizer_cone] at this,
    ext; simp only [preserves_pullback.iso_hom_snd,
      category.assoc, preserves_pullback.iso_hom_fst, pullback.lift_fst, pullback.lift_snd,
      category.comp_id, ← pullback_fst_eq_pullback_snd, ← this],
  end }⟩

-- We hide the "implementation details" inside a namespace
namespace has_coequalizers_of_has_pushouts_and_binary_coproducts

variables [has_binary_coproducts C] [has_pushouts C]

/-- Define the equalizing object -/
@[reducible]
def construct_coequalizer (F : walking_parallel_pair ⥤ C) : C :=
pushout (coprod.desc (𝟙 _) (F.map walking_parallel_pair_hom.left))
        (coprod.desc (𝟙 _) (F.map walking_parallel_pair_hom.right))

/-- Define the equalizing morphism -/
abbreviation pushout_inl (F : walking_parallel_pair ⥤ C) :
  F.obj walking_parallel_pair.one ⟶ construct_coequalizer F :=
pushout.inl

lemma pushout_inl_eq_pushout_inr (F : walking_parallel_pair ⥤ C) :
  pushout_inl F = pushout.inr :=
by convert limits.coprod.inl ≫= pushout.condition; simp

/-- Define the equalizing cocone -/
@[reducible]
def coequalizer_cocone (F : walking_parallel_pair ⥤ C) : cocone F :=
cocone.of_cofork
  (cofork.of_π (pushout_inl F)
    (begin
      conv_rhs { rw pushout_inl_eq_pushout_inr, },
      convert limits.coprod.inr ≫= pushout.condition using 1; simp
     end))

/-- Show the equalizing cocone is a colimit -/
def coequalizer_cocone_is_colimit (F : walking_parallel_pair ⥤ C) :
  is_colimit (coequalizer_cocone F) :=
{ desc :=
  begin
    intro c, apply pushout.desc (c.ι.app _) (c.ι.app _),
    apply colimit.hom_ext,
    rintro (_ | _); simp
  end,
  fac' := by rintros c (_ | _); simp,
  uniq' :=
  begin
    intros c _ J,
    have J1 : pushout_inl F ≫ m = c.ι.app walking_parallel_pair.one :=
      by simpa using J walking_parallel_pair.one,
    apply pushout.hom_ext,
    { rw colimit.ι_desc, exact J1 },
    { rw [colimit.ι_desc, ← pushout_inl_eq_pushout_inr], exact J1 }
  end }

end has_coequalizers_of_has_pushouts_and_binary_coproducts

open has_coequalizers_of_has_pushouts_and_binary_coproducts
/-- Any category with pullbacks and binary products, has equalizers. -/
-- This is not an instance, as it is not always how one wants to construct equalizers!
lemma has_coequalizers_of_has_pushouts_and_binary_coproducts
  [has_binary_coproducts C] [has_pushouts C] : has_coequalizers C :=
{ has_colimit := λ F, has_colimit.mk
  { cocone := coequalizer_cocone F,
    is_colimit := coequalizer_cocone_is_colimit F } }

local attribute[instance] has_pushout_of_preserves_pushout

/-- A functor that preserves pushouts and binary coproducts also presrves coequalizers. -/
def preserves_coequalizers_of_preserves_pushouts_and_binary_coproducts
    [has_binary_coproducts C] [has_pushouts C]
    [preserves_colimits_of_shape (discrete walking_pair) G]
    [preserves_colimits_of_shape walking_span G] :
  preserves_colimits_of_shape walking_parallel_pair G :=
⟨λ K, preserves_colimit_of_preserves_colimit_cocone (coequalizer_cocone_is_colimit K) $
{ desc := λ c, begin
    refine (@@preserves_pushout.iso _ _ _ _ _ _ _ _).inv ≫ pushout.desc _ _ _,
    { exact c.ι.app walking_parallel_pair.one },
    { exact c.ι.app walking_parallel_pair.one },
    apply (map_is_colimit_of_preserves_of_is_colimit G _ _ (coprod_is_coprod _ _)).hom_ext,
    swap, apply_instance,
    rintro (_|_),
    { simp only [binary_cofan.ι_app_left, binary_cofan.mk_inl, category.assoc, ← G.map_comp_assoc,
        coprod.inl_desc] },
    { simp only [binary_cofan.ι_app_right, binary_cofan.mk_inr, category.assoc, ← G.map_comp_assoc,
        coprod.inr_desc],
      exact (c.ι.naturality walking_parallel_pair_hom.left).trans
        (c.ι.naturality walking_parallel_pair_hom.right).symm, },
  end,
  fac' := λ c j, begin
    rcases j with (_|_); simp only [functor.map_cocone_ι_app, cocone.of_cofork_ι, category.id_comp,
      eq_to_hom_refl, category.assoc, functor.map_comp, cofork.of_π_ι_app, pushout.inl_desc,
      preserves_pushout.inl_iso_inv_assoc],
      exact (c.ι.naturality (walking_parallel_pair_hom.left)).trans (category.comp_id _)
  end,
  uniq' := λ s m h, begin
    rw iso.eq_inv_comp,
    have := h walking_parallel_pair.one,
    dsimp [coequalizer_cocone] at this,
    ext; simp only [preserves_pushout.inl_iso_hom_assoc, category.id_comp, pushout.inl_desc,
      pushout.inr_desc, preserves_pushout.inr_iso_hom_assoc,
      ← pushout_inl_eq_pushout_inr, ← this],
  end }⟩

end category_theory.limits


/-
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, Mitchell Rowett, Scott Morrison, Johan Commelin, Mario Carneiro,
  Michael Howes

! This file was ported from Lean 3 source module deprecated.subgroup
! leanprover-community/mathlib commit f93c11933efbc3c2f0299e47b8ff83e9b539cbf6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.GroupTheory.Subgroup.Basic
import Mathlib.Deprecated.Submonoid

/-!
# Unbundled subgroups (deprecated)

This file is deprecated, and is no longer imported by anything in mathlib other than other
deprecated files, and test files. You should not need to import it.

This file defines unbundled multiplicative and additive subgroups. Instead of using this file,
please use `Subgroup G` and `AddSubgroup A`, defined in `GroupTheory.Subgroup.Basic`.

## Main definitions

`IsAddSubgroup (S : Set A)` : the predicate that `S` is the underlying subset of an additive
subgroup of `A`. The bundled variant `AddSubgroup A` should be used in preference to this.

`IsSubgroup (S : Set G)` : the predicate that `S` is the underlying subset of a subgroup
of `G`. The bundled variant `Subgroup G` should be used in preference to this.

## Tags

subgroup, subgroups, IsSubgroup
-/

open Set Function

variable {G : Type _} {H : Type _} {A : Type _} {a a₁ a₂ b c : G}

section Group

variable [Group G] [AddGroup A]

/-- `s` is an additive subgroup: a set containing 0 and closed under addition and negation. -/
structure IsAddSubgroup (s : Set A) extends IsAddSubmonoid s : Prop where
  /-- The proposition that `s` is closed under negation. -/
  neg_mem {a} : a ∈ s → -a ∈ s
#align is_add_subgroup IsAddSubgroup

/-- `s` is a subgroup: a set containing 1 and closed under multiplication and inverse. -/
@[to_additive]
structure IsSubgroup (s : Set G) extends IsSubmonoid s : Prop where
  /-- The proposition that `s` is closed under inverse. -/
  inv_mem {a} : a ∈ s → a⁻¹ ∈ s
#align is_subgroup IsSubgroup

@[to_additive]
theorem IsSubgroup.div_mem {s : Set G} (hs : IsSubgroup s) {x y : G} (hx : x ∈ s) (hy : y ∈ s) :
    x / y ∈ s := by simpa only [div_eq_mul_inv] using hs.mul_mem hx (hs.inv_mem hy)
#align is_subgroup.div_mem IsSubgroup.div_mem
#align is_add_subgroup.sub_mem IsAddSubgroup.sub_mem

theorem Additive.isAddSubgroup {s : Set G} (hs : IsSubgroup s) : @IsAddSubgroup (Additive G) _ s :=
  @IsAddSubgroup.mk (Additive G) _ _ (Additive.isAddSubmonoid hs.toIsSubmonoid) hs.inv_mem
#align additive.is_add_subgroup Additive.isAddSubgroup

theorem Additive.isAddSubgroup_iff {s : Set G} : @IsAddSubgroup (Additive G) _ s ↔ IsSubgroup s :=
  ⟨by rintro ⟨⟨h₁, h₂⟩, h₃⟩; exact @IsSubgroup.mk G _ _ ⟨h₁, @h₂⟩ @h₃, fun h =>
    Additive.isAddSubgroup h⟩
#align additive.is_add_subgroup_iff Additive.isAddSubgroup_iff

theorem Multiplicative.isSubgroup {s : Set A} (hs : IsAddSubgroup s) :
    @IsSubgroup (Multiplicative A) _ s :=
  @IsSubgroup.mk (Multiplicative A) _ _ (Multiplicative.isSubmonoid hs.toIsAddSubmonoid) hs.neg_mem
#align multiplicative.is_subgroup Multiplicative.isSubgroup

theorem Multiplicative.isSubgroup_iff {s : Set A} :
    @IsSubgroup (Multiplicative A) _ s ↔ IsAddSubgroup s :=
  ⟨by rintro ⟨⟨h₁, h₂⟩, h₃⟩; exact @IsAddSubgroup.mk A _ _ ⟨h₁, @h₂⟩ @h₃, fun h =>
    Multiplicative.isSubgroup h⟩
#align multiplicative.is_subgroup_iff Multiplicative.isSubgroup_iff

@[to_additive of_add_neg]
theorem IsSubgroup.of_div (s : Set G) (one_mem : (1 : G) ∈ s)
    (div_mem : ∀ {a b : G}, a ∈ s → b ∈ s → a * b⁻¹ ∈ s) : IsSubgroup s :=
  have inv_mem : ∀ a, a ∈ s → a⁻¹ ∈ s := fun a ha => by
    have : 1 * a⁻¹ ∈ s := div_mem one_mem ha
    convert this using 1
    rw [one_mul]
  { inv_mem := inv_mem _
    mul_mem := fun {a b} ha hb => by
      have : a * b⁻¹⁻¹ ∈ s := div_mem ha (inv_mem b hb)
      convert this
      rw [inv_inv]
    one_mem }
#align is_subgroup.of_div IsSubgroup.of_div
#align is_add_subgroup.of_add_neg IsAddSubgroup.of_add_neg

theorem IsAddSubgroup.of_sub (s : Set A) (zero_mem : (0 : A) ∈ s)
    (sub_mem : ∀ {a b : A}, a ∈ s → b ∈ s → a - b ∈ s) : IsAddSubgroup s :=
  IsAddSubgroup.of_add_neg s zero_mem fun {x y} hx hy => by
    simpa only [sub_eq_add_neg] using sub_mem hx hy
#align is_add_subgroup.of_sub IsAddSubgroup.of_sub

@[to_additive]
theorem IsSubgroup.inter {s₁ s₂ : Set G} (hs₁ : IsSubgroup s₁) (hs₂ : IsSubgroup s₂) :
    IsSubgroup (s₁ ∩ s₂) :=
  { IsSubmonoid.inter hs₁.toIsSubmonoid hs₂.toIsSubmonoid with
    inv_mem := fun hx => ⟨hs₁.inv_mem hx.1, hs₂.inv_mem hx.2⟩ }
#align is_subgroup.inter IsSubgroup.inter
#align is_add_subgroup.inter IsAddSubgroup.inter

@[to_additive]
theorem IsSubgroup.interᵢ {ι : Sort _} {s : ι → Set G} (hs : ∀ y : ι, IsSubgroup (s y)) :
    IsSubgroup (Set.interᵢ s) :=
  { IsSubmonoid.interᵢ fun y => (hs y).toIsSubmonoid with
    inv_mem := fun h =>
      Set.mem_interᵢ.2 fun y => IsSubgroup.inv_mem (hs _) (Set.mem_interᵢ.1 h y) }
#align is_subgroup.Inter IsSubgroup.interᵢ
#align is_add_subgroup.Inter IsAddSubgroup.interᵢ

@[to_additive]
theorem isSubgroup_unionᵢ_of_directed {ι : Type _} [Nonempty ι] {s : ι → Set G}
    (hs : ∀ i, IsSubgroup (s i)) (directed : ∀ i j, ∃ k, s i ⊆ s k ∧ s j ⊆ s k) :
    IsSubgroup (⋃ i, s i) :=
  { inv_mem := fun ha =>
      let ⟨i, hi⟩ := Set.mem_unionᵢ.1 ha
      Set.mem_unionᵢ.2 ⟨i, (hs i).inv_mem hi⟩
    toIsSubmonoid := isSubmonoid_unionᵢ_of_directed (fun i => (hs i).toIsSubmonoid) directed }
#align is_subgroup_Union_of_directed isSubgroup_unionᵢ_of_directed
#align is_add_subgroup_Union_of_directed isAddSubgroup_unionᵢ_of_directed

end Group

namespace IsSubgroup

open IsSubmonoid

variable [Group G] {s : Set G} (hs : IsSubgroup s)

@[to_additive]
theorem inv_mem_iff : a⁻¹ ∈ s ↔ a ∈ s :=
  ⟨fun h => by simpa using hs.inv_mem h, inv_mem hs⟩
#align is_subgroup.inv_mem_iff IsSubgroup.inv_mem_iff
#align is_add_subgroup.neg_mem_iff IsAddSubgroup.neg_mem_iff

@[to_additive]
theorem mul_mem_cancel_right (h : a ∈ s) : b * a ∈ s ↔ b ∈ s :=
  ⟨fun hba => by simpa using hs.mul_mem hba (hs.inv_mem h), fun hb => hs.mul_mem hb h⟩
#align is_subgroup.mul_mem_cancel_right IsSubgroup.mul_mem_cancel_right
#align is_add_subgroup.add_mem_cancel_right IsAddSubgroup.add_mem_cancel_right

@[to_additive]
theorem mul_mem_cancel_left (h : a ∈ s) : a * b ∈ s ↔ b ∈ s :=
  ⟨fun hab => by simpa using hs.mul_mem (hs.inv_mem h) hab, hs.mul_mem h⟩
#align is_subgroup.mul_mem_cancel_left IsSubgroup.mul_mem_cancel_left
#align is_add_subgroup.add_mem_cancel_left IsAddSubgroup.add_mem_cancel_left

end IsSubgroup

/-- `IsNormalAddSubgroup (s : Set A)` expresses the fact that `s` is a normal additive subgroup
of the additive group `A`. Important: the preferred way to say this in Lean is via bundled
subgroups `S : AddSubgroup A` and `hs : S.normal`, and not via this structure. -/
structure IsNormalAddSubgroup [AddGroup A] (s : Set A) extends IsAddSubgroup s : Prop where
  /-- The proposition that `s` is closed under (additive) conjugation. -/
  normal : ∀ n ∈ s, ∀ g : A, g + n + -g ∈ s
#align is_normal_add_subgroup IsNormalAddSubgroup

/-- `IsNormalSubgroup (s : Set G)` expresses the fact that `s` is a normal subgroup
of the group `G`. Important: the preferred way to say this in Lean is via bundled
subgroups `S : Subgroup G` and not via this structure. -/
@[to_additive]
structure IsNormalSubgroup [Group G] (s : Set G) extends IsSubgroup s : Prop where
  /-- The proposition that `s` is closed under conjugation. -/
  normal : ∀ n ∈ s, ∀ g : G, g * n * g⁻¹ ∈ s
#align is_normal_subgroup IsNormalSubgroup

@[to_additive]
theorem isNormalSubgroup_of_commGroup [CommGroup G] {s : Set G} (hs : IsSubgroup s) :
    IsNormalSubgroup s :=
  { hs with normal := fun n hn g => by rwa [mul_right_comm, mul_right_inv, one_mul] }
#align is_normal_subgroup_of_comm_group isNormalSubgroup_of_commGroup
#align is_normal_add_subgroup_of_add_comm_group isNormalAddSubgroup_of_addCommGroup

theorem Additive.isNormalAddSubgroup [Group G] {s : Set G} (hs : IsNormalSubgroup s) :
    @IsNormalAddSubgroup (Additive G) _ s :=
  @IsNormalAddSubgroup.mk (Additive G) _ _ (Additive.isAddSubgroup hs.toIsSubgroup)
    (@IsNormalSubgroup.normal _ ‹Group (Additive G)› _ hs)
    -- porting note: Lean needs help synthesising
#align additive.is_normal_add_subgroup Additive.isNormalAddSubgroup

theorem Additive.isNormalAddSubgroup_iff [Group G] {s : Set G} :
    @IsNormalAddSubgroup (Additive G) _ s ↔ IsNormalSubgroup s :=
  ⟨by rintro ⟨h₁, h₂⟩; exact @IsNormalSubgroup.mk G _ _ (Additive.isAddSubgroup_iff.1 h₁) @h₂,
    fun h => Additive.isNormalAddSubgroup h⟩
#align additive.is_normal_add_subgroup_iff Additive.isNormalAddSubgroup_iff

theorem Multiplicative.isNormalSubgroup [AddGroup A] {s : Set A} (hs : IsNormalAddSubgroup s) :
    @IsNormalSubgroup (Multiplicative A) _ s :=
  @IsNormalSubgroup.mk (Multiplicative A) _ _ (Multiplicative.isSubgroup hs.toIsAddSubgroup)
    (@IsNormalAddSubgroup.normal _ ‹AddGroup (Multiplicative A)› _ hs)
#align multiplicative.is_normal_subgroup Multiplicative.isNormalSubgroup

theorem Multiplicative.isNormalSubgroup_iff [AddGroup A] {s : Set A} :
    @IsNormalSubgroup (Multiplicative A) _ s ↔ IsNormalAddSubgroup s :=
  ⟨by
    rintro ⟨h₁, h₂⟩;
      exact @IsNormalAddSubgroup.mk A _ _ (Multiplicative.isSubgroup_iff.1 h₁) @h₂,
    fun h => Multiplicative.isNormalSubgroup h⟩
#align multiplicative.is_normal_subgroup_iff Multiplicative.isNormalSubgroup_iff

namespace IsSubgroup

variable [Group G]

-- Normal subgroup properties
@[to_additive]
theorem mem_norm_comm {s : Set G} (hs : IsNormalSubgroup s) {a b : G} (hab : a * b ∈ s) :
    b * a ∈ s := by
  have h : a⁻¹ * (a * b) * a⁻¹⁻¹ ∈ s := hs.normal (a * b) hab a⁻¹
  simp at h; exact h
#align is_subgroup.mem_norm_comm IsSubgroup.mem_norm_comm
#align is_add_subgroup.mem_norm_comm IsAddSubgroup.mem_norm_comm

@[to_additive]
theorem mem_norm_comm_iff {s : Set G} (hs : IsNormalSubgroup s) {a b : G} : a * b ∈ s ↔ b * a ∈ s :=
  ⟨mem_norm_comm hs, mem_norm_comm hs⟩
#align is_subgroup.mem_norm_comm_iff IsSubgroup.mem_norm_comm_iff
#align is_add_subgroup.mem_norm_comm_iff IsAddSubgroup.mem_norm_comm_iff

/-- The trivial subgroup -/
@[to_additive "the trivial additive subgroup"]
def trivial (G : Type _) [Group G] : Set G :=
  {1}
#align is_subgroup.trivial IsSubgroup.trivial
#align is_add_subgroup.trivial IsAddSubgroup.trivial

@[to_additive (attr := simp)]
theorem mem_trivial {g : G} : g ∈ trivial G ↔ g = 1 :=
  mem_singleton_iff
#align is_subgroup.mem_trivial IsSubgroup.mem_trivial
#align is_add_subgroup.mem_trivial IsAddSubgroup.mem_trivial

@[to_additive]
theorem trivial_normal : IsNormalSubgroup (trivial G) := by
  refine' { .. } <;> simp (config := { contextual := true }) [trivial]
#align is_subgroup.trivial_normal IsSubgroup.trivial_normal
#align is_add_subgroup.trivial_normal IsAddSubgroup.trivial_normal

@[to_additive]
theorem eq_trivial_iff {s : Set G} (hs : IsSubgroup s) : s = trivial G ↔ ∀ x ∈ s, x = (1 : G) := by
  simp only [Set.ext_iff, IsSubgroup.mem_trivial];
    exact ⟨fun h x => (h x).1, fun h x => ⟨h x, fun hx => hx.symm ▸ hs.toIsSubmonoid.one_mem⟩⟩
#align is_subgroup.eq_trivial_iff IsSubgroup.eq_trivial_iff
#align is_add_subgroup.eq_trivial_iff IsAddSubgroup.eq_trivial_iff

@[to_additive]
theorem univ_subgroup : IsNormalSubgroup (@univ G) := by refine' { .. } <;> simp
#align is_subgroup.univ_subgroup IsSubgroup.univ_subgroup
#align is_add_subgroup.univ_add_subgroup IsAddSubgroup.univ_addSubgroup

/-- The underlying set of the center of a group. -/
@[to_additive addCenter "The underlying set of the center of an additive group."]
def center (G : Type _) [Group G] : Set G :=
  { z | ∀ g, g * z = z * g }
#align is_subgroup.center IsSubgroup.center
#align is_add_subgroup.add_center IsAddSubgroup.addCenter

@[to_additive mem_add_center]
theorem mem_center {a : G} : a ∈ center G ↔ ∀ g, g * a = a * g :=
  Iff.rfl
#align is_subgroup.mem_center IsSubgroup.mem_center
#align is_add_subgroup.mem_add_center IsAddSubgroup.mem_add_center

@[to_additive add_center_normal]
theorem center_normal : IsNormalSubgroup (center G) :=
  { one_mem := by simp [center]
    mul_mem := fun ha hb g => by
      rw [← mul_assoc, mem_center.2 ha g, mul_assoc, mem_center.2 hb g, ← mul_assoc]
    inv_mem := fun {a} ha g =>
      calc
        g * a⁻¹ = a⁻¹ * (g * a) * a⁻¹ := by simp [ha g]
        _ = a⁻¹ * g := by rw [← mul_assoc, mul_assoc]; simp
    normal := fun n ha g h =>
      calc
        h * (g * n * g⁻¹) = h * n := by simp [ha g, mul_assoc]
        _ = g * g⁻¹ * n * h := by rw [ha h]; simp
        _ = g * n * g⁻¹ * h := by rw [mul_assoc g, ha g⁻¹, ← mul_assoc]
         }
#align is_subgroup.center_normal IsSubgroup.center_normal
#align is_add_subgroup.add_center_normal IsAddSubgroup.add_center_normal

/-- The underlying set of the normalizer of a subset `S : Set G` of a group `G`. That is,
  the elements `g : G` such that `g * S * g⁻¹ = S`. -/
@[to_additive addNormalizer
      "The underlying set of the normalizer of a subset `S : Set A` of an
      additive group `A`. That is, the elements `a : A` such that `a + S - a = S`."]
def normalizer (s : Set G) : Set G :=
  { g : G | ∀ n, n ∈ s ↔ g * n * g⁻¹ ∈ s }
#align is_subgroup.normalizer IsSubgroup.normalizer
#align is_add_subgroup.add_normalizer IsAddSubgroup.addNormalizer

@[to_additive]
theorem normalizer_isSubgroup (s : Set G) : IsSubgroup (normalizer s) :=
  { one_mem := by simp [normalizer]
    mul_mem := fun {a b}
      (ha : ∀ n, n ∈ s ↔ a * n * a⁻¹ ∈ s) (hb : ∀ n, n ∈ s ↔ b * n * b⁻¹ ∈ s) n =>
      by rw [mul_inv_rev, ← mul_assoc, mul_assoc a, mul_assoc a, ← ha, ← hb]
    inv_mem := fun {a} (ha : ∀ n, n ∈ s ↔ a * n * a⁻¹ ∈ s) n => by
      rw [ha (a⁻¹ * n * a⁻¹⁻¹)]; simp [mul_assoc] }
#align is_subgroup.normalizer_is_subgroup IsSubgroup.normalizer_isSubgroup
#align is_add_subgroup.normalizer_is_add_subgroup IsAddSubgroup.normalizer_isAddSubgroup

@[to_additive subset_add_normalizer]
theorem subset_normalizer {s : Set G} (hs : IsSubgroup s) : s ⊆ normalizer s := fun g hg n => by
  rw [IsSubgroup.mul_mem_cancel_right hs ((IsSubgroup.inv_mem_iff hs).2 hg),
    IsSubgroup.mul_mem_cancel_left hs hg]
#align is_subgroup.subset_normalizer IsSubgroup.subset_normalizer
#align is_add_subgroup.subset_add_normalizer IsAddSubgroup.subset_add_normalizer

end IsSubgroup

-- Homomorphism subgroups
namespace IsGroupHom

open IsSubmonoid IsSubgroup

/-- `ker f : set G` is the underlying subset of the kernel of a map `G → H`. -/
@[to_additive "`ker f : set A` is the underlying subset of the kernel of a map `A → B`"]
def ker [Group H] (f : G → H) : Set G :=
  preimage f (trivial H)
#align is_group_hom.ker IsGroupHom.ker
#align is_add_group_hom.ker IsAddGroupHom.ker

@[to_additive]
theorem mem_ker [Group H] (f : G → H) {x : G} : x ∈ ker f ↔ f x = 1 :=
  mem_trivial
#align is_group_hom.mem_ker IsGroupHom.mem_ker
#align is_add_group_hom.mem_ker IsAddGroupHom.mem_ker

variable [Group G] [Group H]

@[to_additive]
theorem one_ker_inv {f : G → H} (hf : IsGroupHom f) {a b : G} (h : f (a * b⁻¹) = 1) : f a = f b :=
  by
  rw [hf.map_mul, hf.map_inv] at h
  rw [← inv_inv (f b), eq_inv_of_mul_eq_one_left h]
#align is_group_hom.one_ker_inv IsGroupHom.one_ker_inv
#align is_add_group_hom.zero_ker_neg IsAddGroupHom.zero_ker_neg

@[to_additive]
theorem one_ker_inv' {f : G → H} (hf : IsGroupHom f) {a b : G} (h : f (a⁻¹ * b) = 1) : f a = f b :=
  by
  rw [hf.map_mul, hf.map_inv] at h
  apply inv_injective
  rw [eq_inv_of_mul_eq_one_left h]
#align is_group_hom.one_ker_inv' IsGroupHom.one_ker_inv'
#align is_add_group_hom.zero_ker_neg' IsAddGroupHom.zero_ker_neg'

@[to_additive]
theorem inv_ker_one {f : G → H} (hf : IsGroupHom f) {a b : G} (h : f a = f b) : f (a * b⁻¹) = 1 :=
  by
  have : f a * (f b)⁻¹ = 1 := by rw [h, mul_right_inv]
  rwa [← hf.map_inv, ← hf.map_mul] at this
#align is_group_hom.inv_ker_one IsGroupHom.inv_ker_one
#align is_add_group_hom.neg_ker_zero IsAddGroupHom.neg_ker_zero

@[to_additive]
theorem inv_ker_one' {f : G → H} (hf : IsGroupHom f) {a b : G} (h : f a = f b) : f (a⁻¹ * b) = 1 :=
  by
  have : (f a)⁻¹ * f b = 1 := by rw [h, mul_left_inv]
  rwa [← hf.map_inv, ← hf.map_mul] at this
#align is_group_hom.inv_ker_one' IsGroupHom.inv_ker_one'
#align is_add_group_hom.neg_ker_zero' IsAddGroupHom.neg_ker_zero'

@[to_additive]
theorem one_iff_ker_inv {f : G → H} (hf : IsGroupHom f) (a b : G) : f a = f b ↔ f (a * b⁻¹) = 1 :=
  ⟨hf.inv_ker_one, hf.one_ker_inv⟩
#align is_group_hom.one_iff_ker_inv IsGroupHom.one_iff_ker_inv
#align is_add_group_hom.zero_iff_ker_neg IsAddGroupHom.zero_iff_ker_neg

@[to_additive]
theorem one_iff_ker_inv' {f : G → H} (hf : IsGroupHom f) (a b : G) : f a = f b ↔ f (a⁻¹ * b) = 1 :=
  ⟨hf.inv_ker_one', hf.one_ker_inv'⟩
#align is_group_hom.one_iff_ker_inv' IsGroupHom.one_iff_ker_inv'
#align is_add_group_hom.zero_iff_ker_neg' IsAddGroupHom.zero_iff_ker_neg'

@[to_additive]
theorem inv_iff_ker {f : G → H} (hf : IsGroupHom f) (a b : G) : f a = f b ↔ a * b⁻¹ ∈ ker f := by
  rw [mem_ker]; exact one_iff_ker_inv hf _ _
#align is_group_hom.inv_iff_ker IsGroupHom.inv_iff_ker
#align is_add_group_hom.neg_iff_ker IsAddGroupHom.neg_iff_ker

@[to_additive]
theorem inv_iff_ker' {f : G → H} (hf : IsGroupHom f) (a b : G) : f a = f b ↔ a⁻¹ * b ∈ ker f := by
  rw [mem_ker]; exact one_iff_ker_inv' hf _ _
#align is_group_hom.inv_iff_ker' IsGroupHom.inv_iff_ker'
#align is_add_group_hom.neg_iff_ker' IsAddGroupHom.neg_iff_ker'

@[to_additive]
theorem image_subgroup {f : G → H} (hf : IsGroupHom f) {s : Set G} (hs : IsSubgroup s) :
    IsSubgroup (f '' s) :=
  { mul_mem := fun {a₁ a₂} ⟨b₁, hb₁, eq₁⟩ ⟨b₂, hb₂, eq₂⟩ =>
      ⟨b₁ * b₂, hs.mul_mem hb₁ hb₂, by simp [eq₁, eq₂, hf.map_mul]⟩
    one_mem := ⟨1, hs.toIsSubmonoid.one_mem, hf.map_one⟩
    inv_mem := fun {a} ⟨b, hb, Eq⟩ =>
      ⟨b⁻¹, hs.inv_mem hb, by
        rw [hf.map_inv]
        simp [*]⟩ }
#align is_group_hom.image_subgroup IsGroupHom.image_subgroup
#align is_add_group_hom.image_add_subgroup IsAddGroupHom.image_addSubgroup

@[to_additive]
theorem range_subgroup {f : G → H} (hf : IsGroupHom f) : IsSubgroup (Set.range f) :=
  @Set.image_univ _ _ f ▸ hf.image_subgroup univ_subgroup.toIsSubgroup
#align is_group_hom.range_subgroup IsGroupHom.range_subgroup
#align is_add_group_hom.range_add_subgroup IsAddGroupHom.range_addSubgroup

attribute [local simp] IsSubmonoid.one_mem IsSubgroup.inv_mem
  IsSubmonoid.mul_mem IsNormalSubgroup.normal

@[to_additive]
theorem preimage {f : G → H} (hf : IsGroupHom f) {s : Set H} (hs : IsSubgroup s) :
    IsSubgroup (f ⁻¹' s) := by
  refine' { .. } <;>
    simp (config := { contextual := true }) [hs.one_mem, hs.mul_mem, hs.inv_mem, hf.map_mul,
      hf.map_one, hf.map_inv, InvMemClass.inv_mem]
#align is_group_hom.preimage IsGroupHom.preimage
#align is_add_group_hom.preimage IsAddGroupHom.preimage

@[to_additive]
theorem preimage_normal {f : G → H} (hf : IsGroupHom f) {s : Set H} (hs : IsNormalSubgroup s) :
    IsNormalSubgroup (f ⁻¹' s) :=
  { one_mem := by simp [hf.map_one, hs.toIsSubgroup.one_mem]
    mul_mem := by simp (config := { contextual := true }) [hf.map_mul, hs.toIsSubgroup.mul_mem]
    inv_mem := by simp (config := { contextual := true }) [hf.map_inv, hs.toIsSubgroup.inv_mem]
    normal := by simp (config := { contextual := true }) [hs.normal, hf.map_mul, hf.map_inv] }
#align is_group_hom.preimage_normal IsGroupHom.preimage_normal
#align is_add_group_hom.preimage_normal IsAddGroupHom.preimage_normal

@[to_additive]
theorem isNormalSubgroup_ker {f : G → H} (hf : IsGroupHom f) : IsNormalSubgroup (ker f) :=
  hf.preimage_normal trivial_normal
#align is_group_hom.is_normal_subgroup_ker IsGroupHom.isNormalSubgroup_ker
#align is_add_group_hom.is_normal_add_subgroup_ker IsAddGroupHom.isNormalAddSubgroup_ker

@[to_additive]
theorem injective_of_trivial_ker {f : G → H} (hf : IsGroupHom f) (h : ker f = trivial G) :
    Function.Injective f := by
  intro a₁ a₂ hfa
  simp [ext_iff, ker, IsSubgroup.trivial] at h
  have ha : a₁ * a₂⁻¹ = 1 := by rw [← h]; exact hf.inv_ker_one hfa
  rw [eq_inv_of_mul_eq_one_left ha, inv_inv a₂]
#align is_group_hom.injective_of_trivial_ker IsGroupHom.injective_of_trivial_ker
#align is_add_group_hom.injective_of_trivial_ker IsAddGroupHom.injective_of_trivial_ker

@[to_additive]
theorem trivial_ker_of_injective {f : G → H} (hf : IsGroupHom f) (h : Function.Injective f) :
    ker f = trivial G :=
  Set.ext fun x =>
    Iff.intro
      (fun hx => by
        suffices f x = f 1 by simpa using h this
        simp [hf.map_one]; rwa [mem_ker] at hx)
      (by simp (config := { contextual := true }) [mem_ker, hf.map_one])
#align is_group_hom.trivial_ker_of_injective IsGroupHom.trivial_ker_of_injective
#align is_add_group_hom.trivial_ker_of_injective IsAddGroupHom.trivial_ker_of_injective

@[to_additive]
theorem injective_iff_trivial_ker {f : G → H} (hf : IsGroupHom f) :
    Function.Injective f ↔ ker f = trivial G :=
  ⟨hf.trivial_ker_of_injective, hf.injective_of_trivial_ker⟩
#align is_group_hom.injective_iff_trivial_ker IsGroupHom.injective_iff_trivial_ker
#align is_add_group_hom.injective_iff_trivial_ker IsAddGroupHom.injective_iff_trivial_ker

@[to_additive]
theorem trivial_ker_iff_eq_one {f : G → H} (hf : IsGroupHom f) :
    ker f = trivial G ↔ ∀ x, f x = 1 → x = 1 := by
  rw [Set.ext_iff]; simp [ker];
    exact ⟨fun h x hx => (h x).1 hx, fun h x => ⟨h x, fun hx => by rw [hx, hf.map_one]⟩⟩
#align is_group_hom.trivial_ker_iff_eq_one IsGroupHom.trivial_ker_iff_eq_one
#align is_add_group_hom.trivial_ker_iff_eq_zero IsAddGroupHom.trivial_ker_iff_eq_zero

end IsGroupHom

namespace AddGroup

variable [AddGroup A]

/-- If `A` is an additive group and `s : Set A`, then `InClosure s : Set A` is the underlying
subset of the subgroup generated by `s`. -/
inductive InClosure (s : Set A) : A → Prop
  | basic {a : A} : a ∈ s → InClosure s a
  | zero : InClosure s 0
  | neg {a : A} : InClosure s a → InClosure s (-a)
  | add {a b : A} : InClosure s a → InClosure s b → InClosure s (a + b)
#align add_group.in_closure AddGroup.InClosure

end AddGroup

namespace Group

open IsSubmonoid IsSubgroup

variable [Group G] {s : Set G}

/-- If `G` is a group and `s : Set G`, then `InClosure s : Set G` is the underlying
subset of the subgroup generated by `s`. -/
@[to_additive]
inductive InClosure (s : Set G) : G → Prop
  | basic {a : G} : a ∈ s → InClosure s a
  | one : InClosure s 1
  | inv {a : G} : InClosure s a → InClosure s a⁻¹
  | mul {a b : G} : InClosure s a → InClosure s b → InClosure s (a * b)
#align group.in_closure Group.InClosure

/-- `Group.closure s` is the subgroup generated by `s`, i.e. the smallest subgroup containg `s`. -/
@[to_additive
  "`AddGroup.closure s` is the additive subgroup generated by `s`, i.e., the
  smallest additive subgroup containing `s`."]
def closure (s : Set G) : Set G :=
  { a | InClosure s a }
#align group.closure Group.closure
#align add_group.closure AddGroup.closure

@[to_additive]
theorem mem_closure {a : G} : a ∈ s → a ∈ closure s :=
  InClosure.basic
#align group.mem_closure Group.mem_closure
#align add_group.mem_closure AddGroup.mem_closure

@[to_additive]
theorem closure.isSubgroup (s : Set G) : IsSubgroup (closure s) :=
  { one_mem := InClosure.one
    mul_mem := InClosure.mul
    inv_mem := InClosure.inv }
#align group.closure.is_subgroup Group.closure.isSubgroup
#align add_group.closure.is_add_subgroup AddGroup.closure.isAddSubgroup

@[to_additive]
theorem subset_closure {s : Set G} : s ⊆ closure s := fun _ => mem_closure
#align group.subset_closure Group.subset_closure
#align add_group.subset_closure AddGroup.subset_closure

@[to_additive]
theorem closure_subset {s t : Set G} (ht : IsSubgroup t) (h : s ⊆ t) : closure s ⊆ t := fun a ha =>
  by induction ha <;> simp [h _, *, ht.one_mem, ht.mul_mem, IsSubgroup.inv_mem_iff]
#align group.closure_subset Group.closure_subset
#align add_group.closure_subset AddGroup.closure_subset

@[to_additive]
theorem closure_subset_iff {s t : Set G} (ht : IsSubgroup t) : closure s ⊆ t ↔ s ⊆ t :=
  ⟨fun h _ ha => h (mem_closure ha), fun h _ ha => closure_subset ht h ha⟩
#align group.closure_subset_iff Group.closure_subset_iff
#align add_group.closure_subset_iff AddGroup.closure_subset_iff

@[to_additive]
theorem closure_mono {s t : Set G} (h : s ⊆ t) : closure s ⊆ closure t :=
  closure_subset (closure.isSubgroup _) <| Set.Subset.trans h subset_closure
#align group.closure_mono Group.closure_mono
#align add_group.closure_mono AddGroup.closure_mono

@[to_additive (attr := simp)]
theorem closure_subgroup {s : Set G} (hs : IsSubgroup s) : closure s = s :=
  Set.Subset.antisymm (closure_subset hs <| Set.Subset.refl s) subset_closure
#align group.closure_subgroup Group.closure_subgroup
#align add_group.closure_add_subgroup AddGroup.closure_addSubgroup

@[to_additive]
theorem exists_list_of_mem_closure {s : Set G} {a : G} (h : a ∈ closure s) :
    ∃ l : List G, (∀ x ∈ l, x ∈ s ∨ x⁻¹ ∈ s) ∧ l.prod = a :=
  InClosure.recOn h (fun {x} hxs => ⟨[x], List.forall_mem_singleton.2 <| Or.inl hxs, one_mul _⟩)
    ⟨[], List.forall_mem_nil _, rfl⟩
    (fun {x} _ ⟨L, HL1, HL2⟩ =>
      ⟨L.reverse.map Inv.inv, fun x hx =>
        let ⟨y, hy1, hy2⟩ := List.exists_of_mem_map hx
        hy2 ▸ Or.imp id (by rw [inv_inv]; exact id) (HL1 _ <| List.mem_reverse'.1 hy1).symm,
        HL2 ▸
          List.recOn L inv_one.symm fun hd tl ih => by
            rw [List.reverse_cons, List.map_append, List.prod_append, ih, List.map_singleton,
              List.prod_cons, List.prod_nil, mul_one, List.prod_cons, mul_inv_rev]⟩)
    fun {x y} _ _ ⟨L1, HL1, HL2⟩ ⟨L2, HL3, HL4⟩ =>
    ⟨L1 ++ L2, List.forall_mem_append.2 ⟨HL1, HL3⟩, by rw [List.prod_append, HL2, HL4]⟩
#align group.exists_list_of_mem_closure Group.exists_list_of_mem_closure
#align add_group.exists_list_of_mem_closure AddGroup.exists_list_of_mem_closure

@[to_additive]
theorem image_closure [Group H] {f : G → H} (hf : IsGroupHom f) (s : Set G) :
    f '' closure s = closure (f '' s) :=
  le_antisymm
    (by
      rintro _ ⟨x, hx, rfl⟩
      exact InClosure.recOn hx
        (by intros _ ha; exact subset_closure (mem_image_of_mem f ha))
        (by
          rw [hf.map_one]
          apply IsSubmonoid.one_mem (closure.isSubgroup _).toIsSubmonoid)
        (by
          intros _ _
          rw [hf.map_inv]
          apply IsSubgroup.inv_mem (closure.isSubgroup _))
        (by
          intros _ _ _ _ ha hb
          rw [hf.map_mul]
          exact (closure.isSubgroup (f '' s)).toIsSubmonoid.mul_mem ha hb))
    (closure_subset (hf.image_subgroup <| closure.isSubgroup _) <|
      Set.image_subset _ subset_closure)
#align group.image_closure Group.image_closure
#align add_group.image_closure AddGroup.image_closure

@[to_additive]
theorem mclosure_subset {s : Set G} : Monoid.Closure s ⊆ closure s :=
  Monoid.closure_subset (closure.isSubgroup _).toIsSubmonoid <| subset_closure
#align group.mclosure_subset Group.mclosure_subset
#align add_group.mclosure_subset AddGroup.mclosure_subset

@[to_additive]
theorem mclosure_inv_subset {s : Set G} : Monoid.Closure (Inv.inv ⁻¹' s) ⊆ closure s :=
  Monoid.closure_subset (closure.isSubgroup _).toIsSubmonoid fun x hx =>
    inv_inv x ▸ ((closure.isSubgroup _).inv_mem <| subset_closure hx)
#align group.mclosure_inv_subset Group.mclosure_inv_subset
#align add_group.mclosure_neg_subset AddGroup.mclosure_neg_subset

@[to_additive]
theorem closure_eq_mclosure {s : Set G} : closure s = Monoid.Closure (s ∪ Inv.inv ⁻¹' s) :=
  Set.Subset.antisymm
    (@closure_subset _ _ _ (Monoid.Closure (s ∪ Inv.inv ⁻¹' s))
      { one_mem := (Monoid.closure.isSubmonoid _).one_mem
        mul_mem := (Monoid.closure.isSubmonoid _).mul_mem
        inv_mem := fun hx =>
          Monoid.InClosure.recOn hx
            (fun {x} hx =>
              Or.casesOn hx
                (fun hx =>
                  Monoid.subset_closure <| Or.inr <| show x⁻¹⁻¹ ∈ s from (inv_inv x).symm ▸ hx)
                fun hx => Monoid.subset_closure <| Or.inl hx)
            ((@inv_one G _).symm ▸ IsSubmonoid.one_mem (Monoid.closure.isSubmonoid _))
            fun {x y} _ _ ihx ihy =>
            (mul_inv_rev x y).symm ▸ IsSubmonoid.mul_mem (Monoid.closure.isSubmonoid _) ihy ihx }
      (Set.Subset.trans (Set.subset_union_left _ _) Monoid.subset_closure))
    (Monoid.closure_subset (closure.isSubgroup _).toIsSubmonoid <|
      Set.union_subset subset_closure fun x hx =>
        inv_inv x ▸ (IsSubgroup.inv_mem (closure.isSubgroup _) <| subset_closure hx))
#align group.closure_eq_mclosure Group.closure_eq_mclosure
#align add_group.closure_eq_mclosure AddGroup.closure_eq_mclosure

@[to_additive]
theorem mem_closure_union_iff {G : Type _} [CommGroup G] {s t : Set G} {x : G} :
    x ∈ closure (s ∪ t) ↔ ∃ y ∈ closure s, ∃ z ∈ closure t, y * z = x :=
  by
  simp only [closure_eq_mclosure, Monoid.mem_closure_union_iff, exists_prop, preimage_union];
  constructor
  · rintro ⟨_, ⟨ys, hys, yt, hyt, rfl⟩, _, ⟨zs, hzs, zt, hzt, rfl⟩, rfl⟩
    refine' ⟨_, ⟨_, hys, _, hzs, rfl⟩, _, ⟨_, hyt, _, hzt, rfl⟩, _⟩
    rw [mul_assoc, mul_assoc, mul_left_comm zs]
  · rintro ⟨_, ⟨ys, hys, zs, hzs, rfl⟩, _, ⟨yt, hyt, zt, hzt, rfl⟩, rfl⟩
    refine' ⟨_, ⟨ys, hys, yt, hyt, rfl⟩, _, ⟨zs, hzs, zt, hzt, rfl⟩, _⟩
    rw [mul_assoc, mul_assoc, mul_left_comm yt]
#align group.mem_closure_union_iff Group.mem_closure_union_iff
#align add_group.mem_closure_union_iff AddGroup.mem_closure_union_iff

end Group

namespace IsSubgroup

variable [Group G]

@[to_additive]
theorem trivial_eq_closure : trivial G = Group.closure ∅ :=
  Subset.antisymm (by simp [Set.subset_def, (Group.closure.isSubgroup _).one_mem])
    (Group.closure_subset trivial_normal.toIsSubgroup <| by simp)
#align is_subgroup.trivial_eq_closure IsSubgroup.trivial_eq_closure
#align is_add_subgroup.trivial_eq_closure IsAddSubgroup.trivial_eq_closure

end IsSubgroup

/-The normal closure of a set s is the subgroup closure of all the conjugates of
elements of s. It is the smallest normal subgroup containing s. -/
namespace Group

variable {s : Set G} [Group G]

theorem conjugatesOf_subset {t : Set G} (ht : IsNormalSubgroup t) {a : G} (h : a ∈ t) :
    conjugatesOf a ⊆ t := fun x hc =>
  by
  obtain ⟨c, w⟩ := isConj_iff.1 hc
  have H := IsNormalSubgroup.normal ht a h c
  rwa [← w]
#align group.conjugates_of_subset Group.conjugatesOf_subset

theorem conjugatesOfSet_subset' {s t : Set G} (ht : IsNormalSubgroup t) (h : s ⊆ t) :
    conjugatesOfSet s ⊆ t :=
  Set.unionᵢ₂_subset fun _ H => conjugatesOf_subset ht (h H)
#align group.conjugates_of_set_subset' Group.conjugatesOfSet_subset'

/-- The normal closure of a set s is the subgroup closure of all the conjugates of
elements of s. It is the smallest normal subgroup containing s. -/
def normalClosure (s : Set G) : Set G :=
  closure (conjugatesOfSet s)
#align group.normal_closure Group.normalClosure

theorem conjugatesOfSet_subset_normalClosure : conjugatesOfSet s ⊆ normalClosure s :=
  subset_closure
#align group.conjugates_of_set_subset_normal_closure Group.conjugatesOfSet_subset_normalClosure

theorem subset_normalClosure : s ⊆ normalClosure s :=
  Set.Subset.trans subset_conjugatesOfSet conjugatesOfSet_subset_normalClosure
#align group.subset_normal_closure Group.subset_normalClosure

/-- The normal closure of a set is a subgroup. -/
theorem normalClosure.isSubgroup (s : Set G) : IsSubgroup (normalClosure s) :=
  closure.isSubgroup (conjugatesOfSet s)
#align group.normal_closure.is_subgroup Group.normalClosure.isSubgroup

/-- The normal closure of s is a normal subgroup. -/
theorem normalClosure.is_normal : IsNormalSubgroup (normalClosure s) :=
  { normalClosure.isSubgroup _ with
    normal := fun n h g => by
      induction' h with x hx x hx ihx x y hx hy ihx ihy
      · exact conjugatesOfSet_subset_normalClosure (conj_mem_conjugatesOfSet hx)
      · simpa using (normalClosure.isSubgroup s).one_mem
      · rw [← conj_inv]
        exact (normalClosure.isSubgroup _).inv_mem ihx
      · rw [← conj_mul]
        exact (normalClosure.isSubgroup _).toIsSubmonoid.mul_mem ihx ihy }
#align group.normal_closure.is_normal Group.normalClosure.is_normal

/-- The normal closure of s is the smallest normal subgroup containing s. -/
theorem normalClosure_subset {s t : Set G} (ht : IsNormalSubgroup t) (h : s ⊆ t) :
    normalClosure s ⊆ t := fun a w =>
  by
  induction' w with x hx x _ ihx x y _ _ ihx ihy
  · exact conjugatesOfSet_subset' ht h <| hx
  · exact ht.toIsSubgroup.toIsSubmonoid.one_mem
  · exact ht.toIsSubgroup.inv_mem ihx
  · exact ht.toIsSubgroup.toIsSubmonoid.mul_mem ihx ihy
#align group.normal_closure_subset Group.normalClosure_subset

theorem normalClosure_subset_iff {s t : Set G} (ht : IsNormalSubgroup t) :
    s ⊆ t ↔ normalClosure s ⊆ t :=
  ⟨normalClosure_subset ht, Set.Subset.trans subset_normalClosure⟩
#align group.normal_closure_subset_iff Group.normalClosure_subset_iff

theorem normalClosure_mono {s t : Set G} : s ⊆ t → normalClosure s ⊆ normalClosure t := fun h =>
  normalClosure_subset normalClosure.is_normal (Set.Subset.trans h subset_normalClosure)
#align group.normal_closure_mono Group.normalClosure_mono

end Group

/-- Create a bundled subgroup from a set `s` and `[IsSubgroup s]`. -/
@[to_additive "Create a bundled additive subgroup from a set `s` and `[is_add_subgroup s]`."]
def Subgroup.of [Group G] {s : Set G} (h : IsSubgroup s) : Subgroup G
    where
  carrier := s
  one_mem' := h.1.1
  mul_mem' := h.1.2
  inv_mem' := h.2
#align subgroup.of Subgroup.of
#align add_subgroup.of AddSubgroup.of

@[to_additive]
theorem Subgroup.isSubgroup [Group G] (K : Subgroup G) : IsSubgroup (K : Set G) :=
  { one_mem := K.one_mem'
    mul_mem := K.mul_mem'
    inv_mem := K.inv_mem' }
#align subgroup.is_subgroup Subgroup.isSubgroup
#align add_subgroup.is_add_subgroup AddSubgroup.isAddSubgroup

-- this will never fire if it's an instance
@[to_additive]
theorem Subgroup.of_normal [Group G] (s : Set G) (h : IsSubgroup s) (n : IsNormalSubgroup s) :
    Subgroup.Normal (Subgroup.of h) :=
  { conj_mem := n.normal }
#align subgroup.of_normal Subgroup.of_normal
#align add_subgroup.of_normal AddSubgroup.of_normal


import algebraic_topology.cech_nerve

universe u

noncomputable theory

open_locale simplicial

namespace category_theory

open category_theory.limits

variables {C : Type*} [category C]

namespace simplicial_object

variables [∀ (n : ℕ) (f : arrow C),
  has_wide_pullback f.right (λ i : ulift (fin (n+1)), f.left) (λ i, f.hom)]

section
open simplex_category opposite limits.wide_pullback

lemma hom_ext (X : simplicial_object.augmented C) (F : arrow C)
  (f g : X ⟶ F.augmented_cech_nerve) (hl : f.left.app (op [0]) = g.left.app (op [0]))
  (hr : f.right = g.right) :
  f = g :=
begin
  apply (cech_nerve_equiv X F).symm.injective,
  dsimp only [cech_nerve_equiv_symm_apply],
  ext1,
  { simp only [equivalence_right_to_left_left],
    rw hl },
  { exact hr }
end

-- move this
@[simps]
def augmented_cech_nerve.left_obj_zero_iso (F : arrow C) :
  F.augmented_cech_nerve.left.obj (op [0]) ≅ F.left :=
{ hom := π _ ⟨0⟩,
  inv := lift F.hom (λ _, 𝟙 _) (λ _, category.id_comp _),
  hom_inv_id' :=
  begin
    ext,
    { rw [category.assoc, lift_π, category.id_comp, category.comp_id],
      cases j, congr' 2, dsimp at j ⊢, exact subsingleton.elim _ _ },
    { simp only [π_arrow, category.id_comp, limits.wide_pullback.lift_base, category.assoc], }
  end,
  inv_hom_id' := lift_π _ _ _ _ _ }
.

-- move this
lemma augmented_cech_nerve.left_map_comp_obj_zero_iso
  (F : arrow C) (n : simplex_category) (i : ulift (fin (n.len+1))) :
  F.augmented_cech_nerve.left.map (n.const i.down).op ≫ (augmented_cech_nerve.left_obj_zero_iso F).hom =
  wide_pullback.π _ i :=
begin
  rw [← iso.eq_comp_inv],
  dsimp only [arrow.augmented_cech_nerve_left, arrow.cech_nerve_map,
    augmented_cech_nerve.left_obj_zero_iso_inv],
  ext1 ⟨j⟩,
  { rw [limits.wide_pullback.lift_π, category.assoc, limits.wide_pullback.lift_π, category.comp_id],
    cases i, refl },
  { rw [limits.wide_pullback.lift_base, category.assoc, limits.wide_pullback.lift_base,
      limits.wide_pullback.π_arrow], }
end
.

@[simp]
lemma equivalence_left_to_right_left_app_zero_comp_π
  (X : simplicial_object.augmented C) (F : arrow C) (G : augmented.to_arrow.obj X ⟶ F) (i) :
  (equivalence_left_to_right X F G).left.app (op [0]) ≫ limits.wide_pullback.π _ i =
  G.left :=
begin
  dsimp only [equivalence_left_to_right_left_app, unop_op],
  rw [limits.wide_pullback.lift_π, simplex_category.hom_zero_zero ([0].const i.down),
    op_id, X.left.map_id, category.id_comp],
end
.

end

end simplicial_object

end category_theory