import .ops
open subtype nnf tmodel list

section
variables (φ ψ : nnf) (Γ₁ Γ₂ Δ Λ: list nnf) {st : Type}
variables (k : S4 st) (s : st)
open list

theorem sat_subset (h₁ : Γ₁ ⊆ Γ₂) (h₂ : sat k s Γ₂) : sat k s Γ₁ :=
λ x hx, h₂ _ (h₁ hx)

theorem sat_sublist (h₁ : Γ₁ <+ Γ₂) (h₂ :sat k s Γ₂) : sat k s Γ₁ :=
sat_subset _ _ _ _ (sublist.subset h₁) h₂

theorem sat_append (h₁ : sat k s Γ₁) (h₂ : sat k s Γ₂) : sat k s (Γ₁ ++ Γ₂) :=
begin
  intros φ h, rw mem_append at h, cases h,
  apply h₁ _ h, apply h₂ _ h
end

theorem unsat_contra  {Δ n} : var n ∈ Δ →  neg n ∈ Δ →  unsatisfiable Δ:=
begin
  intros h₁ h₂, intros v hsat, intros s hsat,
  have := hsat _ h₁, have := hsat _ h₂, simpa
end

theorem unsat_contra_seqt {Δ : sseqt} {n} : var n ∈ Δ.m →  neg n ∈ Δ.m →  unsatisfiable (Δ.m ++ Δ.b):=
begin
  intros h₁ h₂, intros st m, intros s hsat,
  have := unsat_contra h₁ h₂,
  have := this _ m s,
  apply this,
  apply sat_subset _ _ _ _ _ hsat,
  simp
end

theorem sat_of_and : force k s (and φ ψ) ↔ (force k s φ) ∧ (force k s ψ) :=
by split; {intro, simpa}

theorem sat_of_sat_erase (h₁ : sat k s $ Δ.erase φ) (h₂ : force k s φ) : sat k s Δ :=
begin
  intro ψ, intro h,
  by_cases (ψ = φ),
  {rw h, assumption},
  {have : ψ ∈ Δ.erase φ,
   rw mem_erase_of_ne, assumption, exact h,
   apply h₁, assumption}
end

theorem unsat_and_of_unsat_split
        (h₁ : and φ ψ ∈ Δ)
        (h₂ : unsatisfiable $ φ :: ψ :: Δ.erase (and φ ψ)) :
        unsatisfiable Δ :=
begin
  intro st, intros, intro h,
  apply h₂, swap 3, exact k, swap, exact s,
  intro e, intro he,
  cases he,
  {rw he, have := h _ h₁, rw sat_of_and at this, exact this.1},
  {cases he,
    {rw he, have := h _ h₁, rw sat_of_and at this, exact this.2},
    {have := h _ h₁, apply h, apply mem_of_mem_erase he} }
end

theorem unsat_and_of_unsat_split_seqt {Γ}
        (h₁ : and φ ψ ∈ Δ)
        (h₂ : unsatisfiable $ (φ :: ψ :: Δ.erase (and φ ψ)++Γ)) :
        unsatisfiable (Δ++Γ) :=
begin
  intro st, intros, intro h,
  apply h₂, swap 3, exact k, swap, exact s,
  intro e, intro he,
  cases he,
  {rw he, have := h _ (mem_append_left _ h₁), rw sat_of_and at this, exact this.1},
  {cases he,
    {rw he, have := h _ (mem_append_left _ h₁), rw sat_of_and at this, exact this.2},
    {have := h _ (mem_append_left _ h₁), apply h, apply mem_of_mem_erase, rw erase_append_left, exact he, exact h₁} }
end

theorem sat_and_of_sat_split
        (h₁ : and φ ψ ∈ Δ)
        (h₂ : sat k s $ φ :: ψ :: Δ.erase (and φ ψ)) :
        sat k s Δ :=
begin
  intro e, intro he,
  by_cases (e = and φ ψ),
  { rw h, dsimp, split, repeat {apply h₂, simp} },
  { have : e ∈ Δ.erase (and φ ψ),
      { rw mem_erase_of_ne, repeat { assumption } },
    apply h₂, simp [this] }
end

theorem sat_and_of_sat_split_seqt {Γ}
        (h₁ : and φ ψ ∈ Δ)
        (h₂ : sat k s $ (φ :: ψ :: Δ.erase (and φ ψ)++Γ)) :
        sat k s (Δ++Γ) :=
begin
  intro e, intro he,
  by_cases (e = and φ ψ),
  { rw h, dsimp, split, repeat {apply h₂, simp} },
  { have : e ∈ Δ.erase (and φ ψ) ++ Γ,
      { rw ←erase_append_left, rw mem_erase_of_ne, repeat {assumption} },
    apply h₂, simp [this] }
end

theorem sat_split_of_sat_and_seqt {Γ}
        (h₁ : and φ ψ ∈ Δ)
        (h₂ : sat k s (Δ++Γ)) :
        sat k s $ (φ :: ψ :: Δ.erase (and φ ψ)++Γ) :=
begin
  intros e he, rw mem_append at he, cases he,
  have : force k s (and φ ψ), {apply h₂, simp [h₁]}, rw sat_of_and at this,
  {cases he,
  {rw he, exact this.left},
  {cases he, rw he, exact this.right, apply h₂, rw mem_append, left, apply mem_of_mem_erase he}
  },
  {apply h₂, rw mem_append, right, exact he}
end

theorem unsat_or_of_unsat_split_seqt {Γ}
        (h : or φ ψ ∈ Δ)
        (h₁ : unsatisfiable $ (φ :: Δ.erase (nnf.or φ ψ)++Γ))
        (h₂ : unsatisfiable $ (ψ :: Δ.erase (nnf.or φ ψ)++Γ)) :
        unsatisfiable $ (Δ++Γ) :=
begin
  intro, intros, intro hsat,
  have := hsat _ (mem_append_left _ h),
  dsimp at this,
  cases this,
  {apply h₁, swap 3, exact k, swap, exact s, intro e, intro he,
   cases he, rw he, exact this, apply hsat,
apply mem_of_mem_erase, rw erase_append_left, exact he, exact h},
  {apply h₂, swap 3, exact k, swap, exact s, intro e, intro he,
   cases he, rw he, exact this, apply hsat, apply mem_of_mem_erase, rw erase_append_left, exact he, exact h}
end

theorem sat_or_of_sat_split_left
        (h : or φ ψ ∈ Δ)
        (hl : sat k s $ φ :: Δ.erase (nnf.or φ ψ)) :
        sat k s Δ :=
begin
  intros e he,
  by_cases (e = or φ ψ),
  { rw h, dsimp, left, apply hl, simp},
  {have : e ∈ Δ.erase (or φ ψ),
     { rw mem_erase_of_ne, repeat { assumption } },
   apply hl, simp [this]}
end

theorem sat_or_of_sat_split_right
        (h : or φ ψ ∈ Δ)
        (hl : sat k s $ ψ :: Δ.erase (nnf.or φ ψ)) :
        sat k s Δ :=
begin
  intros e he,
  by_cases (e = or φ ψ),
  { rw h, dsimp, right, apply hl, simp},
  { have : e ∈ Δ.erase (or φ ψ),
      { rw mem_erase_of_ne, repeat { assumption } },
    apply hl, simp [this] }
end

/- S4-specific lemmas -/

theorem force_of_force_box (h : force k s $ box φ) : force k s φ
:= by apply h; apply k.refl

theorem force_box_box_of_force_box : force k s (box φ) → force k s (box (box φ)) :=
by intros h s₁ rs₁ s₂ rs₂; apply h; apply k.trans rs₁ rs₂

theorem unsat_of_unsat_box_new
        (h₁ : box φ ∈ Δ)
        (h₂ : unsatisfiable $ (φ :: Δ.erase (box φ)) ++ box φ :: Λ) :
        unsatisfiable (Δ ++ Λ) :=
begin
  intros st k s h,
  apply h₂, swap 3, exact k, swap, exact s,
  intros e he,
  rw [mem_append] at he,
  cases he,
  {cases he,
    {rw he, apply force_of_force_box, apply h (box φ), simp [h₁]},
    {apply h, rw mem_append, left, apply mem_of_mem_erase he }},
  {cases he,
    {rw ←he at h₁, apply h, rw mem_append, left, exact h₁},
    {apply h, rw mem_append, right, assumption}}
end

theorem sat_copy_of_sat_box_new
        (h₁ : box φ ∈ Δ)
        (h₂ : sat k s $ (φ :: Δ.erase (box φ)) ++ box φ :: Λ) :
        sat k s (Δ ++ Λ) :=
begin
  intros ψ hφ,
  rw mem_append at hφ,
  cases hφ,
  {by_cases heq : ψ = box φ,
    {rw heq, apply h₂ (box φ), simp},
    {have := mem_erase_of_ne heq, rw ←this at hφ, apply h₂, simp, right, left, exact hφ}},
  {apply h₂, simp, repeat {right}, exact hφ}
end

theorem unsat_of_unsat_box_dup
        (h₁ : box φ ∈ Δ)
        (h₃ : unsatisfiable $ (φ :: Δ.erase (box φ)) ++ Λ) :
        unsatisfiable (Δ ++ Λ) :=
begin
  intros st k s h,
  apply h₃, swap 3, exact k, swap, exact s,
  intros e he,
  cases he,
  {rw he, apply force_of_force_box, apply h (box φ), simp [h₁]},
  {have := mem_append.1 he, cases this,
   {apply h, apply mem_append_left, apply mem_of_mem_erase this},
   {apply h, apply mem_append_right, exact this}}
end

end

def unmodal_seqt (Γ : sseqt) : list sseqt :=
@list.pmap _ _ (λ φ, φ ∉ Γ.h ∧ dia φ ∈ Γ.m)
(λ d h,
({s := some {d := d, b := Γ.b},
a := {d := d, b := Γ.b} :: Γ.a,
h := d :: Γ.h,
m := d :: Γ.b,
ndh := begin rw list.nodup_cons, split, exact h.1, exact Γ.ndh end,
sph := begin apply list.cons_subperm_of_mem, apply Γ.ndh, exact h.1, apply mem_closure_dia, apply Γ.sbm, exact h.2,  exact Γ.sph end,
sbm := begin rw list.cons_subset, split, apply mem_closure_dia, apply Γ.sbm, exact h.2, apply list.subperm.subset, exact Γ.spb end,
ha  := begin intros φ h, cases h with l r, rw l, simp, right, apply Γ.ha, exact r end,
ps₁ := begin simp [dsig] end,
ps₂ := begin simp [bsig] end,
.. Γ} : sseqt))
(filter_undia Γ.h Γ.m)
(begin
intros φ hmem,split,
{apply mem_filter_dia_right, exact hmem},
{apply mem_filter_dia_right_aux, exact hmem}
end)

