/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Kenny Lau
-/
import data.finsupp.to_dfinsupp
import linear_algebra.basis

/-!
# Properties of the module `Π₀ i, M i`

Given an indexed collection of `R`-modules `M i`, the `R`-module structure on `Π₀ i, M i`
is defined in `data.dfinsupp`.

In this file we define `linear_map` versions of various maps:

* `dfinsupp.lsingle a : M →ₗ[R] Π₀ i, M i`: `dfinsupp.single a` as a linear map;

* `dfinsupp.lmk s : (Π i : (↑s : set ι), M i) →ₗ[R] Π₀ i, M i`: `dfinsupp.single a` as a linear map;

* `dfinsupp.lapply i : (Π₀ i, M i) →ₗ[R] M`: the map `λ f, f i` as a linear map;

* `dfinsupp.lsum`: `dfinsupp.sum` or `dfinsupp.lift_add_hom` as a `linear_map`;

## Implementation notes

This file should try to mirror `linear_algebra.finsupp` where possible. The API of `finsupp` is
much more developed, but many lemmas in that file should be eligible to copy over.

## Tags

function with finite support, module, linear algebra
-/

variables {ι : Type*} {R : Type*} {S : Type*} {M : ι → Type*} {N : Type*}

variables [dec_ι : decidable_eq ι]

namespace dfinsupp
variables [semiring R] [Π i, add_comm_monoid (M i)] [Π i, module R (M i)]
variables [add_comm_monoid N] [module R N]

include dec_ι

/-- `dfinsupp.mk` as a `linear_map`. -/
def lmk (s : finset ι) : (Π i : (↑s : set ι), M i) →ₗ[R] Π₀ i, M i :=
{ to_fun := mk s, map_add' := λ _ _, mk_add, map_smul' := λ c x, mk_smul c x}

