/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau

! This file was ported from Lean 3 source module algebra.opposites
! leanprover-community/mathlib commit 7a89b1aed52bcacbcc4a8ad515e72c5c07268940
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Group.Defs
import Mathlib.Logic.Equiv.Defs
import Mathlib.Logic.Nontrivial
import Mathlib.Logic.IsEmpty

/-!

# Multiplicative opposite and algebraic operations on it

In this file we define `MulOpposite α = αᵐᵒᵖ` to be the multiplicative opposite of `α`. It inherits
all additive algebraic structures on `α` (in other files), and reverses the order of multipliers in
multiplicative structures, i.e., `op (x * y) = op y * op x`, where `MulOpposite.op` is the
canonical map from `α` to `αᵐᵒᵖ`.

We also define `AddOpposite α = αᵃᵒᵖ` to be the additive opposite of `α`. It inherits all
multiplicative algebraic structures on `α` (in other files), and reverses the order of summands in
additive structures, i.e. `op (x + y) = op y + op x`, where `AddOpposite.op` is the canonical map
from `α` to `αᵃᵒᵖ`.

## Notation

* `αᵐᵒᵖ = MulOpposite α`
* `αᵃᵒᵖ = AddOpposite α`

## Implementation notes

In mathlib3 `αᵐᵒᵖ` was just a type synonym for `α`, marked irreducible after the API
was developed. In mathlib4 we use a structure with one field, because it is not possible
to change the reducibility of a declaration after its definition, and because Lean 4 has
definitional eta reduction for structures (Lean 3 does not).

## Tags

multiplicative opposite, additive opposite
-/

universe u v

open Function

/-- Multiplicative opposite of a type. This type inherits all additive structures on `α` and
reverses left and right in multiplication.-/
structure MulOpposite (α : Type u) : Type u where
  /-- The element of `MulOpposite α` that represents `x : α`. -/ op ::
  /-- The element of `α` represented by `x : αᵐᵒᵖ`. -/ unop : α
#align mul_opposite.op MulOpposite.op
#align mul_opposite.unop MulOpposite.unop
#align mul_opposite MulOpposite

-- porting note: the attribute `pp_nodot` does not exist yet; `op` and `unop` were
-- both tagged with it in mathlib3

/-- Additive opposite of a type. This type inherits all multiplicative structures on
      `α` and reverses left and right in addition. -/
structure AddOpposite (α : Type u) : Type u where
  /-- The element of `αᵃᵒᵖ` that represents `x : α`. -/ op ::
  /-- The element of `α` represented by `x : αᵃᵒᵖ`. -/ unop : α
#align add_opposite.unop AddOpposite.unop
#align add_opposite.op AddOpposite.op
#align add_opposite AddOpposite

-- porting note: the attribute `pp_nodot` does not exist yet; `op` and `unop` were
-- both tagged with it in mathlib3

attribute [to_additive] MulOpposite

/-- Multiplicative opposite of a type. -/
postfix:max "ᵐᵒᵖ" => MulOpposite

/-- Additive opposite of a type. -/
postfix:max "ᵃᵒᵖ" => AddOpposite

namespace MulOpposite

-- porting note: `simp` can prove this in Lean 4
@[to_additive]
theorem unop_op (x : α) : unop (op x) = x := rfl
#align mul_opposite.unop_op MulOpposite.unop_op
#align add_opposite.unop_op AddOpposite.unop_op

@[to_additive (attr := simp)]
theorem op_unop (x : αᵐᵒᵖ) : op (unop x) = x :=
  rfl
#align mul_opposite.op_unop MulOpposite.op_unop
#align add_opposite.op_unop AddOpposite.op_unop

@[to_additive (attr := simp)]
theorem op_comp_unop : (op : α → αᵐᵒᵖ) ∘ unop = id :=
  rfl
#align mul_opposite.op_comp_unop MulOpposite.op_comp_unop
#align add_opposite.op_comp_unop AddOpposite.op_comp_unop

@[to_additive (attr := simp)]
theorem unop_comp_op : (unop : αᵐᵒᵖ → α) ∘ op = id :=
  rfl
#align mul_opposite.unop_comp_op MulOpposite.unop_comp_op
#align add_opposite.unop_comp_op AddOpposite.unop_comp_op

/-- A recursor for `MulOpposite`. Use as `induction x using MulOpposite.rec'`. -/
@[to_additive (attr := simp)
  "A recursor for `AddOpposite`. Use as `induction x using AddOpposite.rec`."]
protected def rec' {F : ∀ _ : αᵐᵒᵖ, Sort v} (h : ∀ X, F (op X)) : ∀ X, F X := fun X => h (unop X)
#align mul_opposite.rec MulOpposite.rec'
#align add_opposite.rec AddOpposite.rec'

/-- The canonical bijection between `α` and `αᵐᵒᵖ`. -/
@[to_additive (attr := simps (config := { fullyApplied := false }) apply symm_apply)
  "The canonical bijection between `α` and `αᵃᵒᵖ`."]
def opEquiv : α ≃ αᵐᵒᵖ :=
  ⟨op, unop, unop_op, op_unop⟩
#align mul_opposite.op_equiv MulOpposite.opEquiv
#align mul_opposite.op_equiv_apply MulOpposite.opEquiv_apply
#align mul_opposite.op_equiv_symm_apply MulOpposite.opEquiv_symm_apply
#align add_opposite.op_equiv AddOpposite.opEquiv

@[to_additive]
theorem op_bijective : Bijective (op : α → αᵐᵒᵖ) :=
  opEquiv.bijective
#align mul_opposite.op_bijective MulOpposite.op_bijective
#align add_opposite.op_bijective AddOpposite.op_bijective

@[to_additive]
theorem unop_bijective : Bijective (unop : αᵐᵒᵖ → α) :=
  opEquiv.symm.bijective
#align mul_opposite.unop_bijective MulOpposite.unop_bijective
#align add_opposite.unop_bijective AddOpposite.unop_bijective

@[to_additive]
theorem op_injective : Injective (op : α → αᵐᵒᵖ) :=
  op_bijective.injective
#align mul_opposite.op_injective MulOpposite.op_injective
#align add_opposite.op_injective AddOpposite.op_injective

@[to_additive]
theorem op_surjective : Surjective (op : α → αᵐᵒᵖ) :=
  op_bijective.surjective
#align mul_opposite.op_surjective MulOpposite.op_surjective
#align add_opposite.op_surjective AddOpposite.op_surjective

@[to_additive]
theorem unop_injective : Injective (unop : αᵐᵒᵖ → α) :=
  unop_bijective.injective
#align mul_opposite.unop_injective MulOpposite.unop_injective
#align add_opposite.unop_injective AddOpposite.unop_injective

@[to_additive]
theorem unop_surjective : Surjective (unop : αᵐᵒᵖ → α) :=
  unop_bijective.surjective
#align mul_opposite.unop_surjective MulOpposite.unop_surjective
#align add_opposite.unop_surjective AddOpposite.unop_surjective

-- porting note: `simp` can prove this
@[to_additive]
theorem op_inj {x y : α} : op x = op y ↔ x = y := by simp
#align mul_opposite.op_inj MulOpposite.op_inj
#align add_opposite.op_inj AddOpposite.op_inj

@[to_additive (attr := simp, nolint simpComm)]
theorem unop_inj {x y : αᵐᵒᵖ} : unop x = unop y ↔ x = y :=
  unop_injective.eq_iff