def unmodal_seqt_size (Γ : sseqt) : ∀ (i : sseqt),  i ∈ unmodal_seqt Γ → (prod.measure_lex' sseqt_size i Γ) :=
list.pmapp _ _
begin
intros φ h hmem,
right, left,
apply length_sub_lt_of_nodup_subperm,
{apply Γ.sph},
{apply mem_closure_dia, apply Γ.sbm, exact h.2},
{exact h.1},
{exact Γ.ndh}
end
_

def sat_unmodal_of_sat {Γ : sseqt} : ∀ (i : sseqt),  i ∈ unmodal_seqt Γ →
(∀ {st : Type} (k : S4 st) s,
sat k s (Γ.m ++ Γ.b) → ∃ s', sat k s' (i.m ++ i.b)) :=
list.pmapp _ _
begin
intros φ hninh hmem st k s h,
have hd : force k s (dia φ),
  { apply h, rw mem_append, left, exact hninh.2 },
have hb : ∀ φ ∈ Γ.b, force k s (box φ),
  { intros γ hγ,
    have := box_only_ex Γ.hb hγ, cases this with w hw,
    rw hw, apply force_box_box_of_force_box,
    have := h _ (mem_append_right _ hγ), rw hw at this, exact this},
rcases hd with ⟨w, hrw, hfw⟩,
split, swap, exact w,
intros ψ hψ, simp at hψ, cases hψ,
{rw hψ, exact hfw},
{apply hb, exact hψ, exact hrw}
end
_

def unsat_of_unsat_unmodal {Γ : sseqt} (i : sseqt) : i ∈ unmodal_seqt Γ ∧ unsatisfiable (i.m ++ i.b) → unsatisfiable (Γ.m ++ Γ.b) :=
begin
  intro hex, intros st k s h,
  have := sat_unmodal_of_sat i hex.1 k s h,
  cases this with w hw,
  have := hex.2,
  exact this _ _ _ hw
end

def unmodal_mem_box (Γ : sseqt) : ∀ (i : sseqt),  i ∈ unmodal_seqt Γ → (∀ φ, box φ ∈ Γ.b → box φ ∈ i.m) :=
list.pmapp _ _ begin intros φ h hmem ψ hψ, right, exact hψ end _

def mem_unmodal_seqt (Γ : sseqt) (φ) (h : φ ∉ Γ.h ∧ dia φ ∈ Γ.m) : ∃ (i : sseqt), i ∈ unmodal_seqt Γ ∧ φ ∈ i.m :=
begin
split, swap,
{exact
({s := some {d := φ, b := Γ.b},
a := {d := φ, b := Γ.b} :: Γ.a,
h := φ :: Γ.h,
m := φ :: Γ.b,
ndh := begin rw list.nodup_cons, split, exact h.1, exact Γ.ndh end,
sph := begin apply list.cons_subperm_of_mem, apply Γ.ndh, exact h.1, apply mem_closure_dia, apply Γ.sbm, exact h.2,  exact Γ.sph end,
sbm := begin rw list.cons_subset, split, apply mem_closure_dia, apply Γ.sbm, exact h.2, apply list.subperm.subset, exact Γ.spb end,
ha  := begin intros φ h, cases h with l r, rw l, simp, right, apply Γ.ha, exact r end,
ps₁ := begin intro, simp [dsig] end,
ps₂ := begin intro, simp [bsig] end,
.. Γ} : sseqt)},
{ dsimp [unmodal_seqt], split,
  {let mf := (λ (d : nnf) (h : d ∉ Γ.h ∧ dia d ∈ Γ.m),
      ({s := some {d := d, b := Γ.b},
       a := {d := d, b := Γ.b} :: Γ.a,
       h := d :: Γ.h,
       m := d :: Γ.b,
       ndh := begin rw list.nodup_cons, split, exact h.1, exact Γ.ndh end,
       sph := begin apply list.cons_subperm_of_mem, apply Γ.ndh, exact h.1, apply mem_closure_dia, apply Γ.sbm, exact h.2,  exact Γ.sph end,
       sbm := begin rw list.cons_subset, split, apply mem_closure_dia, apply Γ.sbm, exact h.2, apply list.subperm.subset, exact Γ.spb end,
       ha  := begin intros φ h, cases h with l r, rw l, simp, right, apply Γ.ha, exact r end,
       ps₁ := begin simp [dsig] end,
       ps₂ := begin simp [bsig] end,
       .. Γ} :sseqt)),
  have hmem := mem_filter_undia_left _ _ _ h.2 h.1,
  have hf : ∀ (y : nnf), y ∈ filter_undia (Γ.h) (Γ.m) → y ∉ Γ.h ∧ dia y ∈ Γ.m,
    {intros h hy, split, {apply mem_filter_dia_right, exact hy}, {apply mem_filter_dia_right_aux, exact hy}},
  exact mem_pmap_of_mem mf hmem hf},
{ simp } }
end

theorem unmodal_sig (Γ : sseqt) : ∀ (i : sseqt),  i ∈ unmodal_seqt Γ → (∀ a, a ∈ i.a → some a = i.s ∨ a ∈ Γ.a) :=
list.pmapp _ _
begin
intros φ h hmem a ha, simp at ha,
cases ha,
{left, simp, exact ha},
{right, exact ha}
end
_

theorem unsat_of_closed_and {Γ Δ} (i : and_instance Γ Δ) (h : unsatisfiable Δ) : unsatisfiable Γ :=
by cases i; { apply unsat_and_of_unsat_split, repeat {assumption} }

theorem unsat_of_closed_and_seqt {Γ Δ} (i : and_instance_seqt Γ Δ) (h : unsatisfiable (Δ.m++Δ.b)) : unsatisfiable (Γ.m++Γ.b) :=
by cases i; {apply unsat_and_of_unsat_split_seqt, repeat {assumption} }

theorem unsat_of_closed_or_seqt {Γ₁ Γ₂ Δ : sseqt} (i : or_instance_seqt Δ Γ₁ Γ₂)
(h₁ : unsatisfiable (Γ₁.m++Γ₁.b))
(h₂ : unsatisfiable (Γ₂.m++Γ₂.b)) :
unsatisfiable (Δ.m++Δ.b) :=
by cases i; {apply unsat_or_of_unsat_split_seqt, repeat { assumption }}

theorem unsat_of_closed_box_new {Γ Δ} (i : box_new_instance_seqt Γ Δ) (h : unsatisfiable $ (Δ.m++Δ.b)) : unsatisfiable (Γ.m++Γ.b) :=
by cases i; { apply unsat_of_unsat_box_new, repeat { assumption } }

theorem unsat_of_closed_box_dup {Γ Δ} (i : box_dup_instance_seqt Γ Δ) (h : unsatisfiable $ (Δ.m++Δ.b)) : unsatisfiable (Γ.m++Γ.b) :=
by cases i; { apply unsat_of_unsat_box_dup, repeat { assumption } }


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Markus Himmel, Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.limits.shapes.wide_pullbacks
import Mathlib.category_theory.limits.shapes.binary_products
import Mathlib.PostPort

universes v u_1 u u₂

namespace Mathlib

/-!
# Pullbacks

We define a category `walking_cospan` (resp. `walking_span`), which is the index category
for the given data for a pullback (resp. pushout) diagram. Convenience methods `cospan f g`
and `span f g` construct functors from the walking (co)span, hitting the given morphisms.

We define `pullback f g` and `pushout f g` as limits and colimits of such functors.

## References
* [Stacks: Fibre products](https://stacks.math.columbia.edu/tag/001U)
* [Stacks: Pushouts](https://stacks.math.columbia.edu/tag/0025)
-/

namespace category_theory.limits

/--
The type of objects for the diagram indexing a pullback, defined as a special case of
`wide_pullback_shape`.
-/
def walking_cospan := wide_pullback_shape walking_pair

/-- The left point of the walking cospan. -/
/-- The right point of the walking cospan. -/
def walking_cospan.left : walking_cospan := some walking_pair.left

/-- The central point of the walking cospan. -/
def walking_cospan.right : walking_cospan := some walking_pair.right

def walking_cospan.one : walking_cospan := none

/--
The type of objects for the diagram indexing a pushout, defined as a special case of
`wide_pushout_shape`.
-/
def walking_span := wide_pushout_shape walking_pair

/-- The left point of the walking span. -/
/-- The right point of the walking span. -/
def walking_span.left : walking_span := some walking_pair.left

/-- The central point of the walking span. -/
def walking_span.right : walking_span := some walking_pair.right

def walking_span.zero : walking_span := none

namespace walking_cospan

/-- The type of arrows for the diagram indexing a pullback. -/
def hom : walking_cospan → walking_cospan → Type v := wide_pullback_shape.hom

/-- The left arrow of the walking cospan. -/
/-- The right arrow of the walking cospan. -/
def hom.inl : left ⟶ one := wide_pullback_shape.hom.term walking_pair.left

/-- The identity arrows of the walking cospan. -/
def hom.inr : right ⟶ one := wide_pullback_shape.hom.term walking_pair.right

def hom.id (X : walking_cospan) : X ⟶ X := wide_pullback_shape.hom.id X

protected instance category_theory.has_hom.hom.subsingleton (X : walking_cospan)
    (Y : walking_cospan) : subsingleton (X ⟶ Y) :=
  subsingleton.intro
    fun (a b : X ⟶ Y) => eq.mpr (id (propext (eq_iff_true_of_subsingleton a b))) trivial

end walking_cospan

namespace walking_span

/-- The type of arrows for the diagram indexing a pushout. -/
def hom : walking_span → walking_span → Type v := wide_pushout_shape.hom

/-- The left arrow of the walking span. -/
/-- The right arrow of the walking span. -/
def hom.fst : zero ⟶ left := wide_pushout_shape.hom.init walking_pair.left

/-- The identity arrows of the walking span. -/
def hom.snd : zero ⟶ right := wide_pushout_shape.hom.init walking_pair.right

def hom.id (X : walking_span) : X ⟶ X := wide_pushout_shape.hom.id X

protected instance category_theory.has_hom.hom.subsingleton (X : walking_span) (Y : walking_span) :
    subsingleton (X ⟶ Y) :=
  subsingleton.intro
    fun (a b : X ⟶ Y) => eq.mpr (id (propext (eq_iff_true_of_subsingleton a b))) trivial

end walking_span

/-- `cospan f g` is the functor from the walking cospan hitting `f` and `g`. -/
def cospan {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) :
    walking_cospan ⥤ C :=
  wide_pullback_shape.wide_cospan Z (fun (j : walking_pair) => walking_pair.cases_on j X Y)
    fun (j : walking_pair) => walking_pair.cases_on j f g

/-- `span f g` is the functor from the walking span hitting `f` and `g`. -/
def span {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : X ⟶ Z) :
    walking_span ⥤ C :=
  wide_pushout_shape.wide_span X (fun (j : walking_pair) => walking_pair.cases_on j Y Z)
    fun (j : walking_pair) => walking_pair.cases_on j f g

@[simp] theorem cospan_left {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z)
    (g : Y ⟶ Z) : functor.obj (cospan f g) walking_cospan.left = X :=
  rfl

@[simp] theorem span_left {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y)
    (g : X ⟶ Z) : functor.obj (span f g) walking_span.left = Y :=
  rfl

@[simp] theorem cospan_right {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z)
    (g : Y ⟶ Z) : functor.obj (cospan f g) walking_cospan.right = Y :=
  rfl

@[simp] theorem span_right {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y)
    (g : X ⟶ Z) : functor.obj (span f g) walking_span.right = Z :=
  rfl

@[simp] theorem cospan_one {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z)
    (g : Y ⟶ Z) : functor.obj (cospan f g) walking_cospan.one = Z :=
  rfl

@[simp] theorem span_zero {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y)
    (g : X ⟶ Z) : functor.obj (span f g) walking_span.zero = X :=
  rfl

@[simp] theorem cospan_map_inl {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z)
    (g : Y ⟶ Z) : functor.map (cospan f g) walking_cospan.hom.inl = f :=
  rfl

@[simp] theorem span_map_fst {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y)
    (g : X ⟶ Z) : functor.map (span f g) walking_span.hom.fst = f :=
  rfl

@[simp] theorem cospan_map_inr {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z)
    (g : Y ⟶ Z) : functor.map (cospan f g) walking_cospan.hom.inr = g :=
  rfl

@[simp] theorem span_map_snd {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y)
    (g : X ⟶ Z) : functor.map (span f g) walking_span.hom.snd = g :=
  rfl

theorem cospan_map_id {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z) (g : Y ⟶ Z)
    (w : walking_cospan) : functor.map (cospan f g) (walking_cospan.hom.id w) = 𝟙 :=
  rfl

theorem span_map_id {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : X ⟶ Z)
    (w : walking_span) : functor.map (span f g) (walking_span.hom.id w) = 𝟙 :=
  rfl

/-- Every diagram indexing an pullback is naturally isomorphic (actually, equal) to a `cospan` -/
def diagram_iso_cospan {C : Type u} [category C] (F : walking_cospan ⥤ C) :
    F ≅ cospan (functor.map F walking_cospan.hom.inl) (functor.map F walking_cospan.hom.inr) :=
  nat_iso.of_components (fun (j : walking_cospan) => eq_to_iso sorry) sorry

/-- Every diagram indexing a pushout is naturally isomorphic (actually, equal) to a `span` -/
def diagram_iso_span {C : Type u} [category C] (F : walking_span ⥤ C) :
    F ≅ span (functor.map F walking_span.hom.fst) (functor.map F walking_span.hom.snd) :=
  nat_iso.of_components (fun (j : walking_span) => eq_to_iso sorry) sorry

/-- A pullback cone is just a cone on the cospan formed by two morphisms `f : X ⟶ Z` and
    `g : Y ⟶ Z`.-/
def pullback_cone {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) :=
  cone (cospan f g)

namespace pullback_cone

/-- The first projection of a pullback cone. -/
def fst {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}
    (t : pullback_cone f g) : cone.X t ⟶ X :=
  nat_trans.app (cone.π t) walking_cospan.left

/-- The second projection of a pullback cone. -/
def snd {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}
    (t : pullback_cone f g) : cone.X t ⟶ Y :=
  nat_trans.app (cone.π t) walking_cospan.right

/-- This is a slightly more convenient method to verify that a pullback cone is a limit cone. It
    only asks for a proof of facts that carry any mathematical content -/
def is_limit_aux {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}
    (t : pullback_cone f g) (lift : (s : cone (cospan f g)) → cone.X s ⟶ cone.X t)
    (fac_left : ∀ (s : pullback_cone f g), lift s ≫ fst t = fst s)
    (fac_right : ∀ (s : pullback_cone f g), lift s ≫ snd t = snd s)
    (uniq :
      ∀ (s : pullback_cone f g) (m : cone.X s ⟶ cone.X t),
        (∀ (j : walking_cospan), m ≫ nat_trans.app (cone.π t) j = nat_trans.app (cone.π s) j) →
          m = lift s) :
    is_limit t :=
  is_limit.mk lift

/-- This is another convenient method to verify that a pullback cone is a limit cone. It
    only asks for a proof of facts that carry any mathematical content, and allows access to the
    same `s` for all parts. -/
def is_limit_aux' {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}
    (t : pullback_cone f g)
    (create :
      (s : pullback_cone f g) →
        Subtype
          fun (l : cone.X s ⟶ cone.X t) =>
            l ≫ fst t = fst s ∧
              l ≫ snd t = snd s ∧
                ∀ {m : cone.X s ⟶ cone.X t}, m ≫ fst t = fst s → m ≫ snd t = snd s → m = l) :
    is_limit t :=
  is_limit_aux t (fun (s : cone (cospan f g)) => subtype.val (create s)) sorry sorry sorry

/-- A pullback cone on `f` and `g` is determined by morphisms `fst : W ⟶ X` and `snd : W ⟶ Y`
    such that `fst ≫ f = snd ≫ g`. -/
@[simp] theorem mk_π_app {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}
    {W : C} (fst : W ⟶ X) (snd : W ⟶ Y) (eq : fst ≫ f = snd ≫ g) (j : walking_cospan) :
    nat_trans.app (cone.π (mk fst snd eq)) j =
        option.cases_on j (fst ≫ f) fun (j' : walking_pair) => walking_pair.cases_on j' fst snd :=
  Eq.refl (nat_trans.app (cone.π (mk fst snd eq)) j)

@[simp] theorem mk_π_app_left {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z}
    {g : Y ⟶ Z} {W : C} (fst : W ⟶ X) (snd : W ⟶ Y) (eq : fst ≫ f = snd ≫ g) :
    nat_trans.app (cone.π (mk fst snd eq)) walking_cospan.left = fst :=
  rfl

@[simp] theorem mk_π_app_right {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z}
    {g : Y ⟶ Z} {W : C} (fst : W ⟶ X) (snd : W ⟶ Y) (eq : fst ≫ f = snd ≫ g) :
    nat_trans.app (cone.π (mk fst snd eq)) walking_cospan.right = snd :=
  rfl

@[simp] theorem mk_π_app_one {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z}
    {g : Y ⟶ Z} {W : C} (fst : W ⟶ X) (snd : W ⟶ Y) (eq : fst ≫ f = snd ≫ g) :
    nat_trans.app (cone.π (mk fst snd eq)) walking_cospan.one = fst ≫ f :=
  rfl

@[simp] theorem mk_fst {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}
    {W : C} (fst : W ⟶ X) (snd : W ⟶ Y) (eq : fst ≫ f = snd ≫ g) : fst (mk fst snd eq) = fst :=
  rfl

@[simp] theorem mk_snd {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}
    {W : C} (fst : W ⟶ X) (snd : W ⟶ Y) (eq : fst ≫ f = snd ≫ g) : snd (mk fst snd eq) = snd :=
  rfl

theorem condition_assoc {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}
    (t : pullback_cone f g) {X' : C} (f' : Z ⟶ X') : fst t ≫ f ≫ f' = snd t ≫ g ≫ f' :=
  sorry

/-- To check whether a morphism is equalized by the maps of a pullback cone, it suffices to check
  it for `fst t` and `snd t` -/
theorem equalizer_ext {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}
    (t : pullback_cone f g) {W : C} {k : W ⟶ cone.X t} {l : W ⟶ cone.X t}
    (h₀ : k ≫ fst t = l ≫ fst t) (h₁ : k ≫ snd t = l ≫ snd t) (j : walking_cospan) :
    k ≫ nat_trans.app (cone.π t) j = l ≫ nat_trans.app (cone.π t) j :=
  sorry

theorem is_limit.hom_ext {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}
    {t : pullback_cone f g} (ht : is_limit t) {W : C} {k : W ⟶ cone.X t} {l : W ⟶ cone.X t}
    (h₀ : k ≫ fst t = l ≫ fst t) (h₁ : k ≫ snd t = l ≫ snd t) : k = l :=
  is_limit.hom_ext ht (equalizer_ext t h₀ h₁)

/-- If `t` is a limit pullback cone over `f` and `g` and `h : W ⟶ X` and `k : W ⟶ Y` are such that
    `h ≫ f = k ≫ g`, then we have `l : W ⟶ t.X` satisfying `l ≫ fst t = h` and `l ≫ snd t = k`.
    -/
def is_limit.lift' {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}
    {t : pullback_cone f g} (ht : is_limit t) {W : C} (h : W ⟶ X) (k : W ⟶ Y) (w : h ≫ f = k ≫ g) :
    Subtype fun (l : W ⟶ cone.X t) => l ≫ fst t = h ∧ l ≫ snd t = k :=
  { val := is_limit.lift ht (mk h k w), property := sorry }

/--
This is a more convenient formulation to show that a `pullback_cone` constructed using
`pullback_cone.mk` is a limit cone.
-/
def is_limit.mk {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} {W : C}
    {fst : W ⟶ X} {snd : W ⟶ Y} (eq : fst ≫ f = snd ≫ g)
    (lift : (s : pullback_cone f g) → cone.X s ⟶ W)
    (fac_left : ∀ (s : pullback_cone f g), lift s ≫ fst = fst s)
    (fac_right : ∀ (s : pullback_cone f g), lift s ≫ snd = snd s)
    (uniq :
      ∀ (s : pullback_cone f g) (m : cone.X s ⟶ W),
        m ≫ fst = fst s → m ≫ snd = snd s → m = lift s) :
    is_limit (mk fst snd eq) :=
  is_limit_aux (mk fst snd eq) lift fac_left fac_right sorry

/-- The flip of a pullback square is a pullback square. -/
def flip_is_limit {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} {W : C}
    {h : W ⟶ X} {k : W ⟶ Y} {comm : h ≫ f = k ≫ g} (t : is_limit (mk k h flip_is_limit._proof_1)) :
    is_limit (mk h k comm) :=
  is_limit_aux' (mk h k comm)
    fun (s : pullback_cone f g) =>
      { val := subtype.val (is_limit.lift' t (snd s) (fst s) sorry), property := sorry }

/--
The pullback cone `(𝟙 X, 𝟙 X)` for the pair `(f, f)` is a limit if `f` is a mono. The converse is
shown in `mono_of_pullback_is_id`.
-/
def is_limit_mk_id_id {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) [mono f] :
    is_limit (mk 𝟙 𝟙 (is_limit_mk_id_id._proof_1 f)) :=
  is_limit.mk sorry (fun (s : pullback_cone f f) => fst s) sorry sorry sorry

/--
`f` is a mono if the pullback cone `(𝟙 X, 𝟙 X)` is a limit for the pair `(f, f)`. The converse is
given in `pullback_cone.is_id_of_mono`.
-/
theorem mono_of_is_limit_mk_id_id {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    (t : is_limit (mk 𝟙 𝟙 rfl)) : mono f :=
  sorry

end pullback_cone

/-- A pushout cocone is just a cocone on the span formed by two morphisms `f : X ⟶ Y` and
    `g : X ⟶ Z`.-/
def pushout_cocone {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : X ⟶ Z) :=
  cocone (span f g)

namespace pushout_cocone

/-- The first inclusion of a pushout cocone. -/
def inl {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z}
    (t : pushout_cocone f g) : Y ⟶ cocone.X t :=
  nat_trans.app (cocone.ι t) walking_span.left

/-- The second inclusion of a pushout cocone. -/
def inr {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z}
    (t : pushout_cocone f g) : Z ⟶ cocone.X t :=
  nat_trans.app (cocone.ι t) walking_span.right

/-- This is a slightly more convenient method to verify that a pushout cocone is a colimit cocone.
    It only asks for a proof of facts that carry any mathematical content -/
def is_colimit_aux {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z}
    (t : pushout_cocone f g) (desc : (s : pushout_cocone f g) → cocone.X t ⟶ cocone.X s)
    (fac_left : ∀ (s : pushout_cocone f g), inl t ≫ desc s = inl s)
    (fac_right : ∀ (s : pushout_cocone f g), inr t ≫ desc s = inr s)
    (uniq :
      ∀ (s : pushout_cocone f g) (m : cocone.X t ⟶ cocone.X s),
        (∀ (j : walking_span), nat_trans.app (cocone.ι t) j ≫ m = nat_trans.app (cocone.ι s) j) →
          m = desc s) :
    is_colimit t :=
  is_colimit.mk desc

/-- This is another convenient method to verify that a pushout cocone is a colimit cocone. It
    only asks for a proof of facts that carry any mathematical content, and allows access to the
    same `s` for all parts. -/
def is_colimit_aux' {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z}
    (t : pushout_cocone f g)
    (create :
      (s : pushout_cocone f g) →
        Subtype
          fun (l : cocone.X t ⟶ cocone.X s) =>
            inl t ≫ l = inl s ∧
              inr t ≫ l = inr s ∧
                ∀ {m : cocone.X t ⟶ cocone.X s}, inl t ≫ m = inl s → inr t ≫ m = inr s → m = l) :
    is_colimit t :=
  is_colimit_aux t (fun (s : pushout_cocone f g) => subtype.val (create s)) sorry sorry sorry

/-- A pushout cocone on `f` and `g` is determined by morphisms `inl : Y ⟶ W` and `inr : Z ⟶ W` such
    that `f ≫ inl = g ↠ inr`. -/
def mk {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} {W : C}
    (inl : Y ⟶ W) (inr : Z ⟶ W) (eq : f ≫ inl = g ≫ inr) : pushout_cocone f g :=
  cocone.mk W
    (nat_trans.mk
      fun (j : walking_span) =>
        option.cases_on j (f ≫ inl) fun (j' : walking_pair) => walking_pair.cases_on j' inl inr)

@[simp] theorem mk_ι_app_left {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y}
    {g : X ⟶ Z} {W : C} (inl : Y ⟶ W) (inr : Z ⟶ W) (eq : f ≫ inl = g ≫ inr) :
    nat_trans.app (cocone.ι (mk inl inr eq)) walking_span.left = inl :=
  rfl

@[simp] theorem mk_ι_app_right {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y}
    {g : X ⟶ Z} {W : C} (inl : Y ⟶ W) (inr : Z ⟶ W) (eq : f ≫ inl = g ≫ inr) :
    nat_trans.app (cocone.ι (mk inl inr eq)) walking_span.right = inr :=
  rfl

@[simp] theorem mk_ι_app_zero {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y}
    {g : X ⟶ Z} {W : C} (inl : Y ⟶ W) (inr : Z ⟶ W) (eq : f ≫ inl = g ≫ inr) :
    nat_trans.app (cocone.ι (mk inl inr eq)) walking_span.zero = f ≫ inl :=
  rfl

@[simp] theorem mk_inl {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z}
    {W : C} (inl : Y ⟶ W) (inr : Z ⟶ W) (eq : f ≫ inl = g ≫ inr) : inl (mk inl inr eq) = inl :=
  rfl

@[simp] theorem mk_inr {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z}
    {W : C} (inl : Y ⟶ W) (inr : Z ⟶ W) (eq : f ≫ inl = g ≫ inr) : inr (mk inl inr eq) = inr :=
  rfl

theorem condition_assoc {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z}
    (t : pushout_cocone f g) {X' : C} (f' : cocone.X t ⟶ X') : f ≫ inl t ≫ f' = g ≫ inr t ≫ f' :=
  sorry

/-- To check whether a morphism is coequalized by the maps of a pushout cocone, it suffices to check
  it for `inl t` and `inr t` -/
theorem coequalizer_ext {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z}
    (t : pushout_cocone f g) {W : C} {k : cocone.X t ⟶ W} {l : cocone.X t ⟶ W}
    (h₀ : inl t ≫ k = inl t ≫ l) (h₁ : inr t ≫ k = inr t ≫ l) (j : walking_span) :
    nat_trans.app (cocone.ι t) j ≫ k = nat_trans.app (cocone.ι t) j ≫ l :=
  sorry

theorem is_colimit.hom_ext {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z}
    {t : pushout_cocone f g} (ht : is_colimit t) {W : C} {k : cocone.X t ⟶ W} {l : cocone.X t ⟶ W}
    (h₀ : inl t ≫ k = inl t ≫ l) (h₁ : inr t ≫ k = inr t ≫ l) : k = l :=
  is_colimit.hom_ext ht (coequalizer_ext t h₀ h₁)

/-- If `t` is a colimit pushout cocone over `f` and `g` and `h : Y ⟶ W` and `k : Z ⟶ W` are
    morphisms satisfying `f ≫ h = g ≫ k`, then we have a factorization `l : t.X ⟶ W` such that
    `inl t ≫ l = h` and `inr t ≫ l = k`. -/
def is_colimit.desc' {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z}
    {t : pushout_cocone f g} (ht : is_colimit t) {W : C} (h : Y ⟶ W) (k : Z ⟶ W)
    (w : f ≫ h = g ≫ k) : Subtype fun (l : cocone.X t ⟶ W) => inl t ≫ l = h ∧ inr t ≫ l = k :=
  { val := is_colimit.desc ht (mk h k w), property := sorry }

/--
This is a more convenient formulation to show that a `pushout_cocone` constructed using
`pushout_cocone.mk` is a colimit cocone.
-/
def is_colimit.mk {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} {W : C}
    {inl : Y ⟶ W} {inr : Z ⟶ W} (eq : f ≫ inl = g ≫ inr)
    (desc : (s : pushout_cocone f g) → W ⟶ cocone.X s)
    (fac_left : ∀ (s : pushout_cocone f g), inl ≫ desc s = inl s)
    (fac_right : ∀ (s : pushout_cocone f g), inr ≫ desc s = inr s)
    (uniq :
      ∀ (s : pushout_cocone f g) (m : W ⟶ cocone.X s),
        inl ≫ m = inl s → inr ≫ m = inr s → m = desc s) :
    is_colimit (mk inl inr eq) :=
  is_colimit_aux (mk inl inr eq) desc fac_left fac_right sorry

/-- The flip of a pushout square is a pushout square. -/
def flip_is_colimit {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z}
    {W : C} {h : Y ⟶ W} {k : Z ⟶ W} {comm : f ≫ h = g ≫ k}
    (t : is_colimit (mk k h flip_is_colimit._proof_1)) : is_colimit (mk h k comm) :=
  is_colimit_aux' (mk h k comm)
    fun (s : pushout_cocone f g) =>
      { val := subtype.val (is_colimit.desc' t (inr s) (inl s) sorry), property := sorry }

end pushout_cocone

/-- This is a helper construction that can be useful when verifying that a category has all
    pullbacks. Given `F : walking_cospan ⥤ C`, which is really the same as
    `cospan (F.map inl) (F.map inr)`, and a pullback cone on `F.map inl` and `F.map inr`, we
    get a cone on `F`.

    If you're thinking about using this, have a look at `has_pullbacks_of_has_limit_cospan`,
    which you may find to be an easier way of achieving your goal. -/
@[simp] theorem cone.of_pullback_cone_π {C : Type u} [category C] {F : walking_cospan ⥤ C}
    (t :
      pullback_cone (functor.map F walking_cospan.hom.inl) (functor.map F walking_cospan.hom.inr)) :
    cone.π (cone.of_pullback_cone t) = cone.π t ≫ iso.inv (diagram_iso_cospan F) :=
  Eq.refl (cone.π (cone.of_pullback_cone t))

/-- This is a helper construction that can be useful when verifying that a category has all
    pushout. Given `F : walking_span ⥤ C`, which is really the same as
    `span (F.map fst) (F.mal snd)`, and a pushout cocone on `F.map fst` and `F.map snd`,
    we get a cocone on `F`.

    If you're thinking about using this, have a look at `has_pushouts_of_has_colimit_span`, which
    you may find to be an easiery way of achieving your goal.  -/
@[simp] theorem cocone.of_pushout_cocone_X {C : Type u} [category C] {F : walking_span ⥤ C}
    (t : pushout_cocone (functor.map F walking_span.hom.fst) (functor.map F walking_span.hom.snd)) :
    cocone.X (cocone.of_pushout_cocone t) = cocone.X t :=
  Eq.refl (cocone.X (cocone.of_pushout_cocone t))

/-- Given `F : walking_cospan ⥤ C`, which is really the same as `cospan (F.map inl) (F.map inr)`,
    and a cone on `F`, we get a pullback cone on `F.map inl` and `F.map inr`. -/
@[simp] theorem pullback_cone.of_cone_X {C : Type u} [category C] {F : walking_cospan ⥤ C}
    (t : cone F) : cone.X (pullback_cone.of_cone t) = cone.X t :=
  Eq.refl (cone.X (pullback_cone.of_cone t))

/-- Given `F : walking_span ⥤ C`, which is really the same as `span (F.map fst) (F.map snd)`,
    and a cocone on `F`, we get a pushout cocone on `F.map fst` and `F.map snd`. -/
def pushout_cocone.of_cocone {C : Type u} [category C] {F : walking_span ⥤ C} (t : cocone F) :
    pushout_cocone (functor.map F walking_span.hom.fst) (functor.map F walking_span.hom.snd) :=
  cocone.mk (cocone.X t) (iso.inv (diagram_iso_span F) ≫ cocone.ι t)

/--
`has_pullback f g` represents a particular choice of limiting cone
for the pair of morphisms `f : X ⟶ Z` and `g : Y ⟶ Z`.
-/
/--
def has_pullback {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) :=
  has_limit (cospan f g)

`has_pushout f g` represents a particular choice of colimiting cocone
for the pair of morphisms `f : X ⟶ Y` and `g : X ⟶ Z`.
-/
def has_pushout {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : X ⟶ Z) :=
  has_colimit (span f g)

/-- `pullback f g` computes the pullback of a pair of morphisms with the same target. -/
def pullback {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z) (g : Y ⟶ Z)
    [has_pullback f g] : C :=
  limit (cospan f g)

/-- `pushout f g` computes the pushout of a pair of morphisms with the same source. -/
def pushout {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : X ⟶ Z)
    [has_pushout f g] : C :=
  colimit (span f g)

/-- The first projection of the pullback of `f` and `g`. -/
def pullback.fst {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}
    [has_pullback f g] : pullback f g ⟶ X :=
  limit.π (cospan f g) walking_cospan.left

/-- The second projection of the pullback of `f` and `g`. -/
def pullback.snd {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}
    [has_pullback f g] : pullback f g ⟶ Y :=
  limit.π (cospan f g) walking_cospan.right

/-- The first inclusion into the pushout of `f` and `g`. -/
def pushout.inl {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z}
    [has_pushout f g] : Y ⟶ pushout f g :=
  colimit.ι (span f g) walking_span.left

/-- The second inclusion into the pushout of `f` and `g`. -/
def pushout.inr {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z}
    [has_pushout f g] : Z ⟶ pushout f g :=
  colimit.ι (span f g) walking_span.right

/-- A pair of morphisms `h : W ⟶ X` and `k : W ⟶ Y` satisfying `h ≫ f = k ≫ g` induces a morphism
    `pullback.lift : W ⟶ pullback f g`. -/
def pullback.lift {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}
    [has_pullback f g] (h : W ⟶ X) (k : W ⟶ Y) (w : h ≫ f = k ≫ g) : W ⟶ pullback f g :=
  limit.lift (cospan f g) (pullback_cone.mk h k w)

/-- A pair of morphisms `h : Y ⟶ W` and `k : Z ⟶ W` satisfying `f ≫ h = g ≫ k` induces a morphism
    `pushout.desc : pushout f g ⟶ W`. -/
def pushout.desc {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z}
    [has_pushout f g] (h : Y ⟶ W) (k : Z ⟶ W) (w : f ≫ h = g ≫ k) : pushout f g ⟶ W :=
  colimit.desc (span f g) (pushout_cocone.mk h k w)

@[simp] theorem pullback.lift_fst_assoc {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C}
    {f : X ⟶ Z} {g : Y ⟶ Z} [has_pullback f g] (h : W ⟶ X) (k : W ⟶ Y) (w : h ≫ f = k ≫ g) {X' : C}
    (f' : X ⟶ X') : pullback.lift h k w ≫ pullback.fst ≫ f' = h ≫ f' :=
  sorry

@[simp] theorem pullback.lift_snd_assoc {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C}
    {f : X ⟶ Z} {g : Y ⟶ Z} [has_pullback f g] (h : W ⟶ X) (k : W ⟶ Y) (w : h ≫ f = k ≫ g) {X' : C}
    (f' : Y ⟶ X') : pullback.lift h k w ≫ pullback.snd ≫ f' = k ≫ f' :=
  sorry

@[simp] theorem pushout.inl_desc_assoc {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C}
    {f : X ⟶ Y} {g : X ⟶ Z} [has_pushout f g] (h : Y ⟶ W) (k : Z ⟶ W) (w : f ≫ h = g ≫ k) {X' : C}
    (f' : W ⟶ X') : pushout.inl ≫ pushout.desc h k w ≫ f' = h ≫ f' :=
  sorry

@[simp] theorem pushout.inr_desc_assoc {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C}
    {f : X ⟶ Y} {g : X ⟶ Z} [has_pushout f g] (h : Y ⟶ W) (k : Z ⟶ W) (w : f ≫ h = g ≫ k) {X' : C}
    (f' : W ⟶ X') : pushout.inr ≫ pushout.desc h k w ≫ f' = k ≫ f' :=
  sorry

/-- A pair of morphisms `h : W ⟶ X` and `k : W ⟶ Y` satisfying `h ≫ f = k ≫ g` induces a morphism
    `l : W ⟶ pullback f g` such that `l ≫ pullback.fst = h` and `l ≫ pullback.snd = k`. -/
def pullback.lift' {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}
    [has_pullback f g] (h : W ⟶ X) (k : W ⟶ Y) (w : h ≫ f = k ≫ g) :
    Subtype fun (l : W ⟶ pullback f g) => l ≫ pullback.fst = h ∧ l ≫ pullback.snd = k :=
  { val := pullback.lift h k w, property := sorry }

/-- A pair of morphisms `h : Y ⟶ W` and `k : Z ⟶ W` satisfying `f ≫ h = g ≫ k` induces a morphism
    `l : pushout f g ⟶ W` such that `pushout.inl ≫ l = h` and `pushout.inr ≫ l = k`. -/
def pullback.desc' {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z}
    [has_pushout f g] (h : Y ⟶ W) (k : Z ⟶ W) (w : f ≫ h = g ≫ k) :
    Subtype fun (l : pushout f g ⟶ W) => pushout.inl ≫ l = h ∧ pushout.inr ≫ l = k :=
  { val := pushout.desc h k w, property := sorry }

theorem pullback.condition {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}
    [has_pullback f g] : pullback.fst ≫ f = pullback.snd ≫ g :=
  pullback_cone.condition (limit.cone (cospan f g))

theorem pushout.condition_assoc {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y}
    {g : X ⟶ Z} [has_pushout f g] {X' : C} (f' : pushout f g ⟶ X') :
    f ≫ pushout.inl ≫ f' = g ≫ pushout.inr ≫ f' :=
  sorry

/-- Two morphisms into a pullback are equal if their compositions with the pullback morphisms are
    equal -/
theorem pullback.hom_ext {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}
    [has_pullback f g] {W : C} {k : W ⟶ pullback f g} {l : W ⟶ pullback f g}
    (h₀ : k ≫ pullback.fst = l ≫ pullback.fst) (h₁ : k ≫ pullback.snd = l ≫ pullback.snd) : k = l :=
  limit.hom_ext (pullback_cone.equalizer_ext (limit.cone (cospan f g)) h₀ h₁)

/-- The pullback cone built from the pullback projections is a pullback. -/
def pullback_is_pullback {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z) (g : Y ⟶ Z)
    [has_pullback f g] : is_limit (pullback_cone.mk pullback.fst pullback.snd pullback.condition) :=
  pullback_cone.is_limit.mk pullback.condition
    (fun (s : pullback_cone f g) =>
      pullback.lift (pullback_cone.fst s) (pullback_cone.snd s) (pullback_cone.condition s))
    sorry sorry sorry

/-- The pullback of a monomorphism is a monomorphism -/
protected instance pullback.fst_of_mono {C : Type u} [category C] {X : C} {Y : C} {Z : C}
    {f : X ⟶ Z} {g : Y ⟶ Z} [has_pullback f g] [mono g] : mono pullback.fst :=
  sorry

/-- The pullback of a monomorphism is a monomorphism -/
protected instance pullback.snd_of_mono {C : Type u} [category C] {X : C} {Y : C} {Z : C}
    {f : X ⟶ Z} {g : Y ⟶ Z} [has_pullback f g] [mono f] : mono pullback.snd :=
  sorry

/-- Two morphisms out of a pushout are equal if their compositions with the pushout morphisms are
    equal -/
theorem pushout.hom_ext {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z}
    [has_pushout f g] {W : C} {k : pushout f g ⟶ W} {l : pushout f g ⟶ W}
    (h₀ : pushout.inl ≫ k = pushout.inl ≫ l) (h₁ : pushout.inr ≫ k = pushout.inr ≫ l) : k = l :=
  colimit.hom_ext (pushout_cocone.coequalizer_ext (colimit.cocone (span f g)) h₀ h₁)

/-- The pushout of an epimorphism is an epimorphism -/
protected instance pushout.inl_of_epi {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y}
    {g : X ⟶ Z} [has_pushout f g] [epi g] : epi pushout.inl :=
  epi.mk
    fun (W : C) (u v : pushout f g ⟶ W) (h : pushout.inl ≫ u = pushout.inl ≫ v) =>
      pushout.hom_ext h
        (iff.mp (cancel_epi g)
          (eq.mpr
            (id
              (Eq.trans
                ((fun (a a_1 : X ⟶ W) (e_1 : a = a_1) (ᾰ ᾰ_1 : X ⟶ W) (e_2 : ᾰ = ᾰ_1) =>
                    congr (congr_arg Eq e_1) e_2)
                  (g ≫ pushout.inr ≫ u) (f ≫ pushout.inl ≫ v)
                  (Eq.trans (Eq.symm (pushout.condition_assoc u))
                    ((fun (ᾰ ᾰ_1 : X ⟶ Y) (e_1 : ᾰ = ᾰ_1) (ᾰ_2 ᾰ_3 : Y ⟶ W) (e_2 : ᾰ_2 = ᾰ_3) =>
                        congr (congr_arg category_struct.comp e_1) e_2)
                      f f (Eq.refl f) (pushout.inl ≫ u) (pushout.inl ≫ v) h))
                  (g ≫ pushout.inr ≫ v) (f ≫ pushout.inl ≫ v) (Eq.symm (pushout.condition_assoc v)))
                (propext (eq_self_iff_true (f ≫ pushout.inl ≫ v)))))
            trivial))

/-- The pushout of an epimorphism is an epimorphism -/
protected instance pushout.inr_of_epi {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y}
    {g : X ⟶ Z} [has_pushout f g] [epi f] : epi pushout.inr :=
  epi.mk
    fun (W : C) (u v : pushout f g ⟶ W) (h : pushout.inr ≫ u = pushout.inr ≫ v) =>
      pushout.hom_ext
        (iff.mp (cancel_epi f)
          (eq.mpr
            (id
              (Eq.trans
                ((fun (a a_1 : X ⟶ W) (e_1 : a = a_1) (ᾰ ᾰ_1 : X ⟶ W) (e_2 : ᾰ = ᾰ_1) =>
                    congr (congr_arg Eq e_1) e_2)
                  (f ≫ pushout.inl ≫ u) (g ≫ pushout.inr ≫ v)
                  (Eq.trans (pushout.condition_assoc u)
                    ((fun (ᾰ ᾰ_1 : X ⟶ Z) (e_1 : ᾰ = ᾰ_1) (ᾰ_2 ᾰ_3 : Z ⟶ W) (e_2 : ᾰ_2 = ᾰ_3) =>
                        congr (congr_arg category_struct.comp e_1) e_2)
                      g g (Eq.refl g) (pushout.inr ≫ u) (pushout.inr ≫ v) h))
                  (f ≫ pushout.inl ≫ v) (g ≫ pushout.inr ≫ v) (pushout.condition_assoc v))
                (propext (eq_self_iff_true (g ≫ pushout.inr ≫ v)))))
            trivial))
        h

/--
The comparison morphism for the pullback of `f,g`.
This is an isomorphism iff `G` preserves the pullback of `f,g`; see
`category_theory/limits/preserves/shapes/pullbacks.lean`
-/
def pullback_comparison {C : Type u} [category C] {X : C} {Y : C} {Z : C} {D : Type u₂} [category D]
    (G : C ⥤ D) (f : X ⟶ Z) (g : Y ⟶ Z) [has_pullback f g]
    [has_pullback (functor.map G f) (functor.map G g)] :
    functor.obj G (pullback f g) ⟶ pullback (functor.map G f) (functor.map G g) :=
  pullback.lift (functor.map G pullback.fst) (functor.map G pullback.snd) sorry

@[simp] theorem pullback_comparison_comp_fst_assoc {C : Type u} [category C] {X : C} {Y : C} {Z : C}
    {D : Type u₂} [category D] (G : C ⥤ D) (f : X ⟶ Z) (g : Y ⟶ Z) [has_pullback f g]
    [has_pullback (functor.map G f) (functor.map G g)] {X' : D} (f' : functor.obj G X ⟶ X') :
    pullback_comparison G f g ≫ pullback.fst ≫ f' = functor.map G pullback.fst ≫ f' :=
  sorry

@[simp] theorem pullback_comparison_comp_snd_assoc {C : Type u} [category C] {X : C} {Y : C} {Z : C}
    {D : Type u₂} [category D] (G : C ⥤ D) (f : X ⟶ Z) (g : Y ⟶ Z) [has_pullback f g]
    [has_pullback (functor.map G f) (functor.map G g)] {X' : D} (f' : functor.obj G Y ⟶ X') :
    pullback_comparison G f g ≫ pullback.snd ≫ f' = functor.map G pullback.snd ≫ f' :=
  sorry

@[simp] theorem map_lift_pullback_comparison_assoc {C : Type u} [category C] {X : C} {Y : C} {Z : C}
    {D : Type u₂} [category D] (G : C ⥤ D) (f : X ⟶ Z) (g : Y ⟶ Z) [has_pullback f g]
    [has_pullback (functor.map G f) (functor.map G g)] {W : C} {h : W ⟶ X} {k : W ⟶ Y}
    (w : h ≫ f = k ≫ g) {X' : D} (f' : pullback (functor.map G f) (functor.map G g) ⟶ X') :
    functor.map G (pullback.lift h k w) ≫ pullback_comparison G f g ≫ f' =
        pullback.lift (functor.map G h) (functor.map G k)
            (eq.mpr
              (id
                ((fun (a a_1 : functor.obj G W ⟶ functor.obj G Z) (e_1 : a = a_1)
                    (ᾰ ᾰ_1 : functor.obj G W ⟶ functor.obj G Z) (e_2 : ᾰ = ᾰ_1) =>
                    congr (congr_arg Eq e_1) e_2)
                  (functor.map G h ≫ functor.map G f) (functor.map G (k ≫ g))
                  (Eq.trans (Eq.symm (functor.map_comp G h f))
                    ((fun (c : C ⥤ D) {X Y : C} (ᾰ ᾰ_1 : X ⟶ Y) (e_4 : ᾰ = ᾰ_1) =>
                        congr_arg (functor.map c) e_4)
                      G (h ≫ f) (k ≫ g) w))
                  (functor.map G k ≫ functor.map G g) (functor.map G (k ≫ g))
                  (Eq.symm (functor.map_comp G k g))))
              (Eq.refl (functor.map G (k ≫ g)))) ≫
          f' :=
  sorry

/--
`has_pullbacks` represents a choice of pullback for every pair of morphisms

See https://stacks.math.columbia.edu/tag/001W.
-/
def has_pullbacks (C : Type u) [category C] := has_limits_of_shape walking_cospan C

/-- `has_pushouts` represents a choice of pushout for every pair of morphisms -/
def has_pushouts (C : Type u) [category C] := has_colimits_of_shape walking_span C

/-- If `C` has all limits of diagrams `cospan f g`, then it has all pullbacks -/
theorem has_pullbacks_of_has_limit_cospan (C : Type u) [category C]
    [∀ {X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}, has_limit (cospan f g)] : has_pullbacks C :=
  has_limits_of_shape.mk
    fun (F : walking_cospan ⥤ C) => has_limit_of_iso (iso.symm (diagram_iso_cospan F))

/-- If `C` has all colimits of diagrams `span f g`, then it has all pushouts -/
theorem has_pushouts_of_has_colimit_span (C : Type u) [category C]
    [∀ {X Y Z : C} {f : X ⟶ Y} {g : X ⟶ Z}, has_colimit (span f g)] : has_pushouts C :=
  has_colimits_of_shape.mk fun (F : walking_span ⥤ C) => has_colimit_of_iso (diagram_iso_span F)

end Mathlib


/-
Copyright (c) 2022 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 order.category.BddLat
! leanprover-community/mathlib commit e8ac6315bcfcbaf2d19a046719c3b553206dac75
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Order.Category.BddOrd
import Mathbin.Order.Category.Lat
import Mathbin.Order.Category.Semilat

/-!
# The category of bounded lattices

This file defines `BddLat`, the category of bounded lattices.

In literature, this is sometimes called `Lat`, the category of lattices, because being a lattice is
understood to entail having a bottom and a top element.
-/

universe u

open CategoryTheory

/-- The category of bounded lattices with bounded lattice morphisms. -/
structure BddLat where
  toLat : Lat
  [isBoundedOrder : BoundedOrder to_Lat]
#align BddLat BddLat

namespace BddLat

instance : CoeSort BddLat (Type _) :=
  ⟨fun X => X.toLat⟩

instance (X : BddLat) : Lattice X :=
  X.toLat.str

attribute [instance] BddLat.isBoundedOrder

/-- Construct a bundled `BddLat` from `lattice` + `bounded_order`. -/
def of (α : Type _) [Lattice α] [BoundedOrder α] : BddLat :=
  ⟨⟨α⟩⟩
#align BddLat.of BddLat.of

@[simp]
theorem coe_of (α : Type _) [Lattice α] [BoundedOrder α] : ↥(of α) = α :=
  rfl
#align BddLat.coe_of BddLat.coe_of

instance : Inhabited BddLat :=
  ⟨of PUnit⟩

instance : LargeCategory.{u} BddLat
    where
  Hom X Y := BoundedLatticeHom X Y
  id X := BoundedLatticeHom.id X
  comp X Y Z f g := g.comp f
  id_comp' X Y := BoundedLatticeHom.comp_id
  comp_id' X Y := BoundedLatticeHom.id_comp
  assoc' W X Y Z _ _ _ := BoundedLatticeHom.comp_assoc _ _ _

instance : ConcreteCategory BddLat
    where
  forget := ⟨coeSort, fun X Y => coeFn, fun X => rfl, fun X Y Z f g => rfl⟩
  forget_faithful := ⟨fun X Y => by convert FunLike.coe_injective⟩

instance hasForgetToBddOrd : HasForget₂ BddLat BddOrd
    where forget₂ :=
    { obj := fun X => BddOrd.of X
      map := fun X Y => BoundedLatticeHom.toBoundedOrderHom }
#align BddLat.has_forget_to_BddOrd BddLat.hasForgetToBddOrd

instance hasForgetToLat : HasForget₂ BddLat Lat
    where forget₂ :=
    { obj := fun X => ⟨X⟩
      map := fun X Y => BoundedLatticeHom.toLatticeHom }
#align BddLat.has_forget_to_Lat BddLat.hasForgetToLat

instance hasForgetToSemilatSup : HasForget₂ BddLat SemilatSup
    where forget₂ :=
    { obj := fun X => ⟨X⟩
      map := fun X Y => BoundedLatticeHom.toSupBotHom }
#align BddLat.has_forget_to_SemilatSup BddLat.hasForgetToSemilatSup

instance hasForgetToSemilatInf : HasForget₂ BddLat SemilatInf
    where forget₂ :=
    { obj := fun X => ⟨X⟩
      map := fun X Y => BoundedLatticeHom.toInfTopHom }
#align BddLat.has_forget_to_SemilatInf BddLat.hasForgetToSemilatInf

@[simp]
theorem coe_forget_to_bddOrd (X : BddLat) : ↥((forget₂ BddLat BddOrd).obj X) = ↥X :=
  rfl
#align BddLat.coe_forget_to_BddOrd BddLat.coe_forget_to_bddOrd

@[simp]
theorem coe_forget_to_lat (X : BddLat) : ↥((forget₂ BddLat Lat).obj X) = ↥X :=
  rfl
#align BddLat.coe_forget_to_Lat BddLat.coe_forget_to_lat

@[simp]
theorem coe_forget_to_semilatSup (X : BddLat) : ↥((forget₂ BddLat SemilatSup).obj X) = ↥X :=
  rfl
#align BddLat.coe_forget_to_SemilatSup BddLat.coe_forget_to_semilatSup

@[simp]
theorem coe_forget_to_semilatInf (X : BddLat) : ↥((forget₂ BddLat SemilatInf).obj X) = ↥X :=
  rfl
#align BddLat.coe_forget_to_SemilatInf BddLat.coe_forget_to_semilatInf

theorem forget_lat_partOrd_eq_forget_bddOrd_partOrd :
    forget₂ BddLat Lat ⋙ forget₂ Lat PartOrd = forget₂ BddLat BddOrd ⋙ forget₂ BddOrd PartOrd :=
  rfl
#align BddLat.forget_Lat_PartOrd_eq_forget_BddOrd_PartOrd BddLat.forget_lat_partOrd_eq_forget_bddOrd_partOrd

theorem forget_semilatSup_partOrd_eq_forget_bddOrd_partOrd :
    forget₂ BddLat SemilatSup ⋙ forget₂ SemilatSup PartOrd =
      forget₂ BddLat BddOrd ⋙ forget₂ BddOrd PartOrd :=
  rfl
#align BddLat.forget_SemilatSup_PartOrd_eq_forget_BddOrd_PartOrd BddLat.forget_semilatSup_partOrd_eq_forget_bddOrd_partOrd

theorem forget_semilatInf_partOrd_eq_forget_bddOrd_partOrd :
    forget₂ BddLat SemilatInf ⋙ forget₂ SemilatInf PartOrd =
      forget₂ BddLat BddOrd ⋙ forget₂ BddOrd PartOrd :=
  rfl
#align BddLat.forget_SemilatInf_PartOrd_eq_forget_BddOrd_PartOrd BddLat.forget_semilatInf_partOrd_eq_forget_bddOrd_partOrd

/-- Constructs an equivalence between bounded lattices from an order isomorphism
between them. -/
@[simps]
def Iso.mk {α β : BddLat.{u}} (e : α ≃o β) : α ≅ β
    where
  Hom := e
  inv := e.symm
  hom_inv_id' := by
    ext
    exact e.symm_apply_apply _
  inv_hom_id' := by
    ext
    exact e.apply_symm_apply _
#align BddLat.iso.mk BddLat.Iso.mk

/-- `order_dual` as a functor. -/
@[simps]
def dual : BddLat ⥤ BddLat where
  obj X := of Xᵒᵈ
  map X Y := BoundedLatticeHom.dual
#align BddLat.dual BddLat.dual

/-- The equivalence between `BddLat` and itself induced by `order_dual` both ways. -/
@[simps Functor inverse]
def dualEquiv : BddLat ≌ BddLat :=
  Equivalence.mk dual dual
    (NatIso.ofComponents (fun X => Iso.mk <| OrderIso.dualDual X) fun X Y f => rfl)
    (NatIso.ofComponents (fun X => Iso.mk <| OrderIso.dualDual X) fun X Y f => rfl)
#align BddLat.dual_equiv BddLat.dualEquiv

end BddLat

theorem bddLat_dual_comp_forget_to_bddOrd :
    BddLat.dual ⋙ forget₂ BddLat BddOrd = forget₂ BddLat BddOrd ⋙ BddOrd.dual :=
  rfl
#align BddLat_dual_comp_forget_to_BddOrd bddLat_dual_comp_forget_to_bddOrd

theorem bddLat_dual_comp_forget_to_lat :
    BddLat.dual ⋙ forget₂ BddLat Lat = forget₂ BddLat Lat ⋙ Lat.dual :=
  rfl
#align BddLat_dual_comp_forget_to_Lat bddLat_dual_comp_forget_to_lat

theorem bddLat_dual_comp_forget_to_semilatSup :
    BddLat.dual ⋙ forget₂ BddLat SemilatSup = forget₂ BddLat SemilatInf ⋙ SemilatInf.dual :=
  rfl
#align BddLat_dual_comp_forget_to_SemilatSup bddLat_dual_comp_forget_to_semilatSup

theorem bddLat_dual_comp_forget_to_semilatInf :
    BddLat.dual ⋙ forget₂ BddLat SemilatInf = forget₂ BddLat SemilatSup ⋙ SemilatSup.dual :=
  rfl
#align BddLat_dual_comp_forget_to_SemilatInf bddLat_dual_comp_forget_to_semilatInf


import data.real.basic

example (x y : ℝ) : x + y = y + x := by simp


import Kenny_comm_alg.ideal_lattice

noncomputable theory
local attribute [instance] classical.prop_decidable

universe u

namespace is_ideal

section minimal_prime_ideal

parameters {α : Type u} [comm_ring α]
parameters (I : set α) [hi : is_ideal I]
parameters (P : set α) [hp : is_prime_ideal P]
parameters (hip : I ⊆ P)
include hi hp hip

private theorem find_minimal_prime_ideal_aux :
  ∃ (M : {S // I ⊆ S ∧ S ⊆ P ∧ is_prime_ideal S}), ∀ x, x ≤ M → x = M :=
@@zorn.zorn' (order_dual {S // I ⊆ S ∧ S ⊆ P ∧ is_prime_ideal S})
_
⟨⟨P, hip, set.subset.refl P, hp⟩⟩ $
λ c x hxc hc, ⟨⟨{y | ∀ S : {S // I ⊆ S ∧ S ⊆ P ∧ is_prime_ideal S}, S ∈ c → y ∈ S.val},
  λ z hz S hsc, S.2.1 hz,
  λ z hz, x.2.2.1 $ hz x hxc,
  { zero_ := λ S hsc, @@is_ideal.zero _ S.1
      S.2.2.2.to_is_proper_ideal.to_is_ideal,
    add_ := λ x y hx hy S hsc, @@is_ideal.add _
      S.2.2.2.to_is_proper_ideal.to_is_ideal
      (hx S hsc) (hy S hsc),
    smul := λ x y hy S hsc, @@is_ideal.mul_left _
      S.2.2.2.to_is_proper_ideal.to_is_ideal
      (hy S hsc),
    ne_univ := λ h, @is_proper_ideal.ne_univ α _ x.1 x.2.2.2.1 $
      @is_submodule.univ_of_one_mem α _ x.1 x.2.2.2.1.1.1 $
      by rw set.eq_univ_iff_forall at h;
      exact h 1 x hxc,
    mem_or_mem_of_mul_mem := λ x y hxy,
      or_iff_not_and_not.2 $ λ ⟨hx, hy⟩,
      let ⟨Sx, hsx⟩ := not_forall.1 hx in
      let ⟨hxc, hxs⟩ := not_imp.1 hsx in
      let ⟨Sy, hsy⟩ := not_forall.1 hy in
      let ⟨hyc, hys⟩ := not_imp.1 hsy in
      or.cases_on (hc Sx Sy hxc hyc)
        (λ hSxy, hxs $ hSxy $ or.resolve_right
           (@@is_prime_ideal.mem_or_mem_of_mul_mem _ Sy.2.2.2 $ hxy Sy hyc)
           hys)
        (λ hSyx, hys $ hSyx $ or.resolve_left
           (@@is_prime_ideal.mem_or_mem_of_mul_mem _ Sx.2.2.2 $ hxy Sx hxc)
           hxs) }⟩,
λ S hsc z hz, hz S hsc⟩

def find_minimal_prime_ideal : set α :=
(classical.some find_minimal_prime_ideal_aux).1

theorem find_minimal_prime_ideal.ideal_contains : I ⊆ find_minimal_prime_ideal :=
(classical.some find_minimal_prime_ideal_aux).2.1

theorem find_minimal_prime_ideal.contains_prime : find_minimal_prime_ideal ⊆ P :=
(classical.some find_minimal_prime_ideal_aux).2.2.1

def find_minimal_prime_ideal.is_prime_ideal :
  is_prime_ideal find_minimal_prime_ideal :=
(classical.some find_minimal_prime_ideal_aux).2.2.2

def find_minimal_prime_ideal.minimal (S : set α) [hs : is_prime_ideal S]
  (his : I ⊆ S) (hsm : S ⊆ find_minimal_prime_ideal) :
  S = find_minimal_prime_ideal :=
congr_arg subtype.val $
classical.some_spec
  find_minimal_prime_ideal_aux
  ⟨S, his, set.subset.trans hsm find_minimal_prime_ideal.contains_prime, hs⟩ hsm

private theorem find_minimal_prime_ideal_aux' :
  ∃ (M : {S // I ⊆ S ∧ is_prime_ideal S}), ∀ x, x ≤ M → x = M :=
@@zorn.zorn' (order_dual {S // I ⊆ S ∧ is_prime_ideal S})
_
⟨⟨P, hip, hp⟩⟩ $
λ c x hxc hc, ⟨⟨{y | ∀ S : {S // I ⊆ S ∧ is_prime_ideal S}, S ∈ c → y ∈ S.val},
  λ z hz S hsc, S.2.1 hz,
  { zero_ := λ S hsc, @@is_ideal.zero _ S.1
      S.2.2.to_is_proper_ideal.to_is_ideal,
    add_ := λ x y hx hy S hsc, @@is_ideal.add _
      S.2.2.to_is_proper_ideal.to_is_ideal
      (hx S hsc) (hy S hsc),
    smul := λ x y hy S hsc, @@is_ideal.mul_left _
      S.2.2.to_is_proper_ideal.to_is_ideal
      (hy S hsc),
    ne_univ := λ h, @is_proper_ideal.ne_univ α _ x.1 x.2.2.1 $
      @is_submodule.univ_of_one_mem α _ x.1 x.2.2.1.1.1 $
      by rw set.eq_univ_iff_forall at h;
      exact h 1 x hxc,
    mem_or_mem_of_mul_mem := λ x y hxy,
      or_iff_not_and_not.2 $ λ ⟨hx, hy⟩,
      let ⟨Sx, hsx⟩ := not_forall.1 hx in
      let ⟨hxc, hxs⟩ := not_imp.1 hsx in
      let ⟨Sy, hsy⟩ := not_forall.1 hy in
      let ⟨hyc, hys⟩ := not_imp.1 hsy in
      or.cases_on (hc Sx Sy hxc hyc)
        (λ hSxy, hxs $ hSxy $ or.resolve_right
           (@@is_prime_ideal.mem_or_mem_of_mul_mem _ Sy.2.2 $ hxy Sy hyc)
           hys)
        (λ hSyx, hys $ hSyx $ or.resolve_left
           (@@is_prime_ideal.mem_or_mem_of_mul_mem _ Sx.2.2 $ hxy Sx hxc)
           hxs) }⟩,
λ S hsc z hz, hz S hsc⟩

def find_minimal_prime_ideal' : set α :=
(classical.some find_minimal_prime_ideal_aux').1

theorem find_minimal_prime_ideal'.ideal_contains : I ⊆ find_minimal_prime_ideal' :=
(classical.some find_minimal_prime_ideal_aux').2.1

def find_minimal_prime_ideal'.is_prime_ideal :
  is_prime_ideal find_minimal_prime_ideal' :=
(classical.some find_minimal_prime_ideal_aux').2.2

def find_minimal_prime_ideal'.minimal (S : set α) [hs : is_prime_ideal S]
  (his : I ⊆ S) (hsm : S ⊆ find_minimal_prime_ideal') :
  S = find_minimal_prime_ideal' :=
congr_arg subtype.val $
classical.some_spec
  find_minimal_prime_ideal_aux'
  ⟨S, his, hs⟩ hsm

end minimal_prime_ideal

end is_ideal


import order.filter.basic

open filter

/- Turn off trace messages so they don't pollute the test build: -/
set_option trace.silence_library_search true

example {α β γ : Type*} {A : filter α} {B : filter β} {C : filter γ} {f : α → β} {g : β → γ}
  (hf : tendsto f A B) (hg : tendsto g B C) : tendsto (g ∘ f) A C :=
calc
map (g ∘ f) A = map g (map f A) : by library_search
          ... ≤ map g B         : by library_search!
          ... ≤ C               : by library_search!


/-example : 1 + 2222 = 2223 :=
begin
  reflexivity
end

theorem foo : 1 + (2222222222222 : nat)  = 2222222222223 :=
begin
  reflexivity
end
-/

theorem bar : 100003 + 100003 = 200006 :=
rfl


import cnf.literal
import cnf.assignment
import cnf.cnf
import cnf.encoding

import cardinality.direct_amo
import cardinality.sinz_amo
import cardinality.distinct
import cardinality.alk
import cardinality.amk

import data.nat.basic
import data.list.basic
import data.list.range

import logic.equiv.fin

open nat
open list
open function
open literal
open encoding
open clause cnf
open assignment
open alk amk distinct
open direct_amo
open sinz_amo

@[derive decidable_eq]
structure graph := {n : ℕ} (p₁ : 0 < n) (p₂ : n < 5) (w : fin n → fin n → ℤ) (a : ∀ x y, w x y = - w y x) (u : ∀ a b c d, a ≠ b → w a b = w c d → (a = c ∧ b = d)) (id: ℕ)

@[derive decidable_eq]
structure pointed_graph := (g : graph) (v : fin g.n)

instance pointed_graph_inhabited : inhabited pointed_graph :=
  inhabited.mk ⟨⟨nat.zero_lt_one, dec_trivial, λ x y, 0, dec_trivial, dec_trivial, 0⟩ , 0⟩

structure graph_embedding := (g₁ : graph) (g₂ : graph) (f : fin g₁.n → fin g₂.n) (x : fin g₂.n) (p : finset.univ \ finset.image f finset.univ = {x}) (e : ∀ a b, g₁.w a b = g₂.w (f a) (f b))

def special1 (e : graph_embedding) (v : fin e.g₁.n) (p : e.g₂.w (e.f v) e.x ≠ 0) : graph :=
  ⟨zero_lt_two, dec_trivial,
    ![![0, |e.g₂.w (e.f v) e.x|], ![-|e.g₂.w (e.f v) e.x|, 0]],
      by simp [fin.forall_fin_two],
      by simp [fin.forall_fin_two, p, eq_neg_self_iff, neg_eq_self_iff],
      int.nat_abs (|e.g₂.w (e.f v) e.x|.div2 - 1)⟩

def special2 (e : graph_embedding) (v : fin e.g₁.n) : fin 2 :=
  (ite (e.g₂.w (e.f v) e.x > 0) 0 1)

def encoding (D : list graph) (E : list graph_embedding) : cnf pointed_graph :=
  -- at least one literal selected for each graph
  (D.map (λ g: graph, list.of_fn (λ v, Pos ⟨g, v⟩))) ++
  -- at most one literal selected for each graph
  join (D.map (λ g: graph, direct_amo (list.of_fn (λ v, Pos ⟨g, v⟩)))) ++
  -- binary gamma for each embedding
  join (E.map (λ e, (list.reduce_option (list.of_fn (λ v, (dite (e.g₂.w (e.f v) e.x = 0) (λ _, none) (λ _x, some [Neg ⟨special1 e v _x, special2 e v⟩, Neg ⟨e.g₁, v⟩, Pos ⟨e.g₂, e.f v⟩])))) )))

--#eval (encoding [⟨1, nat.zero_lt_one, λ x y, 0⟩] nil)

def binary_gamma (E : list graph_embedding) (f : Π g : graph, fin g.n) := ∀ e : graph_embedding, e ∈ E → (∀ x : (e.g₂.w (e.f (f e.g₁)) e.x ≠ 0), (f (special1 e (f e.g₁) x)) = (special2 e (f e.g₁)) → (f e.g₂ = e.f (f e.g₁)))

lemma lemma1 {n : ℕ} (a : ¬ n = 1) (b : ¬ n ≥ 2) : n = 0 := by omega

theorem encodes_binary_gamma : ∀ D E f, binary_gamma E f → (((encoding D E).eval (λ ⟨g, v⟩, f g = v)) = tt) :=
begin
  intros D E f bg,
  rw eval_tt_iff_forall_clause_eval_tt,
  intros cl hcl,
  simp [encoding] at hcl,
  rcases hcl with (⟨g, gd, h⟩ | ⟨g, gd, hcl⟩ | ⟨e, ee, h⟩),
  {
    subst h,
    simp [eval_tt_iff_exists_literal_eval_tt, list.mem_of_fn],
    use f g,
    simp [literal.eval],
  },
  {
    by_cases (length (list.of_fn (λ v, Pos (pointed_graph.mk g v)))) ≥ 2,
    {
      rcases exists_double_flip_eq_of_mem h hcl with ⟨lit₁, lit₂, rfl⟩,
      rcases distinct_iff_mem.mpr hcl with ⟨i, j, hi, hj, hij, rfl, rfl⟩,
      rw eval_tt_iff_exists_literal_eval_tt,
      simp [eval_flip, literal.flip],
      by_contradiction,
      simp [literal.eval] at h,
      cases h with h1 h2,
      rw h1 at h2,
      exact (eq.not_lt (fin.veq_of_eq h2)) hij,
    },
    let h2 := h,
    by_cases (length (list.of_fn (λ v, Pos (pointed_graph.mk g v)))) = 1,
    {
      rw list.length_eq_one at h,
      cases h with a h,
      rw h at hcl,
      rw direct_amo_singleton at hcl,
      exfalso,
      exact list.not_mem_nil cl hcl,
    },
    let h3 := lemma1 h h2,
    {
      rw list.length_eq_zero at h3,
      rw h3 at hcl,
      rw direct_amo_nil at hcl,
      exfalso,
      exact list.not_mem_nil cl hcl,
    },
  },
  {
    rw list.reduce_option_mem_iff at h,
    rw list.mem_of_fn at h,
    rw set.mem_range at h,
    cases h with y h2,
    by_cases (e.g₂.w (e.f y) e.x = 0),
    rw dite_eq_left_iff.mpr (λ nP, by_contra (λ _, nP h)) at h2,
    simp at h2,
    exfalso,
    exact h2,
    change (dite (e.g₂.w (e.f y) e.x = 0) (λ _, none) (λ (_x : ¬e.g₂.w (e.f y) e.x = 0), some [Neg (pointed_graph.mk (special1 e y h) (special2 e y)), Neg ⟨e.g₁, y⟩, Pos ⟨e.g₂, e.f y⟩])) = some cl at h2,

    rw dite_eq_right_iff.mpr (λ P, by_contra (λ _, h P)) at h2,
    simp at h2,
    let h3 := h,

    subst h2,
    simp [eval_tt_iff_exists_literal_eval_tt],
    simp [literal.eval],

    apply not_or_of_imp,
    intro sp,
    apply not_or_of_imp,
    intro veq,

    unfold binary_gamma at bg,
    rw <-veq at h,
    specialize bg e ee,
    rw veq at bg,
    rw veq at h,
    specialize bg h,
    specialize bg sp,
    exact bg,
  }
end


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.basic
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# modular equivalence for submodule
-/

/-- A predicate saying two elements of a module are equivalent modulo a submodule. -/
def smodeq {R : Type u_1} [ring R] {M : Type u_2} [add_comm_group M] [module R M] (U : submodule R M) (x : M) (y : M) :=
  submodule.quotient.mk x = submodule.quotient.mk y

protected theorem smodeq.def {R : Type u_1} [ring R] {M : Type u_2} [add_comm_group M] [module R M] {U : submodule R M} {x : M} {y : M} : smodeq U x y ↔ submodule.quotient.mk x = submodule.quotient.mk y :=
  iff.rfl

namespace smodeq

@[simp] theorem top {R : Type u_1} [ring R] {M : Type u_2} [add_comm_group M] [module R M] {x : M} {y : M} : smodeq ⊤ x y :=
  iff.mpr (submodule.quotient.eq ⊤) submodule.mem_top

@[simp] theorem bot {R : Type u_1} [ring R] {M : Type u_2} [add_comm_group M] [module R M] {x : M} {y : M} : smodeq ⊥ x y ↔ x = y := sorry

theorem mono {R : Type u_1} [ring R] {M : Type u_2} [add_comm_group M] [module R M] {U₁ : submodule R M} {U₂ : submodule R M} {x : M} {y : M} (HU : U₁ ≤ U₂) (hxy : smodeq U₁ x y) : smodeq U₂ x y :=
  iff.mpr (submodule.quotient.eq U₂) (HU (iff.mp (submodule.quotient.eq U₁) hxy))

theorem refl {R : Type u_1} [ring R] {M : Type u_2} [add_comm_group M] [module R M] {U : submodule R M} {x : M} : smodeq U x x :=
  Eq.refl (submodule.quotient.mk x)

theorem symm {R : Type u_1} [ring R] {M : Type u_2} [add_comm_group M] [module R M] {U : submodule R M} {x : M} {y : M} (hxy : smodeq U x y) : smodeq U y x :=
  Eq.symm hxy

theorem trans {R : Type u_1} [ring R] {M : Type u_2} [add_comm_group M] [module R M] {U : submodule R M} {x : M} {y : M} {z : M} (hxy : smodeq U x y) (hyz : smodeq U y z) : smodeq U x z :=
  Eq.trans hxy hyz

theorem add {R : Type u_1} [ring R] {M : Type u_2} [add_comm_group M] [module R M] {U : submodule R M} {x₁ : M} {x₂ : M} {y₁ : M} {y₂ : M} (hxy₁ : smodeq U x₁ y₁) (hxy₂ : smodeq U x₂ y₂) : smodeq U (x₁ + x₂) (y₁ + y₂) := sorry

theorem smul {R : Type u_1} [ring R] {M : Type u_2} [add_comm_group M] [module R M] {U : submodule R M} {x : M} {y : M} (hxy : smodeq U x y) (c : R) : smodeq U (c • x) (c • y) := sorry

theorem zero {R : Type u_1} [ring R] {M : Type u_2} [add_comm_group M] [module R M] {U : submodule R M} {x : M} : smodeq U x 0 ↔ x ∈ U := sorry

theorem map {R : Type u_1} [ring R] {M : Type u_2} [add_comm_group M] [module R M] {U : submodule R M} {x : M} {y : M} {N : Type u_3} [add_comm_group N] [module R N] (hxy : smodeq U x y) (f : linear_map R M N) : smodeq (submodule.map f U) (coe_fn f x) (coe_fn f y) :=
  iff.mpr (submodule.quotient.eq (submodule.map f U))
    (Eq.subst (linear_map.map_sub f x y) submodule.mem_map_of_mem (iff.mp (submodule.quotient.eq U) hxy))

theorem comap {R : Type u_1} [ring R] {M : Type u_2} [add_comm_group M] [module R M] {x : M} {y : M} {N : Type u_3} [add_comm_group N] [module R N] (V : submodule R N) {f : linear_map R M N} (hxy : smodeq V (coe_fn f x) (coe_fn f y)) : smodeq (submodule.comap f V) x y :=
  iff.mpr (submodule.quotient.eq (submodule.comap f V))
    ((fun (this : coe_fn f (x - y) ∈ V) => this)
      (Eq.symm (linear_map.map_sub f x y) ▸ iff.mp (submodule.quotient.eq V) hxy))