/-
Copyright (c) 2021 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux
-/
import tactic.noncomm_ring
import field_theory.is_alg_closed.basic
import algebra.star.pointwise
/-!
# Spectrum of an element in an algebra
This file develops the basic theory of the spectrum of an element of an algebra.
This theory will serve as the foundation for spectral theory in Banach algebras.

## Main definitions

* `resolvent_set a : set R`: the resolvent set of an element `a : A` where
  `A` is an  `R`-algebra.
* `spectrum a : set R`: the spectrum of an element `a : A` where
  `A` is an  `R`-algebra.
* `resolvent : R → A`: the resolvent function is `λ r, ring.inverse (↑ₐr - a)`, and hence
  when `r ∈ resolvent R A`, it is actually the inverse of the unit `(↑ₐr - a)`.

## Main statements

* `spectrum.unit_smul_eq_smul` and `spectrum.smul_eq_smul`: units in the scalar ring commute
  (multiplication) with the spectrum, and over a field even `0` commutes with the spectrum.
* `spectrum.left_add_coset_eq`: elements of the scalar ring commute (addition) with the spectrum.
* `spectrum.unit_mem_mul_iff_mem_swap_mul` and `spectrum.preimage_units_mul_eq_swap_mul`: the
  units (of `R`) in `σ (a*b)` coincide with those in `σ (b*a)`.
* `spectrum.scalar_eq`: in a nontrivial algebra over a field, the spectrum of a scalar is
  a singleton.
* `spectrum.subset_polynomial_aeval`, `spectrum.map_polynomial_aeval_of_degree_pos`,
  `spectrum.map_polynomial_aeval_of_nonempty`: variations on the spectral mapping theorem.

## Notations

* `σ a` : `spectrum R a` of `a : A`
-/

universes u v

section defs

variables (R : Type u) {A : Type v}
variables [comm_semiring R] [ring A] [algebra R A]

local notation `↑ₐ` := algebra_map R A

-- definition and basic properties

/-- Given a commutative ring `R` and an `R`-algebra `A`, the *resolvent set* of `a : A`
is the `set R` consisting of those `r : R` for which `r•1 - a` is a unit of the
algebra `A`.  -/
def resolvent_set (a : A) : set R :=
{ r : R | is_unit (↑ₐr - a) }

/-- Given a commutative ring `R` and an `R`-algebra `A`, the *spectrum* of `a : A`
is the `set R` consisting of those `r : R` for which `r•1 - a` is not a unit of the
algebra `A`.

The spectrum is simply the complement of the resolvent set.  -/
def spectrum (a : A) : set R :=
(resolvent_set R a)ᶜ

variable {R}
/-- Given an `a : A` where `A` is an `R`-algebra, the *resolvent* is
    a map `R → A` which sends `r : R` to `(algebra_map R A r - a)⁻¹` when
    `r ∈ resolvent R A` and `0` when `r ∈ spectrum R A`. -/
noncomputable def resolvent (a : A) (r : R) : A :=
ring.inverse (↑ₐr - a)

/-- The unit `1 - r⁻¹ • a` constructed from `r • 1 - a` when the latter is a unit. -/
@[simps]
noncomputable def is_unit.sub_inv_smul {r : Rˣ} {s : R} {a : A}
  (h : is_unit $ r • ↑ₐs  - a) : Aˣ :=
{ val := ↑ₐs - r⁻¹ • a,
  inv := r • ↑h.unit⁻¹,
  val_inv := by rw [mul_smul_comm, ←smul_mul_assoc, smul_sub, smul_inv_smul, h.mul_coe_inv],
  inv_val := by rw [smul_mul_assoc, ←mul_smul_comm, smul_sub, smul_inv_smul, h.coe_inv_mul], }

-- products of scalar units and algebra units
lemma is_unit.smul_sub_iff_sub_inv_smul {r : Rˣ} {a : A} :
  is_unit (r • 1 - a) ↔ is_unit (1 - r⁻¹ • a) :=
by rw [←@is_unit_smul_iff _ _ _ _ _ _ _ r (1 - r⁻¹ • a), smul_sub, smul_inv_smul]

end defs

namespace spectrum
open_locale polynomial

section scalar_ring

variables {R : Type u} {A : Type v}
variables [comm_ring R] [ring A] [algebra R A]

local notation `σ` := spectrum R
local notation `↑ₐ` := algebra_map R A

lemma mem_iff {r : R} {a : A} :
  r ∈ σ a ↔ ¬ is_unit (↑ₐr - a) :=
iff.rfl

lemma not_mem_iff {r : R} {a : A} :
  r ∉ σ a ↔ is_unit (↑ₐr - a) :=
by { apply not_iff_not.mp, simp [set.not_not_mem, mem_iff] }

lemma mem_resolvent_set_of_left_right_inverse {r : R} {a b c : A}
  (h₁ : (↑ₐr - a) * b = 1) (h₂ : c * (↑ₐr - a) = 1) :
  r ∈ resolvent_set R a :=
units.is_unit ⟨↑ₐr - a, b, h₁, by rwa ←left_inv_eq_right_inv h₂ h₁⟩

lemma mem_resolvent_set_iff {r : R} {a : A} :
  r ∈ resolvent_set R a ↔ is_unit (↑ₐr - a) :=
iff.rfl

lemma resolvent_eq {a : A} {r : R} (h : r ∈ resolvent_set R a) :
  resolvent a r = ↑h.unit⁻¹ :=
ring.inverse_unit h.unit

lemma units_smul_resolvent {r : Rˣ} {s : R} {a : A} :
  r • resolvent a (s : R) = resolvent (r⁻¹ • a) (r⁻¹ • s : R) :=
