/-
Copyright (c) 2019 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.module.equiv
import data.bracket
import linear_algebra.basic
import tactic.noncomm_ring

/-!
# Lie algebras

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

This file defines Lie rings and Lie algebras over a commutative ring together with their
modules, morphisms and equivalences, as well as various lemmas to make these definitions usable.

## Main definitions

  * `lie_ring`
  * `lie_algebra`
  * `lie_ring_module`
  * `lie_module`
  * `lie_hom`
  * `lie_equiv`
  * `lie_module_hom`
  * `lie_module_equiv`

## Notation

Working over a fixed commutative ring `R`, we introduce the notations:
 * `L →ₗ⁅R⁆ L'` for a morphism of Lie algebras,
 * `L ≃ₗ⁅R⁆ L'` for an equivalence of Lie algebras,
 * `M →ₗ⁅R,L⁆ N` for a morphism of Lie algebra modules `M`, `N` over a Lie algebra `L`,
 * `M ≃ₗ⁅R,L⁆ N` for an equivalence of Lie algebra modules `M`, `N` over a Lie algebra `L`.

## Implementation notes

Lie algebras are defined as modules with a compatible Lie ring structure and thus, like modules,
are partially unbundled.

## References
* [N. Bourbaki, *Lie Groups and Lie Algebras, Chapters 1--3*](bourbaki1975)

## Tags

lie bracket, jacobi identity, lie ring, lie algebra, lie module
-/

universes u v w w₁ w₂
open function

/-- A Lie ring is an additive group with compatible product, known as the bracket, satisfying the
Jacobi identity. -/
@[protect_proj] class lie_ring (L : Type v) extends add_comm_group L, has_bracket L L :=
(add_lie  : ∀ (x y z : L), ⁅x + y, z⁆ = ⁅x, z⁆ + ⁅y, z⁆)
(lie_add  : ∀ (x y z : L), ⁅x, y + z⁆ = ⁅x, y⁆ + ⁅x, z⁆)
(lie_self : ∀ (x : L), ⁅x, x⁆ = 0)
(leibniz_lie : ∀ (x y z : L), ⁅x, ⁅y, z⁆⁆ = ⁅⁅x, y⁆, z⁆ + ⁅y, ⁅x, z⁆⁆)

/-- A Lie algebra is a module with compatible product, known as the bracket, satisfying the Jacobi
identity. Forgetting the scalar multiplication, every Lie algebra is a Lie ring. -/
@[protect_proj] class lie_algebra (R : Type u) (L : Type v) [comm_ring R] [lie_ring L]
  extends module R L :=
(lie_smul : ∀ (t : R) (x y : L), ⁅x, t • y⁆ = t • ⁅x, y⁆)

/-- A Lie ring module is an additive group, together with an additive action of a
Lie ring on this group, such that the Lie bracket acts as the commutator of endomorphisms.
(For representations of Lie *algebras* see `lie_module`.) -/
@[protect_proj] class lie_ring_module (L : Type v) (M : Type w)
  [lie_ring L] [add_comm_group M] extends has_bracket L M :=
(add_lie     : ∀ (x y : L) (m : M), ⁅x + y, m⁆ = ⁅x, m⁆ + ⁅y, m⁆)
(lie_add     : ∀ (x : L) (m n : M), ⁅x, m + n⁆ = ⁅x, m⁆ + ⁅x, n⁆)
(leibniz_lie : ∀ (x y : L) (m : M), ⁅x, ⁅y, m⁆⁆ = ⁅⁅x, y⁆, m⁆ + ⁅y, ⁅x, m⁆⁆)

/-- A Lie module is a module over a commutative ring, together with a linear action of a Lie
algebra on this module, such that the Lie bracket acts as the commutator of endomorphisms. -/
@[protect_proj] class lie_module (R : Type u) (L : Type v) (M : Type w)
  [comm_ring R] [lie_ring L] [lie_algebra R L] [add_comm_group M] [module R M]
  [lie_ring_module L M] :=
(smul_lie : ∀ (t : R) (x : L) (m : M), ⁅t • x, m⁆ = t • ⁅x, m⁆)
(lie_smul : ∀ (t : R) (x : L) (m : M), ⁅x, t • m⁆ = t • ⁅x, m⁆)

section basic_properties

variables {R : Type u} {L : Type v} {M : Type w} {N : Type w₁}
variables [comm_ring R] [lie_ring L] [lie_algebra R L]
variables [add_comm_group M] [module R M] [lie_ring_module L M] [lie_module R L M]
variables [add_comm_group N] [module R N] [lie_ring_module L N] [lie_module R L N]
variables (t : R) (x y z : L) (m n : M)

@[simp] lemma add_lie : ⁅x + y, m⁆ = ⁅x, m⁆ + ⁅y, m⁆ := lie_ring_module.add_lie x y m

@[simp] lemma lie_add : ⁅x, m + n⁆ = ⁅x, m⁆ + ⁅x, n⁆ := lie_ring_module.lie_add x m n

@[simp] lemma smul_lie : ⁅t • x, m⁆ = t • ⁅x, m⁆ := lie_module.smul_lie t x m

@[simp] lemma lie_smul : ⁅x, t • m⁆ = t • ⁅x, m⁆ := lie_module.lie_smul t x m

lemma leibniz_lie : ⁅x, ⁅y, m⁆⁆ = ⁅⁅x, y⁆, m⁆ + ⁅y, ⁅x, m⁆⁆ := lie_ring_module.leibniz_lie x y m

