/-
Copyright (c) 2015, 2017 Ender Doe. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ender Doe, Kevin Buzzard
-/

import data.real.irrational

local notation `|` x `|` := abs x
open_locale classical

/--
  The thomae's function on reals also known as the "Popcorn" function.
-/
noncomputable def thomaes_function (r : ℝ) : ℝ :=
if h : ∃ (q : ℚ), (q : ℝ) = r then (classical.some h).denom⁻¹ else 0

theorem thomaes_at_irrational_eq_zero {x : ℝ} (h: irrational x) :
  thomaes_function x = 0 :=
dif_neg $ h

/-- The thomae function, restricted to the rationals and taking values in the rationals. -/
def thomae_rat (q : ℚ) : ℚ := q.denom⁻¹

@[norm_cast]
lemma coe_thomae_rat (q : ℚ) : thomaes_function q = thomae_rat q :=
begin
  unfold thomaes_function,
  rw dif_pos (⟨q, rfl⟩ : ∃ (q_1 : ℚ), (q_1 : ℝ) = ↑q),
  { generalize_proofs h,
    unfold thomae_rat,
    norm_num,
    congr',
    exact_mod_cast classical.some_spec h },
end

@[norm_cast] lemma coe_thomae_rat' (q : ℚ) : (thomae_rat q : ℝ) = thomaes_function q :=
(coe_thomae_rat q).symm

@[simp]
lemma thomae_rat_num (q : ℚ) : (thomae_rat q).num = 1 :=
  by simp [thomae_rat, rat.inv_coe_nat_num q.pos ]

@[simp]
lemma thomae_rat_denom (q : ℚ) : (thomae_rat q).denom = q.denom :=
  by simp [thomae_rat, rat.inv_coe_nat_denom q.pos]

theorem thomae_rat_pos (q : ℚ) : 0 < (thomae_rat q) := begin
  apply rat.num_pos_iff_pos.mp,
  rw thomae_rat_num,
  exact zero_lt_one,
end

-- add to rat library?
theorem rat.add_int_denom (z: ℤ) (q : ℚ) : (q + z).denom = q.denom :=
begin
  rw rat.add_num_denom,
  simp,
  rw rat.mk_eq_div,
  -- I copied this trick from above
  suffices :(((((q.num + ↑(q.denom) * z) : ℤ) : ℚ) / ((q.denom) : ℤ)).denom : ℤ) = q.denom,
    exact_mod_cast this,
  apply rat.denom_div_eq_of_coprime,
  exact_mod_cast q.pos,
  exact int.coprime_iff_nat_coprime.mp
    (is_coprime.add_mul_left_left
      (int.coprime_iff_nat_coprime.mpr (by exact_mod_cast q.cop)) _),
end

@[simp]
theorem thomaes_is_perodic (n : ℤ) (x  : ℝ) : thomaes_function (x + n) = thomaes_function x  :=
begin
  by_cases (irrational x),
  rw [
    thomaes_at_irrational_eq_zero (by exact_mod_cast irrational.add_rat n h),
    thomaes_at_irrational_eq_zero h
  ],
  unfold irrational at h,
  push_neg at h,
  cases h with q q_eq_x,
  subst q_eq_x,
  norm_cast,
  apply rat.eq_iff_mul_eq_mul.mpr,
  simp [thomae_rat_num, thomae_rat_denom],
  symmetry,
  exact rat.add_int_denom _ _,
end

theorem irrational_ne_rat {x: ℝ} (q : ℚ) (h: irrational x) : x ≠ q :=
λ h2, h ⟨q, h2.symm⟩

lemma δᵢ_pos {x : ℝ} (i : ℕ) (h : irrational x)
: 0 < min (|x - ⌊x * i⌋ / (i :ℝ)|)  (|x - (⌊x * i⌋ + 1) / (i :ℝ)|) :=
begin
  simp only [abs_pos, gt_iff_lt, lt_min_iff],
  split,
  { suffices : x ≠ ((⌊x * ↑i⌋ / i) : ℚ),
    exact_mod_cast sub_ne_zero.mpr this,
    exact irrational_ne_rat _ h },
  { suffices : x ≠ (((⌊x * ↑i⌋ + 1) / i) : ℚ),
    exact_mod_cast sub_ne_zero.mpr this,
    exact irrational_ne_rat _ h },
end

lemma floor_lt_irrational (x : ℝ) (h : irrational x) : ↑⌊x⌋ < x :=
begin
  cases lt_or_eq_of_le (floor_le x) with h2 h2,
  { exact h2 },
  exact false.elim (irrational_ne_rat (⌊ x ⌋) h (by exact_mod_cast h2.symm)),
end

lemma irrational.floor_mul_div_lt
{x : ℝ} (h: irrational x) {i: ℕ} (hi : 0 < i) :
((⌊x * i⌋ / i) : ℝ) < x :=
begin
  rw div_lt_iff (show 0 < (i : ℝ), by assumption_mod_cast),
  apply floor_lt_irrational,
  convert irrational.mul_rat h (show (i : ℚ) ≠ 0, by exact_mod_cast (ne_of_lt hi).symm) using 2,
  norm_cast,
end

lemma irrational.floor_mul_add_one_div_lt
{i: ℕ} (x : ℝ) (hi : 0 < i) :
x < ((⌊x * i⌋ + 1) : ℝ) / (i : ℝ)
:=
begin
  rw lt_div_iff (show 0 < (i : ℝ), by assumption_mod_cast),
  exact lt_floor_add_one _,
end

theorem δᵢ_between {x: ℝ} {r : ℝ}  {i : ℕ}
(hx0 : irrational x) (hn0 : 0 < i)
(h : |r - x| < min (|x - ⌊x * i⌋ / (i :ℝ)|)  (|x - (⌊x * i⌋ + 1) / (i :ℝ)|)) :
(⌊x * i⌋ / i : ℝ) < r ∧ r < ((⌊x * i⌋ + 1) / i : ℝ)
:=
begin
  simp only [lt_min_iff] at h,
  rw abs_of_pos (sub_pos_of_lt (irrational.floor_mul_div_lt hx0 hn0)) at h,
  rw abs_of_neg (sub_neg_of_lt (irrational.floor_mul_add_one_div_lt x hn0)) at h,
  split,
  linarith [(abs_lt.mp h.left).left],
  linarith [(abs_lt.mp h.right).right],
end

theorem no_rat_between  (n : ℤ) (q : ℚ) (l: (n / q.denom : ℚ) < q) (r: q < ((n + 1) / q.denom : ℚ))
: false :=
begin
  nth_rewrite 1 ←rat.num_div_denom q at l,
  nth_rewrite 0 ←rat.num_div_denom q at r,
  have h : (0 : ℚ) < q.denom := by exact_mod_cast q.pos,
  have l' := (mul_lt_mul_right h).mp ((div_lt_div_iff h h).mp l),
  norm_cast at l',
  have r' := (mul_lt_mul_right h).mp ((div_lt_div_iff h h).mp r),
  norm_cast at r',
  linarith,
end

theorem thomaes_continous_at_irrational {x} (h : irrational x)
: continuous_at thomaes_function x :=
begin
  apply metric.continuous_at_iff.mpr,
  simp_rw [real.dist_eq, thomaes_at_irrational_eq_zero h, sub_zero],
  intros ε ε_pos,

  obtain ⟨r, hr⟩ := exists_nat_one_div_lt ε_pos,
  have r_add_one_pos : 0 < r + 1 := nat.succ_pos r,
  rw one_div at hr,

  let δᵢ : ℝ → ℕ → ℝ  := λ x i, min
    (|x - ⌊x * i⌋ / (i :ℝ)|)
    (|x - (⌊x * i⌋ + 1) / (i :ℝ)|),

  obtain ⟨i_min, ⟨i_pos, i_le_r⟩, i_min_indice⟩ :=
    set.exists_min_image _
    (δᵢ x)
    -- δ indices are finite and nonempty
    (set.Ioc_ℕ_finite 0 _)
    (⟨1, zero_lt_one, nat.one_le_of_lt r_add_one_pos⟩),

  refine ⟨δᵢ x i_min, δᵢ_pos i_min h, λ x₁ hδ, _⟩,

  by_cases H : ∃ q : ℚ, (q : ℝ) = x₁,
  { obtain ⟨q, rfl⟩ := H,
    norm_cast,
    rw abs_of_pos (thomae_rat_pos q),

    have r_add_one_le_q_denom : (r + 1) ≤ q.denom,
    { by_contradiction H,
      push_neg at H,
      have lt_delta_of_q := lt_of_lt_of_le hδ (i_min_indice q.denom ⟨q.pos, le_of_lt H⟩),
      obtain ⟨l, r⟩ := δᵢ_between h q.pos lt_delta_of_q,
      exact no_rat_between (⌊ x * q.denom⌋) q (by exact_mod_cast l) (by exact_mod_cast r) },

      rw thomae_rat,
      exact_mod_cast (lt_of_le_of_lt (
        (inv_le_inv
          (show 0 < ((q.denom : ℚ) : ℝ), by exact_mod_cast q.pos)
            (show 0 < (r + 1 :ℝ ), by exact_mod_cast r_add_one_pos)).mpr
              (by exact_mod_cast r_add_one_le_q_denom)) hr),
  },
  { rw thomaes_at_irrational_eq_zero H,
    simpa using ε_pos },
end

theorem thomaes_discontinous_at_rational (q : ℚ)
: ¬continuous_at thomaes_function q :=
begin
  intro h,
  simp only [metric.continuous_at_iff] at h,
  norm_cast at h,
  specialize h
    (thomae_rat q)
    (by exact_mod_cast (thomae_rat_pos q)),
  rcases h with ⟨δ, δ_pos, hδ⟩,
  simp_rw real.dist_eq at hδ,

  rcases exists_irrational_btwn δ_pos with ⟨r, ⟨r_irrat, r_pos, r_lt_δ⟩⟩,

  specialize hδ (show |(r + q) - q| < δ, by simpa [abs_of_pos r_pos]),

  rw [
    thomaes_at_irrational_eq_zero (irrational.add_rat q r_irrat)
  ] at hδ,
  simp only [zero_sub, abs_neg] at hδ,
  rw abs_of_pos (show ((thomae_rat q) : ℝ) > 0, by exact_mod_cast (thomae_rat_pos q)) at hδ,
  exact (lt_self_iff_false _).mp hδ,
end


def ℤ₀ := ℕ × ℕ

def eqv : ℤ₀ → ℤ₀ → Prop
| (a, b) (c, d) := a + d = c + b

infix ` ∽ `:50 := eqv

-- Definition 4.1.2.
def add_ℤ₀ : ℤ₀ → ℤ₀ → ℤ₀
| (a, b) (c, d) := (a + c, b + d)

-- Lemma 4.1.3 (Addition and multiplication are well-defined).

private theorem add_ℤ₀.respects_eqv : ∀ {a b a' b'}, a ∽ a' → b ∽ b' → add_ℤ₀ a b ∽ add_ℤ₀ a' b'
| (a₁, a₂) (b₁, b₂) (a'₁, a'₂) (b'₁, b'₂) :=
  assume a_eqv_a' b_eqv_b',
  have h₁ : a₁ + a'₂ = a'₁ + a₂, from a_eqv_a',
  have h₂ : b₁ + b'₂ = b'₁ + b₂, from b_eqv_b',
  have h₃ : a₁ + b₁ + a'₂ + b'₂ = a'₁ + b'₁ + a₂ + b₂, from
    calc
      a₁ + b₁ + a'₂ + b'₂ = a₁ + a'₂ + b₁ + b'₂ : by simp [add_comm]
                      ... = a₁ + a'₂ + b'₁ + b₂ : by simp [add_assoc, h₂^.symm]
                      ... = a'₁ + a₂ + b'₁ + b₂ : by simp [add_assoc, h₁^.symm]
                      ... = a'₁ + b'₁ + a₂ + b₂ : by simp [add_comm],
  have h₄ : (a₁ + b₁, a₂ + b₂) ∽ (a'₁ + b'₁, a'₂ + b'₂), from h₃, -- Why does this fail?
  have h₅ : add_ℤ₀ (a₁, a₂) (b₁, b₂) = (a₁ + b₁, a₂ + b₂), from rfl,
  have h₆ : add_ℤ₀ (a'₁, a'₂) (b'₁, b'₂) = (a'₁ + b'₁, a'₂ + b'₂), from rfl,
  show add_ℤ₀ (a₁, a₂) (b₁, b₂) ∽ add_ℤ₀ (a'₁, a'₂) (b'₁, b'₂), from sorry


import set_theory.cardinal.finite

universes u u₁ u₂ u₃

section axiom_sets

variable {α : Type*}

section rank

def satisfies_R0 (r : set α → ℕ) : Prop :=
  ∀ X, 0 ≤ r X

def satisfies_R1 (r : set α → ℕ) : Prop :=
  ∀ X, r X ≤ nat.card X

def satisfies_R2 (r : set α → ℕ) : Prop :=
  ∀ X Y, X ⊆ Y → r X ≤ r Y

def satisfies_R3 (r : set α → ℕ) : Prop :=
  ∀ X Y, r (X ∪ Y) + r (X ∩ Y) ≤ r X + r Y

@[ext] structure rankfun (α : Type*) :=
  (r : set α → ℕ)
  (R0 : satisfies_R0 r)
  (R1 : satisfies_R1 r)
  (R2 : satisfies_R2 r)
  (R3 : satisfies_R3 r)

end rank

section indep

def satisfies_I1 (indep : set α → Prop) : Prop :=
  indep ∅

def satisfies_I2 (indep : set α → Prop) : Prop :=
  ∀ I J, I ⊆ J → indep J → indep I

def satisfies_I3 (indep : set α → Prop) : Prop := ∀ (I J : set α),
  nat.card I < nat.card J → indep I → indep J → ∃ (e : α), e ∈ J \ I ∧ indep (I ∪ {e})