begin
  by_cases h : s ∈ spectrum R a,
  { rw [mem_iff] at h,
    simp only [resolvent, algebra.algebra_map_eq_smul_one] at *,
    rw [smul_assoc, ←smul_sub],
    have h' : ¬ is_unit (r⁻¹ • (s • 1 - a)),
      from λ hu, h (by simpa only [smul_inv_smul] using is_unit.smul r hu),
    simp only [ring.inverse_non_unit _ h, ring.inverse_non_unit _ h', smul_zero] },
  { simp only [resolvent],
    have h' : is_unit (r • (algebra_map R A (r⁻¹ • s)) - a),
      { simpa [algebra.algebra_map_eq_smul_one, smul_assoc] using not_mem_iff.mp h },
    rw [←h'.coe_sub_inv_smul, ←(not_mem_iff.mp h).unit_spec, ring.inverse_unit, ring.inverse_unit,
      h'.coe_inv_sub_inv_smul],
    simp only [algebra.algebra_map_eq_smul_one, smul_assoc, smul_inv_smul], },
end

lemma units_smul_resolvent_self {r : Rˣ} {a : A} :
  r • resolvent a (r : R) = resolvent (r⁻¹ • a) (1 : R) :=
by simpa only [units.smul_def, algebra.id.smul_eq_mul, units.inv_mul]
  using @units_smul_resolvent _ _ _ _ _ r r a

/-- The resolvent is a unit when the argument is in the resolvent set. -/
lemma is_unit_resolvent {r : R} {a : A} :
  r ∈ resolvent_set R a ↔ is_unit (resolvent a r) :=
is_unit_ring_inverse.symm

lemma inv_mem_resolvent_set {r : Rˣ} {a : Aˣ} (h : (r : R) ∈ resolvent_set R (a : A)) :
  (↑r⁻¹ : R) ∈ resolvent_set R (↑a⁻¹ : A) :=
begin
  rw [mem_resolvent_set_iff, algebra.algebra_map_eq_smul_one, ←units.smul_def] at h ⊢,
  rw [is_unit.smul_sub_iff_sub_inv_smul, inv_inv, is_unit.sub_iff],
  have h₁ : (a : A) * (r • (↑a⁻¹ : A) - 1) = r • 1 - a,
  { rw [mul_sub, mul_smul_comm, a.mul_inv, mul_one], },
  have h₂ : (r • (↑a⁻¹ : A) - 1) * a = r • 1 - a,
  { rw [sub_mul, smul_mul_assoc, a.inv_mul, one_mul], },
  have hcomm : commute (a : A) (r • (↑a⁻¹ : A) - 1), { rwa ←h₂ at h₁ },
  exact (hcomm.is_unit_mul_iff.mp (h₁.symm ▸ h)).2,
end

lemma inv_mem_iff {r : Rˣ} {a : Aˣ} :
  (r : R) ∈ σ (a : A) ↔ (↑r⁻¹ : R) ∈ σ (↑a⁻¹ : A) :=
begin
  simp only [mem_iff, not_iff_not, ←mem_resolvent_set_iff],
  exact ⟨λ h, inv_mem_resolvent_set h, λ h, by simpa using inv_mem_resolvent_set h⟩,
end

lemma zero_mem_resolvent_set_of_unit (a : Aˣ) : 0 ∈ resolvent_set R (a : A) :=
by { rw [mem_resolvent_set_iff, is_unit.sub_iff], simp }

lemma ne_zero_of_mem_of_unit {a : Aˣ} {r : R} (hr : r ∈ σ (a : A)) : r ≠ 0 :=
λ hn, (hn ▸ hr) (zero_mem_resolvent_set_of_unit a)

lemma add_mem_iff {a : A} {r s : R} :
  r ∈ σ a ↔ r + s ∈ σ (↑ₐs + a) :=
begin
  apply not_iff_not.mpr,
  simp only [mem_resolvent_set_iff],
  have h_eq : ↑ₐ(r + s) - (↑ₐs + a) = ↑ₐr - a,
    { simp, noncomm_ring },
  rw h_eq,
end

lemma smul_mem_smul_iff {a : A} {s : R} {r : Rˣ} :
  r • s ∈ σ (r • a) ↔ s ∈ σ a :=
begin
  apply not_iff_not.mpr,
  simp only [mem_resolvent_set_iff, algebra.algebra_map_eq_smul_one],
  have h_eq : (r • s) • (1 : A) = r • s • 1, by simp,
  rw [h_eq, ←smul_sub, is_unit_smul_iff],
end

open_locale pointwise polynomial

theorem unit_smul_eq_smul (a : A) (r : Rˣ) :
  σ (r • a) = r • σ a :=
begin
  ext,
  have x_eq : x = r • r⁻¹ • x, by simp,
  nth_rewrite 0 x_eq,
  rw smul_mem_smul_iff,
  split,
    { exact λ h, ⟨r⁻¹ • x, ⟨h, by simp⟩⟩},
    { rintros ⟨_, _, x'_eq⟩, simpa [←x'_eq],}
end

theorem left_add_coset_eq (a : A) (r : R) :
  left_add_coset r (σ a) = σ (↑ₐr + a) :=
by { ext, rw [mem_left_add_coset_iff, neg_add_eq_sub, add_mem_iff],
     nth_rewrite 1 ←sub_add_cancel x r, }

-- `r ∈ σ(a*b) ↔ r ∈ σ(b*a)` for any `r : Rˣ`
theorem unit_mem_mul_iff_mem_swap_mul {a b : A} {r : Rˣ} :
  ↑r ∈ σ (a * b) ↔ ↑r ∈ σ (b * a) :=
begin
  apply not_iff_not.mpr,
  simp only [mem_resolvent_set_iff, algebra.algebra_map_eq_smul_one],
  have coe_smul_eq : ↑r • 1 = r • (1 : A), from rfl,
  rw coe_smul_eq,
  simp only [is_unit.smul_sub_iff_sub_inv_smul],
  have right_inv_of_swap : ∀ {x y z : A} (h : (1 - x * y) * z = 1),
    (1 - y * x) * (1 + y * z * x) = 1, from λ x y z h,
      calc (1 - y * x) * (1 + y * z * x) = 1 - y * x + y * ((1 - x * y) * z) * x : by noncomm_ring
      ...                                = 1                                     : by simp [h],
  have left_inv_of_swap : ∀ {x y z : A} (h : z * (1 - x * y) = 1),
    (1 + y * z * x) * (1 - y * x) = 1, from λ x y z h,
      calc (1 + y * z * x) * (1 - y * x) = 1 - y * x + y * (z * (1 - x * y)) * x : by noncomm_ring
      ...                                = 1                                     : by simp [h],
  have is_unit_one_sub_mul_of_swap : ∀ {x y : A} (h : is_unit (1 - x * y)),
    is_unit (1 - y * x), from λ x y h, by
      { let h₁ := right_inv_of_swap h.unit.val_inv,
        let h₂ := left_inv_of_swap h.unit.inv_val,
        exact ⟨⟨1 - y * x, 1 + y * h.unit.inv * x, h₁, h₂⟩, rfl⟩, },
  have is_unit_one_sub_mul_iff_swap : ∀ {x y : A},
    is_unit (1 - x * y) ↔ is_unit (1 - y * x), by
      { intros, split, repeat {apply is_unit_one_sub_mul_of_swap}, },
  rw [←smul_mul_assoc, ←mul_smul_comm r⁻¹ b a, is_unit_one_sub_mul_iff_swap],
end

theorem preimage_units_mul_eq_swap_mul {a b : A} :
  (coe : Rˣ → R) ⁻¹' σ (a * b) = coe ⁻¹'  σ (b * a) :=
by { ext, exact unit_mem_mul_iff_mem_swap_mul, }

section star

variables [star_add_monoid R] [star_ring A] [star_module R A]

lemma star_mem_resolvent_set_iff {r : R} {a : A} :
  star r ∈ resolvent_set R a ↔ r ∈ resolvent_set R (star a) :=
by refine ⟨λ h, _, λ h, _⟩;
   simpa only [mem_resolvent_set_iff, algebra.algebra_map_eq_smul_one, star_sub, star_smul,
     star_star, star_one] using is_unit.star h

protected lemma map_star (a : A) : σ (star a) = star (σ a) :=
by { ext, simpa only [set.mem_star, mem_iff, not_iff_not] using star_mem_resolvent_set_iff.symm }

end star

end scalar_ring

section scalar_field

variables {𝕜 : Type u} {A : Type v}
variables [field 𝕜] [ring A] [algebra 𝕜 A]

local notation `σ` := spectrum 𝕜
local notation `↑ₐ` := algebra_map 𝕜 A

/-- Without the assumption `nontrivial A`, then `0 : A` would be invertible. -/
@[simp] lemma zero_eq [nontrivial A] : σ (0 : A) = {0} :=
begin
  refine set.subset.antisymm _ (by simp [algebra.algebra_map_eq_smul_one, mem_iff]),
  rw [spectrum, set.compl_subset_comm],
  intros k hk,
  rw set.mem_compl_singleton_iff at hk,
  have : is_unit (units.mk0 k hk • (1 : A)) := is_unit.smul (units.mk0 k hk) is_unit_one,
  simpa [mem_resolvent_set_iff, algebra.algebra_map_eq_smul_one]
end

@[simp] theorem scalar_eq [nontrivial A] (k : 𝕜) : σ (↑ₐk) = {k} :=
begin
  have coset_eq : left_add_coset k {0} = {k}, by
    { ext, split,
      { intro hx, simp [left_add_coset] at hx, exact hx, },
      { intro hx, simp at hx, exact ⟨0, ⟨set.mem_singleton 0, by simp [hx]⟩⟩, }, },
  calc σ (↑ₐk) = σ (↑ₐk + 0)                  : by simp
    ...        = left_add_coset k (σ (0 : A)) : by rw ←left_add_coset_eq
    ...        = left_add_coset k {0}         : by rw zero_eq
    ...        = {k}                          : coset_eq,
end

@[simp] lemma one_eq [nontrivial A] : σ (1 : A) = {1} :=
calc σ (1 : A) = σ (↑ₐ1) : by simp [algebra.algebra_map_eq_smul_one]
  ...          = {1}     : scalar_eq 1

open_locale pointwise

/-- the assumption `(σ a).nonempty` is necessary and cannot be removed without
    further conditions on the algebra `A` and scalar field `𝕜`. -/
theorem smul_eq_smul [nontrivial A] (k : 𝕜) (a : A) (ha : (σ a).nonempty) :
  σ (k • a) = k • (σ a) :=
begin
  rcases eq_or_ne k 0 with rfl | h,
  { simpa [ha, zero_smul_set] },
  { exact unit_smul_eq_smul a (units.mk0 k h) },
end

theorem nonzero_mul_eq_swap_mul (a b : A) : σ (a * b) \ {0} = σ (b * a) \ {0} :=
begin
  suffices h : ∀ (x y : A), σ (x * y) \ {0} ⊆ σ (y * x) \ {0},
  { exact set.eq_of_subset_of_subset (h a b) (h b a) },
  { rintros _ _ k ⟨k_mem, k_neq⟩,
    change k with ↑(units.mk0 k k_neq) at k_mem,
    exact ⟨unit_mem_mul_iff_mem_swap_mul.mp k_mem, k_neq⟩ },
end

protected lemma map_inv (a : Aˣ) : (σ (a : A))⁻¹ = σ (↑a⁻¹ : A) :=
begin
  refine set.eq_of_subset_of_subset (λ k hk, _) (λ k hk, _),
  { rw set.mem_inv at hk,
    have : k ≠ 0,
    { simpa only [inv_inv] using inv_ne_zero (ne_zero_of_mem_of_unit hk), },
    lift k to 𝕜ˣ using is_unit_iff_ne_zero.mpr this,
    rw ←units.coe_inv' k at hk,
    exact inv_mem_iff.mp hk },
  { lift k to 𝕜ˣ using is_unit_iff_ne_zero.mpr (ne_zero_of_mem_of_unit hk),
    simpa only [units.coe_inv'] using inv_mem_iff.mp hk, }
end

open polynomial
/-- Half of the spectral mapping theorem for polynomials. We prove it separately
because it holds over any field, whereas `spectrum.map_polynomial_aeval_of_degree_pos` and
`spectrum.map_polynomial_aeval_of_nonempty` need the field to be algebraically closed. -/

lemma exists_mem_of_not_is_unit_aeval_prod {p : 𝕜[X]} {a : A} (hp : p ≠ 0)
  (h : ¬is_unit (aeval a (multiset.map (λ (x : 𝕜), X - C x) p.roots).prod)) :
  ∃ k : 𝕜, k ∈ σ a ∧ eval k p = 0 :=
begin
  rw [←multiset.prod_to_list, alg_hom.map_list_prod] at h,
  replace h := mt list.prod_is_unit h,
  simp only [not_forall, exists_prop, aeval_C, multiset.mem_to_list,
    list.mem_map, aeval_X, exists_exists_and_eq_and, multiset.mem_map, alg_hom.map_sub] at h,
  rcases h with ⟨r, r_mem, r_nu⟩,
  exact ⟨r, by rwa [mem_iff, ←is_unit.sub_iff], by rwa [←is_root.def, ←mem_roots hp]⟩
end

/-- The *spectral mapping theorem* for polynomials.  Note: the assumption `degree p > 0`
is necessary in case `σ a = ∅`, for then the left-hand side is `∅` and the right-hand side,
assuming `[nontrivial A]`, is `{k}` where `p = polynomial.C k`. -/
theorem map_polynomial_aeval_of_degree_pos [is_alg_closed 𝕜] (a : A) (p : 𝕜[X])
  (hdeg : 0 < degree p) : σ (aeval a p) = (λ k, eval k p) '' (σ a) :=
begin
  /- handle the easy direction via `spectrum.subset_polynomial_aeval` -/
  refine set.eq_of_subset_of_subset (λ k hk, _) (subset_polynomial_aeval a p),
  /- write `C k - p` product of linear factors and a constant; show `C k - p ≠ 0`. -/
  have hprod := eq_prod_roots_of_splits_id (is_alg_closed.splits (C k - p)),
  have h_ne : C k - p ≠ 0, from ne_zero_of_degree_gt
    (by rwa [degree_sub_eq_right_of_degree_lt (lt_of_le_of_lt degree_C_le hdeg)]),
  have lead_ne := leading_coeff_ne_zero.mpr h_ne,
  have lead_unit := (units.map (↑ₐ).to_monoid_hom (units.mk0 _ lead_ne)).is_unit,
  /- leading coefficient is a unit so product of linear factors is not a unit;
  apply `exists_mem_of_not_is_unit_aeval_prod`. -/
  have p_a_eq : aeval a (C k - p) = ↑ₐk - aeval a p,
    by simp only [aeval_C, alg_hom.map_sub, sub_left_inj],
  rw [mem_iff, ←p_a_eq, hprod, aeval_mul,
    ((commute.all _ _).map (aeval a)).is_unit_mul_iff, aeval_C] at hk,
  replace hk := exists_mem_of_not_is_unit_aeval_prod h_ne (not_and.mp hk lead_unit),
  rcases hk with ⟨r, r_mem, r_ev⟩,
  exact ⟨r, r_mem, symm (by simpa [eval_sub, eval_C, sub_eq_zero] using r_ev)⟩,
end

/-- In this version of the spectral mapping theorem, we assume the spectrum
is nonempty instead of assuming the degree of the polynomial is positive. Note: the
assumption `[nontrivial A]` is necessary for the same reason as in `spectrum.zero_eq`. -/
theorem map_polynomial_aeval_of_nonempty [is_alg_closed 𝕜] [nontrivial A] (a : A) (p : 𝕜[X])
  (hnon : (σ a).nonempty) : σ (aeval a p) = (λ k, eval k p) '' (σ a) :=
begin
  refine or.elim (le_or_gt (degree p) 0) (λ h, _) (map_polynomial_aeval_of_degree_pos a p),
  { rw eq_C_of_degree_le_zero h,
    simp only [set.image_congr, eval_C, aeval_C, scalar_eq, set.nonempty.image_const hnon] },
end

variable (𝕜)
/--
Every element `a` in a nontrivial finite-dimensional algebra `A`
over an algebraically closed field `𝕜` has non-empty spectrum. -/
-- We will use this both to show eigenvalues exist, and to prove Schur's lemma.
lemma nonempty_of_is_alg_closed_of_finite_dimensional [is_alg_closed 𝕜]
  [nontrivial A] [I : finite_dimensional 𝕜 A] (a : A) :
  ∃ k : 𝕜, k ∈ σ a :=
begin
  obtain ⟨p, ⟨h_mon, h_eval_p⟩⟩ := is_integral_of_noetherian (is_noetherian.iff_fg.2 I) a,
  have nu : ¬ is_unit (aeval a p), { rw [←aeval_def] at h_eval_p, rw h_eval_p, simp, },
  rw [eq_prod_roots_of_monic_of_splits_id h_mon (is_alg_closed.splits p)] at nu,
  obtain ⟨k, hk, _⟩ := exists_mem_of_not_is_unit_aeval_prod (monic.ne_zero h_mon) nu,
  exact ⟨k, hk⟩
end

end scalar_field

end spectrum

namespace alg_hom

variables {R : Type*} {A B : Type*} [comm_ring R] [ring A] [algebra R A] [ring B] [algebra R B]
local notation `σ` := spectrum R
local notation `↑ₐ` := algebra_map R A

lemma apply_mem_spectrum [nontrivial R] (φ : A →ₐ[R] R) (a : A) : φ a ∈ σ a :=
begin
  have h : ↑ₐ(φ a) - a ∈ φ.to_ring_hom.ker,
  { simp only [ring_hom.mem_ker, coe_to_ring_hom, commutes, algebra.id.map_eq_id,
               to_ring_hom_eq_coe, ring_hom.id_apply, sub_self, map_sub] },
  simp only [spectrum.mem_iff, ←mem_nonunits_iff,
             coe_subset_nonunits (φ.to_ring_hom.ker_ne_top) h],
end

lemma mem_resolvent_set_apply (φ : A →ₐ[R] B) {a : A} {r : R} (h : r ∈ resolvent_set R a) :
  r ∈ resolvent_set R (φ a) :=
by simpa only [map_sub, commutes] using h.map φ

lemma spectrum_apply_subset (φ : A →ₐ[R] B) (a : A) : σ (φ a) ⊆ σ a :=
λ _, mt (mem_resolvent_set_apply φ)

end alg_hom


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson

! This file was ported from Lean 3 source module algebra.big_operators.nat_antidiagonal
! leanprover-community/mathlib commit 008205aa645b3f194c1da47025c5f110c8406eab
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finset.NatAntidiagonal
import Mathlib.Algebra.BigOperators.Basic

/-!
# Big operators for `NatAntidiagonal`

This file contains theorems relevant to big operators over `Finset.NatAntidiagonal`.
-/

open BigOperators

variable {M N : Type _} [CommMonoid M] [AddCommMonoid N]

namespace Finset

namespace Nat

theorem prod_antidiagonal_succ {n : ℕ} {f : ℕ × ℕ → M} :
    (∏ p in antidiagonal (n + 1), f p) = f (0, n + 1) * ∏ p in antidiagonal n, f (p.1 + 1, p.2) :=
  by rw [antidiagonal_succ, prod_cons, prod_map]; rfl
#align finset.nat.prod_antidiagonal_succ Finset.Nat.prod_antidiagonal_succ

theorem sum_antidiagonal_succ {n : ℕ} {f : ℕ × ℕ → N} :
    (∑ p in antidiagonal (n + 1), f p) = f (0, n + 1) + ∑ p in antidiagonal n, f (p.1 + 1, p.2) :=
  @prod_antidiagonal_succ (Multiplicative N) _ _ _
#align finset.nat.sum_antidiagonal_succ Finset.Nat.sum_antidiagonal_succ

@[to_additive]
theorem prod_antidiagonal_swap {n : ℕ} {f : ℕ × ℕ → M} :
    (∏ p in antidiagonal n, f p.swap) = ∏ p in antidiagonal n, f p := by
  conv_lhs => rw [← map_swap_antidiagonal, Finset.prod_map]
#align finset.nat.prod_antidiagonal_swap Finset.Nat.prod_antidiagonal_swap
#align finset.nat.sum_antidiagonal_swap Finset.Nat.sum_antidiagonal_swap

theorem prod_antidiagonal_succ' {n : ℕ} {f : ℕ × ℕ → M} :
    (∏ p in antidiagonal (n + 1), f p) = f (n + 1, 0) * ∏ p in antidiagonal n, f (p.1, p.2 + 1) :=
  by
  rw [← prod_antidiagonal_swap, prod_antidiagonal_succ, ← prod_antidiagonal_swap]
  rfl
#align finset.nat.prod_antidiagonal_succ' Finset.Nat.prod_antidiagonal_succ'

@[to_additive]
theorem prod_antidiagonal_subst {n : ℕ} {f : ℕ × ℕ → ℕ → M} :
    (∏ p in antidiagonal n, f p n) = ∏ p in antidiagonal n, f p (p.1 + p.2) :=
  prod_congr rfl fun p hp ↦ by rw [Nat.mem_antidiagonal.1 hp]
#align finset.nat.prod_antidiagonal_subst Finset.Nat.prod_antidiagonal_subst
#align finset.nat.sum_antidiagonal_subst Finset.Nat.sum_antidiagonal_subst

@[to_additive]
theorem prod_antidiagonal_eq_prod_range_succ_mk {M : Type _} [CommMonoid M] (f : ℕ × ℕ → M)
    (n : ℕ) : (∏ ij in Finset.Nat.antidiagonal n, f ij) = ∏ k in range n.succ, f (k, n - k) :=
  Finset.prod_map (range n.succ) ⟨fun i ↦ (i, n - i), fun _ _ h ↦ (Prod.mk.inj h).1⟩ f
#align finset.nat.prod_antidiagonal_eq_prod_range_succ_mk Finset.Nat.prod_antidiagonal_eq_prod_range_succ_mk
#align finset.nat.sum_antidiagonal_eq_sum_range_succ_mk Finset.Nat.sum_antidiagonal_eq_sum_range_succ_mk

/-- This lemma matches more generally than `Finset.Nat.prod_antidiagonal_eq_prod_range_succ_mk` when
using `rw ←`. -/
@[to_additive "This lemma matches more generally than
`Finset.Nat.sum_antidiagonal_eq_sum_range_succ_mk` when using `rw ←`."]
theorem prod_antidiagonal_eq_prod_range_succ {M : Type _} [CommMonoid M] (f : ℕ → ℕ → M) (n : ℕ) :
    (∏ ij in Finset.Nat.antidiagonal n, f ij.1 ij.2) = ∏ k in range n.succ, f k (n - k) :=
  prod_antidiagonal_eq_prod_range_succ_mk _ _
#align finset.nat.prod_antidiagonal_eq_prod_range_succ Finset.Nat.prod_antidiagonal_eq_prod_range_succ
#align finset.nat.sum_antidiagonal_eq_sum_range_succ Finset.Nat.sum_antidiagonal_eq_sum_range_succ
end Nat

end Finset


/- Tactic : rw

## Summary

If `h` is a proof of `X = Y`, then `rw h,` will change
all `X`s in the goal to `Y`s.

Variants: `rw ← h` changes
`Y` to `X` and
`rw h at h2` changes `X` to `Y` in hypothesis `h2` instead
of the goal.

## Details

The `rw` tactic is a way to do "substituting in". There
are two distinct situations where use this tactics.

1) If `h : A = B` is a hypothesis (i.e., a proof of `A = B`)
in your local context (the box in the top right)
and if your goal contains one or more `A`s, then `rw h`
will change them all to `B`'s.

2) The `rw` tactic will also work with proofs of theorems
which are equalities (look for them in the drop down
menu on the left, within Theorem Statements).

Important note: if `h` is not a proof of the form `A = B`
or `A ↔ B` (for example if `h` is a function, an implication,
or perhaps even a proposition itself rather than its proof),
then `rw` is not the tactic you want to use. For example,
`rw (P = Q)` is never correct: `P = Q` is the true-false
statement itself, not the proof.
If `h : P = Q` is its proof, then `rw h` will work.

Pro tip 1: If `h : A = B` and you want to change
`B`s to `A`s instead, try `rw ←h` (get the arrow with `\l`,
note that this is a small letter L, not a number 1).

### Example:
If it looks like this in the top right hand box:
```
A B C : set X
h : A = B ∪ C
⊢ A ∪ B = B ∪ C
```

then

`rw h,`

will change the goal into `⊢ B ∪ C ∪ B = B ∪ C`.

### Example:
You can use `rw` to change a hypothesis as well.
For example, if your local context looks like this:
```
A B C D : set X
h1 : A = B ∩ C
h2 : B ∪ A = D
⊢ D = B
```
then `rw h1 at h2` will turn `h2` into `h2 : B ∪ B ∩ C = D` (remember operator precedence).
-/

/-
The next tactic we will learn is *rw* (from rewrite). It rewrites equalities. That is,
if we have a proof `h : x = 3` and we want to prove `⊢ x + 1 = 4`, then after `rw h` the goal
will become `⊢ 3 + 1 = 4`, which seems reasonable.

-/

/- Hint : Click here for a hint, in case you get stuck.
Delete `sorry` and type `rw h,` (don't forget the comma!). Lean tries `refl` afterwards,
so you will see that this suffices.
-/

variables {X : Type} -- hide

/- Lemma : no-side-bar
If A, B and C are sets and A = B, then A ∪ C = B ∪ C.
-/
lemma union_eq (A B C: set X) (h : A = B) : A ∪ C = B ∪ C :=
begin
  rw h,

end


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import measure_theory.integral.interval_integral
import measure_theory.integral.average

/-!
# Integral average over an interval

In this file we introduce notation `⨍ x in a..b, f x` for the average `⨍ x in Ι a b, f x` of `f`
over the interval `Ι a b = set.Ioc (min a b) (max a b)` w.r.t. the Lebesgue measure, then prove
formulas for this average:

* `interval_average_eq`: `⨍ x in a..b, f x = (b - a)⁻¹ • ∫ x in a..b, f x`;
* `interval_average_eq_div`: `⨍ x in a..b, f x = (∫ x in a..b, f x) / (b - a)`.

We also prove that `⨍ x in a..b, f x = ⨍ x in b..a, f x`, see `interval_average_symm`.

## Notation

`⨍ x in a..b, f x`: average of `f` over the interval `Ι a b` w.r.t. the Lebesgue measure.

-/

open measure_theory set topological_space
open_locale interval

variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]

notation `⨍` binders ` in ` a `..` b `, `
  r:(scoped:60 f, average (measure.restrict volume (Ι a b)) f) := r

lemma interval_average_symm (f : ℝ → E) (a b : ℝ) : ⨍ x in a..b, f x = ⨍ x in b..a, f x :=
by rw [set_average_eq, set_average_eq, uIoc_swap]

lemma interval_average_eq (f : ℝ → E) (a b : ℝ) : ⨍ x in a..b, f x = (b - a)⁻¹ • ∫ x in a..b, f x :=
begin
  cases le_or_lt a b with h h,
  { rw [set_average_eq, uIoc_of_le h, real.volume_Ioc, interval_integral.integral_of_le h,
      ennreal.to_real_of_real (sub_nonneg.2 h)] },
  { rw [set_average_eq, uIoc_of_lt h, real.volume_Ioc, interval_integral.integral_of_ge h.le,
     ennreal.to_real_of_real (sub_nonneg.2 h.le), smul_neg, ← neg_smul, ← inv_neg, neg_sub] }
end

lemma interval_average_eq_div (f : ℝ → ℝ) (a b : ℝ) :
  ⨍ x in a..b, f x = (∫ x in a..b, f x) / (b - a) :=
by rw [interval_average_eq, smul_eq_mul, div_eq_inv_mul]


/- LoVe Exercise 9: Hoare Logic -/

import .love09_hoare_logic_demo

namespace LoVe

/- Question 1: Program Verification -/

section GAUSS

/- The following WHILE program is intended to compute the Gaussian sum up to
`n`, leaving the result in `r`. -/

def GAUSS : program :=
assign "r" (λs, 0) ;;
while (λs, s "n" ≠ 0)
  (assign "r" (λs, s "r" + s "n") ;;
   assign "n" (λs, s "n" - 1))

/- The summation function: -/

def sum_upto : ℕ → ℕ
| 0       := 0
| (n + 1) := n + 1 + sum_upto n

/- 1.1. Prove the correctness of `GAUSS`, using `vcg`. The main challenge is to
figure out which invariant to use for the while loop. The invariant should
capture both the work that has been done already (the intermediate result) and
the work that remains to be done. -/

lemma GAUSS_correct (n : ℕ) :
  {* λs, s "n" = n *} GAUSS {* λs, s "r" = sum_upto n *} :=
show
  {* λs, s "n" = n *}
  assign "r" (λs, 0) ;;
  while_inv (λs, s "r" + sum_upto (s "n") = sum_upto n) (λs, s "n" ≠ 0)
    (assign "r" (λs, s "r" + s "n") ;;
     assign "n" (λs, s "n" - 1))
  {* λs, s "r" = sum_upto n *},
begin
  vcg;
    simp [sum_upto] { contextual := tt },
  intro s,
  cases s "n",
  { simp },
  { simp [nat.succ_eq_add_one, sum_upto, mul_assoc] { contextual := tt } }
end

end GAUSS

section MUL

/- The following WHILE program is intended to compute the product of `n` and
`m`, leaving the result in `r`. -/

def MUL : program :=
assign "r" (λs, 0) ;;
while (λs, s "n" ≠ 0)
  (assign "r" (λs, s "r" + s "m") ;;
   assign "n" (λs, s "n" - 1))

/- 1.2 Prove the correctness of `MUL`, using `vcg`.

Hint: If a variable `x` does not change in a program, it might be useful to
record this in the invariant, by adding a conjunct `s "x" = x`. -/

lemma MUL_correct (n m : ℕ) :
  {* λs, s "n" = n ∧ s "m" = m *} MUL {* λs, s "r" = n * m *} :=
show
  {* λs, s "n" = n ∧ s "m" = m *}
  assign "r" (λs, 0) ;;
  while_inv (λs, s "m" = m ∧ s "r" + s "n" * s "m" = n * s "m") (λs, s "n" ≠ 0)
    (assign "r" (λs, s "r" + s "m") ;;
     assign "n" (λs, s "n" - 1))
  {* λs, s "r" = n * m *},
begin
  vcg;
    simp { contextual := tt },
  intro s,
  cases s "n",
  { simp },
  { simp [nat.succ_eq_add_one, add_mul] { contextual := tt } }
end

end MUL

/- Question 2: Hoare Triples for Total Correctness -/

def total_hoare (P : state → Prop) (p : program) (Q : state → Prop) : Prop :=
∀s, P s → ∃t, (p, s) ⟹ t ∧ Q t

notation `[* ` P : 1 ` *] ` p : 1 ` [* ` Q : 1 ` *]` := total_hoare P p Q

namespace total_hoare

variables {P P' P₁ P₂ P₃ Q Q' : state → Prop} {x : string}
variables {S S₀ S₁ S₂ : program}
variables {b : state → Prop} {a : state → ℕ} {s s₀ s₁ s₂ t u : state}

/- 2.1. Prove the consequence rule. -/

lemma consequence (h : [* P *] S [* Q *]) (hp : ∀s, P' s → P s)
    (hq : ∀s, Q s → Q' s) :
  [* P' *] S [* Q' *] :=
begin
  intros s hs,
  specialize h s (hp s hs),
  cases h with t ht,
  use t,
  apply and.intro,
  { exact and.elim_left ht },
  { exact hq t (and.elim_right ht) }
end

/- 2.2. Prove the rule for `skip`. -/

lemma skip_intro :
  [* P *] skip [* P *] :=
begin
  intros s hs,
  use s,
  apply and.intro big_step.skip hs
end

/- 2.3. Prove the rule for `assign`. -/

lemma assign_intro (P : state → Prop) :
  [* λs, P (s{x ↦ a s}) *] assign x a [* P *] :=
begin
  intros s hs,
  use s{x ↦ a s},
  exact and.intro big_step.assign hs
end

/- 2.4. Prove the rule for `seq`. -/

lemma seq_intro (h₁ : [* P₁ *] S₁ [* P₂ *])
    (h₂ : [* P₂ *] S₂ [* P₃ *]) :
  [* P₁ *] S₁ ;; S₂ [* P₃ *] :=
begin
  intros s hs,
  specialize h₁ s hs,
  cases h₁ with t h₁,
  specialize h₂ t (and.elim_right h₁),
  cases h₂ with u h₂,
  use u,
  apply and.intro,
  { exact big_step.seq (and.elim_left h₁) (and.elim_left h₂) },
  { exact and.elim_right h₂ }
end

/- 2.5 **optional**. Prove the rule for `ite`. This requires `b s ∨ ¬ b s`.
`classical.em (b s)` provides a proof, even when `b` is not decidable. -/

lemma ite_intro (h₁ : [* λs, P s ∧ b s *] S₁ [* Q *])
  (h₂ : [* λs, P s ∧ ¬ b s *] S₂ [* Q *]) :
  [* P *] ite b S₁ S₂ [* Q *] :=
begin
  intros s hs,
  cases classical.em (b s),
  { cases h₁ s (and.intro hs h) with t ht,
    use t,
    apply and.intro,
    { exact big_step.ite_true h (and.elim_left ht) },
    { exact and.elim_right ht } },
  { cases h₂ s (and.intro hs h) with t ht,
    use t,
    apply and.intro,
    { exact big_step.ite_false h (and.elim_left ht) },
    { exact and.elim_right ht } }
end

/- 2.6 **optional**. Try to prove the rule for `while`.

Before we prove our final goal, we introduce an auxiliary proof. This proof
requires well-founded induction. When using `while_intro.aux` as induction
hypothesis we recommend to do it directly after proving that the argument is
less than `n`:

    have ih : ∃u, (while c p, t) ⟹ u ∧ I u ∧ ¬ c u :=
      have M < n := …,
        -- necessary for Lean to figure out the well-founded induction
      while_intro.aux M …,

Similar to `ite`, this requires `c s ∨ ¬ c s`. `classical.em (c s)` provides a
proof. -/

lemma while_intro.aux
  (I : state → Prop)
  (V : state → ℕ)
  (h_inv : ∀n, [* λs, I s ∧ b s ∧ V s = n *] S [* λs, I s ∧ V s < n *]) :
  ∀n s, V s = n → I s → ∃t, (while b S, s) ⟹ t ∧ I t ∧ ¬ b t
| n s V_eq hs :=
  begin
    cases classical.em (b s) with hcs hncs,
    { have h_inv : ∃ t, (S, s) ⟹ t ∧ I t ∧ V t < n :=
        h_inv n s (and.intro hs (and.intro hcs V_eq)),
      cases h_inv with t ht,
      have ih : ∃u, (while b S, t) ⟹ u ∧ I u ∧ ¬ b u :=
        have V t < n := and.elim_right (and.elim_right ht),
        while_intro.aux (V t) t rfl (and.elim_left (and.elim_right ht)),
      cases ih with u hu,
      use u,
      apply and.intro,
      { exact big_step.while_true hcs (and.elim_left ht) (and.elim_left hu) },
      { exact and.elim_right hu } },
    { use s,
      apply and.intro,
      { exact big_step.while_false hncs },
      { exact and.intro hs hncs } }
  end

lemma while_intro
  (I : state → Prop)   -- invariant in the loop
  (V : state → ℕ)      -- variant in the loop body (a.k.a. termination measure)
  (h_inv : ∀n, [* λs, I s ∧ b s ∧ V s = n *] S [* λs, I s ∧ V s < n *]) :
  [* I *] while b S [* λs, I s ∧ ¬ b s *] :=
begin
  intros s hs,
  exact while_intro.aux I V h_inv (V s) s rfl hs
end

end total_hoare

end LoVe


import data.finset data.set.finite data.fintype
--universes u v

/-- sum_from_one_to n f sums f(i) for 1<=i<=n -/
definition sum_from_one_to {α : Type*} [add_comm_monoid α] (n : ℕ) (f : ℕ → α) : α :=
finset.sum (finset.Ico 1 (n+1)) f

theorem sum_from_one_to.rec {α : Type*} [add_comm_monoid α]
  (n : ℕ) (f : ℕ → α) : sum_from_one_to (n+1) f = f (n+1) + sum_from_one_to n f  :=
begin
  unfold sum_from_one_to,
  rw finset.Ico.succ_top (show 1 ≤ n + 1, by simp),
  rw finset.sum_insert,
  simp,
end

/-- sum_from_zero_to n f sums f(i) for 0<=i<=n -/
definition sum_from_zero_to {α : Type*} [add_comm_monoid α] (n : ℕ) (f : ℕ → α) : α :=
finset.sum (finset.range (n + 1)) f

theorem sum_from_zero_to.rec {α : Type*} [add_comm_monoid α]
  (n : ℕ) (f : ℕ → α) : sum_from_zero_to (n+1) f = f (n+1) + sum_from_zero_to n f  :=
begin
  unfold sum_from_zero_to,
  rw finset.range_succ,
  rw finset.sum_insert,
  simp,
end

/-- sum_from_to a n f sums f(i) for a<=i<=n, if a <= n + 1 -/
definition sum_from_to {α : Type*} [add_comm_monoid α]
  (a : ℕ) (n : ℕ) (f : ℕ → α) : α :=
finset.sum (finset.Ico a (n + 1)) f

theorem sum_from_to.rec {α : Type*} [add_comm_monoid α]
  (a : ℕ) (n : ℕ) (f : ℕ → α) (H : a ≤ n + 1) :
sum_from_to a (n+1) f = f (n+1) + sum_from_to a n f  :=
begin
  unfold sum_from_to,
  rw finset.Ico.succ_top H,
  rw finset.sum_insert,
  simp,
end


-- ---------------------------------------------------------------------
-- Ejercicio 1. Realizar las siguientes acciones:
-- 1. Importar la librería de los números reales.
-- 2. Declarar x, y, a y b como variables sobre los reales.
-- 3. Crear el espacio de nombres my_abs.
-- ----------------------------------------------------------------------

import data.real.basic    -- 1
variables {x y a b : ℝ}   -- 2
namespace my_abs          -- 3

-- ---------------------------------------------------------------------
-- Ejercicio 2. Demostrar que
--    x ≤ abs x
-- ----------------------------------------------------------------------

-- 1ª demostración
-- ===============

example : x ≤ abs x :=
begin
  cases (le_or_gt 0 x) with h1 h2,
  { rw abs_of_nonneg h1 },
  { rw abs_of_neg h2,
    apply left.self_le_neg,
    apply le_of_lt h2 },
end

-- Prueba
-- ======

/-
x : ℝ
⊢ x ≤ abs x
  >> cases (le_or_gt 0 x) with h1 h2,
| h1 : 0 ≤ x
| ⊢ x ≤ abs x
  >> { rw abs_of_nonneg h1 },
h2 : 0 > x
⊢ x ≤ abs x
  >> { rw abs_of_neg h2,
⊢ x ≤ -x
  >>   apply self_le_neg,
⊢ x ≤ 0
  >>   apply le_of_lt h2 },
no goals
-/

-- Comentario: Se han usado los siguientes lemas
-- + le_or_gt x y : x ≤ y ∨ x > y
-- + abs_of_nonneg : 0 ≤ x → abs x = x
-- + abs_of_neg : x < 0 → abs x = -x
-- + self_le_neg : x ≤ 0 → x ≤ -x
-- + le_of_lt : x < y → x ≤ y

-- Comprobación
-- #check (@le_or_gt ℝ _ x y)
-- #check (@abs_of_nonneg ℝ _ x)
-- #check (@abs_of_neg ℝ _ x)
-- #check (@self_le_neg ℝ _ x)
-- #check (@le_of_lt ℝ _ x y)

-- 2ª demostración
-- ===============

example : x ≤ abs x :=
begin
  unfold abs,
  exact le_max_left x (-x),
end

-- Comentarios:
-- 1. La táctica (unfold e) despliega la definición de e.
-- 2. La definición de abs
--    + abs (a : α) : α := max a (-a)
-- 3. Se ha usado el lema
--    + le_max_left x y : x ≤ max x y

-- Comprobación
-- #check (@le_max_left ℝ _ x y)
-- #print abs

-- 3ª demostración
-- ===============

example : x ≤ abs x :=
le_max_left x (-x)

-- ---------------------------------------------------------------------
-- Ejercicio 3. Demostrar que
--    -x ≤ abs x
-- ----------------------------------------------------------------------

-- 1ª demostración
-- ===============

theorem neg_le_abs_self : -x ≤ abs x :=
begin
  cases (le_or_gt 0 x) with h1 h2,
  { rw abs_of_nonneg h1,
    apply neg_le_self h1 },
  { rw abs_of_neg h2 },
end

-- Prueba
-- ======

/-
x : ℝ
⊢ -x ≤ abs x
  >> cases (le_or_gt 0 x) with h1 h2,
| h1 : 0 ≤ x
| ⊢ -x ≤ abs x
|   >> { rw abs_of_nonneg h1,
| ⊢ -x ≤ x
|   >>   apply neg_le_self h1 },
h2 : 0 > x
⊢ -x ≤ abs x
  >> { rw abs_of_neg h2 },
no goals
-/

-- Comentario: Los lemas utilizados son
-- + le_or_gt x y : x ≤ y ∨ x > y
-- + abs_of_nonneg : 0 ≤ x → abs x = x
-- + neg_le_self : 0 ≤ x → -x ≤ x
-- + abs_of_neg : x < 0 → abs x = -x

-- Comprobación
-- #check (@le_or_gt ℝ _ x y)
-- #check (@abs_of_nonneg ℝ _ x)
-- #check (@neg_le_self ℝ _ x)
-- #check (@abs_of_neg ℝ _ x)

-- 2ª demostración
-- ===============

example : -x ≤ abs x :=
begin
  unfold abs,
  exact le_max_right x (-x),
end

-- Comentarios:
-- 1. La táctica (unfold e) despliega la definición de e.
-- 2. La definición de abs
--    + abs (a : α) : α := max a (-a)
-- 3. Se ha usado el lema
--    + le_max_right x y : y ≤ max x y

-- Comprobación:
-- #check (@le_max_right ℝ _ x y)

-- 3ª demostración
-- ===============

example : -x ≤ abs x :=
le_max_right x (-x)

-- ---------------------------------------------------------------------
-- Ejercicio 4. Demostrar que si
--    0 ≤ a + b
--    0 ≤ a
-- entonces
--    abs (a + b) ≤ abs a + abs b
-- ----------------------------------------------------------------------

open_locale classical

lemma aux1
  (h1 : 0 ≤ a + b)
  (h2 : 0 ≤ a)
  : abs (a + b) ≤ abs a + abs b :=
begin
  by_cases h3 : 0 ≤ b,
  show abs (a + b) ≤ abs a + abs b,
    calc
      abs (a + b) ≤ abs (a + b)   : by apply le_refl
              ... = a + b         : by rw (abs_of_nonneg h1)
              ... = abs a + b     : by rw (abs_of_nonneg h2)
              ... = abs a + abs b : by rw (abs_of_nonneg h3),
  have h4 : b ≤ 0,
    from le_of_lt (lt_of_not_ge h3),
  show abs (a + b) ≤ abs a + abs b,
    calc
      abs (a + b) = a + b         : by rw (abs_of_nonneg h1)
              ... = abs a + b     : by rw (abs_of_nonneg h2)
              ... ≤ abs a + 0     : add_le_add_left h4 _
              ... ≤ abs a + -b    : add_le_add_left (neg_nonneg_of_nonpos h4) _
              ... = abs a + abs b : by rw (abs_of_nonpos h4),
end

-- Prueba
-- ======

/-
a b : ℝ,
h1 : 0 ≤ a + b,
h2 : 0 ≤ a
⊢ abs (a + b) ≤ abs a + abs b
  >> by_cases h3 : 0 ≤ b,
| h3 : 0 ≤ b
| ⊢ abs (a + b) ≤ abs a + abs b
|   >> show abs (a + b) ≤ abs a + abs b, calc
|   >>   abs (a + b) ≤ abs (a + b)   : by apply le_refl
|   >>           ... = a + b         : by rw (abs_of_nonneg h1)
|   >>           ... = abs a + b     : by rw (abs_of_nonneg h2)
|   >>           ... = abs a + abs b : by rw (abs_of_nonneg h3),
h3 : ¬0 ≤ b
⊢ abs (a + b) ≤ abs a + abs b
  >> have h4 : b ≤ 0,
  >>   from le_of_lt (lt_of_not_ge h3),
h4 : b ≤ 0
⊢ abs (a + b) ≤ abs a + abs b
  >> show abs (a + b) ≤ abs a + abs b, calc
  >>   abs (a + b) = a + b         : by rw (abs_of_nonneg h1)
  >>           ... = abs a + b     : by rw (abs_of_nonneg h2)
  >>           ... ≤ abs a + 0     : add_le_add_left h4 _
  >>           ... ≤ abs a + -b    : add_le_add_left (neg_nonneg_of_nonpos h4)
  >>           ... = abs a + abs b : by rw (abs_of_nonpos h4),
-/

-- Comentarios:
-- 1. La táctica (by_cases h : p) aplica el principio de tercio excluso
--    sobre p; es decir, considera dos casos: en el primero le añade la
--    hipótesis (h : p) y en el segundo, (h : ¬p).
-- 2. Para aplicar la táctica by_cases hay que habilitar la lógica
--    clásica.
-- 3. Se han usado los siguientes lemas
--    + le_refl x : x ≤ x
--    + abs_of_nonneg : 0 ≤ x → abs x = x
--    + le_of_lt : x < y → x ≤ y
--    + lt_of_not_ge : ¬x ≥ y → x < y
--    + add_le_add_left : x ≤ y → ∀ (c : ℝ), c + x ≤ c + y
--    + neg_nonneg_of_nonpos : x ≤ 0 → 0 ≤ -x
--    + abs_of_nonpos : x ≤ 0 → abs x = -x

-- Comprobación:
-- #check (@le_refl ℝ _ x)
-- #check (@abs_of_nonneg ℝ _ x)
-- #check (@le_of_lt ℝ _ x y)
-- #check (@lt_of_not_ge ℝ _ x y)
-- #check (@add_le_add_left ℝ _ x y)
-- #check (@neg_nonneg_of_nonpos ℝ _ x)
-- #check (@abs_of_nonpos ℝ _ x)

-- ---------------------------------------------------------------------
-- Ejercicio 5. Demostrar que si
--    0 ≤ a + b
-- entonces
--    abs (a + b) ≤ abs a + abs b
-- ----------------------------------------------------------------------

lemma aux2
  (h1 : 0 ≤ a + b)
  : abs (a + b) ≤ abs a + abs b :=
begin
  by_cases h2 : 0 ≤ a,
    exact @aux1 a b h1 h2,
  rw add_comm at h1,
  have h3 : 0 ≤ b,
    linarith,
  rw add_comm,
  rw add_comm (abs a),
  exact @aux1 b a h1 h3,
end

-- ---------------------------------------------------------------------
-- Ejercicio 6. Demostrar que
--    abs (x + y) ≤ abs x + abs y
-- ----------------------------------------------------------------------

theorem abs_add : abs (x + y) ≤ abs x + abs y :=
begin
  by_cases h2 : 0 ≤ x + y,
    { exact @aux2 x y h2 },
  have h3 : x + y ≤ 0,
    by exact le_of_not_ge h2,
  have h4: -x + -y = -(x + y),
    by rw neg_add,
  have h5 : 0 ≤ -(x + y),
    from neg_nonneg_of_nonpos h3,
  have h6 : 0 ≤ -x + -y,
    { rw [← h4] at h5,
      exact h5 },
  calc
     abs (x + y) = abs (-x + -y)       : by rw [← abs_neg, neg_add]
             ... ≤ abs (-x) + abs (-y) : aux2 h6
             ... = abs x + abs y       : by rw [abs_neg, abs_neg],
end

-- Prueba
-- ======

/-
x y : ℝ
⊢ abs (x + y) ≤ abs x + abs y
  >> by_cases h2 : 0 ≤ x + y,
| h2 : 0 ≤ x + y
| ⊢ abs (x + y) ≤ abs x + abs y
|   >>   { exact @aux2 x y h2 },
h2 : ¬0 ≤ x + y
⊢ abs (x + y) ≤ abs x + abs y
  >> have h3 : x + y ≤ 0,
  >>   by exact le_of_not_ge h2,
x y : ℝ,
h2 : ¬0 ≤ x + y,
h3 : x + y ≤ 0
⊢ abs (x + y) ≤ abs x + abs y
  >> have h4: -x + -y = -(x + y),
  >>   by rw neg_add,
x y : ℝ,
h2 : ¬0 ≤ x + y,
h3 : x + y ≤ 0,
h4 : -x + -y = -(x + y)
⊢ abs (x + y) ≤ abs x + abs y
  >> have h5 : 0 ≤ -(x + y),
  >>   from neg_nonneg_of_nonpos h3,
x y : ℝ,
h2 : ¬0 ≤ x + y,
h3 : x + y ≤ 0,
h4 : -x + -y = -(x + y),
h5 : 0 ≤ -(x + y)
⊢ abs (x + y) ≤ abs x + abs y
  >> have h6 : 0 ≤ -x + -y,
  >>   { rw [← h4] at h5,
x y : ℝ,
h2 : ¬0 ≤ x + y,
h3 : x + y ≤ 0,
h4 : -x + -y = -(x + y),
h5 : 0 ≤ -x + -y
⊢ 0 ≤ -x + -y
  >>     exact h5 },
x y : ℝ,
h2 : ¬0 ≤ x + y,
h3 : x + y ≤ 0,
h4 : -x + -y = -(x + y),
h5 : 0 ≤ -(x + y),
h6 : 0 ≤ -x + -y
⊢ abs (x + y) ≤ abs x + abs y
  >> calc
  >>    abs (x + y) = abs (-x + -y)       : by rw [← abs_neg, neg_add]
  >>            ... ≤ abs (-x) + abs (-y) : aux2 h6
  >>            ... = abs x + abs y       : by rw [abs_neg, abs_neg],
-/

-- Comentario: Se han usado los lemas
-- + le_of_not_ge : ¬x ≥ y → x ≤ y
-- + neg_add x y : -(x + y) = -x + -y
-- + neg_nonneg_of_nonpos : x ≤ 0 → 0 ≤ -x

-- Comprobación:
-- #check (@le_of_not_ge ℝ _ x y)
-- #check (@neg_add ℝ _ x y)
-- #check (@neg_nonneg_of_nonpos ℝ _ x)

end my_abs


/-
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, Benjamin Davidson
-/
import analysis.special_functions.exp_deriv

/-!
# Differentiability of trigonometric functions

## Main statements

The differentiability of the usual trigonometric functions is proved, and their derivatives are
computed.

## Tags

sin, cos, tan, angle
-/

noncomputable theory
open_locale classical topological_space filter
open set filter

namespace complex

/-- The complex sine function is everywhere strictly differentiable, with the derivative `cos x`. -/
lemma has_strict_deriv_at_sin (x : ℂ) : has_strict_deriv_at sin (cos x) x :=
begin
  simp only [cos, div_eq_mul_inv],
  convert ((((has_strict_deriv_at_id x).neg.mul_const I).cexp.sub
    ((has_strict_deriv_at_id x).mul_const I).cexp).mul_const I).mul_const (2:ℂ)⁻¹,
  simp only [function.comp, id],
  rw [sub_mul, mul_assoc, mul_assoc, I_mul_I, neg_one_mul, neg_neg, mul_one, one_mul, mul_assoc,
      I_mul_I, mul_neg_one, sub_neg_eq_add, add_comm]
end

/-- The complex sine function is everywhere differentiable, with the derivative `cos x`. -/
lemma has_deriv_at_sin (x : ℂ) : has_deriv_at sin (cos x) x :=
(has_strict_deriv_at_sin x).has_deriv_at

lemma times_cont_diff_sin {n} : times_cont_diff ℂ n sin :=
(((times_cont_diff_neg.mul times_cont_diff_const).cexp.sub
  (times_cont_diff_id.mul times_cont_diff_const).cexp).mul times_cont_diff_const).div_const

lemma differentiable_sin : differentiable ℂ sin :=
λx, (has_deriv_at_sin x).differentiable_at

lemma differentiable_at_sin {x : ℂ} : differentiable_at ℂ sin x :=
differentiable_sin x

@[simp] lemma deriv_sin : deriv sin = cos :=
funext $ λ x, (has_deriv_at_sin x).deriv

/-- The complex cosine function is everywhere strictly differentiable, with the derivative
`-sin x`. -/
lemma has_strict_deriv_at_cos (x : ℂ) : has_strict_deriv_at cos (-sin x) x :=
begin
  simp only [sin, div_eq_mul_inv, neg_mul_eq_neg_mul],
  convert (((has_strict_deriv_at_id x).mul_const I).cexp.add
    ((has_strict_deriv_at_id x).neg.mul_const I).cexp).mul_const (2:ℂ)⁻¹,
  simp only [function.comp, id],
  ring
end

/-- The complex cosine function is everywhere differentiable, with the derivative `-sin x`. -/
lemma has_deriv_at_cos (x : ℂ) : has_deriv_at cos (-sin x) x :=
(has_strict_deriv_at_cos x).has_deriv_at

lemma times_cont_diff_cos {n} : times_cont_diff ℂ n cos :=
((times_cont_diff_id.mul times_cont_diff_const).cexp.add
  (times_cont_diff_neg.mul times_cont_diff_const).cexp).div_const

lemma differentiable_cos : differentiable ℂ cos :=
λx, (has_deriv_at_cos x).differentiable_at

lemma differentiable_at_cos {x : ℂ} : differentiable_at ℂ cos x :=
differentiable_cos x

lemma deriv_cos {x : ℂ} : deriv cos x = -sin x :=
(has_deriv_at_cos x).deriv

@[simp] lemma deriv_cos' : deriv cos = (λ x, -sin x) :=
funext $ λ x, deriv_cos

/-- The complex hyperbolic sine function is everywhere strictly differentiable, with the derivative
`cosh x`. -/
lemma has_strict_deriv_at_sinh (x : ℂ) : has_strict_deriv_at sinh (cosh x) x :=
begin
  simp only [cosh, div_eq_mul_inv],
  convert ((has_strict_deriv_at_exp x).sub (has_strict_deriv_at_id x).neg.cexp).mul_const (2:ℂ)⁻¹,
  rw [id, mul_neg_one, sub_eq_add_neg, neg_neg]
end

/-- The complex hyperbolic sine function is everywhere differentiable, with the derivative
`cosh x`. -/
lemma has_deriv_at_sinh (x : ℂ) : has_deriv_at sinh (cosh x) x :=
(has_strict_deriv_at_sinh x).has_deriv_at

lemma times_cont_diff_sinh {n} : times_cont_diff ℂ n sinh :=
(times_cont_diff_exp.sub times_cont_diff_neg.cexp).div_const

lemma differentiable_sinh : differentiable ℂ sinh :=
λx, (has_deriv_at_sinh x).differentiable_at

lemma differentiable_at_sinh {x : ℂ} : differentiable_at ℂ sinh x :=
differentiable_sinh x

@[simp] lemma deriv_sinh : deriv sinh = cosh :=
funext $ λ x, (has_deriv_at_sinh x).deriv

/-- The complex hyperbolic cosine function is everywhere strictly differentiable, with the
derivative `sinh x`. -/
lemma has_strict_deriv_at_cosh (x : ℂ) : has_strict_deriv_at cosh (sinh x) x :=
begin
  simp only [sinh, div_eq_mul_inv],
  convert ((has_strict_deriv_at_exp x).add (has_strict_deriv_at_id x).neg.cexp).mul_const (2:ℂ)⁻¹,
  rw [id, mul_neg_one, sub_eq_add_neg]
end

/-- The complex hyperbolic cosine function is everywhere differentiable, with the derivative
`sinh x`. -/
lemma has_deriv_at_cosh (x : ℂ) : has_deriv_at cosh (sinh x) x :=
(has_strict_deriv_at_cosh x).has_deriv_at

lemma times_cont_diff_cosh {n} : times_cont_diff ℂ n cosh :=
(times_cont_diff_exp.add times_cont_diff_neg.cexp).div_const

lemma differentiable_cosh : differentiable ℂ cosh :=
λx, (has_deriv_at_cosh x).differentiable_at

lemma differentiable_at_cosh {x : ℂ} : differentiable_at ℂ cosh x :=
differentiable_cosh x

@[simp] lemma deriv_cosh : deriv cosh = sinh :=
funext $ λ x, (has_deriv_at_cosh x).deriv

end complex

section
/-! ### Simp lemmas for derivatives of `λ x, complex.cos (f x)` etc., `f : ℂ → ℂ` -/

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

/-! #### `complex.cos` -/

lemma has_strict_deriv_at.ccos (hf : has_strict_deriv_at f f' x) :
  has_strict_deriv_at (λ x, complex.cos (f x)) (- complex.sin (f x) * f') x :=
(complex.has_strict_deriv_at_cos (f x)).comp x hf

lemma has_deriv_at.ccos (hf : has_deriv_at f f' x) :
  has_deriv_at (λ x, complex.cos (f x)) (- complex.sin (f x) * f') x :=
(complex.has_deriv_at_cos (f x)).comp x hf

lemma has_deriv_within_at.ccos (hf : has_deriv_within_at f f' s x) :
  has_deriv_within_at (λ x, complex.cos (f x)) (- complex.sin (f x) * f') s x :=
(complex.has_deriv_at_cos (f x)).comp_has_deriv_within_at x hf

lemma deriv_within_ccos (hf : differentiable_within_at ℂ f s x)
  (hxs : unique_diff_within_at ℂ s x) :
  deriv_within (λx, complex.cos (f x)) s x = - complex.sin (f x) * (deriv_within f s x) :=
hf.has_deriv_within_at.ccos.deriv_within hxs

@[simp] lemma deriv_ccos (hc : differentiable_at ℂ f x) :
  deriv (λx, complex.cos (f x)) x = - complex.sin (f x) * (deriv f x) :=
hc.has_deriv_at.ccos.deriv

/-! #### `complex.sin` -/

lemma has_strict_deriv_at.csin (hf : has_strict_deriv_at f f' x) :
  has_strict_deriv_at (λ x, complex.sin (f x)) (complex.cos (f x) * f') x :=
(complex.has_strict_deriv_at_sin (f x)).comp x hf

lemma has_deriv_at.csin (hf : has_deriv_at f f' x) :
  has_deriv_at (λ x, complex.sin (f x)) (complex.cos (f x) * f') x :=
(complex.has_deriv_at_sin (f x)).comp x hf

lemma has_deriv_within_at.csin (hf : has_deriv_within_at f f' s x) :
  has_deriv_within_at (λ x, complex.sin (f x)) (complex.cos (f x) * f') s x :=
(complex.has_deriv_at_sin (f x)).comp_has_deriv_within_at x hf

lemma deriv_within_csin (hf : differentiable_within_at ℂ f s x)
  (hxs : unique_diff_within_at ℂ s x) :
  deriv_within (λx, complex.sin (f x)) s x = complex.cos (f x) * (deriv_within f s x) :=
hf.has_deriv_within_at.csin.deriv_within hxs

@[simp] lemma deriv_csin (hc : differentiable_at ℂ f x) :
  deriv (λx, complex.sin (f x)) x = complex.cos (f x) * (deriv f x) :=
hc.has_deriv_at.csin.deriv

/-! #### `complex.cosh` -/

lemma has_strict_deriv_at.ccosh (hf : has_strict_deriv_at f f' x) :
  has_strict_deriv_at (λ x, complex.cosh (f x)) (complex.sinh (f x) * f') x :=
(complex.has_strict_deriv_at_cosh (f x)).comp x hf

lemma has_deriv_at.ccosh (hf : has_deriv_at f f' x) :
  has_deriv_at (λ x, complex.cosh (f x)) (complex.sinh (f x) * f') x :=
(complex.has_deriv_at_cosh (f x)).comp x hf

lemma has_deriv_within_at.ccosh (hf : has_deriv_within_at f f' s x) :
  has_deriv_within_at (λ x, complex.cosh (f x)) (complex.sinh (f x) * f') s x :=
(complex.has_deriv_at_cosh (f x)).comp_has_deriv_within_at x hf

lemma deriv_within_ccosh (hf : differentiable_within_at ℂ f s x)
  (hxs : unique_diff_within_at ℂ s x) :
  deriv_within (λx, complex.cosh (f x)) s x = complex.sinh (f x) * (deriv_within f s x) :=
hf.has_deriv_within_at.ccosh.deriv_within hxs

@[simp] lemma deriv_ccosh (hc : differentiable_at ℂ f x) :
  deriv (λx, complex.cosh (f x)) x = complex.sinh (f x) * (deriv f x) :=
hc.has_deriv_at.ccosh.deriv

/-! #### `complex.sinh` -/

lemma has_strict_deriv_at.csinh (hf : has_strict_deriv_at f f' x) :
  has_strict_deriv_at (λ x, complex.sinh (f x)) (complex.cosh (f x) * f') x :=
(complex.has_strict_deriv_at_sinh (f x)).comp x hf

lemma has_deriv_at.csinh (hf : has_deriv_at f f' x) :
  has_deriv_at (λ x, complex.sinh (f x)) (complex.cosh (f x) * f') x :=
(complex.has_deriv_at_sinh (f x)).comp x hf

lemma has_deriv_within_at.csinh (hf : has_deriv_within_at f f' s x) :
  has_deriv_within_at (λ x, complex.sinh (f x)) (complex.cosh (f x) * f') s x :=
(complex.has_deriv_at_sinh (f x)).comp_has_deriv_within_at x hf

lemma deriv_within_csinh (hf : differentiable_within_at ℂ f s x)
  (hxs : unique_diff_within_at ℂ s x) :
  deriv_within (λx, complex.sinh (f x)) s x = complex.cosh (f x) * (deriv_within f s x) :=
hf.has_deriv_within_at.csinh.deriv_within hxs

@[simp] lemma deriv_csinh (hc : differentiable_at ℂ f x) :
  deriv (λx, complex.sinh (f x)) x = complex.cosh (f x) * (deriv f x) :=
hc.has_deriv_at.csinh.deriv

end

section
/-! ### Simp lemmas for derivatives of `λ x, complex.cos (f x)` etc., `f : E → ℂ` -/

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

/-! #### `complex.cos` -/

lemma has_strict_fderiv_at.ccos (hf : has_strict_fderiv_at f f' x) :
  has_strict_fderiv_at (λ x, complex.cos (f x)) (- complex.sin (f x) • f') x :=
(complex.has_strict_deriv_at_cos (f x)).comp_has_strict_fderiv_at x hf

lemma has_fderiv_at.ccos (hf : has_fderiv_at f f' x) :
  has_fderiv_at (λ x, complex.cos (f x)) (- complex.sin (f x) • f') x :=
(complex.has_deriv_at_cos (f x)).comp_has_fderiv_at x hf

lemma has_fderiv_within_at.ccos (hf : has_fderiv_within_at f f' s x) :
  has_fderiv_within_at (λ x, complex.cos (f x)) (- complex.sin (f x) • f') s x :=
(complex.has_deriv_at_cos (f x)).comp_has_fderiv_within_at x hf

lemma differentiable_within_at.ccos (hf : differentiable_within_at ℂ f s x) :
  differentiable_within_at ℂ (λ x, complex.cos (f x)) s x :=
hf.has_fderiv_within_at.ccos.differentiable_within_at

@[simp] lemma differentiable_at.ccos (hc : differentiable_at ℂ f x) :
  differentiable_at ℂ (λx, complex.cos (f x)) x :=
hc.has_fderiv_at.ccos.differentiable_at

lemma differentiable_on.ccos (hc : differentiable_on ℂ f s) :
  differentiable_on ℂ (λx, complex.cos (f x)) s :=
λx h, (hc x h).ccos

@[simp] lemma differentiable.ccos (hc : differentiable ℂ f) :
  differentiable ℂ (λx, complex.cos (f x)) :=
λx, (hc x).ccos

lemma fderiv_within_ccos (hf : differentiable_within_at ℂ f s x)
  (hxs : unique_diff_within_at ℂ s x) :
  fderiv_within ℂ (λx, complex.cos (f x)) s x = - complex.sin (f x) • (fderiv_within ℂ f s x) :=
hf.has_fderiv_within_at.ccos.fderiv_within hxs

@[simp] lemma fderiv_ccos (hc : differentiable_at ℂ f x) :
  fderiv ℂ (λx, complex.cos (f x)) x = - complex.sin (f x) • (fderiv ℂ f x) :=
hc.has_fderiv_at.ccos.fderiv

lemma times_cont_diff.ccos {n} (h : times_cont_diff ℂ n f) :
  times_cont_diff ℂ n (λ x, complex.cos (f x)) :=
complex.times_cont_diff_cos.comp h

lemma times_cont_diff_at.ccos {n} (hf : times_cont_diff_at ℂ n f x) :
  times_cont_diff_at ℂ n (λ x, complex.cos (f x)) x :=
complex.times_cont_diff_cos.times_cont_diff_at.comp x hf

lemma times_cont_diff_on.ccos {n} (hf : times_cont_diff_on ℂ n f s) :
  times_cont_diff_on ℂ n (λ x, complex.cos (f x)) s :=
complex.times_cont_diff_cos.comp_times_cont_diff_on  hf

lemma times_cont_diff_within_at.ccos {n} (hf : times_cont_diff_within_at ℂ n f s x) :
  times_cont_diff_within_at ℂ n (λ x, complex.cos (f x)) s x :=
complex.times_cont_diff_cos.times_cont_diff_at.comp_times_cont_diff_within_at x hf

/-! #### `complex.sin` -/

lemma has_strict_fderiv_at.csin (hf : has_strict_fderiv_at f f' x) :
  has_strict_fderiv_at (λ x, complex.sin (f x)) (complex.cos (f x) • f') x :=
(complex.has_strict_deriv_at_sin (f x)).comp_has_strict_fderiv_at x hf

lemma has_fderiv_at.csin (hf : has_fderiv_at f f' x) :
  has_fderiv_at (λ x, complex.sin (f x)) (complex.cos (f x) • f') x :=
(complex.has_deriv_at_sin (f x)).comp_has_fderiv_at x hf

lemma has_fderiv_within_at.csin (hf : has_fderiv_within_at f f' s x) :
  has_fderiv_within_at (λ x, complex.sin (f x)) (complex.cos (f x) • f') s x :=
(complex.has_deriv_at_sin (f x)).comp_has_fderiv_within_at x hf

lemma differentiable_within_at.csin (hf : differentiable_within_at ℂ f s x) :
  differentiable_within_at ℂ (λ x, complex.sin (f x)) s x :=
hf.has_fderiv_within_at.csin.differentiable_within_at

@[simp] lemma differentiable_at.csin (hc : differentiable_at ℂ f x) :
  differentiable_at ℂ (λx, complex.sin (f x)) x :=
hc.has_fderiv_at.csin.differentiable_at

lemma differentiable_on.csin (hc : differentiable_on ℂ f s) :
  differentiable_on ℂ (λx, complex.sin (f x)) s :=
λx h, (hc x h).csin

@[simp] lemma differentiable.csin (hc : differentiable ℂ f) :
  differentiable ℂ (λx, complex.sin (f x)) :=
λx, (hc x).csin

lemma fderiv_within_csin (hf : differentiable_within_at ℂ f s x)
  (hxs : unique_diff_within_at ℂ s x) :
  fderiv_within ℂ (λx, complex.sin (f x)) s x = complex.cos (f x) • (fderiv_within ℂ f s x) :=
hf.has_fderiv_within_at.csin.fderiv_within hxs

@[simp] lemma fderiv_csin (hc : differentiable_at ℂ f x) :
  fderiv ℂ (λx, complex.sin (f x)) x = complex.cos (f x) • (fderiv ℂ f x) :=
hc.has_fderiv_at.csin.fderiv

lemma times_cont_diff.csin {n} (h : times_cont_diff ℂ n f) :
  times_cont_diff ℂ n (λ x, complex.sin (f x)) :=
complex.times_cont_diff_sin.comp h

lemma times_cont_diff_at.csin {n} (hf : times_cont_diff_at ℂ n f x) :
  times_cont_diff_at ℂ n (λ x, complex.sin (f x)) x :=
complex.times_cont_diff_sin.times_cont_diff_at.comp x hf

lemma times_cont_diff_on.csin {n} (hf : times_cont_diff_on ℂ n f s) :
  times_cont_diff_on ℂ n (λ x, complex.sin (f x)) s :=
complex.times_cont_diff_sin.comp_times_cont_diff_on  hf

lemma times_cont_diff_within_at.csin {n} (hf : times_cont_diff_within_at ℂ n f s x) :
  times_cont_diff_within_at ℂ n (λ x, complex.sin (f x)) s x :=
complex.times_cont_diff_sin.times_cont_diff_at.comp_times_cont_diff_within_at x hf

/-! #### `complex.cosh` -/

lemma has_strict_fderiv_at.ccosh (hf : has_strict_fderiv_at f f' x) :
  has_strict_fderiv_at (λ x, complex.cosh (f x)) (complex.sinh (f x) • f') x :=
(complex.has_strict_deriv_at_cosh (f x)).comp_has_strict_fderiv_at x hf

lemma has_fderiv_at.ccosh (hf : has_fderiv_at f f' x) :
  has_fderiv_at (λ x, complex.cosh (f x)) (complex.sinh (f x) • f') x :=
(complex.has_deriv_at_cosh (f x)).comp_has_fderiv_at x hf

lemma has_fderiv_within_at.ccosh (hf : has_fderiv_within_at f f' s x) :
  has_fderiv_within_at (λ x, complex.cosh (f x)) (complex.sinh (f x) • f') s x :=
(complex.has_deriv_at_cosh (f x)).comp_has_fderiv_within_at x hf

lemma differentiable_within_at.ccosh (hf : differentiable_within_at ℂ f s x) :
  differentiable_within_at ℂ (λ x, complex.cosh (f x)) s x :=
hf.has_fderiv_within_at.ccosh.differentiable_within_at

@[simp] lemma differentiable_at.ccosh (hc : differentiable_at ℂ f x) :
  differentiable_at ℂ (λx, complex.cosh (f x)) x :=
hc.has_fderiv_at.ccosh.differentiable_at

lemma differentiable_on.ccosh (hc : differentiable_on ℂ f s) :
  differentiable_on ℂ (λx, complex.cosh (f x)) s :=
λx h, (hc x h).ccosh

@[simp] lemma differentiable.ccosh (hc : differentiable ℂ f) :
  differentiable ℂ (λx, complex.cosh (f x)) :=
λx, (hc x).ccosh

lemma fderiv_within_ccosh (hf : differentiable_within_at ℂ f s x)
  (hxs : unique_diff_within_at ℂ s x) :
  fderiv_within ℂ (λx, complex.cosh (f x)) s x = complex.sinh (f x) • (fderiv_within ℂ f s x) :=
hf.has_fderiv_within_at.ccosh.fderiv_within hxs

@[simp] lemma fderiv_ccosh (hc : differentiable_at ℂ f x) :
  fderiv ℂ (λx, complex.cosh (f x)) x = complex.sinh (f x) • (fderiv ℂ f x) :=
hc.has_fderiv_at.ccosh.fderiv

lemma times_cont_diff.ccosh {n} (h : times_cont_diff ℂ n f) :
  times_cont_diff ℂ n (λ x, complex.cosh (f x)) :=
complex.times_cont_diff_cosh.comp h

lemma times_cont_diff_at.ccosh {n} (hf : times_cont_diff_at ℂ n f x) :
  times_cont_diff_at ℂ n (λ x, complex.cosh (f x)) x :=
complex.times_cont_diff_cosh.times_cont_diff_at.comp x hf

lemma times_cont_diff_on.ccosh {n} (hf : times_cont_diff_on ℂ n f s) :
  times_cont_diff_on ℂ n (λ x, complex.cosh (f x)) s :=
complex.times_cont_diff_cosh.comp_times_cont_diff_on  hf

lemma times_cont_diff_within_at.ccosh {n} (hf : times_cont_diff_within_at ℂ n f s x) :
  times_cont_diff_within_at ℂ n (λ x, complex.cosh (f x)) s x :=
complex.times_cont_diff_cosh.times_cont_diff_at.comp_times_cont_diff_within_at x hf

/-! #### `complex.sinh` -/

lemma has_strict_fderiv_at.csinh (hf : has_strict_fderiv_at f f' x) :
  has_strict_fderiv_at (λ x, complex.sinh (f x)) (complex.cosh (f x) • f') x :=
(complex.has_strict_deriv_at_sinh (f x)).comp_has_strict_fderiv_at x hf

lemma has_fderiv_at.csinh (hf : has_fderiv_at f f' x) :
  has_fderiv_at (λ x, complex.sinh (f x)) (complex.cosh (f x) • f') x :=
(complex.has_deriv_at_sinh (f x)).comp_has_fderiv_at x hf

lemma has_fderiv_within_at.csinh (hf : has_fderiv_within_at f f' s x) :
  has_fderiv_within_at (λ x, complex.sinh (f x)) (complex.cosh (f x) • f') s x :=
(complex.has_deriv_at_sinh (f x)).comp_has_fderiv_within_at x hf

lemma differentiable_within_at.csinh (hf : differentiable_within_at ℂ f s x) :
  differentiable_within_at ℂ (λ x, complex.sinh (f x)) s x :=
hf.has_fderiv_within_at.csinh.differentiable_within_at

@[simp] lemma differentiable_at.csinh (hc : differentiable_at ℂ f x) :
  differentiable_at ℂ (λx, complex.sinh (f x)) x :=
hc.has_fderiv_at.csinh.differentiable_at

lemma differentiable_on.csinh (hc : differentiable_on ℂ f s) :
  differentiable_on ℂ (λx, complex.sinh (f x)) s :=
λx h, (hc x h).csinh

@[simp] lemma differentiable.csinh (hc : differentiable ℂ f) :
  differentiable ℂ (λx, complex.sinh (f x)) :=
λx, (hc x).csinh

lemma fderiv_within_csinh (hf : differentiable_within_at ℂ f s x)
  (hxs : unique_diff_within_at ℂ s x) :
  fderiv_within ℂ (λx, complex.sinh (f x)) s x = complex.cosh (f x) • (fderiv_within ℂ f s x) :=
hf.has_fderiv_within_at.csinh.fderiv_within hxs

@[simp] lemma fderiv_csinh (hc : differentiable_at ℂ f x) :
  fderiv ℂ (λx, complex.sinh (f x)) x = complex.cosh (f x) • (fderiv ℂ f x) :=
hc.has_fderiv_at.csinh.fderiv

lemma times_cont_diff.csinh {n} (h : times_cont_diff ℂ n f) :
  times_cont_diff ℂ n (λ x, complex.sinh (f x)) :=
complex.times_cont_diff_sinh.comp h

lemma times_cont_diff_at.csinh {n} (hf : times_cont_diff_at ℂ n f x) :
  times_cont_diff_at ℂ n (λ x, complex.sinh (f x)) x :=
complex.times_cont_diff_sinh.times_cont_diff_at.comp x hf

lemma times_cont_diff_on.csinh {n} (hf : times_cont_diff_on ℂ n f s) :
  times_cont_diff_on ℂ n (λ x, complex.sinh (f x)) s :=
complex.times_cont_diff_sinh.comp_times_cont_diff_on  hf

lemma times_cont_diff_within_at.csinh {n} (hf : times_cont_diff_within_at ℂ n f s x) :
  times_cont_diff_within_at ℂ n (λ x, complex.sinh (f x)) s x :=
complex.times_cont_diff_sinh.times_cont_diff_at.comp_times_cont_diff_within_at x hf

end

namespace real

variables {x y z : ℝ}

lemma has_strict_deriv_at_sin (x : ℝ) : has_strict_deriv_at sin (cos x) x :=
(complex.has_strict_deriv_at_sin x).real_of_complex

lemma has_deriv_at_sin (x : ℝ) : has_deriv_at sin (cos x) x :=
(has_strict_deriv_at_sin x).has_deriv_at

lemma times_cont_diff_sin {n} : times_cont_diff ℝ n sin :=
complex.times_cont_diff_sin.real_of_complex

lemma differentiable_sin : differentiable ℝ sin :=
λx, (has_deriv_at_sin x).differentiable_at

lemma differentiable_at_sin : differentiable_at ℝ sin x :=
differentiable_sin x

@[simp] lemma deriv_sin : deriv sin = cos :=
funext $ λ x, (has_deriv_at_sin x).deriv

lemma has_strict_deriv_at_cos (x : ℝ) : has_strict_deriv_at cos (-sin x) x :=
(complex.has_strict_deriv_at_cos x).real_of_complex

lemma has_deriv_at_cos (x : ℝ) : has_deriv_at cos (-sin x) x :=
(complex.has_deriv_at_cos x).real_of_complex

lemma times_cont_diff_cos {n} : times_cont_diff ℝ n cos :=
complex.times_cont_diff_cos.real_of_complex

lemma differentiable_cos : differentiable ℝ cos :=
λx, (has_deriv_at_cos x).differentiable_at

lemma differentiable_at_cos : differentiable_at ℝ cos x :=
differentiable_cos x

lemma deriv_cos : deriv cos x = - sin x :=
(has_deriv_at_cos x).deriv

@[simp] lemma deriv_cos' : deriv cos = (λ x, - sin x) :=
funext $ λ _, deriv_cos

lemma has_strict_deriv_at_sinh (x : ℝ) : has_strict_deriv_at sinh (cosh x) x :=
(complex.has_strict_deriv_at_sinh x).real_of_complex

lemma has_deriv_at_sinh (x : ℝ) : has_deriv_at sinh (cosh x) x :=
(complex.has_deriv_at_sinh x).real_of_complex

lemma times_cont_diff_sinh {n} : times_cont_diff ℝ n sinh :=
complex.times_cont_diff_sinh.real_of_complex

lemma differentiable_sinh : differentiable ℝ sinh :=
λx, (has_deriv_at_sinh x).differentiable_at

lemma differentiable_at_sinh : differentiable_at ℝ sinh x :=
differentiable_sinh x

@[simp] lemma deriv_sinh : deriv sinh = cosh :=
funext $ λ x, (has_deriv_at_sinh x).deriv

lemma has_strict_deriv_at_cosh (x : ℝ) : has_strict_deriv_at cosh (sinh x) x :=
(complex.has_strict_deriv_at_cosh x).real_of_complex

lemma has_deriv_at_cosh (x : ℝ) : has_deriv_at cosh (sinh x) x :=
(complex.has_deriv_at_cosh x).real_of_complex

lemma times_cont_diff_cosh {n} : times_cont_diff ℝ n cosh :=
complex.times_cont_diff_cosh.real_of_complex

lemma differentiable_cosh : differentiable ℝ cosh :=
λx, (has_deriv_at_cosh x).differentiable_at

lemma differentiable_at_cosh : differentiable_at ℝ cosh x :=
differentiable_cosh x

@[simp] lemma deriv_cosh : deriv cosh = sinh :=
funext $ λ x, (has_deriv_at_cosh x).deriv

/-- `sinh` is strictly monotone. -/
lemma sinh_strict_mono : strict_mono sinh :=
strict_mono_of_deriv_pos $ by { rw real.deriv_sinh, exact cosh_pos }

end real

section
/-! ### Simp lemmas for derivatives of `λ x, real.cos (f x)` etc., `f : ℝ → ℝ` -/

variables {f : ℝ → ℝ} {f' x : ℝ} {s : set ℝ}

/-! #### `real.cos` -/

lemma has_strict_deriv_at.cos (hf : has_strict_deriv_at f f' x) :
  has_strict_deriv_at (λ x, real.cos (f x)) (- real.sin (f x) * f') x :=
(real.has_strict_deriv_at_cos (f x)).comp x hf

lemma has_deriv_at.cos (hf : has_deriv_at f f' x) :
  has_deriv_at (λ x, real.cos (f x)) (- real.sin (f x) * f') x :=
(real.has_deriv_at_cos (f x)).comp x hf

lemma has_deriv_within_at.cos (hf : has_deriv_within_at f f' s x) :
  has_deriv_within_at (λ x, real.cos (f x)) (- real.sin (f x) * f') s x :=
(real.has_deriv_at_cos (f x)).comp_has_deriv_within_at x hf

lemma deriv_within_cos (hf : differentiable_within_at ℝ f s x)
  (hxs : unique_diff_within_at ℝ s x) :
  deriv_within (λx, real.cos (f x)) s x = - real.sin (f x) * (deriv_within f s x) :=
hf.has_deriv_within_at.cos.deriv_within hxs

@[simp] lemma deriv_cos (hc : differentiable_at ℝ f x) :
  deriv (λx, real.cos (f x)) x = - real.sin (f x) * (deriv f x) :=
hc.has_deriv_at.cos.deriv

/-! #### `real.sin` -/

lemma has_strict_deriv_at.sin (hf : has_strict_deriv_at f f' x) :
  has_strict_deriv_at (λ x, real.sin (f x)) (real.cos (f x) * f') x :=
(real.has_strict_deriv_at_sin (f x)).comp x hf

lemma has_deriv_at.sin (hf : has_deriv_at f f' x) :
  has_deriv_at (λ x, real.sin (f x)) (real.cos (f x) * f') x :=
(real.has_deriv_at_sin (f x)).comp x hf

lemma has_deriv_within_at.sin (hf : has_deriv_within_at f f' s x) :
  has_deriv_within_at (λ x, real.sin (f x)) (real.cos (f x) * f') s x :=
(real.has_deriv_at_sin (f x)).comp_has_deriv_within_at x hf

lemma deriv_within_sin (hf : differentiable_within_at ℝ f s x)
  (hxs : unique_diff_within_at ℝ s x) :
  deriv_within (λx, real.sin (f x)) s x = real.cos (f x) * (deriv_within f s x) :=
hf.has_deriv_within_at.sin.deriv_within hxs

@[simp] lemma deriv_sin (hc : differentiable_at ℝ f x) :
  deriv (λx, real.sin (f x)) x = real.cos (f x) * (deriv f x) :=
hc.has_deriv_at.sin.deriv

/-! #### `real.cosh` -/

lemma has_strict_deriv_at.cosh (hf : has_strict_deriv_at f f' x) :
  has_strict_deriv_at (λ x, real.cosh (f x)) (real.sinh (f x) * f') x :=
(real.has_strict_deriv_at_cosh (f x)).comp x hf

lemma has_deriv_at.cosh (hf : has_deriv_at f f' x) :
  has_deriv_at (λ x, real.cosh (f x)) (real.sinh (f x) * f') x :=
(real.has_deriv_at_cosh (f x)).comp x hf

lemma has_deriv_within_at.cosh (hf : has_deriv_within_at f f' s x) :
  has_deriv_within_at (λ x, real.cosh (f x)) (real.sinh (f x) * f') s x :=
(real.has_deriv_at_cosh (f x)).comp_has_deriv_within_at x hf

lemma deriv_within_cosh (hf : differentiable_within_at ℝ f s x)
  (hxs : unique_diff_within_at ℝ s x) :
  deriv_within (λx, real.cosh (f x)) s x = real.sinh (f x) * (deriv_within f s x) :=
hf.has_deriv_within_at.cosh.deriv_within hxs

@[simp] lemma deriv_cosh (hc : differentiable_at ℝ f x) :
  deriv (λx, real.cosh (f x)) x = real.sinh (f x) * (deriv f x) :=
hc.has_deriv_at.cosh.deriv

/-! #### `real.sinh` -/

lemma has_strict_deriv_at.sinh (hf : has_strict_deriv_at f f' x) :
  has_strict_deriv_at (λ x, real.sinh (f x)) (real.cosh (f x) * f') x :=
(real.has_strict_deriv_at_sinh (f x)).comp x hf

lemma has_deriv_at.sinh (hf : has_deriv_at f f' x) :
  has_deriv_at (λ x, real.sinh (f x)) (real.cosh (f x) * f') x :=
(real.has_deriv_at_sinh (f x)).comp x hf

lemma has_deriv_within_at.sinh (hf : has_deriv_within_at f f' s x) :
  has_deriv_within_at (λ x, real.sinh (f x)) (real.cosh (f x) * f') s x :=
(real.has_deriv_at_sinh (f x)).comp_has_deriv_within_at x hf

lemma deriv_within_sinh (hf : differentiable_within_at ℝ f s x)
  (hxs : unique_diff_within_at ℝ s x) :
  deriv_within (λx, real.sinh (f x)) s x = real.cosh (f x) * (deriv_within f s x) :=
hf.has_deriv_within_at.sinh.deriv_within hxs

@[simp] lemma deriv_sinh (hc : differentiable_at ℝ f x) :
  deriv (λx, real.sinh (f x)) x = real.cosh (f x) * (deriv f x) :=
hc.has_deriv_at.sinh.deriv

end

section

/-! ### Simp lemmas for derivatives of `λ x, real.cos (f x)` etc., `f : E → ℝ` -/

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

/-! #### `real.cos` -/

lemma has_strict_fderiv_at.cos (hf : has_strict_fderiv_at f f' x) :
  has_strict_fderiv_at (λ x, real.cos (f x)) (- real.sin (f x) • f') x :=
(real.has_strict_deriv_at_cos (f x)).comp_has_strict_fderiv_at x hf

lemma has_fderiv_at.cos (hf : has_fderiv_at f f' x) :
  has_fderiv_at (λ x, real.cos (f x)) (- real.sin (f x) • f') x :=
(real.has_deriv_at_cos (f x)).comp_has_fderiv_at x hf

lemma has_fderiv_within_at.cos (hf : has_fderiv_within_at f f' s x) :
  has_fderiv_within_at (λ x, real.cos (f x)) (- real.sin (f x) • f') s x :=
(real.has_deriv_at_cos (f x)).comp_has_fderiv_within_at x hf

lemma differentiable_within_at.cos (hf : differentiable_within_at ℝ f s x) :
  differentiable_within_at ℝ (λ x, real.cos (f x)) s x :=
hf.has_fderiv_within_at.cos.differentiable_within_at

@[simp] lemma differentiable_at.cos (hc : differentiable_at ℝ f x) :
  differentiable_at ℝ (λx, real.cos (f x)) x :=
hc.has_fderiv_at.cos.differentiable_at

lemma differentiable_on.cos (hc : differentiable_on ℝ f s) :
  differentiable_on ℝ (λx, real.cos (f x)) s :=
λx h, (hc x h).cos

@[simp] lemma differentiable.cos (hc : differentiable ℝ f) :
  differentiable ℝ (λx, real.cos (f x)) :=
λx, (hc x).cos

lemma fderiv_within_cos (hf : differentiable_within_at ℝ f s x)
  (hxs : unique_diff_within_at ℝ s x) :
  fderiv_within ℝ (λx, real.cos (f x)) s x = - real.sin (f x) • (fderiv_within ℝ f s x) :=
hf.has_fderiv_within_at.cos.fderiv_within hxs

@[simp] lemma fderiv_cos (hc : differentiable_at ℝ f x) :
  fderiv ℝ (λx, real.cos (f x)) x = - real.sin (f x) • (fderiv ℝ f x) :=
hc.has_fderiv_at.cos.fderiv

lemma times_cont_diff.cos {n} (h : times_cont_diff ℝ n f) :
  times_cont_diff ℝ n (λ x, real.cos (f x)) :=
real.times_cont_diff_cos.comp h

lemma times_cont_diff_at.cos {n} (hf : times_cont_diff_at ℝ n f x) :
  times_cont_diff_at ℝ n (λ x, real.cos (f x)) x :=
real.times_cont_diff_cos.times_cont_diff_at.comp x hf

lemma times_cont_diff_on.cos {n} (hf : times_cont_diff_on ℝ n f s) :
  times_cont_diff_on ℝ n (λ x, real.cos (f x)) s :=
real.times_cont_diff_cos.comp_times_cont_diff_on  hf

lemma times_cont_diff_within_at.cos {n} (hf : times_cont_diff_within_at ℝ n f s x) :
  times_cont_diff_within_at ℝ n (λ x, real.cos (f x)) s x :=
real.times_cont_diff_cos.times_cont_diff_at.comp_times_cont_diff_within_at x hf

/-! #### `real.sin` -/

lemma has_strict_fderiv_at.sin (hf : has_strict_fderiv_at f f' x) :
  has_strict_fderiv_at (λ x, real.sin (f x)) (real.cos (f x) • f') x :=
(real.has_strict_deriv_at_sin (f x)).comp_has_strict_fderiv_at x hf

lemma has_fderiv_at.sin (hf : has_fderiv_at f f' x) :
  has_fderiv_at (λ x, real.sin (f x)) (real.cos (f x) • f') x :=
(real.has_deriv_at_sin (f x)).comp_has_fderiv_at x hf

lemma has_fderiv_within_at.sin (hf : has_fderiv_within_at f f' s x) :
  has_fderiv_within_at (λ x, real.sin (f x)) (real.cos (f x) • f') s x :=
(real.has_deriv_at_sin (f x)).comp_has_fderiv_within_at x hf

lemma differentiable_within_at.sin (hf : differentiable_within_at ℝ f s x) :
  differentiable_within_at ℝ (λ x, real.sin (f x)) s x :=
hf.has_fderiv_within_at.sin.differentiable_within_at

@[simp] lemma differentiable_at.sin (hc : differentiable_at ℝ f x) :
  differentiable_at ℝ (λx, real.sin (f x)) x :=
hc.has_fderiv_at.sin.differentiable_at

lemma differentiable_on.sin (hc : differentiable_on ℝ f s) :
  differentiable_on ℝ (λx, real.sin (f x)) s :=
λx h, (hc x h).sin

@[simp] lemma differentiable.sin (hc : differentiable ℝ f) :
  differentiable ℝ (λx, real.sin (f x)) :=
λx, (hc x).sin

lemma fderiv_within_sin (hf : differentiable_within_at ℝ f s x)
  (hxs : unique_diff_within_at ℝ s x) :
  fderiv_within ℝ (λx, real.sin (f x)) s x = real.cos (f x) • (fderiv_within ℝ f s x) :=
hf.has_fderiv_within_at.sin.fderiv_within hxs

@[simp] lemma fderiv_sin (hc : differentiable_at ℝ f x) :
  fderiv ℝ (λx, real.sin (f x)) x = real.cos (f x) • (fderiv ℝ f x) :=
hc.has_fderiv_at.sin.fderiv

lemma times_cont_diff.sin {n} (h : times_cont_diff ℝ n f) :
  times_cont_diff ℝ n (λ x, real.sin (f x)) :=
real.times_cont_diff_sin.comp h

lemma times_cont_diff_at.sin {n} (hf : times_cont_diff_at ℝ n f x) :
  times_cont_diff_at ℝ n (λ x, real.sin (f x)) x :=
real.times_cont_diff_sin.times_cont_diff_at.comp x hf

lemma times_cont_diff_on.sin {n} (hf : times_cont_diff_on ℝ n f s) :
  times_cont_diff_on ℝ n (λ x, real.sin (f x)) s :=
real.times_cont_diff_sin.comp_times_cont_diff_on  hf

lemma times_cont_diff_within_at.sin {n} (hf : times_cont_diff_within_at ℝ n f s x) :
  times_cont_diff_within_at ℝ n (λ x, real.sin (f x)) s x :=
real.times_cont_diff_sin.times_cont_diff_at.comp_times_cont_diff_within_at x hf

/-! #### `real.cosh` -/

lemma has_strict_fderiv_at.cosh (hf : has_strict_fderiv_at f f' x) :
  has_strict_fderiv_at (λ x, real.cosh (f x)) (real.sinh (f x) • f') x :=
(real.has_strict_deriv_at_cosh (f x)).comp_has_strict_fderiv_at x hf

lemma has_fderiv_at.cosh (hf : has_fderiv_at f f' x) :
  has_fderiv_at (λ x, real.cosh (f x)) (real.sinh (f x) • f') x :=
(real.has_deriv_at_cosh (f x)).comp_has_fderiv_at x hf

lemma has_fderiv_within_at.cosh (hf : has_fderiv_within_at f f' s x) :
  has_fderiv_within_at (λ x, real.cosh (f x)) (real.sinh (f x) • f') s x :=
(real.has_deriv_at_cosh (f x)).comp_has_fderiv_within_at x hf

lemma differentiable_within_at.cosh (hf : differentiable_within_at ℝ f s x) :
  differentiable_within_at ℝ (λ x, real.cosh (f x)) s x :=
hf.has_fderiv_within_at.cosh.differentiable_within_at

@[simp] lemma differentiable_at.cosh (hc : differentiable_at ℝ f x) :
  differentiable_at ℝ (λx, real.cosh (f x)) x :=
hc.has_fderiv_at.cosh.differentiable_at

lemma differentiable_on.cosh (hc : differentiable_on ℝ f s) :
  differentiable_on ℝ (λx, real.cosh (f x)) s :=
λx h, (hc x h).cosh

@[simp] lemma differentiable.cosh (hc : differentiable ℝ f) :
  differentiable ℝ (λx, real.cosh (f x)) :=
λx, (hc x).cosh

lemma fderiv_within_cosh (hf : differentiable_within_at ℝ f s x)
  (hxs : unique_diff_within_at ℝ s x) :
  fderiv_within ℝ (λx, real.cosh (f x)) s x = real.sinh (f x) • (fderiv_within ℝ f s x) :=
hf.has_fderiv_within_at.cosh.fderiv_within hxs

@[simp] lemma fderiv_cosh (hc : differentiable_at ℝ f x) :
  fderiv ℝ (λx, real.cosh (f x)) x = real.sinh (f x) • (fderiv ℝ f x) :=
hc.has_fderiv_at.cosh.fderiv

lemma times_cont_diff.cosh {n} (h : times_cont_diff ℝ n f) :
  times_cont_diff ℝ n (λ x, real.cosh (f x)) :=
real.times_cont_diff_cosh.comp h

lemma times_cont_diff_at.cosh {n} (hf : times_cont_diff_at ℝ n f x) :
  times_cont_diff_at ℝ n (λ x, real.cosh (f x)) x :=
real.times_cont_diff_cosh.times_cont_diff_at.comp x hf

lemma times_cont_diff_on.cosh {n} (hf : times_cont_diff_on ℝ n f s) :
  times_cont_diff_on ℝ n (λ x, real.cosh (f x)) s :=
real.times_cont_diff_cosh.comp_times_cont_diff_on  hf

lemma times_cont_diff_within_at.cosh {n} (hf : times_cont_diff_within_at ℝ n f s x) :
  times_cont_diff_within_at ℝ n (λ x, real.cosh (f x)) s x :=
real.times_cont_diff_cosh.times_cont_diff_at.comp_times_cont_diff_within_at x hf

/-! #### `real.sinh` -/

lemma has_strict_fderiv_at.sinh (hf : has_strict_fderiv_at f f' x) :
  has_strict_fderiv_at (λ x, real.sinh (f x)) (real.cosh (f x) • f') x :=
(real.has_strict_deriv_at_sinh (f x)).comp_has_strict_fderiv_at x hf

lemma has_fderiv_at.sinh (hf : has_fderiv_at f f' x) :
  has_fderiv_at (λ x, real.sinh (f x)) (real.cosh (f x) • f') x :=
(real.has_deriv_at_sinh (f x)).comp_has_fderiv_at x hf

lemma has_fderiv_within_at.sinh (hf : has_fderiv_within_at f f' s x) :
  has_fderiv_within_at (λ x, real.sinh (f x)) (real.cosh (f x) • f') s x :=
(real.has_deriv_at_sinh (f x)).comp_has_fderiv_within_at x hf

lemma differentiable_within_at.sinh (hf : differentiable_within_at ℝ f s x) :
  differentiable_within_at ℝ (λ x, real.sinh (f x)) s x :=
hf.has_fderiv_within_at.sinh.differentiable_within_at

@[simp] lemma differentiable_at.sinh (hc : differentiable_at ℝ f x) :
  differentiable_at ℝ (λx, real.sinh (f x)) x :=
hc.has_fderiv_at.sinh.differentiable_at

lemma differentiable_on.sinh (hc : differentiable_on ℝ f s) :
  differentiable_on ℝ (λx, real.sinh (f x)) s :=
λx h, (hc x h).sinh

@[simp] lemma differentiable.sinh (hc : differentiable ℝ f) :
  differentiable ℝ (λx, real.sinh (f x)) :=
λx, (hc x).sinh

lemma fderiv_within_sinh (hf : differentiable_within_at ℝ f s x)
  (hxs : unique_diff_within_at ℝ s x) :
  fderiv_within ℝ (λx, real.sinh (f x)) s x = real.cosh (f x) • (fderiv_within ℝ f s x) :=
hf.has_fderiv_within_at.sinh.fderiv_within hxs

@[simp] lemma fderiv_sinh (hc : differentiable_at ℝ f x) :
  fderiv ℝ (λx, real.sinh (f x)) x = real.cosh (f x) • (fderiv ℝ f x) :=
hc.has_fderiv_at.sinh.fderiv

lemma times_cont_diff.sinh {n} (h : times_cont_diff ℝ n f) :
  times_cont_diff ℝ n (λ x, real.sinh (f x)) :=
real.times_cont_diff_sinh.comp h

lemma times_cont_diff_at.sinh {n} (hf : times_cont_diff_at ℝ n f x) :
  times_cont_diff_at ℝ n (λ x, real.sinh (f x)) x :=
real.times_cont_diff_sinh.times_cont_diff_at.comp x hf

lemma times_cont_diff_on.sinh {n} (hf : times_cont_diff_on ℝ n f s) :
  times_cont_diff_on ℝ n (λ x, real.sinh (f x)) s :=
real.times_cont_diff_sinh.comp_times_cont_diff_on  hf

lemma times_cont_diff_within_at.sinh {n} (hf : times_cont_diff_within_at ℝ n f s x) :
  times_cont_diff_within_at ℝ n (λ x, real.sinh (f x)) s x :=
real.times_cont_diff_sinh.times_cont_diff_at.comp_times_cont_diff_within_at x hf

end


import data.list
import data.nat.prime
import tactic
import tactic.gptf

lemma sieve_aux_wf (pred: ℕ -> Prop) [decidable_pred pred] (xs: list ℕ) :
  (xs.filter pred).length < xs.length + 1 :=
  by simp only [nat.lt_succ_of_le, list.length_le_of_sublist, list.filter_sublist]

def sieve_aux : list ℕ -> list ℕ
| [] := []
| (x :: xs) :=
  have (xs.filter $ λ n, ¬(x ∣ n)).length < xs.length + 1,
    from sieve_aux_wf _ _,
  x :: sieve_aux (xs.filter $ λ n, ¬(x ∣ n))
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf list.length⟩]}

def sieve (m: ℕ) : list ℕ := sieve_aux $ (list.range m).drop 2

lemma sieve_aux_sublist (l: list ℕ) :
  sieve_aux l <+ l :=
begin
  apply well_founded.induction (measure_wf list.length) l,
  intros x h₁,

  cases x,
  simp only [sieve_aux],

  simp only [sieve_aux],
  apply list.sublist.cons2,

  simp only [measure, inv_image, list.length] at h₁,
  generalize h₂ : list.filter (λ (n : ℕ), ¬x_hd ∣ n) x_tl = li',

  have h₃ : li' <+ x_tl := by simp only [←h₂, list.filter_sublist],
  have h₄ := h₁ li' (nat.lt_succ_iff.mpr (list.length_le_of_sublist h₃)),
  exact list.sublist.trans h₄ h₃,
end

lemma sieve_aux_mem {n: ℕ} {l: list ℕ} :
  n ∈ sieve_aux l -> n ∈ l :=
  by solve_by_elim [sieve_aux_sublist, list.sublist.subset]

theorem sieve_keeps_primes₁ (n: ℕ) (li: list ℕ):
  nat.prime n -> 1 ∉ li -> n ∈ li -> n ∈ (sieve_aux li) :=
begin
  intro h₁,
  apply well_founded.induction (measure_wf list.length) li,
  intro x,

  cases x,
  simp only [list.not_mem_nil, forall_prop_of_false, not_false_iff, forall_true_iff],

  replace h₁ := h₁.right x_hd,
  by_cases n = x_hd,
  finish [sieve_aux],

  intros h₂ h₃ h₄,
  right,

  apply h₂,
  all_goals { clear li h₂ },

  simp only [measure, inv_image, list.length, sieve_aux_wf],
  finish [list.mem_filter],
  finish [list.mem_filter],
end

lemma nth_le_drop_range (m n i: ℕ) (h: i < n):
  (list.drop m (list.range (m + n))).nth_le i (by simpa) = m + i :=
begin
  rw ← list.nth_le_drop (list.range (m + n)),
  rw list.nth_le_range,
  simpa only [list.length_range, add_lt_add_iff_left],
end

lemma range_drop_mem₁ (m n k: ℕ) :
  (k < n) -> k ∉ (list.range m).drop n :=
begin
  intro h₁,
  by_cases n ≤ m,

  cases nat.le.dest h with m' h₂,
  rw [←h₂] at *,
  clear h₂ m h,

  simp only [list.mem_iff_nth_le, not_exists, add_lt_add_iff_left],
  intros i h₂,
  rw nth_le_drop_range,
  linarith,
  simp only [*, list.length_drop, nat.add_sub_cancel_left, list.length_range] at *,

  set li := (list.range m).drop n with h₂,
  have h₃: li.length = 0 :=
    by simp only [list.length_drop, list.length_range, le_of_not_ge h, nat.sub_eq_zero_of_le],

  simp only [list.length_eq_zero.mp h₃, list.not_mem_nil, not_false_iff],
end

lemma range_drop_mem₂ (m n k: ℕ) :
  (k ≥ n) -> (k < m) -> k ∈ (list.range m).drop n :=
begin
  intros h₁ h₂,

  have h₄ : n ≤ m := by linarith,
  cases nat.le.dest h₁ with k' h₃,
  cases nat.le.dest h₄ with m' h₅,
  simp only [←h₃, ←h₅, add_lt_add_iff_left] at *,
  clear h₁ h₃ h₄ h₅ m k,

  simp only [list.mem_iff_nth_le],
  use k',

  fconstructor,
  simp only [*, list.length_drop, nat.add_sub_cancel_left, list.length_range],

  rwa [nth_le_drop_range],
end

lemma range_drop_mem₃ (m n k: ℕ) :
  (k ≥ m) -> k ∉ (list.range m).drop n :=
begin
  intros h₁ h₂,
  have h₃ : k ∉ list.range m := by finish,
  have h₄ : k ∈ list.range m := list.mem_of_mem_drop h₂,
  contradiction,
end

theorem sieve_keeps_primes₂ (m n: ℕ) :
  n < m -> nat.prime n -> n ∈ sieve m :=
begin
  intros h₁ h₂,
  refine sieve_keeps_primes₁ _ _ h₂ _ _,
  simp only [range_drop_mem₁, nat.one_lt_bit0_iff, not_false_iff],
  finish [nat.prime, range_drop_mem₂],
end

lemma sieve_filters₁ (n k: ℕ) (li: list ℕ) :
  (n ≠ k) -> (n ∣ k) -> k ∉ sieve_aux (n :: li) :=
begin
  intros h₁ h₂ h₃,
  safe [sieve_aux],
  replace h₃ := sieve_aux_mem h₃,
  finish,
end

lemma sieve_sublist₁ (x: ℕ) (li: list ℕ) :
  sieve_aux (li ++ [x]) <+ sieve_aux li ++ [x] :=
begin
  apply well_founded.induction (measure_wf list.length) li,
  clear li,

  intros li h₁,

  cases li,
  simp only [sieve_aux, list.filter_nil, list.nil_append],

  simp only [sieve_aux, list.filter_append, list.cons_append],
  apply list.sublist.cons2,

  by_cases li_hd ∣ x,

  have h₂ : list.filter (λ (n : ℕ), ¬li_hd ∣ n) [x] = list.nil := by finish,
  rw h₂,
  simp only [list.sublist_append_left, list.append_nil],

  have h₂ : list.filter (λ (n : ℕ), ¬li_hd ∣ n) [x] = [x] := by finish,
  rw h₂,
  apply h₁,

  simp only [measure, inv_image, list.length, sieve_aux_wf],
end

lemma sieve_filters₂ (n k: ℕ) (li: list ℕ) :
  (nat.prime n) -> (n ≠ k) -> (n ∣ k) ->
  (1 ∉ li) -> (k ∉ li) -> (n ∈ li) -> (k ∉ sieve_aux (li ++ [k])) :=
begin
  intros h₀ h₁ h₂,
  apply well_founded.induction (measure_wf list.length) li,
  intros li' h₆ h₃ h₄ h₅,
  clear li,

  cases li',
  solve_by_elim,

  simp only [list.cons_append, sieve_aux, list.filter_append, list.mem_cons_iff, ne.def] at *,
  push_neg,
  split,
  tauto,

  by_cases li'_hd ∣ k,

  clear h₆,
  simp only [*, list.filter_cons_of_neg, list.filter_nil,
    list.append_nil, not_true, not_false_iff] at *,
  intro h₆,
  replace h₆ := sieve_aux_mem h₆,
  simp only [*, list.mem_filter, not_true] at *,

  simp only [*, list.filter_nil, not_false_iff, list.filter_cons_of_pos] at *,
  apply h₆,
  all_goals { clear h₆ },

  simp only [*, measure, inv_image, list.length, sieve_aux_wf],

  simp only [*, and_true, list.mem_filter, not_false_iff],
  tauto,

  simp only [*, list.mem_filter, and_true, not_false_iff],
  tauto,

  finish [list.mem_filter, nat.prime],
end

lemma range_drop_append (n k: ℕ):
  (k ≤ n) -> list.drop k (list.range (n + 1)) = list.drop k (list.range n) ++ [n] :=
begin
  intro h₁,
  cases nat.le.dest h₁ with n' h₂,
  rw [←h₂] at *,
  clear h₂ h₁ n,

  apply list.ext_le,
  simp only [list.length_append, list.length_drop, nat.add_sub_cancel_left,
    list.length_singleton, list.length_range],
  omega,

  intros i h₂ h₃,
  set li₂ := list.drop k (list.range (k + n')) ++ [k + n'],
  ring,
  rw nth_le_drop_range,

  by_cases i = n',

  have h₄ : i = li₂.length - 1,
  simpa only [nat.add_succ_sub_one, add_zero, list.length_append, list.length_drop,
    nat.add_sub_cancel_left, list.length_singleton, list.length_range],

  simp only [h₄],
  rw ←list.last_eq_nth_le,
  simp only [nat.add_succ_sub_one, add_zero, list.length_append, list.length_drop,
    nat.add_sub_cancel_left, list.length_singleton, list.length_range, list.last_append],
  simp only [list.append_eq_nil, ne.def, not_false_iff, and_false],

  have h₄ : i < li₂.length - 1,
  simp only [*, nat.add_succ_sub_one, add_zero, list.length_append, list.length_drop,
    nat.add_sub_cancel_left, list.length_singleton, list.length_range] at *,
  omega,

  rw [list.nth_le_append, nth_le_drop_range],

  finish,
  finish,
end

lemma sieve_filters₃ (n: ℕ) :
  ¬nat.prime n -> n ∉ sieve (n + 1) :=
begin
  intro h₁,
  rw sieve,

  cases n,
  exact dec_trivial,
  cases n,
  exact dec_trivial,

  rw nat.not_prime_iff_min_fac_lt at h₁,
  swap,
  exact dec_trivial,

  rw range_drop_append,
  swap,
  exact dec_trivial,

  set n' := n.succ.succ,
  set k := n'.min_fac,
  have h₂ := nat.min_fac_prime (dec_trivial : n' ≠ 1),
  refine sieve_filters₂ k n' _ _ _ _ _ _ _,

  exact h₂,
  linarith,
  exact nat.min_fac_dvd n',

  apply range_drop_mem₁,
  exact dec_trivial,

  apply range_drop_mem₃,
  simp only [ge_iff_le],

  apply range_drop_mem₂,
  exact h₂.left,
  exact h₁,
end

lemma sieve_filters_nonprimes (m n: ℕ) :
  n < m -> ¬nat.prime n -> n ∉ sieve m :=
begin
  intros h₁ h₂,

  induction m,
  exact dec_trivial,

  by_cases n = m_n,
  rw ←h,
  apply sieve_filters₃,
  exact h₂,

  have h₃ : n < m_n := by omega,
  specialize m_ih h₃,
  clear h h₁,

  by_cases 2 ≤ m_n,
  swap,

  cases m_n,
  exact dec_trivial,
  cases m_n,
  exact dec_trivial,
  simp only [nat.succ_eq_add_one, not_le] at *,
  linarith,

  rw [sieve, nat.succ_eq_add_one, range_drop_append],
  swap,
  exact h,

  intro h₁,
  have h₃ := sieve_sublist₁ m_n (list.drop 2 (list.range m_n)),
  rw [sieve] at m_ih,
  replace h₃ := (list.sublist.subset h₃) h₁,

  finish,
end

theorem prime_sieve (m n: ℕ) :
  n < m -> (nat.prime n ↔ n ∈ (sieve m)) :=
begin
  intro h₁,
  split,
  exact sieve_keeps_primes₂ _ _ h₁,

  intro h₂,
  have h₃ := sieve_filters_nonprimes _ _ h₁,
  cc,
end


/-
Copyright (c) 2022 Michael Stoll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Stoll

! This file was ported from Lean 3 source module data.fin.tuple.bubble_sort_induction
! leanprover-community/mathlib commit 4c19a16e4b705bf135cf9a80ac18fcc99c438514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Fin.Tuple.Sort
import Mathlib.Data.Fintype.Perm
import Mathlib.Order.WellFounded

/-!
# "Bubble sort" induction

We implement the following induction principle `Tuple.bubble_sort_induction`
on tuples with values in a linear order `α`.

Let `f : Fin n → α` and let `P` be a predicate on `Fin n → α`. Then we can show that
`f ∘ sort f` satisfies `P` if `f` satisfies `P`, and whenever some `g : Fin n → α`
satisfies `P` and `g i > g j` for some `i < j`, then `g ∘ swap i j` also satisfies `P`.

We deduce it from a stronger variant `Tuple.bubble_sort_induction'`, which
requires the assumption only for `g` that are permutations of `f`.

The latter is proved by well-founded induction via `WellFounded.induction_bot'`
with respect to the lexicographic ordering on the finite set of all permutations of `f`.
-/

namespace Tuple

/-- *Bubble sort induction*: Prove that the sorted version of `f` has some property `P`
if `f` satsifies `P` and `P` is preserved on permutations of `f` when swapping two
antitone values. -/
theorem bubble_sort_induction' {n : ℕ} {α : Type _} [LinearOrder α] {f : Fin n → α}
    {P : (Fin n → α) → Prop} (hf : P f)
    (h :
      ∀ (σ : Equiv.Perm (Fin n)) (i j : Fin n),
        i < j → (f ∘ σ) j < (f ∘ σ) i → P (f ∘ σ) → P (f ∘ σ ∘ Equiv.swap i j)) :
    P (f ∘ sort f) := by
  letI := @Preorder.lift _ (Lex (Fin n → α)) _ fun σ : Equiv.Perm (Fin n) => toLex (f ∘ σ)
  refine'
    @WellFounded.induction_bot' _ _ _ (@Finite.Preorder.wellFounded_lt (Equiv.Perm (Fin n)) _ _)
      (Equiv.refl _) (sort f) P (fun σ => f ∘ σ) (fun σ hσ hfσ => _) hf
  obtain ⟨i, j, hij₁, hij₂⟩ := antitone_pair_of_not_sorted' hσ
  exact ⟨σ * Equiv.swap i j, Pi.lex_desc hij₁ hij₂, h σ i j hij₁ hij₂ hfσ⟩
#align tuple.bubble_sort_induction' Tuple.bubble_sort_induction'

/-- *Bubble sort induction*: Prove that the sorted version of `f` has some property `P`
if `f` satsifies `P` and `P` is preserved when swapping two antitone values. -/
theorem bubble_sort_induction {n : ℕ} {α : Type _} [LinearOrder α] {f : Fin n → α}
    {P : (Fin n → α) → Prop} (hf : P f)
    (h : ∀ (g : Fin n → α) (i j : Fin n), i < j → g j < g i → P g → P (g ∘ Equiv.swap i j)) :
    P (f ∘ sort f) :=
  bubble_sort_induction' hf fun _ => h _
#align tuple.bubble_sort_induction Tuple.bubble_sort_induction

end Tuple


namespace hidden
universe u

-------------------------------------------------------------------------------
inductive list (A:Type) : Type
| Nil {} : list -- Brez {} moramo konstruktorju Nil vedno podati tip A
| Cons : A -> list -> list -- Cons tip A ugotovi iz tipa prvega elementa

namespace list
-- Dopolnite definicije in dokažitve trditve za sezname iz vaj 3. Uporabljate -- lahko notacijo x :: xs, [] in ++ (namesto @), vendar bodite pozorni na
-- oklepaje.

notation x `::` xs := Cons x xs
notation `[]` := Nil

def join {A} : list A -> list A -> list A
| [] ys := ys
| (x :: xs) ys := x :: (join xs ys)

notation xs `++` ys := join xs ys

theorem join_nil {A} (xs: list A) :
  xs ++ [] = xs
:=
begin
  induction xs,
  { unfold join, },
  unfold join, rewrite xs_ih,
end

def reverse {A} : list A -> list A
| [] := []
| (x::xs) := (reverse xs) ++ (x::[])

theorem join_assoc {A} (xs ys zs : list A) :
  xs ++ (ys ++ zs) = (xs ++ ys) ++ zs
:=
begin
  induction xs,
  unfold join,
  unfold join, rewrite xs_ih,
end

theorem reverse_join {A} (xs ys : list A):
  reverse (xs ++ ys) = (reverse ys) ++ (reverse xs)
:=
begin
  induction xs,
  { unfold join, unfold reverse, rewrite join_nil, },
  unfold join, unfold reverse, rewrite xs_ih,
  rewrite join_assoc,
end

end list
-------------------------------------------------------------------------------

-- Podobno kot za sezname, napišite tip za drevesa in dokažite trditve iz
-- vaj 3. Če po definiciji tipa `tree` odprete `namespace tree` lahko
-- uporabljate konstruktorje brez predpone, torej `Empty` namesto
-- `tree.Empty`.

inductive tree (A:Type) : Type
| Empty {} : tree
| Node : tree -> A -> tree -> tree

namespace tree

def mirror {A} : tree A -> tree A
| Empty := Empty
| (Node lt x rt) := Node (mirror rt) x (mirror lt)
theorem mirror_mirror {A} (t : tree A) :
  mirror (mirror t) = t
:=
begin
induction t,
{ unfold mirror, },
unfold mirror, rewrite [t_ih_a, t_ih_a_1],
end

def tree_map {A B : Type} (f : A -> B) : tree A -> tree B
| Empty := Empty
| (Node lt x rt) := Node (tree_map lt) (f x) (tree_map rt)

theorem mirror_map_comm {A B} (t : tree A) (f : A -> B) :
  tree_map f (mirror t) = mirror (tree_map f t)
:=
begin
  induction t,
  { unfold mirror, unfold tree_map, unfold mirror, },
  unfold mirror, unfold tree_map,
  rewrite [t_ih_a, t_ih_a_1],
  unfold mirror,
end

end tree

end hidden


/-
Copyright (c) 2021 Scott Morrison All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import linear_algebra.quotient
import algebra.category.Module.basic

/-!
# Monomorphisms in `Module R`

This file shows that an `R`-linear map is a monomorphism in the category of `R`-modules
if and only if it is injective, and similarly an epimorphism if and only if it is surjective.
-/

universes v u

open category_theory
open Module
open_locale Module

namespace Module

variables {R : Type u} [ring R] {X Y : Module.{v} R} (f : X ⟶ Y)
variables {M : Type v} [add_comm_group M] [module R M]

lemma ker_eq_bot_of_mono [mono f] : f.ker = ⊥ :=
linear_map.ker_eq_bot_of_cancel $ λ u v, (@cancel_mono _ _ _ _ _ f _ ↟u ↟v).1

lemma range_eq_top_of_epi [epi f] : f.range = ⊤ :=
linear_map.range_eq_top_of_cancel $ λ u v, (@cancel_epi _ _ _ _ _ f _ ↟u ↟v).1

lemma mono_iff_ker_eq_bot : mono f ↔ f.ker = ⊥ :=
⟨λ hf, by exactI ker_eq_bot_of_mono _,
 λ hf, concrete_category.mono_of_injective _ $ linear_map.ker_eq_bot.1 hf⟩

lemma mono_iff_injective : mono f ↔ function.injective f :=
by rw [mono_iff_ker_eq_bot, linear_map.ker_eq_bot]

lemma epi_iff_range_eq_top : epi f ↔ f.range = ⊤ :=
⟨λ hf, by exactI range_eq_top_of_epi _,
 λ hf, concrete_category.epi_of_surjective _ $ linear_map.range_eq_top.1 hf⟩

lemma epi_iff_surjective : epi f ↔ function.surjective f :=
by rw [epi_iff_range_eq_top, linear_map.range_eq_top]

/-- If the zero morphism is an epi then the codomain is trivial. -/
def unique_of_epi_zero (X) [h : epi (0 : X ⟶ of R M)] : unique M :=
unique_of_surjective_zero X ((Module.epi_iff_surjective _).mp h)

instance mono_as_hom'_subtype (U : submodule R X) : mono ↾U.subtype :=
(mono_iff_ker_eq_bot _).mpr (submodule.ker_subtype U)

instance epi_as_hom''_mkq (U : submodule R X) : epi ↿U.mkq :=
(epi_iff_range_eq_top _).mpr $ submodule.range_mkq _

instance forget_preserves_epimorphisms : (forget (Module.{v} R)).preserves_epimorphisms :=
{ preserves := λ X Y f hf, by rwa [forget_map_eq_coe, category_theory.epi_iff_surjective,
    ← epi_iff_surjective] }

instance forget_preserves_monomorphisms : (forget (Module.{v} R)).preserves_monomorphisms :=
{ preserves := λ X Y f hf, by rwa [forget_map_eq_coe, category_theory.mono_iff_injective,
    ← mono_iff_injective] }

end Module


import tactic.finish

-- EXAMPLE 1: transfering ordering <= from nat to custom nat (bijection)
-- this example is based on the one in the article by Zimmermann and Herbelin, 2015
namespace example1

-- a custom type N that is the natural numbers, with an ordering like <=
def N : Type := sorry
def ordern : N → N → Prop := sorry

-- functions mapping N to nat and back
def nto : N → nat := sorry
def nof : nat → N := sorry

-- axioms needed for transfer:
-- the nto and nof are inverses
axiom ax1 : ∀ n : nat, nto(nof(n)) = n
axiom ax2 : ∀ x : N, nof(nto(x)) = x
-- ordering is preserved by the mapping
axiom ax3 : ∀ x y : N, ordern x y → nto x <= nto y
axiom ax4 : ∀ m n : nat, m <= n → ordern (nof m) (nof n)

--suppose we have proven transitivity for <= in nat, and want to now prove it in N without doing the proof again
theorem transitiveorder_nat : ∀ x y z : nat, x <= y → y <= z → x <= z := sorry

theorem transitiveorder_N : ∀ x y z : N, ordern x y → ordern y z → ordern x z :=
begin
  intros,
  rw← ax2 x,
  rw← ax2 z,
  apply ax4,
  apply transitiveorder_nat _ (nto y) _;
  finish using [ax3]
end

--we could also prove it the other way, the proof is symmetric: using ax1 instead of ax2 and swapping ax3 and ax4
theorem transitiveorder_nat' : ∀ x y z : nat, x <= y → y <= z → x <= z :=
begin
  intros,
  rw← ax1 x,
  rw← ax1 z,
  apply ax3,
  apply transitiveorder_N _ (nof y) _;
  finish using [ax4]
end

end example1

-- EXAMPLE 2: transfer the theorem that odd+odd=even from z to z mod 2 and back.
namespace example2

definition even (n : int) : Prop := n % 2 = 0

-- a custom type Z/2Z, with operation add and predicate even
inductive Z2 : Type
| zero : Z2
| one : Z2

open Z2

def Z2.add : Z2 → Z2 → Z2
| zero y := y
| one zero := one
| one one := zero

inductive Z2.even : Z2 → Prop
| zeroiseven : Z2.even zero

-- mapping from int to Z2 (no inverse mapping)
def ztoz2 : int → Z2 := λ n, if n % 2 = 0 then zero else one

-- axioms needed for transfer:
-- mapping is surjective
axiom surjectivemap : function.surjective ztoz2
-- mapping respects add and even (there must be transfer axioms for every operation and predicate in the theorem)
axiom transfer_add : ∀ m n : int, (ztoz2 m).add (ztoz2 n) = ztoz2(m + n)
axiom eventoz2 : ∀ n : int, even n → Z2.even (ztoz2 n)
axiom evenfromz2 : ∀ n : int, Z2.even (ztoz2 n) → even n  -- specific wording of the axioms makes the proof go nicely

-- theorem about adding two odd integers, now we want the same result in Z2
theorem thetheoremforint : ∀ m n : int, ¬ even m → ¬ even n → even (m + n) := sorry

theorem thetheoremforZ2 : ∀ x y : Z2, ¬ Z2.even x → ¬ Z2.even y → Z2.even (Z2.add x y) :=
begin
  intros,
  rw [← classical.some_spec (surjectivemap x)] at *,
  rw [← classical.some_spec (surjectivemap y)] at *,
  rw transfer_add,
  apply eventoz2,
  apply thetheoremforint;
  finish using [eventoz2]
end

-- the other direction can also be shown
theorem thetheoremforint' : ∀ x y : int, ¬ even x → ¬ even y → even (x + y) :=
begin
  intros,
  apply evenfromz2,
  rw← transfer_add,
  apply thetheoremforZ2;
  finish using [evenfromz2]
end

end example2

-- EXAMPLE 3: even theorem but with injection natural numbers to integers
namespace example3

definition even (n : nat) : Prop := n % 2 = 0
definition evenint (x : int) : Prop := x % 2 = 0

-- mapping between nat and int
def ntoi : nat → int := int.of_nat --in all example cases the implementations are optional and not necessary for the proofs (nice to have for computation later?)
def nofi : int → nat := int.nat_abs

-- axioms needed for transfer:
axiom inverse1way : ∀ n : nat, nofi(ntoi n) = n
-- respect add
axiom transfer_add : ∀ x y : int, nofi x + nofi y = nofi (x + y)
-- respect even
axiom eventoint: ∀ x : int, even (nofi x) → evenint x
axiom evenfromint : ∀ x : int, evenint x → even (nofi x)

theorem thetheoremfornat : ∀ m n : nat, ¬ even m → ¬ even n → even (m + n) := sorry

theorem thetheoremforint : ∀ x y : int, ¬ evenint x → ¬ evenint y → evenint (x + y) :=
begin
  intros,
  apply eventoint,
  rw← transfer_add,
  apply thetheoremfornat;
  finish using [eventoint]
end

theorem thetheoremfornat' : ∀ m n : nat, ¬ even m → ¬ even n → even (m + n) :=
begin
  intros,
  rw← inverse1way m at *,
  rw← inverse1way n at *,
  rw transfer_add,
  apply evenfromint,
  apply thetheoremforint;
  finish using [evenfromint]
end

end example3

-- EXAMPLE 4: the ordering theorem but with int and nat
namespace example4

-- mapping between nat and int
def ntoi : nat → int := int.of_nat
def nofi : int → nat := int.nat_abs

-- axioms needed for transfer:
-- 1 direction is invertible
axiom inverse1way : ∀ n : nat, nofi(ntoi n) = n

-- ordering is not really preserved by the mapping, which poses a problem
-- ∀ x y : int, x <= y → nofi x <= nofi y     does not hold
-- ∀ x y : int, nofi x <= nofi y → x <= y     does not hold
-- axiom order_ntoi : ∀ m n : nat, m <= n → ntoi m <= ntoi n      not useful
axiom order_nofi : ∀ x y : int, x <= y → nofi x <= nofi y ∨ nofi y <= nofi x    -- doesn't go anywhere

-- transfer approach does not seem to work for this problem
-- idea: smaller axioms ie x<=y and x>0 → nofi x <= nofi y
--                         x<=y and x<0 and y>0 → either is larger
--                         x<=y and x<0 and y<0 → nofi x >= nofi y
--   and split on cases <0 >0
-- doesn't seem too useful either

theorem transitiveorder_nat : ∀ a b c : nat, a <= b → b <= c → a <= c := sorry

theorem transitiveorder_int : ∀ x y z : int, x <= y → y <= z → x <= z :=
begin
  intros,
  have hnxy : nofi x <= nofi y ∨ nofi y <= nofi x := by apply order_nofi _ _ a,
  have hnyz : nofi y <= nofi z ∨ nofi z <= nofi y := by apply order_nofi _ _ a_1,
  cases hnxy; cases hnyz,

  have hnxz : nofi x <= nofi z := begin apply transitiveorder_nat _ _ _ hnxy hnyz end,
  repeat {sorry},
end

theorem transitiveorder_nat' : ∀ a b c : nat, a <= b → b <= c → a <= c :=
begin
  intros,
  rw← inverse1way a at *,
  rw← inverse1way b at *,
  rw← inverse1way c at *,
  sorry
end

end example4