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

! This file was ported from Lean 3 source module category_theory.limits.preserves.shapes.pullbacks
! leanprover-community/mathlib commit f11e306adb9f2a393539d2bb4293bf1b42caa7ac
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Limits.Shapes.Pullbacks
import Mathlib.CategoryTheory.Limits.Preserves.Basic

/-!
# Preserving pullbacks

Constructions to relate the notions of preserving pullbacks and reflecting pullbacks to concrete
pullback cones.

In particular, we show that `pullbackComparison G f g` is an isomorphism iff `G` preserves
the pullback of `f` and `g`.

The dual is also given.

## TODO

* Generalise to wide pullbacks

-/

noncomputable section

universe v₁ v₂ u₁ u₂

-- Porting note: need Functor namespace for mapCone
open CategoryTheory CategoryTheory.Category CategoryTheory.Limits CategoryTheory.Functor

namespace CategoryTheory.Limits

section Pullback

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

variable {D : Type u₂} [Category.{v₂} D]

variable (G : C ⥤ D)

variable {W X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} {h : W ⟶ X} {k : W ⟶ Y} (comm : h ≫ f = k ≫ g)

/-- The map of a pullback cone is a limit iff the fork consisting of the mapped morphisms is a
limit. This essentially lets us commute `PullbackCone.mk` with `Functor.mapCone`. -/
def isLimitMapConePullbackConeEquiv :
    IsLimit (mapCone G (PullbackCone.mk h k comm)) ≃
      IsLimit
        (PullbackCone.mk (G.map h) (G.map k) (by simp only [← G.map_comp, comm]) :
          PullbackCone (G.map f) (G.map g)) :=
  (IsLimit.postcomposeHomEquiv (diagramIsoCospan.{v₂} _) _).symm.trans <|
    IsLimit.equivIsoLimit <|
      Cones.ext (Iso.refl _) <| by
        rintro (_ | _ | _) <;> dsimp <;> simp only [comp_id, id_comp, G.map_comp]
#align category_theory.limits.is_limit_map_cone_pullback_cone_equiv CategoryTheory.Limits.isLimitMapConePullbackConeEquiv

/-- The property of preserving pullbacks expressed in terms of binary fans. -/
def isLimitPullbackConeMapOfIsLimit [PreservesLimit (cospan f g) G]
    (l : IsLimit (PullbackCone.mk h k comm)) :
    have : G.map h ≫ G.map f = G.map k ≫ G.map g := by rw [←G.map_comp,←G.map_comp,comm]
    IsLimit (PullbackCone.mk (G.map h) (G.map k) this) :=
  isLimitMapConePullbackConeEquiv G comm (PreservesLimit.preserves l)
#align category_theory.limits.is_limit_pullback_cone_map_of_is_limit CategoryTheory.Limits.isLimitPullbackConeMapOfIsLimit

/-- The property of reflecting pullbacks expressed in terms of binary fans. -/
def isLimitOfIsLimitPullbackConeMap [ReflectsLimit (cospan f g) G]
    (l : IsLimit (PullbackCone.mk (G.map h) (G.map k) (show G.map h ≫ G.map f = G.map k ≫ G.map g
    from by simp only [←G.map_comp,comm]))) : IsLimit (PullbackCone.mk h k comm) :=
  ReflectsLimit.reflects ((isLimitMapConePullbackConeEquiv G comm).symm l)
#align category_theory.limits.is_limit_of_is_limit_pullback_cone_map CategoryTheory.Limits.isLimitOfIsLimitPullbackConeMap

variable (f g) [PreservesLimit (cospan f g) G]

/-- If `G` preserves pullbacks and `C` has them, then the pullback cone constructed of the mapped
morphisms of the pullback cone is a limit. -/
def isLimitOfHasPullbackOfPreservesLimit [i : HasPullback f g] :
    have : G.map pullback.fst ≫ G.map f  = G.map pullback.snd ≫ G.map g := by
      simp only [←G.map_comp, pullback.condition];
    IsLimit (PullbackCone.mk (G.map (@pullback.fst _ _ _ _ _ f g i)) (G.map pullback.snd) this) :=
  isLimitPullbackConeMapOfIsLimit G _ (pullbackIsPullback f g)
#align category_theory.limits.is_limit_of_has_pullback_of_preserves_limit CategoryTheory.Limits.isLimitOfHasPullbackOfPreservesLimit

/-- If `F` preserves the pullback of `f, g`, it also preserves the pullback of `g, f`. -/
def preservesPullbackSymmetry : PreservesLimit (cospan g f) G where
  preserves {c} hc := by
    apply (IsLimit.postcomposeHomEquiv (diagramIsoCospan.{v₂} _) _).toFun
    apply IsLimit.ofIsoLimit _ (PullbackCone.isoMk _).symm
    apply PullbackCone.flipIsLimit
    apply (isLimitMapConePullbackConeEquiv _ _).toFun
    · refine @PreservesLimit.preserves _ _ _ _ _ _ _ _ ?_ _ ?_
      · dsimp
        infer_instance
      apply PullbackCone.flipIsLimit
      apply IsLimit.ofIsoLimit _ (PullbackCone.isoMk _)
      exact (IsLimit.postcomposeHomEquiv (diagramIsoCospan.{v₁} _) _).invFun hc
    · exact
        (c.π.naturality WalkingCospan.Hom.inr).symm.trans
          (c.π.naturality WalkingCospan.Hom.inl : _)
#align category_theory.limits.preserves_pullback_symmetry CategoryTheory.Limits.preservesPullbackSymmetry

theorem hasPullback_of_preservesPullback [HasPullback f g] : HasPullback (G.map f) (G.map g) :=
  ⟨⟨⟨_, isLimitPullbackConeMapOfIsLimit G _ (pullbackIsPullback _ _)⟩⟩⟩
#align category_theory.limits.has_pullback_of_preserves_pullback CategoryTheory.Limits.hasPullback_of_preservesPullback

variable [HasPullback f g] [HasPullback (G.map f) (G.map g)]

/-- If `G` preserves the pullback of `(f,g)`, then the pullback comparison map for `G` at `(f,g)` is
an isomorphism. -/
def PreservesPullback.iso : G.obj (pullback f g) ≅ pullback (G.map f) (G.map g) :=
  IsLimit.conePointUniqueUpToIso (isLimitOfHasPullbackOfPreservesLimit G f g) (limit.isLimit _)
#align category_theory.limits.preserves_pullback.iso CategoryTheory.Limits.PreservesPullback.iso

@[reassoc]
theorem PreservesPullback.iso_hom_fst :
    (PreservesPullback.iso G f g).hom ≫ pullback.fst = G.map pullback.fst := by
  simp [PreservesPullback.iso]
#align category_theory.limits.preserves_pullback.iso_hom_fst CategoryTheory.Limits.PreservesPullback.iso_hom_fst

@[reassoc]
theorem PreservesPullback.iso_hom_snd :
    (PreservesPullback.iso G f g).hom ≫ pullback.snd = G.map pullback.snd := by
  simp [PreservesPullback.iso]
#align category_theory.limits.preserves_pullback.iso_hom_snd CategoryTheory.Limits.PreservesPullback.iso_hom_snd

@[reassoc (attr := simp)]

@[reassoc (attr := simp)]
theorem PreservesPullback.iso_inv_snd :
    (PreservesPullback.iso G f g).inv ≫ G.map pullback.snd = pullback.snd := by
  simp [PreservesPullback.iso, Iso.inv_comp_eq]
#align category_theory.limits.preserves_pullback.iso_inv_snd CategoryTheory.Limits.PreservesPullback.iso_inv_snd

end Pullback

section Pushout

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

variable {D : Type u₂} [Category.{v₂} D]

variable (G : C ⥤ D)

variable {W X Y Z : C} {h : X ⟶ Z} {k : Y ⟶ Z} {f : W ⟶ X} {g : W ⟶ Y} (comm : f ≫ h = g ≫ k)

/-- The map of a pushout cocone is a colimit iff the cofork consisting of the mapped morphisms is a
colimit. This essentially lets us commute `PushoutCocone.mk` with `Functor.mapCocone`. -/
def isColimitMapCoconePushoutCoconeEquiv :
    IsColimit (mapCocone G (PushoutCocone.mk h k comm)) ≃
      IsColimit
        (PushoutCocone.mk (G.map h) (G.map k) (by simp only [← G.map_comp, comm]) :
          PushoutCocone (G.map f) (G.map g)) :=
  (IsColimit.precomposeHomEquiv (diagramIsoSpan.{v₂} _).symm _).symm.trans <|
    IsColimit.equivIsoColimit <|
      Cocones.ext (Iso.refl _) <| by
        rintro (_ | _ | _) <;> dsimp <;>
          simp only [Category.comp_id, Category.id_comp, ← G.map_comp]
#align category_theory.limits.is_colimit_map_cocone_pushout_cocone_equiv CategoryTheory.Limits.isColimitMapCoconePushoutCoconeEquiv

/-- The property of preserving pushouts expressed in terms of binary cofans. -/
def isColimitPushoutCoconeMapOfIsColimit [PreservesColimit (span f g) G]
    (l : IsColimit (PushoutCocone.mk h k comm)) :
    IsColimit (PushoutCocone.mk (G.map h) (G.map k) (show G.map f ≫ G.map h = G.map g ≫ G.map k
      from by simp only [←G.map_comp,comm] )) :=
  isColimitMapCoconePushoutCoconeEquiv G comm (PreservesColimit.preserves l)
#align category_theory.limits.is_colimit_pushout_cocone_map_of_is_colimit CategoryTheory.Limits.isColimitPushoutCoconeMapOfIsColimit

/-- The property of reflecting pushouts expressed in terms of binary cofans. -/
def isColimitOfIsColimitPushoutCoconeMap [ReflectsColimit (span f g) G]
    (l : IsColimit (PushoutCocone.mk (G.map h) (G.map k) (show G.map f ≫ G.map h =
      G.map g ≫ G.map k from by simp only [←G.map_comp,comm]))) :
    IsColimit (PushoutCocone.mk h k comm) :=
  ReflectsColimit.reflects ((isColimitMapCoconePushoutCoconeEquiv G comm).symm l)
#align category_theory.limits.is_colimit_of_is_colimit_pushout_cocone_map CategoryTheory.Limits.isColimitOfIsColimitPushoutCoconeMap

variable (f g) [PreservesColimit (span f g) G]

/-- If `G` preserves pushouts and `C` has them, then the pushout cocone constructed of the mapped
morphisms of the pushout cocone is a colimit. -/
def isColimitOfHasPushoutOfPreservesColimit [i : HasPushout f g] :
    IsColimit (PushoutCocone.mk (G.map pushout.inl) (G.map (@pushout.inr _ _ _ _ _ f g i))
    (show G.map f ≫ G.map pushout.inl = G.map g ≫ G.map pushout.inr from by
      simp only [← G.map_comp, pushout.condition])) :=
  isColimitPushoutCoconeMapOfIsColimit G _ (pushoutIsPushout f g)
