Skip to content

Commit

Permalink
refactor(category_theory/shift): improve automation (#18670)
Browse files Browse the repository at this point in the history
  • Loading branch information
joelriou committed Mar 28, 2023
1 parent e8ac631 commit 6876fa1
Show file tree
Hide file tree
Showing 7 changed files with 843 additions and 785 deletions.
61 changes: 38 additions & 23 deletions src/category_theory/differential_object.lean
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.int.basic
import category_theory.shift
import category_theory.shift.basic
import category_theory.concrete_category.basic

/-!
Expand Down Expand Up @@ -220,52 +220,67 @@ def shift_functor (n : ℤ) : differential_object C ⥤ differential_object C :=
←functor.map_comp_assoc, X.d_squared, functor.map_zero, zero_comp] },
map := λ X Y f,
{ f := f.f⟦n⟧',
comm' := by { dsimp, rw [category.assoc, shift_comm_hom_comp, ← functor.map_comp_assoc,
f.comm, functor.map_comp_assoc], }, },
comm' := begin
dsimp,
erw [category.assoc, shift_comm_hom_comp, ← functor.map_comp_assoc, f.comm,
functor.map_comp_assoc],
refl,
end, },
map_id' := by { intros X, ext1, dsimp, rw functor.map_id },
map_comp' := by { intros X Y Z f g, ext1, dsimp, rw functor.map_comp } }

local attribute [simp] eq_to_hom_map
local attribute [reducible] discrete.add_monoidal shift_comm

/-- The shift functor on `differential_object C` is additive. -/
@[simps] def shift_functor_add (m n : ℤ) :
shift_functor C (m + n) ≅ shift_functor C m ⋙ shift_functor C n :=
begin
refine nat_iso.of_components (λ X, mk_iso (shift_add X.X _ _) _) _,
{ dsimp,
-- This is just `simp, simp [eq_to_hom_map]`.
simp_rw [category.assoc, obj_μ_inv_app, μ_inv_hom_app_assoc, functor.map_comp, obj_μ_app,
category.assoc, μ_naturality_assoc, μ_inv_hom_app_assoc, obj_μ_inv_app, category.assoc,
μ_naturalityₗ_assoc, μ_inv_hom_app_assoc, μ_inv_naturalityᵣ_assoc],
simp only [eq_to_hom_map, eq_to_hom_app, eq_to_iso.hom, eq_to_hom_trans_assoc,
eq_to_iso.inv], },
rw [← cancel_epi ((shift_functor_add C m n).inv.app X.X)],
simp only [category.assoc, iso.inv_hom_id_app_assoc],
erw [← nat_trans.naturality_assoc],
dsimp,
simp only [functor.map_comp, category.assoc,
shift_functor_comm_hom_app_comp_shift_shift_functor_add_hom_app 1 m n X.X,
iso.inv_hom_id_app_assoc], },
{ intros X Y f, ext, dsimp, exact nat_trans.naturality _ _ }
end

local attribute [reducible] endofunctor_monoidal_category

section
local attribute [instance] endofunctor_monoidal_category

/-- The shift by zero is naturally isomorphic to the identity. -/
@[simps]
def shift_ε : 𝟭 (differential_object C) ≅ shift_functor C 0 :=
def shift_zero : shift_functor C 0 ≅ 𝟭 (differential_object C) :=
begin
refine nat_iso.of_components (λ X, mk_iso ((shift_monoidal_functor C ℤ).ε_iso.app X.X) _) _,
{ dsimp, simp, dsimp, simp },
{ introv, ext, dsimp, simp }
refine nat_iso.of_components (λ X, mk_iso ((shift_functor_zero C ℤ).app X.X) _) _,
{ erw [← nat_trans.naturality],
dsimp,
simp only [shift_functor_zero_hom_app_shift, category.assoc], },
{ tidy, },
end

end

local attribute [simp] eq_to_hom_map

instance : has_shift (differential_object C) ℤ :=
has_shift_mk _ _
{ F := shift_functor C,
ε := shift_ε C,
μ := λ m n, (shift_functor_add C m n).symm }
zero := shift_zero C,
add := shift_functor_add C,
assoc_hom_app := λ m₁ m₂ m₃ X, begin
ext1,
convert shift_functor_add_assoc_hom_app m₁ m₂ m₃ X.X,
dsimp [shift_functor_add'],
simpa,
end,
zero_add_hom_app := λ n X, begin
ext1,
convert shift_functor_add_zero_add_hom_app n X.X,
simpa,
end,
add_zero_hom_app := λ n X, begin
ext1,
convert shift_functor_add_add_zero_hom_app n X.X,
simpa,
end, }

end differential_object

Expand Down
13 changes: 7 additions & 6 deletions src/category_theory/graded_object.lean
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ Authors: Scott Morrison
-/
import algebra.group_power.lemmas
import category_theory.pi.basic
import category_theory.shift
import category_theory.shift.basic
import category_theory.concrete_category.basic

/-!
Expand Down Expand Up @@ -106,11 +106,12 @@ instance has_shift {β : Type*} [add_comm_group β] (s : β) :
has_shift (graded_object_with_shift s C) ℤ :=
has_shift_mk _ _
{ F := λ n, comap (λ _, C) $ λ (b : β), b + n • s,
ε := (comap_id β (λ _, C)).symm ≪≫ (comap_eq C (by { ext, simp })),
μ := λ m n, comap_comp _ _ _ ≪≫ comap_eq C (by { ext, simp [add_zsmul, add_comm] }),
left_unitality := by { introv, ext, dsimp, simpa },
right_unitality := by { introv, ext, dsimp, simpa },
associativity := by { introv, ext, dsimp, simp } }
zero := comap_eq C (by { ext, simp }) ≪≫ comap_id β (λ _, C),
add := λ m n, comap_eq C (by { ext, simp [add_zsmul, add_comm], }) ≪≫
(comap_comp _ _ _).symm,
assoc_hom_app := λ m₁ m₂ m₃ X, by { ext, dsimp, simp, },
zero_add_hom_app := λ n X, by { ext, dsimp, simpa, },
add_zero_hom_app := λ n X, by { ext, dsimp, simpa, }, }

@[simp] lemma shift_functor_obj_apply {β : Type*} [add_comm_group β]
(s : β) (X : β → C) (t : β) (n : ℤ) :
Expand Down
Loading

0 comments on commit 6876fa1

Please sign in to comment.