/-
Copyright (c) 2022 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import computational_monads.distribution_semantics.monad

/-!
# Pairwise Oracle Computations

This file defines a construction `oracle_comp.product` for running two computations independently,
returning both results together as a pair.
We use the notation `oa ×ₘ ob` to represent this monadic product operation.
In theory this could be defined as a specialization of a construction on monads in general,
but that doesn't currently exist in mathlib.

We show that the support is set product of the two individual supports,
and that the probability of an output is the product of the individual probabilities for each
component (similarly for the probability of an event.)
-/

namespace oracle_comp

open oracle_spec
open_locale ennreal big_operators

variables {α β γ : Type} {spec spec' : oracle_spec}

def product (oa : oracle_comp spec α) (ob : oracle_comp spec β) :
  oracle_comp spec (α × β) := do {a ← oa, b ← ob, return (a, b)}

infixr `×ₘ` : 100 := oracle_comp.product

variables (oa : oracle_comp spec α) (ob : oracle_comp spec β)
  (e : set α) (e' : set β) (a : α) (b : β) (x : α × β)

lemma product.def : oa ×ₘ ob = do {a ← oa, b ← ob, return (a, b)} := rfl

instance product.decidable [decidable_eq α] [decidable_eq β] [decidable oa] [decidable ob] :
  decidable (oa ×ₘ ob) := by {unfold product, apply_instance}

section support

@[simp] lemma support_prod : (oa ×ₘ ob).support = oa.support ×ˢ ob.support :=
set.ext (λ x, by simp only [product.def, prod.eq_iff_fst_eq_snd_eq, support_bind, support_bind_return,
  set.mem_Union, set.mem_image, exists_eq_right_right, exists_prop, set.mem_prod])

lemma mem_support_prod_iff : x ∈ (oa ×ₘ ob).support ↔ x.1 ∈ oa.support ∧ x.2 ∈ ob.support :=
by rw [support_prod, set.mem_prod]

end support

section fin_support

variables [decidable_eq α] [decidable_eq β] [decidable oa] [decidable ob]

@[simp] lemma fin_support_prod : (oa ×ₘ ob).fin_support = oa.fin_support ×ˢ ob.fin_support :=
by simp only [fin_support_eq_iff_support_eq_coe, support_prod,
  finset.coe_product, coe_fin_support_eq_support]

lemma mem_fin_support_prod_iff : x ∈ (oa ×ₘ ob).fin_support ↔
  x.1 ∈ oa.fin_support ∧ x.2 ∈ ob.fin_support :=
by rw [fin_support_prod, finset.mem_product]

end fin_support

section distribution_semantics

section eval_dist

/-- Since the two computations run independently, the probability of an element
  is the product of the two individual probabilities-/
@[simp] lemma eval_dist_product_apply : ⁅oa ×ₘ ob⁆ x = ⁅oa⁆ x.1 * ⁅ob⁆ x.2 :=
calc ⁅oa ×ₘ ob⁆ x = ∑' (a : α) (b : β), (⁅oa⁆ a * ⁅ob⁆ b) * (⁅return (a, b)⁆ x) :
    by simp_rw [product.def, eval_dist_bind_apply_eq_tsum, ← ennreal.tsum_mul_left, mul_assoc]
  ... = ∑' (y : α × β), (⁅oa⁆ y.1 * ⁅ob⁆ y.2) * (⁅(return (y.1, y.2) : oracle_comp spec _)⁆ x) :
    by rw ← ennreal.tsum_prod
  ... = (⁅oa⁆ x.1 * ⁅ob⁆ x.2) * (⁅(return (x.1, x.2) : oracle_comp spec _)⁆ x) :
    tsum_eq_single x (λ y hy, by rw [prod.mk.eta, eval_dist_return_apply_of_ne _ hy.symm, mul_zero])
  ... = ⁅oa⁆ x.1 * ⁅ob⁆ x.2 : by rw [prod.mk.eta, eval_dist_return_apply_self, mul_one]

lemma prod_bind_equiv_bind_bind (oc : α × β → oracle_comp spec γ) :
  oa ×ₘ ob >>= oc ≃ₚ do {a ← oa, b ← ob, oc (a, b)} :=
begin
  sorry
end

@[simp] lemma eval_dist_prod_indicator_prod_apply :
  (e ×ˢ e').indicator ⁅oa ×ₘ ob⁆ x = (e.indicator ⁅oa⁆ x.1) * (e'.indicator ⁅ob⁆ x.2) :=
begin
  by_cases ha : x.1 ∈ e,
  { by_cases hb : x.2 ∈ e',
    { have : x ∈ (e ×ˢ e') := ⟨ha, hb⟩,
      rw [set.indicator_apply_eq_self.2 (λ h, (h this).elim),
        set.indicator_apply_eq_self.2 (λ h, (h ha).elim),
        set.indicator_apply_eq_self.2 (λ h, (h hb).elim), eval_dist_product_apply] },
    { have : x ∉ (e ×ˢ e') := λ h, hb h.2,
      rw [set.indicator_apply_eq_zero.2 (λ h, (this h).elim),
        set.indicator_apply_eq_zero.2 (λ h, (hb h).elim), mul_zero] } },
  { have : x ∉ (e ×ˢ e') := λ h, ha h.1,
    rw [set.indicator_apply_eq_zero.2 (λ h, (this h).elim),
      set.indicator_apply_eq_zero.2 (λ h, (ha h).elim), zero_mul] }
end

lemma eval_dist_prod_indicator_preimage_fst_apply :
  (prod.fst ⁻¹' e).indicator ⁅oa ×ₘ ob⁆ (a, b) = e.indicator ⁅oa⁆ a * ⁅ob⁆ b :=
begin
  by_cases ha : a ∈ e,
  { have : (a, b) ∈ (prod.fst ⁻¹' e : set (α × β)) := set.mem_preimage.2 ha,
    rw [set.indicator_apply_eq_self.2 (λ h, (h this).elim),
      set.indicator_apply_eq_self.2 (λ h, (h ha).elim), eval_dist_product_apply] },
  { have : (a, b) ∉ (prod.fst ⁻¹' e : set (α × β)) := λ h, ha (set.mem_preimage.2 h),
    rw [set.indicator_apply_eq_zero.2 (λ  h, (this h).elim),
      set.indicator_apply_eq_zero.2 (λ h, (ha h).elim), zero_mul] }
end

lemma eval_dist_prod_indicator_preimage_snd_apply :
  (prod.snd ⁻¹' e').indicator ⁅oa ×ₘ ob⁆ (a, b) = ⁅oa⁆ a * e'.indicator ⁅ob⁆ b :=
begin
  by_cases hb : b ∈ e',
  { have : (a, b) ∈ (prod.snd ⁻¹' e' : set (α × β)) := set.mem_preimage.2 hb,
    rw [set.indicator_apply_eq_self.2 (λ h, (h this).elim),
      set.indicator_apply_eq_self.2 (λ h, (h hb).elim), eval_dist_product_apply] },
  { have : (a, b) ∉ (prod.snd ⁻¹' e' : set (α × β)) := λ h, hb (set.mem_preimage.2 h),
    rw [set.indicator_apply_eq_zero.2 (λ h, (this h).elim),
      set.indicator_apply_eq_zero.2 (λ h, (hb h).elim), mul_zero] }
end

lemma eval_dist_map_fst_product_apply [decidable_eq γ] (f : α × β → γ) (x : α × γ) :
  ⁅= x | (λ (x : α × β), (prod.fst x, f x)) <$> oa ×ₘ ob⁆ =
    ∑' (b : β), if x.2 = f (a, b) then ⁅= x.1 | oa⁆ * ⁅= b | ob⁆ else 0 :=
begin
  sorry
end

lemma eval_dist_map_product' (f : α × β → γ) :
  ⁅f <$> oa ×ₘ ob⁆ = ⁅oa >>= λ a, ob >>= λ b, return $ f (a, b)⁆ :=
sorry

end eval_dist

section prob_event

@[simp] lemma prob_event_prod_eq_mul : ⁅e ×ˢ e' | oa ×ₘ ob⁆ = ⁅e | oa⁆ * ⁅e' | ob⁆ :=
calc ⁅e ×ˢ e' | oa ×ₘ ob⁆ = ∑' x, (e ×ˢ e').indicator ⁅oa ×ₘ ob⁆ x :
    (prob_event_eq_tsum_indicator _ _)
  ... = ∑' (x : α × β), e.indicator ⁅oa⁆ x.1 * e'.indicator ⇑⁅ob⁆ x.2 :
    tsum_congr (λ x, eval_dist_prod_indicator_prod_apply oa ob e e' x)
  ... = (∑' a, e.indicator ⁅oa⁆ a) * (∑' b, e'.indicator ⁅ob⁆ b) :
    by simp_rw [← ennreal.tsum_mul_right, ← ennreal.tsum_mul_left, ← ennreal.tsum_prod]
  ... = ⁅e | oa⁆ * ⁅e' | ob⁆ : by simp_rw [prob_event_eq_tsum_indicator]

/-- If an event only cares about the first part of the computation,
we can calculate the probability using only the first of the computations. -/
@[simp] lemma prob_event_prod_preimage_fst : ⁅prod.fst ⁻¹' e | oa ×ₘ ob⁆ = ⁅e | oa⁆ :=
calc ⁅prod.fst ⁻¹' e | oa ×ₘ ob⁆
  = ∑' (x : α × β), (prod.fst ⁻¹' e).indicator ⇑⁅oa×ₘ ob⁆ (x.1, x.2) :
    by simp_rw [prob_event_eq_tsum_indicator, prod.mk.eta]
  ... = ∑' a b, (prod.fst ⁻¹' e).indicator ⇑⁅oa×ₘ ob⁆ (a, b) :
    @ennreal.tsum_prod α β (λ a b, (prod.fst ⁻¹' e).indicator ⇑⁅oa×ₘ ob⁆ (a, b))
  ... = ∑' a, e.indicator ⁅oa⁆ a : by simp only [eval_dist_prod_indicator_preimage_fst_apply,
    ennreal.tsum_mul_left, ⁅ob⁆.tsum_coe, mul_one]
  ... = ⁅e | oa⁆ : by rw [prob_event_eq_tsum_indicator]

/-- If an event only cares about the second part of the computation,
we can calculate the probability using only the first of the computations. -/
lemma prob_event_prod_preimage_snd : ⁅prod.snd ⁻¹' e' | oa ×ₘ ob⁆ = ⁅e' | ob⁆ :=
calc ⁅prod.snd ⁻¹' e' | oa ×ₘ ob⁆
  = ∑' (x : α × β), (prod.snd ⁻¹' e').indicator ⁅oa ×ₘ ob⁆ (x.1, x.2) :
    by simp_rw [prob_event_eq_tsum_indicator, prod.mk.eta]
  ... = ∑' a b, (prod.snd ⁻¹' e').indicator ⁅oa ×ₘ ob⁆ (a, b) :
    @ennreal.tsum_prod α β (λ a b, (prod.snd ⁻¹' e').indicator ⁅oa ×ₘ ob⁆ (a, b))
  ... = ∑' b a, (prod.snd ⁻¹' e').indicator ⁅oa ×ₘ ob⁆ (a, b) : ennreal.tsum_comm
  ... = ∑' b, e'.indicator ⁅ob⁆ b : by simp only [eval_dist_prod_indicator_preimage_snd_apply,
    ennreal.tsum_mul_right, ⁅oa⁆.tsum_coe, one_mul]
  ... = ⁅e' | ob⁆ : by rw [prob_event_eq_tsum_indicator]

end prob_event

section indep_events

/-- Any collections of sets corresponding to output types of two computations
are independent when returning the outputs of the computations in a `prod` type. -/
theorem indep_events_prod (es : set (set α)) (es' : set (set β)) :
  indep_events (oa ×ₘ ob) ((λ e, prod.fst ⁻¹' e) '' es) ((λ e', prod.snd ⁻¹' e') '' es') :=
begin
  rw [indep_events_iff],
  intros e e' he he',
  obtain ⟨d, hd, hde⟩ := he,
  obtain ⟨d', hd', hde'⟩ := he',
  have hed : e = prod.fst ⁻¹' d := hde.symm,
  have hed' : e' = prod.snd ⁻¹' d' := hde'.symm,
  have h : e ∩ e' = d ×ˢ d',
  from set.ext (λ x, by simp only [hed, hed', set.mem_inter_iff, set.mem_preimage, set.mem_prod]),
  rw [h, hed, hed', prob_event_prod_eq_mul, prob_event_prod_preimage_fst,
    prob_event_prod_preimage_snd],
end

/-- Any events corresponding to two computations respective output types
are independent when running the two independently and returning the two outputs in a `prod` type -/
lemma indep_event_prod (e : set α) (e' : set β) :
  indep_event (oa ×ₘ ob) (prod.fst ⁻¹' e) (prod.snd ⁻¹' e') :=
begin
  rw [indep_event_iff_indep_events],
  convert indep_events_prod oa ob {e} {e'};
  simp only [set.image_singleton],
end

end indep_events

end distribution_semantics

end oracle_comp


import algebraic_topology.simplicial_object
import algebra.category.Group.basic
import kan_complex

open category_theory

open_locale simplicial

universes u

variable {n : ℕ}
variable {k : fin (n + 3)}

@[derive [large_category]]
def sGrp : Type (u+1) := simplicial_object Group.{u}

variable {G : sGrp.{u}}

def to_sSet : sGrp.{u} ⥤ sSet.{u} := ((simplicial_object.whiskering _ _).obj (forget Group))

instance sGrp_to_sSet : has_coe sGrp sSet := ⟨to_sSet.obj⟩

@[simp]
lemma induction_zero
  {C : fin (n + 1) → Sort*}
  (h0 : C 0)
  (hs : ∀ i : fin n, C i.cast_succ → C i.succ) :
  @fin.induction n C h0 hs 0 = h0 := rfl

@[simp]
lemma induction_succ
  {C : fin (n + 1) → Sort*}
  (h0 : C 0)
  (hs : ∀ i : fin n, C i.cast_succ → C i.succ) (i : fin n) :
  @fin.induction n C h0 hs i.succ =
    hs i (@fin.induction n C h0 hs i.cast_succ) := by cases i; refl

lemma sset_comp (X : sGrp) {i j k} (f : X _[i] ⟶ X _[j])
  (g : X _[j] ⟶ X _[k]) (x : X _[i]) : g (f x) = (f ≫ g) x := rfl

def u
  (y : excluded_part n k → G _[n + 1])
  (faces : matching_faces.{u} n k G y)
  (r : fin (n + 3)) (h : r ≤ k) : G _[n + 2] :=
  fin.induction (λ h, 1) (λ r' ih h,
    have h' : r'.cast_succ < k := fin.cast_succ_lt_iff_succ_le.mpr h,
    let u' := ih (le_of_lt h') in
    u' * G.σ r' (G.δ r'.cast_succ (u' ⁻¹) * y ⟨r'.cast_succ, ne_of_lt h'⟩ ) ) r h

lemma du
  (y : excluded_part n k → G _[n + 1])
  (faces : matching_faces.{u} n k G y)
(r i: fin (n + 3)) (h : r ≤ k) (hi : i < r) : G.δ i (u y faces r h) = y ⟨i, ne_of_lt (lt_of_lt_of_le hi h)⟩ :=
begin
  refine fin.induction _ _ r h i hi;
  clear hi i h r,
  focus {
    intros h i hi,
    cases hi,
  },
  intros r ih h i hi,
  have irlv : i ≠ k := ne_of_lt (lt_of_lt_of_le hi h),
  change G.δ i (u y faces r.succ h) = y {i := i, h := irlv},
  by_cases hi' : i = r.cast_succ,
  focus {
    subst hi',
    clear ih,
    simp_rw [u],
    rw [induction_succ],
    rw [←u],
    swap, assumption,
    simp only [map_inv, map_mul],
    nth_rewrite 2 [sset_comp],
    nth_rewrite 0 [sset_comp],
    rw [simplicial_object.δ_comp_σ_self],
    simp only [id_apply, mul_inv_cancel_left],
  },
  have hi'' : i < r.cast_succ := ne.lt_of_le hi' (fin.le_cast_succ_iff.mpr hi),
  clear hi hi',
  have hi := hi'', clear hi'',
  specialize ih (le_of_lt $ lt_of_lt_of_le fin.lt_succ h) i hi,
  simp_rw [u],
  rw [induction_succ],
  rw [←u], swap, assumption,
  simp only [ih, map_inv, map_mul, mul_right_eq_self],
  set j := i.cast_pred,
  have hj : i = j.cast_succ := by {
    rw [fin.cast_succ_cast_pred],
    exact lt_of_lt_of_le hi (fin.le_last r.cast_succ),
  },
  rw [hj],
  set r' := r.pred (by {
    intro h0,
    rw h0 at hi,
    cases hi,
  }),
  have hr : r = r'.succ := by rw [fin.succ_pred],
  simp_rw [hr],
  nth_rewrite 0 [sset_comp],
  rw [simplicial_object.δ_comp_σ_of_le], swap,
  rw [fin.le_cast_succ_iff, ←fin.cast_succ_lt_cast_succ_iff],
  rwa [←hj, ←hr],
  rw [←sset_comp],
  nth_rewrite 1 [sset_comp],
  simp_rw [←fin.succ_cast_succ],
  have j_leq_r' : j ≤ r'.cast_succ :=
    by rwa [fin.le_cast_succ_iff, ←hr, ←fin.cast_succ_lt_cast_succ_iff, ←hj],
  rw [simplicial_object.δ_comp_δ], swap, assumption,
  simp_rw [←sset_comp, ←hj, fin.succ_cast_succ, ←hr, ih],
  nth_rewrite 1 [sset_comp],
  simp_rw [hj, hr],
  rw [simplicial_object.δ_comp_σ_of_le], swap, assumption,
  rw [←sset_comp, ←map_inv, ←map_mul],
  have j_neq_k : j.cast_succ ≠ k := by rwa [←hj],
  have r_lt_k : r'.cast_succ.succ < k :=
    by rwa [fin.succ_cast_succ, ←hr, fin.cast_succ_lt_iff_succ_le],
  have hc := faces ⟨j, r'.cast_succ, j_leq_r', j_neq_k, ne_of_lt r_lt_k⟩, simp only at hc,
  change simplicial_object.δ G j (y {i := r'.cast_succ.succ, h := _}) = simplicial_object.δ G r'.cast_succ (y {i := j.cast_succ, h := _}) at hc,
  simp_rw [fin.succ_cast_succ] at hc,
  rw hc,
  simp only [mul_left_inv, map_one],
end

def u'
  (y : excluded_part n k → G _[n + 1])
  (faces : matching_faces.{u} n k G y) : G _[n + 2] := u y faces k (by refl)

def du'
  (y : excluded_part n k → G _[n + 1])
  (faces : matching_faces.{u} n k G y)
  (i : fin (n + 3)) (h : i < k) : G.δ i (u' y faces) = y ⟨i, ne_of_lt h⟩ :=
begin
  dsimp [u'],
  apply du,
  assumption,
end

def w
  (y : excluded_part n k → G _[n + 1])
  (faces : matching_faces.{u} n k G y)
  (r : fin (n + 3)) (h : r ≥ k) : G _[n + 2] :=
  fin.reverse_induction (λ _, u' y faces) (λ r' ih h,
    have h' : r'.succ > k := fin.le_cast_succ_iff.mp h,
    let w' := ih (le_of_lt h') in
    w' * G.σ r' (G.δ r'.succ (w' ⁻¹) * y ⟨r'.succ, ne_of_gt h'⟩)) r h

def aux_dw
  {r i : fin (n + 3)}
  (h : r ≥ k)
  (hi : i < k ∨ i > r) : i ≠ k :=
begin
  cases hi,
  exact ne_of_lt hi,
  exact ne_of_gt (gt_of_gt_of_ge hi h),
end

lemma dw
  (y : excluded_part n k → G _[n + 1])
  (faces : matching_faces.{u} n k G y)
  (r i : fin (n + 3)) (h : r ≥ k) (hi : i < k ∨ i > r) :
  G.δ i (w y faces r h) = y ⟨i, aux_dw h hi⟩ :=
begin
  refine fin.reverse_induction _ _ r h i hi;
  clear' r h i hi,
  focus {
    intros h i ih,
    cases ih,
    dsimp [w],
    rw [fin.reverse_induction_last],
    apply du',
    exfalso,
    exact (not_le_of_gt ih (fin.le_last i)),
  },
  intros r ih h i hi,
  have irlv := aux_dw h hi,
  change G.δ i (w y faces (r.cast_succ) h) = y {i := i, h := irlv},
  by_cases hi' : r.succ = i,
  focus {
    subst hi',
    clear ih hi,
    simp_rw [w], rw [fin.reverse_induction_cast_succ],
    rw [←w],
    simp only [map_inv, map_mul],
    nth_rewrite 2 [sset_comp],
    nth_rewrite 0 [sset_comp],
    rw [simplicial_object.δ_comp_σ_succ],
    simp only [id_apply, mul_inv_cancel_left],
  },
  have hi'' : i < k ∨ i > r.succ := by {
    cases hi,
    left, assumption,
    right, refine ne.lt_of_le hi' (fin.cast_succ_lt_iff_succ_le.mp hi),
  },
  clear' hi hi', have hi := hi'', clear hi'',
  have r_succ_gt_k : r.succ > k := fin.le_cast_succ_iff.mp h,
  specialize ih (le_of_lt r_succ_gt_k) i hi,
  simp_rw [w],
  rw [fin.reverse_induction_cast_succ],
  rw [←w],
  simp [ih],
  cases hi,
  case or.inl {
    set j := i.cast_pred,
    have hj : i = j.cast_succ := by {
      rw [fin.cast_succ_cast_pred],
      exact lt_of_lt_of_le hi (fin.le_last k),
    },
    simp_rw [hj] at irlv hi ih ⊢,
    set r' := r.pred (by {
      intro h0,
      have hk : 0 < k := lt_of_le_of_lt j.cast_succ.zero_le hi,
      rw h0 at h, simp at h,
      exact not_le_of_gt hk h,
    }),
    have hr : r = r'.succ := by rw [fin.succ_pred],
    simp_rw [hr] at h r_succ_gt_k ih ⊢,
    have j_leq_r' : j ≤ r'.cast_succ := by {
      rw [fin.cast_succ_lt_iff_succ_le] at hi,
      rw [←fin.succ_cast_succ] at h,
      have h' := le_trans hi h,
      rwa [fin.succ_le_succ_iff] at h',
    },
    have j_le_r'_succ : j ≤ r'.succ :=
      le_of_lt (lt_of_le_of_lt j_leq_r' fin.lt_succ),
    nth_rewrite 0 [sset_comp],
    nth_rewrite 1 [sset_comp],
    rw [simplicial_object.δ_comp_σ_of_le], swap, assumption,
    simp_rw [←sset_comp],
    nth_rewrite 1 [sset_comp],
    rw [simplicial_object.δ_comp_δ], swap, assumption,
    rw [←sset_comp],
    rw [ih],
    specialize faces ⟨j, r'.succ, j_le_r'_succ, irlv, ne_of_gt r_succ_gt_k⟩,
    simp only at faces,
    change G.δ j (y {i := r'.succ.succ, h := _}) =
      G.δ r'.succ (y {i := j.cast_succ, h := _}) at faces,
    rw [←faces_1],
    simp only [mul_left_inv],
  },
  case or.inr {
    set j := i.pred (by {
      intro h0, rw h0 at hi, cases hi,
    }),
    have hj : i = j.succ := by rw [fin.succ_pred],
    simp_rw [hj] at ih hi irlv ⊢,
    change r.succ < j.succ at hi,
    rw [fin.succ_lt_succ_iff] at hi_1,
    set r' := r.cast_pred,
    have hr : r = r'.cast_succ := by {
      rw [fin.cast_succ_cast_pred],
      exact lt_of_lt_of_le hi_1 (fin.le_last j),
    },
    simp_rw [hr] at h r_succ_gt_k ih hi_1 ⊢,
    have hi' : r'.succ ≤ j := fin.cast_succ_lt_iff_succ_le.mp hi_1,
    rw [fin.succ_cast_succ] at r_succ_gt_k,
    nth_rewrite 0 [sset_comp],
    nth_rewrite 1 [sset_comp],
    rw [simplicial_object.δ_comp_σ_of_gt], swap, assumption,
    simp_rw [←sset_comp],
    nth_rewrite 1 [sset_comp],
    simp_rw [fin.succ_cast_succ],
    rw [←simplicial_object.δ_comp_δ], swap, assumption,
    simp_rw [←fin.succ_cast_succ, ←sset_comp, ih],
    specialize faces ⟨r'.succ, j, hi', ne_of_gt r_succ_gt_k, irlv⟩,
    simp only at faces,
    change G.δ r'.succ (y {i := j.succ, h := _}) =
      G.δ j (y {i := r'.succ.cast_succ, h := _}) at faces,
    simp_rw [fin.succ_cast_succ, ←faces_1],
    simp only [mul_left_inv],
  },
end

def w'
  (y : excluded_part n k → G _[n + 1])
  (faces : matching_faces.{u} n k G y) : G _[n + 2] := w y faces k (by fconstructor)

def dw'
  (y : excluded_part n k → G _[n + 1])
  (faces : matching_faces.{u} n k G y)
  (i : fin (n + 3)) (h : i ≠ k) : G.δ i (w' y faces) = y ⟨i, h⟩ :=
begin
  cases lt_trichotomy i k,
  apply dw, left, assumption,
  cases h_1, contradiction,
  apply dw, right, assumption,
end

def sGrp_Ext (G : sGrp.{0}) : extension_condition.{0} G :=
begin
  dsimp [extension_condition],
  intros n k y faces,
  use w' y faces,
  intro idx, cases idx,
  apply dw',
end

def sGrp_Kan (G : sGrp.{0}) : kan_complex G :=
  kan_complex_iff_extension_conditions.mpr (sGrp_Ext G)


import for_mathlib.category_theory.abelian.extension_example
import for_mathlib.algebra.homology.homology_sequence
import for_mathlib.algebra.homology.k_projective

noncomputable theory

open category_theory category_theory.pretriangulated category_theory.abelian
  derived_category

variables {C : Type*} [category C] [abelian C]

/-- The derived category `derived_category C` of an abelian category `C`
is a triangulated category. -/
example : is_triangulated (derived_category C) := infer_instance

/-- There is a triangulated functor from the homotopy category of cochain
complexes indexed by `ℤ` to the derived category. -/
example : functor.is_triangulated
  (Qh : homotopy_category C (complex_shape.up ℤ) ⥤ derived_category C) := infer_instance

/-- The derived category of an abelian category is the localization of the
homotopy category of cochain complexes indexed by `ℤ` with respect to a
certain class of morphisms `(homotopy_category.acyclic C).W`.
By definition, `homotopy_category.acyclic C` is the subtriangulated category
of the homotopy category consisting of acyclic complexes (i.e. with zero homology).
The class `(triangulated.subcategory.W (homotopy_category.acyclic C))` is then the
class of morphisms whose "cone" is acyclic.  -/
example : functor.is_localization Qh
  (triangulated.subcategory.W (homotopy_category.acyclic C)) := infer_instance

/-- The canonical functor `Q : cochain_complex C ℤ ⥤ derived_category C`
is the composition of two functors :
`homotopy_category.quotient _ _ : cochain_complex C ℤ ⥤ homotopy_category C (complex_shape.up ℤ)`
and `Qh : homotopy_category C (complex_shape.up ℤ) ⥤ derived_category C`. -/
example : cochain_complex C ℤ ⥤ derived_category C := Q

/-- The derived category was defined here in two steps from `cochain_complex C ℤ`
(passing to the quotient by the homotopy relation, and then localizing). In this
way, we could get the triangulated structure. We also obtain that the
derived category is the localization of `cochain_complex C ℤ` with
respect to quasi-isomorphisms, which are morphisms inducing isomorphisms
in homology. (This is obtained by showing that the homotopy category is the localization
of `cochain_complex C ℤ` with respect to homotopy equivalences, and a general composition
of localization statement.) -/
example : functor.is_localization Q (quasi_isomorphisms C _) := infer_instance

/- For any short exact sequence `0 ⟶ X₁ ⟶ X₂ ⟶ X₃ ⟶ 0` in `cochain_complex C ℤ`, there is
an associated distinguished triangle `X₁ ⟶ X₂ ⟶ X₃ ⟶ X₁⟦1⟧` in the derived category. -/
example {X₁ X₂ X₃ : cochain_complex C ℤ} (f : X₁ ⟶ X₂) (g : X₂ ⟶ X₃) (w : f ≫ g = 0)
  (ex : (short_complex.mk f g w).short_exact) :
  triangle.mk (Q.map f) (Q.map g) (triangle_of_ses_δ ex) ∈ dist_triang (derived_category C) :=
triangle_of_ses_dist ex

/-- The homology functors on `cochain_complex C ℤ` induce functors
`homology_functor C n : derived_category C ⥤ C`, and these functors
are homological. -/
example (n : ℤ) : (homology_functor C n).is_homological := infer_instance

/-- That these functors are homological implies that any distinguished triangle
`obj₁ ⟶ obj₂ ⟶ obj₃ ⟶ obj₁⟦1⟧` induces an exact sequence
H⁰ obj₁ ⟶ H⁰ obj₂ ⟶ H⁰ obj₃`. -/
example (T : triangle (derived_category C)) (hT : T ∈ dist_triang (derived_category C)) :
  ((short_complex.mk T.mor₁ T.mor₂ (comp_dist_triangle_mor_zero₁₂ _ T hT)).map
    (homology_functor C 0)).exact :=
functor.is_homological.map_distinguished _ T hT
/- Using the rotation of triangles, there is actually an infinitely long exact homology
sequence associated to any distinguished triangle in `derived_category C`. -/

section homology_sequence

open cochain_complex.homology_sequence

variables {X₁ X₂ X₃ : cochain_complex C ℤ} {f : X₁ ⟶ X₂} {g : X₂ ⟶ X₃} {w : f ≫ g = 0}
  (ex : (short_complex.mk f g w).short_exact) (n₀ n₁ : ℤ) (h : n₁ = n₀ + 1)

/- Using the distinguished triangle `X₁ ⟶ X₂ ⟶ X₃ ⟶ X₁⟦1⟧` associated to
a short exact sequence `0 ⟶ X₁ ⟶ X₂ ⟶ X₃ ⟶ 0` in `cochain_complex C ℤ`, we get
a connecting homomorphism in homology, which raises the degree by `1` : `n₁ = n₀ + 1`. -/
example : X₃.homology n₀ ⟶ X₁.homology n₁ := cochain_complex.homology_sequence.δ ex n₀ n₁ h

/- Exactness of the long homology sequences. -/

example : (short_complex.mk (homology_map f n₀) (homology_map g n₀) _).exact := ex₂ ex n₀

example : (short_complex.mk (homology_map g n₀) (δ ex n₀ n₁ h) _).exact := ex₃ ex n₀ n₁ h

example : (short_complex.mk (δ ex n₀ n₁ h) (homology_map f n₁) _).exact := ex₁ ex n₀ n₁ h

/- Relation to the snake lemma. -/

variables {A : C} (x₃ : A ⟶ X₃.X n₀) (x₂ : A ⟶ X₂.X n₀) (x₁ : A ⟶ X₁.X n₁)
  (hx₃ : x₃ ≫ X₃.d n₀ n₁ = 0) -- `x₃` can be thought as a cocycle of `X₃`
  (hx₂ : x₂ ≫ g.f n₀ = x₃)    -- `x₂` is a lift of `x₃`, which may not be a cocycle...
  (hx₁ : x₁ ≫ f.f n₁ = x₂ ≫ X₂.d n₀ n₁) -- `x₁` identifies to the differential of `x₂`

/-- The image of the homology class of the cocycle `x₃` by the connecting homomorphism
is the homology class of `x₁`. -/
example : X₃.lift_cycles x₃ n₁ h.symm hx₃ ≫ X₃.homology_π n₀ ≫ δ ex n₀ n₁ h =
  X₁.lift_cycles x₁ _ rfl _ ≫ X₁.homology_π n₁ :=
cochain_complex.homology_sequence.comp_δ_eq ex x₃ x₂ x₁ h hx₃ hx₂ hx₁

/- Note: the proof of the exactness of the long exact sequence above did not use the
snake lemma. Using the snake lemma, one may get a different construction of a more
general exact sequence in homology associated to a short exact sequences of complexes
for any complex_shape `c`. Then, the formula above could be used in order to show
that the connecting homomorphism obtained from the snake lemma is the same as the
one obtained from the construction above using a distinguished triangle in the
derived category. -/

end homology_sequence

/-- For any `n : ℤ`, there is a functor `single_functor C n : C ⥤ derived_category C`
which sends `A : C` to the complex consisting of `A` in degree `n`, and `0` otherwise.
This functor is fully faithful. -/
instance (n : ℤ) : full (single_functor C n) := infer_instance
instance (n : ℤ) : faithful (single_functor C n) := infer_instance

/-- As a particular case of the construction of a distinguished associated to
a short exact sequence of complexes, a short exact sequence `0 ⟶ B ⟶ E ⟶ A ⟶ 0`
in the abelian category `C` induces a distinguished triangle. -/
example {A B : C} (e : extension A B) :
  (triangle.mk ((single_functor C 0).map e.i) ((single_functor C 0).map e.p) e.δ)
    ∈ dist_triang (derived_category C) := extension.triangle_distinguished e

/-- In the distinguished triangle associated to an extension `e : extension A B`,
we have a connecting morphism `e.δ`. -/
example {A B : C} (e : extension A B) :
  (single_functor C 0).obj A ⟶ ((single_functor C 0).obj B)⟦(1 : ℤ)⟧ := e.δ

/-- All morphisms `(single_functor C 0).obj A ⟶ ((single_functor C 0).obj B)⟦(1 : ℤ)⟧`
are `e.δ` for some `e : extension A B`, and the isomorphisms class of `e` is uniquely
determined. This can be translated as a natural isomorphism from the
bifunctor `extensions_functor C` which sends `A` and `B` to the set of isomorphism
classes in the category `extension A B`. -/
example : extensions_functor C ≅
  ((single_functor C 0).op ⋙
    (single_functor C 0 ⋙ shift_functor _ (1 : ℤ) ⋙ yoneda).flip).flip :=
extensions.δ_nat_iso C

/-- When `n : ℤ` is ≥ 2, the obvious short exact sequence 0 ⟶ ℤ ⟶ ℤ ⟶ ℤ/nℤ ⟶ 0 does not split,
which gives a non trival morphism "ℤ/nℤ ⟶ ℤ⟦1⟧` in the derived category. -/
example (n : ℤ) (hn : 2 ≤ n) :
  (Module.extension_of_non_zero_divisor (n : ℤ) (n.non_zero_divisor_of_two_le hn)).δ ≠ 0 :=
begin
  rw Module.extension_of_non_zero_divisor.δ_neq_zero,
  intro h,
  cases int.is_unit_iff.1 h; linarith,
end

/-- Even though we defined (canonical) truncation functors on `cochain_complex C ℤ` and
`derived_category C` (cf. `algebra/homology/trunc.lean`), we did not formalise
t-structures, but at least we have the following "orthogonality condition" which says
that there are no nonzero morphisms `K ⟶ L` in the derived category
when `K` is cohomologically in degrees ≤ 0 and `L` is cohomologically in degrees ≥ 1. -/
lemma t_structure_condition {K L : derived_category C} [K.is_le 0] [L.is_ge 1]
  (f : K ⟶ L) : f = 0 := orthogonality f 0 1 (one_pos)

/-- In particular, there are no nonzeros morphisms
`(single_functor C 0).obj A ⟶ ((single_functor C 0).obj B)⟦n⟧` when `n>0`. -/
example (A B : C) (n : ℤ) (hn : n < 0)
  (f : (single_functor C 0).obj A ⟶ ((single_functor C 0).obj B)⟦n⟧) :
    f = 0 :=
begin
  /- We show that `(((single_functor C 0).obj B)⟦n⟧` has no homology in degrees < -n -/
  haveI : (((single_functor C 0).obj B)⟦n⟧).is_ge (-n) := shift_is_ge _ 0 n (-n) (by linarith),
  /- In particular, it has no homology in degrees < 1 -/
  haveI : (((single_functor C 0).obj B)⟦n⟧).is_ge 1 := is_ge_of_le _ 1 (-n) (by linarith),
  /- Then, we use a general orthogonality condition -/
  apply t_structure_condition,
end

/-- By definition, a cochain complex `K` is K-projective if for any acyclic complex `L`,
all the maps `K ⟶ L` are null homotopic (Spaltenstein). Then, if `K` is K-projective,
morphisms from `Q.obj K` in the derived category can be computed as homotopy classes
of maps. -/
example (K L : cochain_complex C ℤ) [K.is_K_projective] :
  function.bijective (Qh.map :
    ((homotopy_category.quotient C (complex_shape.up ℤ)).obj K ⟶
    (homotopy_category.quotient C (complex_shape.up ℤ)).obj L) → (Q.obj K ⟶ Q.obj L)) :=
Qh_map_bijective_of_is_K_projective K L

/-- A key technical result is that a bounded above complex consisting of
projective objects is K-projective. -/
example (K : cochain_complex C ℤ) (n : ℤ) [K.is_strictly_le n]
  [∀ (n : ℤ), projective (K.X n)] : K.is_K_projective :=
cochain_complex.is_K_projective_of_bounded_above_of_projective K n

/- It follows from the two previous results that there is a full embedding from
the homotopy category of bounded above complexes of projectives objects into the
derived category. -/


import homotopy_theory.formal.cofibrations.precofibration_category
import homotopy_theory.formal.cylinder.hep

import .cofibrations
import .colimits
import .pushout_lemmas

open set

open category_theory
local notation f ` ∘ `:80 g:80 := g ≫ f

namespace homotopy_theory.topological_spaces
open homotopy_theory.cofibrations
open homotopy_theory.cylinder
open Top
local notation `Top` := Top.{0}

-- We're interested in structures whose "cofibrations" are the
-- *closed* cofibrations, that is, the cofibrations in the classical
-- sense with closed image.
def closed_cofibration {A X : Top} (j : A ⟶ X) : Prop :=
cofibration j ∧ is_closed (range j)

-- A closed cofibration is a closed map.
lemma closed_cofibration.is_closed {A X : Top} {j : A ⟶ X} (hj : closed_cofibration j)
  {v : set A} : is_closed v → is_closed (j '' v) :=
embedding_is_closed (embedding_of_cofibration hj.1) hj.2

lemma closed_cofibration_id (A : Top) : closed_cofibration (𝟙 A) :=
⟨hep_id 0,
 by change is_closed (range (id : A → A)); rw [range_id]; exact is_closed_univ⟩

lemma closed_cofibration_comp {A B C : Top} {j : A ⟶ B} {k : B ⟶ C}
  (hj : closed_cofibration j) (hk : closed_cofibration k) :
  closed_cofibration (k ∘ j) :=
⟨hep_comp 0 hj.1 hk.1,
 by change is_closed (range (function.comp k j)); rw [range_comp];
    exact hk.is_closed hj.2⟩

instance : precofibration_category Top :=
{ is_cof := @closed_cofibration,
  mem_id := closed_cofibration_id,
  mem_comp := @closed_cofibration_comp,
  pushout_by_cof := λ _ _ _ f g _, has_pushouts.pushout f g,
  pushout_is_cof := λ _ _ _ _ f g f' g' po ⟨co_f, cl_f⟩,
    ⟨hep_pushout' 0 po co_f, (range_i_closed_iff_range_j_closed po).mp cl_f⟩ }

instance : all_objects_cofibrant.{0} Top :=
⟨assume A,
 ⟨hep_initial_induced 0
   Top.empty_is_initial_object
   (preserves_initial_object.Is_initial_object_of_Is_initial_object Top.empty_is_initial_object),
  begin
    convert is_closed_empty,
    rw eq_empty_iff_forall_not_mem,
    intros x h,
    rcases h with ⟨⟨⟩, he⟩
  end⟩⟩

lemma closed_cofibration_incl_iff {P : pair} :
  closed_cofibration P.incl ↔ P.cofibered ∧ is_closed P.subset :=
iff.intro
  (assume ⟨h₁, h₂⟩, ⟨h₁, by convert h₂; exact subtype.range_val.symm⟩)
  (assume ⟨h₁, h₂⟩, ⟨h₁, by convert h₂; exact subtype.range_val⟩)

end homotopy_theory.topological_spaces


lemma imp_self (P : Prop) : P → P :=
begin
intro p, exact p,
end


import QL.FOL.Tait.semantics QL.FOL.Tait.coding lib.order

universes u v

namespace fol
open_locale logic_symbol aclogic

namespace Tait

variables {L : language.{u}} {m n : ℕ}

open subformula

def is_terminal (Δ : finset (bounded_subformula L m 0)) : Prop := ∃ {k} (r : L.pr k) (v), relation r v ∈ Δ ∧ neg_relation r v ∈ Δ

variables {L} [∀ k, encodable (L.fn k)] [∀ k, encodable (L.pr k)]
open encodable

@[simp] noncomputable def instance_enum (p : bounded_subformula L m 1) : ℕ → finset (bounded_formula L m)
| 0       := ∅
| (s + 1) := instance_enum s ∪ (option.map (λ t, subst t p) $ fol.subterm.of_index L m 0 s).to_finset

lemma mem_instance_enum_of_lt (t : bounded_subterm L m 0) (p : bounded_subformula L m 1) (i) :
  t.index < i → subst t p ∈ instance_enum p i :=
begin
  induction i with i IH,
  { simp },
  { simp,
    intros h,
    have : t.index < i ∨ t.index = i, from nat.lt_succ_iff_lt_or_eq.mp h,
    rcases this with (lt | rfl),
    { refine or.inl (IH lt) },
    { refine or.inr ⟨t, by simp, rfl⟩ } }
end

--lemma cast_le_instance_enum {m₁ m₂} (h : m₁ ≤ m₂) (p : bounded_subformula L m₁ 1) (i) :
--  (instance_enum p i).image (cast_le h) = instance_enum (cast_le h p) i :=
--by { induction i with i IH, { simp }, { simp[finset.image_union, IH], } }

variables {L}

def decomp : ℕ → bounded_subformula L m 0 → finset (bounded_formula L m) → set (Σ m, finset (bounded_formula L m))
| i (relation r v)     Γ := { ⟨m, Γ⟩, }
| i (neg_relation r v) Γ := { ⟨m, Γ⟩, }
| i (⊤)                Γ := ∅
| i (⊥)                Γ := { ⟨m, Γ⟩, }
| i (p ⊓ q)            Γ := { ⟨m, insert p Γ⟩, ⟨m, insert q Γ⟩, }
| i (p ⊔ q)            Γ := { ⟨m, insert q (insert p Γ)⟩, }
| i (∀'p)              Γ := { ⟨m + 1, insert (push p) (finset_mlift Γ)⟩, }
| i (∃'p)              Γ := { ⟨m, instance_enum p i ∪ Γ⟩, }

lemma decomp_le {m₁ m₂} {p : bounded_subformula L m₁ 0} {Γ₁ : finset (bounded_formula L m₁)} {Γ₂ : finset (bounded_formula L m₂)} {i} :
  sigma.mk m₂ Γ₂ ∈ decomp i p Γ₁ → m₁ ≤ m₂ :=
begin
  { rcases p; simp[decomp, verum_eq, falsum_eq, and_eq, or_eq, fal_eq, ex_eq],
    { rintros rfl rfl, simp },
    { rintros rfl rfl, simp },
    { rintros rfl rfl, simp },
    { rintros (⟨rfl, rfl⟩ | ⟨rfl, rfl⟩); simp },
    { rintros rfl rfl, simp },
    { rintros rfl rfl, simp[(∘)] },
    { rintros rfl rfl, simp } }
end

noncomputable def index_of_set (T : set (sentence L)) (i : ℕ) : option (sentence L) :=
(option.guard (λ i, i ∈ index '' T) i).bind (subformula.of_index L 0 0)

lemma index_of_neg_set_eq_some {T : set (sentence L)} {i : ℕ} {σ : sentence L} :
  index_of_set T i = some σ ↔ i = index σ ∧ σ ∈ T :=
⟨λ h, by { simp[index_of_set] at h, rcases h with ⟨rfl, τ, hτ, e⟩, simp at e, rcases e with rfl, refine ⟨by simp, hτ⟩ },
  by rintros ⟨rfl, hτ⟩; simp[index_of_set, hτ]⟩

@[simp] lemma index_of_neg_set_index {T : set (sentence L)} {σ : sentence L} (h : σ ∈ T) :
  index_of_set T σ.index = some σ :=
by simp[index_of_neg_set_eq_some, h]

@[simp] noncomputable def indices_of_neg_set (T : set (sentence L)) (m) : ℕ → list (bounded_formula L m)
| 0       := []
| (i + 1) := ((index_of_set T i).map coe).to_list ++ indices_of_neg_set i

@[reducible] def search_label (L : language) := ℕ × Σ m, finset (bounded_subformula L m 0)

inductive search_tree_decomp (T : set (sentence L)) (i : ℕ) :
  ∀ {m₁ m₂}, finset (bounded_subformula L m₁ 0) → finset (bounded_subformula L m₂ 0) → Prop
| decomp : ∀ {m₁ m₂} (Γ₁ : finset (bounded_formula L m₁)) (Γ₂ : finset (bounded_formula L m₂))
    (p : bounded_formula L m₁) (hp : p ∈ Γ₁) (hi : p.index = i.unpair.fst),
    sigma.mk m₂ Γ₂ ∈ decomp i.unpair.snd p Γ₁ → search_tree_decomp Γ₂ Γ₁
| none : ∀ {m} (Γ : finset (bounded_formula L m))
    (hi : ∀ p ∈ Γ, subformula.index p ≠ i.unpair.fst),
    search_tree_decomp Γ Γ

notation Γ₂ ` ≺[` :50 i : 50 `; ` T `] ` Γ₁ :50 := search_tree_decomp T i Γ₂ Γ₁

inductive search_tree (T : set (sentence L)) : search_label L → search_label L → Prop
| intro : ∀ (i : ℕ) {m₁ m₂} (Γ₁ : finset (bounded_formula L m₁)) (Γ₂ : finset (bounded_formula L m₂)),
    ¬is_terminal Γ₁ →
    Γ₂ ≺[i; T] Γ₁ →
    search_tree (i + 1, ⟨m₂, Γ₂ ∪ ((index_of_set T i).map coe).to_finset⟩) (i, ⟨m₁, Γ₁⟩)

namespace search_tree
variables {T : set (sentence L)} {Δ : finset (sentence L)}

lemma le_of_decomp (i) {m₁ m₂} {Γ₁ : finset (bounded_subformula L m₁ 0)} {Γ₂ : finset (bounded_subformula L m₂ 0)}
  (h : Γ₂ ≺[i; T] Γ₁) : m₁ ≤ m₂ :=
begin
  cases h,
  case decomp : _ _ _ _ p hi hp hdecomp
  { cases p; simp[decomp, verum_eq, falsum_eq, and_eq, or_eq, fal_eq, ex_eq] at hdecomp; try { simp[hdecomp] },
    { contradiction }, { cases hdecomp; simp[hdecomp] } },
  case none : _ _ hi { refl }
end

lemma ss_of_decomp (i) {m₁ m₂} {Γ₁ : finset (bounded_subformula L m₁ 0)} {Γ₂ : finset (bounded_subformula L m₂ 0)}
  (h : Γ₂ ≺[i; T] Γ₁) {p} (hp : p ∈ Γ₁) : cast_le (le_of_decomp i h) p ∈ Γ₂ :=
begin
  cases h,
  case decomp : _ _ _ _ p hi hp hdecomp
  { cases p; simp[decomp, verum_eq, falsum_eq, and_eq, or_eq, fal_eq, ex_eq] at hdecomp,
    { contradiction },
    { rcases hdecomp with ⟨rfl, rfl⟩, simp* },
    { rcases hdecomp with ⟨rfl, rfl⟩, simp* },
    { rcases hdecomp with ⟨rfl, rfl⟩, simp* },
    { rcases hdecomp with (⟨rfl, rfl⟩ | ⟨rfl, rfl⟩); simp* },
    { rcases hdecomp with ⟨rfl, rfl⟩; simp* },
    { rcases hdecomp with ⟨rfl, rfl⟩; simp[*, cast_le_eq_mlift] },
    { rcases hdecomp with ⟨rfl, rfl⟩; simp* } },
  { simp* }
end

lemma decomp_iff_of_mem {m₁ m₂} {Γ₁ : finset (bounded_subformula L m₁ 0)} {Γ₂ : finset (bounded_subformula L m₂ 0)}
  {p : bounded_formula L m₁} (hp : p ∈ Γ₁) {j} :
  Γ₂ ≺[p.index.mkpair j; T] Γ₁ ↔ sigma.mk m₂ Γ₂ ∈ decomp j p Γ₁ :=
⟨by { rintros (⟨_, _, p', hp', hi, hdecomp⟩ | ⟨_, hi⟩),
      { simp at hdecomp hi, rcases hi with rfl, exact hdecomp },
      { have := hi p hp, simp at this, contradiction } },
 by { intros hdecomp, refine search_tree_decomp.decomp Γ₁ Γ₂ p hp (by simp) (by simpa using hdecomp) }⟩

lemma search_tree_iff {l₁ l₂ : search_label L} :
  search_tree T l₂ l₁ ↔
  ∃ (i : ℕ) {m₁ m₂} (Γ₁ : finset (bounded_formula L m₁)) (Γ₂ : finset (bounded_formula L m₂)),
  l₂ = (i + 1, ⟨m₂, Γ₂ ∪ ((index_of_set T i).map coe).to_finset⟩) ∧
  l₁ = (i, ⟨m₁, Γ₁⟩) ∧
  ¬is_terminal Γ₁ ∧ Γ₂ ≺[i; T] Γ₁ :=
⟨by { rintros ⟨i, Γ₁, Γ₂, hΓ₁, hdecomp⟩, refine ⟨i, _, _, Γ₁, Γ₂, rfl, rfl, hΓ₁, hdecomp⟩ },
 by { rintros ⟨i, _, _, Γ₁, Γ₂, rfl, rfl, hΓ₁, hdecomp⟩,
      exact search_tree.intro i Γ₁ Γ₂ hΓ₁ hdecomp }⟩

lemma search_tree_iff' {i : ℕ} {m₁ m₂} {Γ₁ : finset (bounded_formula L m₁)} {Γ₂ : finset (bounded_formula L m₂)} :
  search_tree T (i + 1, ⟨m₂, Γ₂⟩) (i, ⟨m₁, Γ₁⟩) ↔
  ∃ (Γ : finset (bounded_formula L m₂)),
  Γ₂ = Γ ∪ ((index_of_set T i).map coe).to_finset ∧
  ¬is_terminal Γ₁ ∧ Γ ≺[i; T] Γ₁ :=
⟨by { rintros ⟨i, Γ₁, Γ₂, hΓ₁, hdecomp⟩, refine ⟨Γ₂, by refl, hΓ₁, hdecomp⟩ },
 by { rintros ⟨Γ, rfl, hΓ₁, hdecomp⟩,
      exact search_tree.intro i Γ₁ Γ hΓ₁ hdecomp }⟩

variables (T Δ)

@[reducible] def search_label.top : search_label L := ⟨0, sigma.mk 0 Δ⟩

inductive accessible (Δ : finset (sentence L)) : search_label L → Prop
| top : accessible (search_label.top Δ)
| lt : ∀ {l₁ l₂}, search_tree T l₁ l₂ → accessible l₂ → accessible l₁

def accessible_label := { l // accessible T Δ l }

def accessible_search_tree : accessible_label T Δ → accessible_label T Δ → Prop :=
λ l₁ l₂, search_tree T l₁.val l₂.val

local infix ` ≺ `:50 := accessible_search_tree T Δ

@[simp] lemma Axl_bot (l) (Γ : finset (bounded_formula L m)) (h : is_terminal Γ) {i} : ¬search_tree T l ⟨i, m, Γ⟩ :=
by rintros ⟨⟩; contradiction

section well_founded
variables {T Δ} (wf : well_founded (accessible_search_tree T Δ))

def accessible_search_tree.recursion {C : accessible_label T Δ → Sort*}
  (l) (h : Π l₁, (Π l₂, l₂ ≺ l₁ → C l₂) → C l₁) : C l :=
well_founded.recursion wf l h

variables {m} {Γ : finset (bounded_formula L m)} (hΓ : ¬is_terminal Γ) (i : ℕ)

private lemma synthetic_main_lemma_aux_and {Γ : finset (bounded_formula L m)}
  (IH : ∀ {m'} (Γ' : finset (bounded_formula L m')),
    Γ' ≺[i; T] Γ → ∃ I : finset ℕ, ⊢ᵀ Γ' ∪ I.bind (λ i, (option.map coe (index_of_set T i)).to_finset))
  {p q : bounded_formula L m}
  (hp : p ⊓ q ∈ Γ)
  (hi : index (p ⊓ q) = (nat.unpair i).fst) :
  ∃ (I : finset ℕ), ⊢ᵀ Γ ∪ I.bind (λ i, (option.map coe (index_of_set T i)).to_finset) :=
begin
  rcases IH (insert p Γ) (search_tree_decomp.decomp _ _ _ hp hi (by simp[and_eq, decomp])) with ⟨I₁, hI₁⟩,
      rcases IH (insert q Γ) (search_tree_decomp.decomp _ _ _ hp hi (by simp[and_eq, decomp])) with ⟨I₂, hI₂⟩,
      simp at hI₁ hI₂,
      have : ⊢ᵀ insert (p ⊓ q) (Γ ∪ (
        I₁.sup (λ i, ((index_of_set T i).map coe).to_finset) ∪
        I₂.sup (λ i, ((index_of_set T i).map coe).to_finset))),
      by simpa[←finset.union_union_distrib_left] using derivable.and' hI₁ hI₂,
      refine ⟨I₁ ∪ I₂, derivable.cast this (by simp[finset.bind, finset.sup_union, hp])⟩
end

private lemma synthetic_main_lemma_aux_or {Γ : finset (bounded_formula L m)}
  (IH : ∀ {m'} (Γ' : finset (bounded_formula L m')),
    Γ' ≺[i; T] Γ → ∃ I : finset ℕ, ⊢ᵀ Γ' ∪ I.bind (λ i, (option.map coe (index_of_set T i)).to_finset))
  {p q : bounded_formula L m}
  (hp : p ⊔ q ∈ Γ)
  (hi : index (p ⊔ q) = (nat.unpair i).fst) :
  ∃ (I : finset ℕ), ⊢ᵀ Γ ∪ I.bind (λ i, (option.map coe (index_of_set T i)).to_finset) :=
begin
  rcases IH (insert q (insert p Γ)) (search_tree_decomp.decomp _ _ _ hp hi (by simp[and_eq, decomp])) with ⟨I, hI⟩,
  simp at hI,
  have : ⊢ᵀ (insert p $ insert (p ⊔ q) $ Γ ∪ I.bind (λ i, (option.map coe (index_of_set T i)).to_finset)),
  from derivable.cast (derivable.or_right p q hI) (finset.insert.comm _ _ _),
  refine ⟨I, derivable.cast (derivable.or_left p q this) (by simp[hp])⟩,
end

private lemma synthetic_main_lemma_aux_all {Γ : finset (bounded_formula L m)}
  (IH : ∀ {m'} (Γ' : finset (bounded_formula L m')),
    Γ' ≺[i; T] Γ → ∃ I : finset ℕ, ⊢ᵀ Γ' ∪ I.bind (λ i, (option.map coe (index_of_set T i)).to_finset))
  {p : bounded_subformula L m 1}
  (hp : ∀'p ∈ Γ)
  (hi : index (∀'p) = (nat.unpair i).fst) :
  ∃ (I : finset ℕ), ⊢ᵀ Γ ∪ I.bind (λ i, (option.map coe (index_of_set T i)).to_finset) :=
begin
  rcases IH (insert (push p) (finset_mlift Γ)) (search_tree_decomp.decomp _ _ _ hp hi (by simp[decomp])) with ⟨I, hI⟩,
  simp at hI,
  have : ⊢ᵀ insert (∀'p) (Γ ∪ I.bind (λ (i : ℕ), (option.map coe (index_of_set T i)).to_finset)),
  from @derivable.all L _ (Γ ∪ I.bind (λ (i : ℕ), (option.map coe (index_of_set T i)).to_finset)) p
    (derivable.cast hI $ by simp[finset_mlift, finset.image_union, finset.image_bind, finset.image_to_finset_option, (∘)]),
  refine ⟨I, derivable.cast this $ by simp[hp]⟩
end

lemma exists_of_instances {p : bounded_subformula L m 1} {i Γ} : ⊢ᵀ instance_enum p i ∪ Γ → ⊢ᵀ insert (∃'p) Γ :=
begin
  induction i with i IH generalizing Γ; simp,
  { assume h, exact derivable.weakening h (finset.subset_insert _ _) },
  { cases subterm.of_index L m 0 i with t; simp; assume h,
    { exact IH h },
    { have : ⊢ᵀ insert (subst t p) (insert (∃'p) Γ), from derivable.cast (IH h) (by ext; simp; tauto),
      exact derivable.cast (derivable.ex this) (by ext; simp) } }
end

private lemma synthetic_main_lemma_aux_ex {Γ : finset (bounded_formula L m)}
  (IH : ∀ {m'} (Γ' : finset (bounded_formula L m')),
    Γ' ≺[i; T] Γ → ∃ I : finset ℕ, ⊢ᵀ Γ' ∪ I.bind (λ i, (option.map coe (index_of_set T i)).to_finset))
  {p : bounded_subformula L m 1}
  (hp : ∃'p ∈ Γ)
  (hi : index (∃'p) = (nat.unpair i).fst) :
  ∃ (I : finset ℕ), ⊢ᵀ Γ ∪ I.bind (λ i, (option.map coe (index_of_set T i)).to_finset) :=
begin
  rcases IH (instance_enum p i.unpair.snd ∪ Γ) (search_tree_decomp.decomp _ _ _ hp hi (by {simp[decomp], })) with ⟨I, hI⟩,
  simp at hI,
  refine ⟨I, derivable.cast (exists_of_instances hI) $ by simp[hp]⟩
end

include wf

lemma synthetic_main_lemma_aux (l : accessible_label T Δ) : ∃ I : finset ℕ,
  ⊢ᵀ l.val.2.2 ∪ (I.bind (λ i, ((index_of_set T i).map coe).to_finset)) :=
begin
  apply accessible_search_tree.recursion wf l,
  rintros ⟨⟨i, m, Γ⟩, accΓ⟩ IH, simp,
  show ∃ I : finset ℕ, ⊢ᵀ Γ ∪ I.bind (λ i, (option.map coe (index_of_set T i)).to_finset),
  by_cases hΓ : is_terminal Γ,
  { rcases hΓ with ⟨k, r, v, hΓ, hΓ_neg⟩,
    refine ⟨∅, by simp[finset.bind]; exact derivable.AxL r v hΓ hΓ_neg⟩ },
  have IH : ∀ {m'} (Γ' : finset (bounded_subformula L m' 0)),
    Γ' ≺[i; T] Γ → ∃ I : finset ℕ, ⊢ᵀ Γ' ∪ I.bind (λ i, (option.map coe (index_of_set T i)).to_finset),
  { intros m' Γ' h,
    have hs := search_tree.intro i Γ Γ' hΓ h,
    have : accessible T Δ (i + 1, ⟨m', Γ' ∪ (option.map coe (index_of_set T i)).to_finset⟩),
      from accessible.lt hs accΓ,
    rcases IH ⟨_, this⟩ (by simpa[accessible_search_tree] using hs) with ⟨I, hI⟩,
    refine ⟨insert i I, by simpa[finset.bind] using hI⟩ },
    by_cases hp : ∀ p ∈ Γ, subformula.index p ≠ i.unpair.fst,
    { exact IH Γ (search_tree_decomp.none Γ hp) },
    simp at hp, rcases hp with ⟨p, hp, hi⟩,
    cases p,
    case verum { refine ⟨∅, by simpa[finset.bind] using derivable.verum hp⟩ },
    case falsum { refine IH Γ (search_tree_decomp.decomp _ _ _ hp hi (by simp[falsum_eq, decomp])) },
    case relation : k r v { refine IH Γ (search_tree_decomp.decomp _ _ _ hp hi (by simp[decomp])) },
    case neg_relation : k r v { refine IH Γ (search_tree_decomp.decomp _ _ _ hp hi (by simp[decomp])) },
    case and : { exact synthetic_main_lemma_aux_and i @IH hp hi },
    case or : { exact synthetic_main_lemma_aux_or i @IH hp hi },
    case fal : { exact synthetic_main_lemma_aux_all i @IH hp hi },
    case ex : { exact synthetic_main_lemma_aux_ex i @IH hp hi }
end

lemma synthetic_main_lemma (Γ : finset (bounded_subformula L m 0)) {i}
  (h : accessible T Δ ⟨i, m, Γ⟩) :
  ∃ (I : finset ℕ), ⊢ᵀ Γ ∪ I.bind (λ i, ((index_of_set T i).map coe).to_finset) :=
by simpa using synthetic_main_lemma_aux wf ⟨_, h⟩

variables (T Δ wf)

lemma synthetic_main_lemma' : ∃ Γ : finset (sentence L), ↑Γ ⊆ T ∧ ⊢ᵀ Δ ∪ Γ :=
begin
  have : ∃ I : finset ℕ, ⊢ᵀ Δ ∪ I.bind (λ i, ((index_of_set T i).map coe).to_finset),
  from synthetic_main_lemma wf Δ accessible.top,
  rcases this with ⟨I, h⟩,
  refine ⟨I.bind (λ i, ((index_of_set T i).map coe).to_finset), by intros x; simp[index_of_neg_set_eq_some, finset.mem_bind], h⟩
end

end well_founded

section non_well_founded
variables {T Δ} (wf : ¬well_founded (accessible_search_tree T Δ))

include wf

lemma top_inaccessible : ¬acc (accessible_search_tree T Δ) ⟨search_label.top Δ, accessible.top⟩ :=
begin
  assume A,
  suffices : well_founded (accessible_search_tree T Δ), by contradiction,
  refine ⟨_⟩,
  rintros ⟨l, hl⟩, induction hl,
  case top { exact A },
  case lt : l₁ l₂ h hl₂ IH { refine IH.inv h }
end

noncomputable def chain : ℕ → search_label L :=
  λ i, (descending_chain (accessible_search_tree T Δ) ⟨search_label.top Δ, accessible.top⟩ i).val

@[reducible] noncomputable def rank (i : ℕ) : ℕ := (chain wf i).2.1

def var_domain : set ℕ := set.range (λ i, (chain wf i).2.1)

def domain := {n : ℕ // ∃ i, n < rank wf i}

noncomputable def uniform (i : ℕ) : fin (rank wf i) → domain wf := by { rintros ⟨n, hn⟩, refine ⟨n, i, hn⟩ }

lemma subterm_uniform_inj {i} {t u : bounded_subterm L (rank wf i) n} :
  subterm.map (uniform wf i) t = subterm.map (uniform wf i) u → t = u := λ h,
subterm.map_inj_of_inj (uniform wf i) (by rintros ⟨x, hx⟩ ⟨y, hy⟩; simp[uniform]) h

@[simp] lemma uniform_comp_cast_le {i j} (h) : uniform wf j ∘ fin.cast_le h = uniform wf i :=
by { ext x; cases x; simp[uniform], rw[fin.cast_le_mk], simp }

@[simp] lemma uniform_cast_le_term {i j} (h : rank wf i ≤ rank wf j) (t : bounded_subterm L (rank wf i) n) :
  (subterm.cast_le h t).map (uniform wf j) = t.map (uniform wf i) :=
by simp[subterm.cast_le]

@[simp] lemma uniform_cast_le {i j} (h : rank wf i ≤ rank wf j) (p : bounded_subformula L (rank wf i) n) :
  map (uniform wf j) (cast_le h p) = map (uniform wf i) p :=
by simp[cast_le]

@[reducible] noncomputable def Gamma (i : ℕ) : finset (bounded_formula L (rank wf i)) := (chain wf i).2.2

local notation `Γ`:80 := Gamma wf

@[reducible] noncomputable def uniform_Gamma (i : ℕ) : finset (formula L (domain wf)) := (Γ i).image (map $ uniform wf i)

def chain_union : set (formula L (domain wf)) := {p | ∃ i (p' ∈ Γ i), p = subformula.map (uniform wf i) p'}

local notation `⛓`:= chain_union wf

lemma mem_chain_union_iff {p : formula L (domain wf)} : p ∈ ⛓ ↔ ∃ i, p ∈ (Γ i).image (map $ uniform wf i) :=
by simp[chain_union, eq_comm]

@[simp] lemma chain_zero : chain wf 0 = ⟨0, 0, Δ⟩ := by refl

@[simp] lemma chain_zero' : Γ 0 = Δ := by refl

@[simp] lemma chain_lt (i) : search_tree T (chain wf (i + 1)) (chain wf i) :=
infinite_descending_chain_of_non_acc (accessible_search_tree T Δ) ⟨search_label.top Δ, accessible.top⟩ (top_inaccessible wf) i

@[simp] lemma chain_fst (i) : (chain wf i).1 = i :=
begin
  induction i with i IH,
  { simp },
  { rcases search_tree_iff.mp (chain_lt wf i) with ⟨i', m₁, m₂, Γ₁, Γ₂, his, hi, hterminal, hdecomp⟩,
    have : i = i', by simpa[IH] using congr_arg prod.fst hi,
    rcases this with rfl,
    simpa using congr_arg prod.fst his }
end

lemma chain_eq (i) : chain wf i = (i, ⟨_, Γ i⟩) :=
by ext; simp

lemma Γ_is_not_terminal (i) : ¬is_terminal (Γ i) :=
by { rcases search_tree_iff.mp (chain_lt wf i) with ⟨i', m₁, m₂, Γ₁, Γ₂, his, hi, hterminal, hdecomp⟩,
     simp only [chain_eq, prod.mk.inj_iff] at hi, rcases hi with ⟨rfl, rfl, rfl⟩,
     assumption }

@[simp] lemma Γ_lt (i) : ∃ Γ', Γ (i + 1) = Γ' ∪ ((index_of_set T i).map coe).to_finset ∧ Γ' ≺[i; T] Γ i :=
begin
  have : search_tree T (i + 1, ⟨_, Γ (i + 1)⟩) (i, ⟨_, Γ i⟩),
  { have := chain_lt wf i, rw[chain_eq, chain_eq] at this, exact this },
  rcases search_tree_iff'.mp this with ⟨Γ', hΓ', hterminal, hdecomp⟩,
  refine ⟨Γ', hΓ', hdecomp⟩
end

@[simp] lemma Γ_lt' (i) : ∃ {m'} (Γ' : finset (bounded_formula L m')) (hm' : m' = rank wf (i + 1)),
   Γ (i + 1) = Γ'.image (cast_le (eq.symm hm').ge) ∪ ((index_of_set T i).map coe).to_finset ∧ Γ' ≺[i; T] Γ i :=
begin
  rcases Γ_lt wf i with ⟨Γ', h⟩,
  refine ⟨rank wf (i + 1), Γ', rfl, by simpa using h⟩,
end

@[simp] lemma rank_mono {i j} (h : i ≤ j) : rank wf i ≤ rank wf j :=
begin
  induction j with j IH,
  { have : i = 0, from le_zero_iff.mp h,
    simp[this] },
  { have : i ≤ j ∨ i = j.succ, from nat.of_le_succ h,
    rcases this with (le | eq),
    { rcases Γ_lt wf j with ⟨Γ', _, hdecomp⟩,
      exact le_trans (IH le) (le_of_decomp j hdecomp) },
    { simp[eq] } }
end

lemma cast_mem {i j} (hj : i ≤ j) {p} (h : p ∈ Γ i) : cast_le (rank_mono wf hj) p ∈ Γ j :=
begin
  induction j with j IH,
  { have : i = 0, from le_zero_iff.mp hj, rcases this with rfl,
    simpa using h },
  { have : i ≤ j ∨ i = j.succ, from nat.of_le_succ hj,
    rcases this with (le | eq),
    { rcases Γ_lt wf j with ⟨Γ', his, hdecomp⟩,
      have : cast_le _ p ∈ Γ', by simpa using ss_of_decomp j hdecomp (IH le),
      simp[his, this] },
    { rcases eq with rfl, simp[h] } }
end

lemma cast_mem' {i} {p} (h : p ∈ Γ i) :
  cast_le (rank_mono wf $ nat.right_le_mkpair _ _) p ∈ Γ (p.index.mkpair i) :=
cast_mem wf _ h

lemma cast_mem'' {i j} {p} (h : p ∈ Γ i) (hj : i ≤ j) :
  cast_le (rank_mono wf $ le_trans hj (nat.right_le_mkpair _ _)) p ∈ Γ (p.index.mkpair j) :=
cast_mem wf _ h

lemma T_mem {σ : sentence L} (h : σ ∈ T) : ↑σ ∈ ⛓ :=
⟨σ.index + 1,
  begin
    refine ⟨↑σ, _⟩,
    rcases Γ_lt wf σ.index with ⟨Γ', hΓ', hdecomp⟩,
    have : Gamma wf (index σ + 1) = Γ' ∪ {↑σ}, by simpa[h] using hΓ',
    refine ⟨by simp[this], by simp[uniform]⟩
  end⟩

lemma domian_inv (t : subterm L (domain wf) 0) : ∃ {i} (t' : bounded_term L (rank wf i)), t'.map (uniform wf i) = t :=
by { induction t,
  case metavar : x { rcases x with ⟨x, i, hx⟩, refine ⟨i, &⟨x, hx⟩, by simp[uniform]⟩ },
  case var : x { refine fin.nil x },
  case function : k f v IH { rcases classical.skolem.mp IH with ⟨I, hI⟩,
    let isup := ⨆ᶠ i, I i,
    have : ∀ x, ∃ (t' : bounded_term L (rank wf isup)), subterm.map (uniform wf isup) t' = v x,
    { intros x, rcases hI x with ⟨t, ht⟩,
      refine ⟨subterm.cast_le (rank_mono wf (by simp)) t, by simp[ht]⟩ },
    rcases classical.skolem.mp this with ⟨v', hv'⟩,
    refine ⟨isup, subterm.function f v', by simp[hv']⟩ } }

lemma relation_decomp {k} {r : L.pr k} {v} : relation r v ∈ ⛓ → neg_relation r v ∉ ⛓ :=
begin
  rintros ⟨i, p, hp, eq_rel⟩ ⟨i', p', hp', eq_nrel⟩,
  have : ∃ v', p = relation r v' ∧ v = (λ j, subterm.map (uniform wf i) (v' j)),
  { cases p; simp[map, rew] at eq_rel; try { contradiction },
    case relation : k r v' { rcases eq_rel with ⟨rfl, rfl, rfl⟩, refine ⟨v', rfl, by refl⟩, } },
  rcases this with ⟨v, rfl, rfl⟩,
  have : ∃ v', p' = neg_relation r v' ∧ ∀ j, subterm.map (uniform wf i) (v j) = subterm.map (uniform wf i') (v' j),
  { cases p'; simp[map, rew] at eq_nrel; try { contradiction },
    case neg_relation : k r v { rcases eq_nrel with ⟨rfl, rfl, e⟩,
      refine ⟨v, rfl, by { simp at e, simpa using congr_fun (e) }⟩ } },
  rcases this with ⟨v', rfl, hv⟩,
  let I := max i i',
  let V : fin k → bounded_term L (rank wf I) := λ (j : fin k), subterm.cast_le (rank_mono wf (by simp)) (v j),
  let V' : fin k → bounded_term L (rank wf I) := λ (j : fin k), subterm.cast_le (rank_mono wf (by simp)) (v' j),
  have V_eq : V = V', { ext j, simp[V, V'], refine subterm_uniform_inj wf (by simpa using hv j) },
  have hr : relation r V ∈ Γ I, by simpa using cast_mem wf (show i ≤ max i i', by simp) hp,
  have hnr : neg_relation r V ∈ Γ I, by simpa[V_eq] using cast_mem wf (show i' ≤ max i i', by simp) hp',
  have : is_terminal (Γ I), from ⟨k, r, V, hr, hnr⟩,
  have : ¬is_terminal (Γ I), from Γ_is_not_terminal wf I,
  contradiction
end

lemma verum_decomp : ⊤ ∉ ⛓ :=
begin
  rintros ⟨i, p, hp, eq_top⟩,
  have : p = ⊤, { cases p; simp[map, rew, ←verum_eq] at eq_top; try {contradiction}, { refl } },
  rcases this with rfl,
  let k := (index (⊤ : bounded_subformula L (rank wf i) 0)).mkpair i,
  have mem_Γ : ⊤ ∈ Γ k, from cast_mem' wf hp,
  rcases Γ_lt wf k with ⟨Γ', hΓ', hdecomp⟩,
  have := (decomp_iff_of_mem mem_Γ).mp hdecomp,
  simp[decomp] at this, contradiction
end

lemma and_decomp {p q : formula L (domain wf)} : p ⊓ q ∈ ⛓ → p ∈ ⛓ ∨ q ∈ ⛓ :=
begin
  rintros ⟨i, r, hr, eq_and⟩,
  have : ∃ p' q', r = p' ⊓ q' ∧ p = map (uniform wf i) p' ∧ q = map (uniform wf i) q',
  { cases r; simp[map, rew, ←and_eq] at eq_and; try { contradiction },
    case and : p' q' { refine ⟨p', q', rfl, eq_and⟩ } },
  rcases this with ⟨p, q, rfl, rfl, rfl⟩,
  let k := (index (p ⊓ q)).mkpair i,
  have mem_Γ : cast_le _ (p ⊓ q) ∈ Γ k, from cast_mem' wf hr,
  rcases Γ_lt' wf k with ⟨m', Γ', hm', hΓ', hdecomp⟩,
  have : sigma.mk m' Γ' ∈ decomp i (cast_le _ (p ⊓ q)) (Gamma wf k),
    from (decomp_iff_of_mem mem_Γ).mp (by simp only [cast_le_index]; exact hdecomp),
  simp[decomp] at this, rcases this with (⟨rfl, rfl⟩ | ⟨rfl, rfl⟩),
  { refine or.inl ((mem_chain_union_iff wf).mpr (⟨k + 1, by simp[hΓ']⟩)) },
  { refine or.inr ((mem_chain_union_iff wf).mpr (⟨k + 1, by simp[hΓ']⟩)) }
end

lemma or_decomp {p q : formula L (domain wf)} : p ⊔ q ∈ ⛓ → p ∈ ⛓ ∧ q ∈ ⛓ :=
begin
  rintros ⟨i, r, hr, eq_or⟩,
  have : ∃ p' q', r = p' ⊔ q' ∧ p = map (uniform wf i) p' ∧ q = map (uniform wf i) q',
  { cases r; simp[map, rew, ←or_eq] at eq_or; try { contradiction },
    case or : p' q' { refine ⟨p', q', rfl, eq_or⟩ } },
  rcases this with ⟨p, q, rfl, rfl, rfl⟩,
  let k := (index (p ⊔ q)).mkpair i,
  have mem_Γ : cast_le _ (p ⊔ q) ∈ Γ k, from cast_mem' wf hr,
  rcases Γ_lt' wf k with ⟨m', Γ', hm', hΓ', hdecomp⟩,
  have : sigma.mk m' Γ' ∈ decomp i (cast_le _ (p ⊔ q)) (Gamma wf k),
    from (decomp_iff_of_mem mem_Γ).mp (by simp only [cast_le_index]; exact hdecomp),
  simp[decomp] at this, rcases this with ⟨rfl, rfl⟩,
  refine ⟨(mem_chain_union_iff wf).mpr ⟨k + 1, by simp[hΓ']⟩, (mem_chain_union_iff wf).mpr ⟨k + 1, by simp[hΓ']⟩⟩
end

lemma all_decomp {p : subformula L (domain wf) 1} : ∀'p ∈ ⛓ → ∃ t, subst t p ∈ ⛓ :=
begin
  rintros ⟨i, r, hr, eq_fal⟩,
  have : ∃ p', r = ∀' p' ∧ p = map (uniform wf i) p',
  { cases r; simp[map, rew, ←fal_eq, ←eq_fal] at eq_fal; try { contradiction },
    case fal : p' { refine ⟨p', rfl, eq_fal⟩ } },
  rcases this with ⟨p, rfl, rfl⟩,
  let k := (index (∀'p)).mkpair i,
  have mem_Γ : cast_le _ (∀'p) ∈ Γ k, from cast_mem' wf hr,
  rcases Γ_lt' wf k with ⟨m', Γ', hm', hΓ', hdecomp⟩,
  have : sigma.mk m' Γ' ∈ decomp i (cast_le _ (∀'p)) (Gamma wf k),
    from (decomp_iff_of_mem mem_Γ).mp (by simp only [cast_le_index]; exact hdecomp),
  simp[decomp] at this, rcases this with ⟨rfl, rfl⟩,
  let t : bounded_term L (rank wf (k + 1)) :=
    subterm.cast_le (by simp[hm']) (&(fin.last _) : bounded_term L (rank wf k + 1)),
  refine ⟨t.map (uniform wf _), (mem_chain_union_iff wf).mpr ⟨k + 1, by simp[hΓ', map_subst, t]⟩⟩
end

lemma ex_decomp {p : subformula L (domain wf) 1} : ∃'p ∈ ⛓ → ∀ t, subst t p ∈ ⛓ :=
begin
  rintros ⟨i, r, hr, eq_ex⟩ t,
  have : ∃ p', r = ∃' p' ∧ p = map (uniform wf i) p',
  { cases r; simp[map, rew, ←ex_eq, ←eq_ex] at eq_ex; try { contradiction },
    case ex : p' { refine ⟨p', rfl, eq_ex⟩ } },
  rcases this with ⟨p, rfl, rfl⟩,
  rcases domian_inv wf t with ⟨it, t, rfl⟩,
  let j := (max (max i it) (t.index + 1)),
  let k := (∃'p).index.mkpair j,
  have i_le_k : i ≤ k, { simp[k], refine le_trans (by simp) (nat.right_le_mkpair _ _) },
  have it_le_k : it ≤ k, { simp[k], refine le_trans (by simp) (nat.right_le_mkpair _ _) },
  have mem_Γ : cast_le _ ∃'p ∈ Γ k := cast_mem'' wf hr (by simp),
  rcases Γ_lt' wf k with ⟨m', Γ', hm', hΓ', hdecomp⟩,
  have : sigma.mk m' Γ' ∈ decomp j (cast_le _ (∃'p)) (Γ k),
    from (decomp_iff_of_mem mem_Γ).mp (by simp only [cast_le_index]; exact hdecomp),
  simp[decomp] at this, rcases this with ⟨rfl, rfl⟩,
  have : subst (subterm.cast_le _ t) (cast_le _ p) ∈ instance_enum (cast_le _ p) j,
    from mem_instance_enum_of_lt (subterm.cast_le (rank_mono wf it_le_k) t) (cast_le (rank_mono wf i_le_k) p) j (by simp),
  have : subst (subterm.map (uniform wf it) t) (map (uniform wf i) p) ∈ finset.image (map (uniform wf k)) (instance_enum (cast_le _ p) j),
  by simpa[map_subst, -finset.mem_image] using finset.mem_image_of_mem (map $ uniform wf k) this,
  refine (mem_chain_union_iff wf).mpr ⟨k + 1,
    by simp [hΓ', -finset.mem_image, finset.image_union, finset.mem_union, finset.image_image, (∘), this]⟩
end

def model_pr {k} (r : L.pr k) (v : fin k → term L (domain wf)) : Prop :=
subformula.neg_relation r v ∈ ⛓

@[reducible] def model : Structure L :=
{ dom := term L (domain wf),
  fn := λ k f, subterm.function f,
  pr := λ k r, model_pr wf r }

@[simp] lemma model_val (t) : subterm.val (model wf) subterm.metavar fin.nil t = t :=
by { induction t; simp*, case var : x { exact fin.nil x } }

lemma semantic_main_lemma : ∀ p ∈ ⛓, model wf ⊧ᵀ[subterm.metavar] ∼p
| ⊤                  h  := by { have : ⊤ ∉ ⛓, from verum_decomp wf, contradiction }
| ⊥                  h  := by simp
| (relation r v)     h  := by simpa[model_pr, (∘)] using relation_decomp wf h
| (neg_relation r v) h := by simp[model_pr, (∘), h]
| (p ⊓ q)            h :=
    begin
      have : p ∈ ⛓ ∨ q ∈ ⛓, from and_decomp wf h,
      rcases this with (h | h),
      { simp, refine or.inl (by simpa using semantic_main_lemma p h) },
      { simp, refine or.inr (by simpa using semantic_main_lemma q h) }
    end
| (p ⊔ q)            h :=
    begin
      have : p ∈ ⛓ ∧ q ∈ ⛓, from or_decomp wf h,
      rcases this with ⟨h₁, h₂⟩,
      simp,
      refine ⟨by simpa using semantic_main_lemma p h₁, by simpa using semantic_main_lemma q h₂⟩
    end
| (∀'p)              h :=
    begin
      simp, rcases all_decomp wf h with ⟨t, h⟩,
      refine ⟨t, by simpa[val, subval_subst, fin.concat_zero] using semantic_main_lemma (subst t p) h⟩
    end
| (∃'p)              h :=
    begin
      simp, intros t,
      by simpa[val, subval_subst, fin.concat_zero] using semantic_main_lemma (subst t p) (ex_decomp wf h t)
    end
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.1.complexity)⟩]}

variables (T Δ wf)

lemma semantic_main_lemma' : ∀ σ ∈ T, ¬model wf ⊧ σ :=
by intros σ hσ; simpa using semantic_main_lemma wf ↑σ (T_mem wf hσ)

lemma semantic_main_lemma'_root : ∀ σ ∈ Δ, ¬model wf ⊧ σ := λ σ hσ,
by simpa using semantic_main_lemma wf σ ⟨0,↑σ, by simp[hσ]⟩

end non_well_founded

end search_tree

variables (T : Theory L) (Δ : finset (sentence L))

theorem completeness' (h : ∀ S : Structure L, S ⊧ T → ∃ σ ∈ Δ, S ⊧ σ) :
  ∃ Γ : finset (sentence L), ↑Γ ⊆ not '' T ∧ ⊢ᵀ Δ ∪ Γ :=
begin
  by_contradiction A, simp at A,
  by_cases wf : well_founded (search_tree.accessible_search_tree (not '' T) Δ),
  { have : ∃ (Γ : finset (sentence L)), ↑Γ ⊆ not '' T ∧ ⊢ᵀ Δ ∪ Γ,
      from search_tree.synthetic_main_lemma' (not '' T) Δ wf,
    rcases this with ⟨Γ, hΓ, b⟩,
    have := A Γ hΓ, contradiction },
  { have : search_tree.model wf ⊧ T,
    { intros σ hσ,
      simpa[sentence_models_def] using search_tree.semantic_main_lemma' (not '' T) Δ wf (∼σ)
        (set.mem_image_of_mem subformula.not hσ) },
    have : ∃ σ ∈ Δ, search_tree.model wf ⊧ σ, from h (search_tree.model wf) this,
    have : ¬∃ σ ∈ Δ, search_tree.model wf ⊧ σ, by simpa using search_tree.semantic_main_lemma'_root (not '' T) Δ wf,
    contradiction }
end

variables {T} {σ : sentence L}

theorem completeness : T ⊧ σ → T ⊢ σ := λ h,
completeness' T (singleton σ) (by { simp, intros S hS, exact h hS })

end Tait

end fol


/-
Copyright (c) 2019 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Johan Commelin, Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.equivalence
import Mathlib.data.equiv.basic
import Mathlib.PostPort

universes v₁ v₂ u₁ u₂ l u₃ v₃

namespace Mathlib

namespace category_theory

-- declare the `v`'s first; see `category_theory.category` for an explanation

/--
`F ⊣ G` represents the data of an adjunction between two functors
`F : C ⥤ D` and `G : D ⥤ C`. `F` is the left adjoint and `G` is the right adjoint.

To construct an `adjunction` between two functors, it's often easier to instead use the
constructors `mk_of_hom_equiv` or `mk_of_unit_counit`. To construct a left adjoint,
there are also constructors `left_adjoint_of_equiv` and `adjunction_of_equiv_left` (as
well as their duals) which can be simpler in practice.

Uniqueness of adjoints is shown in `category_theory.adjunction.opposites`.

See https://stacks.math.columbia.edu/tag/0037.
-/
structure adjunction {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D) (G : D ⥤ C)
    where
  hom_equiv : (X : C) → (Y : D) → (functor.obj F X ⟶ Y) ≃ (X ⟶ functor.obj G Y)
  unit : 𝟭 ⟶ F ⋙ G
  counit : G ⋙ F ⟶ 𝟭
  hom_equiv_unit' :
    autoParam
      (∀ {X : C} {Y : D} {f : functor.obj F X ⟶ Y},
        coe_fn (hom_equiv X Y) f = nat_trans.app unit X ≫ functor.map G f)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  hom_equiv_counit' :
    autoParam
      (∀ {X : C} {Y : D} {g : X ⟶ functor.obj G Y},
        coe_fn (equiv.symm (hom_equiv X Y)) g = functor.map F g ≫ nat_trans.app counit Y)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

infixl:15 " ⊣ " => Mathlib.category_theory.adjunction

/-- A class giving a chosen right adjoint to the functor `left`. -/
class is_left_adjoint {C : Type u₁} [category C] {D : Type u₂} [category D] (left : C ⥤ D) where
  right : D ⥤ C
  adj : left ⊣ right

/-- A class giving a chosen left adjoint to the functor `right`. -/
class is_right_adjoint {C : Type u₁} [category C] {D : Type u₂} [category D] (right : D ⥤ C) where
  left : C ⥤ D
  adj : left ⊣ right

/-- Extract the left adjoint from the instance giving the chosen adjoint. -/
def left_adjoint {C : Type u₁} [category C] {D : Type u₂} [category D] (R : D ⥤ C)
    [is_right_adjoint R] : C ⥤ D :=
  is_right_adjoint.left R

/-- Extract the right adjoint from the instance giving the chosen adjoint. -/
def right_adjoint {C : Type u₁} [category C] {D : Type u₂} [category D] (L : C ⥤ D)
    [is_left_adjoint L] : D ⥤ C :=
  is_left_adjoint.right L

/-- The adjunction associated to a functor known to be a left adjoint. -/
def adjunction.of_left_adjoint {C : Type u₁} [category C] {D : Type u₂} [category D] (left : C ⥤ D)
    [is_left_adjoint left] : left ⊣ right_adjoint left :=
  is_left_adjoint.adj

/-- The adjunction associated to a functor known to be a right adjoint. -/
def adjunction.of_right_adjoint {C : Type u₁} [category C] {D : Type u₂} [category D]
    (right : C ⥤ D) [is_right_adjoint right] : left_adjoint right ⊣ right :=
  is_right_adjoint.adj

namespace adjunction

@[simp] theorem hom_equiv_unit {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D}
    {G : D ⥤ C} (c : F ⊣ G) {X : C} {Y : D} {f : functor.obj F X ⟶ Y} :
    coe_fn (hom_equiv c X Y) f = nat_trans.app (unit c) X ≫ functor.map G f :=
  sorry

@[simp] theorem hom_equiv_counit {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D}
    {G : D ⥤ C} (c : F ⊣ G) {X : C} {Y : D} {g : X ⟶ functor.obj G Y} :
    coe_fn (equiv.symm (hom_equiv c X Y)) g = functor.map F g ≫ nat_trans.app (counit c) Y :=
  sorry

@[simp] theorem hom_equiv_naturality_left_symm {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) {X' : C} {X : C} {Y : D} (f : X' ⟶ X)
    (g : X ⟶ functor.obj G Y) :
    coe_fn (equiv.symm (hom_equiv adj X' Y)) (f ≫ g) =
        functor.map F f ≫ coe_fn (equiv.symm (hom_equiv adj X Y)) g :=
  sorry

@[simp] theorem hom_equiv_naturality_left {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) {X' : C} {X : C} {Y : D} (f : X' ⟶ X)
    (g : functor.obj F X ⟶ Y) :
    coe_fn (hom_equiv adj X' Y) (functor.map F f ≫ g) = f ≫ coe_fn (hom_equiv adj X Y) g :=
  sorry

@[simp] theorem hom_equiv_naturality_right {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) {X : C} {Y : D} {Y' : D} (f : functor.obj F X ⟶ Y)
    (g : Y ⟶ Y') :
    coe_fn (hom_equiv adj X Y') (f ≫ g) = coe_fn (hom_equiv adj X Y) f ≫ functor.map G g :=
  sorry

@[simp] theorem hom_equiv_naturality_right_symm {C : Type u₁} [category C] {D : Type u₂}
    [category D] {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) {X : C} {Y : D} {Y' : D}
    (f : X ⟶ functor.obj G Y) (g : Y ⟶ Y') :
    coe_fn (equiv.symm (hom_equiv adj X Y')) (f ≫ functor.map G g) =
        coe_fn (equiv.symm (hom_equiv adj X Y)) f ≫ g :=
  sorry

@[simp] theorem left_triangle {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D}
    {G : D ⥤ C} (adj : F ⊣ G) :
    whisker_right (unit adj) F ≫ whisker_left F (counit adj) = nat_trans.id (𝟭 ⋙ F) :=
  sorry

@[simp] theorem right_triangle {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D}
    {G : D ⥤ C} (adj : F ⊣ G) :
    whisker_left G (unit adj) ≫ whisker_right (counit adj) G = nat_trans.id (G ⋙ 𝟭) :=
  sorry

@[simp] theorem left_triangle_components_assoc {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) {X : C} {X' : D}
    (f' : functor.obj 𝟭 (functor.obj F X) ⟶ X') :
    functor.map F (nat_trans.app (unit adj) X) ≫ nat_trans.app (counit adj) (functor.obj F X) ≫ f' =
        f' :=
  sorry

@[simp] theorem right_triangle_components {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) {Y : D} :
    nat_trans.app (unit adj) (functor.obj G Y) ≫ functor.map G (nat_trans.app (counit adj) Y) = 𝟙 :=
  congr_arg (fun (t : nat_trans (G ⋙ 𝟭) (G ⋙ 𝟭)) => nat_trans.app t Y) (right_triangle adj)

@[simp] theorem counit_naturality {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D}
    {G : D ⥤ C} (adj : F ⊣ G) {X : D} {Y : D} (f : X ⟶ Y) :
    functor.map F (functor.map G f) ≫ nat_trans.app (counit adj) Y =
        nat_trans.app (counit adj) X ≫ f :=
  nat_trans.naturality (counit adj) f

@[simp] theorem unit_naturality {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D}
    {G : D ⥤ C} (adj : F ⊣ G) {X : C} {Y : C} (f : X ⟶ Y) :
    nat_trans.app (unit adj) X ≫ functor.map G (functor.map F f) = f ≫ nat_trans.app (unit adj) Y :=
  Eq.symm (nat_trans.naturality (unit adj) f)

theorem hom_equiv_apply_eq {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D}
    {G : D ⥤ C} (adj : F ⊣ G) {A : C} {B : D} (f : functor.obj F A ⟶ B) (g : A ⟶ functor.obj G B) :
    coe_fn (hom_equiv adj A B) f = g ↔ f = coe_fn (equiv.symm (hom_equiv adj A B)) g :=
  sorry

theorem eq_hom_equiv_apply {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D}
    {G : D ⥤ C} (adj : F ⊣ G) {A : C} {B : D} (f : functor.obj F A ⟶ B) (g : A ⟶ functor.obj G B) :
    g = coe_fn (hom_equiv adj A B) f ↔ coe_fn (equiv.symm (hom_equiv adj A B)) g = f :=
  sorry

end adjunction

namespace adjunction

/--
This is an auxiliary data structure useful for constructing adjunctions.
See `adjunction.mk_of_hom_equiv`.
This structure won't typically be used anywhere else.
-/
structure core_hom_equiv {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D)
    (G : D ⥤ C)
    where
  hom_equiv : (X : C) → (Y : D) → (functor.obj F X ⟶ Y) ≃ (X ⟶ functor.obj G Y)
  hom_equiv_naturality_left_symm' :
    autoParam
      (∀ {X' X : C} {Y : D} (f : X' ⟶ X) (g : X ⟶ functor.obj G Y),
        coe_fn (equiv.symm (hom_equiv X' Y)) (f ≫ g) =
          functor.map F f ≫ coe_fn (equiv.symm (hom_equiv X Y)) g)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  hom_equiv_naturality_right' :
    autoParam
      (∀ {X : C} {Y Y' : D} (f : functor.obj F X ⟶ Y) (g : Y ⟶ Y'),
        coe_fn (hom_equiv X Y') (f ≫ g) = coe_fn (hom_equiv X Y) f ≫ functor.map G g)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

namespace core_hom_equiv

@[simp] theorem hom_equiv_naturality_left_symm {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : D ⥤ C} (c : core_hom_equiv F G) {X' : C} {X : C} {Y : D} (f : X' ⟶ X)
    (g : X ⟶ functor.obj G Y) :
    coe_fn (equiv.symm (hom_equiv c X' Y)) (f ≫ g) =
        functor.map F f ≫ coe_fn (equiv.symm (hom_equiv c X Y)) g :=
  sorry

@[simp] theorem hom_equiv_naturality_right {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : D ⥤ C} (c : core_hom_equiv F G) {X : C} {Y : D} {Y' : D}
    (f : functor.obj F X ⟶ Y) (g : Y ⟶ Y') :
    coe_fn (hom_equiv c X Y') (f ≫ g) = coe_fn (hom_equiv c X Y) f ≫ functor.map G g :=
  sorry

@[simp] theorem hom_equiv_naturality_left {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : D ⥤ C} (adj : core_hom_equiv F G) {X' : C} {X : C} {Y : D} (f : X' ⟶ X)
    (g : functor.obj F X ⟶ Y) :
    coe_fn (hom_equiv adj X' Y) (functor.map F f ≫ g) = f ≫ coe_fn (hom_equiv adj X Y) g :=
  sorry

@[simp] theorem hom_equiv_naturality_right_symm {C : Type u₁} [category C] {D : Type u₂}
    [category D] {F : C ⥤ D} {G : D ⥤ C} (adj : core_hom_equiv F G) {X : C} {Y : D} {Y' : D}
    (f : X ⟶ functor.obj G Y) (g : Y ⟶ Y') :
    coe_fn (equiv.symm (hom_equiv adj X Y')) (f ≫ functor.map G g) =
        coe_fn (equiv.symm (hom_equiv adj X Y)) f ≫ g :=
  sorry

end core_hom_equiv

/--
This is an auxiliary data structure useful for constructing adjunctions.
See `adjunction.mk_of_hom_equiv`.
This structure won't typically be used anywhere else.
-/
structure core_unit_counit {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D)
    (G : D ⥤ C)
    where
  unit : 𝟭 ⟶ F ⋙ G
  counit : G ⋙ F ⟶ 𝟭
  left_triangle' :
    autoParam
      (whisker_right unit F ≫ iso.hom (functor.associator F G F) ≫ whisker_left F counit =
        nat_trans.id (𝟭 ⋙ F))
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  right_triangle' :
    autoParam
      (whisker_left G unit ≫ iso.inv (functor.associator G F G) ≫ whisker_right counit G =
        nat_trans.id (G ⋙ 𝟭))
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

namespace core_unit_counit

@[simp] theorem left_triangle {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D}
    {G : D ⥤ C} (c : core_unit_counit F G) :
    whisker_right (unit c) F ≫ iso.hom (functor.associator F G F) ≫ whisker_left F (counit c) =
        nat_trans.id (𝟭 ⋙ F) :=
  sorry

@[simp] theorem right_triangle {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D}
    {G : D ⥤ C} (c : core_unit_counit F G) :
    whisker_left G (unit c) ≫ iso.inv (functor.associator G F G) ≫ whisker_right (counit c) G =
        nat_trans.id (G ⋙ 𝟭) :=
  sorry

end core_unit_counit

/-- Construct an adjunction between `F` and `G` out of a natural bijection between each
`F.obj X ⟶ Y` and `X ⟶ G.obj Y`. -/
@[simp] theorem mk_of_hom_equiv_counit_app {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : D ⥤ C} (adj : core_hom_equiv F G) (Y : D) :
    nat_trans.app (counit (mk_of_hom_equiv adj)) Y =
        equiv.inv_fun (core_hom_equiv.hom_equiv adj (functor.obj G Y) (functor.obj 𝟭 Y)) 𝟙 :=
  Eq.refl (nat_trans.app (counit (mk_of_hom_equiv adj)) Y)

/-- Construct an adjunction between functors `F` and `G` given a unit and counit for the adjunction
satisfying the triangle identities. -/
@[simp] theorem mk_of_unit_counit_counit {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : D ⥤ C} (adj : core_unit_counit F G) :
    counit (mk_of_unit_counit adj) = core_unit_counit.counit adj :=
  Eq.refl (counit (mk_of_unit_counit adj))

/-- The adjunction between the identity functor on a category and itself. -/
def id {C : Type u₁} [category C] : 𝟭 ⊣ 𝟭 :=
  mk (fun (X Y : C) => equiv.refl (functor.obj 𝟭 X ⟶ Y)) 𝟙 𝟙

-- Satisfy the inhabited linter.

protected instance inhabited {C : Type u₁} [category C] : Inhabited (𝟭 ⊣ 𝟭) := { default := id }

/-- If F and G are naturally isomorphic functors, establish an equivalence of hom-sets. -/
@[simp] theorem equiv_homset_left_of_nat_iso_symm_apply {C : Type u₁} [category C] {D : Type u₂}
    [category D] {F : C ⥤ D} {F' : C ⥤ D} (iso : F ≅ F') {X : C} {Y : D}
    (g : functor.obj F' X ⟶ Y) :
    coe_fn (equiv.symm (equiv_homset_left_of_nat_iso iso)) g = nat_trans.app (iso.hom iso) X ≫ g :=
  Eq.refl (coe_fn (equiv.symm (equiv_homset_left_of_nat_iso iso)) g)

/-- If G and H are naturally isomorphic functors, establish an equivalence of hom-sets. -/
@[simp] theorem equiv_homset_right_of_nat_iso_apply {C : Type u₁} [category C] {D : Type u₂}
    [category D] {G : D ⥤ C} {G' : D ⥤ C} (iso : G ≅ G') {X : C} {Y : D} (f : X ⟶ functor.obj G Y) :
    coe_fn (equiv_homset_right_of_nat_iso iso) f = f ≫ nat_trans.app (iso.hom iso) Y :=
  Eq.refl (coe_fn (equiv_homset_right_of_nat_iso iso) f)

/-- Transport an adjunction along an natural isomorphism on the left. -/
def of_nat_iso_left {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : C ⥤ D}
    {H : D ⥤ C} (adj : F ⊣ H) (iso : F ≅ G) : G ⊣ H :=
  mk_of_hom_equiv
    (core_hom_equiv.mk
      fun (X : C) (Y : D) =>
        equiv.trans (equiv_homset_left_of_nat_iso (iso.symm iso)) (hom_equiv adj X Y))

/-- Transport an adjunction along an natural isomorphism on the right. -/
def of_nat_iso_right {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C}
    {H : D ⥤ C} (adj : F ⊣ G) (iso : G ≅ H) : F ⊣ H :=
  mk_of_hom_equiv
    (core_hom_equiv.mk
      fun (X : C) (Y : D) => equiv.trans (hom_equiv adj X Y) (equiv_homset_right_of_nat_iso iso))

/-- Transport being a right adjoint along a natural isomorphism. -/
def right_adjoint_of_nat_iso {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D}
    {G : C ⥤ D} (h : F ≅ G) [r : is_right_adjoint F] : is_right_adjoint G :=
  is_right_adjoint.mk (is_right_adjoint.left F) (of_nat_iso_right is_right_adjoint.adj h)

/-- Transport being a left adjoint along a natural isomorphism. -/
def left_adjoint_of_nat_iso {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D}
    {G : C ⥤ D} (h : F ≅ G) [r : is_left_adjoint F] : is_left_adjoint G :=
  is_left_adjoint.mk (is_left_adjoint.right F) (of_nat_iso_left is_left_adjoint.adj h)

/--
Composition of adjunctions.

See https://stacks.math.columbia.edu/tag/0DV0.
-/
def comp {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} {E : Type u₃}
    [ℰ : category E] (H : D ⥤ E) (I : E ⥤ D) (adj₁ : F ⊣ G) (adj₂ : H ⊣ I) : F ⋙ H ⊣ I ⋙ G :=
  mk
    (fun (X : C) (Z : E) =>
      equiv.trans (hom_equiv adj₂ (functor.obj F X) Z) (hom_equiv adj₁ X (functor.obj I Z)))
    (unit adj₁ ≫
      whisker_left F (whisker_right (unit adj₂) G) ≫ iso.inv (functor.associator F (H ⋙ I) G))
    (iso.hom (functor.associator I G (F ⋙ H)) ≫
      whisker_left I (whisker_right (counit adj₁) H) ≫ counit adj₂)

/-- If `F` and `G` are left adjoints then `F ⋙ G` is a left adjoint too. -/
protected instance left_adjoint_of_comp {C : Type u₁} [category C] {D : Type u₂} [category D]
    {E : Type u₃} [ℰ : category E] (F : C ⥤ D) (G : D ⥤ E) [Fl : is_left_adjoint F]
    [Gl : is_left_adjoint G] : is_left_adjoint (F ⋙ G) :=
  is_left_adjoint.mk (is_left_adjoint.right G ⋙ is_left_adjoint.right F)
    (comp G (is_left_adjoint.right G) is_left_adjoint.adj is_left_adjoint.adj)

/-- If `F` and `G` are right adjoints then `F ⋙ G` is a right adjoint too. -/
protected instance right_adjoint_of_comp {C : Type u₁} [category C] {D : Type u₂} [category D]
    {E : Type u₃} [ℰ : category E] {F : C ⥤ D} {G : D ⥤ E} [Fr : is_right_adjoint F]
    [Gr : is_right_adjoint G] : is_right_adjoint (F ⋙ G) :=
  is_right_adjoint.mk (is_right_adjoint.left G ⋙ is_right_adjoint.left F)
    (comp (is_right_adjoint.left F) F is_right_adjoint.adj is_right_adjoint.adj)

-- Construction of a left adjoint. In order to construct a left

-- adjoint to a functor G : D → C, it suffices to give the object part

-- of a functor F : C → D together with isomorphisms Hom(FX, Y) ≃

-- Hom(X, GY) natural in Y. The action of F on morphisms can be

-- constructed from this data.

/-- Construct a left adjoint functor to `G`, given the functor's value on objects `F_obj` and
a bijection `e` between `F_obj X ⟶ Y` and `X ⟶ G.obj Y` satisfying a naturality law
`he : ∀ X Y Y' g h, e X Y' (h ≫ g) = e X Y h ≫ G.map g`.
Dual to `right_adjoint_of_equiv`. -/
@[simp] theorem left_adjoint_of_equiv_obj {C : Type u₁} [category C] {D : Type u₂} [category D]
    {G : D ⥤ C} {F_obj : C → D} (e : (X : C) → (Y : D) → (F_obj X ⟶ Y) ≃ (X ⟶ functor.obj G Y))
    (he :
      ∀ (X : C) (Y Y' : D) (g : Y ⟶ Y') (h : F_obj X ⟶ Y),
        coe_fn (e X Y') (h ≫ g) = coe_fn (e X Y) h ≫ functor.map G g) :
    ∀ (ᾰ : C), functor.obj (left_adjoint_of_equiv e he) ᾰ = F_obj ᾰ :=
  fun (ᾰ : C) => Eq.refl (functor.obj (left_adjoint_of_equiv e he) ᾰ)

/-- Show that the functor given by `left_adjoint_of_equiv` is indeed left adjoint to `G`. Dual
to `adjunction_of_equiv_right`. -/
@[simp] theorem adjunction_of_equiv_left_hom_equiv {C : Type u₁} [category C] {D : Type u₂}
    [category D] {G : D ⥤ C} {F_obj : C → D}
    (e : (X : C) → (Y : D) → (F_obj X ⟶ Y) ≃ (X ⟶ functor.obj G Y))
    (he :
      ∀ (X : C) (Y Y' : D) (g : Y ⟶ Y') (h : F_obj X ⟶ Y),
        coe_fn (e X Y') (h ≫ g) = coe_fn (e X Y) h ≫ functor.map G g)
    (X : C) (Y : D) : hom_equiv (adjunction_of_equiv_left e he) X Y = e X Y :=
  Eq.refl (e X Y)

-- Construction of a right adjoint, analogous to the above.

/-- Construct a right adjoint functor to `F`, given the functor's value on objects `G_obj` and
a bijection `e` between `F.obj X ⟶ Y` and `X ⟶ G_obj Y` satisfying a naturality law
`he : ∀ X Y Y' g h, e X' Y (F.map f ≫ g) = f ≫ e X Y g`.
Dual to `left_adjoint_of_equiv`. -/
@[simp] theorem right_adjoint_of_equiv_obj {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G_obj : D → C} (e : (X : C) → (Y : D) → (functor.obj F X ⟶ Y) ≃ (X ⟶ G_obj Y))
    (he :
      ∀ (X' X : C) (Y : D) (f : X' ⟶ X) (g : functor.obj F X ⟶ Y),
        coe_fn (e X' Y) (functor.map F f ≫ g) = f ≫ coe_fn (e X Y) g) :
    ∀ (ᾰ : D), functor.obj (right_adjoint_of_equiv e he) ᾰ = G_obj ᾰ :=
  fun (ᾰ : D) => Eq.refl (functor.obj (right_adjoint_of_equiv e he) ᾰ)

/-- Show that the functor given by `right_adjoint_of_equiv` is indeed right adjoint to `F`. Dual
to `adjunction_of_equiv_left`. -/
@[simp] theorem adjunction_of_equiv_right_counit_app {C : Type u₁} [category C] {D : Type u₂}
    [category D] {F : C ⥤ D} {G_obj : D → C}
    (e : (X : C) → (Y : D) → (functor.obj F X ⟶ Y) ≃ (X ⟶ G_obj Y))
    (he :
      ∀ (X' X : C) (Y : D) (f : X' ⟶ X) (g : functor.obj F X ⟶ Y),
        coe_fn (e X' Y) (functor.map F f ≫ g) = f ≫ coe_fn (e X Y) g)
    (Y : D) :
    nat_trans.app (counit (adjunction_of_equiv_right e he)) Y =
        coe_fn (equiv.symm (e (G_obj Y) Y)) 𝟙 :=
  Eq.refl (coe_fn (equiv.symm (e (G_obj Y) Y)) 𝟙)

/--
If the unit and counit of a given adjunction are (pointwise) isomorphisms, then we can upgrade the
adjunction to an equivalence.
-/
@[simp] theorem to_equivalence_functor {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) [(X : C) → is_iso (nat_trans.app (unit adj) X)]
    [(Y : D) → is_iso (nat_trans.app (counit adj) Y)] :
    equivalence.functor (to_equivalence adj) = F :=
  Eq.refl (equivalence.functor (to_equivalence adj))

/--
If the unit and counit for the adjunction corresponding to a right adjoint functor are (pointwise)
isomorphisms, then the functor is an equivalence of categories.
-/
@[simp] theorem is_right_adjoint_to_is_equivalence_unit_iso_inv_app {C : Type u₁} [category C]
    {D : Type u₂} [category D] {G : D ⥤ C} [is_right_adjoint G]
    [(X : C) → is_iso (nat_trans.app (unit (of_right_adjoint G)) X)]
    [(Y : D) → is_iso (nat_trans.app (counit (of_right_adjoint G)) Y)] (X : D) :
    nat_trans.app (iso.inv is_equivalence.unit_iso) X =
        nat_trans.app (counit (of_right_adjoint G)) X :=
  Eq.refl (nat_trans.app (counit (of_right_adjoint G)) X)

end adjunction

namespace equivalence

/-- The adjunction given by an equivalence of categories. (To obtain the opposite adjunction,
simply use `e.symm.to_adjunction`. -/
def to_adjunction {C : Type u₁} [category C] {D : Type u₂} [category D] (e : C ≌ D) :
    functor e ⊣ inverse e :=
  adjunction.mk_of_unit_counit (adjunction.core_unit_counit.mk (unit e) (counit e))

end equivalence

namespace functor

/-- An equivalence `E` is left adjoint to its inverse. -/
def adjunction {C : Type u₁} [category C] {D : Type u₂} [category D] (E : C ⥤ D)
    [is_equivalence E] : E ⊣ inv E :=
  equivalence.to_adjunction (as_equivalence E)

/-- If `F` is an equivalence, it's a left adjoint. -/
protected instance left_adjoint_of_equivalence {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} [is_equivalence F] : is_left_adjoint F :=
  is_left_adjoint.mk (inv F) (adjunction F)

@[simp] theorem right_adjoint_of_is_equivalence {C : Type u₁} [category C] {D : Type u₂}
    [category D] {F : C ⥤ D} [is_equivalence F] : right_adjoint F = inv F :=
  rfl

/-- If `F` is an equivalence, it's a right adjoint. -/
protected instance right_adjoint_of_equivalence {C : Type u₁} [category C] {D : Type u₂}
    [category D] {F : C ⥤ D} [is_equivalence F] : is_right_adjoint F :=
  is_right_adjoint.mk (inv F) (adjunction (inv F))

@[simp] theorem left_adjoint_of_is_equivalence {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} [is_equivalence F] : left_adjoint F = inv F :=
  rfl

end Mathlib


import .formula
import .derivations

/-- A set `s` is `Σ`-consistent if it does not `Σ`-derive `⊥`.  -/
def set.consistent (s axms : set formula) : Prop := ¬(s ⊢[axms] ⊥)

lemma derivable_iff_not_consistent {Γ : set formula} {axms} {a} :
  (Γ ⊢[axms] a) ↔ ¬(Γ ∪ {¬a}).consistent axms :=
sorry

lemma consistent_extensible (Γ : set formula) (axms) :
  Γ.consistent axms → ∀a, (Γ ∪ {a}).consistent axms ∨ (Γ ∪ {¬a}).consistent axms :=
begin
  contrapose,
  simp only [not_forall],
  intro h,
  cases h with a ha,
  simp [set.consistent, -derivable.from] at ha,
  rw ←and_iff_not_or_not at ha,
  cases ha with ha hna,
  rw [set.consistent, not_not],
  rw [←set.union_singleton, derivable.deduction] at *,
  apply derivable.from.mp (a ⟶ ⊥) _ _ ha,
  apply derivable.from.mp (¬a ⟶ ⊥) _ _ hna,
  derive_taut,
end


import tactic.ring
import tactic.ring_exp
import algebra.category.CommRing.basic
open category_theory
open functor
open CommRing
--          open algebra
--          open finsupp
universes v u
local notation ` Ring `     :=    CommRing.{u}
-- We start to define the affine line over ℤ ! This is a forget full foncteur Ring → Set
local notation ` Set  `     :=    Type u

namespace 𝔸
def  obj  (α : Type u) [comm_ring α]  : Set := α
def map (α : Type u)(β : Type u)[comm_ring α][comm_ring β] (f : α →+* β) : obj ( α ) → obj ( β )  :=
       λ a : obj(α),  f a
end 𝔸
def  𝔸  :  Ring  ⥤  Set :=
    {
            obj   :=    λ R :Ring, 𝔸.obj(R),
            map   :=    λ α β f,  f,
}

-- The structure sheaf of ring of affine line over ℤ !

def 𝕆 : Ring ⥤ Ring  := functor.id Ring   --   non generic version of 𝒪 !
#print Ring.has_forget_to_AddCommGroup     ---- try to construct the additive group Gₐ by convertion !
-- We now want to proof that 𝔸 is a local fonctor
-- This mean  :  ∀ R : Ring, for all finite familly (r_1 ... r_n) s.t exists u_1 ... u_n st  ∑ u_i r_i =1, for all
--      s_1 ... s_n ∈ Loc A_(s_i) s.t they matcth in the localisation s_ij, exists unique
--              s ∈ R s.t (s)_(r_i) = s_i   (comaximal-gluing L for localisation)
--  Perhaps : use the library of localisation
--
--  This mean : 𝔸 is a sheaf for global Zariski topology on Ringᵒᵖ   !
--- We start by somme lemma about co-maximal elements
-- --

namespace study
universes U V
variables (R : Type U)[comm_ring.{U} R](φ : R → R → Prop)
local infix ⊥ := φ

def symm := ∀  ⦃a b⦄  , (a ⊥ b) → (b ⊥ a)

def stab_mul := ∀ ⦃a b c⦄ ,   (a ⊥ c) → (b ⊥ c) → ((a * b) ⊥ c)

def co_max_type := (symm R φ) ∧ (stab_mul R  φ)

end study

open study
universes U V
variables(R : Type U)[comm_ring.{U} R](φ : R → R → Prop)[co_max_type R φ ]

local infix ⊥ :=  φ
lemma power_2 (a b : R) :    (a ⊥ b) →  (b ⊥ a) :=
            φ.has_symm

---   Mettre en place une induction !
---   ensuite :
---         aba trick
---
---  Maintenant on s'amuse de manière formelle en créant une instance !

noncomputable def ι (p : polynomial ℤ)  {R : Ring} : R → R := λ t, eval t (map (to_fun R) p)

def β (R :  Alg ) : ℤ → R := to_fun (R)

noncomputable def ι₁  {R : Ring} :  polynomial ℤ  →   polynomial R :=
 λ P : polynomial ℤ,  map_range  (to_fun R) ( is_add_group_hom.map_zero (to_fun R)) (P)

---   Ca permet d'obtenir une notation sympathique !
---   Maintenant : on souhait prouver un théormee  Pour tout f : A ⟶ B
---   f (ι (p) x) = ι p f(x)
---   En gros, il agit de voir un morphisme
---   iota : A → B → C   →  A[X] →R B[X] →R C[X]

    --- fonctor of point of Z[X] / p ... the subfonctor of 𝔸 s t  p(x) = 0  (certificate)
    --- There is no automatic conversion so ι do the job
    --- The property is that φ ι (p) t = ι (p) φ(t)
    --- in a fonctorial way : this give the proof that Idem(p) is a fonctor ... but i Lean it's difficult
structure Idem (p : polynomial ℤ) (R : Ring) :=
      (t : R)
      (certificat : ι(p) t   = 0)   --- lean notation are not good for maths ! ! ! ! !

@[reducible] def Ω (α : Type u)[comm_ring α] :=    --- subobjet classifier to speack open
submodule α α                                      --- and close subfonctor ! Fiber product construstion

namespace Ω

def map (α : Type u)(β : Type u)[comm_ring α][comm_ring β] (f : α →+* β) : Ω ( α ) → Ω ( β )  :=
  λ (I :  Ω( α )), ideal.span (f '' I)

def Ω₀ (α : Type)[comm_ring α] :=  finset α            --- finite version for finite presentation

def fr  [comm_ring α] : Ω₀(α) →  Ω(α) := λ s : Ω₀(α), ideal.span(s.to_set)

end Ω

have T := (a^n) * (a^(k) * u) + b * v = a^(n+k) * u + b * v, by
                    calc
                        (a^n) * (a^(k) * u) + b * v = a^(n+k) * u + b * v               : by ring_exp,
                have H := (a^n) * (a^(k) * u) + b * v = 1, from
                    calc
                    (a^n) * (a^(k) * u) + b * v = a^(n+k) * u + b * v : T
                    ...                         = 1                                 : by sorry,
                exact ⟨ (a^k * u),  v , H ⟩ ,


import data.set.basic
variables {α : Type*} {β : Type*} [s : setoid α]

namespace quotient
lemma prod_preimage_eq_image (g : quotient s → β) {h : α → β} (Hh : h = g ∘ quotient.mk) (r : set (β × β)) :
  {x : quotient s × quotient s | (g x.1, g x.2) ∈ r} =
  (λ a : α × α, (⟦a.1⟧, ⟦a.2⟧)) '' ((λ a : α × α, (h a.1, h a.2)) ⁻¹' r) :=
  Hh.symm ▸
  set.ext (λ ⟨a₁, a₂⟩, ⟨quotient.induction_on₂ a₁ a₂
    (λ a₁ a₂ h, ⟨(a₁, a₂), h, rfl⟩),
    λ ⟨⟨b₁, b₂⟩, h₁, h₂⟩, show (g a₁, g a₂) ∈ r, from
    have h₃ : ⟦b₁⟧ = a₁ ∧ ⟦b₂⟧ = a₂ := prod.ext_iff.1 h₂,
     h₃.1 ▸ h₃.2 ▸ h₁⟩)

end quotient