/-
The Sinz at-most-one encoding.

Authors: Cayden Codel, Jeremy Avigad, Marijn Heule
Carnegie Mellon University
-/

import cnf.literal
import cnf.clause
import cnf.cnf
import cnf.encoding
import cnf.gensym

import cardinality.distinct
import cardinality.amk
import cardinality.alk

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

variables {V : Type*} [inhabited V] [decidable_eq V]

namespace sinz_amo

open nat
open list
open literal
open clause
open cnf
open assignment
open encoding
open distinct
open gensym
open amk
open alk

variables {l : list (literal V)} {lit l₁ l₂ : literal V} {g : gensym V}
          {τ : assignment V} (hdis : disjoint g.stock (clause.vars l))
          {c : clause V}

lemma disjoint_fresh_of_disjoint : disjoint g.stock (clause.vars (lit :: l)) →
  disjoint g.fresh.2.stock (clause.vars l) :=
begin
  intro hdis,
  apply set.disjoint_right.mpr,
  intros v hv,
  have := (vars_subset_of_vars_cons lit l) hv,
  have := set.disjoint_right.mp hdis this,
  exact set.not_mem_subset (fresh_stock_subset g) this
end

lemma disjoint_fresh_of_disjoint_of_subset {l₂ : list (literal V)} :
  disjoint g.stock (clause.vars l) → l₂ ⊆ l → disjoint g.fresh.2.stock (clause.vars l₂) :=
begin
  intros hdis hss,
  apply set.disjoint_right.mpr,
  intros v hv,
  have := (clause.vars_subset_of_subset hss) hv,
  have := set.disjoint_right.mp hdis this,
  exact set.not_mem_subset (fresh_stock_subset g) this
end

-- A possible recursive definition. Proof was too challenging. Try again later?
/-
def sinz : Π (l : list (literal V)), Π (g : gensym V),
  (disjoint g.stock (clause.vars l)) → cnf V
| []               _ _            := []
| [l₁]             g hdis         := [] --[[l₁.flip, Pos (g.fresh.1)]] -- may be unneeded
| (l₁ :: l₂ :: ls) g hdis         :=
    [l₁.flip, Pos (g.fresh.1)] ::
    [Neg g.fresh.1, Pos g.fresh.2.fresh.1] ::
    [Neg g.fresh.1, l₂.flip] ::
    (sinz (l₂ :: ls) g.fresh.2 (disjoint_fresh_of_disjoint hdis))
-/

def xi_to_si (g : gensym V) (n i : nat) (lit : literal V) : cnf V :=
  if (i < n - 1) then [[lit.flip, Pos (g.nth i)]] else []

def si_to_next_si (g : gensym V) (n i : nat) : cnf V :=
  if (i < n - 2) then [[Neg (g.nth i), Pos (g.nth (i + 1))]] else []

def si_to_next_xi (g : gensym V) (i : nat) (lit : literal V) : cnf V :=
  if (0 < i) then [[Neg (g.nth (i - 1)), lit.flip]] else []

def sinz_amo (l : list (literal V)) (g : gensym V) : cnf V :=
if hl : length l < 2 then [] else
  join (map_with_index (λ (idx : nat) (lit : literal V),
    xi_to_si g (length l) idx lit ++
    si_to_next_si g (length l) idx ++
    si_to_next_xi g idx lit) l)