@[simp] lemma lie_zero : ⁅x, 0⁆ = (0 : M) := (add_monoid_hom.mk' _ (lie_add x)).map_zero

@[simp] lemma zero_lie : ⁅(0 : L), m⁆ = 0 :=
(add_monoid_hom.mk' (λ (x : L), ⁅x, m⁆) (λ x y, add_lie x y m)).map_zero

@[simp] lemma lie_self : ⁅x, x⁆ = 0 := lie_ring.lie_self x

instance lie_ring_self_module : lie_ring_module L L := { ..(infer_instance : lie_ring L) }

@[simp] lemma lie_skew : -⁅y, x⁆ = ⁅x, y⁆ :=
have h : ⁅x + y, x⁆ + ⁅x + y, y⁆ = 0, { rw ← lie_add, apply lie_self, },
by simpa [neg_eq_iff_add_eq_zero] using h

/-- Every Lie algebra is a module over itself. -/
instance lie_algebra_self_module : lie_module R L L :=
{ smul_lie := λ t x m, by rw [←lie_skew, ←lie_skew x m, lie_algebra.lie_smul, smul_neg],
  lie_smul := by apply lie_algebra.lie_smul, }

@[simp] lemma neg_lie : ⁅-x, m⁆ = -⁅x, m⁆ :=
by { rw [←sub_eq_zero, sub_neg_eq_add, ←add_lie], simp, }

@[simp] lemma lie_neg : ⁅x, -m⁆ = -⁅x, m⁆ :=
by { rw [←sub_eq_zero, sub_neg_eq_add, ←lie_add], simp, }

@[simp] lemma sub_lie : ⁅x - y, m⁆ = ⁅x, m⁆ - ⁅y, m⁆ :=
by simp [sub_eq_add_neg]

@[simp] lemma lie_sub : ⁅x, m - n⁆ = ⁅x, m⁆ - ⁅x, n⁆ :=
by simp [sub_eq_add_neg]

@[simp] lemma nsmul_lie (n : ℕ) : ⁅n • x, m⁆ = n • ⁅x, m⁆ :=
add_monoid_hom.map_nsmul ⟨λ (x : L), ⁅x, m⁆, zero_lie m, λ _ _, add_lie _ _ _⟩ _ _

@[simp] lemma lie_nsmul (n : ℕ) : ⁅x, n • m⁆ = n • ⁅x, m⁆ :=
add_monoid_hom.map_nsmul ⟨λ (m : M), ⁅x, m⁆, lie_zero x, λ _ _, lie_add _ _ _⟩ _ _

@[simp] lemma zsmul_lie (a : ℤ) : ⁅a • x, m⁆ = a • ⁅x, m⁆ :=
add_monoid_hom.map_zsmul ⟨λ (x : L), ⁅x, m⁆, zero_lie m, λ _ _, add_lie _ _ _⟩ _ _

@[simp] lemma lie_zsmul (a : ℤ) : ⁅x, a • m⁆ = a • ⁅x, m⁆ :=
add_monoid_hom.map_zsmul ⟨λ (m : M), ⁅x, m⁆, lie_zero x, λ _ _, lie_add _ _ _⟩ _ _

@[simp] lemma lie_lie : ⁅⁅x, y⁆, m⁆ = ⁅x, ⁅y, m⁆⁆ - ⁅y, ⁅x, m⁆⁆ :=
by rw [leibniz_lie, add_sub_cancel]

lemma lie_jacobi : ⁅x, ⁅y, z⁆⁆ + ⁅y, ⁅z, x⁆⁆ + ⁅z, ⁅x, y⁆⁆ = 0 :=
by { rw [← neg_neg ⁅x, y⁆, lie_neg z, lie_skew y x, ← lie_skew, lie_lie], abel, }

instance lie_ring.int_lie_algebra : lie_algebra ℤ L :=
{ lie_smul := λ n x y, lie_zsmul x y n, }

instance : lie_ring_module L (M →ₗ[R] N) :=
{ bracket     := λ x f,
  { to_fun    := λ m, ⁅x, f m⁆ - f ⁅x, m⁆,
    map_add'  := λ m n, by { simp only [lie_add, linear_map.map_add], abel, },
    map_smul' := λ t m, by simp only [smul_sub, linear_map.map_smul, lie_smul, ring_hom.id_apply] },
  add_lie     := λ x y f, by
    { ext n, simp only [add_lie, linear_map.coe_mk, linear_map.add_apply, linear_map.map_add],
      abel, },
  lie_add     := λ x f g, by
    { ext n, simp only [linear_map.coe_mk, lie_add, linear_map.add_apply], abel, },
  leibniz_lie := λ x y f, by
    { ext n,
      simp only [lie_lie, linear_map.coe_mk, linear_map.map_sub, linear_map.add_apply, lie_sub],
      abel, }, }

@[simp] lemma lie_hom.lie_apply (f : M →ₗ[R] N) (x : L) (m : M) :
  ⁅x, f⁆ m = ⁅x, f m⁆ - f ⁅x, m⁆ :=
rfl

instance : lie_module R L (M →ₗ[R] N) :=
{ smul_lie := λ t x f, by
    { ext n,
      simp only [smul_sub, smul_lie, linear_map.smul_apply, lie_hom.lie_apply,
        linear_map.map_smul], },
  lie_smul := λ t x f, by
    { ext n, simp only [smul_sub, linear_map.smul_apply, lie_hom.lie_apply, lie_smul], }, }

end basic_properties

/-- A morphism of Lie algebras is a linear map respecting the bracket operations. -/
structure lie_hom (R : Type u) (L : Type v) (L' : Type w)
  [comm_ring R] [lie_ring L] [lie_algebra R L] [lie_ring L'] [lie_algebra R L']
  extends L →ₗ[R] L' :=
(map_lie' : ∀ {x y : L}, to_fun ⁅x, y⁆ = ⁅to_fun x, to_fun y⁆)

attribute [nolint doc_blame] lie_hom.to_linear_map

notation L ` →ₗ⁅`:25 R:25 `⁆ `:0 L':0 := lie_hom R L L'

namespace lie_hom

variables {R : Type u} {L₁ : Type v} {L₂ : Type w} {L₃ : Type w₁}
variables [comm_ring R]
variables [lie_ring L₁] [lie_algebra R L₁]
variables [lie_ring L₂] [lie_algebra R L₂]
variables [lie_ring L₃] [lie_algebra R L₃]

instance : has_coe (L₁ →ₗ⁅R⁆ L₂) (L₁ →ₗ[R] L₂) := ⟨lie_hom.to_linear_map⟩

/-- see Note [function coercion] -/
instance : has_coe_to_fun (L₁ →ₗ⁅R⁆ L₂) (λ _, L₁ → L₂) := ⟨λ f, f.to_linear_map.to_fun⟩

/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
  because it is a composition of multiple projections. -/
def simps.apply (h : L₁ →ₗ⁅R⁆ L₂) : L₁ → L₂ := h

initialize_simps_projections lie_hom (to_linear_map_to_fun → apply)

@[simp, norm_cast] lemma coe_to_linear_map (f : L₁ →ₗ⁅R⁆ L₂) : ((f : L₁ →ₗ[R] L₂) : L₁ → L₂) = f :=
rfl

@[simp] lemma to_fun_eq_coe (f : L₁ →ₗ⁅R⁆ L₂) : f.to_fun = ⇑f := rfl

@[simp] lemma map_smul (f : L₁ →ₗ⁅R⁆ L₂) (c : R) (x : L₁) : f (c • x) = c • f x :=
linear_map.map_smul (f : L₁ →ₗ[R] L₂) c x

@[simp] lemma map_add (f : L₁ →ₗ⁅R⁆ L₂) (x y : L₁) : f (x + y) = (f x) + (f y) :=
linear_map.map_add (f : L₁ →ₗ[R] L₂) x y

@[simp] lemma map_sub (f : L₁ →ₗ⁅R⁆ L₂) (x y : L₁) : f (x - y) = (f x) - (f y) :=
linear_map.map_sub (f : L₁ →ₗ[R] L₂) x y

@[simp] lemma map_neg (f : L₁ →ₗ⁅R⁆ L₂) (x : L₁) : f (-x) = -(f x) :=
linear_map.map_neg (f : L₁ →ₗ[R] L₂) x

@[simp] lemma map_lie (f : L₁ →ₗ⁅R⁆ L₂) (x y : L₁) : f ⁅x, y⁆ = ⁅f x, f y⁆ := lie_hom.map_lie' f

@[simp] lemma map_zero (f : L₁ →ₗ⁅R⁆ L₂) : f 0 = 0 := (f : L₁ →ₗ[R] L₂).map_zero

/-- The identity map is a morphism of Lie algebras. -/
def id : L₁ →ₗ⁅R⁆ L₁ :=
{ map_lie' := λ x y, rfl,
  .. (linear_map.id : L₁ →ₗ[R] L₁) }

@[simp] lemma coe_id : ((id : L₁ →ₗ⁅R⁆ L₁) : L₁ → L₁) = _root_.id := rfl

lemma id_apply (x : L₁) : (id : L₁ →ₗ⁅R⁆ L₁) x = x := rfl

/-- The constant 0 map is a Lie algebra morphism. -/
instance : has_zero (L₁ →ₗ⁅R⁆ L₂) := ⟨{ map_lie' := by simp, ..(0 : L₁ →ₗ[R] L₂)}⟩

@[norm_cast, simp] lemma coe_zero : ((0 : L₁ →ₗ⁅R⁆ L₂) : L₁ → L₂) = 0 := rfl

lemma zero_apply (x : L₁) : (0 : L₁ →ₗ⁅R⁆ L₂) x = 0 := rfl

/-- The identity map is a Lie algebra morphism. -/
instance : has_one (L₁ →ₗ⁅R⁆ L₁) := ⟨id⟩

@[simp] lemma coe_one : ((1 : (L₁ →ₗ⁅R⁆ L₁)) : L₁ → L₁) = _root_.id := rfl

lemma one_apply (x : L₁) : (1 : (L₁ →ₗ⁅R⁆ L₁)) x = x := rfl

instance : inhabited (L₁ →ₗ⁅R⁆ L₂) := ⟨0⟩

lemma coe_injective : @function.injective (L₁ →ₗ⁅R⁆ L₂) (L₁ → L₂) coe_fn :=
by rintro ⟨⟨f, _⟩⟩ ⟨⟨g, _⟩⟩ ⟨h⟩; congr

@[ext] lemma ext {f g : L₁ →ₗ⁅R⁆ L₂} (h : ∀ x, f x = g x) : f = g :=
coe_injective $ funext h

lemma ext_iff {f g : L₁ →ₗ⁅R⁆ L₂} : f = g ↔ ∀ x, f x = g x :=
⟨by { rintro rfl x, refl }, ext⟩

lemma congr_fun {f g : L₁ →ₗ⁅R⁆ L₂} (h : f = g) (x : L₁) : f x = g x := h ▸ rfl

@[simp] lemma mk_coe (f : L₁ →ₗ⁅R⁆ L₂) (h₁ h₂ h₃) :
  (⟨⟨f, h₁, h₂⟩, h₃⟩ : L₁ →ₗ⁅R⁆ L₂) = f :=
by { ext, refl, }

@[simp] lemma coe_mk (f : L₁ → L₂) (h₁ h₂ h₃) :
  ((⟨⟨f, h₁, h₂⟩, h₃⟩ : L₁ →ₗ⁅R⁆ L₂) : L₁ → L₂) = f := rfl

/-- The composition of morphisms is a morphism. -/
def comp (f : L₂ →ₗ⁅R⁆ L₃) (g : L₁ →ₗ⁅R⁆ L₂) : L₁ →ₗ⁅R⁆ L₃ :=
{ map_lie' := λ x y, by { change f (g ⁅x, y⁆) = ⁅f (g x), f (g y)⁆, rw [map_lie, map_lie], },
  ..linear_map.comp f.to_linear_map g.to_linear_map }

lemma comp_apply (f : L₂ →ₗ⁅R⁆ L₃) (g : L₁ →ₗ⁅R⁆ L₂) (x : L₁) :
  f.comp g x = f (g x) := rfl

@[norm_cast, simp]
lemma coe_comp (f : L₂ →ₗ⁅R⁆ L₃) (g : L₁ →ₗ⁅R⁆ L₂) :
  (f.comp g : L₁ → L₃) = f ∘ g :=
rfl

@[norm_cast, simp]
lemma coe_linear_map_comp (f : L₂ →ₗ⁅R⁆ L₃) (g : L₁ →ₗ⁅R⁆ L₂) :
  (f.comp g : L₁ →ₗ[R] L₃) = (f : L₂ →ₗ[R] L₃).comp (g : L₁ →ₗ[R] L₂) :=
rfl

@[simp] lemma comp_id (f : L₁ →ₗ⁅R⁆ L₂) : f.comp (id : L₁ →ₗ⁅R⁆ L₁) = f :=
by { ext, refl, }

@[simp] lemma id_comp (f : L₁ →ₗ⁅R⁆ L₂) : (id : L₂ →ₗ⁅R⁆ L₂).comp f = f :=
by { ext, refl, }

/-- The inverse of a bijective morphism is a morphism. -/
def inverse (f : L₁ →ₗ⁅R⁆ L₂) (g : L₂ → L₁)
  (h₁ : function.left_inverse g f) (h₂ : function.right_inverse g f) : L₂ →ₗ⁅R⁆ L₁ :=
{ map_lie' := λ x y,
  calc g ⁅x, y⁆ = g ⁅f (g x), f (g y)⁆ : by { conv_lhs { rw [←h₂ x, ←h₂ y], }, }
            ... = g (f ⁅g x, g y⁆) : by rw map_lie
            ... = ⁅g x, g y⁆ : (h₁ _),
  ..linear_map.inverse f.to_linear_map g h₁ h₂ }

end lie_hom

section module_pull_back

variables {R : Type u} {L₁ : Type v} {L₂ : Type w} (M : Type w₁)
variables [comm_ring R]  [lie_ring L₁] [lie_algebra R L₁] [lie_ring L₂] [lie_algebra R L₂]
variables [add_comm_group M] [lie_ring_module L₂ M]
variables (f : L₁ →ₗ⁅R⁆ L₂)
include f

/-- A Lie ring module may be pulled back along a morphism of Lie algebras.

See note [reducible non-instances]. -/
@[reducible]
def lie_ring_module.comp_lie_hom : lie_ring_module L₁ M :=
{ bracket     := λ x m, ⁅f x, m⁆,
  lie_add     := λ x, lie_add (f x),
  add_lie     := λ x y m, by simp only [lie_hom.map_add, add_lie],
  leibniz_lie := λ x y m, by simp only [lie_lie, sub_add_cancel, lie_hom.map_lie], }

lemma lie_ring_module.comp_lie_hom_apply (x : L₁) (m : M) :
  by haveI := lie_ring_module.comp_lie_hom M f; exact
  ⁅x, m⁆ = ⁅f x, m⁆ :=
rfl

/-- A Lie module may be pulled back along a morphism of Lie algebras.

See note [reducible non-instances]. -/
@[reducible]
def lie_module.comp_lie_hom [module R M] [lie_module R L₂ M] :
  @lie_module R L₁ M _ _ _ _ _ (lie_ring_module.comp_lie_hom M f) :=
{ smul_lie := λ t x m, by simp only [smul_lie, lie_hom.map_smul],
  lie_smul := λ t x m, by simp only [lie_smul], }

end module_pull_back

/-- An equivalence of Lie algebras is a morphism which is also a linear equivalence. We could
instead define an equivalence to be a morphism which is also a (plain) equivalence. However it is
more convenient to define via linear equivalence to get `.to_linear_equiv` for free. -/
structure lie_equiv (R : Type u) (L : Type v) (L' : Type w)
  [comm_ring R] [lie_ring L] [lie_algebra R L] [lie_ring L'] [lie_algebra R L']
  extends L →ₗ⁅R⁆ L' :=
(inv_fun   : L' → L)
(left_inv  : function.left_inverse inv_fun to_lie_hom.to_fun)
(right_inv : function.right_inverse inv_fun to_lie_hom.to_fun)

attribute [nolint doc_blame] lie_equiv.to_lie_hom

notation L ` ≃ₗ⁅`:50 R `⁆ ` L' := lie_equiv R L L'

namespace lie_equiv

variables {R : Type u} {L₁ : Type v} {L₂ : Type w} {L₃ : Type w₁}
variables [comm_ring R] [lie_ring L₁] [lie_ring L₂] [lie_ring L₃]
variables [lie_algebra R L₁] [lie_algebra R L₂] [lie_algebra R L₃]

/-- Consider an equivalence of Lie algebras as a linear equivalence. -/
def to_linear_equiv (f : L₁ ≃ₗ⁅R⁆ L₂) : L₁ ≃ₗ[R] L₂ := { ..f.to_lie_hom, ..f }

instance has_coe_to_lie_hom : has_coe (L₁ ≃ₗ⁅R⁆ L₂) (L₁ →ₗ⁅R⁆ L₂) := ⟨to_lie_hom⟩
instance has_coe_to_linear_equiv : has_coe (L₁ ≃ₗ⁅R⁆ L₂) (L₁ ≃ₗ[R] L₂) := ⟨to_linear_equiv⟩

/-- see Note [function coercion] -/
instance : has_coe_to_fun (L₁ ≃ₗ⁅R⁆ L₂) (λ _, L₁ → L₂) := ⟨λ e, e.to_lie_hom.to_fun⟩

@[simp, norm_cast] lemma coe_to_lie_hom (e : L₁ ≃ₗ⁅R⁆ L₂) : ((e : L₁ →ₗ⁅R⁆ L₂) : L₁ → L₂) = e :=
rfl

@[simp, norm_cast] lemma coe_to_linear_equiv (e : L₁ ≃ₗ⁅R⁆ L₂) :
  ((e : L₁ ≃ₗ[R] L₂) : L₁ → L₂) = e := rfl

@[simp] lemma to_linear_equiv_mk (f : L₁ →ₗ⁅R⁆ L₂) (g h₁ h₂) :
  (mk f g h₁ h₂ : L₁ ≃ₗ[R] L₂) = { inv_fun := g, left_inv := h₁, right_inv := h₂, .. f } := rfl

lemma coe_linear_equiv_injective : injective (coe : (L₁ ≃ₗ⁅R⁆ L₂) → (L₁ ≃ₗ[R] L₂)) :=
begin
  intros f₁ f₂ h, cases f₁, cases f₂, dsimp at h, simp only at h,
  congr, exacts [lie_hom.coe_injective h.1, h.2]
end

lemma coe_injective : @injective (L₁ ≃ₗ⁅R⁆ L₂) (L₁ → L₂) coe_fn :=
linear_equiv.coe_injective.comp coe_linear_equiv_injective

@[ext] lemma ext {f g : L₁ ≃ₗ⁅R⁆ L₂} (h : ∀ x, f x = g x) : f = g := coe_injective $ funext h

instance : has_one (L₁ ≃ₗ⁅R⁆ L₁) :=
⟨{ map_lie' := λ x y, rfl,
  ..(1 : L₁ ≃ₗ[R] L₁)}⟩

@[simp] lemma one_apply (x : L₁) : (1 : (L₁ ≃ₗ⁅R⁆ L₁)) x = x := rfl

instance : inhabited (L₁ ≃ₗ⁅R⁆ L₁) := ⟨1⟩

/-- Lie algebra equivalences are reflexive. -/
@[refl]
def refl : L₁ ≃ₗ⁅R⁆ L₁ := 1

@[simp] lemma refl_apply (x : L₁) : (refl : L₁ ≃ₗ⁅R⁆ L₁) x = x := rfl

/-- Lie algebra equivalences are symmetric. -/
@[symm]
def symm (e : L₁ ≃ₗ⁅R⁆ L₂) : L₂ ≃ₗ⁅R⁆ L₁ :=
{ ..lie_hom.inverse e.to_lie_hom e.inv_fun e.left_inv e.right_inv,
  ..e.to_linear_equiv.symm }

@[simp] lemma symm_symm (e : L₁ ≃ₗ⁅R⁆ L₂) : e.symm.symm = e :=
by { ext, refl }

@[simp] lemma apply_symm_apply (e : L₁ ≃ₗ⁅R⁆ L₂) : ∀ x, e (e.symm x) = x :=
  e.to_linear_equiv.apply_symm_apply

@[simp] lemma symm_apply_apply (e : L₁ ≃ₗ⁅R⁆ L₂) : ∀ x, e.symm (e x) = x :=
  e.to_linear_equiv.symm_apply_apply

@[simp]

/-- Lie algebra equivalences are transitive. -/
@[trans]
def trans (e₁ : L₁ ≃ₗ⁅R⁆ L₂) (e₂ : L₂ ≃ₗ⁅R⁆ L₃) : L₁ ≃ₗ⁅R⁆ L₃ :=
{ ..lie_hom.comp e₂.to_lie_hom e₁.to_lie_hom,
  ..linear_equiv.trans e₁.to_linear_equiv e₂.to_linear_equiv }

@[simp] lemma self_trans_symm (e : L₁ ≃ₗ⁅R⁆ L₂) : e.trans e.symm = refl :=
ext e.symm_apply_apply

@[simp] lemma symm_trans_self (e : L₁ ≃ₗ⁅R⁆ L₂) : e.symm.trans e = refl :=
e.symm.self_trans_symm

@[simp] lemma trans_apply (e₁ : L₁ ≃ₗ⁅R⁆ L₂) (e₂ : L₂ ≃ₗ⁅R⁆ L₃) (x : L₁) :
  (e₁.trans e₂) x = e₂ (e₁ x) := rfl

@[simp] lemma symm_trans (e₁ : L₁ ≃ₗ⁅R⁆ L₂) (e₂ : L₂ ≃ₗ⁅R⁆ L₃) :
  (e₁.trans e₂).symm = e₂.symm.trans e₁.symm := rfl

protected lemma bijective (e : L₁ ≃ₗ⁅R⁆ L₂) : function.bijective ((e : L₁ →ₗ⁅R⁆ L₂) : L₁ → L₂) :=
e.to_linear_equiv.bijective

protected lemma injective (e : L₁ ≃ₗ⁅R⁆ L₂) : function.injective ((e : L₁ →ₗ⁅R⁆ L₂) : L₁ → L₂) :=
e.to_linear_equiv.injective

protected lemma surjective (e : L₁ ≃ₗ⁅R⁆ L₂) : function.surjective ((e : L₁ →ₗ⁅R⁆ L₂) : L₁ → L₂) :=
e.to_linear_equiv.surjective

/-- A bijective morphism of Lie algebras yields an equivalence of Lie algebras. -/
@[simps] noncomputable def of_bijective (f : L₁ →ₗ⁅R⁆ L₂)
  (h : function.bijective f) : L₁ ≃ₗ⁅R⁆ L₂ :=
{ to_fun   := f,
  map_lie' := f.map_lie,
  .. (linear_equiv.of_bijective (f : L₁ →ₗ[R] L₂) h), }

end lie_equiv

section lie_module_morphisms

variables (R : Type u) (L : Type v) (M : Type w) (N : Type w₁) (P : Type w₂)
variables [comm_ring R] [lie_ring L] [lie_algebra R L]
variables [add_comm_group M] [add_comm_group N] [add_comm_group P]
variables [module R M] [module R N] [module R P]
variables [lie_ring_module L M] [lie_ring_module L N] [lie_ring_module L P]
variables [lie_module R L M] [lie_module R L N] [lie_module R L P]

/-- A morphism of Lie algebra modules is a linear map which commutes with the action of the Lie
algebra. -/
structure lie_module_hom extends M →ₗ[R] N :=
(map_lie' : ∀ {x : L} {m : M}, to_fun ⁅x, m⁆ = ⁅x, to_fun m⁆)

attribute [nolint doc_blame] lie_module_hom.to_linear_map

notation M ` →ₗ⁅`:25 R,L:25 `⁆ `:0 N:0 := lie_module_hom R L M N

namespace lie_module_hom

variables {R L M N P}

instance : has_coe (M →ₗ⁅R,L⁆ N) (M →ₗ[R] N) := ⟨lie_module_hom.to_linear_map⟩

/-- see Note [function coercion] -/
instance : has_coe_to_fun (M →ₗ⁅R,L⁆ N) (λ _, M → N) := ⟨λ f, f.to_linear_map.to_fun⟩

@[simp, norm_cast] lemma coe_to_linear_map (f : M →ₗ⁅R,L⁆ N) : ((f : M →ₗ[R] N) : M → N) = f :=
rfl

@[simp] lemma map_smul (f : M →ₗ⁅R,L⁆ N) (c : R) (x : M) : f (c • x) = c • f x :=
linear_map.map_smul (f : M →ₗ[R] N) c x

@[simp] lemma map_add (f : M →ₗ⁅R,L⁆ N) (x y : M) : f (x + y) = (f x) + (f y) :=
linear_map.map_add (f : M →ₗ[R] N) x y

@[simp] lemma map_sub (f : M →ₗ⁅R,L⁆ N) (x y : M) : f (x - y) = (f x) - (f y) :=
linear_map.map_sub (f : M →ₗ[R] N) x y

@[simp] lemma map_neg (f : M →ₗ⁅R,L⁆ N) (x : M) : f (-x) = -(f x) :=
linear_map.map_neg (f : M →ₗ[R] N) x

@[simp] lemma map_lie (f : M →ₗ⁅R,L⁆ N) (x : L) (m : M) : f ⁅x, m⁆ = ⁅x, f m⁆ :=
lie_module_hom.map_lie' f

lemma map_lie₂ (f : M →ₗ⁅R,L⁆ N →ₗ[R] P) (x : L) (m : M) (n : N) :
  ⁅x, f m n⁆ = f ⁅x, m⁆ n + f m ⁅x, n⁆ :=
by simp only [sub_add_cancel, map_lie, lie_hom.lie_apply]

@[simp] lemma map_zero (f : M →ₗ⁅R,L⁆ N) : f 0 = 0 :=
linear_map.map_zero (f : M →ₗ[R] N)

/-- The identity map is a morphism of Lie modules. -/
def id : M →ₗ⁅R,L⁆ M :=
{ map_lie' := λ x m, rfl,
  .. (linear_map.id : M →ₗ[R] M) }

@[simp] lemma coe_id : ((id : M →ₗ⁅R,L⁆ M) : M → M) = _root_.id := rfl

lemma id_apply (x : M) : (id : M →ₗ⁅R,L⁆ M) x = x := rfl

/-- The constant 0 map is a Lie module morphism. -/
instance : has_zero (M →ₗ⁅R,L⁆ N) := ⟨{ map_lie' := by simp, ..(0 : M →ₗ[R] N) }⟩

@[norm_cast, simp] lemma coe_zero : ((0 : M →ₗ⁅R,L⁆ N) : M → N) = 0 := rfl

lemma zero_apply (m : M) : (0 : M →ₗ⁅R,L⁆ N) m = 0 := rfl

/-- The identity map is a Lie module morphism. -/
instance : has_one (M →ₗ⁅R,L⁆ M) := ⟨id⟩

instance : inhabited (M →ₗ⁅R,L⁆ N) := ⟨0⟩

lemma coe_injective : @function.injective (M →ₗ⁅R,L⁆ N) (M → N) coe_fn :=
by { rintros ⟨⟨f, _⟩⟩ ⟨⟨g, _⟩⟩ ⟨h⟩, congr, }

@[ext] lemma ext {f g : M →ₗ⁅R,L⁆ N} (h : ∀ m, f m = g m) : f = g :=
coe_injective $ funext h

lemma ext_iff {f g : M →ₗ⁅R,L⁆ N} : f = g ↔ ∀ m, f m = g m :=
⟨by { rintro rfl m, refl, }, ext⟩

lemma congr_fun {f g : M →ₗ⁅R,L⁆ N} (h : f = g) (x : M) : f x = g x := h ▸ rfl

@[simp] lemma mk_coe (f : M →ₗ⁅R,L⁆ N) (h) :
  (⟨f, h⟩ : M →ₗ⁅R,L⁆ N) = f :=
by { ext, refl, }

@[simp] lemma coe_mk (f : M →ₗ[R] N) (h) :
  ((⟨f, h⟩ : M →ₗ⁅R,L⁆ N) : M → N) = f :=
by { ext, refl, }

@[norm_cast, simp] lemma coe_linear_mk (f : M →ₗ[R] N) (h) :
  ((⟨f, h⟩ : M →ₗ⁅R,L⁆ N) : M →ₗ[R] N) = f :=
by { ext, refl, }

/-- The composition of Lie module morphisms is a morphism. -/
def comp (f : N →ₗ⁅R,L⁆ P) (g : M →ₗ⁅R,L⁆ N) : M →ₗ⁅R,L⁆ P :=
{ map_lie' := λ x m, by { change f (g ⁅x, m⁆) = ⁅x, f (g m)⁆, rw [map_lie, map_lie], },
  ..linear_map.comp f.to_linear_map g.to_linear_map }

lemma comp_apply (f : N →ₗ⁅R,L⁆ P) (g : M →ₗ⁅R,L⁆ N) (m : M) :
  f.comp g m = f (g m) := rfl

@[norm_cast, simp] lemma coe_comp (f : N →ₗ⁅R,L⁆ P) (g : M →ₗ⁅R,L⁆ N) :
  (f.comp g : M → P) = f ∘ g :=
rfl

@[norm_cast, simp] lemma coe_linear_map_comp (f : N →ₗ⁅R,L⁆ P) (g : M →ₗ⁅R,L⁆ N) :
  (f.comp g : M →ₗ[R] P) = (f : N →ₗ[R] P).comp (g : M →ₗ[R] N) :=
rfl

/-- The inverse of a bijective morphism of Lie modules is a morphism of Lie modules. -/
def inverse (f : M →ₗ⁅R,L⁆ N) (g : N → M)
  (h₁ : function.left_inverse g f) (h₂ : function.right_inverse g f) : N →ₗ⁅R,L⁆ M :=
{ map_lie' := λ x n,
    calc g ⁅x, n⁆ = g ⁅x, f (g n)⁆ : by rw h₂
              ... = g (f ⁅x, g n⁆) : by rw map_lie
              ... = ⁅x, g n⁆ : (h₁ _),
  ..linear_map.inverse f.to_linear_map g h₁ h₂ }

instance : has_add (M →ₗ⁅R,L⁆ N) :=
{ add := λ f g, { map_lie' := by simp, ..((f : M →ₗ[R] N) + (g : M →ₗ[R] N)) }, }

instance : has_sub (M →ₗ⁅R,L⁆ N) :=
{ sub := λ f g, { map_lie' := by simp, ..((f : M →ₗ[R] N) - (g : M →ₗ[R] N)) }, }

instance : has_neg (M →ₗ⁅R,L⁆ N) :=
{ neg := λ f, { map_lie' := by simp, ..(-(f : (M →ₗ[R] N))) }, }

@[norm_cast, simp] lemma coe_add (f g : M →ₗ⁅R,L⁆ N) : ⇑(f + g) = f + g := rfl

lemma add_apply (f g : M →ₗ⁅R,L⁆ N) (m : M) : (f + g) m = f m + g m := rfl

@[norm_cast, simp] lemma coe_sub (f g : M →ₗ⁅R,L⁆ N) : ⇑(f - g) = f - g := rfl

lemma sub_apply (f g : M →ₗ⁅R,L⁆ N) (m : M) : (f - g) m = f m - g m := rfl

@[norm_cast, simp] lemma coe_neg (f : M →ₗ⁅R,L⁆ N) : ⇑(-f) = -f := rfl

lemma neg_apply (f : M →ₗ⁅R,L⁆ N) (m : M) : (-f) m = -(f m) := rfl

instance has_nsmul : has_smul ℕ (M →ₗ⁅R,L⁆ N) :=
{ smul := λ n f, { map_lie' := λ x m, by simp, ..(n • (f : M →ₗ[R] N)) } }

@[norm_cast, simp] lemma coe_nsmul (n : ℕ) (f : M →ₗ⁅R,L⁆ N) : ⇑(n • f) = n • f := rfl

lemma nsmul_apply (n : ℕ) (f : M →ₗ⁅R,L⁆ N) (m : M) : (n • f) m = n • f m := rfl

instance has_zsmul : has_smul ℤ (M →ₗ⁅R,L⁆ N) :=
{ smul := λ z f, { map_lie' := λ x m, by simp, ..(z • (f : M →ₗ[R] N)) } }

@[norm_cast, simp] lemma coe_zsmul (z : ℤ) (f : M →ₗ⁅R,L⁆ N) : ⇑(z • f) = z • f := rfl

lemma zsmul_apply (z : ℤ) (f : M →ₗ⁅R,L⁆ N) (m : M) : (z • f) m = z • f m := rfl

instance : add_comm_group (M →ₗ⁅R,L⁆ N) :=
coe_injective.add_comm_group _
  coe_zero coe_add coe_neg coe_sub (λ _ _, coe_nsmul _ _) (λ _ _, coe_zsmul _ _)

instance : has_smul R (M →ₗ⁅R,L⁆ N) :=
{ smul := λ t f, { map_lie' := by simp, ..(t • (f : M →ₗ[R] N)) }, }

@[norm_cast, simp] lemma coe_smul (t : R) (f : M →ₗ⁅R,L⁆ N) : ⇑(t • f) = t • f := rfl

lemma smul_apply (t : R) (f : M →ₗ⁅R,L⁆ N) (m : M) : (t • f) m = t • (f m) := rfl

instance : module R (M →ₗ⁅R,L⁆ N) :=
function.injective.module R ⟨λ f, f.to_linear_map.to_fun, rfl, coe_add⟩ coe_injective coe_smul

end lie_module_hom

/-- An equivalence of Lie algebra modules is a linear equivalence which is also a morphism of
Lie algebra modules. -/
structure lie_module_equiv extends M →ₗ⁅R,L⁆ N :=
(inv_fun   : N → M)
(left_inv  : function.left_inverse inv_fun to_fun)
(right_inv : function.right_inverse inv_fun to_fun)

attribute [nolint doc_blame] lie_module_equiv.to_lie_module_hom

notation M ` ≃ₗ⁅`:25 R,L:25 `⁆ `:0 N:0 := lie_module_equiv R L M N

namespace lie_module_equiv

variables {R L M N P}

/-- View an equivalence of Lie modules as a linear equivalence. -/
@[ancestor]
def to_linear_equiv (e : M ≃ₗ⁅R,L⁆ N) : M ≃ₗ[R] N := { ..e }

/-- View an equivalence of Lie modules as a type level equivalence. -/
@[ancestor]
def to_equiv (e : M ≃ₗ⁅R,L⁆ N) : M ≃ N := { ..e }

instance has_coe_to_equiv : has_coe (M ≃ₗ⁅R,L⁆ N) (M ≃ N) := ⟨to_equiv⟩
instance has_coe_to_lie_module_hom : has_coe (M ≃ₗ⁅R,L⁆ N) (M →ₗ⁅R,L⁆ N) := ⟨to_lie_module_hom⟩
instance has_coe_to_linear_equiv : has_coe (M ≃ₗ⁅R,L⁆ N) (M ≃ₗ[R] N) := ⟨to_linear_equiv⟩

/-- see Note [function coercion] -/
instance : has_coe_to_fun (M ≃ₗ⁅R,L⁆ N) (λ _, M → N) := ⟨λ e, e.to_lie_module_hom.to_fun⟩

lemma injective (e : M ≃ₗ⁅R,L⁆ N) : function.injective e := e.to_equiv.injective

@[simp] lemma coe_mk (f : M →ₗ⁅R,L⁆ N) (inv_fun h₁ h₂) :
  ((⟨f, inv_fun, h₁, h₂⟩ : M ≃ₗ⁅R,L⁆ N) : M → N) = f := rfl

@[simp, norm_cast] lemma coe_to_lie_module_hom (e : M ≃ₗ⁅R,L⁆ N) :
  ((e : M →ₗ⁅R,L⁆ N) : M → N) = e := rfl

@[simp, norm_cast] lemma coe_to_linear_equiv (e : M ≃ₗ⁅R,L⁆ N) : ((e : M ≃ₗ[R] N) : M → N) = e :=
rfl

lemma to_equiv_injective : function.injective (to_equiv : (M ≃ₗ⁅R,L⁆ N) → M ≃ N) :=
λ e₁ e₂ h, begin
  rcases e₁ with ⟨⟨⟩⟩, rcases e₂ with ⟨⟨⟩⟩,
  have inj := equiv.mk.inj h,
  dsimp at inj,
  apply lie_module_equiv.mk.inj_eq.mpr,
  split,
  { congr,
    ext,
    rw inj.1 },
  { exact inj.2 },
end

@[ext] lemma ext (e₁ e₂ : M ≃ₗ⁅R,L⁆ N) (h : ∀ m, e₁ m = e₂ m) : e₁ = e₂ :=
to_equiv_injective (equiv.ext h)

instance : has_one (M ≃ₗ⁅R,L⁆ M) := ⟨{ map_lie' := λ x m, rfl, ..(1 : M ≃ₗ[R] M) }⟩

@[simp] lemma one_apply (m : M) : (1 : (M ≃ₗ⁅R,L⁆ M)) m = m := rfl

instance : inhabited (M ≃ₗ⁅R,L⁆ M) := ⟨1⟩

/-- Lie module equivalences are reflexive. -/
@[refl] def refl : M ≃ₗ⁅R,L⁆ M := 1

@[simp] lemma refl_apply (m : M) : (refl : M ≃ₗ⁅R,L⁆ M) m = m := rfl

/-- Lie module equivalences are syemmtric. -/
@[symm] def symm (e : M ≃ₗ⁅R,L⁆ N) : N ≃ₗ⁅R,L⁆ M :=
{ ..lie_module_hom.inverse e.to_lie_module_hom e.inv_fun e.left_inv e.right_inv,
  ..(e : M ≃ₗ[R] N).symm }

@[simp] lemma apply_symm_apply (e : M ≃ₗ⁅R,L⁆ N) : ∀ x, e (e.symm x) = x :=
  e.to_linear_equiv.apply_symm_apply

@[simp] lemma symm_apply_apply (e : M ≃ₗ⁅R,L⁆ N) : ∀ x, e.symm (e x) = x :=
  e.to_linear_equiv.symm_apply_apply

@[simp] lemma symm_symm (e : M ≃ₗ⁅R,L⁆ N) : e.symm.symm = e :=
by { ext, apply_fun e.symm using e.symm.injective, simp, }

/-- Lie module equivalences are transitive. -/
@[trans] def trans (e₁ : M ≃ₗ⁅R,L⁆ N) (e₂ : N ≃ₗ⁅R,L⁆ P) : M ≃ₗ⁅R,L⁆ P :=
{ ..lie_module_hom.comp e₂.to_lie_module_hom e₁.to_lie_module_hom,
  ..linear_equiv.trans e₁.to_linear_equiv e₂.to_linear_equiv }

@[simp] lemma trans_apply (e₁ : M ≃ₗ⁅R,L⁆ N) (e₂ : N ≃ₗ⁅R,L⁆ P) (m : M) :
  (e₁.trans e₂) m = e₂ (e₁ m) := rfl

@[simp] lemma symm_trans (e₁ : M ≃ₗ⁅R,L⁆ N) (e₂ : N ≃ₗ⁅R,L⁆ P) :
  (e₁.trans e₂).symm = e₂.symm.trans e₁.symm := rfl

@[simp] lemma self_trans_symm (e : M ≃ₗ⁅R,L⁆ N) : e.trans e.symm = refl :=
ext _ _ e.symm_apply_apply

@[simp] lemma symm_trans_self (e : M ≃ₗ⁅R,L⁆ N) : e.symm.trans e = refl :=
ext _ _ e.apply_symm_apply

end lie_module_equiv

end lie_module_morphisms


/-
Copyright (c) 2021 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang

! This file was ported from Lean 3 source module algebraic_geometry.presheafed_space.gluing
! leanprover-community/mathlib commit d39590fc8728fbf6743249802486f8c91ffe07bc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Gluing
import Mathbin.AlgebraicGeometry.OpenImmersion
import Mathbin.AlgebraicGeometry.LocallyRingedSpace.HasColimits

/-!
# Gluing Structured spaces

Given a family of gluing data of structured spaces (presheafed spaces, sheafed spaces, or locally
ringed spaces), we may glue them together.

The construction should be "sealed" and considered as a black box, while only using the API
provided.

## Main definitions

* `algebraic_geometry.PresheafedSpace.glue_data`: A structure containing the family of gluing data.
* `category_theory.glue_data.glued`: The glued presheafed space.
    This is defined as the multicoequalizer of `∐ V i j ⇉ ∐ U i`, so that the general colimit API
    can be used.
* `category_theory.glue_data.ι`: The immersion `ι i : U i ⟶ glued` for each `i : J`.

## Main results

* `algebraic_geometry.PresheafedSpace.glue_data.ι_is_open_immersion`: The map `ι i : U i ⟶ glued`
  is an open immersion for each `i : J`.
* `algebraic_geometry.PresheafedSpace.glue_data.ι_jointly_surjective` : The underlying maps of
  `ι i : U i ⟶ glued` are jointly surjective.
* `algebraic_geometry.PresheafedSpace.glue_data.V_pullback_cone_is_limit` : `V i j` is the pullback
  (intersection) of `U i` and `U j` over the glued space.

Analogous results are also provided for `SheafedSpace` and `LocallyRingedSpace`.

## Implementation details

Almost the whole file is dedicated to showing tht `ι i` is an open immersion. The fact that
this is an open embedding of topological spaces follows from `topology.gluing.lean`, and it remains
to construct `Γ(𝒪_{U_i}, U) ⟶ Γ(𝒪_X, ι i '' U)` for each `U ⊆ U i`.
Since `Γ(𝒪_X, ι i '' U)` is the the limit of `diagram_over_open`, the components of the structure
sheafs of the spaces in the gluing diagram, we need to construct a map
`ι_inv_app_π_app : Γ(𝒪_{U_i}, U) ⟶ Γ(𝒪_V, U_V)` for each `V` in the gluing diagram.

We will refer to ![this diagram](https://i.imgur.com/P0phrwr.png) in the following doc strings.
The `X` is the glued space, and the dotted arrow is a partial inverse guaranteed by the fact
that it is an open immersion. The map `Γ(𝒪_{U_i}, U) ⟶ Γ(𝒪_{U_j}, _)` is given by the composition
of the red arrows, and the map `Γ(𝒪_{U_i}, U) ⟶ Γ(𝒪_{V_{jk}}, _)` is given by the composition of the
blue arrows. To lift this into a map from `Γ(𝒪_X, ι i '' U)`, we also need to show that these
commute with the maps in the diagram (the green arrows), which is just a lengthy diagram-chasing.

-/

noncomputable section

open TopologicalSpace CategoryTheory Opposite

open CategoryTheory.Limits AlgebraicGeometry.PresheafedSpace

open CategoryTheory.GlueData

namespace AlgebraicGeometry

universe v u

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

namespace PresheafedSpace

/-- A family of gluing data consists of
1. An index type `J`
2. A presheafed space `U i` for each `i : J`.
3. A presheafed space `V i j` for each `i j : J`.
  (Note that this is `J × J → PresheafedSpace C` rather than `J → J → PresheafedSpace C` to
  connect to the limits library easier.)
4. An open immersion `f i j : V i j ⟶ U i` for each `i j : ι`.
5. A transition map `t i j : V i j ⟶ V j i` for each `i j : ι`.
such that
6. `f i i` is an isomorphism.
7. `t i i` is the identity.
8. `V i j ×[U i] V i k ⟶ V i j ⟶ V j i` factors through `V j k ×[U j] V j i ⟶ V j i` via some
    `t' : V i j ×[U i] V i k ⟶ V j k ×[U j] V j i`.
9. `t' i j k ≫ t' j k i ≫ t' k i j = 𝟙 _`.

We can then glue the spaces `U i` together by identifying `V i j` with `V j i`, such
that the `U i`'s are open subspaces of the glued space.
-/
@[nolint has_nonempty_instance]
structure GlueData extends GlueData (PresheafedSpace.{v} C) where
  f_open : ∀ i j, IsOpenImmersion (f i j)
#align algebraic_geometry.PresheafedSpace.glue_data AlgebraicGeometry.PresheafedSpace.GlueData

attribute [instance] glue_data.f_open

namespace GlueData

variable {C} (D : GlueData C)

-- mathport name: «expr𝖣»
local notation "𝖣" => D.toGlueData

-- mathport name: «exprπ₁ , , »
local notation "π₁ " i ", " j ", " k => @pullback.fst _ _ _ _ _ (D.f i j) (D.f i k) _

-- mathport name: «exprπ₂ , , »
local notation "π₂ " i ", " j ", " k => @pullback.snd _ _ _ _ _ (D.f i j) (D.f i k) _

-- mathport name: «exprπ₁⁻¹ , , »
local notation "π₁⁻¹ " i ", " j ", " k =>
  (PresheafedSpace.IsOpenImmersion.pullbackFstOfRight (D.f i j) (D.f i k)).invApp

-- mathport name: «exprπ₂⁻¹ , , »
local notation "π₂⁻¹ " i ", " j ", " k =>
  (PresheafedSpace.IsOpenImmersion.pullbackSndOfLeft (D.f i j) (D.f i k)).invApp

/-- The glue data of topological spaces associated to a family of glue data of PresheafedSpaces. -/
abbrev toTopGlueData : TopCat.GlueData :=
  { f_open := fun i j => (D.f_open i j).base_open
    toGlueData := 𝖣.mapGlueData (forget C) }
#align algebraic_geometry.PresheafedSpace.glue_data.to_Top_glue_data AlgebraicGeometry.PresheafedSpace.GlueData.toTopGlueData

theorem ι_openEmbedding [HasLimits C] (i : D.J) : OpenEmbedding (𝖣.ι i).base :=
  by
  rw [← show _ = (𝖣.ι i).base from 𝖣.ι_gluedIso_inv (PresheafedSpace.forget _) _]
  exact
    OpenEmbedding.comp
      (TopCat.homeoOfIso (𝖣.gluedIso (PresheafedSpace.forget _)).symm).OpenEmbedding
      (D.to_Top_glue_data.ι_open_embedding i)
#align algebraic_geometry.PresheafedSpace.glue_data.ι_open_embedding AlgebraicGeometry.PresheafedSpace.GlueData.ι_openEmbedding

theorem pullback_base (i j k : D.J) (S : Set (D.V (i, j)).carrier) :
    (π₂ i, j, k) '' ((π₁ i, j, k) ⁻¹' S) = D.f i k ⁻¹' (D.f i j '' S) :=
  by
  have eq₁ : _ = (π₁ i, j, k).base := preserves_pullback.iso_hom_fst (forget C) _ _
  have eq₂ : _ = (π₂ i, j, k).base := preserves_pullback.iso_hom_snd (forget C) _ _
  rw [coe_to_fun_eq, coe_to_fun_eq, ← eq₁, ← eq₂, coe_comp, Set.image_comp, coe_comp,
    Set.preimage_comp, Set.image_preimage_eq, TopCat.pullback_snd_image_fst_preimage]
  rfl
  rw [← TopCat.epi_iff_surjective]
  infer_instance
#align algebraic_geometry.PresheafedSpace.glue_data.pullback_base AlgebraicGeometry.PresheafedSpace.GlueData.pullback_base

/-- The red and the blue arrows in ![this diagram](https://i.imgur.com/0GiBUh6.png) commute. -/
@[simp, reassoc.1]
theorem f_invApp_f_app (i j k : D.J) (U : Opens (D.V (i, j)).carrier) :
    (D.f_open i j).invApp U ≫ (D.f i k).c.app _ =
      (π₁ i, j, k).c.app (op U) ≫
        (π₂⁻¹ i, j, k) (unop _) ≫
          (D.V _).Presheaf.map
            (eqToHom
              (by
                delta is_open_immersion.open_functor
                dsimp only [functor.op, IsOpenMap.functor, opens.map, unop_op]
                congr
                apply pullback_base)) :=
  by
  have := PresheafedSpace.congr_app (@pullback.condition _ _ _ _ _ (D.f i j) (D.f i k) _)
  dsimp only [comp_c_app] at this
  rw [← cancel_epi (inv ((D.f_open i j).invApp U)), is_iso.inv_hom_id_assoc,
    is_open_immersion.inv_inv_app]
  simp_rw [category.assoc]
  erw [(π₁ i, j, k).c.naturality_assoc, reassoc_of this, ← functor.map_comp_assoc,
    is_open_immersion.inv_naturality_assoc, is_open_immersion.app_inv_app_assoc, ←
    (D.V (i, k)).Presheaf.map_comp, ← (D.V (i, k)).Presheaf.map_comp]
  convert(category.comp_id _).symm
  erw [(D.V (i, k)).Presheaf.map_id]
  rfl
#align algebraic_geometry.PresheafedSpace.glue_data.f_inv_app_f_app AlgebraicGeometry.PresheafedSpace.GlueData.f_invApp_f_app

/-- We can prove the `eq` along with the lemma. Thus this is bundled together here, and the
lemma itself is separated below.
-/
theorem snd_invApp_t_app' (i j k : D.J) (U : Opens (pullback (D.f i j) (D.f i k)).carrier) :
    ∃ eq,
      (π₂⁻¹ i, j, k) U ≫ (D.t k i).c.app _ ≫ (D.V (k, i)).Presheaf.map (eqToHom Eq) =
        (D.t' k i j).c.app _ ≫ (π₁⁻¹ k, j, i) (unop _) :=
  by
  constructor
  rw [← is_iso.eq_inv_comp, is_open_immersion.inv_inv_app, category.assoc,
    (D.t' k i j).c.naturality_assoc]
  simp_rw [← category.assoc]
  erw [← comp_c_app]
  rw [congr_app (D.t_fac k i j), comp_c_app]
  simp_rw [category.assoc]
  erw [is_open_immersion.inv_naturality, is_open_immersion.inv_naturality_assoc,
    is_open_immersion.app_inv_app'_assoc]
  simp_rw [← (𝖣.V (k, i)).Presheaf.map_comp, eq_to_hom_map (functor.op _), eq_to_hom_op,
    eq_to_hom_trans]
  rintro x ⟨y, hy, eq⟩
  replace eq := concrete_category.congr_arg (𝖣.t i k).base Eq
  change ((π₂ i, j, k) ≫ D.t i k).base y = (D.t k i ≫ D.t i k).base x at eq
  rw [𝖣.t_inv, id_base, TopCat.id_app] at eq
  subst Eq
  use (inv (D.t' k i j)).base y
  change (inv (D.t' k i j) ≫ π₁ k, i, j).base y = _
  congr 2
  rw [is_iso.inv_comp_eq, 𝖣.t_fac_assoc, 𝖣.t_inv, category.comp_id]
#align algebraic_geometry.PresheafedSpace.glue_data.snd_inv_app_t_app' AlgebraicGeometry.PresheafedSpace.GlueData.snd_invApp_t_app'

/-- The red and the blue arrows in ![this diagram](https://i.imgur.com/q6X1GJ9.png) commute. -/
@[simp, reassoc.1]
theorem snd_invApp_t_app (i j k : D.J) (U : Opens (pullback (D.f i j) (D.f i k)).carrier) :
    (π₂⁻¹ i, j, k) U ≫ (D.t k i).c.app _ =
      (D.t' k i j).c.app _ ≫
        (π₁⁻¹ k, j, i) (unop _) ≫
          (D.V (k, i)).Presheaf.map (eqToHom (D.snd_invApp_t_app' i j k U).some.symm) :=
  by
  have e := (D.snd_inv_app_t_app' i j k U).choose_spec
  reassoc! e
  rw [← e]
  simp [eq_to_hom_map]
#align algebraic_geometry.PresheafedSpace.glue_data.snd_inv_app_t_app AlgebraicGeometry.PresheafedSpace.GlueData.snd_invApp_t_app

variable [HasLimits C]

theorem ι_image_preimage_eq (i j : D.J) (U : Opens (D.U i).carrier) :
    (Opens.map (𝖣.ι j).base).obj ((D.ι_openEmbedding i).IsOpenMap.Functor.obj U) =
      (D.f_open j i).openFunctor.obj
        ((Opens.map (𝖣.t j i).base).obj ((Opens.map (𝖣.f i j).base).obj U)) :=
  by
  ext1
  dsimp only [opens.map_coe, IsOpenMap.functor_obj_coe]
  rw [← show _ = (𝖣.ι i).base from 𝖣.ι_gluedIso_inv (PresheafedSpace.forget _) i, ←
    show _ = (𝖣.ι j).base from 𝖣.ι_gluedIso_inv (PresheafedSpace.forget _) j, coe_comp, coe_comp,
    Set.image_comp, Set.preimage_comp, Set.preimage_image_eq]
  refine' Eq.trans (D.to_Top_glue_data.preimage_image_eq_image' _ _ _) _
  rw [coe_comp, Set.image_comp]
  congr 1
  erw [Set.eq_preimage_iff_image_eq]
  rw [← Set.image_comp]
  change (D.t i j ≫ D.t j i).base '' _ = _
  rw [𝖣.t_inv]
  · simp
  · change Function.Bijective (TopCat.homeoOfIso (as_iso _))
    exact Homeomorph.bijective _
    infer_instance
  · rw [← TopCat.mono_iff_injective]
    infer_instance
#align algebraic_geometry.PresheafedSpace.glue_data.ι_image_preimage_eq AlgebraicGeometry.PresheafedSpace.GlueData.ι_image_preimage_eq

/-- (Implementation). The map `Γ(𝒪_{U_i}, U) ⟶ Γ(𝒪_{U_j}, 𝖣.ι j ⁻¹' (𝖣.ι i '' U))` -/
def opensImagePreimageMap (i j : D.J) (U : Opens (D.U i).carrier) :
    (D.U i).Presheaf.obj (op U) ⟶ (D.U j).Presheaf.obj _ :=
  (D.f i j).c.app (op U) ≫
    (D.t j i).c.app _ ≫
      (D.f_open j i).invApp (unop _) ≫
        (𝖣.U j).Presheaf.map (eqToHom (D.ι_image_preimage_eq i j U)).op
#align algebraic_geometry.PresheafedSpace.glue_data.opens_image_preimage_map AlgebraicGeometry.PresheafedSpace.GlueData.opensImagePreimageMap

theorem opensImagePreimageMap_app' (i j k : D.J) (U : Opens (D.U i).carrier) :
    ∃ eq,
      D.opensImagePreimageMap i j U ≫ (D.f j k).c.app _ =
        ((π₁ j, i, k) ≫ D.t j i ≫ D.f i j).c.app (op U) ≫
          (π₂⁻¹ j, i, k) (unop _) ≫ (D.V (j, k)).Presheaf.map (eqToHom Eq) :=
  by
  constructor
  delta opens_image_preimage_map
  simp_rw [category.assoc]
  rw [(D.f j k).c.naturality, f_inv_app_f_app_assoc]
  erw [← (D.V (j, k)).Presheaf.map_comp]
  simp_rw [← category.assoc]
  erw [← comp_c_app, ← comp_c_app]
  simp_rw [category.assoc]
  dsimp only [functor.op, unop_op, Quiver.Hom.unop_op]
  rw [eq_to_hom_map (opens.map _), eq_to_hom_op, eq_to_hom_trans]
  congr
#align algebraic_geometry.PresheafedSpace.glue_data.opens_image_preimage_map_app' AlgebraicGeometry.PresheafedSpace.GlueData.opensImagePreimageMap_app'

/-- The red and the blue arrows in ![this diagram](https://i.imgur.com/mBzV1Rx.png) commute. -/
theorem opensImagePreimageMap_app (i j k : D.J) (U : Opens (D.U i).carrier) :
    D.opensImagePreimageMap i j U ≫ (D.f j k).c.app _ =
      ((π₁ j, i, k) ≫ D.t j i ≫ D.f i j).c.app (op U) ≫
        (π₂⁻¹ j, i, k) (unop _) ≫
          (D.V (j, k)).Presheaf.map (eqToHom (opensImagePreimageMap_app' D i j k U).some) :=
  (opensImagePreimageMap_app' D i j k U).choose_spec
#align algebraic_geometry.PresheafedSpace.glue_data.opens_image_preimage_map_app AlgebraicGeometry.PresheafedSpace.GlueData.opensImagePreimageMap_app

-- This is proved separately since `reassoc` somehow timeouts.
theorem opensImagePreimageMap_app_assoc (i j k : D.J) (U : Opens (D.U i).carrier) {X' : C}
    (f' : _ ⟶ X') :
    D.opensImagePreimageMap i j U ≫ (D.f j k).c.app _ ≫ f' =
      ((π₁ j, i, k) ≫ D.t j i ≫ D.f i j).c.app (op U) ≫
        (π₂⁻¹ j, i, k) (unop _) ≫
          (D.V (j, k)).Presheaf.map (eqToHom (opensImagePreimageMap_app' D i j k U).some) ≫ f' :=
  by
  simpa only [category.assoc] using
    congr_arg (fun g => g ≫ f') (opens_image_preimage_map_app D i j k U)
#align algebraic_geometry.PresheafedSpace.glue_data.opens_image_preimage_map_app_assoc AlgebraicGeometry.PresheafedSpace.GlueData.opensImagePreimageMap_app_assoc

/-- (Implementation) Given an open subset of one of the spaces `U ⊆ Uᵢ`, the sheaf component of
the image `ι '' U` in the glued space is the limit of this diagram. -/
abbrev diagramOverOpen {i : D.J} (U : Opens (D.U i).carrier) : (WalkingMultispan _ _)ᵒᵖ ⥤ C :=
  componentwiseDiagram 𝖣.diagram.multispan ((D.ι_openEmbedding i).IsOpenMap.Functor.obj U)
#align algebraic_geometry.PresheafedSpace.glue_data.diagram_over_open AlgebraicGeometry.PresheafedSpace.GlueData.diagramOverOpen

/-- (Implementation)
The projection from the limit of `diagram_over_open` to a component of `D.U j`. -/
abbrev diagramOverOpenπ {i : D.J} (U : Opens (D.U i).carrier) (j : D.J) :=
  limit.π (D.diagramOverOpen U) (op (WalkingMultispan.right j))
#align algebraic_geometry.PresheafedSpace.glue_data.diagram_over_open_π AlgebraicGeometry.PresheafedSpace.GlueData.diagramOverOpenπ

/-- (Implementation) We construct the map `Γ(𝒪_{U_i}, U) ⟶ Γ(𝒪_V, U_V)` for each `V` in the gluing
diagram. We will lift these maps into `ι_inv_app`. -/
def ιInvAppπApp {i : D.J} (U : Opens (D.U i).carrier) (j) :
    (𝖣.U i).Presheaf.obj (op U) ⟶ (D.diagramOverOpen U).obj (op j) :=
  by
  rcases j with (⟨j, k⟩ | j)
  · refine'
      D.opens_image_preimage_map i j U ≫ (D.f j k).c.app _ ≫ (D.V (j, k)).Presheaf.map (eq_to_hom _)
    rw [functor.op_obj]
    congr 1
    ext1
    dsimp only [functor.op_obj, opens.map_coe, unop_op, IsOpenMap.functor_obj_coe]
    rw [Set.preimage_preimage]
    change (D.f j k ≫ 𝖣.ι j).base ⁻¹' _ = _
    congr 3
    exact colimit.w 𝖣.diagram.multispan (walking_multispan.hom.fst (j, k))
  · exact D.opens_image_preimage_map i j U
#align algebraic_geometry.PresheafedSpace.glue_data.ι_inv_app_π_app AlgebraicGeometry.PresheafedSpace.GlueData.ιInvAppπApp

/-- (Implementation) The natural map `Γ(𝒪_{U_i}, U) ⟶ Γ(𝒪_X, 𝖣.ι i '' U)`.
This forms the inverse of `(𝖣.ι i).c.app (op U)`. -/
def ιInvApp {i : D.J} (U : Opens (D.U i).carrier) :
    (D.U i).Presheaf.obj (op U) ⟶ limit (D.diagramOverOpen U) :=
  limit.lift (D.diagramOverOpen U)
    { pt := (D.U i).Presheaf.obj (op U)
      π :=
        { app := fun j => D.ιInvAppπApp U (unop j)
          naturality' := fun X Y f' => by
            induction X using Opposite.rec
            induction Y using Opposite.rec
            let f : Y ⟶ X := f'.unop
            have : f' = f.op := rfl
            clear_value f
            subst this
            rcases f with (_ | ⟨j, k⟩ | ⟨j, k⟩)
            · erw [category.id_comp, CategoryTheory.Functor.map_id]
              rw [category.comp_id]
            · erw [category.id_comp]
              congr 1
            erw [category.id_comp]
            -- It remains to show that the blue is equal to red + green in the original diagram.
            -- The proof strategy is illustrated in ![this diagram](https://i.imgur.com/mBzV1Rx.png)
            -- where we prove red = pink = light-blue = green = blue.
            change
              D.opens_image_preimage_map i j U ≫
                  (D.f j k).c.app _ ≫ (D.V (j, k)).Presheaf.map (eq_to_hom _) =
                D.opens_image_preimage_map _ _ _ ≫
                  ((D.f k j).c.app _ ≫ (D.t j k).c.app _) ≫ (D.V (j, k)).Presheaf.map (eq_to_hom _)
            erw [opens_image_preimage_map_app_assoc]
            simp_rw [category.assoc]
            erw [opens_image_preimage_map_app_assoc, (D.t j k).c.naturality_assoc]
            rw [snd_inv_app_t_app_assoc]
            erw [← PresheafedSpace.comp_c_app_assoc]
            -- light-blue = green is relatively easy since the part that differs does not involve
            -- partial inverses.
            have :
              D.t' j k i ≫ (π₁ k, i, j) ≫ D.t k i ≫ 𝖣.f i k =
                (pullback_symmetry _ _).Hom ≫ (π₁ j, i, k) ≫ D.t j i ≫ D.f i j :=
              by
              rw [← 𝖣.t_fac_assoc, 𝖣.t'_comp_eq_pullbackSymmetry_assoc,
                pullback_symmetry_hom_comp_snd_assoc, pullback.condition, 𝖣.t_fac_assoc]
            rw [congr_app this]
            erw [PresheafedSpace.comp_c_app_assoc (pullback_symmetry _ _).Hom]
            simp_rw [category.assoc]
            congr 1
            rw [← is_iso.eq_inv_comp]
            erw [is_open_immersion.inv_inv_app]
            simp_rw [category.assoc]
            erw [nat_trans.naturality_assoc, ← PresheafedSpace.comp_c_app_assoc,
              congr_app (pullback_symmetry_hom_comp_snd _ _)]
            simp_rw [category.assoc]
            erw [is_open_immersion.inv_naturality_assoc, is_open_immersion.inv_naturality_assoc,
              is_open_immersion.inv_naturality_assoc, is_open_immersion.app_inv_app_assoc]
            repeat' erw [← (D.V (j, k)).Presheaf.map_comp]
            congr } }
#align algebraic_geometry.PresheafedSpace.glue_data.ι_inv_app AlgebraicGeometry.PresheafedSpace.GlueData.ιInvApp

/-- `ι_inv_app` is the left inverse of `D.ι i` on `U`. -/
theorem ιInvApp_π {i : D.J} (U : Opens (D.U i).carrier) :
    ∃ eq, D.ιInvApp U ≫ D.diagramOverOpenπ U i = (D.U i).Presheaf.map (eqToHom Eq) :=
  by
  constructor
  delta ι_inv_app
  rw [limit.lift_π]
  change D.opens_image_preimage_map i i U = _
  dsimp [opens_image_preimage_map]
  rw [congr_app (D.t_id _), id_c_app, ← functor.map_comp]
  erw [is_open_immersion.inv_naturality_assoc, is_open_immersion.app_inv_app'_assoc]
  simp only [eq_to_hom_op, eq_to_hom_trans, eq_to_hom_map (functor.op _), ← functor.map_comp]
  rw [set.range_iff_surjective.mpr _]
  · simp
  · rw [← TopCat.epi_iff_surjective]
    infer_instance
#align algebraic_geometry.PresheafedSpace.glue_data.ι_inv_app_π AlgebraicGeometry.PresheafedSpace.GlueData.ιInvApp_π

/-- The `eq_to_hom` given by `ι_inv_app_π`. -/
abbrev ιInvAppπEqMap {i : D.J} (U : Opens (D.U i).carrier) :=
  (D.U i).Presheaf.map (eqToIso (D.ιInvApp_π U).some).inv
#align algebraic_geometry.PresheafedSpace.glue_data.ι_inv_app_π_eq_map AlgebraicGeometry.PresheafedSpace.GlueData.ιInvAppπEqMap

/-- `ι_inv_app` is the right inverse of `D.ι i` on `U`. -/
theorem π_ιInvApp_π (i j : D.J) (U : Opens (D.U i).carrier) :
    D.diagramOverOpenπ U i ≫ D.ιInvAppπEqMap U ≫ D.ιInvApp U ≫ D.diagramOverOpenπ U j =
      D.diagramOverOpenπ U j :=
  by
  rw [←
    cancel_mono
      ((componentwise_diagram 𝖣.diagram.multispan _).map
          (Quiver.Hom.op (walking_multispan.hom.snd (i, j))) ≫
        𝟙 _)]
  simp_rw [category.assoc]
  rw [limit.w_assoc]
  erw [limit.lift_π_assoc]
  rw [category.comp_id, category.comp_id]
  change _ ≫ _ ≫ (_ ≫ _) ≫ _ = _
  rw [congr_app (D.t_id _), id_c_app]
  simp_rw [category.assoc]
  rw [← functor.map_comp_assoc, is_open_immersion.inv_naturality_assoc]
  erw [is_open_immersion.app_inv_app_assoc]
  iterate 3 rw [← functor.map_comp_assoc]
  rw [nat_trans.naturality_assoc]
  erw [← (D.V (i, j)).Presheaf.map_comp]
  convert limit.w (componentwise_diagram 𝖣.diagram.multispan _)
      (Quiver.Hom.op (walking_multispan.hom.fst (i, j)))
  · rw [category.comp_id]
    apply (config := { instances := false }) mono_comp
    change mono ((_ ≫ D.f j i).c.app _)
    rw [comp_c_app]
    apply (config := { instances := false }) mono_comp
    erw [D.ι_image_preimage_eq i j U]
    all_goals infer_instance
#align algebraic_geometry.PresheafedSpace.glue_data.π_ι_inv_app_π AlgebraicGeometry.PresheafedSpace.GlueData.π_ιInvApp_π

/-- `ι_inv_app` is the inverse of `D.ι i` on `U`. -/
theorem π_ιInvApp_eq_id (i : D.J) (U : Opens (D.U i).carrier) :
    D.diagramOverOpenπ U i ≫ D.ιInvAppπEqMap U ≫ D.ιInvApp U = 𝟙 _ :=
  by
  ext j
  induction j using Opposite.rec
  rcases j with (⟨j, k⟩ | ⟨j⟩)
  · rw [←
      limit.w (componentwise_diagram 𝖣.diagram.multispan _)
        (Quiver.Hom.op (walking_multispan.hom.fst (j, k))),
      ← category.assoc, category.id_comp]
    congr 1
    simp_rw [category.assoc]
    apply π_ι_inv_app_π
  · simp_rw [category.assoc]
    rw [category.id_comp]
    apply π_ι_inv_app_π
#align algebraic_geometry.PresheafedSpace.glue_data.π_ι_inv_app_eq_id AlgebraicGeometry.PresheafedSpace.GlueData.π_ιInvApp_eq_id

instance componentwise_diagram_π_isIso (i : D.J) (U : Opens (D.U i).carrier) :
    IsIso (D.diagramOverOpenπ U i) :=
  by
  use D.ι_inv_app_π_eq_map U ≫ D.ι_inv_app U
  constructor
  · apply π_ι_inv_app_eq_id
  · rw [category.assoc, (D.ι_inv_app_π _).choose_spec]
    exact iso.inv_hom_id ((D.to_glue_data.U i).Presheaf.mapIso (eq_to_iso _))
#align algebraic_geometry.PresheafedSpace.glue_data.componentwise_diagram_π_is_iso AlgebraicGeometry.PresheafedSpace.GlueData.componentwise_diagram_π_isIso

instance ιIsOpenImmersion (i : D.J) : IsOpenImmersion (𝖣.ι i)
    where
  base_open := D.ι_openEmbedding i
  c_iso U := by
    erw [← colimit_presheaf_obj_iso_componentwise_limit_hom_π]
    infer_instance
#align algebraic_geometry.PresheafedSpace.glue_data.ι_is_open_immersion AlgebraicGeometry.PresheafedSpace.GlueData.ιIsOpenImmersion

/-- The following diagram is a pullback, i.e. `Vᵢⱼ` is the intersection of `Uᵢ` and `Uⱼ` in `X`.

Vᵢⱼ ⟶ Uᵢ
 |      |
 ↓      ↓
 Uⱼ ⟶ X
-/
def vPullbackConeIsLimit (i j : D.J) : IsLimit (𝖣.vPullbackCone i j) :=
  PullbackCone.isLimitAux' _ fun s => by
    refine' ⟨_, _, _, _⟩
    · refine' PresheafedSpace.is_open_immersion.lift (D.f i j) s.fst _
      erw [← D.to_Top_glue_data.preimage_range j i]
      have :
        s.fst.base ≫ D.to_Top_glue_data.to_glue_data.ι i =
          s.snd.base ≫ D.to_Top_glue_data.to_glue_data.ι j :=
        by
        rw [← 𝖣.ι_gluedIso_hom (PresheafedSpace.forget _) _, ←
          𝖣.ι_gluedIso_hom (PresheafedSpace.forget _) _]
        have := congr_arg PresheafedSpace.hom.base s.condition
        rw [comp_base, comp_base] at this
        reassoc! this
        exact this _
      rw [← Set.image_subset_iff, ← Set.image_univ, ← Set.image_comp, Set.image_univ, ← coe_comp,
        this, coe_comp, ← Set.image_univ, Set.image_comp]
      exact Set.image_subset_range _ _
    · apply is_open_immersion.lift_fac
    · rw [← cancel_mono (𝖣.ι j), category.assoc, ← (𝖣.vPullbackCone i j).condition]
      conv_rhs => rw [← s.condition]
      erw [is_open_immersion.lift_fac_assoc]
    · intro m e₁ e₂
      rw [← cancel_mono (D.f i j)]
      erw [e₁]
      rw [is_open_immersion.lift_fac]
#align algebraic_geometry.PresheafedSpace.glue_data.V_pullback_cone_is_limit AlgebraicGeometry.PresheafedSpace.GlueData.vPullbackConeIsLimit

theorem ι_jointly_surjective (x : 𝖣.glued) : ∃ (i : D.J)(y : D.U i), (𝖣.ι i).base y = x :=
  𝖣.ι_jointly_surjective (PresheafedSpace.forget _ ⋙ CategoryTheory.forget TopCat) x
#align algebraic_geometry.PresheafedSpace.glue_data.ι_jointly_surjective AlgebraicGeometry.PresheafedSpace.GlueData.ι_jointly_surjective

end GlueData

end PresheafedSpace

namespace SheafedSpace

variable (C) [HasProducts.{v} C]

/-- A family of gluing data consists of
1. An index type `J`
2. A sheafed space `U i` for each `i : J`.
3. A sheafed space `V i j` for each `i j : J`.
  (Note that this is `J × J → SheafedSpace C` rather than `J → J → SheafedSpace C` to
  connect to the limits library easier.)
4. An open immersion `f i j : V i j ⟶ U i` for each `i j : ι`.
5. A transition map `t i j : V i j ⟶ V j i` for each `i j : ι`.
such that
6. `f i i` is an isomorphism.
7. `t i i` is the identity.
8. `V i j ×[U i] V i k ⟶ V i j ⟶ V j i` factors through `V j k ×[U j] V j i ⟶ V j i` via some
    `t' : V i j ×[U i] V i k ⟶ V j k ×[U j] V j i`.
9. `t' i j k ≫ t' j k i ≫ t' k i j = 𝟙 _`.

We can then glue the spaces `U i` together by identifying `V i j` with `V j i`, such
that the `U i`'s are open subspaces of the glued space.
-/
@[nolint has_nonempty_instance]
structure GlueData extends GlueData (SheafedSpace.{v} C) where
  f_open : ∀ i j, SheafedSpace.IsOpenImmersion (f i j)
#align algebraic_geometry.SheafedSpace.glue_data AlgebraicGeometry.SheafedSpace.GlueData

attribute [instance] glue_data.f_open

namespace GlueData

variable {C} (D : GlueData C)

-- mathport name: «expr𝖣»
local notation "𝖣" => D.toGlueData

/-- The glue data of presheafed spaces associated to a family of glue data of sheafed spaces. -/
abbrev toPresheafedSpaceGlueData : PresheafedSpace.GlueData C :=
  { f_open := D.f_open
    toGlueData := 𝖣.mapGlueData forgetToPresheafedSpace }
#align algebraic_geometry.SheafedSpace.glue_data.to_PresheafedSpace_glue_data AlgebraicGeometry.SheafedSpace.GlueData.toPresheafedSpaceGlueData

variable [HasLimits C]

/-- The gluing as sheafed spaces is isomorphic to the gluing as presheafed spaces. -/
abbrev isoPresheafedSpace :
    𝖣.glued.toPresheafedSpace ≅ D.toPresheafedSpaceGlueData.toGlueData.glued :=
  𝖣.gluedIso forgetToPresheafedSpace
#align algebraic_geometry.SheafedSpace.glue_data.iso_PresheafedSpace AlgebraicGeometry.SheafedSpace.GlueData.isoPresheafedSpace

theorem ι_isoPresheafedSpace_inv (i : D.J) :
    D.toPresheafedSpaceGlueData.toGlueData.ι i ≫ D.isoPresheafedSpace.inv = 𝖣.ι i :=
  𝖣.ι_gluedIso_inv _ _
#align algebraic_geometry.SheafedSpace.glue_data.ι_iso_PresheafedSpace_inv AlgebraicGeometry.SheafedSpace.GlueData.ι_isoPresheafedSpace_inv

instance ι_isOpenImmersion (i : D.J) : IsOpenImmersion (𝖣.ι i) :=
  by
  rw [← D.ι_iso_PresheafedSpace_inv]
  infer_instance
#align algebraic_geometry.SheafedSpace.glue_data.ι_is_open_immersion AlgebraicGeometry.SheafedSpace.GlueData.ι_isOpenImmersion

theorem ι_jointly_surjective (x : 𝖣.glued) : ∃ (i : D.J)(y : D.U i), (𝖣.ι i).base y = x :=
  𝖣.ι_jointly_surjective (SheafedSpace.forget _ ⋙ CategoryTheory.forget TopCat) x
#align algebraic_geometry.SheafedSpace.glue_data.ι_jointly_surjective AlgebraicGeometry.SheafedSpace.GlueData.ι_jointly_surjective

/-- The following diagram is a pullback, i.e. `Vᵢⱼ` is the intersection of `Uᵢ` and `Uⱼ` in `X`.

Vᵢⱼ ⟶ Uᵢ
 |      |
 ↓      ↓
 Uⱼ ⟶ X
-/
def vPullbackConeIsLimit (i j : D.J) : IsLimit (𝖣.vPullbackCone i j) :=
  𝖣.vPullbackConeIsLimitOfMap forgetToPresheafedSpace i j
    (D.toPresheafedSpaceGlueData.vPullbackConeIsLimit _ _)
#align algebraic_geometry.SheafedSpace.glue_data.V_pullback_cone_is_limit AlgebraicGeometry.SheafedSpace.GlueData.vPullbackConeIsLimit

end GlueData

end SheafedSpace

namespace LocallyRingedSpace

/-- A family of gluing data consists of
1. An index type `J`
2. A locally ringed space `U i` for each `i : J`.
3. A locally ringed space `V i j` for each `i j : J`.
  (Note that this is `J × J → LocallyRingedSpace` rather than `J → J → LocallyRingedSpace` to
  connect to the limits library easier.)
4. An open immersion `f i j : V i j ⟶ U i` for each `i j : ι`.
5. A transition map `t i j : V i j ⟶ V j i` for each `i j : ι`.
such that
6. `f i i` is an isomorphism.
7. `t i i` is the identity.
8. `V i j ×[U i] V i k ⟶ V i j ⟶ V j i` factors through `V j k ×[U j] V j i ⟶ V j i` via some
    `t' : V i j ×[U i] V i k ⟶ V j k ×[U j] V j i`.
9. `t' i j k ≫ t' j k i ≫ t' k i j = 𝟙 _`.

We can then glue the spaces `U i` together by identifying `V i j` with `V j i`, such
that the `U i`'s are open subspaces of the glued space.
-/
@[nolint has_nonempty_instance]
structure GlueData extends GlueData LocallyRingedSpace where
  f_open : ∀ i j, LocallyRingedSpace.IsOpenImmersion (f i j)
#align algebraic_geometry.LocallyRingedSpace.glue_data AlgebraicGeometry.LocallyRingedSpace.GlueData

attribute [instance] glue_data.f_open

namespace GlueData

variable (D : GlueData)

-- mathport name: «expr𝖣»
local notation "𝖣" => D.toGlueData

/-- The glue data of ringed spaces associated to a family of glue data of locally ringed spaces. -/
abbrev toSheafedSpaceGlueData : SheafedSpace.GlueData CommRingCat :=
  { f_open := D.f_open
    toGlueData := 𝖣.mapGlueData forgetToSheafedSpace }
#align algebraic_geometry.LocallyRingedSpace.glue_data.to_SheafedSpace_glue_data AlgebraicGeometry.LocallyRingedSpace.GlueData.toSheafedSpaceGlueData

/-- The gluing as locally ringed spaces is isomorphic to the gluing as ringed spaces. -/
abbrev isoSheafedSpace : 𝖣.glued.toSheafedSpace ≅ D.toSheafedSpaceGlueData.toGlueData.glued :=
  𝖣.gluedIso forgetToSheafedSpace
#align algebraic_geometry.LocallyRingedSpace.glue_data.iso_SheafedSpace AlgebraicGeometry.LocallyRingedSpace.GlueData.isoSheafedSpace

theorem ι_isoSheafedSpace_inv (i : D.J) :
    D.toSheafedSpaceGlueData.toGlueData.ι i ≫ D.isoSheafedSpace.inv = (𝖣.ι i).1 :=
  𝖣.ι_gluedIso_inv forgetToSheafedSpace i
#align algebraic_geometry.LocallyRingedSpace.glue_data.ι_iso_SheafedSpace_inv AlgebraicGeometry.LocallyRingedSpace.GlueData.ι_isoSheafedSpace_inv

instance ι_isOpenImmersion (i : D.J) : IsOpenImmersion (𝖣.ι i) :=
  by
  delta is_open_immersion
  rw [← D.ι_iso_SheafedSpace_inv]
  apply PresheafedSpace.is_open_immersion.comp
#align algebraic_geometry.LocallyRingedSpace.glue_data.ι_is_open_immersion AlgebraicGeometry.LocallyRingedSpace.GlueData.ι_isOpenImmersion

instance (i j k : D.J) : PreservesLimit (cospan (𝖣.f i j) (𝖣.f i k)) forgetToSheafedSpace :=
  inferInstance

theorem ι_jointly_surjective (x : 𝖣.glued) : ∃ (i : D.J)(y : D.U i), (𝖣.ι i).1.base y = x :=
  𝖣.ι_jointly_surjective
    ((LocallyRingedSpace.forgetToSheafedSpace ⋙ SheafedSpace.forget _) ⋙ forget TopCat) x
#align algebraic_geometry.LocallyRingedSpace.glue_data.ι_jointly_surjective AlgebraicGeometry.LocallyRingedSpace.GlueData.ι_jointly_surjective

/-- The following diagram is a pullback, i.e. `Vᵢⱼ` is the intersection of `Uᵢ` and `Uⱼ` in `X`.

Vᵢⱼ ⟶ Uᵢ
 |      |
 ↓      ↓
 Uⱼ ⟶ X
-/
def vPullbackConeIsLimit (i j : D.J) : IsLimit (𝖣.vPullbackCone i j) :=
  𝖣.vPullbackConeIsLimitOfMap forgetToSheafedSpace i j
    (D.toSheafedSpaceGlueData.vPullbackConeIsLimit _ _)
#align algebraic_geometry.LocallyRingedSpace.glue_data.V_pullback_cone_is_limit AlgebraicGeometry.LocallyRingedSpace.GlueData.vPullbackConeIsLimit

end GlueData

end LocallyRingedSpace

end AlgebraicGeometry


/-
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 for_mathlib.dold_kan.split_simplicial_object

/-!

# Construction of the inverse functor of the Dold-Kan equivalence

In this file, we construct the functor `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`
which shall be the inverse functor of the Dold-Kan equivalence in the case of abelian categories,
and more generally pseudoabelian categories.

By definition, when `K` is a chain_complex, `Γ₀.obj K` is a simplicial object which
sends `Δ : simplex_categoryᵒᵖ` to a certain coproduct indexed by the set
`splitting.index_set Δ` whose elements consists of epimorphisms `e : Δ.unop ⟶ Δ'.unop`
(with `Δ' : simplex_categoryᵒᵖ`); the summand attached to such an `e` is `K.X Δ'.unop.len`.
By construction, `Γ₀.obj K` is a split simplicial object whose splitting is `Γ₀.splitting K`.

We also construct `Γ₂ : karoubi (chain_complex C ℕ) ⥤ karoubi (simplicial_object C)`
which shall be an equivalence for any additive category `C`.

-/

noncomputable theory

open category_theory category_theory.category category_theory.limits
  simplex_category simplicial_object opposite category_theory.idempotents
open_locale simplicial dold_kan

namespace algebraic_topology

namespace dold_kan

variables {C : Type*} [category C] [preadditive C] (K K' : chain_complex C ℕ) (f : K ⟶ K')
  {Δ'' Δ' Δ : simplex_category} (i' : Δ'' ⟶ Δ') [mono i'] (i : Δ' ⟶ Δ) [mono i]

/-- `is_δ₀ i` is a simple condition used to check whether a monomorphism `i` in
`simplex_category` identifies to the coface map `δ 0`. -/
@[nolint unused_arguments]
def is_δ₀ {Δ Δ' : simplex_category} (i : Δ' ⟶ Δ) [mono i] : Prop :=
(Δ.len = Δ'.len+1) ∧ (i.to_order_hom 0 ≠ 0)

namespace is_δ₀

lemma iff {j : ℕ} {i : fin (j+2)} : is_δ₀ (simplex_category.δ i) ↔ i = 0 :=
begin
  split,
  { rintro ⟨h₁, h₂⟩,
    by_contradiction,
    exact h₂ (fin.succ_above_ne_zero_zero h), },
  { rintro rfl,
    exact ⟨rfl, fin.succ_ne_zero _⟩, },
end

lemma eq_δ₀ {n : ℕ} {i : [n] ⟶ [n+1]} [mono i] (hi : is_δ₀ i) :
  i = simplex_category.δ 0 :=
begin
  unfreezingI { obtain ⟨j, rfl⟩ := simplex_category.eq_δ_of_mono i, },
  rw iff at hi,
  rw hi,
end

end is_δ₀

namespace Γ₀

namespace obj

/-- In the definition of `(Γ₀.obj K).obj Δ` as a direct sum indexed by `A : splitting.index_set Δ`,
the summand `summand K Δ A` is `K.X A.1.len`. -/
def summand (Δ : simplex_categoryᵒᵖ) (A : splitting.index_set Δ) : C := K.X A.1.unop.len

/-- The functor `Γ₀` sends a chain complex `K` to the simplicial object which
sends `Δ` to the direct sum of the objects `summand K Δ A` for all `A : splitting.index_set Δ` -/
def obj₂ (K : chain_complex C ℕ) (Δ : simplex_categoryᵒᵖ) [has_finite_coproducts C] : C :=
∐ (λ (A : splitting.index_set Δ), summand K Δ A)

namespace termwise

/-- A monomorphism `i : Δ' ⟶ Δ` induces a morphism `K.X Δ.len ⟶ K.X Δ'.len` which
is the identity if `Δ = Δ'`, the differential on the complex `K` if `i = δ 0`, and
zero otherwise. -/
def map_mono (K : chain_complex C ℕ) {Δ' Δ : simplex_category} (i : Δ' ⟶ Δ) [mono i] :
  K.X Δ.len ⟶ K.X Δ'.len :=
begin
  by_cases Δ = Δ',
  { exact eq_to_hom (by congr'), },
  { by_cases is_δ₀ i,
    { exact K.d Δ.len Δ'.len, },
    { exact 0, }, },
end

variable (Δ)

lemma map_mono_id : map_mono K (𝟙 Δ) = 𝟙 _ :=
by { unfold map_mono, simp only [eq_self_iff_true, eq_to_hom_refl, dite_eq_ite, if_true], }

variable {Δ}

lemma map_mono_δ₀' (hi : is_δ₀ i) : map_mono K i = K.d Δ.len Δ'.len :=
begin
  unfold map_mono,
  classical,
  rw [dif_neg, dif_pos hi],
  unfreezingI { rintro rfl, },
  simpa only [self_eq_add_right, nat.one_ne_zero] using hi.1,
end

@[simp]
lemma map_mono_δ₀ {n : ℕ} : map_mono K (δ (0 : fin (n+2))) = K.d (n+1) n :=
map_mono_δ₀' K _ (by rw is_δ₀.iff)

lemma map_mono_eq_zero (h₁ : Δ ≠ Δ') (h₂ : ¬is_δ₀ i) : map_mono K i = 0 :=
by { unfold map_mono, rw ne.def at h₁, split_ifs, refl, }

variables {K K'}

@[simp, reassoc]
lemma map_mono_naturality : map_mono K i ≫ f.f Δ'.len = f.f Δ.len ≫ map_mono K' i :=
begin
  unfold map_mono,
  split_ifs,
  { unfreezingI { subst h, },
    simp only [id_comp, eq_to_hom_refl, comp_id], },
  { rw homological_complex.hom.comm, },
  { rw [zero_comp, comp_zero], }
end

variable (K)

@[simp, reassoc]
lemma map_mono_comp : map_mono K i ≫ map_mono K i' = map_mono K (i' ≫ i) :=
begin
  /- case where i : Δ' ⟶ Δ is the identity -/
  by_cases h₁ : Δ = Δ',
  { unfreezingI { subst h₁, },
    simp only [simplex_category.eq_id_of_mono i,
      comp_id, id_comp, map_mono_id K, eq_to_hom_refl], },
  /- case where i' : Δ'' ⟶ Δ' is the identity -/
  by_cases h₂ : Δ' = Δ'',
  { unfreezingI { subst h₂, },
    simp only [simplex_category.eq_id_of_mono i',
      comp_id, id_comp, map_mono_id K, eq_to_hom_refl], },
  /- then the RHS is always zero -/
  obtain ⟨k, hk⟩ := nat.exists_eq_add_of_lt (len_lt_of_mono i h₁),
  obtain ⟨k', hk'⟩ := nat.exists_eq_add_of_lt (len_lt_of_mono i' h₂),
  have eq : Δ.len = Δ''.len + (k+k'+2) := by linarith,
  rw map_mono_eq_zero K (i' ≫ i) _ _, rotate,
  { by_contradiction,
    simpa only [self_eq_add_right, h] using eq, },
  { by_contradiction,
    simp only [h.1, add_right_inj] at eq,
    linarith, },
  /- in all cases, the LHS is also zero, either by definition, or because d ≫ d = 0 -/
  by_cases h₃ : is_δ₀ i,
  { by_cases h₄ : is_δ₀ i',
    { rw [map_mono_δ₀' K i h₃, map_mono_δ₀' K i' h₄,
        homological_complex.d_comp_d], },
    { simp only [map_mono_eq_zero K i' h₂ h₄, comp_zero], }, },
  { simp only [map_mono_eq_zero K i h₁ h₃, zero_comp], },
end

end termwise

variable [has_finite_coproducts C]

/-- The simplicial morphism on the simplicial object `Γ₀.obj K` induced by
a morphism `Δ' → Δ` in `simplex_category` is defined on each summand
associated to an `A : Γ_index_set Δ` in terms of the epi-mono factorisation
of `θ ≫ A.e`. -/
def map (K : chain_complex C ℕ) {Δ' Δ : simplex_categoryᵒᵖ} (θ : Δ ⟶ Δ') :
  obj₂ K Δ ⟶ obj₂ K Δ' :=
sigma.desc (λ A, termwise.map_mono K (image.ι (θ.unop ≫ A.e)) ≫
  (sigma.ι (summand K Δ') (A.pull θ)))

@[reassoc]
lemma map_on_summand₀ {Δ Δ' : simplex_categoryᵒᵖ} (A : splitting.index_set Δ) {θ : Δ ⟶ Δ'}
  {Δ'' : simplex_category} {e : Δ'.unop ⟶ Δ''} {i : Δ'' ⟶ A.1.unop} [epi e] [mono i]
  (fac : e ≫ i = θ.unop ≫ A.e) :
  (sigma.ι (summand K Δ) A) ≫ map K θ =
    termwise.map_mono K i ≫ sigma.ι (summand K Δ') (splitting.index_set.mk e) :=
begin
  simp only [map, colimit.ι_desc, cofan.mk_ι_app],
  have h := simplex_category.image_eq fac,
  unfreezingI { subst h, },
  congr,
  { exact simplex_category.image_ι_eq fac, },
  { dsimp only [simplicial_object.splitting.index_set.pull],
    congr,
    exact simplex_category.factor_thru_image_eq fac, },
end

@[reassoc]
lemma map_on_summand₀' {Δ Δ' : simplex_categoryᵒᵖ} (A : splitting.index_set Δ) (θ : Δ ⟶ Δ') :
  (sigma.ι (summand K Δ) A) ≫ map K θ =
    termwise.map_mono K (image.ι (θ.unop ≫ A.e)) ≫ sigma.ι (summand K _) (A.pull θ) :=
map_on_summand₀ K A (A.fac_pull θ)

end obj

variable [has_finite_coproducts C]

/-- The functor `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`, on objects. -/
@[simps]
def obj (K : chain_complex C ℕ) : simplicial_object C :=
{ obj := λ Δ, obj.obj₂ K Δ,
  map := λ Δ Δ' θ, obj.map K θ,
  map_id' := λ Δ, begin
    ext A,
    cases A,
    have fac : A.e ≫ 𝟙 A.1.unop = (𝟙 Δ).unop ≫ A.e := by rw [unop_id, comp_id, id_comp],
    erw [obj.map_on_summand₀ K A fac, obj.termwise.map_mono_id, id_comp, comp_id],
    unfreezingI { rcases A with ⟨Δ', ⟨e, he⟩⟩, },
    refl,
  end,
  map_comp' := λ Δ'' Δ' Δ θ' θ, begin
    ext A,
    cases A,
    have fac : θ.unop ≫ θ'.unop ≫ A.e = (θ' ≫ θ).unop ≫ A.e := by rw [unop_comp, assoc],
    rw [← image.fac (θ'.unop ≫ A.e), ← assoc,
      ← image.fac (θ.unop ≫ factor_thru_image (θ'.unop ≫ A.e)), assoc] at fac,
    simpa only [obj.map_on_summand₀'_assoc K A θ', obj.map_on_summand₀' K _ θ,
      obj.termwise.map_mono_comp_assoc, obj.map_on_summand₀ K A fac],
  end }

lemma splitting_map_eq_id (Δ : simplex_categoryᵒᵖ) :
  (simplicial_object.splitting.map (Γ₀.obj K)
    (λ (n : ℕ), sigma.ι (Γ₀.obj.summand K (op [n])) (splitting.index_set.id (op [n]))) Δ)
    = 𝟙 _ :=
begin
  ext A,
  discrete_cases,
  induction Δ using opposite.rec,
  induction Δ with n,
  dsimp,
  simp only [colimit.ι_desc, cofan.mk_ι_app, comp_id, Γ₀.obj_map],
  rw [Γ₀.obj.map_on_summand₀ K
    (simplicial_object.splitting.index_set.id A.1) (show A.e ≫ 𝟙 _ = A.e.op.unop ≫ 𝟙 _, by refl),
    Γ₀.obj.termwise.map_mono_id, A.ext'],
  apply id_comp,
end

/-- By construction, the simplicial `Γ₀.obj K` is equipped with a splitting. -/
def splitting (K : chain_complex C ℕ) : simplicial_object.splitting (Γ₀.obj K) :=
{ N := λ n, K.X n,
  ι := λ n, sigma.ι (Γ₀.obj.summand K (op [n])) (splitting.index_set.id (op [n])),
  map_is_iso' := λ Δ, begin
    rw Γ₀.splitting_map_eq_id,
    apply is_iso.id,
  end, }

@[simp]
lemma splitting_iso_hom_eq_id (Δ : simplex_categoryᵒᵖ) : ((splitting K).iso Δ).hom = 𝟙 _ :=
splitting_map_eq_id K Δ

@[reassoc]
lemma obj.map_on_summand {Δ Δ' : simplex_categoryᵒᵖ} (A : splitting.index_set Δ) (θ : Δ ⟶ Δ')
  {Δ'' : simplex_category}
  {e : Δ'.unop ⟶ Δ''} {i : Δ'' ⟶ A.1.unop} [epi e] [mono i]
  (fac : e ≫ i = θ.unop ≫ A.e) : (Γ₀.splitting K).ι_summand A ≫ (Γ₀.obj K).map θ =
  Γ₀.obj.termwise.map_mono K i ≫ (Γ₀.splitting K).ι_summand (splitting.index_set.mk e) :=
begin
  dsimp only [simplicial_object.splitting.ι_summand,
    simplicial_object.splitting.ι_coprod],
  simp only [assoc, Γ₀.splitting_iso_hom_eq_id, id_comp, comp_id],
  exact Γ₀.obj.map_on_summand₀ K A fac,
end

@[reassoc]
lemma obj.map_on_summand' {Δ Δ' : simplex_categoryᵒᵖ} (A : splitting.index_set Δ) (θ : Δ ⟶ Δ') :
  (splitting K).ι_summand A ≫ (obj K).map θ =
    obj.termwise.map_mono K (image.ι (θ.unop ≫ A.e)) ≫ (splitting K).ι_summand (A.pull θ) :=
by { apply obj.map_on_summand, apply image.fac, }

@[reassoc]
lemma obj.map_mono_on_summand_id {Δ Δ' : simplex_category} (i : Δ' ⟶ Δ) [mono i] :
  (splitting K).ι_summand (splitting.index_set.id (op Δ)) ≫ (obj K).map i.op =
  obj.termwise.map_mono K i ≫ (splitting K).ι_summand (splitting.index_set.id (op Δ')) :=
obj.map_on_summand K (splitting.index_set.id (op Δ)) i.op (rfl : 𝟙 _ ≫ i = i ≫ 𝟙 _)

@[reassoc]
lemma obj.map_epi_on_summand_id {Δ Δ' : simplex_category } (e : Δ' ⟶ Δ) [epi e] :
  (Γ₀.splitting K).ι_summand (splitting.index_set.id (op Δ)) ≫ (Γ₀.obj K).map e.op =
    (Γ₀.splitting K).ι_summand (splitting.index_set.mk e) :=
by simpa only [Γ₀.obj.map_on_summand K (splitting.index_set.id (op Δ)) e.op
    (rfl : e ≫ 𝟙 Δ = e ≫ 𝟙 Δ), Γ₀.obj.termwise.map_mono_id] using id_comp _

/-- The functor `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`, on morphisms. -/
@[simps]
def map {K K' : chain_complex C ℕ} (f : K ⟶ K') : obj K ⟶ obj K' :=
{ app := λ Δ, (Γ₀.splitting K).desc Δ (λ A, f.f A.1.unop.len ≫ (Γ₀.splitting K').ι_summand A),
  naturality' := λ Δ' Δ θ, begin
    apply (Γ₀.splitting K).hom_ext',
    intro A,
    simp only [(splitting K).ι_desc_assoc, obj.map_on_summand'_assoc K _ θ,
      (splitting K).ι_desc, assoc, obj.map_on_summand' K' _ θ],
    apply obj.termwise.map_mono_naturality_assoc,
  end, }

end Γ₀

variable [has_finite_coproducts C]

/-- The functor `Γ₀' : chain_complex C ℕ ⥤ simplicial_object.split C`
that induces `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`, which
shall be the inverse functor of the Dold-Kan equivalence for
abelian or pseudo-abelian categories. -/
@[simps]
def Γ₀' : chain_complex C ℕ ⥤ simplicial_object.split C :=
{ obj := λ K, simplicial_object.split.mk' (Γ₀.splitting K),
  map := λ K K' f,
  { F := Γ₀.map f,
    f := f.f,
    comm' := λ n, by { dsimp, simpa only [← splitting.ι_summand_id,
      (Γ₀.splitting K).ι_desc], }, }, }

/-- The functor `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`, which is
the inverse functor of the Dold-Kan equivalence when `C` is an abelian
category, or more generally a pseudoabelian category. -/
@[simps]
def Γ₀ : chain_complex C ℕ ⥤ simplicial_object C := Γ₀' ⋙ split.forget _

/-- The extension of `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`
on the idempotent completions. It shall be an equivalence of categories
for any additive category `C`. -/
@[simps]
def Γ₂ : karoubi (chain_complex C ℕ) ⥤ karoubi (simplicial_object C) :=
(category_theory.idempotents.functor_extension₂ _ _).obj Γ₀

lemma higher_faces_vanish.on_Γ₀_summand_id (K : chain_complex C ℕ) (n : ℕ) :
  higher_faces_vanish (n+1) ((Γ₀.splitting K).ι_summand (splitting.index_set.id (op [n+1]))) :=
begin
  intros j hj,
  have eq := Γ₀.obj.map_mono_on_summand_id K (simplex_category.δ j.succ),
  rw [Γ₀.obj.termwise.map_mono_eq_zero K, zero_comp] at eq, rotate,
  { intro h,
    exact (nat.succ_ne_self n) (congr_arg simplex_category.len h), },
  { exact λ h, fin.succ_ne_zero j (by simpa only [is_δ₀.iff] using h), },
  exact eq,
end

@[simp, reassoc]
lemma P_infty_on_Γ₀_splitting_summand_eq_self
  (K : chain_complex C ℕ) {n : ℕ} :
  (Γ₀.splitting K).ι_summand (splitting.index_set.id (op [n])) ≫ (P_infty : K[Γ₀.obj K] ⟶ _).f n =
    (Γ₀.splitting K).ι_summand (splitting.index_set.id (op [n])) :=
begin
  rw P_infty_f,
  cases n,
  { simpa only [P_f_0_eq] using comp_id _, },
  { exact (higher_faces_vanish.on_Γ₀_summand_id K n).comp_P_eq_self, },
end

end dold_kan

end algebraic_topology


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen, Eric Wieser

! This file was ported from Lean 3 source module data.matrix.notation
! leanprover-community/mathlib commit 55e2dfde0cff928ce5c70926a3f2c7dee3e2dd99
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Matrix.Basic
import Mathbin.Data.Fin.VecNotation
import Mathbin.Tactic.FinCases
import Mathbin.Algebra.BigOperators.Fin

/-!
# Matrix and vector notation

This file includes `simp` lemmas for applying operations in `data.matrix.basic` to values built out
of the matrix notation `![a, b] = vec_cons a (vec_cons b vec_empty)` defined in
`data.fin.vec_notation`.

This also provides the new notation `!![a, b; c, d] = matrix.of ![![a, b], ![c, d]]`.
This notation also works for empty matrices; `!![,,,] : matrix (fin 0) (fin 3)` and
`!![;;;] : matrix (fin 3) (fin 0)`.

## Implementation notes

The `simp` lemmas require that one of the arguments is of the form `vec_cons _ _`.
This ensures `simp` works with entries only when (some) entries are already given.
In other words, this notation will only appear in the output of `simp` if it
already appears in the input.

## Notations

This file provide notation `!![a, b; c, d]` for matrices, which corresponds to
`matrix.of ![![a, b], ![c, d]]`.
A parser for `a, b; c, d`-style strings is provided as `matrix.entry_parser`, while
`matrix.notation` provides the hook for the `!!` notation.
Note that in lean 3 the pretty-printer will not show `!!` notation, instead showing the version
with `of ![![...]]`.

## Examples

Examples of usage can be found in the `test/matrix.lean` file.
-/

namespace Matrix

universe u

variable {α : Type u} {o n m : ℕ} {m' n' o' : Type _}

open Matrix

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:73:14: unsupported tactic `reflect_name #[] -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:73:14: unsupported tactic `reflect_name #[] -/
/-- Matrices can be reflected whenever their entries can. We insert an `@id (matrix m' n' α)` to
prevent immediate decay to a function. -/
unsafe instance matrix.reflect [reflected_univ.{u}] [reflected_univ.{u_1}] [reflected_univ.{u_2}]
    [reflected _ α] [reflected _ m'] [reflected _ n'] [h : has_reflect (m' → n' → α)] :
    has_reflect (Matrix m' n' α) := fun m =>
  (by
          trace
            "./././Mathport/Syntax/Translate/Tactic/Builtin.lean:73:14: unsupported tactic `reflect_name #[]" :
          reflected _ @id.{max u_1 u_2 u + 1}).subst₂
      ((by
            trace
              "./././Mathport/Syntax/Translate/Tactic/Builtin.lean:73:14: unsupported tactic `reflect_name #[]" :
            reflected _ @Matrix.{u_1, u_2, u}).subst₃
        q(_) q(_) q(_)) <|
    by
    dsimp only [Matrix]
    exact h m
#align matrix.matrix.reflect matrix.matrix.reflect

section Parser

open Lean

open Lean.Parser

open Interactive

open Interactive.Types

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- Parse the entries of a matrix -/
unsafe def entry_parser {α : Type} (p : parser α) : parser (Σm n, Fin m → Fin n → α) := do
  let-- a list of lists if the matrix has at least one row, or the number of columns if the matrix has
  -- zero rows.
  p :
    parser (Sum (List (List α)) ℕ) :=-- empty rows
        Sum.inl <$>
        ((pure [] <* tk ";").repeat_at_least 1 <|>
          (sep_by_trailing (tk ";") <| sep_by_trailing (tk ",") p)) <|>
      Sum.inr <$> List.length <$> many (tk ",")
  let which
    ←-- empty columns
      p
  match which with
    | Sum.inl l => do
      let h::tl ← pure l
      let n := h
      let l : List (Vector α n) ←
        l fun row =>
            if h : row = n then pure (⟨row, h⟩ : Vector α n)
            else interaction_monad.fail "Rows must be of equal length"
      pure ⟨l, n, fun i j => (l _ i).get? j⟩
    | Sum.inr n => pure ⟨0, n, finZeroElim⟩
#align matrix.entry_parser matrix.entry_parser

-- Lean can't find this instance without some help. We only need it available in `Type 0`, and it is
-- a massive amount of effort to make it universe-polymorphic.
@[instance]
unsafe def sigma_sigma_fin_matrix_has_reflect {α : Type} [has_reflect α] [reflected _ α] :
    has_reflect (Σm n : ℕ, Fin m → Fin n → α) :=
  @sigma.reflect.{0, 0} _ _ ℕ (fun m => Σn, Fin m → Fin n → α) _ _ _ fun i =>
    @sigma.reflect.{0, 0} _ _ ℕ _ _ _ _ fun j => inferInstance
#align matrix.sigma_sigma_fin_matrix_has_reflect matrix.sigma_sigma_fin_matrix_has_reflect

/-- `!![a, b; c, d]` notation for matrices indexed by `fin m` and `fin n`. See the module docstring
for details. -/
@[user_notation]
unsafe def notation (_ : parse <| tk "!![")
    (val : parse (entry_parser (parser.pexpr 1) <* tk "]")) : parser pexpr := do
  let ⟨m, n, entries⟩ := val
  let entry_vals := pi_fin.to_pexpr (pi_fin.to_pexpr ∘ entries)
  pure (``(@Matrix.of (Fin $(q(m))) (Fin $(q(n))) _).app entry_vals)
#align matrix.notation matrix.notation

end Parser

variable (a b : ℕ)

/-- Use `![...]` notation for displaying a `fin`-indexed matrix, for example:

```
#eval !![1, 2; 3, 4] + !![3, 4; 5, 6]  -- !![4, 6; 8, 10]
```
-/
instance [Repr α] : Repr (Matrix (Fin m) (Fin n) α)
    where repr f :=
    "!![" ++
        (String.intercalate "; " <|
          (List.finRange m).map fun i =>
            String.intercalate ", " <| (List.finRange n).map fun j => repr (f i j)) ++
      "]"

@[simp]
theorem cons_val' (v : n' → α) (B : Fin m → n' → α) (i j) :
    vecCons v B i j = vecCons (v j) (fun i => B i j) i := by refine' Fin.cases _ _ i <;> simp
#align matrix.cons_val' Matrix.cons_val'

@[simp]
theorem head_val' (B : Fin m.succ → n' → α) (j : n') : (vecHead fun i => B i j) = vecHead B j :=
  rfl
#align matrix.head_val' Matrix.head_val'

@[simp]
theorem tail_val' (B : Fin m.succ → n' → α) (j : n') :
    (vecTail fun i => B i j) = fun i => vecTail B i j :=
  by
  ext
  simp [vec_tail]
#align matrix.tail_val' Matrix.tail_val'

section DotProduct

variable [AddCommMonoid α] [Mul α]

@[simp]
theorem dotProduct_empty (v w : Fin 0 → α) : dotProduct v w = 0 :=
  Finset.sum_empty
#align matrix.dot_product_empty Matrix.dotProduct_empty

@[simp]
theorem cons_dotProduct (x : α) (v : Fin n → α) (w : Fin n.succ → α) :
    dotProduct (vecCons x v) w = x * vecHead w + dotProduct v (vecTail w) := by
  simp [dot_product, Fin.sum_univ_succ, vec_head, vec_tail]
#align matrix.cons_dot_product Matrix.cons_dotProduct

@[simp]
theorem dotProduct_cons (v : Fin n.succ → α) (x : α) (w : Fin n → α) :
    dotProduct v (vecCons x w) = vecHead v * x + dotProduct (vecTail v) w := by
  simp [dot_product, Fin.sum_univ_succ, vec_head, vec_tail]
#align matrix.dot_product_cons Matrix.dotProduct_cons

@[simp]
theorem cons_dotProduct_cons (x : α) (v : Fin n → α) (y : α) (w : Fin n → α) :
    dotProduct (vecCons x v) (vecCons y w) = x * y + dotProduct v w := by simp
#align matrix.cons_dot_product_cons Matrix.cons_dotProduct_cons

end DotProduct

section ColRow

@[simp]
theorem col_empty (v : Fin 0 → α) : col v = vecEmpty :=
  empty_eq _
#align matrix.col_empty Matrix.col_empty

@[simp]
theorem col_cons (x : α) (u : Fin m → α) : col (vecCons x u) = vecCons (fun _ => x) (col u) :=
  by
  ext (i j)
  refine' Fin.cases _ _ i <;> simp [vec_head, vec_tail]
#align matrix.col_cons Matrix.col_cons

@[simp]
theorem row_empty : row (vecEmpty : Fin 0 → α) = fun _ => vecEmpty :=
  by
  ext
  rfl
#align matrix.row_empty Matrix.row_empty

@[simp]
theorem row_cons (x : α) (u : Fin m → α) : row (vecCons x u) = fun _ => vecCons x u :=
  by
  ext
  rfl
#align matrix.row_cons Matrix.row_cons

end ColRow

section Transpose

@[simp]
theorem transpose_empty_rows (A : Matrix m' (Fin 0) α) : Aᵀ = of ![] :=
  empty_eq _
#align matrix.transpose_empty_rows Matrix.transpose_empty_rows

@[simp]
theorem transpose_empty_cols (A : Matrix (Fin 0) m' α) : Aᵀ = of fun i => ![] :=
  funext fun i => empty_eq _
#align matrix.transpose_empty_cols Matrix.transpose_empty_cols

@[simp]
theorem cons_transpose (v : n' → α) (A : Matrix (Fin m) n' α) :
    (of (vecCons v A))ᵀ = of fun i => vecCons (v i) (Aᵀ i) :=
  by
  ext (i j)
  refine' Fin.cases _ _ j <;> simp
#align matrix.cons_transpose Matrix.cons_transpose

@[simp]
theorem head_transpose (A : Matrix m' (Fin n.succ) α) :
    vecHead (of.symm Aᵀ) = vecHead ∘ of.symm A :=
  rfl
#align matrix.head_transpose Matrix.head_transpose

@[simp]
theorem tail_transpose (A : Matrix m' (Fin n.succ) α) : vecTail (of.symm Aᵀ) = (vecTail ∘ A)ᵀ :=
  by
  ext (i j)
  rfl
#align matrix.tail_transpose Matrix.tail_transpose

end Transpose

section Mul

variable [Semiring α]

@[simp]
theorem empty_mul [Fintype n'] (A : Matrix (Fin 0) n' α) (B : Matrix n' o' α) : A ⬝ B = of ![] :=
  empty_eq _
#align matrix.empty_mul Matrix.empty_mul

@[simp]
theorem empty_mul_empty (A : Matrix m' (Fin 0) α) (B : Matrix (Fin 0) o' α) : A ⬝ B = 0 :=
  rfl
#align matrix.empty_mul_empty Matrix.empty_mul_empty

@[simp]
theorem mul_empty [Fintype n'] (A : Matrix m' n' α) (B : Matrix n' (Fin 0) α) :
    A ⬝ B = of fun _ => ![] :=
  funext fun _ => empty_eq _
#align matrix.mul_empty Matrix.mul_empty

theorem mul_val_succ [Fintype n'] (A : Matrix (Fin m.succ) n' α) (B : Matrix n' o' α) (i : Fin m)
    (j : o') : (A ⬝ B) i.succ j = (of (vecTail (of.symm A)) ⬝ B) i j :=
  rfl
#align matrix.mul_val_succ Matrix.mul_val_succ

@[simp]
theorem cons_mul [Fintype n'] (v : n' → α) (A : Fin m → n' → α) (B : Matrix n' o' α) :
    of (vecCons v A) ⬝ B = of (vecCons (vecMul v B) (of.symm (of A ⬝ B))) :=
  by
  ext (i j)
  refine' Fin.cases _ _ i
  · rfl
  simp [mul_val_succ]
#align matrix.cons_mul Matrix.cons_mul

end Mul

section VecMul

variable [Semiring α]

@[simp]
theorem empty_vecMul (v : Fin 0 → α) (B : Matrix (Fin 0) o' α) : vecMul v B = 0 :=
  rfl
#align matrix.empty_vec_mul Matrix.empty_vecMul

@[simp]
theorem vecMul_empty [Fintype n'] (v : n' → α) (B : Matrix n' (Fin 0) α) : vecMul v B = ![] :=
  empty_eq _
#align matrix.vec_mul_empty Matrix.vecMul_empty

@[simp]
theorem cons_vecMul (x : α) (v : Fin n → α) (B : Fin n.succ → o' → α) :
    vecMul (vecCons x v) (of B) = x • vecHead B + vecMul v (of <| vecTail B) :=
  by
  ext i
  simp [vec_mul]
#align matrix.cons_vec_mul Matrix.cons_vecMul

@[simp]
theorem vecMul_cons (v : Fin n.succ → α) (w : o' → α) (B : Fin n → o' → α) :
    vecMul v (of <| vecCons w B) = vecHead v • w + vecMul (vecTail v) (of B) :=
  by
  ext i
  simp [vec_mul]
#align matrix.vec_mul_cons Matrix.vecMul_cons

@[simp]
theorem cons_vecMul_cons (x : α) (v : Fin n → α) (w : o' → α) (B : Fin n → o' → α) :
    vecMul (vecCons x v) (of <| vecCons w B) = x • w + vecMul v (of B) := by simp
#align matrix.cons_vec_mul_cons Matrix.cons_vecMul_cons

end VecMul

section MulVec

variable [Semiring α]

@[simp]
theorem empty_mulVec [Fintype n'] (A : Matrix (Fin 0) n' α) (v : n' → α) : mulVec A v = ![] :=
  empty_eq _
#align matrix.empty_mul_vec Matrix.empty_mulVec

@[simp]
theorem mulVec_empty (A : Matrix m' (Fin 0) α) (v : Fin 0 → α) : mulVec A v = 0 :=
  rfl
#align matrix.mul_vec_empty Matrix.mulVec_empty

@[simp]
theorem cons_mulVec [Fintype n'] (v : n' → α) (A : Fin m → n' → α) (w : n' → α) :
    mulVec (of <| vecCons v A) w = vecCons (dotProduct v w) (mulVec (of A) w) :=
  by
  ext i
  refine' Fin.cases _ _ i <;> simp [mul_vec]
#align matrix.cons_mul_vec Matrix.cons_mulVec

@[simp]
theorem mulVec_cons {α} [CommSemiring α] (A : m' → Fin n.succ → α) (x : α) (v : Fin n → α) :
    mulVec (of A) (vecCons x v) = x • vecHead ∘ A + mulVec (of (vecTail ∘ A)) v :=
  by
  ext i
  simp [mul_vec, mul_comm]
#align matrix.mul_vec_cons Matrix.mulVec_cons

end MulVec

section VecMulVec

variable [Semiring α]

@[simp]
theorem empty_vecMulVec (v : Fin 0 → α) (w : n' → α) : vecMulVec v w = ![] :=
  empty_eq _
#align matrix.empty_vec_mul_vec Matrix.empty_vecMulVec

@[simp]
theorem vecMulVec_empty (v : m' → α) (w : Fin 0 → α) : vecMulVec v w = fun _ => ![] :=
  funext fun i => empty_eq _
#align matrix.vec_mul_vec_empty Matrix.vecMulVec_empty

@[simp]
theorem cons_vecMulVec (x : α) (v : Fin m → α) (w : n' → α) :
    vecMulVec (vecCons x v) w = vecCons (x • w) (vecMulVec v w) :=
  by
  ext i
  refine' Fin.cases _ _ i <;> simp [vec_mul_vec]
#align matrix.cons_vec_mul_vec Matrix.cons_vecMulVec

@[simp]
theorem vecMulVec_cons (v : m' → α) (x : α) (w : Fin n → α) :
    vecMulVec v (vecCons x w) = fun i => v i • vecCons x w :=
  by
  ext (i j)
  rw [vec_mul_vec, Pi.smul_apply, smul_eq_mul]
#align matrix.vec_mul_vec_cons Matrix.vecMulVec_cons

end VecMulVec

section Smul

variable [Semiring α]

@[simp]
theorem smul_mat_empty {m' : Type _} (x : α) (A : Fin 0 → m' → α) : x • A = ![] :=
  empty_eq _
#align matrix.smul_mat_empty Matrix.smul_mat_empty

@[simp]
theorem smul_mat_cons (x : α) (v : n' → α) (A : Fin m → n' → α) :
    x • vecCons v A = vecCons (x • v) (x • A) :=
  by
  ext i
  refine' Fin.cases _ _ i <;> simp
#align matrix.smul_mat_cons Matrix.smul_mat_cons

end Smul

section Submatrix

@[simp]
theorem submatrix_empty (A : Matrix m' n' α) (row : Fin 0 → m') (col : o' → n') :
    submatrix A row col = ![] :=
  empty_eq _
#align matrix.submatrix_empty Matrix.submatrix_empty

@[simp]
theorem submatrix_cons_row (A : Matrix m' n' α) (i : m') (row : Fin m → m') (col : o' → n') :
    submatrix A (vecCons i row) col = vecCons (fun j => A i (col j)) (submatrix A row col) :=
  by
  ext (i j)
  refine' Fin.cases _ _ i <;> simp [submatrix]
#align matrix.submatrix_cons_row Matrix.submatrix_cons_row

end Submatrix

section Vec2AndVec3

section One

variable [Zero α] [One α]

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `«expr!![ » -/
/- ./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation -/
theorem one_fin_two :
    (1 : Matrix (Fin 2) (Fin 2) α) =
      «expr!![ »
        "./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation" :=
  by
  ext (i j)
  fin_cases i <;> fin_cases j <;> rfl
#align matrix.one_fin_two Matrix.one_fin_two

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `«expr!![ » -/
/- ./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation -/
theorem one_fin_three :
    (1 : Matrix (Fin 3) (Fin 3) α) =
      «expr!![ »
        "./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation" :=
  by
  ext (i j)
  fin_cases i <;> fin_cases j <;> rfl
#align matrix.one_fin_three Matrix.one_fin_three

end One

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `«expr!![ » -/
/- ./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation -/
theorem eta_fin_two (A : Matrix (Fin 2) (Fin 2) α) :
    A =
      «expr!![ »
        "./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation" :=
  by
  ext (i j)
  fin_cases i <;> fin_cases j <;> rfl
#align matrix.eta_fin_two Matrix.eta_fin_two

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `«expr!![ » -/
/- ./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation -/
theorem eta_fin_three (A : Matrix (Fin 3) (Fin 3) α) :
    A =
      «expr!![ »
        "./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation" :=
  by
  ext (i j)
  fin_cases i <;> fin_cases j <;> rfl
#align matrix.eta_fin_three Matrix.eta_fin_three

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `«expr!![ » -/
/- ./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `«expr!![ » -/
/- ./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `«expr!![ » -/
/- ./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation -/
theorem mul_fin_two [AddCommMonoid α] [Mul α] (a₁₁ a₁₂ a₂₁ a₂₂ b₁₁ b₁₂ b₂₁ b₂₂ : α) :
    «expr!![ »
          "./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation" ⬝
        «expr!![ »
          "./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation" =
      «expr!![ »
        "./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation" :=
  by
  ext (i j)
  fin_cases i <;> fin_cases j <;> simp [Matrix.mul, dot_product, Fin.sum_univ_succ]
#align matrix.mul_fin_two Matrix.mul_fin_two

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `«expr!![ » -/
/- ./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `«expr!![ » -/
/- ./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `«expr!![ » -/
/- ./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation -/
theorem mul_fin_three [AddCommMonoid α] [Mul α]
    (a₁₁ a₁₂ a₁₃ a₂₁ a₂₂ a₂₃ a₃₁ a₃₂ a₃₃ b₁₁ b₁₂ b₁₃ b₂₁ b₂₂ b₂₃ b₃₁ b₃₂ b₃₃ : α) :
    «expr!![ »
          "./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation" ⬝
        «expr!![ »
          "./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation" =
      «expr!![ »
        "./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation" :=
  by
  ext (i j)
  fin_cases i <;> fin_cases j <;> simp [Matrix.mul, dot_product, Fin.sum_univ_succ, ← add_assoc]
#align matrix.mul_fin_three Matrix.mul_fin_three

theorem vec2_eq {a₀ a₁ b₀ b₁ : α} (h₀ : a₀ = b₀) (h₁ : a₁ = b₁) : ![a₀, a₁] = ![b₀, b₁] := by
  subst_vars
#align matrix.vec2_eq Matrix.vec2_eq

theorem vec3_eq {a₀ a₁ a₂ b₀ b₁ b₂ : α} (h₀ : a₀ = b₀) (h₁ : a₁ = b₁) (h₂ : a₂ = b₂) :
    ![a₀, a₁, a₂] = ![b₀, b₁, b₂] := by subst_vars
#align matrix.vec3_eq Matrix.vec3_eq

theorem vec2_add [Add α] (a₀ a₁ b₀ b₁ : α) : ![a₀, a₁] + ![b₀, b₁] = ![a₀ + b₀, a₁ + b₁] := by
  rw [cons_add_cons, cons_add_cons, empty_add_empty]
#align matrix.vec2_add Matrix.vec2_add

theorem vec3_add [Add α] (a₀ a₁ a₂ b₀ b₁ b₂ : α) :
    ![a₀, a₁, a₂] + ![b₀, b₁, b₂] = ![a₀ + b₀, a₁ + b₁, a₂ + b₂] := by
  rw [cons_add_cons, cons_add_cons, cons_add_cons, empty_add_empty]
#align matrix.vec3_add Matrix.vec3_add

theorem smul_vec2 {R : Type _} [SMul R α] (x : R) (a₀ a₁ : α) : x • ![a₀, a₁] = ![x • a₀, x • a₁] :=
  by rw [smul_cons, smul_cons, smul_empty]
#align matrix.smul_vec2 Matrix.smul_vec2

theorem smul_vec3 {R : Type _} [SMul R α] (x : R) (a₀ a₁ a₂ : α) :
    x • ![a₀, a₁, a₂] = ![x • a₀, x • a₁, x • a₂] := by
  rw [smul_cons, smul_cons, smul_cons, smul_empty]
#align matrix.smul_vec3 Matrix.smul_vec3

variable [AddCommMonoid α] [Mul α]

theorem vec2_dot_product' {a₀ a₁ b₀ b₁ : α} : ![a₀, a₁] ⬝ᵥ ![b₀, b₁] = a₀ * b₀ + a₁ * b₁ := by
  rw [cons_dot_product_cons, cons_dot_product_cons, dot_product_empty, add_zero]
#align matrix.vec2_dot_product' Matrix.vec2_dot_product'

@[simp]
theorem vec2_dotProduct (v w : Fin 2 → α) : v ⬝ᵥ w = v 0 * w 0 + v 1 * w 1 :=
  vec2_dot_product'
#align matrix.vec2_dot_product Matrix.vec2_dotProduct

theorem vec3_dot_product' {a₀ a₁ a₂ b₀ b₁ b₂ : α} :
    ![a₀, a₁, a₂] ⬝ᵥ ![b₀, b₁, b₂] = a₀ * b₀ + a₁ * b₁ + a₂ * b₂ := by
  rw [cons_dot_product_cons, cons_dot_product_cons, cons_dot_product_cons, dot_product_empty,
    add_zero, add_assoc]
#align matrix.vec3_dot_product' Matrix.vec3_dot_product'

@[simp]
theorem vec3_dotProduct (v w : Fin 3 → α) : v ⬝ᵥ w = v 0 * w 0 + v 1 * w 1 + v 2 * w 2 :=
  vec3_dot_product'
#align matrix.vec3_dot_product Matrix.vec3_dotProduct

end Vec2AndVec3

end Matrix


import .basic
open list quot subtype decidable function

namespace finset
/- image (corresponds to map on list) -/
section image
variables {A B : Type}
variable [h : decidable_eq B]
include h

definition image (f : A → B) (s : finset A) : finset B :=
quot.lift_on s
  (λ l, to_finset (list.map f l.1))
  (λ l₁ l₂ p, quot.sound (perm.perm_erase_dup_of_perm (perm.perm_map _ p)))

infix `'` := image

theorem image_empty (f : A → B) : image f empty = empty := rfl

theorem mem_image_of_mem (f : A → B) {s : finset A} {a : A} : a ∈ s → f a ∈ image f s :=
quot.induction_on s (take l, assume H : a ∈ l.1, mem_to_finset (mem_map f H))

theorem mem_image {f : A → B} {s : finset A} {a : A} {b : B}
    (H1 : a ∈ s) (H2 : f a = b) :
  b ∈ image f s :=
eq.subst H2 (mem_image_of_mem f H1)

theorem exists_of_mem_image {f : A → B} {s : finset A} {b : B} :
  b ∈ image f s → ∃a, a ∈ s ∧ f a = b :=
quot.induction_on s
  (take l, assume H : b ∈ erase_dup (list.map f l.1),
    exists_of_mem_map (mem_of_mem_erase_dup H))

theorem mem_image_iff (f : A → B) {s : finset A} {y : B} : y ∈ image f s ↔ ∃x, x ∈ s ∧ f x = y :=
iff.intro exists_of_mem_image
  (assume H, let ⟨x,H₁,H₂⟩ := H in mem_image H₁ H₂)

theorem mem_image_eq (f : A → B) {s : finset A} {y : B} : y ∈ image f s = ∃x, x ∈ s ∧ f x = y :=
propext (mem_image_iff f)

theorem mem_image_of_mem_image_of_subset {f : A → B} {s t : finset A} {y : B}
    (H1 : y ∈ image f s) (H2 : s ⊆ t) : y ∈ image f t :=
let ⟨x, H3, H4⟩ := exists_of_mem_image H1 in
have H5 : x ∈ t, from mem_of_subset_of_mem H2 H3,
show y ∈ image f t, from mem_image H5 H4

theorem image_insert [h' : decidable_eq A] (f : A → B) (s : finset A) (a : A) :
  image f (insert a s) = insert (f a) (image f s) :=
ext (take y, iff.intro
  (assume H : y ∈ image f (insert a s),
    let ⟨x,H1l,H1r⟩ := exists_of_mem_image H in
    have x = a ∨ x ∈ s, from eq_or_mem_of_mem_insert H1l,
    or.elim this
      (suppose x = a,
        have f a = y, from eq.subst this H1r,
        show y ∈ insert (f a) (image f s), from eq.subst this (mem_insert _ _))
      (suppose x ∈ s,
        have f x ∈ image f s, from mem_image_of_mem f this,
        show y ∈ insert (f a) (image f s), from eq.subst H1r (mem_insert_of_mem _ this)))
  (suppose y ∈ insert (f a) (image f s),
    have y = f a ∨ y ∈ image f s, from eq_or_mem_of_mem_insert this,
    or.elim this
      (assume eq : y = f a,
        have f a ∈ image f (insert a s), from mem_image_of_mem f (mem_insert _ _),
        show y ∈ image f (insert a s), by rw eq;exact this)
      (suppose y ∈ image f s,
        show y ∈ image f (insert a s), from mem_image_of_mem_image_of_subset this (subset_insert _ _) )))

lemma image_comp {C : Type} [deceqC : decidable_eq C] {f : B → C} {g : A → B} {s : finset A} :
  image (f∘g) s = image f (image g s) :=
ext (take z, iff.intro
  (suppose z ∈ image (f∘g) s,
   let ⟨x,Hx,Hgfx⟩ := exists_of_mem_image this in
    by rewrite -Hgfx; apply mem_image_of_mem _ (mem_image_of_mem _ Hx))
  (suppose z ∈ image f (image g s),
   let ⟨y,Hy,Hfy⟩ := exists_of_mem_image this in
   let ⟨x,Hx,Hgx⟩ := exists_of_mem_image Hy in
   mem_image Hx (begin simp [comp, Hgx, Hfy] end)))

lemma image_subset {a b : finset A} (f : A → B) (H : a ⊆ b) : image f a ⊆ image f b :=
subset_of_forall
  (take y, assume Hy : y ∈ image f a,
    let ⟨x,Hx₁,Hx₂⟩ := exists_of_mem_image Hy in
    mem_image (mem_of_subset_of_mem H Hx₁) Hx₂)

theorem image_union [h' : decidable_eq A] (f : A → B) (s t : finset A) :
  image f (s ∪ t) = image f s ∪ image f t :=
ext (take y, iff.intro
  (assume H : y ∈ image f (s ∪ t),
   let ⟨x,xst,fxy⟩ := exists_of_mem_image H in
    or.elim (mem_or_mem_of_mem_union xst)
      (assume xs, mem_union_l (mem_image xs fxy))
      (assume xt, mem_union_r (mem_image xt fxy)))
  (assume H : y ∈ image f s ∪ image f t,
    or.elim (mem_or_mem_of_mem_union H)
      (assume yifs : y ∈ image f s,
        let ⟨x,xs,fxy⟩ := exists_of_mem_image yifs in
        mem_image (mem_union_l xs) fxy)
      (assume yift : y ∈ image f t,
        let ⟨x,xt,fxy⟩ := exists_of_mem_image yift in
        mem_image (mem_union_r xt) fxy)))

end image

/- separation and set-builder notation -/
section sep
variables {A : Type} [deceq : decidable_eq A]
include deceq
variables (p : A → Prop) [decp : decidable_pred p] (s : finset A) {x : A}
include decp

definition sep : finset A :=
quot.lift_on s
  (λl, to_finset_of_nodup
    (list.filter p l.1)
    (list.nodup_filter p l.2))
(λ l₁ l₂ u, quot.sound (perm.perm_filter u))

-- notation [priority finset.prio] `{` binder ` ∈ ` s ` | ` r:(scoped:1 p, sep p s) `}` := r

theorem sep_empty : sep p empty = empty := rfl

variables {p s}

theorem of_mem_sep : x ∈ sep p s → p x :=
quot.induction_on s (take l, list.of_mem_filter)

theorem mem_of_mem_sep : x ∈ sep p s → x ∈ s :=
quot.induction_on s (take l, list.mem_of_mem_filter)

theorem mem_sep_of_mem {x : A} : x ∈ s → p x → x ∈ sep p s :=
quot.induction_on s (take l, list.mem_filter_of_mem)

variables (p s)

theorem mem_sep_iff : x ∈ sep p s ↔ x ∈ s ∧ p x :=
iff.intro
  (assume H, and.intro (mem_of_mem_sep H) (of_mem_sep H))
  (assume H, mem_sep_of_mem (and.left H) (and.right H))

theorem mem_sep_eq : x ∈ sep p s = (x ∈ s ∧ p x) :=
propext (mem_sep_iff _ _)

variable t : finset A

theorem mem_sep_union_iff : x ∈ sep p (s ∪ t) ↔ x ∈ sep p s ∨ x ∈ sep p t :=
by repeat {rw mem_sep_iff}; rw [mem_union_iff]; super

end sep

section

variables {A : Type} [deceqA : decidable_eq A]
include deceqA

theorem eq_sep_of_subset {s t : finset A} (ssubt : s ⊆ t) : s = sep (λ x, x ∈ s) t :=
ext (take x, iff.intro
  (suppose x ∈ s, mem_sep_of_mem (mem_of_subset_of_mem ssubt this) this)
  (suppose x ∈ sep (λ x, x ∈ s) t, @of_mem_sep _ _ _ _ _ _ this))

end

/- set difference -/
section diff
variables {A : Type} [deceq : decidable_eq A]
include deceq

definition diff (s t : finset A) : finset A := sep (λ x, x ∉ t) s
infix ` \ ` := diff

theorem mem_of_mem_diff {s t : finset A} {x : A} (H : x ∈ s \ t) : x ∈ s :=
mem_of_mem_sep H

theorem not_mem_of_mem_diff {s t : finset A} {x : A} (H : x ∈ s \ t) : x ∉ t :=
@of_mem_sep _ _ _ _ _ _ H

theorem mem_diff {s t : finset A} {x : A} (H1 : x ∈ s) (H2 : x ∉ t) : x ∈ s \ t :=
mem_sep_of_mem H1 H2

theorem mem_diff_iff (s t : finset A) (x : A) : x ∈ s \ t ↔ x ∈ s ∧ x ∉ t :=
iff.intro
  (assume H, and.intro (mem_of_mem_diff H) (not_mem_of_mem_diff H))
  (assume H, mem_diff (and.left H) (and.right H))

theorem mem_diff_eq (s t : finset A) (x : A) : x ∈ s \ t = (x ∈ s ∧ x ∉ t) :=
propext (mem_diff_iff _ _ _)

theorem union_diff_cancel {s t : finset A} (H : s ⊆ t) : s ∪ (t \ s) = t :=
ext (take x, iff.intro
  (suppose x ∈ s ∪ (t \ s),
    or.elim (mem_or_mem_of_mem_union this)
      (suppose x ∈ s, mem_of_subset_of_mem H this)
      (suppose x ∈ t \ s, mem_of_mem_diff this))
  (assume h,
    decidable.by_cases
      (suppose x ∈ s, mem_union_left _ this)
      (suppose x ∉ s, mem_union_right _ (mem_diff h this))))

theorem diff_union_cancel {s t : finset A} (H : s ⊆ t) : (t \ s) ∪ s = t :=
@eq.subst _ (λ x, x = t) _ _ (union_comm _ _) (union_diff_cancel H)

end diff

/- set complement -/
section complement
-- TODO
end complement

end finset