--def satisfies_I3' : (set α → Prop) → Prop :=
--  λ indep, ∀ X, ∃ r, ∀ B, (B ⊆ X ∧ indep B ∧ (∀ Y, B ⊂ Y → Y ⊆ X → ¬indep Y) → size B = r

@[ext] structure indep_family (α : Type*) :=
  (indep : set α → Prop)
  (I1 : satisfies_I1 indep)
  (I2 : satisfies_I2 indep)
  (I3 : satisfies_I3 indep)

/-@[ext] structure indep_family' (α : Type*) :=
  (indep : set α → Prop)
  (I1 : satisfies_I1 indep)
  (I2 : satisfies_I2 indep)
  (I3' : satisfies_I3' indep)-/

end indep

section cct

def satisfies_C1 (cct : set α → Prop) : Prop :=
  ¬ cct ∅

def satisfies_C2 (cct : set α → Prop) : Prop:=
  ∀ C₁ C₂, cct C₁ → cct C₂ → ¬(C₁ ⊂ C₂)

def satisfies_C3 (cct : set α → Prop) : Prop:=
  ∀ C₁ C₂ (e : α), C₁ ≠ C₂ → cct C₁ → cct C₂
    → e ∈ (C₁ ∩ C₂) → ∃ C₀ , cct C₀ ∧ C₀ ⊆ (C₁ ∪ C₂) \ {e}

@[ext] structure cct_family (α : Type*) :=
  (cct : set α → Prop)
  (C1 : satisfies_C1 cct)
  (C2 : satisfies_C2 cct)
  (C3 : satisfies_C3 cct)

end cct

section basis

def exists_basis (basis : set α → Prop) : Prop :=
  ∃ B, basis B

def basis_exchange (basis : set α → Prop) : Prop :=
  ∀ B₁ B₂, basis B₁ → basis B₂
    → ∀ (b₁ : α), b₁ ∈ B₁ \ B₂ → ∃ b₂, (b₂ ∈ B₂ \ B₁) ∧ basis (B₁ \ {b₁} ∪ {b₂})

@[ext] structure basis_family (α : Type*) :=
  (basis : set α → Prop)
  (B1 : exists_basis basis)
  (B2 : basis_exchange basis)

end basis

section cl

def satisfies_cl1 : (set α → set α) → Prop :=
  λ cl, ∀ X, X ⊆ cl X

def satisfies_cl2 : (set α → set α) → Prop :=
  λ cl, ∀ X, cl (cl X) = cl X

def satisfies_cl3 : (set α → set α) → Prop :=
  λ cl, ∀ X Y : set α , X ⊆ Y → cl X ⊆ cl Y

def satisfies_cl4 : (set α → set α) → Prop :=
  λ cl, ∀ X (e f : α), (e ∈ cl (X ∪ {f}) \ X) → (f ∈ cl (X ∪ {e}) \ X)

structure clfun (α : Type*) :=
  (cl : set α → set α)
  (cl1 : satisfies_cl1 cl)
  (cl2 : satisfies_cl2 cl)
  (cl3 : satisfies_cl3 cl)
  (cl4 : satisfies_cl4 cl)

end cl

end axiom_sets

def matroid (α : Type*) := basis_family α

variables {α₁ : Type* }{α₂ : Type* }{α₃ : Type*}

namespace matroid

structure isom (M₁ : matroid α₁) (M₂ : matroid α₂) :=
(equiv : α₁ ≃ α₂)
(on_basis : ∀ B, M₁.basis B ↔ M₂.basis (equiv '' B))
-- (on_rank : ∀ X, M₂.r (equiv '' X) = M₁.r X)

-- instance coe_to_equiv {M₁ : matroid α₁} {M₂ : matroid α₂} : has_coe_to_fun (M₁.isom M₂) :=
-- { F := _,
--   coe := λ i, i.equiv }

-- def isom.refl (M₁ : matroid α₁) :
-- M₁.isom M₁ :=
-- { equiv := equiv.refl α₁,
--   on_rank := by simp  }

-- def isom.trans {M₁ : matroid α₁} {M₂ : matroid α₂} {M₃ : matroid α₃}
-- (I12 : M₁.isom M₂) (I23 : M₂.isom M₃) :
-- M₁.isom M₃ :=
-- { equiv := I12.equiv.trans I23.equiv ,
--   on_rank := λ X, by {rw [←I12.on_rank, ←I23.on_rank], apply congr_arg, ext, simp  }  }

-- def isom.symm {M₁ : matroid α₁} {M₂ : matroid α₂} (i : M₁.isom M₂) : M₂.isom M₁ :=
-- { equiv := i.equiv.symm,
--   on_rank := λ X, by {rw ←i.on_rank, apply congr_arg, ext, simp,  } }

-- def is_isom (M₁ : matroid α₁) (M₂ : matroid α₂) :=
--   nonempty (M₁.isom M₂)

-- lemma isom.inv_on_rank {M₁ : matroid α₁} {M₂ : matroid α₂} (i : isom M₁ M₂) (X : set α₂) :
--   M₂.r X = M₁.r (i.equiv.symm '' X) :=
-- by {rw ←i.symm.on_rank X, refl}

-- def isom_equiv {M₁ N₁ : matroid α₁} {M₂ N₂ : matroid α₂}
-- (h₁ : M₁ = N₁) (h₂ : M₂ = N₂) (i : isom M₁ M₂) :
--   isom N₁ N₂ :=
-- { equiv := i.equiv,
--   on_rank := λ X, by {rw [←h₁,←h₂], apply i.on_rank, } }

end matroid


/-
Copyright (c) 2021 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Damiano Testa, Jens Wagemaker
-/
import data.nat.interval
import data.polynomial.degree.definitions

/-!
# Induction on polynomials

This file contains lemmas dealing with different flavours of induction on polynomials.
-/

noncomputable theory
open_locale classical big_operators polynomial

open finset

namespace polynomial
universes u v w z
variables {R : Type u} {S : Type v} {T : Type w} {A : Type z} {a b : R} {n : ℕ}

section semiring
variables [semiring R] {p q : R[X]}

/-- `div_X p` returns a polynomial `q` such that `q * X + C (p.coeff 0) = p`.
  It can be used in a semiring where the usual division algorithm is not possible -/
def div_X (p : R[X]) : R[X] :=
∑ n in Ico 0 p.nat_degree, monomial n (p.coeff (n + 1))

@[simp] lemma coeff_div_X : (div_X p).coeff n = p.coeff (n+1) :=
begin
  simp only [div_X, coeff_monomial, true_and, finset_sum_coeff, not_lt,
    mem_Ico, zero_le, finset.sum_ite_eq', ite_eq_left_iff],
  intro h,
  rw coeff_eq_zero_of_nat_degree_lt (nat.lt_succ_of_le h)
end

lemma div_X_mul_X_add (p : R[X]) : div_X p * X + C (p.coeff 0) = p :=
ext $ by rintro ⟨_|_⟩; simp [coeff_C, nat.succ_ne_zero, coeff_mul_X]

@[simp] lemma div_X_C (a : R) : div_X (C a) = 0 :=
ext $ λ n, by simp [div_X, coeff_C]; simp [coeff]

lemma div_X_eq_zero_iff : div_X p = 0 ↔ p = C (p.coeff 0) :=
⟨λ h, by simpa [eq_comm, h] using div_X_mul_X_add p,
  λ h, by rw [h, div_X_C]⟩

lemma div_X_add : div_X (p + q) = div_X p + div_X q :=
ext $ by simp

lemma degree_div_X_lt (hp0 : p ≠ 0) : (div_X p).degree < p.degree :=
by haveI := nontrivial.of_polynomial_ne hp0;
calc (div_X p).degree < (div_X p * X + C (p.coeff 0)).degree :
  if h : degree p ≤ 0
  then begin
      have h' : C (p.coeff 0) ≠ 0, by rwa [← eq_C_of_degree_le_zero h],
      rw [eq_C_of_degree_le_zero h, div_X_C, degree_zero, zero_mul, zero_add],
      exact lt_of_le_of_ne bot_le (ne.symm (mt degree_eq_bot.1 $
        by simp [h'])),
    end
  else
    have hXp0 : div_X p ≠ 0,
      by simpa [div_X_eq_zero_iff, -not_le, degree_le_zero_iff] using h,
    have leading_coeff (div_X p) * leading_coeff X ≠ 0, by simpa,
    have degree (C (p.coeff 0)) < degree (div_X p * X),
      from calc degree (C (p.coeff 0)) ≤ 0 : degree_C_le
         ... < 1 : dec_trivial
         ... = degree (X : R[X]) : degree_X.symm
         ... ≤ degree (div_X p * X) :
          by rw [← zero_add (degree X), degree_mul' this];
            exact add_le_add
              (by rw [zero_le_degree_iff, ne.def, div_X_eq_zero_iff];
                exact λ h0, h (h0.symm ▸ degree_C_le))
              le_rfl,
    by rw [degree_add_eq_left_of_degree_lt this];
      exact degree_lt_degree_mul_X hXp0
... = p.degree : congr_arg _ (div_X_mul_X_add _)

/-- An induction principle for polynomials, valued in Sort* instead of Prop. -/
@[elab_as_eliminator] noncomputable def rec_on_horner
  {M : R[X] → Sort*} : Π (p : R[X]),
  M 0 →
  (Π p a, coeff p 0 = 0 → a ≠ 0 → M p → M (p + C a)) →
  (Π p, p ≠ 0 → M p → M (p * X)) →
  M p
| p := λ M0 MC MX,
if hp : p = 0 then eq.rec_on hp.symm M0
else
have wf : degree (div_X p) < degree p,
  from degree_div_X_lt hp,
by rw [← div_X_mul_X_add p] at *;
  exact
  if hcp0 : coeff p 0 = 0
  then by rw [hcp0, C_0, add_zero];
    exact MX _ (λ h : div_X p = 0, by simpa [h, hcp0] using hp)
      (rec_on_horner _ M0 MC MX)
  else MC _ _ (coeff_mul_X_zero _) hcp0 (if hpX0 : div_X p = 0
    then show M (div_X p * X), by rw [hpX0, zero_mul]; exact M0
    else MX (div_X p) hpX0 (rec_on_horner _ M0 MC MX))
using_well_founded {dec_tac := tactic.assumption}

/--  A property holds for all polynomials of positive `degree` with coefficients in a semiring `R`
if it holds for
* `a * X`, with `a ∈ R`,
* `p * X`, with `p ∈ R[X]`,
* `p + a`, with `a ∈ R`, `p ∈ R[X]`,
with appropriate restrictions on each term.

See `nat_degree_ne_zero_induction_on` for a similar statement involving no explicit multiplication.
 -/
@[elab_as_eliminator] lemma degree_pos_induction_on
  {P : R[X] → Prop} (p : R[X]) (h0 : 0 < degree p)
  (hC : ∀ {a}, a ≠ 0 → P (C a * X))
  (hX : ∀ {p}, 0 < degree p → P p → P (p * X))
  (hadd : ∀ {p} {a}, 0 < degree p → P p → P (p + C a)) : P p :=
rec_on_horner p
  (λ h, by rw degree_zero at h; exact absurd h dec_trivial)
  (λ p a _ _ ih h0,
    have 0 < degree p,
      from lt_of_not_ge (λ h, (not_lt_of_ge degree_C_le) $
        by rwa [eq_C_of_degree_le_zero h, ← C_add] at h0),
    hadd this (ih this))
  (λ p _ ih h0',
    if h0 : 0 < degree p
    then hX h0 (ih h0)
    else by rw [eq_C_of_degree_le_zero (le_of_not_gt h0)] at *;
      exact hC (λ h : coeff p 0 = 0,
        by simpa [h, nat.not_lt_zero] using h0'))
  h0

/--  A property holds for all polynomials of non-zero `nat_degree` with coefficients in a
semiring `R` if it holds for
* `p + a`, with `a ∈ R`, `p ∈ R[X]`,
* `p + q`, with `p, q ∈ R[X]`,
* monomials with nonzero coefficient and non-zero exponent,
with appropriate restrictions on each term.
Note that multiplication is "hidden" in the assumption on monomials, so there is no explicit
multiplication in the statement.
See `degree_pos_induction_on` for a similar statement involving more explicit multiplications.
 -/
@[elab_as_eliminator] lemma nat_degree_ne_zero_induction_on {M : R[X] → Prop}
  {f : R[X]} (f0 : f.nat_degree ≠ 0) (h_C_add : ∀ {a p}, M p → M (C a + p))
  (h_add : ∀ {p q}, M p → M q → M (p + q))
  (h_monomial : ∀ {n : ℕ} {a : R}, a ≠ 0 → n ≠ 0 → M (monomial n a)) :
  M f :=
suffices f.nat_degree = 0 ∨ M f, from or.dcases_on this (λ h, (f0 h).elim) id,
begin
  apply f.induction_on,
  { exact λ a, or.inl (nat_degree_C _) },
  { rintros p q (hp | hp) (hq | hq),
    { refine or.inl _,
      rw [eq_C_of_nat_degree_eq_zero hp, eq_C_of_nat_degree_eq_zero hq, ← C_add, nat_degree_C] },
    { refine or.inr _,
      rw [eq_C_of_nat_degree_eq_zero hp],
      exact h_C_add hq },
    { refine or.inr _,
      rw [eq_C_of_nat_degree_eq_zero hq, add_comm],
      exact h_C_add hp },
    { exact or.inr (h_add hp hq) } },
  { intros n a hi,
    by_cases a0 : a = 0,
    { exact or.inl (by rw [a0, C_0, zero_mul, nat_degree_zero]) },
    { refine or.inr _,
      rw C_mul_X_pow_eq_monomial,
      exact h_monomial a0 n.succ_ne_zero } }
end

end semiring

end polynomial


import data.set.basic -- hide
open set -- hide

/-
## The distributive property

The extensionality property of sets says that two sets are equal if and only if they have the same elements.

One can `apply ext, intro x` to invoke it. The `ext` tactic is a shortcut for this.
-/

variables {X Y : Type} -- hide

/- Lemma :
The distributive property of ∩ with respect to ∪.
-/
lemma inter_union (A B C : set X) : A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) :=
begin
  ext,
  split,
  {
    intro h,
    cases h,
    cases h_right,
    {
      left,
      split;
      assumption,
    },
    {
      right,
      split;
      assumption,
    }
  },
  {
    intro h,
    cases h,
    {
      split,
      {
        exact h.1,
      },
      {
        left,
        exact h.2,
      },
    },
    {
      split,
      {
        exact h.1,
      },
      {
        right,
        exact h.2,
      }
    }
  }
end


/-
Copyright (c) 2021 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import analysis.normed_space.ordered
import analysis.asymptotics.asymptotics
import topology.algebra.ordered.liminf_limsup
import data.polynomial.eval

/-!
# Super-Polynomial Function Decay

This file defines a predicate `asymptotics.superpolynomial_decay f` for a function satisfying
  one of following equivalent definitions (The definition is in terms of the first condition):

* `x ^ n * f` tends to `𝓝 0` for all (or sufficiently large) naturals `n`
* `|x ^ n * f|` tends to `𝓝 0` for all naturals `n` (`superpolynomial_decay_iff_abs_tendsto_zero`)
* `|x ^ n * f|` is bounded for all naturals `n` (`superpolynomial_decay_iff_abs_is_bounded_under`)
* `f` is `o(x ^ c)` for all integers `c` (`superpolynomial_decay_iff_is_o`)
* `f` is `O(x ^ c)` for all integers `c` (`superpolynomial_decay_iff_is_O`)

These conditions are all equivalent to conditions in terms of polynomials, replacing `x ^ c` with
  `p(x)` or `p(x)⁻¹` as appropriate, since asymptotically `p(x)` behaves like `X ^ p.nat_degree`.
These further equivalences are not proven in mathlib but would be good future projects.

The definition of superpolynomial decay for `f : α → β` is relative to a parameter `k : α → β`.
Super-polynomial decay then means `f x` decays faster than `(k x) ^ c` for all integers `c`.
Equivalently `f x` decays faster than `p.eval (k x)` for all polynomials `p : polynomial β`.
The definition is also relative to a filter `l : filter α` where the decay rate is compared.

When the map `k` is given by `n ↦ ↑n : ℕ → ℝ` this defines negligible functions:
https://en.wikipedia.org/wiki/Negligible_function

When the map `k` is given by `(r₁,...,rₙ) ↦ r₁*...*rₙ : ℝⁿ → ℝ` this is equivalent
  to the definition of rapidly decreasing functions given here:
https://ncatlab.org/nlab/show/rapidly+decreasing+function

# Main Theorems

* `superpolynomial_decay.polynomial_mul` says that if `f(x)` is negligible,
    then so is `p(x) * f(x)` for any polynomial `p`.
* `superpolynomial_decay_iff_zpow_tendsto_zero` gives an equivalence between definitions in terms
    of decaying faster than `k(x) ^ n` for all naturals `n` or `k(x) ^ c` for all integer `c`.
-/

namespace asymptotics

open_locale topological_space
open filter

/-- `f` has superpolynomial decay in parameter `k` along filter `l` if
  `k ^ n * f` tends to zero at `l` for all naturals `n` -/
def superpolynomial_decay {α β : Type*} [topological_space β] [comm_semiring β]
  (l : filter α) (k : α → β) (f : α → β) :=
∀ (n : ℕ), tendsto (λ (a : α), (k a) ^ n * f a) l (𝓝 0)

variables {α β : Type*} {l : filter α} {k : α → β} {f g g' : α → β}

section comm_semiring

variables [topological_space β] [comm_semiring β]

lemma superpolynomial_decay.congr' (hf : superpolynomial_decay l k f)
  (hfg : f =ᶠ[l] g) : superpolynomial_decay l k g :=
λ z, (hf z).congr' (eventually_eq.mul (eventually_eq.refl l _) hfg)

lemma superpolynomial_decay.congr (hf : superpolynomial_decay l k f)
  (hfg : ∀ x, f x = g x) : superpolynomial_decay l k g :=
λ z, (hf z).congr (λ x, congr_arg (λ a, k x ^ z * a) $ hfg x)

@[simp]
lemma superpolynomial_decay_zero (l : filter α) (k : α → β) :
  superpolynomial_decay l k 0 :=
λ z, by simpa only [pi.zero_apply, mul_zero] using tendsto_const_nhds

lemma superpolynomial_decay.add [has_continuous_add β] (hf : superpolynomial_decay l k f)
  (hg : superpolynomial_decay l k g) : superpolynomial_decay l k (f + g) :=
λ z, by simpa only [mul_add, add_zero, pi.add_apply] using (hf z).add (hg z)

lemma superpolynomial_decay.mul [has_continuous_mul β] (hf : superpolynomial_decay l k f)
  (hg : superpolynomial_decay l k g) : superpolynomial_decay l k (f * g) :=
λ z, by simpa only [mul_assoc, one_mul, mul_zero, pow_zero] using (hf z).mul (hg 0)

lemma superpolynomial_decay.mul_const [has_continuous_mul β] (hf : superpolynomial_decay l k f)
  (c : β) : superpolynomial_decay l k (λ n, f n * c) :=
λ z, by simpa only [←mul_assoc, zero_mul] using tendsto.mul_const c (hf z)

lemma superpolynomial_decay.const_mul [has_continuous_mul β] (hf : superpolynomial_decay l k f)
  (c : β) : superpolynomial_decay l k (λ n, c * f n) :=
(hf.mul_const c).congr (λ _, mul_comm _ _)

lemma superpolynomial_decay.param_mul (hf : superpolynomial_decay l k f) :
  superpolynomial_decay l k (k * f) :=
λ z, tendsto_nhds.2 (λ s hs hs0, l.sets_of_superset ((tendsto_nhds.1 (hf $ z + 1)) s hs hs0)
  (λ x hx, by simpa only [set.mem_preimage, pi.mul_apply, ← mul_assoc, ← pow_succ'] using hx))

lemma superpolynomial_decay.mul_param (hf : superpolynomial_decay l k f) :
  superpolynomial_decay l k (f * k) :=
(hf.param_mul).congr (λ _, mul_comm _ _)

lemma superpolynomial_decay.param_pow_mul (hf : superpolynomial_decay l k f)
  (n : ℕ) : superpolynomial_decay l k (k ^ n * f) :=
begin
  induction n with n hn,
  { simpa only [one_mul, pow_zero] using hf },
  { simpa only [pow_succ, mul_assoc] using hn.param_mul }
end

lemma superpolynomial_decay.mul_param_pow (hf : superpolynomial_decay l k f)
  (n : ℕ) : superpolynomial_decay l k (f * k ^ n) :=
(hf.param_pow_mul n).congr (λ _, mul_comm _ _)

lemma superpolynomial_decay.polynomial_mul [has_continuous_add β] [has_continuous_mul β]
  (hf : superpolynomial_decay l k f) (p : polynomial β) :
  superpolynomial_decay l k (λ x, (p.eval $ k x) * f x) :=
polynomial.induction_on' p (λ p q hp hq, by simpa [add_mul] using hp.add hq)
  (λ n c, by simpa [mul_assoc] using (hf.param_pow_mul n).const_mul c)

lemma superpolynomial_decay.mul_polynomial [has_continuous_add β] [has_continuous_mul β]
  (hf : superpolynomial_decay l k f) (p : polynomial β) :
  superpolynomial_decay l k (λ x, f x * (p.eval $ k x)) :=
(hf.polynomial_mul p).congr (λ _, mul_comm _ _)

end comm_semiring

section ordered_comm_semiring

variables [topological_space β] [ordered_comm_semiring β] [order_topology β]

end ordered_comm_semiring

section linear_ordered_comm_ring

variables [topological_space β] [linear_ordered_comm_ring β] [order_topology β]

variables (l k f)

lemma superpolynomial_decay_iff_abs_tendsto_zero :
  superpolynomial_decay l k f ↔ ∀ (n : ℕ), tendsto (λ (a : α), |(k a) ^ n * f a|) l (𝓝 0) :=
⟨λ h z, (tendsto_zero_iff_abs_tendsto_zero _).1 (h z),
  λ h z, (tendsto_zero_iff_abs_tendsto_zero _).2 (h z)⟩

lemma superpolynomial_decay_iff_superpolynomial_decay_abs :
  superpolynomial_decay l k f ↔ superpolynomial_decay l (λ a, |k a|) (λ a, |f a|) :=
(superpolynomial_decay_iff_abs_tendsto_zero l k f).trans (by simp [superpolynomial_decay, abs_mul])

variables {l k f}

lemma superpolynomial_decay.trans_eventually_abs_le (hf : superpolynomial_decay l k f)
  (hfg : abs ∘ g ≤ᶠ[l] abs ∘ f) : superpolynomial_decay l k g :=
begin
  rw superpolynomial_decay_iff_abs_tendsto_zero at hf ⊢,
  refine λ z, tendsto_of_tendsto_of_tendsto_of_le_of_le' (tendsto_const_nhds) (hf z)
    (eventually_of_forall $ λ x, abs_nonneg _) (hfg.mono $ λ x hx, _),
  calc |k x ^ z * g x| = |k x ^ z| * |g x| : abs_mul (k x ^ z) (g x)
    ... ≤ |k x ^ z| * |f x| : mul_le_mul le_rfl hx (abs_nonneg _) (abs_nonneg _)
    ... = |k x ^ z * f x| : (abs_mul (k x ^ z) (f x)).symm,
end

lemma superpolynomial_decay.trans_abs_le (hf : superpolynomial_decay l k f)
  (hfg : ∀ x, |g x| ≤ |f x|) : superpolynomial_decay l k g :=
hf.trans_eventually_abs_le (eventually_of_forall hfg)

end linear_ordered_comm_ring

section field

variables [topological_space β] [field β] (l k f)

lemma superpolynomial_decay_mul_const_iff [has_continuous_mul β] {c : β} (hc0 : c ≠ 0) :
  superpolynomial_decay l k (λ n, f n * c) ↔ superpolynomial_decay l k f :=
⟨λ h, (h.mul_const c⁻¹).congr (λ x, by simp [mul_assoc, mul_inv_cancel hc0]), λ h, h.mul_const c⟩

lemma superpolynomial_decay_const_mul_iff [has_continuous_mul β] {c : β} (hc0 : c ≠ 0) :
  superpolynomial_decay l k (λ n, c * f n) ↔ superpolynomial_decay l k f :=
⟨λ h, (h.const_mul c⁻¹).congr (λ x, by simp [← mul_assoc, inv_mul_cancel hc0]), λ h, h.const_mul c⟩

variables {l k f}

end field

section linear_ordered_field

variables [topological_space β] [linear_ordered_field β] [order_topology β]

variable (f)

lemma superpolynomial_decay_iff_abs_is_bounded_under (hk : tendsto k l at_top) :
  superpolynomial_decay l k f ↔ ∀ (z : ℕ), is_bounded_under (≤) l (λ (a : α), |(k a) ^ z * f a|) :=
begin
  refine ⟨λ h z, tendsto.is_bounded_under_le (tendsto.abs (h z)),
    λ h, (superpolynomial_decay_iff_abs_tendsto_zero l k f).2 (λ z, _)⟩,
  obtain ⟨m, hm⟩ := h (z + 1),
  have h1 : tendsto (λ (a : α), (0 : β)) l (𝓝 0) := tendsto_const_nhds,
  have h2 : tendsto (λ (a : α), |(k a)⁻¹| * m) l (𝓝 0) := (zero_mul m) ▸ tendsto.mul_const m
    ((tendsto_zero_iff_abs_tendsto_zero _).1 hk.inv_tendsto_at_top),
  refine tendsto_of_tendsto_of_tendsto_of_le_of_le' h1 h2
    (eventually_of_forall (λ x, abs_nonneg _)) ((eventually_map.1 hm).mp _),
  refine ((eventually_ne_of_tendsto_at_top hk 0).mono $ λ x hk0 hx, _),
  refine le_trans (le_of_eq _) (mul_le_mul_of_nonneg_left hx $ abs_nonneg (k x)⁻¹),
  rw [← abs_mul, ← mul_assoc, pow_succ, ← mul_assoc, inv_mul_cancel hk0, one_mul],
end

lemma superpolynomial_decay_iff_zpow_tendsto_zero (hk : tendsto k l at_top) :
  superpolynomial_decay l k f ↔ ∀ (z : ℤ), tendsto (λ (a : α), (k a) ^ z * f a) l (𝓝 0) :=
begin
  refine ⟨λ h z, _, λ h n, by simpa only [zpow_coe_nat] using h (n : ℤ)⟩,
  by_cases hz : 0 ≤ z,
  { lift z to ℕ using hz,
    simpa using h z },
  { have : tendsto (λ a, (k a) ^ z) l (𝓝 0) :=
      tendsto.comp (tendsto_zpow_at_top_zero (not_le.1 hz)) hk,
    have h : tendsto f l (𝓝 0) := by simpa using h 0,
    exact (zero_mul (0 : β)) ▸ this.mul h },
end

variable {f}

lemma superpolynomial_decay.param_zpow_mul (hk : tendsto k l at_top)
  (hf : superpolynomial_decay l k f) (z : ℤ) : superpolynomial_decay l k (λ a, k a ^ z * f a) :=
begin
  rw superpolynomial_decay_iff_zpow_tendsto_zero _ hk at hf ⊢,
  refine λ z', (hf $ z' + z).congr' ((eventually_ne_of_tendsto_at_top hk 0).mono (λ x hx, _)),
  simp [zpow_add₀ hx, mul_assoc, pi.mul_apply],
end

lemma superpolynomial_decay.mul_param_zpow (hk : tendsto k l at_top)
  (hf : superpolynomial_decay l k f) (z : ℤ) : superpolynomial_decay l k (λ a, f a * k a ^ z) :=
(hf.param_zpow_mul hk z).congr (λ _, mul_comm _ _)

lemma superpolynomial_decay.inv_param_mul (hk : tendsto k l at_top)
  (hf : superpolynomial_decay l k f) : superpolynomial_decay l k (k⁻¹ * f) :=
by simpa using (hf.param_zpow_mul hk (-1))

lemma superpolynomial_decay.param_inv_mul (hk : tendsto k l at_top)
  (hf : superpolynomial_decay l k f) : superpolynomial_decay l k (f * k⁻¹) :=
(hf.inv_param_mul hk).congr (λ _, mul_comm _ _)

variable (f)

lemma superpolynomial_decay_param_mul_iff (hk : tendsto k l at_top) :
  superpolynomial_decay l k (k * f) ↔ superpolynomial_decay l k f :=
⟨λ h, (h.inv_param_mul hk).congr' ((eventually_ne_of_tendsto_at_top hk 0).mono
  (λ x hx, by simp [← mul_assoc, inv_mul_cancel hx])), λ h, h.param_mul⟩

lemma superpolynomial_decay_mul_param_iff (hk : tendsto k l at_top) :
  superpolynomial_decay l k (f * k) ↔ superpolynomial_decay l k f :=
by simpa [mul_comm k] using superpolynomial_decay_param_mul_iff f hk

lemma superpolynomial_decay_param_pow_mul_iff (hk : tendsto k l at_top) (n : ℕ) :
  superpolynomial_decay l k (k ^ n * f) ↔ superpolynomial_decay l k f :=
begin
  induction n with n hn,
  { simp },
  { simpa [pow_succ, ← mul_comm k, mul_assoc,
      superpolynomial_decay_param_mul_iff (k ^ n * f) hk] using hn }
end

lemma superpolynomial_decay_mul_param_pow_iff (hk : tendsto k l at_top) (n : ℕ) :
  superpolynomial_decay l k (f * k ^ n) ↔ superpolynomial_decay l k f :=
by simpa [mul_comm f] using superpolynomial_decay_param_pow_mul_iff f hk n

variable {f}

end linear_ordered_field

section normed_linear_ordered_field

variable [normed_linear_ordered_field β]

variables (l k f)

lemma superpolynomial_decay_iff_norm_tendsto_zero :
  superpolynomial_decay l k f ↔ ∀ (n : ℕ), tendsto (λ (a : α), ∥(k a) ^ n * f a∥) l (𝓝 0) :=
⟨λ h z, tendsto_zero_iff_norm_tendsto_zero.1 (h z),
  λ h z, tendsto_zero_iff_norm_tendsto_zero.2 (h z)⟩

lemma superpolynomial_decay_iff_superpolynomial_decay_norm :
  superpolynomial_decay l k f ↔ superpolynomial_decay l (λ a, ∥k a∥) (λ a, ∥f a∥) :=
(superpolynomial_decay_iff_norm_tendsto_zero l k f).trans (by simp [superpolynomial_decay])

variables {l k}

variable [order_topology β]

lemma superpolynomial_decay_iff_is_O (hk : tendsto k l at_top) :
  superpolynomial_decay l k f ↔ ∀ (z : ℤ), is_O f (λ (a : α), (k a) ^ z) l :=
begin
  refine (superpolynomial_decay_iff_zpow_tendsto_zero f hk).trans _,
  have hk0 : ∀ᶠ x in l, k x ≠ 0 := eventually_ne_of_tendsto_at_top hk 0,
  refine ⟨λ h z, _, λ h z, _⟩,
  { refine is_O_of_div_tendsto_nhds (hk0.mono (λ x hx hxz, absurd (zpow_eq_zero hxz) hx)) 0 _,
    have : (λ (a : α), k a ^ z)⁻¹ = (λ (a : α), k a ^ (- z)) := funext (λ x, by simp),
    rw [div_eq_mul_inv, mul_comm f, this],
    exact h (-z) },
  { suffices : is_O (λ (a : α), k a ^ z * f a) (λ (a : α), (k a)⁻¹) l,
    from is_O.trans_tendsto this hk.inv_tendsto_at_top,
    refine ((is_O_refl (λ a, (k a) ^ z) l).mul (h (- (z + 1)))).trans
      (is_O.of_bound 1 $ hk0.mono (λ a ha0, _)),
    simp only [one_mul, neg_add z 1, zpow_add₀ ha0, ← mul_assoc, zpow_neg₀,
      mul_inv_cancel (zpow_ne_zero z ha0), zpow_one] }
end

lemma superpolynomial_decay_iff_is_o (hk : tendsto k l at_top) :
  superpolynomial_decay l k f ↔ ∀ (z : ℤ), is_o f (λ (a : α), (k a) ^ z) l :=
begin
  refine ⟨λ h z, _, λ h, (superpolynomial_decay_iff_is_O f hk).2 (λ z, (h z).is_O)⟩,
  have hk0 : ∀ᶠ x in l, k x ≠ 0 := eventually_ne_of_tendsto_at_top hk 0,
  have : is_o (λ (x : α), (1 : β)) k l := is_o_of_tendsto'
    (hk0.mono (λ x hkx hkx', absurd hkx' hkx)) (by simpa using hk.inv_tendsto_at_top),
  have : is_o f (λ (x : α), k x * k x ^ (z - 1)) l,
  by simpa using this.mul_is_O (((superpolynomial_decay_iff_is_O f hk).1 h) $ z - 1),
  refine this.trans_is_O (is_O.of_bound 1 (hk0.mono $ λ x hkx, le_of_eq _)),
  rw [one_mul, zpow_sub_one₀ hkx, mul_comm (k x), mul_assoc, inv_mul_cancel hkx, mul_one],
end

variable {f}

end normed_linear_ordered_field

end asymptotics


/-
Copyright (c) 2020 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Yury Kudryashov
-/
import analysis.calculus.deriv
import measure_theory.constructions.borel_space
import measure_theory.function.strongly_measurable.basic
import tactic.ring_exp

/-!
# Derivative is measurable

In this file we prove that the derivative of any function with complete codomain is a measurable
function. Namely, we prove:

* `measurable_set_of_differentiable_at`: the set `{x | differentiable_at 𝕜 f x}` is measurable;
* `measurable_fderiv`: the function `fderiv 𝕜 f` is measurable;
* `measurable_fderiv_apply_const`: for a fixed vector `y`, the function `λ x, fderiv 𝕜 f x y`
  is measurable;
* `measurable_deriv`: the function `deriv f` is measurable (for `f : 𝕜 → F`).

We also show the same results for the right derivative on the real line
(see `measurable_deriv_within_Ici` and ``measurable_deriv_within_Ioi`), following the same
proof strategy.

## Implementation

We give a proof that avoids second-countability issues, by expressing the differentiability set
as a function of open sets in the following way. Define `A (L, r, ε)` to be the set of points
where, on a ball of radius roughly `r` around `x`, the function is uniformly approximated by the
linear map `L`, up to `ε r`. It is an open set.
Let also `B (L, r, s, ε) = A (L, r, ε) ∩ A (L, s, ε)`: we require that at two possibly different
scales `r` and `s`, the function is well approximated by the linear map `L`. It is also open.

We claim that the differentiability set of `f` is exactly
`D = ⋂ ε > 0, ⋃ δ > 0, ⋂ r, s < δ, ⋃ L, B (L, r, s, ε)`.
In other words, for any `ε > 0`, we require that there is a size `δ` such that, for any two scales
below this size, the function is well approximated by a linear map, common to the two scales.

The set `⋃ L, B (L, r, s, ε)` is open, as a union of open sets. Converting the intersections and
unions to countable ones (using real numbers of the form `2 ^ (-n)`), it follows that the
differentiability set is measurable.

To prove the claim, there are two inclusions. One is trivial: if the function is differentiable
at `x`, then `x` belongs to `D` (just take `L` to be the derivative, and use that the
differentiability exactly says that the map is well approximated by `L`). This is proved in
`mem_A_of_differentiable` and `differentiable_set_subset_D`.

For the other direction, the difficulty is that `L` in the union may depend on `ε, r, s`. The key
point is that, in fact, it doesn't depend too much on them. First, if `x` belongs both to
`A (L, r, ε)` and `A (L', r, ε)`, then `L` and `L'` have to be close on a shell, and thus
`‖L - L'‖` is bounded by `ε` (see `norm_sub_le_of_mem_A`). Assume now `x ∈ D`. If one has two maps
`L` and `L'` such that `x` belongs to `A (L, r, ε)` and to `A (L', r', ε')`, one deduces that `L` is
close to `L'` by arguing as follows. Consider another scale `s` smaller than `r` and `r'`. Take a
linear map `L₁` that approximates `f` around `x` both at scales `r` and `s` w.r.t. `ε` (it exists as
`x` belongs to `D`). Take also `L₂` that approximates `f` around `x` both at scales `r'` and `s`
w.r.t. `ε'`. Then `L₁` is close to `L` (as they are close on a shell of radius `r`), and `L₂` is
close to `L₁` (as they are close on a shell of radius `s`), and `L'` is close to `L₂` (as they are
close on a shell of radius `r'`). It follows that `L` is close to `L'`, as we claimed.

It follows that the different approximating linear maps that show up form a Cauchy sequence when
`ε` tends to `0`. When the target space is complete, this sequence converges, to a limit `f'`.
With the same kind of arguments, one checks that `f` is differentiable with derivative `f'`.

To show that the derivative itself is measurable, add in the definition of `B` and `D` a set
`K` of continuous linear maps to which `L` should belong. Then, when `K` is complete, the set `D K`
is exactly the set of points where `f` is differentiable with a derivative in `K`.

## Tags

derivative, measurable function, Borel σ-algebra
-/

noncomputable theory

open set metric asymptotics filter continuous_linear_map
open topological_space (second_countable_topology) measure_theory
open_locale topology

namespace continuous_linear_map

variables {𝕜 E F : Type*} [nontrivially_normed_field 𝕜]
  [normed_add_comm_group E] [normed_space 𝕜 E] [normed_add_comm_group F] [normed_space 𝕜 F]

lemma measurable_apply₂ [measurable_space E] [opens_measurable_space E]
  [second_countable_topology E] [second_countable_topology (E →L[𝕜] F)]
  [measurable_space F] [borel_space F] :
  measurable (λ p : (E →L[𝕜] F) × E, p.1 p.2) :=
is_bounded_bilinear_map_apply.continuous.measurable

end continuous_linear_map

section fderiv

variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
variables {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F]
variables {f : E → F} (K : set (E →L[𝕜] F))

namespace fderiv_measurable_aux

/-- The set `A f L r ε` is the set of points `x` around which the function `f` is well approximated
at scale `r` by the linear map `L`, up to an error `ε`. We tweak the definition to make sure that
this is an open set.-/
def A (f : E → F) (L : E →L[𝕜] F) (r ε : ℝ) : set E :=
{x | ∃ r' ∈ Ioc (r/2) r, ∀ y z ∈ ball x r', ‖f z - f y - L (z-y)‖ ≤ ε * r}

/-- The set `B f K r s ε` is the set of points `x` around which there exists a continuous linear map
`L` belonging to `K` (a given set of continuous linear maps) that approximates well the
function `f` (up to an error `ε`), simultaneously at scales `r` and `s`. -/
def B (f : E → F) (K : set (E →L[𝕜] F)) (r s ε : ℝ) : set E :=
⋃ (L ∈ K), (A f L r ε) ∩ (A f L s ε)

/-- The set `D f K` is a complicated set constructed using countable intersections and unions. Its
main use is that, when `K` is complete, it is exactly the set of points where `f` is differentiable,
with a derivative in `K`. -/
def D (f : E → F) (K : set (E →L[𝕜] F)) : set E :=
⋂ (e : ℕ), ⋃ (n : ℕ), ⋂ (p ≥ n) (q ≥ n), B f K ((1/2) ^ p) ((1/2) ^ q) ((1/2) ^ e)

lemma is_open_A (L : E →L[𝕜] F) (r ε : ℝ) : is_open (A f L r ε) :=
begin
  rw metric.is_open_iff,
  rintros x ⟨r', r'_mem, hr'⟩,
  obtain ⟨s, s_gt, s_lt⟩ : ∃ (s : ℝ), r / 2 < s ∧ s < r' := exists_between r'_mem.1,
  have : s ∈ Ioc (r/2) r := ⟨s_gt, le_of_lt (s_lt.trans_le r'_mem.2)⟩,
  refine ⟨r' - s, by linarith, λ x' hx', ⟨s, this, _⟩⟩,
  have B : ball x' s ⊆ ball x r' := ball_subset (le_of_lt hx'),
  assume y hy z hz,
  exact hr' y (B hy) z (B hz)
end

lemma is_open_B {K : set (E →L[𝕜] F)} {r s ε : ℝ} : is_open (B f K r s ε) :=
by simp [B, is_open_Union, is_open.inter, is_open_A]

lemma A_mono (L : E →L[𝕜] F) (r : ℝ) {ε δ : ℝ} (h : ε ≤ δ) :
  A f L r ε ⊆ A f L r δ :=
begin
  rintros x ⟨r', r'r, hr'⟩,
  refine ⟨r', r'r, λ y hy z hz, (hr' y hy z hz).trans (mul_le_mul_of_nonneg_right h _)⟩,
  linarith [mem_ball.1 hy, r'r.2, @dist_nonneg _ _ y x],
end

lemma mem_A_of_differentiable {ε : ℝ} (hε : 0 < ε) {x : E} (hx : differentiable_at 𝕜 f x) :
  ∃ R > 0, ∀ r ∈ Ioo (0 : ℝ) R, x ∈ A f (fderiv 𝕜 f x) r ε :=
begin
  have := hx.has_fderiv_at,
  simp only [has_fderiv_at, has_fderiv_at_filter, is_o_iff] at this,
  rcases eventually_nhds_iff_ball.1 (this (half_pos hε)) with ⟨R, R_pos, hR⟩,
  refine ⟨R, R_pos, λ r hr, _⟩,
  have : r ∈ Ioc (r/2) r := ⟨half_lt_self hr.1, le_rfl⟩,
  refine ⟨r, this, λ y hy z hz, _⟩,
  calc  ‖f z - f y - (fderiv 𝕜 f x) (z - y)‖
      = ‖(f z - f x - (fderiv 𝕜 f x) (z - x)) - (f y - f x - (fderiv 𝕜 f x) (y - x))‖ :
    by { congr' 1, simp only [continuous_linear_map.map_sub], abel }
  ... ≤ ‖(f z - f x - (fderiv 𝕜 f x) (z - x))‖ + ‖f y - f x - (fderiv 𝕜 f x) (y - x)‖ :
    norm_sub_le _ _
  ... ≤ ε / 2 * ‖z - x‖ + ε / 2 * ‖y - x‖ :
    add_le_add (hR _ (lt_trans (mem_ball.1 hz) hr.2)) (hR _ (lt_trans (mem_ball.1 hy) hr.2))
  ... ≤ ε / 2 * r + ε / 2 * r :
    add_le_add
      (mul_le_mul_of_nonneg_left (le_of_lt (mem_ball_iff_norm.1 hz)) (le_of_lt (half_pos hε)))
      (mul_le_mul_of_nonneg_left (le_of_lt (mem_ball_iff_norm.1 hy)) (le_of_lt (half_pos hε)))
  ... = ε * r : by ring
end

lemma norm_sub_le_of_mem_A {c : 𝕜} (hc : 1 < ‖c‖)
  {r ε : ℝ} (hε : 0 < ε) (hr : 0 < r) {x : E} {L₁ L₂ : E →L[𝕜] F}
  (h₁ : x ∈ A f L₁ r ε) (h₂ : x ∈ A f L₂ r ε) : ‖L₁ - L₂‖ ≤ 4 * ‖c‖ * ε :=
begin
  have : 0 ≤ 4 * ‖c‖ * ε :=
    mul_nonneg (mul_nonneg (by norm_num : (0 : ℝ) ≤ 4) (norm_nonneg _)) hε.le,
  refine op_norm_le_of_shell (half_pos hr) this hc _,
  assume y ley ylt,
  rw [div_div,
      div_le_iff' (mul_pos (by norm_num : (0 : ℝ) < 2) (zero_lt_one.trans hc))] at ley,
  calc ‖(L₁ - L₂) y‖
        = ‖(f (x + y) - f x - L₂ ((x + y) - x)) - (f (x + y) - f x - L₁ ((x + y) - x))‖ : by simp
    ... ≤ ‖(f (x + y) - f x - L₂ ((x + y) - x))‖ + ‖(f (x + y) - f x - L₁ ((x + y) - x))‖ :
      norm_sub_le _ _
    ... ≤ ε * r + ε * r :
      begin
        apply add_le_add,
        { apply le_of_mem_A h₂,
          { simp only [le_of_lt (half_pos hr), mem_closed_ball, dist_self] },
          { simp only [dist_eq_norm, add_sub_cancel', mem_closed_ball, ylt.le], } },
        { apply le_of_mem_A h₁,
          { simp only [le_of_lt (half_pos hr), mem_closed_ball, dist_self] },
          { simp only [dist_eq_norm, add_sub_cancel', mem_closed_ball, ylt.le] } },
      end
    ... = 2 * ε * r : by ring
    ... ≤ 2 * ε * (2 * ‖c‖ * ‖y‖) : mul_le_mul_of_nonneg_left ley (mul_nonneg (by norm_num) hε.le)
    ... = 4 * ‖c‖ * ε * ‖y‖ : by ring
end

/-- Easy inclusion: a differentiability point with derivative in `K` belongs to `D f K`. -/
lemma differentiable_set_subset_D : {x | differentiable_at 𝕜 f x ∧ fderiv 𝕜 f x ∈ K} ⊆ D f K :=
begin
  assume x hx,
  rw [D, mem_Inter],
  assume e,
  have : (0 : ℝ) < (1/2) ^ e := pow_pos (by norm_num) _,
  rcases mem_A_of_differentiable this hx.1 with ⟨R, R_pos, hR⟩,
  obtain ⟨n, hn⟩ : ∃ (n : ℕ), (1/2) ^ n < R :=
    exists_pow_lt_of_lt_one R_pos (by norm_num : (1 : ℝ)/2 < 1),
  simp only [mem_Union, mem_Inter, B, mem_inter_iff],
  refine ⟨n, λ p hp q hq, ⟨fderiv 𝕜 f x, hx.2, ⟨_, _⟩⟩⟩;
  { refine hR _ ⟨pow_pos (by norm_num) _, lt_of_le_of_lt _ hn⟩,
    exact pow_le_pow_of_le_one (by norm_num) (by norm_num) (by assumption) }
end

/-- Harder inclusion: at a point in `D f K`, the function `f` has a derivative, in `K`. -/
lemma D_subset_differentiable_set {K : set (E →L[𝕜] F)} (hK : is_complete K) :
  D f K ⊆ {x | differentiable_at 𝕜 f x ∧ fderiv 𝕜 f x ∈ K} :=
begin
  have P : ∀ {n : ℕ}, (0 : ℝ) < (1/2) ^ n := pow_pos (by norm_num),
  rcases normed_field.exists_one_lt_norm 𝕜 with ⟨c, hc⟩,
  have cpos : 0 < ‖c‖ := lt_trans zero_lt_one hc,
  assume x hx,
  have : ∀ (e : ℕ), ∃ (n : ℕ), ∀ p q, n ≤ p → n ≤ q → ∃ L ∈ K,
    x ∈ A f L ((1/2) ^ p) ((1/2) ^ e) ∩ A f L ((1/2) ^ q) ((1/2) ^ e),
  { assume e,
    have := mem_Inter.1 hx e,
    rcases mem_Union.1 this with ⟨n, hn⟩,
    refine ⟨n, λ p q hp hq, _⟩,
    simp only [mem_Inter, ge_iff_le] at hn,
    rcases mem_Union.1 (hn p hp q hq) with ⟨L, hL⟩,
    exact ⟨L, mem_Union.1 hL⟩, },
  /- Recast the assumptions: for each `e`, there exist `n e` and linear maps `L e p q` in `K`
  such that, for `p, q ≥ n e`, then `f` is well approximated by `L e p q` at scale `2 ^ (-p)` and
  `2 ^ (-q)`, with an error `2 ^ (-e)`. -/
  choose! n L hn using this,
  /- All the operators `L e p q` that show up are close to each other. To prove this, we argue
    that `L e p q` is close to `L e p r` (where `r` is large enough), as both approximate `f` at
    scale `2 ^(- p)`. And `L e p r` is close to `L e' p' r` as both approximate `f` at scale
    `2 ^ (- r)`. And `L e' p' r` is close to `L e' p' q'` as both approximate `f` at scale
    `2 ^ (- p')`. -/
  have M : ∀ e p q e' p' q', n e ≤ p → n e ≤ q → n e' ≤ p' → n e' ≤ q' → e ≤ e' →
    ‖L e p q - L e' p' q'‖ ≤ 12 * ‖c‖ * (1/2) ^ e,
  { assume e p q e' p' q' hp hq hp' hq' he',
    let r := max (n e) (n e'),
    have I : ((1:ℝ)/2)^e' ≤ (1/2)^e := pow_le_pow_of_le_one (by norm_num) (by norm_num) he',
    have J1 : ‖L e p q - L e p r‖ ≤ 4 * ‖c‖ * (1/2)^e,
    { have I1 : x ∈ A f (L e p q) ((1 / 2) ^ p) ((1/2)^e) :=
        (hn e p q hp hq).2.1,
      have I2 : x ∈ A f (L e p r) ((1 / 2) ^ p) ((1/2)^e) :=
        (hn e p r hp (le_max_left _ _)).2.1,
      exact norm_sub_le_of_mem_A hc P P I1 I2 },
    have J2 : ‖L e p r - L e' p' r‖ ≤ 4 * ‖c‖ * (1/2)^e,
    { have I1 : x ∈ A f (L e p r) ((1 / 2) ^ r) ((1/2)^e) :=
        (hn e p r hp (le_max_left _ _)).2.2,
      have I2 : x ∈ A f (L e' p' r) ((1 / 2) ^ r) ((1/2)^e') :=
        (hn e' p' r hp' (le_max_right _ _)).2.2,
      exact norm_sub_le_of_mem_A hc P P I1 (A_mono _ _ I I2) },
    have J3 : ‖L e' p' r - L e' p' q'‖ ≤ 4 * ‖c‖ * (1/2)^e,
    { have I1 : x ∈ A f (L e' p' r) ((1 / 2) ^ p') ((1/2)^e') :=
        (hn e' p' r hp' (le_max_right _ _)).2.1,
      have I2 : x ∈ A f (L e' p' q') ((1 / 2) ^ p') ((1/2)^e') :=
        (hn e' p' q' hp' hq').2.1,
      exact norm_sub_le_of_mem_A hc P P (A_mono _ _ I I1) (A_mono _ _ I I2) },
    calc ‖L e p q - L e' p' q'‖
          = ‖(L e p q - L e p r) + (L e p r - L e' p' r) + (L e' p' r - L e' p' q')‖ :
        by { congr' 1, abel }
      ... ≤ ‖L e p q - L e p r‖ + ‖L e p r - L e' p' r‖ + ‖L e' p' r - L e' p' q'‖ :
        le_trans (norm_add_le _ _) (add_le_add_right (norm_add_le _ _) _)
      ... ≤ 4 * ‖c‖ * (1/2)^e + 4 * ‖c‖ * (1/2)^e + 4 * ‖c‖ * (1/2)^e :
        by apply_rules [add_le_add]
      ... = 12 * ‖c‖ * (1/2)^e : by ring },
  /- For definiteness, use `L0 e = L e (n e) (n e)`, to have a single sequence. We claim that this
  is a Cauchy sequence. -/
  let L0 : ℕ → (E →L[𝕜] F) := λ e, L e (n e) (n e),
  have : cauchy_seq L0,
  { rw metric.cauchy_seq_iff',
    assume ε εpos,
    obtain ⟨e, he⟩ : ∃ (e : ℕ), (1/2) ^ e < ε / (12 * ‖c‖) :=
      exists_pow_lt_of_lt_one (div_pos εpos (mul_pos (by norm_num) cpos)) (by norm_num),
    refine ⟨e, λ e' he', _⟩,
    rw [dist_comm, dist_eq_norm],
    calc ‖L0 e - L0 e'‖
          ≤ 12 * ‖c‖ * (1/2)^e : M _ _ _ _ _ _ le_rfl le_rfl le_rfl le_rfl he'
      ... < 12 * ‖c‖ * (ε / (12 * ‖c‖)) :
        mul_lt_mul' le_rfl he (le_of_lt P) (mul_pos (by norm_num) cpos)
      ... = ε : by { field_simp [(by norm_num : (12 : ℝ) ≠ 0), ne_of_gt cpos], ring } },
  /- As it is Cauchy, the sequence `L0` converges, to a limit `f'` in `K`.-/
  obtain ⟨f', f'K, hf'⟩ : ∃ f' ∈ K, tendsto L0 at_top (𝓝 f') :=
    cauchy_seq_tendsto_of_is_complete hK (λ e, (hn e (n e) (n e) le_rfl le_rfl).1) this,
  have Lf' : ∀ e p, n e ≤ p → ‖L e (n e) p - f'‖ ≤ 12 * ‖c‖ * (1/2)^e,
  { assume e p hp,
    apply le_of_tendsto (tendsto_const_nhds.sub hf').norm,
    rw eventually_at_top,
    exact ⟨e, λ e' he', M _ _ _ _ _ _ le_rfl hp le_rfl le_rfl he'⟩ },
  /- Let us show that `f` has derivative `f'` at `x`. -/
  have : has_fderiv_at f f' x,
  { simp only [has_fderiv_at_iff_is_o_nhds_zero, is_o_iff],
    /- to get an approximation with a precision `ε`, we will replace `f` with `L e (n e) m` for
    some large enough `e` (yielding a small error by uniform approximation). As one can vary `m`,
    this makes it possible to cover all scales, and thus to obtain a good linear approximation in
    the whole ball of radius `(1/2)^(n e)`. -/
    assume ε εpos,
    have pos : 0 < 4 + 12 * ‖c‖ :=
      add_pos_of_pos_of_nonneg (by norm_num) (mul_nonneg (by norm_num) (norm_nonneg _)),
    obtain ⟨e, he⟩ : ∃ (e : ℕ), (1 / 2) ^ e < ε / (4 + 12 * ‖c‖) :=
      exists_pow_lt_of_lt_one (div_pos εpos pos) (by norm_num),
    rw eventually_nhds_iff_ball,
    refine ⟨(1/2) ^ (n e + 1), P, λ y hy, _⟩,
    -- We need to show that `f (x + y) - f x - f' y` is small. For this, we will work at scale
    -- `k` where `k` is chosen with `‖y‖ ∼ 2 ^ (-k)`.
    by_cases y_pos : y = 0, {simp [y_pos] },
    have yzero : 0 < ‖y‖ := norm_pos_iff.mpr y_pos,
    have y_lt : ‖y‖ < (1/2) ^ (n e + 1), by simpa using mem_ball_iff_norm.1 hy,
    have yone : ‖y‖ ≤ 1 :=
      le_trans (y_lt.le) (pow_le_one _ (by norm_num) (by norm_num)),
    -- define the scale `k`.
    obtain ⟨k, hk, h'k⟩ : ∃ (k : ℕ), (1/2) ^ (k + 1) < ‖y‖ ∧ ‖y‖ ≤ (1/2) ^ k :=
      exists_nat_pow_near_of_lt_one yzero yone (by norm_num : (0 : ℝ) < 1/2)
      (by norm_num : (1 : ℝ)/2 < 1),
    -- the scale is large enough (as `y` is small enough)
    have k_gt : n e < k,
    { have : ((1:ℝ)/2) ^ (k + 1) < (1/2) ^ (n e + 1) := lt_trans hk y_lt,
      rw pow_lt_pow_iff_of_lt_one (by norm_num : (0 : ℝ) < 1/2) (by norm_num) at this,
      linarith },
    set m := k - 1 with hl,
    have m_ge : n e ≤ m := nat.le_pred_of_lt k_gt,
    have km : k = m + 1 := (nat.succ_pred_eq_of_pos (lt_of_le_of_lt (zero_le _) k_gt)).symm,
    rw km at hk h'k,
    -- `f` is well approximated by `L e (n e) k` at the relevant scale
    -- (in fact, we use `m = k - 1` instead of `k` because of the precise definition of `A`).
    have J1 : ‖f (x + y) - f x - L e (n e) m ((x + y) - x)‖ ≤ (1/2) ^ e * (1/2) ^ m,
    { apply le_of_mem_A (hn e (n e) m le_rfl m_ge).2.2,
      { simp only [mem_closed_ball, dist_self],
        exact div_nonneg (le_of_lt P) (zero_le_two) },
      { simpa only [dist_eq_norm, add_sub_cancel', mem_closed_ball, pow_succ', mul_one_div]
          using h'k } },
    have J2 : ‖f (x + y) - f x - L e (n e) m y‖ ≤ 4 * (1/2) ^ e * ‖y‖ := calc
      ‖f (x + y) - f x - L e (n e) m y‖ ≤ (1/2) ^ e * (1/2) ^ m :
        by simpa only [add_sub_cancel'] using J1
      ... = 4 * (1/2) ^ e * (1/2) ^ (m + 2) : by { field_simp, ring_exp }
      ... ≤ 4 * (1/2) ^ e * ‖y‖ :
        mul_le_mul_of_nonneg_left (le_of_lt hk) (mul_nonneg (by norm_num) (le_of_lt P)),
    -- use the previous estimates to see that `f (x + y) - f x - f' y` is small.
    calc ‖f (x + y) - f x - f' y‖
        = ‖(f (x + y) - f x - L e (n e) m y) + (L e (n e) m - f') y‖ :
      congr_arg _ (by simp)
    ... ≤ 4 * (1/2) ^ e * ‖y‖ + 12 * ‖c‖ * (1/2) ^ e * ‖y‖ :
      norm_add_le_of_le J2
        ((le_op_norm _ _).trans (mul_le_mul_of_nonneg_right (Lf' _ _ m_ge) (norm_nonneg _)))
    ... = (4 + 12 * ‖c‖) * ‖y‖ * (1/2) ^ e : by ring
    ... ≤ (4 + 12 * ‖c‖) * ‖y‖ * (ε / (4 + 12 * ‖c‖)) :
      mul_le_mul_of_nonneg_left he.le
        (mul_nonneg (add_nonneg (by norm_num) (mul_nonneg (by norm_num) (norm_nonneg _)))
          (norm_nonneg _))
    ... = ε * ‖y‖ : by { field_simp [ne_of_gt pos], ring } },
  rw ← this.fderiv at f'K,
  exact ⟨this.differentiable_at, f'K⟩
end

theorem differentiable_set_eq_D (hK : is_complete K) :
  {x | differentiable_at 𝕜 f x ∧ fderiv 𝕜 f x ∈ K} = D f K :=
subset.antisymm (differentiable_set_subset_D _) (D_subset_differentiable_set hK)

end fderiv_measurable_aux

open fderiv_measurable_aux

variables [measurable_space E] [opens_measurable_space E]
variables (𝕜 f)

/-- The set of differentiability points of a function, with derivative in a given complete set,
is Borel-measurable. -/
theorem measurable_set_of_differentiable_at_of_is_complete
  {K : set (E →L[𝕜] F)} (hK : is_complete K) :
  measurable_set {x | differentiable_at 𝕜 f x ∧ fderiv 𝕜 f x ∈ K} :=
by simp [differentiable_set_eq_D K hK, D, is_open_B.measurable_set, measurable_set.Inter,
         measurable_set.Union]

variable [complete_space F]

/-- The set of differentiability points of a function taking values in a complete space is
Borel-measurable. -/
theorem measurable_set_of_differentiable_at :
  measurable_set {x | differentiable_at 𝕜 f x} :=
begin
  have : is_complete (univ : set (E →L[𝕜] F)) := complete_univ,
  convert measurable_set_of_differentiable_at_of_is_complete 𝕜 f this,
  simp
end

@[measurability] lemma measurable_fderiv : measurable (fderiv 𝕜 f) :=
begin
  refine measurable_of_is_closed (λ s hs, _),
  have : fderiv 𝕜 f ⁻¹' s = {x | differentiable_at 𝕜 f x ∧ fderiv 𝕜 f x ∈ s} ∪
    ({x | ¬differentiable_at 𝕜 f x} ∩ {x | (0 : E →L[𝕜] F) ∈ s}) :=
    set.ext (λ x, mem_preimage.trans fderiv_mem_iff),
  rw this,
  exact (measurable_set_of_differentiable_at_of_is_complete _ _ hs.is_complete).union
    ((measurable_set_of_differentiable_at _ _).compl.inter (measurable_set.const _))
end

@[measurability] lemma measurable_fderiv_apply_const [measurable_space F] [borel_space F] (y : E) :
  measurable (λ x, fderiv 𝕜 f x y) :=
(continuous_linear_map.measurable_apply y).comp (measurable_fderiv 𝕜 f)

variable {𝕜}

@[measurability] lemma measurable_deriv [measurable_space 𝕜] [opens_measurable_space 𝕜]
  [measurable_space F] [borel_space F] (f : 𝕜 → F) : measurable (deriv f) :=
by simpa only [fderiv_deriv] using measurable_fderiv_apply_const 𝕜 f 1

lemma strongly_measurable_deriv [measurable_space 𝕜] [opens_measurable_space 𝕜]
  [second_countable_topology F] (f : 𝕜 → F) :
  strongly_measurable (deriv f) :=
by { borelize F, exact (measurable_deriv f).strongly_measurable }

lemma ae_measurable_deriv [measurable_space 𝕜] [opens_measurable_space 𝕜] [measurable_space F]
  [borel_space F] (f : 𝕜 → F) (μ : measure 𝕜) : ae_measurable (deriv f) μ :=
(measurable_deriv f).ae_measurable

lemma ae_strongly_measurable_deriv [measurable_space 𝕜] [opens_measurable_space 𝕜]
  [second_countable_topology F] (f : 𝕜 → F) (μ : measure 𝕜) :
  ae_strongly_measurable (deriv f) μ :=
(strongly_measurable_deriv f).ae_strongly_measurable

end fderiv

section right_deriv

variables {F : Type*} [normed_add_comm_group F] [normed_space ℝ F]
variables {f : ℝ → F} (K : set F)

namespace right_deriv_measurable_aux

/-- The set `A f L r ε` is the set of points `x` around which the function `f` is well approximated
at scale `r` by the linear map `h ↦ h • L`, up to an error `ε`. We tweak the definition to
make sure that this is open on the right. -/
def A (f : ℝ → F) (L : F) (r ε : ℝ) : set ℝ :=
{x | ∃ r' ∈ Ioc (r/2) r, ∀ y z ∈ Icc x (x + r'), ‖f z - f y - (z-y) • L‖ ≤ ε * r}

/-- The set `B f K r s ε` is the set of points `x` around which there exists a vector
`L` belonging to `K` (a given set of vectors) such that `h • L` approximates well `f (x + h)`
(up to an error `ε`), simultaneously at scales `r` and `s`. -/
def B (f : ℝ → F) (K : set F) (r s ε : ℝ) : set ℝ :=
⋃ (L ∈ K), (A f L r ε) ∩ (A f L s ε)

/-- The set `D f K` is a complicated set constructed using countable intersections and unions. Its
main use is that, when `K` is complete, it is exactly the set of points where `f` is differentiable,
with a derivative in `K`. -/
def D (f : ℝ → F) (K : set F) : set ℝ :=
⋂ (e : ℕ), ⋃ (n : ℕ), ⋂ (p ≥ n) (q ≥ n), B f K ((1/2) ^ p) ((1/2) ^ q) ((1/2) ^ e)

lemma A_mem_nhds_within_Ioi {L : F} {r ε x : ℝ} (hx : x ∈ A f L r ε) :
  A f L r ε ∈ 𝓝[>] x :=
begin
  rcases hx with ⟨r', rr', hr'⟩,
  rw mem_nhds_within_Ioi_iff_exists_Ioo_subset,
  obtain ⟨s, s_gt, s_lt⟩ : ∃ (s : ℝ), r / 2 < s ∧ s < r' := exists_between rr'.1,
  have : s ∈ Ioc (r/2) r := ⟨s_gt, le_of_lt (s_lt.trans_le rr'.2)⟩,
  refine ⟨x + r' - s, by { simp only [mem_Ioi], linarith }, λ x' hx', ⟨s, this, _⟩⟩,
  have A : Icc x' (x' + s) ⊆ Icc x (x + r'),
  { apply Icc_subset_Icc hx'.1.le,
    linarith [hx'.2] },
  assume y hy z hz,
  exact hr' y (A hy) z (A hz)
end

lemma B_mem_nhds_within_Ioi {K : set F} {r s ε x : ℝ} (hx : x ∈ B f K r s ε) :
  B f K r s ε ∈ 𝓝[>] x :=
begin
  obtain ⟨L, LK, hL₁, hL₂⟩ : ∃ (L : F), L ∈ K ∧ x ∈ A f L r ε ∧ x ∈ A f L s ε,
    by simpa only [B, mem_Union, mem_inter_iff, exists_prop] using hx,
  filter_upwards [A_mem_nhds_within_Ioi hL₁, A_mem_nhds_within_Ioi hL₂] with y hy₁ hy₂,
  simp only [B, mem_Union, mem_inter_iff, exists_prop],
  exact ⟨L, LK, hy₁, hy₂⟩
end

lemma measurable_set_B {K : set F} {r s ε : ℝ} : measurable_set (B f K r s ε) :=
measurable_set_of_mem_nhds_within_Ioi (λ x hx, B_mem_nhds_within_Ioi hx)

lemma A_mono (L : F) (r : ℝ) {ε δ : ℝ} (h : ε ≤ δ) :
  A f L r ε ⊆ A f L r δ :=
begin
  rintros x ⟨r', r'r, hr'⟩,
  refine ⟨r', r'r, λ y hy z hz, (hr' y hy z hz).trans (mul_le_mul_of_nonneg_right h _)⟩,
  linarith [hy.1, hy.2, r'r.2],
end

lemma le_of_mem_A {r ε : ℝ} {L : F} {x : ℝ} (hx : x ∈ A f L r ε)
  {y z : ℝ} (hy : y ∈ Icc x (x + r/2)) (hz : z ∈ Icc x (x + r/2)) :
  ‖f z - f y - (z-y) • L‖ ≤ ε * r :=
begin
  rcases hx with ⟨r', r'mem, hr'⟩,
  have A : x + r / 2 ≤ x + r', by linarith [r'mem.1],
  exact hr' _ ((Icc_subset_Icc le_rfl A) hy) _ ((Icc_subset_Icc le_rfl A) hz),
end

lemma mem_A_of_differentiable {ε : ℝ} (hε : 0 < ε) {x : ℝ}
  (hx : differentiable_within_at ℝ f (Ici x) x) :
  ∃ R > 0, ∀ r ∈ Ioo (0 : ℝ) R, x ∈ A f (deriv_within f (Ici x) x) r ε :=
begin
  have := hx.has_deriv_within_at,
  simp_rw [has_deriv_within_at_iff_is_o, is_o_iff] at this,
  rcases mem_nhds_within_Ici_iff_exists_Ico_subset.1 (this (half_pos hε)) with ⟨m, xm, hm⟩,
  refine ⟨m - x, by linarith [show x < m, from xm], λ r hr, _⟩,
  have : r ∈ Ioc (r/2) r := ⟨half_lt_self hr.1, le_rfl⟩,
  refine ⟨r, this, λ y hy z hz, _⟩,
  calc  ‖f z - f y - (z - y) • deriv_within f (Ici x) x‖
      = ‖(f z - f x - (z - x) • deriv_within f (Ici x) x)
           - (f y - f x - (y - x) • deriv_within f (Ici x) x)‖ :
    by { congr' 1, simp only [sub_smul], abel }
  ... ≤ ‖f z - f x - (z - x) • deriv_within f (Ici x) x‖
         + ‖f y - f x - (y - x) • deriv_within f (Ici x) x‖ :
    norm_sub_le _ _
  ... ≤ ε / 2 * ‖z - x‖ + ε / 2 * ‖y - x‖ :
    add_le_add (hm ⟨hz.1, hz.2.trans_lt (by linarith [hr.2])⟩)
               (hm ⟨hy.1, hy.2.trans_lt (by linarith [hr.2])⟩)
  ... ≤ ε / 2 * r + ε / 2 * r :
  begin
    apply add_le_add,
    { apply mul_le_mul_of_nonneg_left _ (le_of_lt (half_pos hε)),
      rw [real.norm_of_nonneg];
      linarith [hz.1, hz.2] },
    { apply mul_le_mul_of_nonneg_left _ (le_of_lt (half_pos hε)),
      rw [real.norm_of_nonneg];
      linarith [hy.1, hy.2] },
   end
  ... = ε * r : by ring
end

lemma norm_sub_le_of_mem_A
  {r x : ℝ} (hr : 0 < r) (ε : ℝ) {L₁ L₂ : F}
  (h₁ : x ∈ A f L₁ r ε) (h₂ : x ∈ A f L₂ r ε) : ‖L₁ - L₂‖ ≤ 4 * ε :=
begin
  suffices H : ‖(r/2) • (L₁ - L₂)‖ ≤ (r / 2) * (4 * ε),
    by rwa [norm_smul, real.norm_of_nonneg (half_pos hr).le, mul_le_mul_left (half_pos hr)] at H,
  calc
  ‖(r/2) • (L₁ - L₂)‖
      = ‖(f (x + r/2) - f x - (x + r/2 - x) • L₂) - (f (x + r/2) - f x - (x + r/2 - x) • L₁)‖ :
    by simp [smul_sub]
  ... ≤ ‖f (x + r/2) - f x - (x + r/2 - x) • L₂‖ + ‖f (x + r/2) - f x - (x + r/2 - x) • L₁‖ :
    norm_sub_le _ _
  ... ≤ ε * r + ε * r :
    begin
      apply add_le_add,
      { apply le_of_mem_A h₂;
        simp [(half_pos hr).le] },
      { apply le_of_mem_A h₁;
        simp [(half_pos hr).le] },
    end
  ... = (r / 2) * (4 * ε) : by ring
end

/-- Easy inclusion: a differentiability point with derivative in `K` belongs to `D f K`. -/
lemma differentiable_set_subset_D :
  {x | differentiable_within_at ℝ f (Ici x) x ∧ deriv_within f (Ici x) x ∈ K} ⊆ D f K :=
begin
  assume x hx,
  rw [D, mem_Inter],
  assume e,
  have : (0 : ℝ) < (1/2) ^ e := pow_pos (by norm_num) _,
  rcases mem_A_of_differentiable this hx.1 with ⟨R, R_pos, hR⟩,
  obtain ⟨n, hn⟩ : ∃ (n : ℕ), (1/2) ^ n < R :=
    exists_pow_lt_of_lt_one R_pos (by norm_num : (1 : ℝ)/2 < 1),
  simp only [mem_Union, mem_Inter, B, mem_inter_iff],
  refine ⟨n, λ p hp q hq, ⟨deriv_within f (Ici x) x, hx.2, ⟨_, _⟩⟩⟩;
  { refine hR _ ⟨pow_pos (by norm_num) _, lt_of_le_of_lt _ hn⟩,
    exact pow_le_pow_of_le_one (by norm_num) (by norm_num) (by assumption) }
end

/-- Harder inclusion: at a point in `D f K`, the function `f` has a derivative, in `K`. -/
lemma D_subset_differentiable_set {K : set F} (hK : is_complete K) :
  D f K ⊆ {x | differentiable_within_at ℝ f (Ici x) x ∧ deriv_within f (Ici x) x ∈ K} :=
begin
  have P : ∀ {n : ℕ}, (0 : ℝ) < (1/2) ^ n := pow_pos (by norm_num),
  assume x hx,
  have : ∀ (e : ℕ), ∃ (n : ℕ), ∀ p q, n ≤ p → n ≤ q → ∃ L ∈ K,
    x ∈ A f L ((1/2) ^ p) ((1/2) ^ e) ∩ A f L ((1/2) ^ q) ((1/2) ^ e),
  { assume e,
    have := mem_Inter.1 hx e,
    rcases mem_Union.1 this with ⟨n, hn⟩,
    refine ⟨n, λ p q hp hq, _⟩,
    simp only [mem_Inter, ge_iff_le] at hn,
    rcases mem_Union.1 (hn p hp q hq) with ⟨L, hL⟩,
    exact ⟨L, mem_Union.1 hL⟩, },
  /- Recast the assumptions: for each `e`, there exist `n e` and linear maps `L e p q` in `K`
  such that, for `p, q ≥ n e`, then `f` is well approximated by `L e p q` at scale `2 ^ (-p)` and
  `2 ^ (-q)`, with an error `2 ^ (-e)`. -/
  choose! n L hn using this,
  /- All the operators `L e p q` that show up are close to each other. To prove this, we argue
    that `L e p q` is close to `L e p r` (where `r` is large enough), as both approximate `f` at
    scale `2 ^(- p)`. And `L e p r` is close to `L e' p' r` as both approximate `f` at scale
    `2 ^ (- r)`. And `L e' p' r` is close to `L e' p' q'` as both approximate `f` at scale
    `2 ^ (- p')`. -/
  have M : ∀ e p q e' p' q', n e ≤ p → n e ≤ q → n e' ≤ p' → n e' ≤ q' → e ≤ e' →
    ‖L e p q - L e' p' q'‖ ≤ 12 * (1/2) ^ e,
  { assume e p q e' p' q' hp hq hp' hq' he',
    let r := max (n e) (n e'),
    have I : ((1:ℝ)/2)^e' ≤ (1/2)^e := pow_le_pow_of_le_one (by norm_num) (by norm_num) he',
    have J1 : ‖L e p q - L e p r‖ ≤ 4 * (1/2)^e,
    { have I1 : x ∈ A f (L e p q) ((1 / 2) ^ p) ((1/2)^e) :=
        (hn e p q hp hq).2.1,
      have I2 : x ∈ A f (L e p r) ((1 / 2) ^ p) ((1/2)^e) :=
        (hn e p r hp (le_max_left _ _)).2.1,
      exact norm_sub_le_of_mem_A P _ I1 I2 },
    have J2 : ‖L e p r - L e' p' r‖ ≤ 4 * (1/2)^e,
    { have I1 : x ∈ A f (L e p r) ((1 / 2) ^ r) ((1/2)^e) :=
        (hn e p r hp (le_max_left _ _)).2.2,
      have I2 : x ∈ A f (L e' p' r) ((1 / 2) ^ r) ((1/2)^e') :=
        (hn e' p' r hp' (le_max_right _ _)).2.2,
      exact norm_sub_le_of_mem_A P _ I1 (A_mono _ _ I I2) },
    have J3 : ‖L e' p' r - L e' p' q'‖ ≤ 4 * (1/2)^e,
    { have I1 : x ∈ A f (L e' p' r) ((1 / 2) ^ p') ((1/2)^e') :=
        (hn e' p' r hp' (le_max_right _ _)).2.1,
      have I2 : x ∈ A f (L e' p' q') ((1 / 2) ^ p') ((1/2)^e') :=
        (hn e' p' q' hp' hq').2.1,
      exact norm_sub_le_of_mem_A P _ (A_mono _ _ I I1) (A_mono _ _ I I2) },
    calc ‖L e p q - L e' p' q'‖
          = ‖(L e p q - L e p r) + (L e p r - L e' p' r) + (L e' p' r - L e' p' q')‖ :
        by { congr' 1, abel }
      ... ≤ ‖L e p q - L e p r‖ + ‖L e p r - L e' p' r‖ + ‖L e' p' r - L e' p' q'‖ :
        le_trans (norm_add_le _ _) (add_le_add_right (norm_add_le _ _) _)
      ... ≤ 4 * (1/2)^e + 4 * (1/2)^e + 4 * (1/2)^e :
        by apply_rules [add_le_add]
      ... = 12 * (1/2)^e : by ring },
  /- For definiteness, use `L0 e = L e (n e) (n e)`, to have a single sequence. We claim that this
  is a Cauchy sequence. -/
  let L0 : ℕ → F := λ e, L e (n e) (n e),
  have : cauchy_seq L0,
  { rw metric.cauchy_seq_iff',
    assume ε εpos,
    obtain ⟨e, he⟩ : ∃ (e : ℕ), (1/2) ^ e < ε / 12 :=
      exists_pow_lt_of_lt_one (div_pos εpos (by norm_num)) (by norm_num),
    refine ⟨e, λ e' he', _⟩,
    rw [dist_comm, dist_eq_norm],
    calc ‖L0 e - L0 e'‖
          ≤ 12 * (1/2)^e : M _ _ _ _ _ _ le_rfl le_rfl le_rfl le_rfl he'
      ... < 12 * (ε / 12) :
        mul_lt_mul' le_rfl he (le_of_lt P) (by norm_num)
      ... = ε : by { field_simp [(by norm_num : (12 : ℝ) ≠ 0)], ring } },
  /- As it is Cauchy, the sequence `L0` converges, to a limit `f'` in `K`.-/
  obtain ⟨f', f'K, hf'⟩ : ∃ f' ∈ K, tendsto L0 at_top (𝓝 f') :=
    cauchy_seq_tendsto_of_is_complete hK (λ e, (hn e (n e) (n e) le_rfl le_rfl).1) this,
  have Lf' : ∀ e p, n e ≤ p → ‖L e (n e) p - f'‖ ≤ 12 * (1/2)^e,
  { assume e p hp,
    apply le_of_tendsto (tendsto_const_nhds.sub hf').norm,
    rw eventually_at_top,
    exact ⟨e, λ e' he', M _ _ _ _ _ _ le_rfl hp le_rfl le_rfl he'⟩ },
  /- Let us show that `f` has right derivative `f'` at `x`. -/
  have : has_deriv_within_at f f' (Ici x) x,
  { simp only [has_deriv_within_at_iff_is_o, is_o_iff],
    /- to get an approximation with a precision `ε`, we will replace `f` with `L e (n e) m` for
    some large enough `e` (yielding a small error by uniform approximation). As one can vary `m`,
    this makes it possible to cover all scales, and thus to obtain a good linear approximation in
    the whole interval of length `(1/2)^(n e)`. -/
    assume ε εpos,
    obtain ⟨e, he⟩ : ∃ (e : ℕ), (1 / 2) ^ e < ε / 16 :=
      exists_pow_lt_of_lt_one (div_pos εpos (by norm_num)) (by norm_num),
    have xmem : x ∈ Ico x (x + (1/2)^(n e + 1)),
      by simp only [one_div, left_mem_Ico, lt_add_iff_pos_right, inv_pos, pow_pos, zero_lt_bit0,
        zero_lt_one],
    filter_upwards [Icc_mem_nhds_within_Ici xmem] with y hy,
    -- We need to show that `f y - f x - f' (y - x)` is small. For this, we will work at scale
    -- `k` where `k` is chosen with `‖y - x‖ ∼ 2 ^ (-k)`.
    rcases eq_or_lt_of_le hy.1 with rfl|xy,
    { simp only [sub_self, zero_smul, norm_zero, mul_zero]},
    have yzero : 0 < y - x := sub_pos.2 xy,
    have y_le : y - x ≤ (1/2) ^ (n e + 1), by linarith [hy.2],
    have yone : y - x ≤ 1 := le_trans y_le (pow_le_one _ (by norm_num) (by norm_num)),
    -- define the scale `k`.
    obtain ⟨k, hk, h'k⟩ : ∃ (k : ℕ), (1/2) ^ (k + 1) < y - x ∧ y - x ≤ (1/2) ^ k :=
      exists_nat_pow_near_of_lt_one yzero yone (by norm_num : (0 : ℝ) < 1/2)
      (by norm_num : (1 : ℝ)/2 < 1),
    -- the scale is large enough (as `y - x` is small enough)
    have k_gt : n e < k,
    { have : ((1:ℝ)/2) ^ (k + 1) < (1/2) ^ (n e + 1) := lt_of_lt_of_le hk y_le,
      rw pow_lt_pow_iff_of_lt_one (by norm_num : (0 : ℝ) < 1/2) (by norm_num) at this,
      linarith },
    set m := k - 1 with hl,
    have m_ge : n e ≤ m := nat.le_pred_of_lt k_gt,
    have km : k = m + 1 := (nat.succ_pred_eq_of_pos (lt_of_le_of_lt (zero_le _) k_gt)).symm,
    rw km at hk h'k,
    -- `f` is well approximated by `L e (n e) k` at the relevant scale
    -- (in fact, we use `m = k - 1` instead of `k` because of the precise definition of `A`).
    have J : ‖f y - f x - (y - x) • L e (n e) m‖ ≤ 4 * (1/2) ^ e * ‖y - x‖ := calc
      ‖f y - f x - (y - x) • L e (n e) m‖ ≤ (1/2) ^ e * (1/2) ^ m :
        begin
          apply le_of_mem_A (hn e (n e) m le_rfl m_ge).2.2,
          { simp only [one_div, inv_pow, left_mem_Icc, le_add_iff_nonneg_right],
            exact div_nonneg (inv_nonneg.2 (pow_nonneg zero_le_two _)) zero_le_two },
          { simp only [pow_add, tsub_le_iff_left] at h'k,
            simpa only [hy.1, mem_Icc, true_and, one_div, pow_one] using h'k }
        end
      ... = 4 * (1/2) ^ e * (1/2) ^ (m + 2) : by { field_simp, ring_exp }
      ... ≤ 4 * (1/2) ^ e * (y - x) :
        mul_le_mul_of_nonneg_left (le_of_lt hk) (mul_nonneg (by norm_num) (le_of_lt P))
      ... = 4 * (1/2) ^ e * ‖y - x‖ : by rw [real.norm_of_nonneg yzero.le],
    calc ‖f y - f x - (y - x) • f'‖
        = ‖(f y - f x - (y - x) • L e (n e) m) + (y - x) • (L e (n e) m - f')‖ :
      by simp only [smul_sub, sub_add_sub_cancel]
    ... ≤ 4 * (1/2) ^ e * ‖y - x‖ + ‖y - x‖ * (12 * (1/2) ^ e) : norm_add_le_of_le J
      (by { rw [norm_smul], exact mul_le_mul_of_nonneg_left (Lf' _ _ m_ge) (norm_nonneg _) })
    ... = 16 * ‖y - x‖ * (1/2) ^ e : by ring
    ... ≤ 16 * ‖y - x‖ * (ε / 16) :
      mul_le_mul_of_nonneg_left he.le (mul_nonneg (by norm_num) (norm_nonneg _))
    ... = ε * ‖y - x‖ : by ring },
  rw ← this.deriv_within (unique_diff_on_Ici x x le_rfl) at f'K,
  exact ⟨this.differentiable_within_at, f'K⟩,
end

theorem differentiable_set_eq_D (hK : is_complete K) :
  {x | differentiable_within_at ℝ f (Ici x) x ∧ deriv_within f (Ici x) x ∈ K} = D f K :=
subset.antisymm (differentiable_set_subset_D _) (D_subset_differentiable_set hK)

end right_deriv_measurable_aux

open right_deriv_measurable_aux

variables (f)

/-- The set of right differentiability points of a function, with derivative in a given complete
set, is Borel-measurable. -/
theorem measurable_set_of_differentiable_within_at_Ici_of_is_complete
  {K : set F} (hK : is_complete K) :
  measurable_set {x | differentiable_within_at ℝ f (Ici x) x ∧ deriv_within f (Ici x) x ∈ K} :=
by simp [differentiable_set_eq_D K hK, D, measurable_set_B, measurable_set.Inter,
         measurable_set.Union]

variable [complete_space F]

/-- The set of right differentiability points of a function taking values in a complete space is
Borel-measurable. -/
theorem measurable_set_of_differentiable_within_at_Ici :
  measurable_set {x | differentiable_within_at ℝ f (Ici x) x} :=
begin
  have : is_complete (univ : set F) := complete_univ,
  convert measurable_set_of_differentiable_within_at_Ici_of_is_complete f this,
  simp
end

@[measurability] lemma measurable_deriv_within_Ici [measurable_space F] [borel_space F] :
  measurable (λ x, deriv_within f (Ici x) x) :=
begin
  refine measurable_of_is_closed (λ s hs, _),
  have : (λ x, deriv_within f (Ici x) x) ⁻¹' s =
    {x | differentiable_within_at ℝ f (Ici x) x ∧ deriv_within f (Ici x) x ∈ s} ∪
    ({x | ¬differentiable_within_at ℝ f (Ici x) x} ∩ {x | (0 : F) ∈ s}) :=
    set.ext (λ x, mem_preimage.trans deriv_within_mem_iff),
  rw this,
  exact (measurable_set_of_differentiable_within_at_Ici_of_is_complete _ hs.is_complete).union
    ((measurable_set_of_differentiable_within_at_Ici _).compl.inter (measurable_set.const _))
end

lemma strongly_measurable_deriv_within_Ici [second_countable_topology F] :
  strongly_measurable (λ x, deriv_within f (Ici x) x) :=
by { borelize F, exact (measurable_deriv_within_Ici f).strongly_measurable }

lemma ae_measurable_deriv_within_Ici [measurable_space F] [borel_space F]
  (μ : measure ℝ) : ae_measurable (λ x, deriv_within f (Ici x) x) μ :=
(measurable_deriv_within_Ici f).ae_measurable

lemma ae_strongly_measurable_deriv_within_Ici [second_countable_topology F] (μ : measure ℝ) :
  ae_strongly_measurable (λ x, deriv_within f (Ici x) x) μ :=
(strongly_measurable_deriv_within_Ici f).ae_strongly_measurable

/-- The set of right differentiability points of a function taking values in a complete space is
Borel-measurable. -/
theorem measurable_set_of_differentiable_within_at_Ioi :
  measurable_set {x | differentiable_within_at ℝ f (Ioi x) x} :=
by simpa [differentiable_within_at_Ioi_iff_Ici]
  using measurable_set_of_differentiable_within_at_Ici f

@[measurability] lemma measurable_deriv_within_Ioi [measurable_space F] [borel_space F] :
  measurable (λ x, deriv_within f (Ioi x) x) :=
by simpa [deriv_within_Ioi_eq_Ici] using measurable_deriv_within_Ici f

lemma strongly_measurable_deriv_within_Ioi [second_countable_topology F] :
  strongly_measurable (λ x, deriv_within f (Ioi x) x) :=
by { borelize F, exact (measurable_deriv_within_Ioi f).strongly_measurable }

lemma ae_measurable_deriv_within_Ioi [measurable_space F] [borel_space F]
  (μ : measure ℝ) : ae_measurable (λ x, deriv_within f (Ioi x) x) μ :=
(measurable_deriv_within_Ioi f).ae_measurable

lemma ae_strongly_measurable_deriv_within_Ioi [second_countable_topology F] (μ : measure ℝ) :
  ae_strongly_measurable (λ x, deriv_within f (Ioi x) x) μ :=
(strongly_measurable_deriv_within_Ioi f).ae_strongly_measurable

end right_deriv


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel, Scott Morrison

! This file was ported from Lean 3 source module category_theory.abelian.images
! leanprover-community/mathlib commit 9e7c80f638149bfb3504ba8ff48dfdbfc949fb1a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Limits.Shapes.Kernels

/-!
# The abelian image and coimage.

In an abelian category we usually want the image of a morphism `f` to be defined as
`kernel (cokernel.π f)`, and the coimage to be defined as `cokernel (kernel.ι f)`.

We make these definitions here, as `Abelian.image f` and `Abelian.coimage f`
(without assuming the category is actually abelian),
and later relate these to the usual categorical notions when in an abelian category.

There is a canonical morphism `coimageImageComparison : Abelian.coimage f ⟶ Abelian.image f`.
Later we show that this is always an isomorphism in an abelian category,
and conversely a category with (co)kernels and finite products in which this morphism
is always an isomorphism is an abelian category.
-/

noncomputable section

universe v u

open CategoryTheory

open CategoryTheory.Limits

namespace CategoryTheory.Abelian

variable {C : Type u} [Category.{v} C] [HasZeroMorphisms C] [HasKernels C] [HasCokernels C]

variable {P Q : C} (f : P ⟶ Q)

section Image

/-- The kernel of the cokernel of `f` is called the (abelian) image of `f`. -/
protected abbrev image : C :=
  kernel (cokernel.π f)
#align category_theory.abelian.image CategoryTheory.Abelian.image

/-- The inclusion of the image into the codomain. -/
protected abbrev image.ι : Abelian.image f ⟶ Q :=
  kernel.ι (cokernel.π f)
#align category_theory.abelian.image.ι CategoryTheory.Abelian.image.ι

/-- There is a canonical epimorphism `p : P ⟶ image f` for every `f`. -/
protected abbrev factorThruImage : P ⟶ Abelian.image f :=
  kernel.lift (cokernel.π f) f <| cokernel.condition f
#align category_theory.abelian.factor_thru_image CategoryTheory.Abelian.factorThruImage

-- Porting note: simp can prove this and reassoc version, removed tags
/-- `f` factors through its image via the canonical morphism `p`. -/
protected theorem image.fac : Abelian.factorThruImage f ≫ image.ι f = f :=
  kernel.lift_ι _ _ _
#align category_theory.abelian.image.fac CategoryTheory.Abelian.image.fac

instance mono_factorThruImage [Mono f] : Mono (Abelian.factorThruImage f) :=
  mono_of_mono_fac <| image.fac f
#align category_theory.abelian.mono_factor_thru_image CategoryTheory.Abelian.mono_factorThruImage

end Image

section Coimage

/-- The cokernel of the kernel of `f` is called the (abelian) coimage of `f`. -/
protected abbrev coimage : C :=
  cokernel (kernel.ι f)
#align category_theory.abelian.coimage CategoryTheory.Abelian.coimage

/-- The projection onto the coimage. -/
protected abbrev coimage.π : P ⟶ Abelian.coimage f :=
  cokernel.π (kernel.ι f)
#align category_theory.abelian.coimage.π CategoryTheory.Abelian.coimage.π

/-- There is a canonical monomorphism `i : coimage f ⟶ Q`. -/
protected abbrev factorThruCoimage : Abelian.coimage f ⟶ Q :=
  cokernel.desc (kernel.ι f) f <| kernel.condition f
#align category_theory.abelian.factor_thru_coimage CategoryTheory.Abelian.factorThruCoimage

/-- `f` factors through its coimage via the canonical morphism `p`. -/
protected theorem coimage.fac : coimage.π f ≫ Abelian.factorThruCoimage f = f :=
  cokernel.π_desc _ _ _
#align category_theory.abelian.coimage.fac CategoryTheory.Abelian.coimage.fac

instance epi_factorThruCoimage [Epi f] : Epi (Abelian.factorThruCoimage f) :=
  epi_of_epi_fac <| coimage.fac f
#align category_theory.abelian.epi_factor_thru_coimage CategoryTheory.Abelian.epi_factorThruCoimage

end Coimage

/-- The canonical map from the abelian coimage to the abelian image.
In any abelian category this is an isomorphism.

Conversely, any additive category with kernels and cokernels and
in which this is always an isomorphism, is abelian.

See <https://stacks.math.columbia.edu/tag/0107>
-/
def coimageImageComparison : Abelian.coimage f ⟶ Abelian.image f :=
  cokernel.desc (kernel.ι f) (kernel.lift (cokernel.π f) f (by simp)) <|
    by apply equalizer.hom_ext; simp
#align category_theory.abelian.coimage_image_comparison CategoryTheory.Abelian.coimageImageComparison

/-- An alternative formulation of the canonical map from the abelian coimage to the abelian image.
-/
def coimageImageComparison' : Abelian.coimage f ⟶ Abelian.image f :=
  kernel.lift (cokernel.π f) (cokernel.desc (kernel.ι f) f (by simp))
    (by apply coequalizer.hom_ext; simp)
#align category_theory.abelian.coimage_image_comparison' CategoryTheory.Abelian.coimageImageComparison'

theorem coimageImageComparison_eq_coimageImageComparison' :
    coimageImageComparison f = coimageImageComparison' f := by
  apply coequalizer.hom_ext; apply equalizer.hom_ext
  simp [coimageImageComparison, coimageImageComparison']
#align category_theory.abelian.coimage_image_comparison_eq_coimage_image_comparison' CategoryTheory.Abelian.coimageImageComparison_eq_coimageImageComparison'

@[reassoc (attr := simp)]
theorem coimage_image_factorisation : coimage.π f ≫ coimageImageComparison f ≫ image.ι f = f := by
  simp [coimageImageComparison]
#align category_theory.abelian.coimage_image_factorisation CategoryTheory.Abelian.coimage_image_factorisation

end CategoryTheory.Abelian


universes u

def f1 (n m : Nat) (x : Fin n) (h : n = m) : Fin m :=
h ▸ x

def f2 (n m : Nat) (x : Fin n) (h : m = n) : Fin m :=
h ▸ x

theorem ex1 {α : Sort u} {a b c : α} (h₁ : a = b) (h₂ : b = c) : a = c :=
h₂ ▸ h₁

theorem ex2 {α : Sort u} {a b : α} (h : a = b) : b = a :=
h ▸ rfl

theorem ex3 {α : Sort u} {a b c : α} (r : α → α → Prop) (h₁ : r a b) (h₂ : b = c) : r a c :=
h₂ ▸ h₁

theorem ex3b {α : Sort u} {a b c : α} (r : α → α → Prop) (h₁ : r a b) (h₂ : b = c) : r a c :=
h₂.symm ▸ h₁

theorem ex3c {α : Sort u} {a b c : α} (r : α → α → Prop) (h₁ : r a b) (h₂ : b = c) : r a c :=
h₂.symm.symm ▸ h₁

theorem ex4 {α : Sort u} {a b c : α} (r : α → α → Prop) (h₁ : a = b) (h₂ : r b c) : r a c :=
h₁ ▸ h₂

theorem ex5 {p : Prop} (h : p = True) : p :=
h ▸ trivial

theorem ex6 {p : Prop} (h : p = False) : ¬p :=
fun hp => h ▸ hp

theorem ex7 {α} {a b c d : α} (h₁ : a = c) (h₂ : b = d) (h₃ : c ≠ d) : a ≠ b :=
h₁ ▸ h₂ ▸ h₃

theorem ex8 (n m k : Nat) (h : Nat.succ n + m = Nat.succ n + k) : Nat.succ (n + m) = Nat.succ (n + k) :=
Nat.succ_add .. ▸ Nat.succ_add .. ▸ h

theorem ex9 (a b : Nat) (h₁ : a = a + b) (h₂ : a = b) : a = b + a  :=
h₂ ▸ h₁

theorem ex10 (a b : Nat) (h : a = b) : b = a :=
h ▸ rfl

def ex11  {α : Type u} {n : Nat} (a : Array α) (i : Nat) (h₁ : a.size = n) (h₂ : i < n) : α :=
  a.get ⟨i, h₁ ▸ h₂⟩

theorem ex12 {α : Type u} {n : Nat}
  (a b : Array α)
  (hsz₁ : a.size = n) (hsz₂ : b.size = n)
  (h : ∀ (i : Nat) (hi : i < n), a.getLit i hsz₁ hi = b.getLit i hsz₂ hi) : a = b :=
Array.ext a b (hsz₁.trans hsz₂.symm) fun i hi₁ hi₂ => h i (hsz₁ ▸ hi₁)

def toArrayLit {α : Type u} (a : Array α) (n : Nat) (hsz : a.size = n) : Array α :=
List.toArray $ Array.toListLitAux a n hsz n (hsz ▸ Nat.leRefl _) []

partial def isEqvAux {α} (a b : Array α) (hsz : a.size = b.size) (p : α → α → Bool) (i : Nat) : Bool :=
  if h : i < a.size then
     let aidx : Fin a.size := ⟨i, h⟩
     let bidx : Fin b.size := ⟨i, hsz ▸ h⟩
     match p (a.get aidx) (b.get bidx) with
     | true  => isEqvAux a b hsz p (i+1)
     | false => false
  else
    true


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

import ..todo
import topology.separation

/-!
A formal roadmap for the shrinking lemma for local finite countable covers.

It contains the statement of the lemma, and an informal sketch of the proof,
along with references.

The lemma is now formalized as `exists_subset_Union_closure_subset` in `topology/shrinking_lemma`.
This file is preserved as an example of a formal roadmap.

The actual implementation differs from the roadmap in two aspects:

- it uses a custom `structure` with a `partial_order` instead of a combination
  of `sigma` and `subtype`;
- it provides a version for coverings of a closed set in a normal space. While mathematically it's
  almost the same (just add `sᶜ` to the covering), it's easier to prove a version for a closed set,
  then apply it to `univ` than to deal with coverings indexed by `option α`.
-/

open set

universes u v

/-- A point-finite open cover of a closed subset of a normal space can be "shrunk" to a new open
cover so that the closure of each new open set is contained in the corresponding original open
set. -/
lemma roadmap.shrinking_lemma {X : Type u} [topological_space X] [normal_space X]
  {s : set X} (hs : is_closed s) {α : Type v} (u : α → set X) (uo : ∀ a, is_open (u a))
  (uf : ∀ x, {a | x ∈ u a}.finite) (su : s ⊆ Union u) :
  ∃ v : α → set X, s ⊆ Union v ∧ ∀ a, is_open (v a) ∧ closure (v a) ⊆ u a :=
todo
/-
Apply Zorn's lemma to
 T = Σ (i : set α), {v : α → set X // s ⊆ Union v ∧ (∀ a, is_open (v a)) ∧
                                      (∀ a ∈ i, closure (v a) ⊆ u a) ∧ (∀ a ∉ i, v a = u a)}
with the ordering
 ⟨i, v, _⟩ ≤ ⟨i', v', _⟩ ↔ i ⊆ i' ∧ ∀ a ∈ i, v a = v' a
The hypothesis that `X` is normal implies that a maximal element must have `i = univ`.
Point-finiteness of `u` (hypothesis `uf`) implies that
the least upper bound of a chain in `T` again yields a covering of `s`.

Compare proofs in
* https://ncatlab.org/nlab/show/shrinking+lemma#ShrinkingLemmaForLocallyFiniteCountableCovers
* Bourbaki, General Topology, Chapter IX, §4.3
* Dugundji, Topology, Chapter VII, Theorem 6.1
-/


import tactic
import data.finsupp.basic -- finitely-supported functions
import data.polynomial.basic -- polynomials

/-

# Finitely-supported functions

We're used to dealing with finite-dimensional vector spaces when we begin studying
vector spaces, but infinite-dimensional vector spaces exist everywhere (for example
the polynonial ring `ℝ[X]` is an infinite-dimensional real vector space) and Lean
is happy to work with both finite and infinite-dimensional vector spaces.

If `V` is a finite-dimensional vector space, with basis `{e₁,e₂,...,eₙ}`, then
every element of `V` can be uniquely expressed as ∑ cᵢeᵢ, with cᵢ in the ground field.
In the infinite-dimensional case this doesn't make sense, because in algebra you
cannot do infinite sums in general; you need some kind of metric or topology
to express the idea that an infinite sum converges or tends to some limit, and a general
field `k` may not have a metric or a topology. If `k` is a finite field, you could
give it the discrete topology, but then no infinite sum would converge, unless all
but finitely many of the terms were actually equal to zero.

The simplest example of an infinite-dimensional vector space is the ring of polynomials
`k[X]` over a field `k`, and this vector space has a basis `{1,X,X²,X³,...}`. Hopefully
this enables you to see what is going on: whilst the vector space is infinite-dimensional,
and the basis is infinite, each vector in the space (i.e. each polynomial in `k[X]`) is
a *finite* linear combination of basis elements; so we have `v = ∑ᵢ cᵢ eᵢ` but all
of the `cᵢ` are zero other than finitely many of them. This makes the sum finite,
and hence it makes in algebra without having to assume anything about existence of
metrics or topologies.

This example shows that an important role in the theory of vector spaces is played
by the *finitely-supported functions*. If `X` and `Y` are types, and `Y` has a special
element called `0`, then a function from `X` to `Y` is *finitely-supported* if it sends
all but finitely many elements of `X` to `0`. Just like the theory of finite sets,
there are two ways to set up a theory of finitely-supported functions. We could first
consider all functions and then have a predicate on functions saying "I have finite support".
Alternatively, we could make an entirely new type of finitely-supported functions, and
then just have a map from that type to the type of all functions. This latter approach
is what we do in Lean.

The type of finitely-supported functions from `X` to `Y` is denoted `X →₀ Y`, which
is notation for `finsupp X Y`. Note that `Y` needs to have a `zero` for this notion
to make sense.

-/

example : Type := ℕ →₀ ℕ -- works because ℕ has a zero

/-

The theory of finitely supported functions is a noncomputable theory in Lean 3, so
let's switch `noncomputable` on.

-/

noncomputable theory

-- In the application to vector spaces, `Y` will be a field, so it will have a zero.
-- If you know about free modules, then you can let `Y` be a ring.

-- Lean's typeclass inference system knows that if `X` is an arbitrary type and `k` is a field,
-- then `X →₀ k` is a `k`-vector space.

example (X : Type) (k : Type) [field k] : module k (X →₀ k) := infer_instance

-- In particular, Lean is happy to add two finitely-supported functions and return
-- a finitely-supported function.

-- Lean will also allow you to evaluate a finitely-supported function at an input,
-- even though a finitely-supported function is not strictly speaking a function
-- (it's a function plus some extra data and proofs). Lean will *coerce* a finitely-supported
-- function into a function if required though (the coercion symbol for coercion into
-- functions is `⇑`).

example (X : Type) (k : Type) [field k] (f : X →₀ k) (x : X) : k := f x -- actually `⇑f x`

-- Because these things are a vector space, addition of two finitely-supported functions is a
-- finitely-supported function. Similarly multiplication by a scalar is a finitely-supported
-- function

example (X : Type) (k : Type) [field k] (f g : X →₀ k) (c : k) : X →₀ k := c • f + g


import tactic.fin_cases
import data.nat.prime
import group_theory.perm.sign
import tactic.norm_num

example (f : ℕ → Prop) (p : fin 3) (h0 : f 0) (h1 : f 1) (h2 : f 2) : f p.val :=
begin
  fin_cases *,
  simp, assumption,
  simp, assumption,
  simp, assumption,
end

example (x2 : fin 2) (x3 : fin 3) (n : nat) (y : fin n) : x2.val * x3.val = x3.val * x2.val :=
begin
  fin_cases x2;
  fin_cases x3,
  success_if_fail { fin_cases * },
  success_if_fail { fin_cases y },
  all_goals { simp },
end

open finset
example (x : ℕ) (h : x ∈ Ico 2 5) : x = 2 ∨ x = 3 ∨ x = 4 :=
begin
  fin_cases h,
  all_goals { simp }
end

open nat
example (x : ℕ) (h : x ∈ [2,3,5,7]) : x = 2 ∨ x = 3 ∨ x = 5 ∨ x = 7 :=
begin
  fin_cases h,
  all_goals { simp }
end

example (x : ℕ) (h : x ∈ [2,3,5,7]) : true :=
begin
  success_if_fail { fin_cases h with [3,3,5,7] },
  trivial
end

example (x : list ℕ) (h : x ∈ [[1],[2]]) : x.length = 1 :=
begin
  fin_cases h with [[1],[1+1]],
  simp,
  guard_target (list.length [1 + 1] = 1),
  simp
end

 -- testing that `with` arguments are elaborated with respect to the expected type:
example (x : ℤ) (h : x ∈ ([2,3] : list ℤ)) : x = 2 ∨ x = 3:=
begin
  fin_cases h with [2,3],
  all_goals { simp }
end

instance (n : ℕ) : decidable (prime n) := decidable_prime_1 n
example (x : ℕ) (h : x ∈ (range 10).filter prime) : x = 2 ∨ x = 3 ∨ x = 5 ∨ x = 7 :=
begin
  fin_cases h; exact dec_trivial
end

open equiv.perm
example (x : (Σ (a : fin 4), fin 4)) (h : x ∈ fin_pairs_lt 4) : x.1.val < 4 :=
begin
  fin_cases h; simp,
  any_goals { exact dec_trivial },
end

example (x : fin 3) : x.val < 5 :=
begin
  fin_cases x; exact dec_trivial
end

example (f : ℕ → Prop) (p : fin 3) (h0 : f 0) (h1 : f 1) (h2 : f 2) : f p.val :=
begin
  fin_cases *,
  all_goals { assumption }
end