#align mul_opposite.unop_inj MulOpposite.unop_inj
#align add_opposite.unop_inj AddOpposite.unop_inj

attribute [nolint simpComm] AddOpposite.unop_inj

variable (α)

@[to_additive]
instance nontrivial [Nontrivial α] : Nontrivial αᵐᵒᵖ :=
  op_injective.nontrivial

@[to_additive]
instance inhabited [Inhabited α] : Inhabited αᵐᵒᵖ :=
  ⟨op default⟩

@[to_additive]
instance subsingleton [Subsingleton α] : Subsingleton αᵐᵒᵖ :=
  unop_injective.subsingleton

@[to_additive]
instance unique [Unique α] : Unique αᵐᵒᵖ :=
  Unique.mk' _

@[to_additive]
instance isEmpty [IsEmpty α] : IsEmpty αᵐᵒᵖ :=
  Function.isEmpty unop

instance zero [Zero α] : Zero αᵐᵒᵖ where zero := op 0

@[to_additive]
instance one [One α] : One αᵐᵒᵖ where one := op 1

instance add [Add α] : Add αᵐᵒᵖ where add x y := op (unop x + unop y)

instance sub [Sub α] : Sub αᵐᵒᵖ where sub x y := op (unop x - unop y)

instance neg [Neg α] : Neg αᵐᵒᵖ where neg x := op $ -unop x

instance involutiveNeg [InvolutiveNeg α] : InvolutiveNeg αᵐᵒᵖ :=
  { MulOpposite.neg α with neg_neg := fun _ => unop_injective $ neg_neg _ }

@[to_additive]
instance mul [Mul α] : Mul αᵐᵒᵖ where mul x y := op (unop y * unop x)

@[to_additive]
instance inv [Inv α] : Inv αᵐᵒᵖ where inv x := op $ (unop x)⁻¹

@[to_additive]
instance involutiveInv [InvolutiveInv α] : InvolutiveInv αᵐᵒᵖ :=
  { MulOpposite.inv α with inv_inv := fun _ => unop_injective $ inv_inv _ }

@[to_additive]
instance smul (R : Type _) [SMul R α] : SMul R αᵐᵒᵖ where smul c x := op (c • unop x)

section

@[simp]
theorem op_zero [Zero α] : op (0 : α) = 0 :=
  rfl
#align mul_opposite.op_zero MulOpposite.op_zero

@[simp]
theorem unop_zero [Zero α] : unop (0 : αᵐᵒᵖ) = 0 :=
  rfl
#align mul_opposite.unop_zero MulOpposite.unop_zero

@[to_additive (attr := simp)]
theorem op_one [One α] : op (1 : α) = 1 :=
  rfl
#align mul_opposite.op_one MulOpposite.op_one
#align add_opposite.op_zero AddOpposite.op_zero

@[to_additive (attr := simp)]
theorem unop_one [One α] : unop (1 : αᵐᵒᵖ) = 1 :=
  rfl
#align mul_opposite.unop_one MulOpposite.unop_one
#align add_opposite.unop_zero AddOpposite.unop_zero

variable {α}

@[simp]
theorem op_add [Add α] (x y : α) : op (x + y) = op x + op y :=
  rfl
#align mul_opposite.op_add MulOpposite.op_add

@[simp]
theorem unop_add [Add α] (x y : αᵐᵒᵖ) : unop (x + y) = unop x + unop y :=
  rfl
#align mul_opposite.unop_add MulOpposite.unop_add

@[simp]
theorem op_neg [Neg α] (x : α) : op (-x) = -op x :=
  rfl
#align mul_opposite.op_neg MulOpposite.op_neg

@[simp]

@[to_additive (attr := simp)]
theorem op_mul [Mul α] (x y : α) : op (x * y) = op y * op x :=
  rfl
#align mul_opposite.op_mul MulOpposite.op_mul
#align add_opposite.op_add AddOpposite.op_add

@[to_additive (attr := simp)]
theorem unop_mul [Mul α] (x y : αᵐᵒᵖ) : unop (x * y) = unop y * unop x :=
  rfl
#align mul_opposite.unop_mul MulOpposite.unop_mul
#align add_opposite.unop_add AddOpposite.unop_add

@[to_additive (attr := simp)]
theorem op_inv [Inv α] (x : α) : op x⁻¹ = (op x)⁻¹ :=
  rfl
#align mul_opposite.op_inv MulOpposite.op_inv
#align add_opposite.op_neg AddOpposite.op_neg

@[to_additive (attr := simp)]
theorem unop_inv [Inv α] (x : αᵐᵒᵖ) : unop x⁻¹ = (unop x)⁻¹ :=
  rfl
#align mul_opposite.unop_inv MulOpposite.unop_inv
#align add_opposite.unop_neg AddOpposite.unop_neg

@[simp]
theorem op_sub [Sub α] (x y : α) : op (x - y) = op x - op y :=
  rfl
#align mul_opposite.op_sub MulOpposite.op_sub

@[simp]
theorem unop_sub [Sub α] (x y : αᵐᵒᵖ) : unop (x - y) = unop x - unop y :=
  rfl
#align mul_opposite.unop_sub MulOpposite.unop_sub

@[to_additive (attr := simp)]
theorem op_smul {R : Type _} [SMul R α] (c : R) (a : α) : op (c • a) = c • op a :=
  rfl
#align mul_opposite.op_smul MulOpposite.op_smul
#align add_opposite.op_vadd AddOpposite.op_vadd

@[to_additive (attr := simp)]
theorem unop_smul {R : Type _} [SMul R α] (c : R) (a : αᵐᵒᵖ) : unop (c • a) = c • unop a :=
  rfl
#align mul_opposite.unop_smul MulOpposite.unop_smul
#align add_opposite.unop_vadd AddOpposite.unop_vadd

end

variable {α}

@[simp, nolint simpComm]
theorem unop_eq_zero_iff [Zero α] (a : αᵐᵒᵖ) : a.unop = (0 : α) ↔ a = (0 : αᵐᵒᵖ) :=
  unop_injective.eq_iff' rfl
#align mul_opposite.unop_eq_zero_iff MulOpposite.unop_eq_zero_iff

@[simp]
theorem op_eq_zero_iff [Zero α] (a : α) : op a = (0 : αᵐᵒᵖ) ↔ a = (0 : α) :=
  op_injective.eq_iff' rfl
#align mul_opposite.op_eq_zero_iff MulOpposite.op_eq_zero_iff

theorem unop_ne_zero_iff [Zero α] (a : αᵐᵒᵖ) : a.unop ≠ (0 : α) ↔ a ≠ (0 : αᵐᵒᵖ) :=
  not_congr $ unop_eq_zero_iff a
#align mul_opposite.unop_ne_zero_iff MulOpposite.unop_ne_zero_iff

theorem op_ne_zero_iff [Zero α] (a : α) : op a ≠ (0 : αᵐᵒᵖ) ↔ a ≠ (0 : α) :=
  not_congr $ op_eq_zero_iff a
#align mul_opposite.op_ne_zero_iff MulOpposite.op_ne_zero_iff

@[to_additive (attr := simp, nolint simpComm)]
theorem unop_eq_one_iff [One α] (a : αᵐᵒᵖ) : a.unop = 1 ↔ a = 1 :=
  unop_injective.eq_iff' rfl
