/-- When `F : C ⥤ D` is a functor satisfying suitable technical assumptions,
this is the induced term of type `HasShift D A` deduced from `[HasShift C A]`. -/
noncomputable def induced : HasShift D A :=
  hasShiftMk D A
    { F := s
      zero := Induced.zero F s i hF
      add := Induced.add F s i hF
      zero_add_hom_app := fun n => by
        have := hF.2
        suffices (Induced.add F s i hF 0 n).hom =
          eqToHom (by rw [zero_add]; rfl) ≫ whiskerRight (Induced.zero F s i hF).inv (s n) by
          intro X
          simpa using NatTrans.congr_app this X
        apply ((whiskeringLeft C D D).obj F).map_injective
        ext X
        have eq := dcongr_arg (fun a => (i a).hom.app X) (zero_add n)
        dsimp
        simp only [Induced.add_hom_app_obj, eq, shiftFunctorAdd_zero_add_hom_app,
          Functor.map_comp, eqToHom_map, Category.assoc, eqToHom_trans_assoc,
          eqToHom_refl, Category.id_comp, eqToHom_app, Induced.zero_inv_app_obj]
        erw [← NatTrans.naturality_assoc, Iso.hom_inv_id_app_assoc]
        rfl
      add_zero_hom_app := fun n => by
        have := hF.2
        suffices (Induced.add F s i hF n 0).hom =
            eqToHom (by rw [add_zero]; rfl) ≫ whiskerLeft (s n) (Induced.zero F s i hF).inv by
          intro X
          simpa using NatTrans.congr_app this X
        apply ((whiskeringLeft C D D).obj F).map_injective
        ext X
        dsimp
        erw [Induced.add_hom_app_obj, dcongr_arg (fun a => (i a).hom.app X) (add_zero n),
          ← cancel_mono ((s 0).map ((i n).hom.app X)), Category.assoc,
          Category.assoc, Category.assoc, Category.assoc, Category.assoc,
          Category.assoc, ← (s 0).map_comp, Iso.inv_hom_id_app, Functor.map_id, Category.comp_id,
          ← NatTrans.naturality, Induced.zero_inv_app_obj,
          shiftFunctorAdd_add_zero_hom_app]
        simp [eqToHom_map, eqToHom_app]
      assoc_hom_app := fun m₁ m₂ m₃ => by
        have := hF.2
        suffices (Induced.add F s i hF (m₁ + m₂) m₃).hom ≫
            whiskerRight (Induced.add F s i hF m₁ m₂).hom (s m₃) =
            eqToHom (by rw [add_assoc]) ≫ (Induced.add F s i hF m₁ (m₂ + m₃)).hom ≫
              whiskerLeft (s m₁) (Induced.add F s i hF m₂ m₃).hom by
          intro X
          simpa using NatTrans.congr_app this X
        apply ((whiskeringLeft C D D).obj F).map_injective
        ext X
        dsimp
        have eq := F.congr_map (shiftFunctorAdd'_assoc_hom_app
          m₁ m₂ m₃ _ _ (m₁+m₂+m₃) rfl rfl rfl X)
        simp only [shiftFunctorAdd'_eq_shiftFunctorAdd] at eq
        simp only [Functor.comp_obj, Functor.map_comp, shiftFunctorAdd',
          Iso.trans_hom, eqToIso.hom, NatTrans.comp_app, eqToHom_app,
          Category.assoc] at eq
        

Proof state:
case a.w.h
C : Type ?u.46399
D : Type ?u.46402
inst✝³ : Category.{?u.46406, ?u.46399} C
inst✝² : Category.{?u.46410, ?u.46402} D
F : C ⥤ D
A : Type ?u.46441
inst✝¹ : AddMonoid A
inst✝ : HasShift C A
s : A → D ⥤ D
i : (a : A) → F ⋙ s a ≅ shiftFunctor C a ⋙ F
hF : Nonempty (Full ((whiskeringLeft C D D).obj F)) ∧ Faithful ((whiskeringLeft C D D).obj F)
m₁ m₂ m₃ : A
this : Faithful ((whiskeringLeft C D D).obj F)
X : C
eq :
  F.map ((shiftFunctorAdd C (m₁ + m₂) m₃).hom.app X) ≫
      F.map ((shiftFunctor C m₃).map ((shiftFunctorAdd C m₁ m₂).hom.app X)) =
    F.map (eqToHom (_ : (shiftFunctor C (m₁ + m₂ + m₃)).obj X = (shiftFunctor C (m₁ + (m₂ + m₃))).obj X)) ≫
      F.map ((shiftFunctorAdd C m₁ (m₂ + m₃)).hom.app X) ≫
        F.map ((shiftFunctorAdd C m₂ m₃).hom.app ((shiftFunctor C m₁).obj X))
⊢ (Induced.add F s i hF (m₁ + m₂) m₃).hom.app (F.obj X) ≫ (s m₃).map ((Induced.add F s i hF m₁ m₂).hom.app (F.obj X)) =
    (eqToHom (_ : s (m₁ + m₂ + m₃) = s (m₁ + (m₂ + m₃)))).app (F.obj X) ≫
      (Induced.add F s i hF m₁ (m₂ + m₃)).hom.app (F.obj X) ≫
        (Induced.add F s i hF m₂ m₃).hom.app ((s m₁).obj (F.obj X))

Next tactic:
rw [← cancel_mono ((s m₃).map ((s m₂).map ((i m₁).hom.app X)))]