#align category_theory.limits.is_colimit_of_has_pushout_of_preserves_colimit CategoryTheory.Limits.isColimitOfHasPushoutOfPreservesColimit

/-- If `F` preserves the pushout of `f, g`, it also preserves the pushout of `g, f`. -/
def preservesPushoutSymmetry : PreservesColimit (span g f) G where
  preserves {c} hc :=
    by
    apply (IsColimit.precomposeHomEquiv (diagramIsoSpan.{v₂} _).symm _).toFun
    apply IsColimit.ofIsoColimit _ (PushoutCocone.isoMk _).symm
    apply PushoutCocone.flipIsColimit
    apply (isColimitMapCoconePushoutCoconeEquiv _ _).toFun
    · refine @PreservesColimit.preserves _ _ _ _ _ _ _ _ ?_ _ ?_ -- Porting note: more TC coddling
      · dsimp
        infer_instance
      apply PushoutCocone.flipIsColimit
      apply IsColimit.ofIsoColimit _ (PushoutCocone.isoMk _)
      exact (IsColimit.precomposeHomEquiv (diagramIsoSpan.{v₁} _) _).invFun hc
    · exact (c.ι.naturality WalkingSpan.Hom.snd).trans (c.ι.naturality WalkingSpan.Hom.fst).symm
#align category_theory.limits.preserves_pushout_symmetry CategoryTheory.Limits.preservesPushoutSymmetry

theorem hasPushout_of_preservesPushout [HasPushout f g] : HasPushout (G.map f) (G.map g) :=
  ⟨⟨⟨_, isColimitPushoutCoconeMapOfIsColimit G _ (pushoutIsPushout _ _)⟩⟩⟩
#align category_theory.limits.has_pushout_of_preserves_pushout CategoryTheory.Limits.hasPushout_of_preservesPushout

variable [HasPushout f g] [HasPushout (G.map f) (G.map g)]

/-- If `G` preserves the pushout of `(f,g)`, then the pushout comparison map for `G` at `(f,g)` is
an isomorphism. -/
def PreservesPushout.iso : pushout (G.map f) (G.map g) ≅ G.obj (pushout f g) :=
  IsColimit.coconePointUniqueUpToIso (colimit.isColimit _)
    (isColimitOfHasPushoutOfPreservesColimit G f g)
#align category_theory.limits.preserves_pushout.iso CategoryTheory.Limits.PreservesPushout.iso

@[reassoc]
theorem PreservesPushout.inl_iso_hom :
    pushout.inl ≫ (PreservesPushout.iso G f g).hom = G.map pushout.inl := by
  delta PreservesPushout.iso
  simp
#align category_theory.limits.preserves_pushout.inl_iso_hom CategoryTheory.Limits.PreservesPushout.inl_iso_hom

@[reassoc]
theorem PreservesPushout.inr_iso_hom :
    pushout.inr ≫ (PreservesPushout.iso G f g).hom = G.map pushout.inr := by
  delta PreservesPushout.iso
  simp
#align category_theory.limits.preserves_pushout.inr_iso_hom CategoryTheory.Limits.PreservesPushout.inr_iso_hom

@[reassoc (attr := simp)]
theorem PreservesPushout.inl_iso_inv :
    G.map pushout.inl ≫ (PreservesPushout.iso G f g).inv = pushout.inl := by
  simp [PreservesPushout.iso, Iso.comp_inv_eq]
#align category_theory.limits.preserves_pushout.inl_iso_inv CategoryTheory.Limits.PreservesPushout.inl_iso_inv

@[reassoc (attr := simp)]
theorem PreservesPushout.inr_iso_inv :
    G.map pushout.inr ≫ (PreservesPushout.iso G f g).inv = pushout.inr := by
  simp [PreservesPushout.iso, Iso.comp_inv_eq]
#align category_theory.limits.preserves_pushout.inr_iso_inv CategoryTheory.Limits.PreservesPushout.inr_iso_inv

end Pushout

section

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

variable {D : Type u₂} [Category.{v₁} D]

variable (G : C ⥤ D)

section Pullback

variable {X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}

variable [HasPullback f g] [HasPullback (G.map f) (G.map g)]

/-- If the pullback comparison map for `G` at `(f,g)` is an isomorphism, then `G` preserves the
pullback of `(f,g)`. -/
def PreservesPullback.ofIsoComparison [i : IsIso (pullbackComparison G f g)] :
    PreservesLimit (cospan f g) G := by
  apply preservesLimitOfPreservesLimitCone (pullbackIsPullback f g)
  apply (isLimitMapConePullbackConeEquiv _ _).symm _
  refine @IsLimit.ofPointIso _ _ _ _ _ _ _ (limit.isLimit (cospan (G.map f) (G.map g))) ?_
  apply i
#align category_theory.limits.preserves_pullback.of_iso_comparison CategoryTheory.Limits.PreservesPullback.ofIsoComparison

variable [PreservesLimit (cospan f g) G]

@[simp]
theorem PreservesPullback.iso_hom : (PreservesPullback.iso G f g).hom = pullbackComparison G f g :=
  rfl
#align category_theory.limits.preserves_pullback.iso_hom CategoryTheory.Limits.PreservesPullback.iso_hom

instance : IsIso (pullbackComparison G f g) := by
  rw [← PreservesPullback.iso_hom]
  infer_instance

end Pullback

section Pushout

variable {X Y Z : C} {f : X ⟶ Y} {g : X ⟶ Z}

variable [HasPushout f g] [HasPushout (G.map f) (G.map g)]

/-- If the pushout comparison map for `G` at `(f,g)` is an isomorphism, then `G` preserves the
pushout of `(f,g)`. -/
def PreservesPushout.ofIsoComparison [i : IsIso (pushoutComparison G f g)] :
    PreservesColimit (span f g) G := by
  apply preservesColimitOfPreservesColimitCocone (pushoutIsPushout f g)
  apply (isColimitMapCoconePushoutCoconeEquiv _ _).symm _
  -- Porting note: apply no longer creates goals for instances
  refine @IsColimit.ofPointIso _ _ _ _ _ _ _ (colimit.isColimit (span (G.map f) (G.map g))) ?_
  apply i
#align category_theory.limits.preserves_pushout.of_iso_comparison CategoryTheory.Limits.PreservesPushout.ofIsoComparison

variable [PreservesColimit (span f g) G]

@[simp]
theorem PreservesPushout.iso_hom : (PreservesPushout.iso G f g).hom = pushoutComparison G f g :=
  rfl
#align category_theory.limits.preserves_pushout.iso_hom CategoryTheory.Limits.PreservesPushout.iso_hom

instance : IsIso (pushoutComparison G f g) := by
  rw [← PreservesPushout.iso_hom]
  infer_instance

end Pushout

end

end CategoryTheory.Limits


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Sébastien Gouëzel,
  Rémy Degenne
-/
import analysis.special_functions.pow
import analysis.special_functions.complex.log_deriv
import analysis.calculus.extend_deriv
import analysis.special_functions.log_deriv
import analysis.special_functions.trigonometric.deriv

/-!
# Derivatives of power function on `ℂ`, `ℝ`, `ℝ≥0`, and `ℝ≥0∞`

We also prove differentiability and provide derivatives for the power functions `x ^ y`.
-/

noncomputable theory

open_locale classical real topological_space nnreal ennreal filter
open filter

namespace complex

lemma has_strict_fderiv_at_cpow {p : ℂ × ℂ} (hp : 0 < p.1.re ∨ p.1.im ≠ 0) :
  has_strict_fderiv_at (λ x : ℂ × ℂ, x.1 ^ x.2)
    ((p.2 * p.1 ^ (p.2 - 1)) • continuous_linear_map.fst ℂ ℂ ℂ +
      (p.1 ^ p.2 * log p.1) • continuous_linear_map.snd ℂ ℂ ℂ) p :=
begin
  have A : p.1 ≠ 0, by { intro h, simpa [h, lt_irrefl] using hp },
  have : (λ x : ℂ × ℂ, x.1 ^ x.2) =ᶠ[𝓝 p] (λ x, exp (log x.1 * x.2)),
    from ((is_open_ne.preimage continuous_fst).eventually_mem A).mono
      (λ p hp, cpow_def_of_ne_zero hp _),
  rw [cpow_sub _ _ A, cpow_one, mul_div_comm, mul_smul, mul_smul, ← smul_add],
  refine has_strict_fderiv_at.congr_of_eventually_eq _ this.symm,
  simpa only [cpow_def_of_ne_zero A, div_eq_mul_inv, mul_smul, add_comm]
    using ((has_strict_fderiv_at_fst.clog hp).mul has_strict_fderiv_at_snd).cexp
end

lemma has_strict_fderiv_at_cpow' {x y : ℂ} (hp : 0 < x.re ∨ x.im ≠ 0) :
  has_strict_fderiv_at (λ x : ℂ × ℂ, x.1 ^ x.2)
    ((y * x ^ (y - 1)) • continuous_linear_map.fst ℂ ℂ ℂ +
      (x ^ y * log x) • continuous_linear_map.snd ℂ ℂ ℂ) (x, y) :=
@has_strict_fderiv_at_cpow (x, y) hp

lemma has_strict_deriv_at_const_cpow {x y : ℂ} (h : x ≠ 0 ∨ y ≠ 0) :
  has_strict_deriv_at (λ y, x ^ y) (x ^ y * log x) y :=
begin
  rcases em (x = 0) with rfl|hx,
  { replace h := h.neg_resolve_left rfl,
    rw [log_zero, mul_zero],
    refine (has_strict_deriv_at_const _ 0).congr_of_eventually_eq _,
    exact (is_open_ne.eventually_mem h).mono (λ y hy, (zero_cpow hy).symm) },
  { simpa only [cpow_def_of_ne_zero hx, mul_one]
      using ((has_strict_deriv_at_id y).const_mul (log x)).cexp }
end

lemma has_fderiv_at_cpow {p : ℂ × ℂ} (hp : 0 < p.1.re ∨ p.1.im ≠ 0) :
  has_fderiv_at (λ x : ℂ × ℂ, x.1 ^ x.2)
    ((p.2 * p.1 ^ (p.2 - 1)) • continuous_linear_map.fst ℂ ℂ ℂ +
      (p.1 ^ p.2 * log p.1) • continuous_linear_map.snd ℂ ℂ ℂ) p :=
(has_strict_fderiv_at_cpow hp).has_fderiv_at

end complex

section fderiv

open complex

variables {E : Type*} [normed_group E] [normed_space ℂ E] {f g : E → ℂ} {f' g' : E →L[ℂ] ℂ}
  {x : E} {s : set E} {c : ℂ}