theorem xi_to_si_mem {l : list (literal V)} (hl : length l ≥ 2) (g : gensym V)
  {i : nat} (Hi' : i < length l - 1) (Hi : i < length l) :
  [(l.nth_le i Hi).flip, Pos (g.nth i)] ∈ sinz_amo l g :=
begin
  rw sinz_amo,
  simp [not_lt.mpr hl],
  use (xi_to_si g l.length i (l.nth_le i Hi) ++ si_to_next_si g l.length i ++ si_to_next_xi g i (l.nth_le i Hi)),
  split,
  { use [l.nth_le i Hi, i, Hi],
    simp only [eq_self_iff_true, append_assoc, and_self] },
  { simp [xi_to_si, Hi'] }
end

theorem si_to_next_si_mem {l : list (literal V)} (hl : length l ≥ 2) (g : gensym V)
  {i : nat} (Hi' : i < length l - 2) (Hi : i < length l) :
  [Neg (g.nth i), Pos (g.nth (i + 1))] ∈ sinz_amo l g :=
begin
  rw sinz_amo,
  simp [not_lt.mpr hl],
  use (xi_to_si g l.length i (l.nth_le i Hi) ++ si_to_next_si g l.length i ++ si_to_next_xi g i (l.nth_le i Hi)),
  split,
  { use [l.nth_le i Hi, i, Hi],
    simp only [eq_self_iff_true, append_assoc, and_self] },
  { simp [si_to_next_si, Hi'] }
end

theorem si_to_next_xi_mem {l : list (literal V)} (hl : length l ≥ 2) (g : gensym V)
  {i : nat} (Hi : 0 < i ∧ i < length l) :
  [Neg (g.nth (i - 1)), (l.nth_le i Hi.2).flip] ∈ sinz_amo l g :=
begin
  rw sinz_amo,
  simp [not_lt.mpr hl],
  use (xi_to_si g l.length i (l.nth_le i Hi.2) ++ si_to_next_si g l.length i ++ si_to_next_xi g i (l.nth_le i Hi.2)),
  split,
  { use [l.nth_le i Hi.2, i, Hi.2],
    simp only [eq_self_iff_true, append_assoc, and_self] },
  { simp [si_to_next_xi, Hi.1] }
end

def nth_from_var (g : gensym V) (v : V) : nat → nat
| 0       := 0
| (i + 1) := if v = g.nth (i + 1) then i + 1 else nth_from_var i

theorem nth_from_var_eq_nth_of_le (g : gensym V) {i n : nat} (Hi : i ≤ n) :
  nth_from_var g (g.nth i) n = i :=
begin
  induction n with n ih generalizing i,
  { cases i,
    { refl },
    { rw nonpos_iff_eq_zero at Hi,
      exact absurd Hi (succ_ne_zero _) } },
  { by_cases hn : i = n.succ,
    { subst hn,
      simp [nth_from_var] },
    { simp [nth_from_var, nth_ne_of_ne hn],
      exact ih (le_of_lt_succ (lt_of_le_of_ne Hi hn)) } }
end

def signal_truth (l : list (literal V)) (τ : assignment V) : nat → bool
| 0       := l.head.eval τ
| (i + 1) := if h : (i + 1) < length l then (l.nth_le (i + 1) h).eval τ || signal_truth i
             else ff

def sinz_tau (l : list (literal V)) (g : gensym V) (τ : assignment V) : assignment V :=
  λ v, if v ∈ clause.vars l then τ v else
    signal_truth l τ (nth_from_var g v (length l))

theorem signal_semantics {g : gensym V} {l : list (literal V)}
  (hdis : disjoint g.stock (clause.vars l)) {i : nat} :
  i < length l → ∀ {τ : assignment V},
  (signal_truth l τ i = tt ↔ alk.eval 1 τ (l.take (i + 1)) = tt) :=
begin
  intros hi τ,
  induction i with i ih,
  { simp [signal_truth, take_one_of_ne_nil (ne_nil_of_length_pos hi),
    alk.eval, alk, bool_symm] },
  { simp [signal_truth, hi],
    split,
    { rintros (hs | hs),
      { rw eval_take_tail_pos hi hs,
        exact eval_zero _ _ },
      { have ihred := (ih (lt_of_succ_lt hi)).mp hs,
        have := take_sublist_of_le (le_succ (i + 1)) l,
        exact eval_tt_of_sublist_of_eval_tt this ihred } },
    { intro hl,
      cases h : (l.nth_le (i + 1) _).eval τ,
      { rw eval_take_tail_neg hi h at hl,
        exact or.inr ((ih (lt_of_succ_lt hi)).mpr hl) },
      { simp only [eq_self_iff_true, true_or] } } }
end

lemma minus_two {n m : nat} : n < m - 2 → n + 1 < m :=
begin
  intro h, cases m,
  { linarith },
  { cases m,
    { linarith },
    { simp only [succ_sub_succ_eq_sub, tsub_zero] at h,
      exact lt_succ_of_lt (succ_lt_succ_iff.mpr h) } }
end

theorem xts_eval_tt {g : gensym V} {l : list (literal V)}
  (hdis : disjoint g.stock (clause.vars l)) {i : nat} (Hi : i < length l) :
  ∀ (τ : assignment V),
  (xi_to_si g (length l) i (l.nth_le i Hi)).eval (sinz_tau l g τ) = tt :=
begin
  intro τ,
  rw eval_tt_iff_forall_clause_eval_tt,
  intros c hc,
  rw [xi_to_si] at hc,
  by_cases Hi₂ : (i = l.length - 1),
  { simp [Hi₂] at hc, contradiction },
  { simp [lt_of_le_of_ne (le_pred_of_lt Hi) Hi₂] at hc,
    subst hc,
    rw eval_tt_iff_exists_literal_eval_tt,
    cases hl : (l.nth_le i Hi).eval τ,
    { use (l.nth_le i Hi).flip,
      have hmem := mem_vars_of_mem (nth_le_mem l i Hi),
      cases l.nth_le i Hi;
      { rw var at hmem,
        rw literal.eval at hl,
        simp [eval_flip, literal.eval, hl, sinz_tau, hmem] } },
    { use Pos (g.nth i),
      simp [literal.eval, sinz_tau, forall_nth_not_mem_of_disjoint' hdis i,
        nth_from_var_eq_nth_of_le g (le_of_lt Hi)],
      cases i,
      { rw signal_truth, rw nth_le_zero at hl, exact hl },
      { simp [signal_truth, Hi], exact or.inl hl } } }
end

theorem stns_eval_tt {g : gensym V} {l : list (literal V)}
  (hdis : disjoint g.stock (clause.vars l)) :
  ∀ (i : nat) (τ : assignment V),
  (si_to_next_si g (length l) i).eval (sinz_tau l g τ) = tt :=
begin
  intros i τ,
  rw eval_tt_iff_forall_clause_eval_tt,
  intros c hc,
  rw si_to_next_si at hc,
  by_cases hi : (i < l.length - 2),
  { simp [hi] at hc,
    subst hc,
    rw eval_tt_iff_exists_literal_eval_tt,
    cases hs : (sinz_tau l g τ) (g.nth i),
    { use Neg (g.nth i),
      simp [literal.eval, hs] },
    { use Pos (g.nth (i + 1)),
      simp [literal.eval, sinz_tau, forall_nth_not_mem_of_disjoint' hdis (i + 1)],
      have : i + 1 < l.length, from minus_two hi,
      rw nth_from_var_eq_nth_of_le g (le_of_lt this),
      simp [signal_truth, this],
      simp [sinz_tau, forall_nth_not_mem_of_disjoint' hdis i,
        nth_from_var_eq_nth_of_le g (le_of_lt (lt_of_succ_lt this))] at hs,
      exact or.inr hs } },
  { simp [hi] at hc, contradiction }
end

theorem stnx_eval_tt {g : gensym V} {l : list (literal V)}
  (hdis : disjoint g.stock (clause.vars l)) {i : nat} (Hi : i < length l) :
  ∀ (τ : assignment V), amk.eval 1 τ (l.take (i + 1)) = tt →
  (si_to_next_xi g i (l.nth_le i Hi)).eval (sinz_tau l g τ) = tt :=
begin
  intros τ hamo,
  rw eval_tt_iff_forall_clause_eval_tt,
  intros c hc,
  rw si_to_next_xi at hc,
  cases i; simp at hc,
  { contradiction },
  { subst hc,
    rw eval_tt_iff_exists_literal_eval_tt,
    cases hs : (sinz_tau l g τ) (g.nth i),
    { use Neg (g.nth i),
      simp [hs, literal.eval] },
    { simp [sinz_tau, forall_nth_not_mem_of_disjoint' hdis i] at hs,
      rw nth_from_var_eq_nth_of_le g (le_of_lt (lt_of_succ_lt Hi)) at hs,
      cases ht : (l.nth_le _ Hi).eval (sinz_tau l g τ),
      { use (l.nth_le _ Hi).flip,
        simp [eval_flip, literal.eval, ht] },
      { have heqod : eqod (sinz_tau l g τ) τ (clause.vars l),
        { rw sinz_tau,
          intros v hv,
          simp [hv] },
        have := (signal_semantics hdis (lt_of_succ_lt Hi)).mp hs,
        have hmem := mem_vars_of_mem (nth_le_mem l _ Hi),
        rw eval_eq_of_eqod_of_var_mem heqod hmem at ht,
        rw eval_tail_pos ht at hamo,
        rw alk_of_amk_of_gt hamo nat.one_pos at this,
        contradiction } } }
end

-- Forward direction
theorem sinz_forward {τ : assignment V} {l : list (literal V)} {g : gensym V}
  (hdis : disjoint g.stock (clause.vars l)) :
  amk.eval 1 τ l = tt → (sinz_amo l g).eval (sinz_tau l g τ) = tt :=
begin
  intro hamo,
  rw eval_tt_iff_forall_clause_eval_tt,
  intros c hc,
  by_cases hl : length l < 2,
  { simp [sinz_amo, hl] at hc, exfalso, exact hc },
  { simp [sinz_amo, hl] at hc,
    rcases hc with ⟨f, ⟨lit, i, ⟨Hi, rfl⟩, rfl⟩, hc⟩,
    simp at hc,
    rcases hc with (hc | hc | hc),
    { have := xts_eval_tt hdis Hi τ,
      exact eval_tt_iff_forall_clause_eval_tt.mp this _ hc },
    { have := stns_eval_tt hdis i τ,
      exact eval_tt_iff_forall_clause_eval_tt.mp this _ hc },
    { have := amk.eval_take hamo (i + 1),
      have := stnx_eval_tt hdis Hi τ this,
      rw si_to_next_xi at hc,
      by_cases hiz : (0 < i),
      { simp [hiz] at hc, subst hc,
        simp [si_to_next_xi, eval_tt_iff_forall_clause_eval_tt, hiz] at this,
        rw eval_tt_iff_exists_literal_eval_tt,
        rcases this with (hl | hl),
        { use Neg (g.nth (i - 1)), simp [hl] },
        { use (l.nth_le i Hi).flip, simp [hl] } },
      { simp [hiz] at hc, exfalso, exact hc } } }
end

-- Reverse direction --

-- Proofs for necessary conditions for setting signal variables to true
theorem signal_nec2 {τ} {l : list (literal V)} (hl : length l ≥ 2) {g : gensym V}
  {i : nat} (hi : i < length l - 2) :
  (sinz_amo l g).eval τ = tt →
  τ (g.nth i) = tt → ∀ {j : nat}, (j > i ∧ j < length l - 1) → τ (g.nth j) = tt :=
begin
  rintros hs hg j ⟨hij, hj⟩,
  induction j with j ih,
  { linarith },
  { by_cases hij' : i = j,
    { subst hij',
      have := si_to_next_si_mem hl g hi (lt_of_succ_lt (minus_two hi)),
      have := eval_tt_iff_forall_clause_eval_tt.mp hs _ this,
      simp [eval_tt_iff_exists_literal_eval_tt] at this,
      rcases this with (hl | hl),
      { rw [literal.eval, hg] at hl, contradiction },
      { rw literal.eval at hl, exact hl } },
    { have := lt_of_le_of_ne (le_of_lt_succ hij) hij',
      have ihred := ih this (lt_of_succ_lt hj),
      have hjl : j < length l,
      { rcases exists_eq_add_of_le hl with ⟨k, hk⟩,
        rw add_comm at hk,
        simp [hk] at hj |-,
        exact lt_of_succ_lt (lt_succ_of_lt hj) },
      have : j < length l - 2,
      { rcases exists_eq_add_of_le hl with ⟨k, hk⟩,
        rw add_comm at hk,
        simp [hk] at hj |-,
        exact succ_lt_succ_iff.mp hj },
      have := si_to_next_si_mem hl g this hjl,
      have := eval_tt_iff_forall_clause_eval_tt.mp hs _ this,
      simp [eval_tt_iff_exists_literal_eval_tt] at this,
      rcases this with (hl | hl),
      { rw [literal.eval, ihred] at hl, contradiction },
      { rw literal.eval at hl, exact hl } } }
end

theorem signal_nec {τ} {l : list (literal V)} (hl : length l ≥ 2) {g : gensym V}
  {i : nat} (hi : i < length l - 1) :
  (sinz_amo l g).eval τ = tt →
  alk.eval 1 τ (l.take (i + 1)) = tt → τ (g.nth i) = tt :=
begin
  intros hs hlk,
  induction i with i ih,
  { cases l with l ls,
    { rw length at hi, linarith },
    { rw length at hl,
      have : ls.length > 0, linarith,
      have : [l.flip, Pos (g.nth 0)] ∈ ite (0 < ls.length) [[l.flip, Pos (g.nth 0)]] [],
      { have : 0 < ls.length, exact this,
        simp [this] },
      simp [alk.eval, alk] at hlk,
      simp [sinz_amo, not_lt.mpr hl, eval_tt_iff_forall_clause_eval_tt, xi_to_si] at hs,
      have := hs _ (or.inl this),
      simp [eval_tt_iff_exists_literal_eval_tt] at this,
      rcases this with (hl | hl),
      { rw [eval_flip, ← hlk] at hl, contradiction },
      { rw literal.eval at hl, exact hl } } },
  { have : i + 1 < length l, from lt_of_lt_pred hi,
    cases hx : literal.eval τ (l.nth_le _ this),
    { rw eval_take_tail_neg this hx at hlk,
      have ihred := ih (lt_of_succ_lt hi) hlk,
      have : i < l.length - 2,
      { rcases exists_eq_add_of_le hl with ⟨k, hk⟩,
        rw add_comm at hk,
        simp [hk] at hi |-,
        exact succ_lt_succ_iff.mp hi },
      apply signal_nec2 hl this hs ihred,
      split,
      { exact lt_succ_self i },
      { rcases exists_eq_add_of_le hl with ⟨k, hk⟩,
        rw add_comm at hk,
        simp [hk] at this |-,
        exact succ_lt_succ_iff.mpr this } },
    { have hmem := xi_to_si_mem hl g hi this,
      have := eval_tt_iff_forall_clause_eval_tt.mp hs _ hmem,
      simp [eval_tt_iff_exists_literal_eval_tt] at this,
      rcases this with (hl | hl),
      { rw [eval_flip, hx] at hl, contradiction },
      { rw literal.eval at hl, exact hl } } }
end

theorem signal_nec3 {τ} {l : list (literal V)} (hl : length l ≥ 2) {g : gensym V}
  {i : nat} (hi : i < length l) :
  (sinz_amo l g).eval τ = tt → τ (g.nth i) = tt →
  ∀ {j : nat} (hj : (j > i ∧ j < length l)), (l.nth_le j hj.2).eval τ = ff :=
begin
  rintros hs hg j ⟨hij, hj⟩,
  have hs' := hs,
  rw eval_tt_iff_forall_clause_eval_tt at hs,
  have hc := hs _ (si_to_next_xi_mem hl g ⟨pos_of_gt hij, hj⟩),
  by_cases hj' : (j - 1) = i,
  { rw [hj', eval_tt_iff_exists_literal_eval_tt] at hc,
    simp at hc,
    rcases hc with ⟨lit, (rfl | rfl), he⟩,
    { simp [literal.eval, hg] at he, contradiction },
    { simp [eval_flip] at he, exact he } },
  { have hsub : j - 1 > i,
    { have := pos_of_gt hij,
      cases j,
      { linarith },
      { have : i ≤ j, exact lt_succ_iff.mp hij,
        simp at hj' |-,
        exact lt_of_le_of_ne this (ne.symm hj') } },
    have : j - 1 < length l - 1,
    { rcases exists_eq_add_of_le hl with ⟨k, hk⟩,
      rw add_comm at hk,
      simp [hk] at hj |-,
      cases j,
      { simp },
      { simp, exact succ_lt_succ_iff.mp hj } },
    have hi₂ : i < l.length - 2,
    { rcases exists_eq_add_of_le hl with ⟨k, hk⟩,
      rw add_comm at hk,
      simp [hk] at this |-,
      exact lt_of_lt_of_le hsub (le_of_lt_succ this) },
    have := signal_nec2 hl hi₂ hs' hg ⟨hsub, this⟩,
    simp [eval_tt_iff_exists_literal_eval_tt] at hc,
    rcases hc with (hl | hl),
    { rw [literal.eval, this] at hl, contradiction },
    { simp [eval_flip] at hl, exact hl } }
end

theorem sinz_reverse {τ} {l : list (literal V)} {g : gensym V}
  (hdis : disjoint g.stock (clause.vars l)) :
  (sinz_amo l g).eval τ = tt → amk.eval 1 τ l = tt :=
begin
  intro hs,
  by_cases hl : length l ≥ 2,
  { rw amo_eval_tt_iff_distinct_eval_ff_of_eval_tt,
    rintros lit₁ lit₂ ⟨i, j, hi, hj, hij, rfl, rfl⟩ hl₁,
    have : i < length l - 1, from lt_of_lt_of_le hij (le_pred_of_lt hj),
    have := signal_nec hl this hs (amo_take_of_tt hi hl₁),
    exact signal_nec3 hl hi hs this ⟨hij, hj⟩ },
  { rw not_le at hl,
    exact eval_tt_of_ge_length (le_of_lt_succ hl) _ }
end

theorem sinz_amo_encodes_amo {l : list (literal V)} {g : gensym V}
  (hdis : disjoint g.stock (clause.vars l)) :
  encodes (amk 1) (sinz_amo l g) l :=
begin
  intro τ, split,
  { intro hamo,
    use sinz_tau l g τ,
    split,
    { exact sinz_forward hdis hamo },
    { intros v hv, simp [sinz_tau, hv] } },
  { rintros ⟨σ, hs, heqod⟩,
    rw [← amk.eval, eval_eq_amk_of_eqod 1 heqod],
    exact sinz_reverse hdis hs }
end

/-
theorem mem_sinz_vars_of_mem {l : list (literal V)} {g : gensym V} :
  length l ≥ 2 → clause.vars l ⊆ cnf.vars (sinz_amo l g hdis) :=
begin
  intro hlen,
  induction l using strong_induction_on_lists with l ih generalizing g,
  rcases exists_cons_cons_of_length_ge_two hlen with ⟨l₁, l₂, ls, rfl⟩,
  intros v hv,
  rw sinz,
  simp [clause.vars] at hv,
  rcases hv with (rfl | rfl | hv),
  { simp [cnf.vars, clause.vars, flip_var_eq] },
  { simp [cnf.vars, clause.vars, flip_var_eq] },
  { cases ls with l₃ ls,
    { rw clause.vars_nil at hv,
      exact absurd hv (finset.not_mem_empty _) },
    { have hlen' : length (l₂ :: l₃ :: ls) ≥ 2, dec_trivial,
      have hless : length (l₂ :: l₃ :: ls) < length (l₁ :: l₂ :: l₃ :: ls), simp,
      have hdis' := disjoint_fresh_of_disjoint hdis,
      simp [cnf.vars],
      right, right, right,
      exact (ih _ hless hlen' hdis') (vars_subset_of_vars_cons l₂ (l₃ :: ls) hv) } }
end

theorem mem_or_mem_of_mem_vars {v : V} : v ∈ cnf.vars (sinz l g hdis) →
  v ∈ clause.vars l ∨ v ∈ g.stock :=
begin
  induction l using strong_induction_on_lists with l ih generalizing g,
  cases l with l₁ ls,
  { rw [sinz, cnf.vars_nil], intro h, exact absurd h (finset.not_mem_empty _) },
  cases ls with l₂ ls,
  { rw [sinz, cnf.vars_nil], intro h, exact absurd h (finset.not_mem_empty _) },
  rw sinz,
  intro h,
  simp [cnf.vars, clause.vars, flip_var_eq, var] at h,
  rcases h with (rfl | rfl | rfl | rfl | rfl | h),
  { left, simp [clause.vars] },
  { exact or.inr (fresh_mem_stock g) },
  { exact or.inr (fresh_fresh_mem_stock g) },
  { exact or.inr (fresh_mem_stock g) },
  { left, simp [clause.vars] },
  { cases ls with l₃ ls,
    { rw [sinz, cnf.vars_nil] at h,
      exact absurd h (finset.not_mem_empty _) },
    { have hlen := length_lt_length_cons l₁ (l₂ :: l₃ :: ls),
      have hdis' := disjoint_fresh_of_disjoint hdis,
      rcases ih _ hlen hdis' h with (hv | hv),
      { exact or.inl ((vars_subset_of_vars_cons l₁ _) hv) },
      { exact or.inr (fresh_stock_subset g hv) } } }
end

theorem not_mem_sinz_vars_of_not_mems {v : V} : v ∉ clause.vars l →
  v ∉ g.stock → v ∉ cnf.vars (sinz l g hdis) :=
begin
  intros hvar hstock,
  induction l using strong_induction_on_lists with l ih generalizing g,
  cases l with l₁ ls,
  { simp [sinz] },
  cases ls with l₂ ls,
  { simp [sinz] },
  have hg₁ : v ≠ g.fresh.1,
  { exact (ne_of_mem_of_not_mem (fresh_mem_stock g) hstock).symm },
  have hg₂ : v ≠ g.fresh.2.fresh.1,
  { exact (ne_of_mem_of_not_mem (fresh_fresh_mem_stock g) hstock).symm },
  cases ls with l₃ ls,
  { simp [clause.vars, not_or_distrib] at hvar,
    rcases hvar with ⟨hvar₁, hvar₂⟩,
    simp [sinz, cnf.vars, clause.vars, not_or_distrib, flip_var_eq, var,
      hvar₁, hvar₂, hg₁, hg₂] },
  { rw sinz,
    have hvar' : v ∉ clause.vars (l₂ :: l₃ :: ls),
    { rw clause.vars at hvar,
      simp only [not_or_distrib, finset.mem_union, finset.mem_singleton] at hvar,
      exact hvar.2 },
    have hless : length (l₂ :: l₃ :: ls) < length (l₁ :: l₂ :: l₃ :: ls), simp,
    have hdis' := disjoint_fresh_of_disjoint hdis,
    have : v ∉ g.fresh.2.stock,
    { intro hcon,
      exact hstock ((fresh_stock_subset g) hcon) },
    have ihred := ih _ hless hvar' hdis' this,
    simp [clause.vars, not_or_distrib] at hvar,
    rcases hvar with ⟨hvar₁, hvar₂, hvar₃, hvar⟩,
    simp [cnf.vars, clause.vars, not_or_distrib, flip_var_eq, var,
      hvar₁, hvar₂, hvar₃, hg₁, hg₂, ihred] }
end
-/

end sinz_amo


import metric_spaces.basic

/--
In this file we showed that the `closed_set` form a Galois insertion with
`Closure` being its Galois connection, and with that, we conclude `closed_set`
form a `complete_lattice`.

- `closed_set` is defined to be a closed subset of a metric space
- `Closure` is defined to be a `closed_set` with `closure' _` as its carrier
-/

variables {X : Type*} [metric_space X]
variables {Y : Type*} [metric_space Y]

open definitions set

namespace closed_set

open open_closed_sets.closure'

/- Defining the structure of a closed set -/
structure closed_set (X : Type*) [metric_space X] :=
(carrier : set X)
(is_closed : is_closed' carrier)

instance : has_coe (closed_set X) (set X) := ⟨closed_set.carrier⟩

def Closure (S : set X) : closed_set X :=
{ carrier := closure' S,
  is_closed := closure_closed S }

theorem ext' {S T : closed_set X} (h : (S : set X) = T) : S = T :=
by cases S; cases T; congr'

/- Closed sets form a partial order -/
instance : partial_order (closed_set X) :=
{.. partial_order.lift (coe : closed_set X → set X) (λ a b, ext') (by apply_instance)}

/- The closure of a closed_set is itself -/
lemma Closure_self (T : closed_set X) : T = Closure T.1 :=
ext' $ show ↑T = closure' T.carrier, by {rw closure_self, refl, from T.2}

/- Closed sets form a Galois insertion -/
def gi : @galois_insertion (set X) (closed_set X) _ _ Closure closed_set.carrier :=
{ choice := λ S h, Closure S,
  gc := λ S T,
    ⟨λ h, set.subset.trans subset_closure' h, λ h, by rw Closure_self T; from closure_mono' h⟩,
  le_l_u := λ S, subset_closure',
  choice_eq := λ _ _, rfl }

/- Closed sets form a complete lattice -/
instance : complete_lattice (closed_set X) :=
{ .. galois_insertion.lift_complete_lattice gi}

end closed_set


/-
Copyright (c) 2021 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä
-/
import topology.algebra.weak_dual_topology
import analysis.normed_space.dual
import analysis.normed_space.operator_norm

/-!
# Weak dual of normed space

Let `E` be a normed space over a field `𝕜`. This file is concerned with properties of the weak-*
topology on the dual of `E`. By the dual, we mean either of the type synonyms
`normed_space.dual 𝕜 E` or `weak_dual 𝕜 E`, depending on whether it is viewed as equipped with its
usual operator norm topology or the weak-* topology.

It is shown that the canonical mapping `normed_space.dual 𝕜 E → weak_dual 𝕜 E` is continuous, and
as a consequence the weak-* topology is coarser than the topology obtained from the operator norm
(dual norm).

The file is a stub, some TODOs below.

## Main definitions

The main definitions concern the canonical mapping `dual 𝕜 E → weak_dual 𝕜 E`.

* `normed_space.dual.to_weak_dual` and `weak_dual.to_normed_dual`: Linear equivalences from
  `dual 𝕜 E` to `weak_dual 𝕜 E` and in the converse direction.
* `normed_space.dual.continuous_linear_map_to_weak_dual`: A continuous linear mapping from
  `dual 𝕜 E` to `weak_dual 𝕜 E` (same as `normed_space.dual.to_weak_dual` but different bundled
  data).

## Main results

The first main result concerns the comparison of the operator norm topology on `dual 𝕜 E` and the
weak-* topology on (its type synonym) `weak_dual 𝕜 E`:
* `dual_norm_topology_le_weak_dual_topology`: The weak-* topology on the dual of a normed space is
  coarser (not necessarily strictly) than the operator norm topology.

TODOs:
* Add that in finite dimensions, the weak-* topology and the dual norm topology coincide.
* Add that in infinite dimensions, the weak-* topology is strictly coarser than the dual norm
  topology.
* Add Banach-Alaoglu theorem (general version maybe in `topology.algebra.weak_dual_topology`).
* Add metrizability of the dual unit ball (more generally bounded subsets) of `weak_dual 𝕜 E`
  under the assumption of separability of `E`. Sequential Banach-Alaoglu theorem would then follow
  from the general one.

## Notations

No new notation is introduced.

## Implementation notes

Weak-* topology is defined generally in the file `topology.algebra.weak_dual_topology`.

When `E` is a normed space, the duals `dual 𝕜 E` and `weak_dual 𝕜 E` are type synonyms with
different topology instances.

## References

* https://en.wikipedia.org/wiki/Weak_topology#Weak-*_topology

## Tags

weak-star, weak dual

-/

noncomputable theory
open filter
open_locale topological_space

section weak_star_topology_for_duals_of_normed_spaces
/-!
### Weak star topology on duals of normed spaces
In this section, we prove properties about the weak-* topology on duals of normed spaces.
We prove in particular that the canonical mapping `dual 𝕜 E → weak_dual 𝕜 E` is continuous,
i.e., that the weak-* topology is coarser (not necessarily strictly) than the topology given
by the dual-norm (i.e. the operator-norm).
-/

open normed_space

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
variables {E : Type*} [normed_group E] [normed_space 𝕜 E]

/-- For normed spaces `E`, there is a canonical map `dual 𝕜 E → weak_dual 𝕜 E` (the "identity"
mapping). It is a linear equivalence. -/
def normed_space.dual.to_weak_dual : dual 𝕜 E ≃ₗ[𝕜] weak_dual 𝕜 E :=
linear_equiv.refl 𝕜 (E →L[𝕜] 𝕜)

/-- For normed spaces `E`, there is a canonical map `weak_dual 𝕜 E → dual 𝕜 E` (the "identity"
mapping). It is a linear equivalence. Here it is implemented as the inverse of the linear
equivalence `normed_space.dual.to_weak_dual` in the other direction. -/
def weak_dual.to_normed_dual : weak_dual 𝕜 E ≃ₗ[𝕜] dual 𝕜 E :=
normed_space.dual.to_weak_dual.symm

@[simp] lemma weak_dual.coe_to_fun_eq_normed_coe_to_fun (x' : dual 𝕜 E) :
  (x'.to_weak_dual : E → 𝕜) = x' := rfl

namespace normed_space.dual

@[simp] lemma to_weak_dual_eq_iff (x' y' : dual 𝕜 E) :
  x'.to_weak_dual = y'.to_weak_dual ↔ x' = y' :=
to_weak_dual.injective.eq_iff

@[simp] lemma _root_.weak_dual.to_normed_dual_eq_iff (x' y' : weak_dual 𝕜 E) :
  x'.to_normed_dual = y'.to_normed_dual ↔ x' = y' :=
weak_dual.to_normed_dual.injective.eq_iff

theorem to_weak_dual_continuous :
  continuous (λ (x' : dual 𝕜 E), x'.to_weak_dual) :=
begin
  apply weak_dual.continuous_of_continuous_eval,
  intros z,
  exact (inclusion_in_double_dual 𝕜 E z).continuous,
end

/-- For a normed space `E`, according to `to_weak_dual_continuous` the "identity mapping"
`dual 𝕜 E → weak_dual 𝕜 E` is continuous. This definition implements it as a continuous linear
map. -/
def continuous_linear_map_to_weak_dual : dual 𝕜 E →L[𝕜] weak_dual 𝕜 E :=
{ cont := to_weak_dual_continuous, .. to_weak_dual, }

/-- The weak-star topology is coarser than the dual-norm topology. -/
theorem dual_norm_topology_le_weak_dual_topology :
  (by apply_instance : topological_space (dual 𝕜 E)) ≤
    (by apply_instance : topological_space (weak_dual 𝕜 E)) :=
begin
  refine continuous.le_induced _,
  apply continuous_pi_iff.mpr,
  intros z,
  exact (inclusion_in_double_dual 𝕜 E z).continuous,
end

end normed_space.dual

end weak_star_topology_for_duals_of_normed_spaces


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

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

/-!
# Morphisms from equations between objects.

When working categorically, sometimes one encounters an equation `h : X = Y` between objects.

Your initial aversion to this is natural and appropriate:
you're in for some trouble, and if there is another way to approach the problem that won't
rely on this equality, it may be worth pursuing.

You have two options:
1. Use the equality `h` as one normally would in Lean (e.g. using `rw` and `subst`).
   This may immediately cause difficulties, because in category theory everything is dependently
   typed, and equations between objects quickly lead to nasty goals with `eq.rec`.
2. Promote `h` to a morphism using `eqToHom h : X ⟶ Y`, or `eqToIso h : X ≅ Y`.

This file introduces various `simp` lemmas which in favourable circumstances
result in the various `eqToHom` morphisms to drop out at the appropriate moment!
-/

universe v₁ v₂ v₃ u₁ u₂ u₃

-- morphism levels before object levels. See note [CategoryTheory universes].
namespace CategoryTheory

open Opposite

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

/-- An equality `X = Y` gives us a morphism `X ⟶ Y`.

It is typically better to use this, rather than rewriting by the equality then using `𝟙 _`
which usually leads to dependent type theory hell.
-/
def eqToHom {X Y : C} (p : X = Y) : X ⟶ Y := by rw [p]; exact 𝟙 _
#align category_theory.eq_to_hom CategoryTheory.eqToHom

@[simp]
theorem eqToHom_refl (X : C) (p : X = X) : eqToHom p = 𝟙 X :=
  rfl
#align category_theory.eq_to_hom_refl CategoryTheory.eqToHom_refl

@[reassoc (attr := simp)]
theorem eqToHom_trans {X Y Z : C} (p : X = Y) (q : Y = Z) :
    eqToHom p ≫ eqToHom q = eqToHom (p.trans q) :=
  by
  cases p
  cases q
  simp
#align category_theory.eq_to_hom_trans CategoryTheory.eqToHom_trans

theorem comp_eqToHom_iff {X Y Y' : C} (p : Y = Y') (f : X ⟶ Y) (g : X ⟶ Y') :
    f ≫ eqToHom p = g ↔ f = g ≫ eqToHom p.symm :=
  { mp := fun h => h ▸ by simp
    mpr := fun h => by simp [eq_whisker h (eqToHom p)] }
#align category_theory.comp_eq_to_hom_iff CategoryTheory.comp_eqToHom_iff

theorem eqToHom_comp_iff {X X' Y : C} (p : X = X') (f : X ⟶ Y) (g : X' ⟶ Y) :
    eqToHom p ≫ g = f ↔ g = eqToHom p.symm ≫ f :=
  { mp := fun h => h ▸ by simp
    mpr := fun h => h ▸ by simp [whisker_eq _ h] }
#align category_theory.eq_to_hom_comp_iff CategoryTheory.eqToHom_comp_iff

/- Porting note: simpNF complains about thsi not reducing but it is clearly used
in `congrArg_mrp_hom_left`. It has been no-linted. -/
/-- Reducible form of congrArg_mpr_hom_left -/
@[simp, nolint simpNF]
theorem congrArg_cast_hom_left {X Y Z : C} (p : X = Y) (q : Y ⟶  Z) :
    cast (congrArg (fun W : C => W ⟶  Z) p.symm) q = eqToHom p ≫ q := by
  cases p
  simp

 /-- If we (perhaps unintentionally) perform equational rewriting on
the source object of a morphism,
we can replace the resulting `_.mpr f` term by a composition with an `eqToHom`.

It may be advisable to introduce any necessary `eqToHom` morphisms manually,
rather than relying on this lemma firing.
-/
theorem congrArg_mpr_hom_left {X Y Z : C} (p : X = Y) (q : Y ⟶ Z) :
    (congrArg (fun W : C => W ⟶ Z) p).mpr q = eqToHom p ≫ q := by
  cases p
  simp
#align category_theory.congr_arg_mpr_hom_left CategoryTheory.congrArg_mpr_hom_left

/- Porting note: simpNF complains about thsi not reducing but it is clearly used
in `congrArg_mrp_hom_right`. It has been no-linted. -/
/-- Reducible form of `congrArg_mpr_hom_right` -/
@[simp, nolint simpNF]
theorem congrArg_cast_hom_right {X Y Z : C} (p : X ⟶ Y) (q : Z = Y) :
    cast (congrArg (fun W : C => X ⟶  W) q.symm) p = p ≫ eqToHom q.symm := by
  cases q
  simp

/-- If we (perhaps unintentionally) perform equational rewriting on
the target object of a morphism,
we can replace the resulting `_.mpr f` term by a composition with an `eqToHom`.

It may be advisable to introduce any necessary `eqToHom` morphisms manually,
rather than relying on this lemma firing.
-/
theorem congrArg_mpr_hom_right {X Y Z : C} (p : X ⟶ Y) (q : Z = Y) :
    (congrArg (fun W : C => X ⟶ W) q).mpr p = p ≫ eqToHom q.symm := by
  cases q
  simp
#align category_theory.congr_arg_mpr_hom_right CategoryTheory.congrArg_mpr_hom_right

/-- An equality `X = Y` gives us an isomorphism `X ≅ Y`.

It is typically better to use this, rather than rewriting by the equality then using `Iso.refl _`
which usually leads to dependent type theory hell.
-/
def eqToIso {X Y : C} (p : X = Y) : X ≅ Y :=
  ⟨eqToHom p, eqToHom p.symm, by simp, by simp⟩
#align category_theory.eq_to_iso CategoryTheory.eqToIso

@[simp]
theorem eqToIso.hom {X Y : C} (p : X = Y) : (eqToIso p).hom = eqToHom p :=
  rfl
#align category_theory.eq_to_iso.hom CategoryTheory.eqToIso.hom

@[simp]
theorem eqToIso.inv {X Y : C} (p : X = Y) : (eqToIso p).inv = eqToHom p.symm :=
  rfl
#align category_theory.eq_to_iso.inv CategoryTheory.eqToIso.inv

@[simp]
theorem eqToIso_refl {X : C} (p : X = X) : eqToIso p = Iso.refl X :=
  rfl
#align category_theory.eq_to_iso_refl CategoryTheory.eqToIso_refl

@[simp]
theorem eqToIso_trans {X Y Z : C} (p : X = Y) (q : Y = Z) :
    eqToIso p ≪≫ eqToIso q = eqToIso (p.trans q) := by ext; simp
#align category_theory.eq_to_iso_trans CategoryTheory.eqToIso_trans

@[simp]
theorem eqToHom_op {X Y : C} (h : X = Y) : (eqToHom h).op = eqToHom (congr_arg op h.symm) := by
  cases h
  rfl
#align category_theory.eq_to_hom_op CategoryTheory.eqToHom_op

@[simp]
theorem eqToHom_unop {X Y : Cᵒᵖ} (h : X = Y) :
    (eqToHom h).unop = eqToHom (congr_arg unop h.symm) := by
  cases h
  rfl
#align category_theory.eq_to_hom_unop CategoryTheory.eqToHom_unop

instance {X Y : C} (h : X = Y) : IsIso (eqToHom h) :=
  IsIso.of_iso (eqToIso h)

@[simp]
theorem inv_eqToHom {X Y : C} (h : X = Y) : inv (eqToHom h) = eqToHom h.symm := by
  aesop_cat
#align category_theory.inv_eq_to_hom CategoryTheory.inv_eqToHom

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

namespace Functor

/-- Proving equality between functors. This isn't an extensionality lemma,
  because usually you don't really want to do this. -/
theorem ext {F G : C ⥤ D} (h_obj : ∀ X, F.obj X = G.obj X)
    (h_map : ∀ X Y f, F.map f = eqToHom (h_obj X) ≫ G.map f ≫ eqToHom (h_obj Y).symm) :
    F = G := by
  match F, G with
  | mk F_pre _ _ , mk G_pre _ _ =>
    match F_pre, G_pre with  -- Porting note: did not unfold the Prefunctor unlike Lean3
    | Prefunctor.mk F_obj _ , Prefunctor.mk G_obj _ =>
    obtain rfl : F_obj = G_obj := by
      ext X
      apply h_obj
    congr
    funext X Y f
    simpa using h_map X Y f
#align category_theory.functor.ext CategoryTheory.Functor.ext

/-- Two morphisms are conjugate via eqToHom if and only if they are heterogeneously equal. -/
theorem conj_eqToHom_iff_hEq {W X Y Z : C} (f : W ⟶ X) (g : Y ⟶ Z) (h : W = Y) (h' : X = Z) :
    f = eqToHom h ≫ g ≫ eqToHom h'.symm ↔ HEq f g := by
  cases h
  cases h'
  simp
#align category_theory.functor.conj_eq_to_hom_iff_heq CategoryTheory.Functor.conj_eqToHom_iff_hEq

/-- Proving equality between functors using heterogeneous equality. -/
theorem hext {F G : C ⥤ D} (h_obj : ∀ X, F.obj X = G.obj X)
    (h_map : ∀ (X Y) (f : X ⟶ Y), HEq (F.map f) (G.map f)) : F = G :=
  Functor.ext h_obj fun _ _ f => (conj_eqToHom_iff_hEq _ _ (h_obj _) (h_obj _)).2 <| h_map _ _ f
#align category_theory.functor.hext CategoryTheory.Functor.hext

-- Using equalities between functors.
theorem congr_obj {F G : C ⥤ D} (h : F = G) (X) : F.obj X = G.obj X := by rw [h]
#align category_theory.functor.congr_obj CategoryTheory.Functor.congr_obj

theorem congr_hom {F G : C ⥤ D} (h : F = G) {X Y} (f : X ⟶ Y) :
    F.map f = eqToHom (congr_obj h X) ≫ G.map f ≫ eqToHom (congr_obj h Y).symm := by
  subst h; simp
#align category_theory.functor.congr_hom CategoryTheory.Functor.congr_hom

theorem congr_inv_of_congr_hom (F G : C ⥤ D) {X Y : C} (e : X ≅ Y) (hX : F.obj X = G.obj X)
    (hY : F.obj Y = G.obj Y)
    (h₂ : F.map e.hom = eqToHom (by rw [hX]) ≫ G.map e.hom ≫ eqToHom (by rw [hY])) :
    F.map e.inv = eqToHom (by rw [hY]) ≫ G.map e.inv ≫ eqToHom (by rw [hX]) := by
  simp only [← IsIso.Iso.inv_hom e, Functor.map_inv, h₂, IsIso.inv_comp, inv_eqToHom,
    Category.assoc]
#align category_theory.functor.congr_inv_of_congr_hom CategoryTheory.Functor.congr_inv_of_congr_hom

theorem congr_map (F : C ⥤ D) {X Y : C} {f g : X ⟶ Y} (h : f = g) : F.map f = F.map g := by rw [h]
#align category_theory.functor.congr_map CategoryTheory.Functor.congr_map

section HEq

-- Composition of functors and maps w.r.t. heq
variable {E : Type u₃} [Category.{v₃} E] {F G : C ⥤ D} {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z}

theorem map_comp_hEq (hx : F.obj X = G.obj X) (hy : F.obj Y = G.obj Y) (hz : F.obj Z = G.obj Z)
    (hf : HEq (F.map f) (G.map f)) (hg : HEq (F.map g) (G.map g)) :
    HEq (F.map (f ≫ g)) (G.map (f ≫ g)) := by
  rw [F.map_comp, G.map_comp]
  congr
#align category_theory.functor.map_comp_heq CategoryTheory.Functor.map_comp_hEq

theorem map_comp_hEq' (hobj : ∀ X : C, F.obj X = G.obj X)
    (hmap : ∀ {X Y} (f : X ⟶ Y), HEq (F.map f) (G.map f)) :
    HEq (F.map (f ≫ g)) (G.map (f ≫ g)) := by
  rw [Functor.hext hobj fun _ _ => hmap]
#align category_theory.functor.map_comp_heq' CategoryTheory.Functor.map_comp_hEq'

theorem precomp_map_hEq (H : E ⥤ C) (hmap : ∀ {X Y} (f : X ⟶ Y), HEq (F.map f) (G.map f)) {X Y : E}
    (f : X ⟶ Y) : HEq ((H ⋙ F).map f) ((H ⋙ G).map f) :=
  hmap _
#align category_theory.functor.precomp_map_heq CategoryTheory.Functor.precomp_map_hEq

theorem postcomp_map_hEq (H : D ⥤ E) (hx : F.obj X = G.obj X) (hy : F.obj Y = G.obj Y)
    (hmap : HEq (F.map f) (G.map f)) : HEq ((F ⋙ H).map f) ((G ⋙ H).map f) := by
  dsimp
  congr
#align category_theory.functor.postcomp_map_heq CategoryTheory.Functor.postcomp_map_hEq

theorem postcomp_map_hEq' (H : D ⥤ E) (hobj : ∀ X : C, F.obj X = G.obj X)
    (hmap : ∀ {X Y} (f : X ⟶ Y), HEq (F.map f) (G.map f)) : HEq ((F ⋙ H).map f) ((G ⋙ H).map f) :=
  by rw [Functor.hext hobj fun _ _ => hmap]
#align category_theory.functor.postcomp_map_heq' CategoryTheory.Functor.postcomp_map_hEq'

theorem hcongr_hom {F G : C ⥤ D} (h : F = G) {X Y} (f : X ⟶ Y) : HEq (F.map f) (G.map f) := by
  rw [h]
#align category_theory.functor.hcongr_hom CategoryTheory.Functor.hcongr_hom

end HEq

end Functor

/-- This is not always a good idea as a `@[simp]` lemma,
as we lose the ability to use results that interact with `F`,
e.g. the naturality of a natural transformation.

In some files it may be appropriate to use `local attribute [simp] eqToHom_map`, however.
-/
theorem eqToHom_map (F : C ⥤ D) {X Y : C} (p : X = Y) :
    F.map (eqToHom p) = eqToHom (congr_arg F.obj p) := by cases p; simp
#align category_theory.eq_to_hom_map CategoryTheory.eqToHom_map

/-- See the note on `eqToHom_map` regarding using this as a `simp` lemma.
-/
theorem eqToIso_map (F : C ⥤ D) {X Y : C} (p : X = Y) :
    F.mapIso (eqToIso p) = eqToIso (congr_arg F.obj p) := by ext; cases p; simp
#align category_theory.eq_to_iso_map CategoryTheory.eqToIso_map

@[simp]
theorem eqToHom_app {F G : C ⥤ D} (h : F = G) (X : C) :
    (eqToHom h : F ⟶ G).app X = eqToHom (Functor.congr_obj h X) := by subst h; rfl
#align category_theory.eq_to_hom_app CategoryTheory.eqToHom_app

theorem NatTrans.congr {F G : C ⥤ D} (α : F ⟶ G) {X Y : C} (h : X = Y) :
    α.app X = F.map (eqToHom h) ≫ α.app Y ≫ G.map (eqToHom h.symm) := by
  rw [α.naturality_assoc]
  simp [eqToHom_map]
#align category_theory.nat_trans.congr CategoryTheory.NatTrans.congr

theorem eq_conj_eqToHom {X Y : C} (f : X ⟶ Y) : f = eqToHom rfl ≫ f ≫ eqToHom rfl := by
  simp only [Category.id_comp, eqToHom_refl, Category.comp_id]
#align category_theory.eq_conj_eq_to_hom CategoryTheory.eq_conj_eqToHom

theorem dcongr_arg {ι : Type _} {F G : ι → C} (α : ∀ i, F i ⟶ G i) {i j : ι} (h : i = j) :
    α i = eqToHom (congr_arg F h) ≫ α j ≫ eqToHom (congr_arg G h.symm) := by
  subst h
  simp
#align category_theory.dcongr_arg CategoryTheory.dcongr_arg

end CategoryTheory


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import category_theory.limits.shapes.binary_products
import category_theory.limits.shapes.equalizers
import category_theory.limits.shapes.pullbacks

/-!
# Constructing pullbacks from binary products and equalizers

If a category as binary products and equalizers, then it has pullbacks.
Also, if a category has binary coproducts and coequalizers, then it has pushouts
-/

universes v u

open category_theory

namespace category_theory.limits

/-- If the product `X ⨯ Y` and the equalizer of `π₁ ≫ f` and `π₂ ≫ g` exist, then the
    pullback of `f` and `g` exists: It is given by composing the equalizer with the projections. -/
lemma has_limit_cospan_of_has_limit_pair_of_has_limit_parallel_pair
  {C : Type u} [𝒞 : category.{v} C] {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) [has_limit (pair X Y)]
  [has_limit (parallel_pair (prod.fst ≫ f) (prod.snd ≫ g))] : has_limit (cospan f g) :=
let π₁ : X ⨯ Y ⟶ X := prod.fst, π₂ : X ⨯ Y ⟶ Y := prod.snd, e := equalizer.ι (π₁ ≫ f) (π₂ ≫ g) in
has_limit.mk
{ cone := pullback_cone.mk (e ≫ π₁) (e ≫ π₂) $ by simp only [category.assoc, equalizer.condition],
  is_limit := pullback_cone.is_limit.mk _
    (λ s, equalizer.lift (prod.lift (s.π.app walking_cospan.left)
      (s.π.app walking_cospan.right)) $ by
        rw [←category.assoc, limit.lift_π, ←category.assoc, limit.lift_π];
        exact pullback_cone.condition _)
    (by simp) (by simp) $ λ s m h₁ h₂, by { ext,
      { simpa using h₁ },
      { simpa using h₂ } } }

section

local attribute [instance] has_limit_cospan_of_has_limit_pair_of_has_limit_parallel_pair

/-- If a category has all binary products and all equalizers, then it also has all pullbacks.
    As usual, this is not an instance, since there may be a more direct way to construct
    pullbacks. -/
lemma has_pullbacks_of_has_binary_products_of_has_equalizers
  (C : Type u) [𝒞 : category.{v} C] [has_binary_products C] [has_equalizers C] :
  has_pullbacks C :=
{ has_limit := λ F, has_limit_of_iso (diagram_iso_cospan F).symm }

end

/-- If the coproduct `Y ⨿ Z` and the coequalizer of `f ≫ ι₁` and `g ≫ ι₂` exist, then the
    pushout of `f` and `g` exists: It is given by composing the inclusions with the coequalizer. -/
lemma has_colimit_span_of_has_colimit_pair_of_has_colimit_parallel_pair
  {C : Type u} [𝒞 : category.{v} C] {X Y Z : C} (f : X ⟶ Y) (g : X ⟶ Z) [has_colimit (pair Y Z)]
  [has_colimit (parallel_pair (f ≫ coprod.inl) (g ≫ coprod.inr))] : has_colimit (span f g) :=
let ι₁ : Y ⟶ Y ⨿ Z := coprod.inl, ι₂ : Z ⟶ Y ⨿ Z := coprod.inr,
  c := coequalizer.π (f ≫ ι₁) (g ≫ ι₂) in
has_colimit.mk
{ cocone := pushout_cocone.mk (ι₁ ≫ c) (ι₂ ≫ c) $
    by rw [←category.assoc, ←category.assoc, coequalizer.condition],
  is_colimit := pushout_cocone.is_colimit.mk _
    (λ s, coequalizer.desc (coprod.desc (s.ι.app walking_span.left)
      (s.ι.app walking_span.right)) $ by
        rw [category.assoc, colimit.ι_desc, category.assoc, colimit.ι_desc];
        exact pushout_cocone.condition _)
    (by simp) (by simp) $ λ s m h₁ h₂, by { ext,
      { simpa using h₁ },
      { simpa using h₂ } } }

section

local attribute [instance] has_colimit_span_of_has_colimit_pair_of_has_colimit_parallel_pair

/-- If a category has all binary coproducts and all coequalizers, then it also has all pushouts.
    As usual, this is not an instance, since there may be a more direct way to construct
    pushouts. -/
lemma has_pushouts_of_has_binary_coproducts_of_has_coequalizers
  (C : Type u) [𝒞 : category.{v} C] [has_binary_coproducts C] [has_coequalizers C] :
  has_pushouts C :=
has_pushouts_of_has_colimit_span C

end

end category_theory.limits