#align mul_opposite.unop_eq_one_iff MulOpposite.unop_eq_one_iff
#align add_opposite.unop_eq_zero_iff AddOpposite.unop_eq_zero_iff

attribute [nolint simpComm] AddOpposite.unop_eq_zero_iff

@[to_additive (attr := simp)]
theorem op_eq_one_iff [One α] (a : α) : op a = 1 ↔ a = 1 :=
  op_injective.eq_iff' rfl
#align mul_opposite.op_eq_one_iff MulOpposite.op_eq_one_iff
#align add_opposite.op_eq_zero_iff AddOpposite.op_eq_zero_iff

end MulOpposite

namespace AddOpposite

instance one [One α] : One αᵃᵒᵖ where one := op 1

@[simp]
theorem op_one [One α] : op (1 : α) = 1 :=
  rfl
#align add_opposite.op_one AddOpposite.op_one

@[simp]
theorem unop_one [One α] : unop 1 = (1 : α) :=
  rfl
#align add_opposite.unop_one AddOpposite.unop_one

@[simp]
theorem op_eq_one_iff [One α] {a : α} : op a = 1 ↔ a = 1 :=
  op_injective.eq_iff' op_one
#align add_opposite.op_eq_one_iff AddOpposite.op_eq_one_iff

@[simp]
theorem unop_eq_one_iff [One α] {a : αᵃᵒᵖ} : unop a = 1 ↔ a = 1 :=
  unop_injective.eq_iff' unop_one
#align add_opposite.unop_eq_one_iff AddOpposite.unop_eq_one_iff

attribute [nolint simpComm] unop_eq_one_iff

instance mul [Mul α] : Mul αᵃᵒᵖ where mul a b := op (unop a * unop b)

@[simp]
theorem op_mul [Mul α] (a b : α) : op (a * b) = op a * op b :=
  rfl
#align add_opposite.op_mul AddOpposite.op_mul

@[simp]
theorem unop_mul [Mul α] (a b : αᵃᵒᵖ) : unop (a * b) = unop a * unop b :=
  rfl
#align add_opposite.unop_mul AddOpposite.unop_mul

instance inv [Inv α] : Inv αᵃᵒᵖ where inv a := op (unop a)⁻¹

instance involutiveInv [InvolutiveInv α] : InvolutiveInv αᵃᵒᵖ :=
  { AddOpposite.inv with inv_inv := fun _ => unop_injective $ inv_inv _ }

@[simp]
theorem op_inv [Inv α] (a : α) : op a⁻¹ = (op a)⁻¹ :=
  rfl
#align add_opposite.op_inv AddOpposite.op_inv

@[simp]
theorem unop_inv [Inv α] (a : αᵃᵒᵖ) : unop a⁻¹ = (unop a)⁻¹ :=
  rfl
#align add_opposite.unop_inv AddOpposite.unop_inv

instance div [Div α] : Div αᵃᵒᵖ where div a b := op (unop a / unop b)

@[simp]
theorem op_div [Div α] (a b : α) : op (a / b) = op a / op b :=
  rfl
#align add_opposite.op_div AddOpposite.op_div

@[simp]
theorem unop_div [Div α] (a b : αᵃᵒᵖ) : unop (a / b) = unop a / unop b :=
  rfl
#align add_opposite.unop_div AddOpposite.unop_div

end AddOpposite


/-
Copyright (c) 2022 Joël Riou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joël Riou
-/

import algebraic_topology.dold_kan.homotopies
import tactic.ring_exp

/-!

# Study of face maps for the Dold-Kan correspondence

TODO (@joelriou) continue adding the various files referenced below

In this file, we obtain the technical lemmas that are used in the file
`projections.lean` in order to get basic properties of the endomorphisms
`P q : K[X] ⟶ K[X]` with respect to face maps (see `homotopies.lean` for the
role of these endomorphisms in the overall strategy of proof).

The main lemma in this file is `higher_faces_vanish.induction`. It is based
on two technical lemmas `higher_faces_vanish.comp_Hσ_eq` and
`higher_faces_vanish.comp_Hσ_eq_zero`.

-/

open nat
open category_theory
open category_theory.limits
open category_theory.category
open category_theory.preadditive
open category_theory.simplicial_object
open_locale simplicial dold_kan

namespace algebraic_topology

namespace dold_kan

variables {C : Type*} [category C] [preadditive C]
variables {X : simplicial_object C}

/-- A morphism `φ : Y ⟶ X _[n+1]` satisfies `higher_faces_vanish q φ`
when the compositions `φ ≫ X.δ j` are `0` for `j ≥ max 1 (n+2-q)`. When `q ≤ n+1`,
it basically means that the composition `φ ≫ X.δ j` are `0` for the `q` highest
possible values of a nonzero `j`. Otherwise, when `q ≥ n+2`, all the compositions
`φ ≫ X.δ j` for nonzero `j` vanish. See also the lemma `comp_P_eq_self_iff` in
`projections.lean` which states that `higher_faces_vanish q φ` is equivalent to
the identity `φ ≫ (P q).f (n+1) = φ`. -/
def higher_faces_vanish {Y : C} {n : ℕ} (q : ℕ) (φ : Y ⟶ X _[n+1]) : Prop :=
∀ (j : fin (n+1)), (n+1 ≤ (j : ℕ) + q) → φ ≫ X.δ j.succ = 0

namespace higher_faces_vanish

@[reassoc]
lemma comp_δ_eq_zero {Y : C} {n : ℕ} {q : ℕ} {φ : Y ⟶ X _[n+1]}
  (v : higher_faces_vanish q φ) (j : fin (n+2)) (hj₁ : j ≠ 0) (hj₂ : n+2 ≤ (j : ℕ) + q) :
  φ ≫ X.δ j = 0 :=
begin
  obtain ⟨i, hi⟩ := fin.eq_succ_of_ne_zero hj₁,
  subst hi,
  apply v i,
  rw [← @nat.add_le_add_iff_right 1, add_assoc],
  simpa only [fin.coe_succ, add_assoc, add_comm 1] using hj₂,
end

lemma of_comp {Y Z : C} {q n : ℕ} {φ : Y ⟶ X _[n+1]}
  (v : higher_faces_vanish q φ) (f : Z ⟶ Y) :
  higher_faces_vanish q (f ≫ φ) := λ j hj,
by rw [assoc, v j hj, comp_zero]

lemma comp_Hσ_eq {Y : C} {n a q : ℕ} {φ : Y ⟶ X _[n+1]}
  (v : higher_faces_vanish q φ) (hnaq : n=a+q) : φ ≫ (Hσ q).f (n+1) =
  - φ ≫ X.δ ⟨a+1, nat.succ_lt_succ (nat.lt_succ_iff.mpr (nat.le.intro hnaq.symm))⟩ ≫
    X.σ ⟨a, nat.lt_succ_iff.mpr (nat.le.intro hnaq.symm)⟩ :=