/-- `dfinsupp.single` as a `linear_map` -/
def lsingle (i) : M i →ₗ[R] Π₀ i, M i :=
{ to_fun := single i, map_smul' := single_smul, .. dfinsupp.single_add_hom _ _ }

/-- Two `R`-linear maps from `Π₀ i, M i` which agree on each `single i x` agree everywhere. -/
lemma lhom_ext ⦃φ ψ : (Π₀ i, M i) →ₗ[R] N⦄
  (h : ∀ i x, φ (single i x) = ψ (single i x)) :
  φ = ψ :=
linear_map.to_add_monoid_hom_injective $ add_hom_ext h

/-- Two `R`-linear maps from `Π₀ i, M i` which agree on each `single i x` agree everywhere.

See note [partially-applied ext lemmas].
After apply this lemma, if `M = R` then it suffices to verify `φ (single a 1) = ψ (single a 1)`. -/
@[ext] lemma lhom_ext' ⦃φ ψ : (Π₀ i, M i) →ₗ[R] N⦄
  (h : ∀ i, φ.comp (lsingle i) = ψ.comp (lsingle i)) :
  φ = ψ :=
lhom_ext $ λ i, linear_map.congr_fun (h i)

omit dec_ι

/-- Interpret `λ (f : Π₀ i, M i), f i` as a linear map. -/
def lapply (i : ι) : (Π₀ i, M i) →ₗ[R] M i :=
{ to_fun := λ f, f i,
  map_add' := λ f g, add_apply f g i,
  map_smul' := λ c f, smul_apply c f i}

include dec_ι

@[simp] lemma lmk_apply (s : finset ι) (x) : (lmk s : _ →ₗ[R] Π₀ i, M i) x = mk s x := rfl

@[simp] lemma lsingle_apply (i : ι) (x : M i) : (lsingle i : _ →ₗ[R] _) x = single i x := rfl

omit dec_ι

@[simp] lemma lapply_apply (i : ι) (f : Π₀ i, M i) : (lapply i : _ →ₗ[R] _) f = f i := rfl

section lsum

/-- Typeclass inference can't find `dfinsupp.add_comm_monoid` without help for this case.
This instance allows it to be found where it is needed on the LHS of the colon in
`dfinsupp.module_of_linear_map`. -/
instance add_comm_monoid_of_linear_map : add_comm_monoid (Π₀ (i : ι), M i →ₗ[R] N) :=
@dfinsupp.add_comm_monoid _ (λ i, M i →ₗ[R] N) _

/-- Typeclass inference can't find `dfinsupp.module` without help for this case.
This is needed to define `dfinsupp.lsum` below.

The cause seems to be an inability to unify the `Π i, add_comm_monoid (M i →ₗ[R] N)` instance that
we have with the `Π i, has_zero (M i →ₗ[R] N)` instance which appears as a parameter to the
`dfinsupp` type. -/
instance module_of_linear_map [semiring S] [module S N] [smul_comm_class R S N] :
  module S (Π₀ (i : ι), M i →ₗ[R] N) :=
@dfinsupp.module _ _ (λ i, M i →ₗ[R] N) _ _ _

variables (S)

include dec_ι

/-- The `dfinsupp` version of `finsupp.lsum`.

See note [bundled maps over different rings] for why separate `R` and `S` semirings are used. -/
@[simps]
def lsum [semiring S] [module S N] [smul_comm_class R S N] :
  (Π i, M i →ₗ[R] N) ≃ₗ[S] ((Π₀ i, M i) →ₗ[R] N) :=
{ to_fun := λ F,
  { to_fun := sum_add_hom (λ i, (F i).to_add_monoid_hom),
    map_add' := (lift_add_hom (λ i, (F i).to_add_monoid_hom)).map_add,
    map_smul' := λ c f, by
    { dsimp,
      apply dfinsupp.induction f,
      { rw [smul_zero, add_monoid_hom.map_zero, smul_zero] },
      { intros a b f ha hb hf,
        rw [smul_add, add_monoid_hom.map_add, add_monoid_hom.map_add, smul_add, hf, ←single_smul,
          sum_add_hom_single, sum_add_hom_single, linear_map.to_add_monoid_hom_coe,
          linear_map.map_smul], } } },
  inv_fun := λ F i, F.comp (lsingle i),
  left_inv := λ F, by { ext x y, simp },
  right_inv := λ F, by { ext x y, simp },
  map_add' := λ F G, by { ext x y, simp },
  map_smul' := λ c F, by { ext, simp } }

/-- While `simp` can prove this, it is often convenient to avoid unfolding `lsum` into `sum_add_hom`
with `dfinsupp.lsum_apply_apply`. -/
lemma lsum_single [semiring S] [module S N] [smul_comm_class R S N]
  (F : Π i, M i →ₗ[R] N) (i) (x : M i) :
  lsum S F (single i x) = F i x :=
sum_add_hom_single _ _ _

end lsum

/-! ### Bundled versions of `dfinsupp.map_range`

The names should match the equivalent bundled `finsupp.map_range` definitions.
-/

section map_range

variables {β β₁ β₂: ι → Type*}
variables [Π i, add_comm_monoid (β i)] [Π i, add_comm_monoid (β₁ i)] [Π i, add_comm_monoid (β₂ i)]
variables [Π i, module R (β i)] [Π i, module R (β₁ i)] [Π i, module R (β₂ i)]

lemma map_range_smul (f : Π i, β₁ i → β₂ i) (hf : ∀ i, f i 0 = 0)
  (r : R) (hf' : ∀ i x, f i (r • x) = r • f i x) (g : Π₀ i, β₁ i):
  map_range f hf (r • g) = r • map_range f hf g :=
begin
  ext,
  simp only [map_range_apply f, coe_smul, pi.smul_apply, hf']
end

/-- `dfinsupp.map_range` as an `linear_map`. -/
@[simps apply]
def map_range.linear_map (f : Π i, β₁ i →ₗ[R] β₂ i) : (Π₀ i, β₁ i) →ₗ[R] (Π₀ i, β₂ i) :=
{ to_fun := map_range (λ i x, f i x) (λ i, (f i).map_zero),
  map_smul' := λ r, map_range_smul _ _ _ (λ i, (f i).map_smul r),
  .. map_range.add_monoid_hom (λ i, (f i).to_add_monoid_hom) }

@[simp]
lemma map_range.linear_map_id :
  map_range.linear_map (λ i, (linear_map.id : (β₂ i) →ₗ[R] _)) = linear_map.id :=
linear_map.ext map_range_id

lemma map_range.linear_map_comp (f : Π i, β₁ i →ₗ[R] β₂ i) (f₂ : Π i, β i →ₗ[R] β₁ i):
  map_range.linear_map (λ i, (f i).comp (f₂ i)) =
    (map_range.linear_map f).comp (map_range.linear_map f₂) :=
linear_map.ext $ map_range_comp (λ i x, f i x) (λ i x, f₂ i x) _ _ _

include dec_ι
lemma sum_map_range_index.linear_map
  [Π (i : ι) (x : β₁ i), decidable (x ≠ 0)] [Π (i : ι) (x : β₂ i), decidable (x ≠ 0)]
  {f : Π i, β₁ i →ₗ[R] β₂ i} {h : Π i, β₂ i →ₗ[R] N} {l : Π₀ i, β₁ i} :
  dfinsupp.lsum ℕ h (map_range.linear_map f l) = dfinsupp.lsum ℕ (λ i, (h i).comp (f i)) l :=
by simpa [dfinsupp.sum_add_hom_apply] using
  @sum_map_range_index ι N _ _ _ _ _ _ _ _ (λ i, f i) (λ i, by simp) l (λ i, h i) (λ i, by simp)
omit dec_ι

/-- `dfinsupp.map_range.linear_map` as an `linear_equiv`. -/
@[simps apply]
def map_range.linear_equiv (e : Π i, β₁ i ≃ₗ[R] β₂ i) : (Π₀ i, β₁ i) ≃ₗ[R] (Π₀ i, β₂ i) :=
{ to_fun := map_range (λ i x, e i x) (λ i, (e i).map_zero),
  inv_fun := map_range (λ i x, (e i).symm x) (λ i, (e i).symm.map_zero),
  .. map_range.add_equiv (λ i, (e i).to_add_equiv),
  .. map_range.linear_map (λ i, (e i).to_linear_map) }

@[simp]
lemma map_range.linear_equiv_refl :
  (map_range.linear_equiv $ λ i, linear_equiv.refl R (β₁ i)) = linear_equiv.refl _ _ :=
linear_equiv.ext map_range_id

lemma map_range.linear_equiv_trans (f : Π i, β i ≃ₗ[R] β₁ i) (f₂ : Π i, β₁ i ≃ₗ[R] β₂ i):
  map_range.linear_equiv (λ i, (f i).trans (f₂ i)) =
    (map_range.linear_equiv f).trans (map_range.linear_equiv f₂) :=
linear_equiv.ext $ map_range_comp (λ i x, f₂ i x) (λ i x, f i x) _ _ _

@[simp]
lemma map_range.linear_equiv_symm (e : Π i, β₁ i ≃ₗ[R] β₂ i) :
  (map_range.linear_equiv e).symm = map_range.linear_equiv (λ i, (e i).symm) := rfl

end map_range

section basis

/-- The direct sum of free modules is free.

Note that while this is stated for `dfinsupp` not `direct_sum`, the types are defeq. -/
noncomputable def basis {η : ι → Type*} (b : Π i, basis (η i) R (M i)) :
  basis (Σ i, η i) R (Π₀ i, M i) :=
basis.of_repr ((map_range.linear_equiv (λ i, (b i).repr)).trans
  (sigma_finsupp_lequiv_dfinsupp R).symm)

end basis

end dfinsupp

include dec_ι

namespace submodule
variables [semiring R] [add_comm_monoid N] [module R N]
open dfinsupp

lemma dfinsupp_sum_mem {β : ι → Type*} [Π i, has_zero (β i)]
  [Π i (x : β i), decidable (x ≠ 0)] (S : submodule R N)
  (f : Π₀ i, β i) (g : Π i, β i → N) (h : ∀ c, f c ≠ 0 → g c (f c) ∈ S) : f.sum g ∈ S :=
S.to_add_submonoid.dfinsupp_sum_mem f g h

lemma dfinsupp_sum_add_hom_mem {β : ι → Type*} [Π i, add_zero_class (β i)]
  (S : submodule R N) (f : Π₀ i, β i) (g : Π i, β i →+ N) (h : ∀ c, f c ≠ 0 → g c (f c) ∈ S) :
  dfinsupp.sum_add_hom g f ∈ S :=
S.to_add_submonoid.dfinsupp_sum_add_hom_mem f g h

/-- The supremum of a family of submodules is equal to the range of `dfinsupp.lsum`; that is
every element in the `supr` can be produced from taking a finite number of non-zero elements
of `p i`, coercing them to `N`, and summing them. -/
lemma supr_eq_range_dfinsupp_lsum (p : ι → submodule R N) :
  supr p = (dfinsupp.lsum ℕ (λ i, (p i).subtype)).range :=
begin
  apply le_antisymm,
  { apply supr_le _,
    intros i y hy,
    exact ⟨dfinsupp.single i ⟨y, hy⟩, dfinsupp.sum_add_hom_single _ _ _⟩, },
  { rintros x ⟨v, rfl⟩,
    exact dfinsupp_sum_add_hom_mem _ v _ (λ i _, (le_supr p i : p i ≤ _) (v i).prop) }
end

/-- The bounded supremum of a family of commutative additive submonoids is equal to the range of
`dfinsupp.sum_add_hom` composed with `dfinsupp.filter_add_monoid_hom`; that is, every element in the
bounded `supr` can be produced from taking a finite number of non-zero elements from the `S i` that
satisfy `p i`, coercing them to `γ`, and summing them. -/
lemma bsupr_eq_range_dfinsupp_lsum (p : ι → Prop)
  [decidable_pred p] (S : ι → submodule R N) :
  (⨆ i (h : p i), S i) =
    ((dfinsupp.lsum ℕ (λ i, (S i).subtype)).comp (dfinsupp.filter_linear_map R _ p)).range :=
begin
  apply le_antisymm,
  { apply bsupr_le _,
    intros i hi y hy,
    refine ⟨dfinsupp.single i ⟨y, hy⟩, _⟩,
    rw [linear_map.comp_apply, filter_linear_map_apply, filter_single_pos _ _ hi],
    exact dfinsupp.sum_add_hom_single _ _ _, },
  { rintros x ⟨v, rfl⟩,
    refine dfinsupp_sum_add_hom_mem _ _ _ (λ i hi, _),
    refine mem_supr_of_mem i _,
    by_cases hp : p i,
    { simp [hp], },
    { simp [hp] }, }
end

lemma mem_supr_iff_exists_dfinsupp (p : ι → submodule R N) (x : N) :
  x ∈ supr p ↔ ∃ f : Π₀ i, p i, dfinsupp.lsum ℕ (λ i, (p i).subtype) f = x :=
set_like.ext_iff.mp (supr_eq_range_dfinsupp_lsum p) x

/-- A variant of `submodule.mem_supr_iff_exists_dfinsupp` with the RHS fully unfolded. -/
lemma mem_supr_iff_exists_dfinsupp' (p : ι → submodule R N) [Π i (x : p i), decidable (x ≠ 0)]
  (x : N) :
  x ∈ supr p ↔ ∃ f : Π₀ i, p i, f.sum (λ i xi, ↑xi) = x :=
begin
  rw mem_supr_iff_exists_dfinsupp,
  simp_rw [dfinsupp.lsum_apply_apply, dfinsupp.sum_add_hom_apply],
  congr',
end

lemma mem_bsupr_iff_exists_dfinsupp (p : ι → Prop) [decidable_pred p] (S : ι → submodule R N)
  (x : N) :
  x ∈ (⨆ i (h : p i), S i) ↔
    ∃ f : Π₀ i, S i, dfinsupp.lsum ℕ (λ i, (S i).subtype) (f.filter p) = x :=
set_like.ext_iff.mp (bsupr_eq_range_dfinsupp_lsum p S) x

end submodule

namespace complete_lattice

open dfinsupp

section semiring
variables [semiring R] [add_comm_monoid N] [module R N]

/-- Independence of a family of submodules can be expressed as a quantifier over `dfinsupp`s.

This is an intermediate result used to prove
`complete_lattice.independent_of_dfinsupp_lsum_injective` and
`complete_lattice.independent.dfinsupp_lsum_injective`. -/
lemma independent_iff_forall_dfinsupp (p : ι → submodule R N) :
  independent p ↔
    ∀ i (x : p i) (v : Π₀ (i : ι), ↥(p i)), lsum ℕ (λ i, (p i).subtype) (erase i v) = x → x = 0 :=
begin
  simp_rw [complete_lattice.independent_def, submodule.disjoint_def,
    submodule.mem_bsupr_iff_exists_dfinsupp, exists_imp_distrib, filter_ne_eq_erase],
  apply forall_congr (λ i, _),
  refine subtype.forall'.trans _,
  simp_rw submodule.coe_eq_zero,
  refl,
end

/- If `dfinsupp.lsum` applied with `submodule.subtype` is injective then the submodules are
independent. -/
lemma independent_of_dfinsupp_lsum_injective (p : ι → submodule R N)
  (h : function.injective (lsum ℕ (λ i, (p i).subtype))) :
  independent p :=
begin
  rw independent_iff_forall_dfinsupp,
  intros i x v hv,
  replace hv : lsum ℕ (λ i, (p i).subtype) (erase i v) = lsum ℕ (λ i, (p i).subtype) (single i x),
  { simpa only [lsum_single] using hv, },
  have := dfinsupp.ext_iff.mp (h hv) i,
  simpa [eq_comm] using this,
end

/- If `dfinsupp.sum_add_hom` applied with `add_submonoid.subtype` is injective then the additive
submonoids are independent. -/
lemma independent_of_dfinsupp_sum_add_hom_injective (p : ι → add_submonoid N)
  (h : function.injective (sum_add_hom (λ i, (p i).subtype))) :
  independent p :=
begin
  rw ←independent_map_order_iso_iff (add_submonoid.to_nat_submodule : add_submonoid N ≃o _),
  exact independent_of_dfinsupp_lsum_injective _ h,
end

/-- Combining `dfinsupp.lsum` with `linear_map.to_span_singleton` is the same as `finsupp.total` -/
lemma lsum_comp_map_range_to_span_singleton
  [Π (m : R), decidable (m ≠ 0)]
  (p : ι → submodule R N) {v : ι → N} (hv : ∀ (i : ι), v i ∈ p i) :
  ((lsum ℕ) (λ i, (p i).subtype) : _ →ₗ[R] _).comp
    ((map_range.linear_map
      (λ i, linear_map.to_span_singleton R ↥(p i) ⟨v i, hv i⟩) : _ →ₗ[R] _).comp
      (finsupp_lequiv_dfinsupp R : (ι →₀ R) ≃ₗ[R] _).to_linear_map) =
  finsupp.total ι N R v :=
by { ext, simp }

end semiring

section ring
variables [ring R] [add_comm_group N] [module R N]

/- If `dfinsupp.sum_add_hom` applied with `add_submonoid.subtype` is injective then the additive
subgroups are independent. -/
lemma independent_of_dfinsupp_sum_add_hom_injective' (p : ι → add_subgroup N)
  (h : function.injective (sum_add_hom (λ i, (p i).subtype))) :
  independent p :=
begin
  rw ←independent_map_order_iso_iff (add_subgroup.to_int_submodule : add_subgroup N ≃o _),
  exact independent_of_dfinsupp_lsum_injective _ h,
end

/-- The canonical map out of a direct sum of a family of submodules is injective when the submodules
are `complete_lattice.independent`.

Note that this is not generally true for `[semiring R]`, for instance when `A` is the
`ℕ`-submodules of the positive and negative integers.

See `counterexamples/direct_sum_is_internal.lean` for a proof of this fact. -/
lemma independent.dfinsupp_lsum_injective {p : ι → submodule R N}
  (h : independent p) : function.injective (lsum ℕ (λ i, (p i).subtype)) :=
begin
  -- simplify everything down to binders over equalities in `N`
  rw independent_iff_forall_dfinsupp at h,
  suffices : (lsum ℕ (λ i, (p i).subtype)).ker = ⊥,
  { -- Lean can't find this without our help
    letI : add_comm_group (Π₀ i, p i) := @dfinsupp.add_comm_group _ (λ i, p i) _,
    rw linear_map.ker_eq_bot at this, exact this },
  rw linear_map.ker_eq_bot',
  intros m hm,
  ext i : 1,
  -- split `m` into the piece at `i` and the pieces elsewhere, to match `h`
  rw [dfinsupp.zero_apply, ←neg_eq_zero],
  refine h i (-m i) m _,
  rwa [←erase_add_single i m, linear_map.map_add, lsum_single, submodule.subtype_apply,
    add_eq_zero_iff_eq_neg, ←submodule.coe_neg] at hm,
end

/-- The canonical map out of a direct sum of a family of additive subgroups is injective when the
additive subgroups are `complete_lattice.independent`. -/
lemma independent.dfinsupp_sum_add_hom_injective {p : ι → add_subgroup N}
  (h : independent p) : function.injective (sum_add_hom (λ i, (p i).subtype)) :=
begin
  rw ←independent_map_order_iso_iff (add_subgroup.to_int_submodule : add_subgroup N ≃o _) at h,
  exact h.dfinsupp_lsum_injective,
end

/-- A family of submodules over an additive group are independent if and only iff `dfinsupp.lsum`
applied with `submodule.subtype` is injective.

Note that this is not generally true for `[semiring R]`; see
`complete_lattice.independent.dfinsupp_lsum_injective` for details. -/
lemma independent_iff_dfinsupp_lsum_injective (p : ι → submodule R N) :
  independent p ↔ function.injective (lsum ℕ (λ i, (p i).subtype)) :=
⟨independent.dfinsupp_lsum_injective, independent_of_dfinsupp_lsum_injective p⟩

/-- A family of additive subgroups over an additive group are independent if and only if
`dfinsupp.sum_add_hom` applied with `add_subgroup.subtype` is injective. -/
lemma independent_iff_dfinsupp_sum_add_hom_injective (p : ι → add_subgroup N) :
  independent p ↔ function.injective (sum_add_hom (λ i, (p i).subtype)) :=
⟨independent.dfinsupp_sum_add_hom_injective, independent_of_dfinsupp_sum_add_hom_injective' p⟩

omit dec_ι
/-- If a family of submodules is `independent`, then a choice of nonzero vector from each submodule
forms a linearly independent family. -/
lemma independent.linear_independent [no_zero_smul_divisors R N] (p : ι → submodule R N)
  (hp : complete_lattice.independent p) {v : ι → N} (hv : ∀ i, v i ∈ p i) (hv' : ∀ i, v i ≠ 0) :
  linear_independent R v :=
begin
  classical,
  rw linear_independent_iff,
  intros l hl,
  let a := dfinsupp.map_range.linear_map
    (λ i, linear_map.to_span_singleton R (p i) (⟨v i, hv i⟩)) l.to_dfinsupp,
  have ha : a = 0,
  { apply hp.dfinsupp_lsum_injective,
    rwa ←lsum_comp_map_range_to_span_singleton _ hv at hl },
  ext i,
  apply smul_left_injective R (hv' i),
  have : l i • v i = a i := rfl,
  simp [this, ha],
end

end ring

end complete_lattice


import topology.algebra.ordered
import topology.instances.real

-- `set_of_is_preconnected_eq_of_ordered` is the useful lemma
variables {X : Type} [topological_space X] [preconnected_space X]

#check @set_of_is_preconnected_eq_of_ordered

example (P Q R : Prop) (h : P ∨ Q ∨ R) (hQ : ¬ Q) : P ∨ R :=
or.cases_on h or.inl (λ h', or.inr (or.resolve_left h' hQ))

-- Shorter IVT-ish
example (f : X → ℝ) (hf : continuous f) (a b : X) (r : ℝ) (ha : f a < r) (hb : r < f b) :
  ∃ c, f c = r :=
by_contra $ λ h,
have h : ∀ x, f x ≠ r, from not_exists.mp h,
have h₁ : disjoint (f ⁻¹' (set.Iio r)) (f ⁻¹' (set.Ioi r)) := λ t h, lt_asymm h.1 h.2,
have h₂ : set.univ ⊆ (f ⁻¹' (set.Iio r)) ∪ (f ⁻¹' (set.Ioi r)) := set.univ_subset_iff.mpr
  (set.eq_univ_of_forall (λ x, or.cases_on (lt_trichotomy r (f x)) or.inr
    (λ h', or.inl (or.resolve_left h' (h x).symm)))),
let ⟨_, hx⟩ := is_preconnected_univ _ _ (continuous.is_open_preimage hf _ is_open_Iio)
    (continuous.is_open_preimage hf _ is_open_Ioi) h₂ ⟨a, by rwa set.univ_inter⟩ ⟨b, by rwa set.univ_inter⟩ in
h₁ $ by rwa set.univ_inter at hx


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

import measure_theory.measure.regular
import measure_theory.function.simple_func_dense_lp
import topology.urysohns_lemma
import measure_theory.function.l1_space

/-!
# Approximation in Lᵖ by continuous functions

This file proves that bounded continuous functions are dense in `Lp E p μ`, for `1 ≤ p < ∞`, if the
domain `α` of the functions is a normal topological space and the measure `μ` is weakly regular.

The result is presented in several versions:
* `measure_theory.Lp.bounded_continuous_function_dense`: The subgroup
  `measure_theory.Lp.bounded_continuous_function` of `Lp E p μ`, the additive subgroup of
  `Lp E p μ` consisting of equivalence classes containing a continuous representative, is dense in
  `Lp E p μ`.
* `bounded_continuous_function.to_Lp_dense_range`: For finite-measure `μ`, the continuous linear
  map `bounded_continuous_function.to_Lp p μ 𝕜` from `α →ᵇ E` to `Lp E p μ` has dense range.
* `continuous_map.to_Lp_dense_range`: For compact `α` and finite-measure `μ`, the continuous linear
  map `continuous_map.to_Lp p μ 𝕜` from `C(α, E)` to `Lp E p μ` has dense range.

Note that for `p = ∞` this result is not true:  the characteristic function of the set `[0, ∞)` in
`ℝ` cannot be continuously approximated in `L∞`.

The proof is in three steps.  First, since simple functions are dense in `Lp`, it suffices to prove
the result for a scalar multiple of a characteristic function of a measurable set `s`. Secondly,
since the measure `μ` is weakly regular, the set `s` can be approximated above by an open set and
below by a closed set.  Finally, since the domain `α` is normal, we use Urysohn's lemma to find a
continuous function interpolating between these two sets.

## Related results

Are you looking for a result on "directional" approximation (above or below with respect to an
order) of functions whose codomain is `ℝ≥0∞` or `ℝ`, by semicontinuous functions?  See the
Vitali-Carathéodory theorem, in the file `measure_theory.vitali_caratheodory`.

-/

open_locale ennreal nnreal topological_space bounded_continuous_function
open measure_theory topological_space continuous_map

variables {α : Type*} [measurable_space α] [topological_space α] [normal_space α] [borel_space α]
variables (E : Type*) [normed_group E]
  [second_countable_topology_either α E]
variables {p : ℝ≥0∞} [_i : fact (1 ≤ p)] (hp : p ≠ ∞) (μ : measure α)

include _i hp

namespace measure_theory.Lp

variables [normed_space ℝ E]

/-- A function in `Lp` can be approximated in `Lp` by continuous functions. -/
lemma bounded_continuous_function_dense [μ.weakly_regular] :
  (bounded_continuous_function E p μ).topological_closure = ⊤ :=
begin
  have hp₀ : 0 < p := lt_of_lt_of_le ennreal.zero_lt_one _i.elim,
  have hp₀' : 0 ≤ 1 / p.to_real := div_nonneg zero_le_one ennreal.to_real_nonneg,
  have hp₀'' : 0 < p.to_real,
  { simpa [← ennreal.to_real_lt_to_real ennreal.zero_ne_top hp] using hp₀ },
  -- It suffices to prove that scalar multiples of the indicator function of a finite-measure
  -- measurable set can be approximated by continuous functions
  suffices :  ∀ (c : E) {s : set α} (hs : measurable_set s) (hμs : μ s < ⊤),
    (Lp.simple_func.indicator_const p hs hμs.ne c : Lp E p μ)
      ∈ (bounded_continuous_function E p μ).topological_closure,
  { rw add_subgroup.eq_top_iff',
    refine Lp.induction hp _ _ _ _,
    { exact this },
    { exact λ f g hf hg hfg', add_subgroup.add_mem _ },
    { exact add_subgroup.is_closed_topological_closure _ } },
  -- Let `s` be a finite-measure measurable set, let's approximate `c` times its indicator function
  intros c s hs hsμ,
  refine mem_closure_iff_frequently.mpr _,
  rw metric.nhds_basis_closed_ball.frequently_iff,
  intros ε hε,
  -- A little bit of pre-emptive work, to find `η : ℝ≥0` which will be a margin small enough for
  -- our purposes
  obtain ⟨η, hη_pos, hη_le⟩ : ∃ η, 0 < η ∧ (↑(∥bit0 (∥c∥)∥₊ * (2 * η) ^ (1 / p.to_real)) : ℝ) ≤ ε,
  { have : filter.tendsto (λ x : ℝ≥0, ∥bit0 (∥c∥)∥₊ * (2 * x) ^ (1 / p.to_real)) (𝓝 0) (𝓝 0),
    { have : filter.tendsto (λ x : ℝ≥0, 2 * x) (𝓝 0) (𝓝 (2 * 0)) := filter.tendsto_id.const_mul 2,
      convert ((nnreal.continuous_at_rpow_const (or.inr hp₀')).tendsto.comp this).const_mul _,
      simp [hp₀''.ne'] },
    let ε' : ℝ≥0 := ⟨ε, hε.le⟩,
    have hε' : 0 < ε' := by exact_mod_cast hε,
    obtain ⟨δ, hδ, hδε'⟩ :=
      nnreal.nhds_zero_basis.eventually_iff.mp (eventually_le_of_tendsto_lt hε' this),
    obtain ⟨η, hη, hηδ⟩ := exists_between hδ,
    refine ⟨η, hη, _⟩,
    exact_mod_cast hδε' hηδ },
  have hη_pos' : (0 : ℝ≥0∞) < η := ennreal.coe_pos.2 hη_pos,
  -- Use the regularity of the measure to `η`-approximate `s` by an open superset and a closed
  -- subset
  obtain ⟨u, su, u_open, μu⟩ : ∃ u ⊇ s, is_open u ∧ μ u < μ s + ↑η,
  { refine s.exists_is_open_lt_of_lt _ _,
    simpa using ennreal.add_lt_add_left hsμ.ne hη_pos' },
  obtain ⟨F, Fs, F_closed, μF⟩ : ∃ F ⊆ s, is_closed F ∧ μ s < μ F + ↑η :=
    hs.exists_is_closed_lt_add hsμ.ne hη_pos'.ne',
  have : disjoint uᶜ F,
  { rw [set.disjoint_iff_inter_eq_empty, set.inter_comm, ← set.subset_compl_iff_disjoint],
    simpa using Fs.trans su },
  have h_μ_sdiff : μ (u \ F) ≤ 2 * η,
  { have hFμ : μ F < ⊤ := (measure_mono Fs).trans_lt hsμ,
    refine ennreal.le_of_add_le_add_left hFμ.ne _,
    have : μ u < μ F + ↑η + ↑η,
      from μu.trans (ennreal.add_lt_add_right ennreal.coe_ne_top μF),
    convert this.le using 1,
    { rw [add_comm, ← measure_union, set.diff_union_of_subset (Fs.trans su)],
      exacts [disjoint_sdiff_self_left, F_closed.measurable_set] },
    have : (2:ℝ≥0∞) * η = η + η := by simpa using add_mul (1:ℝ≥0∞) 1 η,
    rw this,
    abel },
  -- Apply Urysohn's lemma to get a continuous approximation to the characteristic function of
  -- the set `s`
  obtain ⟨g, hgu, hgF, hg_range⟩ :=
    exists_continuous_zero_one_of_closed u_open.is_closed_compl F_closed this,
  -- Multiply this by `c` to get a continuous approximation to the function `f`; the key point is
  -- that this is pointwise bounded by the indicator of the set `u \ F`
  have g_norm : ∀ x, ∥g x∥ = g x := λ x, by rw [real.norm_eq_abs, abs_of_nonneg (hg_range x).1],
  have gc_bd : ∀ x, ∥g x • c - s.indicator (λ x, c) x∥ ≤ ∥(u \ F).indicator (λ x, bit0 ∥c∥) x∥,
  { intros x,
    by_cases hu : x ∈ u,
    { rw ← set.diff_union_of_subset (Fs.trans su) at hu,
      cases hu with hFu hF,
      { refine (norm_sub_le _ _).trans _,
        refine (add_le_add_left (norm_indicator_le_norm_self (λ x, c) x) _).trans _,
        have h₀ : g x * ∥c∥ + ∥c∥ ≤ 2 * ∥c∥,
        { nlinarith [(hg_range x).1, (hg_range x).2, norm_nonneg c] },
        have h₁ : (2:ℝ) * ∥c∥ = bit0 (∥c∥) := by simpa using add_mul (1:ℝ) 1 (∥c∥),
        simp [hFu, norm_smul, h₀, ← h₁, g_norm x] },
      { simp [hgF hF, Fs hF] } },
    { have : x ∉ s := λ h, hu (su h),
      simp [hgu hu, this] } },
  -- The rest is basically just `ennreal`-arithmetic
  have gc_snorm : snorm ((λ x, g x • c) - s.indicator (λ x, c)) p μ
    ≤ (↑(∥bit0 (∥c∥)∥₊ * (2 * η) ^ (1 / p.to_real)) : ℝ≥0∞),
  { refine (snorm_mono_ae (filter.eventually_of_forall gc_bd)).trans _,
    rw snorm_indicator_const (u_open.sdiff F_closed).measurable_set hp₀.ne' hp,
    push_cast [← ennreal.coe_rpow_of_nonneg _ hp₀'],
    exact ennreal.mul_left_mono (ennreal.monotone_rpow_of_nonneg hp₀' h_μ_sdiff) },
  have gc_cont : continuous (λ x, g x • c) := g.continuous.smul continuous_const,
  have gc_mem_ℒp : mem_ℒp (λ x, g x • c) p μ,
  { have : mem_ℒp ((λ x, g x • c) - s.indicator (λ x, c)) p μ :=
    ⟨gc_cont.ae_strongly_measurable.sub (strongly_measurable_const.indicator hs)
        .ae_strongly_measurable,
      gc_snorm.trans_lt ennreal.coe_lt_top⟩,
    simpa using this.add (mem_ℒp_indicator_const p hs c (or.inr hsμ.ne)) },
  refine ⟨gc_mem_ℒp.to_Lp _, _, _⟩,
  { rw mem_closed_ball_iff_norm,
    refine le_trans _ hη_le,
    rw [simple_func.coe_indicator_const, indicator_const_Lp, ← mem_ℒp.to_Lp_sub, Lp.norm_to_Lp],
    exact ennreal.to_real_le_coe_of_le_coe gc_snorm },
  { rw [set_like.mem_coe, mem_bounded_continuous_function_iff],
    refine ⟨bounded_continuous_function.of_normed_group _ gc_cont (∥c∥) _, rfl⟩,
    intros x,
    have h₀ : g x * ∥c∥ ≤ ∥c∥,
    { nlinarith [(hg_range x).1, (hg_range x).2, norm_nonneg c] },
    simp [norm_smul, g_norm x, h₀] },
end

end measure_theory.Lp

variables (𝕜 : Type*) [normed_field 𝕜] [normed_algebra ℝ 𝕜] [normed_space 𝕜 E]

namespace bounded_continuous_function

lemma to_Lp_dense_range [μ.weakly_regular] [is_finite_measure μ] :
  dense_range ⇑(to_Lp p μ 𝕜 : (α →ᵇ E) →L[𝕜] Lp E p μ) :=
begin
  haveI : normed_space ℝ E := restrict_scalars.normed_space ℝ 𝕜 E,
  rw dense_range_iff_closure_range,
  suffices : (to_Lp p μ 𝕜 : _ →L[𝕜] Lp E p μ).range.to_add_subgroup.topological_closure = ⊤,
  { exact congr_arg coe this },
  simp [range_to_Lp p μ, measure_theory.Lp.bounded_continuous_function_dense E hp],
end

end bounded_continuous_function

namespace continuous_map

lemma to_Lp_dense_range [compact_space α] [μ.weakly_regular] [is_finite_measure μ] :
  dense_range ⇑(to_Lp p μ 𝕜 : C(α, E) →L[𝕜] Lp E p μ) :=
begin
  haveI : normed_space ℝ E := restrict_scalars.normed_space ℝ 𝕜 E,
  rw dense_range_iff_closure_range,
  suffices : (to_Lp p μ 𝕜 : _ →L[𝕜] Lp E p μ).range.to_add_subgroup.topological_closure = ⊤,
  { exact congr_arg coe this },
  simp [range_to_Lp p μ, measure_theory.Lp.bounded_continuous_function_dense E hp]
end

end continuous_map


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Johan Commelin, Andrew Yang, Joël Riou

! This file was ported from Lean 3 source module category_theory.shift.basic
! leanprover-community/mathlib commit 6876fa15e3158ff3e4a4e2af1fb6e1945c6e8803
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Limits.Preserves.Shapes.Zero
import Mathbin.CategoryTheory.Monoidal.End
import Mathbin.CategoryTheory.Monoidal.Discrete

/-!
# Shift

A `shift` on a category `C` indexed by a monoid `A` is nothing more than a monoidal functor
from `A` to `C ⥤ C`. A typical example to keep in mind might be the category of
complexes `⋯ → C_{n-1} → C_n → C_{n+1} → ⋯`. It has a shift indexed by `ℤ`, where we assign to
each `n : ℤ` the functor `C ⥤ C` that re-indexes the terms, so the degree `i` term of `shift n C`
would be the degree `i+n`-th term of `C`.

## Main definitions
* `has_shift`: A typeclass asserting the existence of a shift functor.
* `shift_equiv`: When the indexing monoid is a group, then the functor indexed by `n` and `-n` forms
  an self-equivalence of `C`.
* `shift_comm`: When the indexing monoid is commutative, then shifts commute as well.

## Implementation Notes

`[has_shift C A]` is implemented using `monoidal_functor (discrete A) (C ⥤ C)`.
However, the API of monodial functors is used only internally: one should use the API of
shifts functors which includes `shift_functor C a : C ⥤ C` for `a : A`,
`shift_functor_zero C A : shift_functor C (0 : A) ≅ 𝟭 C` and
`shift_functor_add C i j : shift_functor C (i + j) ≅ shift_functor C i ⋙ shift_functor C j`
(and its variant `shift_functor_add'`). These isomorphisms satisfy some coherence properties
which are stated in lemmas like `shift_functor_add'_assoc`, `shift_functor_add'_zero_add` and
`shift_functor_add'_add_zero`.

-/

namespace CategoryTheory

noncomputable section

universe v u

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

attribute [local instance] endofunctor_monoidal_category

section Defs

variable (A C) [AddMonoid A]

/-- A category has a shift indexed by an additive monoid `A`
if there is a monoidal functor from `A` to `C ⥤ C`. -/
class HasShift (C : Type u) (A : Type _) [Category.{v} C] [AddMonoid A] where
  shift : MonoidalFunctor (Discrete A) (C ⥤ C)
#align category_theory.has_shift CategoryTheory.HasShift

/-- A helper structure to construct the shift functor `(discrete A) ⥤ (C ⥤ C)`. -/
@[nolint has_nonempty_instance]
structure ShiftMkCore where
  f : A → C ⥤ C
  zero : F 0 ≅ 𝟭 C
  add : ∀ n m : A, F (n + m) ≅ F n ⋙ F m
  assoc_hom_app :
    ∀ (m₁ m₂ m₃ : A) (X : C),
      (add (m₁ + m₂) m₃).Hom.app X ≫ (F m₃).map ((add m₁ m₂).Hom.app X) =
        eqToHom (by rw [add_assoc]) ≫
          (add m₁ (m₂ + m₃)).Hom.app X ≫ (add m₂ m₃).Hom.app ((F m₁).obj X)
  zero_add_hom_app :
    ∀ (n : A) (X : C),
      (add 0 n).Hom.app X = eqToHom (by dsimp <;> rw [zero_add]) ≫ (F n).map (zero.inv.app X)
  add_zero_hom_app :
    ∀ (n : A) (X : C),
      (add n 0).Hom.app X = eqToHom (by dsimp <;> rw [add_zero]) ≫ zero.inv.app ((F n).obj X)
#align category_theory.shift_mk_core CategoryTheory.ShiftMkCore

namespace ShiftMkCore

variable {C A}

attribute [reassoc.1] assoc_hom_app

@[reassoc.1]
theorem assoc_inv_app (h : ShiftMkCore C A) (m₁ m₂ m₃ : A) (X : C) :
    (h.f m₃).map ((h.add m₁ m₂).inv.app X) ≫ (h.add (m₁ + m₂) m₃).inv.app X =
      (h.add m₂ m₃).inv.app ((h.f m₁).obj X) ≫
        (h.add m₁ (m₂ + m₃)).inv.app X ≫ eqToHom (by rw [add_assoc]) :=
  by
  rw [← cancel_mono ((h.add (m₁ + m₂) m₃).Hom.app X ≫ (h.F m₃).map ((h.add m₁ m₂).Hom.app X)),
    category.assoc, category.assoc, category.assoc, iso.inv_hom_id_app_assoc, ← functor.map_comp,
    iso.inv_hom_id_app, Functor.map_id, h.assoc_hom_app, eq_to_hom_trans_assoc, eq_to_hom_refl,
    category.id_comp, iso.inv_hom_id_app_assoc, iso.inv_hom_id_app]
  rfl
#align category_theory.shift_mk_core.assoc_inv_app CategoryTheory.ShiftMkCore.assoc_inv_app

theorem zero_add_inv_app (h : ShiftMkCore C A) (n : A) (X : C) :
    (h.add 0 n).inv.app X = (h.f n).map (h.zero.Hom.app X) ≫ eqToHom (by dsimp <;> rw [zero_add]) :=
  by
  rw [← cancel_epi ((h.add 0 n).Hom.app X), iso.hom_inv_id_app, h.zero_add_hom_app, category.assoc,
    ← functor.map_comp_assoc, iso.inv_hom_id_app, Functor.map_id, category.id_comp, eq_to_hom_trans,
    eq_to_hom_refl]
#align category_theory.shift_mk_core.zero_add_inv_app CategoryTheory.ShiftMkCore.zero_add_inv_app

theorem add_zero_inv_app (h : ShiftMkCore C A) (n : A) (X : C) :
    (h.add n 0).inv.app X = h.zero.Hom.app ((h.f n).obj X) ≫ eqToHom (by dsimp <;> rw [add_zero]) :=
  by
  rw [← cancel_epi ((h.add n 0).Hom.app X), iso.hom_inv_id_app, h.add_zero_hom_app, category.assoc,
    iso.inv_hom_id_app_assoc, eq_to_hom_trans, eq_to_hom_refl]
#align category_theory.shift_mk_core.add_zero_inv_app CategoryTheory.ShiftMkCore.add_zero_inv_app

end ShiftMkCore

section

attribute [local simp] eq_to_hom_map

attribute [local reducible] endofunctor_monoidal_category Discrete.addMonoidal

/-- Constructs a `has_shift C A` instance from `shift_mk_core`. -/
def hasShiftMk (h : ShiftMkCore C A) : HasShift C A :=
  ⟨{ Discrete.functor h.f with
      ε := h.zero.inv
      μ := fun m n => (h.add m.as n.as).inv
      μ_natural' := by
        rintro ⟨X⟩ ⟨Y⟩ ⟨X'⟩ ⟨Y'⟩ ⟨⟨⟨rfl⟩⟩⟩ ⟨⟨⟨rfl⟩⟩⟩
        ext
        dsimp
        simp only [discrete.functor_map_id, category.assoc]
        dsimp
        simp
      associativity' := by
        rintro ⟨m₁⟩ ⟨m₂⟩ ⟨m₃⟩
        ext X
        dsimp
        simp [h.assoc_inv_app_assoc m₁ m₂ m₃ X]
      left_unitality' := by
        rintro ⟨n⟩
        ext X
        dsimp
        simp only [h.zero_add_inv_app, ← functor.map_comp, category.id_comp, eq_to_hom_map,
          eq_to_hom_app, category.assoc, eq_to_hom_trans, eq_to_hom_refl, category.comp_id,
          iso.inv_hom_id_app]
        erw [Functor.map_id]
      right_unitality' := by
        rintro ⟨n⟩
        ext X
        dsimp
        simpa only [h.add_zero_inv_app, Functor.map_id, category.comp_id, eq_to_hom_map,
          eq_to_hom_app, category.assoc, eq_to_hom_trans, eq_to_hom_refl, iso.inv_hom_id_app] }⟩
#align category_theory.has_shift_mk CategoryTheory.hasShiftMk

end

section

variable [HasShift C A]

/-- The monoidal functor from `A` to `C ⥤ C` given a `has_shift` instance. -/
def shiftMonoidalFunctor : MonoidalFunctor (Discrete A) (C ⥤ C) :=
  HasShift.shift
#align category_theory.shift_monoidal_functor CategoryTheory.shiftMonoidalFunctor

variable {A}

/-- The shift autoequivalence, moving objects and morphisms 'up'. -/
def shiftFunctor (i : A) : C ⥤ C :=
  (shiftMonoidalFunctor C A).obj ⟨i⟩
#align category_theory.shift_functor CategoryTheory.shiftFunctor

/-- Shifting by `i + j` is the same as shifting by `i` and then shifting by `j`. -/
def shiftFunctorAdd (i j : A) : shiftFunctor C (i + j) ≅ shiftFunctor C i ⋙ shiftFunctor C j :=
  ((shiftMonoidalFunctor C A).μIso ⟨i⟩ ⟨j⟩).symm
#align category_theory.shift_functor_add CategoryTheory.shiftFunctorAdd

/-- When `k = i + j`, shifting by `k` is the same as shifting by `i` and then shifting by `j`. -/
def shiftFunctorAdd' (i j k : A) (h : i + j = k) :
    shiftFunctor C k ≅ shiftFunctor C i ⋙ shiftFunctor C j :=
  eqToIso (by rw [h]) ≪≫ shiftFunctorAdd C i j
#align category_theory.shift_functor_add' CategoryTheory.shiftFunctorAdd'

theorem shiftFunctorAdd'_eq_shiftFunctorAdd (i j : A) :
    shiftFunctorAdd' C i j (i + j) rfl = shiftFunctorAdd C i j :=
  by
  ext1
  apply category.id_comp
#align category_theory.shift_functor_add'_eq_shift_functor_add CategoryTheory.shiftFunctorAdd'_eq_shiftFunctorAdd

variable (A)

/-- Shifting by zero is the identity functor. -/
def shiftFunctorZero : shiftFunctor C (0 : A) ≅ 𝟭 C :=
  (shiftMonoidalFunctor C A).εIso.symm
#align category_theory.shift_functor_zero CategoryTheory.shiftFunctorZero

end

variable {C A}

theorem ShiftMkCore.shiftFunctor_eq (h : ShiftMkCore C A) (a : A) :
    @shiftFunctor _ _ _ _ (hasShiftMk C A h) a = h.f a :=
  Functor.ext (by tidy) (by tidy)
#align category_theory.shift_mk_core.shift_functor_eq CategoryTheory.ShiftMkCore.shiftFunctor_eq

theorem ShiftMkCore.shiftFunctorZero_eq (h : ShiftMkCore C A) :
    @shiftFunctorZero _ _ _ _ (hasShiftMk C A h) = h.zero :=
  by
  letI := has_shift_mk C A h
  ext1
  suffices (shift_functor_zero C A).inv = h.zero.inv
    by
    rw [← cancel_mono h.zero.inv, h.zero.hom_inv_id, ← this, iso.hom_inv_id]
    rfl
  rfl
#align category_theory.shift_mk_core.shift_functor_zero_eq CategoryTheory.ShiftMkCore.shiftFunctorZero_eq

theorem ShiftMkCore.shiftFunctorAdd_eq (h : ShiftMkCore C A) (a b : A) :
    @shiftFunctorAdd _ _ _ _ (hasShiftMk C A h) a b = h.add a b :=
  by
  letI := has_shift_mk C A h
  ext1
  suffices (shift_functor_add C a b).inv = (h.add a b).inv
    by
    rw [← cancel_mono (h.add a b).inv, (h.add a b).hom_inv_id, ← this, iso.hom_inv_id]
    rfl
  rfl
#align category_theory.shift_mk_core.shift_functor_add_eq CategoryTheory.ShiftMkCore.shiftFunctorAdd_eq

-- mathport name: «expr ⟦ ⟧»
notation -- Any better notational suggestions?
X "⟦" n "⟧" => (shiftFunctor _ n).obj X

-- mathport name: «expr ⟦ ⟧'»
notation f "⟦" n "⟧'" => (shiftFunctor _ n).map f

variable (C)

variable [HasShift C A]

attribute [local reducible] endofunctor_monoidal_category Discrete.addMonoidal

theorem shiftFunctorAdd'_zero_add (a : A) :
    shiftFunctorAdd' C 0 a a (zero_add a) =
      (Functor.leftUnitor _).symm ≪≫
        isoWhiskerRight (shiftFunctorZero C A).symm (shiftFunctor C a) :=
  by
  ext X
  dsimp [shift_functor_add']
  erw [obj_ε_app]
  simpa [eq_to_hom_map]
#align category_theory.shift_functor_add'_zero_add CategoryTheory.shiftFunctorAdd'_zero_add

theorem shiftFunctorAdd'_add_zero (a : A) :
    shiftFunctorAdd' C a 0 a (add_zero a) =
      (Functor.rightUnitor _).symm ≪≫
        isoWhiskerLeft (shiftFunctor C a) (shiftFunctorZero C A).symm :=
  by
  ext X
  dsimp [shift_functor_add']
  erw [ε_app_obj]
  simpa [eq_to_hom_map]
#align category_theory.shift_functor_add'_add_zero CategoryTheory.shiftFunctorAdd'_add_zero

theorem shiftFunctorAdd'_assoc (a₁ a₂ a₃ a₁₂ a₂₃ a₁₂₃ : A) (h₁₂ : a₁ + a₂ = a₁₂)
    (h₂₃ : a₂ + a₃ = a₂₃) (h₁₂₃ : a₁ + a₂ + a₃ = a₁₂₃) :
    shiftFunctorAdd' C a₁₂ a₃ a₁₂₃ (by rw [← h₁₂, h₁₂₃]) ≪≫
        isoWhiskerRight (shiftFunctorAdd' C a₁ a₂ a₁₂ h₁₂) _ ≪≫ Functor.associator _ _ _ =
      shiftFunctorAdd' C a₁ a₂₃ a₁₂₃ (by rw [← h₂₃, ← add_assoc, h₁₂₃]) ≪≫
        isoWhiskerLeft _ (shiftFunctorAdd' C a₂ a₃ a₂₃ h₂₃) :=
  by
  substs h₁₂ h₂₃ h₁₂₃
  ext X
  dsimp
  simp only [shift_functor_add'_eq_shift_functor_add, category.comp_id]
  dsimp [shift_functor_add', shift_functor_add, shift_functor]
  simp [obj_μ_inv_app, eq_to_hom_map]
#align category_theory.shift_functor_add'_assoc CategoryTheory.shiftFunctorAdd'_assoc

theorem shiftFunctorAdd_assoc (a₁ a₂ a₃ : A) :
    shiftFunctorAdd C (a₁ + a₂) a₃ ≪≫
        isoWhiskerRight (shiftFunctorAdd C a₁ a₂) _ ≪≫ Functor.associator _ _ _ =
      shiftFunctorAdd' C a₁ (a₂ + a₃) _ (add_assoc a₁ a₂ a₃).symm ≪≫
        isoWhiskerLeft _ (shiftFunctorAdd C a₂ a₃) :=
  by
  ext X
  simpa [shift_functor_add'_eq_shift_functor_add] using
    nat_trans.congr_app (congr_arg iso.hom (shift_functor_add'_assoc C a₁ a₂ a₃ _ _ _ rfl rfl rfl))
      X
#align category_theory.shift_functor_add_assoc CategoryTheory.shiftFunctorAdd_assoc

variable {C}

theorem shiftFunctorAdd'_zero_add_hom_app (a : A) (X : C) :
    (shiftFunctorAdd' C 0 a a (zero_add a)).Hom.app X = (shiftFunctorZero C A).inv.app X⟦a⟧' := by
  simpa using nat_trans.congr_app (congr_arg iso.hom (shift_functor_add'_zero_add C a)) X
#align category_theory.shift_functor_add'_zero_add_hom_app CategoryTheory.shiftFunctorAdd'_zero_add_hom_app

theorem shiftFunctorAdd_zero_add_hom_app (a : A) (X : C) :
    (shiftFunctorAdd C 0 a).Hom.app X =
      eqToHom (by dsimp <;> rw [zero_add]) ≫ (shiftFunctorZero C A).inv.app X⟦a⟧' :=
  by
  erw [← shift_functor_add'_zero_add_hom_app]
  dsimp [shift_functor_add']
  simp
#align category_theory.shift_functor_add_zero_add_hom_app CategoryTheory.shiftFunctorAdd_zero_add_hom_app

theorem shiftFunctorAdd'_zero_add_inv_app (a : A) (X : C) :
    (shiftFunctorAdd' C 0 a a (zero_add a)).inv.app X = (shiftFunctorZero C A).Hom.app X⟦a⟧' :=
  by
  have := nat_trans.congr_app (congr_arg iso.inv (shift_functor_add'_zero_add C a)) X
  simp only [iso.trans_inv, iso_whisker_right_inv, iso.symm_inv, nat_trans.comp_app,
    whisker_right_app, functor.left_unitor_hom_app] at this
  dsimp at this
  simpa only [category.comp_id] using this
#align category_theory.shift_functor_add'_zero_add_inv_app CategoryTheory.shiftFunctorAdd'_zero_add_inv_app

theorem shiftFunctorAdd_zero_add_inv_app (a : A) (X : C) :
    (shiftFunctorAdd C 0 a).inv.app X =
      (shiftFunctorZero C A).Hom.app X⟦a⟧' ≫ eqToHom (by dsimp <;> rw [zero_add]) :=
  by
  erw [← shift_functor_add'_zero_add_inv_app]
  dsimp [shift_functor_add']
  simp
#align category_theory.shift_functor_add_zero_add_inv_app CategoryTheory.shiftFunctorAdd_zero_add_inv_app

theorem shiftFunctorAdd'_add_zero_hom_app (a : A) (X : C) :
    (shiftFunctorAdd' C a 0 a (add_zero a)).Hom.app X = (shiftFunctorZero C A).inv.app (X⟦a⟧) := by
  simpa using nat_trans.congr_app (congr_arg iso.hom (shift_functor_add'_add_zero C a)) X
#align category_theory.shift_functor_add'_add_zero_hom_app CategoryTheory.shiftFunctorAdd'_add_zero_hom_app

theorem shiftFunctorAdd_add_zero_hom_app (a : A) (X : C) :
    (shiftFunctorAdd C a 0).Hom.app X =
      eqToHom (by dsimp <;> rw [add_zero]) ≫ (shiftFunctorZero C A).inv.app (X⟦a⟧) :=
  by
  rw [← shift_functor_add'_add_zero_hom_app]
  dsimp [shift_functor_add']
  simp
#align category_theory.shift_functor_add_add_zero_hom_app CategoryTheory.shiftFunctorAdd_add_zero_hom_app

theorem shiftFunctorAdd'_add_zero_inv_app (a : A) (X : C) :
    (shiftFunctorAdd' C a 0 a (add_zero a)).inv.app X = (shiftFunctorZero C A).Hom.app (X⟦a⟧) :=
  by
  have := nat_trans.congr_app (congr_arg iso.inv (shift_functor_add'_add_zero C a)) X
  simp only [iso.trans_inv, iso_whisker_left_inv, iso.symm_inv, nat_trans.comp_app,
    whisker_left_app, functor.right_unitor_hom_app] at this
  dsimp at this
  simpa only [category.comp_id] using this
#align category_theory.shift_functor_add'_add_zero_inv_app CategoryTheory.shiftFunctorAdd'_add_zero_inv_app

theorem shiftFunctorAdd_add_zero_inv_app (a : A) (X : C) :
    (shiftFunctorAdd C a 0).inv.app X =
      (shiftFunctorZero C A).Hom.app (X⟦a⟧) ≫ eqToHom (by dsimp <;> rw [add_zero]) :=
  by
  rw [← shift_functor_add'_add_zero_inv_app]
  dsimp [shift_functor_add']
  simp
#align category_theory.shift_functor_add_add_zero_inv_app CategoryTheory.shiftFunctorAdd_add_zero_inv_app

@[reassoc.1]
theorem shiftFunctorAdd'_assoc_hom_app (a₁ a₂ a₃ a₁₂ a₂₃ a₁₂₃ : A) (h₁₂ : a₁ + a₂ = a₁₂)
    (h₂₃ : a₂ + a₃ = a₂₃) (h₁₂₃ : a₁ + a₂ + a₃ = a₁₂₃) (X : C) :
    (shiftFunctorAdd' C a₁₂ a₃ a₁₂₃ (by rw [← h₁₂, h₁₂₃])).Hom.app X ≫
        (shiftFunctorAdd' C a₁ a₂ a₁₂ h₁₂).Hom.app X⟦a₃⟧' =
      (shiftFunctorAdd' C a₁ a₂₃ a₁₂₃ (by rw [← h₂₃, ← add_assoc, h₁₂₃])).Hom.app X ≫
        (shiftFunctorAdd' C a₂ a₃ a₂₃ h₂₃).Hom.app (X⟦a₁⟧) :=
  by
  simpa using
    nat_trans.congr_app (congr_arg iso.hom (shift_functor_add'_assoc C _ _ _ _ _ _ h₁₂ h₂₃ h₁₂₃)) X
#align category_theory.shift_functor_add'_assoc_hom_app CategoryTheory.shiftFunctorAdd'_assoc_hom_app

@[reassoc.1]
theorem shiftFunctorAdd'_assoc_inv_app (a₁ a₂ a₃ a₁₂ a₂₃ a₁₂₃ : A) (h₁₂ : a₁ + a₂ = a₁₂)
    (h₂₃ : a₂ + a₃ = a₂₃) (h₁₂₃ : a₁ + a₂ + a₃ = a₁₂₃) (X : C) :
    (shiftFunctorAdd' C a₁ a₂ a₁₂ h₁₂).inv.app X⟦a₃⟧' ≫
        (shiftFunctorAdd' C a₁₂ a₃ a₁₂₃ (by rw [← h₁₂, h₁₂₃])).inv.app X =
      (shiftFunctorAdd' C a₂ a₃ a₂₃ h₂₃).inv.app (X⟦a₁⟧) ≫
        (shiftFunctorAdd' C a₁ a₂₃ a₁₂₃ (by rw [← h₂₃, ← add_assoc, h₁₂₃])).inv.app X :=
  by
  simpa using
    nat_trans.congr_app (congr_arg iso.inv (shift_functor_add'_assoc C _ _ _ _ _ _ h₁₂ h₂₃ h₁₂₃)) X
#align category_theory.shift_functor_add'_assoc_inv_app CategoryTheory.shiftFunctorAdd'_assoc_inv_app

@[reassoc.1]
theorem shiftFunctorAdd_assoc_hom_app (a₁ a₂ a₃ : A) (X : C) :
    (shiftFunctorAdd C (a₁ + a₂) a₃).Hom.app X ≫ (shiftFunctorAdd C a₁ a₂).Hom.app X⟦a₃⟧' =
      (shiftFunctorAdd' C a₁ (a₂ + a₃) (a₁ + a₂ + a₃) (add_assoc _ _ _).symm).Hom.app X ≫
        (shiftFunctorAdd C a₂ a₃).Hom.app (X⟦a₁⟧) :=
  by simpa using nat_trans.congr_app (congr_arg iso.hom (shift_functor_add_assoc C a₁ a₂ a₃)) X
#align category_theory.shift_functor_add_assoc_hom_app CategoryTheory.shiftFunctorAdd_assoc_hom_app

@[reassoc.1]
theorem shiftFunctorAdd_assoc_inv_app (a₁ a₂ a₃ : A) (X : C) :
    (shiftFunctorAdd C a₁ a₂).inv.app X⟦a₃⟧' ≫ (shiftFunctorAdd C (a₁ + a₂) a₃).inv.app X =
      (shiftFunctorAdd C a₂ a₃).inv.app (X⟦a₁⟧) ≫
        (shiftFunctorAdd' C a₁ (a₂ + a₃) (a₁ + a₂ + a₃) (add_assoc _ _ _).symm).inv.app X :=
  by simpa using nat_trans.congr_app (congr_arg iso.inv (shift_functor_add_assoc C a₁ a₂ a₃)) X
#align category_theory.shift_functor_add_assoc_inv_app CategoryTheory.shiftFunctorAdd_assoc_inv_app

end Defs

section AddMonoid

variable {C A} [AddMonoid A] [HasShift C A] (X Y : C) (f : X ⟶ Y)

@[simp]
theorem HasShift.shift_obj_obj (n : A) (X : C) : (HasShift.shift.obj ⟨n⟩).obj X = X⟦n⟧ :=
  rfl
#align category_theory.has_shift.shift_obj_obj CategoryTheory.HasShift.shift_obj_obj

/-- Shifting by `i + j` is the same as shifting by `i` and then shifting by `j`. -/
abbrev shiftAdd (i j : A) : X⟦i + j⟧ ≅ X⟦i⟧⟦j⟧ :=
  (shiftFunctorAdd C i j).app _
#align category_theory.shift_add CategoryTheory.shiftAdd

theorem shift_shift' (i j : A) :
    f⟦i⟧'⟦j⟧' = (shiftAdd X i j).inv ≫ f⟦i + j⟧' ≫ (shiftAdd Y i j).Hom :=
  by
  symm
  apply nat_iso.naturality_1
#align category_theory.shift_shift' CategoryTheory.shift_shift'

variable (A)

/-- Shifting by zero is the identity functor. -/
abbrev shiftZero : X⟦0⟧ ≅ X :=
  (shiftFunctorZero C A).app _
#align category_theory.shift_zero CategoryTheory.shiftZero

theorem shift_zero' : f⟦(0 : A)⟧' = (shiftZero A X).Hom ≫ f ≫ (shiftZero A Y).inv :=
  by
  symm
  apply nat_iso.naturality_2
#align category_theory.shift_zero' CategoryTheory.shift_zero'

variable (C) {A}

/-- When `i + j = 0`, shifting by `i` and by `j` gives the identity functor -/
def shiftFunctorCompIsoId (i j : A) (h : i + j = 0) : shiftFunctor C i ⋙ shiftFunctor C j ≅ 𝟭 C :=
  (shiftFunctorAdd' C i j 0 h).symm ≪≫ shiftFunctorZero C A
#align category_theory.shift_functor_comp_iso_id CategoryTheory.shiftFunctorCompIsoId

end AddMonoid

section AddGroup

variable (C) {A} [AddGroup A] [HasShift C A]

/-- shifting by `i` and shifting by `j` forms an equivalence when `i + j = 0`. -/
@[simps]
def shiftEquiv' (i j : A) (h : i + j = 0) : C ≌ C
    where
  Functor := shiftFunctor C i
  inverse := shiftFunctor C j
  unitIso := (shiftFunctorCompIsoId C i j h).symm
  counitIso :=
    shiftFunctorCompIsoId C j i (by rw [← add_left_inj j, add_assoc, h, zero_add, add_zero])
  functor_unitIso_comp' X :=
    by
    let E :=
      equiv_of_tensor_iso_unit (shift_monoidal_functor C A) ⟨i⟩ ⟨j⟩ (eq_to_iso (by ext <;> exact h))
        (eq_to_iso (by ext <;> dsimp <;> rw [← add_left_inj j, add_assoc, h, zero_add, add_zero]))
        (Subsingleton.elim _ _)
    convert equivalence.functor_unit_iso_comp E X
    all_goals
      ext X
      dsimp [shift_functor_comp_iso_id, unit_of_tensor_iso_unit, shift_functor_add']
      simpa only [eq_to_hom_map, category.assoc]
#align category_theory.shift_equiv' CategoryTheory.shiftEquiv'

/-- shifting by `n` and shifting by `-n` forms an equivalence. -/
abbrev shiftEquiv (i : A) : C ≌ C :=
  shiftEquiv' C i (-i) (add_neg_self i)
#align category_theory.shift_equiv CategoryTheory.shiftEquiv

variable (X Y : C) (f : X ⟶ Y)

/-- Shifting by `i` is an equivalence. -/
instance (i : A) : IsEquivalence (shiftFunctor C i) :=
  IsEquivalence.ofEquivalence (shiftEquiv C i)

@[simp]
theorem shiftFunctor_inv (i : A) : (shiftFunctor C i).inv = shiftFunctor C (-i) :=
  rfl
#align category_theory.shift_functor_inv CategoryTheory.shiftFunctor_inv

section

variable (C)

/-- Shifting by `n` is an essentially surjective functor. -/
instance shiftFunctor_essSurj (i : A) : EssSurj (shiftFunctor C i) :=
  Equivalence.essSurj_of_equivalence _
#align category_theory.shift_functor_ess_surj CategoryTheory.shiftFunctor_essSurj

end

variable {C}

/-- Shifting by `i` and then shifting by `-i` is the identity. -/
abbrev shiftShiftNeg (i : A) : X⟦i⟧⟦-i⟧ ≅ X :=
  (shiftEquiv C i).unitIso.symm.app _
#align category_theory.shift_shift_neg CategoryTheory.shiftShiftNeg

/-- Shifting by `-i` and then shifting by `i` is the identity. -/
abbrev shiftNegShift (i : A) : X⟦-i⟧⟦i⟧ ≅ X :=
  (shiftEquiv C i).counitIso.app _
#align category_theory.shift_neg_shift CategoryTheory.shiftNegShift

variable {X Y}

theorem shift_shift_neg' (i : A) :
    f⟦i⟧'⟦-i⟧' =
      (shiftFunctorCompIsoId C i (-i) (add_neg_self i)).Hom.app X ≫
        f ≫ (shiftFunctorCompIsoId C i (-i) (add_neg_self i)).inv.app Y :=
  (NatIso.naturality_2 (shiftFunctorCompIsoId C i (-i) (add_neg_self i)) f).symm
#align category_theory.shift_shift_neg' CategoryTheory.shift_shift_neg'

theorem shift_neg_shift' (i : A) :
    f⟦-i⟧'⟦i⟧' =
      (shiftFunctorCompIsoId C (-i) i (neg_add_self i)).Hom.app X ≫
        f ≫ (shiftFunctorCompIsoId C (-i) i (neg_add_self i)).inv.app Y :=
  (NatIso.naturality_2 (shiftFunctorCompIsoId C (-i) i (neg_add_self i)) f).symm
#align category_theory.shift_neg_shift' CategoryTheory.shift_neg_shift'

theorem shift_equiv_triangle (n : A) (X : C) :
    (shiftShiftNeg X n).inv⟦n⟧' ≫ (shiftNegShift (X⟦n⟧) n).Hom = 𝟙 (X⟦n⟧) :=
  (shiftEquiv C n).functor_unitIso_comp X
#align category_theory.shift_equiv_triangle CategoryTheory.shift_equiv_triangle

section

theorem shift_shiftFunctorCompIsoId_hom_app (n m : A) (h : n + m = 0) (X : C) :
    (shiftFunctorCompIsoId C n m h).Hom.app X⟦n⟧' =
      (shiftFunctorCompIsoId C m n (by rw [← neg_eq_of_add_eq_zero_left h, add_right_neg])).Hom.app
        (X⟦n⟧) :=
  by
  dsimp [shift_functor_comp_iso_id]
  simpa only [functor.map_comp, ← shift_functor_add'_zero_add_inv_app n X, ←
    shift_functor_add'_add_zero_inv_app n X] using
    shift_functor_add'_assoc_inv_app n m n 0 0 n h
      (by rw [← neg_eq_of_add_eq_zero_left h, add_right_neg]) (by rw [h, zero_add]) X
#align category_theory.shift_shift_functor_comp_iso_id_hom_app CategoryTheory.shift_shiftFunctorCompIsoId_hom_app

theorem shift_shiftFunctorCompIsoId_inv_app (n m : A) (h : n + m = 0) (X : C) :
    (shiftFunctorCompIsoId C n m h).inv.app X⟦n⟧' =
      (shiftFunctorCompIsoId C m n (by rw [← neg_eq_of_add_eq_zero_left h, add_right_neg])).inv.app
        (X⟦n⟧) :=
  by
  rw [← cancel_mono ((shift_functor_comp_iso_id C n m h).Hom.app X⟦n⟧'), ← functor.map_comp,
    iso.inv_hom_id_app, Functor.map_id, shift_shift_functor_comp_iso_id_hom_app, iso.inv_hom_id_app]
  rfl
#align category_theory.shift_shift_functor_comp_iso_id_inv_app CategoryTheory.shift_shiftFunctorCompIsoId_inv_app

theorem shift_shiftFunctorCompIsoId_add_neg_self_hom_app (n : A) (X : C) :
    (shiftFunctorCompIsoId C n (-n) (add_neg_self n)).Hom.app X⟦n⟧' =
      (shiftFunctorCompIsoId C (-n) n (neg_add_self n)).Hom.app (X⟦n⟧) :=
  by apply shift_shift_functor_comp_iso_id_hom_app
#align category_theory.shift_shift_functor_comp_iso_id_add_neg_self_hom_app CategoryTheory.shift_shiftFunctorCompIsoId_add_neg_self_hom_app

theorem shift_shiftFunctorCompIsoId_add_neg_self_inv_app (n : A) (X : C) :
    (shiftFunctorCompIsoId C n (-n) (add_neg_self n)).inv.app X⟦n⟧' =
      (shiftFunctorCompIsoId C (-n) n (neg_add_self n)).inv.app (X⟦n⟧) :=
  by apply shift_shift_functor_comp_iso_id_inv_app
#align category_theory.shift_shift_functor_comp_iso_id_add_neg_self_inv_app CategoryTheory.shift_shiftFunctorCompIsoId_add_neg_self_inv_app

theorem shift_shiftFunctorCompIsoId_neg_add_self_hom_app (n : A) (X : C) :
    (shiftFunctorCompIsoId C (-n) n (neg_add_self n)).Hom.app X⟦-n⟧' =
      (shiftFunctorCompIsoId C n (-n) (add_neg_self n)).Hom.app (X⟦-n⟧) :=
  by apply shift_shift_functor_comp_iso_id_hom_app
#align category_theory.shift_shift_functor_comp_iso_id_neg_add_self_hom_app CategoryTheory.shift_shiftFunctorCompIsoId_neg_add_self_hom_app

theorem shift_shiftFunctorCompIsoId_neg_add_self_inv_app (n : A) (X : C) :
    (shiftFunctorCompIsoId C (-n) n (neg_add_self n)).inv.app X⟦-n⟧' =
      (shiftFunctorCompIsoId C n (-n) (add_neg_self n)).inv.app (X⟦-n⟧) :=
  by apply shift_shift_functor_comp_iso_id_inv_app
#align category_theory.shift_shift_functor_comp_iso_id_neg_add_self_inv_app CategoryTheory.shift_shiftFunctorCompIsoId_neg_add_self_inv_app

end

variable {A C}

open CategoryTheory.Limits

variable [HasZeroMorphisms C]

theorem shift_zero_eq_zero (X Y : C) (n : A) : (0 : X ⟶ Y)⟦n⟧' = (0 : X⟦n⟧ ⟶ Y⟦n⟧) :=
  CategoryTheory.Functor.map_zero _ _ _
#align category_theory.shift_zero_eq_zero CategoryTheory.shift_zero_eq_zero

end AddGroup

section AddCommMonoid

variable (C) {A} [AddCommMonoid A] [HasShift C A]

/-- When shifts are indexed by an additive commutative monoid, then shifts commute. -/
def shiftFunctorComm (i j : A) :
    shiftFunctor C i ⋙ shiftFunctor C j ≅ shiftFunctor C j ⋙ shiftFunctor C i :=
  (shiftFunctorAdd C i j).symm ≪≫ shiftFunctorAdd' C j i (i + j) (add_comm j i)
#align category_theory.shift_functor_comm CategoryTheory.shiftFunctorComm

theorem shiftFunctorComm_eq (i j k : A) (h : i + j = k) :
    shiftFunctorComm C i j =
      (shiftFunctorAdd' C i j k h).symm ≪≫ shiftFunctorAdd' C j i k (by rw [add_comm j i, h]) :=
  by
  subst h
  rw [shift_functor_add'_eq_shift_functor_add]
  rfl
#align category_theory.shift_functor_comm_eq CategoryTheory.shiftFunctorComm_eq

theorem shiftFunctorComm_symm (i j : A) : (shiftFunctorComm C i j).symm = shiftFunctorComm C j i :=
  by
  ext1
  dsimp
  simpa only [shift_functor_comm_eq C i j (i + j) rfl,
    shift_functor_comm_eq C j i (i + j) (add_comm j i)]
#align category_theory.shift_functor_comm_symm CategoryTheory.shiftFunctorComm_symm

variable {C} (X Y : C) (f : X ⟶ Y)

/-- When shifts are indexed by an additive commutative monoid, then shifts commute. -/
abbrev shiftComm (i j : A) : X⟦i⟧⟦j⟧ ≅ X⟦j⟧⟦i⟧ :=
  (shiftFunctorComm C i j).app X
#align category_theory.shift_comm CategoryTheory.shiftComm

@[simp]
theorem shiftComm_symm (i j : A) : (shiftComm X i j).symm = shiftComm X j i :=
  by
  ext1
  exact nat_trans.congr_app (congr_arg iso.hom (shift_functor_comm_symm C i j)) X
#align category_theory.shift_comm_symm CategoryTheory.shiftComm_symm

variable {X Y}

/-- When shifts are indexed by an additive commutative monoid, then shifts commute. -/
theorem shift_comm' (i j : A) :
    f⟦i⟧'⟦j⟧' = (shiftComm _ _ _).Hom ≫ f⟦j⟧'⟦i⟧' ≫ (shiftComm _ _ _).Hom :=
  by
  erw [← shift_comm_symm Y i j, ← (shift_functor_comm C i j).Hom.naturality_assoc f,
    iso.hom_inv_id_app, category.comp_id]
  rfl
#align category_theory.shift_comm' CategoryTheory.shift_comm'

@[reassoc.1]
theorem shiftComm_hom_comp (i j : A) :
    (shiftComm X i j).Hom ≫ f⟦j⟧'⟦i⟧' = f⟦i⟧'⟦j⟧' ≫ (shiftComm Y i j).Hom := by
  rw [shift_comm', ← shift_comm_symm, iso.symm_hom, iso.inv_hom_id_assoc]
#align category_theory.shift_comm_hom_comp CategoryTheory.shiftComm_hom_comp

theorem shiftFunctorZero_hom_app_shift (n : A) :
    (shiftFunctorZero C A).Hom.app (X⟦n⟧) =
      (shiftFunctorComm C n 0).Hom.app X ≫ (shiftFunctorZero C A).Hom.app X⟦n⟧' :=
  by
  rw [← shift_functor_add'_zero_add_inv_app n X, shift_functor_comm_eq C n 0 n (add_zero n)]
  dsimp
  rw [category.assoc, iso.hom_inv_id_app, category.comp_id, shift_functor_add'_add_zero_inv_app]
#align category_theory.shift_functor_zero_hom_app_shift CategoryTheory.shiftFunctorZero_hom_app_shift

theorem shiftFunctorZero_inv_app_shift (n : A) :
    (shiftFunctorZero C A).inv.app (X⟦n⟧) =
      (shiftFunctorZero C A).inv.app X⟦n⟧' ≫ (shiftFunctorComm C n 0).inv.app X :=
  by
  rw [← cancel_mono ((shift_functor_zero C A).Hom.app (X⟦n⟧)), category.assoc, iso.inv_hom_id_app,
    shift_functor_zero_hom_app_shift, iso.inv_hom_id_app_assoc, ← functor.map_comp,
    iso.inv_hom_id_app]
  dsimp
  rw [Functor.map_id]
#align category_theory.shift_functor_zero_inv_app_shift CategoryTheory.shiftFunctorZero_inv_app_shift

@[reassoc.1]
theorem shiftFunctorComm_hom_app_comp_shift_shiftFunctorAdd_hom_app (m₁ m₂ m₃ : A) (X : C) :
    (shiftFunctorComm C m₁ (m₂ + m₃)).Hom.app X ≫ (shiftFunctorAdd C m₂ m₃).Hom.app X⟦m₁⟧' =
      (shiftFunctorAdd C m₂ m₃).Hom.app (X⟦m₁⟧) ≫
        (shiftFunctorComm C m₁ m₂).Hom.app X⟦m₃⟧' ≫ (shiftFunctorComm C m₁ m₃).Hom.app (X⟦m₂⟧) :=
  by
  simp only [← cancel_mono ((shift_functor_comm C m₁ m₃).inv.app (X⟦m₂⟧)), ←
    cancel_mono ((shift_functor_comm C m₁ m₂).inv.app X⟦m₃⟧'), category.assoc, iso.hom_inv_id_app]
  dsimp
  simp only [category.id_comp, ← functor.map_comp, iso.hom_inv_id_app]
  dsimp
  simp only [Functor.map_id, category.comp_id, shift_functor_comm_eq C _ _ _ rfl, ←
    shift_functor_add'_eq_shift_functor_add]
  dsimp
  simp only [category.assoc, iso.hom_inv_id_app_assoc, iso.inv_hom_id_app_assoc, ← functor.map_comp,
    shift_functor_add'_assoc_hom_app_assoc m₂ m₃ m₁ (m₂ + m₃) (m₁ + m₃) (m₁ + (m₂ + m₃)) rfl
      (add_comm m₃ m₁) (add_comm _ m₁) X,
    ←
    shift_functor_add'_assoc_hom_app_assoc m₂ m₁ m₃ (m₁ + m₂) (m₁ + m₃) (m₁ + (m₂ + m₃))
      (add_comm _ _) rfl (by rw [add_comm m₂ m₁, add_assoc]) X,
    shift_functor_add'_assoc_hom_app m₁ m₂ m₃ (m₁ + m₂) (m₂ + m₃) (m₁ + (m₂ + m₃)) rfl rfl
      (add_assoc _ _ _) X]
#align category_theory.shift_functor_comm_hom_app_comp_shift_shift_functor_add_hom_app CategoryTheory.shiftFunctorComm_hom_app_comp_shift_shiftFunctorAdd_hom_app

end AddCommMonoid

variable {C A} {D : Type _} [Category D] [AddMonoid A] [HasShift D A]

variable (F : C ⥤ D) [Full F] [Faithful F]

section

variable (s : A → C ⥤ C) (i : ∀ i, s i ⋙ F ≅ F ⋙ shiftFunctor D i)

include F s i

/-- auxiliary definition for `has_shift_of_fully_faithful` -/
def hasShiftOfFullyFaithfulZero : s 0 ≅ 𝟭 C :=
  natIsoOfCompFullyFaithful F
    (i 0 ≪≫
      isoWhiskerLeft F (shiftFunctorZero D A) ≪≫
        Functor.rightUnitor _ ≪≫ (Functor.leftUnitor _).symm)
#align category_theory.has_shift_of_fully_faithful_zero CategoryTheory.hasShiftOfFullyFaithfulZero

@[simp]
theorem map_hasShiftOfFullyFaithfulZero_hom_app (X : C) :
    F.map ((hasShiftOfFullyFaithfulZero F s i).Hom.app X) =
      (i 0).Hom.app X ≫ (shiftFunctorZero D A).Hom.app (F.obj X) :=
  by
  dsimp [has_shift_of_fully_faithful_zero]
  simp
#align category_theory.map_has_shift_of_fully_faithful_zero_hom_app CategoryTheory.map_hasShiftOfFullyFaithfulZero_hom_app

@[simp]
theorem map_hasShiftOfFullyFaithfulZero_inv_app (X : C) :
    F.map ((hasShiftOfFullyFaithfulZero F s i).inv.app X) =
      (shiftFunctorZero D A).inv.app (F.obj X) ≫ (i 0).inv.app X :=
  by
  dsimp [has_shift_of_fully_faithful_zero]
  simp
#align category_theory.map_has_shift_of_fully_faithful_zero_inv_app CategoryTheory.map_hasShiftOfFullyFaithfulZero_inv_app

/-- auxiliary definition for `has_shift_of_fully_faithful` -/
def hasShiftOfFullyFaithfulAdd (a b : A) : s (a + b) ≅ s a ⋙ s b :=
  natIsoOfCompFullyFaithful F
    (i (a + b) ≪≫
      isoWhiskerLeft _ (shiftFunctorAdd D a b) ≪≫
        (Functor.associator _ _ _).symm ≪≫
          isoWhiskerRight (i a).symm _ ≪≫
            Functor.associator _ _ _ ≪≫
              isoWhiskerLeft _ (i b).symm ≪≫ (Functor.associator _ _ _).symm)
#align category_theory.has_shift_of_fully_faithful_add CategoryTheory.hasShiftOfFullyFaithfulAdd

@[simp]
theorem map_hasShiftOfFullyFaithfulAdd_hom_app (a b : A) (X : C) :
    F.map ((hasShiftOfFullyFaithfulAdd F s i a b).Hom.app X) =
      (i (a + b)).Hom.app X ≫
        (shiftFunctorAdd D a b).Hom.app (F.obj X) ≫
          (i a).inv.app X⟦b⟧' ≫ (i b).inv.app ((s a).obj X) :=
  by
  dsimp [has_shift_of_fully_faithful_add]
  simp
#align category_theory.map_has_shift_of_fully_faithful_add_hom_app CategoryTheory.map_hasShiftOfFullyFaithfulAdd_hom_app

@[simp]
theorem map_hasShiftOfFullyFaithfulAdd_inv_app (a b : A) (X : C) :
    F.map ((hasShiftOfFullyFaithfulAdd F s i a b).inv.app X) =
      (i b).Hom.app ((s a).obj X) ≫
        (i a).Hom.app X⟦b⟧' ≫ (shiftFunctorAdd D a b).inv.app (F.obj X) ≫ (i (a + b)).inv.app X :=
  by
  dsimp [has_shift_of_fully_faithful_add]
  simp
#align category_theory.map_has_shift_of_fully_faithful_add_inv_app CategoryTheory.map_hasShiftOfFullyFaithfulAdd_inv_app

/-- Given a family of endomorphisms of `C` which are interwined by a fully faithful `F : C ⥤ D`
with shift functors on `D`, we can promote that family to shift functors on `C`. -/
def hasShiftOfFullyFaithful : HasShift C A :=
  hasShiftMk C A
    { f := s
      zero := hasShiftOfFullyFaithfulZero F s i
      add := hasShiftOfFullyFaithfulAdd F s i
      assoc_hom_app := fun m₁ m₂ m₃ X =>
        F.map_injective
          (by
            rw [← cancel_mono ((i m₃).Hom.app ((s m₂).obj ((s m₁).obj X)))]
            simp only [functor.map_comp, map_has_shift_of_fully_faithful_add_hom_app,
              category.assoc, iso.inv_hom_id_app_assoc, iso.inv_hom_id_app]
            erw [(i m₃).Hom.naturality]
            have := dcongr_arg (fun a => (i a).Hom.app X) (add_assoc m₁ m₂ m₃)
            dsimp at this
            dsimp
            rw [iso.inv_hom_id_app_assoc, map_has_shift_of_fully_faithful_add_hom_app, this,
              eq_to_hom_map, category.comp_id, ← functor.map_comp, category.assoc,
              iso.inv_hom_id_app_assoc, functor.map_comp, functor.map_comp,
              shift_functor_add_assoc_hom_app_assoc m₁ m₂ m₃ (F.obj X)]
            dsimp [shift_functor_add']
            simp only [eq_to_hom_app, category.assoc, eq_to_hom_trans_assoc, eq_to_hom_refl,
              category.id_comp, nat_trans.naturality_assoc, functor.comp_map])
      zero_add_hom_app := fun n X =>
        F.map_injective
          (by
            have := dcongr_arg (fun a => (i a).Hom.app X) (zero_add n)
            dsimp at this
            rw [← cancel_mono ((i n).Hom.app ((s 0).obj X))]
            simp only [this, map_has_shift_of_fully_faithful_add_hom_app,
              shift_functor_add_zero_add_hom_app, eq_to_hom_map, category.assoc,
              eq_to_hom_trans_assoc, eq_to_hom_refl, category.id_comp, iso.inv_hom_id_app,
              functor.map_comp]
            erw [(i n).Hom.naturality]
            dsimp
            simp)
      add_zero_hom_app := fun n X =>
        F.map_injective
          (by
            have := dcongr_arg (fun a => (i a).Hom.app X) (add_zero n)
            dsimp at this
            simpa [this, ← nat_trans.naturality_assoc, eq_to_hom_map,
              shift_functor_add_add_zero_hom_app] ) }
#align category_theory.has_shift_of_fully_faithful CategoryTheory.hasShiftOfFullyFaithful

end

end CategoryTheory