lemma has_strict_fderiv_at.cpow (hf : has_strict_fderiv_at f f' x)
  (hg : has_strict_fderiv_at g g' x) (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) :
  has_strict_fderiv_at (λ x, f x ^ g x)
    ((g x * f x ^ (g x - 1)) • f' + (f x ^ g x * log (f x)) • g') x :=
by convert (@has_strict_fderiv_at_cpow ((λ x, (f x, g x)) x) h0).comp x (hf.prod hg)

lemma has_strict_fderiv_at.const_cpow (hf : has_strict_fderiv_at f f' x) (h0 : c ≠ 0 ∨ f x ≠ 0) :
  has_strict_fderiv_at (λ x, c ^ f x) ((c ^ f x * log c) • f') x :=
(has_strict_deriv_at_const_cpow h0).comp_has_strict_fderiv_at x hf

lemma has_fderiv_at.cpow (hf : has_fderiv_at f f' x) (hg : has_fderiv_at g g' x)
  (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) :
  has_fderiv_at (λ x, f x ^ g x)
    ((g x * f x ^ (g x - 1)) • f' + (f x ^ g x * log (f x)) • g') x :=
by convert (@complex.has_fderiv_at_cpow ((λ x, (f x, g x)) x) h0).comp x (hf.prod hg)

lemma has_fderiv_at.const_cpow (hf : has_fderiv_at f f' x) (h0 : c ≠ 0 ∨ f x ≠ 0) :
  has_fderiv_at (λ x, c ^ f x) ((c ^ f x * log c) • f') x :=
(has_strict_deriv_at_const_cpow h0).has_deriv_at.comp_has_fderiv_at x hf

lemma has_fderiv_within_at.cpow (hf : has_fderiv_within_at f f' s x)
  (hg : has_fderiv_within_at g g' s x) (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) :
  has_fderiv_within_at (λ x, f x ^ g x)
    ((g x * f x ^ (g x - 1)) • f' + (f x ^ g x * log (f x)) • g') s x :=
by convert (@complex.has_fderiv_at_cpow ((λ x, (f x, g x)) x) h0).comp_has_fderiv_within_at x
  (hf.prod hg)

lemma has_fderiv_within_at.const_cpow (hf : has_fderiv_within_at f f' s x) (h0 : c ≠ 0 ∨ f x ≠ 0) :
  has_fderiv_within_at (λ x, c ^ f x) ((c ^ f x * log c) • f') s x :=
(has_strict_deriv_at_const_cpow h0).has_deriv_at.comp_has_fderiv_within_at x hf

lemma differentiable_at.cpow (hf : differentiable_at ℂ f x) (hg : differentiable_at ℂ g x)
  (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) :
  differentiable_at ℂ (λ x, f x ^ g x) x :=
(hf.has_fderiv_at.cpow hg.has_fderiv_at h0).differentiable_at

lemma differentiable_at.const_cpow (hf : differentiable_at ℂ f x) (h0 : c ≠ 0 ∨ f x ≠ 0) :
  differentiable_at ℂ (λ x, c ^ f x) x :=
(hf.has_fderiv_at.const_cpow h0).differentiable_at

lemma differentiable_within_at.cpow (hf : differentiable_within_at ℂ f s x)
  (hg : differentiable_within_at ℂ g s x) (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) :
  differentiable_within_at ℂ (λ x, f x ^ g x) s x :=
(hf.has_fderiv_within_at.cpow hg.has_fderiv_within_at h0).differentiable_within_at

lemma differentiable_within_at.const_cpow (hf : differentiable_within_at ℂ f s x)
  (h0 : c ≠ 0 ∨ f x ≠ 0) :
  differentiable_within_at ℂ (λ x, c ^ f x) s x :=
(hf.has_fderiv_within_at.const_cpow h0).differentiable_within_at

end fderiv

section deriv

open complex

variables {f g : ℂ → ℂ} {s : set ℂ} {f' g' x c : ℂ}

/-- A private lemma that rewrites the output of lemmas like `has_fderiv_at.cpow` to the form
expected by lemmas like `has_deriv_at.cpow`. -/
private lemma aux :
  ((g x * f x ^ (g x - 1)) • (1 : ℂ →L[ℂ] ℂ).smul_right f' +
    (f x ^ g x * log (f x)) • (1 : ℂ →L[ℂ] ℂ).smul_right g') 1 =
    g x * f x ^ (g x - 1) * f' + f x ^ g x * log (f x) * g' :=
by simp only [algebra.id.smul_eq_mul, one_mul, continuous_linear_map.one_apply,
  continuous_linear_map.smul_right_apply, continuous_linear_map.add_apply, pi.smul_apply,
  continuous_linear_map.coe_smul']

lemma has_strict_deriv_at.cpow (hf : has_strict_deriv_at f f' x) (hg : has_strict_deriv_at g g' x)
  (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) :
  has_strict_deriv_at (λ x, f x ^ g x)
    (g x * f x ^ (g x - 1) * f' + f x ^ g x * log (f x) * g') x :=
by simpa only [aux] using (hf.cpow hg h0).has_strict_deriv_at

lemma has_strict_deriv_at.const_cpow (hf : has_strict_deriv_at f f' x) (h : c ≠ 0 ∨ f x ≠ 0) :
  has_strict_deriv_at (λ x, c ^ f x) (c ^ f x * log c * f') x :=
(has_strict_deriv_at_const_cpow h).comp x hf

lemma complex.has_strict_deriv_at_cpow_const (h : 0 < x.re ∨ x.im ≠ 0) :
  has_strict_deriv_at (λ z : ℂ, z ^ c) (c * x ^ (c - 1)) x :=
by simpa only [mul_zero, add_zero, mul_one]
  using (has_strict_deriv_at_id x).cpow (has_strict_deriv_at_const x c) h

lemma has_strict_deriv_at.cpow_const (hf : has_strict_deriv_at f f' x)
  (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) :
  has_strict_deriv_at (λ x, f x ^ c) (c * f x ^ (c - 1) * f') x :=
(complex.has_strict_deriv_at_cpow_const h0).comp x hf

lemma has_deriv_at.cpow (hf : has_deriv_at f f' x) (hg : has_deriv_at g g' x)
  (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) :
  has_deriv_at (λ x, f x ^ g x) (g x * f x ^ (g x - 1) * f' + f x ^ g x * log (f x) * g') x :=
by simpa only [aux] using (hf.has_fderiv_at.cpow hg h0).has_deriv_at

lemma has_deriv_at.const_cpow (hf : has_deriv_at f f' x) (h0 : c ≠ 0 ∨ f x ≠ 0) :
  has_deriv_at (λ x, c ^ f x) (c ^ f x * log c * f') x :=
(has_strict_deriv_at_const_cpow h0).has_deriv_at.comp x hf

lemma has_deriv_at.cpow_const (hf : has_deriv_at f f' x) (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) :
  has_deriv_at (λ x, f x ^ c) (c * f x ^ (c - 1) * f') x :=
(complex.has_strict_deriv_at_cpow_const h0).has_deriv_at.comp x hf

lemma has_deriv_within_at.cpow (hf : has_deriv_within_at f f' s x)
  (hg : has_deriv_within_at g g' s x) (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) :
  has_deriv_within_at (λ x, f x ^ g x)
    (g x * f x ^ (g x - 1) * f' + f x ^ g x * log (f x) * g') s x :=
by simpa only [aux] using (hf.has_fderiv_within_at.cpow hg h0).has_deriv_within_at

lemma has_deriv_within_at.const_cpow (hf : has_deriv_within_at f f' s x) (h0 : c ≠ 0 ∨ f x ≠ 0) :
  has_deriv_within_at (λ x, c ^ f x) (c ^ f x * log c * f') s x :=
(has_strict_deriv_at_const_cpow h0).has_deriv_at.comp_has_deriv_within_at x hf

lemma has_deriv_within_at.cpow_const (hf : has_deriv_within_at f f' s x)
  (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) :
  has_deriv_within_at (λ x, f x ^ c) (c * f x ^ (c - 1) * f') s x :=
(complex.has_strict_deriv_at_cpow_const h0).has_deriv_at.comp_has_deriv_within_at x hf

end deriv

namespace real

variables {x y z : ℝ}

/-- `(x, y) ↦ x ^ y` is strictly differentiable at `p : ℝ × ℝ` such that `0 < p.fst`. -/
lemma has_strict_fderiv_at_rpow_of_pos (p : ℝ × ℝ) (hp : 0 < p.1) :
  has_strict_fderiv_at (λ x : ℝ × ℝ, x.1 ^ x.2)
    ((p.2 * p.1 ^ (p.2 - 1)) • continuous_linear_map.fst ℝ ℝ ℝ +
      (p.1 ^ p.2 * log p.1) • continuous_linear_map.snd ℝ ℝ ℝ) p :=
begin
  have : (λ x : ℝ × ℝ, x.1 ^ x.2) =ᶠ[𝓝 p] (λ x, exp (log x.1 * x.2)),
    from (continuous_at_fst.eventually (lt_mem_nhds hp)).mono (λ p hp, rpow_def_of_pos hp _),
  refine has_strict_fderiv_at.congr_of_eventually_eq _ this.symm,
  convert ((has_strict_fderiv_at_fst.log hp.ne').mul has_strict_fderiv_at_snd).exp,
  rw [rpow_sub_one hp.ne', ← rpow_def_of_pos hp, smul_add, smul_smul, mul_div_comm,
    div_eq_mul_inv, smul_smul, smul_smul, mul_assoc, add_comm]
end

/-- `(x, y) ↦ x ^ y` is strictly differentiable at `p : ℝ × ℝ` such that `p.fst < 0`. -/
lemma has_strict_fderiv_at_rpow_of_neg (p : ℝ × ℝ) (hp : p.1 < 0) :
  has_strict_fderiv_at (λ x : ℝ × ℝ, x.1 ^ x.2)
    ((p.2 * p.1 ^ (p.2 - 1)) • continuous_linear_map.fst ℝ ℝ ℝ +
      (p.1 ^ p.2 * log p.1 - exp (log p.1 * p.2) * sin (p.2 * π) * π) •
        continuous_linear_map.snd ℝ ℝ ℝ) p :=
begin
  have : (λ x : ℝ × ℝ, x.1 ^ x.2) =ᶠ[𝓝 p] (λ x, exp (log x.1 * x.2) * cos (x.2 * π)),
    from (continuous_at_fst.eventually (gt_mem_nhds hp)).mono (λ p hp, rpow_def_of_neg hp _),
  refine has_strict_fderiv_at.congr_of_eventually_eq _ this.symm,
  convert ((has_strict_fderiv_at_fst.log hp.ne).mul has_strict_fderiv_at_snd).exp.mul
    (has_strict_fderiv_at_snd.mul_const _).cos using 1,
  simp_rw [rpow_sub_one hp.ne, smul_add, ← add_assoc, smul_smul, ← add_smul, ← mul_assoc,
    mul_comm (cos _), ← rpow_def_of_neg hp],
  rw [div_eq_mul_inv, add_comm], congr' 2; ring
end

/-- The function `λ (x, y), x ^ y` is infinitely smooth at `(x, y)` unless `x = 0`. -/
lemma times_cont_diff_at_rpow_of_ne (p : ℝ × ℝ) (hp : p.1 ≠ 0) {n : with_top ℕ} :
  times_cont_diff_at ℝ n (λ p : ℝ × ℝ, p.1 ^ p.2) p :=
begin
  cases hp.lt_or_lt with hneg hpos,
  exacts [(((times_cont_diff_at_fst.log hneg.ne).mul times_cont_diff_at_snd).exp.mul
    (times_cont_diff_at_snd.mul times_cont_diff_at_const).cos).congr_of_eventually_eq
      ((continuous_at_fst.eventually (gt_mem_nhds hneg)).mono (λ p hp, rpow_def_of_neg hp _)),
    ((times_cont_diff_at_fst.log hpos.ne').mul times_cont_diff_at_snd).exp.congr_of_eventually_eq
      ((continuous_at_fst.eventually (lt_mem_nhds hpos)).mono (λ p hp, rpow_def_of_pos hp _))]
end

lemma differentiable_at_rpow_of_ne (p : ℝ × ℝ) (hp : p.1 ≠ 0) :
  differentiable_at ℝ (λ p : ℝ × ℝ, p.1 ^ p.2) p :=
(times_cont_diff_at_rpow_of_ne p hp).differentiable_at le_rfl

lemma _root_.has_strict_deriv_at.rpow {f g : ℝ → ℝ} {f' g' : ℝ} (hf : has_strict_deriv_at f f' x)
  (hg : has_strict_deriv_at g g' x) (h : 0 < f x) :
  has_strict_deriv_at (λ x, f x ^ g x)
    (f' * g x * (f x) ^ (g x - 1) + g' * f x ^ g x * log (f x)) x :=
begin
  convert (has_strict_fderiv_at_rpow_of_pos ((λ x, (f x, g x)) x) h).comp_has_strict_deriv_at _
    (hf.prod hg) using 1,
  simp [mul_assoc, mul_comm, mul_left_comm]
end

lemma has_strict_deriv_at_rpow_const_of_ne {x : ℝ} (hx : x ≠ 0) (p : ℝ) :
  has_strict_deriv_at (λ x, x ^ p) (p * x ^ (p - 1)) x :=
begin
  cases hx.lt_or_lt with hx hx,
  { have := (has_strict_fderiv_at_rpow_of_neg (x, p) hx).comp_has_strict_deriv_at x
      ((has_strict_deriv_at_id x).prod (has_strict_deriv_at_const _ _)),
    convert this, simp },
  { simpa using (has_strict_deriv_at_id x).rpow (has_strict_deriv_at_const x p) hx }
end

lemma has_strict_deriv_at_const_rpow {a : ℝ} (ha : 0 < a) (x : ℝ) :
  has_strict_deriv_at (λ x, a ^ x) (a ^ x * log a) x :=
by simpa using (has_strict_deriv_at_const _ _).rpow (has_strict_deriv_at_id x) ha

/-- This lemma says that `λ x, a ^ x` is strictly differentiable for `a < 0`. Note that these
values of `a` are outside of the "official" domain of `a ^ x`, and we may redefine `a ^ x`
for negative `a` if some other definition will be more convenient. -/
lemma has_strict_deriv_at_const_rpow_of_neg {a x : ℝ} (ha : a < 0) :
  has_strict_deriv_at (λ x, a ^ x) (a ^ x * log a - exp (log a * x) * sin (x * π) * π) x :=
by simpa using (has_strict_fderiv_at_rpow_of_neg (a, x) ha).comp_has_strict_deriv_at x
  ((has_strict_deriv_at_const _ _).prod (has_strict_deriv_at_id _))

end real

namespace real

variables {z x y : ℝ}

lemma has_deriv_at_rpow_const {x p : ℝ} (h : x ≠ 0 ∨ 1 ≤ p) :
  has_deriv_at (λ x, x ^ p) (p * x ^ (p - 1)) x :=
begin
  rcases ne_or_eq x 0 with hx | rfl,
  { exact (has_strict_deriv_at_rpow_const_of_ne hx _).has_deriv_at },
  replace h : 1 ≤ p := h.neg_resolve_left rfl,
  apply has_deriv_at_of_has_deriv_at_of_ne
    (λ x hx, (has_strict_deriv_at_rpow_const_of_ne hx p).has_deriv_at),
  exacts [continuous_at_id.rpow_const (or.inr (zero_le_one.trans h)),
    continuous_at_const.mul (continuous_at_id.rpow_const (or.inr (sub_nonneg.2 h)))]
end

lemma differentiable_rpow_const {p : ℝ} (hp : 1 ≤ p) :
  differentiable ℝ (λ x : ℝ, x ^ p) :=
λ x, (has_deriv_at_rpow_const (or.inr hp)).differentiable_at

lemma deriv_rpow_const {x p : ℝ} (h : x ≠ 0 ∨ 1 ≤ p) :
  deriv (λ x : ℝ, x ^ p) x = p * x ^ (p - 1) :=
(has_deriv_at_rpow_const h).deriv

lemma deriv_rpow_const' {p : ℝ} (h : 1 ≤ p) :
  deriv (λ x : ℝ, x ^ p) = λ x, p * x ^ (p - 1) :=
funext $ λ x, deriv_rpow_const (or.inr h)

lemma times_cont_diff_at_rpow_const_of_ne {x p : ℝ} {n : with_top ℕ} (h : x ≠ 0) :
  times_cont_diff_at ℝ n (λ x, x ^ p) x :=
(times_cont_diff_at_rpow_of_ne (x, p) h).comp x
  (times_cont_diff_at_id.prod times_cont_diff_at_const)

lemma times_cont_diff_rpow_const_of_le {p : ℝ} {n : ℕ} (h : ↑n ≤ p) :
  times_cont_diff ℝ n (λ x : ℝ, x ^ p) :=
begin
  induction n with n ihn generalizing p,
  { exact times_cont_diff_zero.2 (continuous_id.rpow_const (λ x, or.inr h)) },
  { have h1 : 1 ≤ p, from le_trans (by simp) h,
    rw [nat.cast_succ, ← le_sub_iff_add_le] at h,
    simpa [times_cont_diff_succ_iff_deriv, differentiable_rpow_const, h1, deriv_rpow_const']
      using times_cont_diff_const.mul (ihn h) }
end

lemma times_cont_diff_at_rpow_const_of_le {x p : ℝ} {n : ℕ} (h : ↑n ≤ p) :
  times_cont_diff_at ℝ n (λ x : ℝ, x ^ p) x :=
(times_cont_diff_rpow_const_of_le h).times_cont_diff_at

lemma times_cont_diff_at_rpow_const {x p : ℝ} {n : ℕ} (h : x ≠ 0 ∨ ↑n ≤ p) :
  times_cont_diff_at ℝ n (λ x : ℝ, x ^ p) x :=
h.elim times_cont_diff_at_rpow_const_of_ne times_cont_diff_at_rpow_const_of_le

lemma has_strict_deriv_at_rpow_const {x p : ℝ} (hx : x ≠ 0 ∨ 1 ≤ p) :
  has_strict_deriv_at (λ x, x ^ p) (p * x ^ (p - 1)) x :=
times_cont_diff_at.has_strict_deriv_at'
  (times_cont_diff_at_rpow_const (by rwa nat.cast_one))
  (has_deriv_at_rpow_const hx) le_rfl

end real

section differentiability
open real

section fderiv

variables {E : Type*} [normed_group E] [normed_space ℝ E] {f g : E → ℝ} {f' g' : E →L[ℝ] ℝ}
  {x : E} {s : set E} {c p : ℝ} {n : with_top ℕ}

lemma has_fderiv_within_at.rpow (hf : has_fderiv_within_at f f' s x)
  (hg : has_fderiv_within_at g g' s x) (h : 0 < f x) :
  has_fderiv_within_at (λ x, f x ^ g x)
    ((g x * f x ^ (g x - 1)) • f' + (f x ^ g x * log (f x)) • g') s x :=
(has_strict_fderiv_at_rpow_of_pos (f x, g x) h).has_fderiv_at.comp_has_fderiv_within_at x
  (hf.prod hg)

lemma has_fderiv_at.rpow (hf : has_fderiv_at f f' x) (hg : has_fderiv_at g g' x) (h : 0 < f x) :
  has_fderiv_at (λ x, f x ^ g x) ((g x * f x ^ (g x - 1)) • f' + (f x ^ g x * log (f x)) • g') x :=
(has_strict_fderiv_at_rpow_of_pos (f x, g x) h).has_fderiv_at.comp x (hf.prod hg)

lemma has_strict_fderiv_at.rpow (hf : has_strict_fderiv_at f f' x)
  (hg : has_strict_fderiv_at g g' x) (h : 0 < f x) :
  has_strict_fderiv_at (λ x, f x ^ g x)
    ((g x * f x ^ (g x - 1)) • f' + (f x ^ g x * log (f x)) • g') x :=
(has_strict_fderiv_at_rpow_of_pos (f x, g x) h).comp x (hf.prod hg)

lemma differentiable_within_at.rpow (hf : differentiable_within_at ℝ f s x)
  (hg : differentiable_within_at ℝ g s x) (h : f x ≠ 0) :
  differentiable_within_at ℝ (λ x, f x ^ g x) s x :=
(differentiable_at_rpow_of_ne (f x, g x) h).comp_differentiable_within_at x (hf.prod hg)

lemma differentiable_at.rpow (hf : differentiable_at ℝ f x) (hg : differentiable_at ℝ g x)
  (h : f x ≠ 0) :
  differentiable_at ℝ (λ x, f x ^ g x) x :=
(differentiable_at_rpow_of_ne (f x, g x) h).comp x (hf.prod hg)

lemma differentiable_on.rpow (hf : differentiable_on ℝ f s) (hg : differentiable_on ℝ g s)
  (h : ∀ x ∈ s, f x ≠ 0) :
  differentiable_on ℝ (λ x, f x ^ g x) s :=
λ x hx, (hf x hx).rpow (hg x hx) (h x hx)

lemma differentiable.rpow (hf : differentiable ℝ f) (hg : differentiable ℝ g) (h : ∀ x, f x ≠ 0) :
  differentiable ℝ (λ x, f x ^ g x) :=
λ x, (hf x).rpow (hg x) (h x)

lemma has_fderiv_within_at.rpow_const (hf : has_fderiv_within_at f f' s x) (h : f x ≠ 0 ∨ 1 ≤ p) :
  has_fderiv_within_at (λ x, f x ^ p) ((p * f x ^ (p - 1)) • f') s x :=
(has_deriv_at_rpow_const h).comp_has_fderiv_within_at x hf

lemma has_fderiv_at.rpow_const (hf : has_fderiv_at f f' x) (h : f x ≠ 0 ∨ 1 ≤ p) :
  has_fderiv_at (λ x, f x ^ p) ((p * f x ^ (p - 1)) • f') x :=
(has_deriv_at_rpow_const h).comp_has_fderiv_at x hf

lemma has_strict_fderiv_at.rpow_const (hf : has_strict_fderiv_at f f' x) (h : f x ≠ 0 ∨ 1 ≤ p) :
  has_strict_fderiv_at (λ x, f x ^ p) ((p * f x ^ (p - 1)) • f') x :=
(has_strict_deriv_at_rpow_const h).comp_has_strict_fderiv_at x hf

lemma differentiable_within_at.rpow_const (hf : differentiable_within_at ℝ f s x)
  (h : f x ≠ 0 ∨ 1 ≤ p) :
  differentiable_within_at ℝ (λ x, f x ^ p) s x :=
(hf.has_fderiv_within_at.rpow_const h).differentiable_within_at

@[simp] lemma differentiable_at.rpow_const (hf : differentiable_at ℝ f x) (h : f x ≠ 0 ∨ 1 ≤ p) :
  differentiable_at ℝ (λ x, f x ^ p) x :=
(hf.has_fderiv_at.rpow_const h).differentiable_at

lemma differentiable_on.rpow_const (hf : differentiable_on ℝ f s) (h : ∀ x ∈ s, f x ≠ 0 ∨ 1 ≤ p) :
  differentiable_on ℝ (λ x, f x ^ p) s :=
λ x hx, (hf x hx).rpow_const (h x hx)

lemma differentiable.rpow_const (hf : differentiable ℝ f) (h : ∀ x, f x ≠ 0 ∨ 1 ≤ p) :
  differentiable ℝ (λ x, f x ^ p) :=
λ x, (hf x).rpow_const (h x)

lemma has_fderiv_within_at.const_rpow (hf : has_fderiv_within_at f f' s x) (hc : 0 < c) :
  has_fderiv_within_at (λ x, c ^ f x) ((c ^ f x * log c) • f') s x :=
(has_strict_deriv_at_const_rpow hc (f x)).has_deriv_at.comp_has_fderiv_within_at x hf

lemma has_fderiv_at.const_rpow (hf : has_fderiv_at f f' x) (hc : 0 < c) :
  has_fderiv_at (λ x, c ^ f x) ((c ^ f x * log c) • f') x :=
(has_strict_deriv_at_const_rpow hc (f x)).has_deriv_at.comp_has_fderiv_at x hf

lemma has_strict_fderiv_at.const_rpow (hf : has_strict_fderiv_at f f' x) (hc : 0 < c) :
  has_strict_fderiv_at (λ x, c ^ f x) ((c ^ f x * log c) • f') x :=
(has_strict_deriv_at_const_rpow hc (f x)).comp_has_strict_fderiv_at x hf

lemma times_cont_diff_within_at.rpow (hf : times_cont_diff_within_at ℝ n f s x)
  (hg : times_cont_diff_within_at ℝ n g s x) (h : f x ≠ 0) :
  times_cont_diff_within_at ℝ n (λ x, f x ^ g x) s x :=
(times_cont_diff_at_rpow_of_ne (f x, g x) h).comp_times_cont_diff_within_at x (hf.prod hg)

lemma times_cont_diff_at.rpow (hf : times_cont_diff_at ℝ n f x) (hg : times_cont_diff_at ℝ n g x)
  (h : f x ≠ 0) :
  times_cont_diff_at ℝ n (λ x, f x ^ g x) x :=
(times_cont_diff_at_rpow_of_ne (f x, g x) h).comp x (hf.prod hg)

lemma times_cont_diff_on.rpow (hf : times_cont_diff_on ℝ n f s) (hg : times_cont_diff_on ℝ n g s)
  (h : ∀ x ∈ s, f x ≠ 0) :
  times_cont_diff_on ℝ n (λ x, f x ^ g x) s :=
λ x hx, (hf x hx).rpow (hg x hx) (h x hx)

lemma times_cont_diff.rpow (hf : times_cont_diff ℝ n f) (hg : times_cont_diff ℝ n g)
  (h : ∀ x, f x ≠ 0) :
  times_cont_diff ℝ n (λ x, f x ^ g x) :=
times_cont_diff_iff_times_cont_diff_at.mpr $
  λ x, hf.times_cont_diff_at.rpow hg.times_cont_diff_at (h x)

lemma times_cont_diff_within_at.rpow_const_of_ne (hf : times_cont_diff_within_at ℝ n f s x)
  (h : f x ≠ 0) :
  times_cont_diff_within_at ℝ n (λ x, f x ^ p) s x :=
hf.rpow times_cont_diff_within_at_const h

lemma times_cont_diff_at.rpow_const_of_ne (hf : times_cont_diff_at ℝ n f x) (h : f x ≠ 0) :
  times_cont_diff_at ℝ n (λ x, f x ^ p) x :=
hf.rpow times_cont_diff_at_const h

lemma times_cont_diff_on.rpow_const_of_ne (hf : times_cont_diff_on ℝ n f s) (h : ∀ x ∈ s, f x ≠ 0) :
  times_cont_diff_on ℝ n (λ x, f x ^ p) s :=
λ x hx, (hf x hx).rpow_const_of_ne (h x hx)

lemma times_cont_diff.rpow_const_of_ne (hf : times_cont_diff ℝ n f) (h : ∀ x, f x ≠ 0) :
  times_cont_diff ℝ n (λ x, f x ^ p) :=
hf.rpow times_cont_diff_const h

variable {m : ℕ}

lemma times_cont_diff_within_at.rpow_const_of_le (hf : times_cont_diff_within_at ℝ m f s x)
  (h : ↑m ≤ p) :
  times_cont_diff_within_at ℝ m (λ x, f x ^ p) s x :=
(times_cont_diff_at_rpow_const_of_le h).comp_times_cont_diff_within_at x hf

lemma times_cont_diff_at.rpow_const_of_le (hf : times_cont_diff_at ℝ m f x) (h : ↑m ≤ p) :
  times_cont_diff_at ℝ m (λ x, f x ^ p) x :=
by { rw ← times_cont_diff_within_at_univ at *, exact hf.rpow_const_of_le h }

lemma times_cont_diff_on.rpow_const_of_le (hf : times_cont_diff_on ℝ m f s) (h : ↑m ≤ p) :
  times_cont_diff_on ℝ m (λ x, f x ^ p) s :=
λ x hx, (hf x hx).rpow_const_of_le h

lemma times_cont_diff.rpow_const_of_le (hf : times_cont_diff ℝ m f) (h : ↑m ≤ p) :
  times_cont_diff ℝ m (λ x, f x ^ p) :=
times_cont_diff_iff_times_cont_diff_at.mpr $ λ x, hf.times_cont_diff_at.rpow_const_of_le h

end fderiv

section deriv

variables {f g : ℝ → ℝ} {f' g' x y p : ℝ} {s : set ℝ}

lemma has_deriv_within_at.rpow (hf : has_deriv_within_at f f' s x)
  (hg : has_deriv_within_at g g' s x) (h : 0 < f x) :
  has_deriv_within_at (λ x, f x ^ g x)
    (f' * g x * (f x) ^ (g x - 1) + g' * f x ^ g x * log (f x)) s x :=
begin
  convert (hf.has_fderiv_within_at.rpow hg.has_fderiv_within_at h).has_deriv_within_at using 1,
  dsimp, ring
end

lemma has_deriv_at.rpow (hf : has_deriv_at f f' x) (hg : has_deriv_at g g' x) (h : 0 < f x) :
  has_deriv_at (λ x, f x ^ g x) (f' * g x * (f x) ^ (g x - 1) + g' * f x ^ g x * log (f x)) x :=
begin
  rw ← has_deriv_within_at_univ at *,
  exact hf.rpow hg h
end

lemma has_deriv_within_at.rpow_const (hf : has_deriv_within_at f f' s x) (hx : f x ≠ 0 ∨ 1 ≤ p) :
  has_deriv_within_at (λ y, (f y)^p) (f' * p * (f x) ^ (p - 1)) s x :=
begin
  convert (has_deriv_at_rpow_const hx).comp_has_deriv_within_at x hf using 1,
  ring
end

lemma has_deriv_at.rpow_const (hf : has_deriv_at f f' x) (hx : f x ≠ 0 ∨ 1 ≤ p) :
  has_deriv_at (λ y, (f y)^p) (f' * p * (f x)^(p-1)) x :=
begin
  rw ← has_deriv_within_at_univ at *,
  exact hf.rpow_const hx
end

lemma deriv_within_rpow_const (hf : differentiable_within_at ℝ f s x) (hx : f x ≠ 0 ∨ 1 ≤ p)
  (hxs : unique_diff_within_at ℝ s x) :
  deriv_within (λx, (f x) ^ p) s x = (deriv_within f s x) * p * (f x) ^ (p - 1) :=
(hf.has_deriv_within_at.rpow_const hx).deriv_within hxs

@[simp] lemma deriv_rpow_const (hf : differentiable_at ℝ f x) (hx : f x ≠ 0 ∨ 1 ≤ p) :
  deriv (λx, (f x)^p) x = (deriv f x) * p * (f x)^(p-1) :=
(hf.has_deriv_at.rpow_const hx).deriv

end deriv

end differentiability

section limits
open real filter

/-- The function `(1 + t/x) ^ x` tends to `exp t` at `+∞`. -/
lemma tendsto_one_plus_div_rpow_exp (t : ℝ) :
  tendsto (λ (x : ℝ), (1 + t / x) ^ x) at_top (𝓝 (exp t)) :=
begin
  apply ((real.continuous_exp.tendsto _).comp (tendsto_mul_log_one_plus_div_at_top t)).congr' _,
  have h₁ : (1:ℝ)/2 < 1 := by linarith,
  have h₂ : tendsto (λ x : ℝ, 1 + t / x) at_top (𝓝 1) :=
    by simpa using (tendsto_inv_at_top_zero.const_mul t).const_add 1,
  refine (eventually_ge_of_tendsto_gt h₁ h₂).mono (λ x hx, _),
  have hx' : 0 < 1 + t / x := by linarith,
  simp [mul_comm x, exp_mul, exp_log hx'],
end

/-- The function `(1 + t/x) ^ x` tends to `exp t` at `+∞` for naturals `x`. -/
lemma tendsto_one_plus_div_pow_exp (t : ℝ) :
  tendsto (λ (x : ℕ), (1 + t / (x:ℝ)) ^ x) at_top (𝓝 (real.exp t)) :=
((tendsto_one_plus_div_rpow_exp t).comp tendsto_coe_nat_at_top_at_top).congr (by simp)

end limits


/-
Copyright © 2018 François G. Dorais. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import .basic .cons .append .sumprod .map

variable {α : Type*}

definition ntup.join {n : ℕ} : ntup α ^ n → ntup α := tup.join

definition ntup.join_length {n : ℕ} (ts : ntup α ^ n) : ℕ := (ntup.join ts).length

#exit

definition fin.step :
Π {m : ℕ} (ns : ℕ ^ m) (i : fin m) (j : fin ns[i]), fin (tup.sum' ns)
| 0 _ i _ :=
  fin.elim0 i
| (m+1) ns ⟨0,_⟩ j :=
  fin.lift (tup.sum' ns.tail) j
| (m+1) ns ⟨i+1,ih⟩ j :=
  fin.push ns.head (fin.step ns.tail ⟨i, nat.lt_of_succ_lt_succ ih⟩ j)

lemma ntup.join_val :
∀ {m : ℕ} (nxs : (ntup α) ^ m) (i : fin m) (j : fin nxs[i].length),
(ntup.join nxs).to_tup[fin.step (tup.map ntup.length nxs) i j] = nxs.to_tup[i].to_tup[j]
| 0 _ i _ :=
  fin.elim0 i
| (m+1) ns ⟨0,_⟩ j :=
  begin
  simp [tup.join, fin.step]
  end
| (m+1) ns ⟨i+1,_⟩ j :=
  by simp [tup.join, fin.step, tup.join_val]; reflexivity


import geometry.manifold.algebra.smooth_functions
import ring_theory.derivation
import geometry.manifold.temporary_to_be_removed

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E]
{H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
(M : Type*) [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]

open_locale manifold

def module_point_derivation (x : M) : module C∞(I, M; 𝕜) 𝕜 :=
{ smul := λ f k, f x * k,
  one_smul := λ k, one_mul k,
  mul_smul := λ f g k, mul_assoc _ _ _,
  smul_add := λ f g k, mul_add _ _ _,
  smul_zero := λ f, mul_zero _,
  add_smul := λ f g k, add_mul _ _ _,
  zero_smul := λ f, zero_mul _ }

def compatible_semimodule_tangent_space (x : M) :
  @compatible_semimodule 𝕜 C∞(I, M; 𝕜) _ _ _ 𝕜 _ (module_point_derivation I M x) _ :=
{ compatible_smul := λ h k, rfl, }

@[reducible] def point_derivation (x : M) :=
  @derivation 𝕜 C∞(I, M; 𝕜) _ _ _ 𝕜 _ (module_point_derivation I M x) _
  (compatible_semimodule_tangent_space I M x)

def tangent_bundle_derivation := Σ x : M, point_derivation I M x

/-instance : has_add (tangent_bundle_derivation I M) :=
{ add := λ v w, sigma.mk v.1 (v.2 + w.2) }-/

variables {I M}

def tangent_space_inclusion {x : M} (v : point_derivation I M x) : tangent_bundle_derivation I M :=
sigma.mk x v

/- Something weird is happening. Does not find the instance of smooth manifolds with corners.
Moreover if I define it as a reducible def .eval does not work... It also takes very long time to
typecheck -/

section

namespace point_derivation

variables {I} {M} {x y : M} {v w : point_derivation I M x} (f g : C∞(I, M; 𝕜)) (r : 𝕜)

lemma coe_injective (h : ⇑v = w) : v = w :=
@derivation.coe_injective 𝕜 _ C∞(I, M; 𝕜) _ _ 𝕜 _ (module_point_derivation I M x) _
(compatible_semimodule_tangent_space I M x) v w h

@[ext] theorem ext (h : ∀ f, v f = w f) : v = w :=
coe_injective $ funext h

variables {u : point_derivation I M y}

theorem hext (h1 : x = y) (h2 : ∀ f, v f = u f) : v == u :=
begin
  cases h1,
  rw heq_iff_eq at *,
  ext,
  exact h2 f,
end

end point_derivation

end

section

variables {I} {M} {X Y : vector_field_derivation I M} (f g : C∞(I, M; 𝕜)) (r : 𝕜)

namespace vector_field_derivation

instance : has_coe_to_fun (vector_field_derivation I M) := ⟨_, λ X, X.to_linear_map.to_fun⟩

instance has_coe_to_derivation :
  has_coe (vector_field_derivation I M) (derivation 𝕜 C∞(I, M; 𝕜) C∞(I, M; 𝕜)) :=
⟨to_derivation⟩

instance has_coe_to_linear_map :
  has_coe (vector_field_derivation I M) (C∞(I, M; 𝕜) →ₗ[𝕜] C∞(I, M; 𝕜)) :=
  ⟨λ X, X.to_linear_map⟩

@[simp] lemma to_fun_eq_coe : X.to_fun = ⇑X := rfl

@[simp, norm_cast]
lemma coe_linear_map (X : vector_field_derivation I M) :
  ⇑(X : C∞(I, M; 𝕜) →ₗ[𝕜] C∞(I, M; 𝕜)) = X := rfl

lemma coe_injective (h : ⇑X = Y) : X = Y :=
by { cases X, cases Y, congr', exact derivation.coe_injective h }

@[ext] theorem ext (h : ∀ f, X f = Y f) : X = Y :=
coe_injective $ funext h

variables (X Y)

@[simp] lemma map_add : X (f + g) = X f + X g := derivation.map_add _ _ _
@[simp] lemma map_zero : X 0 = 0 := derivation.map_zero _
@[simp] lemma map_smul : X (r • f) = r • X f := derivation.map_smul _ _ _
@[simp] lemma leibniz : X (f * g) = f • X g + g • X f := derivation.leibniz _ _ _
@[simp] lemma map_one_eq_zero : X 1 = 0 := derivation.map_one_eq_zero _
@[simp] lemma map_neg : X (-f) = -X f := derivation.map_neg _ _
@[simp] lemma map_sub : X (f - g) = X f - X g := derivation.map_sub _ _ _

instance : has_zero (vector_field_derivation I M) := ⟨⟨(0 : derivation 𝕜 C∞(I, M; 𝕜) C∞(I, M; 𝕜))⟩⟩
instance : inhabited (vector_field_derivation I M) := ⟨0⟩

instance : add_comm_group (vector_field_derivation I M) :=
{ add := λ X Y, ⟨X + Y⟩,
  add_assoc := λ X Y Z, ext $ λ a, add_assoc _ _ _,
  zero_add := λ X, ext $ λ a, zero_add _,
  add_zero := λ X, ext $ λ a, add_zero _,
  add_comm := λ X Y, ext $ λ a, add_comm _ _,
  neg := λ X, ⟨-X⟩,
  add_left_neg := λ X, ext $ λ a, add_left_neg _,
  ..vector_field_derivation.has_zero }

@[simp] lemma add_apply : (X + Y) f = X f + Y f := rfl
@[simp] lemma zero_apply : (0 : vector_field_derivation I M) f = 0 := rfl

instance : has_bracket (vector_field_derivation I M) :=
{ bracket := λ X Y, ⟨⁅X, Y⁆⟩ }

@[simp] lemma commutator_to_derivation_coe : ⁅X, Y⁆.to_derivation = ⁅X, Y⁆ := rfl

@[simp] lemma commutator_coe_derivation :
  ⇑⁅X, Y⁆ = (⁅X, Y⁆ : derivation 𝕜 C∞(I, M; 𝕜) C∞(I, M; 𝕜)) := rfl

@[simp] lemma commutator_apply : ⁅X, Y⁆ f = X (Y f) - Y (X f) :=
by rw [commutator_coe_derivation, derivation.commutator_apply]; refl

instance : lie_ring (vector_field_derivation I M) :=
{ add_lie := λ X Y Z, by { ext1 f, simp only [commutator_apply, add_apply, map_add], ring, },
  lie_add := λ X Y Z, by { ext1 f, simp only [commutator_apply, add_apply, map_add], ring },
  lie_self := λ X, by { ext1 f, simp only [commutator_apply, zero_apply, sub_self] },
  jacobi := λ X Y Z, by { ext1 f, simp only [commutator_apply, add_apply, map_sub,
    zero_apply], ring }, }

instance : has_scalar 𝕜 (vector_field_derivation I M) :=
{ smul := λ k X, ⟨k • X⟩ }

instance kmodule : module 𝕜 (vector_field_derivation I M) :=
semimodule.of_core $
{ mul_smul := λ r s X, ext $ λ b, mul_smul _ _ _,
  one_smul := λ X, ext $ λ b, one_smul 𝕜 _,
  smul_add := λ r X Y, ext $ λ b, smul_add _ _ _,
  add_smul := λ r s X, ext $ λ b, add_smul _ _ _,
  ..vector_field_derivation.has_scalar }

@[simp] lemma smul_apply : (r • X) f = r • X f := rfl

instance : lie_algebra 𝕜 (vector_field_derivation I M) :=
{ lie_smul := λ X Y Z, by { ext1 f, simp only [commutator_apply, smul_apply, map_smul, smul_sub] },
  ..vector_field_derivation.kmodule, }

def eval (X : vector_field_derivation I M) (x : M) : point_derivation I M x :=
{ to_fun := λ f, (X f) x,
  map_add' := λ f g, by { rw map_add, refl },
  map_smul' := λ f g, by { rw [map_smul, algebra.id.smul_eq_mul], refl },
  leibniz' := λ h k, by { dsimp only [], rw [leibniz, algebra.id.smul_eq_mul], refl } }

@[simp] lemma eval_apply (x : M) : X.eval x f = (X f) x := rfl

@[simp] lemma eval_add (x : M) :
  (X + Y).eval x = X.eval x + Y.eval x :=
by ext f; simp only [derivation.add_apply, add_apply, eval_apply, smooth_map.add_apply]

/- to be moved -/
@[simp] lemma ring_commutator.apply {α : Type*} {R : Type*} [ring R] (f g : α → R) (a : α) :
  ⁅f, g⁆ a = ⁅f a, g a⁆ :=
by simp only [ring_commutator.commutator, pi.mul_apply, pi.sub_apply]

/- instance : has_coe_to_fun (vector_field_derivation I M) := ⟨_, λ X, eval X⟩ polymorphysm of coercions to functions is not possible? -/

end vector_field_derivation

variables {E' : Type*} [normed_group E'] [normed_space 𝕜 E']
{H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
{M' : Type*} [topological_space M'] [charted_space H' M'] [smooth_manifold_with_corners I' M']

def fdifferential (f : C∞(I, M; I', M')) (x : M) (v : point_derivation I M x) : (point_derivation I' M' (f x)) :=
{ to_fun := λ g, v (g.comp f),
  map_add' := λ g h, by { rw smooth_map.add_comp, },
  map_smul' := λ k g, by { rw smooth_map.smul_comp, },
  leibniz' := λ f g, by {dsimp only [], sorry}, } /-TODO: change it so that it is a linear map -/

localized "notation `fd` := fdifferential" in manifold

lemma apply_fdifferential (f : C∞(I, M; I', M')) (x : M) (v : point_derivation I M x) (g : C∞(I', M'; 𝕜)) :
  fd f x v g = v (g.comp f) := rfl

variables {E'' : Type*} [normed_group E''] [normed_space 𝕜 E'']
{H'' : Type*} [topological_space H''] {I'' : model_with_corners 𝕜 E'' H''}
{M'' : Type*} [topological_space M''] [charted_space H'' M''] [smooth_manifold_with_corners I'' M'']

@[simp] lemma fdifferential_comp (g : C∞(I', M'; I'', M'')) (f : C∞(I, M; I', M')) (x : M) :
  (fd g (f x)) ∘ (fd f x) = fd (g.comp f) x :=
by { ext, simp only [apply_fdifferential], refl }

end


import number_theory.bernoulli

--OUTPUT 1
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  have h1 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1),
    from by {
      assume m : ℕ,
      assume hm : m < n,
      induction m with d hd,
      {show (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x^(0 - 1), from by ring},
      {have h1 : (polynomial.bernoulli d).eval (1 + x) = (polynomial.bernoulli d).eval x + d * x^(d - 1), from by {
        have h2 : (d + 1) * (polynomial.bernoulli (d + 1)).eval (1 + x) - (d + 1) * (polynomial.bernoulli (d + 1)).eval x =
          ∑ (k : ℕ) in finset.range (d + 1), (d + 1) * C (d + 1) k * (polynomial.bernoulli k).eval x * x^(k - 1),
          from by {
            rw ← polynomial.eval_add,
            rw ← polynomial.eval_mul,
            rw ← polynomial.eval_mul,
            rw ← polynomial.eval_mul,
            rw ← polynomial.eval_add,
            rw ← polynomial.eval_mul,
            rw ← polynomial.eval_mul,
            rw ← polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_add,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul,
            rw polynomial.eval_pow,
            rw polynomial.eval_one,
            rw polynomial.eval_mul,
            rw polynomial.eval_mul
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  induction n with d hd,
  {
    rw polynomial.bernoulli_zero,
    rw polynomial.eval_C,
    ring,
  },
  {
    rw polynomial.bernoulli_succ,
    rw polynomial.eval_add,
    rw polynomial.eval_mul,
    rw polynomial.eval_X,
    rw polynomial.eval_C,
    rw polynomial.eval_add,
    rw polynomial.eval_mul,
    rw polynomial.eval_X,
    rw polynomial.eval_C,
    rw polynomial.eval_sub,
    rw polynomial.eval_C,
    rw polynomial.eval_X,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_X,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,

end --Needs more than 2000 tokens!

--OUTPUT 3
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  have h1 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
    assume (m : ℕ) (h : m < n),
    begin
      induction m with m hm,
      show (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x^(0 - 1), from
        by {rw [polynomial.bernoulli_zero,polynomial.bernoulli_zero,zero_pow],ring,},
      assume h1 : ∀ m : ℕ, m < m → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1),
      show (polynomial.bernoulli (m + 1)).eval (1 + x) = (polynomial.bernoulli (m + 1)).eval x + (m + 1) * x^((m + 1) - 1), from
        begin
          have h2 : ∀ l : ℕ, (polynomial.bernoulli l).eval (1 + x) = (polynomial.bernoulli l).eval x + l * x^(l - 1), from
            assume l : ℕ,
            begin
              induction l with l hl,
              show (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x^(0 - 1), from
                by {rw [polynomial.bernoulli_zero,polynomial.bernoulli_zero,zero_pow],ring,},
              assume h2 : (polynomial.bernoulli l).eval (1 + x) = (polynomial.bernoulli l).eval x + l * x^(l - 1),
              show (polynomial.bernoulli (l + 1)).eval (1 + x) = (polynomial.bernoulli (l + 1)).eval x + (l + 1) * x^((l + 1) - 1), from
                by {rw [polynomial.bernoulli_succ,polynomial.bernoulli_succ],rw [h2,h2],ring,},
            end,
          have h3 : ∀ l : ℕ, (polynomial.bernoulli l).eval (1 + x) = (polynomial.bernoulli l).eval x + l * x^(l - 1), from
            assume l : ℕ,
            begin
              induction l with l hl,
              show (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x^(0 - 1), from
                by {rw [polynomial.bernoulli_zero,polynomial.bernoulli_zero,zero_pow],ring,},
              assume h3 : (polynomial.bernoulli l).eval (1 + x) = (polynomial.bernoulli l).eval x + l * x^(l - 1),
              show (polynomial.bernoulli (l + 1)).eval (1 + x) = (polynomial.bernoulli (l + 1)).eval x + (l + 1) * x^((l + 1) - 1), from
                by {rw [polynomial.bernoulli_succ,polynomial.bernoulli_succ],rw [h3,h3],ring,},
            end,
          have h4 : (polynomial.bernoulli (m + 1)).eval (1 + x) = (polynomial.bernoulli (m + 1)).eval x + (m + 1) * x^((m + 1) - 1), from
            begin
              rw [polynomial.bernoulli_succ,polynomial.bernoulli_succ],
              have h5 : ∀ l : ℕ, (polynomial.bernoulli l).eval (1 + x) = (polynomial.bernoulli l).eval x + l * x^(l - 1), from
                assume l : ℕ,
                begin
                  induction l with l hl,
                  show (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x^(0 - 1), from
                    by {rw [polynomial.bernoulli_zero,polynomial.bernoulli_zero,zero_pow],ring,},
                  assume h5 : (polynomial.bernoulli l).eval (1 + x) = (polynomial.bernoulli l).eval x + l * x^(l - 1),
                  show (polynomial.bernoulli (l + 1)).eval (1 + x) = (polynomial.bernoulli (l + 1)).eval x + (l + 1) * x^((l + 1) - 1), from
                    by {rw [polynomial.bernoulli_succ,polynomial.bernoulli_succ],rw [h5,h5],ring,},
                end,
              have h6 : ∀ l : ℕ, (polynomial.bernoulli l).eval (1 + x) = (polynomial.bernoulli l).eval x + l * x^(l - 1), from
                assume l : ℕ,
                begin
                  induction l with l hl,
                  show (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x^(0 - 1), from
                    by {rw [polynomial.bernoulli_zero,polynomial.bernoulli_zero,zero_pow],ring,},
                  assume h6 : (polynomial.bernoulli l).eval (1 + x) = (polynomial.bernoulli l).eval x + l * x^(l - 1),
                  show (polynomial.bernoulli (l + 1)).eval (1 + x) = (polynomial.bernoulli (l + 1)).eval x + (l + 1) * x^((l + 1) - 1), from
                    by {rw [polynomial.bernoulli_succ,polynomial.bernoulli_succ],rw [h6,h6],ring,},
                end,
              have h7 : ∀ l : ℕ, (polynomial.bernoulli l).eval (1 + x) = (polynomial.bernoulli l).eval x + l * x^(l - 1), from
                assume l : ℕ,
                begin
                  induction l with l hl,
                  show (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x^(0 - 1), from
                    by {rw [polynomial.bernoulli_zero,polynomial.bernoulli_zero,zero_pow],ring,},
                  assume h7 : (polynomial.bernoulli l).eval (1 + x) = (polynomial.bernoulli l).eval x + l * x^(l - 1),
                  show (polynomial.bernoulli (l + 1)).eval (1 + x) = (polynomial.bernoulli (l + 1)).eval x + (l + 1) * x^((l + 1) - 1), from
                    by {rw [polynomial.bernoulli_succ,polynomial.bernoulli_succ],rw [h7,h7],ring,},
                end,
              have h8 : ∀ l : ℕ, (polynomial.bernoulli l).eval (1 + x) = (polynomial.bernoulli l).eval x + l * x^(l - 1), from
                assume l : ℕ,
                begin
                  induction l with l hl,
                  show (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x^(0 - 1), from
                    by {rw [polynomial.bernoulli_zero,polynomial.bernoulli_zero,zero_pow],
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  have h1 : ∀ m : ℕ, (m < n) → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from assume (m : ℕ) (h : m < n),
    begin
      induction m with d hd,
      {
        show (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x^(0 - 1), from by {
          rw [← polynomial.bernoulli_zero, ← polynomial.bernoulli_zero],
          ring,
        },
      },
      {
        have h1 : ∀ m : ℕ, (m < d) → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from assume (m : ℕ) (h : m < d), hd h,
        have h2 : (polynomial.bernoulli d).eval (1 + x) = (polynomial.bernoulli d).eval x + d * x^(d - 1), from by {
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          have h3 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from by {
            rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
            rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
            ring,
          },
          rw [h3],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial.bernoulli_succ, ← polynomial.bernoulli_succ],
          rw [← polynomial
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  induction n with d hd,
  {
    show (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x^(0 - 1), from
    begin
      rw polynomial.bernoulli,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      ring,
    end,
  },
  {
    have h1 : ∀ (m : ℕ) (x : ℚ), m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
      assume (m : ℕ) (x : ℚ) (h : m < d), hd m h,
    have h2 : ∀ (m : ℕ) (x : ℚ), m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
      assume (m : ℕ) (x : ℚ) (h : m < d), hd m h,
    have h3 : ∀ (m : ℕ) (x : ℚ), m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
      assume (m : ℕ) (x : ℚ) (h : m < d), hd m h,

    have h4 : ∀ (m : ℕ) (x : ℚ), m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
      assume (m : ℕ) (x : ℚ) (h : m < d), hd m h,
    have h5 : ∀ (m : ℕ) (x : ℚ), m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
      assume (m : ℕ) (x : ℚ) (h : m < d), hd m h,
    have h6 : ∀ (m : ℕ) (x : ℚ), m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
      assume (m : ℕ) (x : ℚ) (h : m < d), hd m h,
    have h7 : ∀ (m : ℕ) (x : ℚ), m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
      assume (m : ℕ) (x : ℚ) (h : m < d), hd m h,
    have h8 : ∀ (m : ℕ) (x : ℚ), m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
      assume (m : ℕ) (x : ℚ) (h : m < d), hd m h,
    have h9 : ∀ (m : ℕ) (x : ℚ), m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
      assume (m : ℕ) (x : ℚ) (h : m < d), hd m h,
    have h10 : ∀ (m : ℕ) (x : ℚ), m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
      assume (m : ℕ) (x : ℚ) (h : m < d), hd m h,
    have h11 : ∀ (m : ℕ) (x : ℚ), m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
      assume (m : ℕ) (x : ℚ) (h : m < d), hd m h,
    have h12 : ∀ (m : ℕ) (x : ℚ), m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
      assume (m : ℕ) (x : ℚ) (h : m < d), hd m h,
    have h13 : ∀ (m : ℕ) (x : ℚ), m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
      assume (m : ℕ) (x : ℚ) (h : m < d), hd m h,
    have h14 : ∀ (m : ℕ) (x : ℚ), m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
      assume (m : ℕ) (x : ℚ) (h : m < d), hd m h,
    have h15 : ∀ (m : ℕ) (x : ℚ), m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
      assume (m : ℕ) (x : ℚ) (h : m < d), hd m h,
    have h16 : ∀ (m : ℕ) (x : ℚ), m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
      assume (m : ℕ) (x : ℚ) (h : m < d), hd m h,
    have h17 : ∀ (m : ℕ) (x : ℚ), m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
      assume (m : ℕ) (x : ℚ) (h : m < d), hd m h,
    have h18 : ∀ (m : ℕ) (x : ℚ), m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
      assume (m : ℕ) (x : ℚ) (h : m < d), hd m h,
    have h19 : ∀ (m : ℕ) (x : ℚ), m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
      assume (m : ℕ) (x : ℚ) (h : m < d), hd m h,
    have h20 : ∀ (m : ℕ) (x : ℚ), m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from
      assume (m : ℕ) (x : ℚ) (h
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  apply nat.strong_induction_on n,
  assume (d : ℕ) (h : ∀ m < d, (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1)),
  have h1 : (polynomial.bernoulli d).eval (1 + x) = (polynomial.bernoulli d).eval x + d * x^(d - 1),
  begin
    have h2 : (d + 1) * (1 + x)^d = (d + 1) * x^d + (d + 1) * (d - 1) * x^(d - 1),
    begin
      rw [pow_add,pow_one,mul_add,mul_one,← mul_assoc,← mul_assoc,← mul_assoc],
      rw [← pow_two,← pow_one,← pow_add,← pow_one,← pow_add,← pow_one],
      ring,
    end,
    have h3 : (polynomial.bernoulli d).eval (1 + x) = (d + 1) * (1 + x)^d - (d + 1) * x^d,
    begin
      rw [← polynomial.eval_C_mul,← polynomial.eval_C_mul,← polynomial.eval_C_add,polynomial.eval_C_mul,polynomial.eval_C_pow,polynomial.eval_C_mul,polynomial.eval_C_pow,polynomial.eval_C_add],
      ring,
    end,
    have h4 : (polynomial.bernoulli d).eval (1 + x) = (d + 1) * x^d + (d + 1) * (d - 1) * x^(d - 1), from by rw [h3,h2],
    have h5 : (polynomial.bernoulli d).eval (1 + x) = (d + 1) * x^d + (d + 1) * (d - 1) * x^(d - 1) + d * x^(d - 1), from by ring,
    have h6 : (polynomial.bernoulli d).eval (1 + x) = (polynomial.bernoulli d).eval x + d * x^(d - 1), from by rw [h4,h5],
    show (polynomial.bernoulli d).eval (1 + x) = (polynomial.bernoulli d).eval x + d * x^(d - 1), from h6,
  end,
  show (polynomial.bernoulli d).eval (1 + x) = (polynomial.bernoulli d).eval x + d * x^(d - 1), from h1,
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
Bernoulli polynomial evaluation
Given a natural number $n$ and a rational $x$, let $B_n (x)$ denote the $n$-th Bernoulli polynomial evaluated at $x$. Then, $$B_n (1 + x) = B_n (x) + n x^{n - 1}$$
`proof`
We apply strong induction on $n$. So, for all $m < d$, we have $B_{m} (1 + x) = B_{m} (x) + m x^{m - 1}$ and we want to show that $$B_{d} (1 + x) = B_{d} (x) + d x^{d - 1}$$
Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
$$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
The conclusion then follows easily.

QED

-/
theorem  bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.hom.equiv

/-!
# `ulift` instances for groups and monoids

This file defines instances for group, monoid, semigroup and related structures on `ulift` types.

(Recall `ulift α` is just a "copy" of a type `α` in a higher universe.)

We use `tactic.pi_instance_derive_field`, even though it wasn't intended for this purpose,
which seems to work fine.

We also provide `ulift.mul_equiv : ulift R ≃* R` (and its additive analogue).
-/

universes u v
variables {α : Type u} {x y : ulift.{v} α}

namespace ulift

@[to_additive] instance has_one [has_one α] : has_one (ulift α) := ⟨⟨1⟩⟩
@[simp, to_additive] lemma one_down [has_one α] : (1 : ulift α).down = 1 := rfl

@[to_additive] instance has_mul [has_mul α] : has_mul (ulift α) := ⟨λ f g, ⟨f.down * g.down⟩⟩
@[simp, to_additive] lemma mul_down [has_mul α] : (x * y).down = x.down * y.down := rfl

@[to_additive] instance has_div [has_div α] : has_div (ulift α) := ⟨λ f g, ⟨f.down / g.down⟩⟩
@[simp, to_additive] lemma div_down [has_div α] : (x / y).down = x.down / y.down := rfl

@[to_additive] instance has_inv [has_inv α] : has_inv (ulift α) := ⟨λ f, ⟨f.down⁻¹⟩⟩
@[simp, to_additive] lemma inv_down [has_inv α] : x⁻¹.down = (x.down)⁻¹ := rfl

/--
The multiplicative equivalence between `ulift α` and `α`.
-/
@[to_additive "The additive equivalence between `ulift α` and `α`."]
def _root_.mul_equiv.ulift [has_mul α] : ulift α ≃* α :=
{ map_mul' := λ x y, rfl,
  .. equiv.ulift }

@[to_additive]
instance semigroup [semigroup α] : semigroup (ulift α) :=
mul_equiv.ulift.injective.semigroup _ $ λ x y, rfl

@[to_additive]
instance comm_semigroup [comm_semigroup α] : comm_semigroup (ulift α) :=
equiv.ulift.injective.comm_semigroup _ $ λ x y, rfl

@[to_additive]
instance mul_one_class [mul_one_class α] : mul_one_class (ulift α) :=
equiv.ulift.injective.mul_one_class _ rfl $ λ x y, rfl

instance mul_zero_one_class [mul_zero_one_class α] : mul_zero_one_class (ulift α) :=
equiv.ulift.injective.mul_zero_one_class _ rfl rfl $ λ x y, rfl

@[to_additive has_vadd]
instance has_scalar {β : Type*} [has_scalar α β] : has_scalar α (ulift β) :=
⟨λ n x, up (n • x.down)⟩

@[to_additive has_scalar, to_additive_reorder 1]
instance has_pow {β : Type*} [has_pow α β] : has_pow (ulift α) β :=
⟨λ x n, up (x.down ^ n)⟩

@[to_additive]
instance monoid [monoid α] : monoid (ulift α) :=
equiv.ulift.injective.monoid _ rfl (λ _ _, rfl) (λ _ _, rfl)

@[to_additive]
instance comm_monoid [comm_monoid α] : comm_monoid (ulift α) :=
equiv.ulift.injective.comm_monoid _ rfl (λ _ _, rfl) (λ _ _, rfl)

instance monoid_with_zero [monoid_with_zero α] : monoid_with_zero (ulift α) :=
equiv.ulift.injective.monoid_with_zero _ rfl rfl (λ _ _, rfl) (λ _ _, rfl)

instance comm_monoid_with_zero [comm_monoid_with_zero α] : comm_monoid_with_zero (ulift α) :=
equiv.ulift.injective.comm_monoid_with_zero _ rfl rfl (λ _ _, rfl) (λ _ _, rfl)

@[to_additive]
instance div_inv_monoid [div_inv_monoid α] : div_inv_monoid (ulift α) :=
equiv.ulift.injective.div_inv_monoid _ rfl (λ _ _, rfl) (λ _, rfl)
  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

@[to_additive]
instance group [group α] : group (ulift α) :=
equiv.ulift.injective.group _ rfl (λ _ _, rfl) (λ _, rfl)
  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

@[to_additive]
instance comm_group [comm_group α] : comm_group (ulift α) :=
equiv.ulift.injective.comm_group _ rfl (λ _ _, rfl) (λ _, rfl)
  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

instance group_with_zero [group_with_zero α] : group_with_zero (ulift α) :=
equiv.ulift.injective.group_with_zero _ rfl rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
  (λ _ _, rfl)

instance comm_group_with_zero [comm_group_with_zero α] : comm_group_with_zero (ulift α) :=
equiv.ulift.injective.comm_group_with_zero _ rfl rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl)
  (λ _ _, rfl) (λ _ _, rfl)

@[to_additive add_left_cancel_semigroup]
instance left_cancel_semigroup [left_cancel_semigroup α] :
  left_cancel_semigroup (ulift α) :=
equiv.ulift.injective.left_cancel_semigroup _ (λ _ _, rfl)

@[to_additive add_right_cancel_semigroup]
instance right_cancel_semigroup [right_cancel_semigroup α] :
  right_cancel_semigroup (ulift α) :=
equiv.ulift.injective.right_cancel_semigroup _ (λ _ _, rfl)

@[to_additive add_left_cancel_monoid]
instance left_cancel_monoid [left_cancel_monoid α] :
  left_cancel_monoid (ulift α) :=
equiv.ulift.injective.left_cancel_monoid _ rfl (λ _ _, rfl) (λ _ _, rfl)

@[to_additive add_right_cancel_monoid]
instance right_cancel_monoid [right_cancel_monoid α] :
  right_cancel_monoid (ulift α) :=
equiv.ulift.injective.right_cancel_monoid _ rfl (λ _ _, rfl) (λ _ _, rfl)

@[to_additive add_cancel_monoid]
instance cancel_monoid [cancel_monoid α] :
  cancel_monoid (ulift α) :=
equiv.ulift.injective.cancel_monoid _ rfl (λ _ _, rfl) (λ _ _, rfl)

@[to_additive add_cancel_monoid]
instance cancel_comm_monoid [cancel_comm_monoid α] :
  cancel_comm_monoid (ulift α) :=
equiv.ulift.injective.cancel_comm_monoid _ rfl (λ _ _, rfl) (λ _ _, rfl)

instance nontrivial [nontrivial α] : nontrivial (ulift α) :=
equiv.ulift.symm.injective.nontrivial

-- TODO we don't do `ordered_cancel_comm_monoid` or `ordered_comm_group`
-- We'd need to add instances for `ulift` in `order.basic`.

end ulift