begin
  have hnaq_shift : Π d : ℕ, n+d=(a+d)+q,
  { intro d, rw [add_assoc, add_comm d, ← add_assoc, hnaq], },
  rw [Hσ, homotopy.null_homotopic_map'_f (c_mk (n+2) (n+1) rfl) (c_mk (n+1) n rfl),
    hσ'_eq hnaq (c_mk (n+1) n rfl), hσ'_eq (hnaq_shift 1) (c_mk (n+2) (n+1) rfl)],
  simp only [alternating_face_map_complex.obj_d_eq, eq_to_hom_refl,
    comp_id, comp_sum, sum_comp, comp_add],
  simp only [comp_zsmul, zsmul_comp, ← assoc, ← mul_zsmul],
  /- cleaning up the first sum -/
  rw [← fin.sum_congr' _ (hnaq_shift 2).symm, fin.sum_trunc], swap,
  { rintro ⟨k, hk⟩,
    suffices : φ ≫ X.δ (⟨a+2+k, by linarith⟩ : fin (n+2)) = 0,
    { simp only [this, fin.nat_add_mk, fin.cast_mk, zero_comp, smul_zero], },
    convert v ⟨a+k+1, by linarith⟩ (by { rw fin.coe_mk, linarith, }),
    rw [nat.succ_eq_add_one],
    linarith, },
  /- cleaning up the second sum -/
  rw [← fin.sum_congr' _ (hnaq_shift 3).symm, @fin.sum_trunc _ _ (a+3)], swap,
  { rintros ⟨k, hk⟩,
    rw [assoc, X.δ_comp_σ_of_gt', v.comp_δ_eq_zero_assoc, zero_comp, zsmul_zero],
    { intro h,
      rw [fin.pred_eq_iff_eq_succ, fin.ext_iff] at h,
      dsimp at h,
      linarith, },
    { dsimp,
      simp only [fin.coe_pred, fin.coe_mk, succ_add_sub_one],
      linarith, },
    { dsimp,
      linarith, }, },
  /- leaving out three specific terms -/
  conv_lhs { congr, skip, rw [fin.sum_univ_cast_succ, fin.sum_univ_cast_succ], },
  rw fin.sum_univ_cast_succ,
  simp only [fin.last, fin.cast_le_mk, fin.coe_cast, fin.cast_mk,
    fin.coe_cast_le, fin.coe_mk, fin.cast_succ_mk, fin.coe_cast_succ],
  /- the purpose of the following `simplif` is to create three subgoals in order
    to finish the proof -/
  have simplif : ∀ (a b c d e f : Y ⟶ X _[n+1]), b=f → d+e=0 → c+a=0 → a+b+(c+d+e) = f,
  { intros a b c d e f h1 h2 h3,
    rw [add_assoc c d e, h2, add_zero, add_comm a b, add_assoc,
      add_comm a c, h3, add_zero, h1], },
  apply simplif,
  { /- b=f -/
    rw [← pow_add, odd.neg_one_pow, neg_smul, one_zsmul],
    use a,
    linarith, },
  { /- d+e = 0 -/
    rw [assoc, assoc, X.δ_comp_σ_self' (fin.cast_succ_mk _ _ _).symm,
      X.δ_comp_σ_succ' (fin.succ_mk _ _ _).symm],
    simp only [comp_id, pow_add _ (a+1) 1, pow_one, mul_neg, mul_one, neg_smul,
      add_right_neg], },
  { /- c+a = 0 -/
    rw ← finset.sum_add_distrib,
    apply finset.sum_eq_zero,
    rintros ⟨i, hi⟩ h₀,
    have hia : (⟨i, by linarith⟩ : fin (n+2)) ≤ fin.cast_succ (⟨a, by linarith⟩ : fin (n+1)) :=
      by simpa only [fin.le_iff_coe_le_coe, fin.coe_mk, fin.cast_succ_mk, ← lt_succ_iff] using hi,
    simp only [fin.coe_mk, fin.cast_le_mk, fin.cast_succ_mk, fin.succ_mk, assoc, fin.cast_mk,
      ← δ_comp_σ_of_le X hia, add_eq_zero_iff_eq_neg, ← neg_zsmul],
    congr,
    ring_exp, },
end

lemma comp_Hσ_eq_zero {Y : C} {n q : ℕ} {φ : Y ⟶ X _[n+1]}
  (v : higher_faces_vanish q φ) (hqn : n<q) : φ ≫ (Hσ q).f (n+1) = 0 :=
begin
  simp only [Hσ, homotopy.null_homotopic_map'_f (c_mk (n+2) (n+1) rfl) (c_mk (n+1) n rfl)],
  rw [hσ'_eq_zero hqn (c_mk (n+1) n rfl), comp_zero, zero_add],
  by_cases hqn' : n+1<q,
  { rw [hσ'_eq_zero hqn' (c_mk (n+2) (n+1) rfl), zero_comp, comp_zero], },
  { simp only [hσ'_eq (show n+1=0+q, by linarith) (c_mk (n+2) (n+1) rfl),
      pow_zero, fin.mk_zero, one_zsmul, eq_to_hom_refl, comp_id,
      comp_sum, alternating_face_map_complex.obj_d_eq],
    rw [← fin.sum_congr' _ (show 2+(n+1)=n+1+2, by linarith), fin.sum_trunc],
    { simp only [fin.sum_univ_cast_succ, fin.sum_univ_zero, zero_add, fin.last,
        fin.cast_le_mk, fin.cast_mk, fin.cast_succ_mk],
      simp only [fin.mk_zero, fin.coe_zero, pow_zero, one_zsmul, fin.mk_one,
        fin.coe_one, pow_one, neg_smul, comp_neg],
      erw [δ_comp_σ_self, δ_comp_σ_succ, add_right_neg], },
    { intro j,
      rw [comp_zsmul, comp_zsmul, δ_comp_σ_of_gt', v.comp_δ_eq_zero_assoc, zero_comp, zsmul_zero],
      { intro h,
        rw [fin.pred_eq_iff_eq_succ, fin.ext_iff] at h,
        dsimp at h,
        linarith, },
      { dsimp,
        simp only [fin.cast_nat_add, fin.coe_pred, fin.coe_add_nat, add_succ_sub_one],
        linarith, },
      { rw fin.lt_iff_coe_lt_coe,
        dsimp,
        linarith, }, }, },
end

lemma induction {Y : C} {n q : ℕ} {φ : Y ⟶ X _[n+1]}
  (v : higher_faces_vanish q φ) : higher_faces_vanish (q+1) (φ ≫ (𝟙 _ + Hσ q).f (n+1)) :=
begin
  intros j hj₁,
  dsimp,
  simp only [comp_add, add_comp, comp_id],
  -- when n < q, the result follows immediately from the assumption
  by_cases hqn : n<q,
  { rw [v.comp_Hσ_eq_zero hqn, zero_comp, add_zero, v j (by linarith)], },
  -- we now assume that n≥q, and write n=a+q
  cases nat.le.dest (not_lt.mp hqn) with a ha,
  rw [v.comp_Hσ_eq (show n=a+q, by linarith), neg_comp, add_neg_eq_zero, assoc, assoc],
  cases n with m hm,
  -- the boundary case n=0
  { simpa only [nat.eq_zero_of_add_eq_zero_left ha, fin.eq_zero j,
      fin.mk_zero, fin.mk_one, δ_comp_σ_succ, comp_id], },
  -- in the other case, we need to write n as m+1
  -- then, we first consider the particular case j = a
  by_cases hj₂ : a = (j : ℕ),
  { simp only [hj₂, fin.eta, δ_comp_σ_succ, comp_id],
    congr,
    ext,
    simp only [fin.coe_succ, fin.coe_mk], },
  -- now, we assume j ≠ a (i.e. a < j)
  have haj : a<j := (ne.le_iff_lt hj₂).mp (by linarith),
  have hj₃ := j.is_lt,
  have ham : a≤m,
  { by_contradiction,
    rw [not_le, ← nat.succ_le_iff] at h,
    linarith, },
  rw [X.δ_comp_σ_of_gt', j.pred_succ], swap,
  { rw fin.lt_iff_coe_lt_coe,
    simpa only [fin.coe_mk, fin.coe_succ, add_lt_add_iff_right] using haj, },
  obtain (ham' | ham'') := ham.lt_or_eq,
  { -- case where `a<m`
    rw ← X.δ_comp_δ''_assoc, swap,
    { rw fin.le_iff_coe_le_coe,
      dsimp,
      linarith, },
    simp only [← assoc, v j (by linarith), zero_comp], },
  { -- in the last case, a=m, q=1 and j=a+1
    rw X.δ_comp_δ_self'_assoc, swap,
    { ext,
      dsimp,
      have hq : q = 1 := by rw [← add_left_inj a, ha, ham'', add_comm],
      linarith, },
    simp only [← assoc, v j (by linarith), zero_comp], },
end

end higher_faces_vanish

end dold_kan

end algebraic_topology


import tactic linear_algebra.basis mathlib_lemmas ring_theory.principal_ideal_domain torsion
run_cmd tactic.skip
open_locale classical

variables (ι : Type*) (Rr : Type*) [integral_domain Rr]
          [decidable_eq Rr] [fintype ι]

variables (l : ι →₀ Rr)

/-- An R-module `P` is projective iff for all R-modules `A, B` and R-module homs
`f : P →ₗ[R] B, g : A →ₗ[R] B` such that g is surjective, there exists an R-module hom
`h : P →ₗ[R] B` such that `g ∘ h = f`. -/
def projective (P : Type*) [add_comm_group P] [module Rr P] := ∀ (A : Type*)
  [add_comm_group A], by exactI ∀ [module Rr A] (B : Type*), by exactI ∀ [add_comm_group B],
  by exactI ∀ [module Rr B] (f : by exactI P →ₗ[Rr] B), by exactI ∀ (g : A →ₗ[Rr] B) (h : function.surjective g),
  by exactI ∃ h : P →ₗ[Rr] A, ∀ x, g (h x) = f x

variables {Rr}

variables (Rr)
open function

/-- The short five lemma... -/
noncomputable def short_five {A : Type*} {B : Type*} {C : Type*} {D : Type*}
  {E : Type*} {F : Type*} [add_comm_group A] [add_comm_group B] [add_comm_group C]
  [add_comm_group D] [add_comm_group E] [add_comm_group F] [module Rr A] [module Rr B]
  [module Rr C] [module Rr D] [module Rr E] [module Rr F] (f : A →ₗ[Rr] B) (g : B →ₗ[Rr] C)
  (h : A ≃ₗ[Rr] D) (j : B →ₗ[Rr] E) (k : C ≃ₗ[Rr] F) (l : D →ₗ[Rr] E) (m : E →ₗ[Rr] F) (hf : f.ker = ⊥)
  (hex1 : f.range = g.ker) (hg : g.range = ⊤) (hl : l.ker = ⊥) (hex2 : l.range = m.ker)
  (hm : m.range = ⊤) (h1 : ∀ x, j (f x) = l (h x)) (h2 : ∀ x, k (g x) = m (j x)) : B ≃ₗ[Rr] E :=
linear_equiv.of_bijective j (linear_map.ker_eq_bot'.2 $ λ b H,
  begin
    obtain ⟨a, _, ha⟩ : b ∈ f.range,
      begin
        rw hex1,
        apply linear_map.mem_ker.2,
        apply linear_map.ker_eq_bot'.1 k.ker (g b),
        erw [h2 b, H, m.map_zero]
      end,
    rw ←ha,
    suffices : a = 0, from this.symm ▸ f.map_zero,
    apply linear_map.ker_eq_bot'.1 (ker_eq_bot_comp h.ker hl) a,
    erw [←h1 a, ha, H]
  end) (eq_top_iff.2 $ λ e _,
  begin
    obtain ⟨b, _, hb⟩ : m e ∈ (k.to_linear_map.comp g).range, by
      erw range_eq_top_comp hg k.range; trivial,
    obtain ⟨d, _, hd⟩ : j b - e ∈ l.range, by
      rw hex2; exact linear_map.sub_mem_ker_iff.2 (h2 b ▸ hb),
    obtain ⟨a, _, ha⟩ : d ∈ h.to_linear_map.range, by
      erw h.range; trivial,
    exact ⟨b - f a, trivial, by erw [j.map_sub, h1 a, ha, hd, sub_sub_self]⟩
  end)

/-- In an exact sequence, `Im ∂ₙ₊₁ ⊆ Ker ∂ₙ`.  -/
lemma comp_of_exact {A : Type*} {B : Type*} {C : Type*} [add_comm_group A]
  [add_comm_group B] [add_comm_group C] [module Rr A] [module Rr B] [module Rr C]
  (f : A →ₗ[Rr] B) (g : B →ₗ[Rr] C) (hex : f.range = g.ker) (x : A) : g (f x) = 0 :=
linear_map.mem_ker.1 $ by rw ←hex; exact ⟨x, trivial, rfl⟩

/-- In an SES 0 → A → B → C → 0 with maps `f, g`, if there's an R-module hom `h : C →ₗ[R] B` that's left
inverse to `g`, the SES is split. -/
noncomputable def split_of_left_inverse (A : Type*) (B : Type*) (C : Type*) [add_comm_group A]
  [add_comm_group B] [add_comm_group C] [module Rr A] [module Rr B] [module Rr C]
  (f : A →ₗ[Rr] B) (g : B →ₗ[Rr] C) (hf : f.ker = ⊥) (hg : g.range = ⊤)
  (hex : f.range = g.ker) (h : C →ₗ[Rr] B) (H : ∀ x, g (h x) = x) :
  (A × C) ≃ₗ[Rr] B :=
short_five Rr (linear_map.inl Rr A C) (linear_map.snd Rr A C) (linear_equiv.refl Rr A) (linear_map.coprod f h)
(linear_equiv.refl Rr C) f g (linear_map.ker_eq_bot'.2 $ λ x h, (prod.ext_iff.1 h).1)
(submodule.ext $ λ x, ⟨λ ⟨y, _, h⟩, linear_map.mem_ker.2 $ h ▸ rfl, λ h, ⟨x.1, trivial, prod.ext rfl $
  show 0 = x.2, from (linear_map.mem_ker.1 h).symm⟩⟩) (eq_top_iff.2 $ λ x _, ⟨⟨0, x⟩, trivial, rfl⟩)
  hf hex hg (λ x, show f x + h 0 = f x, by rw [h.map_zero, add_zero]) $
  λ x, show x.2 = g (f x.1 + h x.2), by rw [g.map_add, H x.2, comp_of_exact Rr _ _ hex, zero_add]


import algebraic_topology.simplex_category
import algebraic_topology.simplicial_object
import analysis.convex.topology
import algebraic_topology.simplicial_set
import category_theory.natural_isomorphism
import .category_theory .general_topology

local attribute [instance]
  category_theory.concrete_category.has_coe_to_sort
  category_theory.concrete_category.has_coe_to_fun

noncomputable theory

namespace simplex_category

def squash (n : ℕ) : simplex_category.mk n ⟶ simplex_category.mk 0 :=
  simplex_category.mk_hom ⟨(λ _, 0), by { intros x y _, reflexivity }⟩

def to_Top'_obj (x : simplex_category) := std_simplex ℝ x

open_locale simplicial big_operators classical

instance (x : simplex_category) : has_coe_to_fun x.to_Top'_obj (λ _, x → ℝ) :=
⟨λ f, (f : x → ℝ)⟩

lemma to_Top'_obj_coord_sum_nonzero {x : simplex_category} {s : finset x}
  (p : x.to_Top'_obj) : 0 ≤ ∑ i in s, p i :=
  le_of_eq_of_le (finset.sum_eq_zero (λ _ _, rfl)).symm
                 (finset.sum_le_sum (λ i _, p.property.left i))

@[ext]
lemma to_Top'_obj.ext {x : simplex_category} (f g : x.to_Top'_obj) :
  (f : x → ℝ) = g → f = g := subtype.ext

-- Should be defined in analysis.convex.basic, maybe?
def to_Top'_map {x y : simplex_category} (f : x ⟶ y)
  : x.to_Top'_obj → y.to_Top'_obj :=
    λ p, ⟨λ i, ∑ j in (finset.univ.filter (λ k, f k = i)), p j,
          λ i, to_Top'_obj_coord_sum_nonzero p,
          by { refine eq.trans _ p.2.right,
                refine eq.trans (finset.sum_bUnion _).symm _,
                { refine finset.pairwise_disjoint_coe.mp _,
                  convert set.pairwise_disjoint_fiber f _,
                  ext, simp },
                { apply finset.sum_congr,
                  { rw finset.eq_univ_iff_forall,
                    intro i,
                    rw finset.mem_bUnion,
                    exact ⟨f i, by simp, by simp⟩ },
                  { intros, refl } } }⟩

@[simp]
lemma coe_to_Top'_map {x y : simplex_category} (f : x ⟶ y) (g : x.to_Top'_obj) (i : y) :
  to_Top'_map f g i = ∑ j in (finset.univ.filter (λ k, f k = i)), g j := rfl

@[continuity]
lemma continuous_to_Top'_map {x y : simplex_category} (f : x ⟶ y) :
  continuous (to_Top'_map f) :=
continuous_subtype_mk _ $ continuous_pi $ λ i, continuous_finset_sum _ $
  λ j hj, continuous.comp (continuous_apply _) continuous_subtype_val

@[simps]
def to_Top' : simplex_category ⥤ Top :=
{ obj := λ x, Top.of x.to_Top'_obj,
  map := λ x y f, ⟨to_Top'_map f⟩,
  map_id' := begin
    intros x,
    ext f i : 3,
    change (finset.univ.filter (λ k, k = i)).sum _ = _,
    simp [finset.sum_filter]
  end,
  map_comp' := begin
    intros x y z f g,
    ext h i : 3,
    dsimp,
    erw ← finset.sum_bUnion,
    apply finset.sum_congr,
    { exact finset.ext (λ j, ⟨λ hj, by simpa using hj, λ hj, by simpa using hj⟩) },
    { tauto },
    { refine finset.pairwise_disjoint_coe.mp _,
      convert set.pairwise_disjoint_fiber f _,
      ext, simp },
  end }.

def topological_simplex_alt_desc (n : simplex_category)
  : {f : n → nnreal | ∑ (i : n), f i = 1} ≃ₜ std_simplex ℝ n := {
  to_fun := λ x, ⟨λ i, (x.val i).val, λ i, (x.val i).property,
                    by { have := (congr_arg subtype.val x.property),
                        refine eq.trans _ this,
                        symmetry,
                        simp at this,
                        have := map_sum (⟨subtype.val, _, _⟩ : nnreal →+ ℝ) x.val finset.univ,
                        swap, { refl }, swap, { rintros ⟨x, _⟩ ⟨y, _⟩, simp },
                        refine eq.trans this _,
                        congr }⟩,
  inv_fun := λ x, ⟨λ i, ⟨x.val i, x.property.left i⟩,
                     by { refine subtype.eq _,
                         have := x.property.right,
                         refine eq.trans _ this,
                         let f : fin (n.len + 1) → nnreal := λ i, ⟨x.val i, x.property.left i⟩,
                         have := map_sum (⟨subtype.val, _, _⟩ : nnreal →+ ℝ) f finset.univ,
                         swap, { refl }, swap, { rintros ⟨x, _⟩ ⟨y, _⟩, simp },
                         refine eq.trans this _,
                         congr }⟩,
  left_inv := λ x, by simp,
  right_inv := λ x, by simp,
  continuous_to_fun := by { simp, continuity,
                            apply continuous.congr ((continuous_apply i).comp continuous_subtype_coe),
                            simp },
  continuous_inv_fun := by { simp, continuity,
                             apply continuous.congr ((continuous_apply i).comp continuous_subtype_coe),
                             simp }
}.

def to_Top_iso_to_Top' : to_Top ≅ to_Top' :=
  category_theory.nat_iso.of_components (λ x, Top.iso_of_homeo (topological_simplex_alt_desc x))
    (by { intros n m f,
          ext p k,
          change ((finset.filter (λ j, f j = k) finset.univ).sum p.val).val
               = (finset.filter (λ j, f j = k) finset.univ).sum (λ i, (p.val i).val),
          exact map_sum (⟨subtype.val, rfl, nnreal.coe_add⟩ : nnreal →+ ℝ) p.val _, })

end simplex_category

open category_theory

def Top.to_sSet' : Top ⥤ sSet :=
colimit_adj.restricted_yoneda simplex_category.to_Top'

def Top.to_sSet_iso_to_sSet' : Top.to_sSet ≅ Top.to_sSet' :=
begin
  refine @functor.map_iso _ _ _ _
    (@restricted_yoneda_functor simplex_category _ Top.{0} _)
    (opposite.op simplex_category.to_Top) (opposite.op simplex_category.to_Top')
    (iso.op simplex_category.to_Top_iso_to_Top'.symm),
end

lemma ext_to_hext {α : Type*} {β γ : α → Type*} (f : Π {a : α}, β a → γ a)
  (e : ∀ {a} (x y : β a), x = y ↔ f x = f y)
  {a a' : α} (x : β a) (y : β a') : a = a' → (x == y ↔ f x == f y) :=
begin
  intro h, induction h,
  rw [heq_iff_eq, heq_iff_eq], apply e,
end

universes u u'
def connected_functor_preserves_coprod {C : Type (max u u')} [small_category C]
  (F : C ⥤ Top.{max u u'}) {J : Type u'} (f : J → Top.{max u u'})
  (hF : ∀ x : C, connected_space (F.obj x))
  : limits.preserves_colimit (discrete.functor f) (colimit_adj.restricted_yoneda F) :=
begin
  apply limits.preserves_colimit_of_preserves_colimit_cocone (Top.sigma_cofan_is_colimit.{(max u u') u'} f),
  apply limits.evaluation_jointly_reflects_colimits,
  intro x,
  let α := functor.associator (discrete.functor f) (colimit_adj.restricted_yoneda F)
                              ((evaluation Cᵒᵖ (Type (max u u'))).obj x),
  refine limits.is_colimit.equiv_of_nat_iso_of_iso α.symm _ _
           (functor.map_cocone_map_cocone' _ _ _ _) _,
  change limits.is_colimit ((coyoneda.obj (F.op.obj x)).map_cocone (Top.sigma_cofan.{(max u u') u'} f)),
  dsimp [Top.sigma_cofan, coyoneda, functor.map_cocone, limits.cocones.functoriality],
  have : ∀ g : F.obj x.unop ⟶ Top.of (Σ (i : J), f i), ∃! j : J,
             set.range g ⊆ set.range (Top.sigma_ι.{(max u u') u'} f j),
  { intro g,
    obtain ⟨hx, ⟨b⟩⟩ := hF x.unop,
    have : ∀ {j : J}, g b ∈ set.range (Top.sigma_ι.{(max u u') u'} f j)
                    ↔ set.range g ⊆ set.range (Top.sigma_ι.{(max u u') u'} f j),
    { intro j, refine ⟨_, λ h, h (set.mem_range_self b)⟩,
      intro h,
      exact is_preconnected.subset_clopen (is_preconnected_range g.continuous_to_fun)
                                          ⟨is_open_range_sigma_mk, is_closed_sigma_mk⟩
                                          ⟨g b, set.mem_range_self b, h⟩ },
    refine ⟨(g b).fst, this.mp ⟨(g b).snd, (g b).eta⟩, _⟩,
    intros j hj,
    obtain ⟨p, hp⟩ := this.mpr hj,
    rw ← hp, refl },
  have h : ∀ g : F.obj x.unop ⟶ Top.of (Σ (i : J), f i),
               g = embedding.pullback (@embedding_sigma_mk J (λ i, ↥(f i)) _ _) g
                                      (classical.some_spec (this g)).left
                   ≫ Top.sigma_ι.{(max u u') u'} f (classical.some (this g)),
  { intro g, ext p : 1, symmetry,
    exact embedding.pullback_spec (@embedding_sigma_mk J (λ i, ↥(f i)) _ _) g
                                      (classical.some_spec (this g)).left _ },
  refine ⟨_, _, _⟩,
  { intros s g,
    refine s.ι.app ⟨classical.some (this g)⟩ _,
    let := embedding_sigma_mk.pullback g (classical.some_spec (this g)).left,
    exact this },
  { rintros c j, ext g, dsimp at g,
    dsimp,
    have H : j = ⟨classical.some (this (g ≫ Top.sigma_ι.{(max u u') u'} f j.as))⟩,
    { ext, unfold_projs,
      apply (classical.some_spec (this (g ≫ Top.sigma_ι.{(max u u') u'} f j.as))).right j.as,
      apply set.range_comp_subset_range },
    apply congr_heq,
    { congr, exact H.symm },
    { replace h := congr_arg continuous_map.to_fun (h (g ≫ Top.sigma_ι.{(max u u') u'} f j.as)),
      have H' : ∀ (j : discrete J) (f₁ f₂ : F.obj (opposite.unop x) ⟶ (discrete.functor f).obj j),
                  f₁ = f₂ ↔ continuous_map.to_fun f₁ = continuous_map.to_fun f₂,
      { intros, split; intro h,
        { exact congr_arg _ h },
        { ext, exact congr_fun h _ } },
      refine (ext_to_hext (λ j, @continuous_map.to_fun (F.obj (opposite.unop x))
                                                       ((discrete.functor f).obj j) _ _) H'
                                                       _ g H.symm).mpr _,
      refine function.hfunext rfl _, intros y y' h', cases h',
      exact ((@sigma.mk.inj_iff J (λ i, (discrete.functor f).obj ⟨i⟩)
                                (classical.some (this (g ≫ Top.sigma_ι.{(max u u') u'} f j.as)))
                                j.as _ _).mp (congr_fun h y).symm).right } },
  { intros c m h', ext g,
    dsimp,
    rw ← h' ⟨classical.some (this g)⟩,
    dsimp, congr,
    exact h g }
end.

def topological_simplex (n : ℕ) := simplex_category.to_Top'_obj (simplex_category.mk n)

def topological_simplex.point : topological_simplex 0 := ⟨(λ _, 1), by {
  split, { intro, exact zero_le_one },
  apply finset.sum_eq_single_of_mem,
  exact finset.mem_univ 0,
  intros b h h', cases b with b bh,
  exfalso, cases b, trivial, simp at bh,
  assumption
}⟩

instance topological_simplex.point_unique : unique (topological_simplex 0) := {
  default := topological_simplex.point,
  uniq := by {
    suffices : ∀ x : topological_simplex 0, x.val 0 = 1,
    { intro, ext x,
      cases x with k hk, simp at hk, subst hk,
      exact eq.trans (this a) (this topological_simplex.point).symm },
    rintro ⟨f, h⟩,
    exact eq.trans finset.sum_singleton.symm h.right }
}

noncomputable
def inclusion (n : ℕ) : Top.of (topological_simplex n) ⟶ Top.of (topological_simplex (n + 1)) :=
  simplex_category.to_Top'.map (simplex_category.δ 0)

noncomputable
def const_vertex (n : ℕ) (i : simplex_category.mk (n + 1))
  : Top.of (topological_simplex n) ⟶ Top.of (topological_simplex (n + 1)) :=
  simplex_category.to_Top'.map (simplex_category.squash n
                               ≫ simplex_category.const (simplex_category.mk (n+1)) i)

noncomputable
def vertex (n : ℕ) (i : simplex_category.mk n) : topological_simplex n
  := simplex_category.to_Top'.map (simplex_category.const (simplex_category.mk n) i)
                                  topological_simplex.point

instance Top.to_sSet'_preserves_coprod {J : Type} (f : J → Top)
  : limits.preserves_colimit (discrete.functor f) Top.to_sSet' :=
begin
  apply connected_functor_preserves_coprod,
  intro x,
  refine (subtype.connected_space ((convex_std_simplex ℝ (fin (x.len + 1))).is_connected _)),
  rw ← set.nonempty_coe_sort, constructor,
  exact vertex x.len 0,
end

lemma topological_simplex.coord_le_one (n : ℕ) (i : simplex_category.mk n)
  (x : topological_simplex n) : x.val i ≤ 1 :=
begin
  transitivity (finset.univ.sum x.val),
  { rw ← finset.insert_erase (finset.mem_univ i),
    rw finset.sum_insert (finset.not_mem_erase _ _),
    refine le_of_eq_of_le (add_zero _).symm _,
    apply add_le_add, refl,
    apply simplex_category.to_Top'_obj_coord_sum_nonzero },
  { exact le_of_eq x.property.right }
end

lemma topological_simplex.has_one_implies_eq_zero (n : ℕ) (i : simplex_category.mk n)
  (x : topological_simplex n) (h : x.val i = 1) : ∀ j, i ≠ j → x.val j = 0 :=
begin
  intros j hij,
  have : finset.sum (insert i (insert j (finset.erase (finset.erase finset.univ i) j))) x.val = 1,
  { rw ← x.property.right, congr, rw [finset.insert_erase, finset.insert_erase],
    apply finset.mem_univ,
    apply finset.mem_erase_of_ne_of_mem,
    symmetry, assumption,
    apply finset.mem_univ },
  rw [finset.sum_insert, finset.sum_insert] at this,
  { rw h at this,
    rw add_right_eq_self at this,
    refine le_antisymm _ (x.property.left j),
    refine le_of_le_of_eq _ this,
    refine le_add_of_nonneg_right _,
    apply simplex_category.to_Top'_obj_coord_sum_nonzero },
  simp, simp, assumption
end

lemma vertex_coord_one (n : ℕ) (i : simplex_category.mk n) :
  @coe_fn _ _ (simplex_category.to_Top'_obj.has_coe_to_fun (simplex_category.mk n))
              (vertex n i) i = 1 :=
begin
  simp [vertex],
  transitivity finset.univ.sum (λ _, (1 : ℝ)),
  congr,
  { refine finset.eq_univ_of_forall _, intro x, simp, refl },
  { norm_num }
end

lemma vertex_coord_zero (n : ℕ) (i j : simplex_category.mk n) (h : i ≠ j) :
  @coe_fn _ _ (simplex_category.to_Top'_obj.has_coe_to_fun (simplex_category.mk n))
              (vertex n i) j = 0 :=
topological_simplex.has_one_implies_eq_zero n i _ (vertex_coord_one n i) j h

lemma eq_vertex (n : ℕ) (i : simplex_category.mk n) (x : topological_simplex n)
  : x.val i = 1 → x = vertex n i :=
begin
  intros hi,
  ext k,
  by_cases (i = k),
  { subst h, rw vertex_coord_one, rw ← hi, refl },
  { rw vertex_coord_zero n _ _ h,
    exact topological_simplex.has_one_implies_eq_zero n i x hi _ h }
end

lemma vertex_coord_binary (n : ℕ) (i j : simplex_category.mk n) :
  @coe_fn _ _ (simplex_category.to_Top'_obj.has_coe_to_fun (simplex_category.mk n))
              (vertex n i) j = 0
  ∨ @coe_fn _ _ (simplex_category.to_Top'_obj.has_coe_to_fun (simplex_category.mk n))
              (vertex n i) j = 1 :=
begin
  by_cases (i = j),
  { subst h, right, apply vertex_coord_one },
  { left, apply vertex_coord_zero, assumption }
end

lemma const_desc (n : ℕ) (i : simplex_category.mk (n + 1)) (x : topological_simplex n)
  : const_vertex n i x = vertex (n+1) i :=
begin
  delta const_vertex,
  delta vertex,
  rw simplex_category.to_Top'.map_comp,
  simp, congr,
  apply @unique.eq_default _ topological_simplex.point_unique
end

lemma deg_zero_zeroth_coface_map_is_vertex_one
  : simplex_category.to_Top'_map (simplex_category.δ 0) topological_simplex.point
  = vertex 1 1 :=
by {
  transitivity const_vertex 0 1 topological_simplex.point,
  { congr, ext, cases x with x hx, cases x,
    refl, exfalso, simp at hx, assumption },
  { apply const_desc }
}

lemma deg_zero_oneth_coface_map_is_vertex_zero
  : simplex_category.to_Top'_map (simplex_category.δ 1) topological_simplex.point
  = vertex 1 0 :=
by {
  transitivity const_vertex 0 0 topological_simplex.point,
  { congr, ext, cases x with x hx, cases x,
    refl, exfalso, simp at hx, assumption },
  { apply const_desc }
}

def one_simplex_homeo_interval : topological_simplex 1 ≃ₜ unit_interval := {
  to_fun := λ p, ⟨p.val 0, p.property.left 0, topological_simplex.coord_le_one 1 0 p⟩,
  inv_fun := λ t, ⟨(λ i, if i = 0 then t else unit_interval.symm t),
                   by { intro x, change 0 ≤ ite (x = 0) (t : ℝ) (unit_interval.symm t),
                        split_ifs; exact unit_interval.nonneg _ },
                   by { rw finset.univ_fin2, simp }⟩,
  left_inv := by { intro p, ext i, dsimp, fin_cases i,
                   { change ite (0 = 0) (p.val 0) (1 - p.val 0) = p.val 0, simp },
                   { dsimp [coe_fn, has_coe_to_fun.coe],
                     split_ifs, exfalso, cases h,
                     rw sub_eq_iff_eq_add, symmetry, rw add_comm,
                     convert p.property.right,
                     simp [list.pmap], congr, } },
  right_inv := by { intro t, ext, simp },
  continuous_to_fun := by { continuity,
                            exact (continuous_apply (0 : fin 2)).comp continuous_subtype_val },
  continuous_inv_fun := by { continuity, apply continuous.if_const, continuity }
}.

lemma coface_map_misses_output (n : ℕ) (i : fin (n + 2)) (j : simplex_category.mk n) :
  simplex_category.δ i j ≠ i :=
  fin.succ_above_ne i j

lemma succ_sigma_of_nonzero (n : ℕ) (k : simplex_category.mk (n + 1)) (h : k ≠ 0)
  : fin.succ (simplex_category.σ 0 k) = k :=
begin
  cases k with k hk,
  cases k, contradiction, refl
end

lemma fourth_simplicial_identity_modified (n : ℕ)
  (j : fin (n + 2)) (i : simplex_category.mk (n + 1))
  (H : ¬ (j = 0 ∧ i = 0))
  : simplex_category.δ j (simplex_category.σ 0 i)
  = simplex_category.σ 0 (simplex_category.δ j.succ i) :=
begin
  by_cases j = 0,
  { subst h, rw not_and at H, specialize H rfl,
    have : i = simplex_category.δ 0 (simplex_category.σ 0 i),
    { symmetry, apply succ_sigma_of_nonzero, assumption },
    rw this,
    generalize : simplex_category.σ 0 i = i', clear H this i,
    transitivity simplex_category.δ 0
                    ((simplex_category.δ (fin.cast_succ 0) ≫ simplex_category.σ 0) i'),
    refl,
    rw simplex_category.δ_comp_σ_self,
    transitivity (simplex_category.δ (fin.succ 0) ≫ simplex_category.σ 0)
                    (simplex_category.δ 0 i'),
    rw simplex_category.δ_comp_σ_succ, refl, refl },
  { transitivity (simplex_category.σ 0 ≫ simplex_category.δ j) i, refl,
    rw ← simplex_category.δ_comp_σ_of_gt,
    { refl },
    { apply lt_of_le_of_ne,
      apply fin.zero_le,
      apply ne.symm, dsimp,
      assumption } }
end

lemma sum_over_n_simplices_eq {G} [add_comm_monoid  G] (n : ℕ) (f : simplex_category.mk n → G) :
  finset.univ.sum f = (finset.filter (λ i : simplex_category.mk (n + 1), i ≠ 0) finset.univ).sum
                                     (λ j, f (simplex_category.σ 0 j)) :=
@finset.sum_bij' G (simplex_category.mk n) (simplex_category.mk (n + 1)) _
                 finset.univ
                 (finset.filter (λ i : simplex_category.mk (n + 1), i ≠ 0) finset.univ)
                 f
                 (λ i, f (simplex_category.σ 0 i))
                 (λ i _, simplex_category.δ 0 i)
                 (λ x h, finset.mem_filter.mpr ⟨finset.mem_univ _, coface_map_misses_output n 0 x⟩)
                 (λ x h, congr_arg f (by {
                   transitivity (simplex_category.δ (fin.cast_succ 0) ≫ simplex_category.σ 0) x,
                   { rw simplex_category.δ_comp_σ_self, refl },
                   { refl } }))
                 (λ j _, simplex_category.σ 0 j)
                 (λ j _, finset.mem_univ _)
                 (λ i h, by { transitivity (simplex_category.δ (fin.cast_succ 0)
                                            ≫ simplex_category.σ 0) i,
                              refl,
                              rw simplex_category.δ_comp_σ_self, refl })
                 (λ j h, by { dsimp,
                              simp at h,
                              exact succ_sigma_of_nonzero n j h })